diff lisp/gnus/nnwarchive.el @ 89971:cce1c0ee76ee

Revision: [e-mail]--gnu-2004/emacs--unicode--0--patch-36 Merge from emacs--cvs-trunk--0, emacs--gnus--5.10, gnus--rel--5.10 Patches applied: * [e-mail]--gnu-2004/emacs--cvs-trunk--0--patch-523 Merge from emacs--gnus--5.10, gnus--rel--5.10 * [e-mail]--gnu-2004/emacs--cvs-trunk--0--patch-524 - [e-mail]--gnu-2004/emacs--cvs-trunk--0--patch-534 Update from CVS * [e-mail]--gnu-2004/emacs--gnus--5.10--base-0 tag of [e-mail]--gnu-2004/emacs--cvs-trunk--0--patch-464 * [e-mail]--gnu-2004/emacs--gnus--5.10--patch-1 Import from CVS branch gnus-5_10-branch * [e-mail]--gnu-2004/emacs--gnus--5.10--patch-2 Merge from [e-mail]--2004/emacs--multi-tty--0, emacs--cvs-trunk--0 * [e-mail]--gnu-2004/emacs--gnus--5.10--patch-3 Merge from gnus--rel--5.10 * [e-mail]--gnu-2004/emacs--gnus--5.10--patch-4 Merge from gnus--rel--5.10 * [e-mail]--gnu-2004/gnus--rel--5.10--patch-18 Update from CVS * [e-mail]--gnu-2004/gnus--rel--5.10--patch-19 Remove autoconf-generated files from archive * [e-mail]--gnu-2004/gnus--rel--5.10--patch-20 Update from CVS

--- a/lisp/gnus/nnwarchive.el	Sun Sep 05 01:53:47 2004 +0000
+++ b/lisp/gnus/nnwarchive.el	Thu Sep 09 09:36:36 2004 +0000
@@ -1,5 +1,5 @@
 ;;; nnwarchive.el --- interfacing with web archives
-;; Copyright (C) 1999, 2000 Free Software Foundation, Inc.
+;; Copyright (C) 1999, 2000, 2003 Free Software Foundation, Inc.
 
 ;; Author: Shenghuo Zhu <[e-mail]>
 ;; Keywords: news egroups mail-archive
@@ -24,7 +24,7 @@
 ;;; Commentary:
 
 ;; Note: You need to have `url' (w3 0.46) or greater version
-;; installed for this backend to work.
+;; installed for some functions of this backend to work.
 
 ;; Todo:
 ;; 1. To support more web archives.
@@ -41,19 +41,7 @@
 (require 'gnus-bcklg)
 (require 'nnmail)
 (require 'mm-util)
-(require 'mail-source)
-(eval-when-compile
-  (ignore-errors
-    (require 'w3)
-    (require 'url)
-    (require 'w3-forms)
-    (require 'nnweb)))
-;; Report failure to find w3 at load time if appropriate.
-(eval '(progn
-	 (require 'w3)
-	 (require 'url)
-	 (require 'w3-forms)
-	 (require 'nnweb)))
+(require 'mm-url)
 
 (nnoo-declare nnwarchive)
 
@@ -297,7 +285,7 @@
 		 user-mail-address)))
     (setq nnwarchive-passwd
 	  (or nnwarchive-passwd
-	      (mail-source-read-passwd
+	      (read-passwd
 	       (format "Password for %s at %s: "
 		       nnwarchive-login server)))))
   (unless nnwarchive-groups
@@ -360,23 +348,6 @@
 	     (format " *nnwarchive %s %s*" nnwarchive-type server)))))
   (nnwarchive-set-default nnwarchive-type))
 
-(defun nnwarchive-encode-www-form-urlencoded (pairs)
-  "Return PAIRS encoded for forms."
-  (mapconcat
-   (function
-    (lambda (data)
-      (concat (w3-form-encode-xwfu (car data)) "="
-	      (w3-form-encode-xwfu (cdr data)))))
-   pairs "&"))
-
-(defun nnwarchive-fetch-form (url pairs)
-  (let ((url-request-data (nnwarchive-encode-www-form-urlencoded pairs))
-	(url-request-method "POST")
-	(url-request-extra-headers
-	 '(("Content-type" . "application/x-www-form-urlencoded"))))
-    (nnweb-insert url))
-  t)
-
 (defun nnwarchive-eval (expr)
   (cond
    ((consp expr)
@@ -388,14 +359,14 @@
 
 (defun nnwarchive-url (xurl)
   (mm-with-unibyte-current-buffer
-    (let ((url-confirmation-func 'identity)
+    (let ((url-confirmation-func 'identity) ;; Some hacks.
 	  (url-cookie-multiple-line nil))
       (cond
        ((eq (car xurl) 'post)
 	(pop xurl)
-	(nnwarchive-fetch-form (car xurl) (nnwarchive-eval (cdr xurl))))
+	(mm-url-fetch-form (car xurl) (nnwarchive-eval (cdr xurl))))
        (t
-	(nnweb-insert (apply 'format (nnwarchive-eval xurl))))))))
+	(mm-url-insert (apply 'format (nnwarchive-eval xurl))))))))
 
 (defun nnwarchive-generate-active ()
   (save-excursion
@@ -470,8 +441,8 @@
 	       article
 	       (make-full-mail-header
 		article
-		(nnweb-decode-entities-string subject)
-		(nnweb-decode-entities-string from)
+		(mm-url-decode-entities-string subject)
+		(mm-url-decode-entities-string from)
 		date
 		(concat "<" group "%"
 			(number-to-string article)
@@ -490,7 +461,7 @@
   (goto-char (point-min))
   (while (re-search-forward "<a[^>]+>\\([^<]+\\)</a>" nil t)
     (replace-match "\\1"))
-  (nnweb-decode-entities)
+  (mm-url-decode-entities)
   (buffer-string))
 
 (defun nnwarchive-egroups-xover-files (group articles)
@@ -550,7 +521,7 @@
 	    subject (match-string 2))
       (forward-line 1)
       (unless (assq article nnwarchive-headers)
-	(if (looking-at "<UL><LI><EM>From</EM>:\\([^&]+\\)<\\([^&]+\\)>")
+	(if (looking-at "<UL><LI><EM>From</EM>: *\\([^<]*[^< ]\\) *&lt;\\([^&]+\\)&gt;")
 	    (progn
 	      (setq from (match-string 1)
 		    date (identity (match-string 2))))
@@ -559,8 +530,8 @@
 	       article
 	       (make-full-mail-header
 		article
-		(nnweb-decode-entities-string subject)
-		(nnweb-decode-entities-string from)
+		(mm-url-decode-entities-string subject)
+		(mm-url-decode-entities-string from)
 		date
 		(format "<%05d%%%s>\n" (1- article) group)
 		""
@@ -623,7 +594,7 @@
       (when (search-forward "X-Head-End" nil t)
 	(beginning-of-line)
 	(narrow-to-region (point-min) (point))
-	(nnweb-decode-entities)
+	(mm-url-decode-entities)
 	(goto-char (point-min))
 	(while (search-forward "<!--X-" nil t)
 	  (replace-match ""))
@@ -645,8 +616,8 @@
 	(search-forward "</ul>" nil t)
 	(end-of-line)
 	(narrow-to-region (point-min) (point))
-	(nnweb-remove-markup)
-	(nnweb-decode-entities)
+	(mm-url-remove-markup)
+	(mm-url-decode-entities)
 	(goto-char (point-min))
 	(delete-blank-lines)
 	(when from
@@ -687,8 +658,8 @@
 		(delete-region (match-beginning 0) (match-end 0))
 		(save-restriction
 		  (narrow-to-region p (point))
-		  (nnweb-remove-markup)
-		  (nnweb-decode-entities)
+		  (mm-url-remove-markup)
+		  (mm-url-decode-entities)
 		  (goto-char (point-max)))))
 	     ((looking-at "<P><A HREF=\"\\([^\"]+\\)")
 	      (setq url (match-string 1))
@@ -696,14 +667,17 @@
 			     (progn (forward-line) (point)))
 	      ;; I hate to download the url encode it, then immediately
 	      ;; decode it.
-	      ;; FixMe: Find a better solution to attach the URL.
-	      ;; Maybe do some hack in external part of mml-generate-mim-1.
-	      (insert "<#part>"
-		      "\n--\nExternal: \n"
-		      (format "<URL:http://www.mail-archive.com/%s/%s>"
+	      (insert "<#external"
+		      " type="
+		      (or (and url
+			       (string-match "\\.[^\\.]+$" url)
+			       (mailcap-extension-to-mime
+				(match-string 0 url)))
+			  "application/octet-stream")
+		      (format " url=\"http://www.mail-archive.com/%s/%s\""
 			      group url)
-		      "\n--\n"
-		      "<#/part>")
+		      ">\n"
+		      "<#/external>")
 	      (setq mime t))
 	     (t
 	      (setq p (point))