[PATCH 1/5] emacs: create notmuch-tag.el, and move appropriate functions from notmuch.el
Jameson Graef Rollins
jrollins at finestructure.net
Sat Apr 14 11:52:50 PDT 2012
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.
---
emacs/Makefile.local | 1 +
emacs/notmuch-message.el | 1 +
emacs/notmuch-show.el | 3 +-
emacs/notmuch-tag.el | 135 ++++++++++++++++++++++++++++++++++++++++++++++
emacs/notmuch.el | 109 +------------------------------------
5 files changed, 139 insertions(+), 110 deletions(-)
create mode 100644 emacs/notmuch-tag.el
diff --git a/emacs/Makefile.local b/emacs/Makefile.local
index 4fee0e8..fb82247 100644
--- a/emacs/Makefile.local
+++ b/emacs/Makefile.local
@@ -13,6 +13,7 @@ emacs_sources := \
$(dir)/notmuch-maildir-fcc.el \
$(dir)/notmuch-message.el \
$(dir)/notmuch-crypto.el \
+ $(dir)/notmuch-tag.el \
$(dir)/coolj.el \
$(dir)/notmuch-print.el
diff --git a/emacs/notmuch-message.el b/emacs/notmuch-message.el
index 3010281..5964caa 100644
--- a/emacs/notmuch-message.el
+++ b/emacs/notmuch-message.el
@@ -20,6 +20,7 @@
;; Authors: Jesse Rosenthal <jrosenthal at jhu.edu>
(require 'message)
+(require 'notmuch-tag)
(require 'notmuch-mua)
(defcustom notmuch-message-replied-tags '("replied")
diff --git a/emacs/notmuch-show.el b/emacs/notmuch-show.el
index 30b26d1..a4c313d 100644
--- a/emacs/notmuch-show.el
+++ b/emacs/notmuch-show.el
@@ -30,6 +30,7 @@
(require 'goto-addr)
(require 'notmuch-lib)
+(require 'notmuch-tag)
(require 'notmuch-query)
(require 'notmuch-wash)
(require 'notmuch-mua)
@@ -38,10 +39,8 @@
(declare-function notmuch-call-notmuch-process "notmuch" (&rest args))
(declare-function notmuch-fontify-headers "notmuch" nil)
-(declare-function notmuch-read-tag-changes "notmuch" (&optional initial-input &rest search-terms))
(declare-function notmuch-search-next-thread "notmuch" nil)
(declare-function notmuch-search-show-thread "notmuch" nil)
-(declare-function notmuch-update-tags "notmuch" (current-tags tag-changes))
(defcustom notmuch-message-headers '("Subject" "To" "Cc" "Date")
"Headers that should be shown in a message, in this order.
diff --git a/emacs/notmuch-tag.el b/emacs/notmuch-tag.el
new file mode 100644
index 0000000..c25cff8
--- /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 at 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)
diff --git a/emacs/notmuch.el b/emacs/notmuch.el
index ba833e6..9aec96d 100644
--- a/emacs/notmuch.el
+++ b/emacs/notmuch.el
@@ -48,11 +48,11 @@
;; required, but is available from http://notmuchmail.org).
(eval-when-compile (require 'cl))
-(require 'crm)
(require 'mm-view)
(require 'message)
(require 'notmuch-lib)
+(require 'notmuch-tag)
(require 'notmuch-show)
(require 'notmuch-mua)
(require 'notmuch-hello)
@@ -76,68 +76,6 @@ For example:
(defvar notmuch-query-history nil
"Variable to store minibuffer history for notmuch queries")
-(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-foreach-mime-part (function mm-handle)
(cond ((stringp (car mm-handle))
(dolist (part (cdr mm-handle))
@@ -545,51 +483,6 @@ and will also appear in a buffer named \"*Notmuch errors*\"."
(error (buffer-substring beg end))
))))))
-(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)))
-
-(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)
-
(defun notmuch-search-set-tags (tags)
(save-excursion
(end-of-line)
--
1.7.9.5
More information about the notmuch
mailing list