1
0
mirror of https://git.savannah.gnu.org/git/emacs/org-mode.git synced 2025-02-08 21:38:10 +00:00

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.
This commit is contained in:
Nicolas Goaziou 2016-02-17 22:38:39 +01:00
parent c158bf2f16
commit 9e3090a5a0
2 changed files with 97 additions and 34 deletions

View File

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

View File

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