X-Git-Url: https://git.notmuchmail.org/git?p=notmuch;a=blobdiff_plain;f=emacs%2Fnotmuch-tag.el;h=fa376b02b5f9ebc6fde1a2a4f8f23c665948e05d;hp=2fcf5a9e9fa65073a9bf0f71b839ce8af3dfc2c1;hb=fc4cda07a9afbbb545dcc6cd835ca697f6ef2a1b;hpb=caaa10876046096320f4e69053542eabe17e7e55 diff --git a/emacs/notmuch-tag.el b/emacs/notmuch-tag.el index 2fcf5a9e..fa376b02 100644 --- a/emacs/notmuch-tag.el +++ b/emacs/notmuch-tag.el @@ -1,4 +1,4 @@ -;;; notmuch-tag.el --- tag messages within emacs +;;; notmuch-tag.el --- tag messages within emacs -*- lexical-binding: t -*- ;; ;; Copyright © Damien Cassou ;; Copyright © Carl Worth @@ -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." @@ -69,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." @@ -85,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") @@ -117,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 @@ -129,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 @@ -171,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 @@ -179,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 @@ -200,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 @@ -218,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. @@ -271,6 +276,8 @@ 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'.") @@ -288,22 +295,24 @@ This can be used with `notmuch-tag-format-image-data'." (and (eq (string-match key tag) 0) (= (match-end 0) (length tag))))))) -(defun notmuch-tag--do-format (tag formatted-tag formats) +(defun notmuch-tag--do-format (bare-tag tag formats) "Apply a tag-formats entry to TAG." (cond ((null formats) ;; - Tag not in `formats', - formatted-tag) ;; the format is the tag itself. + 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 "")))) + (let ((return-tag (copy-sequence (or tag "")))) (dolist (format (cdr formats)) - (setq tag (eval format))) - (if (and (null formatted-tag) (equal tag "")) + (setq return-tag + (eval format + `((bare-tag . ,bare-tag) + (tag . ,return-tag))))) + (if (and (null tag) (equal return-tag "")) nil - tag))))) + return-tag))))) (defun notmuch-tag-format-tag (tags orig-tags tag) "Format TAG according to `notmuch-tag-formats'. @@ -348,6 +357,8 @@ changed (the normal case) are shown using formats from face t))) +;;; Hooks + (defcustom notmuch-before-tag-hook nil "Hooks that are run before tags of a message are modified. @@ -370,6 +381,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.") @@ -382,8 +395,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 @@ -430,6 +443,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. @@ -507,7 +522,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 @@ -525,14 +540,15 @@ 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 @@ -547,6 +563,8 @@ and vice versa." (setq action-map (nreverse action-map)) (notmuch-jump action-map "Tag: "))) -;; +;;; _ (provide 'notmuch-tag) + +;;; notmuch-tag.el ends here