Return-Path: X-Original-To: notmuch@notmuchmail.org Delivered-To: notmuch@notmuchmail.org Received: from localhost (localhost [127.0.0.1]) by olra.theworths.org (Postfix) with ESMTP id 9E925431FCF for ; Sat, 7 Apr 2012 17:35:56 -0700 (PDT) X-Virus-Scanned: Debian amavisd-new at olra.theworths.org X-Spam-Flag: NO X-Spam-Score: -2.3 X-Spam-Level: X-Spam-Status: No, score=-2.3 tagged_above=-999 required=5 tests=[RCVD_IN_DNSWL_MED=-2.3] autolearn=disabled Received: from olra.theworths.org ([127.0.0.1]) by localhost (olra.theworths.org [127.0.0.1]) (amavisd-new, port 10024) with ESMTP id Lm86iykiihJh for ; Sat, 7 Apr 2012 17:35:52 -0700 (PDT) Received: from outgoing-mail.its.caltech.edu (outgoing-mail.its.caltech.edu [131.215.239.19]) by olra.theworths.org (Postfix) with ESMTP id C7429431FD8 for ; Sat, 7 Apr 2012 17:35:47 -0700 (PDT) Received: from fire-doxen.imss.caltech.edu (localhost [127.0.0.1]) by fire-doxen-postvirus (Postfix) with ESMTP id 9B7EA2E50DD7 for ; Sat, 7 Apr 2012 17:35:46 -0700 (PDT) X-Spam-Scanned: at Caltech-IMSS on fire-doxen by amavisd-new Received: from finestructure.net (unknown [76.89.193.65]) (Authenticated sender: jrollins) by fire-doxen-submit (Postfix) with ESMTP id 500FC2E50D70 for ; Sat, 7 Apr 2012 17:35:43 -0700 (PDT) Received: by finestructure.net (Postfix, from userid 1000) id EEA33183; Sat, 7 Apr 2012 17:35:42 -0700 (PDT) From: Jameson Graef Rollins To: Notmuch Mail Subject: [PATCH 1/8] emacs: create notmuch-tag.el, and move appropriate functions from notmuch.el Date: Sat, 7 Apr 2012 17:35:31 -0700 Message-Id: <1333845338-22960-2-git-send-email-jrollins@finestructure.net> X-Mailer: git-send-email 1.7.9.1 In-Reply-To: <1333845338-22960-1-git-send-email-jrollins@finestructure.net> References: <1333354853-25729-1-git-send-email-jrollins@finestructure.net> <1333845338-22960-1-git-send-email-jrollins@finestructure.net> MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit X-BeenThere: notmuch@notmuchmail.org X-Mailman-Version: 2.1.13 Precedence: list List-Id: "Use and development of the notmuch mail system." List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , X-List-Received-Date: Sun, 08 Apr 2012 00:35:57 -0000 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 | 133 ++++++++++++++++++++++++++++++++++++++++++++++ emacs/notmuch.el | 107 +------------------------------------ 5 files changed, 137 insertions(+), 108 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 (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..81b4b00 --- /dev/null +++ b/emacs/notmuch-tag.el @@ -0,0 +1,133 @@ +;; 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 . +;; +;; Authors: Carl Worth + +(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) + (split-string + (with-output-to-string + (with-current-buffer standard-output + (apply 'call-process notmuch-command nil t + nil "search-tags" 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 + ;; 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 f0afa07..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,66 +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) - (split-string - (with-output-to-string - (with-current-buffer standard-output - (apply 'call-process notmuch-command nil t - nil "search-tags" 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 - ;; 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)) @@ -543,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.1