Sync Org 7.9.2 from the commit tagged "release_7.9.2" in Org's Git repo.

1 files changed, 94 insertions, 65 deletions

diff --git a/lisp/org/org-colview.el b/lisp/org/org-colview.el
index 5cec355d738..e17210b7ff5 100644
--- a/lisp/org/org-colview.el
+++ b/lisp/org/org-colview.el
@@ -33,9 +33,10 @@
 
 (declare-function org-agenda-redo "org-agenda" ())
 (declare-function org-agenda-do-context-action "org-agenda" ())
+(declare-function org-clock-sum-today "org-clock" (&optional headline-filter))
 
 (when (featurep 'xemacs)
-  (error "Do not load this file into XEmacs, use 'org-colview-xemacs.el'."))
+  (error "Do not load this file into XEmacs, use `org-colview-xemacs.el'"))
 
 ;;; Column View
 
@@ -149,6 +150,7 @@ This is the compiled version of the format.")
   "Create a new column overlay and add it to the list."
   (let ((ov (make-overlay beg end)))
     (overlay-put ov 'face (or face 'secondary-selection))
+    (remove-text-properties 0 (length string) '(face nil) string)
     (org-overlay-display ov string face)
     (push ov org-columns-overlays)
     ov))
@@ -186,17 +188,15 @@ This is the compiled version of the format.")
 		    (cons "ITEM"
 			  ;; When in a buffer, get the whole line,
 			  ;; we'll clean it later…
-			  (if (eq major-mode 'org-mode)
+			  (if (derived-mode-p 'org-mode)
 			      (save-match-data
-				(org-no-properties
-				 (org-remove-tabs
-				  (buffer-substring-no-properties
-				   (point-at-bol) (point-at-eol)))))
+				(org-remove-tabs
+				 (buffer-substring-no-properties
+				  (point-at-bol) (point-at-eol))))
 			    ;; In agenda, just get the `txt' property
-			    (org-no-properties
-			     (or (org-get-at-bol 'txt)
-				 (buffer-substring
-				  (point) (progn (end-of-line) (point)))))))
+			    (or (org-get-at-bol 'txt)
+				(buffer-substring-no-properties
+				 (point) (progn (end-of-line) (point))))))
 		  (assoc property props))
 	    width (or (cdr (assoc property org-columns-current-maxwidths))
 		      (nth 2 column)
@@ -240,20 +240,20 @@ 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)))
-       (overlay-put ov 'invisible t)
-       (overlay-put ov 'keymap org-columns-map)
-       (overlay-put ov 'intangible t)
-       (overlay-put ov 'line-prefix "")
-       (overlay-put ov 'wrap-prefix "")
-       (push ov org-columns-overlays)
-       (setq ov (make-overlay (1- (point-at-eol)) (1+ (point-at-eol))))
-       (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)))
+     (overlay-put ov 'invisible t)
+     (overlay-put ov 'keymap org-columns-map)
+     (overlay-put ov 'intangible t)
+     (overlay-put ov 'line-prefix "")
+     (overlay-put ov 'wrap-prefix "")
+     (push ov org-columns-overlays)
+     (setq ov (make-overlay (1- (point-at-eol)) (1+ (point-at-eol))))
+     (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")))))
 
@@ -304,7 +304,7 @@ for the duration of the command.")
     (org-set-local 'org-columns-current-widths (nreverse widths))
     (setq org-columns-full-header-line-format title)
     (setq org-columns-previous-hscroll -1)
-;    (org-columns-hscoll-title)
+					;    (org-columns-hscoll-title)
     (org-add-hook 'post-command-hook 'org-columns-hscoll-title nil 'local)))
 
 (defun org-columns-hscoll-title ()
@@ -442,8 +442,8 @@ Where possible, use the standard interface for changing this line."
 		    (org-edit-headline))))
      ((equal key "TODO")
       (setq eval '(org-with-point-at
-		   pom
-		   (call-interactively 'org-todo))))
+		      pom
+		    (call-interactively 'org-todo))))
      ((equal key "PRIORITY")
       (setq eval '(org-with-point-at pom
 		    (call-interactively 'org-priority))))
@@ -499,7 +499,7 @@ Where possible, use the standard interface for changing this line."
 		(org-columns-eval eval))
 	    (org-columns-display-here)))
 	(org-move-to-column col)
-	(if (and (eq major-mode 'org-mode)
+	(if (and (derived-mode-p 'org-mode)
 		 (nth 3 (assoc key org-columns-current-fmt-compiled)))
 	    (org-columns-update key)))))))
 
@@ -665,27 +665,38 @@ around it."
     (org-open-link-from-string value arg)))
 
 (defun org-columns-get-format-and-top-level ()
-  (let (fmt)
+  (let ((fmt (org-columns-get-format)))
+    (org-columns-goto-top-level)
+    fmt))
+
+(defun org-columns-get-format (&optional fmt-string)
+  (interactive)
+  (let (fmt-as-property fmt)
     (when (condition-case nil (org-back-to-heading) (error nil))
-      (setq fmt (org-entry-get nil "COLUMNS" t)))
-    (setq fmt (or fmt org-columns-default-format))
+      (setq fmt-as-property (org-entry-get nil "COLUMNS" t)))
+    (setq fmt (or fmt-string fmt-as-property org-columns-default-format))
     (org-set-local 'org-columns-current-fmt fmt)
     (org-columns-compile-format fmt)
-    (if (marker-position org-entry-property-inherited-from)
-	(move-marker org-columns-top-level-marker
-		     org-entry-property-inherited-from)
-      (move-marker org-columns-top-level-marker (point)))
     fmt))
 
-(defun org-columns ()
-  "Turn on column view on an org-mode file."
+(defun org-columns-goto-top-level ()
+  (when (condition-case nil (org-back-to-heading) (error nil))
+    (org-entry-get nil "COLUMNS" t))
+  (if (marker-position org-entry-property-inherited-from)
+      (move-marker org-columns-top-level-marker org-entry-property-inherited-from)
+    (move-marker org-columns-top-level-marker (point))))
+
+(defun org-columns (&optional columns-fmt-string)
+  "Turn on column view on an org-mode file.
+When COLUMNS-FMT-STRING is non-nil, use it as the column format."
   (interactive)
   (org-verify-version 'columns)
   (org-columns-remove-overlays)
   (move-marker org-columns-begin-marker (point))
   (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))
+    (org-columns-goto-top-level)
+    (setq fmt (org-columns-get-format columns-fmt-string))
     (save-excursion
       (goto-char org-columns-top-level-marker)
       (setq beg (point))
@@ -700,6 +711,11 @@ around it."
 	  (save-restriction
 	    (narrow-to-region beg end)
 	    (org-clock-sum))))
+      (when (assoc "CLOCKSUM_T" org-columns-current-fmt-compiled)
+	(save-excursion
+	  (save-restriction
+	    (narrow-to-region beg end)
+	    (org-clock-sum-today))))
       (while (re-search-forward org-outline-regexp-bol end t)
 	(if (and org-columns-skip-archived-trees
 		 (looking-at (concat ".*:" org-archive-tag ":")))
@@ -1014,7 +1030,7 @@ Don't set this, this is meant for dynamic scoping.")
       (if (marker-position org-columns-begin-marker)
 	  (goto-char org-columns-begin-marker))
       (org-columns-remove-overlays)
-      (if (eq major-mode 'org-mode)
+      (if (derived-mode-p 'org-mode)
 	  (call-interactively 'org-columns)
 	(org-agenda-redo)
 	(call-interactively 'org-agenda-columns)))
@@ -1083,6 +1099,14 @@ Don't set this, this is meant for dynamic scoping.")
           (while l
             (setq sum (+ (string-to-number (pop l)) (/ sum 60))))
           sum))
+       ((string-match (concat "\\([0-9.]+\\) *\\("
+			      (regexp-opt (mapcar 'car org-effort-durations))
+			      "\\)") s)
+	(setq s (concat "0:" (org-duration-string-to-minutes s t)))
+        (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))
        ((memq fmt '(estimate)) (org-string-to-estimate s))
@@ -1215,13 +1239,16 @@ PARAMS is a property list of parameters:
 :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.
+:format   When non-nil, specify the column view format to use."
   (let ((pos (move-marker (make-marker) (point)))
 	(hlines (plist-get params :hlines))
 	(vlines (plist-get params :vlines))
 	(maxlevel (plist-get params :maxlevel))
 	(content-lines (org-split-string (plist-get params :content) "\n"))
 	(skip-empty-rows (plist-get params :skip-empty-rows))
+	(columns-fmt (plist-get params :format))
+	(case-fold-search t)
 	tbl id idpos nfields tmp recalc line
 	id-as-string view-file view-pos)
     (when (setq id (plist-get params :id))
@@ -1250,7 +1277,7 @@ PARAMS is a property list of parameters:
 	(save-restriction
 	  (widen)
 	  (goto-char (or view-pos (point)))
-	  (org-columns)
+	  (org-columns columns-fmt)
 	  (setq tbl (org-columns-capture-view maxlevel skip-empty-rows))
 	  (setq nfields (length (car tbl)))
 	  (org-columns-quit))))
@@ -1287,7 +1314,7 @@ PARAMS is a property list of parameters:
       (while (setq line (pop content-lines))
 	(when (string-match "^#" line)
 	  (insert "\n" line)
-	  (when (string-match "^[ \t]*#\\+TBLFM" line)
+	  (when (string-match "^[ \t]*#\\+tblfm" line)
 	    (setq recalc t))))
       (if recalc
 	  (progn (goto-char pos) (org-table-recalculate 'all))
@@ -1337,12 +1364,11 @@ and tailing newline characters."
   (org-columns-remove-overlays)
   (move-marker org-columns-begin-marker (point))
   (let ((org-columns-time (time-to-number-of-days (current-time)))
-	 cache maxwidths m p a d fmt)
+	cache maxwidths m p a d fmt)
     (cond
      ((and (boundp 'org-agenda-overriding-columns-format)
 	   org-agenda-overriding-columns-format)
-      (setq fmt org-agenda-overriding-columns-format)
-      (org-set-local 'org-agenda-overriding-columns-format fmt))
+      (setq fmt org-agenda-overriding-columns-format))
      ((setq m (org-get-at-bol 'org-hd-marker))
       (setq fmt (or (org-entry-get m "COLUMNS" t)
 		    (with-current-buffer (marker-buffer m)
@@ -1370,7 +1396,7 @@ and tailing newline characters."
 	  (setq p (org-entry-properties m))
 
 	  (when (or (not (setq a (assoc org-effort-property p)))
-			 (not (string-match "\\S-" (or (cdr a) ""))))
+		    (not (string-match "\\S-" (or (cdr a) ""))))
 	    ;; 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)))
@@ -1397,8 +1423,9 @@ and tailing newline characters."
   "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)
-			(if (equal (car x) "CLOCKSUM")
-			    (list "CLOCKSUM" (nth 1 x) (nth 2 x) ":" 'add_times
+			(if (string-match "CLOCKSUM.*" (car x))
+			    (list (match-string 0 (car x))
+				  (nth 1 x) (nth 2 x) ":" 'add_times
 				  nil '+ nil)
 			  x))
 		      org-columns-current-fmt-compiled))
@@ -1485,23 +1512,25 @@ This will add overlays to the date lines, to show the summary for each day."
 	    (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)))))))))))
+	      (cond ((equal (car fm) "CLOCKSUM")
+		     (org-clock-sum))
+		    ((equal (car fm) "CLOCKSUM_T")
+		     (org-clock-sum-today))
+		    ((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-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))
+      (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))
     ""))
 
 (defun org-estimate-mean-and-var (v)
@@ -1519,10 +1548,10 @@ and variances (respectively) of the individual estimates."
   (let ((mean 0)
         (var 0))
     (mapc (lambda (e)
-              (let ((stats (org-estimate-mean-and-var e)))
-                (setq mean (+ mean (car stats)))
-                (setq var (+ var (cadr stats)))))
-            el)
+	    (let ((stats (org-estimate-mean-and-var e)))
+	      (setq mean (+ mean (car stats)))
+	      (setq var (+ var (cadr stats)))))
+	  el)
     (let ((stdev (sqrt var)))
       (list (- mean stdev) (+ mean stdev)))))