From fedd6be97ae03c9cdd0bf67c2691100cec86ad70 Mon Sep 17 00:00:00 2001 From: Nicolas Goaziou Date: Sun, 21 Feb 2016 00:16:51 +0100 Subject: [PATCH] org-colview: Introduce custom summary types * lisp/org-colview.el (org-columns-summary-types): New variable. (org-columns-compile-map): Rename into... (org-columns-summary-types-default): ... this. (org-columns-new): (org-columns-compile-format): Use new variables. * testing/lisp/test-org-colview.el (test-org-colview/columns-summary): Add test. * doc/org.texi (Column attributes): Document new variable. Improve description of time and age based summary types. --- doc/org.texi | 28 +++++++----- etc/ORG-NEWS | 3 ++ lisp/org-colview.el | 77 +++++++++++++++++++++++--------- testing/lisp/test-org-colview.el | 18 ++++++++ 4 files changed, 94 insertions(+), 32 deletions(-) diff --git a/doc/org.texi b/doc/org.texi index 1365b06fa..4515efe0b 100644 --- a/doc/org.texi +++ b/doc/org.texi @@ -5626,22 +5626,26 @@ optional. The individual parts have the following meaning: @{+@} @r{Sum numbers in this column.} @{+;%.1f@} @r{Like @samp{+}, but format result with @samp{%.1f}.} @{$@} @r{Currency, short for @samp{+;%.2f}.} - @{:@} @r{Sum times, HH:MM, plain numbers are hours.} - @{X@} @r{Checkbox status, @samp{[X]} if all children are @samp{[X]}.} - @{X/@} @r{Checkbox status, @samp{[n/m]}.} - @{X%@} @r{Checkbox status, @samp{[n%]}.} @{min@} @r{Smallest number in column.} @{max@} @r{Largest number.} @{mean@} @r{Arithmetic mean of numbers.} + @{X@} @r{Checkbox status, @samp{[X]} if all children are @samp{[X]}.} + @{X/@} @r{Checkbox status, @samp{[n/m]}.} + @{X%@} @r{Checkbox status, @samp{[n%]}.} + @{:@} @r{Sum times, HH:MM, plain numbers are + hours@footnote{A time can also be a duration, using effort + modifiers defined in @code{org-effort-durations}, e.g., + @samp{3d 1h}. If any value in the column is as such, the + summary will also be an effort duration.}.} @{:min@} @r{Smallest time value in column.} @{:max@} @r{Largest time value.} @{:mean@} @r{Arithmetic mean of time values.} - @{@@min@} @r{Minimum age (in - days/hours/mins/seconds@footnote{Days, hours, minutes and - seconds are represented with, respectively, @samp{d}, - @samp{h}, @samp{m} and @samp{s} suffixes, e.g., @samp{13h - 10s}. Alternatively, an age can be defined as a duration - since a given time-stamp (@pxref{Timestamps}).}).} + @{@@min@} @r{Minimum age@footnote{An age is defined as + a duration since a given time-stamp (@pxref{Timestamps}). It + can also be expressed as days, hours, minutes and seconds, + identified by @samp{d}, @samp{h}, @samp{m} and @samp{s} + suffixes, all mandatory, e.g., @samp{0d 13h 0m 10s}.} (in + days/hours/mins/seconds).} @{@@max@} @r{Maximum age (in days/hours/mins/seconds).} @{@@mean@} @r{Arithmetic mean of ages (in days/hours/mins/seconds).} @{est+@} @r{Add @samp{low-high} estimates.} @@ -5672,6 +5676,10 @@ full job more realistically, at 10--15 days. Numbers are right-aligned when a format specifier with an explicit width like @code{%5d} or @code{%5.1f} is used. +@vindex org-columns-summary-types +You can also define custom summary types by setting +@code{org-columns-summary-types}, which see. + Here is an example for a complete columns definition, along with allowed values. diff --git a/etc/ORG-NEWS b/etc/ORG-NEWS index 4da002fda..f259b065a 100644 --- a/etc/ORG-NEWS +++ b/etc/ORG-NEWS @@ -214,6 +214,9 @@ When called with a prefix argument, ~org-columns~ apply to the whole buffer unconditionally. **** New variable : ~org-agenda-view-columns-initially~ The variable used to be a ~defvar~, it is now a ~defcustom~. +**** Allow custom summaries +It is now possible to add new summary types, or override those +provided by Org by customizing ~org-columns-summary-types~, which see. *** Preview LaTeX snippets in buffers not visiting files *** New option ~org-attach-commit~ When non-nil, commit attachments with git, assuming the document is in diff --git a/lisp/org-colview.el b/lisp/org-colview.el index 81d05a6d6..999d8ed72 100644 --- a/lisp/org-colview.el +++ b/lisp/org-colview.el @@ -62,6 +62,32 @@ or nil if the normal value should be used." :group 'org-properties :type '(choice (const nil) (function))) +(defcustom org-columns-summary-types nil + "Alist between operators and summarize functions. + +Each association follows the pattern (LABEL . SUMMARIZE) where + + LABEL is a string used in #+COLUMNS definition describing the + summary type. It can contain any character but \"}\". It is + case-sensitive. + + SUMMARIZE is a function called with two arguments. The first + argument is a non-empty list of values, as non-empty strings. + The second one is a format string or nil. It has to return + a string summarizing the list of values. + +Note that the return value can become one value for an higher +order summary, so the function is expected to handle its own +output. + +Types defined in this variable take precedence over those defined +in `org-columns-summary-types-default', which see." + :group 'org-properties + :version "25.1" + :package-version '(Org . "9.0") + :type '(alist :key-type (string :tag " Label") + :value-type (function :tag "Summarize"))) + ;;; Column View @@ -87,7 +113,7 @@ This is the compiled version of the format.") (defvar org-columns-map (make-sparse-keymap) "The keymap valid in column display.") -(defconst org-columns-compile-map +(defconst org-columns-summary-types-default '(("+" . org-columns--summary-sum) ("$" . org-columns--summary-currencies) ("X" . org-columns--summary-checkbox) @@ -105,13 +131,7 @@ This is the compiled version of the format.") ("@min" . org-columns--summary-min-age) ("est+" . org-columns--summary-estimate)) "Map operators to summarize functions. -Used to compile/uncompile columns format and completing read in -interactive function `org-columns-new'. - -operator string used in #+COLUMNS definition describing the - summary type -function called with a list of values as argument to calculate - the summary value") +See `org-columns-summary-types' for details.") (defun org-columns-content () "Switch to contents view while in columns view." @@ -803,12 +823,17 @@ When COLUMNS-FMT-STRING is non-nil, use it as the column format." (org-string-nw-p (completing-read "Summary: " - (mapcar (lambda (x) (list (car x))) org-columns-compile-map) + (delete-dups + (mapcar (lambda (x) (list (car x))) + (append org-columns-summary-types + org-columns-summary-types-default))) nil t)))) - (summarize (or summarize - (cdr (assoc operator org-columns-compile-map)))) - (edit (and prop - (assoc-string prop org-columns-current-fmt-compiled t)))) + (summarize + (or summarize + (cdr (or (assoc operator org-columns-summary-types) + (assoc operator org-columns-summary-types-default))))) + (edit + (and prop (assoc-string prop org-columns-current-fmt-compiled t)))) (if edit (progn (setcar edit prop) @@ -996,15 +1021,23 @@ This function updates `org-columns-current-fmt-compiled'." (let* ((width (and (match-end 1) (string-to-number (match-string 1 fmt)))) (prop (match-string 2 fmt)) (title (or (match-string 3 fmt) prop)) - (op (match-string 4 fmt)) - (printf nil) - (fun '+)) - (when (and op (string-match ";" op)) - (setq printf (substring op (match-end 0))) - (setq op (substring op 0 (match-beginning 0)))) - (let ((op-match (assoc op org-columns-compile-map))) - (when op-match (setq fun (cdr op-match)))) - (push (list prop title width op printf fun) + (operator (match-string 4 fmt))) + (push (if (not operator) (list prop title width nil nil nil) + (let (printf) + (when (string-match ";" operator) + (setq printf (substring operator (match-end 0))) + (setq operator (substring operator 0 (match-beginning 0)))) + (let* ((summary-type + (or (assoc operator org-columns-summary-types) + (assoc operator org-columns-summary-types-default))) + (summarize + (cond + ((not summary-type) + (user-error "Unknown summary operator: %S" operator)) + ((cdr summary-type)) + (t (user-error "Missing summary function for type: %S" + operator))))) + (list prop title width operator printf summarize)))) org-columns-current-fmt-compiled))) (setq org-columns-current-fmt-compiled (nreverse org-columns-current-fmt-compiled)))) diff --git a/testing/lisp/test-org-colview.el b/testing/lisp/test-org-colview.el index 9dfa3526c..e00d6b950 100644 --- a/testing/lisp/test-org-colview.el +++ b/testing/lisp/test-org-colview.el @@ -503,6 +503,24 @@ :END: " (let ((org-columns-default-format "%A{est+}")) (org-columns)) + (get-char-property (point) 'org-columns-value-modified)))) + ;; Test custom summary types. + (should + (equal + "1|2" + (org-test-with-temp-text + "* H +** S1 +:PROPERTIES: +:A: 1 +:END: +** S1 +:PROPERTIES: +:A: 2 +:END:" + (let ((org-columns-summary-types + '(("custom" . (lambda (s _) (mapconcat #'identity s "|"))))) + (org-columns-default-format "%A{custom}")) (org-columns)) (get-char-property (point) 'org-columns-value-modified))))) (ert-deftest test-org-colview/columns-update ()