[PATCH WIP v3 1/3] emacs: show: mark tags changed since buffer loaded

Subject: [PATCH WIP v3 1/3] emacs: show: mark tags changed since buffer loaded

Date: Thu, 5 Dec 2013 20:04:29 +0000

To: notmuch@notmuchmail.org

Cc:

From: Mark Walters

This shows any tags changed in the show buffer since it was loaded or
refreshed. By default a removed tag is displayed with strike-through
in red and an added tag is displayed underlined in green.

One nice feature is that this makes it clear when a message was unread
when you first loaded the buffer (previously the unread tag could be
removed before a user realised that it had been unread).
---
 emacs/notmuch-show.el |   34 +++++++++++++++++++++++++++++-----
 emacs/notmuch-tag.el  |   30 ++++++++++++++++++++----------
 2 files changed, 49 insertions(+), 15 deletions(-)

diff --git a/emacs/notmuch-show.el b/emacs/notmuch-show.el
index 784644c..d64d407 100644
--- a/emacs/notmuch-show.el
+++ b/emacs/notmuch-show.el
@@ -211,6 +211,18 @@ For example, if you wanted to remove an \"unread\" tag and add a
   :type '(repeat string)
   :group 'notmuch-show)
 
+(defface notmuch-show-deleted-tag-face
+  '((t :strike-through "red" :inherit 'notmuch-tag-face))
+  "Face for tags that have been removed"
+  :group 'notmuch-show
+  :group 'notmuch-faces)
+
+(defface notmuch-show-added-tag-face
+  '((t :underline "green"))
+  "Face for tags that have been added"
+  :group 'notmuch-show
+  :group 'notmuch-faces)
+
 
 (defmacro with-current-notmuch-show-message (&rest body)
   "Evaluate body with current buffer set to the text of current message"
@@ -341,11 +353,21 @@ 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 "("
-				 (notmuch-tag-format-tags tags)
-				 ")"))))))
+    (let* ((orig-tags (notmuch-show-get-prop :orig-tags))
+	   (all-tags (sort (delete-dups (append tags orig-tags)) #'string<))
+	   (display-tags (mapcar (lambda (tag) (cond ((and (member tag tags) (member tag orig-tags))
+						      tag)
+						     ((not (member tag tags))
+						      (cons tag 'deleted))
+						     ((not (member tag orig-tags))
+						      (cons tag 'added))))
+				 all-tags)))
+
+      (if (re-search-forward "(\\([^()]*\\))$" (line-end-position) t)
+	  (let ((inhibit-read-only t))
+	    (replace-match (concat "("
+				   (notmuch-tag-format-tags display-tags)
+				   ")")))))))
 
 (defun notmuch-clean-address (address)
   "Try to clean a single email ADDRESS for display. Return a cons
@@ -1167,6 +1189,8 @@ function is used."
 
       (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))))
 
diff --git a/emacs/notmuch-tag.el b/emacs/notmuch-tag.el
index b60f46c..fac2c3b 100644
--- a/emacs/notmuch-tag.el
+++ b/emacs/notmuch-tag.el
@@ -137,16 +137,26 @@ This can be used with `notmuch-tag-format-image-data'."
 
 (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))))))))
+  (let* ((status (if (consp tag) (cdr tag)))
+	 (tag (if (consp tag) (car tag) tag))
+	 (formats (append (assoc tag notmuch-tag-formats)))
+	 (tag
+	  (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))))))))
+    (when tag
+      (cond
+       ((eq status 'deleted)
+	(notmuch-combine-face-text-property-string tag 'notmuch-show-deleted-tag-face))
+       ((eq status 'added)
+	(notmuch-combine-face-text-property-string tag 'notmuch-show-added-tag-face))
+       (t tag)))))
 
 (defun notmuch-tag-format-tags (tags)
   "Return a string representing formatted TAGS."
-- 
1.7.9.1

Thread: