org-colview: Allow custom COLLECT functions for derived properties

* lisp/org-colview.el (org-columns-summary-types): Allow new format.
(org-columns--summarize): Update to new summary type format.
(org-columns--collect): New function.
(org-columns--compute-spec): Apply changes.

* testing/lisp/test-org-colview.el (test-org-colview/columns-summary):
  Add test.

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.

TINYCHANGE

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

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
+  (pcase (or (assoc operator org-columns-summary-types)
-    (cdr (or (assoc operator org-columns-summary-types)
+	     (assoc operator org-columns-summary-types-default))
-	     (assoc operator org-columns-summary-types-default)
+    (`nil (error "Unknown %S operator" operator))
-	     (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)

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