0
0
Fork 1
mirror of https://git.savannah.gnu.org/git/emacs/org-mode.git synced 2024-09-29 18:00:49 +00:00

org-colview: Remove summarize function from format spec

* lisp/org-colview.el (org-columns--summarize): Throw an error when no
  summarize function is associated to a given operator.

(org-columns-compile-format): Do not provide summarize function, which
can be found using the accessor `org-columns--summarize'.

(org-columns-new):
(org-columns-uncompile-format):
(org-columns-compute):
(org-columns-compute-all):
(org-agenda-colview-summarize): Use new compiled format.
This commit is contained in:
Nicolas Goaziou 2016-02-22 14:12:48 +01:00
parent 9dfe3d8079
commit 633e4d4202

View file

@ -299,8 +299,10 @@ integers greater than 0."
(defun org-columns--summarize (operator) (defun org-columns--summarize (operator)
"Return summary function associated to string OPERATOR." "Return summary function associated to string OPERATOR."
(cdr (or (assoc operator org-columns-summary-types) (if (not operator) nil
(assoc operator org-columns-summary-types-default)))) (cdr (or (assoc operator org-columns-summary-types)
(assoc operator org-columns-summary-types-default)
(error "Unknown %S operator" operator)))))
(defun org-columns--overlay-text (value fmt width property original) (defun org-columns--overlay-text (value fmt width property original)
"Return text " "Return text "
@ -811,7 +813,7 @@ When COLUMNS-FMT-STRING is non-nil, use it as the column format."
(goto-char (car entry)) (goto-char (car entry))
(org-columns--display-here (cdr entry))))))))) (org-columns--display-here (cdr entry)))))))))
(defun org-columns-new (&optional prop title width operator &rest _) (defun org-columns-new (&optional prop title width operator _)
"Insert a new column, to the left of the current column." "Insert a new column, to the left of the current column."
(interactive) (interactive)
(let* ((automatic (org-string-nw-p prop)) (let* ((automatic (org-string-nw-p prop))
@ -838,11 +840,10 @@ When COLUMNS-FMT-STRING is non-nil, use it as the column format."
(append org-columns-summary-types (append org-columns-summary-types
org-columns-summary-types-default))) org-columns-summary-types-default)))
nil t)))) nil t))))
(summarize (and prop operator (org-columns--summarize operator)))
(edit (edit
(and prop (assoc-string prop org-columns-current-fmt-compiled t)))) (and prop (assoc-string prop org-columns-current-fmt-compiled t))))
(if edit (setcdr edit (list title width operator nil summarize)) (if edit (setcdr edit (list title width operator nil))
(push (list prop title width operator nil summarize) (push (list prop title width operator nil)
(nthcdr (current-column) org-columns-current-fmt-compiled))) (nthcdr (current-column) org-columns-current-fmt-compiled)))
(org-columns-store-format) (org-columns-store-format)
(org-columns-redo))) (org-columns-redo)))
@ -987,7 +988,7 @@ COMPILED is an alist, as returned by
(mapconcat (mapconcat
(lambda (spec) (lambda (spec)
(pcase spec (pcase spec
(`(,prop ,title ,width ,op ,printf ,_) (`(,prop ,title ,width ,op ,printf)
(concat "%" (concat "%"
(and width (number-to-string width)) (and width (number-to-string width))
prop prop
@ -1007,7 +1008,6 @@ title the title field for the columns, as a string
width the column width in characters, can be nil for automatic width width the column width in characters, can be nil for automatic width
operator the summary operator, as a string, or nil operator the summary operator, as a string, or nil
printf a printf format for computed values, as a string, or nil printf a printf format for computed values, as a string, or nil
fun the lisp function to compute summary values, derived from operator
This function updates `org-columns-current-fmt-compiled'." This function updates `org-columns-current-fmt-compiled'."
(setq org-columns-current-fmt-compiled nil) (setq org-columns-current-fmt-compiled nil)
@ -1021,16 +1021,12 @@ This function updates `org-columns-current-fmt-compiled'."
(prop (match-string-no-properties 2 fmt)) (prop (match-string-no-properties 2 fmt))
(title (or (match-string-no-properties 3 fmt) prop)) (title (or (match-string-no-properties 3 fmt) prop))
(operator (match-string-no-properties 4 fmt))) (operator (match-string-no-properties 4 fmt)))
(push (if (not operator) (list (upcase prop) title width nil nil nil) (push (if (not operator) (list (upcase prop) title width nil nil)
(let (printf) (let (printf)
(when (string-match ";" operator) (when (string-match ";" operator)
(setq printf (substring operator (match-end 0))) (setq printf (substring operator (match-end 0)))
(setq operator (substring operator 0 (match-beginning 0)))) (setq operator (substring operator 0 (match-beginning 0))))
(let* ((summary (list (upcase prop) title width operator printf)))
(or (org-columns--summarize operator)
(user-error "Cannot find %S summary function"
operator))))
(list (upcase prop) title width operator printf summary))))
org-columns-current-fmt-compiled))) org-columns-current-fmt-compiled)))
(setq org-columns-current-fmt-compiled (setq org-columns-current-fmt-compiled
(nreverse org-columns-current-fmt-compiled)))) (nreverse org-columns-current-fmt-compiled))))
@ -1105,8 +1101,8 @@ format instead. Otherwise, use H:M format."
29)) ;Hard-code deepest level. 29)) ;Hard-code deepest level.
(lvals (make-vector (1+ lmax) nil)) (lvals (make-vector (1+ lmax) nil))
(spec (assoc-string property org-columns-current-fmt-compiled t)) (spec (assoc-string property org-columns-current-fmt-compiled t))
(operator (nth 3 spec))
(printf (nth 4 spec)) (printf (nth 4 spec))
(summarize (nth 5 spec))
(level 0) (level 0)
(inminlevel lmax) (inminlevel lmax)
(last-level lmax)) (last-level lmax))
@ -1132,7 +1128,8 @@ format instead. Otherwise, use H:M format."
(let ((all (append (and (/= last-level inminlevel) (let ((all (append (and (/= last-level inminlevel)
(aref lvals last-level)) (aref lvals last-level))
(aref lvals inminlevel)))) (aref lvals inminlevel))))
(and all (funcall summarize all printf))))) (and all (funcall (org-columns--summarize operator)
all printf)))))
(let* ((summaries-alist (get-text-property pos 'org-summaries)) (let* ((summaries-alist (get-text-property pos 'org-summaries))
(old (assoc-string property summaries-alist t)) (old (assoc-string property summaries-alist t))
(new (new
@ -1166,7 +1163,7 @@ format instead. Otherwise, use H:M format."
(let ((org-columns--time (float-time (current-time)))) (let ((org-columns--time (float-time (current-time))))
(dolist (spec org-columns-current-fmt-compiled) (dolist (spec org-columns-current-fmt-compiled)
(pcase spec (pcase spec
(`(,property ,_ ,_ ,operator . ,_) (`(,property ,_ ,_ ,operator ,_)
(when operator (save-excursion (org-columns-compute property)))))))) (when operator (save-excursion (org-columns-compute property))))))))
(defun org-columns--summary-sum (values printf) (defun org-columns--summary-sum (values printf)
@ -1528,8 +1525,7 @@ This will add overlays to the date lines, to show the summary for each day."
(pcase spec (pcase spec
(`(,property ,title ,width . ,_) (`(,property ,title ,width . ,_)
(if (member property '("CLOCKSUM" "CLOCKSUM_T")) (if (member property '("CLOCKSUM" "CLOCKSUM_T"))
(let ((summarize (org-columns--summarize ":"))) (list property title width ":" nil)
(list property title width ":" nil summarize))
spec)))) spec))))
org-columns-current-fmt-compiled)) org-columns-current-fmt-compiled))
entries) entries)
@ -1561,9 +1557,10 @@ This will add overlays to the date lines, to show the summary for each day."
(line-beginning-position) (line-beginning-position)
(line-end-position)))) (line-end-position))))
(list "ITEM" date date))) (list "ITEM" date date)))
(`(,prop ,_ ,_ nil . ,_) (list prop "" "")) (`(,prop ,_ ,_ nil ,_) (list prop "" ""))
(`(,prop ,_ ,_ ,_ ,printf ,summarize) (`(,prop ,_ ,_ ,operator ,printf)
(let* ((values (let* ((summarize (org-columns--summarize operator))
(values
;; Use real values for summary, not those ;; Use real values for summary, not those
;; prepared for display. ;; prepared for display.
(delq nil (delq nil