cgit.sxemacs.org Git - gnus/blob - lisp/nnwarchive.el

   1 ;;; nnwarchive.el --- interfacing with web archives
   2 ;; Copyright (C) 1999 Free Software Foundation, Inc.
   3
   4 ;; Author: Shenghuo Zhu <zsh@cs.rochester.edu>
   5 ;; Keywords: news
   6
   7 ;; This file is part of GNU Emacs.
   8
   9 ;; GNU Emacs is free software; you can redistribute it and/or modify
  10 ;; it under the terms of the GNU General Public License as published
  11 ;; by the Free Software Foundation; either version 2, or (at your
  12 ;; option) any later version.
  13
  14 ;; GNU Emacs is distributed in the hope that it will be useful, but
  15 ;; WITHOUT ANY WARRANTY; without even the implied warranty of
  16 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  17 ;; General Public License for more details.
  18
  19 ;; You should have received a copy of the GNU General Public License
  20 ;; along with GNU Emacs; see the file COPYING.  If not, write to the
  21 ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
  22 ;; Boston, MA 02111-1307, USA.
  23
  24 ;;; Commentary:
  25
  26 ;; Note: You need to have `url' and `w3' installed for this backend to
  27 ;; work.
  28
  29 ;; A lot of codes stolen from mail-source, nnslashdot, nnweb.
  30
  31 ;; Todo:
  32 ;; 1. To support more web archives.
  33 ;; 2. Support nnwarchive-xover-is-evil.
  34
  35 ;; Known bugs: in w3 0.44, there are two copies of url-maybe-relative.
  36 ;; If it is loaded from w3.el, (load-library "url").  Update to w3 0.46
  37 ;; or greater version.
  38
  39 ;;; Code:
  40
  41 (eval-when-compile (require 'cl))
  42
  43 (require 'nnoo)
  44 (require 'message)
  45 (require 'gnus-util)
  46 (require 'gnus)
  47 (require 'nnmail)
  48 (require 'mm-util)
  49 (require 'mail-source)
  50 (eval-when-compile
  51   (ignore-errors
  52     (require 'w3)
  53     (require 'url)
  54     (require 'w3-forms)
  55     (require 'nnweb)))
  56 ;; Report failure to find w3 at load time if appropriate.
  57 (eval '(progn
  58          (require 'w3)
  59          (require 'url)
  60          (require 'w3-forms)
  61          (require 'nnweb)))
  62
  63 (nnoo-declare nnwarchive)
  64
  65 (defvar nnwarchive-type-definition
  66   '((egroups
  67      (address . "www.egroups.com")
  68      (open-url
  69       "http://www.egroups.com/register?method=loginAction&email=%s&password=%s"
  70       nnwarchive-login nnwarchive-passwd)
  71      (list-url
  72       "http://www.egroups.com/UserGroupsPage?")
  73      (list-dissect . nnwarchive-egroups-list)
  74      (list-groups . nnwarchive-egroups-list-groups)
  75      (xover-url
  76       "http://www.egroups.com/group/%s/?fetchForward=1&start=%d" group aux)
  77      (xover-last-url
  78       "http://www.egroups.com/group/%s/?fetchForward=1" group)
  79      (xover-page-size . 13)
  80      (xover-dissect . nnwarchive-egroups-xover)
  81      (article-url
  82       "http://www.egroups.com/group/%s/%d.html?raw=1" group article)
  83      (article-dissect . nnwarchive-egroups-article)
  84      (authentication . t)
  85      (xover-files . nnwarchive-egroups-xover-files))
  86     (mail-archive
  87      (address . "www.mail-archive.com")
  88      (list-url
  89       "http://www.mail-archive.com/lists.html")
  90      (list-dissect . nnwarchive-mail-archive-list)
  91      (list-groups . nnwarchive-mail-archive-list-groups)
  92      (xover-url
  93       "http://www.mail-archive.com/%s/mail%d.html" group aux)
  94      (xover-last-url
  95       "http://www.mail-archive.com/%s/maillist.html" group)
  96      (xover-dissect . nnwarchive-mail-archive-xover)
  97      (article-url
  98       "http://www.mail-archive.com/%s/msg%05d.html" group article1)
  99      (article-dissect . nnwarchive-mail-archive-article)
 100      (xover-files . nnwarchive-mail-archive-xover-files)
 101      (article-offset . 1))))
 102
 103 (defvar nnwarchive-default-type 'egroups)
 104
 105 (defvoo nnwarchive-directory (nnheader-concat gnus-directory "warchive/")
 106   "Where nnwarchive will save its files.")
 107
 108 (eval-and-compile
 109   (defvoo nnwarchive-type nil
 110     "The type of nnwarchive."))
 111
 112 (defvoo nnwarchive-address ""
 113   "The address of nnwarchive.")
 114
 115 (defvoo nnwarchive-login nil
 116   "Your login name for the group.")
 117
 118 (defvoo nnwarchive-passwd nil
 119   "Your password for the group.")
 120
 121 (defvoo nnwarchive-groups nil)
 122
 123 (defvoo nnwarchive-headers-cache nil)
 124
 125 (defvoo nnwarchive-opened nil)
 126
 127 (defvoo nnwarchive-authentication nil)
 128
 129 (defvoo nnwarchive-xover-is-evil nil) ;; not implemented
 130
 131 (defconst nnwarchive-version "nnwarchive 1.0")
 132
 133 ;;; Internal variables
 134
 135 (defvoo nnwarchive-open-url nil)
 136 (defvoo nnwarchive-open-dissect nil)
 137
 138 (defvoo nnwarchive-list-url nil)
 139 (defvoo nnwarchive-list-dissect nil)
 140 (defvoo nnwarchive-list-groups nil)
 141
 142 (defvoo nnwarchive-xover-files nil)
 143 (defvoo nnwarchive-xover-url nil)
 144 (defvoo nnwarchive-xover-last-url nil)
 145 (defvoo nnwarchive-xover-dissect nil)
 146 (defvoo nnwarchive-xover-page-size nil)
 147
 148 (defvoo nnwarchive-article-url nil)
 149 (defvoo nnwarchive-article-dissect nil)
 150 (defvoo nnwarchive-xover-files nil)
 151 (defvoo nnwarchive-article-offset 0)
 152
 153 (defvoo nnwarchive-buffer nil)
 154
 155 (defvar nnwarchive-headers nil)
 156
 157
 158 ;;; Interface functions
 159
 160 (nnoo-define-basics nnwarchive)
 161
 162 (defun nnwarchive-set-default (type)
 163   (let ((defs (cdr (assq type nnwarchive-type-definition)))
 164         def)
 165     (dolist (def defs)
 166       (set (intern (concat "nnwarchive-" (symbol-name (car def))))
 167            (cdr def)))))
 168
 169 (deffoo nnwarchive-retrieve-headers (articles &optional group server fetch-old)
 170   (nnwarchive-possibly-change-server group server)
 171   (setq nnwarchive-headers (cdr (assoc group nnwarchive-headers-cache)))
 172   (save-excursion
 173     (set-buffer nnwarchive-buffer)
 174     (erase-buffer)
 175     (funcall nnwarchive-xover-files group articles))
 176   (save-excursion
 177     (set-buffer nntp-server-buffer)
 178     (erase-buffer)
 179     (let (header)
 180       (dolist (art articles)
 181         (if (setq header (assq art nnwarchive-headers))
 182             (nnheader-insert-nov (cdr header))))))
 183   (let ((elem (assoc group nnwarchive-headers-cache)))
 184     (if elem
 185         (setcdr elem nnwarchive-headers)
 186       (push (cons group nnwarchive-headers) nnwarchive-headers-cache)))
 187   'nov)
 188
 189 (deffoo nnwarchive-retrieve-groups (groups &optional server)
 190   "Retrieve group info on GROUPS."
 191   (nnwarchive-possibly-change-server nil server)
 192   (if nnwarchive-list-groups
 193       (funcall nnwarchive-list-groups groups))
 194   (nnwarchive-write-groups)
 195   (nnwarchive-generate-active)
 196   'active)
 197
 198 (deffoo nnwarchive-request-group (group &optional server dont-check)
 199   (nnwarchive-possibly-change-server nil server)
 200   (if nnwarchive-list-groups
 201       (funcall nnwarchive-list-groups (list group)))
 202   (nnwarchive-write-groups)
 203   (let ((elem (assoc group nnwarchive-groups)))
 204     (cond
 205      ((not elem)
 206       (nnheader-report 'nnwarchive "Group does not exist"))
 207      (t
 208       (nnheader-report 'nnwarchive "Opened group %s" group)
 209       (nnheader-insert
 210        "211 %d %d %d %s\n" (or (cadr elem) 0) 1 (or (cadr elem) 0)
 211        (prin1-to-string group))
 212       t))))
 213
 214 (deffoo nnwarchive-close-group (group &optional server)
 215   (nnwarchive-possibly-change-server group server)
 216   (when (gnus-buffer-live-p nnwarchive-buffer)
 217     (save-excursion
 218       (set-buffer nnwarchive-buffer)
 219       (kill-buffer nnwarchive-buffer)))
 220   t)
 221
 222 (deffoo nnwarchive-request-article (article &optional group server buffer)
 223   (nnwarchive-possibly-change-server group server)
 224   (let (contents)
 225     (save-excursion
 226       (set-buffer nnwarchive-buffer)
 227       (goto-char (point-min))
 228       (let ((article1 (- article nnwarchive-article-offset)))
 229         (nnwarchive-url nnwarchive-article-url))
 230       (setq contents (funcall nnwarchive-article-dissect group article)))
 231     (when contents
 232       (save-excursion
 233         (set-buffer (or buffer nntp-server-buffer))
 234         (erase-buffer)
 235         (insert contents)
 236         (nnheader-report 'nnwarchive "Fetched article %s" article)
 237         (cons group article)))))
 238
 239 (deffoo nnwarchive-close-server (&optional server)
 240   (when (and (nnwarchive-server-opened server)
 241              (gnus-buffer-live-p nnwarchive-buffer))
 242     (save-excursion
 243       (set-buffer nnwarchive-buffer)
 244       (kill-buffer nnwarchive-buffer)))
 245   (nnoo-close-server 'nnwarchive server))
 246
 247 (deffoo nnwarchive-request-list (&optional server)
 248   (nnwarchive-possibly-change-server nil server)
 249   (save-excursion
 250     (set-buffer nnwarchive-buffer)
 251     (erase-buffer)
 252     (if nnwarchive-list-url
 253         (nnwarchive-url nnwarchive-list-url))
 254     (if nnwarchive-list-dissect
 255         (funcall nnwarchive-list-dissect))
 256     (nnwarchive-write-groups)
 257     (nnwarchive-generate-active))
 258   'active)
 259
 260 (deffoo nnwarchive-request-newgroups (date &optional server)
 261   (nnwarchive-possibly-change-server nil server)
 262   (nnwarchive-write-groups)
 263   (nnwarchive-generate-active)
 264   'active)
 265
 266 (deffoo nnwarchive-asynchronous-p ()
 267   nil)
 268
 269 (deffoo nnwarchive-server-opened (&optional server)
 270   nnwarchive-opened)
 271
 272 (deffoo nnwarchive-open-server (server &optional defs connectionless)
 273   (nnwarchive-init server)
 274   (unless (nnwarchive-server-opened server)
 275     (when nnwarchive-authentication
 276       (setq nnwarchive-login
 277             (or nnwarchive-login
 278                 (read-string
 279                  (format "Login at %s: " server)
 280                  user-mail-address)))
 281       (setq nnwarchive-passwd
 282             (or nnwarchive-passwd
 283                 (mail-source-read-passwd
 284                  (format "Password for %s at %s: "
 285                          nnwarchive-login server)))))
 286     (unless nnwarchive-groups
 287       (nnwarchive-read-groups))
 288     (save-excursion
 289       (set-buffer nnwarchive-buffer)
 290       (erase-buffer)
 291       (if nnwarchive-open-url
 292           (nnwarchive-url nnwarchive-open-url))
 293       (if nnwarchive-open-dissect
 294           (funcall nnwarchive-open-dissect))
 295       (setq nnwarchive-opened t)))
 296   t)
 297
 298 (nnoo-define-skeleton nnwarchive)
 299
 300 ;;; Internal functions
 301
 302 (defun nnwarchive-possibly-change-server (&optional group server)
 303   (nnwarchive-init server)
 304   (when (and server
 305              (not (nnwarchive-server-opened server)))
 306     (nnwarchive-open-server server)))
 307
 308 (defun nnwarchive-read-groups ()
 309   (let ((file (expand-file-name (concat "groups-" nnwarchive-address)
 310                                 nnwarchive-directory)))
 311     (when (file-exists-p file)
 312       (with-temp-buffer
 313         (insert-file-contents file)
 314         (goto-char (point-min))
 315         (setq nnwarchive-groups (read (current-buffer)))))))
 316
 317 (defun nnwarchive-write-groups ()
 318   (with-temp-file (expand-file-name (concat "groups-" nnwarchive-address)
 319                                     nnwarchive-directory)
 320     (prin1 nnwarchive-groups (current-buffer))))
 321
 322 (defun nnwarchive-init (server)
 323   "Initialize buffers and such."
 324   (let ((type (intern server)) (defs nnwarchive-type-definition) def)
 325     (cond
 326      ((equal server "")
 327       (setq type nnwarchive-default-type))
 328      ((assq type nnwarchive-type-definition) t)
 329      (t
 330       (setq type nil)
 331       (while (setq def (pop defs))
 332         (when (equal (cdr (assq 'address (cdr def))) server)
 333           (setq defs nil)
 334           (setq type (car def))))
 335       (unless type
 336         (error "Undefined server %s" server))))
 337     (setq nnwarchive-type type))
 338   (unless (file-exists-p nnwarchive-directory)
 339     (gnus-make-directory nnwarchive-directory))
 340   (unless (gnus-buffer-live-p nnwarchive-buffer)
 341     (setq nnwarchive-buffer
 342           (save-excursion
 343             (nnheader-set-temp-buffer
 344              (format " *nnwarchive %s %s*" nnwarchive-type server)))))
 345   (nnwarchive-set-default nnwarchive-type))
 346
 347 (defun nnwarchive-encode-www-form-urlencoded (pairs)
 348   "Return PAIRS encoded for forms."
 349   (mapconcat
 350    (function
 351     (lambda (data)
 352       (concat (w3-form-encode-xwfu (car data)) "="
 353               (w3-form-encode-xwfu (cdr data)))))
 354    pairs "&"))
 355
 356 (defun nnwarchive-fetch-form (url pairs)
 357   (let ((url-request-data (nnwarchive-encode-www-form-urlencoded pairs))
 358         (url-request-method "POST")
 359         (url-request-extra-headers
 360          '(("Content-type" . "application/x-www-form-urlencoded"))))
 361     (nnweb-insert url))
 362   t)
 363
 364 (defun nnwarchive-eval (expr)
 365   (cond
 366    ((consp expr)
 367     (cons (nnwarchive-eval (car expr)) (nnwarchive-eval (cdr expr))))
 368    ((symbolp expr)
 369     (eval expr))
 370    (t
 371     expr)))
 372
 373 (defun nnwarchive-url (xurl)
 374   (let ((url-confirmation-func 'identity))
 375     (cond
 376      ((eq (car xurl) 'post)
 377       (pop xurl)
 378       (nnwarchive-fetch-form (car xurl) (nnwarchive-eval (cdr xurl))))
 379      (t
 380       (nnweb-insert (apply 'format (nnwarchive-eval xurl)))))))
 381
 382 (defun nnwarchive-decode-entities ()
 383   (goto-char (point-min))
 384   (while (re-search-forward "&\\(#[0-9]+\\|[a-z]+\\);" nil t)
 385     (replace-match (char-to-string
 386                     (if (eq (aref (match-string 1) 0) ?\#)
 387                         (string-to-number (substring (match-string 1) 1))
 388                       (or (cdr (assq (intern (match-string 1))
 389                                      w3-html-entities))
 390                           ?#)))
 391                    t t)))
 392
 393 (defun nnwarchive-decode-entities-string (str)
 394   (with-temp-buffer
 395     (insert str)
 396     (nnwarchive-decode-entities)
 397     (buffer-substring (point-min) (point-max))))
 398
 399 (defun nnwarchive-remove-markup ()
 400   (goto-char (point-min))
 401   (while (search-forward "<!--" nil t)
 402     (delete-region (match-beginning 0)
 403                    (or (search-forward "-->" nil t)
 404                        (point-max))))
 405   (goto-char (point-min))
 406   (while (re-search-forward "<[^>]+>" nil t)
 407     (replace-match "" t t)))
 408
 409 (defun nnwarchive-date-to-date (sdate)
 410   (let ((elem (split-string sdate)))
 411     (concat (substring (nth 0 elem) 0 3) " "
 412             (substring (nth 1 elem) 0 3) " "
 413             (substring (nth 2 elem) 0 2) " "
 414             (substring (nth 3 elem) 1 6) " "
 415             (format-time-string "%Y") " "
 416             (nth 4 elem))))
 417
 418 (defun nnwarchive-generate-active ()
 419   (save-excursion
 420     (set-buffer nntp-server-buffer)
 421     (erase-buffer)
 422     (dolist (elem nnwarchive-groups)
 423       (insert (prin1-to-string (car elem))
 424               " " (number-to-string (or (cadr elem) 0)) " 1 y\n"))))
 425
 426 (defun nnwarchive-paged (articles)
 427   (let (art narts next)
 428     (while (setq art (pop articles))
 429       (when (and (>= art (or next 0))
 430                  (not (assq art nnwarchive-headers)))
 431         (push art narts)
 432         (setq next (+ art nnwarchive-xover-page-size))))
 433     narts))
 434
 435 ;; egroups
 436
 437 (defun nnwarchive-egroups-list-groups (groups)
 438   (save-excursion
 439     (let (articles)
 440       (set-buffer nnwarchive-buffer)
 441       (dolist (group groups)
 442         (erase-buffer)
 443         (nnwarchive-url nnwarchive-xover-last-url)
 444         (goto-char (point-min))
 445         (when (re-search-forward "of \\([0-9]+\\)</title>" nil t)
 446           (setq articles (string-to-number (match-string 1))))
 447         (let ((elem (assoc group nnwarchive-groups)))
 448           (if elem
 449               (setcar (cdr elem) articles)
 450             (push (list group articles "") nnwarchive-groups)))
 451         (setq nnwarchive-headers (cdr (assoc group nnwarchive-headers-cache)))
 452         (nnwarchive-egroups-xover group)
 453         (let ((elem (assoc group nnwarchive-headers-cache)))
 454           (if elem
 455               (setcdr elem nnwarchive-headers)
 456             (push (cons group nnwarchive-headers) nnwarchive-headers-cache)))))))
 457
 458 (defun nnwarchive-egroups-list ()
 459   (let ((case-fold-search t)
 460         group description elem articles)
 461     (goto-char (point-min))
 462     (while
 463         (re-search-forward
 464          "/group/\\([^/]+\\)/info\\.html[^>]+>[^>]+>[\040\t]*-[\040\t]*\\([^<]+\\)<"
 465          nil t)
 466       (setq group (match-string 1)
 467             description (match-string 2))
 468       (forward-line 1)
 469       (when (re-search-forward ">\\([0-9]+\\)<" nil t)
 470         (setq articles (string-to-number (match-string 1))))
 471       (if (setq elem (assoc group nnwarchive-groups))
 472           (setcar (cdr elem) articles)
 473         (push (list group articles description) nnwarchive-groups)))
 474     (nnwarchive-egroups-list-groups (mapcar 'identity nnwarchive-groups)))
 475   t)
 476
 477 (defun nnwarchive-egroups-xover (group)
 478   (let (article subject from date)
 479     (goto-char (point-min))
 480     (while (re-search-forward
 481             "<a href=\"/group/\\([^/]+\\)/\\([0-9]+\\)\\.html[^>]+>\\([^<]+\\)<"
 482             nil t)
 483       (setq group  (match-string 1)
 484             article (string-to-number (match-string 2))
 485             subject (match-string 3))
 486       (forward-line 1)
 487       (unless (assq article nnwarchive-headers)
 488         (if (looking-at "<td[^>]+><font[^>]+>\\([^<]+\\)</font>")
 489             (setq from (match-string 1)))
 490         (forward-line 1)
 491         (if (looking-at "<td[^>]+><font[^>]+>\\([^<]+\\)</font>")
 492             (setq date (identity (match-string 1))))
 493         (push (cons
 494                article
 495                (make-full-mail-header
 496                 article
 497                 (nnwarchive-decode-entities-string subject)
 498                 (nnwarchive-decode-entities-string from)
 499                 date
 500                 (concat "<" group "%"
 501                         (number-to-string article)
 502                         "@egroup.com>")
 503                 ""
 504                 0 0 "")) nnwarchive-headers))))
 505   nnwarchive-headers)
 506
 507 (defun nnwarchive-egroups-article (group articles)
 508   (goto-char (point-min))
 509   (if (search-forward "<pre>" nil t)
 510       (delete-region (point-min) (point)))
 511   (goto-char (point-max))
 512   (if (search-backward "</pre>" nil t)
 513       (delete-region (point) (point-max)))
 514   (goto-char (point-min))
 515   (while (re-search-forward "<a[^>]+>\\([^<]+\\)</a>" nil t)
 516     (replace-match "<\\1>"))
 517   (nnwarchive-decode-entities)
 518   (buffer-substring (point-min) (point-max)))
 519
 520 (defun nnwarchive-egroups-xover-files (group articles)
 521   (let (aux auxs)
 522     (setq auxs (nnwarchive-paged (sort articles '<)))
 523     (while (setq aux (pop auxs))
 524       (goto-char (point-max))
 525       (nnwarchive-url nnwarchive-xover-url))
 526     (if nnwarchive-xover-dissect
 527         (nnwarchive-egroups-xover group))))
 528
 529 ;; mail-archive
 530
 531 (defun nnwarchive-mail-archive-list-groups (groups)
 532   (save-excursion
 533     (let (articles)
 534       (set-buffer nnwarchive-buffer)
 535       (dolist (group groups)
 536         (erase-buffer)
 537         (nnwarchive-url nnwarchive-xover-last-url)
 538         (goto-char (point-min))
 539         (when (re-search-forward "msg\\([0-9]+\\)\\.html" nil t)
 540           (setq articles (1+ (string-to-number (match-string 1)))))
 541         (let ((elem (assoc group nnwarchive-groups)))
 542           (if elem
 543               (setcar (cdr elem) articles)
 544             (push (list group articles "") nnwarchive-groups)))
 545         (setq nnwarchive-headers (cdr (assoc group nnwarchive-headers-cache)))
 546         (nnwarchive-mail-archive-xover group)
 547         (let ((elem (assoc group nnwarchive-headers-cache)))
 548           (if elem
 549               (setcdr elem nnwarchive-headers)
 550             (push (cons group nnwarchive-headers)
 551                   nnwarchive-headers-cache)))))))
 552
 553 (defun nnwarchive-mail-archive-list ()
 554   (let ((case-fold-search t)
 555         group description elem articles)
 556     (goto-char (point-min))
 557     (while (re-search-forward "<a href=\"\\([^/]+\\)/\">\\([^>]+\\)<" nil t)
 558       (setq group (match-string 1)
 559             description (match-string 2))
 560       (forward-line 1)
 561       (setq articles 0)
 562       (if (setq elem (assoc group nnwarchive-groups))
 563           (setcar (cdr elem) articles)
 564         (push (list group articles description) nnwarchive-groups))))
 565   t)
 566
 567 (defun nnwarchive-mail-archive-xover (group)
 568   (let (article subject from date)
 569     (goto-char (point-min))
 570     (while (re-search-forward
 571             "<A[^>]*HREF=\"msg\\([0-9]+\\)\\.html[^>]+>\\([^<]+\\)<"
 572             nil t)
 573       (setq article (1+ (string-to-number (match-string 1)))
 574             subject (match-string 2))
 575       (forward-line 1)
 576       (unless (assq article nnwarchive-headers)
 577         (if (looking-at "<UL><LI><EM>From</EM>:\\([^&]+\\)&lt;\\([^&]+\\)&gt;")
 578             (progn
 579               (setq from (match-string 1)
 580                     date (identity (match-string 2))))
 581           (setq from "" date ""))
 582         (push (cons
 583                article
 584                (make-full-mail-header
 585                 article
 586                 (nnwarchive-decode-entities-string subject)
 587                 (nnwarchive-decode-entities-string from)
 588                 date
 589                 (format "<%05d%%%s>\n" (1- article) group)
 590                 ""
 591                 0 0 "")) nnwarchive-headers))))
 592   nnwarchive-headers)
 593
 594 (defun nnwarchive-mail-archive-xover-files (group articles)
 595   (unless nnwarchive-headers
 596     (erase-buffer)
 597     (nnwarchive-url nnwarchive-xover-last-url)
 598     (goto-char (point-min))
 599     (nnwarchive-mail-archive-xover group))
 600   (let ((minart (apply 'min articles))
 601         (min (apply 'min (mapcar 'car nnwarchive-headers)))
 602         (aux 2))
 603     (while (> min minart)
 604       (erase-buffer)
 605       (nnwarchive-url nnwarchive-xover-url)
 606       (nnwarchive-mail-archive-xover group)
 607       (setq min (apply 'min (mapcar 'car nnwarchive-headers))))))
 608
 609 (defun nnwarchive-mail-archive-article (group article)
 610   (let (p refs url mime file)
 611     (save-restriction
 612       (goto-char (point-min))
 613       (when (search-forward "<ul>" nil t)
 614         (forward-line)
 615         (delete-region (point-min) (point))
 616         (search-forward "</ul>" nil t)
 617         (forward-line)
 618         (narrow-to-region (point-min) (point))
 619         (nnwarchive-remove-markup)
 620         (nnwarchive-decode-entities)
 621         (goto-char (point-min))
 622         (delete-blank-lines)
 623         (goto-char (point-max))
 624         (widen)
 625         (insert "\n"))
 626       (setq p (point))
 627       (when (search-forward "X-Body-of-Message" nil t)
 628           (forward-line)
 629           (delete-region p (point))
 630           (search-forward "X-Body-of-Message-End" nil t)
 631           (beginning-of-line)
 632           (save-restriction
 633             (narrow-to-region p (point))
 634             (goto-char (point-min))
 635             (if (looking-at "<PRE>")
 636                 (progn
 637                   (delete-char 5)
 638                   (setq p (point))
 639                   (when (search-forward "</PRE>" nil t)
 640                     (goto-char (match-beginning 0))
 641                     (delete-char 6)
 642                     (save-restriction
 643                       (narrow-to-region p (point))
 644                       (nnwarchive-remove-markup)
 645                       (nnwarchive-decode-entities)
 646                       (goto-char (point-max))))
 647                   (while (looking-at
 648                           "[\040\n\r\t]*<P><A HREF=\"\\([^\"]+\\)[^>]*><[^>]*>\\([^<]+\\)")
 649                     (setq url (match-string 1)
 650                           file (match-string 2))
 651                     (goto-char (match-beginning 1))
 652                     (beginning-of-line)
 653                     (setq p (point))
 654                     (delete-region p (progn (forward-line) (point)))
 655                     (insert (format "http://www.mail-archive.com/%s/%s\n"
 656                                     group url))))
 657               (setq mime t))
 658             (goto-char (point-max))))
 659       (setq p (point))
 660       (when (search-forward "X-References-End" nil t)
 661         (narrow-to-region p (point))
 662         (goto-char (point-min))
 663         (while (re-search-forward "msg\\([0-9]+\\)\\.html" nil t)
 664           (push (concat "<" (match-string 1) "%" group ">") refs))
 665         (widen))
 666       (delete-region p (point-max))
 667       (goto-char (point-min))
 668       (insert (format "Message-ID: <%05d%%%s>\n" (1- article) group))
 669       (when refs
 670         (insert "References:")
 671         (while refs
 672           (insert " " (pop refs)))
 673         (insert "\n"))
 674       (when mime
 675         (insert "MIME-Version: 1.0\n"
 676                 "Content-Type: text/html\n")))
 677     (buffer-string (point-min) (point-max))))
 678
 679 (provide 'nnwarchive)
 680
 681 ;;; nnwarchive.el ends here