mailclient.el 5.82 KB
Newer Older
1
;;; mailclient.el --- mail sending via system's mail client.
Richard M. Stallman's avatar
Richard M. Stallman committed
2

Paul Eggert's avatar
Paul Eggert committed
3
;; Copyright (C) 2005-2015 Free Software Foundation, Inc.
Richard M. Stallman's avatar
Richard M. Stallman committed
4 5 6 7 8 9

;; Author: David Reitter <david.reitter@gmail.com>
;; Keywords: mail

;; This file is part of GNU Emacs.

10
;; GNU Emacs is free software: you can redistribute it and/or modify
Richard M. Stallman's avatar
Richard M. Stallman committed
11
;; it under the terms of the GNU General Public License as published by
12 13
;; the Free Software Foundation, either version 3 of the License, or
;; (at your option) any later version.
Richard M. Stallman's avatar
Richard M. Stallman committed
14 15 16 17 18 19 20

;; GNU Emacs 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
21
;; along with GNU Emacs.  If not, see <http://www.gnu.org/licenses/>.
Richard M. Stallman's avatar
Richard M. Stallman committed
22 23 24

;;; Commentary:

25 26
;; This package allows to hand over a buffer to be sent off
;; via the system's designated e-mail client.
Richard M. Stallman's avatar
Richard M. Stallman committed
27 28 29
;; Note that the e-mail client will display the contents of the buffer
;; again for editing.
;; The e-mail client is taken to be whoever handles a mailto: URL
30
;; via `browse-url'.
Richard M. Stallman's avatar
Richard M. Stallman committed
31 32 33 34 35
;; Mailto: URLs are composed according to RFC2368.

;; MIME bodies are not supported - we rather expect the mail client
;; to encode the body and add, for example, a digital signature.
;; The mailto URL RFC calls for "short text messages that are
36
;; actually the content of automatic processing."
Richard M. Stallman's avatar
Richard M. Stallman committed
37
;; So mailclient.el is ideal for situations where an e-mail is
38 39
;; generated automatically, and the user can edit it in the
;; mail client (e.g. bug-reports).
Richard M. Stallman's avatar
Richard M. Stallman committed
40 41 42 43 44 45 46 47 48

;; To activate:
;; (setq send-mail-function 'mailclient-send-it) ; if you use `mail'

;;; Code:


(require 'sendmail)   ;; for mail-sendmail-undelimit-header
(require 'mail-utils) ;; for mail-fetch-field
49
(require 'browse-url)
Richard M. Stallman's avatar
Richard M. Stallman committed
50

51
(defcustom mailclient-place-body-on-clipboard-flag
Richard M. Stallman's avatar
Richard M. Stallman committed
52 53
  (fboundp 'w32-set-clipboard-data)
  "If non-nil, put the e-mail body on the clipboard in mailclient.
54 55
This is useful on systems where only short mailto:// URLs are
supported.  Defaults to non-nil on Windows, nil otherwise."
Richard M. Stallman's avatar
Richard M. Stallman committed
56 57 58 59 60 61 62 63 64 65
  :type 'boolean
  :group 'mail)

(defun mailclient-encode-string-as-url (string)
  "Convert STRING to a URL, using utf-8 as encoding."
  (apply (function concat)
	 (mapcar
	  (lambda (char)
	    (cond
	     ((eq char ?\x20) "%20")   ;; space
66
	     ((eq char ?\n) "%0D%0A")  ;; newline
Richard M. Stallman's avatar
Richard M. Stallman committed
67 68 69 70 71 72 73 74 75 76
	     ((string-match "[-a-zA-Z0-9_:/.@]" (char-to-string char))
	      (char-to-string char))   ;; printable
	     (t                        ;; everything else
	      (format "%%%02x" char))))	;; escape
	  ;; Convert string to list of chars
	  (append (encode-coding-string string 'utf-8)))))

(defvar mailclient-delim-static "?")
(defun mailclient-url-delim ()
  (let ((current mailclient-delim-static))
77
    (setq mailclient-delim-static "&")
Richard M. Stallman's avatar
Richard M. Stallman committed
78 79 80 81 82 83
    current))

(defun mailclient-gather-addresses (str &optional drop-first-name)
  (let ((field (mail-fetch-field str nil t)))
    (if field
	(save-excursion
84
	  (let ((first t)
Richard M. Stallman's avatar
Richard M. Stallman committed
85 86 87
		(result ""))
	    (mapc
	     (lambda (recp)
88 89
	       (setq result
		     (concat
Richard M. Stallman's avatar
Richard M. Stallman committed
90 91 92 93 94
		      result
		      (if (and drop-first-name
			       first)
			  ""
			(concat (mailclient-url-delim) str "="))
95
		      (mailclient-encode-string-as-url
Richard M. Stallman's avatar
Richard M. Stallman committed
96 97
		       recp)))
	       (setq first nil))
98
	     (split-string
Richard M. Stallman's avatar
Richard M. Stallman committed
99 100 101
	      (mail-strip-quoted-names field) "\, *"))
	    result)))))

Glenn Morris's avatar
Glenn Morris committed
102 103
(declare-function clipboard-kill-ring-save "menu-bar.el"
		  (beg end &optional region))
104

Richard M. Stallman's avatar
Richard M. Stallman committed
105
;;;###autoload
106
(defun mailclient-send-it ()
Richard M. Stallman's avatar
Richard M. Stallman committed
107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126
  "Pass current buffer on to the system's mail client.
Suitable value for `send-mail-function'.
The mail client is taken to be the handler of mailto URLs."
  (require 'mail-utils)
  (let ((case-fold-search nil)
	delimline
	(mailbuf (current-buffer)))
    (unwind-protect
	(with-temp-buffer
	  (insert-buffer-substring mailbuf)
	  ;; Move to header delimiter
	  (mail-sendmail-undelimit-header)
	  (setq delimline (point-marker))
	  (if mail-aliases
	      (expand-mail-aliases (point-min) delimline))
	  (goto-char (point-min))
	  ;; ignore any blank lines in the header
	  (while (and (re-search-forward "\n\n\n*" delimline t)
		      (< (point) delimline))
	    (replace-match "\n"))
127 128 129 130
	  (let ((case-fold-search t)
		;; Use the external browser function to send the
		;; message.
		(browse-url-mailto-function nil))
Richard M. Stallman's avatar
Richard M. Stallman committed
131 132 133
	    ;; initialize limiter
	    (setq mailclient-delim-static "?")
	    ;; construct and call up mailto URL
134 135
	    (browse-url
	     (concat
Richard M. Stallman's avatar
Richard M. Stallman committed
136 137
	      (save-excursion
		(narrow-to-region (point-min) delimline)
138
		(concat
Richard M. Stallman's avatar
Richard M. Stallman committed
139 140
		 "mailto:"
		 ;; some of the headers according to RFC822
141 142
		 (mailclient-gather-addresses "To"
					      'drop-first-name)
Richard M. Stallman's avatar
Richard M. Stallman committed
143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158
		 (mailclient-gather-addresses "cc"  )
		 (mailclient-gather-addresses "bcc"  )
		 (mailclient-gather-addresses "Resent-To"  )
		 (mailclient-gather-addresses "Resent-cc"  )
		 (mailclient-gather-addresses "Resent-bcc"  )
		 (mailclient-gather-addresses "Reply-To"  )
		 ;; The From field is not honored for now: it's
		 ;; not necessarily configured. The mail client
		 ;; knows the user's address(es)
		 ;; (mailclient-gather-addresses "From"  )
		 ;; subject line
		 (let ((subj (mail-fetch-field "Subject" nil t)))
		   (widen) ;; so we can read the body later on
		   (if subj ;; if non-blank
		       ;; the mail client will deal with
		       ;; warning the user etc.
159
		       (concat (mailclient-url-delim) "subject="
Richard M. Stallman's avatar
Richard M. Stallman committed
160 161 162
			       (mailclient-encode-string-as-url subj))
		     ""))))
	      ;; body
163 164
	      (concat
	       (mailclient-url-delim) "body="
Richard M. Stallman's avatar
Richard M. Stallman committed
165 166 167
	       (mailclient-encode-string-as-url
		(if mailclient-place-body-on-clipboard-flag
		    (progn
168
		      (clipboard-kill-ring-save
Richard M. Stallman's avatar
Richard M. Stallman committed
169 170 171
		       (+ 1 delimline) (point-max))
		      (concat
		       "*** E-Mail body has been placed on clipboard, "
172
		       "please paste it here! ***"))
Richard M. Stallman's avatar
Richard M. Stallman committed
173 174 175 176 177 178
		  ;; else
		  (buffer-substring (+ 1 delimline) (point-max))))))))))))

(provide 'mailclient)

;;; mailclient.el ends here