cgit.sxemacs.org Git - slh/blob - mozmail.el

   1 ;; mozmail.el --- Open mailto links from Mozilla in an (X)Emacs mailer.
   2
   3 ;; Copyright (C) 2003,04,07 Steve Youngs
   4
   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.
  11 ;; Keywords:   mail
  12
  13 ;; This file is part of mozmail.
  14
  15 ;; Redistribution and use in source and binary forms, with or without
  16 ;; modification, are permitted provided that the following conditions
  17 ;; are met:
  18 ;;
  19 ;; 1. Redistributions of source code must retain the above copyright
  20 ;;    notice, this list of conditions and the following disclaimer.
  21 ;;
  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.
  25 ;;
  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.
  29 ;;
  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.
  41
  42 ;;; Commentary:
  43 ;;
  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.
  50 ;;
  51 ;; Setup (Mozilla):
  52 ;;
  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.
  56 ;;
  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
  60 ;;
  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).
  69 ;;
  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".
  73 ;;
  74 ;;   That's all you need to do on the Mozilla side of things.  Restarting
  75 ;;   Mozilla probably wouldn't be a bad idea.
  76 ;;
  77 ;; Setup (Shell Script):
  78 ;;
  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.
  82 ;;
  83 ;;      #!/bin/bash
  84 ;;      gnuclient -eval "(mozmail \"$1\")"
  85 ;;
  86 ;; Setup ((X)Emacs):
  87 ;;
  88 ;;   Add the following to your init file...
  89 ;;
  90 ;;   (gnuserv-start)
  91 ;;   (require 'mozmail)
  92 ;;
  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
  95 ;;   for details.
  96 ;;
  97 ;;   Gnus users can optionally customise `mozmail-gnus-is-plugged' to
  98 ;;   run Gnus in either "plugged" or "unplugged" modes.
  99 ;;
 100 ;; Alternative Setup for GNOME users:
 101 ;;
 102 ;;   I received some feedback from a user who had this to say about
 103 ;;   setting mozmail up with GNOME (on Debian):
 104 ;;
 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".
 111 ;;
 112 ;;   With this mozmail gets used by all Mozilla based browser on my
 113 ;;   system.
 114
 115 ;;; Todo:
 116 ;;
 117 ;;   o Can this be done without using gnuserv/gnuclient?
 118
 119 ;;; ChangeLog:
 120 ;;
 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.
 124 ;;
 125
 126 ;;; Code:
 127 (defconst mozmail-version 1.9
 128   "Mozmail version.")
 129
 130 (defun mozmail-version (&optional arg)
 131   "Return the current version info for mozmail.
 132
 133 With optional argument ARG, insert version info at point in the current
 134 buffer."
 135   (interactive "P")
 136   (let ((ver mozmail-version))
 137     (if (interactive-p)
 138         (if arg
 139             (insert (format "mozmail v%.1f" ver))
 140           (message "mozmail v%.1f" ver))
 141       ver)))
 142
 143 (eval-and-compile
 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))
 164
 165 (eval-when-compile
 166   (defalias 'mozmail-compose 'ignore))
 167
 168 (defun mozmail-commentary ()
 169   "*Display the commentary section of mozmail.el."
 170   (interactive)
 171   (with-electric-help
 172    '(lambda ()
 173       (insert
 174        (with-temp-buffer
 175          (erase-buffer)
 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*"))
 182
 183 (defun mozmail-copyright ()
 184   "*Display the copyright notice for mozmail."
 185   (interactive)
 186   (with-electric-help
 187    '(lambda ()
 188       (insert
 189        (with-temp-buffer
 190          (erase-buffer)
 191          (insert-file-contents (locate-library "mozmail.el"))
 192          (goto-char (point-min))
 193          (re-search-forward ";;; Commentary" nil t)
 194          (beginning-of-line)
 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*"))
 200
 201 (defgroup mozmail nil
 202   "Customisations for mozmail."
 203   :prefix "mozmail-"
 204   :group 'mail)
 205
 206 (defcustom mozmail-gnus-is-plugged t
 207   "*When non-nil use Gnus in \"plugged\" mode."
 208   :type 'boolean
 209   :group 'mozmail)
 210
 211 (defcustom mozmail-default-mua gnus
 212   "*The default \(X\)Emacs mailer to use.
 213
 214 Valid symbols are: gnus, vm, mhe, mew, wanderlust, rmail, emacs.
 215
 216 CAUTION: If you wish to set this variable outside of the custom
 217 interface, you MUST set it via `customize-set-variable'.
 218
 219 For example:
 220
 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))
 229   :require 'mozmail
 230   :initialize (lambda (symbol value)
 231                 (progn
 232                   (let ((gnus 'gnus)
 233                         (vm 'vm)
 234                         (mhe 'mhe)
 235                         (mew 'mew)
 236                         (wanderlust 'wanderlust)
 237                         (rmail 'rmail)
 238                         (emacs 'emacs))
 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)))
 247   :group 'mozmail)
 248
 249
 250 ;; Lifted verbatim from url.el, only the names have been changed to
 251 ;; protect the innocent.
 252 (defun mozmail-url-unhex (x)
 253   (if (> x ?9)
 254       (if (>= x ?a)
 255           (+ 10 (- x ?a))
 256         (+ 10 (- x ?A)))
 257     (- x ?0)))
 258
 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 ""))
 265   (let ((tmp "")
 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))))
 270              (code (+ (* 16 ch1)
 271                       (mozmail-url-unhex (elt str (+ start 2))))))
 272         (setq tmp (concat
 273                    tmp (substring str 0 start)
 274                    (cond
 275                     (allow-newlines
 276                      (char-to-string code))
 277                     ((or (= code ?\n) (= code ?\r))
 278                      " ")
 279                     (t (char-to-string code))))
 280               str (substring str (match-end 0)))))
 281     (setq tmp (concat tmp str))
 282     tmp))
 283
 284 (defun mozmail-compose-gnus (to &optional subject cc bcc body)
 285   "Compose a mail in Gnus from a Mozilla mailto link.
 286
 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
 292 mail."
 293   (unless (gnus-alive-p)
 294     (if mozmail-gnus-is-plugged
 295         (gnus)
 296       (gnus-unplugged)))
 297   (gnus-group-mail)
 298   (message-goto-to)
 299   (insert (mozmail-url-unhex-string to))
 300   (when subject
 301     (message-goto-subject)
 302     (insert (mozmail-url-unhex-string subject)))
 303   (when cc
 304     (message-goto-cc)
 305     (insert (mozmail-url-unhex-string cc)))
 306   (when bcc
 307     (message-goto-bcc)
 308     (insert (mozmail-url-unhex-string bcc)))
 309   (when body
 310     (message-goto-body)
 311     (insert (mozmail-url-unhex-string body 'allow-newlines))))
 312
 313 (defun mozmail-populate-headers (to &optional subject cc bcc body)
 314   "Populate the mail headers from a mailto link.
 315
 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
 321 mail."
 322   (mail-to)
 323   (insert (mozmail-url-unhex-string to))
 324   (when subject
 325     (mail-subject)
 326     (insert (mozmail-url-unhex-string subject)))
 327   (when cc
 328     (mail-cc)
 329     (insert (mozmail-url-unhex-string cc)))
 330   (when bcc
 331     (mail-bcc)
 332     (insert (mozmail-url-unhex-string bcc)))
 333   (when body
 334     (mail-text)
 335     (insert (mozmail-url-unhex-string body 'allow-newlines))))
 336
 337 (defun mozmail-compose-vm (to &optional subject cc bcc body)
 338   "Compose a mail in VM from a Mozilla mailto link.
 339
 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
 345 mail."
 346   (vm-mail)
 347   (mozmail-populate-headers to subject cc bcc body))
 348
 349 (defun mozmail-compose-mhe (to &optional subject cc bcc body)
 350   "Compose a mail in MH-E from a Mozilla mailto link.
 351
 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
 357 mail."
 358   (mh-smail)
 359   (mozmail-populate-headers to subject cc bcc body))
 360
 361 (defun mozmail-compose-mew (to &optional subject cc bcc body)
 362   "Compose a mail in MEW from a Mozilla mailto link.
 363
 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
 369 mail."
 370   (mew-send)
 371   (mozmail-populate-headers to subject cc bcc body))
 372
 373 (defun mozmail-compose-wanderlust (to &optional subject cc bcc body)
 374   "Compose a mail in Wanderlust from a Mozilla mailto link.
 375
 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
 381 mail."
 382   (wl-draft)
 383   (mozmail-populate-headers to subject cc bcc body))
 384
 385 (defun mozmail-compose-emacs (to &optional subject cc bcc body)
 386   "Compose a mail in Emacs from a Mozilla mailto link.
 387
 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
 393 mail."
 394   (mail)
 395   (mozmail-populate-headers to subject cc bcc body))
 396
 397 (defun mozmail-compose-rmail (to &optional subject cc bcc body)
 398   "Compose a mail in RMail from a Mozilla mailto link.
 399
 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
 405 mail."
 406   (rmail-mail)
 407   (mozmail-populate-headers to subject cc bcc body))
 408
 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)
 412       ;; XEmacs
 413       (split-string-by-char string char)
 414     ;; GNU/Emacs
 415     (split-string string (char-to-string char))))
 416
 417 (defun mozmail-split-url (url sym)
 418   "Split a mailto URL into its various components.
 419
 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',
 423 and `body'."
 424   (let ((value nil))
 425     (cond ((eq sym 'to)
 426            (setq value (substring (car (mozmail-split-string url ?\?)) 7)))
 427           ((eq sym 'subject)
 428            (setq url (cdr (mozmail-split-string url ?\?)))
 429            (when url
 430              (setq url (mozmail-split-string (car url) ?&))
 431              (while url
 432                (when (string= "subject=" (downcase (substring (car url) 0 8)))
 433                  (setq value (substring (car url) 8)))
 434                (setq url (cdr url)))))
 435           ((eq sym 'cc)
 436            (setq url (cdr (mozmail-split-string url ?\?)))
 437            (when url
 438              (setq url (mozmail-split-string (car url) ?&))
 439              (while url
 440                (when (string= "cc=" (downcase (substring (car url) 0 3)))
 441                  (setq value (substring (car url) 3)))
 442                (setq url (cdr url)))))
 443           ((eq sym 'bcc)
 444            (setq url (cdr (mozmail-split-string url ?\?)))
 445            (when url
 446              (setq url (mozmail-split-string (car url) ?&))
 447              (while url
 448                (when (string= "bcc=" (downcase (substring (car url) 0 4)))
 449                  (setq value (substring (car url) 4)))
 450                (setq url (cdr url)))))
 451           ((eq sym 'body)
 452            (setq url (cdr (mozmail-split-string url ?\?)))
 453            (when url
 454              (setq url (mozmail-split-string (car url) ?&))
 455              (while url
 456                (when (string= "body=" (downcase (substring (car url) 0 5)))
 457                  (setq value (substring (car url) 5)))
 458                (setq url (cdr url)))))
 459           (t
 460            (error 'invalid-argument sym)))
 461     value))
 462
 463 (defun mozmail (url)
 464   "Use an (X)Emacs MUA as the target of a Mozilla mailto link.
 465
 466 See `mozmail-commentary' for instructions on how to set this up in
 467 Mozilla."
 468   ;; A URL that consists of just "mailto:" and nothing else is obviously
 469   ;; wrong.
 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)))
 478
 479 (provide 'mozmail)
 480
 481 ;;; mozmail.el ends here
 482