From: Richard M. Stallman Date: Fri, 23 Sep 2005 18:31:49 +0000 (+0000) Subject: New file. X-Git-Tag: emacs-pretest-22.0.90~6973 X-Git-Url: http://git.eshelyaron.com/gitweb/?a=commitdiff_plain;h=60a97d23c87311bba7f5654fe0aa846b07dc2ffb;p=emacs.git New file. --- diff --git a/lisp/mail/mailclient.el b/lisp/mail/mailclient.el new file mode 100644 index 00000000000..60d53c3d983 --- /dev/null +++ b/lisp/mail/mailclient.el @@ -0,0 +1,173 @@ +;;; mailclient.el --- mail sending via system's mail client. -*- byte-compile-dynamic: t -*- + +;; Copyright (C) 2005 Free Software Foundation + +;; Author: David Reitter +;; 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 +;; the Free Software Foundation; either version 2, or (at your option) +;; 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: + +;; This package allows to hand over a buffer to be sent off +;; via the system's designated e-mail client. +;; 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 +;; via `browse-url'. +;; 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 +;; actually the content of automatic processing." +;; So mailclient.el is ideal for situations where an e-mail is +;; generated automatically, and the user can edit it in the +;; mail client (e.g. bug-reports). + +;; 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 + +(defcustom mailclient-place-body-on-clipboard-flag + (fboundp 'w32-set-clipboard-data) + "If non-nil, put the e-mail body on the clipboard in mailclient. +This is useful on systems where only short mailto:// URLs are +supported. Defaults to non-nil on Windows, nil otherwise." + :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 + ((eq char ?\n) "%0D%0A") ;; newline + ((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)) + (setq mailclient-delim-static "&") + current)) + +(defun mailclient-gather-addresses (str &optional drop-first-name) + (let ((field (mail-fetch-field str nil t))) + (if field + (save-excursion + (let ((first t) + (result "")) + (mapc + (lambda (recp) + (setq result + (concat + result + (if (and drop-first-name + first) + "" + (concat (mailclient-url-delim) str "=")) + (mailclient-encode-string-as-url + recp))) + (setq first nil)) + (split-string + (mail-strip-quoted-names field) "\, *")) + result))))) + +;;;###autoload +(defun mailclient-send-it () + "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")) + (let ((case-fold-search t)) + ;; initialize limiter + (setq mailclient-delim-static "?") + ;; construct and call up mailto URL + (browse-url + (concat + (save-excursion + (narrow-to-region (point-min) delimline) + (concat + "mailto:" + ;; some of the headers according to RFC822 + (mailclient-gather-addresses "To" + 'drop-first-name) + (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. + (concat (mailclient-url-delim) "subject=" + (mailclient-encode-string-as-url subj)) + "")))) + ;; body + (concat + (mailclient-url-delim) "body=" + (mailclient-encode-string-as-url + (if mailclient-place-body-on-clipboard-flag + (progn + (clipboard-kill-ring-save + (+ 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) + +;;; mailclient.el ends here