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

[Jani Nikula]

On Thu, 05 Dec 2013, Mark Walters <markwalters1009 at gmail.com> wrote:
> 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).

I really like how this works. Very nice!

I did notice a small wrinkle though. On a terminal the strike-through
does not work, and the appearance is that the tag was not removed (until
you refresh with '='). I don't know if you can easily adapt the face or
disable the whole feature when on terminal. Or make this an opt-in
feature. I guess some people might not like this in general, so a way to
disable might be a good idea too. Fine tuning.

BR,
Jani.




> ---
>  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
>
> _______________________________________________
> notmuch mailing list
> notmuch at notmuchmail.org
> http://notmuchmail.org/mailman/listinfo/notmuch