Browse Source

org-colview: Move summary functions in a dedicated section

Nicolas Goaziou 9 years ago
parent
commit
5c0a927990
1 changed files with 129 additions and 123 deletions
  1. 129 123
      lisp/org-colview.el

+ 129 - 123
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