[Mew-dist 08705] Re: use mew-mailto.el with browse-url.el
sen_ml at example.com
sen_ml at example.com
1999年 5月 4日 (火) 18:53:18 JST
返事が遅れてすみません。
At around Sun, 2 May 1999 14:59:10 +0900,
Umekichi <umekichi at example.com> may have mentioned:
> contrib に入っている mew-mailto.el ですが
> (Sen Nagata <sen at example.com>さんが送られたものですね)、
> browse-url.el と一緒に使いにくかったため、
> patch を作ってみました(ダミーの変数を与えただけですが)。
ナイスです。早速変更を加えました。
> (Emacs 20.3 だけかも。)
こちらの Emacs 20.3 でもちゃんと動いてくれました。
で、XEmacs 20.4 でも試してみましたが、XEmacs 20.4 の browse-url.el の
ヴァージョンが古い(？)のでだめでした・・・ XEmacs 21.x には新しいものが
ついてくるかどうか、知っている方はいらっしゃいますか？
mew-mailto.el と mailto.el に他の変更も最近加えたので、添付します。
注： mew-mailto.el は sendmail.el に依存する様になりました。
-------------- next part --------------
;;; -*- emacs-lisp -*-
;;;
;;; name: mew-mailto.el
;;; version: 0.5
;;; 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)
;;; -sendmail.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:
;;;
;;; -here is a rfc-2369-relevant url: http://www.nisto.com/listspec/
;;; -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...
;; changes:
;;
;; 0.5
;;
;; 1999-05-04:
;;
;; modified the interface to mew-mailto-compose-message-from-mailto-url
;; as suggested by Umekichi <umekichi at example.com>. see the interface
;; to browse-url-mail in browse-url.el for details.
;; 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.5")
;; use mailto support -- should be useable for things other than mew too
(require 'mailto)
;; use mail-mode support: mail-position-on-field, mail-header-separator
(require 'sendmail)
;; isn't there a way to make this non-global?
(defvar mew-mailto-draft-p nil)
;; hook function for setting up mail-header-separator appropriately
;;
;; this is very important!
;;
;; it's important that the value of mail-header-separator be set to
;; the value of mew-header-separator before the hook function executues
;;
;; (a hook that is added last is run first...)
(add-hook 'mew-draft-mode-hook 'mew-mailto-draft-hook-function)
;; originally suggested by Mito <mit at example.com> for general problem
;;
;; this is so that all the code that expects 'mail-header-separator'
;; can work...i don't understand the reasons for using 'mew-header-separator'
;(add-hook 'mew-draft-mode-hook
; '(lambda ()
; (make-local-variable 'mail-header-separator)
; (setq mail-header-separator mew-header-separator)
; ))
(defun mew-mailto-insert-header (header-name header-value)
"Helper function to insert a header into a message in mail-mode."
(mail-position-on-field
;; this is for stripping the trailing colon, there are probably better
;; ways to do this that won't break if the header-name's don't have
;; colons...ew, i saw that -- using an apostrophe to set off the plural
;; suffix...strings start at index 0, but buffers at index 1 in
;; emacs -- why is that?
(substring header-name 0 -1))
(insert header-value))
;; ** haven't dealt w/ case where the body is already set **
(defun mew-mailto-insert-body (body-text)
"Helper function to insert a body of text into a message in mail-mode."
;; code defensively... :-P
(goto-char (point-min))
(search-forward mail-header-separator)
(forward-line 1)
(insert body-text))
;; for mew-draft-mode-hook
(defun mew-mailto-draft-hook-function ()
"Hook function to manipulate headers and body of a new draft created by mew-summary-send (actually mew-draft-mode?). The author's intention was for this function to be add-hook'ed to mew-mailto-setup-hook."
;; hack for the moment...
;; TODO: fix this up...
(make-local-variable 'mail-header-separator)
(setq mail-header-separator mew-header-separator)
;; using advice would be cooler
(if mew-mailto-draft-p
(progn
(mapcar
(lambda (x)
(let ((header-name (car x))
(header-value (cdr x)))
(if (not (equal header-name "Body:"))
(mew-mailto-insert-header header-name header-value)
t)))
mew-mailto-draft-headers-alist)
(if mew-mailto-draft-body
(mew-mailto-insert-body mew-mailto-draft-body)
nil))
t))
(defun mew-mailto-summary-send (url)
"Wrapper around mew-summary-send for the purposes of creating a new message based on URL (RFC 2368)."
(let (mew-mailto-draft-headers-alist
mew-mailto-draft-body)
(unwind-protect
(progn
(setq mew-mailto-draft-headers-alist (mailto-parse-url url))
(if (assoc "Body:" mew-mailto-draft-headers-alist)
(setq mew-mailto-draft-body
(cdr (assoc "Body:" mew-mailto-draft-headers-alist)))
(setq mew-mailto-draft-body nil))
(setq mew-mailto-draft-p t)
;; is it necessary to call this interactively
(mew-summary-send))
;; no longer composing a draft -- isn't there a nicer way to
;; arrange for this to happen?
(setq mew-mailto-draft-p nil))))
;; prepare a message from a mailto: url
(defun mew-mailto-compose-message-from-mailto-url (url &optional dummy)
"Compose a message from URL. The optional second argument, DUMMY, exists
to match the interface provided by browse-url-mail -- DUMMY does not do
anything."
(interactive "sURL: ")
(if (string-match mailto-url-regexp url)
;(mew-mailto-summary-send-old (mailto-parse-url url))
(mew-mailto-summary-send 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 ()
"Compose a message from a mailto url found 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: mailto.el
;; version: 0.8
;; 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.8")
;; 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]:\\)\\([^?]+\\)\\(\\?\\(.*\\)\\)*"
)
; "\\([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))
Mew-dist メーリングリストの案内