X-Git-Url: https://git.notmuchmail.org/git?a=blobdiff_plain;f=emacs%2Fnotmuch-tag.el;h=c54e6ad048468d94955d775d3e1d3cd825ce8ebe;hb=87d462a20423a25eaf4b54a90bfd538dd93da675;hp=49662c2034ce3c4d13f8bb980695b14ae5541616;hpb=ba8fba3d6aa37b1c7698137f6d577309335981ae;p=notmuch diff --git a/emacs/notmuch-tag.el b/emacs/notmuch-tag.el index 49662c20..c54e6ad0 100644 --- a/emacs/notmuch-tag.el +++ b/emacs/notmuch-tag.el @@ -24,8 +24,12 @@ ;;; Code: ;; -(require 'cl) +(require 'cl-lib) +(eval-when-compile + (require 'pcase)) + (require 'crm) + (require 'notmuch-lib) (declare-function notmuch-search-tag "notmuch" tag-changes) @@ -57,10 +61,13 @@ tagging operations to apply, or a variable which contains a list of tagging operations such as `notmuch-archive-tags'. The final element is a name for this tagging operation. If the name is omitted or empty then the list of tag changes, or the variable -name is used as the name. The key `r` should not be used as that -is already bound: it switches the menu to a menu of the reverse -tagging operations. The reverse of a tagging operation is the -same list of individual tag-ops but with `+tag` replaced by +name is used as the name. + +The key `notmuch-tag-jump-reverse-key' (k by default) should not +be used (either as a key, or as the start of a key sequence) as +it is already bound: it switches the menu to a menu of the +reverse tagging operations. The reverse of a tagging operation is +the same list of individual tag-ops but with `+tag` replaced by `-tag` and vice versa. If setting this variable outside of customize then it should be a @@ -77,7 +84,7 @@ from TAGGING-OPERATIONS." :group 'notmuch-tag) (define-widget 'notmuch-tag-format-type 'lazy - "Customize widget for notmuch-tag-format and friends" + "Customize widget for notmuch-tag-format and friends." :type '(alist :key-type (regexp :tag "Tag") :extra-offset -3 :value-type @@ -112,7 +119,12 @@ Used in the default value of `notmuch-tag-formats`." :group 'notmuch-faces) (defface notmuch-tag-flagged - '((t :foreground "blue")) + '((((class color) + (background dark)) + (:foreground "LightBlue1")) + (((class color) + (background light)) + (:foreground "blue"))) "Face used for the flagged tag. Used in the default value of `notmuch-tag-formats`." @@ -269,10 +281,10 @@ This can be used with `notmuch-tag-format-image-data'." (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))))))) + (cl-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." @@ -301,13 +313,13 @@ are not in TAGS) are shown using formats from 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'" +`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 + (over (cl-case tag-state (deleted (notmuch-tag--get-formats tag notmuch-tag-deleted-formats)) (added (notmuch-tag--get-formats @@ -339,7 +351,7 @@ changed (the normal case) are shown using formats from '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" +the messages that are about to be tagged." :type 'hook :options '(notmuch-hl-line-mode) @@ -351,7 +363,7 @@ the messages that are about to be tagged" '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" +the messages that were tagged." :type 'hook :options '(notmuch-hl-line-mode) :group 'notmuch-hooks) @@ -428,7 +440,7 @@ from TAGS if present." (dolist (tag-change tag-changes) (let ((op (string-to-char tag-change)) (tag (unless (string= tag-change "") (substring tag-change 1)))) - (case op + (cl-case op (?+ (unless (member tag result-tags) (push tag result-tags))) (?- (setq result-tags (delete tag result-tags))) @@ -449,7 +461,7 @@ QUERY should be a string containing the search-terms. TAG-CHANGES is a list of strings of the form \"+tag\" or \"-tag\" to add or remove tags, respectively. -Note: Other code should always use this function alter tags of +Note: Other code should always use this function to alter tags of messages instead of running (notmuch-call-notmuch-process \"tag\" ..) directly, so that hooks specified in notmuch-before-tag-hook and notmuch-after-tag-hook will be run." @@ -485,6 +497,9 @@ begin with a \"+\" or a \"-\". If REVERSE is non-nil, replace all s))) tags)) +(defvar notmuch-tag-jump-reverse-key "k" + "The key in tag-jump to switch to the reverse tag changes.") + (defun notmuch-tag-jump (reverse) "Create a jump menu for tagging operations. @@ -500,22 +515,21 @@ and vice versa." ;; REVERSE is specified. (interactive "P") (let (action-map) - (dolist (binding notmuch-tagging-keys) - (let* ((tag-function (case major-mode + (pcase-dolist (`(,key ,tag ,name) notmuch-tagging-keys) + (let* ((tag-function (cl-case major-mode (notmuch-search-mode #'notmuch-search-tag) (notmuch-show-mode #'notmuch-show-tag) (notmuch-tree-mode #'notmuch-tree-tag))) - (key (first binding)) - (forward-tag-change (if (symbolp (second binding)) - (symbol-value (second binding)) - (second binding))) + (tag (if (symbolp tag) + (symbol-value tag) + tag)) (tag-change (if reverse - (notmuch-tag-change-list forward-tag-change 't) - forward-tag-change)) - (name (or (and (not (string= (third binding) "")) - (third binding)) - (and (symbolp (second binding)) - (symbol-name (second binding))))) + (notmuch-tag-change-list tag 't) + tag)) + (name (or (and (not (string= name "")) + name) + (and (symbolp name) + (symbol-name name)))) (name-string (if name (if reverse (concat "Reverse " name) name) @@ -523,9 +537,10 @@ and vice versa." (push (list key name-string `(lambda () (,tag-function ',tag-change))) action-map))) - (push (list "r" (if reverse - "Forward tag changes " - "Reverse tag changes") + (push (list notmuch-tag-jump-reverse-key + (if reverse + "Forward tag changes " + "Reverse tag changes") (apply-partially 'notmuch-tag-jump (not reverse))) action-map) (setq action-map (nreverse action-map)) @@ -534,7 +549,3 @@ and vice versa." ;; (provide 'notmuch-tag) - -;; Local Variables: -;; byte-compile-warnings: (not cl-functions) -;; End: