From 62ec8c0a48fb8eac664ef24c95538544afc13e0d Mon Sep 17 00:00:00 2001 From: Nicolas Goaziou Date: Thu, 18 Feb 2016 11:33:33 +0100 Subject: [PATCH] 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. --- lisp/org-colview.el | 133 +++++++++++++++---------------- testing/lisp/test-org-colview.el | 25 +++++- 2 files changed, 87 insertions(+), 71 deletions(-) diff --git a/lisp/org-colview.el b/lisp/org-colview.el index 435640222..5319e5ab5 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 9fe8ebd49..95f9a5e43 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))))))