summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorNicolas Goaziou <mail@nicolasgoaziou.fr>2015-07-18 09:39:23 +0200
committerNicolas Goaziou <mail@nicolasgoaziou.fr>2015-07-18 09:39:23 +0200
commitcf5cb157435dc4495918017791e9063ffb260ba9 (patch)
tree534025e094db71f373583ef2ac268e4080e6f819
parentf6b51781568570995399ab2214ce38d8a38a4280 (diff)
downloadorg-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.el179
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."