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

@@ -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
+                @{@@min@}    @r{Minimum age@footnote{An age is defined as
-                days/hours/mins/seconds@footnote{Days, hours, minutes and
+                a duration since a given time-stamp (@pxref{Timestamps}).  It
-                seconds are represented with, respectively, @samp{d},
+                can  also be expressed as days, hours, minutes and seconds,
-                @samp{h}, @samp{m} and @samp{s} suffixes, e.g., @samp{13h
+                identified by @samp{d}, @samp{h}, @samp{m} and @samp{s}
-                10s}.  Alternatively, an age can be defined as a duration
+                suffixes, all mandatory, e.g., @samp{0d 13h 0m 10s}.} (in
-                since a given time-stamp (@pxref{Timestamps}).}).}
+                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.
 

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

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
+See `org-columns-summary-types' for details.")
-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")
 
 (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
+	 (summarize
-			(cdr (assoc operator org-columns-compile-map))))
+	  (or summarize
-	 (edit (and prop
+	      (cdr (or (assoc operator org-columns-summary-types)
-		    (assoc-string prop org-columns-current-fmt-compiled t))))
+		       (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))
+	     (operator (match-string 4 fmt)))
-	     (printf nil)
+	(push (if (not operator) (list prop title width nil nil nil)
-	     (fun '+))
+		(let (printf)
-	(when (and op (string-match ";" op))
+		  (when (string-match ";" operator)
-	  (setq printf (substring op (match-end 0)))
+		    (setq printf (substring operator (match-end 0)))
-	  (setq op (substring op 0 (match-beginning 0))))
+		    (setq operator (substring operator 0 (match-beginning 0))))
-	(let ((op-match (assoc op org-columns-compile-map)))
+		  (let* ((summary-type
-	  (when op-match (setq fun (cdr op-match))))
+			  (or (assoc operator org-columns-summary-types)
-	(push (list prop title width op printf fun)
+			      (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))))

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 ()