[PATCH] org-columns-summary-types entries can take COLLECT function

[Stig Brautaset <stig@brautaset.org>]

[-- Attachment #1: Type: text/plain, Size: 511 bytes --]

Hello!

I've taken a stab at adding support for allowing
org-columns-summary-types entries to contain an optional COLLECT
function that can be used to conditionally collect a property.

Please see the included patch. I added a NEWS entry, but wasn't sure
whether a manual entry is required.

I added a couple simple tests, which pass, but the test immediately
above the two I added fails when this patch is applied; I haven't been
able to figure out why. Any help appreciated.

Comments / feedback welcome :-)


[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #2: Add COLLECT function support to org-columns-summary-types --]
[-- Type: text/x-patch, Size: 7168 bytes --]

From 749c90afad4908cda5a4d2d6c93f2049860e2c4d Mon Sep 17 00:00:00 2001
From: Stig Brautaset <stig@brautaset.org>
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)


[-- Attachment #3: Type: text/plain, Size: 52 bytes --]


Stig

--
; GNU Emacs 26.0.50, Org mode version 9.1