diff options
author | Nicolas Goaziou <mail@nicolasgoaziou.fr> | 2016-02-22 10:48:00 +0100 |
---|---|---|
committer | Nicolas Goaziou <mail@nicolasgoaziou.fr> | 2016-02-22 22:15:13 +0100 |
commit | ebf7bbb308af8f7ee94773f70387141e2a2c3697 (patch) | |
tree | 4b0dbde0eee42ad03b3846f518be535ad849e857 | |
parent | 92443160fd248467a519552411dbcf32dc72de16 (diff) | |
download | org-mode-ebf7bbb308af8f7ee94773f70387141e2a2c3697.tar.gz |
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'.
-rw-r--r-- | lisp/org-colview.el | 80 | ||||
-rw-r--r-- | testing/lisp/test-org-colview.el | 26 |
2 files changed, 60 insertions, 46 deletions
diff --git a/lisp/org-colview.el b/lisp/org-colview.el index 65223d8..538435f 100644 --- a/lisp/org-colview.el +++ b/lisp/org-colview.el @@ -226,9 +226,9 @@ initialized." ((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)) + (nth 1 (assoc property org-columns-current-fmt-compiled)) value))) - ((equal (upcase property) "ITEM") + ((equal property "ITEM") (concat (make-string (1- (org-current-level)) (if org-hide-leading-stars ?\s ?*)) "* " @@ -249,14 +249,13 @@ initialized." (mapcar (lambda (spec) (let* ((p (car spec)) - (v (or (cdr (assoc-string - p (get-text-property (point) 'org-summaries) t)) + (v (or (cdr (assoc p (get-text-property (point) 'org-summaries))) (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)) + (string= p (upcase org-effort-property)) (get-text-property (point) 'duration) (org-propertize (org-minutes-to-clocksum-string @@ -279,7 +278,7 @@ WIDTH as an integer greater than 0." ;; 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)))) + (let ((value (nth 2 (assoc property (cdr entry))))) (setq width (max (length value) width))))))))) org-columns-current-fmt-compiled)) @@ -300,7 +299,7 @@ WIDTH as an integer greater than 0." "Return text " (format fmt (let ((v (org-columns-add-ellipses value width))) - (pcase (upcase property) + (pcase property ("PRIORITY" (propertize v 'face (org-get-priority-face original))) ("TAGS" @@ -347,9 +346,7 @@ argument DATELINE is non-nil when the face used should be (dolist (column columns) (pcase column (`(,property ,original ,value) - (let* ((width - (cdr - (assoc-string property org-columns-current-maxwidths t))) + (let* ((width (cdr (assoc property org-columns-current-maxwidths))) (fmt (format (if (= (point) limit) "%%-%d.%ds |" "%%-%d.%ds | ") width width)) @@ -416,8 +413,7 @@ for the duration of the command.") (dolist (column org-columns-current-fmt-compiled) (pcase column (`(,property ,name . ,_) - (let* ((width - (cdr (assoc-string property org-columns-current-maxwidths t))) + (let* ((width (cdr (assoc property org-columns-current-maxwidths))) (fmt (format "%%-%d.%ds | " width width))) (setq title (concat title (format fmt (or name property)))))))) (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 (allowed (or (org-property-get-allowed-values pom key) - (and (member (nth 3 (assoc-string key - org-columns-current-fmt-compiled - t)) + (and (member (nth 3 (assoc key org-columns-current-fmt-compiled)) '("X" "X/" "X%")) '("[ ]" "[X]")) (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 (when (and (not global) (org-at-heading-p)) (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)) - (when (assoc-string "CLOCKSUM_T" org-columns-current-fmt-compiled t) + (when (assoc "CLOCKSUM_T" org-columns-current-fmt-compiled) (org-clock-sum-today)) (let ((cache ;; 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)) (entry (nth n org-columns-current-fmt-compiled)) (width (or (nth 2 entry) - (cdr (assoc-string (car entry) - org-columns-current-maxwidths - t))))) + (cdr (assoc (car entry) org-columns-current-maxwidths))))) (setq width (max 1 (+ width arg))) (setcar (nthcdr 2 entry) width) (org-columns-store-format) @@ -941,7 +933,7 @@ display, or in the #+COLUMNS line of the current buffer." (let ((p (upcase property))) (dolist (ov org-columns-overlays) (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)) (let ((value (cdr (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 that list are: -property the property name -title the title field for the columns -width the column width in characters, can be nil for automatic -operator the summary operator if any -printf a printf format for computed values +property the property name, as an upper-case string +title the title field for the columns, as a string +width the column width in characters, can be nil for automatic width +operator the summary operator, 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'." @@ -1018,19 +1010,19 @@ This function updates `org-columns-current-fmt-compiled'." fmt start) (setq start (match-end 0)) (let* ((width (and (match-end 1) (string-to-number (match-string 1 fmt)))) - (prop (match-string 2 fmt)) - (title (or (match-string 3 fmt) prop)) - (operator (match-string 4 fmt))) - (push (if (not operator) (list prop title width nil nil nil) + (prop (match-string-no-properties 2 fmt)) + (title (or (match-string-no-properties 3 fmt) prop)) + (operator (match-string-no-properties 4 fmt))) + (push (if (not operator) (list (upcase prop) title width nil nil nil) (let (printf) (when (string-match ";" operator) (setq printf (substring operator (match-end 0))) (setq operator (substring operator 0 (match-beginning 0)))) - (let* ((summarize + (let* ((summary (or (org-columns--summarize operator) (user-error "Cannot find %S summary function" operator)))) - (list prop title width operator printf summarize)))) + (list (upcase prop) title width operator printf summary)))) org-columns-current-fmt-compiled))) (setq 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) (goto-char org-columns-top-level-marker) (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) (org-map-entries (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))) (push (org-quote-vert (get-char-property col - (if (string= (upcase p) "ITEM") + (if (string= p "ITEM") 'org-columns-value 'org-columns-value-modified))) row))) @@ -1384,7 +1376,7 @@ PARAMS is a property list of parameters: ;; required, and possibly precede some of them with a horizontal ;; rule. (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 org-columns-current-fmt-compiled :test #'equal)))) @@ -1528,7 +1520,7 @@ This will add overlays to the date lines, to show the summary for each day." (lambda (spec) (pcase spec (`(,property ,title ,width . ,_) - (if (member-ignore-case property '("CLOCKSUM" "CLOCKSUM_T")) + (if (member property '("CLOCKSUM" "CLOCKSUM_T")) (let ((summarize (org-columns--summarize ":"))) (list property title width ":" nil summarize)) spec)))) @@ -1555,24 +1547,22 @@ This will add overlays to the date lines, to show the summary for each day." (mapcar (lambda (spec) (pcase spec - (`(,(and prop (guard (equal (upcase prop) "ITEM"))) . ,_) + (`("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 "" "")) + (list "ITEM" date date))) + (`(,prop ,_ ,_ nil . ,_) (list prop "" "")) (`(,prop ,_ ,_ ,_ ,printf ,summarize) (let* ((values ;; Use real values for summary, not those ;; prepared for display. (delq nil (mapcar - (lambda (entry) - (org-string-nw-p - (nth 1 (assoc-string prop entry t)))) + (lambda (e) + (org-string-nw-p (nth 1 (assoc prop e)))) entries))) (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) (let ((prop (car spec))) (cond - ((equal (upcase prop) "CLOCKSUM") (org-clock-sum)) - ((equal (upcase prop) "CLOCKSUM_T") (org-clock-sum-today)) + ((equal prop "CLOCKSUM") (org-clock-sum)) + ((equal prop "CLOCKSUM_T") (org-clock-sum-today)) ((and (nth 3 spec) (let ((a (assoc prop org-columns-current-fmt-compiled))) (equal (nth 3 a) (nth 3 spec)))) diff --git a/testing/lisp/test-org-colview.el b/testing/lisp/test-org-colview.el index a25c24b..0fa517a 100644 --- a/testing/lisp/test-org-colview.el +++ b/testing/lisp/test-org-colview.el @@ -542,7 +542,7 @@ (list (get-char-property (1- (point)) 'org-columns-key) (get-char-property (point) 'org-columns-key) (get-char-property (1+ (point)) 'org-columns-key))))) - ;; Update #+COLUMNS: keyword if needed. + ;; Update #+COLUMNS keyword if needed. (should (equal "#+COLUMNS: %FOO %ITEM" (org-test-with-temp-text "#+COLUMNS: %ITEM\n<point>* H" @@ -557,6 +557,15 @@ (forward-char) (org-columns-new "FOO") (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)))))) (ert-deftest test-org-colview/columns-update () @@ -576,6 +585,21 @@ (insert "2") (org-columns-update "A") (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. (should (equal |