Mercurial > emacs
diff lisp/gnus/nnwarchive.el @ 56927:55fd4f77387a after-merge-gnus-5_10
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Merge from emacs--gnus--5.10, gnus--rel--5.10
Patches applied:
* miles@gnu.org--gnu-2004/emacs--gnus--5.10--base-0
tag of miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-464
* miles@gnu.org--gnu-2004/emacs--gnus--5.10--patch-1
Import from CVS branch gnus-5_10-branch
* miles@gnu.org--gnu-2004/emacs--gnus--5.10--patch-2
Merge from lorentey@elte.hu--2004/emacs--multi-tty--0, emacs--cvs-trunk--0
* miles@gnu.org--gnu-2004/emacs--gnus--5.10--patch-3
Merge from gnus--rel--5.10
* miles@gnu.org--gnu-2004/emacs--gnus--5.10--patch-4
Merge from gnus--rel--5.10
* miles@gnu.org--gnu-2004/gnus--rel--5.10--patch-18
Update from CVS
* miles@gnu.org--gnu-2004/gnus--rel--5.10--patch-19
Remove autoconf-generated files from archive
* miles@gnu.org--gnu-2004/gnus--rel--5.10--patch-20
Update from CVS
author | Miles Bader <miles@gnu.org> |
---|---|
date | Sat, 04 Sep 2004 13:13:48 +0000 |
parents | 695cf19ef79e |
children | 18a818a2ee7c cce1c0ee76ee |
line wrap: on
line diff
--- a/lisp/gnus/nnwarchive.el Sat Sep 04 13:06:38 2004 +0000 +++ b/lisp/gnus/nnwarchive.el Sat Sep 04 13:13:48 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 <zsh@cs.rochester.edu> ;; 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>: *\\([^<]*[^< ]\\) *<\\([^&]+\\)>") (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))