mailclient.el 5.78 KB
Newer Older
Richard M. Stallman's avatar
Richard M. Stallman committed
1 2
;;; mailclient.el --- mail sending via system's mail client.  -*- byte-compile-dynamic: t -*-

Glenn Morris's avatar
Glenn Morris committed
3
;; Copyright (C) 2005, 2006, 2007, 2008, 2009, 2010 Free Software Foundation
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 49

;; 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

50
(defcustom mailclient-place-body-on-clipboard-flag
Richard M. Stallman's avatar
Richard M. Stallman committed
51 52
  (fboundp 'w32-set-clipboard-data)
  "If non-nil, put the e-mail body on the clipboard in mailclient.
53 54
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
55 56 57 58 59 60 61 62 63 64
  :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
65
	     ((eq char ?\n) "%0D%0A")  ;; newline
Richard M. Stallman's avatar
Richard M. Stallman committed
66 67 68 69 70 71 72 73 74 75
	     ((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))
76
    (setq mailclient-delim-static "&")
Richard M. Stallman's avatar
Richard M. Stallman committed
77 78 79 80 81 82
    current))

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

101 102
(declare-function clipboard-kill-ring-save "menu-bar.el" (beg end))

Richard M. Stallman's avatar
Richard M. Stallman committed
103
;;;###autoload
104
(defun mailclient-send-it ()
Richard M. Stallman's avatar
Richard M. Stallman committed
105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124
  "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"))
125
	  (let ((case-fold-search t))
Richard M. Stallman's avatar
Richard M. Stallman committed
126 127 128
	    ;; initialize limiter
	    (setq mailclient-delim-static "?")
	    ;; construct and call up mailto URL
129 130
	    (browse-url
	     (concat
Richard M. Stallman's avatar
Richard M. Stallman committed
131 132
	      (save-excursion
		(narrow-to-region (point-min) delimline)
133
		(concat
Richard M. Stallman's avatar
Richard M. Stallman committed
134 135
		 "mailto:"
		 ;; some of the headers according to RFC822
136 137
		 (mailclient-gather-addresses "To"
					      'drop-first-name)
Richard M. Stallman's avatar
Richard M. Stallman committed
138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153
		 (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.
154
		       (concat (mailclient-url-delim) "subject="
Richard M. Stallman's avatar
Richard M. Stallman committed
155 156 157
			       (mailclient-encode-string-as-url subj))
		     ""))))
	      ;; body
158 159
	      (concat
	       (mailclient-url-delim) "body="
Richard M. Stallman's avatar
Richard M. Stallman committed
160 161 162
	       (mailclient-encode-string-as-url
		(if mailclient-place-body-on-clipboard-flag
		    (progn
163
		      (clipboard-kill-ring-save
Richard M. Stallman's avatar
Richard M. Stallman committed
164 165 166
		       (+ 1 delimline) (point-max))
		      (concat
		       "*** E-Mail body has been placed on clipboard, "
167
		       "please paste it here! ***"))
Richard M. Stallman's avatar
Richard M. Stallman committed
168 169 170 171 172
		  ;; else
		  (buffer-substring (+ 1 delimline) (point-max))))))))))))

(provide 'mailclient)

Miles Bader's avatar
Miles Bader committed
173
;; arch-tag: 35d10fc8-a1bc-4f29-a4e6-c288e53578ef
Richard M. Stallman's avatar
Richard M. Stallman committed
174
;;; mailclient.el ends here