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:
parent
c158bf2f16
commit
9e3090a5a0
@ -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))
|
||||
|
@ -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
|
||||
|
Loading…
x
Reference in New Issue
Block a user