[Patch v4 0/8] emacs: show tag changes in buffer

[Patch v4 0/8] emacs: show tag changes in buffer

[Mark Walters]

This is v4 of this patch set. V3 is at
id:1394597397-8486-1-git-send-email-markwalters1009@gmail.com. This
addresses all the review comments from Austin.

Patches 1-3 and 6-8 are unchanged. For patch 5 I have changed the
comments slightly, tried to make the unread deleted case clearer by
using the new `bare-tag' variable, and added all three custom format
variables to the notmuch-faces group.

For patch 6 I have switched to Austin's suggested approach with the
changes mentioned in id:87pplek4v0.fsf@qmul.ac.uk and
id:87mwgih2zx.fsf@qmul.ac.uk

Best wishes

Mark


Austin Clements (2):
  emacs: Combine notmuch-combine-face-text-property{,-string}
  Make keys of notmuch-tag-formats regexps and use caching

Mark Walters (6):
  emacs: tag split customise option for format-tags into a widget
  emacs: tag: add customize for deleted/added tag formats
  emacs: show: mark tags changed since buffer loaded
  emacs: show: use orig-tags for tag display
  emacs: search: use orig-tags in search
  emacs: tree: use orig-tags in search

 emacs/notmuch-lib.el  |   35 ++++-----
 emacs/notmuch-show.el |    7 +-
 emacs/notmuch-tag.el  |  197 +++++++++++++++++++++++++++++++++++++------------
 emacs/notmuch-tree.el |   12 ++-
 emacs/notmuch.el      |   44 ++++++-----
 test/test-lib.el      |    5 ++
 6 files changed, 213 insertions(+), 87 deletions(-)

-- 
1.7.10.4

[Patch v4 1/8] emacs: Combine notmuch-combine-face-text-property{, -string}

[Mark Walters]

From: Austin Clements <amdragon@MIT.EDU>

This combines our two face combining functions into one, easy to use
function with a much shorter name: `notmuch-apply-face'.  This
function takes the full set of arguments that
`notmuch-combine-face-text-property' took, but takes them in a more
convenient order and provides smarter defaults that make the function
easy to use on both strings and buffers.
---
 emacs/notmuch-lib.el  |   35 ++++++++++++++++++-----------------
 emacs/notmuch-tag.el  |    2 +-
 emacs/notmuch-tree.el |    2 +-
 emacs/notmuch.el      |    2 +-
 4 files changed, 21 insertions(+), 20 deletions(-)

diff --git a/emacs/notmuch-lib.el b/emacs/notmuch-lib.el
index 2fefdad..fa7646f 100644
--- a/emacs/notmuch-lib.el
+++ b/emacs/notmuch-lib.el
@@ -578,23 +578,32 @@ (defun notmuch-face-ensure-list-form (face)
       face
     (list face)))
 
-(defun notmuch-combine-face-text-property (start end face &optional below object)
-  "Combine FACE into the 'face text property between START and END.
+(defun notmuch-apply-face (object face &optional below start end)
+  "Combine FACE into the 'face text property of OBJECT between START and END.
 
 This function combines FACE with any existing faces between START
-and END in OBJECT (which defaults to the current buffer).
-Attributes specified by FACE take precedence over existing
-attributes unless BELOW is non-nil.  FACE must be a face name (a
-symbol or string), a property list of face attributes, or a list
-of these.  For convenience when applied to strings, this returns
-OBJECT."
+and END in OBJECT.  Attributes specified by FACE take precedence
+over existing attributes unless BELOW is non-nil.
+
+OBJECT may be a string, a buffer, or nil (which means the current
+buffer).  If object is a string, START and END are 0-based;
+otherwise they are buffer positions (integers or markers).  FACE
+must be a face name (a symbol or string), a property list of face
+attributes, or a list of these.  If START and/or END are omitted,
+they default to the beginning/end of OBJECT.  For convenience
+when applied to strings, this returns OBJECT."
 
   ;; A face property can have three forms: a face name (a string or
   ;; symbol), a property list, or a list of these two forms.  In the
   ;; list case, the faces will be combined, with the earlier faces
   ;; taking precedent.  Here we canonicalize everything to list form
   ;; to make it easy to combine.
-  (let ((pos start)
+  (let ((pos (cond (start start)
+		   ((stringp object) 0)
+		   (t 1)))
+	(end (cond (end end)
+		   ((stringp object) (length object))
+		   (t (1+ (buffer-size object)))))
 	(face-list (notmuch-face-ensure-list-form face)))
     (while (< pos end)
       (let* ((cur (get-text-property pos 'face object))
@@ -607,14 +616,6 @@ (defun notmuch-combine-face-text-property (start end face &optional below object
 	(setq pos next))))
   object)
 
-(defun notmuch-combine-face-text-property-string (string face &optional below)
-  (notmuch-combine-face-text-property
-   0
-   (length string)
-   face
-   below
-   string))
-
 (defun notmuch-map-text-property (start end prop func &optional object)
   "Transform text property PROP using FUNC.
 
diff --git a/emacs/notmuch-tag.el b/emacs/notmuch-tag.el
index 908e7ad..41b1687 100644
--- a/emacs/notmuch-tag.el
+++ b/emacs/notmuch-tag.el
@@ -151,7 +151,7 @@ (defun notmuch-tag-format-tag (tag)
 (defun notmuch-tag-format-tags (tags &optional face)
   "Return a string representing formatted TAGS."
   (let ((face (or face 'notmuch-tag-face)))
-    (notmuch-combine-face-text-property-string
+    (notmuch-apply-face
      (mapconcat #'identity
 		;; nil indicated that the tag was deliberately hidden
 		(delq nil (mapcar #'notmuch-tag-format-tag tags))
diff --git a/emacs/notmuch-tree.el b/emacs/notmuch-tree.el
index 4f2ac02..e3aa2cd 100644
--- a/emacs/notmuch-tree.el
+++ b/emacs/notmuch-tree.el
@@ -715,7 +715,7 @@ (defun notmuch-tree-format-field-list (field-list msg)
     (dolist (spec field-list result-string)
       (let ((field-string (notmuch-tree-format-field (car spec) (cdr spec) msg)))
 	(setq result-string (concat result-string field-string))))
-    (notmuch-combine-face-text-property-string result-string face t)))
+    (notmuch-apply-face result-string face t)))
 
 (defun notmuch-tree-insert-msg (msg)
   "Insert the message MSG according to notmuch-tree-result-format"
diff --git a/emacs/notmuch.el b/emacs/notmuch.el
index 0471750..5cddaac 100644
--- a/emacs/notmuch.el
+++ b/emacs/notmuch.el
@@ -649,7 +649,7 @@ (defun notmuch-search-color-line (start end line-tag-list)
 	  (let ((tag (car elem))
 		(attributes (cdr elem)))
 	    (when (member tag line-tag-list)
-	      (notmuch-combine-face-text-property start end attributes))))
+	      (notmuch-apply-face nil attributes nil start end))))
 	;; Reverse the list so earlier entries take precedence
 	(reverse notmuch-search-line-faces)))
 
-- 
1.7.10.4

[Patch v4 2/8] Make keys of notmuch-tag-formats regexps and use caching

[Mark Walters]

From: Austin Clements <amdragon@MIT.EDU>

This modifies `notmuch-tag-format-tag' to treat the keys of
`notmuch-tag-formats' as (anchored) regexps, rather than literal
strings.  This is clearly more flexible, as it allows for prefix
matching, defining a fallback format, etc.  This may cause compatibility
problems if people have customized `notmuch-tag-formats' to match tags
that contain regexp specials, but this seems unlikely.

Regular expression matching has quite a performance hit over string
lookup, so this also introduces a simple cache from exact tags to
formatted strings.  The number of unique tags is likely to be quite
small, so this cache should have a high hit rate.  In addition to
eliminating the regexp lookup in the common case, this cache stores
fully formatted tags, eliminating the repeated evaluation of potentially
expensive, user-specified formatting code.  This makes regexp lookup at
least as fast as assoc for unformatted tags (e.g., inbox) and *faster*
than the current code for formatted tags (e.g., unread):

                    inbox (usec)   unread (usec)
    assoc:              0.4            2.8
    regexp:             3.2            7.2
    regexp+caching:     0.4            0.4

(Though even at 7.2 usec, tag formatting is not our top bottleneck.)

This cache must be explicitly cleared to keep it coherent, so this adds
the appropriate clearing calls.
---
 emacs/notmuch-show.el |    1 +
 emacs/notmuch-tag.el  |   76 ++++++++++++++++++++++++++++++++++---------------
 emacs/notmuch-tree.el |    1 +
 emacs/notmuch.el      |    1 +
 4 files changed, 56 insertions(+), 23 deletions(-)

diff --git a/emacs/notmuch-show.el b/emacs/notmuch-show.el
index b8782dd..019f51d 100644
--- a/emacs/notmuch-show.el
+++ b/emacs/notmuch-show.el
@@ -1145,6 +1145,7 @@ (defun notmuch-show-build-buffer ()
     ;; Don't track undo information for this buffer
     (set 'buffer-undo-list t)
 
+    (notmuch-tag-clear-cache)
     (erase-buffer)
     (goto-char (point-min))
     (save-excursion
diff --git a/emacs/notmuch-tag.el b/emacs/notmuch-tag.el
index 41b1687..42c425e 100644
--- a/emacs/notmuch-tag.el
+++ b/emacs/notmuch-tag.el
@@ -34,17 +34,21 @@ (defcustom notmuch-tag-formats
      (notmuch-tag-format-image-data tag (notmuch-tag-star-icon))))
   "Custom formats for individual tags.
 
-This gives a list that maps from tag names to lists of formatting
-expressions.  The car of each element gives a tag name and the
-cdr gives a list of Elisp expressions that modify the tag.  If
-the list is empty, the tag will simply be hidden.  Otherwise,
-each expression will be evaluated in order: for the first
-expression, the variable `tag' will be bound to the tag name; for
-each later expression, the variable `tag' will be bound to the
-result of the previous expression.  In this way, each expression
-can build on the formatting performed by the previous expression.
-The result of the last expression will displayed in place of the
-tag.
+This is an association list that maps from tag name regexps to
+lists of formatting expressions.  The first entry whose car
+regexp-matches a tag will be used to format that tag.  The regexp
+is implicitly anchored, so to match a literal tag name, just use
+that tag name (if it contains special regexp characters like
+\".\" or \"*\", these have to be escaped).  The cdr of the
+matching entry gives a list of Elisp expressions that modify the
+tag.  If the list is empty, the tag will simply be hidden.
+Otherwise, each expression will be evaluated in order: for the
+first expression, the variable `tag' will be bound to the tag
+name; for each later expression, the variable `tag' will be bound
+to the result of the previous expression.  In this way, each
+expression can build on the formatting performed by the previous
+expression.  The result of the last expression will displayed in
+place of the tag.
 
 For example, to replace a tag with another string, simply use
 that string as a formatting expression.  To change the foreground
@@ -56,7 +60,7 @@ (defcustom notmuch-tag-formats
 
   :group 'notmuch-search
   :group 'notmuch-show
-  :type '(alist :key-type (string :tag "Tag")
+  :type '(alist :key-type (regexp :tag "Tag")
 		:extra-offset -3
 		:value-type
 		(radio :format "%v"
@@ -135,18 +139,44 @@ (defun notmuch-tag-tag-icon ()
   </g>
 </svg>")
 
+(defvar notmuch-tag--format-cache (make-hash-table :test 'equal)
+  "Cache of tag format lookup.  Internal to `notmuch-tag-format-tag'.")
+
+(defun notmuch-tag-clear-cache ()
+  "Clear the internal cache of tag formats."
+  (clrhash notmuch-tag--format-cache))
+
 (defun notmuch-tag-format-tag (tag)
-  "Format TAG by looking into `notmuch-tag-formats'."
-  (let ((formats (assoc tag notmuch-tag-formats)))
-    (cond
-     ((null formats)		;; - Tag not in `notmuch-tag-formats',
-      tag)			;;   the format is the tag itself.
-     ((null (cdr formats))	;; - Tag was deliberately hidden,
-      nil)			;;   no format must be returned
-     (t				;; - Tag was found and has formats,
-      (let ((tag tag))		;;   we must apply all the formats.
-	(dolist (format (cdr formats) tag)
-	  (setq tag (eval format))))))))
+  "Format TAG by according to `notmuch-tag-formats'.
+
+Callers must ensure that the tag format cache has been recently cleared
+via `notmuch-tag-clear-cache' before using this function.  For example,
+it would be appropriate to clear the cache just prior to filling a
+buffer that uses formatted tags."
+
+  (let ((formatted (gethash tag notmuch-tag--format-cache 'missing)))
+    (when (eq formatted 'missing)
+      (let* ((formats
+	      (save-match-data
+		;; Don't use assoc-default since there's no way to
+		;; distinguish a missing key from a present key with a
+		;; null cdr:.
+		(assoc* tag notmuch-tag-formats
+			:test (lambda (tag key)
+				(and (eq (string-match key tag) 0)
+				     (= (match-end 0) (length tag))))))))
+	(setq formatted
+	      (cond
+	       ((null formats)		;; - Tag not in `notmuch-tag-formats',
+		tag)			;;   the format is the tag itself.
+	       ((null (cdr formats))	;; - Tag was deliberately hidden,
+		nil)			;;   no format must be returned
+	       (t			;; - Tag was found and has formats,
+		(let ((tag tag))	;;   we must apply all the formats.
+		  (dolist (format (cdr formats) tag)
+		    (setq tag (eval format)))))))
+	(puthash tag formatted notmuch-tag--format-cache)))
+    formatted))
 
 (defun notmuch-tag-format-tags (tags &optional face)
   "Return a string representing formatted TAGS."
diff --git a/emacs/notmuch-tree.el b/emacs/notmuch-tree.el
index e3aa2cd..c78d9de 100644
--- a/emacs/notmuch-tree.el
+++ b/emacs/notmuch-tree.el
@@ -881,6 +881,7 @@ (defun notmuch-tree-worker (basic-query &optional query-context target open-targ
 	 (message-arg "--entire-thread"))
     (if (equal (car (process-lines notmuch-command "count" search-args)) "0")
 	(setq search-args basic-query))
+    (notmuch-tag-clear-cache)
     (let ((proc (notmuch-start-notmuch
 		 "notmuch-tree" (current-buffer) #'notmuch-tree-process-sentinel
 		 "show" "--body=false" "--format=sexp"
diff --git a/emacs/notmuch.el b/emacs/notmuch.el
index 5cddaac..93a6d8b 100644
--- a/emacs/notmuch.el
+++ b/emacs/notmuch.el
@@ -888,6 +888,7 @@ (defun notmuch-search (&optional query oldest-first target-thread target-line)
     (set 'notmuch-search-oldest-first oldest-first)
     (set 'notmuch-search-target-thread target-thread)
     (set 'notmuch-search-target-line target-line)
+    (notmuch-tag-clear-cache)
     (let ((proc (get-buffer-process (current-buffer)))
 	  (inhibit-read-only t))
       (if proc
-- 
1.7.10.4

[Patch v4 3/8] emacs: tag split customise option for format-tags into a widget

[Mark Walters]

We will re-use the customize option for format-tags for formattting
deleted tags to added tags in the next patch so split it into a
widget. There should be no functional change.
---
 emacs/notmuch-tag.el |   55 ++++++++++++++++++++++++++------------------------
 1 file changed, 29 insertions(+), 26 deletions(-)

diff --git a/emacs/notmuch-tag.el b/emacs/notmuch-tag.el
index 42c425e..a4dea39 100644
--- a/emacs/notmuch-tag.el
+++ b/emacs/notmuch-tag.el
@@ -28,6 +28,34 @@
 (require 'crm)
 (require 'notmuch-lib)
 
+(define-widget 'notmuch-tag-format-type 'lazy
+  "Customize widget for notmuch-tag-format and friends"
+  :type '(alist :key-type (regexp :tag "Tag")
+		:extra-offset -3
+		:value-type
+		(radio :format "%v"
+		       (const :tag "Hidden" nil)
+		       (set :tag "Modified"
+			    (string :tag "Display as")
+			    (list :tag "Face" :extra-offset -4
+				  (const :format "" :inline t
+					 (propertize tag 'face))
+				  (list :format "%v"
+					(const :format "" quote)
+					custom-face-edit))
+			    (list :format "%v" :extra-offset -4
+				  (const :format "" :inline t
+					 (notmuch-tag-format-image-data tag))
+				  (choice :tag "Image"
+					  (const :tag "Star"
+						 (notmuch-tag-star-icon))
+					  (const :tag "Empty star"
+						 (notmuch-tag-star-empty-icon))
+					  (const :tag "Tag"
+						 (notmuch-tag-tag-icon))
+					  (string :tag "Custom")))
+			    (sexp :tag "Custom")))))
+
 (defcustom notmuch-tag-formats
   '(("unread" (propertize tag 'face '(:foreground "red")))
     ("flagged" (propertize tag 'face '(:foreground "blue"))
@@ -57,34 +85,9 @@ (defcustom notmuch-tag-formats
 
 See also `notmuch-tag-format-image', which can help replace tags
 with images."
-
   :group 'notmuch-search
   :group 'notmuch-show
-  :type '(alist :key-type (regexp :tag "Tag")
-		:extra-offset -3
-		:value-type
-		(radio :format "%v"
-		       (const :tag "Hidden" nil)
-		       (set :tag "Modified"
-			    (string :tag "Display as")
-			    (list :tag "Face" :extra-offset -4
-				  (const :format "" :inline t
-					 (propertize tag 'face))
-				  (list :format "%v"
-					(const :format "" quote)
-					custom-face-edit))
-			    (list :format "%v" :extra-offset -4
-				  (const :format "" :inline t
-					 (notmuch-tag-format-image-data tag))
-				  (choice :tag "Image"
-					  (const :tag "Star"
-						 (notmuch-tag-star-icon))
-					  (const :tag "Empty star"
-						 (notmuch-tag-star-empty-icon))
-					  (const :tag "Tag"
-						 (notmuch-tag-tag-icon))
-					  (string :tag "Custom")))
-			    (sexp :tag "Custom")))))
+  :type 'notmuch-tag-format-type)
 
 (defun notmuch-tag-format-image-data (tag data)
   "Replace TAG with image DATA, if available.
-- 
1.7.10.4

[Patch v4 4/8] emacs: tag: add customize for deleted/added tag formats

[Mark Walters]

Add customize options for deleted/added tag formats.  These are not
used yet but will be later in the series.

We switch to using `notmuch-apply-face' rather than `propertize' in
the defcustom for faces so that the faces for deleted/added tags add
to the default face attributes for the tag.

We special case deleting the unread tag as that tag is a strong visual
cue and we don't need that cue when we are just saying it used to be
unread. Thus, we revert to the normal tag face with strikethough for
deleted unread tags.
---
 emacs/notmuch-tag.el |   46 +++++++++++++++++++++++++++++++++++++++++++++-
 1 file changed, 45 insertions(+), 1 deletion(-)

diff --git a/emacs/notmuch-tag.el b/emacs/notmuch-tag.el
index a4dea39..3ae5e62 100644
--- a/emacs/notmuch-tag.el
+++ b/emacs/notmuch-tag.el
@@ -39,7 +39,7 @@ (define-widget 'notmuch-tag-format-type 'lazy
 			    (string :tag "Display as")
 			    (list :tag "Face" :extra-offset -4
 				  (const :format "" :inline t
-					 (propertize tag 'face))
+					 (notmuch-apply-face tag))
 				  (list :format "%v"
 					(const :format "" quote)
 					custom-face-edit))
@@ -87,6 +87,50 @@ (defcustom notmuch-tag-formats
 with images."
   :group 'notmuch-search
   :group 'notmuch-show
+  :group 'notmuch-faces
+  :type 'notmuch-tag-format-type)
+
+(defcustom notmuch-tag-deleted-formats
+  '(("unread" (notmuch-apply-face bare-tag
+				  (if (display-supports-face-attributes-p '(:strike-through "red"))
+				      '(:strike-through "red")
+				    '(:inverse-video t))))
+    (".*" (notmuch-apply-face tag
+			      (if (display-supports-face-attributes-p '(:strike-through "red"))
+				  '(:strike-through "red")
+				'(:inverse-video t)))))
+  "Custom formats for tags when deleted.
+
+For deleted tags the formats in `notmuch-tag-formats` are applied
+first and then these formats are applied on top; that is `tag'
+passed to the function is the tag with all these previous
+formattings applied. The formatted can access the original
+unformatted tag as `bare-tag'.
+
+By default this shows deleted tags with strike-through in red,
+unless strike-through is not available (e.g., emacs is running in
+a terminal) in which case it uses inverse video. To hide deleted
+tags completely set this to
+  '((\".*\" nil))
+
+See `notmuch-tag-formats' for full documentation."
+  :group 'notmuch-show
+  :group 'notmuch-faces
+  :type 'notmuch-tag-format-type)
+
+(defcustom notmuch-tag-added-formats
+  '((".*" (notmuch-apply-face tag '(:underline "green"))))
+  "Custom formats for tags when added.
+
+For added tags the formats in `notmuch-tag-formats` are applied
+first and then these formats are applied on top.
+
+To disable special formatting of added tags, set this variable to
+nil.
+
+See `notmuch-tag-formats' for full documentation."
+  :group 'notmuch-show
+  :group 'notmuch-faces
   :type 'notmuch-tag-format-type)
 
 (defun notmuch-tag-format-image-data (tag data)
-- 
1.7.10.4

[Patch v4 5/8] emacs: show: mark tags changed since buffer loaded

[Mark Walters]

This allows (and requires) the original-tags to be passed along with
the current-tags to be passed to notmuch-tag-format-tags. This allows
the tag formatting to show added and deleted tags.By default a removed
tag is displayed with strike-through in red (if strike-through is not
available, eg on a terminal, inverse video is used instead) and an
added tag is displayed underlined in green.

If the caller does not wish to use the new feature it can pass
current-tags for both arguments and, at this point, we do exactly that
in the three callers of this function.

Note, we cannot tidily allow original-tags to be optional because we would
need to distinguish nil meaning "we are not specifying original-tags"
from nil meaning there were no original-tags (an empty list).

We use this in subsequent patches to make it clear when a message was
unread when you first loaded a show buffer (previously the unread tag
could be removed before a user realised that it had been unread).

The code adds into the existing tag formatting code. The user can
specify exactly how a tag should be displayed normally, when deleted,
or when added.

Since the formatting code matches regexps a user can match all deleted
tags with a ".*" in notmuch-tag-deleted-formats.  For example setting
notmuch-tag-deleted-formats to '((".*" nil)) tells notmuch not to show
deleted tags at all.

All the variables are customizable; however, more complicated cases
like changing the face depending on the type of display will require
custom lisp.

Currently this overrides notmuch-tag-deleted-formats for the tests
setting it to '((".*" nil)) so that they get removed from the display
and, thus, all tests still pass.
---
 emacs/notmuch-show.el |    4 +--
 emacs/notmuch-tag.el  |   96 +++++++++++++++++++++++++++++++------------------
 emacs/notmuch-tree.el |    2 +-
 emacs/notmuch.el      |    2 +-
 test/test-lib.el      |    5 +++
 5 files changed, 70 insertions(+), 39 deletions(-)

diff --git a/emacs/notmuch-show.el b/emacs/notmuch-show.el
index 019f51d..5492be4 100644
--- a/emacs/notmuch-show.el
+++ b/emacs/notmuch-show.el
@@ -344,7 +344,7 @@ (defun notmuch-show-update-tags (tags)
     (if (re-search-forward "(\\([^()]*\\))$" (line-end-position) t)
 	(let ((inhibit-read-only t))
 	  (replace-match (concat "("
-				 (notmuch-tag-format-tags tags)
+				 (notmuch-tag-format-tags tags tags)
 				 ")"))))))
 
 (defun notmuch-clean-address (address)
@@ -423,7 +423,7 @@ (defun notmuch-show-insert-headerline (headers date tags depth)
 	    " ("
 	    date
 	    ") ("
-	    (notmuch-tag-format-tags tags)
+	    (notmuch-tag-format-tags tags tags)
 	    ")\n")
     (overlay-put (make-overlay start (point)) 'face 'notmuch-message-summary-face)))
 
diff --git a/emacs/notmuch-tag.el b/emacs/notmuch-tag.el
index 3ae5e62..07c260e 100644
--- a/emacs/notmuch-tag.el
+++ b/emacs/notmuch-tag.el
@@ -193,45 +193,71 @@ (defun notmuch-tag-clear-cache ()
   "Clear the internal cache of tag formats."
   (clrhash notmuch-tag--format-cache))
 
-(defun notmuch-tag-format-tag (tag)
-  "Format TAG by according to `notmuch-tag-formats'.
-
-Callers must ensure that the tag format cache has been recently cleared
-via `notmuch-tag-clear-cache' before using this function.  For example,
-it would be appropriate to clear the cache just prior to filling a
-buffer that uses formatted tags."
-
-  (let ((formatted (gethash tag notmuch-tag--format-cache 'missing)))
-    (when (eq formatted 'missing)
-      (let* ((formats
-	      (save-match-data
-		;; Don't use assoc-default since there's no way to
-		;; distinguish a missing key from a present key with a
-		;; null cdr:.
-		(assoc* tag notmuch-tag-formats
-			:test (lambda (tag key)
-				(and (eq (string-match key tag) 0)
-				     (= (match-end 0) (length tag))))))))
-	(setq formatted
-	      (cond
-	       ((null formats)		;; - Tag not in `notmuch-tag-formats',
-		tag)			;;   the format is the tag itself.
-	       ((null (cdr formats))	;; - Tag was deliberately hidden,
-		nil)			;;   no format must be returned
-	       (t			;; - Tag was found and has formats,
-		(let ((tag tag))	;;   we must apply all the formats.
-		  (dolist (format (cdr formats) tag)
-		    (setq tag (eval format)))))))
-	(puthash tag formatted notmuch-tag--format-cache)))
-    formatted))
-
-(defun notmuch-tag-format-tags (tags &optional face)
+(defun notmuch-tag--get-formats (tag format-alist)
+  "Find the first item whose car regexp-matches TAG."
+  (save-match-data
+    ;; Don't use assoc-default since there's no way to distinguish a
+    ;; missing key from a present key with a null cdr.
+    (assoc* tag format-alist
+	    :test (lambda (tag key)
+		    (and (eq (string-match key tag) 0)
+			 (= (match-end 0) (length tag)))))))
+
+(defun notmuch-tag--do-format (tag formatted-tag formats)
+  "Apply a tag-formats entry to TAG."
+  (cond ((null formats)		;; - Tag not in `formats',
+	 formatted-tag)	       	;;   the format is the tag itself.
+	((null (cdr formats))	;; - Tag was deliberately hidden,
+	 nil)			;;   no format must be returned
+	(t
+	 ;; Tag was found and has formats, we must apply all the
+	 ;; formats.  TAG may be null so treat that as a special case.
+	 (let ((bare-tag tag)
+	       (tag (copy-sequence (or formatted-tag ""))))
+	   (dolist (format (cdr formats))
+	     (setq tag (eval format)))
+	   (if (and (null formatted-tag) (equal tag ""))
+	       nil
+	     tag)))))
+
+(defun notmuch-tag-format-tag (tags orig-tags tag)
+  "Format TAG according to `notmuch-tag-formats'.
+
+TAGS and ORIG-TAGS are lists of the current tags and the original
+tags; tags which have been deleted (i.e., are in ORIG-TAGS but
+are not in TAGS) are shown using formats from
+`notmuch-tag-deleted-formats'; tags which have been added (i.e.,
+are in TAGS but are not in ORIG-TAGS) are shown using formats
+from `notmuch-tag-added-formats' and tags which have not been
+changed (the normal case) are shown using formats from
+`notmuch-tag-formats'"
+  (let* ((tag-state (cond ((not (member tag tags)) 'deleted)
+			  ((not (member tag orig-tags)) 'added)))
+	 (formatted-tag (gethash (cons tag tag-state) notmuch-tag--format-cache 'missing)))
+    (when (eq formatted-tag 'missing)
+      (let ((base (notmuch-tag--get-formats tag notmuch-tag-formats))
+	    (over (case tag-state
+		    (deleted (notmuch-tag--get-formats
+			      tag notmuch-tag-deleted-formats))
+		    (added (notmuch-tag--get-formats
+			    tag notmuch-tag-added-formats))
+		    (otherwise nil))))
+	(setq formatted-tag (notmuch-tag--do-format tag tag base))
+	(setq formatted-tag (notmuch-tag--do-format tag formatted-tag over))
+
+	(puthash (cons tag tag-state) formatted-tag notmuch-tag--format-cache)))
+    formatted-tag))
+
+(defun notmuch-tag-format-tags (tags orig-tags &optional face)
   "Return a string representing formatted TAGS."
-  (let ((face (or face 'notmuch-tag-face)))
+  (let ((face (or face 'notmuch-tag-face))
+	(all-tags (sort (delete-dups (append tags orig-tags nil)) #'string<)))
     (notmuch-apply-face
      (mapconcat #'identity
 		;; nil indicated that the tag was deliberately hidden
-		(delq nil (mapcar #'notmuch-tag-format-tag tags))
+		(delq nil (mapcar
+			   (apply-partially #'notmuch-tag-format-tag tags orig-tags)
+			   all-tags))
 		" ")
      face
      t)))
diff --git a/emacs/notmuch-tree.el b/emacs/notmuch-tree.el
index c78d9de..8bf2fbc 100644
--- a/emacs/notmuch-tree.el
+++ b/emacs/notmuch-tree.el
@@ -704,7 +704,7 @@ (defun notmuch-tree-format-field (field format-string msg)
 	    (face (if match
 		      'notmuch-tree-match-tag-face
 		    'notmuch-tree-no-match-tag-face)))
-	(format format-string (notmuch-tag-format-tags tags face)))))))
+	(format format-string (notmuch-tag-format-tags tags tags face)))))))
 
 (defun notmuch-tree-format-field-list (field-list msg)
   "Format fields of MSG according to FIELD-LIST and return string"
diff --git a/emacs/notmuch.el b/emacs/notmuch.el
index 93a6d8b..609f408 100644
--- a/emacs/notmuch.el
+++ b/emacs/notmuch.el
@@ -754,7 +754,7 @@ (defun notmuch-search-insert-field (field format-string result)
 
    ((string-equal field "tags")
     (let ((tags (plist-get result :tags)))
-      (insert (format format-string (notmuch-tag-format-tags tags)))))))
+      (insert (format format-string (notmuch-tag-format-tags tags tags)))))))
 
 (defun notmuch-search-show-result (result &optional pos)
   "Insert RESULT at POS or the end of the buffer if POS is null."
diff --git a/test/test-lib.el b/test/test-lib.el
index 37fcb3d..437f83f 100644
--- a/test/test-lib.el
+++ b/test/test-lib.el
@@ -165,3 +165,8 @@ (defun notmuch-test-expect-equal (output expected)
 
      (t
       (notmuch-test-report-unexpected output expected)))))
+
+;; For historical reasons, we hide deleted tags by default in the test
+;; suite
+(setq notmuch-tag-deleted-formats
+      '((".*" nil)))
-- 
1.7.10.4

[Patch v4 6/8] emacs: show: use orig-tags for tag display

[Mark Walters]

This uses the previous patch to show the tag changes that have occured
in the show buffer since it was last loaded/refreshed.
---
 emacs/notmuch-show.el |    4 +++-
 1 file changed, 3 insertions(+), 1 deletion(-)

diff --git a/emacs/notmuch-show.el b/emacs/notmuch-show.el
index 5492be4..f6ca827 100644
--- a/emacs/notmuch-show.el
+++ b/emacs/notmuch-show.el
@@ -344,7 +344,7 @@ (defun notmuch-show-update-tags (tags)
     (if (re-search-forward "(\\([^()]*\\))$" (line-end-position) t)
 	(let ((inhibit-read-only t))
 	  (replace-match (concat "("
-				 (notmuch-tag-format-tags tags tags)
+				 (notmuch-tag-format-tags tags (notmuch-show-get-prop :orig-tags))
 				 ")"))))))
 
 (defun notmuch-clean-address (address)
@@ -1168,6 +1168,8 @@ (defun notmuch-show-build-buffer ()
 
       (jit-lock-register #'notmuch-show-buttonise-links)
 
+      (notmuch-show-mapc (lambda () (notmuch-show-set-prop :orig-tags (notmuch-show-get-tags))))
+
       ;; Set the header line to the subject of the first message.
       (setq header-line-format (notmuch-sanitize (notmuch-show-strip-re (notmuch-show-get-subject))))
 
-- 
1.7.10.4

[Patch v4 7/8] emacs: search: use orig-tags in search

[Mark Walters]

This uses the recent functionality to show the tag changes in the
search buffer. Currently this is only used to show changes the search
buffer makes itself: i.e., it does not make display any changes
reflecting tagging done by other notmuch-buffers.
---
 emacs/notmuch.el |   41 +++++++++++++++++++++++++----------------
 1 file changed, 25 insertions(+), 16 deletions(-)

diff --git a/emacs/notmuch.el b/emacs/notmuch.el
index 609f408..cb71381 100644
--- a/emacs/notmuch.el
+++ b/emacs/notmuch.el
@@ -753,24 +753,33 @@ (defun notmuch-search-insert-field (field format-string result)
      format-string (notmuch-sanitize (plist-get result :authors))))
 
    ((string-equal field "tags")
-    (let ((tags (plist-get result :tags)))
-      (insert (format format-string (notmuch-tag-format-tags tags tags)))))))
+    (let ((tags (plist-get result :tags))
+	  (orig-tags (plist-get result :orig-tags)))
+      (insert (format format-string (notmuch-tag-format-tags tags orig-tags)))))))
 
-(defun notmuch-search-show-result (result &optional pos)
-  "Insert RESULT at POS or the end of the buffer if POS is null."
+(defun notmuch-search-show-result (result pos)
+  "Insert RESULT at POS."
   ;; Ignore excluded matches
   (unless (= (plist-get result :matched) 0)
-    (let ((beg (or pos (point-max))))
-      (save-excursion
-	(goto-char beg)
-	(dolist (spec notmuch-search-result-format)
-	  (notmuch-search-insert-field (car spec) (cdr spec) result))
-	(insert "\n")
-	(notmuch-search-color-line beg (point) (plist-get result :tags))
-	(put-text-property beg (point) 'notmuch-search-result result))
-      (when (string= (plist-get result :thread) notmuch-search-target-thread)
-	(setq notmuch-search-target-thread "found")
-	(goto-char beg)))))
+    (save-excursion
+      (goto-char pos)
+      (dolist (spec notmuch-search-result-format)
+	(notmuch-search-insert-field (car spec) (cdr spec) result))
+      (insert "\n")
+      (notmuch-search-color-line pos (point) (plist-get result :tags))
+      (put-text-property pos (point) 'notmuch-search-result result))))
+
+(defun notmuch-search-append-result (result)
+  "Insert RESULT at the end of the buffer.
+
+This is only called when a result is first inserted so it also
+sets the :orig-tag property."
+  (let ((new-result (plist-put result :orig-tags (plist-get result :tags)))
+	(pos (point-max)))
+    (notmuch-search-show-result new-result pos)
+    (when (string= (plist-get result :thread) notmuch-search-target-thread)
+      (setq notmuch-search-target-thread "found")
+      (goto-char pos))))
 
 (defun notmuch-search-process-filter (proc string)
   "Process and filter the output of \"notmuch search\""
@@ -784,7 +793,7 @@ (defun notmuch-search-process-filter (proc string)
 	(save-excursion
 	  (goto-char (point-max))
 	  (insert string))
-	(notmuch-sexp-parse-partial-list 'notmuch-search-show-result
+	(notmuch-sexp-parse-partial-list 'notmuch-search-append-result
 					 results-buf)))))
 
 (defun notmuch-search-tag-all (tag-changes)
-- 
1.7.10.4

[Patch v4 8/8] emacs: tree: use orig-tags in search

[Mark Walters]

This uses the recent functionality to show the tag changes in the tree
buffer. Currently this is only used to show changes the tree buffer
makes itself: i.e., it does not make display any changes reflecting
tagging done by other notmuch-buffers.
---
 emacs/notmuch-tree.el |    9 ++++++---
 1 file changed, 6 insertions(+), 3 deletions(-)

diff --git a/emacs/notmuch-tree.el b/emacs/notmuch-tree.el
index 8bf2fbc..7d5f475 100644
--- a/emacs/notmuch-tree.el
+++ b/emacs/notmuch-tree.el
@@ -701,10 +701,11 @@ (defun notmuch-tree-format-field (field format-string msg)
 
      ((string-equal field "tags")
       (let ((tags (plist-get msg :tags))
+	    (orig-tags (plist-get msg :orig-tags))
 	    (face (if match
 		      'notmuch-tree-match-tag-face
 		    'notmuch-tree-no-match-tag-face)))
-	(format format-string (notmuch-tag-format-tags tags tags face)))))))
+	(format format-string (notmuch-tag-format-tags tags orig-tags face)))))))
 
 (defun notmuch-tree-format-field-list (field-list msg)
   "Format fields of MSG according to FIELD-LIST and return string"
@@ -766,8 +767,10 @@ (defun notmuch-tree-insert-tree (tree depth tree-status first last)
 	(push "├" tree-status)))
 
       (push (concat (if replies "┬" "─") "►") tree-status)
-      (plist-put msg :first (and first (eq 0 depth)))
-      (notmuch-tree-goto-and-insert-msg (plist-put msg :tree-status tree-status))
+      (setq msg (plist-put msg :first (and first (eq 0 depth))))
+      (setq msg (plist-put msg :tree-status tree-status))
+      (setq msg (plist-put msg :orig-tags (plist-get msg :tags)))
+      (notmuch-tree-goto-and-insert-msg msg)
       (pop tree-status)
       (pop tree-status)
 
-- 
1.7.10.4

Re: [Patch v4 0/8] emacs: show tag changes in buffer

[Austin Clements]

LGTM.  Ship it!

Quoth Mark Walters on Mar 22 at 11:51 am:
> This is v4 of this patch set. V3 is at
> id:1394597397-8486-1-git-send-email-markwalters1009@gmail.com. This
> addresses all the review comments from Austin.
> 
> Patches 1-3 and 6-8 are unchanged. For patch 5 I have changed the
> comments slightly, tried to make the unread deleted case clearer by
> using the new `bare-tag' variable, and added all three custom format
> variables to the notmuch-faces group.
> 
> For patch 6 I have switched to Austin's suggested approach with the
> changes mentioned in id:87pplek4v0.fsf@qmul.ac.uk and
> id:87mwgih2zx.fsf@qmul.ac.uk
> 
> Best wishes
> 
> Mark

Re: [Patch v4 0/8] emacs: show tag changes in buffer

[Jani Nikula]

On Sat, 22 Mar 2014, Austin Clements <amdragon@MIT.EDU> wrote:
> LGTM.  Ship it!

Seems to work. Ship it!

Jani.

Re: [Patch v4 0/8] emacs: show tag changes in buffer

[David Bremner]

Mark Walters <markwalters1009@gmail.com> writes:

> This is v4 of this patch set. V3 is at
> id:1394597397-8486-1-git-send-email-markwalters1009@gmail.com. This
> addresses all the review comments from Austin.

series pushed.

d