X-Git-Url: https://git.notmuchmail.org/git?a=blobdiff_plain;f=emacs%2Fnotmuch-tag.el;h=ad0cb1c13c859a5232ce3a80861f5a25c38b5bc1;hb=d298af9e9d75f076d767044738b4811a82f9b2ca;hp=a553dfd9aeedd4292ac4b9b12f0509f61b4958ad;hpb=9be8c6802fa5ce7fa61a2656daf337ac935da423;p=notmuch

diff --git a/emacs/notmuch-tag.el b/emacs/notmuch-tag.el
index a553dfd9..ad0cb1c1 100644
--- a/emacs/notmuch-tag.el
+++ b/emacs/notmuch-tag.el
@@ -23,10 +23,6 @@
 
 ;;; Code:
 
-(require 'cl-lib)
-(eval-when-compile
-  (require 'pcase))
-
 (require 'crm)
 
 (require 'notmuch-lib)
@@ -141,20 +137,23 @@ Used in the default value of `notmuch-tag-formats'."
      (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.  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
@@ -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\"?>
-<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\"
@@ -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\"?>
-<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\"
@@ -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\"?>
-<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\"
@@ -384,35 +383,34 @@ the messages that were tagged."
 ;;; 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
-  "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.
 
-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
-       (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)
-  (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.
 
-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
@@ -431,17 +429,9 @@ initial input in the minibuffer."
 	    (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
 
@@ -454,9 +444,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)
-      (let ((op (string-to-char tag-change))
-	    (tag (unless (string= tag-change "") (substring tag-change 1))))
-	(cl-case op
+      (let ((tag (and (not (string-empty-p tag-change))
+		      (substring tag-change 1))))
+	(cl-case (aref tag-change 0)
 	  (?+ (unless (member tag result-tags)
 		(push tag result-tags)))
 	  (?- (setq result-tags (delete tag result-tags)))
@@ -468,7 +458,11 @@ 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
-avoid system argument length limits and performance problems.")
+avoid system argument length limits and performance problems.
+
+NOTE: this variable is no longer used.")
+
+(make-obsolete-variable 'notmuch-tag-argument-limit nil "notmuch 0.36")
 
 (defun notmuch-tag (query tag-changes)
   "Add/remove tags in TAG-CHANGES to messages matching QUERY.
@@ -482,22 +476,22 @@ messages instead of running (notmuch-call-notmuch-process \"tag\" ..)
 directly, so that hooks specified in notmuch-before-tag-hook and
 notmuch-after-tag-hook will be run."
   ;; Perform some validation
-  (mapc (lambda (tag-change)
-	  (unless (string-match-p "^[-+]\\S-+$" tag-change)
-	    (error "Tag must be of the form `+this_tag' or `-that_tag'")))
-	tag-changes)
+  (dolist (tag-change tag-changes)
+    (unless (string-match-p "^[-+]\\S-+$" tag-change)
+      (error "Tag must be of the form `+this_tag' or `-that_tag'")))
   (unless query
     (error "Nothing to tag!"))
-  (unless (null 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")))
-    (run-hooks 'notmuch-after-tag-hook)))
+  (when tag-changes
+    (notmuch-dlet ((tag-changes tag-changes)
+		   (query query))
+      (run-hooks 'notmuch-before-tag-hook))
+    ;; 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-after-tag-hook)))
 
 (defun notmuch-tag-change-list (tags &optional reverse)
   "Convert TAGS into a list of tag changes.
@@ -552,7 +546,7 @@ and vice versa."
 				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