[PATCH 4/7] emacs: show: mark tags changed since buffer loaded

Austin Clements amdragon at MIT.EDU
Tue Feb 11 17:21:23 PST 2014


On Sat, 18 Jan 2014, Mark Walters <markwalters1009 at gmail.com> wrote:
> 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. For convenience an entry for the empty string in the
> notmuch-tag-formats (and the corresponding notmuch-tag-deleted-formats
> notmuch-tag-added-formats) is applied to all tags which do not have an
> explicit match.
>
> This means that a user can tell notmuch not to show deleted tags at
> all by setting notmuch-tag-deleted-formats to
> '(("" nil))
> or not to show any deleted tags except "unread" by setting it to
> '(("" nil)
>   ("unread" (propertize tag 'face '(strike-through "red"))))
>
> 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  |   32 +++++++++++++++++++++++++-------
>  emacs/notmuch-tree.el |    2 +-
>  emacs/notmuch.el      |    2 +-
>  test/test-lib.el      |    4 ++++
>  5 files changed, 33 insertions(+), 11 deletions(-)
>
> diff --git a/emacs/notmuch-show.el b/emacs/notmuch-show.el
> index 1ac80ca..1ce56f9 100644
> --- a/emacs/notmuch-show.el
> +++ b/emacs/notmuch-show.el
> @@ -344,7 +344,7 @@ operation on the contents of the current buffer."
>      (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 @@ message at DEPTH in the current thread."
>  	    " ("
>  	    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 9757a0e..6bc47fb 100644
> --- a/emacs/notmuch-tag.el
> +++ b/emacs/notmuch-tag.el
> @@ -164,10 +164,25 @@ This can be used with `notmuch-tag-format-image-data'."
>    </g>
>  </svg>")
>  
> -(defun notmuch-tag-format-tag (tag)
> -  "Format TAG by looking into `notmuch-tag-formats'."
> -  (let ((formats (or (assoc tag notmuch-tag-formats)
> -		     (assoc "" notmuch-tag-formats))))
> +(defun notmuch-tag-format-tag (tags orig-tags tag)
> +  "Format TAG by looking into `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* ((status-formats (cond ((and (member tag tags) (member tag orig-tags))
> +				notmuch-tag-formats)
> +			       ((not (member tag tags))
> +				notmuch-tag-deleted-formats)
> +			       ((not (member tag orig-tags))
> +				notmuch-tag-added-formats)))
> +	 (formats (or (assoc tag status-formats)
> +		      (assoc "" status-formats))))

I would expect this to be cumulative.  That is, I would want added and
deleted tags to have my regular `notmuch-tag-formats' formatting in
addition to extra formatting specified by
`notmuch-tag-{added,deleted}-formats' (especially if, for example, it's
replaced with an image).

I think this should just be a matter of something like
  (let ((formats
         (append
          (notmuch-tag--get-format tag notmuch-tag-formats)
          (cond ((not (member tag tags))
                 (notmuch-tag--get-format tag notmuch-tag-deleted-formats))
                ((not (member tag orig-tags)
                 (notmuch-tag--get-format tag notmuch-tag-added-formats)))))))
    ...)
where notmuch-tag--get-format is something I made up to abstract the
assoc (or the regexp lookup).  This also has the benefit of reducing the
number of member tests.

>      (cond
>       ((null formats)		;; - Tag not in `notmuch-tag-formats',
>        tag)			;;   the format is the tag itself.
> @@ -178,13 +193,16 @@ This can be used with `notmuch-tag-format-image-data'."
>  	(dolist (format (cdr formats) tag)
>  	  (setq tag (eval format))))))))
>  
> -(defun notmuch-tag-format-tags (tags &optional face)
> +(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)) #'string<)))

This may mutate orig-tags.  It's not obvious to me that's okay.  You
could use remove-duplicates from cl.  (I'm surprised I can't find a
uniq-like function in cl, which would save the O(n^2) operation, but I
doubt it matters.)

>      (notmuch-combine-face-text-property-string
>       (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 4f2ac02..b37e2cd 100644
> --- a/emacs/notmuch-tree.el
> +++ b/emacs/notmuch-tree.el
> @@ -704,7 +704,7 @@ unchanged ADDRESS if parsing fails."
>  	    (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 0471750..1436e5a 100644
> --- a/emacs/notmuch.el
> +++ b/emacs/notmuch.el
> @@ -754,7 +754,7 @@ non-authors is found, assume that all of the authors match."
>  
>     ((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..6cbd57c 100644
> --- a/test/test-lib.el
> +++ b/test/test-lib.el
> @@ -165,3 +165,7 @@ nothing."
>  
>       (t
>        (notmuch-test-report-unexpected output expected)))))
> +
> +;; hide deleted tags

Maybe "For historical reasons, we hide deleted tags by default in the
test suite"?

> +(setq notmuch-tag-deleted-formats
> +      '(("" nil)))
> -- 
> 1.7.9.1
>
> _______________________________________________
> notmuch mailing list
> notmuch at notmuchmail.org
> http://notmuchmail.org/mailman/listinfo/notmuch


More information about the notmuch mailing list