diff options
author | Nicolas Goaziou <mail@nicolasgoaziou.fr> | 2016-02-17 22:38:39 +0100 |
---|---|---|
committer | Nicolas Goaziou <mail@nicolasgoaziou.fr> | 2016-02-17 22:49:19 +0100 |
commit | 9e3090a5a0d355ea5fe1e9f5ad57f2e59f6319c5 (patch) | |
tree | c0f7a5a566b8997d0b519621a73e45160c73887f | |
parent | c158bf2f1679b1a3d6ab777784ee69e339f382d6 (diff) | |
download | org-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.el | 79 | ||||
-rw-r--r-- | testing/lisp/test-org-colview.el | 52 |
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 |