diff --git a/lisp/org-colview.el b/lisp/org-colview.el index 9c9d8ddaf..b68ea2a67 100644 --- a/lisp/org-colview.el +++ b/lisp/org-colview.el @@ -46,6 +46,7 @@ (defvar org-agenda-view-columns-initially) (defvar org-inlinetask-min-level) + ;;; Configuration (defcustom org-columns-modify-value-for-display-function nil @@ -61,6 +62,8 @@ or nil if the normal value should be used." :group 'org-properties :type '(choice (const nil) (function))) + + ;;; Column View (defvar org-columns-overlays nil @@ -88,6 +91,33 @@ 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 + '(("none" . +) + (":" . +) + ("+" . +) + ("$" . +) + ("X" . +) + ("X/" . +) + ("X%" . +) + ("max" . max) + ("min" . min) + ("mean" . (lambda (&rest x) (/ (apply '+ x) (float (length x))))) + (":max" . max) + (":min" . min) + (":mean" . (lambda (&rest x) (/ (apply '+ x) (float (length x))))) + ("@min" . min) + ("@max" . max) + ("@mean" . (lambda (&rest x) (/ (apply '+ x) (float (length x))))) + ("est+" . org-columns--estimate-combine)) + "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") + (defun org-columns-content () "Switch to contents view while in columns view." (interactive) @@ -761,33 +791,6 @@ When COLUMNS-FMT-STRING is non-nil, use it as the column format." (goto-char (car entry)) (org-columns--display-here (cdr entry))))))))) -(defconst org-columns-compile-map - '(("none" . +) - (":" . +) - ("+" . +) - ("$" . +) - ("X" . +) - ("X/" . +) - ("X%" . +) - ("max" . max) - ("min" . min) - ("mean" . (lambda (&rest x) (/ (apply '+ x) (float (length x))))) - (":max" . max) - (":min" . min) - (":mean" . (lambda (&rest x) (/ (apply '+ x) (float (length x))))) - ("@min" . min) - ("@max" . max) - ("@mean" . (lambda (&rest x) (/ (apply '+ x) (float (length x))))) - ("est+" . org-columns--estimate-combine)) - "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") - (defun org-columns-new (&optional prop title width operator _f _p summarize) "Insert a new column, to the left of the current column." (interactive) @@ -915,16 +918,6 @@ display, or in the #+COLUMNS line of the current buffer." (insert-before-markers "#+COLUMNS: " fmt "\n"))) (setq-local org-columns-default-format fmt)))))) -(defun org-columns-compute-all () - "Compute all columns that have operators defined." - (org-with-silent-modifications - (remove-text-properties (point-min) (point-max) '(org-summaries t))) - (let ((org-columns--time (float-time (current-time)))) - (dolist (spec org-columns-current-fmt-compiled) - (pcase spec - (`(,property ,_ ,_ ,operator . ,_) - (when operator (save-excursion (org-columns-compute property)))))))) - (defun org-columns-update (property) "Recompute PROPERTY, and update the columns display for it." (org-columns-compute property) @@ -953,6 +946,80 @@ display, or in the #+COLUMNS line of the current buffer." (org-columns--overlay-text displayed format width property value)))))))))) +(defun org-columns-redo () + "Construct the column display again." + (interactive) + (message "Recomputing columns...") + (let ((line (org-current-line)) + (col (current-column))) + (save-excursion + (if (marker-position org-columns-begin-marker) + (goto-char org-columns-begin-marker)) + (org-columns-remove-overlays) + (if (derived-mode-p 'org-mode) + (call-interactively 'org-columns) + (org-agenda-redo) + (call-interactively 'org-agenda-columns))) + (org-goto-line line) + (move-to-column col)) + (message "Recomputing columns...done")) + +(defun org-columns-uncompile-format (compiled) + "Turn the compiled columns format back into a string representation. +COMPILED is an alist, as returned by +`org-columns-compile-format', which see." + (mapconcat + (lambda (spec) + (pcase spec + (`(,prop ,title ,width ,op ,printf ,_) + (concat "%" + (and width (number-to-string width)) + prop + (and title (not (equal prop title)) (format "(%s)" title)) + (cond ((not op) nil) + (printf (format "{%s;%s}" op printf)) + (t (format "{%s}" op))))))) + compiled " ")) + +(defun org-columns-compile-format (fmt) + "Turn a column format string FMT into an alist of specifications. + +The alist has one entry for each column in the format. The elements of +that list are: +property the property name +title the title field for the columns +width the column width in characters, can be nil for automatic +operator the summary operator if any +printf a printf format for computed values +fun the lisp function to compute summary values, derived from operator + +This function updates `org-columns-current-fmt-compiled'." + (setq org-columns-current-fmt-compiled nil) + (let ((start 0)) + (while (string-match + "%\\([0-9]+\\)?\\([[:alnum:]_-]+\\)\\(?:(\\([^)]+\\))\\)?\ +\\(?:{\\([^}]+\\)}\\)?\\s-*" + fmt start) + (setq start (match-end 0)) + (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) + org-columns-current-fmt-compiled))) + (setq org-columns-current-fmt-compiled + (nreverse org-columns-current-fmt-compiled)))) + + +;;;; Column View Summary + ;;;###autoload (defun org-columns-compute (property) "Summarize the values of property PROPERTY hierarchically." @@ -1022,23 +1089,31 @@ display, or in the #+COLUMNS line of the current buffer." (aref lvals level))) (t nil))))))) -(defun org-columns-redo () - "Construct the column display again." - (interactive) - (message "Recomputing columns...") - (let ((line (org-current-line)) - (col (current-column))) - (save-excursion - (if (marker-position org-columns-begin-marker) - (goto-char org-columns-begin-marker)) - (org-columns-remove-overlays) - (if (derived-mode-p 'org-mode) - (call-interactively 'org-columns) - (org-agenda-redo) - (call-interactively 'org-agenda-columns))) - (org-goto-line line) - (move-to-column col)) - (message "Recomputing columns...done")) +(defun org-columns-compute-all () + "Compute all columns that have operators defined." + (org-with-silent-modifications + (remove-text-properties (point-min) (point-max) '(org-summaries t))) + (let ((org-columns--time (float-time (current-time)))) + (dolist (spec org-columns-current-fmt-compiled) + (pcase spec + (`(,property ,_ ,_ ,operator . ,_) + (when operator (save-excursion (org-columns-compute property)))))))) + +(defun org-columns--estimate-combine (&rest estimates) + "Combine a list of estimates, using mean and variance. +The mean and variance of the result will be the sum of the means +and variances (respectively) of the individual estimates." + (let ((mean 0) + (var 0)) + (dolist (e estimates) + (pcase e + (`(,low ,high) + (let ((m (/ (+ low high) 2.0))) + (cl-incf mean m) + (cl-incf var (- (/ (+ (* low low) (* high high)) 2.0) (* m m))))) + (value (cl-incf mean value)))) + (let ((sd (sqrt var))) + (list (- mean sd) (+ mean sd))))) ;;;###autoload (defun org-columns-number-to-string (n operator &optional printf) @@ -1068,22 +1143,6 @@ PRINTF, when non-nil, is a format string used to print N." (format-seconds "%dd %.2hh %mm %ss" n)) (t (number-to-string n)))) -(defun org-columns--estimate-combine (&rest estimates) - "Combine a list of estimates, using mean and variance. -The mean and variance of the result will be the sum of the means -and variances (respectively) of the individual estimates." - (let ((mean 0) - (var 0)) - (dolist (e estimates) - (pcase e - (`(,low ,high) - (let ((m (/ (+ low high) 2.0))) - (cl-incf mean m) - (cl-incf var (- (/ (+ (* low low) (* high high)) 2.0) (* m m))))) - (value (cl-incf mean value)))) - (let ((sd (sqrt var))) - (list (- mean sd) (+ mean sd))))) - (defun org-columns-string-to-number (s operator) "Convert a column value S to a number. OPERATOR is a string describing the summary type." @@ -1120,59 +1179,6 @@ OPERATOR is a string describing the summary type." (setq sum (+ (string-to-number n) (/ sum 60)))))) (t (string-to-number s)))) -(defun org-columns-uncompile-format (compiled) - "Turn the compiled columns format back into a string representation. -COMPILED is an alist, as returned by -`org-columns-compile-format', which see." - (mapconcat - (lambda (spec) - (pcase spec - (`(,prop ,title ,width ,op ,printf ,_) - (concat "%" - (and width (number-to-string width)) - prop - (and title (not (equal prop title)) (format "(%s)" title)) - (cond ((not op) nil) - (printf (format "{%s;%s}" op printf)) - (t (format "{%s}" op))))))) - compiled " ")) - -(defun org-columns-compile-format (fmt) - "Turn a column format string FMT into an alist of specifications. - -The alist has one entry for each column in the format. The elements of -that list are: -property the property name -title the title field for the columns -width the column width in characters, can be nil for automatic -operator the summary operator if any -printf a printf format for computed values -fun the lisp function to compute summary values, derived from operator - -This function updates `org-columns-current-fmt-compiled'." - (setq org-columns-current-fmt-compiled nil) - (let ((start 0)) - (while (string-match - "%\\([0-9]+\\)?\\([[:alnum:]_-]+\\)\\(?:(\\([^)]+\\))\\)?\ -\\(?:{\\([^}]+\\)}\\)?\\s-*" - fmt start) - (setq start (match-end 0)) - (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) - org-columns-current-fmt-compiled))) - (setq org-columns-current-fmt-compiled - (nreverse org-columns-current-fmt-compiled)))) - ;;; Dynamic block for Column view