1 ;;; mailclient.el --- mail sending via system's mail client.
3 ;; Copyright (C) 2005-2015 Free Software Foundation, Inc.
5 ;; Author: David Reitter <david.reitter@gmail.com>
8 ;; This file is part of GNU Emacs.
10 ;; GNU Emacs is free software: you can redistribute it and/or modify
11 ;; it under the terms of the GNU General Public License as published by
12 ;; the Free Software Foundation, either version 3 of the License, or
13 ;; (at your option) any later version.
15 ;; GNU Emacs is distributed in the hope that it will be useful,
16 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
17 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
18 ;; GNU General Public License for more details.
20 ;; You should have received a copy of the GNU General Public License
21 ;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
25 ;; This package allows to hand over a buffer to be sent off
26 ;; via the system's designated e-mail client.
27 ;; Note that the e-mail client will display the contents of the buffer
29 ;; The e-mail client is taken to be whoever handles a mailto: URL
31 ;; Mailto: URLs are composed according to RFC2368.
33 ;; MIME bodies are not supported - we rather expect the mail client
34 ;; to encode the body and add, for example, a digital signature.
35 ;; The mailto URL RFC calls for "short text messages that are
36 ;; actually the content of automatic processing."
37 ;; So mailclient.el is ideal for situations where an e-mail is
38 ;; generated automatically, and the user can edit it in the
39 ;; mail client (e.g. bug-reports).
42 ;; (setq send-mail-function 'mailclient-send-it) ; if you use `mail'
47 (require 'sendmail) ;; for mail-sendmail-undelimit-header
48 (require 'mail-utils) ;; for mail-fetch-field
51 (defcustom mailclient-place-body-on-clipboard-flag
52 (fboundp 'w32-set-clipboard-data)
53 "If non-nil, put the e-mail body on the clipboard in mailclient.
54 This is useful on systems where only short mailto:// URLs are
55 supported. Defaults to non-nil on Windows, nil otherwise."
59 (defun mailclient-encode-string-as-url (string)
60 "Convert STRING to a URL, using utf-8 as encoding."
61 (apply (function concat)
65 ((eq char ?\n) "%0D%0A") ;; newline
66 ((string-match "[-a-zA-Z0-9._~]" (char-to-string char))
67 (char-to-string char)) ;; unreserved as per RFC 6068
69 (format "%%%02x" char)))) ;; escape
70 ;; Convert string to list of chars
71 (append (encode-coding-string string 'utf-8)))))
73 (defvar mailclient-delim-static "?")
74 (defun mailclient-url-delim ()
75 (let ((current mailclient-delim-static))
76 (setq mailclient-delim-static "&")
79 (defun mailclient-gather-addresses (str &optional drop-first-name)
80 (let ((field (mail-fetch-field str nil t)))
90 (if (and drop-first-name
93 (concat (mailclient-url-delim) str "="))
94 (mailclient-encode-string-as-url
98 (mail-strip-quoted-names field) ", *"))
101 (declare-function clipboard-kill-ring-save "menu-bar.el"
102 (beg end &optional region))
105 (defun mailclient-send-it ()
106 "Pass current buffer on to the system's mail client.
107 Suitable value for `send-mail-function'.
108 The mail client is taken to be the handler of mailto URLs."
109 (require 'mail-utils)
110 (let ((case-fold-search nil)
112 (mailbuf (current-buffer)))
115 (insert-buffer-substring mailbuf)
116 ;; Move to header delimiter
117 (mail-sendmail-undelimit-header)
118 (setq delimline (point-marker))
120 (expand-mail-aliases (point-min) delimline))
121 (goto-char (point-min))
122 ;; ignore any blank lines in the header
123 (while (and (re-search-forward "\n\n\n*" delimline t)
124 (< (point) delimline))
125 (replace-match "\n"))
126 (let ((case-fold-search t)
127 (mime-charset-pattern
129 "^content-type:[ \t]*text/plain;"
130 "\\(?:[ \t\n]*\\(?:format\\|delsp\\)=\"?[-a-z0-9]+\"?;\\)*"
131 "[ \t\n]*charset=\"?\\([^ \t\n\";]+\\)\"?"))
134 ;; Use the external browser function to send the
136 (browse-url-mailto-function nil))
137 ;; initialize limiter
138 (setq mailclient-delim-static "?")
139 ;; construct and call up mailto URL
143 (narrow-to-region (point-min) delimline)
144 (goto-char (point-min))
146 (if (re-search-forward mime-charset-pattern nil t)
147 (coding-system-from-name (match-string 1))
149 (setq character-coding
150 (mail-fetch-field "content-transfer-encoding"))
151 (when character-coding
152 (setq character-coding (downcase character-coding)))
155 ;; some of the headers according to RFC822
156 (mailclient-gather-addresses "To"
158 (mailclient-gather-addresses "cc" )
159 (mailclient-gather-addresses "bcc" )
160 (mailclient-gather-addresses "Resent-To" )
161 (mailclient-gather-addresses "Resent-cc" )
162 (mailclient-gather-addresses "Resent-bcc" )
163 (mailclient-gather-addresses "Reply-To" )
164 ;; The From field is not honored for now: it's
165 ;; not necessarily configured. The mail client
166 ;; knows the user's address(es)
167 ;; (mailclient-gather-addresses "From" )
169 (let ((subj (mail-fetch-field "Subject" nil t)))
170 (widen) ;; so we can read the body later on
171 (if subj ;; if non-blank
172 ;; the mail client will deal with
173 ;; warning the user etc.
174 (concat (mailclient-url-delim) "subject="
175 (mailclient-encode-string-as-url subj))
178 (mailclient-url-delim) "body="
180 (delete-region (point-min) delimline)
181 (unless (null character-coding)
182 ;; mailto: and clipboard need UTF-8 and cannot deal with
183 ;; Content-Transfer-Encoding or Content-Type.
184 ;; FIXME: There is code duplication here with rmail.el.
185 (set-buffer-multibyte nil)
187 ((string= character-coding "base64")
188 (base64-decode-region (point-min) (point-max)))
189 ((string= character-coding "quoted-printable")
190 (mail-unquote-printable-region (point-min) (point-max)
192 (t (error "unsupported Content-Transfer-Encoding: %s"
194 (decode-coding-region (point-min) (point-max) coding-system))
195 (mailclient-encode-string-as-url
196 (if mailclient-place-body-on-clipboard-flag
198 (clipboard-kill-ring-save (point-min) (point-max))
200 "*** E-Mail body has been placed on clipboard, "
201 "please paste it here! ***"))
202 (buffer-string)))))))))))
204 (provide 'mailclient)
206 ;;; mailclient.el ends here