Improve adding up time estimates.

Appointment times can now be included into the estimated load for a day.

ChangeLog

@@ -1,7 +1,14 @@
+2008-04-16  Carsten Dominik  <dominik@science.uva.nl>
+
+	* lisp/org-colview.el (org-columns-compute): Only write property
+	value if it has changed.  This avoids raising the
+	buffer-change-flag unnecessarily.
+
 2008-04-15  Carsten Dominik  <dominik@science.uva.nl>
 
 	* lisp/org-agenda.el (org-agenda-columns-show-summaries)
 	(org-agenda-columns-compute-summary-properties): New options.
+	(org-format-agenda-item): Compute the duration of the item.
 
 	* lisp/org-colview.el (org-agenda-colview-summarize)
 	(org-agenda-colview-compute): New functions.

lisp/org-agenda.el

@@ -3527,10 +3527,11 @@ Any match of REMOVE-RE will be removed from TXT."
 	   time    ; time and tag are needed for the eval of the prefix format
 	   (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)
+	   stamp plain s0 s1 s2 rtn srp
+	   duration)
       (and (org-mode-p) buffer-file-name
 	   (add-to-list 'org-agenda-contributing-files buffer-file-name))
-      (when (and dotime time-of-day org-prefix-has-time)
+      (when (and dotime time-of-day)
 	;; Extract starting and ending time and move them to prefix
 	(when (or (setq stamp (string-match org-stamp-time-of-day-regexp ts))
 		  (setq plain (string-match org-plain-time-of-day-regexp ts)))
@@ -3542,7 +3543,8 @@ Any match of REMOVE-RE will be removed from TXT."
 	  ;; If the times are in TXT (not in DOTIMES), and the prefix will list
 	  ;; them, we might want to remove them there to avoid duplication.
 	  ;; The user can turn this off with a variable.
-	  (if (and org-agenda-remove-times-when-in-prefix (or stamp plain)
+	  (if (and org-prefix-has-time
+		   org-agenda-remove-times-when-in-prefix (or stamp plain)
 		   (string-match (concat (regexp-quote s0) " *") txt)
 		   (not (equal ?\] (string-to-char (substring txt (match-end 0)))))
 		   (if (eq org-agenda-remove-times-when-in-prefix 'beg)
@@ -3551,7 +3553,18 @@ Any match of REMOVE-RE will be removed from TXT."
 	      (setq txt (replace-match "" nil nil txt))))
 	;; Normalize the time(s) to 24 hour
 	(if s1 (setq s1 (org-get-time-of-day s1 'string t)))
-	(if s2 (setq s2 (org-get-time-of-day s2 'string t))))
+	(if s2 (setq s2 (org-get-time-of-day s2 'string t)))
+	;; Compute the duration
+	(when s1
+	  (setq t1 (+ (* 60 (string-to-number (substring s1 0 2)))
+		      (string-to-number (substring s1 3)))
+		t2 (cond
+		    (s2 (+ (* 60 (string-to-number (substring s2 0 2)))
+			   (string-to-number (substring s2 3))))
+		    (org-agenda-default-appointment-duration
+		     (+ t1 org-agenda-default-appointment-duration))
+		    (t nil)))
+	  (setq duration (if t2 (- t2 t1)))))      
 
       (when (and s1 (not s2) org-agenda-default-appointment-duration
 		 (string-match "\\([0-9]+\\):\\([0-9]+\\)" s1))
@@ -3597,6 +3610,7 @@ Any match of REMOVE-RE will be removed from TXT."
 	'org-lowest-priority org-lowest-priority
 	'prefix-length (- (length rtn) (length txt))
 	'time-of-day time-of-day
+	'duration duration
 	'txt txt
 	'time time
 	'extra extra
@@ -3882,9 +3896,7 @@ If ERROR is non-nil, throw an error, otherwise just return nil."
   "Exit agenda by removing the window or the buffer."
   (interactive)
   (if org-agenda-columns-active
-      (progn
-	(setq org-agenda-columns-active nil)
-	(org-columns-quit))
+      (org-columns-quit)
     (let ((buf (current-buffer)))
       (if (not (one-window-p)) (delete-window))
       (kill-buffer buf)

lisp/org-colview.el

@@ -171,7 +171,8 @@ This is the compiled version of the format.")
 	    string (format f (or modval val)))
       ;; Create the overlay
       (org-unmodified
-       (setq ov (org-columns-new-overlay beg (setq beg (1+ beg)) string face))
+       (setq ov (org-columns-new-overlay
+		 beg (setq beg (1+ beg)) string face))
        (org-overlay-put ov 'keymap org-columns-map)
        (org-overlay-put ov 'org-columns-key property)
        (org-overlay-put ov 'org-columns-value (cdr ass))
@@ -290,6 +291,7 @@ This is the compiled version of the format.")
    (let ((inhibit-read-only t))
      (remove-text-properties (point-min) (point-max) '(read-only t))))
   (when (eq major-mode 'org-agenda-mode)
+    (setq org-agenda-columns-active nil)
     (message
      "Modification not yet reflected in Agenda buffer, use `r' to refresh")))
 
@@ -370,7 +372,8 @@ Where possible, use the standard interface for changing this line."
 	(setq eval '(org-entry-put pom key nval)))))
     (when eval
       (let ((inhibit-read-only t))
-	(remove-text-properties (max (point-min) (1- bol)) eol '(read-only t))
+	(org-unmodified
+	 (remove-text-properties (max (point-min) (1- bol)) eol '(read-only t)))
 	(unwind-protect
 	    (progn
 	      (setq org-columns-overlays
@@ -482,9 +485,12 @@ Where possible, use the standard interface for changing this line."
 	    (org-columns-eval '(org-entry-put pom key nval)))
 	(org-columns-display-here)))
     (move-to-column col)
-    (if (and (org-mode-p)
-	     (nth 3 (assoc key org-columns-current-fmt-compiled)))
-	(org-columns-update key))))
+    (cond
+     ((equal major-mode 'org-agenda-mode)
+      (org-agenda-redo))
+     ((and (org-mode-p)
+	   (nth 3 (assoc key org-columns-current-fmt-compiled)))
+      (org-columns-update key)))))
 
 (defun org-verify-version (task)
   (cond
@@ -667,131 +673,6 @@ display, or in the #+COLUMNS line of the current buffer."
 
 (defvar org-overriding-columns-format nil
   "When set, overrides any other definition.")
-(defvar org-agenda-view-columns-initially nil
-  "When set, switch to columns view immediately after creating the agenda.")
-
-(defvar org-agenda-columns-show-summaries) ; defined in org-agenda.el
-(defun org-agenda-columns ()
-  "Turn on column view in the agenda."
-  (interactive)
-  (org-verify-version 'columns)
-  (org-columns-remove-overlays)
-  (move-marker org-columns-begin-marker (point))
-  (let (fmt cache maxwidths m)
-    (cond
-     ((and (local-variable-p 'org-overriding-columns-format)
-	   org-overriding-columns-format)
-      (setq fmt org-overriding-columns-format))
-     ((setq m (get-text-property (point-at-bol) 'org-hd-marker))
-      (setq fmt (or (org-entry-get m "COLUMNS" t)
-		    (with-current-buffer (marker-buffer m)
-		      org-columns-default-format))))
-     ((and (boundp 'org-columns-current-fmt)
-	   (local-variable-p 'org-columns-current-fmt)
-	   org-columns-current-fmt)
-      (setq fmt org-columns-current-fmt))
-     ((setq m (next-single-property-change (point-min) 'org-hd-marker))
-      (setq m (get-text-property m 'org-hd-marker))
-      (setq fmt (or (org-entry-get m "COLUMNS" t)
-		    (with-current-buffer (marker-buffer m)
-		      org-columns-default-format)))))
-    (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)
-    (save-excursion
-      ;; Get and cache the properties
-      (goto-char (point-min))
-      (while (not (eobp))
-	(when (setq m (or (get-text-property (point) 'org-hd-marker)
-			  (get-text-property (point) 'org-marker)))
-	  (push (cons (org-current-line) (org-entry-properties m)) cache))
-	(beginning-of-line 2))
-      (when cache
-	(setq maxwidths (org-columns-get-autowidth-alist fmt cache))
-	(org-set-local 'org-columns-current-maxwidths maxwidths)
-	(org-columns-display-here-title)
-	(mapc (lambda (x)
-		(goto-line (car x))
-		(org-columns-display-here (cdr x)))
-	      cache)
-	(when org-agenda-columns-show-summaries
-	  (org-agenda-colview-summarize cache))))))
-
-(defun org-agenda-colview-summarize (cache)
-  "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."
-  (let* ((fmt (mapcar (lambda (x)
-			(list (car x) (if (equal (car x) "CLOCKSUM")
-					  '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)
-		       (cons prop (org-columns-number-to-string lsum stype)))))
-		   fmt))
-	    (org-columns-display-here props)
-	    (org-set-local 'org-agenda-columns-active 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
-	      (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))))))))))))
 
 (defun org-columns-get-autowidth-alist (s cache)
   "Derive the maximum column widths from the format and the cache."
@@ -875,7 +756,7 @@ This will add overlays to the date lines, to show the summary for each day."
 	    (org-unmodified
 	     (add-text-properties sumpos (1+ sumpos)
 				  (list 'org-summaries sum-alist))))
-	  (when val
+	  (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
 	  (when (or flag valflag)
@@ -1144,6 +1025,152 @@ and tailing newline characters."
     (org-create-dblock defaults)
     (org-update-dblock)))
 
+;;; Column view in the agenda
+
+(defvar org-agenda-view-columns-initially nil
+  "When set, switch to columns view immediately after creating the agenda.")
+
+(defvar org-agenda-columns-show-summaries) ; defined in org-agenda.el
+
+(defun org-agenda-columns ()
+  "Turn on column view in the agenda."
+  (interactive)
+  (org-verify-version 'columns)
+  (org-columns-remove-overlays)
+  (move-marker org-columns-begin-marker (point))
+  (let (fmt cache maxwidths m p a)
+    (cond
+     ((and (local-variable-p 'org-overriding-columns-format)
+	   org-overriding-columns-format)
+      (setq fmt org-overriding-columns-format))
+     ((setq m (get-text-property (point-at-bol) 'org-hd-marker))
+      (setq fmt (or (org-entry-get m "COLUMNS" t)
+		    (with-current-buffer (marker-buffer m)
+		      org-columns-default-format))))
+     ((and (boundp 'org-columns-current-fmt)
+	   (local-variable-p 'org-columns-current-fmt)
+	   org-columns-current-fmt)
+      (setq fmt org-columns-current-fmt))
+     ((setq m (next-single-property-change (point-min) 'org-hd-marker))
+      (setq m (get-text-property m 'org-hd-marker))
+      (setq fmt (or (org-entry-get m "COLUMNS" t)
+		    (with-current-buffer (marker-buffer m)
+		      org-columns-default-format)))))
+    (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)
+    (save-excursion
+      ;; Get and cache the properties
+      (goto-char (point-min))
+      (while (not (eobp))
+	(when (setq m (or (get-text-property (point) 'org-hd-marker)
+			  (get-text-property (point) 'org-marker)))
+	  (setq p (org-entry-properties m))
+
+	  (when (or (not (setq a (assoc org-time-estimates-property p)))
+			 (not (string-match "\\S-" (or (cdr a) ""))))
+	    ;; OK, no property gives us a value
+	    (when (and org-time-estimate-include-appointments
+		       (setq d (get-text-property (point) 'duration)))
+	      (setq d (org-minutes-to-hours d))
+	      (put-text-property 0 (length d) 'face 'org-warning d)
+	      (push (cons org-time-estimates-property d) p)))
+	  (push (cons (org-current-line) p) cache))
+	(beginning-of-line 2))
+      (when cache
+	(setq maxwidths (org-columns-get-autowidth-alist fmt cache))
+	(org-set-local 'org-columns-current-maxwidths maxwidths)
+	(org-columns-display-here-title)
+	(mapc (lambda (x)
+		(goto-line (car x))
+		(org-columns-display-here (cdr x)))
+	      cache)
+	(when org-agenda-columns-show-summaries
+	  (org-agenda-colview-summarize cache))))))
+
+(defun org-agenda-colview-summarize (cache)
+  "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."
+  (let* ((fmt (mapcar (lambda (x)
+			(list (car x) (if (equal (car x) "CLOCKSUM")
+					  '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))
+	  (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))))))))))))
+
 (provide 'org-colview)
 
 ;;; org-colview.el ends here

lisp/org-exp.el

@@ -2474,6 +2474,7 @@ lang=\"%s\" xml:lang=\"%s\">
 				  "\">\\nbsp@</a>")
 			  t t line)))
 	     ((and org-export-with-toc (equal (string-to-char line) ?*))
+	      ;; FIXME: NOT DEPENDENT on TOC?????????????????????
 	      (setq line (replace-match
 			  (concat "@<span class=\"target\">" (match-string 1 line) "@</span> ")
 ;			  (concat "@<i>" (match-string 1 line) "@</i> ")

lisp/org.el

@@ -6614,6 +6614,17 @@ Org-mode syntax."
   (interactive)
   (org-run-like-in-org-mode 'org-open-at-point))
 
+;;;###autoload
+(defun org-open-link-from-string (s &optional arg)
+  "Open a link in the string S, as if it was in Org-mode."
+  (interactive "sLink: \nP")
+  (with-temp-buffer
+    (let ((org-inhibit-startup t))
+      (org-mode)
+      (insert s)
+      (goto-char (point-min))
+      (org-open-at-point arg))))
+
 (defun org-open-at-point (&optional in-emacs)
   "Open link at or after point.
 If there is no link at point, this function will search forward up to
@@ -6763,6 +6774,9 @@ optional argument IN-EMACS is non-nil, Emacs will visit the file."
   (move-marker org-open-link-marker nil)
   (run-hook-with-args 'org-follow-link-hook))
 
+;;;; Time estimates
+
+
 ;;; File search
 
 (defvar org-create-file-search-functions nil
@@ -13554,13 +13568,68 @@ Still experimental, may disappear in the future."
 ;; arch-tag: e77da1a7-acc7-4336-b19e-efa25af3f9fd
 ;;; org.el ends here
 
-(defun org-open-link-from-string (s &optional arg)
-  "Open a link in the string S, as if it was in Org-mode."
+
+(defcustom org-time-estimates-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)
-  (with-temp-buffer
-    (let ((org-inhibit-startup t))
-      (org-mode)
-      (insert s)
-      (goto-char (point-min))
-      (org-open-at-point arg))))
+  (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))