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 (require 'notmuch-address)
  27
  28 ;;
  29
  30 (defcustom notmuch-mua-send-hook '(notmuch-mua-message-send-hook)
  31   "Hook run before sending messages."
  32   :group 'notmuch
  33   :type 'hook)
  34
  35 (defcustom notmuch-mua-user-agent-function 'notmuch-mua-user-agent-full
  36   "Function used to generate a `User-Agent:' string. If this is
  37 `nil' then no `User-Agent:' will be generated."
  38   :group 'notmuch
  39   :type 'function
  40   :options '(notmuch-mua-user-agent-full
  41              notmuch-mua-user-agent-notmuch
  42              notmuch-mua-user-agent-emacs))
  43
  44 ;;
  45
  46 (defun notmuch-mua-user-agent-full ()
  47   "Generate a `User-Agent:' string suitable for notmuch."
  48   (concat (notmuch-mua-user-agent-notmuch)
  49           " "
  50           (notmuch-mua-user-agent-emacs)))
  51
  52 (defun notmuch-mua-user-agent-notmuch ()
  53   "Generate a `User-Agent:' string suitable for notmuch."
  54   (concat "Notmuch/" (notmuch-version) " (http://notmuchmail.org)"))
  55
  56 (defun notmuch-mua-user-agent-emacs ()
  57   "Generate a `User-Agent:' string suitable for notmuch."
  58   (concat "Emacs/" emacs-version " (" system-configuration ")"))
  59
  60 (defun notmuch-mua-reply (query-string)
  61   (let (headers body)
  62     ;; This make assumptions about the output of `notmuch reply', but
  63     ;; really only that the headers come first followed by a blank
  64     ;; line and then the body.
  65     (with-temp-buffer
  66       (call-process notmuch-command nil t nil "reply" query-string)
  67       (goto-char (point-min))
  68       (if (re-search-forward "^$" nil t)
  69           (save-excursion
  70             (save-restriction
  71               (narrow-to-region (point-min) (point))
  72               (goto-char (point-min))
  73               (setq headers (mail-header-extract)))))
  74       (forward-line 1)
  75       (setq body (buffer-substring (point) (point-max))))
  76     (let
  77         ;; Overlay the composition window on that being used to read
  78         ;; the original message.
  79         ((same-window-regexps '("\\*mail .*")))
  80       (notmuch-mua-mail (mail-header 'to headers)
  81                         (mail-header 'subject headers)
  82                         (loop for header in headers
  83                               if (not (or (eq 'to (car header))
  84                                           (eq 'subject (car header))))
  85                               collect header)))
  86     (message-sort-headers)
  87     (message-hide-headers)
  88     (save-excursion
  89       (goto-char (point-max))
  90       (insert body))
  91     (set-buffer-modified-p nil)))
  92
  93 (defun notmuch-mua-forward-message ()
  94   (message-forward)
  95   (save-excursion
  96     (when notmuch-mua-user-agent-function
  97       (let ((user-agent (funcall notmuch-mua-user-agent-function)))
  98         (when (not (string= "" user-agent))
  99           (message-add-header (format "User-Agent: %s" user-agent)))))
 100     (message-sort-headers)
 101     (message-hide-headers))
 102   (set-buffer-modified-p nil))
 103
 104 (defun notmuch-mua-mail (&optional to subject other-headers continue
 105                                    switch-function yank-action send-actions)
 106   (interactive)
 107
 108   (when notmuch-mua-user-agent-function
 109     (let ((user-agent (funcall notmuch-mua-user-agent-function)))
 110       (when (not (string= "" user-agent))
 111         (push (cons "User-Agent" user-agent) other-headers))))
 112
 113   (message-mail to subject other-headers continue
 114                 switch-function yank-action send-actions)
 115   (message-sort-headers)
 116   (message-hide-headers))
 117
 118 (defun notmuch-mua-send-and-exit (&optional arg)
 119   (interactive "P")
 120   (message-send-and-exit arg))
 121
 122 (defun notmuch-mua-kill-buffer ()
 123   (interactive)
 124   (message-kill-buffer))
 125
 126 (defun notmuch-mua-message-send-hook ()
 127   "The default function used for `notmuch-mua-send-hook', this
 128 simply runs the corresponding `message-mode' hook functions."
 129   (run-hooks 'message-send-hook))
 130
 131 ;;
 132
 133 (define-mail-user-agent 'notmuch-user-agent
 134   'notmuch-mua-mail 'notmuch-mua-send-and-exit
 135   'notmuch-mua-kill-buffer 'notmuch-mua-send-hook)
 136
 137 ;;
 138
 139 (provide 'notmuch-mua)