[Mew-dist 07021] announcement: mailto.el, mew-mailto.el, mew-ml.el
sen_ml at example.com
sen_ml at example.com
1998年 12月 2日 (水) 19:56:45 JST
hello-
this is an announcement of a reworking of mailto.el, plus some additional
functionality. there are now three files:
mailto.el - this is an elisp package that provides some rudimentary
support for rfc 2368 type mailto urls -- i have tried to make
this independent of mew (it should be).
mew-mailto.el - this consists of functions for mew which use the mailto.el
package. you can create draft messages in mew based on
rfc 2368 type mailto urls.
mew-ml.el - this consists of functions for creating messages for
interfacing with mailing lists (subscription, help, etc.)
based on rfc 2369 type headers.
instructions for installation are included in each file. i've tried to
make functionality available through mew menus, but i am not sure i have done
this appropriately. [these packages have received limited testing, and
can surely be improved.]
thanks for your attention.
-------------- next part --------------
;; -*- emacs-lisp -*-
;;
;; name: mailto.el
;; version: 0.7
;; description: some support for rfc 2368 (mailto: urls)
;; creation date: 1998-11-07
;; author: "Sen Nagata" <sen at example.com>
;; warning: not optimized at all
;; required:
;;
;; -browse-url.el (i think this comes w/ emacs)
;; -string.el (from elib) -- this should not be necessary any more
;; installation:
;;
;; -place this file in a place where emacs can find it (emacs loadpath)
;; notes and todo:
;;
;; -try to remove dependencies on other packages (because the code
;; reuse is small, etc.)
;; -i've used this code w/ emacs versions >= 20.3
;; 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.
(defconst mailto-version "mailto.el 0.7")
;; it would be nice to have a function which could do the equivalent of
;; perl's /e...so i wrote a limited version. see
;; 'string-replace-match-using-function'
;; not using string-replace-match from string.el from elib
;(require 'string)
;; we could use 'url-unhex-string' from url.el in w3, but i don't want
;; to force people to get w3 to use this...
(fset 'mailto-unhexify-string 'my-unhexify-string)
;; uses 'browse-url', but this is loaded autmatically?
;; i need to perform this 'require' explicity, because if i don't,
;; 'browse-url-url-at-point' doesn't seem to get defined if emacs is
;; running in terminal mode
(require 'browse-url)
;; removing explicit dependencies on browse-url in code that uses mailto.el
(fset 'mailto-url-at-point 'browse-url-url-at-point)
;; only an approximation...
;; see rfc 1738
(defconst mailto-url-regexp
; "^\\([-a-zA-Z0-9+.]+:\\)\\([^?]*\\)\\?\\(.*\\)")
; isn't there a better way to achieve case insensitivity?
; need a better regexp...could we set 'case-fold-search' in
; functions that use this regular expression?
; "^\\([mM][aA][iI][lL][tT][oO]:\\)\\([^?]*\\)\\(\\?\\(.*\\)\\)?")
"\\([mM][aA][iI][lL][tT][oO]:\\)\\([^?]*\\)\\(\\?\\(.*\\)\\)?")
; "\\([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/ "&"
;; warning: haven't tested this lately
(defun mailto-html-unescape-url (mailto-url)
; (string-replace-match "&" mailto-url "&" t t))
;; much slower but independent of string.el
(string-replace-match-using-function
"&"
mailto-url
(lambda (x) ("&"))
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 (mailto-unhexify-string header-name))
":")
;; unhexify header-value
(mailto-unhexify-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
;; we need to do more if the 'prequery' portion is not empty
(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))
(defun mailto-extract-mailto-urls-from-string (string)
"Extract mailto: urls from a string, STRING.
STRING may contain multiple mailto: urls. The results are returned
as a list. If there are no mailto: urls, nil is returned."
(string-match-global "mailto:[^>]+" string t)
)
;; what i want is something like m//g in perl...
(defun string-match-global (regexp string &optional case-insensitive)
"Extract strings in STRING which match REGEXP.
The result is returned as a list of the matched strings. If there were
no matches, nil is returned.
Optional arg CASE-INSENSTIVE toggles whether the search is case-insensitive.
By default, the search is case-sensitive."
(let ((case-fold-search case-insensitive)
(string-length (length string))
(current-position 0)
(strings-list nil))
(while (< current-position string-length)
(if (setq current-position
(string-match regexp string current-position))
(progn
;; keep track of each match
(setq strings-list
(cons (substring string
(match-beginning 0)
(match-end 0))
strings-list))
;; prepare to search rest of string
(setq current-position (match-end 0)))
;; there were no more matches, so make the loop end
;; by making things so that the loop condition fails
(setq current-position string-length)))
;; our result
strings-list
))
;; i'll make a better version some time...
;; want to be able to hand my-func multiple arguments, may be...
;; perhaps we can use '&rest args'...
(defun string-replace-match-using-function
(regexp string func &optional global)
"Replace match of REGEXP in STRING with result of evaluating FUNC.
If not match is found, string should be returned as is.
Optional arg GLOBAL means to replace all matches instead of only the first."
(let ((result-string "")
(case-fold-search t))
;; look for every occurence?
(if global
(let ((last-position 0)
(current-position 0)
(string-length (length string)))
;; ugly? may be...
(while (< current-position string-length)
(if (setq current-position
(string-match regexp string current-position))
;; there was a match, so append pre-match portion and
;; transformed match portion
(progn
;; work on building result-string
(setq result-string
(concat result-string
;; what didn't match which came before the
;; match and after the last match (if any)
(substring string
last-position
current-position)
;; transform what matched...
(funcall func
(substring string
(match-beginning 0)
(match-end 0)))))
;; update where we are looking in the string
(setq current-position (match-end 0))
(setq last-position current-position))
;; there was no match, so append the rest of the string to
;; result-string
(progn
;; finish building result-string
(setq result-string
(concat result-string
(substring string
last-position)))
;; do this to fall out of the loop -- should be a better way
(setq current-position string-length))
)))
;; not global -- only do things once
(if (not (string-match regexp string 0))
(setq result-string string)
(setq result-string
(concat (substring string 0 (match-beginning 0))
(funcall func
(substring string
(match-beginning 0)
(match-end 0)))
(substring string (match-end 0))))))
;; our result :-)
result-string)
)
;; warning: no uppercase letters -- perhaps i should do something about that...
(defun hex-to-dec (hex-digit)
"Convert a hex digit [0-9a-f] to decimal."
(if (>= hex-digit ?a)
(+ (- hex-digit ?a) 10)
(- hex-digit ?0)))
;; convert from a hex byte string (e.g. '20') to a string of one character
;; (e.g. '20' -> ' ')
(defun hex-byte-string-to-char-string (hex-byte-string)
;; convert to a string of one character
(char-to-string
;; add the converted byte values together
(+
;; convert the right/low byte
(hex-to-dec
(string-to-char (substring hex-byte-string 1 2)))
;; convert the left/high byte
(* 16
(hex-to-dec
(string-to-char (substring hex-byte-string 0 1)))))))
;; takes a string like %20 and returns the corresponding ascii character
;; should just place a lambda version of this in my-unhexify-string...
(defun our-func (string)
(hex-byte-string-to-char-string
(substring string 1 3)))
;; just to remove the w3 dependency...
(defun my-unhexify-string (hex-string)
(string-replace-match-using-function
"%\\([0-9a-f][0-9a-f]\\)" hex-string 'our-func t))
(provide 'mailto)
; test
;(string-replace-match-using-function "%\\([0-9a-f][0-9a-f]\\)"
; "%20hithere%20"
; 'our-func
; nil
; nil)
; elib candidate
; (defun string-replace-match-using-function (regexp string func &optional global)
; "Replace match of REGEXP in STRING using the result of evaluating FUNC on the matched string.
; If no match is found, nil is returned instead of the new string.
; Optional arg GLOBAL means to replace all matches instead of only the first."
; (let ((data (match-data)))
; (unwind-protect
; (if global
; (let ((result "")
; (start 0)
; matchbeginning
; matchend)
; (while (string-match regexp string start)
; (setq matchbeginning (match-beginning 0)
; matchend (match-end 0)
; result (concat result
; (substring string start matchbeginning)
; (funcall func
; (substring string
; (match-beginning 0)
; (match-end 0))))
; start matchend))
; (if matchbeginning ; matched at least once
; (concat result (substring string start))
; nil))
; ;; not GLOBAL
; (if (not (string-match regexp string 0))
; nil
; (concat (substring string 0 (match-beginning 0))
; (funcall func
; (substring string
; (match-beginning 0)
; (match-end 0)))
; (substring string (match-end 0)))))
; (store-match-data data))))
; test
;(string-replace-match-using-function
; "%\\([0-9a-f][0-9a-f]\\)"
; "mailto:majordomo at example.com?body=unsubscribe%20scwm-discuss"
; 'our-func
; t)
; (defun string-replace-match-using-function
; (regexp string func &optional global args)
; "Replace match of REGEXP in STRING using the result of evaluating FUNC on the matched string.
; If no match is found, nil is returned instead of the new string.
; Optional arg GLOBAL means to replace all matches instead of only the first.
; Optional arg ARGS is a list of indeces of subexpressions of REGEXP -- the
; intended use is to construct a list of arguments (the matching substrings)
; to pass to FUNC."
; (let ((data (match-data)))
; ; if 'args' was not specified, set it to a list containing 0 --
; ; this means use the whole matched string as an argument to 'func'
; (if (not args)
; (setq args (list 0)))
; (unwind-protect
; ;; find all matches
; (if global
; (let ((result "")
; (start 0)
; matchbeginning
; matchend
; func-args)
; ; while there are matches...
; (while (string-match regexp string start)
; (progn
; (setq matchbeginning (match-beginning 0)
; matchend (match-end 0)
; ; compute arguments to 'func'
; func-args (mapcar
; (lambda (index)
; (substring string
; (match-beginning index)
; (match-end index)))
; args)
; ; compute the resulting string
; result (concat
; result
; (substring string start matchbeginning)
; ; compute the replacement text
; (apply func func-args))
; start matchend)))
; (if matchbeginning ; matched at least once
; (concat result (substring string start))
; nil))
; ;; not GLOBAL
; (if (not (string-match regexp string 0))
; nil
; (let (func-args)
; ; compute arguments to 'func'
; (setq func-args (mapcar
; (lambda (index)
; (substring string
; (match-beginning index)
; (match-end index)))
; args))
; ; compute the resulting string
; (concat (substring string 0 (match-beginning 0))
; ; compute the replacement text
; (apply func func-args)
; (substring string (match-end 0)))))
; (store-match-data data)))))
; tests
; (string-replace-match-using-function
; "%\\([0-9a-f][0-9a-f]\\)"
; "mailto:majordomo at example.com?body=unsubscribe%20scwm-discuss"
; 'our-func
; t
; '(0))
; (string-replace-match-using-function
; "%\\([0-9a-f][0-9a-f]\\)"
; "mailto:majordomo at example.com?body=unsubscribe%20scwm-discuss"
; 'hex-byte-string-to-char-string
; t
; '(1))
-------------- next part --------------
;; -*- emacs-lisp -*-
;;
;; name: mew-mailto.el
;; version: 0.3
;; description: some mailto support for mew
;; creation date: 1998-11-07
;; author: "Sen Nagata" <sen at example.com>
;; warning: not optimized at all
;; required:
;;
;; -mew (tested for 1.93)
;; -mailto.el (should come w/ mew-mailto.el)
;; installation:
;;
;; -put this file (and mailto.el) in an appropriate directory (so emacs
;; can find it)
;;
;; <necessary>
;; -put:
;;
;; (add-hook 'mew-init-hook (lambda () (require 'mew-mailto)))
;;
;; in your .emacs file.
;;
;; <optional>
;; -put:
;;
;; (defvar mew-mailto-menu-spec
;; '("Mailto"
;; ["Compose msg from mailto URL in message"
;; mew-mailto-compose-message-from-mailto-url-in-message t]
;; ))
;;
;; (add-hook
;; 'mew-summary-mode-hook
;; (lambda ()
;; (setq mew-summary-mode-menu-spec
;; (nconc mew-summary-mode-menu-spec
;; (list "----"
;; mew-mailto-menu-spec)))
;; ;; got this section from mew-summary.el
;; (easy-menu-define
;; mew-summary-mode-menu
;; mew-summary-mode-map
;; "Menu used in Summary mode."
;; mew-summary-mode-menu-spec)))
;;
;; in your .emacs.
;;
;; <optional>
;; -for enhancing the menu for message mode, put:
;;
;; (defvar mew-mailto-message-menu-spec
;; '("Mailto"
;; ["Compose msg from mailto URL"
;; mew-mailto-compose-message-from-mailto-url t]
;; ["Compose msg from mailto URL at point"
;; mew-mailto-compose-message-from-mailto-url-at-point t]
;; ))
;;
;; (add-hook
;; 'mew-message-mode-hook
;; (lambda ()
;; (setq mew-message-mode-menu-spec
;; (nconc mew-message-mode-menu-spec
;; (list "----"
;; mew-mailto-message-menu-spec)))
;; ;; got this section from 'mew-message.el'
;; (if mew-temacs-p
;; (easy-menu-define
;; mew-message-mode-menu
;; mew-message-mode-map
;; "Menu used in Message mode."
;; mew-message-mode-menu-spec))))
;;
;; in your .emacs.
;; details:
;;
;; this package provides a number of interactive functions
;; (commands) for the user. each of the commands ultimately creates a
;; draft message based on some information. the names of the commands
;; and brief descriptions are:
;;
;; 1) mew-mailto-compose-message-from-mailto-url
;; make a draft message from a user-specified mailto: url
;;
;; 2) mew-mailto-compose-message-from-mailto-url-at-point
;; make a draft message from a mailto: url at point
;;
;; 3) mew-mailto-compose-message-from-mailto-url-in-message
;; extract mailto: urls from message, have user choose one
;; particular mailto: url, and then draft a message from the
;; chosen url
;;
;; note: i don't use xemacs that often so i don't test it as much.
;; usage:
;;
;; -invoke mew
;; -try out the commands mentioned above in 'details'
;; -you can also try the commands via menu items now
;; notes and todo:
;;
;; -see TODO items in code
;; -place the menu and keybinding 'hook' stuff mentioned above into a
;; separate file and suggest that the user 'require'/'load' this via
;; their .emacs file? another possibility is just to set up our own
;; menus...seems kind of ugly though.
;; -keybindings and menu items -> is there a good way to modify the
;; existing menus for mew? (is that a bad idea?)
;; -i've used this code w/ emacs versions >= 20.3
;; -test w/ xemacs -- not at all sure of the menu and keybinding stuff
;; -prepare a test suite...
;; how should we handle the dependecy on mew?
;; doing the following seems to have catastrophic effects on my machine :-(
;(require 'mew)
;; will this work?
(eval-when-compile
(require 'mew))
(defconst mew-mailto-version "mew-mailto.el 0.3")
;; use mailto support -- should be useable for things other than mew too
(require 'mailto)
;; 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 mew-mailto-summary-send (mailto-alist)
"Write a message. A new draft is prepared in Draft mode."
;; does this need to be interactive?
;(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
;; this part could probably use some improvement...
(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 mew-mailto-compose-message-from-mailto-url (url)
(interactive "sURL: ")
(if (string-match mailto-url-regexp url)
(mew-mailto-summary-send (mailto-parse-url url))
;; tell the user that we don't think we received a mailto: url.
(message "Not a mailto: url.")))
;; prepare a message from a mailto: url at point
(defun mew-mailto-compose-message-from-mailto-url-at-point ()
(interactive)
(let ((url (mailto-url-at-point)))
(if (string-match mailto-url-regexp url)
(mew-mailto-compose-message-from-mailto-url url)
;; tell the user that we didn't find a mailto: url at point
(message "No mailto: url detected at point."))))
;; builds a table (alist) of mailto urls, extracting them from the current
;; message. the table should be suitable for use w/ completing-read.
;; [need thingatpt for this]
(defun mew-mailto-build-mailto-url-table-from-message ()
(let* ((fld (mew-summary-folder-name))
(msg (mew-summary-message-number))
;; found something like this in mew-summary-display-message
(my-filename (mew-expand-folder fld msg))
;; value for the moment...a hack
(url-list '(("mailto:?to=&subject=" . "")))
(temp-buffer-name nil))
(save-excursion
(setq temp-buffer-name (generate-new-buffer-name "*mew-mailto-work*"))
(generate-new-buffer temp-buffer-name)
(set-buffer temp-buffer-name)
(insert-file-contents my-filename)
;; could be improved -- should make the regular expression a const?
(while (search-forward-regexp
;; could we just use mailto-url-regexp here?
"\\([mM][aA][iI][lL][tT][oO]:\\)" nil t)
(progn
(setq url-list
(cons
(cons (mailto-url-at-point) "")
url-list))
))
;; this makes it so that one can't peek at the contents of the
;; buffer before it gets killed -- if we don't do this, the
;; contents of the buffer are available to functions via
;; 'kill-buffer-hook'
(erase-buffer)
(kill-buffer temp-buffer-name))
;; we want to return this
url-list
))
;; compose a message from a user-specified mailto: url.
;; the user chooses the mailto: url from a selection prepared by
;; extracting urls from a message
;;
;; note: figure out a way to provide this functionality from when
;; point is in the buffer containing the message -- this version
;; only works if point is in the summary buffer -> TODO
(defun mew-mailto-compose-message-from-mailto-url-in-message (url)
(interactive
(list
(completing-read
"Choose: "
(mew-mailto-build-mailto-url-table-from-message)
nil
nil
"mailto:")))
(mew-mailto-compose-message-from-mailto-url url))
;; idea:
;;
;; given a header name:
;;
;; -search through headers in a message for this header line,
;; -extract mailto: urls from the header value
;; -if there are multiple mailto: urls, get the user to choose one
;; -compose a draft message from the chosen mailto: url
;; note: we're also searching the body of the message so this code is
;; not quite correct
(defun mew-mailto-find-header-line (header-name)
"Return a string containing a header line associated with HEADER-NAME.
The first header line which is associated with HEADER-NAME is
returned as a string. If no such header line exists, nil is returned.
HEADER-NAME should not be terminated by a colon."
;; how do we extract information from an existing message?
(let* ((fld (mew-summary-folder-name))
(msg (mew-summary-message-number))
;; found something like this in mew-summary-display-message
(my-filename (mew-expand-folder fld msg))
(temp-buffer-name nil)
(header-line nil)
(beginning-of-line-position nil)
;; can we set things up to do thigngs case-insensitively?
(case-fold-search t))
(save-excursion
(setq temp-buffer-name (generate-new-buffer-name "*mew-mailto-work*"))
(generate-new-buffer temp-buffer-name)
(set-buffer temp-buffer-name)
(insert-file-contents my-filename)
;; for the last line matching header, use 'while'?
; (while (search-forward-regexp
(if (search-forward-regexp
(concat "^" header-name ":") nil t)
;; go to the beginning of the line
(progn
(beginning-of-line)
(setq beginning-of-line-position
(point))
(end-of-line)
(setq header-line
(buffer-substring
beginning-of-line-position (point)))
;; isn't there some way to break out of a loop in elisp?
))
;; this makes it so that one can't peek at the contents of the
;; buffer before it gets killed -- if we don't do this, the
;; contents of the buffer are available to functions via
;; 'kill-buffer-hook'
(erase-buffer)
(kill-buffer temp-buffer-name))
;; what we were looking for (or not...)
header-line
))
;; in elisp, what do you do for cases when usually a user doesn't need
;; to choose from a list of things, but sometimes it is necessary?
;; perhaps break the interactive part out into another function?
;; that's not what i did here.
(defun mew-mailto-compose-message-from-header (header-name)
"Compose a message based on the header line identified by HEADER-NAME.
HEADER-NAME should identify a single header line. The header line is
searched for mailto: urls. If there are multiple mailto: urls,
the user is prompted to select one.
Note: The case where there is more than on header line with a given HEADER-NAME
is not dealt with."
(let* ((header-line (mew-mailto-find-header-line header-name))
(our-mailto-urls (mailto-extract-mailto-urls-from-string header-line))
(number-of-urls (length our-mailto-urls)))
(cond
;; there were no mailto: urls...
((= number-of-urls 0)
;; shall we
nil)
;; there was exactly one mailto: url, so compose a message out
;; of that.
((= number-of-urls 1)
(mew-mailto-compose-message-from-mailto-url (car our-mailto-urls)))
;; there was more than one mailto: url, so the user should choose which
;; one to compose a message from
((> number-of-urls 1)
(mew-mailto-compose-message-from-mailto-url
(completing-read
"URL: "
;; build alist
(mapcar
(lambda (x)
(cons x ""))
our-mailto-urls)
nil
nil
"mailto:"))))
)
)
;; since this will be used via 'require'...
(provide 'mew-mailto)
-------------- next part --------------
;; -*- emacs-lisp -*-
;;
;; name: mew-ml.el
;; version: 0.1
;; description: some mailing list support for mew
;; creation date: 1998-11-18
;; author: "Sen Nagata" <sen at example.com>
;; warning: not optimized at all
;; required:
;;
;; -mew (tested for 1.93)
;; -mew-mailto.el (mew-mailto.el depends on mailto.el)
;; installation:
;;
;; -put this file (mew-mailto.el and mailto.el) in an appropriate
;; directory (so emacs can find it)
;;
;; <necessary>
;; -put:
;;
;; (add-hook 'mew-init-hook (lambda () (require 'mew-ml)))
;;
;; in your .emacs file.
;;
;; <optional>
;; -for key-bindings put (haven't tested for xemacs yet):
;;
;; (add-hook
;; 'mew-summary-mode-hook
;; (lambda ()
;; (define-key mew-summary-mode-map
;; "ch" 'mew-ml-compose-help-message)
;; (define-key mew-summary-mode-map
;; "cu" 'mew-ml-compose-unsubscribe-message)
;; (define-key mew-summary-mode-map
;; "cs" 'mew-ml-compose-subscribe-message)
;; (define-key mew-summary-mode-map
;; "cp" 'mew-ml-compose-post-message)
;; (define-key mew-summary-mode-map
;; "co" 'mew-ml-compose-owner-message)))
;;
;; in your .emacs file.
;;
;; <optional>
;; -for enhancing the menu for summary mode, put:
;;
;; (defvar mew-ml-menu-spec
;; '("Mailing List"
;; ["Help msg"
;; mew-ml-compose-help-message t]
;; ["Unsubscribe msg"
;; mew-ml-compose-unsubscribe-message t]
;; ["Subscribe msg"
;; mew-ml-compose-subscribe-message t]
;; ["Post msg"
;; mew-ml-compose-post-message t]
;; ["Owner msg"
;; mew-ml-compose-owner-message t]
;; ))
;;
;; (add-hook
;; 'mew-summary-mode-hook
;; (lambda ()
;; (setq mew-summary-mode-menu-spec
;; (nconc mew-summary-mode-menu-spec
;; (list "----"
;; mew-ml-menu-spec)))
;; ;; got this section from mew-summary.el
;; (easy-menu-define
;; mew-summary-mode-menu
;; mew-summary-mode-map
;; "Menu used in Summary mode."
;; mew-summary-mode-menu-spec)))
;;
;; in your .emacs.
;; details:
;;
;; this package provides a number of interactive functions
;; (commands) for the user. each of the commands ultimately creates a
;; draft message based on some information. the names of the commands
;; and brief descriptions are:
;;
;; mew-ml-compose-*-message
;; make a draft message from one of the corresponding
;; List-* headers (Unsubscribe, Subscribe, etc.). if no such
;; header is detected, the user is notified via 'message'.
;;
;; note: i don't use xemacs that often so i don't test it as much.
;; usage:
;;
;; -invoke mew
;; -try out the commands mentioned above in 'details'
;; -you can also try the commands via the menu now
;; notes and todo:
;;
;; -see TODO items in code
;; -place the menu and keybinding 'hook' stuff mentioned above into a
;; separate file and suggest that the user 'require'/'load' this via
;; their .emacs file? another possibility is just to set up our own
;; menus...seems kind of ugly though.
;; -keybindings and menu items -> is there a good way to modify the
;; existing menus for mew? (is that a bad idea?)
;; -support some kind of warning message for messages which should be
;; edited (e.g. subscribe messages requiring names). there isn't a
;; standard solution for this yet (for a discussion, see section A.5 of rfc
;; 2368)
;; -i've used this code w/ emacs versions >= 20.3
;; -test w/ xemacs -- not at all sure of the menu and keybinding stuff
;; -prepare a test suite...
;; how should we handle the dependecy on mew?
;; doing the following seems to have catastrophic effects on my machine :-(
;(require 'mew)
;; will this work?
(eval-when-compile
(require 'mew))
(defconst mew-ml-version "mew-ml.el 0.1")
;; use mew-mailto support -- should be useable for things other than mew too
(require 'mew-mailto)
;; notes:
;;
;; 1) i am not clear on whether mew-mailto-compose-message-from-header
;; returns
;;
;; 2) perhaps i should do the below w/ macros?
;;
;; 3) see 'mew-summary-reply' for a way to deal w/ the case when point
;; is not on a row w/ a message (located after all of the rows
;; representing messages) -> TODO
;;
;; 4) figure out a way to provide similar functionality when point is
;; is in message mode -> TODO
(defun mew-ml-compose-help-message ()
(interactive)
(if (not (mew-mailto-compose-message-from-header "List-Help"))
(message
"There does not appear to be a List-Help: header in this message."))
)
(defun mew-ml-compose-unsubscribe-message ()
(interactive)
(if (not (mew-mailto-compose-message-from-header "List-Unsubscribe"))
(message
"There does not appear to be a List-Unsubscribe: header in this message."))
)
(defun mew-ml-compose-subscribe-message ()
(interactive)
(if (not (mew-mailto-compose-message-from-header "List-Subscribe"))
(message
"There does not appear to be a List-Subscribe: header in this message."))
)
(defun mew-ml-compose-post-message ()
(interactive)
(if (not (mew-mailto-compose-message-from-header "List-Post"))
(message
"There does not appear to be a List-Post: header in this message."))
)
(defun mew-ml-compose-owner-message ()
(interactive)
(if (not (mew-mailto-compose-message-from-header "List-Owner"))
(message
"There does not appear to be a List-Owner: header in this message."))
)
;; since this will be used via 'require'...
(provide 'mew-ml)
Mew-dist メーリングリストの案内