Browse Source

org-colview: Ignore "fmt" format property

* lisp/org-colview.el (org-columns--displayed-value):
(org-columns-next-allowed-value):
(org-columns-new):
(org-columns-compute):
(org-columns-number-to-string):
(org-columns-string-to-number):
(org-columns-uncompile-format):
(org-columns-compile-format):
(org-agenda-colview-summarize):
(org-agenda-colview-compute): Ignore "fmt" property.  Use "op" instead.

* lisp/org.el (org-entry-properties): Ditto.

* testing/lisp/test-org-colview.el (test-org-colview/columns-summary):
  Ditto.
Nicolas Goaziou 9 years ago
parent
commit
d59d96efaa
3 changed files with 105 additions and 115 deletions
  1. 99 109
      lisp/org-colview.el
  2. 3 3
      lisp/org.el
  3. 3 3
      testing/lisp/test-org-colview.el

+ 99 - 109
lisp/org-colview.el

@@ -178,7 +178,7 @@ VALUE is the real value of the property, as a string.
 This function assumes `org-columns-current-fmt-compiled' is
 initialized."
   (pcase (assoc-string property org-columns-current-fmt-compiled t)
-    (`(,_ ,_ ,_ ,_ ,fmt ,printf ,_)
+    (`(,_ ,_ ,_ ,operator ,_ ,printf ,_)
      (cond
       ((and (functionp org-columns-modify-value-for-display-function)
 	    (funcall
@@ -191,7 +191,7 @@ initialized."
 	       "* "
 	       (org-columns-compact-links value)))
       (printf (org-columns-number-to-string
-	       (org-columns-string-to-number value fmt) fmt printf))
+	       (org-columns-string-to-number value operator) operator printf))
       (value)))))
 
 (defun org-columns--collect-values (&optional agenda)
@@ -610,14 +610,14 @@ an integer, select that value."
 	 (bol (point-at-bol)) (eol (point-at-eol))
 	 (pom (or (get-text-property bol 'org-hd-marker)
 		  (point)))	     ; keep despite of compiler waring
-	 (allowed (or (org-property-get-allowed-values pom key)
-		      (and (memq
-			    (nth 4 (assoc-string key
-						 org-columns-current-fmt-compiled
-						 t))
-			    '(checkbox checkbox-n-of-m checkbox-percent))
-			   '("[ ]" "[X]"))
-		      (org-colview-construct-allowed-dates value)))
+	 (allowed
+	  (or (org-property-get-allowed-values pom key)
+	      (and (member (nth 3 (assoc-string key
+						org-columns-current-fmt-compiled
+						t))
+			   '("X" "X/" "X%"))
+		   '("[ ]" "[X]"))
+	      (org-colview-construct-allowed-dates value)))
 	 nval)
     (when (integerp nth)
       (setq nth (1- nth))
@@ -792,37 +792,39 @@ format      symbol describing summary type selected interactively in
 function    called with a list of values as argument to calculate
 	    the summary value")
 
-(defun org-columns-new (&optional prop title width _op fmt fun &rest _rest)
+(defun org-columns-new (&optional prop title width operator _f _p summarize)
   "Insert a new column, to the left of the current column."
   (interactive)
-  (let ((editp (and prop
-		    (assoc-string prop org-columns-current-fmt-compiled t)))
-	cell)
-    (setq prop (completing-read
-		"Property: " (mapcar #'list (org-buffer-property-keys t nil t))
-		nil nil prop))
-    (setq title (read-string (concat "Column title [" prop "]: ") (or title prop)))
-    (setq width (read-string "Column width: " (if width (number-to-string width))))
-    (if (string-match "\\S-" width)
-	(setq width (string-to-number width))
-      (setq width nil))
-    (setq fmt (completing-read
+  (let* ((prop (or prop (completing-read
+			 "Property: "
+			 (mapcar #'list (org-buffer-property-keys t nil t)))))
+	 (title (or title
+		    (read-string (format "Column title [%s]: " prop) prop)))
+	 (width
+	  ;; WIDTH may be nil, but if PROP is provided, assume this is
+	  ;; the expected width.
+	  (if prop width
+	    ;; Use `read-string' instead of `read-number' to allow
+	    ;; empty width.
+	    (let ((w (read-string "Column width: ")))
+	      (and (org-string-nw-p w) (string-to-number w)))))
+	 (operator
+	  (or operator
+	      (completing-read
 	       "Summary [none]: "
-	       (mapcar (lambda (x) (list (symbol-name (cadr x))))
-		       org-columns-compile-map)
-	       nil t))
-    (setq fmt (intern fmt)
-	  fun (cdr (assoc fmt (mapcar 'cdr org-columns-compile-map))))
-    (if (eq fmt 'none) (setq fmt nil))
-    (if editp
+	       (mapcar (lambda (x) (list (car x))) org-columns-compile-map)
+	       nil t)))
+	 (summarize (or summarize
+			(nth 2 (assoc operator org-columns-compile-map))))
+	 (edit (and prop
+		    (assoc-string prop org-columns-current-fmt-compiled t))))
+    (if edit
 	(progn
-	  (setcar editp prop)
-	  (setcdr editp (list title width nil fmt nil fun)))
-      (setq cell (nthcdr (1- (current-column))
-			 org-columns-current-fmt-compiled))
-      (setcdr cell (cons (list prop title width nil fmt nil
-			       (car fun) (cadr fun))
-			 (cdr cell))))
+	  (setcar edit prop)
+	  (setcdr edit (list title width nil operator nil summarize)))
+      (let ((cell (nthcdr (1- (current-column))
+			  org-columns-current-fmt-compiled)))
+	(push (list prop title width nil operator nil summarize) (cdr cell))))
     (org-columns-store-format)
     (org-columns-redo)))
 
@@ -964,7 +966,7 @@ display, or in the #+COLUMNS line of the current buffer."
 		 29))			;Hard-code deepest level.
 	 (lvals (make-vector (1+ lmax) nil))
 	 (spec (assoc-string property org-columns-current-fmt-compiled t))
-	 (format (nth 4 spec))
+	 (operator (nth 3 spec))
 	 (printf (nth 5 spec))
 	 (fun (nth 6 spec))
 	 (level 0)
@@ -994,7 +996,7 @@ display, or in the #+COLUMNS line of the current buffer."
 				      (aref lvals inminlevel))))
 		     (and all (apply fun all))))
 		  (str (and summary (org-columns-number-to-string
-				     summary format printf))))
+				     summary operator printf))))
 	     (let* ((summaries-alist (get-text-property pos 'org-summaries))
 		    (old (assoc-string property summaries-alist t))
 		    (new (cond
@@ -1013,14 +1015,14 @@ display, or in the #+COLUMNS line of the current buffer."
 	       (org-entry-put nil property str))
 	     ;; Add current to current level accumulator.
 	     (when (or summary value-set)
-	       (push (or summary (org-columns-string-to-number value format))
+	       (push (or summary (org-columns-string-to-number value operator))
 		     (aref lvals level)))
 	     ;; Clear accumulators for deeper levels.
 	     (cl-loop for l from (1+ level) to lmax do
 		      (aset lvals l nil))))
 	  (value-set
 	   ;; Add what we have here to the accumulator for this level.
-	   (push (org-columns-string-to-number value format)
+	   (push (org-columns-string-to-number value operator)
 		 (aref lvals level)))
 	  (t nil)))))))
 
@@ -1043,30 +1045,30 @@ display, or in the #+COLUMNS line of the current buffer."
   (message "Recomputing columns...done"))
 
 ;;;###autoload
-(defun org-columns-number-to-string (n fmt &optional printf)
+(defun org-columns-number-to-string (n operator &optional printf)
   "Convert a computed column number N to a string value.
-FMT is a symbol describing the summary type.  Optional argument
+operator is a string describing the summary type.  Optional argument
 PRINTF, when non-nil, is a format string used to print N."
   (cond
-   ((eq fmt 'estimate)
+   ((equal operator "est+")
     (let ((fmt (or printf "%.0f")))
       (mapconcat (lambda (n) (format fmt n)) (if (consp n) n (list n n)) "-")))
    ((not (numberp n)) "")
-   ((memq fmt '(add_times max_times min_times mean_times))
+   ((member operator '(":" ":max" ":min" ":mean"))
     (org-hours-to-clocksum-string n))
-   ((eq fmt 'checkbox)
+   ((equal operator "X")
     (cond ((= n (floor n)) "[X]")
 	  ((> n 1.) "[-]")
 	  (t "[ ]")))
-   ((memq fmt '(checkbox-n-of-m checkbox-percent))
+   ((member operator '("X/" "X%"))
     (let* ((n1 (floor n))
 	   (n2 (+ (floor (+ .5 (* 1000000 (- n n1)))) n1)))
-      (cond ((not (eq fmt 'checkbox-percent)) (format "[%d/%d]" n1 n2))
+      (cond ((not (equal operator "X%")) (format "[%d/%d]" n1 n2))
 	    ((or (= n1 0) (= n2 0)) "[0%]")
 	    (t (format "[%d%%]" (round (* 100.0 n1) n2))))))
    (printf (format printf n))
-   ((eq fmt 'currency) (format "%.2f" n))
-   ((memq fmt '(min_age max_age mean_age))
+   ((equal operator "$") (format "%.2f" n))
+   ((member operator '("@min" "@max" "@mean"))
     (format-seconds "%dd %.2hh %mm %ss" n))
    (t (number-to-string n))))
 
@@ -1086,12 +1088,12 @@ and variances (respectively) of the individual estimates."
     (let ((sd (sqrt var)))
       (list (- mean sd) (+ mean sd)))))
 
-(defun org-columns-string-to-number (s fmt)
+(defun org-columns-string-to-number (s operator)
   "Convert a column value S to a number.
-FMT is a symbol describing the summary type."
+OPERATOR is a string describing the summary type."
   (cond
    ((not s) nil)
-   ((memq fmt '(min_age max_age mean_age))
+   ((member operator '("@min" "@max" "@mean"))
     (cond
      ((string= s "") org-columns--time)
      ((string-match "\\`\\(?: *\\([0-9]+\\)d\\)?\\(?: *\\([0-9]+\\)h\\)?\
@@ -1108,9 +1110,9 @@ FMT is a symbol describing the summary type."
     (let ((sum 0.0))
       (dolist (n (nreverse (split-string s ":")) sum)
 	(setq sum (+ (string-to-number n) (/ sum 60))))))
-   ((memq fmt '(checkbox checkbox-n-of-m checkbox-percent))
+   ((member operator '("X" "X/" "X%"))
     (if (equal s "[X]") 1. 0.000001))
-   ((eq fmt 'estimate)
+   ((equal operator "est+")
     (if (not (string-match "\\(.*\\)-\\(.*\\)" s))
 	(string-to-number s)
       (list (string-to-number (match-string 1 s))
@@ -1122,28 +1124,22 @@ FMT is a symbol describing the summary type."
 	(setq sum (+ (string-to-number n) (/ sum 60))))))
    (t (string-to-number s))))
 
-(defun org-columns-uncompile-format (cfmt)
-  "Turn the compiled columns format back into a string representation."
-  (let ((rtn "") e s prop title op width fmt printf ee map)
-    (while (setq e (pop cfmt))
-      (setq prop (car e)
-	    title (nth 1 e)
-	    width (nth 2 e)
-	    op (nth 3 e)
-	    fmt (nth 4 e)
-	    printf (nth 5 e))
-      (setq map (copy-sequence org-columns-compile-map))
-      (while (setq ee (pop map))
-	(if (equal fmt (nth 1 ee))
-	    (setq op (car ee) map nil)))
-      (if (and op printf) (setq op (concat op ";" printf)))
-      (if (equal title prop) (setq title nil))
-      (setq s (concat "%" (if width (number-to-string width))
-		      prop
-		      (if title (concat "(" title ")"))
-		      (if op (concat "{" op "}"))))
-      (setq rtn (concat rtn " " s)))
-    (org-trim rtn)))
+(defun org-columns-uncompile-format (compiled)
+  "Turn the compiled columns format back into a string representation.
+COMPILED is an alist, as returned by
+`org-columns-compile-format', which see."
+  (mapconcat
+   (lambda (spec)
+     (pcase spec
+       (`(,prop ,title ,width ,op ,_ ,printf ,_)
+	(concat "%"
+		(and width (number-to-string width))
+		prop
+		(and title (not (equal prop title)) (format "(%s)" title))
+		(cond ((not op) nil)
+		      (printf (format "{%s;%s}" op printf))
+		      (t (format "{%s}" op)))))))
+   compiled " "))
 
 (defun org-columns-compile-format (fmt)
   "Turn a column format string FMT into an alist of specifications.
@@ -1170,7 +1166,6 @@ This function updates `org-columns-current-fmt-compiled'."
 	     (prop (match-string 2 fmt))
 	     (title (or (match-string 3 fmt) prop))
 	     (op (match-string 4 fmt))
-	     (f nil)
 	     (printf nil)
 	     (fun '+))
 	(when (and op (string-match ";" op))
@@ -1178,9 +1173,8 @@ This function updates `org-columns-current-fmt-compiled'."
 	  (setq op (substring op 0 (match-beginning 0))))
 	(let ((op-match (assoc op org-columns-compile-map)))
 	  (when op-match
-	    (setq f (nth 1 op-match))
 	    (setq fun (nth 2 op-match))))
-	(push (list prop title width op f printf fun)
+	(push (list prop title width op nil printf fun)
 	      org-columns-current-fmt-compiled)))
     (setq org-columns-current-fmt-compiled
 	  (nreverse org-columns-current-fmt-compiled))))
@@ -1447,7 +1441,7 @@ This will add overlays to the date lines, to show the summary for each day."
 	      org-columns-current-fmt-compiled))
 	entries)
     ;; Ensure there's at least one summation column.
-    (when (cl-some (lambda (spec) (nth 4 spec)) fmt)
+    (when (cl-some (lambda (spec) (nth 3 spec)) fmt)
       (goto-char (point-max))
       (while (not (bobp))
 	(when (or (get-text-property (point) 'org-date-line)
@@ -1474,24 +1468,25 @@ This will add overlays to the date lines, to show the summary for each day."
 				(line-beginning-position)
 				(line-end-position))))
 		     (list prop date date)))
-		  (`(,prop ,_ ,_ ,_ nil . ,_)
+		  (`(,prop ,_ ,_ nil . ,_)
 		   (list prop "" ""))
-		  (`(,prop ,_ ,_ ,_ ,stype ,_ ,sumfunc)
+		  (`(,prop ,_ ,_ ,operator ,_ ,_ ,sumfunc)
 		   (let (lsum)
 		     (dolist (entry entries (setq lsum (delq nil lsum)))
 		       ;; Use real values for summary, not those
 		       ;; prepared for display.
 		       (let ((v (nth 1 (assoc-string prop entry t))))
 			 (when v
-			   (push (org-columns-string-to-number v stype) lsum))))
+			   (push (org-columns-string-to-number v operator)
+				 lsum))))
 		     (setq lsum
 			   (let ((l (length lsum)))
 			     (cond ((> l 1)
 				    (org-columns-number-to-string
-				     (apply sumfunc lsum) stype))
+				     (apply sumfunc lsum) operator))
 				   ((= l 1)
 				    (org-columns-number-to-string
-				     (car lsum) stype))
+				     (car lsum) operator))
 				   (t ""))))
 		     (put-text-property 0 (length lsum) 'face 'bold lsum)
 		     (list prop lsum lsum)))))
@@ -1504,29 +1499,24 @@ This will add overlays to the date lines, to show the summary for each day."
   "Compute the relevant columns in the contributing source buffers."
   (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-with-silent-modifications
-	     (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))
-	      (cond ((equal (car fm) "CLOCKSUM")
-		     (org-clock-sum))
-		    ((equal (car fm) "CLOCKSUM_T")
-		     (org-clock-sum-today))
-		    ((and (nth 4 fm)
-			  (setq a (assoc-string (car fm)
-						org-columns-current-fmt-compiled
-						t))
-			  (equal (nth 4 a) (nth 4 fm)))
-		     (org-columns-compute (car fm)))))))))))
+	(org-columns-top-level-marker (make-marker)))
+    (dolist (f files)
+      (let ((b (find-buffer-visiting f)))
+	(with-current-buffer (or (buffer-base-buffer b) b)
+	  (org-with-wide-buffer
+	   (org-with-silent-modifications
+	    (remove-text-properties (point-min) (point-max) '(org-summaries t)))
+	   (goto-char (point-min))
+	   (org-columns-get-format-and-top-level)
+	   (dolist (spec fmt)
+	     (let ((prop (car spec)))
+	       (cond
+		((equal (upcase prop) "CLOCKSUM") (org-clock-sum))
+		((equal (upcase prop) "CLOCKSUM_T") (org-clock-sum-today))
+		((and (nth 3 spec)
+		      (let ((a (assoc prop org-columns-current-fmt-compiled)))
+			(equal (nth 3 a) (nth 3 spec))))
+		 (org-columns-compute prop)))))))))))
 
 
 (provide 'org-colview)

+ 3 - 3
lisp/org.el

@@ -4726,7 +4726,7 @@ Otherwise, these types are allowed:
 
 ;; Declare Column View Code
 
-(declare-function org-columns-number-to-string "org-colview" (n fmt &optional printf))
+(declare-function org-columns-number-to-string "org-colview" (n operator &optional printf))
 (declare-function org-columns-get-format-and-top-level "org-colview" ())
 (declare-function org-columns-compute "org-colview" (property))
 
@@ -15601,7 +15601,7 @@ strings."
 		(when clocksum
 		  (push (cons "CLOCKSUM"
 			      (org-columns-number-to-string
-			       (/ (float clocksum) 60.) 'add_times))
+			       (/ clocksum 60.0) ":"))
 			props)))
 	      (when specific (throw 'exit props)))
 	    (when (or (not specific) (string= specific "CLOCKSUM_T"))
@@ -15610,7 +15610,7 @@ strings."
 		(when clocksumt
 		  (push (cons "CLOCKSUM_T"
 			      (org-columns-number-to-string
-			       (/ (float clocksumt) 60.) 'add_times))
+			       (/ clocksumt 60.0) ":"))
 			props)))
 	      (when specific (throw 'exit props)))
 	    (when (or (not specific) (string= specific "ITEM"))

+ 3 - 3
testing/lisp/test-org-colview.el

@@ -378,7 +378,7 @@
       (time-subtract
        (current-time)
        (apply #'encode-time (org-parse-time-string "<2014-03-04 Tue>"))))
-     'min_age)
+     "@min")
     (org-test-with-temp-text
 	"* H
 ** S1
@@ -398,7 +398,7 @@
       (time-subtract
        (current-time)
        (apply #'encode-time (org-parse-time-string "<2012-03-29 Thu>"))))
-     'max_age)
+     "@max")
     (org-test-with-temp-text
 	"* H
 ** S1
@@ -423,7 +423,7 @@
 	     (current-time)
 	     (apply #'encode-time (org-parse-time-string "<2012-03-29 Thu>")))))
 	2)
-     'mean_age)
+     "@mean")
     (org-test-with-temp-text
 	"* H
 ** S1