Further steps concerning effort estimates. Still not done.

But I am pushing this, so that it can be tested......

ChangeLog

@@ -1,3 +1,8 @@
+2008-04-17  Carsten Dominik  <dominik@science.uva.nl>
+
+	* lisp/org-agenda.el (org-prefix-has-effort): New variable.
+	(org-sort-agenda-noeffort-is-high): New option.
+
 2008-04-16  Carsten Dominik  <dominik@science.uva.nl>
 
 	* lisp/org-colview.el (org-columns-compute): Only write property
@@ -2125,7 +2130,7 @@ installed as 4.38
 
 ----------------------------------------------------------------------
 installed as 4.37
-	
+
 
 2006-06-10  Carsten Dominik  <dominik@science.uva.nl>
 

doc/org.texi

@@ -5431,7 +5431,9 @@ sequence in which they are found in the agenda files.
 @end itemize
 
 Sorting can be customized using the variable
-@code{org-agenda-sorting-strategy}.
+@code{org-agenda-sorting-strategy}, and may also include criteria based on
+the estimated effort of an entry.
+@c FIXME: link!!!!!!!!
 
 
 @node Agenda commands, Custom agenda views, Presentation and sorting, Agenda Views
@@ -5508,7 +5510,7 @@ Toggle Clockreport mode.  In clockreport mode, the daily/weekly agenda will
 always show a table with the clocked times for the timespan and file scope
 covered by the current agenda view.  The initial setting for this mode in new
 agenda buffers can be set with the variable
-@code{org-agenda-start-with-follow-mode}.
+@code{org-agenda-start-with-clockreport-mode}.
 
 @tsubheading{Change display}
 @cindex display changing, in agenda

lisp/org-agenda.el

@@ -78,7 +78,7 @@ only needed when the text to be killed contains more than N non-white lines."
   "Non-nil means, make the block agenda more compact.
 This is done by leaving out unnecessary lines."
   :group 'org-agenda
-  :type nil)
+  :type 'boolean)
 
 (defgroup org-agenda-export nil
  "Options concerning exporting agenda views in Org-mode."
@@ -148,7 +148,8 @@ you can \"misuse\" it to also add other text to the header.  However,
     (const time-up) (const time-down)
     (const category-keep) (const category-up) (const category-down)
     (const tag-down) (const tag-up)
-    (const priority-up) (const priority-down))
+    (const priority-up) (const priority-down)
+    (const effort-up) (const effort-down))
   "Sorting choices.")
 
 (defconst org-agenda-custom-commands-local-options
@@ -718,6 +719,8 @@ tag-up          Sort alphabetically by last tag, A-Z.
 tag-down        Sort alphabetically by last tag, Z-A.
 priority-up     Sort numerically by priority, high priority last.
 priority-down   Sort numerically by priority, high priority first.
+effort-up       Sort numerically by estimated effort, high effort last.
+effort-down     Sort numerically by estimated effort, high effort first.
 
 The different possibilities will be tried in sequence, and testing stops
 if one comparison returns a \"not-equal\".  For example, the default
@@ -756,6 +759,12 @@ agenda entries."
   :group 'org-agenda-sorting
   :type 'boolean)
 
+(defcustom org-sort-agenda-noeffort-is-high t
+  "Non-nil means, items without effort estimate are sorted as high effort.
+When nil, such items are sorted as 0 minutes effort."
+  :group 'org-agenda-sorting
+  :type 'boolean)
+
 (defgroup org-agenda-line-format nil
   "Options concerning the entry prefix in the Org-mode agenda display."
   :tag "Org Agenda Line Format"
@@ -948,6 +957,15 @@ computations are current."
   :group 'org-agenda-column-view
   :type 'boolean)
 
+(defcustom org-agenda-columns-add-appointments-to-effort-sum nil
+  "Non-nil means, the duration of an appointment will add to day effort.
+The property to which appointment durations will be added is the one given
+in the option `org-effort-property'.  If an appointment does not have
+an end time, `org-agenda-default-appointment-duration' will be used.  If that
+is not set, an appointment without end time will not contribute to the time
+estimate."
+  :group 'org-agenda-column-view
+  :type 'boolean)
 
 (eval-when-compile
   (require 'cl))
@@ -3499,6 +3517,9 @@ The flag is set if the currently compiled format contains a `%t'.")
 (defvar org-prefix-has-tag nil
   "A flag, set by `org-compile-prefix-format'.
 The flag is set if the currently compiled format contains a `%T'.")
+(defvar org-prefix-has-effort nil
+  "A flag, set by `org-compile-prefix-format'.
+The flag is set if the currently compiled format contains a `%e'.")
 
 (defun org-format-agenda-item (extra txt &optional category tags dotime
 				     noprefix remove-re)
@@ -3523,8 +3544,9 @@ Any match of REMOVE-RE will be removed from TXT."
 			     (file-name-sans-extension
 			      (file-name-nondirectory buffer-file-name))
 			   "")))
+	   ;; time, tag, effort are needed for the eval of the prefix format
 	   (tag (if tags (nth (1- (length tags)) tags) ""))
-	   time    ; time and tag are needed for the eval of the prefix format
+	   time effort neffort
 	   (ts (if dotime (concat (if (stringp dotime) dotime "") txt)))
 	   (time-of-day (and dotime (org-get-time-of-day ts)))
 	   stamp plain s0 s1 s2 rtn srp
@@ -3564,7 +3586,7 @@ Any match of REMOVE-RE will be removed from TXT."
 		    (org-agenda-default-appointment-duration
 		     (+ t1 org-agenda-default-appointment-duration))
 		    (t nil)))
-	  (setq duration (if t2 (- t2 t1)))))      
+	  (setq duration (if t2 (- t2 t1)))))
 
       (when (and s1 (not s2) org-agenda-default-appointment-duration
 		 (string-match "\\([0-9]+\\):\\([0-9]+\\)" s1))
@@ -3586,6 +3608,16 @@ Any match of REMOVE-RE will be removed from TXT."
 		     (concat (make-string (max (- 50 (length txt)) 1) ?\ )
 			     (match-string 2 txt))
 		     t t txt))))
+      (when (org-mode-p)
+	(setq effort
+	      (condition-case nil
+		  (org-get-effort
+		   (or (get-text-property 0 'org-hd-marker txt)
+		       (get-text-property 0 'org-marker txt)))
+		(error nil)))
+	(when effort
+	  (setq neffort (org-hh:mm-string-to-minutes effort)
+		effort (setq effort (concat "[" effort"]" )))))
 
       (when remove-re
 	(while (string-match remove-re txt)
@@ -3611,6 +3643,8 @@ Any match of REMOVE-RE will be removed from TXT."
 	'prefix-length (- (length rtn) (length txt))
 	'time-of-day time-of-day
 	'duration duration
+	'effort effort
+	'effort-minutes neffort
 	'txt txt
 	'time time
 	'extra extra
@@ -3654,7 +3688,8 @@ Any match of REMOVE-RE will be removed from TXT."
   "Compile the prefix format into a Lisp form that can be evaluated.
 The resulting form is returned and stored in the variable
 `org-prefix-format-compiled'."
-  (setq org-prefix-has-time nil org-prefix-has-tag nil)
+  (setq org-prefix-has-time nil org-prefix-has-tag nil
+	org-prefix-has-effort nil)
   (let ((s (cond
 	    ((stringp org-agenda-prefix-format)
 	     org-agenda-prefix-format)
@@ -3663,16 +3698,17 @@ The resulting form is returned and stored in the variable
 	    (t "  %-12:c%?-12t% s")))
 	(start 0)
 	varform vars var e c f opt)
-    (while (string-match "%\\(\\?\\)?\\([-+]?[0-9.]*\\)\\([ .;,:!?=|/<>]?\\)\\([cts]\\)"
+    (while (string-match "%\\(\\?\\)?\\([-+]?[0-9.]*\\)\\([ .;,:!?=|/<>]?\\)\\([ctse]\\)"
 			 s start)
       (setq var (cdr (assoc (match-string 4 s)
 			    '(("c" . category) ("t" . time) ("s" . extra)
-			      ("T" . tag))))
+			      ("T" . tag) ("e" . effort))))
 	    c (or (match-string 3 s) "")
 	    opt (match-beginning 1)
 	    start (1+ (match-beginning 0)))
       (if (equal var 'time) (setq org-prefix-has-time t))
       (if (equal var 'tag)  (setq org-prefix-has-tag  t))
+      (if (equal var 'effort) (setq org-prefix-has-effort t))
       (setq f (concat "%" (match-string 2 s) "s"))
       (if opt
 	  (setq varform
@@ -3765,6 +3801,15 @@ HH:MM."
 	  ((< pa pb) -1)
 	  (t nil))))
 
+(defsubst org-cmp-effort (a b)
+  "Compare the priorities of string A and B."
+  (let* ((def (if org-sort-agenda-noeffort-is-high 32767 -1))
+	 (ea (or (get-text-property 1 'effort-minutes a) def))
+	 (eb (or (get-text-property 1 'effort-minutes b) def)))
+    (cond ((> ea eb) +1)
+	  ((< ea eb) -1)
+	  (t nil))))
+
 (defsubst org-cmp-category (a b)
   "Compare the string values of categories of strings A and B."
   (let ((ca (or (get-text-property 1 'org-category a) ""))
@@ -3800,6 +3845,8 @@ HH:MM."
 	 (time-down (if time-up (- time-up) nil))
 	 (priority-up (org-cmp-priority a b))
 	 (priority-down (if priority-up (- priority-up) nil))
+	 (effort-up (org-cmp-effort a b))
+	 (effort-down (if effort-up (- effort-up) nil))
 	 (category-up (org-cmp-category a b))
 	 (category-down (if category-up (- category-up) nil))
 	 (category-keep (if category-up +1 nil))

lisp/org-clock.el

@@ -649,7 +649,7 @@ the currently selected interval size."
 		  (push (org-clocktable-add-file
 			 file 
 			 (concat "| |*File time*|*"
-				 (org-minutes-to-hours
+				 (org-minutes-to-hh:mm-string
 				  org-clock-file-total-minutes)
 				 "*|\n"
 				 tbl1)) tbl)
@@ -683,7 +683,7 @@ the currently selected interval size."
 		  (push (concat
 			 "| " (int-to-string level) "|" hlc hdl hlc " |"
 			 (make-string (1- level) ?|)
-			 hlc (org-minutes-to-hours time) hlc
+			 hlc (org-minutes-to-hh:mm-string time) hlc
 			 " |") tbl))))))
 	(setq tbl (nreverse tbl))
 	(if tostring
@@ -707,7 +707,7 @@ the currently selected interval size."
 	   (if (eq scope 'agenda) "|" "")
 	   "|"
 	   "*Total time*| *"
-	   (org-minutes-to-hours (or total-time 0))
+	   (org-minutes-to-hh:mm-string (or total-time 0))
 	   "*|\n|-\n")
 	  (setq tbl (delq nil tbl))
 	  (if (and (stringp (car tbl)) (> (length (car tbl)) 1)

lisp/org-colview.el

@@ -228,7 +228,8 @@ This is the compiled version of the format.")
 	    title (concat title string)))
     (setq title (concat
 		 (org-add-props " " nil 'display '(space :align-to 0))
-		 (org-add-props title nil 'face '(:weight bold :underline t :inherit default))))
+		 ;;(org-add-props title nil 'face '(:weight bold :underline t :inherit default))))
+		 (org-add-props title nil 'face 'org-column-title)))
     (org-set-local 'org-previous-header-line-format header-line-format)
     (org-set-local 'org-columns-current-widths (nreverse widths))
     (setq org-columns-full-header-line-format title)
@@ -1031,6 +1032,7 @@ and tailing newline characters."
   "When set, switch to columns view immediately after creating the agenda.")
 
 (defvar org-agenda-columns-show-summaries) ; defined in org-agenda.el
+(defvar org-agenda-columns-compute-summary-properties); defined in org-agenda.el
 
 (defun org-agenda-columns ()
   "Turn on column view in the agenda."
@@ -1059,7 +1061,8 @@ and tailing newline characters."
     (setq fmt (or fmt org-columns-default-format))
     (org-set-local 'org-columns-current-fmt fmt)
     (org-columns-compile-format fmt)
-    (org-agenda-colview-compute org-columns-current-fmt-compiled)
+    (when org-agenda-columns-compute-summary-properties
+      (org-agenda-colview-compute org-columns-current-fmt-compiled))
     (save-excursion
       ;; Get and cache the properties
       (goto-char (point-min))
@@ -1068,14 +1071,14 @@ and tailing newline characters."
 			  (get-text-property (point) 'org-marker)))
 	  (setq p (org-entry-properties m))
 
-	  (when (or (not (setq a (assoc org-time-estimate-property p)))
+	  (when (or (not (setq a (assoc org-effort-property p)))
 			 (not (string-match "\\S-" (or (cdr a) ""))))
-	    ;; OK, no property gives us a value
-	    (when (and org-time-estimate-include-appointments
+	    ;; OK, the property is not defined.  Use appointment duration?
+	    (when (and org-agenda-columns-add-appointments-to-effort-sum
 		       (setq d (get-text-property (point) 'duration)))
-	      (setq d (org-minutes-to-hours d))
+	      (setq d (org-minutes-to-hh:mm-string d))
 	      (put-text-property 0 (length d) 'face 'org-warning d)
-	      (push (cons org-time-estimate-property d) p)))
+	      (push (cons org-effort-property d) p)))
 	  (push (cons (org-current-line) p) cache))
 	(beginning-of-line 2))
       (when cache
@@ -1097,79 +1100,78 @@ This will add overlays to the date lines, to show the summary for each day."
 					  'add_times (nth 4 x))))
 		      org-columns-current-fmt-compiled))
 	 line c c1 stype props lsum entries prop v)
-    (when (delq nil (mapcar 'cadr fmt))
-      ;; OK, at least one summation column, it makes sense to try this
-      (goto-char (point-max))
-      (while (not (bobp))
-	(if (not (or (get-text-property (point) 'org-date-line)
-		     (eq (get-text-property (point) 'face)
-			 'org-agenda-structure)))
-	    (beginning-of-line 0)
-	  ;; OK, this is a date line
-	  (setq line (org-current-line))
-	  (setq entries nil c cache cache nil)
-	  (while (setq c1 (pop c))
-	    (if (> (car c1) line)
-		(push c1 entries)
-	      (push c1 cache)))
-	  ;; now ENTRIES are the ones we want to use, CACHE is the rest
-	  ;; Compute the summaries for the properties we want,
-	  ;; set nil properties for the rest.
-	  (when (setq entries (mapcar 'cdr entries))
-	    (setq props
-		  (mapcar
-		   (lambda (f)
-		     (setq prop (car f) stype (nth 1 f))
-		     (cond
-		      ((equal prop "ITEM")
-		       (cons prop (buffer-substring (point-at-bol)
-						    (point-at-eol))))
-		      ((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-column-string-to-number
-						    v stype)))))
-			     entries)
-		       (setq lsum (org-columns-number-to-string lsum stype))
-		       (put-text-property
-			0 (length lsum) 'face 'bold lsum)
-		       (cons prop lsum))))
-		   fmt))
-	    (org-columns-display-here props)
-	    (org-set-local 'org-agenda-columns-active t))
+    (catch 'exit
+      (when (delq nil (mapcar 'cadr fmt))
+	;; OK, at least one summation column, it makes sense to try this
+	(goto-char (point-max))
+	(while t
+	  (when (or (get-text-property (point) 'org-date-line)
+		    (eq (get-text-property (point) 'face)
+			'org-agenda-structure))
+	    ;; OK, this is a date line that should be used
+	    (setq line (org-current-line))
+	    (setq entries nil c cache cache nil)
+	    (while (setq c1 (pop c))
+	      (if (> (car c1) line)
+		  (push c1 entries)
+		(push c1 cache)))
+	    ;; now ENTRIES are the ones we want to use, CACHE is the rest
+	    ;; Compute the summaries for the properties we want,
+	    ;; set nil properties for the rest.
+	    (when (setq entries (mapcar 'cdr entries))
+	      (setq props
+		    (mapcar
+		     (lambda (f)
+		       (setq prop (car f) stype (nth 1 f))
+		       (cond
+			((equal prop "ITEM")
+			 (cons prop (buffer-substring (point-at-bol)
+						      (point-at-eol))))
+			((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-column-string-to-number
+						      v stype)))))
+			       entries)
+			 (setq lsum (org-columns-number-to-string lsum stype))
+			 (put-text-property
+			  0 (length lsum) 'face 'bold lsum)
+			 (cons prop lsum))))
+		     fmt))
+	      (org-columns-display-here props)
+	      (org-set-local 'org-agenda-columns-active t)))
+	  (if (bobp) (throw 'exit t))
 	  (beginning-of-line 0))))))
 
-(defvar org-agenda-columns-compute-summary-properties); defined in org-agenda.el
 (defun org-agenda-colview-compute (fmt)
   "Compute the relevant columns in the contributing source buffers."
-  (when org-agenda-columns-compute-summary-properties
-    (let ((files org-agenda-contributing-files)
-	  (org-columns-begin-marker (make-marker))
-	  (org-columns-top-level-marker (make-marker))
-	  f fm a b)
-      (while (setq f (pop files))
-	(setq b (find-buffer-visiting f))
-	(with-current-buffer (or (buffer-base-buffer b) b)
-	  (save-excursion
-	    (save-restriction
-	      (widen)
-	      (org-unmodified
-	       (remove-text-properties (point-min) (point-max)
-				       '(org-summaries t)))
-	      (goto-char (point-min))
-	      (org-columns-get-format-and-top-level)
-	      (while (setq fm (pop fmt))
-		(if (equal (car fm) "CLOCKSUM")
-		    (org-clock-sum)
-		  (when (and (nth 4 fm)
-			     (setq a (assoc (car fm)
-					    org-columns-current-fmt-compiled))
-			     (equal (nth 4 a) (nth 4 fm)))
-		    (org-columns-compute (car fm))))))))))))
+  (let ((files org-agenda-contributing-files)
+	(org-columns-begin-marker (make-marker))
+	(org-columns-top-level-marker (make-marker))
+	f fm a b)
+    (while (setq f (pop files))
+      (setq b (find-buffer-visiting f))
+      (with-current-buffer (or (buffer-base-buffer b) b)
+	(save-excursion
+	  (save-restriction
+	    (widen)
+	    (org-unmodified
+	     (remove-text-properties (point-min) (point-max)
+				     '(org-summaries t)))
+	    (goto-char (point-min))
+	    (org-columns-get-format-and-top-level)
+	    (while (setq fm (pop fmt))
+	      (if (equal (car fm) "CLOCKSUM")
+		  (org-clock-sum)
+		(when (and (nth 4 fm)
+			   (setq a (assoc (car fm)
+					  org-columns-current-fmt-compiled))
+			   (equal (nth 4 a) (nth 4 fm)))
+		  (org-columns-compute (car fm)))))))))))
 
 (provide 'org-colview)
 

lisp/org-faces.el

@@ -159,6 +159,18 @@ color of the frame."
   "Face for column display of entry properties."
   :group 'org-faces)
 
+(defface org-column-title
+  (org-compatible-face nil
+    '((((class color) (min-colors 16) (background light))
+       (:background "grey90" :underline t :weight bold))
+      (((class color) (min-colors 16) (background dark))
+       (:background "grey30" :underline t :weight bold))
+      (((class color) (min-colors 8))
+       (:background "cyan" :foreground "black" :underline t :weight bold))
+      (t (:inverse-video t))))
+  "Face for column display of entry properties."
+  :group 'org-faces)
+
 (when (fboundp 'set-face-attribute)
   ;; Make sure that a fixed-width face is used when we have a column table.
   (set-face-attribute 'org-column nil

lisp/org.el

@@ -1836,6 +1836,13 @@ This variable can be set on the per-file basis by inserting a line
   :group 'org-properties
   :type 'string)
 
+(defcustom org-effort-property "Effort"
+  "The property that is being used to keep track of effort estimates.
+Effort estimates given in this property need to have the format H:MM."
+  :group 'org-properties
+  :group 'org-progress
+  :type '(string :tag "Property"))
+
 (defcustom org-global-properties nil
   "List of property/value pairs that can be inherited by any entry.
 You can set buffer-local values for this by adding lines like
@@ -6776,6 +6783,9 @@ optional argument IN-EMACS is non-nil, Emacs will visit the file."
 
 ;;;; Time estimates
 
+(defun org-get-effort (&optional pom)
+  "Get the effort estimate for the current entry."
+  (org-entry-get pom org-effort-property))
 
 ;;; File search
 
@@ -10954,12 +10964,18 @@ If there is already a time stamp at the cursor position, update it."
       (org-insert-time-stamp
        (encode-time 0 0 0 (nth 1 cal-date) (car cal-date) (nth 2 cal-date))))))
 
-(defun org-minutes-to-hours (m)
+(defun org-minutes-to-hh:mm-string (m)
   "Compute H:MM from a number of minutes."
   (let ((h (/ m 60)))
     (setq m (- m (* 60 h)))
     (format "%d:%02d" h m)))
 
+(defun org-hh:mm-string-to-minutes (s)
+  "Convert a string H:MM to a number of minutes."
+  (if (string-match "\\([0-9]+\\):\\([0-9]+\\)" s)
+      (+ (* (string-to-number (match-string 1 s)) 60)
+	 (string-to-number (match-string 2 s)))
+    0))
 
 ;;;; Agenda files
 
@@ -13569,67 +13585,3 @@ Still experimental, may disappear in the future."
 ;;; org.el ends here
 
 
-(defcustom org-time-estimate-property "Effort"
-  "The property that is being used to keep track of time estimates.
-
-- If an entry is queried for this property, the default is taken from the
-  time estimateion cookie in the headline.
-- In the agenda, the duration of appointments is treated as a time estimate
-  if the option `org-time-estimate-include-appointments' is set."
-  :group 'org-time-estimates
-  :type '(string :tag "Property"))
-
-(defcustom org-time-estimate-include-appointments t
-  "Non-nil means, the duration of an appointment will add to the time estimate."
-  :group 'org-time-estimates
-  :type 'boolean)
-
-(defcustom org-time-estimates '("5m" "10m" "15m" "30m" "45m" "1h" "1:30h" "2h" "3h" "4h" "5h" "6h" "7h" "8h")
-  "Discrete time estimates."
-  :group 'org-time-estimates
-  :type '(repeat (string)))
-
-(defun org-time-estimate-up ()
-  "Increate the time estimate."
-  (interactive)
-  (org-time-estimate-change 'up))
-
-(defun org-time-estimate-down ()
-  "Increate the time estimate."
-  (interactive)
-  (org-time-estimate-change 'down))
-
-(defun org-time-estimate-change (how)
-  ""
-  (save-excursion
-    (if (not (or (org-at-regexp-p org-time-estimate-regexp)
-		 (progn
-		   (goto-char (point-at-bol))
-		   (re-search-forward org-time-estimate-regexp
-				      (point-at-eol) t))))
-	(error "Don't know which time estimate to change here"))
-    (let* ((match (match-string 0))
-	   (rest (member match org-time-estimates))
-	   new)
-      (unless rest
-	(error "Not a standard value: %s" match))
-      (if (eq how 'up)
-	  (setq new (cadr rest))
-	(setq new (car (nthcdr (- (length org-time-estimates) (length rest) 1)
-			       org-time-estimates))))
-      (replace-match new t t))))
-
-(defconst org-time-estimate-regexp
-  "\\<[0-9]+m\\|\\([0-9]+:\\)?\\([0-9]+h\\)\\>"
-  "Regular expression matching time estimates.")
-
-(defun org-get-time-estimate (&optional string)
-  (setq string (or string (buffer-substring (point-at-bol) (point-at-eol))))
-  (if (string-match org-time-estimate-regexp string)
-      (cond ((match-end 1)
-	     (+ (* 60 (string-to-number (match-string 1 string)))
-		(string-to-number (match-string 2 string))))
-	    ((match-end 2)
-	     (* 60 (string-to-number (match-string 2 string))))
-	    (t (string-to-number (match-string 0 string))))
-    nil))