Selaa lähdekoodia

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'.
Nicolas Goaziou 9 vuotta sitten
vanhempi
commit
ebf7bbb308
2 muutettua tiedostoa jossa 60 lisäystä ja 46 poistoa
  1. 35 45
      lisp/org-colview.el
  2. 25 1
      testing/lisp/test-org-colview.el

+ 35 - 45
lisp/org-colview.el

@@ -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
-			 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)
 		   (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
-		     (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 |"
 		    (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
-		 (cdr (assoc-string property org-columns-current-maxwidths t)))
+	 (let* ((width (cdr (assoc property org-columns-current-maxwidths)))
 		(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
-						org-columns-current-fmt-compiled
-						t))
+	      (and (member (nth 3 (assoc key org-columns-current-fmt-compiled))
 			   '("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)
-				       org-columns-current-maxwidths
-				       t)))))
+		    (cdr (assoc (car entry) org-columns-current-maxwidths)))))
     (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
-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
 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))
-	     (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)
 		(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)))
-		  (`(,prop ,_ ,_ nil . ,_)
-		   (list prop "" ""))
+		     (list "ITEM" date date)))
+		  (`(,prop ,_ ,_ nil . ,_) (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)
-				    (org-string-nw-p
-				     (nth 1 (assoc-string prop entry t))))
+				  (lambda (e)
+				    (org-string-nw-p (nth 1 (assoc prop e))))
 				  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 (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)
 		((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))))

+ 25 - 1
testing/lisp/test-org-colview.el

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