[RFC][PATCH] emacs: Use text properties rather than overlays in various places.

[David Edmondson]

Except for where invisibility is involved, replace the use of overlays
with text properties, which are considerably more efficient.
---

Probably just for aficionados at the moment...

Given that clashes between overlays and text properties are a problem
and overlays are considered expensive, switching to text properties
makes sense. For example, the coloured tags in the headerline are back
with this patch.

The remaining overlays are used where invisibility is
involved. Replacing them for this is difficult, as there is no
integration between isearch and invisible text properties.

Using properties for indentation (and perhaps later for cited regions)
is interesting, but I haven't got that to work properly yet. It looks
like a bug in the display engine at first, which I've filed.

(This is on top of all of the other patches I've sent.)

 emacs/notmuch-lib.el  |   16 +++--------
 emacs/notmuch-show.el |   68 +++++++++++++++++++++++++++++++++----------------
 emacs/notmuch-wash.el |    8 ++++-
 3 files changed, 57 insertions(+), 35 deletions(-)

diff --git a/emacs/notmuch-lib.el b/emacs/notmuch-lib.el
index 1f00fe0..843668f 100644
--- a/emacs/notmuch-lib.el
+++ b/emacs/notmuch-lib.el
@@ -98,21 +98,15 @@ the user hasn't set this variable with the old or new value."
 
 (defun notmuch-color-line (start end line-tag-list spec)
   "Colorize a line based on tags."
-  ;; Create the overlay only if the message has tags which match one
-  ;; of those specified in `spec'.
-  (let (overlay)
+  (let (face-spec)
     (mapc (lambda (elem)
 	    (let ((tag (car elem))
 		  (attributes (cdr elem)))
 	      (when (member tag line-tag-list)
-		(when (not overlay)
-		  (setq overlay (make-overlay start end))
-		  (overlay-put overlay 'priority 5))
-		;; Merge the specified properties with any already
-		;; applied from an earlier match.
-		(overlay-put overlay 'face
-			     (append (overlay-get overlay 'face) attributes)))))
-	  spec)))
+		(setq face-spec (append attributes face-spec)))))
+	  spec)
+    (when face-spec
+      (put-text-property start end 'face face-spec))))
 
 ;;
 
diff --git a/emacs/notmuch-show.el b/emacs/notmuch-show.el
index 0885bd5..ca157ad 100644
--- a/emacs/notmuch-show.el
+++ b/emacs/notmuch-show.el
@@ -216,10 +216,10 @@ indentation."
 	       (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."
@@ -236,9 +236,11 @@ indentation."
   "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 "(" (mapconcat 'identity tags " ") ")"))))))
+    (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
@@ -286,18 +288,27 @@ unchanged ADDRESS if parsing fails."
 (defun notmuch-show-insert-headerline (headers date tags depth)
   "Insert a notmuch style headerline based on HEADERS for a
 message at DEPTH in the current thread."
-  (let ((start (point))
-	overlay)
-    (insert (notmuch-show-spaces-n (* notmuch-indent-messages-width depth))
-	    (notmuch-show-clean-address (plist-get headers :From))
-	    " ("
-	    date
-	    ") ("
-	    (mapconcat 'identity tags " ")
-	    ")\n")
-    (setq overlay (make-overlay start (point)))
-    (overlay-put overlay 'face 'notmuch-message-summary-face)
-    (overlay-put overlay 'priority 2)))
+  (let ((start (point)))
+    (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."
@@ -795,11 +806,24 @@ current buffer, if possible."
     (setq body-end (point-marker))
     (setq content-end (point-marker))
 
-    ;; Indent according to the depth in the thread.
-    (indent-rigidly content-start content-end (* notmuch-indent-messages-width depth))
-
     (setq message-end (point-max-marker))
 
+    ;; Indent according to the depth in the thread.
+    ;;
+    ;; It would be convenient to use text properties to achieve the
+    ;; indentation:
+    ;;
+    ;; (let ((leader (notmuch-show-spaces-n (* notmuch-indent-messages-width depth))))
+    ;;   (put-text-property message-start message-end 'line-prefix leader)
+    ;;   (put-text-property message-start message-end 'wrap-prefix leader))
+    ;;
+    ;; but the face used for the line-prefix of such regions appears
+    ;; incorrect (or at least, not what we want here). Until that can
+    ;; be figured out, just insert leading spaces. (Note that the
+    ;; wrap-prefix regions use the correct face.)
+    (indent-rigidly message-start message-end
+    		    (* notmuch-indent-messages-width depth))
+
     ;; Save the extents of this message over the whole text of the
     ;; message.
     (put-text-property message-start message-end :notmuch-message-extent (cons message-start message-end))
diff --git a/emacs/notmuch-wash.el b/emacs/notmuch-wash.el
index 1f420b2..2b2f0f5 100644
--- a/emacs/notmuch-wash.el
+++ b/emacs/notmuch-wash.el
@@ -183,7 +183,9 @@ insert before the button, probably for indentation."
     (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))
@@ -205,7 +207,9 @@ insert before the button, probably for indentation."
 		  (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" "\n"))))))
-- 
1.7.7.3