diff --git a/etc/ORG-NEWS b/etc/ORG-NEWS index 59e6cb38b..d2a2a4eaf 100644 --- a/etc/ORG-NEWS +++ b/etc/ORG-NEWS @@ -54,6 +54,53 @@ its previous state. Editing the column automatically expands the whole column to its full size. +*** =org-columns-summary-types= entries can take an optional COLLECT function + +You can use this to make collection of a property from an entry +conditional on another entry. E.g. given this configuration: + +#+BEGIN_SRC emacs-lisp + (defun custom/org-collect-confirmed (property) + "Return `PROPERTY' for `CONFIRMED' entries" + (let ((prop (org-entry-get nil property)) + (confirmed (org-entry-get nil "CONFIRMED"))) + (if (and prop (string= "[X]" confirmed)) + prop + "0"))) + + (setq org-columns-summary-types + '(("X+" org-columns--summary-sum + custom/org-collect-confirmed))) +#+END_SRC + +You can have a file =bananas.org= containing: + +#+BEGIN_SRC org + ,#+columns: %ITEM %CONFIRMED %Bananas{+} %Bananas(Confirmed Bananas){X+} + + ,* All shipments + ,** Shipment 1 + :PROPERTIES: + :CONFIRMED: [X] + :Bananas: 4 + :END: + + ,** Shipment 2 + :PROPERTIES: + :CONFIRMED: [ ] + :BANANAS: 7 + :END: +#+END_SRC + +... and when going to the top of that file and entering column view +you should expect to see something like: + +| ITEM | CONFIRMED | Bananas | Confirmed Bananas | +|-----------------+-----------+---------+-------------------| +| All shipments | | 11 | 4 | +| Shipment 1 | [X] | 4 | 4 | +| Shipment 2 | [ ] | 7 | 7 | + #+BEGIN_EXAMPLE ,#+STARTUP: shrink #+END_EXAMPLE diff --git a/lisp/org-colview.el b/lisp/org-colview.el index 679cb5ab8..3a8ae07b1 100644 --- a/lisp/org-colview.el +++ b/lisp/org-colview.el @@ -67,7 +67,8 @@ or nil if the normal value should be used." (defcustom org-columns-summary-types nil "Alist between operators and summarize functions. -Each association follows the pattern (LABEL . SUMMARIZE) where +Each association follows the pattern (LABEL . SUMMARIZE), +or (LABEL SUMMARISE COLLECT) where LABEL is a string used in #+COLUMNS definition describing the summary type. It can contain any character but \"}\". It is @@ -78,6 +79,13 @@ Each association follows the pattern (LABEL . SUMMARIZE) where The second one is a format string or nil. It has to return a string summarizing the list of values. + COLLECT is a function called with one argument, a property + name. It is called in the context of a headline and must + return the collected property, or the empty string. You can + use this to only collect a property if a related conditional + properties is set, e.g., to return VACATION_DAYS only if + CONFIRMED is true. + Note that the return value can become one value for an higher order summary, so the function is expected to handle its own output. @@ -301,10 +309,22 @@ integers greater than 0." (defun org-columns--summarize (operator) "Return summary function associated to string OPERATOR." - (if (not operator) nil - (cdr (or (assoc operator org-columns-summary-types) - (assoc operator org-columns-summary-types-default) - (error "Unknown %S operator" operator))))) + (pcase (or (assoc operator org-columns-summary-types) + (assoc operator org-columns-summary-types-default)) + (`nil (error "Unknown %S operator" operator)) + (`(,_ . ,(and (pred functionp) summarize)) summarize) + (`(,_ ,summarize ,_) summarize) + (_ (error "Invalid definition for operator %S" operator)))) + +(defun org-columns--collect (operator) + "Return collect function associated to string OPERATOR. +Return nil if no collect function is associated to OPERATOR." + (pcase (or (assoc operator org-columns-summary-types) + (assoc operator org-columns-summary-types-default)) + (`nil (error "Unknown %S operator" operator)) + (`(,_ . ,(pred functionp)) nil) ;default value + (`(,_ ,_ ,collect) collect) + (_ (error "Invalid definition for operator %S" operator)))) (defun org-columns--overlay-text (value fmt width property original) "Return text " @@ -1110,7 +1130,9 @@ properties drawers." (last-level lmax) (property (car spec)) (printf (nth 4 spec)) - (summarize (org-columns--summarize (nth 3 spec)))) + (operator (nth 3 spec)) + (collect (and operator (org-columns--collect operator))) + (summarize (and operator (org-columns--summarize operator)))) (org-with-wide-buffer ;; Find the region to compute. (goto-char org-columns-top-level-marker) @@ -1122,7 +1144,8 @@ properties drawers." (setq last-level level)) (setq level (org-reduced-level (org-outline-level))) (let* ((pos (match-beginning 0)) - (value (org-entry-get nil property)) + (value (if collect (funcall collect property) + (org-entry-get (point) property))) (value-set (org-string-nw-p value))) (cond ((< level last-level) diff --git a/testing/lisp/test-org-colview.el b/testing/lisp/test-org-colview.el index a84201358..e6b02b9e1 100644 --- a/testing/lisp/test-org-colview.el +++ b/testing/lisp/test-org-colview.el @@ -683,6 +683,56 @@ '(("custom" . (lambda (s _) (mapconcat #'identity s "|"))))) (org-columns-default-format "%A{custom}")) (org-columns)) (get-char-property (point) 'org-columns-value-modified)))) + ;; Allow custom _collect_ for summary types. + (should + (equal + "2" + (org-test-with-temp-text + "* H +** S1 +:PROPERTIES: +:A: 1 +:END: +** S1 +:PROPERTIES: +:A: 2 +:A-OK: 1 +:END:" + (let ((org-columns-summary-types + '(("custom" org-columns--summary-sum + (lambda (p) + (if (equal "1" (org-entry-get nil (format "%s-OK" p))) + (org-entry-get nil p) + ""))))) + (org-columns-default-format "%A{custom}")) (org-columns)) + (get-char-property (point) 'org-columns-value-modified)))) + ;; Allow custom collect function to be used for different columns + (should + (equal + '("2" "1") + (org-test-with-temp-text + "* H +** S1 +:PROPERTIES: +:A: 1 +:B: 1 +:B-OK: 1 +:END: +** S1 +:PROPERTIES: +:A: 2 +:B: 2 +:A-OK: 1 +:END:" + (let ((org-columns-summary-types + '(("custom" org-columns--summary-sum + (lambda (p) + (if (equal "1" (org-entry-get nil (format "%s-OK" p))) + (org-entry-get nil p) + ""))))) + (org-columns-default-format "%A{custom} %B{custom}")) (org-columns)) + (list (get-char-property (point) 'org-columns-value-modified) + (get-char-property (1+ (point)) 'org-columns-value-modified))))) ;; Allow multiple summary types applied to the same property. (should (equal