mailclient.el revised for Windows

mailclient.el revised for Windows

[David Reitter]

[-- Attachment #1: Type: text/plain, Size: 1662 bytes --]

Here is a revised mailclient.el and a patch for sendmail.el to enable  
it.
It contains some changes to allow for the e-mail body to be placed on  
the clipboard in order to accomodate w32 systems that apparently  
can't handle longer URLs. Lennart Borgman had suggested that; I have  
implemented it using clipboard-kill-ring-save instead of some OS- 
specific w32-* function, so it'll work on all systems.

Please add it to the trunk if you think it's ok now.

==


*** sendmail.el 6 Aug 2005 18:54:05 -0000       1.287
--- sendmail.el 14 Aug 2005 18:57:45 -0000
***************
*** 120,126 ****

   ;; Useful to set in site-init.el
   ;;;###autoload
! (defcustom send-mail-function 'sendmail-send-it
     "Function to call to send the current buffer as mail.
   The headers should be delimited by a line which is
   not a valid RFC822 header or continuation line,
--- 120,129 ----

   ;; Useful to set in site-init.el
   ;;;###autoload
! (defcustom send-mail-function
!   (if (memq system-type '(darwin windows-nt))
!       'mailclient-send-it
!     'sendmail-send-it)
     "Function to call to send the current buffer as mail.
   The headers should be delimited by a line which is
   not a valid RFC822 header or continuation line,
***************
*** 130,135 ****
--- 133,139 ----
     :type '(radio (function-item sendmail-send-it :tag "Use Sendmail  
package")
                 (function-item smtpmail-send-it :tag "Use SMTPmail  
package")
                 (function-item feedmail-send-it :tag "Use Feedmail  
package")
+               (function-item mailclient-send-it :tag "Use  
Mailclient package")
                 function)
     :group 'sendmail)


[-- Attachment #2: mailclient.el --]
[-- Type: application/octet-stream, Size: 4871 bytes --]

;;; mailclient.el --- mail sending via system's mail client.  -*- byte-compile-dynamic: t -*-

;; Copyright (C) 2005 Free Software Foundation

;; Maintainer: 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'.
;; To activate:
;; (setq send-mail-function 'mailclient-send-it) ; if you use `mail'

;;; Code:


(defvar mailclient-place-body-on-clipboard (fboundp 'w32-set-clipboard-data)
  "non-nil if mailclient is to put the e-mail body on the clipboard.
Defaults to non-nil on Windows because only short mailto URLs are supported 
there.")
  
(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 ?\n) "%0D%0A")  ;; new line
	    
	     ((string-match "[-a-zA-Z0-9_:/.@]" (char-to-string char))
	      (char-to-string char))   ;; characters
	     ((eq char ?\x20) "%20")   ;; space
	     (t ;; else
	      (format "%%%02x" char))))	; escape
	  ;; Convert string to list of chars
	  (append (encode-coding-string (or 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 delimline &optional drop-first-name)
  (let ((cc "")
	end) 
    (goto-char (point-min))
    ;; find all cc's
    (while
	(re-search-forward 
	 (format "^%s:[ ]*" (upcase-initials str)) delimline t)
      (let ((beg (point)))
	(re-search-forward "\n" delimline t)
	(setq end (point))
	(goto-char beg))
      (while 
	  (re-search-forward "[ ]*\\([^ ,\n]+\\)" end t) 
	(setq cc 
	      (concat cc  
		      (if (and drop-first-name
			       (= (length cc) 0))
			  ""
			  (concat (mailclient-url-delim) str "="))
		      (mailclient-encode-string-as-url 
		       (match-string 1))))))
    cc))

(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."
  (let ((case-fold-search nil)
	delimline
	(mailbuf (current-buffer))
	(tembuf (generate-new-buffer " mailclient temp")))
    (unwind-protect
	(save-excursion
	  (set-buffer tembuf)
	  (erase-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 "mailto:"
		     (mailclient-gather-addresses "to" delimline 
						  'drop-first-name)	         
		     (mailclient-gather-addresses "cc" delimline)
		     (mailclient-gather-addresses "bcc" delimline)
		     (mailclient-gather-addresses "reply-to" delimline)
		     ;; subject line
		     (if (and (goto-char (point-min))
			      (re-search-forward 
			       "^Subject:\s*\\([^\n]*[^ ]\\)\n" delimline t))
			 (concat (mailclient-url-delim) "subject=" 
				 (mailclient-encode-string-as-url 
				  (match-string 1)))
		       "")
		     ;; body
		     (concat (mailclient-url-delim) "body=" 
			      (mailclient-encode-string-as-url
			       (if mailclient-place-body-on-clipboard
				 (progn
				   (clipboard-kill-ring-save  
				    delimline (point-max))
				   "*** E-Mail body has been placed on clipboard, please paste them here! ***")
				 ;; else
				 (buffer-substring delimline (point-max)))))))))  
      (kill-buffer tembuf))))
 
(provide 'mailclient)


[-- Attachment #3: Type: text/plain, Size: 142 bytes --]

_______________________________________________
Emacs-devel mailing list
Emacs-devel@gnu.org
http://lists.gnu.org/mailman/listinfo/emacs-devel