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.
This commit is contained in:
Nicolas Goaziou 2016-02-20 15:13:03 +01:00
parent 73d5733d01
commit d59d96efaa
3 changed files with 105 additions and 115 deletions

View File

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

View File

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

View File

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