57/1d3125be033b8b7d6dfc3d0e8439f304d5c14e

   1 Return-Path: <dme@dme.org>\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 D7F1D4196F2\r
   6         for <notmuch@notmuchmail.org>; Thu, 22 Apr 2010 02:03:38 -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: -1.9\r
  10 X-Spam-Level: \r
  11 X-Spam-Status: No, score=-1.9 tagged_above=-999 required=5\r
  12         tests=[BAYES_00=-1.9] autolearn=ham\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 O9sQ1hHT86iU for <notmuch@notmuchmail.org>;\r
  16         Thu, 22 Apr 2010 02:03:37 -0700 (PDT)\r
  17 Received: from mail-wy0-f181.google.com (mail-wy0-f181.google.com\r
  18         [74.125.82.181])\r
  19         by olra.theworths.org (Postfix) with ESMTP id F0774431FC1\r
  20         for <notmuch@notmuchmail.org>; Thu, 22 Apr 2010 02:03:36 -0700 (PDT)\r
  21 Received: by wyf23 with SMTP id 23so540793wyf.26\r
  22         for <notmuch@notmuchmail.org>; Thu, 22 Apr 2010 02:03:36 -0700 (PDT)\r
  23 Received: by 10.216.87.66 with SMTP id x44mr120881wee.183.1271927016146;\r
  24         Thu, 22 Apr 2010 02:03:36 -0700 (PDT)\r
  25 Received: from ut.hh.sledj.net (host83-217-165-81.dsl.vispa.com\r
  26         [83.217.165.81])\r
  27         by mx.google.com with ESMTPS id z3sm74111044wbs.10.2010.04.22.02.03.34\r
  28         (version=TLSv1/SSLv3 cipher=RC4-MD5);\r
  29         Thu, 22 Apr 2010 02:03:35 -0700 (PDT)\r
  30 Received: by ut.hh.sledj.net (Postfix, from userid 1000)\r
  31         id 76A03594163; Thu, 22 Apr 2010 10:03:33 +0100 (BST)\r
  32 From: David Edmondson <dme@dme.org>\r
  33 To: notmuch@notmuchmail.org\r
  34 Subject: [PATCH] emacs: Re-arrange message sending code\r
  35 Date: Thu, 22 Apr 2010 10:03:32 +0100\r
  36 Message-Id: <1271927012-10062-1-git-send-email-dme@dme.org>\r
  37 X-Mailer: git-send-email 1.7.0\r
  38 X-BeenThere: notmuch@notmuchmail.org\r
  39 X-Mailman-Version: 2.1.13\r
  40 Precedence: list\r
  41 List-Id: "Use and development of the notmuch mail system."\r
  42         <notmuch.notmuchmail.org>\r
  43 List-Unsubscribe: <http://notmuchmail.org/mailman/options/notmuch>,\r
  44         <mailto:notmuch-request@notmuchmail.org?subject=unsubscribe>\r
  45 List-Archive: <http://notmuchmail.org/pipermail/notmuch>\r
  46 List-Post: <mailto:notmuch@notmuchmail.org>\r
  47 List-Help: <mailto:notmuch-request@notmuchmail.org?subject=help>\r
  48 List-Subscribe: <http://notmuchmail.org/mailman/listinfo/notmuch>,\r
  49         <mailto:notmuch-request@notmuchmail.org?subject=subscribe>\r
  50 X-List-Received-Date: Thu, 22 Apr 2010 09:03:39 -0000\r
  51 \r
  52 Define a new `mail-user-agent' (`notmuch-user-agent') and use it by\r
  53 default. Re-arrange various routines that send mail to use this\r
  54 (compose, reply, forward). Insert a `User-Agent:' header by default.\r
  55 ---\r
  56  emacs/Makefile.local   |    5 +-\r
  57  emacs/notmuch-hello.el |    2 +\r
  58  emacs/notmuch-lib.el   |   16 ++++++\r
  59  emacs/notmuch-mua.el   |  133 ++++++++++++++++++++++++++++++++++++++++++++++++\r
  60  emacs/notmuch-show.el  |    8 ++--\r
  61  emacs/notmuch.el       |   20 ++-----\r
  62  6 files changed, 163 insertions(+), 21 deletions(-)\r
  63  create mode 100644 emacs/notmuch-mua.el\r
  64 \r
  65 diff --git a/emacs/Makefile.local b/emacs/Makefile.local\r
  66 index 6486d90..e5013b3 100644\r
  67 --- a/emacs/Makefile.local\r
  68 +++ b/emacs/Makefile.local\r
  69 @@ -6,8 +6,9 @@ emacs_sources := \\r
  70         $(dir)/notmuch.el \\r
  71         $(dir)/notmuch-query.el \\r
  72         $(dir)/notmuch-show.el \\r
  73 -       $(dir)/notmuch-wash.el\r
  74 -       $(dir)/notmuch-hello.el\r
  75 +       $(dir)/notmuch-wash.el \\r
  76 +       $(dir)/notmuch-hello.el \\r
  77 +       $(dir)/notmuch-mua.el\r
  78  \r
  79  emacs_images := \\r
  80         $(dir)/notmuch-logo.png\r
  81 diff --git a/emacs/notmuch-hello.el b/emacs/notmuch-hello.el\r
  82 index 13de6f8..fa6433e 100644\r
  83 --- a/emacs/notmuch-hello.el\r
  84 +++ b/emacs/notmuch-hello.el\r
  85 @@ -25,6 +25,7 @@\r
  86  \r
  87  (require 'notmuch-lib)\r
  88  (require 'notmuch)\r
  89 +(require 'notmuch-mua)\r
  90  \r
  91  (declare-function notmuch-search "notmuch" (query &optional oldest-first target-thread target-line))\r
  92  (declare-function notmuch-folder-count "notmuch" (search))\r
  93 @@ -335,6 +336,7 @@ diagonal."\r
  94  \r
  95    (use-local-map widget-keymap)\r
  96    (local-set-key "=" 'notmuch-hello-update)\r
  97 +  (local-set-key "m" 'notmuch-mua-mail)\r
  98    (local-set-key "q" '(lambda () (interactive) (kill-buffer (current-buffer))))\r
  99    (local-set-key "s" 'notmuch-hello-goto-search)\r
 100    (local-set-key "v" '(lambda () (interactive)\r
 101 diff --git a/emacs/notmuch-lib.el b/emacs/notmuch-lib.el\r
 102 index 274d7ec..47c74b9 100644\r
 103 --- a/emacs/notmuch-lib.el\r
 104 +++ b/emacs/notmuch-lib.el\r
 105 @@ -33,6 +33,22 @@\r
 106    :type '(alist :key-type (string) :value-type (string))\r
 107    :group 'notmuch)\r
 108  \r
 109 +;;\r
 110 +\r
 111 +(defun notmuch-version ()\r
 112 +  "Return a string with the notmuch version number."\r
 113 +  (let ((long-string\r
 114 +        ;; Trim off the trailing newline.\r
 115 +        (substring (shell-command-to-string\r
 116 +                    (concat notmuch-command " --version"))\r
 117 +                   0 -1)))\r
 118 +    (if (string-match "^notmuch\\( version\\)? \\(.*\\)$"\r
 119 +                     long-string)\r
 120 +       (match-string 2 long-string)\r
 121 +      "unknown")))\r
 122 +\r
 123 +;;\r
 124 +\r
 125  ;; XXX: This should be a generic function in emacs somewhere, not\r
 126  ;; here.\r
 127  (defun point-invisible-p ()\r
 128 diff --git a/emacs/notmuch-mua.el b/emacs/notmuch-mua.el\r
 129 new file mode 100644\r
 130 index 0000000..acb7dbf\r
 131 --- /dev/null\r
 132 +++ b/emacs/notmuch-mua.el\r
 133 @@ -0,0 +1,133 @@\r
 134 +;; notmuch-mua.el --- emacs style mail-user-agent\r
 135 +;;\r
 136 +;; Copyright © David Edmondson\r
 137 +;;\r
 138 +;; This file is part of Notmuch.\r
 139 +;;\r
 140 +;; Notmuch is free software: you can redistribute it and/or modify it\r
 141 +;; under the terms of the GNU General Public License as published by\r
 142 +;; the Free Software Foundation, either version 3 of the License, or\r
 143 +;; (at your option) any later version.\r
 144 +;;\r
 145 +;; Notmuch is distributed in the hope that it will be useful, but\r
 146 +;; WITHOUT ANY WARRANTY; without even the implied warranty of\r
 147 +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU\r
 148 +;; General Public License for more details.\r
 149 +;;\r
 150 +;; You should have received a copy of the GNU General Public License\r
 151 +;; along with Notmuch.  If not, see <http://www.gnu.org/licenses/>.\r
 152 +;;\r
 153 +;; Authors: David Edmondson <dme@dme.org>\r
 154 +\r
 155 +(require 'cl)\r
 156 +(require 'message)\r
 157 +\r
 158 +(require 'notmuch-lib)\r
 159 +\r
 160 +;;\r
 161 +\r
 162 +(defcustom notmuch-mua-send-hook '(notmuch-mua-message-send-hook)\r
 163 +  "Hook run before sending messages."\r
 164 +  :group 'notmuch\r
 165 +  :type 'hook)\r
 166 +\r
 167 +(defcustom notmuch-mua-user-agent-function 'notmuch-mua-user-agent-full\r
 168 +  "Function used to generate a `User-Agent:' string. If this is\r
 169 +`nil' then no `User-Agent:' will be generated."\r
 170 +  :group 'notmuch\r
 171 +  :type 'function\r
 172 +  :options '(notmuch-mua-user-agent-full\r
 173 +            notmuch-mua-user-agent-notmuch\r
 174 +            notmuch-mua-user-agent-emacs))\r
 175 +\r
 176 +;;\r
 177 +\r
 178 +(defun notmuch-mua-user-agent-full ()\r
 179 +  "Generate a `User-Agent:' string suitable for notmuch."\r
 180 +  (concat (notmuch-mua-user-agent-notmuch)\r
 181 +         " "\r
 182 +         (notmuch-mua-user-agent-emacs)))\r
 183 +\r
 184 +(defun notmuch-mua-user-agent-notmuch ()\r
 185 +  "Generate a `User-Agent:' string suitable for notmuch."\r
 186 +  (concat "Notmuch/" (notmuch-version) " (http://notmuchmail.org)"))\r
 187 +\r
 188 +(defun notmuch-mua-user-agent-emacs ()\r
 189 +  "Generate a `User-Agent:' string suitable for notmuch."\r
 190 +  (concat "Emacs/" emacs-version " (" system-configuration ")"))\r
 191 +\r
 192 +(defun notmuch-mua-reply (query-string)\r
 193 +  (let (headers body)\r
 194 +    ;; This make assumptions about the output of `notmuch reply', but\r
 195 +    ;; really only that the headers come first followed by a blank\r
 196 +    ;; line and then the body.\r
 197 +    (with-temp-buffer\r
 198 +      (call-process notmuch-command nil t nil "reply" query-string)\r
 199 +      (goto-char (point-min))\r
 200 +      (if (re-search-forward "^$" nil t)\r
 201 +         (save-excursion\r
 202 +           (save-restriction\r
 203 +             (narrow-to-region (point-min) (point))\r
 204 +             (goto-char (point-min))\r
 205 +             (setq headers (mail-header-extract)))))\r
 206 +      (forward-line 1)\r
 207 +      (setq body (buffer-substring (point) (point-max))))\r
 208 +    (notmuch-mua-mail (mail-header 'to headers)\r
 209 +                     (mail-header 'subject headers)\r
 210 +                     (loop for header in headers\r
 211 +                           if (not (or (eq 'to (car header))\r
 212 +                                       (eq 'subject (car header))))\r
 213 +                           collect header))\r
 214 +    (message-sort-headers)\r
 215 +    (message-hide-headers)\r
 216 +    (save-excursion\r
 217 +      (goto-char (point-max))\r
 218 +      (insert body))\r
 219 +    (set-buffer-modified-p nil)))\r
 220 +\r
 221 +(defun notmuch-mua-forward-message ()\r
 222 +  (message-forward)\r
 223 +  (save-excursion\r
 224 +    (when notmuch-mua-user-agent-function\r
 225 +      (let ((user-agent (funcall notmuch-mua-user-agent-function)))\r
 226 +       (when (not (string= "" user-agent))\r
 227 +         (message-add-header (format "User-Agent: %s" user-agent)))))\r
 228 +    (message-sort-headers)\r
 229 +    (message-hide-headers))\r
 230 +  (set-buffer-modified-p nil))\r
 231 +\r
 232 +(defun notmuch-mua-mail (&optional to subject other-headers continue\r
 233 +                                  switch-function yank-action send-actions)\r
 234 +  (interactive)\r
 235 +\r
 236 +  (when notmuch-mua-user-agent-function\r
 237 +    (let ((user-agent (funcall notmuch-mua-user-agent-function)))\r
 238 +      (when (not (string= "" user-agent))\r
 239 +       (push (cons "User-Agent" user-agent) other-headers))))\r
 240 +\r
 241 +  (message-mail to subject other-headers continue\r
 242 +               switch-function yank-action send-actions)\r
 243 +  (message-hide-headers))\r
 244 +\r
 245 +(defun notmuch-mua-send-and-exit (&optional arg)\r
 246 +  (interactive "P")\r
 247 +  (message-send-and-exit arg))\r
 248 +\r
 249 +(defun notmuch-mua-kill-buffer ()\r
 250 +  (interactive)\r
 251 +  (message-kill-buffer))\r
 252 +\r
 253 +(defun notmuch-mua-message-send-hook ()\r
 254 +  "The default function used for `notmuch-mua-send-hook', this\r
 255 +simply runs the corresponding `message-mode' hook functions."\r
 256 +  (run-hooks 'message-send-hook))\r
 257 +\r
 258 +;;\r
 259 +\r
 260 +(define-mail-user-agent 'notmuch-user-agent\r
 261 +  'notmuch-mua-mail 'notmuch-mua-send-and-exit\r
 262 +  'notmuch-mua-kill-buffer 'notmuch-mua-send-hook)\r
 263 +\r
 264 +;;\r
 265 +\r
 266 +(provide 'notmuch-mua)\r
 267 diff --git a/emacs/notmuch-show.el b/emacs/notmuch-show.el\r
 268 index 9775fb4..379e344 100644\r
 269 --- a/emacs/notmuch-show.el\r
 270 +++ b/emacs/notmuch-show.el\r
 271 @@ -30,9 +30,9 @@\r
 272  (require 'notmuch-lib)\r
 273  (require 'notmuch-query)\r
 274  (require 'notmuch-wash)\r
 275 +(require 'notmuch-mua)\r
 276  \r
 277  (declare-function notmuch-call-notmuch-process "notmuch" (&rest args))\r
 278 -(declare-function notmuch-reply "notmuch" (query-string))\r
 279  (declare-function notmuch-fontify-headers "notmuch" nil)\r
 280  (declare-function notmuch-select-tag-with-completion "notmuch" (prompt &rest search-terms))\r
 281  (declare-function notmuch-search-show-thread "notmuch" nil)\r
 282 @@ -507,7 +507,7 @@ function is used. "\r
 283         (define-key map (kbd "M-TAB") 'notmuch-show-previous-button)\r
 284         (define-key map (kbd "TAB") 'notmuch-show-next-button)\r
 285         (define-key map "s" 'notmuch-search)\r
 286 -       (define-key map "m" 'message-mail)\r
 287 +       (define-key map "m" 'notmuch-mua-mail)\r
 288         (define-key map "f" 'notmuch-show-forward-message)\r
 289         (define-key map "r" 'notmuch-show-reply)\r
 290         (define-key map "|" 'notmuch-show-pipe-message)\r
 291 @@ -805,13 +805,13 @@ any effects from previous calls to\r
 292  (defun notmuch-show-reply ()\r
 293    "Reply to the current message."\r
 294    (interactive)\r
 295 -  (notmuch-reply (notmuch-show-get-message-id)))\r
 296 +  (notmuch-mua-reply (notmuch-show-get-message-id)))\r
 297  \r
 298  (defun notmuch-show-forward-message ()\r
 299    "Forward the current message."\r
 300    (interactive)\r
 301    (with-current-notmuch-show-message\r
 302 -   (message-forward)))\r
 303 +   (notmuch-mua-forward-message)))\r
 304  \r
 305  (defun notmuch-show-next-message ()\r
 306    "Show the next message."\r
 307 diff --git a/emacs/notmuch.el b/emacs/notmuch.el\r
 308 index 4c13f32..f96394a 100644\r
 309 --- a/emacs/notmuch.el\r
 310 +++ b/emacs/notmuch.el\r
 311 @@ -53,6 +53,7 @@\r
 312  \r
 313  (require 'notmuch-lib)\r
 314  (require 'notmuch-show)\r
 315 +(require 'notmuch-mua)\r
 316  \r
 317  (defcustom notmuch-search-authors-width 20\r
 318    "Number of columns to use to display authors in a notmuch-search buffer."\r
 319 @@ -116,17 +117,6 @@ For example:\r
 320              (mm-save-part p))))\r
 321     mm-handle))\r
 322  \r
 323 -(defun notmuch-reply (query-string)\r
 324 -  (switch-to-buffer (generate-new-buffer "notmuch-draft"))\r
 325 -  (call-process notmuch-command nil t nil "reply" query-string)\r
 326 -  (message-insert-signature)\r
 327 -  (goto-char (point-min))\r
 328 -  (if (re-search-forward "^$" nil t)\r
 329 -      (progn\r
 330 -       (insert "--text follows this line--")\r
 331 -       (forward-line)))\r
 332 -  (message-mode))\r
 333 -\r
 334  (defun notmuch-documentation-first-line (symbol)\r
 335    "Return the first line of the documentation string for SYMBOL."\r
 336    (let ((doc (documentation symbol)))\r
 337 @@ -216,7 +206,7 @@ For a mouse binding, return nil."\r
 338      (define-key map "p" 'notmuch-search-previous-thread)\r
 339      (define-key map "n" 'notmuch-search-next-thread)\r
 340      (define-key map "r" 'notmuch-search-reply-to-thread)\r
 341 -    (define-key map "m" 'message-mail)\r
 342 +    (define-key map "m" 'notmuch-mua-mail)\r
 343      (define-key map "s" 'notmuch-search)\r
 344      (define-key map "o" 'notmuch-search-toggle-order)\r
 345      (define-key map "=" 'notmuch-search-refresh-view)\r
 346 @@ -408,7 +398,7 @@ Complete list of currently available key bindings:\r
 347    "Begin composing a reply to the entire current thread in a new buffer."\r
 348    (interactive)\r
 349    (let ((message-id (notmuch-search-find-thread-id)))\r
 350 -    (notmuch-reply message-id)))\r
 351 +    (notmuch-mua-reply message-id)))\r
 352  \r
 353  (defun notmuch-call-notmuch-process (&rest args)\r
 354    "Synchronously invoke \"notmuch\" with the given list of arguments.\r
 355 @@ -796,14 +786,14 @@ current search results AND that are tagged with the given tag."\r
 356    (interactive)\r
 357    (notmuch-search "tag:inbox" notmuch-search-oldest-first))\r
 358  \r
 359 -(setq mail-user-agent 'message-user-agent)\r
 360 +(setq mail-user-agent 'notmuch-user-agent)\r
 361  \r
 362  (defvar notmuch-folder-mode-map\r
 363    (let ((map (make-sparse-keymap)))\r
 364      (define-key map "?" 'notmuch-help)\r
 365      (define-key map "x" 'kill-this-buffer)\r
 366      (define-key map "q" 'kill-this-buffer)\r
 367 -    (define-key map "m" 'message-mail)\r
 368 +    (define-key map "m" 'notmuch-mua-mail)\r
 369      (define-key map "e" 'notmuch-folder-show-empty-toggle)\r
 370      (define-key map ">" 'notmuch-folder-last)\r
 371      (define-key map "<" 'notmuch-folder-first)\r
 372 -- \r
 373 1.7.0\r
 374 \r