mirror of
https://git.savannah.gnu.org/git/emacs/org-mode.git
synced 2024-09-29 19:37:52 +00:00
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>
This commit is contained in:
Nicolas Goaziou
parent
f6b5178156
commit
cf5cb15743
|
|
@ -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."
|
||||
|
|
|
|||
Loading…
Reference in a new issue