[Patch v3 5/8] emacs: show: mark tags changed since buffer loaded
Mark Walters
markwalters1009 at gmail.com
Sat Mar 22 01:35:47 PDT 2014
Hi
Ok I have something working based on your version below. I will post
once I have tested a little more. Since the diff with my version will be
quite big I will just comment on the differences from your version.
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.
>
>> +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.
>
> 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)
I changed formatted to formatted-tag.
> (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)))))
I moved the nil case to an otherwise case (and corrected the typo of
deleted-formats to added-formats in the second clause).
> (setq formatted (notmuch-tag--do-format
> (notmuch-tag--do-format tag) base over))
I split this into two steps. I also slightly changed
notmuch-tag--do-format so it gets passed tag and formatted-tag
> (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)))))))
I have not changed this.
> (defun notmuch-tag--do-format (tag formats)
> "Apply a tag-formats entry to TAG."
We need to pass formatted-tag as well as the original unformatted tag
because we want to do the look up to decide what to do based on the
original tag not whatever it has become.
> (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)))))
This got slightly tweaked because of the formatted/original split above.
> (Completely untested and all indented with spaces and probably
> incorrectly because I wrote it all in my email buffer, but you get the
> idea.)
And I think I fixed all the whitespace
This looks much nicer than my version. Thanks!
Best wishes
Mark
>
>> (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 ...
>
>> + (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