From 749c90afad4908cda5a4d2d6c93f2049860e2c4d Mon Sep 17 00:00:00 2001 From: Stig Brautaset Date: Thu, 7 Sep 2017 17:57:44 +0100 Subject: [PATCH] org-colview: Allow custom COLLECT functions for derived properties In addition to (LABEL . SUMMARIZE), org-columns-summary-types now accepts (LABEL SUMMARIZE COLLECT) entries. The new COLLECT function is called with one argument, the property being summarized. --- etc/ORG-NEWS | 47 +++++++++++++++++++++++++++++++++++++ lisp/org-colview.el | 32 +++++++++++++++++++++---- testing/lisp/test-org-colview.el | 50 ++++++++++++++++++++++++++++++++++++++++ 3 files changed, 125 insertions(+), 4 deletions(-) diff --git a/etc/ORG-NEWS b/etc/ORG-NEWS index e6ad838a6..b555cf971 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..5ab5bf939 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,12 @@ 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. @@ -299,13 +306,29 @@ integers greater than 0." (push ov org-columns-overlays) ov)) -(defun org-columns--summarize (operator) - "Return summary function associated to string OPERATOR." +(defun org-columns--summary-type (operator) + "Return summary type function(s) 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))))) +(defun org-columns--summarize (operator) + "Return summary function associated to string OPERATOR." + (let ((type (org-columns--summary-type operator))) + (if (functionp type) + type + ;; got summary AND collect functions + (car type)))) + +(defun org-columns--collect (operator) + "Return collect function associated to string OPERATOR." + (let ((type (org-columns--summary-type operator))) + (if (and (listp type) + (< 1 (length type))) + (cadr type) + (lambda (p) (org-entry-get (point) p))))) + (defun org-columns--overlay-text (value fmt width property original) "Return text " (format fmt @@ -1110,6 +1133,7 @@ properties drawers." (last-level lmax) (property (car spec)) (printf (nth 4 spec)) + (collect (org-columns--collect (nth 3 spec))) (summarize (org-columns--summarize (nth 3 spec)))) (org-with-wide-buffer ;; Find the region to compute. @@ -1122,7 +1146,7 @@ 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 (funcall collect 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..dcc84ef9c 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 + "5" + (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 -- 2.11.0 (Apple Git-81)