[PATCH v3 1/2] emacs: Use text properties rather than overlays in `notmuch-show-mode'.

David Edmondson dme at dme.org
Tue Feb 7 00:46:16 PST 2012


Except for where invisibility is involved, replace the use of overlays
in `notmuch-show-mode' with text properties, which are more efficient
and can be merged together more effectively.
---
 emacs/notmuch-show.el |   62 +++++++++++++++++++++++++++++++-----------------
 emacs/notmuch-wash.el |    8 ++++-
 2 files changed, 46 insertions(+), 24 deletions(-)

diff --git a/emacs/notmuch-show.el b/emacs/notmuch-show.el
index 7469e2e..bc1e7db 100644
--- a/emacs/notmuch-show.el
+++ b/emacs/notmuch-show.el
@@ -264,10 +264,10 @@ operation on the contents of the current buffer."
 	       (t
 		'message-header-other))))
 
-    (overlay-put (make-overlay (point) (re-search-forward ":"))
-		 'face 'message-header-name)
-    (overlay-put (make-overlay (point) (re-search-forward ".*$"))
-		 'face face)))
+    (put-text-property (point) (re-search-forward ":")
+		       'face 'message-header-name)
+    (put-text-property (point) (re-search-forward ".*$")
+		       'face face)))
 
 (defun notmuch-show-colour-headers ()
   "Apply some colouring to the current headers."
@@ -284,12 +284,11 @@ operation on the contents of the current buffer."
   "Update the displayed tags of the current message."
   (save-excursion
     (goto-char (notmuch-show-message-top))
-    (if (re-search-forward "(\\([^()]*\\))$" (line-end-position) t)
-	(let ((inhibit-read-only t))
-	  (replace-match (concat "("
-				 (propertize (mapconcat 'identity tags " ")
-					     'face 'notmuch-tag-face)
-				 ")"))))))
+    (when (re-search-forward "(\\([^()]*\\))$" (line-end-position) t)
+      (let ((inhibit-read-only t))
+	(replace-match (propertize (mapconcat 'identity tags " ")
+				   'face '(notmuch-tag-face notmuch-message-summary-face))
+		       nil nil nil 1)))))
 
 (defun notmuch-show-clean-address (address)
   "Try to clean a single email ADDRESS for display.  Return
@@ -352,15 +351,26 @@ unchanged ADDRESS if parsing fails."
   "Insert a notmuch style headerline based on HEADERS for a
 message at DEPTH in the current thread."
   (let ((start (point)))
-    (insert (notmuch-show-spaces-n (* notmuch-show-indent-messages-width depth))
-	    (notmuch-show-clean-address (plist-get headers :From))
-	    " ("
-	    date
-	    ") ("
-	    (propertize (mapconcat 'identity tags " ")
-			'face 'notmuch-tag-face)
-	    ")\n")
-    (overlay-put (make-overlay start (point)) 'face 'notmuch-message-summary-face)))
+    (insert
+     (propertize (concat (notmuch-show-clean-address (plist-get headers :From))
+			 " ("
+			 date
+			 ") (")
+		 'face 'notmuch-message-summary-face)
+     (propertize (mapconcat 'identity tags " ")
+		 'face '(notmuch-tag-face notmuch-message-summary-face))
+     (propertize ")\n"
+		 'face 'notmuch-message-summary-face))
+
+    ;; Ensure that any insertions at the start of this line (usually
+    ;; just spaces for indentation purposes) inherit the face of the
+    ;; rest of the line...
+    (put-text-property start (1+ start)
+		       'front-sticky '(face))
+    ;; ...and that insertions at the end of this region do _not_
+    ;; inherit the face of the rest of this line.
+    (put-text-property (1- (point)) (point)
+		       'rear-nonsticky '(face))))
 
 (defun notmuch-show-insert-header (header header-value)
   "Insert a single header."
@@ -796,8 +806,15 @@ current buffer, if possible."
 (defun notmuch-show-insert-bodypart (msg part depth)
   "Insert the body part PART at depth DEPTH in the current thread."
   (let ((content-type (downcase (plist-get part :content-type)))
-	(nth (plist-get part :id)))
-    (notmuch-show-insert-bodypart-internal msg part content-type nth depth content-type))
+	(nth (plist-get part :id))
+	(start (point)))
+    (notmuch-show-insert-bodypart-internal msg part content-type nth depth content-type)
+
+    ;; Ensure that face properties applied to text in the buffer by
+    ;; the part handler don't leak into the following text.
+    (put-text-property start (point-max)
+		       'rear-nonsticky '(face)))
+
   ;; Some of the body part handlers leave point somewhere up in the
   ;; part, so we make sure that we're down at the end.
   (goto-char (point-max))
@@ -889,7 +906,8 @@ current buffer, if possible."
     (setq content-end (point-marker))
 
     ;; Indent according to the depth in the thread.
-    (indent-rigidly content-start content-end (* notmuch-show-indent-messages-width depth))
+    (indent-rigidly message-start message-end
+    		    (* notmuch-show-indent-messages-width depth))
 
     (setq message-end (point-max-marker))
 
diff --git a/emacs/notmuch-wash.el b/emacs/notmuch-wash.el
index 56981d0..29a9d45 100644
--- a/emacs/notmuch-wash.el
+++ b/emacs/notmuch-wash.el
@@ -187,7 +187,9 @@ that PREFIX should not include a newline."
     (let* ((cite-start (match-beginning 0))
 	   (cite-end (match-end 0))
 	   (cite-lines (count-lines cite-start cite-end)))
-      (overlay-put (make-overlay cite-start cite-end) 'face 'message-cited-text)
+      (put-text-property cite-start cite-end 'face 'message-cited-text)
+      ;; Ensure that the next line doesn't inherit our face.
+      (put-text-property (1- cite-end) cite-end 'rear-nonsticky '(face))
       (when (> cite-lines (+ notmuch-wash-citation-lines-prefix
 			     notmuch-wash-citation-lines-suffix
 			     1))
@@ -209,7 +211,9 @@ that PREFIX should not include a newline."
 		  (sig-end-marker (make-marker)))
 	      (set-marker sig-start-marker sig-start)
 	      (set-marker sig-end-marker (point-max))
-	      (overlay-put (make-overlay sig-start-marker sig-end-marker) 'face 'message-cited-text)
+	      (put-text-property sig-start-marker sig-end-marker 'face 'message-cited-text)
+	      ;; Ensure that the next line doesn't inherit our face.
+	      (put-text-property (1- sig-end-marker) sig-end-marker 'rear-nonsticky '(face))
 	      (notmuch-wash-region-to-button
 	       msg sig-start-marker sig-end-marker
 	       "signature"))))))
-- 
1.7.8.3



More information about the notmuch mailing list