Browse Source

org-colview: Fix `org-columns-update'

* lisp/org-colview.el (org-columns--overlay-text): New function.
(org-columns--display-here): Use new function.
(org-columns-update): Properly handle additional decorations to
displayed values (e.g., ellipses).

* testing/lisp/test-org-colview.el (test-org-colview/columns-update):
  New test.
Nicolas Goaziou 9 years ago
parent
commit
9e3090a5a0
2 changed files with 97 additions and 34 deletions
  1. 45 34
      lisp/org-colview.el
  2. 52 0
      testing/lisp/test-org-colview.el

+ 45 - 34
lisp/org-colview.el

@@ -244,6 +244,23 @@ WIDTH as an integer greater than 0."
     (push ov org-columns-overlays)
     (push ov org-columns-overlays)
     ov))
     ov))
 
 
+(defun org-columns--overlay-text (value fmt width property original)
+  "Return text "
+  (format fmt
+          (let ((v (org-columns-add-ellipses value width)))
+            (pcase (upcase property)
+              ("PRIORITY"
+               (propertize v 'face (org-get-priority-face original)))
+              ("TAGS"
+               (if (not org-tags-special-faces-re)
+                   (propertize v 'face 'org-tag)
+                 (replace-regexp-in-string
+                  org-tags-special-faces-re
+                  (lambda (m) (propertize m 'face (org-get-tag-face m)))
+                  v nil nil 1)))
+              ("TODO" (propertize v 'face (org-get-todo-face original)))
+              (_ v)))))
+
 (defun org-columns--display-here (columns &optional dateline)
 (defun org-columns--display-here (columns &optional dateline)
   "Overlay the current line with column display.
   "Overlay the current line with column display.
 COLUMNS is an alist (PROPERTY VALUE DISPLAYED).  Optional
 COLUMNS is an alist (PROPERTY VALUE DISPLAYED).  Optional
@@ -284,26 +301,11 @@ argument DATELINE is non-nil when the face used should be
 		    (fmt (format (if (= (point) limit) "%%-%d.%ds |"
 		    (fmt (format (if (= (point) limit) "%%-%d.%ds |"
 				   "%%-%d.%ds | ")
 				   "%%-%d.%ds | ")
 				 width width))
 				 width width))
-		    (text
-		     (format
-		      fmt
-		      (let ((v (org-columns-add-ellipses value width)))
-			(pcase (upcase property)
-			  ("PRIORITY"
-			   (propertize v 'face (org-get-priority-face original)))
-			  ("TAGS"
-			   (if (not org-tags-special-faces-re)
-			       (propertize v 'face 'org-tag)
-			     (replace-regexp-in-string
-			      org-tags-special-faces-re
-			      (lambda (m)
-				(propertize m 'face (org-get-tag-face m)))
-			      v nil nil 1)))
-			  ("TODO"
-			   (propertize v 'face (org-get-todo-face original)))
-			  (_ v)))))
 		    (ov (org-columns-new-overlay
 		    (ov (org-columns-new-overlay
-			 (point) (1+ (point)) text (if dateline face1 face))))
+			 (point) (1+ (point))
+			 (org-columns--overlay-text
+			  value fmt width property original)
+			 (if dateline face1 face))))
 	       (overlay-put ov 'keymap org-columns-map)
 	       (overlay-put ov 'keymap org-columns-map)
 	       (overlay-put ov 'org-columns-key property)
 	       (overlay-put ov 'org-columns-key property)
 	       (overlay-put ov 'org-columns-value original)
 	       (overlay-put ov 'org-columns-value original)
@@ -922,21 +924,30 @@ display, or in the #+COLUMNS line of the current buffer."
 (defun org-columns-update (property)
 (defun org-columns-update (property)
   "Recompute PROPERTY, and update the columns display for it."
   "Recompute PROPERTY, and update the columns display for it."
   (org-columns-compute property)
   (org-columns-compute property)
-  (let (fmt val pos)
-    (save-excursion
-      (mapc (lambda (ov)
-	      (when (equal (overlay-get ov 'org-columns-key) property)
-		(setq pos (overlay-start ov))
-		(goto-char pos)
-		(when (setq val (cdr (assoc-string
-				      property
-				      (get-text-property
-				       (point-at-bol) 'org-summaries)
-				      t)))
-		  (setq fmt (overlay-get ov 'org-columns-format))
-		  (overlay-put ov 'org-columns-value val)
-		  (overlay-put ov 'display (format fmt val)))))
-	    org-columns-overlays))))
+  (org-with-wide-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)))
+	 (goto-char (overlay-start ov))
+	 (let ((value (cdr
+		       (assoc-string
+			property
+			(get-text-property (line-beginning-position)
+					   'org-summaries)
+			t))))
+	   (when value
+	     (let ((displayed (org-columns--displayed-value property value))
+		   (format (overlay-get ov 'org-columns-format))
+		   (width (cdr (assoc-string property
+					     org-columns-current-maxwidths
+					     t))))
+	       (overlay-put ov 'org-columns-value value)
+	       (overlay-put ov 'org-columns-value-modified displayed)
+	       (overlay-put ov
+			    'display
+			    (org-columns--overlay-text
+			     displayed format width property value))))))))))
 
 
 (defvar org-inlinetask-min-level
 (defvar org-inlinetask-min-level
   (if (featurep 'org-inlinetask) org-inlinetask-min-level 15))
   (if (featurep 'org-inlinetask) org-inlinetask-min-level 15))

+ 52 - 0
testing/lisp/test-org-colview.el

@@ -485,6 +485,58 @@
       (let ((org-columns-default-format "%A{est+}")) (org-columns))
       (let ((org-columns-default-format "%A{est+}")) (org-columns))
       (get-char-property (point) 'org-columns-value-modified)))))
       (get-char-property (point) 'org-columns-value-modified)))))
 
 
+(ert-deftest test-org-colview/columns-update ()
+  "Test `org-columns-update' specifications."
+  ;; Update display.
+  (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
+    '("12" "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")
+      (list (get-char-property (point-min) 'org-columns-value)
+	    (get-char-property (point-min) 'org-columns-value-modified)))))
+  ;; Ensure additional processing is done (e.g., ellipses, special
+  ;; keywords fontification...).
+  (should
+   (equal
+    "ve.. |"
+    (org-test-with-temp-text
+	"* H
+:PROPERTIES:
+:A: text
+:END:
+"
+      (let ((org-columns-default-format "%4A")
+	    (org-columns-ellipses ".."))
+	(org-columns))
+      (search-forward ":A: ")
+      (insert "very long ")
+      (org-columns-update "A")
+      (get-char-property (point-min) 'display)))))
+
 
 
 
 
 ;;; Dynamic block
 ;;; Dynamic block