summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorNicolas Goaziou <mail@nicolasgoaziou.fr>2016-02-18 11:33:33 +0100
committerNicolas Goaziou <mail@nicolasgoaziou.fr>2016-02-18 11:40:17 +0100
commit62ec8c0a48fb8eac664ef24c95538544afc13e0d (patch)
treef958fdbcc6f86c53ca770af41e19a698b6436dba
parentca1fb80dad17c6b5435c746c722bf796f39e23cc (diff)
downloadorg-mode-62ec8c0a48fb8eac664ef24c95538544afc13e0d.tar.gz
org-colview: Fix `org-columns-compute' with inlinetasks
* lisp/org-colview.el (org-columns-compute): Properly summarize values obtained through inline tasks. * testing/lisp/test-org-colview.el (test-org-colview/columns-update): Add test. Previously, the summary of values from inline tasks was added to to the summary of values from children.
-rw-r--r--lisp/org-colview.el133
-rw-r--r--testing/lisp/test-org-colview.el25
2 files changed, 87 insertions, 71 deletions
diff --git a/lisp/org-colview.el b/lisp/org-colview.el
index 4356402..5319e5a 100644
--- a/lisp/org-colview.el
+++ b/lisp/org-colview.el
@@ -44,6 +44,7 @@
(defvar org-agenda-columns-compute-summary-properties)
(defvar org-agenda-columns-show-summaries)
(defvar org-agenda-view-columns-initially)
+(defvar org-inlinetask-min-level)
;;; Configuration
@@ -954,82 +955,74 @@ display, or in the #+COLUMNS line of the current buffer."
(org-columns--overlay-text
displayed format width property value))))))))))
-(defvar org-inlinetask-min-level
- (if (featurep 'org-inlinetask) org-inlinetask-min-level 15))
-
;;;###autoload
(defun org-columns-compute (property)
- "Sum the values of property PROPERTY hierarchically, for the entire buffer."
+ "Summarize the values of property PROPERTY hierarchically."
(interactive)
- (let* ((re org-outline-regexp-bol)
- (lmax 30) ; Does anyone use deeper levels???
+ (let* ((lmax (if (org-bound-and-true-p org-inlinetask-min-level)
+ (1+ org-inlinetask-min-level)
+ 30)) ;Hard-code deepest level.
(lvals (make-vector lmax nil))
- (lflag (make-vector lmax nil))
+ (spec (assoc-string property org-columns-current-fmt-compiled t))
+ (format (nth 4 spec))
+ (printf (nth 5 spec))
+ (fun (nth 6 spec))
(level 0)
- (ass (assoc-string property org-columns-current-fmt-compiled t))
- (format (nth 4 ass))
- (printf (nth 5 ass))
- (fun (nth 6 ass))
- (beg org-columns-top-level-marker)
(inminlevel org-inlinetask-min-level)
- (last-level org-inlinetask-min-level)
- val valflag flag end sumpos sum-alist sum str str1 useval)
- (save-excursion
- ;; Find the region to compute
- (goto-char beg)
- (setq end (condition-case nil (org-end-of-subtree t) (error (point-max))))
- (goto-char end)
- ;; Walk the tree from the back and do the computations
- (while (re-search-backward re beg t)
- (setq sumpos (match-beginning 0)
- last-level (if (not (or (zerop level) (eq level inminlevel)))
- level last-level)
- level (org-outline-level)
- val (org-entry-get nil property)
- valflag (org-string-nw-p val))
- (cond
- ((< level last-level)
- ;; Put the sum of lower levels here as a property. If
- ;; values are estimates, use an appropriate sum function.
- (setq sum (funcall (if (eq fun 'org-columns--estimate-combine)
- #'org-columns--estimate-combine
- #'+)
- (if (and (/= last-level inminlevel)
- (aref lvals last-level))
- (apply fun (aref lvals last-level))
- 0)
- (if (aref lvals inminlevel)
- (apply fun (aref lvals inminlevel))
- 0))
- flag (or (aref lflag last-level) ; any valid entries from children?
- (aref lflag inminlevel)) ; or inline tasks?
- str (org-columns-number-to-string sum format printf)
- str1 (org-add-props (copy-sequence str) nil 'org-computed t 'face 'bold)
- useval (if flag str1 (if valflag val ""))
- sum-alist (get-text-property sumpos 'org-summaries))
- (let ((old (assoc-string property sum-alist t)))
- (if old (setcdr old useval)
- (push (cons property useval) sum-alist)
- (org-with-silent-modifications
- (add-text-properties sumpos (1+ sumpos)
- (list 'org-summaries sum-alist)))))
- (when (and val (not (equal val (if flag str val))))
- (org-entry-put nil property (if flag str val)))
- ;; add current to current level accumulator
- (when (or flag valflag)
- (push (if flag sum (org-columns-string-to-number val format))
- (aref lvals level))
- (aset lflag level t))
- ;; clear accumulators for deeper levels
- (loop for l from (1+ level) to (1- lmax) do
- (aset lvals l nil)
- (aset lflag l nil)))
- ((>= level last-level)
- ;; add what we have here to the accumulator for this level
- (when valflag
- (push (org-columns-string-to-number val format) (aref lvals level))
- (aset lflag level t)))
- (t (error "This should not happen")))))))
+ (last-level org-inlinetask-min-level))
+ (org-with-wide-buffer
+ ;; Find the region to compute.
+ (goto-char org-columns-top-level-marker)
+ (goto-char (condition-case nil (org-end-of-subtree t) (error (point-max))))
+ ;; Walk the tree from the back and do the computations.
+ (while (re-search-backward
+ org-outline-regexp-bol org-columns-top-level-marker t)
+ (unless (or (= level 0) (eq level inminlevel))
+ (setq last-level level))
+ (setq level (org-reduced-level (org-outline-level)))
+ (let* ((pos (match-beginning 0))
+ (value (org-entry-get nil property))
+ (value-set (org-string-nw-p value)))
+ (cond
+ ((< level last-level)
+ ;; Collect values from lower levels and inline tasks here
+ ;; and summarize them using FUN. Store them as text
+ ;; property.
+ (let* ((summary
+ (let ((all (append (and (/= last-level inminlevel)
+ (aref lvals last-level))
+ (aref lvals inminlevel))))
+ (and all (apply fun all))))
+ (str (and summary (org-columns-number-to-string
+ summary format printf))))
+ (let* ((summaries-alist (get-text-property pos 'org-summaries))
+ (old (assoc-string property summaries-alist t))
+ (new (cond
+ (summary (propertize str 'org-computed t 'face 'bold))
+ (value-set value)
+ (t ""))))
+ (if old (setcdr old new)
+ (push (cons property new) summaries-alist)
+ (org-with-silent-modifications
+ (add-text-properties pos (1+ pos)
+ (list 'org-summaries summaries-alist)))))
+ ;; When PROPERTY is set in current node, but its value
+ ;; doesn't match the one computed, use the latter
+ ;; instead.
+ (when (and value str (not (equal value str)))
+ (org-entry-put nil property str))
+ ;; Add current to current level accumulator.
+ (when (or summary value-set)
+ (push (or summary (org-columns-string-to-number value format))
+ (aref lvals level)))
+ ;; Clear accumulators for deeper levels.
+ (cl-loop for l from (1+ level) to (1- lmax) do
+ (aset lvals l nil))))
+ (value-set
+ ;; Add what we have here to the accumulator for this level.
+ (push (org-columns-string-to-number value format)
+ (aref lvals level)))
+ (t nil)))))))
(defun org-columns-redo ()
"Construct the column display again."
diff --git a/testing/lisp/test-org-colview.el b/testing/lisp/test-org-colview.el
index 9fe8ebd..95f9a5e 100644
--- a/testing/lisp/test-org-colview.el
+++ b/testing/lisp/test-org-colview.el
@@ -535,7 +535,30 @@
(search-forward ":A: ")
(insert "very long ")
(org-columns-update "A")
- (get-char-property (point-min) 'display)))))
+ (get-char-property (point-min) 'display))))
+ ;; Values obtained from inline tasks are at the same level as those
+ ;; obtained from children of the current node.
+ (when (featurep 'org-inlinetask)
+ (should
+ (equal
+ "2"
+ (org-test-with-temp-text
+ "* H
+*************** Inline task
+:PROPERTIES:
+:A: 2
+:END:
+*************** END
+** Children
+:PROPERTIES:
+:A: 3
+:END:
+"
+ (let ((org-columns-default-format "%A{min}")
+ (org-columns-ellipses "..")
+ (org-inlinetask-min-level 15))
+ (org-columns))
+ (get-char-property (point-min) 'org-columns-value))))))