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