Add min/max/mean age operators to column view.

This lets you see how long has passed since the specified timestamp property
each entry. The three operators (@min, @max, @mean) show either the age of the
youngest or oldest entry or the average age of the children.

lisp/ChangeLog

@@ -173,6 +173,30 @@
 	(org-clock-in): Use `org-clock-auto-clock-resolution' to determine
 	whether or not to resolve Org buffers on clock in.
 
+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-26  Bastien Guerry  <bzg@altern.org>
 
 	* org.el (org-mode-hook): Turn `org-mode-hook' into a customizable
@@ -1723,20 +1747,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
 
@@ -4603,7 +4621,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>
 

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,8 +1082,10 @@ 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"
-  (let ((start 0) width prop title op op-match f printf fun)
+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 calc)
     (setq org-columns-current-fmt-compiled nil)
     (while (string-match
 	    (org-re "%\\([0-9]+\\)?\\([[:alnum:]_-]+\\)\\(?:(\\([^)]+\\))\\)?\\(?:{\\([^}]+\\)}\\)?\\s-*")
@@ -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

lisp/org.el

@@ -3394,8 +3394,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)