tec/org-mode
tec
/
org-mode
forked from mirrors/org-mode
1
0
Fork 0
Code Pull Requests Releases Activity

org-colview: Fix summary computation in agenda 

* lisp/org-colview.el (org-agenda-colview-summarize): Do not include
  already summarized values in current summary.
This commit is contained in:
Nicolas Goaziou 2017-01-17 12:00:49 +01:00
parent b223c099f0
commit d2af251077
1 changed files with 46 additions and 42 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

88
lisp/org-colview.el
View File

@ -1566,55 +1566,59 @@ This will add overlays to the date lines, to show the summary for each day."
(if (member property '("CLOCKSUM" "CLOCKSUM_T")) (if (member property '("CLOCKSUM" "CLOCKSUM_T"))
(list property title width ":" nil) (list property title width ":" nil)
spec)))) spec))))
org-columns-current-fmt-compiled)) org-columns-current-fmt-compiled)))
entries)
;; Ensure there's at least one summation column. ;; Ensure there's at least one summation column.
(when (cl-some (lambda (spec) (nth 3 spec)) fmt) (when (cl-some (lambda (spec) (nth 3 spec)) fmt)
(goto-char (point-max)) (goto-char (point-max))
(catch :complete (catch :complete
(while t (while t
(when (or (get-text-property (point) 'org-date-line) (when (or (get-text-property (point) 'org-date-line)
(eq (get-text-property (point) 'face) 'org-agenda-structure)) (eq (get-text-property (point) 'face)
'org-agenda-structure))
;; OK, this is a date line that should be used. ;; OK, this is a date line that should be used.
(let (rest) (let (entries)
(dolist (c cache (setq cache rest)) (let (rest)
(if (> (car c) (point)) (dolist (c cache)
(push c entries) (if (> (car c) (point))
(push c rest)))) (push c entries)
;; Now ENTRIES contains entries below the current one. (push c rest)))
;; CACHE is the rest. Compute the summaries for the (setq cache rest))
;; properties we want, set nil properties for the rest. ;; ENTRIES contains entries below the current one.
(when (setq entries (mapcar #'cdr entries)) ;; CACHE is the rest. Compute the summaries for the
(org-columns--display-here ;; properties we want, set nil properties for the rest.
(mapcar (when (setq entries (mapcar #'cdr entries))
(lambda (spec) (org-columns--display-here
(pcase spec (mapcar
(`("ITEM" . ,_) (lambda (spec)
;; Replace ITEM with current date. Preserve (pcase spec
;; properties for fontification. (`("ITEM" . ,_)
(let ((date (buffer-substring ;; Replace ITEM with current date. Preserve
(line-beginning-position) ;; properties for fontification.
(line-end-position)))) (let ((date (buffer-substring
(list spec date date))) (line-beginning-position)
(`(,_ ,_ ,_ nil ,_) (list spec "" "")) (line-end-position))))
(`(,_ ,_ ,_ ,operator ,printf) (list spec date date)))
(let* ((summarize (org-columns--summarize operator)) (`(,_ ,_ ,_ nil ,_) (list spec "" ""))
(values (`(,_ ,_ ,_ ,operator ,printf)
;; Use real values for summary, not those (let* ((summarize (org-columns--summarize operator))
;; prepared for display. (values
(delq nil ;; Use real values for summary, not
(mapcar ;; those prepared for display.
(lambda (e) (delq nil
(org-string-nw-p (nth 1 (assoc spec e)))) (mapcar
entries))) (lambda (e) (org-string-nw-p
(final (if values (funcall summarize values printf) (nth 1 (assoc spec e))))
""))) entries)))
(unless (equal final "") (final (if values
(put-text-property 0 (length final) 'face 'bold final)) (funcall summarize values printf)
(list spec final final))))) "")))
fmt) (unless (equal final "")
'dateline) (put-text-property 0 (length final)
(setq-local org-agenda-columns-active t))) 'face 'bold final))
(list spec final final)))))
fmt)
'dateline)
(setq-local org-agenda-columns-active t))))
(if (bobp) (throw :complete t) (forward-line -1))))))) (if (bobp) (throw :complete t) (forward-line -1)))))))
(defun org-agenda-colview-compute (fmt) (defun org-agenda-colview-compute (fmt)