X-Git-Url: https://git.notmuchmail.org/git?p=notmuch;a=blobdiff_plain;f=emacs%2Fnotmuch-tag.el;h=c7f62c90974995caf64aea212e0a5eae9fa97b5e;hp=3ae5e62ffa106ef57c038a95550ecd4cc4ce581a;hb=3b348ab1e11339ccbef1b56ceeb96e96e44eb079;hpb=d5acfdda5f9a64b934a86e5ec877b6b7d1d80a0f diff --git a/emacs/notmuch-tag.el b/emacs/notmuch-tag.el index 3ae5e62f..c7f62c90 100644 --- a/emacs/notmuch-tag.el +++ b/emacs/notmuch-tag.el @@ -193,45 +193,71 @@ This can be used with `notmuch-tag-format-image-data'." "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))) - (when (eq formatted 'missing) - (let* ((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 - :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 (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))))))) - (puthash tag formatted notmuch-tag--format-cache))) - formatted)) - -(defun notmuch-tag-format-tags (tags &optional face) +(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 formatted-tag formats) + "Apply a tag-formats entry to TAG." + (cond ((null formats) ;; - Tag not in `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, we must apply all the + ;; formats. TAG may be null so treat that as a special case. + (let ((bare-tag tag) + (tag (copy-sequence (or formatted-tag "")))) + (dolist (format (cdr formats)) + (setq tag (eval format))) + (if (and (null formatted-tag) (equal tag "")) + nil + 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-tag (gethash (cons tag tag-state) notmuch-tag--format-cache 'missing))) + (when (eq formatted-tag 'missing) + (let ((base (notmuch-tag--get-formats tag notmuch-tag-formats)) + (over (case tag-state + (deleted (notmuch-tag--get-formats + tag notmuch-tag-deleted-formats)) + (added (notmuch-tag--get-formats + tag notmuch-tag-added-formats)) + (otherwise nil)))) + (setq formatted-tag (notmuch-tag--do-format tag tag base)) + (setq formatted-tag (notmuch-tag--do-format tag formatted-tag over)) + + (puthash (cons tag tag-state) formatted-tag notmuch-tag--format-cache))) + 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))) @@ -239,7 +265,7 @@ buffer that uses formatted tags." (defcustom notmuch-before-tag-hook nil "Hooks that are run before tags of a message are modified. -'tags' will contain the tags that are about to be added or removed as +'tag-changes' will contain the tags that are about to be added or removed as a list of strings of the form \"+TAG\" or \"-TAG\". 'query' will be a string containing the search query that determines the messages that are about to be tagged" @@ -251,7 +277,7 @@ the messages that are about to be tagged" (defcustom notmuch-after-tag-hook nil "Hooks that are run after tags of a message are modified. -'tags' will contain the tags that were added or removed as +'tag-changes' will contain the tags that were added or removed as a list of strings of the form \"+TAG\" or \"-TAG\". 'query' will be a string containing the search query that determines the messages that were tagged" @@ -361,6 +387,8 @@ notmuch-after-tag-hook will be run." (unless (string-match-p "^[-+]\\S-+$" tag-change) (error "Tag must be of the form `+this_tag' or `-that_tag'"))) tag-changes) + (unless query + (error "Nothing to tag!")) (unless (null tag-changes) (run-hooks 'notmuch-before-tag-hook) (if (<= (length query) notmuch-tag-argument-limit)