[Patch v3 5/8] emacs: show: mark tags changed since buffer loaded
Mark Walters
markwalters1009 at gmail.com
Sat Mar 22 00:56:41 PDT 2014
On Sat, 22 Mar 2014, Austin Clements <amdragon at MIT.EDU> wrote:
> Quoth Mark Walters on Mar 12 at 4:09 am:
>> 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 | 72 +++++++++++++++++++++++++++++++++++-------------
>> emacs/notmuch-tree.el | 2 +-
>> emacs/notmuch.el | 2 +-
>> test/test-lib.el | 5 +++
>> 5 files changed, 61 insertions(+), 24 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 4698856..cfccb8e 100644
>> --- a/emacs/notmuch-tag.el
>> +++ b/emacs/notmuch-tag.el
>> @@ -184,45 +184,77 @@ (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)))
>> +(defun notmuch-tag-format-tag-by-state (tag formatted-tag tag-state)
>> + "Format TAG according to the appropriate `notmuch-tag-formats`.
>> +
>> +Applies formats for TAG from the appropriate one of
>> +`notmuch-tag-formats`, `notmuch-tag-deleted-formats` and
>> +`notmuch-tag-added-formats` based on TAG-STATE to the partially
>
> The second ` should be a ' on all four of the above references.
Fixed.
>
>> +formatted tag FORMATTED-TAG."
>> + (let ((formatted (gethash (cons tag tag-state) notmuch-tag--format-cache 'missing)))
>
> Something's strange here. If this hits in the cache, it will ignore
> formatted-tag. I can't actually construct a situation where this does
> the wrong thing, but it always seems to do the right thing for the
> wrong reasons.
I think the code is OK: it only hits the cache if it has already got an
entry for the pair (tag tag-state) which means it worked it out before
and that used formatted-tag.
So my code looks in the cache twice for a deleted tag once to find the
partially formatted tag from default formatting which it then ignores
and looks up the fully formatted tag with deleted formatting applied
too. In the case that we have already seen the partially formatted tag
but not the fully formatted tag we look the partially formatted tag in
the cache and then work out and store the fully formatted tag.
In comparison your code looks up (tag tag-state) in the cache, if it's
there then it returns that and is done, if it is not then it calculates
it from scratch. In particular your code does not look to see if we
already have the partially formatted tag in the cache (nor, if we meet
the deleted case first, does it save the partially formatted tag in the
cache).
Of course, the efficiency differences are totally trivial: I only
mention them to try and show how the two versions differ.
I think your version is clearer so will try something along those lines.
>
> This code would make a lot more sense to me if it were turned
> inside-out with `notmuch-tag-format-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 (gethash (cons tag tag-state) notmuch-tag--format-cache
> 'missing)))
> (when (eq formatted 'missing)
> (let ((base (notmuch-tag--get-formats tag notmuch-tag-formats))
> (over (case tag-state
> ((nil) nil)
> (deleted (notmuch-tag--get-formats
> tag notmuch-tag-deleted-formats))
> (added (notmuch-tag--get-formats
> tag notmuch-tag-deleted-formats)))))
> (setq formatted (notmuch-tag--do-format
> (notmuch-tag--do-format tag) base over))
> (puthash (cons tag tag-state) formatted notmuch-tag--format-cache)))
> formatted))
>
> (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 formats)
> "Apply a tag-formats entry to TAG."
> (cond ((null formats) ;; - Tag not in `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, we must apply all the
> ;; formats. TAG may be null so treat that as a special case.
> (let ((old-tag tag) (tag (or tag "")))
> (dolist (format (cdr formats))
> (setq tag (eval format)))
> (if (and (null old-tag) (equal tag ""))
> nil
> tag)))))
>
> (Completely untested and all indented with spaces and probably
> incorrectly because I wrote it all in my email buffer, but you get the
> idea.)
>
>> (when (eq formatted 'missing)
>> - (let* ((formats
>> + (let* ((tag-formats (case tag-state
>> + ((list nil) notmuch-tag-formats)
>
> While this isn't *technically* wrong, I don't think you meant to
> accept a tag-state of 'list. Should be
>
> (case tag-state
> ((nil) notmuch-tag-formats)
> (deleted ...
I have gone with what you suggested on irc: making the nil case the
otherwise case.
Best wishes
Mark
>
>> + (deleted notmuch-tag-deleted-formats)
>> + (added notmuch-tag-added-formats)))
>> + (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
>> + (assoc* tag 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 formats) ;; - Tag not in `tag-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,
>> - (let ((tag tag)) ;; we must apply all the formats.
>> + (t
>> + ;; Tag was found and has formats, we must apply all
>> + ;; the formats. FORMATTED-TAG may be null so treat
>> + ;; that as a special case.
>> + (let ((tag (or formatted-tag "")))
>> (dolist (format (cdr formats) tag)
>> - (setq tag (eval format)))))))
>> - (puthash tag formatted notmuch-tag--format-cache)))
>> + (setq tag (eval format)))
>> + (if (and (null formatted-tag)
>> + (equal tag ""))
>> + nil
>> + tag)))))
>> + (puthash (cons tag tag-state) formatted notmuch-tag--format-cache)))
>> formatted))
>>
>> -(defun notmuch-tag-format-tags (tags &optional face)
>> +(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* ((formatted-tag (notmuch-tag-format-tag-by-state tag tag nil)))
>> + (cond ((not (member tag tags))
>> + (notmuch-tag-format-tag-by-state tag formatted-tag 'deleted))
>> + ((not (member tag orig-tags))
>> + (notmuch-tag-format-tag-by-state tag formatted-tag 'added))
>> + (t
>> + 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)))
More information about the notmuch
mailing list