[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
[O] [PATCH] org-columns-summary-types entries can take COLLECT function
From: |
Stig Brautaset |
Subject: |
[O] [PATCH] org-columns-summary-types entries can take COLLECT function |
Date: |
Fri, 08 Sep 2017 20:26:56 +0100 |
User-agent: |
mu4e 0.9.19; emacs 26.0.50 |
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 :-)
>From 749c90afad4908cda5a4d2d6c93f2049860e2c4d Mon Sep 17 00:00:00 2001
From: Stig Brautaset <address@hidden>
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)
Stig
--
; GNU Emacs 26.0.50, Org mode version 9.1
- [O] [PATCH] org-columns-summary-types entries can take COLLECT function,
Stig Brautaset <=