61/e5644bbc6ff9450d0e500cfaa3bb700e85920f

   1 Return-Path: <jrollins@finestructure.net>\r
   2 X-Original-To: notmuch@notmuchmail.org\r
   3 Delivered-To: notmuch@notmuchmail.org\r
   4 Received: from localhost (localhost [127.0.0.1])\r
   5         by olra.theworths.org (Postfix) with ESMTP id 9E925431FCF\r
   6         for <notmuch@notmuchmail.org>; Sat,  7 Apr 2012 17:35:56 -0700 (PDT)\r
   7 X-Virus-Scanned: Debian amavisd-new at olra.theworths.org\r
   8 X-Spam-Flag: NO\r
   9 X-Spam-Score: -2.3\r
  10 X-Spam-Level: \r
  11 X-Spam-Status: No, score=-2.3 tagged_above=-999 required=5\r
  12         tests=[RCVD_IN_DNSWL_MED=-2.3] autolearn=disabled\r
  13 Received: from olra.theworths.org ([127.0.0.1])\r
  14         by localhost (olra.theworths.org [127.0.0.1]) (amavisd-new, port 10024)\r
  15         with ESMTP id Lm86iykiihJh for <notmuch@notmuchmail.org>;\r
  16         Sat,  7 Apr 2012 17:35:52 -0700 (PDT)\r
  17 Received: from outgoing-mail.its.caltech.edu (outgoing-mail.its.caltech.edu\r
  18         [131.215.239.19])\r
  19         by olra.theworths.org (Postfix) with ESMTP id C7429431FD8\r
  20         for <notmuch@notmuchmail.org>; Sat,  7 Apr 2012 17:35:47 -0700 (PDT)\r
  21 Received: from fire-doxen.imss.caltech.edu (localhost [127.0.0.1])\r
  22         by fire-doxen-postvirus (Postfix) with ESMTP id 9B7EA2E50DD7\r
  23         for <notmuch@notmuchmail.org>; Sat,  7 Apr 2012 17:35:46 -0700 (PDT)\r
  24 X-Spam-Scanned: at Caltech-IMSS on fire-doxen by amavisd-new\r
  25 Received: from finestructure.net (unknown [76.89.193.65])\r
  26         (Authenticated sender: jrollins)\r
  27         by fire-doxen-submit (Postfix) with ESMTP id 500FC2E50D70\r
  28         for <notmuch@notmuchmail.org>; Sat,  7 Apr 2012 17:35:43 -0700 (PDT)\r
  29 Received: by finestructure.net (Postfix, from userid 1000)\r
  30         id EEA33183; Sat,  7 Apr 2012 17:35:42 -0700 (PDT)\r
  31 From: Jameson Graef Rollins <jrollins@finestructure.net>\r
  32 To: Notmuch Mail <notmuch@notmuchmail.org>\r
  33 Subject: [PATCH 1/8] emacs: create notmuch-tag.el, and move appropriate functions from notmuch.el\r
  34 Date: Sat,  7 Apr 2012 17:35:31 -0700\r
  35 Message-Id: <1333845338-22960-2-git-send-email-jrollins@finestructure.net>\r
  36 X-Mailer: git-send-email 1.7.9.1\r
  37 In-Reply-To: <1333845338-22960-1-git-send-email-jrollins@finestructure.net>\r
  38 References: <1333354853-25729-1-git-send-email-jrollins@finestructure.net>\r
  39         <1333845338-22960-1-git-send-email-jrollins@finestructure.net>\r
  40 MIME-Version: 1.0\r
  41 Content-Type: text/plain; charset=UTF-8\r
  42 Content-Transfer-Encoding: 8bit\r
  43 X-BeenThere: notmuch@notmuchmail.org\r
  44 X-Mailman-Version: 2.1.13\r
  45 Precedence: list\r
  46 List-Id: "Use and development of the notmuch mail system."\r
  47         <notmuch.notmuchmail.org>\r
  48 List-Unsubscribe: <http://notmuchmail.org/mailman/options/notmuch>,\r
  49         <mailto:notmuch-request@notmuchmail.org?subject=unsubscribe>\r
  50 List-Archive: <http://notmuchmail.org/pipermail/notmuch>\r
  51 List-Post: <mailto:notmuch@notmuchmail.org>\r
  52 List-Help: <mailto:notmuch-request@notmuchmail.org?subject=help>\r
  53 List-Subscribe: <http://notmuchmail.org/mailman/listinfo/notmuch>,\r
  54         <mailto:notmuch-request@notmuchmail.org?subject=subscribe>\r
  55 X-List-Received-Date: Sun, 08 Apr 2012 00:35:57 -0000\r
  56 \r
  57 Tagging functions are used in notmuch.el, notmuch-show.el, and\r
  58 notmuch-message.el.  There are enough common functions for tagging\r
  59 that it makes sense to put them all in their own library.\r
  60 \r
  61 No code is modified, just moved around.\r
  62 ---\r
  63  emacs/Makefile.local     |    1 +\r
  64  emacs/notmuch-message.el |    1 +\r
  65  emacs/notmuch-show.el    |    3 +-\r
  66  emacs/notmuch-tag.el     |  133 ++++++++++++++++++++++++++++++++++++++++++++++\r
  67  emacs/notmuch.el         |  107 +------------------------------------\r
  68  5 files changed, 137 insertions(+), 108 deletions(-)\r
  69  create mode 100644 emacs/notmuch-tag.el\r
  70 \r
  71 diff --git a/emacs/Makefile.local b/emacs/Makefile.local\r
  72 index 4fee0e8..fb82247 100644\r
  73 --- a/emacs/Makefile.local\r
  74 +++ b/emacs/Makefile.local\r
  75 @@ -13,6 +13,7 @@ emacs_sources := \\r
  76         $(dir)/notmuch-maildir-fcc.el \\r
  77         $(dir)/notmuch-message.el \\r
  78         $(dir)/notmuch-crypto.el \\r
  79 +       $(dir)/notmuch-tag.el \\r
  80         $(dir)/coolj.el \\r
  81         $(dir)/notmuch-print.el\r
  82  \r
  83 diff --git a/emacs/notmuch-message.el b/emacs/notmuch-message.el\r
  84 index 3010281..5964caa 100644\r
  85 --- a/emacs/notmuch-message.el\r
  86 +++ b/emacs/notmuch-message.el\r
  87 @@ -20,6 +20,7 @@\r
  88  ;; Authors: Jesse Rosenthal <jrosenthal@jhu.edu>\r
  89  \r
  90  (require 'message)\r
  91 +(require 'notmuch-tag)\r
  92  (require 'notmuch-mua)\r
  93  \r
  94  (defcustom notmuch-message-replied-tags '("replied")\r
  95 diff --git a/emacs/notmuch-show.el b/emacs/notmuch-show.el\r
  96 index 30b26d1..a4c313d 100644\r
  97 --- a/emacs/notmuch-show.el\r
  98 +++ b/emacs/notmuch-show.el\r
  99 @@ -30,6 +30,7 @@\r
 100  (require 'goto-addr)\r
 101  \r
 102  (require 'notmuch-lib)\r
 103 +(require 'notmuch-tag)\r
 104  (require 'notmuch-query)\r
 105  (require 'notmuch-wash)\r
 106  (require 'notmuch-mua)\r
 107 @@ -38,10 +39,8 @@\r
 108  \r
 109  (declare-function notmuch-call-notmuch-process "notmuch" (&rest args))\r
 110  (declare-function notmuch-fontify-headers "notmuch" nil)\r
 111 -(declare-function notmuch-read-tag-changes "notmuch" (&optional initial-input &rest search-terms))\r
 112  (declare-function notmuch-search-next-thread "notmuch" nil)\r
 113  (declare-function notmuch-search-show-thread "notmuch" nil)\r
 114 -(declare-function notmuch-update-tags "notmuch" (current-tags tag-changes))\r
 115  \r
 116  (defcustom notmuch-message-headers '("Subject" "To" "Cc" "Date")\r
 117    "Headers that should be shown in a message, in this order.\r
 118 diff --git a/emacs/notmuch-tag.el b/emacs/notmuch-tag.el\r
 119 new file mode 100644\r
 120 index 0000000..81b4b00\r
 121 --- /dev/null\r
 122 +++ b/emacs/notmuch-tag.el\r
 123 @@ -0,0 +1,133 @@\r
 124 +;; notmuch-tag.el --- tag messages within emacs\r
 125 +;;\r
 126 +;; Copyright © Carl Worth\r
 127 +;;\r
 128 +;; This file is part of Notmuch.\r
 129 +;;\r
 130 +;; Notmuch is free software: you can redistribute it and/or modify it\r
 131 +;; under the terms of the GNU General Public License as published by\r
 132 +;; the Free Software Foundation, either version 3 of the License, or\r
 133 +;; (at your option) any later version.\r
 134 +;;\r
 135 +;; Notmuch is distributed in the hope that it will be useful, but\r
 136 +;; WITHOUT ANY WARRANTY; without even the implied warranty of\r
 137 +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU\r
 138 +;; General Public License for more details.\r
 139 +;;\r
 140 +;; You should have received a copy of the GNU General Public License\r
 141 +;; along with Notmuch.  If not, see <http://www.gnu.org/licenses/>.\r
 142 +;;\r
 143 +;; Authors: Carl Worth <cworth@cworth.org>\r
 144 +\r
 145 +(eval-when-compile (require 'cl))\r
 146 +(require 'crm)\r
 147 +(require 'notmuch-lib)\r
 148 +\r
 149 +(defcustom notmuch-before-tag-hook nil\r
 150 +  "Hooks that are run before tags of a message are modified.\r
 151 +\r
 152 +'tags' will contain the tags that are about to be added or removed as\r
 153 +a list of strings of the form \"+TAG\" or \"-TAG\".\r
 154 +'query' will be a string containing the search query that determines\r
 155 +the messages that are about to be tagged"\r
 156 +\r
 157 +  :type 'hook\r
 158 +  :options '(notmuch-hl-line-mode)\r
 159 +  :group 'notmuch-hooks)\r
 160 +\r
 161 +(defcustom notmuch-after-tag-hook nil\r
 162 +  "Hooks that are run after tags of a message are modified.\r
 163 +\r
 164 +'tags' will contain the tags that were added or removed as\r
 165 +a list of strings of the form \"+TAG\" or \"-TAG\".\r
 166 +'query' will be a string containing the search query that determines\r
 167 +the messages that were tagged"\r
 168 +  :type 'hook\r
 169 +  :options '(notmuch-hl-line-mode)\r
 170 +  :group 'notmuch-hooks)\r
 171 +\r
 172 +(defvar notmuch-select-tag-history nil\r
 173 +  "Variable to store minibuffer history for\r
 174 +`notmuch-select-tag-with-completion' function.")\r
 175 +\r
 176 +(defvar notmuch-read-tag-changes-history nil\r
 177 +  "Variable to store minibuffer history for\r
 178 +`notmuch-read-tag-changes' function.")\r
 179 +\r
 180 +(defun notmuch-tag-completions (&optional search-terms)\r
 181 +  (split-string\r
 182 +   (with-output-to-string\r
 183 +     (with-current-buffer standard-output\r
 184 +       (apply 'call-process notmuch-command nil t\r
 185 +             nil "search-tags" search-terms)))\r
 186 +   "\n+" t))\r
 187 +\r
 188 +(defun notmuch-select-tag-with-completion (prompt &rest search-terms)\r
 189 +  (let ((tag-list (notmuch-tag-completions search-terms)))\r
 190 +    (completing-read prompt tag-list nil nil nil 'notmuch-select-tag-history)))\r
 191 +\r
 192 +(defun notmuch-read-tag-changes (&optional initial-input &rest search-terms)\r
 193 +  (let* ((all-tag-list (notmuch-tag-completions))\r
 194 +        (add-tag-list (mapcar (apply-partially 'concat "+") all-tag-list))\r
 195 +        (remove-tag-list (mapcar (apply-partially 'concat "-")\r
 196 +                                 (if (null search-terms)\r
 197 +                                     all-tag-list\r
 198 +                                   (notmuch-tag-completions search-terms))))\r
 199 +        (tag-list (append add-tag-list remove-tag-list))\r
 200 +        (crm-separator " ")\r
 201 +        ;; By default, space is bound to "complete word" function.\r
 202 +        ;; Re-bind it to insert a space instead.  Note that <tab>\r
 203 +        ;; still does the completion.\r
 204 +        (crm-local-completion-map\r
 205 +         (let ((map (make-sparse-keymap)))\r
 206 +           (set-keymap-parent map crm-local-completion-map)\r
 207 +           (define-key map " " 'self-insert-command)\r
 208 +           map)))\r
 209 +    (delete "" (completing-read-multiple "Tags (+add -drop): "\r
 210 +               tag-list nil nil initial-input\r
 211 +               'notmuch-read-tag-changes-history))))\r
 212 +\r
 213 +(defun notmuch-update-tags (tags tag-changes)\r
 214 +  "Return a copy of TAGS with additions and removals from TAG-CHANGES.\r
 215 +\r
 216 +TAG-CHANGES must be a list of tags names, each prefixed with\r
 217 +either a \"+\" to indicate the tag should be added to TAGS if not\r
 218 +present or a \"-\" to indicate that the tag should be removed\r
 219 +from TAGS if present."\r
 220 +  (let ((result-tags (copy-sequence tags)))\r
 221 +    (dolist (tag-change tag-changes)\r
 222 +      (let ((op (string-to-char tag-change))\r
 223 +           (tag (unless (string= tag-change "") (substring tag-change 1))))\r
 224 +       (case op\r
 225 +         (?+ (unless (member tag result-tags)\r
 226 +               (push tag result-tags)))\r
 227 +         (?- (setq result-tags (delete tag result-tags)))\r
 228 +         (otherwise\r
 229 +          (error "Changed tag must be of the form `+this_tag' or `-that_tag'")))))\r
 230 +    (sort result-tags 'string<)))\r
 231 +\r
 232 +(defun notmuch-tag (query &rest tag-changes)\r
 233 +  "Add/remove tags in TAG-CHANGES to messages matching QUERY.\r
 234 +\r
 235 +TAG-CHANGES should be a list of strings of the form \"+tag\" or\r
 236 +\"-tag\" and QUERY should be a string containing the\r
 237 +search-query.\r
 238 +\r
 239 +Note: Other code should always use this function alter tags of\r
 240 +messages instead of running (notmuch-call-notmuch-process \"tag\" ..)\r
 241 +directly, so that hooks specified in notmuch-before-tag-hook and\r
 242 +notmuch-after-tag-hook will be run."\r
 243 +  ;; Perform some validation\r
 244 +  (mapc (lambda (tag-change)\r
 245 +         (unless (string-match-p "^[-+]\\S-+$" tag-change)\r
 246 +           (error "Tag must be of the form `+this_tag' or `-that_tag'")))\r
 247 +       tag-changes)\r
 248 +  (unless (null tag-changes)\r
 249 +    (run-hooks 'notmuch-before-tag-hook)\r
 250 +    (apply 'notmuch-call-notmuch-process "tag"\r
 251 +          (append tag-changes (list "--" query)))\r
 252 +    (run-hooks 'notmuch-after-tag-hook)))\r
 253 +\r
 254 +;;\r
 255 +\r
 256 +(provide 'notmuch-tag)\r
 257 diff --git a/emacs/notmuch.el b/emacs/notmuch.el\r
 258 index f0afa07..9aec96d 100644\r
 259 --- a/emacs/notmuch.el\r
 260 +++ b/emacs/notmuch.el\r
 261 @@ -48,11 +48,11 @@\r
 262  ;; required, but is available from http://notmuchmail.org).\r
 263  \r
 264  (eval-when-compile (require 'cl))\r
 265 -(require 'crm)\r
 266  (require 'mm-view)\r
 267  (require 'message)\r
 268  \r
 269  (require 'notmuch-lib)\r
 270 +(require 'notmuch-tag)\r
 271  (require 'notmuch-show)\r
 272  (require 'notmuch-mua)\r
 273  (require 'notmuch-hello)\r
 274 @@ -76,66 +76,6 @@ For example:\r
 275  (defvar notmuch-query-history nil\r
 276    "Variable to store minibuffer history for notmuch queries")\r
 277  \r
 278 -(defvar notmuch-select-tag-history nil\r
 279 -  "Variable to store minibuffer history for\r
 280 -`notmuch-select-tag-with-completion' function.")\r
 281 -\r
 282 -(defvar notmuch-read-tag-changes-history nil\r
 283 -  "Variable to store minibuffer history for\r
 284 -`notmuch-read-tag-changes' function.")\r
 285 -\r
 286 -(defun notmuch-tag-completions (&optional search-terms)\r
 287 -  (split-string\r
 288 -   (with-output-to-string\r
 289 -     (with-current-buffer standard-output\r
 290 -       (apply 'call-process notmuch-command nil t\r
 291 -             nil "search-tags" search-terms)))\r
 292 -   "\n+" t))\r
 293 -\r
 294 -(defun notmuch-select-tag-with-completion (prompt &rest search-terms)\r
 295 -  (let ((tag-list (notmuch-tag-completions search-terms)))\r
 296 -    (completing-read prompt tag-list nil nil nil 'notmuch-select-tag-history)))\r
 297 -\r
 298 -(defun notmuch-read-tag-changes (&optional initial-input &rest search-terms)\r
 299 -  (let* ((all-tag-list (notmuch-tag-completions))\r
 300 -        (add-tag-list (mapcar (apply-partially 'concat "+") all-tag-list))\r
 301 -        (remove-tag-list (mapcar (apply-partially 'concat "-")\r
 302 -                                 (if (null search-terms)\r
 303 -                                     all-tag-list\r
 304 -                                   (notmuch-tag-completions search-terms))))\r
 305 -        (tag-list (append add-tag-list remove-tag-list))\r
 306 -        (crm-separator " ")\r
 307 -        ;; By default, space is bound to "complete word" function.\r
 308 -        ;; Re-bind it to insert a space instead.  Note that <tab>\r
 309 -        ;; still does the completion.\r
 310 -        (crm-local-completion-map\r
 311 -         (let ((map (make-sparse-keymap)))\r
 312 -           (set-keymap-parent map crm-local-completion-map)\r
 313 -           (define-key map " " 'self-insert-command)\r
 314 -           map)))\r
 315 -    (delete "" (completing-read-multiple "Tags (+add -drop): "\r
 316 -               tag-list nil nil initial-input\r
 317 -               'notmuch-read-tag-changes-history))))\r
 318 -\r
 319 -(defun notmuch-update-tags (tags tag-changes)\r
 320 -  "Return a copy of TAGS with additions and removals from TAG-CHANGES.\r
 321 -\r
 322 -TAG-CHANGES must be a list of tags names, each prefixed with\r
 323 -either a \"+\" to indicate the tag should be added to TAGS if not\r
 324 -present or a \"-\" to indicate that the tag should be removed\r
 325 -from TAGS if present."\r
 326 -  (let ((result-tags (copy-sequence tags)))\r
 327 -    (dolist (tag-change tag-changes)\r
 328 -      (let ((op (string-to-char tag-change))\r
 329 -           (tag (unless (string= tag-change "") (substring tag-change 1))))\r
 330 -       (case op\r
 331 -         (?+ (unless (member tag result-tags)\r
 332 -               (push tag result-tags)))\r
 333 -         (?- (setq result-tags (delete tag result-tags)))\r
 334 -         (otherwise\r
 335 -          (error "Changed tag must be of the form `+this_tag' or `-that_tag'")))))\r
 336 -    (sort result-tags 'string<)))\r
 337 -\r
 338  (defun notmuch-foreach-mime-part (function mm-handle)\r
 339    (cond ((stringp (car mm-handle))\r
 340           (dolist (part (cdr mm-handle))\r
 341 @@ -543,51 +483,6 @@ and will also appear in a buffer named \"*Notmuch errors*\"."\r
 342             (error (buffer-substring beg end))\r
 343             ))))))\r
 344  \r
 345 -(defun notmuch-tag (query &rest tag-changes)\r
 346 -  "Add/remove tags in TAG-CHANGES to messages matching QUERY.\r
 347 -\r
 348 -TAG-CHANGES should be a list of strings of the form \"+tag\" or\r
 349 -\"-tag\" and QUERY should be a string containing the\r
 350 -search-query.\r
 351 -\r
 352 -Note: Other code should always use this function alter tags of\r
 353 -messages instead of running (notmuch-call-notmuch-process \"tag\" ..)\r
 354 -directly, so that hooks specified in notmuch-before-tag-hook and\r
 355 -notmuch-after-tag-hook will be run."\r
 356 -  ;; Perform some validation\r
 357 -  (mapc (lambda (tag-change)\r
 358 -         (unless (string-match-p "^[-+]\\S-+$" tag-change)\r
 359 -           (error "Tag must be of the form `+this_tag' or `-that_tag'")))\r
 360 -       tag-changes)\r
 361 -  (unless (null tag-changes)\r
 362 -    (run-hooks 'notmuch-before-tag-hook)\r
 363 -    (apply 'notmuch-call-notmuch-process "tag"\r
 364 -          (append tag-changes (list "--" query)))\r
 365 -    (run-hooks 'notmuch-after-tag-hook)))\r
 366 -\r
 367 -(defcustom notmuch-before-tag-hook nil\r
 368 -  "Hooks that are run before tags of a message are modified.\r
 369 -\r
 370 -'tags' will contain the tags that are about to be added or removed as\r
 371 -a list of strings of the form \"+TAG\" or \"-TAG\".\r
 372 -'query' will be a string containing the search query that determines\r
 373 -the messages that are about to be tagged"\r
 374 -\r
 375 -  :type 'hook\r
 376 -  :options '(notmuch-hl-line-mode)\r
 377 -  :group 'notmuch-hooks)\r
 378 -\r
 379 -(defcustom notmuch-after-tag-hook nil\r
 380 -  "Hooks that are run after tags of a message are modified.\r
 381 -\r
 382 -'tags' will contain the tags that were added or removed as\r
 383 -a list of strings of the form \"+TAG\" or \"-TAG\".\r
 384 -'query' will be a string containing the search query that determines\r
 385 -the messages that were tagged"\r
 386 -  :type 'hook\r
 387 -  :options '(notmuch-hl-line-mode)\r
 388 -  :group 'notmuch-hooks)\r
 389 -\r
 390  (defun notmuch-search-set-tags (tags)\r
 391    (save-excursion\r
 392      (end-of-line)\r
 393 -- \r
 394 1.7.9.1\r
 395 \r