X-Git-Url: https://git.notmuchmail.org/git?p=notmuch;a=blobdiff_plain;f=emacs%2Fnotmuch-tag.el;h=817ea99fcfc33c5b7770ffb0dfc8f44d2f7593c0;hp=c54e6ad048468d94955d775d3e1d3cd825ce8ebe;hb=2ca941163da06aed564dab1990fb333fd7457ec2;hpb=ed40579ad3882e6f9bbe9b1ba5e707ab289ca203 diff --git a/emacs/notmuch-tag.el b/emacs/notmuch-tag.el index c54e6ad0..817ea99f 100644 --- a/emacs/notmuch-tag.el +++ b/emacs/notmuch-tag.el @@ -20,9 +20,8 @@ ;; ;; Authors: Carl Worth ;; Damien Cassou -;; + ;;; Code: -;; (require 'cl-lib) (eval-when-compile @@ -32,11 +31,13 @@ (require 'notmuch-lib) -(declare-function notmuch-search-tag "notmuch" tag-changes) -(declare-function notmuch-show-tag "notmuch-show" tag-changes) -(declare-function notmuch-tree-tag "notmuch-tree" tag-changes) +(declare-function notmuch-search-tag "notmuch" + (tag-changes &optional beg end only-matched)) +(declare-function notmuch-show-tag "notmuch-show" (tag-changes)) +(declare-function notmuch-tree-tag "notmuch-tree" (tag-changes)) +(declare-function notmuch-jump "notmuch-jump" (action-map prompt)) -(autoload 'notmuch-jump "notmuch-jump") +;;; Keys (define-widget 'notmuch-tag-key-type 'list "A single key tagging binding." @@ -44,7 +45,9 @@ :args '((list :inline t :format "%v" (key-sequence :tag "Key") - (radio :tag "Tag operations" (repeat :tag "Tag list" (string :format "%v" :tag "change")) + (radio :tag "Tag operations" + (repeat :tag "Tag list" + (string :format "%v" :tag "change")) (variable :tag "Tag variable")) (string :tag "Name")))) @@ -67,15 +70,15 @@ 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. +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 list of triples (lists of three elements). Each triple should be of the form (key-binding tagging-operations name). KEY-BINDING can be a single character or a key sequence; TAGGING-OPERATIONS should either be a list of individual tag operations each of the -form `+tag` or `-tag`, or the variable name of a variable that is +form `+tag' or `-tag', or the variable name of a variable that is a list of tagging operations; NAME should be a name for the tagging operation, if omitted or empty than then name is taken from TAGGING-OPERATIONS." @@ -83,6 +86,8 @@ from TAGGING-OPERATIONS." :type '(repeat notmuch-tag-key-type) :group 'notmuch-tag) +;;; Faces and Formats + (define-widget 'notmuch-tag-format-type 'lazy "Customize widget for notmuch-tag-format and friends." :type '(alist :key-type (regexp :tag "Tag") @@ -115,7 +120,7 @@ from TAGGING-OPERATIONS." '((t :foreground "red")) "Default face used for the unread tag. -Used in the default value of `notmuch-tag-formats`." +Used in the default value of `notmuch-tag-formats'." :group 'notmuch-faces) (defface notmuch-tag-flagged @@ -127,7 +132,7 @@ Used in the default value of `notmuch-tag-formats`." (:foreground "blue"))) "Face used for the flagged tag. -Used in the default value of `notmuch-tag-formats`." +Used in the default value of `notmuch-tag-formats'." :group 'notmuch-faces) (defcustom notmuch-tag-formats @@ -169,7 +174,7 @@ with images." (t :inverse-video t)) "Face used to display deleted tags. -Used in the default value of `notmuch-tag-deleted-formats`." +Used in the default value of `notmuch-tag-deleted-formats'." :group 'notmuch-faces) (defcustom notmuch-tag-deleted-formats @@ -177,7 +182,7 @@ Used in the default value of `notmuch-tag-deleted-formats`." (".*" (notmuch-apply-face tag `notmuch-tag-deleted))) "Custom formats for tags when deleted. -For deleted tags the formats in `notmuch-tag-formats` are applied +For deleted tags the formats in `notmuch-tag-formats' are applied first and then these formats are applied on top; that is `tag' passed to the function is the tag with all these previous formattings applied. The formatted can access the original @@ -198,14 +203,14 @@ See `notmuch-tag-formats' for full documentation." '((t :underline "green")) "Default face used for added tags. -Used in the default value for `notmuch-tag-added-formats`." +Used in the default value for `notmuch-tag-added-formats'." :group 'notmuch-faces) (defcustom notmuch-tag-added-formats '((".*" (notmuch-apply-face tag 'notmuch-tag-added))) "Custom formats for tags when added. -For added tags the formats in `notmuch-tag-formats` are applied +For added tags the formats in `notmuch-tag-formats' are applied first and then these formats are applied on top. To disable special formatting of added tags, set this variable to @@ -216,6 +221,8 @@ See `notmuch-tag-formats' for full documentation." :group 'notmuch-faces :type 'notmuch-tag-format-type) +;;; Icons + (defun notmuch-tag-format-image-data (tag data) "Replace TAG with image DATA, if available. @@ -234,7 +241,7 @@ DATA is the content of an SVG picture (e.g., as returned by (defun notmuch-tag-star-icon () "Return SVG data representing a star icon. This can be used with `notmuch-tag-format-image-data'." -" + " ") +;;; Format Handling + (defvar notmuch-tag--format-cache (make-hash-table :test 'equal) "Cache of tag format lookup. Internal to `notmuch-tag-format-tag'.") @@ -316,7 +325,9 @@ 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))) + (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 (cl-case tag-state @@ -327,7 +338,6 @@ changed (the normal case) are shown using formats from (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)) @@ -338,13 +348,15 @@ changed (the normal case) are shown using formats from (notmuch-apply-face (mapconcat #'identity ;; nil indicated that the tag was deliberately hidden - (delq nil (mapcar - (apply-partially #'notmuch-tag-format-tag tags orig-tags) - all-tags)) + (delq nil (mapcar (apply-partially #'notmuch-tag-format-tag + tags orig-tags) + all-tags)) " ") face t))) +;;; Hooks + (defcustom notmuch-before-tag-hook nil "Hooks that are run before tags of a message are modified. @@ -352,7 +364,6 @@ changed (the normal case) are shown using formats from 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." - :type 'hook :options '(notmuch-hl-line-mode) :group 'notmuch-hooks) @@ -368,6 +379,8 @@ the messages that were tagged." :options '(notmuch-hl-line-mode) :group 'notmuch-hooks) +;;; User Input + (defvar notmuch-select-tag-history nil "Variable to store minibuffer history for `notmuch-select-tag-with-completion' function.") @@ -380,8 +393,8 @@ the messages that were tagged." "Return a list of tags for messages matching SEARCH-TERMS. Returns all tags if no search terms are given." - (if (null search-terms) - (setq search-terms (list "*"))) + (unless search-terms + (setq search-terms (list "*"))) (split-string (with-output-to-string (with-current-buffer standard-output @@ -402,7 +415,6 @@ completions. CURRENT-TAGS may contain duplicates. PROMPT, if non-nil, is the query string to present in the minibuffer. It defaults to \"Tags\". INITIAL-INPUT, if non-nil, will be the initial input in the minibuffer." - (let* ((all-tag-list (notmuch-tag-completions)) (add-tag-list (mapcar (apply-partially 'concat "+") all-tag-list)) (remove-tag-list (mapcar (apply-partially 'concat "-") current-tags)) @@ -429,6 +441,8 @@ initial input in the minibuffer." nil nil initial-input 'notmuch-read-tag-changes-history)))) +;;; Tagging + (defun notmuch-update-tags (tags tag-changes) "Return a copy of TAGS with additions and removals from TAG-CHANGES. @@ -506,7 +520,7 @@ begin with a \"+\" or a \"-\". If REVERSE is non-nil, replace all Creates and displays a jump menu for the tagging operations specified in `notmuch-tagging-keys'. If REVERSE is set then it offers a menu of the reverses of the operations specified in -`notmuch-tagging-keys'; i.e. each `+tag` is replaced by `-tag` +`notmuch-tagging-keys'; i.e. each `+tag' is replaced by `-tag' and vice versa." ;; In principle this function is simple, but it has to deal with ;; lots of cases: different modes (search/show/tree), whether a name @@ -524,18 +538,19 @@ and vice versa." (symbol-value tag) tag)) (tag-change (if reverse - (notmuch-tag-change-list tag 't) + (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) + (if reverse + (concat "Reverse " name) name) (mapconcat #'identity tag-change " ")))) (push (list key name-string - `(lambda () (,tag-function ',tag-change))) + `(lambda () (,tag-function ',tag-change))) action-map))) (push (list notmuch-tag-jump-reverse-key (if reverse @@ -546,6 +561,8 @@ and vice versa." (setq action-map (nreverse action-map)) (notmuch-jump action-map "Tag: "))) -;; +;;; _ (provide 'notmuch-tag) + +;;; notmuch-tag.el ends here