]> git.notmuchmail.org Git - notmuch/blobdiff - emacs/notmuch-tag.el
emacs: make headings outline-minor-mode compatible
[notmuch] / emacs / notmuch-tag.el
index c54e6ad048468d94955d775d3e1d3cd825ce8ebe..817ea99fcfc33c5b7770ffb0dfc8f44d2f7593c0 100644 (file)
@@ -20,9 +20,8 @@
 ;;
 ;; Authors: Carl Worth <cworth@cworth.org>
 ;;          Damien Cassou <damien.cassou@gmail.com>
 ;;
 ;; Authors: Carl Worth <cworth@cworth.org>
 ;;          Damien Cassou <damien.cassou@gmail.com>
-;;
+
 ;;; Code:
 ;;; Code:
-;;
 
 (require 'cl-lib)
 (eval-when-compile
 
 (require 'cl-lib)
 (eval-when-compile
 
 (require 'notmuch-lib)
 
 
 (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."
 
 (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")
   :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"))))
 
                       (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
 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
 
 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."
 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)
 
   :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")
 (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.
 
   '((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
   :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.
 
      (: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
   :group 'notmuch-faces)
 
 (defcustom notmuch-tag-formats
@@ -169,7 +174,7 @@ with images."
     (t :inverse-video t))
   "Face used to display deleted tags.
 
     (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
   :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.
 
     (".*" (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
 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.
 
   '((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.
 
   :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
 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)
 
   :group 'notmuch-faces
   :type 'notmuch-tag-format-type)
 
+;;; Icons
+
 (defun notmuch-tag-format-image-data (tag data)
   "Replace TAG with image DATA, if available.
 
 (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'."
 (defun notmuch-tag-star-icon ()
   "Return SVG data representing a star icon.
 This can be used with `notmuch-tag-format-image-data'."
-"<?xml version=\"1.0\" encoding=\"UTF-8\" standalone=\"no\"?>
+  "<?xml version=\"1.0\" encoding=\"UTF-8\" standalone=\"no\"?>
 <svg version=\"1.1\" width=\"16\" height=\"16\">
   <g transform=\"translate(-242.81601,-315.59635)\">
     <path
 <svg version=\"1.1\" width=\"16\" height=\"16\">
   <g transform=\"translate(-242.81601,-315.59635)\">
     <path
@@ -269,6 +276,8 @@ This can be used with `notmuch-tag-format-image-data'."
   </g>
 </svg>")
 
   </g>
 </svg>")
 
+;;; Format Handling
+
 (defvar notmuch-tag--format-cache (make-hash-table :test 'equal)
   "Cache of tag format lookup.  Internal to `notmuch-tag-format-tag'.")
 
 (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)))
 `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
     (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))
                    (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))
 
        (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
     (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)))
 
                " ")
      face
      t)))
 
+;;; Hooks
+
 (defcustom notmuch-before-tag-hook nil
   "Hooks that are run before tags of a message are modified.
 
 (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."
 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)
   :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)
 
   :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.")
 (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."
   "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
   (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."
 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))
   (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))))
 
                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.
 
 (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
 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
 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
                      (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
                           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
                                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
              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: ")))
 
     (setq action-map (nreverse action-map))
     (notmuch-jump action-map "Tag: ")))
 
-;;
+;;; _
 
 (provide 'notmuch-tag)
 
 (provide 'notmuch-tag)
+
+;;; notmuch-tag.el ends here