git.notmuchmail.org Git - notmuch/blob - emacs/notmuch-mua.el

   1 ;; notmuch-mua.el --- emacs style mail-user-agent
   2 ;;
   3 ;; Copyright © David Edmondson
   4 ;;
   5 ;; This file is part of Notmuch.
   6 ;;
   7 ;; Notmuch is free software: you can redistribute it and/or modify it
   8 ;; under the terms of the GNU General Public License as published by
   9 ;; the Free Software Foundation, either version 3 of the License, or
  10 ;; (at your option) any later version.
  11 ;;
  12 ;; Notmuch is distributed in the hope that it will be useful, but
  13 ;; WITHOUT ANY WARRANTY; without even the implied warranty of
  14 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  15 ;; General Public License for more details.
  16 ;;
  17 ;; You should have received a copy of the GNU General Public License
  18 ;; along with Notmuch.  If not, see <http://www.gnu.org/licenses/>.
  19 ;;
  20 ;; Authors: David Edmondson <dme@dme.org>
  21
  22 (require 'cl)
  23 (require 'message)
  24
  25 (require 'notmuch-lib)
  26
  27 ;;
  28
  29 (defcustom notmuch-mua-send-hook '(notmuch-mua-message-send-hook)
  30   "Hook run before sending messages."
  31   :group 'notmuch
  32   :type 'hook)
  33
  34 (defcustom notmuch-mua-user-agent-function 'notmuch-mua-user-agent-full
  35   "Function used to generate a `User-Agent:' string. If this is
  36 `nil' then no `User-Agent:' will be generated."
  37   :group 'notmuch
  38   :type 'function
  39   :options '(notmuch-mua-user-agent-full
  40              notmuch-mua-user-agent-notmuch
  41              notmuch-mua-user-agent-emacs))
  42
  43 ;;
  44
  45 (defun notmuch-mua-user-agent-full ()
  46   "Generate a `User-Agent:' string suitable for notmuch."
  47   (concat (notmuch-mua-user-agent-notmuch)
  48           " "
  49           (notmuch-mua-user-agent-emacs)))
  50
  51 (defun notmuch-mua-user-agent-notmuch ()
  52   "Generate a `User-Agent:' string suitable for notmuch."
  53   (concat "Notmuch/" (notmuch-version) " (http://notmuchmail.org)"))
  54
  55 (defun notmuch-mua-user-agent-emacs ()
  56   "Generate a `User-Agent:' string suitable for notmuch."
  57   (concat "Emacs/" emacs-version " (" system-configuration ")"))
  58
  59 (defun notmuch-mua-reply (query-string)
  60   (let (headers body)
  61     ;; This make assumptions about the output of `notmuch reply', but
  62     ;; really only that the headers come first followed by a blank
  63     ;; line and then the body.
  64     (with-temp-buffer
  65       (call-process notmuch-command nil t nil "reply" query-string)
  66       (goto-char (point-min))
  67       (if (re-search-forward "^$" nil t)
  68           (save-excursion
  69             (save-restriction
  70               (narrow-to-region (point-min) (point))
  71               (goto-char (point-min))
  72               (setq headers (mail-header-extract)))))
  73       (forward-line 1)
  74       (setq body (buffer-substring (point) (point-max))))
  75     (let
  76         ;; Overlay the composition window on that being used to read
  77         ;; the original message.
  78         ((same-window-regexps '("\\*mail .*")))
  79       (notmuch-mua-mail (mail-header 'to headers)
  80                         (mail-header 'subject headers)
  81                         (loop for header in headers
  82                               if (not (or (eq 'to (car header))
  83                                           (eq 'subject (car header))))
  84                               collect header)))
  85     (message-sort-headers)
  86     (message-hide-headers)
  87     (save-excursion
  88       (goto-char (point-max))
  89       (insert body))
  90     (set-buffer-modified-p nil)))
  91
  92 (defun notmuch-mua-forward-message ()
  93   (message-forward)
  94   (save-excursion
  95     (when notmuch-mua-user-agent-function
  96       (let ((user-agent (funcall notmuch-mua-user-agent-function)))
  97         (when (not (string= "" user-agent))
  98           (message-add-header (format "User-Agent: %s" user-agent)))))
  99     (message-sort-headers)
 100     (message-hide-headers))
 101   (set-buffer-modified-p nil))
 102
 103 (defun notmuch-mua-mail (&optional to subject other-headers continue
 104                                    switch-function yank-action send-actions)
 105   (interactive)
 106
 107   (when notmuch-mua-user-agent-function
 108     (let ((user-agent (funcall notmuch-mua-user-agent-function)))
 109       (when (not (string= "" user-agent))
 110         (push (cons "User-Agent" user-agent) other-headers))))
 111
 112   (message-mail to subject other-headers continue
 113                 switch-function yank-action send-actions)
 114   (message-sort-headers)
 115   (message-hide-headers))
 116
 117 (defun notmuch-mua-send-and-exit (&optional arg)
 118   (interactive "P")
 119   (message-send-and-exit arg))
 120
 121 (defun notmuch-mua-kill-buffer ()
 122   (interactive)
 123   (message-kill-buffer))
 124
 125 (defun notmuch-mua-message-send-hook ()
 126   "The default function used for `notmuch-mua-send-hook', this
 127 simply runs the corresponding `message-mode' hook functions."
 128   (run-hooks 'message-send-hook))
 129
 130 ;;
 131
 132 (define-mail-user-agent 'notmuch-user-agent
 133   'notmuch-mua-mail 'notmuch-mua-send-and-exit
 134   'notmuch-mua-kill-buffer 'notmuch-mua-send-hook)
 135
 136 ;;
 137
 138 (provide 'notmuch-mua)