From 45ad21fba18730cdf76725b8a132fc52ba4190a7 Mon Sep 17 00:00:00 2001 From: David Edmondson Date: Thu, 22 Apr 2010 10:03:32 +0100 Subject: [PATCH] emacs: Re-arrange message sending code 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. This is the real commit for this functionality this time. The previous attempt to merge this code: commit 57926bc7b0f784cbacb620fda0ee5157e2e0ff27 was botched (by Carl Worth, not David) to include only the Makefile change. So the build was broken until this commit that actually adds the new file. --- emacs/notmuch-hello.el | 2 + emacs/notmuch-lib.el | 16 +++++ emacs/notmuch-mua.el | 133 +++++++++++++++++++++++++++++++++++++++++ emacs/notmuch.el | 20 ++----- 4 files changed, 156 insertions(+), 15 deletions(-) create mode 100644 emacs/notmuch-mua.el diff --git a/emacs/notmuch-hello.el b/emacs/notmuch-hello.el index aefa350f..7e3107c3 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 continuation)) (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 274d7ec5..47c74b9e 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 00000000..acb7dbf0 --- /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 . +;; +;; Authors: David Edmondson + +(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.el b/emacs/notmuch.el index 1d8d7da0..378c004b 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-result-format `(("date" . "%s ") @@ -111,17 +112,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))) @@ -211,7 +201,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) @@ -405,7 +395,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. @@ -823,14 +813,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) -- 2.43.0