emacs: avoid binding unnamed commands in keymaps

[notmuch] / emacs / notmuch-tag.el

diff --git a/emacs/notmuch-tag.el b/emacs/notmuch-tag.el
index 0500927d37ce2b1e0173fb0f6ff7bc159a85018e..925de78c7dc6bc4927d60cc31ead75e6a1e52211 100644 (file)
--- a/emacs/notmuch-tag.el
+++ b/emacs/notmuch-tag.el
@@ -20,19 +20,22 @@
 ;;
 ;; 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)
+(require 'cl-lib)
+(eval-when-compile
+  (require 'pcase))
+

 (require 'crm)
 (require 'crm)

-(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)
+(require 'notmuch-lib)

 
 

-(autoload 'notmuch-jump "notmuch-jump")
+(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))

 
 (define-widget 'notmuch-tag-key-type 'list
   "A single key tagging binding."
 
 (define-widget 'notmuch-tag-key-type 'list
   "A single key tagging binding."


@@ -40,7 +43,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"))))
 


@@ -63,15 +68,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."


@@ -80,7 +85,7 @@ from TAGGING-OPERATIONS."
   :group 'notmuch-tag)
 
 (define-widget 'notmuch-tag-format-type 'lazy
   :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
   :type '(alist :key-type (regexp :tag "Tag")
                :extra-offset -3
                :value-type


@@ -111,7 +116,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


@@ -123,7 +128,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


@@ -165,7 +170,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


@@ -173,7 +178,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


@@ -194,14 +199,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


@@ -230,7 +235,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


@@ -277,10 +282,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.
   (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."
 
 (defun notmuch-tag--do-format (tag formatted-tag formats)
   "Apply a tag-formats entry to TAG."


@@ -309,13 +314,15 @@ 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
 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)))
   (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))
     (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
                    (deleted (notmuch-tag--get-formats
                              tag notmuch-tag-deleted-formats))
                    (added (notmuch-tag--get-formats


@@ -323,7 +330,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))
 


@@ -334,9 +340,9 @@ 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)))


@@ -347,8 +353,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
 '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)
   :group 'notmuch-hooks)
   :type 'hook
   :options '(notmuch-hl-line-mode)
   :group 'notmuch-hooks)


@@ -359,7 +364,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
 '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)
   :type 'hook
   :options '(notmuch-hl-line-mode)
   :group 'notmuch-hooks)


@@ -376,8 +381,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


@@ -398,7 +403,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))


@@ -436,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))))
     (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)))
          (?+ (unless (member tag result-tags)
                (push tag result-tags)))
          (?- (setq result-tags (delete tag result-tags)))


@@ -502,7 +506,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


@@ -511,28 +515,28 @@ and vice versa."
   ;; REVERSE is specified.
   (interactive "P")
   (let (action-map)
   ;; 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)))
                             (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
             (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
             (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


@@ -547,6 +551,4 @@ and vice versa."
 
 (provide 'notmuch-tag)
 
 
 (provide 'notmuch-tag)
 

-;; Local Variables:
-;; byte-compile-warnings: (not cl-functions)
-;; End:
+;;; notmuch-tag.el ends here