emacs: Add new option notmuch-search-hide-excluded

[notmuch] / emacs / notmuch-tag.el

diff --git a/emacs/notmuch-tag.el b/emacs/notmuch-tag.el
index 0c9a32ac4856a9d78167751da4ebf48e9b7c74db..811018288f373b1df099fa7b791b27a47e313709 100644 (file)
--- a/emacs/notmuch-tag.el
+++ b/emacs/notmuch-tag.el
@@ -23,10 +23,6 @@
 
 ;;; Code:
 
 
 ;;; Code:
 

-(require 'cl-lib)
-(eval-when-compile
-  (require 'pcase))
-

 (require 'crm)
 
 (require 'notmuch-lib)
 (require 'crm)
 
 (require 'notmuch-lib)


@@ -141,26 +137,29 @@ Used in the default value of `notmuch-tag-formats'."
      (notmuch-tag-format-image-data tag (notmuch-tag-star-icon))))
   "Custom formats for individual tags.
 
      (notmuch-tag-format-image-data tag (notmuch-tag-star-icon))))
   "Custom formats for individual tags.
 

-This is an association list that maps from tag name regexps to
-lists of formatting expressions.  The first entry whose car
-regexp-matches a tag will be used to format that tag.  The regexp
-is implicitly anchored, so to match a literal tag name, just use
-that tag name (if it contains special regexp characters like
-\".\" or \"*\", these have to be escaped).  The cdr of the
-matching entry gives a list of Elisp expressions that modify the
-tag.  If the list is empty, the tag will simply be hidden.
-Otherwise, each expression will be evaluated in order: for the
-first expression, the variable `tag' will be bound to the tag
-name; for each later expression, the variable `tag' will be bound
-to the result of the previous expression.  In this way, each
+This is an association list of the form ((MATCH EXPR...)...),
+mapping tag name regexps to lists of formatting expressions.
+
+The first entry whose MATCH regexp-matches a tag is used to
+format that tag.  The regexp is implicitly anchored, so to match
+a literal tag name, just use that tag name (if it contains
+special regexp characters like \".\" or \"*\", these have to be
+escaped).
+
+The cdr of the matching entry gives a list of Elisp expressions
+that modify the tag.  If the list is empty, the tag is simply
+hidden.  Otherwise, each expression EXPR is evaluated in order:
+for the first expression, the variable `tag' is bound to the tag
+name; for each later expression, the variable `tag' is bound to
+the result of the previous expression.  In this way, each

 expression can build on the formatting performed by the previous
 expression can build on the formatting performed by the previous

-expression.  The result of the last expression will displayed in
+expression.  The result of the last expression is displayed in

 place of the tag.
 
 For example, to replace a tag with another string, simply use
 that string as a formatting expression.  To change the foreground
 of a tag to red, use the expression
 place of the tag.
 
 For example, to replace a tag with another string, simply use
 that string as a formatting expression.  To change the foreground
 of a tag to red, use the expression

-  (propertize tag 'face '(:foreground \"red\"))
+  (propertize tag \\='face \\='(:foreground \"red\"))

 
 See also `notmuch-tag-format-image', which can help replace tags
 with images."
 
 See also `notmuch-tag-format-image', which can help replace tags
 with images."


@@ -192,7 +191,7 @@ By default this shows deleted tags with strike-through in red,
 unless strike-through is not available (e.g., emacs is running in
 a terminal) in which case it uses inverse video. To hide deleted
 tags completely set this to
 unless strike-through is not available (e.g., emacs is running in
 a terminal) in which case it uses inverse video. To hide deleted
 tags completely set this to

-  '((\".*\" nil))
+  \\='((\".*\" nil))

 
 See `notmuch-tag-formats' for full documentation."
   :group 'notmuch-show
 
 See `notmuch-tag-formats' for full documentation."
   :group 'notmuch-show


@@ -242,7 +241,7 @@ DATA is the content of an SVG picture (e.g., as returned by
   "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\"?>
   "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\"?>

-<svg version=\"1.1\" width=\"16\" height=\"16\">
+<svg version=\"1.1\" width=\"16\" height=\"16\" xmlns=\"http://www.w3.org/2000/svg\">

   <g transform=\"translate(-242.81601,-315.59635)\">
     <path
        d=\"m 290.25762,334.31206 -17.64143,-11.77975 -19.70508,7.85447 5.75171,-20.41814 -13.55925,-16.31348 21.19618,-0.83936 11.325,-17.93675 7.34825,19.89939 20.55849,5.22795 -16.65471,13.13786 z\"
   <g transform=\"translate(-242.81601,-315.59635)\">
     <path
        d=\"m 290.25762,334.31206 -17.64143,-11.77975 -19.70508,7.85447 5.75171,-20.41814 -13.55925,-16.31348 21.19618,-0.83936 11.325,-17.93675 7.34825,19.89939 20.55849,5.22795 -16.65471,13.13786 z\"


@@ -255,7 +254,7 @@ This can be used with `notmuch-tag-format-image-data'."
   "Return SVG data representing an empty star icon.
 This can be used with `notmuch-tag-format-image-data'."
   "<?xml version=\"1.0\" encoding=\"UTF-8\" standalone=\"no\"?>
   "Return SVG data representing an empty star icon.
 This can be used with `notmuch-tag-format-image-data'."
   "<?xml version=\"1.0\" encoding=\"UTF-8\" standalone=\"no\"?>

-<svg version=\"1.1\" width=\"16\" height=\"16\">
+<svg version=\"1.1\" width=\"16\" height=\"16\" xmlns=\"http://www.w3.org/2000/svg\">

   <g transform=\"translate(-242.81601,-315.59635)\">
     <path
        d=\"m 290.25762,334.31206 -17.64143,-11.77975 -19.70508,7.85447 5.75171,-20.41814 -13.55925,-16.31348 21.19618,-0.83936 11.325,-17.93675 7.34825,19.89939 20.55849,5.22795 -16.65471,13.13786 z\"
   <g transform=\"translate(-242.81601,-315.59635)\">
     <path
        d=\"m 290.25762,334.31206 -17.64143,-11.77975 -19.70508,7.85447 5.75171,-20.41814 -13.55925,-16.31348 21.19618,-0.83936 11.325,-17.93675 7.34825,19.89939 20.55849,5.22795 -16.65471,13.13786 z\"


@@ -268,7 +267,7 @@ This can be used with `notmuch-tag-format-image-data'."
   "Return SVG data representing a tag icon.
 This can be used with `notmuch-tag-format-image-data'."
   "<?xml version=\"1.0\" encoding=\"UTF-8\" standalone=\"no\"?>
   "Return SVG data representing a tag icon.
 This can be used with `notmuch-tag-format-image-data'."
   "<?xml version=\"1.0\" encoding=\"UTF-8\" standalone=\"no\"?>

-<svg version=\"1.1\" width=\"16\" height=\"16\">
+<svg version=\"1.1\" width=\"16\" height=\"16\" xmlns=\"http://www.w3.org/2000/svg\">

   <g transform=\"translate(0,-1036.3622)\">
     <path
        d=\"m 0.44642857,1040.9336 12.50000043,0 2.700893,3.6161 -2.700893,3.616 -12.50000043,0 z\"
   <g transform=\"translate(0,-1036.3622)\">
     <path
        d=\"m 0.44642857,1040.9336 12.50000043,0 2.700893,3.6161 -2.700893,3.616 -12.50000043,0 z\"


@@ -276,6 +275,11 @@ This can be used with `notmuch-tag-format-image-data'."
   </g>
 </svg>")
 
   </g>
 </svg>")
 

+;;; track history of tag operations
+(defvar-local notmuch-tag-history nil
+  "Buffer local history of `notmuch-tag' function.")
+(put 'notmuch-tag-history 'permanent-local t)
+

 ;;; Format Handling
 
 (defvar notmuch-tag--format-cache (make-hash-table :test 'equal)
 ;;; Format Handling
 
 (defvar notmuch-tag--format-cache (make-hash-table :test 'equal)


@@ -362,9 +366,9 @@ changed (the normal case) are shown using formats from
 (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.
 

-'tag-changes' will contain the tags that are about to be added or removed as
+`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\".
 a list of strings of the form \"+TAG\" or \"-TAG\".

-'query' will be a string containing the search query that determines
+`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)
 the messages that are about to be tagged."
   :type 'hook
   :options '(notmuch-hl-line-mode)


@@ -373,9 +377,9 @@ the messages that are about to be tagged."
 (defcustom notmuch-after-tag-hook nil
   "Hooks that are run after tags of a message are modified.
 
 (defcustom notmuch-after-tag-hook nil
   "Hooks that are run after tags of a message are modified.
 

-'tag-changes' will contain the tags that were added or removed as
+`tag-changes' will contain the tags that were added or removed as

 a list of strings of the form \"+TAG\" or \"-TAG\".
 a list of strings of the form \"+TAG\" or \"-TAG\".

-'query' will be a string containing the search query that determines
+`query' will be a string containing the search query that determines

 the messages that were tagged."
   :type 'hook
   :options '(notmuch-hl-line-mode)
 the messages that were tagged."
   :type 'hook
   :options '(notmuch-hl-line-mode)


@@ -384,35 +388,34 @@ the messages that were tagged."
 ;;; User Input
 
 (defvar notmuch-select-tag-history nil
 ;;; User Input
 
 (defvar notmuch-select-tag-history nil

-  "Variable to store minibuffer history for
-`notmuch-select-tag-with-completion' function.")
+  "Minibuffer history of `notmuch-select-tag-with-completion' function.")

 
 (defvar notmuch-read-tag-changes-history nil
 
 (defvar notmuch-read-tag-changes-history nil

-  "Variable to store minibuffer history for
-`notmuch-read-tag-changes' function.")
+  "Minibuffer history of `notmuch-read-tag-changes' function.")

 
 (defun notmuch-tag-completions (&rest search-terms)
   "Return a list of tags for messages matching SEARCH-TERMS.
 
 
 (defun notmuch-tag-completions (&rest search-terms)
   "Return a list of tags for messages matching SEARCH-TERMS.
 

-Returns all tags if no search terms are given."
+Return all tags if no search terms are given."

   (unless search-terms
     (setq search-terms (list "*")))
   (split-string
    (with-output-to-string
      (with-current-buffer standard-output
   (unless search-terms
     (setq search-terms (list "*")))
   (split-string
    (with-output-to-string
      (with-current-buffer standard-output

-       (apply 'call-process notmuch-command nil t
+       (apply 'notmuch--call-process notmuch-command nil t

              nil "search" "--output=tags" "--exclude=false" search-terms)))
    "\n+" t))
 
 (defun notmuch-select-tag-with-completion (prompt &rest search-terms)
              nil "search" "--output=tags" "--exclude=false" search-terms)))
    "\n+" t))
 
 (defun notmuch-select-tag-with-completion (prompt &rest search-terms)

-  (let ((tag-list (apply #'notmuch-tag-completions search-terms)))
-    (completing-read prompt tag-list nil nil nil 'notmuch-select-tag-history)))
+  (completing-read prompt
+                  (apply #'notmuch-tag-completions search-terms)
+                  nil nil nil 'notmuch-select-tag-history))

 
 (defun notmuch-read-tag-changes (current-tags &optional prompt initial-input)
   "Prompt for tag changes in the minibuffer.
 
 
 (defun notmuch-read-tag-changes (current-tags &optional prompt initial-input)
   "Prompt for tag changes in the minibuffer.
 

-CURRENT-TAGS is a list of tags that are present on the message or
-messages to be changed.  These are offered as tag removal
+CURRENT-TAGS is a list of tags that are present on the message
+or messages to be changed.  These are offered as tag removal

 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
 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


@@ -431,17 +434,9 @@ initial input in the minibuffer."
            (set-keymap-parent map crm-local-completion-map)
            (define-key map " " 'self-insert-command)
            map)))
            (set-keymap-parent map crm-local-completion-map)
            (define-key map " " 'self-insert-command)
            map)))

-    (delete "" (completing-read-multiple
-               prompt
-               ;; Append the separator to each completion so when the
-               ;; user completes a tag they can immediately begin
-               ;; entering another.  `completing-read-multiple'
-               ;; ultimately splits the input on crm-separator, so we
-               ;; don't need to strip this back off (we just need to
-               ;; delete "empty" entries caused by trailing spaces).
-               (mapcar (lambda (tag-op) (concat tag-op crm-separator)) tag-list)
-               nil nil initial-input
-               'notmuch-read-tag-changes-history))))
+    (completing-read-multiple prompt tag-list
+                             nil nil initial-input
+                             'notmuch-read-tag-changes-history)))

 
 ;;; Tagging
 
 
 ;;; Tagging
 


@@ -454,10 +449,9 @@ present or a \"-\" to indicate that the tag should be removed
 from TAGS if present."
   (let ((result-tags (copy-sequence tags)))
     (dolist (tag-change tag-changes)
 from TAGS if present."
   (let ((result-tags (copy-sequence tags)))
     (dolist (tag-change tag-changes)

-      (let ((op (aref tag-change 0))
-           (tag (and (not (string= tag-change ""))
+      (let ((tag (and (not (string-empty-p tag-change))

                      (substring tag-change 1))))
                      (substring tag-change 1))))

-       (cl-case op
+       (cl-case (aref tag-change 0)

          (?+ (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)))


@@ -469,14 +463,19 @@ from TAGS if present."
   "Use batch tagging if the tagging query is longer than this.
 
 This limits the length of arguments passed to the notmuch CLI to
   "Use batch tagging if the tagging query is longer than this.
 
 This limits the length of arguments passed to the notmuch CLI to

-avoid system argument length limits and performance problems.")
+avoid system argument length limits and performance problems.
+
+NOTE: this variable is no longer used.")

 
 

-(defun notmuch-tag (query tag-changes)
+(make-obsolete-variable 'notmuch-tag-argument-limit nil "notmuch 0.36")
+
+(defun notmuch-tag (query tag-changes &optional omit-hist)

   "Add/remove tags in TAG-CHANGES to messages matching QUERY.
 
 QUERY should be a string containing the search-terms.
   "Add/remove tags in TAG-CHANGES to messages matching QUERY.
 
 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.
+TAG-CHANGES is a list of strings of the form \"+tag\" or \"-tag\"
+to add or remove tags, respectively.  OMIT-HIST disables history
+tracking if non-nil.

 
 Note: Other code should always use this function to alter tags of
 messages instead of running (notmuch-call-notmuch-process \"tag\" ..)
 
 Note: Other code should always use this function to alter tags of
 messages instead of running (notmuch-call-notmuch-process \"tag\" ..)


@@ -489,16 +488,34 @@ notmuch-after-tag-hook will be run."
   (unless query
     (error "Nothing to tag!"))
   (when tag-changes
   (unless query
     (error "Nothing to tag!"))
   (when tag-changes

-    (run-hooks 'notmuch-before-tag-hook)
-    (if (<= (length query) notmuch-tag-argument-limit)
-       (apply 'notmuch-call-notmuch-process "tag"
-              (append tag-changes (list "--" query)))
-      ;; Use batch tag mode to avoid argument length limitations
-      (let ((batch-op (concat (mapconcat #'notmuch-hex-encode tag-changes " ")
-                             " -- " query)))
-       (notmuch-call-notmuch-process :stdin-string batch-op "tag" "--batch")))
+    (notmuch-dlet ((tag-changes tag-changes)
+                  (query query))
+      (run-hooks 'notmuch-before-tag-hook))
+    (with-temp-buffer
+      (insert (concat (mapconcat #'notmuch-hex-encode tag-changes " ") " -- " query))
+      (unless (= 0
+                (notmuch--call-process-region
+                 (point-min) (point-max) notmuch-command t t nil "tag" "--batch"))
+       (notmuch-logged-error "notmuch tag failed" (buffer-string))))
+    (unless omit-hist
+      (push (list :query query :tag-changes tag-changes) notmuch-tag-history)))
+  (notmuch-dlet ((tag-changes tag-changes)
+                (query query))

     (run-hooks 'notmuch-after-tag-hook)))
 
     (run-hooks 'notmuch-after-tag-hook)))
 

+(defun notmuch-tag-undo ()
+  "Undo the previous tagging operation in the current buffer. Uses
+buffer local variable `notmuch-tag-history' to determine what
+that operation was."
+  (interactive)
+  (when (null notmuch-tag-history)
+    (error "no further notmuch undo information"))
+  (let* ((action (pop notmuch-tag-history))
+        (query (plist-get action :query))
+        (changes (notmuch-tag-change-list (plist-get action :tag-changes) t)))
+    (notmuch-tag query changes t))
+  (notmuch-refresh-this-buffer))
+

 (defun notmuch-tag-change-list (tags &optional reverse)
   "Convert TAGS into a list of tag changes.
 
 (defun notmuch-tag-change-list (tags &optional reverse)
   "Convert TAGS into a list of tag changes.
 


@@ -552,7 +569,7 @@ and vice versa."
                                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 () (funcall 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