forked from mirrors/org-mode
org-colview: Store properties in upper case
* lisp/org-colview.el (org-columns-compile-format): Property is upper-cased. Title is not, however. (org-columns--displayed-value): (org-columns--collect-values): (org-columns--autowidth-alist): (org-columns--overlay-text): (org-columns--display-here): (org-columns--display-here-title): (org-columns-next-allowed-value): (org-columns): (org-columns-widen): (org-columns-update): (org-columns--capture-view): (org-dblock-write:columnview): (org-agenda-colview-summarize): Since properties in compiled format are upper-cased, remove the `upcase' or `assoc-string' dance. * testing/lisp/test-org-colview.el (test-org-colview/columns-new): (test-org-colview/columns-update): Add case-sensitivity tests. `assoc-string' is still necessary in functions where property is provided by the user, e.g. `org-columns-update'.
This commit is contained in:
parent
92443160fd
commit
ebf7bbb308
|
@ -226,9 +226,9 @@ initialized."
|
||||||
((and (functionp org-columns-modify-value-for-display-function)
|
((and (functionp org-columns-modify-value-for-display-function)
|
||||||
(funcall
|
(funcall
|
||||||
org-columns-modify-value-for-display-function
|
org-columns-modify-value-for-display-function
|
||||||
(nth 1 (assoc-string property org-columns-current-fmt-compiled t))
|
(nth 1 (assoc property org-columns-current-fmt-compiled))
|
||||||
value)))
|
value)))
|
||||||
((equal (upcase property) "ITEM")
|
((equal property "ITEM")
|
||||||
(concat (make-string (1- (org-current-level))
|
(concat (make-string (1- (org-current-level))
|
||||||
(if org-hide-leading-stars ?\s ?*))
|
(if org-hide-leading-stars ?\s ?*))
|
||||||
"* "
|
"* "
|
||||||
|
@ -249,14 +249,13 @@ initialized."
|
||||||
(mapcar
|
(mapcar
|
||||||
(lambda (spec)
|
(lambda (spec)
|
||||||
(let* ((p (car spec))
|
(let* ((p (car spec))
|
||||||
(v (or (cdr (assoc-string
|
(v (or (cdr (assoc p (get-text-property (point) 'org-summaries)))
|
||||||
p (get-text-property (point) 'org-summaries) t))
|
|
||||||
(org-entry-get (point) p 'selective t)
|
(org-entry-get (point) p 'selective t)
|
||||||
(and agenda
|
(and agenda
|
||||||
;; Effort property is not defined. Try to use
|
;; Effort property is not defined. Try to use
|
||||||
;; appointment duration.
|
;; appointment duration.
|
||||||
org-agenda-columns-add-appointments-to-effort-sum
|
org-agenda-columns-add-appointments-to-effort-sum
|
||||||
(string= (upcase p) (upcase org-effort-property))
|
(string= p (upcase org-effort-property))
|
||||||
(get-text-property (point) 'duration)
|
(get-text-property (point) 'duration)
|
||||||
(org-propertize
|
(org-propertize
|
||||||
(org-minutes-to-clocksum-string
|
(org-minutes-to-clocksum-string
|
||||||
|
@ -279,7 +278,7 @@ WIDTH as an integer greater than 0."
|
||||||
;; by checking all possible values for PROPERTY.
|
;; by checking all possible values for PROPERTY.
|
||||||
(let ((width (length name)))
|
(let ((width (length name)))
|
||||||
(dolist (entry cache (cons property width))
|
(dolist (entry cache (cons property width))
|
||||||
(let ((value (nth 2 (assoc-string property (cdr entry) t))))
|
(let ((value (nth 2 (assoc property (cdr entry)))))
|
||||||
(setq width (max (length value) width)))))))))
|
(setq width (max (length value) width)))))))))
|
||||||
org-columns-current-fmt-compiled))
|
org-columns-current-fmt-compiled))
|
||||||
|
|
||||||
|
@ -300,7 +299,7 @@ WIDTH as an integer greater than 0."
|
||||||
"Return text "
|
"Return text "
|
||||||
(format fmt
|
(format fmt
|
||||||
(let ((v (org-columns-add-ellipses value width)))
|
(let ((v (org-columns-add-ellipses value width)))
|
||||||
(pcase (upcase property)
|
(pcase property
|
||||||
("PRIORITY"
|
("PRIORITY"
|
||||||
(propertize v 'face (org-get-priority-face original)))
|
(propertize v 'face (org-get-priority-face original)))
|
||||||
("TAGS"
|
("TAGS"
|
||||||
|
@ -347,9 +346,7 @@ argument DATELINE is non-nil when the face used should be
|
||||||
(dolist (column columns)
|
(dolist (column columns)
|
||||||
(pcase column
|
(pcase column
|
||||||
(`(,property ,original ,value)
|
(`(,property ,original ,value)
|
||||||
(let* ((width
|
(let* ((width (cdr (assoc property org-columns-current-maxwidths)))
|
||||||
(cdr
|
|
||||||
(assoc-string property org-columns-current-maxwidths t)))
|
|
||||||
(fmt (format (if (= (point) limit) "%%-%d.%ds |"
|
(fmt (format (if (= (point) limit) "%%-%d.%ds |"
|
||||||
"%%-%d.%ds | ")
|
"%%-%d.%ds | ")
|
||||||
width width))
|
width width))
|
||||||
|
@ -416,8 +413,7 @@ for the duration of the command.")
|
||||||
(dolist (column org-columns-current-fmt-compiled)
|
(dolist (column org-columns-current-fmt-compiled)
|
||||||
(pcase column
|
(pcase column
|
||||||
(`(,property ,name . ,_)
|
(`(,property ,name . ,_)
|
||||||
(let* ((width
|
(let* ((width (cdr (assoc property org-columns-current-maxwidths)))
|
||||||
(cdr (assoc-string property org-columns-current-maxwidths t)))
|
|
||||||
(fmt (format "%%-%d.%ds | " width width)))
|
(fmt (format "%%-%d.%ds | " width width)))
|
||||||
(setq title (concat title (format fmt (or name property))))))))
|
(setq title (concat title (format fmt (or name property))))))))
|
||||||
(setq-local org-previous-header-line-format header-line-format)
|
(setq-local org-previous-header-line-format header-line-format)
|
||||||
|
@ -658,9 +654,7 @@ an integer, select that value."
|
||||||
(point))) ; keep despite of compiler waring
|
(point))) ; keep despite of compiler waring
|
||||||
(allowed
|
(allowed
|
||||||
(or (org-property-get-allowed-values pom key)
|
(or (org-property-get-allowed-values pom key)
|
||||||
(and (member (nth 3 (assoc-string key
|
(and (member (nth 3 (assoc key org-columns-current-fmt-compiled))
|
||||||
org-columns-current-fmt-compiled
|
|
||||||
t))
|
|
||||||
'("X" "X/" "X%"))
|
'("X" "X/" "X%"))
|
||||||
'("[ ]" "[X]"))
|
'("[ ]" "[X]"))
|
||||||
(org-colview-construct-allowed-dates value)))
|
(org-colview-construct-allowed-dates value)))
|
||||||
|
@ -782,9 +776,9 @@ When COLUMNS-FMT-STRING is non-nil, use it as the column format."
|
||||||
(save-restriction
|
(save-restriction
|
||||||
(when (and (not global) (org-at-heading-p))
|
(when (and (not global) (org-at-heading-p))
|
||||||
(narrow-to-region (point) (org-end-of-subtree t t)))
|
(narrow-to-region (point) (org-end-of-subtree t t)))
|
||||||
(when (assoc-string "CLOCKSUM" org-columns-current-fmt-compiled t)
|
(when (assoc "CLOCKSUM" org-columns-current-fmt-compiled)
|
||||||
(org-clock-sum))
|
(org-clock-sum))
|
||||||
(when (assoc-string "CLOCKSUM_T" org-columns-current-fmt-compiled t)
|
(when (assoc "CLOCKSUM_T" org-columns-current-fmt-compiled)
|
||||||
(org-clock-sum-today))
|
(org-clock-sum-today))
|
||||||
(let ((cache
|
(let ((cache
|
||||||
;; Collect contents of columns ahead of time so as to
|
;; Collect contents of columns ahead of time so as to
|
||||||
|
@ -871,9 +865,7 @@ When COLUMNS-FMT-STRING is non-nil, use it as the column format."
|
||||||
(let* ((n (current-column))
|
(let* ((n (current-column))
|
||||||
(entry (nth n org-columns-current-fmt-compiled))
|
(entry (nth n org-columns-current-fmt-compiled))
|
||||||
(width (or (nth 2 entry)
|
(width (or (nth 2 entry)
|
||||||
(cdr (assoc-string (car entry)
|
(cdr (assoc (car entry) org-columns-current-maxwidths)))))
|
||||||
org-columns-current-maxwidths
|
|
||||||
t)))))
|
|
||||||
(setq width (max 1 (+ width arg)))
|
(setq width (max 1 (+ width arg)))
|
||||||
(setcar (nthcdr 2 entry) width)
|
(setcar (nthcdr 2 entry) width)
|
||||||
(org-columns-store-format)
|
(org-columns-store-format)
|
||||||
|
@ -941,7 +933,7 @@ display, or in the #+COLUMNS line of the current buffer."
|
||||||
(let ((p (upcase property)))
|
(let ((p (upcase property)))
|
||||||
(dolist (ov org-columns-overlays)
|
(dolist (ov org-columns-overlays)
|
||||||
(when (let ((key (overlay-get ov 'org-columns-key)))
|
(when (let ((key (overlay-get ov 'org-columns-key)))
|
||||||
(and key (equal (upcase key) p) (overlay-start ov)))
|
(and key (equal key p) (overlay-start ov)))
|
||||||
(goto-char (overlay-start ov))
|
(goto-char (overlay-start ov))
|
||||||
(let ((value (cdr
|
(let ((value (cdr
|
||||||
(assoc-string
|
(assoc-string
|
||||||
|
@ -1002,11 +994,11 @@ COMPILED is an alist, as returned by
|
||||||
|
|
||||||
The alist has one entry for each column in the format. The elements of
|
The alist has one entry for each column in the format. The elements of
|
||||||
that list are:
|
that list are:
|
||||||
property the property name
|
property the property name, as an upper-case string
|
||||||
title the title field for the columns
|
title the title field for the columns, as a string
|
||||||
width the column width in characters, can be nil for automatic
|
width the column width in characters, can be nil for automatic width
|
||||||
operator the summary operator if any
|
operator the summary operator, as a string, or nil
|
||||||
printf a printf format for computed values
|
printf a printf format for computed values, as a string, or nil
|
||||||
fun the lisp function to compute summary values, derived from operator
|
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'."
|
||||||
|
@ -1018,19 +1010,19 @@ This function updates `org-columns-current-fmt-compiled'."
|
||||||
fmt start)
|
fmt start)
|
||||||
(setq start (match-end 0))
|
(setq start (match-end 0))
|
||||||
(let* ((width (and (match-end 1) (string-to-number (match-string 1 fmt))))
|
(let* ((width (and (match-end 1) (string-to-number (match-string 1 fmt))))
|
||||||
(prop (match-string 2 fmt))
|
(prop (match-string-no-properties 2 fmt))
|
||||||
(title (or (match-string 3 fmt) prop))
|
(title (or (match-string-no-properties 3 fmt) prop))
|
||||||
(operator (match-string 4 fmt)))
|
(operator (match-string-no-properties 4 fmt)))
|
||||||
(push (if (not operator) (list prop title width nil nil nil)
|
(push (if (not operator) (list (upcase prop) title width nil 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* ((summarize
|
(let* ((summary
|
||||||
(or (org-columns--summarize operator)
|
(or (org-columns--summarize operator)
|
||||||
(user-error "Cannot find %S summary function"
|
(user-error "Cannot find %S summary function"
|
||||||
operator))))
|
operator))))
|
||||||
(list prop title width operator printf summarize))))
|
(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))))
|
||||||
|
@ -1291,7 +1283,7 @@ other rows. Each row is a list of fields, as strings, or
|
||||||
(org-columns (not local) format)
|
(org-columns (not local) format)
|
||||||
(goto-char org-columns-top-level-marker)
|
(goto-char org-columns-top-level-marker)
|
||||||
(let ((columns (length org-columns-current-fmt-compiled))
|
(let ((columns (length org-columns-current-fmt-compiled))
|
||||||
(has-item (assoc-string "ITEM" org-columns-current-fmt-compiled t))
|
(has-item (assoc "ITEM" org-columns-current-fmt-compiled))
|
||||||
table)
|
table)
|
||||||
(org-map-entries
|
(org-map-entries
|
||||||
(lambda ()
|
(lambda ()
|
||||||
|
@ -1302,7 +1294,7 @@ other rows. Each row is a list of fields, as strings, or
|
||||||
(p (get-char-property col 'org-columns-key)))
|
(p (get-char-property col 'org-columns-key)))
|
||||||
(push (org-quote-vert
|
(push (org-quote-vert
|
||||||
(get-char-property col
|
(get-char-property col
|
||||||
(if (string= (upcase p) "ITEM")
|
(if (string= p "ITEM")
|
||||||
'org-columns-value
|
'org-columns-value
|
||||||
'org-columns-value-modified)))
|
'org-columns-value-modified)))
|
||||||
row)))
|
row)))
|
||||||
|
@ -1384,7 +1376,7 @@ PARAMS is a property list of parameters:
|
||||||
;; required, and possibly precede some of them with a horizontal
|
;; required, and possibly precede some of them with a horizontal
|
||||||
;; rule.
|
;; rule.
|
||||||
(let ((item-index
|
(let ((item-index
|
||||||
(let ((p (assoc-string "ITEM" org-columns-current-fmt-compiled t)))
|
(let ((p (assoc "ITEM" org-columns-current-fmt-compiled)))
|
||||||
(and p (cl-position p
|
(and p (cl-position p
|
||||||
org-columns-current-fmt-compiled
|
org-columns-current-fmt-compiled
|
||||||
:test #'equal))))
|
:test #'equal))))
|
||||||
|
@ -1528,7 +1520,7 @@ This will add overlays to the date lines, to show the summary for each day."
|
||||||
(lambda (spec)
|
(lambda (spec)
|
||||||
(pcase spec
|
(pcase spec
|
||||||
(`(,property ,title ,width . ,_)
|
(`(,property ,title ,width . ,_)
|
||||||
(if (member-ignore-case property '("CLOCKSUM" "CLOCKSUM_T"))
|
(if (member property '("CLOCKSUM" "CLOCKSUM_T"))
|
||||||
(let ((summarize (org-columns--summarize ":")))
|
(let ((summarize (org-columns--summarize ":")))
|
||||||
(list property title width ":" nil summarize))
|
(list property title width ":" nil summarize))
|
||||||
spec))))
|
spec))))
|
||||||
|
@ -1555,24 +1547,22 @@ This will add overlays to the date lines, to show the summary for each day."
|
||||||
(mapcar
|
(mapcar
|
||||||
(lambda (spec)
|
(lambda (spec)
|
||||||
(pcase spec
|
(pcase spec
|
||||||
(`(,(and prop (guard (equal (upcase prop) "ITEM"))) . ,_)
|
(`("ITEM" . ,_)
|
||||||
;; Replace ITEM with current date. Preserve
|
;; Replace ITEM with current date. Preserve
|
||||||
;; properties for fontification.
|
;; properties for fontification.
|
||||||
(let ((date (buffer-substring
|
(let ((date (buffer-substring
|
||||||
(line-beginning-position)
|
(line-beginning-position)
|
||||||
(line-end-position))))
|
(line-end-position))))
|
||||||
(list prop date date)))
|
(list "ITEM" date date)))
|
||||||
(`(,prop ,_ ,_ nil . ,_)
|
(`(,prop ,_ ,_ nil . ,_) (list prop "" ""))
|
||||||
(list prop "" ""))
|
|
||||||
(`(,prop ,_ ,_ ,_ ,printf ,summarize)
|
(`(,prop ,_ ,_ ,_ ,printf ,summarize)
|
||||||
(let* ((values
|
(let* ((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
|
||||||
(mapcar
|
(mapcar
|
||||||
(lambda (entry)
|
(lambda (e)
|
||||||
(org-string-nw-p
|
(org-string-nw-p (nth 1 (assoc prop e))))
|
||||||
(nth 1 (assoc-string prop entry t))))
|
|
||||||
entries)))
|
entries)))
|
||||||
(final (if values (funcall summarize values printf)
|
(final (if values (funcall summarize values printf)
|
||||||
"")))
|
"")))
|
||||||
|
@ -1600,8 +1590,8 @@ This will add overlays to the date lines, to show the summary for each day."
|
||||||
(dolist (spec fmt)
|
(dolist (spec fmt)
|
||||||
(let ((prop (car spec)))
|
(let ((prop (car spec)))
|
||||||
(cond
|
(cond
|
||||||
((equal (upcase prop) "CLOCKSUM") (org-clock-sum))
|
((equal prop "CLOCKSUM") (org-clock-sum))
|
||||||
((equal (upcase prop) "CLOCKSUM_T") (org-clock-sum-today))
|
((equal prop "CLOCKSUM_T") (org-clock-sum-today))
|
||||||
((and (nth 3 spec)
|
((and (nth 3 spec)
|
||||||
(let ((a (assoc prop org-columns-current-fmt-compiled)))
|
(let ((a (assoc prop org-columns-current-fmt-compiled)))
|
||||||
(equal (nth 3 a) (nth 3 spec))))
|
(equal (nth 3 a) (nth 3 spec))))
|
||||||
|
|
|
@ -542,7 +542,7 @@
|
||||||
(list (get-char-property (1- (point)) 'org-columns-key)
|
(list (get-char-property (1- (point)) 'org-columns-key)
|
||||||
(get-char-property (point) 'org-columns-key)
|
(get-char-property (point) 'org-columns-key)
|
||||||
(get-char-property (1+ (point)) 'org-columns-key)))))
|
(get-char-property (1+ (point)) 'org-columns-key)))))
|
||||||
;; Update #+COLUMNS: keyword if needed.
|
;; Update #+COLUMNS keyword if needed.
|
||||||
(should
|
(should
|
||||||
(equal "#+COLUMNS: %FOO %ITEM"
|
(equal "#+COLUMNS: %FOO %ITEM"
|
||||||
(org-test-with-temp-text "#+COLUMNS: %ITEM\n<point>* H"
|
(org-test-with-temp-text "#+COLUMNS: %ITEM\n<point>* H"
|
||||||
|
@ -557,6 +557,15 @@
|
||||||
(forward-char)
|
(forward-char)
|
||||||
(org-columns-new "FOO")
|
(org-columns-new "FOO")
|
||||||
(goto-char (point-min))
|
(goto-char (point-min))
|
||||||
|
(buffer-substring-no-properties (point) (line-end-position)))))
|
||||||
|
;; Mind case when updating #+COLUMNS.
|
||||||
|
(should
|
||||||
|
(equal "#+COLUMNS: %ITEM %Foo %BAR"
|
||||||
|
(org-test-with-temp-text "#+COLUMNS: %ITEM %BAR\n<point>* H"
|
||||||
|
(let ((org-columns-default-format "%ITEM %BAR")) (org-columns))
|
||||||
|
(forward-char)
|
||||||
|
(org-columns-new "Foo")
|
||||||
|
(goto-char (point-min))
|
||||||
(buffer-substring-no-properties (point) (line-end-position))))))
|
(buffer-substring-no-properties (point) (line-end-position))))))
|
||||||
|
|
||||||
(ert-deftest test-org-colview/columns-update ()
|
(ert-deftest test-org-colview/columns-update ()
|
||||||
|
@ -576,6 +585,21 @@
|
||||||
(insert "2")
|
(insert "2")
|
||||||
(org-columns-update "A")
|
(org-columns-update "A")
|
||||||
(get-char-property (point-min) 'display))))
|
(get-char-property (point-min) 'display))))
|
||||||
|
;; Update is case-insensitive.
|
||||||
|
(should
|
||||||
|
(equal
|
||||||
|
"12 |"
|
||||||
|
(org-test-with-temp-text
|
||||||
|
"* H
|
||||||
|
:PROPERTIES:
|
||||||
|
:A: 1
|
||||||
|
:END:
|
||||||
|
"
|
||||||
|
(let ((org-columns-default-format "%5A")) (org-columns))
|
||||||
|
(search-forward "1")
|
||||||
|
(insert "2")
|
||||||
|
(org-columns-update "a")
|
||||||
|
(get-char-property (point-min) 'display))))
|
||||||
;; Update stored values.
|
;; Update stored values.
|
||||||
(should
|
(should
|
||||||
(equal
|
(equal
|
||||||
|
|
Loading…
Reference in New Issue