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 5 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)
     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)
   "Overlay the current line with column display.
 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 |"
 				   "%%-%d.%ds | ")
 				 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
-			 (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 'org-columns-key property)
 	       (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)
   "Recompute PROPERTY, and update the columns display for it."
   (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
   (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))
       (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