3:12 p.m.
Here's a little utility to add a list-archive.xemacs.org URL when
you have a Message ID and want to provide a hyperlink.
I'm sure other people have written utilities like this, but I haven't
seen any published. I finally got around to writing my own (I needed
to learn about w3/url.el anyway, so it wasn't a waste of time).
; Copyright 2001 Stephen Turnbull
; Maintained by Code That Sucks, Ltd.
; Licensed under the GNU GPL. Warranty? Heaven forbid!
; I keep the working buffer open in a short window. Normally only
; about 5 lines are needed.
(defvar sjt/working-buffer-name "sjt/temp-url"
"Working buffer to hold fetched documents.")
(defvar sjt/verbose t
"Non-nil enables verbose messages.")
(defvar sjt/truncate-id-length 24
"Truncate query strings to this length.
The wilma search engine at list-archive.xemacs.org doesn't like long queries
(or maybe just long words in the queries). The default is 24, but some
queries seem to work better with even less."
(defvar sjt/parse-url-regexp
"<A HREF=\"/cgi-bin/wilma_hiliter\\(/.*\\.html\\)\\?"
"Regexp to parse part of the URL, expected to be in group 1.")
(defvar sjt/parse-url-format "http://list-archive.xemacs.org%s"
"Format string to make a valid URL from the first match group of
`sjt/parse-url-regexp'.")
(defun sjt/wrap-link-around-message-id (begin end)
"Wrap an HTML HREF around a Message ID, doing a web search for the URL.
Leaves point at beginning and mark at end of the original text, "
(interactive "r")
(let ((url (buffer-substring begin end)))
(setq end (set-marker (make-marker) end))
(goto-char begin)
(insert "<a href=\"")
(insert (sjt/message-id-to-url url
""
"xemacs-beta"
"xemacs-nt"
"xemacs-patches"))
(insert "\">")
(setq begin (point))
(setq end (marker-position end)) ; freeze end
(goto-char end)
(insert "</a>")
(move-marker (mark-marker t) end)
(goto-char begin)))
(defun sjt/message-id-to-url (id &optional auth &rest lists)
"Return URL corresponding to message-id ID posted to LISTS.
AUTH is an authorization in the form USER:PASSWORD. It has no default.
LISTS defaults to (\"xemacs-beta\" \"xemacs-nt\"
\"xemacs-patches\"); each
is tried in order and the URL corresponding to the first match is returned."
(interactive (let ((args (list (if (region-active-p)
(buffer-substring (region-beginning)
(region-end))
(read-string "Message-ID: "))
(read-string "User:Password: "))))
(let ((l (read-string "List (null to terminate): ")))
(while (> (length l) 0)
(setq args (nconc args (list l)))
(setq l (read-string "List (null to terminate): "))))
args))
(setq auth (cond ((null auth) "")
((> (length auth) 0) (concat auth "＠"))
(t auth)))
(setq lists (or (and lists (> (length (car lists)) 0) lists)
'("xemacs-beta" "xemacs-nt"
"xemacs-patches")))
(if sjt/verbose (message id))
;; wilma doesn't like long queries
(let ((id (substring id 0 (min (length id) sjt/truncate-id-length)))
url)
(save-excursion ; url-retrieve leaves you in the buffer
(while lists
(let ((url-working-buffer sjt/working-buffer-name)
(ml (car lists)))
(url-retrieve
(concat "http://"
auth
"list-archive.xemacs.org"
"/cgi-bin/wilma_glimpse/"
ml
"?query="
(url-hexify-string id)
"&partial=on")))
(setq url (sjt/parse-url-from-response))
(if sjt/verbose (message url))
(if url
(setq lists nil)
(setq lists (cdr lists)))))
url))
(defun sjt/parse-url-from-response ()
"Parse an URL from the HTML returned by a web search on message-id.
Expects to be called in the HTML buffer."
(goto-char (point-min))
(if (let ((case-fold-search t))
(search-forward "Message-ID" nil t))
(let ((eol (progn (end-of-line) (point))))
(beginning-of-line)
(re-search-forward sjt/parse-url-regexp eol)
(format sjt/parse-url-format
(match-string 1)))))
--
University of Tsukuba Tennodai 1-1-1 Tsukuba 305-8573 JAPAN
Institute of Policy and Planning Sciences Tel/fax: +81 (298) 53-5091
_________________ _________________ _________________ _________________
What are those straight lines for? "XEmacs rules."
4:36 p.m.
>>>> "Stephen" == Stephen J Turnbull
<turnbull(a)sk.tsukuba.ac.jp> writes:
Stephen> Here's a little utility to add a list-archive.xemacs.org
Stephen> URL when you have a Message ID and want to provide a
Stephen> hyperlink.
Hi Stephen,
I have a small patch for this. The version you sent has never been run.
diff -u c:\Users\AichnerAd\el\sjt-message-id-to-url.el~
c:\Users\AichnerAd\el\sjt-message-id-to-url.el
--- c:\Users\AichnerAd\el\sjt-message-id-to-url.el~ Sun Apr 29 17:26:49 2001
+++ c:\Users\AichnerAd\el\sjt-message-id-to-url.el Sun Apr 29 17:26:49 2001
＠＠ -15,7 +15,7 ＠＠
The wilma search engine at list-archive.xemacs.org doesn't like long queries
(or maybe just long words in the queries). The default is 24, but some
-queries seem to work better with even less."
+queries seem to work better with even less.")
(defvar sjt/parse-url-regexp
"<A HREF=\"/cgi-bin/wilma_hiliter\\(/.*\\.html\\)\\?"
Stephen> I'm sure other people have written utilities like this,
Stephen> but I haven't seen any published. I finally got around
Stephen> to writing my own (I needed to learn about w3/url.el
Stephen> anyway, so it wasn't a waste of time).
The query length limitation is in glimpse, not wilma:
http://www.webglimpse.org/glimpsehelp.html#sect14
Stephen, I would like my release-mail-to-html.el to use this utility.
What do you suggest:
1. Include this in release-mail-to-html.el
2. Find a name for your utility, put it in xemacsweb and have
release-mail-to-html.el (require ...) it.
I vote for 2.
Please advise.
Best regards,
Adrian
Stephen> ; Copyright 2001 Stephen Turnbull
Stephen> ; Maintained by Code That Sucks, Ltd.
Stephen> ; Licensed under the GNU GPL. Warranty? Heaven forbid!
Stephen> ; I keep the working buffer open in a short window. Normally only
Stephen> ; about 5 lines are needed.
Stephen> (defvar sjt/working-buffer-name "sjt/temp-url"
Stephen> "Working buffer to hold fetched documents.")
Stephen> (defvar sjt/verbose t
Stephen> "Non-nil enables verbose messages.")
Stephen> (defvar sjt/truncate-id-length 24
Stephen> "Truncate query strings to this length.
Stephen> The wilma search engine at list-archive.xemacs.org doesn't like long
queries
Stephen> (or maybe just long words in the queries). The default is 24, but some
Stephen> queries seem to work better with even less."
Stephen> (defvar sjt/parse-url-regexp
Stephen> "<A HREF=\"/cgi-bin/wilma_hiliter\\(/.*\\.html\\)\\?"
Stephen> "Regexp to parse part of the URL, expected to be in group
1.")
Stephen> (defvar sjt/parse-url-format "http://list-archive.xemacs.org%s"
Stephen> "Format string to make a valid URL from the first match group of
Stephen> `sjt/parse-url-regexp'.")
Stephen> (defun sjt/wrap-link-around-message-id (begin end)
Stephen> "Wrap an HTML HREF around a Message ID, doing a web search for the
URL.
Stephen> Leaves point at beginning and mark at end of the original text, "
Stephen> (interactive "r")
Stephen> (let ((url (buffer-substring begin end)))
Stephen> (setq end (set-marker (make-marker) end))
Stephen> (goto-char begin)
Stephen> (insert "<a href=\"")
Stephen> (insert (sjt/message-id-to-url url
Stephen> ""
Stephen> "xemacs-beta"
Stephen> "xemacs-nt"
Stephen> "xemacs-patches"))
Stephen> (insert "\">")
Stephen> (setq begin (point))
Stephen> (setq end (marker-position end)) ; freeze end
Stephen> (goto-char end)
Stephen> (insert "</a>")
Stephen> (move-marker (mark-marker t) end)
Stephen> (goto-char begin)))
Stephen> (defun sjt/message-id-to-url (id &optional auth &rest lists)
Stephen> "Return URL corresponding to message-id ID posted to LISTS.
Stephen> AUTH is an authorization in the form USER:PASSWORD. It has no default.
Stephen> LISTS defaults to (\"xemacs-beta\" \"xemacs-nt\"
\"xemacs-patches\"); each
Stephen> is tried in order and the URL corresponding to the first match is
returned."
Stephen> (interactive (let ((args (list (if (region-active-p)
Stephen> (buffer-substring (region-beginning)
Stephen> (region-end))
Stephen> (read-string "Message-ID:
"))
Stephen> (read-string "User:Password:
"))))
Stephen> (let ((l (read-string "List (null to terminate):
")))
Stephen> (while (> (length l) 0)
Stephen> (setq args (nconc args (list l)))
Stephen> (setq l (read-string "List (null to
terminate): "))))
Stephen> args))
Stephen> (setq auth (cond ((null auth) "")
Stephen> ((> (length auth) 0) (concat auth "＠"))
Stephen> (t auth)))
Stephen> (setq lists (or (and lists (> (length (car lists)) 0) lists)
Stephen> '("xemacs-beta" "xemacs-nt"
"xemacs-patches")))
Stephen> (if sjt/verbose (message id))
Stephen> ;; wilma doesn't like long queries
Stephen> (let ((id (substring id 0 (min (length id) sjt/truncate-id-length)))
Stephen> url)
Stephen> (save-excursion ; url-retrieve leaves you in the buffer
Stephen> (while lists
Stephen> (let ((url-working-buffer sjt/working-buffer-name)
Stephen> (ml (car lists)))
Stephen> (url-retrieve
Stephen> (concat "http://"
Stephen> auth
Stephen> "list-archive.xemacs.org"
Stephen> "/cgi-bin/wilma_glimpse/"
Stephen> ml
Stephen> "?query="
Stephen> (url-hexify-string id)
Stephen> "&partial=on")))
Stephen> (setq url (sjt/parse-url-from-response))
Stephen> (if sjt/verbose (message url))
Stephen> (if url
Stephen> (setq lists nil)
Stephen> (setq lists (cdr lists)))))
Stephen> url))
Stephen> (defun sjt/parse-url-from-response ()
Stephen> "Parse an URL from the HTML returned by a web search on
message-id.
Stephen> Expects to be called in the HTML buffer."
Stephen> (goto-char (point-min))
Stephen> (if (let ((case-fold-search t))
Stephen> (search-forward "Message-ID" nil t))
Stephen> (let ((eol (progn (end-of-line) (point))))
Stephen> (beginning-of-line)
Stephen> (re-search-forward sjt/parse-url-regexp eol)
Stephen> (format sjt/parse-url-format
Stephen> (match-string 1)))))
Stephen> --
Stephen> University of Tsukuba Tennodai 1-1-1 Tsukuba 305-8573
JAPAN
Stephen> Institute of Policy and Planning Sciences Tel/fax: +81 (298)
53-5091
Stephen> _________________ _________________ _________________
_________________
Stephen> What are those straight lines for? "XEmacs rules."
--
Adrian Aichner
mailto:adrian＠xemacs.org
http://www.xemacs.org/
6:34 a.m.
>>>> "APA" == Adrian Aichner
<Adrian.Aichner(a)t-online.de> writes:
APA> I have a small patch for this. The version you sent has
APA> never been run.
Sorry about the typo, I was working on a different XEmacs and
copy/pasted via X -- the code was working in my other XEmacs.
APA> 1. Include this in release-mail-to-html.el
APA> 2. Find a name for your utility, put it in xemacsweb and have
APA> release-mail-to-html.el (require ...) it.
Sure, do what you like with it. I've had a bad weekend personally,
and am going to concentrate the next couple of days on getting a
release out incorporating many recent contributions. I don't have
time to work on it for a while; it was intended as proof of concept.
The only necessary thing is legal; I've signed assign.future so if you
add it to XEmacs, it automatically becomes copyright FSF -- don't
leave my name in the Copyright column.
I plan to clean it up eventually, I've got a bunch more code in
development for related functions. Why don't you call it
msgid-to-url.el, do s＠sjt/＠mtu-＠/g on it, and put it in the same place
as release-mail-to-html.el. Probably it will get renamed or
incorporated in a larger library, so I don't recommend it for
xemacs-devel as it is.
What I suggest (eventually) is that the xemacs-devel package be split
into two pieces, xemacs-devel and xemacs-releng. xemacs-devel will
contain generally useful utilities, such as msg-id-to-url.el and
cvs-rw (in lib-src, I guess?). xemacs-releng will focus on stuff of
specific interest to release engineers, including most of what
currently is in xemacs-builds, my own xre.py (a reimplementation of
Martin's perl script xre), etc. I suggest this is a better place for
release-mail-to-html.el than the xemacsweb module, too.
--
University of Tsukuba Tennodai 1-1-1 Tsukuba 305-8573 JAPAN
Institute of Policy and Planning Sciences Tel/fax: +81 (298) 53-5091
_________________ _________________ _________________ _________________
What are those straight lines for? "XEmacs rules."
8607
days inactive
8611
days old
2 comments
2 participants
participants (2)
-
Adrian Aichner -
Stephen J. Turnbull