forked from mirrors/org-mode
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.
This commit is contained in:
Nicolas Goaziou
parent
ca1fb80dad
commit
62ec8c0a48
|
|
@ -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."
|
||||
|
|
|
|||
|
|
@ -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))))))
|
||||
|
||||
|
||||
|
||||
|
|
|
|||
Loading…
Reference in New Issue