--- /dev/null
+Return-Path: <jrollins@finestructure.net>\r
+X-Original-To: notmuch@notmuchmail.org\r
+Delivered-To: notmuch@notmuchmail.org\r
+Received: from localhost (localhost [127.0.0.1])\r
+ by olra.theworths.org (Postfix) with ESMTP id 9E925431FCF\r
+ for <notmuch@notmuchmail.org>; Sat, 7 Apr 2012 17:35:56 -0700 (PDT)\r
+X-Virus-Scanned: Debian amavisd-new at olra.theworths.org\r
+X-Spam-Flag: NO\r
+X-Spam-Score: -2.3\r
+X-Spam-Level: \r
+X-Spam-Status: No, score=-2.3 tagged_above=-999 required=5\r
+ tests=[RCVD_IN_DNSWL_MED=-2.3] autolearn=disabled\r
+Received: from olra.theworths.org ([127.0.0.1])\r
+ by localhost (olra.theworths.org [127.0.0.1]) (amavisd-new, port 10024)\r
+ with ESMTP id Lm86iykiihJh for <notmuch@notmuchmail.org>;\r
+ Sat, 7 Apr 2012 17:35:52 -0700 (PDT)\r
+Received: from outgoing-mail.its.caltech.edu (outgoing-mail.its.caltech.edu\r
+ [131.215.239.19])\r
+ by olra.theworths.org (Postfix) with ESMTP id C7429431FD8\r
+ for <notmuch@notmuchmail.org>; Sat, 7 Apr 2012 17:35:47 -0700 (PDT)\r
+Received: from fire-doxen.imss.caltech.edu (localhost [127.0.0.1])\r
+ by fire-doxen-postvirus (Postfix) with ESMTP id 9B7EA2E50DD7\r
+ for <notmuch@notmuchmail.org>; Sat, 7 Apr 2012 17:35:46 -0700 (PDT)\r
+X-Spam-Scanned: at Caltech-IMSS on fire-doxen by amavisd-new\r
+Received: from finestructure.net (unknown [76.89.193.65])\r
+ (Authenticated sender: jrollins)\r
+ by fire-doxen-submit (Postfix) with ESMTP id 500FC2E50D70\r
+ for <notmuch@notmuchmail.org>; Sat, 7 Apr 2012 17:35:43 -0700 (PDT)\r
+Received: by finestructure.net (Postfix, from userid 1000)\r
+ id EEA33183; Sat, 7 Apr 2012 17:35:42 -0700 (PDT)\r
+From: Jameson Graef Rollins <jrollins@finestructure.net>\r
+To: Notmuch Mail <notmuch@notmuchmail.org>\r
+Subject: [PATCH 1/8] emacs: create notmuch-tag.el, and move appropriate functions from notmuch.el\r
+Date: Sat, 7 Apr 2012 17:35:31 -0700\r
+Message-Id: <1333845338-22960-2-git-send-email-jrollins@finestructure.net>\r
+X-Mailer: git-send-email 1.7.9.1\r
+In-Reply-To: <1333845338-22960-1-git-send-email-jrollins@finestructure.net>\r
+References: <1333354853-25729-1-git-send-email-jrollins@finestructure.net>\r
+ <1333845338-22960-1-git-send-email-jrollins@finestructure.net>\r
+MIME-Version: 1.0\r
+Content-Type: text/plain; charset=UTF-8\r
+Content-Transfer-Encoding: 8bit\r
+X-BeenThere: notmuch@notmuchmail.org\r
+X-Mailman-Version: 2.1.13\r
+Precedence: list\r
+List-Id: "Use and development of the notmuch mail system."\r
+ <notmuch.notmuchmail.org>\r
+List-Unsubscribe: <http://notmuchmail.org/mailman/options/notmuch>,\r
+ <mailto:notmuch-request@notmuchmail.org?subject=unsubscribe>\r
+List-Archive: <http://notmuchmail.org/pipermail/notmuch>\r
+List-Post: <mailto:notmuch@notmuchmail.org>\r
+List-Help: <mailto:notmuch-request@notmuchmail.org?subject=help>\r
+List-Subscribe: <http://notmuchmail.org/mailman/listinfo/notmuch>,\r
+ <mailto:notmuch-request@notmuchmail.org?subject=subscribe>\r
+X-List-Received-Date: Sun, 08 Apr 2012 00:35:57 -0000\r
+\r
+Tagging functions are used in notmuch.el, notmuch-show.el, and\r
+notmuch-message.el. There are enough common functions for tagging\r
+that it makes sense to put them all in their own library.\r
+\r
+No code is modified, just moved around.\r
+---\r
+ emacs/Makefile.local | 1 +\r
+ emacs/notmuch-message.el | 1 +\r
+ emacs/notmuch-show.el | 3 +-\r
+ emacs/notmuch-tag.el | 133 ++++++++++++++++++++++++++++++++++++++++++++++\r
+ emacs/notmuch.el | 107 +------------------------------------\r
+ 5 files changed, 137 insertions(+), 108 deletions(-)\r
+ create mode 100644 emacs/notmuch-tag.el\r
+\r
+diff --git a/emacs/Makefile.local b/emacs/Makefile.local\r
+index 4fee0e8..fb82247 100644\r
+--- a/emacs/Makefile.local\r
++++ b/emacs/Makefile.local\r
+@@ -13,6 +13,7 @@ emacs_sources := \\r
+ $(dir)/notmuch-maildir-fcc.el \\r
+ $(dir)/notmuch-message.el \\r
+ $(dir)/notmuch-crypto.el \\r
++ $(dir)/notmuch-tag.el \\r
+ $(dir)/coolj.el \\r
+ $(dir)/notmuch-print.el\r
+ \r
+diff --git a/emacs/notmuch-message.el b/emacs/notmuch-message.el\r
+index 3010281..5964caa 100644\r
+--- a/emacs/notmuch-message.el\r
++++ b/emacs/notmuch-message.el\r
+@@ -20,6 +20,7 @@\r
+ ;; Authors: Jesse Rosenthal <jrosenthal@jhu.edu>\r
+ \r
+ (require 'message)\r
++(require 'notmuch-tag)\r
+ (require 'notmuch-mua)\r
+ \r
+ (defcustom notmuch-message-replied-tags '("replied")\r
+diff --git a/emacs/notmuch-show.el b/emacs/notmuch-show.el\r
+index 30b26d1..a4c313d 100644\r
+--- a/emacs/notmuch-show.el\r
++++ b/emacs/notmuch-show.el\r
+@@ -30,6 +30,7 @@\r
+ (require 'goto-addr)\r
+ \r
+ (require 'notmuch-lib)\r
++(require 'notmuch-tag)\r
+ (require 'notmuch-query)\r
+ (require 'notmuch-wash)\r
+ (require 'notmuch-mua)\r
+@@ -38,10 +39,8 @@\r
+ \r
+ (declare-function notmuch-call-notmuch-process "notmuch" (&rest args))\r
+ (declare-function notmuch-fontify-headers "notmuch" nil)\r
+-(declare-function notmuch-read-tag-changes "notmuch" (&optional initial-input &rest search-terms))\r
+ (declare-function notmuch-search-next-thread "notmuch" nil)\r
+ (declare-function notmuch-search-show-thread "notmuch" nil)\r
+-(declare-function notmuch-update-tags "notmuch" (current-tags tag-changes))\r
+ \r
+ (defcustom notmuch-message-headers '("Subject" "To" "Cc" "Date")\r
+ "Headers that should be shown in a message, in this order.\r
+diff --git a/emacs/notmuch-tag.el b/emacs/notmuch-tag.el\r
+new file mode 100644\r
+index 0000000..81b4b00\r
+--- /dev/null\r
++++ b/emacs/notmuch-tag.el\r
+@@ -0,0 +1,133 @@\r
++;; notmuch-tag.el --- tag messages within emacs\r
++;;\r
++;; Copyright © Carl Worth\r
++;;\r
++;; This file is part of Notmuch.\r
++;;\r
++;; Notmuch is free software: you can redistribute it and/or modify it\r
++;; under the terms of the GNU General Public License as published by\r
++;; the Free Software Foundation, either version 3 of the License, or\r
++;; (at your option) any later version.\r
++;;\r
++;; Notmuch is distributed in the hope that it will be useful, but\r
++;; WITHOUT ANY WARRANTY; without even the implied warranty of\r
++;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU\r
++;; General Public License for more details.\r
++;;\r
++;; You should have received a copy of the GNU General Public License\r
++;; along with Notmuch. If not, see <http://www.gnu.org/licenses/>.\r
++;;\r
++;; Authors: Carl Worth <cworth@cworth.org>\r
++\r
++(eval-when-compile (require 'cl))\r
++(require 'crm)\r
++(require 'notmuch-lib)\r
++\r
++(defcustom notmuch-before-tag-hook nil\r
++ "Hooks that are run before tags of a message are modified.\r
++\r
++'tags' will contain the tags that are about to be added or removed as\r
++a list of strings of the form \"+TAG\" or \"-TAG\".\r
++'query' will be a string containing the search query that determines\r
++the messages that are about to be tagged"\r
++\r
++ :type 'hook\r
++ :options '(notmuch-hl-line-mode)\r
++ :group 'notmuch-hooks)\r
++\r
++(defcustom notmuch-after-tag-hook nil\r
++ "Hooks that are run after tags of a message are modified.\r
++\r
++'tags' will contain the tags that were added or removed as\r
++a list of strings of the form \"+TAG\" or \"-TAG\".\r
++'query' will be a string containing the search query that determines\r
++the messages that were tagged"\r
++ :type 'hook\r
++ :options '(notmuch-hl-line-mode)\r
++ :group 'notmuch-hooks)\r
++\r
++(defvar notmuch-select-tag-history nil\r
++ "Variable to store minibuffer history for\r
++`notmuch-select-tag-with-completion' function.")\r
++\r
++(defvar notmuch-read-tag-changes-history nil\r
++ "Variable to store minibuffer history for\r
++`notmuch-read-tag-changes' function.")\r
++\r
++(defun notmuch-tag-completions (&optional search-terms)\r
++ (split-string\r
++ (with-output-to-string\r
++ (with-current-buffer standard-output\r
++ (apply 'call-process notmuch-command nil t\r
++ nil "search-tags" search-terms)))\r
++ "\n+" t))\r
++\r
++(defun notmuch-select-tag-with-completion (prompt &rest search-terms)\r
++ (let ((tag-list (notmuch-tag-completions search-terms)))\r
++ (completing-read prompt tag-list nil nil nil 'notmuch-select-tag-history)))\r
++\r
++(defun notmuch-read-tag-changes (&optional initial-input &rest search-terms)\r
++ (let* ((all-tag-list (notmuch-tag-completions))\r
++ (add-tag-list (mapcar (apply-partially 'concat "+") all-tag-list))\r
++ (remove-tag-list (mapcar (apply-partially 'concat "-")\r
++ (if (null search-terms)\r
++ all-tag-list\r
++ (notmuch-tag-completions search-terms))))\r
++ (tag-list (append add-tag-list remove-tag-list))\r
++ (crm-separator " ")\r
++ ;; By default, space is bound to "complete word" function.\r
++ ;; Re-bind it to insert a space instead. Note that <tab>\r
++ ;; still does the completion.\r
++ (crm-local-completion-map\r
++ (let ((map (make-sparse-keymap)))\r
++ (set-keymap-parent map crm-local-completion-map)\r
++ (define-key map " " 'self-insert-command)\r
++ map)))\r
++ (delete "" (completing-read-multiple "Tags (+add -drop): "\r
++ tag-list nil nil initial-input\r
++ 'notmuch-read-tag-changes-history))))\r
++\r
++(defun notmuch-update-tags (tags tag-changes)\r
++ "Return a copy of TAGS with additions and removals from TAG-CHANGES.\r
++\r
++TAG-CHANGES must be a list of tags names, each prefixed with\r
++either a \"+\" to indicate the tag should be added to TAGS if not\r
++present or a \"-\" to indicate that the tag should be removed\r
++from TAGS if present."\r
++ (let ((result-tags (copy-sequence tags)))\r
++ (dolist (tag-change tag-changes)\r
++ (let ((op (string-to-char tag-change))\r
++ (tag (unless (string= tag-change "") (substring tag-change 1))))\r
++ (case op\r
++ (?+ (unless (member tag result-tags)\r
++ (push tag result-tags)))\r
++ (?- (setq result-tags (delete tag result-tags)))\r
++ (otherwise\r
++ (error "Changed tag must be of the form `+this_tag' or `-that_tag'")))))\r
++ (sort result-tags 'string<)))\r
++\r
++(defun notmuch-tag (query &rest tag-changes)\r
++ "Add/remove tags in TAG-CHANGES to messages matching QUERY.\r
++\r
++TAG-CHANGES should be a list of strings of the form \"+tag\" or\r
++\"-tag\" and QUERY should be a string containing the\r
++search-query.\r
++\r
++Note: Other code should always use this function alter tags of\r
++messages instead of running (notmuch-call-notmuch-process \"tag\" ..)\r
++directly, so that hooks specified in notmuch-before-tag-hook and\r
++notmuch-after-tag-hook will be run."\r
++ ;; Perform some validation\r
++ (mapc (lambda (tag-change)\r
++ (unless (string-match-p "^[-+]\\S-+$" tag-change)\r
++ (error "Tag must be of the form `+this_tag' or `-that_tag'")))\r
++ tag-changes)\r
++ (unless (null tag-changes)\r
++ (run-hooks 'notmuch-before-tag-hook)\r
++ (apply 'notmuch-call-notmuch-process "tag"\r
++ (append tag-changes (list "--" query)))\r
++ (run-hooks 'notmuch-after-tag-hook)))\r
++\r
++;;\r
++\r
++(provide 'notmuch-tag)\r
+diff --git a/emacs/notmuch.el b/emacs/notmuch.el\r
+index f0afa07..9aec96d 100644\r
+--- a/emacs/notmuch.el\r
++++ b/emacs/notmuch.el\r
+@@ -48,11 +48,11 @@\r
+ ;; required, but is available from http://notmuchmail.org).\r
+ \r
+ (eval-when-compile (require 'cl))\r
+-(require 'crm)\r
+ (require 'mm-view)\r
+ (require 'message)\r
+ \r
+ (require 'notmuch-lib)\r
++(require 'notmuch-tag)\r
+ (require 'notmuch-show)\r
+ (require 'notmuch-mua)\r
+ (require 'notmuch-hello)\r
+@@ -76,66 +76,6 @@ For example:\r
+ (defvar notmuch-query-history nil\r
+ "Variable to store minibuffer history for notmuch queries")\r
+ \r
+-(defvar notmuch-select-tag-history nil\r
+- "Variable to store minibuffer history for\r
+-`notmuch-select-tag-with-completion' function.")\r
+-\r
+-(defvar notmuch-read-tag-changes-history nil\r
+- "Variable to store minibuffer history for\r
+-`notmuch-read-tag-changes' function.")\r
+-\r
+-(defun notmuch-tag-completions (&optional search-terms)\r
+- (split-string\r
+- (with-output-to-string\r
+- (with-current-buffer standard-output\r
+- (apply 'call-process notmuch-command nil t\r
+- nil "search-tags" search-terms)))\r
+- "\n+" t))\r
+-\r
+-(defun notmuch-select-tag-with-completion (prompt &rest search-terms)\r
+- (let ((tag-list (notmuch-tag-completions search-terms)))\r
+- (completing-read prompt tag-list nil nil nil 'notmuch-select-tag-history)))\r
+-\r
+-(defun notmuch-read-tag-changes (&optional initial-input &rest search-terms)\r
+- (let* ((all-tag-list (notmuch-tag-completions))\r
+- (add-tag-list (mapcar (apply-partially 'concat "+") all-tag-list))\r
+- (remove-tag-list (mapcar (apply-partially 'concat "-")\r
+- (if (null search-terms)\r
+- all-tag-list\r
+- (notmuch-tag-completions search-terms))))\r
+- (tag-list (append add-tag-list remove-tag-list))\r
+- (crm-separator " ")\r
+- ;; By default, space is bound to "complete word" function.\r
+- ;; Re-bind it to insert a space instead. Note that <tab>\r
+- ;; still does the completion.\r
+- (crm-local-completion-map\r
+- (let ((map (make-sparse-keymap)))\r
+- (set-keymap-parent map crm-local-completion-map)\r
+- (define-key map " " 'self-insert-command)\r
+- map)))\r
+- (delete "" (completing-read-multiple "Tags (+add -drop): "\r
+- tag-list nil nil initial-input\r
+- 'notmuch-read-tag-changes-history))))\r
+-\r
+-(defun notmuch-update-tags (tags tag-changes)\r
+- "Return a copy of TAGS with additions and removals from TAG-CHANGES.\r
+-\r
+-TAG-CHANGES must be a list of tags names, each prefixed with\r
+-either a \"+\" to indicate the tag should be added to TAGS if not\r
+-present or a \"-\" to indicate that the tag should be removed\r
+-from TAGS if present."\r
+- (let ((result-tags (copy-sequence tags)))\r
+- (dolist (tag-change tag-changes)\r
+- (let ((op (string-to-char tag-change))\r
+- (tag (unless (string= tag-change "") (substring tag-change 1))))\r
+- (case op\r
+- (?+ (unless (member tag result-tags)\r
+- (push tag result-tags)))\r
+- (?- (setq result-tags (delete tag result-tags)))\r
+- (otherwise\r
+- (error "Changed tag must be of the form `+this_tag' or `-that_tag'")))))\r
+- (sort result-tags 'string<)))\r
+-\r
+ (defun notmuch-foreach-mime-part (function mm-handle)\r
+ (cond ((stringp (car mm-handle))\r
+ (dolist (part (cdr mm-handle))\r
+@@ -543,51 +483,6 @@ and will also appear in a buffer named \"*Notmuch errors*\"."\r
+ (error (buffer-substring beg end))\r
+ ))))))\r
+ \r
+-(defun notmuch-tag (query &rest tag-changes)\r
+- "Add/remove tags in TAG-CHANGES to messages matching QUERY.\r
+-\r
+-TAG-CHANGES should be a list of strings of the form \"+tag\" or\r
+-\"-tag\" and QUERY should be a string containing the\r
+-search-query.\r
+-\r
+-Note: Other code should always use this function alter tags of\r
+-messages instead of running (notmuch-call-notmuch-process \"tag\" ..)\r
+-directly, so that hooks specified in notmuch-before-tag-hook and\r
+-notmuch-after-tag-hook will be run."\r
+- ;; Perform some validation\r
+- (mapc (lambda (tag-change)\r
+- (unless (string-match-p "^[-+]\\S-+$" tag-change)\r
+- (error "Tag must be of the form `+this_tag' or `-that_tag'")))\r
+- tag-changes)\r
+- (unless (null tag-changes)\r
+- (run-hooks 'notmuch-before-tag-hook)\r
+- (apply 'notmuch-call-notmuch-process "tag"\r
+- (append tag-changes (list "--" query)))\r
+- (run-hooks 'notmuch-after-tag-hook)))\r
+-\r
+-(defcustom notmuch-before-tag-hook nil\r
+- "Hooks that are run before tags of a message are modified.\r
+-\r
+-'tags' will contain the tags that are about to be added or removed as\r
+-a list of strings of the form \"+TAG\" or \"-TAG\".\r
+-'query' will be a string containing the search query that determines\r
+-the messages that are about to be tagged"\r
+-\r
+- :type 'hook\r
+- :options '(notmuch-hl-line-mode)\r
+- :group 'notmuch-hooks)\r
+-\r
+-(defcustom notmuch-after-tag-hook nil\r
+- "Hooks that are run after tags of a message are modified.\r
+-\r
+-'tags' will contain the tags that were added or removed as\r
+-a list of strings of the form \"+TAG\" or \"-TAG\".\r
+-'query' will be a string containing the search query that determines\r
+-the messages that were tagged"\r
+- :type 'hook\r
+- :options '(notmuch-hl-line-mode)\r
+- :group 'notmuch-hooks)\r
+-\r
+ (defun notmuch-search-set-tags (tags)\r
+ (save-excursion\r
+ (end-of-line)\r
+-- \r
+1.7.9.1\r
+\r
projects / notmuch-archives.git / commitdiff