From: David Edmondson <dme@dme.org>
To: notmuch@notmuchmail.org
Subject: [PATCH] emacs: Re-arrange message sending code
Date: Thu, 22 Apr 2010 10:03:32 +0100
Message-Id: <1271927012-10062-1-git-send-email-dme@dme.org>
Precedence: list

Define a new `mail-user-agent' (`notmuch-user-agent') and use it by
default. Re-arrange various routines that send mail to use this
(compose, reply, forward). Insert a `User-Agent:' header by default.
---
 emacs/Makefile.local   |    5 +-
 emacs/notmuch-hello.el |    2 +
 emacs/notmuch-lib.el   |   16 ++++++
 emacs/notmuch-mua.el   |  133 ++++++++++++++++++++++++++++++++++++++++++++++++
 emacs/notmuch-show.el  |    8 ++--
 emacs/notmuch.el       |   20 ++-----
 6 files changed, 163 insertions(+), 21 deletions(-)
 create mode 100644 emacs/notmuch-mua.el

diff --git a/emacs/Makefile.local b/emacs/Makefile.local
index 6486d90..e5013b3 100644
--- a/emacs/Makefile.local
+++ b/emacs/Makefile.local
@@ -6,8 +6,9 @@ emacs_sources := \
 	$(dir)/notmuch.el \
 	$(dir)/notmuch-query.el \
 	$(dir)/notmuch-show.el \
-	$(dir)/notmuch-wash.el
-	$(dir)/notmuch-hello.el
+	$(dir)/notmuch-wash.el \
+	$(dir)/notmuch-hello.el \
+	$(dir)/notmuch-mua.el
 
 emacs_images := \
 	$(dir)/notmuch-logo.png
diff --git a/emacs/notmuch-hello.el b/emacs/notmuch-hello.el
index 13de6f8..fa6433e 100644
--- a/emacs/notmuch-hello.el
+++ b/emacs/notmuch-hello.el
@@ -25,6 +25,7 @@
 
 (require 'notmuch-lib)
 (require 'notmuch)
+(require 'notmuch-mua)
 
 (declare-function notmuch-search "notmuch" (query &optional oldest-first target-thread target-line))
 (declare-function notmuch-folder-count "notmuch" (search))
@@ -335,6 +336,7 @@ diagonal."
 
   (use-local-map widget-keymap)
   (local-set-key "=" 'notmuch-hello-update)
+  (local-set-key "m" 'notmuch-mua-mail)
   (local-set-key "q" '(lambda () (interactive) (kill-buffer (current-buffer))))
   (local-set-key "s" 'notmuch-hello-goto-search)
   (local-set-key "v" '(lambda () (interactive)
diff --git a/emacs/notmuch-lib.el b/emacs/notmuch-lib.el
index 274d7ec..47c74b9 100644
--- a/emacs/notmuch-lib.el
+++ b/emacs/notmuch-lib.el
@@ -33,6 +33,22 @@
   :type '(alist :key-type (string) :value-type (string))
   :group 'notmuch)
 
+;;
+
+(defun notmuch-version ()
+  "Return a string with the notmuch version number."
+  (let ((long-string
+	 ;; Trim off the trailing newline.
+	 (substring (shell-command-to-string
+		     (concat notmuch-command " --version"))
+		    0 -1)))
+    (if (string-match "^notmuch\\( version\\)? \\(.*\\)$"
+		      long-string)
+	(match-string 2 long-string)
+      "unknown")))
+
+;;
+
 ;; XXX: This should be a generic function in emacs somewhere, not
 ;; here.
 (defun point-invisible-p ()
diff --git a/emacs/notmuch-mua.el b/emacs/notmuch-mua.el
new file mode 100644
index 0000000..acb7dbf
--- /dev/null
+++ b/emacs/notmuch-mua.el
@@ -0,0 +1,133 @@
+;; notmuch-mua.el --- emacs style mail-user-agent
+;;
+;; Copyright © David Edmondson
+;;
+;; 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 <http://www.gnu.org/licenses/>.
+;;
+;; Authors: David Edmondson <dme@dme.org>
+
+(require 'cl)
+(require 'message)
+
+(require 'notmuch-lib)
+
+;;
+
+(defcustom notmuch-mua-send-hook '(notmuch-mua-message-send-hook)
+  "Hook run before sending messages."
+  :group 'notmuch
+  :type 'hook)
+
+(defcustom notmuch-mua-user-agent-function 'notmuch-mua-user-agent-full
+  "Function used to generate a `User-Agent:' string. If this is
+`nil' then no `User-Agent:' will be generated."
+  :group 'notmuch
+  :type 'function
+  :options '(notmuch-mua-user-agent-full
+	     notmuch-mua-user-agent-notmuch
+	     notmuch-mua-user-agent-emacs))
+
+;;
+
+(defun notmuch-mua-user-agent-full ()
+  "Generate a `User-Agent:' string suitable for notmuch."
+  (concat (notmuch-mua-user-agent-notmuch)
+	  " "
+	  (notmuch-mua-user-agent-emacs)))
+
+(defun notmuch-mua-user-agent-notmuch ()
+  "Generate a `User-Agent:' string suitable for notmuch."
+  (concat "Notmuch/" (notmuch-version) " (http://notmuchmail.org)"))
+
+(defun notmuch-mua-user-agent-emacs ()
+  "Generate a `User-Agent:' string suitable for notmuch."
+  (concat "Emacs/" emacs-version " (" system-configuration ")"))
+
+(defun notmuch-mua-reply (query-string)
+  (let (headers body)
+    ;; This make assumptions about the output of `notmuch reply', but
+    ;; really only that the headers come first followed by a blank
+    ;; line and then the body.
+    (with-temp-buffer
+      (call-process notmuch-command nil t nil "reply" query-string)
+      (goto-char (point-min))
+      (if (re-search-forward "^$" nil t)
+	  (save-excursion
+	    (save-restriction
+	      (narrow-to-region (point-min) (point))
+	      (goto-char (point-min))
+	      (setq headers (mail-header-extract)))))
+      (forward-line 1)
+      (setq body (buffer-substring (point) (point-max))))
+    (notmuch-mua-mail (mail-header 'to headers)
+		      (mail-header 'subject headers)
+		      (loop for header in headers
+			    if (not (or (eq 'to (car header))
+					(eq 'subject (car header))))
+			    collect header))
+    (message-sort-headers)
+    (message-hide-headers)
+    (save-excursion
+      (goto-char (point-max))
+      (insert body))
+    (set-buffer-modified-p nil)))
+
+(defun notmuch-mua-forward-message ()
+  (message-forward)
+  (save-excursion
+    (when notmuch-mua-user-agent-function
+      (let ((user-agent (funcall notmuch-mua-user-agent-function)))
+	(when (not (string= "" user-agent))
+	  (message-add-header (format "User-Agent: %s" user-agent)))))
+    (message-sort-headers)
+    (message-hide-headers))
+  (set-buffer-modified-p nil))
+
+(defun notmuch-mua-mail (&optional to subject other-headers continue
+				   switch-function yank-action send-actions)
+  (interactive)
+
+  (when notmuch-mua-user-agent-function
+    (let ((user-agent (funcall notmuch-mua-user-agent-function)))
+      (when (not (string= "" user-agent))
+	(push (cons "User-Agent" user-agent) other-headers))))
+
+  (message-mail to subject other-headers continue
+		switch-function yank-action send-actions)
+  (message-hide-headers))
+
+(defun notmuch-mua-send-and-exit (&optional arg)
+  (interactive "P")
+  (message-send-and-exit arg))
+
+(defun notmuch-mua-kill-buffer ()
+  (interactive)
+  (message-kill-buffer))
+
+(defun notmuch-mua-message-send-hook ()
+  "The default function used for `notmuch-mua-send-hook', this
+simply runs the corresponding `message-mode' hook functions."
+  (run-hooks 'message-send-hook))
+
+;;
+
+(define-mail-user-agent 'notmuch-user-agent
+  'notmuch-mua-mail 'notmuch-mua-send-and-exit
+  'notmuch-mua-kill-buffer 'notmuch-mua-send-hook)
+
+;;
+
+(provide 'notmuch-mua)
diff --git a/emacs/notmuch-show.el b/emacs/notmuch-show.el
index 9775fb4..379e344 100644
--- a/emacs/notmuch-show.el
+++ b/emacs/notmuch-show.el
@@ -30,9 +30,9 @@
 (require 'notmuch-lib)
 (require 'notmuch-query)
 (require 'notmuch-wash)
+(require 'notmuch-mua)
 
 (declare-function notmuch-call-notmuch-process "notmuch" (&rest args))
-(declare-function notmuch-reply "notmuch" (query-string))
 (declare-function notmuch-fontify-headers "notmuch" nil)
 (declare-function notmuch-select-tag-with-completion "notmuch" (prompt &rest search-terms))
 (declare-function notmuch-search-show-thread "notmuch" nil)
@@ -507,7 +507,7 @@ function is used. "
 	(define-key map (kbd "M-TAB") 'notmuch-show-previous-button)
 	(define-key map (kbd "TAB") 'notmuch-show-next-button)
 	(define-key map "s" 'notmuch-search)
-	(define-key map "m" 'message-mail)
+	(define-key map "m" 'notmuch-mua-mail)
 	(define-key map "f" 'notmuch-show-forward-message)
 	(define-key map "r" 'notmuch-show-reply)
 	(define-key map "|" 'notmuch-show-pipe-message)
@@ -805,13 +805,13 @@ any effects from previous calls to
 (defun notmuch-show-reply ()
   "Reply to the current message."
   (interactive)
-  (notmuch-reply (notmuch-show-get-message-id)))
+  (notmuch-mua-reply (notmuch-show-get-message-id)))
 
 (defun notmuch-show-forward-message ()
   "Forward the current message."
   (interactive)
   (with-current-notmuch-show-message
-   (message-forward)))
+   (notmuch-mua-forward-message)))
 
 (defun notmuch-show-next-message ()
   "Show the next message."
diff --git a/emacs/notmuch.el b/emacs/notmuch.el
index 4c13f32..f96394a 100644
--- a/emacs/notmuch.el
+++ b/emacs/notmuch.el
@@ -53,6 +53,7 @@
 
 (require 'notmuch-lib)
 (require 'notmuch-show)
+(require 'notmuch-mua)
 
 (defcustom notmuch-search-authors-width 20
   "Number of columns to use to display authors in a notmuch-search buffer."
@@ -116,17 +117,6 @@ For example:
             (mm-save-part p))))
    mm-handle))
 
-(defun notmuch-reply (query-string)
-  (switch-to-buffer (generate-new-buffer "notmuch-draft"))
-  (call-process notmuch-command nil t nil "reply" query-string)
-  (message-insert-signature)
-  (goto-char (point-min))
-  (if (re-search-forward "^$" nil t)
-      (progn
-	(insert "--text follows this line--")
-	(forward-line)))
-  (message-mode))
-
 (defun notmuch-documentation-first-line (symbol)
   "Return the first line of the documentation string for SYMBOL."
   (let ((doc (documentation symbol)))
@@ -216,7 +206,7 @@ For a mouse binding, return nil."
     (define-key map "p" 'notmuch-search-previous-thread)
     (define-key map "n" 'notmuch-search-next-thread)
     (define-key map "r" 'notmuch-search-reply-to-thread)
-    (define-key map "m" 'message-mail)
+    (define-key map "m" 'notmuch-mua-mail)
     (define-key map "s" 'notmuch-search)
     (define-key map "o" 'notmuch-search-toggle-order)
     (define-key map "=" 'notmuch-search-refresh-view)
@@ -408,7 +398,7 @@ Complete list of currently available key bindings:
   "Begin composing a reply to the entire current thread in a new buffer."
   (interactive)
   (let ((message-id (notmuch-search-find-thread-id)))
-    (notmuch-reply message-id)))
+    (notmuch-mua-reply message-id)))
 
 (defun notmuch-call-notmuch-process (&rest args)
   "Synchronously invoke \"notmuch\" with the given list of arguments.
@@ -796,14 +786,14 @@ current search results AND that are tagged with the given tag."
   (interactive)
   (notmuch-search "tag:inbox" notmuch-search-oldest-first))
 
-(setq mail-user-agent 'message-user-agent)
+(setq mail-user-agent 'notmuch-user-agent)
 
 (defvar notmuch-folder-mode-map
   (let ((map (make-sparse-keymap)))
     (define-key map "?" 'notmuch-help)
     (define-key map "x" 'kill-this-buffer)
     (define-key map "q" 'kill-this-buffer)
-    (define-key map "m" 'message-mail)
+    (define-key map "m" 'notmuch-mua-mail)
     (define-key map "e" 'notmuch-folder-show-empty-toggle)
     (define-key map ">" 'notmuch-folder-last)
     (define-key map "<" 'notmuch-folder-first)
-- 
1.7.0