Browse Source

More bugfixes for agenda column view

Make org-agenda-columns-summarize work properly with the new summary types.
It was assuming the values should be summarised by adding them together. It's
now updated to use the summary functions in org-columns-compile-map, and also
handles summary types with calculated values properly.

Leave calculated columns blank if there is no underlying value.

Don't return zero if a property is missing.

Changes are also applied to xemacs colview.
James TD Smith 16 years ago
parent
commit
b81fae4c3f
3 changed files with 105 additions and 40 deletions
  1. 16 0
      lisp/ChangeLog
  2. 44 19
      lisp/org-colview-xemacs.el
  3. 45 21
      lisp/org-colview.el

+ 16 - 0
lisp/ChangeLog

@@ -1,3 +1,19 @@
+2009-11-12  James TD Smith  <ahktenzero@mohorovi.cc>
+
+	* org-colview.el (org-columns-display-here): Don't try to
+	calculate values if the underlying property is not set.
+	(org-columns-string-to-number): Convert age strings back into
+	fractional days.
+	(org-agenda-colview-summarize): Handle extended summary types
+	properly.
+
+	* org-colview-xemacs.el (org-columns-display-here): Don't try to
+	calculate values if the underlying property is not set.
+	(org-columns-string-to-number): Convert age strings back into
+	fractional days.
+	(org-agenda-colview-summarize): Handle extended summary types
+	properly.
+
 2009-11-11  Carsten Dominik  <carsten.dominik@gmail.com>
 2009-11-11  Carsten Dominik  <carsten.dominik@gmail.com>
 
 
 	* org-protocol.el (org-protocol-char-to-string): New defsubst.
 	* org-protocol.el (org-protocol-char-to-string): New defsubst.

+ 44 - 19
lisp/org-colview-xemacs.el

@@ -358,6 +358,7 @@ This is the compiled version of the format.")
 			    (org-agenda-columns-cleanup-item
 			    (org-agenda-columns-cleanup-item
 			     val pl cphr org-columns-current-fmt-compiled)))
 			     val pl cphr org-columns-current-fmt-compiled)))
 			 ((and calc (functionp calc)
 			 ((and calc (functionp calc)
+			       (not (string= val ""))
 			       (not (get-text-property 0 'org-computed val)))
 			       (not (get-text-property 0 'org-computed val)))
 			  (org-columns-number-to-string
 			  (org-columns-number-to-string
 			   (funcall calc (org-columns-string-to-number
 			   (funcall calc (org-columns-string-to-number
@@ -1230,9 +1231,16 @@ Don't set this, this is meant for dynamic scoping.")
   (if s
   (if s
       (cond
       (cond
        ((memq fmt '(min_age max_age mean_age))
        ((memq fmt '(min_age max_age mean_age))
-	(if (string= s "")
-	    org-columns-time
-	  (time-to-number-of-days (apply 'encode-time (org-parse-time-string s t)))))
+	(cond ((string= s "") org-columns-time)
+	      ((string-match
+		"\\([0-9]+\\)d \\([0-9]+\\)h \\([0-9]+\\)m \\([0-9]+\\)s"
+		s)
+	       (+ (* 60 (+ (* 60 (+ (* 24 (string-to-number (match-string 1 s)))
+				    (string-to-number (match-string 2 s))))
+			   (string-to-number (match-string 3 s))))
+		  (string-to-number (match-string 4 s))))
+	      (t (time-to-number-of-days (apply 'encode-time
+						(org-parse-time-string s t))))))
        ((string-match ":" s)
        ((string-match ":" s)
 	(let ((l (nreverse (org-split-string s ":"))) (sum 0.0))
 	(let ((l (nreverse (org-split-string s ":"))) (sum 0.0))
 	  (while l
 	  (while l
@@ -1577,10 +1585,11 @@ and tailing newline characters."
   "Summarize the summarizable columns in column view in the agenda.
   "Summarize the summarizable columns in column view in the agenda.
 This will add overlays to the date lines, to show the summary for each day."
 This will add overlays to the date lines, to show the summary for each day."
   (let* ((fmt (mapcar (lambda (x)
   (let* ((fmt (mapcar (lambda (x)
-			(list (car x) (if (equal (car x) "CLOCKSUM")
-					  'add_times (nth 4 x))))
+			(if (equal (car x) "CLOCKSUM")
+			    (list "CLOCKSUM" (nth 2 x) add_times + identity)
+			  (cdr x)))
 		      org-columns-current-fmt-compiled))
 		      org-columns-current-fmt-compiled))
-	 line c c1 stype props lsum entries prop v)
+	 line c c1 stype calc sumfunc props lsum entries prop v)
     (catch 'exit
     (catch 'exit
       (when (delq nil (mapcar 'cadr fmt))
       (when (delq nil (mapcar 'cadr fmt))
 	;; OK, at least one summation column, it makes sense to try this
 	;; OK, at least one summation column, it makes sense to try this
@@ -1603,24 +1612,40 @@ This will add overlays to the date lines, to show the summary for each day."
 	      (setq props
 	      (setq props
 		    (mapcar
 		    (mapcar
 		     (lambda (f)
 		     (lambda (f)
-		       (setq prop (car f) stype (nth 1 f))
+		       (setq prop (car f)
+			     stype (nth 3 f)
+			     sumfunc (nth 5 f)
+			     calc (or (nth 6 f) 'identity))
 		       (cond
 		       (cond
 			((equal prop "ITEM")
 			((equal prop "ITEM")
 			 (cons prop (buffer-substring (point-at-bol)
 			 (cons prop (buffer-substring (point-at-bol)
 						      (point-at-eol))))
 						      (point-at-eol))))
 			((not stype) (cons prop ""))
 			((not stype) (cons prop ""))
-			(t
-			 ;; do the summary
-			 (setq lsum 0)
-			 (mapc (lambda (x)
-				 (setq v (cdr (assoc prop x)))
-				 (if v (setq lsum (+ lsum
-						     (org-columns-string-to-number
-						      v stype)))))
-			       entries)
-			 (setq lsum (org-columns-number-to-string lsum stype))
-			 (put-text-property
-			  0 (length lsum) 'face 'bold lsum)
+			(t ;; do the summary
+			 (setq lsum nil)
+			 (dolist (x entries)
+			   (setq v (cdr (assoc prop x)))
+			   (if v
+			       (push
+				(funcall
+				 (if (not (get-text-property 0 'org-computed v))
+				     calc
+				   'identity)
+				 (org-columns-string-to-number
+				  v stype))
+				lsum)))
+			 (setq lsum (remove nil lsum))
+			 (setq lsum
+			       (cond ((> (length lsum) 1)
+				      (org-columns-number-to-string
+				       (apply sumfunc lsum) stype))
+				     ((eq (length lsum) 1)
+				      (org-columns-number-to-string
+				       (car lsum) stype))
+				     (t "")))
+			 (put-text-property 0 (length lsum) 'face 'bold lsum)
+			 (if (neq calc 'identity)
+			     (put-text-property 0 (length lsum) 'org-computed t lsum))
 			 (cons prop lsum))))
 			 (cons prop lsum))))
 		     fmt))
 		     fmt))
 	      (org-columns-display-here props)
 	      (org-columns-display-here props)

+ 45 - 21
lisp/org-colview.el

@@ -203,6 +203,7 @@ This is the compiled version of the format.")
 			    (org-agenda-columns-cleanup-item
 			    (org-agenda-columns-cleanup-item
 			     val pl cphr org-columns-current-fmt-compiled)))
 			     val pl cphr org-columns-current-fmt-compiled)))
 			 ((and calc (functionp calc)
 			 ((and calc (functionp calc)
+			       (not (string= val ""))
 			       (not (get-text-property 0 'org-computed val)))
 			       (not (get-text-property 0 'org-computed val)))
 			  (org-columns-number-to-string
 			  (org-columns-number-to-string
 			   (funcall calc (org-columns-string-to-number
 			   (funcall calc (org-columns-string-to-number
@@ -1044,9 +1045,16 @@ Don't set this, this is meant for dynamic scoping.")
   (if s
   (if s
       (cond
       (cond
        ((memq fmt '(min_age max_age mean_age))
        ((memq fmt '(min_age max_age mean_age))
-	(if (string= s "")
-	    org-columns-time
-	  (time-to-number-of-days (apply 'encode-time (org-parse-time-string s t)))))
+	(cond ((string= s "") org-columns-time)
+	      ((string-match
+		"\\([0-9]+\\)d \\([0-9]+\\)h \\([0-9]+\\)m \\([0-9]+\\)s"
+		s)
+	       (+ (* 60 (+ (* 60 (+ (* 24 (string-to-number (match-string 1 s)))
+				    (string-to-number (match-string 2 s))))
+			   (string-to-number (match-string 3 s))))
+		  (string-to-number (match-string 4 s))))
+	      (t (time-to-number-of-days (apply 'encode-time
+						(org-parse-time-string s t))))))
        ((string-match ":" s)
        ((string-match ":" s)
 	(let ((l (nreverse (org-split-string s ":"))) (sum 0.0))
 	(let ((l (nreverse (org-split-string s ":"))) (sum 0.0))
 	  (while l
 	  (while l
@@ -1054,8 +1062,7 @@ Don't set this, this is meant for dynamic scoping.")
 	  sum))
 	  sum))
        ((memq fmt '(checkbox checkbox-n-of-m checkbox-percent))
        ((memq fmt '(checkbox checkbox-n-of-m checkbox-percent))
 	(if (equal s "[X]") 1. 0.000001))
 	(if (equal s "[X]") 1. 0.000001))
-       (t (string-to-number s)))
-    0))
+       (t (string-to-number s)))))
 
 
 (defun org-columns-uncompile-format (cfmt)
 (defun org-columns-uncompile-format (cfmt)
   "Turn the compiled columns format back into a string representation."
   "Turn the compiled columns format back into a string representation."
@@ -1364,10 +1371,11 @@ and tailing newline characters."
   "Summarize the summarizable columns in column view in the agenda.
   "Summarize the summarizable columns in column view in the agenda.
 This will add overlays to the date lines, to show the summary for each day."
 This will add overlays to the date lines, to show the summary for each day."
   (let* ((fmt (mapcar (lambda (x)
   (let* ((fmt (mapcar (lambda (x)
-			(list (car x) (if (equal (car x) "CLOCKSUM")
-					  'add_times (nth 4 x))))
+			(if (equal (car x) "CLOCKSUM")
+			    (list "CLOCKSUM" (nth 2 x) add_times + identity)
+			  (cdr x)))
 		      org-columns-current-fmt-compiled))
 		      org-columns-current-fmt-compiled))
-	 line c c1 stype props lsum entries prop v)
+	 line c c1 stype calc sumfunc props lsum entries prop v)
     (catch 'exit
     (catch 'exit
       (when (delq nil (mapcar 'cadr fmt))
       (when (delq nil (mapcar 'cadr fmt))
 	;; OK, at least one summation column, it makes sense to try this
 	;; OK, at least one summation column, it makes sense to try this
@@ -1390,24 +1398,40 @@ This will add overlays to the date lines, to show the summary for each day."
 	      (setq props
 	      (setq props
 		    (mapcar
 		    (mapcar
 		     (lambda (f)
 		     (lambda (f)
-		       (setq prop (car f) stype (nth 1 f))
+		       (setq prop (car f)
+			     stype (nth 3 f)
+			     sumfunc (nth 5 f)
+			     calc (or (nth 6 f) 'identity))
 		       (cond
 		       (cond
 			((equal prop "ITEM")
 			((equal prop "ITEM")
 			 (cons prop (buffer-substring (point-at-bol)
 			 (cons prop (buffer-substring (point-at-bol)
 						      (point-at-eol))))
 						      (point-at-eol))))
 			((not stype) (cons prop ""))
 			((not stype) (cons prop ""))
-			(t
-			 ;; do the summary
-			 (setq lsum 0)
-			 (mapc (lambda (x)
-				 (setq v (cdr (assoc prop x)))
-				 (if v (setq lsum (+ lsum
-						     (org-columns-string-to-number
-						      v stype)))))
-			       entries)
-			 (setq lsum (org-columns-number-to-string lsum stype))
-			 (put-text-property
-			  0 (length lsum) 'face 'bold lsum)
+			(t ;; do the summary
+			 (setq lsum nil)
+			 (dolist (x entries)
+			   (setq v (cdr (assoc prop x)))
+			   (if v
+			       (push
+				(funcall
+				 (if (not (get-text-property 0 'org-computed v))
+				     calc
+				   'identity)
+				 (org-columns-string-to-number
+				  v stype))
+				lsum)))
+			 (setq lsum (remove nil lsum))
+			 (setq lsum
+			       (cond ((> (length lsum) 1)
+				      (org-columns-number-to-string
+				       (apply sumfunc lsum) stype))
+				     ((eq (length lsum) 1)
+				      (org-columns-number-to-string
+				       (car lsum) stype))
+				     (t "")))
+			 (put-text-property 0 (length lsum) 'face 'bold lsum)
+			 (if (neq calc 'identity)
+			     (put-text-property 0 (length lsum) 'org-computed t lsum))
 			 (cons prop lsum))))
 			 (cons prop lsum))))
 		     fmt))
 		     fmt))
 	      (org-columns-display-here props 'dateline)
 	      (org-columns-display-here props 'dateline)