Selaa lähdekoodia

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>
Nicolas Goaziou 9 vuotta sitten
vanhempi
commit
cf5cb15743
1 muutettua tiedostoa jossa 92 lisäystä ja 87 poistoa
  1. 92 87
      lisp/org-colview.el

+ 92 - 87
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."