diff options
author | Nicolas Goaziou <mail@nicolasgoaziou.fr> | 2015-07-18 09:39:23 +0200 |
---|---|---|
committer | Nicolas Goaziou <mail@nicolasgoaziou.fr> | 2015-07-18 09:39:23 +0200 |
commit | cf5cb157435dc4495918017791e9063ffb260ba9 (patch) | |
tree | 534025e094db71f373583ef2ac268e4080e6f819 | |
parent | f6b51781568570995399ab2214ce38d8a38a4280 (diff) | |
download | org-mode-cf5cb157435dc4495918017791e9063ffb260ba9.tar.gz |
org-colview: Do not silently modify buffer
* lisp/org-colview.el (org-columns-display-here): Do not modify buffer
silently. Small refactoring.
Reported-by: Nicolas Richard <youngfrog@members.fsf.org>
<http://permalink.gmane.org/gmane.emacs.orgmode/98992>
-rw-r--r-- | lisp/org-colview.el | 179 |
1 files changed, 92 insertions, 87 deletions
diff --git a/lisp/org-colview.el b/lisp/org-colview.el index bc6b2dd..b88cb77 100644 --- a/lisp/org-colview.el +++ b/lisp/org-colview.el @@ -158,94 +158,99 @@ This is the compiled version of the format.") (defun org-columns-display-here (&optional props dateline) "Overlay the current line with column display." (interactive) - (let* ((fmt org-columns-current-fmt-compiled) - (beg (point-at-bol)) - (level-face (save-excursion - (beginning-of-line 1) - (and (looking-at "\\(\\**\\)\\(\\* \\)") - (org-get-level-face 2)))) - (ref-face (or level-face - (and (eq major-mode 'org-agenda-mode) - (get-text-property (point-at-bol) 'face)) - 'default)) - (color (list :foreground (face-attribute ref-face :foreground))) - (font (list :height (face-attribute 'default :height) - :family (face-attribute 'default :family))) - (face (list color font 'org-column ref-face)) - (face1 (list color font 'org-agenda-column-dateline ref-face)) - (cphr (get-text-property (point-at-bol) 'org-complex-heading-regexp)) - pom property ass width f fc string fm ov column val modval s2 title calc) - ;; Check if the entry is in another buffer. - (unless props - (if (eq major-mode 'org-agenda-mode) - (setq pom (or (org-get-at-bol 'org-hd-marker) - (org-get-at-bol 'org-marker)) - props (if pom (org-entry-properties pom) nil)) - (setq props (org-entry-properties nil)))) - ;; Walk the format - (while (setq column (pop fmt)) - (setq property (car column) - title (nth 1 column) - ass (assoc-string property props t) - width (or (cdr - (assoc-string property org-columns-current-maxwidths t)) - (nth 2 column) - (length property)) - f (format "%%-%d.%ds | " width width) - fm (nth 4 column) - fc (nth 5 column) - calc (nth 7 column) - val (or (cdr ass) "") - modval (cond ((and org-columns-modify-value-for-display-function - (functionp - org-columns-modify-value-for-display-function)) - (funcall org-columns-modify-value-for-display-function - title val)) - ((equal property "ITEM") - (org-columns-compact-links val)) - (fc (org-columns-number-to-string - (org-columns-string-to-number val fm) fm fc)) - ((and calc (functionp calc) - (not (string= val "")) - (not (get-text-property 0 'org-computed val))) - (org-columns-number-to-string - (funcall calc (org-columns-string-to-number - val fm)) fm)))) - (setq s2 (org-columns-add-ellipses (or modval val) width)) - (setq string (format f s2)) - ;; Create the overlay + (save-excursion + (beginning-of-line) + (let* ((level-face (and (looking-at "\\(\\**\\)\\(\\* \\)") + (org-get-level-face 2))) + (ref-face (or level-face + (and (eq major-mode 'org-agenda-mode) + (org-get-at-bol 'face)) + 'default)) + (color (list :foreground (face-attribute ref-face :foreground))) + (font (list :height (face-attribute 'default :height) + :family (face-attribute 'default :family))) + (face (list color font 'org-column ref-face)) + (face1 (list color font 'org-agenda-column-dateline ref-face)) + (pom (and (eq major-mode 'org-agenda-mode) + (or (org-get-at-bol 'org-hd-marker) + (org-get-at-bol 'org-marker)))) + (props (cond (props) + ((eq major-mode 'org-agenda-mode) + (and pom (org-entry-properties pom))) + (t (org-entry-properties))))) + ;; Each column is an overlay on top of a character. So there has + ;; to be at least as many characters available on the line as + ;; columns to display. + (let ((columns (length org-columns-current-fmt-compiled)) + (chars (- (line-end-position) (line-beginning-position)))) + (when (> columns chars) + (save-excursion + (end-of-line) + (let ((inhibit-read-only t)) + (insert (make-string (- columns chars) ?\s)))))) + ;; Walk the format. Create and install the overlay for the + ;; current column on the next character. + (dolist (column org-columns-current-fmt-compiled) + (let* ((property (car column)) + (title (nth 1 column)) + (ass (assoc-string property props t)) + (width + (or + (cdr (assoc-string property org-columns-current-maxwidths t)) + (nth 2 column) + (length property))) + (f (format "%%-%d.%ds | " width width)) + (fm (nth 4 column)) + (fc (nth 5 column)) + (calc (nth 7 column)) + (val (or (cdr ass) "")) + (modval + (cond + ((and org-columns-modify-value-for-display-function + (functionp + org-columns-modify-value-for-display-function)) + (funcall org-columns-modify-value-for-display-function + title val)) + ((equal property "ITEM") (org-columns-compact-links val)) + (fc (org-columns-number-to-string + (org-columns-string-to-number val fm) fm fc)) + ((and calc (functionp calc) + (not (string= val "")) + (not (get-text-property 0 'org-computed val))) + (org-columns-number-to-string + (funcall calc (org-columns-string-to-number val fm)) fm)))) + (string + (format f (org-columns-add-ellipses (or modval val) width))) + (ov (org-columns-new-overlay + (point) (1+ (point)) string (if dateline face1 face)))) + (overlay-put ov 'keymap org-columns-map) + (overlay-put ov 'org-columns-key property) + (overlay-put ov 'org-columns-value (cdr ass)) + (overlay-put ov 'org-columns-value-modified modval) + (overlay-put ov 'org-columns-pom pom) + (overlay-put ov 'org-columns-format f) + (overlay-put ov 'line-prefix "") + (overlay-put ov 'wrap-prefix "") + (forward-char))) + ;; Make the rest of the line disappear. + (let ((ov (org-columns-new-overlay (point) (line-end-position)))) + (overlay-put ov 'invisible t) + (overlay-put ov 'keymap org-columns-map) + (overlay-put ov 'line-prefix "") + (overlay-put ov 'wrap-prefix "")) + (let ((ov (make-overlay (1- (line-end-position)) + (line-beginning-position 2)))) + (overlay-put ov 'keymap org-columns-map) + (push ov org-columns-overlays)) (org-with-silent-modifications - (setq ov (org-columns-new-overlay - beg (setq beg (1+ beg)) string (if dateline face1 face))) - (overlay-put ov 'keymap org-columns-map) - (overlay-put ov 'org-columns-key property) - (overlay-put ov 'org-columns-value (cdr ass)) - (overlay-put ov 'org-columns-value-modified modval) - (overlay-put ov 'org-columns-pom pom) - (overlay-put ov 'org-columns-format f) - (overlay-put ov 'line-prefix "") - (overlay-put ov 'wrap-prefix "")) - (if (or (not (char-after beg)) - (equal (char-after beg) ?\n)) - (let ((inhibit-read-only t)) - (save-excursion - (goto-char beg) - (org-unmodified (insert " ")))))) ;; FIXME: add props and remove later? - ;; Make the rest of the line disappear. - (org-unmodified - (setq ov (org-columns-new-overlay beg (point-at-eol))) - (overlay-put ov 'invisible t) - (overlay-put ov 'keymap org-columns-map) - (overlay-put ov 'line-prefix "") - (overlay-put ov 'wrap-prefix "") - (push ov org-columns-overlays) - (setq ov (make-overlay (1- (point-at-eol)) (1+ (point-at-eol)))) - (overlay-put ov 'keymap org-columns-map) - (push ov org-columns-overlays) - (let ((inhibit-read-only t)) - (put-text-property (max (point-min) (1- (point-at-bol))) - (min (point-max) (1+ (point-at-eol))) - 'read-only "Type `e' to edit property"))))) + (let ((inhibit-read-only t)) + (put-text-property + (line-end-position 0) + (line-beginning-position 2) + 'read-only + (substitute-command-keys + "Type \\<org-columns-map>\\[org-columns-edit-value] \ +to edit property"))))))) (defun org-columns-add-ellipses (string width) "Truncate STRING with WIDTH characters, with ellipses." |