summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorNicolas Goaziou <mail@nicolasgoaziou.fr>2016-02-20 15:13:03 +0100
committerNicolas Goaziou <mail@nicolasgoaziou.fr>2016-02-21 00:44:17 +0100
commitd59d96efaa7b2586092d7be445f7fc8af6806e18 (patch)
tree034a3d30bd578bc25c14aef577bc73b261c01824
parent73d5733d0107f62388ac8deee1fb54fbf485703c (diff)
downloadorg-mode-d59d96efaa7b2586092d7be445f7fc8af6806e18.tar.gz
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.
-rw-r--r--lisp/org-colview.el208
-rw-r--r--lisp/org.el6
-rw-r--r--testing/lisp/test-org-colview.el6
3 files changed, 105 insertions, 115 deletions
diff --git a/lisp/org-colview.el b/lisp/org-colview.el
index a7eb0d8..9e95afe 100644
--- a/lisp/org-colview.el
+++ b/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)
diff --git a/lisp/org.el b/lisp/org.el
index 951586c..58c8f38 100644
--- a/lisp/org.el
+++ b/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"))
diff --git a/testing/lisp/test-org-colview.el b/testing/lisp/test-org-colview.el
index 95f9a5e..5a50181 100644
--- a/testing/lisp/test-org-colview.el
+++ b/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