summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorNicolas Goaziou <mail@nicolasgoaziou.fr>2016-02-20 15:36:23 +0100
committerNicolas Goaziou <mail@nicolasgoaziou.fr>2016-02-21 00:44:17 +0100
commit5c0a92799053a5093004e589b90cf4004b9cbac0 (patch)
treeb65fc8f557636b8673bd4adf44ae7c45f05136ea
parent58777b82002138464792b58e45f4b28a28edbaeb (diff)
downloadorg-mode-5c0a92799053a5093004e589b90cf4004b9cbac0.tar.gz
org-colview: Move summary functions in a dedicated section
-rw-r--r--lisp/org-colview.el252
1 files changed, 129 insertions, 123 deletions
diff --git a/lisp/org-colview.el b/lisp/org-colview.el
index 9c9d8dd..b68ea2a 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