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:
Nicolas Goaziou 2016-02-22 10:48:00 +01:00
parent 92443160fd
commit ebf7bbb308
2 changed files with 60 additions and 46 deletions

View File

@ -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))))

View File

@ -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