1 ;; mozmail.el --- Open mailto links from Mozilla in an (X)Emacs mailer.
3 ;; Copyright (C) 2003,04,07 Steve Youngs
5 ;; Author: Steve Youngs <steve@youngs.au.com>
6 ;; Maintainer: Steve Youngs <steve@youngs.au.com>
7 ;; Time-stamp: <Tuesday Jan 30, 2007 14:28:11 steve>
8 ;; Created: <2003-12-22>
9 ;; Homepage: None, contact maintainer for the latest version.
10 ;; Or get it from the XEmacs "net-utils" package.
13 ;; This file is part of mozmail.
15 ;; Redistribution and use in source and binary forms, with or without
16 ;; modification, are permitted provided that the following conditions
19 ;; 1. Redistributions of source code must retain the above copyright
20 ;; notice, this list of conditions and the following disclaimer.
22 ;; 2. Redistributions in binary form must reproduce the above copyright
23 ;; notice, this list of conditions and the following disclaimer in the
24 ;; documentation and/or other materials provided with the distribution.
26 ;; 3. Neither the name of the author nor the names of any contributors
27 ;; may be used to endorse or promote products derived from this
28 ;; software without specific prior written permission.
30 ;; THIS SOFTWARE IS PROVIDED BY THE AUTHOR "AS IS" AND ANY EXPRESS OR
31 ;; IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED
32 ;; WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE
33 ;; DISCLAIMED. IN NO EVENT SHALL THE REGENTS OR CONTRIBUTORS BE LIABLE
34 ;; FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
35 ;; CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
36 ;; SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR
37 ;; BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY,
38 ;; WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE
39 ;; OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN
40 ;; IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
44 ;; Mozilla is a terrific web browser, but for mail and news I
45 ;; much prefer XEmacs & Gnus. Once this is set up, clicking on a
46 ;; mailto link in Mozilla will fire up an (X)Emacs MUA with all
47 ;; the appropriate fields filled in. MUAs that are supported at
48 ;; this time are: Gnus, VM, MH-E, MEW, Wanderlust, RMail, and the
49 ;; built-in Emacs mailer.
53 ;; To get this to work you will need a very recent version of Mozilla,
54 ;; I was using 1.6b when I wrote this. If you get `mozmail.el' to
55 ;; work with older versions of Mozilla, please let me know.
57 ;; The first thing you must do is tweak your Mozilla settings so
58 ;; mailto links will invoke an external process. Fire up Mozilla,
59 ;; and in the location bar type: about:config
61 ;; That will give you a list of all of your settings. There are
62 ;; litterally hundreds of them so prune them down by typing
63 ;; "protocol-handler" in the filter bar. Now right-click on one of
64 ;; the items in the list and choose "New -> Boolean". In the
65 ;; resulting dialog, type:
66 ;; "network.protocol-handler.external.mailto" (sans quotes).
67 ;; Another dialog will appear prompting for a value for this new
68 ;; variable, enter "true" (sans quotes).
70 ;; Next, add another variable: right-click on a list item and choose "New
71 ;; -> String", in the dialog put: "network.protocol-handler.app.mailto".
72 ;; In the value dialog for this variable, put: "mozmail.sh".
74 ;; That's all you need to do on the Mozilla side of things. Restarting
75 ;; Mozilla probably wouldn't be a bad idea.
77 ;; Setup (Shell Script):
79 ;; You will also need a very small (2 line) wrapper script. Copy
80 ;; the following text to `mozmail.sh', put it somewhere in your
81 ;; $PATH and make it executable.
84 ;; gnuclient -eval "(mozmail \"$1\")"
88 ;; Add the following to your init file...
93 ;; People who use MUA's other than Gnus will need to customise the
94 ;; variable `mozmail-default-mua'. See that variable's doc string
97 ;; Gnus users can optionally customise `mozmail-gnus-is-plugged' to
98 ;; run Gnus in either "plugged" or "unplugged" modes.
100 ;; Alternative Setup for GNOME users:
102 ;; I received some feedback from a user who had this to say about
103 ;; setting mozmail up with GNOME (on Debian):
105 ;; Here's different way to enable it for GNOME users (at least on
106 ;; Debian). Instead of modifying Mozilla's preferences just run
107 ;; gnome-default-applications-properties (see the
108 ;; Applications/Desktop Preferences/Advanced/Preferred Applications
109 ;; menu entry), on the "Mail Reader" tab select "Custom Mail Reader"
110 ;; and enter "mozmail.sh %s".
112 ;; With this mozmail gets used by all Mozilla based browser on my
117 ;; o Can this be done without using gnuserv/gnuclient?
121 ;; From this point on, `mozmail.el' is in the XEmacs packages CVS
122 ;; repository. For further changes please consult
123 ;; ./xemacs-packages/net-utils/ChangeLog.
127 (defconst mozmail-version 1.9
130 (defun mozmail-version (&optional arg)
131 "Return the current version info for mozmail.
133 With optional argument ARG, insert version info at point in the current
136 (let ((ver mozmail-version))
139 (insert (format "mozmail v%.1f" ver))
140 (message "mozmail v%.1f" ver))
144 (autoload 'with-electric-help "ehelp")
145 (autoload 'gnus-alive-p "gnus-util")
146 (autoload 'gnus-group-mail "gnus-msg" nil t)
147 (autoload 'message-goto-to "message" nil t)
148 (autoload 'message-goto-subject "message" nil t)
149 (autoload 'message-goto-cc "message" nil t)
150 (autoload 'message-goto-bcc "message" nil t)
151 (autoload 'message-goto-body "message" nil t)
152 (autoload 'gnus "gnus" nil t)
153 (autoload 'vm-mail "vm-startup" nil t)
154 (autoload 'mew-send "mew" nil t)
155 (autoload 'wl-draft "wl-draft" nil t)
156 (autoload 'mh-smail "mh-comp" nil t)
157 (autoload 'rmail-mail "rmail" nil t)
158 (autoload 'mail-to "sendmail" nil t)
159 (autoload 'mail-cc "sendmail" nil t)
160 (autoload 'mail-bcc "sendmail" nil t)
161 (autoload 'mail-subject "sendmail" nil t)
162 (autoload 'mail-text "sendmail" nil t)
163 (autoload 'lm-commentary "lisp-mnt" nil t))
166 (defalias 'mozmail-compose 'ignore))
168 (defun mozmail-commentary ()
169 "*Display the commentary section of mozmail.el."
176 (insert (lm-commentary (locate-library "mozmail.el")))
177 (goto-char (point-min))
178 (while (re-search-forward "^;+ ?" nil t)
179 (replace-match "" nil nil))
180 (buffer-string (current-buffer)))))
181 "*Mozmail Commentary*"))
183 (defun mozmail-copyright ()
184 "*Display the copyright notice for mozmail."
191 (insert-file-contents (locate-library "mozmail.el"))
192 (goto-char (point-min))
193 (re-search-forward ";;; Commentary" nil t)
195 (narrow-to-region (point-min) (point))
196 (while (re-search-backward "^;+ ?" nil t)
197 (replace-match "" nil nil))
198 (buffer-string (current-buffer)))))
199 "*Mozmail Copyright Notice*"))
201 (defgroup mozmail nil
202 "Customisations for mozmail."
206 (defcustom mozmail-gnus-is-plugged t
207 "*When non-nil use Gnus in \"plugged\" mode."
211 (defcustom mozmail-default-mua gnus
212 "*The default \(X\)Emacs mailer to use.
214 Valid symbols are: gnus, vm, mhe, mew, wanderlust, rmail, emacs.
216 CAUTION: If you wish to set this variable outside of the custom
217 interface, you MUST set it via `customize-set-variable'.
221 \(customize-set-variable 'mozmail-default-mua 'gnus\)"
222 :type '(choice (const :tag "Gnus" :value gnus)
223 (const :tag "VM" :value vm)
224 (const :tag "MH-E" :value mhe)
225 (const :tag "MEW" :value mew)
226 (const :tag "Wanderlust" :value wanderlust)
227 (const :tag "RMail" :value rmail)
228 (const :tag "Emacs Mail" :value emacs))
230 :initialize (lambda (symbol value)
236 (wanderlust 'wanderlust)
239 (custom-initialize-default symbol value)
240 (defalias 'mozmail-compose
241 (intern (format "mozmail-compose-%s" value)))))
242 (message (format "%s set to %s" symbol value)))
243 :set (lambda (symbol value)
244 (defalias 'mozmail-compose
245 (intern (format "mozmail-compose-%s" value)))
246 (message (format "%s set to %s" symbol value)))
250 ;; Lifted verbatim from url.el, only the names have been changed to
251 ;; protect the innocent.
252 (defun mozmail-url-unhex (x)
259 (defun mozmail-url-unhex-string (str &optional allow-newlines)
260 "Remove %XXX embedded spaces, etc in a url.
261 If optional second argument ALLOW-NEWLINES is non-nil, then allow the
262 decoding of carriage returns and line feeds in the string, which is normally
263 forbidden in URL encoding."
264 (setq str (or str ""))
266 (case-fold-search t))
267 (while (string-match "%[0-9a-f][0-9a-f]" str)
268 (let* ((start (match-beginning 0))
269 (ch1 (mozmail-url-unhex (elt str (+ start 1))))
271 (mozmail-url-unhex (elt str (+ start 2))))))
273 tmp (substring str 0 start)
276 (char-to-string code))
277 ((or (= code ?\n) (= code ?\r))
279 (t (char-to-string code))))
280 str (substring str (match-end 0)))))
281 (setq tmp (concat tmp str))
284 (defun mozmail-compose-gnus (to &optional subject cc bcc body)
285 "Compose a mail in Gnus from a Mozilla mailto link.
287 Argument TO is the receipient of the mail.
288 Optional argument SUBJECT is the mail's subject.
289 Optional argument CC - carbon copy.
290 Optional argument BCC - blind carbon copy.
291 Optional argument BODY - text that will appear in the body of the
293 (unless (gnus-alive-p)
294 (if mozmail-gnus-is-plugged
299 (insert (mozmail-url-unhex-string to))
301 (message-goto-subject)
302 (insert (mozmail-url-unhex-string subject)))
305 (insert (mozmail-url-unhex-string cc)))
308 (insert (mozmail-url-unhex-string bcc)))
311 (insert (mozmail-url-unhex-string body 'allow-newlines))))
313 (defun mozmail-populate-headers (to &optional subject cc bcc body)
314 "Populate the mail headers from a mailto link.
316 Argument TO is the receipient of the mail.
317 Optional argument SUBJECT is the mail's subject.
318 Optional argument CC - carbon copy.
319 Optional argument BCC - blind carbon copy.
320 Optional argument BODY - text that will appear in the body of the
323 (insert (mozmail-url-unhex-string to))
326 (insert (mozmail-url-unhex-string subject)))
329 (insert (mozmail-url-unhex-string cc)))
332 (insert (mozmail-url-unhex-string bcc)))
335 (insert (mozmail-url-unhex-string body 'allow-newlines))))
337 (defun mozmail-compose-vm (to &optional subject cc bcc body)
338 "Compose a mail in VM from a Mozilla mailto link.
340 Argument TO is the receipient of the mail.
341 Optional argument SUBJECT is the mail's subject.
342 Optional argument CC - carbon copy.
343 Optional argument BCC - blind carbon copy.
344 Optional argument BODY - text that will appear in the body of the
347 (mozmail-populate-headers to subject cc bcc body))
349 (defun mozmail-compose-mhe (to &optional subject cc bcc body)
350 "Compose a mail in MH-E from a Mozilla mailto link.
352 Argument TO is the receipient of the mail.
353 Optional argument SUBJECT is the mail's subject.
354 Optional argument CC - carbon copy.
355 Optional argument BCC - blind carbon copy.
356 Optional argument BODY - text that will appear in the body of the
359 (mozmail-populate-headers to subject cc bcc body))
361 (defun mozmail-compose-mew (to &optional subject cc bcc body)
362 "Compose a mail in MEW from a Mozilla mailto link.
364 Argument TO is the receipient of the mail.
365 Optional argument SUBJECT is the mail's subject.
366 Optional argument CC - carbon copy.
367 Optional argument BCC - blind carbon copy.
368 Optional argument BODY - text that will appear in the body of the
371 (mozmail-populate-headers to subject cc bcc body))
373 (defun mozmail-compose-wanderlust (to &optional subject cc bcc body)
374 "Compose a mail in Wanderlust from a Mozilla mailto link.
376 Argument TO is the receipient of the mail.
377 Optional argument SUBJECT is the mail's subject.
378 Optional argument CC - carbon copy.
379 Optional argument BCC - blind carbon copy.
380 Optional argument BODY - text that will appear in the body of the
383 (mozmail-populate-headers to subject cc bcc body))
385 (defun mozmail-compose-emacs (to &optional subject cc bcc body)
386 "Compose a mail in Emacs from a Mozilla mailto link.
388 Argument TO is the receipient of the mail.
389 Optional argument SUBJECT is the mail's subject.
390 Optional argument CC - carbon copy.
391 Optional argument BCC - blind carbon copy.
392 Optional argument BODY - text that will appear in the body of the
395 (mozmail-populate-headers to subject cc bcc body))
397 (defun mozmail-compose-rmail (to &optional subject cc bcc body)
398 "Compose a mail in RMail from a Mozilla mailto link.
400 Argument TO is the receipient of the mail.
401 Optional argument SUBJECT is the mail's subject.
402 Optional argument CC - carbon copy.
403 Optional argument BCC - blind carbon copy.
404 Optional argument BODY - text that will appear in the body of the
407 (mozmail-populate-headers to subject cc bcc body))
409 (defun mozmail-split-string (string char)
410 "Does `split-string-by-char' in XEmacs and `split-string' in GNU/Emacs."
411 (if (featurep 'xemacs)
413 (split-string-by-char string char)
415 (split-string string (char-to-string char))))
417 (defun mozmail-split-url (url sym)
418 "Split a mailto URL into its various components.
420 Argument URL is a mailto URL.
421 Argument SYM is a symbol representing the field name that you
422 want a value for. Valid symbols are: `to', `subject', `cc', `bcc',
426 (setq value (substring (car (mozmail-split-string url ?\?)) 7)))
428 (setq url (cdr (mozmail-split-string url ?\?)))
430 (setq url (mozmail-split-string (car url) ?&))
432 (when (string= "subject=" (downcase (substring (car url) 0 8)))
433 (setq value (substring (car url) 8)))
434 (setq url (cdr url)))))
436 (setq url (cdr (mozmail-split-string url ?\?)))
438 (setq url (mozmail-split-string (car url) ?&))
440 (when (string= "cc=" (downcase (substring (car url) 0 3)))
441 (setq value (substring (car url) 3)))
442 (setq url (cdr url)))))
444 (setq url (cdr (mozmail-split-string url ?\?)))
446 (setq url (mozmail-split-string (car url) ?&))
448 (when (string= "bcc=" (downcase (substring (car url) 0 4)))
449 (setq value (substring (car url) 4)))
450 (setq url (cdr url)))))
452 (setq url (cdr (mozmail-split-string url ?\?)))
454 (setq url (mozmail-split-string (car url) ?&))
456 (when (string= "body=" (downcase (substring (car url) 0 5)))
457 (setq value (substring (car url) 5)))
458 (setq url (cdr url)))))
460 (error 'invalid-argument sym)))
464 "Use an (X)Emacs MUA as the target of a Mozilla mailto link.
466 See `mozmail-commentary' for instructions on how to set this up in
468 ;; A URL that consists of just "mailto:" and nothing else is obviously
470 (when (string= (substring url 7) "")
471 (error 'invalid-argument url))
472 (let ((to (mozmail-split-url url 'to))
473 (subject (mozmail-split-url url 'subject))
474 (cc (mozmail-split-url url 'cc))
475 (bcc (mozmail-split-url url 'bcc))
476 (body (mozmail-split-url url 'body)))
477 (mozmail-compose to subject cc bcc body)))
481 ;;; mozmail.el ends here