mailclient.el 5.79 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 Free Software Foundation
Richard M. Stallman's avatar
Richard M. Stallman committed
4 5 6 7 8 9 10 11

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

;; This file is part of GNU Emacs.

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

;; 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
;; along with GNU Emacs; see the file COPYING.  If not, write to the
;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
;; Boston, MA 02110-1301, USA.

;;; Commentary:

27 28
;; 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
29 30 31
;; 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
32
;; via `browse-url'.
Richard M. Stallman's avatar
Richard M. Stallman committed
33 34 35 36 37
;; 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
38
;; actually the content of automatic processing."
Richard M. Stallman's avatar
Richard M. Stallman committed
39
;; So mailclient.el is ideal for situations where an e-mail is
40 41
;; 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
42 43 44 45 46 47 48 49 50 51

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

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

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

;;;###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 167 168 169 170 171 172
		       (+ 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
173
;; arch-tag: 35d10fc8-a1bc-4f29-a4e6-c288e53578ef
Richard M. Stallman's avatar
Richard M. Stallman committed
174
;;; mailclient.el ends here