cgit.sxemacs.org Git - packages/blob - xemacs-packages/mew/mew/contrib/mew-mailto.el

   1 ;;; -*- emacs-lisp -*-
   2 ;;;
   3 ;;; name: mew-mailto.el
   4 ;;; version: 0.6
   5 ;;; description: some mailto support for mew
   6 ;;; creation date: 1998-11-07
   7 ;;; author: "Sen Nagata" <sen@eccosys.com>
   8 ;;; warning: not optimized at all
   9
  10 ;;; required:
  11 ;;;
  12 ;;;   -mew (1.94 and up -- uses mew-user-agent-compose)
  13 ;;;   -rfc2368.el
  14 ;;;   -thingatpt.el (comes w/ emacs) for thing-at-pt
  15
  16 ;;; installation:
  17 ;;;
  18 ;;;   -put this file (and rfc2368.el) in an appropriate directory (so emacs
  19 ;;;    can find it)
  20 ;;;
  21 ;;;   <necessary>
  22 ;;;   -put:
  23 ;;;
  24 ;;;     (add-hook 'mew-init-hook (lambda () (require 'mew-mailto)))
  25 ;;;
  26 ;;;    in your .emacs file.
  27
  28 ;;; details:
  29 ;;;
  30 ;;;   this package provides a number of interactive functions
  31 ;;; (commands) for the user.  each of the commands ultimately creates a
  32 ;;; draft message based on some information.  the names of the commands
  33 ;;; and brief descriptions are:
  34 ;;;
  35 ;;;     1) mew-mailto-compose-message-from-mailto-url
  36 ;;;            make a draft message from a user-specified mailto: url
  37 ;;;
  38 ;;;     2) mew-mailto-compose-message-from-mailto-url-at-point
  39 ;;;            make a draft message from a mailto: url at point
  40
  41 ;;; usage:
  42 ;;;
  43 ;;;   -invoke mew
  44 ;;;   -try out the commands mentioned above in 'details'
  45
  46 ;;; History:
  47 ;;
  48 ;; 0.6
  49 ;;
  50 ;; 1999-07-30
  51 ;;
  52 ;;   fixed a bug in mew-mailto-compose-message-from-mailto-url that could
  53 ;;   lead to duplicate headers in messages
  54 ;;
  55 ;; 1999-06-01
  56 ;;
  57 ;;   added compatibility garbage for xemacs -- thingatpt.el vs browse-url.el
  58 ;;
  59 ;; 1999-05-31
  60 ;;
  61 ;;   rewrote to use rfc2368.el
  62 ;;   removed a lot of functionality
  63 ;;
  64 ;; 0.5
  65 ;;
  66 ;; 1999-05-04:
  67 ;;
  68 ;;   modified the interface to mew-mailto-compose-message-from-mailto-url
  69 ;; as suggested by Umekichi <umekichi@bu.iij4u.or.jp>.  see the interface
  70 ;; to browse-url-mail in browse-url.el for details.
  71
  72 ;; how should we handle the dependecy on mew?
  73 ;; doing the following seems to have catastrophic effects on my machine :-(
  74 ;(require 'mew)
  75
  76 ;; will this work?
  77 (eval-when-compile
  78   (require 'mew))
  79
  80 (defconst mew-mailto-version "mew-mailto.el 0.6")
  81
  82 ;; use rfc2368 support -- should be useable for things other than mew too
  83 (require 'rfc2368)
  84
  85 ;; yucky compatibility stuff...
  86 (if (and (string-match "^XEmacs \\([0-9.]+\\)" (emacs-version))
  87          (< (string-to-int (match-string 1 (emacs-version))) 21))
  88     ;; for xemacs versions less than 21, use browse-url.el
  89     (progn
  90       (require 'browse-url)
  91       (fset 'mew-mailto-url-at-point
  92             'browse-url-url-at-point))
  93   ;; for everything else, use thingatpt.el
  94   (progn
  95     (require 'thingatpt)
  96     (fset 'mew-mailto-url-at-point
  97           (lambda ()
  98             (thing-at-point 'url)))))
  99
 100 (defun mew-mailto-compose-message-from-mailto-url (url &optional dummy)
 101   "Compose a message from URL.  The optional second argument, DUMMY, exists
 102 to match the interface provided by browse-url-mail -- DUMMY does not do
 103 anything."
 104   (interactive "sURL: ")
 105   (if (string-match rfc2368-mailto-regexp url)
 106       (let* ((other-headers (rfc2368-parse-mailto-url url))
 107              ;; the reason i'm bothering to extract To and Subject is
 108              ;; because i want them to appear at reasonable places in
 109              ;; the headers (not in some random order) -- i'll need to
 110              ;; do the same for any other headers that work that way too...
 111              (to (cdr (assoc-ignore-case "to" other-headers)))
 112              (subject (cdr (assoc-ignore-case "subject" other-headers))))
 113
 114         ;; if these are not removed from other-headers, we will get duplicates
 115         (remove-alist 'other-headers "To")
 116         (remove-alist 'other-headers "Subject")
 117
 118         ;; mew doesn't handle specifying a message body via
 119         ;; mew-user-agent-compose yet -- rms said he would support
 120         ;; specifying a body via the compose-mail interface after
 121         ;; emacs 20.4 is released
 122         (mew-user-agent-compose to subject other-headers))
 123     (message "Not a mailto: url.")))
 124
 125 ;; prepare a message from a mailto: url at point
 126 (defun mew-mailto-compose-message-from-mailto-url-at-point ()
 127   "Compose a message from a mailto url found at point."
 128   (interactive)
 129   (let ((url (mew-mailto-url-at-point)))
 130     (if (string-match rfc2368-mailto-regexp url)
 131         (mew-mailto-compose-message-from-mailto-url url)
 132       ;; tell the user that we didn't find a mailto: url at point
 133       (message "No mailto: url detected at point."))))
 134
 135 ;; since this will be used via 'require'...
 136 (provide 'mew-mailto)
 137
 138 ;; end of mew-mailto.el