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
parent
73d5733d01
commit
d59d96efaa
|
|
@ -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)
|
||||
|
|
|
|||
|
|
@ -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"))
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
Loading…
Reference in New Issue