emacs: create notmuch-tag.el, and move appropriate functions from notmuch.el

Tagging functions are used in notmuch.el, notmuch-show.el, and
notmuch-message.el.  There are enough common functions for tagging
that it makes sense to put them all in their own library.

No code is modified, just moved around.

1 files changed, 135 insertions, 0 deletions

diff --git a/emacs/notmuch-tag.el b/emacs/notmuch-tag.el
new file mode 100644
index 00000000..c25cff84
--- /dev/null
+++ b/emacs/notmuch-tag.el
@@ -0,0 +1,135 @@
+;; notmuch-tag.el --- tag messages within emacs
+;;
+;; Copyright © Carl Worth
+;;
+;; This file is part of Notmuch.
+;;
+;; Notmuch is free software: you can redistribute it and/or modify it
+;; under the terms of the GNU General Public License as published by
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
+;;
+;; Notmuch is distributed in the hope that it will be useful, but
+;; WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+;; General Public License for more details.
+;;
+;; You should have received a copy of the GNU General Public License
+;; along with Notmuch.  If not, see <http://www.gnu.org/licenses/>.
+;;
+;; Authors: Carl Worth <cworth@cworth.org>
+
+(eval-when-compile (require 'cl))
+(require 'crm)
+(require 'notmuch-lib)
+
+(defcustom notmuch-before-tag-hook nil
+  "Hooks that are run before tags of a message are modified.
+
+'tags' 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"
+
+  :type 'hook
+  :options '(notmuch-hl-line-mode)
+  :group 'notmuch-hooks)
+
+(defcustom notmuch-after-tag-hook nil
+  "Hooks that are run after tags of a message are modified.
+
+'tags' 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"
+  :type 'hook
+  :options '(notmuch-hl-line-mode)
+  :group 'notmuch-hooks)
+
+(defvar notmuch-select-tag-history nil
+  "Variable to store minibuffer history for
+`notmuch-select-tag-with-completion' function.")
+
+(defvar notmuch-read-tag-changes-history nil
+  "Variable to store minibuffer history for
+`notmuch-read-tag-changes' function.")
+
+(defun notmuch-tag-completions (&optional search-terms)
+  (if (null search-terms)
+      (setq search-terms (list "*")))
+  (split-string
+   (with-output-to-string
+     (with-current-buffer standard-output
+       (apply '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 (notmuch-tag-completions search-terms)))
+    (completing-read prompt tag-list nil nil nil 'notmuch-select-tag-history)))
+
+(defun notmuch-read-tag-changes (&optional initial-input &rest search-terms)
+  (let* ((all-tag-list (notmuch-tag-completions))
+	 (add-tag-list (mapcar (apply-partially 'concat "+") all-tag-list))
+	 (remove-tag-list (mapcar (apply-partially 'concat "-")
+				  (if (null search-terms)
+				      all-tag-list
+				    (notmuch-tag-completions search-terms))))
+	 (tag-list (append add-tag-list remove-tag-list))
+	 (crm-separator " ")
+	 ;; By default, space is bound to "complete word" function.
+	 ;; Re-bind it to insert a space instead.  Note that <tab>
+	 ;; still does the completion.
+	 (crm-local-completion-map
+	  (let ((map (make-sparse-keymap)))
+	    (set-keymap-parent map crm-local-completion-map)
+	    (define-key map " " 'self-insert-command)
+	    map)))
+    (delete "" (completing-read-multiple "Tags (+add -drop): "
+		tag-list nil nil initial-input
+		'notmuch-read-tag-changes-history))))
+
+(defun notmuch-update-tags (tags tag-changes)
+  "Return a copy of TAGS with additions and removals from TAG-CHANGES.
+
+TAG-CHANGES must be a list of tags names, each prefixed with
+either a \"+\" to indicate the tag should be added to TAGS if not
+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))))
+	(case op
+	  (?+ (unless (member tag result-tags)
+		(push tag result-tags)))
+	  (?- (setq result-tags (delete tag result-tags)))
+	  (otherwise
+	   (error "Changed tag must be of the form `+this_tag' or `-that_tag'")))))
+    (sort result-tags 'string<)))
+
+(defun notmuch-tag (query &rest tag-changes)
+  "Add/remove tags in TAG-CHANGES to messages matching QUERY.
+
+TAG-CHANGES should be a list of strings of the form \"+tag\" or
+\"-tag\" and QUERY should be a string containing the
+search-query.
+
+Note: Other code should always use this function alter tags of
+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)
+  (unless (null tag-changes)
+    (run-hooks 'notmuch-before-tag-hook)
+    (apply 'notmuch-call-notmuch-process "tag"
+	   (append tag-changes (list "--" query)))
+    (run-hooks 'notmuch-after-tag-hook)))
+
+;;
+
+(provide 'notmuch-tag)