[PATCH] emacs: Re-arrange message sending code
David Edmondson
dme at dme.org
Thu Apr 15 08:50:27 PDT 2010
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/notmuch-hello.el | 2 +
emacs/notmuch-mua.el | 94 ++++++++++++++++++++++++++++++++++++++++++++++++
emacs/notmuch-show.el | 5 ++-
emacs/notmuch.el | 43 ++++++++++++++++------
4 files changed, 130 insertions(+), 14 deletions(-)
create mode 100644 emacs/notmuch-mua.el
diff --git a/emacs/notmuch-hello.el b/emacs/notmuch-hello.el
index c49a35f..83586f2 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))
@@ -314,6 +315,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)
diff --git a/emacs/notmuch-mua.el b/emacs/notmuch-mua.el
new file mode 100644
index 0000000..c8a8743
--- /dev/null
+++ b/emacs/notmuch-mua.el
@@ -0,0 +1,94 @@
+;; 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 at dme.org>
+
+(require 'message)
+
+;;
+
+(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
+ "Function used to generate a `User-Agent:' string. If this is
+`nil' then no `User-Agent:' will be generated."
+ :group 'notmuch
+ :type 'function)
+
+;;
+
+(defun notmuch-mua-user-agent ()
+ "Generate a `User-Agent:' string suitable for notmuch."
+ (concat
+ ;; Trim off the trailing newline.
+ (substring (shell-command-to-string
+ (concat notmuch-command " --version"))
+ 0 -1)
+ " (Emacs " emacs-version "/"
+ system-configuration ")"))
+
+(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 54d1c48..d1b0f1a 100644
--- a/emacs/notmuch-show.el
+++ b/emacs/notmuch-show.el
@@ -30,6 +30,7 @@
(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))
@@ -519,7 +520,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)
@@ -835,7 +836,7 @@ any effects from previous calls to
"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 b9a0a3e..56bb27f 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."
@@ -117,15 +118,33 @@ For example:
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))
+ (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-documentation-first-line (symbol)
"Return the first line of the documentation string for SYMBOL."
@@ -216,7 +235,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)
@@ -767,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
More information about the notmuch
mailing list