mailclient.el 5.71 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 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 101
	      (mail-strip-quoted-names field) "\, *"))
	    result)))))

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

(provide 'mailclient)

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