summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorNicolas Goaziou <mail@nicolasgoaziou.fr>2016-02-17 22:38:39 +0100
committerNicolas Goaziou <mail@nicolasgoaziou.fr>2016-02-17 22:49:19 +0100
commit9e3090a5a0d355ea5fe1e9f5ad57f2e59f6319c5 (patch)
treec0f7a5a566b8997d0b519621a73e45160c73887f
parentc158bf2f1679b1a3d6ab777784ee69e339f382d6 (diff)
downloadorg-mode-9e3090a5a0d355ea5fe1e9f5ad57f2e59f6319c5.tar.gz
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.
-rw-r--r--lisp/org-colview.el79
-rw-r--r--testing/lisp/test-org-colview.el52
2 files changed, 97 insertions, 34 deletions
diff --git a/lisp/org-colview.el b/lisp/org-colview.el
index c5bf011..1570910 100644
--- a/lisp/org-colview.el
+++ b/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))
diff --git a/testing/lisp/test-org-colview.el b/testing/lisp/test-org-colview.el
index 642d372..9fe8ebd 100644
--- a/testing/lisp/test-org-colview.el
+++ b/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