org-colview: Remove unused "calc" operator

* lisp/org-colview.el (org-columns--displayed-value):
(org-columns-compile-map):
(org-columns-compute):
(org-columns-compile-format):
(org-agenda-colview-summarize): Remove "calc" operator.
This commit is contained in:
Nicolas Goaziou 2016-02-17 15:36:31 +01:00
parent 923f512ee4
commit 2c974fc8c8
1 changed files with 28 additions and 50 deletions

View File

@ -172,7 +172,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 ,_ ,calc) (`(,_ ,_ ,_ ,_ ,fmt ,printf ,_)
(cond (cond
((and (functionp org-columns-modify-value-for-display-function) ((and (functionp org-columns-modify-value-for-display-function)
(funcall (funcall
@ -186,11 +186,6 @@ 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 fmt) fmt printf))
((and (functionp calc)
(not (string= value ""))
(not (get-text-property 0 'org-computed value)))
(org-columns-number-to-string
(funcall calc (org-columns-string-to-number value fmt)) fmt))
(value))))) (value)))))
(defun org-columns--collect-values (&optional agenda) (defun org-columns--collect-values (&optional agenda)
@ -773,7 +768,7 @@ When COLUMNS-FMT-STRING is non-nil, use it as the column format."
("@max" max_age max) ("@max" max_age max)
("@mean" mean_age (lambda (&rest x) (/ (apply '+ x) (float (length x))))) ("@mean" mean_age (lambda (&rest x) (/ (apply '+ x) (float (length x)))))
("est+" estimate org-estimate-combine)) ("est+" estimate org-estimate-combine))
"Operator <-> format,function,calc map. "Operator <-> format,function map.
Used to compile/uncompile columns format and completing read in Used to compile/uncompile columns format and completing read in
interactive function `org-columns-new'. interactive function `org-columns-new'.
@ -784,9 +779,7 @@ format symbol describing summary type selected interactively in
`org-columns-number-to-string' and `org-columns-number-to-string' and
`org-columns-string-to-number' `org-columns-string-to-number'
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")
calc function called on every element before summarizing. This is
optional and should only be specified if needed")
(defun org-columns-new (&optional prop title width _op fmt fun &rest _rest) (defun org-columns-new (&optional prop title width _op fmt fun &rest _rest)
"Insert a new column, to the left of the current column." "Insert a new column, to the left of the current column."
@ -958,7 +951,6 @@ display, or in the #+COLUMNS line of the current buffer."
(format (nth 4 ass)) (format (nth 4 ass))
(printf (nth 5 ass)) (printf (nth 5 ass))
(fun (nth 6 ass)) (fun (nth 6 ass))
(calc (or (nth 7 ass) 'identity))
(beg org-columns-top-level-marker) (beg org-columns-top-level-marker)
(inminlevel org-inlinetask-min-level) (inminlevel org-inlinetask-min-level)
(last-level org-inlinetask-min-level) (last-level org-inlinetask-min-level)
@ -1004,10 +996,7 @@ display, or in the #+COLUMNS line of the current buffer."
(org-entry-put nil property (if flag str val))) (org-entry-put nil property (if flag str val)))
;; add current to current level accumulator ;; add current to current level accumulator
(when (or flag valflag) (when (or flag valflag)
(push (if flag (push (if flag sum (org-columns-string-to-number val format))
sum
(funcall calc (org-columns-string-to-number
(if flag str val) format)))
(aref lvals level)) (aref lvals level))
(aset lflag level t)) (aset lflag level t))
;; clear accumulators for deeper levels ;; clear accumulators for deeper levels
@ -1017,8 +1006,7 @@ display, or in the #+COLUMNS line of the current buffer."
((>= level last-level) ((>= level last-level)
;; add what we have here to the accumulator for this level ;; add what we have here to the accumulator for this level
(when valflag (when valflag
(push (funcall calc (org-columns-string-to-number val format)) (push (org-columns-string-to-number val format) (aref lvals level))
(aref lvals level))
(aset lflag level t))) (aset lflag level t)))
(t (error "This should not happen"))))))) (t (error "This should not happen")))))))
@ -1133,33 +1121,31 @@ operator the operator if any
format the output format for computed results, derived from operator format the output format for computed results, derived from operator
printf a printf format for computed values printf a printf format for computed values
fun the lisp function to compute summary values, derived from operator fun the lisp function to compute summary values, derived from operator
calc function to get values from base elements
This function updates `org-columns-current-fmt-compiled'." This function updates `org-columns-current-fmt-compiled'."
(let ((start 0) width prop title op op-match f printf fun calc) (setq org-columns-current-fmt-compiled nil)
(setq org-columns-current-fmt-compiled nil) (let ((start 0))
(while (string-match (while (string-match
(org-re "%\\([0-9]+\\)?\\([[:alnum:]_-]+\\)\\(?:(\\([^)]+\\))\\)?\\(?:{\\([^}]+\\)}\\)?\\s-*") "%\\([0-9]+\\)?\\([[:alnum:]_-]+\\)\\(?:(\\([^)]+\\))\\)?\
\\(?:{\\([^}]+\\)}\\)?\\s-*"
fmt start) fmt start)
(setq start (match-end 0) (setq start (match-end 0))
width (match-string 1 fmt) (let* ((width (and (match-end 1) (string-to-number (match-string 1 fmt))))
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 (f nil)
printf nil (printf nil)
fun '+ (fun '+))
calc nil) (when (and op (string-match ";" op))
(if width (setq width (string-to-number width))) (setq printf (substring op (match-end 0)))
(when (and op (string-match ";" op)) (setq op (substring op 0 (match-beginning 0))))
(setq printf (substring op (match-end 0)) (let ((op-match (assoc op org-columns-compile-map)))
op (substring op 0 (match-beginning 0)))) (when op-match
(when (setq op-match (assoc op org-columns-compile-map)) (setq f (nth 1 op-match))
(setq f (cadr op-match) (setq fun (nth 2 op-match))))
fun (caddr op-match) (push (list prop title width op f printf fun)
calc (cadddr op-match))) org-columns-current-fmt-compiled)))
(push (list prop title width op f printf fun calc)
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))))
@ -1450,20 +1436,14 @@ This will add overlays to the date lines, to show the summary for each day."
(list prop date date))) (list prop date date)))
(`(,prop ,_ ,_ ,_ nil . ,_) (`(,prop ,_ ,_ ,_ nil . ,_)
(list prop "" "")) (list prop "" ""))
(`(,prop ,_ ,_ ,_ ,stype ,_ ,sumfunc ,calc) (`(,prop ,_ ,_ ,_ ,stype ,_ ,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
(let ((n (org-columns-string-to-number v stype))) (push (org-columns-string-to-number v stype) lsum))))
(push
(if (or (get-text-property 0 'org-computed v)
(not calc))
n
(funcall calc n))
lsum)))))
(setq lsum (setq lsum
(let ((l (length lsum))) (let ((l (length lsum)))
(cond ((> l 1) (cond ((> l 1)
@ -1473,8 +1453,6 @@ This will add overlays to the date lines, to show the summary for each day."
(org-columns-number-to-string (org-columns-number-to-string
(car lsum) stype)) (car lsum) stype))
(t "")))) (t ""))))
(unless (memq calc '(identity nil))
(put-text-property 0 (length lsum) 'org-computed t lsum))
(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)))))
fmt) fmt)