diff --git a/lisp/org-colview.el b/lisp/org-colview.el index a7eb0d8ee..9e95afeb3 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 951586c0a..58c8f3884 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 95f9a5e43..5a5018179 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