1;;; mailclient.el --- mail sending via system's mail client.  -*- byte-compile-dynamic: t -*-
2
3;; Copyright (C) 2005, 2006, 2007 Free Software Foundation
4
5;; Author: David Reitter <david.reitter@gmail.com>
6;; Keywords: mail
7
8;; This file is part of GNU Emacs.
9
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 2, or (at your option)
13;; any later version.
14
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.
19
20;; You should have received a copy of the GNU General Public License
21;; along with GNU Emacs; see the file COPYING.  If not, write to the
22;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
23;; Boston, MA 02110-1301, USA.
24
25;;; Commentary:
26
27;; This package allows to hand over a buffer to be sent off
28;; via the system's designated e-mail client.
29;; Note that the e-mail client will display the contents of the buffer
30;; again for editing.
31;; The e-mail client is taken to be whoever handles a mailto: URL
32;; via `browse-url'.
33;; Mailto: URLs are composed according to RFC2368.
34
35;; MIME bodies are not supported - we rather expect the mail client
36;; to encode the body and add, for example, a digital signature.
37;; The mailto URL RFC calls for "short text messages that are
38;; actually the content of automatic processing."
39;; So mailclient.el is ideal for situations where an e-mail is
40;; generated automatically, and the user can edit it in the
41;; mail client (e.g. bug-reports).
42
43;; To activate:
44;; (setq send-mail-function 'mailclient-send-it) ; if you use `mail'
45
46;;; Code:
47
48
49(require 'sendmail)   ;; for mail-sendmail-undelimit-header
50(require 'mail-utils) ;; for mail-fetch-field
51
52(defcustom mailclient-place-body-on-clipboard-flag
53  (fboundp 'w32-set-clipboard-data)
54  "If non-nil, put the e-mail body on the clipboard in mailclient.
55This is useful on systems where only short mailto:// URLs are
56supported.  Defaults to non-nil on Windows, nil otherwise."
57  :type 'boolean
58  :group 'mail)
59
60(defun mailclient-encode-string-as-url (string)
61  "Convert STRING to a URL, using utf-8 as encoding."
62  (apply (function concat)
63	 (mapcar
64	  (lambda (char)
65	    (cond
66	     ((eq char ?\x20) "%20")   ;; space
67	     ((eq char ?\n) "%0D%0A")  ;; newline
68	     ((string-match "[-a-zA-Z0-9_:/.@]" (char-to-string char))
69	      (char-to-string char))   ;; printable
70	     (t                        ;; everything else
71	      (format "%%%02x" char))))	;; escape
72	  ;; Convert string to list of chars
73	  (append (encode-coding-string string 'utf-8)))))
74
75(defvar mailclient-delim-static "?")
76(defun mailclient-url-delim ()
77  (let ((current mailclient-delim-static))
78    (setq mailclient-delim-static "&")
79    current))
80
81(defun mailclient-gather-addresses (str &optional drop-first-name)
82  (let ((field (mail-fetch-field str nil t)))
83    (if field
84	(save-excursion
85	  (let ((first t)
86		(result ""))
87	    (mapc
88	     (lambda (recp)
89	       (setq result
90		     (concat
91		      result
92		      (if (and drop-first-name
93			       first)
94			  ""
95			(concat (mailclient-url-delim) str "="))
96		      (mailclient-encode-string-as-url
97		       recp)))
98	       (setq first nil))
99	     (split-string
100	      (mail-strip-quoted-names field) "\, *"))
101	    result)))))
102
103;;;###autoload
104(defun mailclient-send-it ()
105  "Pass current buffer on to the system's mail client.
106Suitable value for `send-mail-function'.
107The mail client is taken to be the handler of mailto URLs."
108  (require 'mail-utils)
109  (let ((case-fold-search nil)
110	delimline
111	(mailbuf (current-buffer)))
112    (unwind-protect
113	(with-temp-buffer
114	  (insert-buffer-substring mailbuf)
115	  ;; Move to header delimiter
116	  (mail-sendmail-undelimit-header)
117	  (setq delimline (point-marker))
118	  (if mail-aliases
119	      (expand-mail-aliases (point-min) delimline))
120	  (goto-char (point-min))
121	  ;; ignore any blank lines in the header
122	  (while (and (re-search-forward "\n\n\n*" delimline t)
123		      (< (point) delimline))
124	    (replace-match "\n"))
125	  (let ((case-fold-search t))
126	    ;; initialize limiter
127	    (setq mailclient-delim-static "?")
128	    ;; construct and call up mailto URL
129	    (browse-url
130	     (concat
131	      (save-excursion
132		(narrow-to-region (point-min) delimline)
133		(concat
134		 "mailto:"
135		 ;; some of the headers according to RFC822
136		 (mailclient-gather-addresses "To"
137					      'drop-first-name)
138		 (mailclient-gather-addresses "cc"  )
139		 (mailclient-gather-addresses "bcc"  )
140		 (mailclient-gather-addresses "Resent-To"  )
141		 (mailclient-gather-addresses "Resent-cc"  )
142		 (mailclient-gather-addresses "Resent-bcc"  )
143		 (mailclient-gather-addresses "Reply-To"  )
144		 ;; The From field is not honored for now: it's
145		 ;; not necessarily configured. The mail client
146		 ;; knows the user's address(es)
147		 ;; (mailclient-gather-addresses "From"  )
148		 ;; subject line
149		 (let ((subj (mail-fetch-field "Subject" nil t)))
150		   (widen) ;; so we can read the body later on
151		   (if subj ;; if non-blank
152		       ;; the mail client will deal with
153		       ;; warning the user etc.
154		       (concat (mailclient-url-delim) "subject="
155			       (mailclient-encode-string-as-url subj))
156		     ""))))
157	      ;; body
158	      (concat
159	       (mailclient-url-delim) "body="
160	       (mailclient-encode-string-as-url
161		(if mailclient-place-body-on-clipboard-flag
162		    (progn
163		      (clipboard-kill-ring-save
164		       (+ 1 delimline) (point-max))
165		      (concat
166		       "*** E-Mail body has been placed on clipboard, "
167		       "please paste them here! ***"))
168		  ;; else
169		  (buffer-substring (+ 1 delimline) (point-max))))))))))))
170
171(provide 'mailclient)
172
173;; arch-tag: 35d10fc8-a1bc-4f29-a4e6-c288e53578ef
174;;; mailclient.el ends here
175