[PATCH] Add min/max/mean age operators to column view.

[James TD Smith <ahktenzero@mohorovi.cc>]

I posted a patch to the list in July which added two new special properties
intended for displaying the age of an entry in column view. After some
discussion with Bastien (who was maintainer at the time) we decided I would
reimplement this functionality using column summary operators. It took me a
while bit I've finally got a working version.

The patch is also available in the misc-new-features branch at
git://yog-sothoth.mohorovi.cc/org-mode.git.

---
 lisp/ChangeLog      |   38 +++++++---
 lisp/org-colview.el |  198 ++++++++++++++++++++++++++++++++-------------------
 lisp/org.el         |    4 +-
 3 files changed, 156 insertions(+), 84 deletions(-)

diff --git a/lisp/ChangeLog b/lisp/ChangeLog
index 1b5848e..5677058 100755
--- a/lisp/ChangeLog
+++ b/lisp/ChangeLog
@@ -1,3 +1,27 @@
+2009-10-25  James TD Smith  <ahktenzero@mohorovi.cc>
+
+	* org-colview.el (org-format-time-period): Function to format
+	times in fractional days for display.
+	(org-columns-display-here): Add support for showing a calculated
+	value in place of the property.
+	(org-columns): Set `org-columns-time' to the current time so time
+	difference calculations will work.
+	(org-columns-time): Use to store the current time when column view
+	is displayed, so all time differences will use the same reference
+	point.
+	(org-columns-compile-map): There is now an extra position in each
+	entry specifying the function to use to calculate the displayed
+	value for the non-calculated properties in the column,
+	(org-columns-compute-all): Set `org-columns-time' to the current
+	time so time difference calculations will work.
+	(org-columns-compute): Handle column operators where the values
+	used are calculated from the underlying property.
+	(org-columns-number-to-string): Handle the 'age' column format
+	(org-columns-string-to-number): Correct the function name (was
+	org-column...). Add support for the 'age' column format.
+	(org-columns-compile-format): Support the additional parameter in
+	org-columns-compile-map.
+
 2009-10-25  Carsten Dominik  <carsten.dominik@gmail.com>

 	* org-clock.el (org-clock-has-been-used): New variable.
@@ -1543,20 +1567,14 @@
 	* org-exp.el (org-export-format-source-code-or-example): Fix
 	bad line numbering when exporting examples in HTML.

-2009-07-12  James TD Smith  <ahktenzero@mohorovi.cc>
-
 	* org-colview.el (org-format-time-period): Formats a time in
 	fractional days as days, hours, mins, seconds.
 	(org-columns-display-here): Add special handling for SINCE and
 	SINCE_IA to format for display.

-	* org.el (org-time-since): Add a function to get the time since an
-	org timestamp.
-	(org-entry-properties): Add two new special properties: SINCE and
-	SINCE_IA. These give the time since any active or inactive
-	timestamp in an entry.
-	(org-special-properties): Add SINCE, SINCE_IA.
-	(org-tags-sort-function): Add custom declaration for tags
+2009-07-12  James TD Smith  <ahktenzero@mohorovi.cc>
+
+	* org.el (org-tags-sort-function): Add custom declaration for tags
 	sorting function.
 	(org-set-tags): Sort tags if org-tags-sort-function is set

@@ -4423,7 +4441,7 @@
 	(org-agenda-change-all-lines, org-tags-sparse-tree)
 	(org-time-string-to-absolute, org-small-year-to-year)
 	(org-link-escape): Re-apply changes accidentially overwritten
-	by last commit to Emacs.
+	by last commit to Emacs

 2008-11-23  Carsten Dominik  <carsten.dominik@gmail.com>

diff --git a/lisp/org-colview.el b/lisp/org-colview.el
index 374d22a..87c1412 100644
--- a/lisp/org-colview.el
+++ b/lisp/org-colview.el
@@ -111,8 +111,8 @@ This is the compiled version of the format.")
 (org-defkey org-columns-map [(shift meta left)] 'org-columns-delete)
 (dotimes (i 10)
   (org-defkey org-columns-map (number-to-string i)
-              `(lambda () (interactive)
-                 (org-columns-next-allowed-value nil ,i))))
+	      `(lambda () (interactive)
+		 (org-columns-next-allowed-value nil ,i))))

 (easy-menu-define org-columns-menu org-columns-map "Org Column Menu"
   '("Column"
@@ -165,7 +165,7 @@ This is the compiled version of the format.")
 	 (face1 (list color 'org-agenda-column-dateline ref-face))
 	 (pl (or (get-text-property (point-at-bol) 'prefix-length) 0))
 	 (cphr (get-text-property (point-at-bol) 'org-complex-heading-regexp))
-	 pom property ass width f string ov column val modval s2 title)
+	 pom property ass width f string ov column val modval s2 title calc)
     ;; Check if the entry is in another buffer.
     (unless props
       (if (eq major-mode 'org-agenda-mode)
@@ -189,19 +189,25 @@ This is the compiled version of the format.")
 		      (nth 2 column)
 		      (length property))
 	    f (format "%%-%d.%ds | " width width)
+	    calc (nth 7 column)
 	    val (or (cdr ass) "")
-	    modval (or (and org-columns-modify-value-for-display-function
-			    (functionp
-			     org-columns-modify-value-for-display-function)
-			    (funcall
-			     org-columns-modify-value-for-display-function
-			     title val))
-		       (if (equal property "ITEM")
-			   (if (org-mode-p)
-			       (org-columns-cleanup-item
-				val org-columns-current-fmt-compiled)
-			     (org-agenda-columns-cleanup-item
-			      val pl cphr org-columns-current-fmt-compiled)))))
+	    modval (cond ((and org-columns-modify-value-for-display-function
+			       (functionp
+				org-columns-modify-value-for-display-function))
+			  (funcall org-columns-modify-value-for-display-function
+				   title val))
+			 ((equal property "ITEM")
+			  (if (org-mode-p)
+			      (org-columns-cleanup-item
+			       val org-columns-current-fmt-compiled)
+			    (org-agenda-columns-cleanup-item
+			     val pl cphr org-columns-current-fmt-compiled)))
+			 ((and calc (functionp calc)
+			       (not (get-text-property 0 'org-computed val)))
+			  (org-columns-number-to-string
+			   (funcall calc (org-columns-string-to-number
+					  val (nth 4 column)))
+			   (nth 4 column)))))
       (setq s2 (org-columns-add-ellipses (or modval val) width))
       (setq string (format f s2))
       ;; Create the overlay
@@ -220,18 +226,18 @@ This is the compiled version of the format.")
 	    (save-excursion
 	      (goto-char beg)
 	      (org-unmodified (insert " ")))))) ;; FIXME: add props and remove later?
-    ;; Make the rest of the line disappear.
-    (org-unmodified
-     (setq ov (org-columns-new-overlay beg (point-at-eol)))
-     (org-overlay-put ov 'invisible t)
-     (org-overlay-put ov 'keymap org-columns-map)
-     (org-overlay-put ov 'intangible t)
-     (push ov org-columns-overlays)
-     (setq ov (org-make-overlay (1- (point-at-eol)) (1+ (point-at-eol))))
-     (org-overlay-put ov 'keymap org-columns-map)
-     (push ov org-columns-overlays)
-     (let ((inhibit-read-only t))
-       (put-text-property (max (point-min) (1- (point-at-bol)))
+      ;; Make the rest of the line disappear.
+      (org-unmodified
+       (setq ov (org-columns-new-overlay beg (point-at-eol)))
+       (org-overlay-put ov 'invisible t)
+       (org-overlay-put ov 'keymap org-columns-map)
+       (org-overlay-put ov 'intangible t)
+       (push ov org-columns-overlays)
+       (setq ov (org-make-overlay (1- (point-at-eol)) (1+ (point-at-eol))))
+       (org-overlay-put ov 'keymap org-columns-map)
+       (push ov org-columns-overlays)
+       (let ((inhibit-read-only t))
+	 (put-text-property (max (point-min) (1- (point-at-bol)))
 			  (min (point-max) (1+ (point-at-eol)))
 			  'read-only "Type `e' to edit property")))))

@@ -257,6 +263,7 @@ for the duration of the command.")

 (defvar header-line-format)
 (defvar org-columns-previous-hscroll 0)
+
 (defun org-columns-display-here-title ()
   "Overlay the newline before the current line with the table title."
   (interactive)
@@ -347,6 +354,7 @@ for the duration of the command.")
   s)

 (defvar org-agenda-columns-remove-prefix-from-item)
+
 (defun org-agenda-columns-cleanup-item (item pl cphr fmt)
   "Cleanup the time property for agenda column view.
 See also the variable `org-agenda-columns-remove-prefix-from-item'."
@@ -366,6 +374,7 @@ See also the variable `org-agenda-columns-remove-prefix-from-item'."
     (message "Value is: %s" (or value ""))))

 (defvar org-agenda-columns-active) ;; defined in org-agenda.el
+
 (defun org-columns-quit ()
   "Remove the column overlays and in this way exit column editing."
   (interactive)
@@ -417,6 +426,7 @@ Where possible, use the standard interface for changing this line."
 				   (<= (overlay-start x) eol)
 				   x))
 			    org-columns-overlays)))
+	 (org-columns-time (time-to-number-of-days (current-time)))
 	 nval eval allowed)
     (cond
      ((equal key "CLOCKSUM")
@@ -661,7 +671,8 @@ around it."
   (org-verify-version 'columns)
   (org-columns-remove-overlays)
   (move-marker org-columns-begin-marker (point))
-  (let (beg end fmt cache maxwidths)
+  (let ((org-columns-time (time-to-number-of-days (current-time)))
+	beg end fmt cache maxwidths)
     (setq fmt (org-columns-get-format-and-top-level))
     (save-excursion
       (goto-char org-columns-top-level-marker)
@@ -678,7 +689,7 @@ around it."
 	    (narrow-to-region beg end)
 	    (org-clock-sum))))
       (while (re-search-forward (concat "^" outline-regexp) end t)
-	(if (and org-columns-skip-arrchived-trees
+	(if (and org-columns-skip-archived-trees
 		 (looking-at (concat ".*:" org-archive-tag ":")))
 	    (org-end-of-subtree t)
 	  (push (cons (org-current-line) (org-entry-properties)) cache)))
@@ -698,20 +709,34 @@ around it."
 		(org-columns-display-here (cdr x)))
 	      cache)))))

+(eval-when-compile (defvar org-columns-time))
+
 (defvar org-columns-compile-map
-  '(("none"  none              +)
-    (":"     add_times         +)
-    ("+"     add_numbers       +)
-    ("$"     currency          +)
-    ("X"     checkbox          +)
-    ("X/"    checkbox-n-of-m   +)
-    ("X%"    checkbox-percent  +)
-    ("max"   max_numbers       max)
-    ("min"   min_numbers       min)
-    ("mean"  mean_numbers      (lambda (&rest x) (/ (apply '+ x) (float (length x)))))
-    (":max"  max_times         max)
-    (":min"  min_times         min)
-    (":mean" mean_times        (lambda (&rest x) (/ (apply '+ x) (float (length x))))))
+  '(("none" none + identity)
+    (":" add_times + identity)
+    ("+" add_numbers + identity)
+    ("$" currency + identity)
+    ("X" checkbox + identity)
+    ("X/" checkbox-n-of-m + identity)
+    ("X%" checkbox-percent + identity)
+    ("max" max_numbers max identity)
+    ("min" min_numbers min identity)
+    ("mean" mean_numbers
+     (lambda (&rest x) (/ (apply '+ x) (float (length x))))
+     identity)
+    (":max" max_times max identity)
+    (":min" min_times min identity)
+    (":mean" mean_times
+     (lambda (&rest x) (/ (apply '+ x) (float (length x))))
+     identity)
+    ("@min" age min
+     (lambda (x) (- org-columns-time x)))
+    ("@max" age max
+     (lambda (x) (- org-columns-time x)))
+    ("@mean" age
+     (lambda (&rest x)
+       (/ (apply '+ x) (float (length x))))
+     (lambda (x) (- org-columns-time x)))))
   "Operator <-> format,function map.
 Used to compile/uncompile columns format and completing read in
 interactive function org-columns-new.")
@@ -860,7 +885,9 @@ Don't set this, this is meant for dynamic scoping.")
   "Compute all columns that have operators defined."
   (org-unmodified
    (remove-text-properties (point-min) (point-max) '(org-summaries t)))
-  (let ((columns org-columns-current-fmt-compiled) col)
+  (let ((columns org-columns-current-fmt-compiled)
+	(org-columns-time (time-to-number-of-days (current-time)))
+	col)
     (while (setq col (pop columns))
       (when (nth 3 col)
 	(save-excursion
@@ -895,6 +922,7 @@ Don't set this, this is meant for dynamic scoping.")
 	 (format (nth 4 ass))
 	 (printf (nth 5 ass))
 	 (fun (nth 6 ass))
+	 (calc (or (nth 7 ass) 'identity))
 	 (beg org-columns-top-level-marker)
 	 last-level val valflag flag end sumpos sum-alist sum str str1 useval)
     (save-excursion
@@ -927,10 +955,12 @@ Don't set this, this is meant for dynamic scoping.")
 				  (list 'org-summaries sum-alist))))
 	  (when (and val (not (equal val (if flag str val))))
 	    (org-entry-put nil property (if flag str val)))
-	  ;; add current to current  level accumulator
+	  ;; add current to current level accumulator
 	  (when (or flag valflag)
-	    (push (if flag sum
-		    (org-column-string-to-number (if flag str val) format))
+	    (push (if flag
+		      sum
+		    (funcall calc (org-columns-string-to-number
+				   (if flag str val) format)))
 		  (aref lvals level))
 	    (aset lflag level t))
 	  ;; clear accumulators for deeper levels
@@ -940,8 +970,8 @@ Don't set this, this is meant for dynamic scoping.")
 	 ((>= level last-level)
 	  ;; add what we have here to the accumulator for this level
 	  (when valflag
-	    (push (org-column-string-to-number val format)
-		(aref lvals level))
+	    (push (funcall calc (org-columns-string-to-number val format))
+		  (aref lvals level))
 	    (aset lflag level t)))
 	 (t (error "This should not happen")))))))

@@ -967,7 +997,6 @@ Don't set this, this is meant for dynamic scoping.")
   (if (eq major-mode 'org-agenda-mode)
       (error "This command is only allowed in Org-mode buffers")))

-
 (defun org-string-to-number (s)
   "Convert string to number, and interpret hh:mm:ss."
   (if (not (string-match ":" s))
@@ -994,6 +1023,8 @@ Don't set this, this is meant for dynamic scoping.")
    (printf (format printf n))
    ((eq fmt 'currency)
     (format "%.2f" n))
+   ((eq fmt 'age)
+    (org-format-time-period n))
    (t (number-to-string n))))

 (defun org-nofm-to-completion (n m &optional percent)
@@ -1001,17 +1032,23 @@ Don't set this, this is meant for dynamic scoping.")
       (format "[%d/%d]" n m)
     (format "[%d%%]"(floor (+ 0.5 (* 100. (/ (* 1.0 n) m)))))))

-(defun org-column-string-to-number (s fmt)
+(defun org-columns-string-to-number (s fmt)
   "Convert a column value to a number that can be used for column computing."
-  (cond
-   ((string-match ":" s)
-    (let ((l (nreverse (org-split-string s ":"))) (sum 0.0))
-      (while l
-	(setq sum (+ (string-to-number (pop l)) (/ sum 60))))
-      sum))
-   ((memq fmt '(checkbox checkbox-n-of-m checkbox-percent))
-    (if (equal s "[X]") 1. 0.000001))
-   (t (string-to-number s))))
+  (if s
+      (cond
+       ((eq fmt 'age)
+	(if (string= s "")
+	    org-columns-time
+	  (time-to-number-of-days (apply 'encode-time (org-parse-time-string s t)))))
+       ((string-match ":" s)
+	(let ((l (nreverse (org-split-string s ":"))) (sum 0.0))
+	  (while l
+	    (setq sum (+ (string-to-number (pop l)) (/ sum 60))))
+	  sum))
+       ((memq fmt '(checkbox checkbox-n-of-m checkbox-percent))
+	(if (equal s "[X]") 1. 0.000001))
+       (t (string-to-number s)))
+    0))

 (defun org-columns-uncompile-format (cfmt)
   "Turn the compiled columns format back into a string representation."
@@ -1045,7 +1082,9 @@ width        the column width in characters, can be nil for automatic
 operator     the operator if any
 format       the output format for computed results, derived from operator
 printf       a printf format for computed values
-fun          the lisp function to compute values, derived from operator"
+fun          the lisp function to compute summary values, derived from operator
+calc         function to get values from base elements
+"
   (let ((start 0) width prop title op op-match f printf fun)
     (setq org-columns-current-fmt-compiled nil)
     (while (string-match
@@ -1058,15 +1097,18 @@ fun          the lisp function to compute values, derived from operator"
 	    op (match-string 4 fmt)
 	    f nil
 	    printf nil
-	    fun '+)
+	    fun '+
+	    calc nil)
       (if width (setq width (string-to-number width)))
       (when (and op (string-match ";" op))
 	(setq printf (substring op (match-end 0))
 	      op (substring op 0 (match-beginning 0))))
       (when (setq op-match (assoc op org-columns-compile-map))
 	(setq f (cadr op-match)
-	      fun (caddr op-match)))
-      (push (list prop title width op f printf fun) org-columns-current-fmt-compiled))
+	      fun (caddr op-match)
+	      calc (cadddr op-match)))
+      (push (list prop title width op f printf fun calc)
+	    org-columns-current-fmt-compiled))
     (setq org-columns-current-fmt-compiled
 	  (nreverse org-columns-current-fmt-compiled))))

@@ -1121,18 +1163,18 @@ PARAMS is a property list of parameters:

 :width    enforce same column widths with <N> specifiers.
 :id       the :ID: property of the entry where the columns view
-          should be built.  When the symbol `local', call locally.
-          When `global' call column view with the cursor at the beginning
-          of the buffer (usually this means that the whole buffer switches
-          to column view).  When \"file:path/to/file.org\", invoke column
-          view at the start of that file.  Otherwise, the ID is located
-          using `org-id-find'.
+	  should be built.  When the symbol `local', call locally.
+	  When `global' call column view with the cursor at the beginning
+	  of the buffer (usually this means that the whole buffer switches
+	  to column view).  When \"file:path/to/file.org\", invoke column
+	  view at the start of that file.  Otherwise, the ID is located
+	  using `org-id-find'.
 :hlines   When t, insert a hline before each item.  When a number, insert
-          a hline before each level <= that number.
+	  a hline before each level <= that number.
 :vlines   When t, make each column a colgroup to enforce vertical lines.
 :maxlevel When set to a number, don't capture headlines below this level.
 :skip-empty-rows
-          When t, skip rows where all specifiers other than ITEM are empty."
+	  When t, skip rows where all specifiers other than ITEM are empty."
   (let ((pos (move-marker (make-marker) (point)))
 	(hlines (plist-get params :hlines))
 	(vlines (plist-get params :vlines))
@@ -1351,7 +1393,7 @@ This will add overlays to the date lines, to show the summary for each day."
 			 (mapc (lambda (x)
 				 (setq v (cdr (assoc prop x)))
 				 (if v (setq lsum (+ lsum
-						     (org-column-string-to-number
+						     (org-columns-string-to-number
 						      v stype)))))
 			       entries)
 			 (setq lsum (org-columns-number-to-string lsum stype))
@@ -1390,6 +1432,18 @@ This will add overlays to the date lines, to show the summary for each day."
 			   (equal (nth 4 a) (nth 4 fm)))
 		  (org-columns-compute (car fm)))))))))))

+(defun org-format-time-period (interval)
+  "Convert time in fractional days to days/hours/minutes/seconds"
+  (if (numberp interval)
+    (let* ((days (floor interval))
+	   (frac-hours (* 24 (- interval days)))
+	   (hours (floor frac-hours))
+	   (minutes (floor (* 60 (- frac-hours hours))))
+	   (seconds (floor (* 60 (- (* 60 (- frac-hours hours)) minutes)))))
+      (format "%dd %02dh %02dm %02ds" days hours minutes seconds))
+    ""))
+
+
 (provide 'org-colview)

 ;; arch-tag: 61f5128d-747c-4983-9479-e3871fa3d73c
diff --git a/lisp/org.el b/lisp/org.el
index dad2e83..24907d8 100644
--- a/lisp/org.el
+++ b/lisp/org.el
@@ -3346,8 +3346,8 @@ Instead, use the key `v' to cycle the archives-mode in the agenda."
   :group 'org-agenda-skip
   :type 'boolean)

-(defcustom org-columns-skip-arrchived-trees t
-  "Non-nil means, irgnore archived trees when creating column view."
+(defcustom org-columns-skip-archived-trees t
+  "Non-nil means, ignore archived trees when creating column view."
   :group 'org-archive
   :group 'org-properties
   :type 'boolean)
--
1.6.3.3