New file.

1 files changed, 173 insertions, 0 deletions

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