diff options
author | Nicolas Goaziou <mail@nicolasgoaziou.fr> | 2016-02-14 10:17:14 +0100 |
---|---|---|
committer | Nicolas Goaziou <mail@nicolasgoaziou.fr> | 2016-02-17 22:49:19 +0100 |
commit | 279902ca4da4fe5f0ceff801a3aab51b942b42b7 (patch) | |
tree | d5e7bae0377c1337a797e5ffaf40f8ce698cedac | |
parent | 3196b1434289c9427704f0eccc074f7d5901715a (diff) | |
download | org-mode-279902ca4da4fe5f0ceff801a3aab51b942b42b7.tar.gz |
org-colview: Fix column width computation
* lisp/org-colview.el (org-columns-current-widths): Remove variable.
(org-columns--value): Remove function.
(org-columns--displayed-value): New function.
(org-columns--collect-values): New function.
(org-columns-display-here): Rename function to...
(org-columns--display-here): ... this. First argument is now mandatory.
(org-columns-display-here-title): Rename function to...
(org-columns--display-here-title): ... this.
(org-columns-autowidth-alist): Rename function to...
(org-columns--autowidth-alist): ... this. Remove one argument.
(org-columns-edit-value):
(org-columns-next-allowed-value): Always refresh all columns, not only
the current one. Otherwise, the current column may end up with
a different width than the others.
(org-columns):
(org-dblock-write:columnview):
(org-agenda-columns):
(org-agenda-colview-summarize): Apply changes above.
Columns width is now computed according to displayed values, not real
ones.
-rw-r--r-- | lisp/org-colview.el | 527 |
1 files changed, 237 insertions, 290 deletions
diff --git a/lisp/org-colview.el b/lisp/org-colview.el index 1c1fc6a..6e1956b 100644 --- a/lisp/org-colview.el +++ b/lisp/org-colview.el @@ -35,6 +35,11 @@ (declare-function org-agenda-do-context-action "org-agenda" ()) (declare-function org-clock-sum-today "org-clock" (&optional headline-filter)) +(defvar org-agenda-columns-add-appointments-to-effort-sum) +(defvar org-agenda-columns-compute-summary-properties) +(defvar org-agenda-columns-show-summaries) +(defvar org-agenda-view-columns-initially) + ;;; Configuration (defcustom org-columns-modify-value-for-display-function nil @@ -62,8 +67,6 @@ or nil if the normal value should be used." (defvar-local org-columns-current-fmt-compiled nil "Local variable, holds the currently active column format. This is the compiled version of the format.") -(defvar-local org-columns-current-widths nil - "Loval variable, holds the currently widths of fields.") (defvar-local org-columns-current-maxwidths nil "Loval variable, holds the currently active maximum column widths.") (defvar org-columns-begin-marker (make-marker) @@ -156,10 +159,82 @@ This is the compiled version of the format.") "--" ["Quit" org-columns-quit t])) -(defun org-columns--value (property pos) - "Return value for PROPERTY at buffer position POS." - (or (cdr (assoc-string property (get-text-property pos 'org-summaries) t)) - (org-entry-get pos property 'selective t))) +(defun org-columns--displayed-value (property value) + "Return displayed value for PROPERTY in current entry. + +VALUE is the real value of the property, as a string. + +This function assumes `org-columns-current-fmt-compiled' is +initialized." + (pcase (assoc-string property org-columns-current-fmt-compiled t) + (`(,_ ,_ ,_ ,_ ,fmt ,printf ,_ ,calc) + (cond + ((and (functionp org-columns-modify-value-for-display-function) + (funcall + org-columns-modify-value-for-display-function + (nth 1 (assoc-string property org-columns-current-fmt-compiled t)) + value))) + ((equal (upcase property) "ITEM") + (concat (make-string (1- (org-current-level)) + (if org-hide-leading-stars ?\s ?*)) + "* " + (org-columns-compact-links value))) + (printf (org-columns-number-to-string + (org-columns-string-to-number value fmt) fmt printf)) + ((and (functionp calc) + (not (string= value "")) + (not (get-text-property 0 'org-computed value))) + (org-columns-number-to-string + (funcall calc (org-columns-string-to-number value fmt)) fmt)) + (value))))) + +(defun org-columns--collect-values (&optional agenda) + "Collect values for columns on the current line. + +When optional argument AGENDA is non-nil, assume the value is +meant for the agenda, i.e., caller is `org-agenda-columns'. + +Return a list of triplets (PROPERTY VALUE DISPLAYED) suitable for +`org-columns--display-here'. + +This function assumes `org-columns-current-fmt-compiled' is +initialized." + (mapcar + (lambda (spec) + (let* ((p (car spec)) + (v (or (cdr (assoc-string + p (get-text-property (point) 'org-summaries) t)) + (org-entry-get (point) p 'selective t) + (and agenda + ;; Effort property is not defined. Try to use + ;; appointment duration. + org-agenda-columns-add-appointments-to-effort-sum + (string= (upcase p) (upcase org-effort-property)) + (get-text-property (point) 'duration) + (org-propertize + (org-minutes-to-clocksum-string + (get-text-property (point) 'duration)) + 'face 'org-warning)) + ""))) + (list p v (org-columns--displayed-value p v)))) + org-columns-current-fmt-compiled)) + +(defun org-columns--autowidth-alist (cache) + "Derive the maximum column widths from the format and the cache. +Return an alist (PROPERTY . WIDTH), with PROPERTY as a string and +WIDTH as an integer greater than 0." + (mapcar + (lambda (spec) + (pcase spec + (`(,property ,name ,width . ,_) + (if width (cons property width) + ;; No width is specified in the columns format. Compute it + ;; by checking all possible values for PROPERTY. + (let ((width (length name))) + (dolist (entry cache (cons property width)) + (let ((value (nth 2 (assoc-string property (cdr entry) t)))) + (setq width (max (length value) width))))))))) + org-columns-current-fmt-compiled)) (defun org-columns-new-overlay (beg end &optional string face) "Create a new column overlay and add it to the list." @@ -169,9 +244,11 @@ This is the compiled version of the format.") (push ov org-columns-overlays) ov)) -(defun org-columns-display-here (&optional props dateline) - "Overlay the current line with column display." - (interactive) +(defun org-columns--display-here (columns &optional dateline) + "Overlay the current line with column display. +COLUMNS is an alist (PROPERTY VALUE DISPLAYED). Optional +argument DATELINE is non-nil when the face used should be +`org-agenda-column-dateline'." (save-excursion (beginning-of-line) (let* ((level-face (and (looking-at "\\(\\**\\)\\(\\* \\)") @@ -184,14 +261,7 @@ This is the compiled version of the format.") (font (list :height (face-attribute 'default :height) :family (face-attribute 'default :family))) (face (list color font 'org-column ref-face)) - (face1 (list color font 'org-agenda-column-dateline ref-face)) - (pom (and (eq major-mode 'org-agenda-mode) - (or (org-get-at-bol 'org-hd-marker) - (org-get-at-bol 'org-marker)))) - (props (cond (props) - ((eq major-mode 'org-agenda-mode) - (and pom (org-entry-properties pom))) - (t (org-entry-properties))))) + (face1 (list color font 'org-agenda-column-dateline ref-face))) ;; Each column is an overlay on top of a character. So there has ;; to be at least as many characters available on the line as ;; columns to display. @@ -202,64 +272,43 @@ This is the compiled version of the format.") (end-of-line) (let ((inhibit-read-only t)) (insert (make-string (- columns chars) ?\s)))))) - ;; Walk the format. Create and install the overlay for the + ;; Display columns. Create and install the overlay for the ;; current column on the next character. - (dolist (column org-columns-current-fmt-compiled) - (let* ((property (car column)) - (title (nth 1 column)) - (ass (assoc-string property props t)) - (width - (or - (cdr (assoc-string property org-columns-current-maxwidths t)) - (nth 2 column) - (length property))) - (f (format "%%-%d.%ds | " width width)) - (fm (nth 4 column)) - (fc (nth 5 column)) - (calc (nth 7 column)) - (val (or (cdr ass) "")) - (modval - (cond - ((functionp org-columns-modify-value-for-display-function) - (funcall org-columns-modify-value-for-display-function - title val)) - ((equal property "ITEM") (org-columns-compact-links val)) - (fc (org-columns-number-to-string - (org-columns-string-to-number val fm) fm fc)) - ((and calc (functionp calc) - (not (string= val "")) - (not (get-text-property 0 'org-computed val))) - (org-columns-number-to-string - (funcall calc (org-columns-string-to-number val fm)) fm)))) - (string - (format f - (let ((v (org-columns-add-ellipses - (or modval val) width))) - (cond - ((equal property "PRIORITY") - (propertize v 'face (org-get-priority-face val))) - ((equal property "TAGS") - (if (not org-tags-special-faces-re) - (propertize v 'face 'org-tag) - (replace-regexp-in-string - org-tags-special-faces-re - (lambda (m) - (propertize m 'face (org-get-tag-face m))) - v nil nil 1))) - ((equal property "TODO") - (propertize v 'face (org-get-todo-face val))) - (t v))))) - (ov (org-columns-new-overlay - (point) (1+ (point)) string (if dateline face1 face)))) - (overlay-put ov 'keymap org-columns-map) - (overlay-put ov 'org-columns-key property) - (overlay-put ov 'org-columns-value (cdr ass)) - (overlay-put ov 'org-columns-value-modified modval) - (overlay-put ov 'org-columns-pom pom) - (overlay-put ov 'org-columns-format f) - (overlay-put ov 'line-prefix "") - (overlay-put ov 'wrap-prefix "") - (forward-char))) + (dolist (column columns) + (pcase column + (`(,property ,original ,value) + (let* ((width + (cdr + (assoc-string property org-columns-current-maxwidths t))) + (fmt (format "%%-%d.%ds | " width width)) + (text + (format + fmt + (let ((v (org-columns-add-ellipses value width))) + (pcase (upcase property) + ("PRIORITY" + (propertize v 'face (org-get-priority-face original))) + ("TAGS" + (if (not org-tags-special-faces-re) + (propertize v 'face 'org-tag) + (replace-regexp-in-string + org-tags-special-faces-re + (lambda (m) + (propertize m 'face (org-get-tag-face m))) + v nil nil 1))) + ("TODO" + (propertize v 'face (org-get-todo-face original))) + (_ v))))) + (ov (org-columns-new-overlay + (point) (1+ (point)) text (if dateline face1 face)))) + (overlay-put ov 'keymap org-columns-map) + (overlay-put ov 'org-columns-key property) + (overlay-put ov 'org-columns-value original) + (overlay-put ov 'org-columns-value-modified value) + (overlay-put ov 'org-columns-format fmt) + (overlay-put ov 'line-prefix "") + (overlay-put ov 'wrap-prefix "") + (forward-char))))) ;; Make the rest of the line disappear. (let ((ov (org-columns-new-overlay (point) (line-end-position)))) (overlay-put ov 'invisible t) @@ -303,33 +352,23 @@ for the duration of the command.") (defvar header-line-format) (defvar org-columns-previous-hscroll 0) -(defun org-columns-display-here-title () +(defun org-columns--display-here-title () "Overlay the newline before the current line with the table title." (interactive) - (let ((fmt org-columns-current-fmt-compiled) - string (title "") - property width f column str widths) - (while (setq column (pop fmt)) - (setq property (car column) - str (or (nth 1 column) property) - width (or (cdr (assoc-string property - org-columns-current-maxwidths - t)) - (nth 2 column) - (length str)) - widths (push width widths) - f (format "%%-%d.%ds | " width width) - string (format f str) - title (concat title string))) - (setq title (concat - (org-add-props " " nil 'display '(space :align-to 0)) - ;;(org-add-props title nil 'face '(:weight bold :underline t :inherit default)))) - (org-add-props title nil 'face 'org-column-title))) + (let ((title "")) + (dolist (column org-columns-current-fmt-compiled) + (pcase column + (`(,property ,name . ,_) + (let* ((width + (cdr (assoc-string property org-columns-current-maxwidths t))) + (fmt (format "%%-%d.%ds | " width width))) + (setq title (concat title (format fmt (or name property)))))))) + (setq title + (concat (org-add-props " " nil 'display '(space :align-to 0)) + (org-add-props title nil 'face 'org-column-title))) (setq-local org-previous-header-line-format header-line-format) - (setq-local org-columns-current-widths (nreverse widths)) (setq org-columns-full-header-line-format title) (setq org-columns-previous-hscroll -1) - ; (org-columns-hscoll-title) (org-add-hook 'post-command-hook 'org-columns-hscoll-title nil 'local))) (defun org-columns-hscoll-title () @@ -432,13 +471,6 @@ Where possible, use the standard interface for changing this line." (bol (point-at-bol)) (eol (point-at-eol)) (pom (or (get-text-property bol 'org-hd-marker) (point))) ; keep despite of compiler waring - (line-overlays - (delq nil (mapcar (lambda (x) - (and (eq (overlay-buffer x) (current-buffer)) - (>= (overlay-start x) bol) - (<= (overlay-start x) eol) - x)) - org-columns-overlays))) (org-columns-time (time-to-number-of-days (current-time))) nval eval allowed) (cond @@ -496,17 +528,9 @@ Where possible, use the standard interface for changing this line." (org-with-silent-modifications (remove-text-properties (max (point-min) (1- bol)) eol '(read-only t))) - (unwind-protect - (progn - (setq org-columns-overlays - (org-delete-all line-overlays org-columns-overlays)) - (mapc 'delete-overlay line-overlays) - (org-columns-eval eval)) - (org-columns-display-here))) + (org-columns-eval eval)) (org-move-to-column col) - (if (and (derived-mode-p 'org-mode) - (nth 3 (assoc-string key org-columns-current-fmt-compiled t))) - (org-columns-update key))))))) + (org-columns-update key)))))) (defun org-edit-headline () ; FIXME: this is not columns specific. Make interactive????? Use from agenda???? "Edit the current headline, the part without TODO keyword, TAGS." @@ -575,13 +599,6 @@ an integer, select that value." (bol (point-at-bol)) (eol (point-at-eol)) (pom (or (get-text-property bol 'org-hd-marker) (point))) ; keep despite of compiler waring - (line-overlays - (delq nil (mapcar (lambda (x) - (and (eq (overlay-buffer x) (current-buffer)) - (>= (overlay-start x) bol) - (<= (overlay-start x) eol) - x)) - org-columns-overlays))) (allowed (or (org-property-get-allowed-values pom key) (and (memq (nth 4 (assoc-string key @@ -627,16 +644,9 @@ an integer, select that value." (t (let ((inhibit-read-only t)) (remove-text-properties (max (1- bol) (point-min)) eol '(read-only t)) - (unwind-protect - (progn - (setq org-columns-overlays - (org-delete-all line-overlays org-columns-overlays)) - (mapc 'delete-overlay line-overlays) - (org-columns-eval `(org-entry-put ,pom ,key ,nval))) - (org-columns-display-here))) + (org-columns-eval `(org-entry-put ,pom ,key ,nval))) (org-move-to-column col) - (and (nth 3 (assoc-string key org-columns-current-fmt-compiled t)) - (org-columns-update key)))))) + (org-columns-update key))))) (defun org-colview-construct-allowed-dates (s) "Construct a list of three dates around the date in S. @@ -708,34 +718,20 @@ When COLUMNS-FMT-STRING is non-nil, use it as the column format." (narrow-to-region (point) (if (org-at-heading-p) (org-end-of-subtree t t) (point-max))) - (when (assoc "CLOCKSUM" org-columns-current-fmt-compiled) + (when (assoc-string "CLOCKSUM" org-columns-current-fmt-compiled t) (org-clock-sum)) - (when (assoc "CLOCKSUM_T" org-columns-current-fmt-compiled) + (when (assoc-string "CLOCKSUM_T" org-columns-current-fmt-compiled t) (org-clock-sum-today)) - (let* ((column-names (mapcar #'car org-columns-current-fmt-compiled)) - (cache - (org-map-entries - (lambda () - (cons (point) - (mapcar - (lambda (p) - (cons p - (let ((v (org-columns--value p (point)))) - (if (not (equal "ITEM" p)) v - (concat (make-string - (1- (org-current-level)) - (if org-hide-leading-stars - ?\s ?*)) - "* " - v))))) - column-names))) - nil nil (and org-columns-skip-archived-trees 'archive)))) + (let ((cache + ;; Collect contents of columns ahead of time so as to + ;; compute their maximum width. + (org-map-entries + (lambda () (cons (point) (org-columns--collect-values))) + nil nil (and org-columns-skip-archived-trees 'archive)))) (when cache (setq-local org-columns-current-maxwidths - (org-columns-get-autowidth-alist - org-columns-current-fmt - cache)) - (org-columns-display-here-title) + (org-columns--autowidth-alist cache)) + (org-columns--display-here-title) (when (setq-local org-columns-flyspell-was-active (org-bound-and-true-p flyspell-mode)) (flyspell-mode 0)) @@ -743,9 +739,9 @@ When COLUMNS-FMT-STRING is non-nil, use it as the column format." (setq-local org-colview-initial-truncate-line-value truncate-lines)) (setq truncate-lines t) - (dolist (x cache) - (goto-char (car x)) - (org-columns-display-here (cdr x)))))))) + (dolist (entry cache) + (goto-char (car entry)) + (org-columns--display-here (cdr entry)))))))) (defvar org-columns-compile-map '(("none" none +) @@ -909,24 +905,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-get-autowidth-alist (s cache) - "Derive the maximum column widths from the format and the cache." - (let ((start 0) rtn) - (while (string-match (org-re "%\\([[:alpha:]][[:alnum:]_-]*\\)") s start) - (push (cons (match-string 1 s) 1) rtn) - (setq start (match-end 0))) - (mapc (lambda (x) - (setcdr x - (apply #'max - (let ((prop (car x))) - (mapcar - (lambda (y) - (length (or (cdr (assoc-string prop (cdr y) t)) - " "))) - cache))))) - rtn) - rtn)) - (defun org-columns-compute-all () "Compute all columns that have operators defined." (org-with-silent-modifications @@ -1346,7 +1324,7 @@ PARAMS is a property list of parameters: (insert (org-listtable-to-string tbl)) (when (plist-get params :width) (insert "\n|" (mapconcat (lambda (x) (format "<%d>" (max 3 x))) - org-columns-current-widths "|"))) + org-columns-current-maxwidths "|"))) (while (setq line (pop content-lines)) (when (string-match "^#" line) (insert "\n" line) @@ -1387,11 +1365,6 @@ and tailing newline characters." ;;; Column view in the agenda -(defvar org-agenda-view-columns-initially) -(defvar org-agenda-columns-show-summaries) ; defined in org-agenda.el -(defvar org-agenda-columns-compute-summary-properties); defined in org-agenda.el -(defvar org-agenda-columns-add-appointments-to-effort-sum); as well - ;;;###autoload (defun org-agenda-columns () "Turn on or update column view in the agenda." @@ -1424,127 +1397,101 @@ and tailing newline characters." ;; Collect properties for each headline in current view. (goto-char (point-min)) (let (cache) - (let ((names (mapcar #'car org-columns-current-fmt-compiled)) m) - (while (not (eobp)) - (when (setq m (or (org-get-at-bol 'org-hd-marker) - (org-get-at-bol 'org-marker))) - (push - (cons - (line-beginning-position) - (org-with-point-at m - (mapcar - (lambda (name) - (let ((value (org-columns--value name (point)))) - (cons - name - (cond - ((and org-agenda-columns-add-appointments-to-effort-sum - (not value) - (eq (compare-strings name nil nil - org-effort-property nil nil - t) - t) - ;; Effort property is not defined. Try ; - ;; to use appointment duration. ; - (get-text-property (point) 'duration)) - (org-propertize - (org-minutes-to-clocksum-string - (get-text-property (point) 'duration)) - 'face 'org-warning)) - ((equal "ITEM" name) - (concat (make-string (org-current-level) ?*) - " " - value)) - (t value))))) - names))) - cache)) - (forward-line))) + (while (not (eobp)) + (let ((m (or (org-get-at-bol 'org-hd-marker) + (org-get-at-bol 'org-marker)))) + (when m + (push (cons (line-beginning-position) + (org-with-point-at m + (org-columns--collect-values 'agenda))) + cache))) + (forward-line)) (when cache (setq-local org-columns-current-maxwidths - (org-columns-get-autowidth-alist fmt cache)) - (org-columns-display-here-title) + (org-columns--autowidth-alist cache)) + (org-columns--display-here-title) (when (setq-local org-columns-flyspell-was-active (org-bound-and-true-p flyspell-mode)) (flyspell-mode 0)) - (dolist (x cache) - (goto-char (car x)) - (org-columns-display-here (cdr x))) + (dolist (entry cache) + (goto-char (car entry)) + (org-columns--display-here (cdr entry))) (when org-agenda-columns-show-summaries (org-agenda-colview-summarize cache))))))) (defun org-agenda-colview-summarize (cache) "Summarize the summarizable columns in column view in the agenda. This will add overlays to the date lines, to show the summary for each day." - (let* ((fmt (mapcar (lambda (x) - (if (string-match "CLOCKSUM.*" (car x)) - (list (match-string 0 (car x)) - (nth 1 x) (nth 2 x) ":" 'add_times - nil '+ nil) - x)) - org-columns-current-fmt-compiled)) - line c c1 stype calc sumfunc props lsum entries prop v) - (catch 'exit - (when (delq nil (mapcar 'cadr fmt)) - ;; OK, at least one summation column, it makes sense to try this - (goto-char (point-max)) - (while t - (when (or (get-text-property (point) 'org-date-line) - (eq (get-text-property (point) 'face) - 'org-agenda-structure)) - ;; OK, this is a date line that should be used - (setq line (org-current-line)) - (setq entries nil c cache cache nil) - (while (setq c1 (pop c)) - (if (> (car c1) line) - (push c1 entries) - (push c1 cache))) - ;; now ENTRIES are the ones we want to use, CACHE is the rest - ;; Compute the summaries for the properties we want, - ;; set nil properties for the rest. - (when (setq entries (mapcar 'cdr entries)) - (setq props - (mapcar - (lambda (f) - (setq prop (car f) - stype (nth 4 f) - sumfunc (nth 6 f) - calc (or (nth 7 f) 'identity)) - (cond - ((equal prop "ITEM") - (cons prop (buffer-substring (point-at-bol) - (point-at-eol)))) - ((not stype) (cons prop "")) - (t ;; do the summary - (setq lsum nil) - (dolist (x entries) - (setq v (cdr (assoc-string prop x t))) - (if v - (push - (funcall - (if (not (get-text-property 0 'org-computed v)) - calc - 'identity) - (org-columns-string-to-number - v stype)) - lsum))) - (setq lsum (remove nil lsum)) - (setq lsum - (cond ((> (length lsum) 1) - (org-columns-number-to-string - (apply sumfunc lsum) stype)) - ((eq (length lsum) 1) - (org-columns-number-to-string - (car lsum) stype)) - (t ""))) - (put-text-property 0 (length lsum) 'face 'bold lsum) - (unless (eq calc 'identity) - (put-text-property 0 (length lsum) 'org-computed t lsum)) - (cons prop lsum)))) - fmt)) - (org-columns-display-here props 'dateline) - (setq-local org-agenda-columns-active t))) - (if (bobp) (throw 'exit t)) - (beginning-of-line 0)))))) + (let ((fmt (mapcar + (lambda (spec) + (pcase spec + (`(,property ,title ,width . ,_) + (if (member-ignore-case property '("CLOCKSUM" "CLOCKSUM_T")) + (list property title width ":" 'add_times nil '+ nil) + spec)))) + org-columns-current-fmt-compiled)) + entries) + ;; Ensure there's at least one summation column. + (when (cl-some (lambda (spec) (nth 4 spec)) fmt) + (goto-char (point-max)) + (while (not (bobp)) + (when (or (get-text-property (point) 'org-date-line) + (eq (get-text-property (point) 'face) + 'org-agenda-structure)) + ;; OK, this is a date line that should be used. + (let (rest) + (dolist (c cache (setq cache rest)) + (if (> (car c) (point)) + (push c entries) + (push c rest)))) + ;; Now ENTRIES contains entries below the current one. + ;; CACHE is the rest. Compute the summaries for the + ;; properties we want, set nil properties for the rest. + (when (setq entries (mapcar 'cdr entries)) + (org-columns--display-here + (mapcar + (lambda (spec) + (pcase spec + (`(,(and prop (guard (equal (upcase prop) "ITEM"))) . ,_) + ;; Replace ITEM with current date. Preserve + ;; properties for fontification. + (let ((date (buffer-substring + (line-beginning-position) + (line-end-position)))) + (list prop date date))) + (`(,prop ,_ ,_ ,_ nil . ,_) + (list prop "" "")) + (`(,prop ,_ ,_ ,_ ,stype ,_ ,sumfunc ,calc) + (let (lsum) + (dolist (entry entries (setq lsum (delq nil lsum))) + ;; Use real values for summary, not those + ;; prepared for display. + (let ((v (nth 1 (assoc-string prop entry t)))) + (when v + (let ((n (org-columns-string-to-number v stype))) + (push + (if (or (get-text-property 0 'org-computed v) + (not calc)) + n + (funcall calc n)) + lsum))))) + (setq lsum + (let ((l (length lsum))) + (cond ((> l 1) + (org-columns-number-to-string + (apply sumfunc lsum) stype)) + ((= l 1) + (org-columns-number-to-string + (car lsum) stype)) + (t "")))) + (unless (memq calc '(identity nil)) + (put-text-property 0 (length lsum) 'org-computed t lsum)) + (put-text-property 0 (length lsum) 'face 'bold lsum) + (list prop lsum lsum))))) + fmt) + 'dateline) + (setq-local org-agenda-columns-active t))) + (forward-line -1))))) (defun org-agenda-colview-compute (fmt) "Compute the relevant columns in the contributing source buffers." |