From: Jameson Graef Rollins Date: Sun, 8 Apr 2012 00:35:31 +0000 (+1700) Subject: [PATCH 1/8] emacs: create notmuch-tag.el, and move appropriate functions from notmuch.el X-Git-Url: http://git.tremily.us/gitweb.cgi?a=commitdiff_plain;h=23275559ce690770e03881db3487999852dad9b9;p=notmuch-archives.git [PATCH 1/8] emacs: create notmuch-tag.el, and move appropriate functions from notmuch.el --- diff --git a/61/e5644bbc6ff9450d0e500cfaa3bb700e85920f b/61/e5644bbc6ff9450d0e500cfaa3bb700e85920f new file mode 100644 index 000000000..c22829882 --- /dev/null +++ b/61/e5644bbc6ff9450d0e500cfaa3bb700e85920f @@ -0,0 +1,395 @@ +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 +