Commits

stephent  committed cea1607

Add msgid-to-url.el

  • Participants
  • Branches unlabeled-1.1.2

Comments (0)

Files changed (1)

File stephen/msgid-to-url.el

+;;; msg-id-to-url.el --- search XEmacs list archives, and provide URL
+
+;; Copyright (C) 2003 Free Software Foundation
+
+;; Author:   Stephen J. Turnbull <stephen@xemacs.org>
+
+;; Version:  1.0
+;; Created:  2003 August 19
+;; Keywords: maint, mail
+
+;; This file is part of XEmacs.
+
+;; XEmacs is free software; you can redistribute it and/or modify it
+;; under the terms of the GNU General Public License as published by
+;; the Free Software Foundation; either version 2, or (at your option)
+;; any later version.
+
+;; XEmacs is distributed in the hope that it will be useful, but
+;; WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+;; General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with XEmacs; see the file COPYING.  If not, write to the 
+;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
+;; Boston, MA 02111-1307, USA.
+
+;;; Commentary:
+
+;; Search the XEmacs archives for a message ID, and provide an URL to it.
+;; Alternatively, take the message ID from the region, and wrap an HTML
+;; anchor around it.
+
+;; Entry points (interactive commands):
+;;     wrap-link-around-message-id
+;;     message-id-to-url
+
+;;; Code:
+
+;;; Synched up with: Not in GNU Emacs.
+
+;; candidates for defcustoms
+
+(defvar msgid-to-url-verbose t
+  "Non-nil enables verbose messages.")
+
+(defvar msgid-to-url-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 msgid-to-url-parse-url-regexp
+  "<A HREF=\"/cgi-bin/wilma_hiliter\\(/.*\\.html\\)\\?"
+  "Regexp to parse part of the URL, expected to be in group 1.")
+
+(defvar msgid-to-url-parse-url-format "http://list-archive.xemacs.org%s"
+  "Format string to make a valid URL from the first match group of
+`msgid-to-url-parse-url-regexp'.")
+
+;; internal variables
+
+(defvar msgid-to-url-working-buffer-name "msgid-to-url-temp-url"
+  "Working buffer to hold fetched documents.")
+
+(defvar msgid-to-url-junk-tag-re "</?[a-zA-Z]+>")
+
+;; the main entry points
+
+(defun 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 ((target (buffer-substring begin end)))
+
+    (setq end (set-marker (make-marker) end))
+
+    (let ((url (or (message-id-to-url target nil
+				      "xemacs-beta"
+				      "xemacs-nt"
+				      "xemacs-patches")
+		   (error "No URL found.  Too soon?  Typo in Message-ID?"))))
+      (goto-char begin)
+      (insert "<a href=\"")
+      (insert url)
+      (insert "\">\n")
+      (setq begin (point))
+      (setq end (marker-position end))	; freeze end
+      (goto-char end)
+      (insert "\n</a>")
+      (move-marker (mark-marker t) end)
+      (goto-char begin))))
+
+(defun 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.
+BASE-URL may contain the descriptor \"%s\", and the list is substituted into
+the query there.  BASE-URL should contain the query operator \"?\".
+It defaults to \"http://list-archive.xemacs.org/cgi-bin/wilma_glimpse/%s?\"."
+
+    (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 msgid-to-url-verbose (message id))
+
+    ;; wilma doesn't like long queries
+    (let ((id (substring id 0 (min (length id)
+				   msgid-to-url-truncate-id-length))) 
+	  url)
+      (save-excursion    ; url-retrieve leaves you in the buffer
+	(while lists
+	  (let ((url-working-buffer msgid-to-url-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 (msgid-to-url-parse-url-from-response))
+	  (if msgid-to-url-verbose (message url))
+	  (if url
+	      (setq lists nil)
+	    (setq lists (cdr lists)))))
+      url))
+
+;; internal helpers
+
+(defun msgid-to-url-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.  Returns `nil' on failure."
+
+  (goto-char (point-min))
+  ;; Aargh, wilma puts so much s**t in the buffer
+  (while (re-search-forward msgid-to-url-junk-tag-re nil t)
+    (replace-match ""))
+  (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 msgid-to-url-parse-url-regexp eol)
+        (format msgid-to-url-parse-url-format
+                (match-string 1)))))
+
+(provide 'msgid-to-url)
+