[Mew-dist 06633] sample implementation of rfc 2368 (mailto: url) support for mew
sen_ml at example.com
sen_ml at example.com
1998年 10月 5日 (月) 20:53:35 JST
hello-
i hacked up a rough implementation of rfc 2368 (mailto: url)
support for mew. the main user-oriented functionality at the moment is
the ability to compose messages from mailto: urls.
for example, given the following mailto: url,
mailto:mew-dist-ctl at example.com?body=subscribe%20name
for emacs20 (not for xemacs yet, sorry):
once a user places 'point' in or on the url, and invokes the
'mailto-mew-compose-message-from-url-at-point' command, a new draft
message is composed based on the contents of the url (of course the
user needs to install the package and mew should be running :-) ).
for xemacs (and emacs20):
user invokes 'mailto-mew-compose-message-from-url' w/ above mailto:
url as argument (copying and pasting is probably a good idea). a
new draft message is composed as explained above.
to use this, you will need mew, thingatpt.el (i think this comes w/
emacs -- not used for xemacs), string.el (from elib), and url.el (from
w3). (i hope to get rid of unnecessary dependencies or make them
optional in the future).
installation instructions (a matter of placing the file in the
appropriate place and adding a line to .emacs) and other details are
contained in the attached file.
please give it a try.
-------------- next part --------------
; mailto.el 0.3
; rfc 2368 support for mew
; required:
;
; -mew (tested for 1.93)
; -thingatpt.el (not used for xemacs)
; -string.el (from elib)
; -url.el (from w3)
; installation:
;
; -put this file in an appropriate directory (so emacs can find it)
; -put:
;
; (require 'mailto)
;
; in your .emacs file. (this is preliminary)
;
; usage:
;
; -start mew
;
; for emacs20 only:
;
; -move the emacs point into/onto a mailto: url
; -invoke the 'mailto-mew-compose-message-from-url-at-point' command
;
; for xemacs (or emacs20):
;
; -invoke the 'mailto-mew-compose-message-from-url' command and enter a
; mailto: url (copying and pasting is probably easiest)
; notes and todo:
;
; -support rfc 2369 (List-*: headers w/ url values)
; -support some kind of warning message for messages which should be
; be editted (e.g. subscribe messages requiring names). this isn't
; really possible in general (for a discussion, see section A.5 of rfc
; 2368)
; -try to remove dependencies on other packages (because the code
; reuse is small, etc.)
; from rfc 2368:
;
; mailtoURL = "mailto:" [ to ] [ headers ]
; to = #mailbox
; headers = "?" header *( "&" header )
; header = hname "=" hvalue
; hname = *urlc
; hvalue = *urlc
; "#mailbox" is as specified in RFC 822 [RFC822]. This means that it
; consists of zero or more comma-separated mail addresses, possibly
; including "phrase" and "comment" components. Note that all URL
; reserved characters in "to" must be encoded: in particular,
; parentheses, commas, and the percent sign ("%"), which commonly occur
; in the "mailbox" syntax.
; "hname" and "hvalue" are encodings of an RFC 822 header name and
; value, respectively. As with "to", all URL reserved characters must
; be encoded.
; The special hname "body" indicates that the associated hvalue is the
; body of the message. The "body" hname should contain the content for
; the first text/plain body part of the message. The mailto URL is
; primarily intended for generation of short text messages that are
; actually the content of automatic processing (such as "subscribe"
; messages for mailing lists), not general MIME bodies.
; Within mailto URLs, the characters "?", "=", "&" are reserved.
; Because the "&" (ampersand) character is reserved in HTML, any mailto
; URL which contains an ampersand must be spelled differently in HTML
; than in other contexts. A mailto URL which appears in an HTML
; document must use "&" instead of "&".
; Also note that it is legal to specify both "to" and an "hname" whose
; value is "to". That is,
; mailto:addr1%2C%20addr2
; is equivalent to
; mailto:?to=addr1%2C%20addr2
; is equivalent to
; mailto:addr1?to=addr2
; 8-bit characters in mailto URLs are forbidden. MIME encoded words (as
; defined in [RFC2047]) are permitted in header values, but not for any
; part of a "body" hname.
; using string-replace-match from string.el in elib
(require 'string)
; using url-unhex-string from url.el in w3
(require 'url)
; only an approximation...
; see rfc 1738
(defconst mailto-url-regexp
; "^\\([-a-zA-Z0-9+.]+:\\)\\([^?]*\\)\\?\\(.*\\)")
; isn't there a better way to achieve case insensitivity?
"^\\([mM][aA][iI][lL][tT][oO]:\\)\\([^?]*\\)\\(\\?\\(.*\\)\\)?")
; describes 'mailto:'
(defconst mailto-url-scheme-index 1)
; describes the portion of the url between 'mailto:' and '?'
; i'm going to call this part the 'prequery'
(defconst mailto-url-prequery-index 2)
; describes the portion of the url after '?'
; i'm going to call this part the 'query'
(defconst mailto-url-query-index 4)
; replace all occurences of "&" w/ "&"
(defun mailto-html-unescape-url (mailto-url)
(string-replace-match "&" mailto-url "&" t t))
; parse a mailto: url into parts and return an alist containing these
; components. returned alist looks something like:
;
; (("To:" . "mailinglist at example.com")
; ("Subject:" . "this is a subject")
; ("Body:" . "this is a body"))
;
; WARNING: the mailto: url is assumed NOT to have been taken from html --
; so it should have '&' and not '&'...
(defun mailto-parse-url (mailto-url)
(let (scheme prequery query mailto-alist)
(string-match mailto-url-regexp mailto-url)
; possibly replace all occurences of "&" w/ "&"...
;(setq mailto-url (mailto-html-unescape-url mailto-url))
; unnecessary
(setq scheme
(match-string mailto-url-scheme-index mailto-url))
; necessary :-)
; do we need to unhexify 'prequery'?
(setq prequery
(match-string mailto-url-prequery-index mailto-url))
(setq query
(match-string mailto-url-query-index mailto-url))
; build our mailto-alist if 'query' is non-empty
(if (not (null query))
(setq mailto-alist
(mapcar
(lambda (x)
; there's a better way
(let* ((temp-list (split-string x "="))
(header-name (car temp-list))
(header-value (cadr temp-list)))
; each element of our result looks something like:
;
; ("From:" . "god at example.com")
(cons
; capitalize and append colon to an unhexified header-name
(concat
(capitalize (url-unhex-string header-name))
":")
; unhexify header-value
(url-unhex-string header-value))))
(split-string query "&"))))
; if there is a 'prequery' portion, convert this part into the second
; form described on page 2 of rfc 2368:
;
; mailto:?to=addr1%2C%20addr2
;
; isn't it legal for this to be:
;
; mailto:?to=addr1,%20addr2
;
; ?
;
; actually, don't bother converting...but modify mailto-alist
; if necessary w.r.t. the "To:" cons cell
(if (not (string-equal "" prequery))
(progn
; if there's already a "To:" cons cell, modify the value
(if (assoc "To:" mailto-alist)
(let* ((our-cons-cell
(assoc "To:" mailto-alist))
(our-car ; unnecessary
(car our-cons-cell))
(our-cdr
(cdr our-cons-cell)))
(setcdr
our-cons-cell
(concat our-cdr ", " prequery)))
; there isn't a "To:" cons cell, so make one and add it
(setq mailto-alist
(cons
(cons "To:" prequery)
mailto-alist)))))
; the value we return...
mailto-alist))
; prepare a message given an alist w/ headers (and may be a body)
; [based on the 'mew-summary-send' function from mew-summary.el,
; and the 'mew-draft-header' function in mew-draft.el]
(defun mailto-mew-summary-send (mailto-alist)
"Write a message. A new draft is prepared in Draft mode."
(interactive)
(let ((file (mew-folder-new-message mew-draft-folder))
(find-file-hooks nil)
(inhibit-quit t)
(default-alist nil)
(body nil))
; default headers -- not overridden by mailto-alist
(setq default-alist
(list
(cons mew-from: mew-from)
(cons mew-fcc: mew-fcc)
(cons mew-reply-to: mew-reply-to)
(cons mew-x-mailer: mew-x-mailer)
(cons mew-mv: mew-mv:-num)
))
; code from the original 'mew-summary-send' function...
(mew-current-set 'window (current-window-configuration))
(mew-window-configure (current-buffer) 'draft)
(mew-summary-prepare-draft
(switch-to-buffer (find-file-noselect file))
(mew-draft-rename file)
; insert mailto headers (and possibly defaults...)
(mapcar
(lambda (x)
(let ((header-name (car x))
(header-value (cdr x)))
; skip if we've reached "Body:"...
(if (not (equal header-name "Body:"))
(progn
; is there a default?
(if (assoc header-name default-alist)
; there was a default, so use that instead
(setq header-value
(cdr
(assoc header-name default-alist))))
; insert header using header-name and header-value
(mew-header-insert-here header-name header-value)))))
mailto-alist)
; insert remaining default headers
(mapcar
(lambda (x)
(let ((header-name (car x))
(header-value (cdr x)))
(if (not (assoc header-name mailto-alist))
(mew-header-insert-here header-name header-value))))
default-alist)
; when the header is ready...does highlighting, adds ---, etc.
(mew-header-prepared)
; put the necessary body in (how do you do this properly?)
; isn't there something like mew-body-insert (cf. mew-header-insert)?
(if (assoc "Body:" mailto-alist)
(progn
(setq body
(cdr
(assoc "Body:" mailto-alist)))
(if (stringp body)
(progn
; should really be beginning of the message body
(goto-char (point-max))
(insert-before-markers body)))))
(goto-char (point-min))
(mew-draft-mode))))
; prepare a message from a mailto: url
(defun mailto-mew-compose-message-from-url (url)
(interactive "sURL: ")
(if (string-match mailto-url-regexp url)
(mailto-mew-summary-send (mailto-parse-url url))))
; straight from emu.el
(defvar running-xemacs (string-match "XEmacs" emacs-version))
; following won't work for xemacs...
; how do you do 'thing-at-point' stuff in xemacs?
(cond ((not running-xemacs)
; using thing-at-point from thingatpt.el
(require 'thingatpt)
; prepare a message from a mailto: url at point
(defun mailto-mew-compose-message-from-url-at-point ()
(interactive)
(let ((url (thing-at-point 'url)))
(mailto-mew-compose-message-from-url url)))
))
(provide 'mailto)
; unfinished
; not implemented yet
;(defun mailto-extract-urls-from-buffer ()
; )
; 'mailto-extract-urls-from-buffer' is not done yet
;(defun mailto-mew-compose-message-from-urls-in-buffer (url)
; (interactive
; (list
; (completing-read "URL: " (mailto-extract-urls-from-buffer) nil)))
; (mailto-mew-compose-message-from-url url))
Mew-dist メーリングリストの案内