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 (defvoo nnwarchive-type nil
 109     "The type of nnwarchive.")
 110
 111 (defvoo nnwarchive-address ""
 112   "The address of nnwarchive.")
 113
 114 (defvoo nnwarchive-login nil
 115   "Your login name for the group.")
 116
 117 (defvoo nnwarchive-passwd nil
 118   "Your password for the group.")
 119
 120 (defvoo nnwarchive-groups nil)
 121
 122 (defvoo nnwarchive-headers-cache nil)
 123
 124 (defvoo nnwarchive-opened nil)
 125
 126 (defvoo nnwarchive-authentication nil)
 127
 128 (defvoo nnwarchive-xover-is-evil nil) ;; not implemented
 129
 130 (defconst nnwarchive-version "nnwarchive 1.0")
 131
 132 ;;; Internal variables
 133
 134 (defvoo nnwarchive-open-url nil)
 135 (defvoo nnwarchive-open-dissect nil)
 136
 137 (defvoo nnwarchive-list-url nil)
 138 (defvoo nnwarchive-list-dissect nil)
 139 (defvoo nnwarchive-list-groups nil)
 140
 141 (defvoo nnwarchive-xover-files nil)
 142 (defvoo nnwarchive-xover-url nil)
 143 (defvoo nnwarchive-xover-last-url nil)
 144 (defvoo nnwarchive-xover-dissect nil)
 145 (defvoo nnwarchive-xover-page-size nil)
 146
 147 (defvoo nnwarchive-article-url nil)
 148 (defvoo nnwarchive-article-dissect nil)
 149 (defvoo nnwarchive-xover-files nil)
 150 (defvoo nnwarchive-article-offset 0)
 151
 152 (defvoo nnwarchive-buffer nil)
 153
 154 (defvar nnwarchive-headers nil)
 155
 156
 157 ;;; Interface functions
 158
 159 (nnoo-define-basics nnwarchive)
 160
 161 (defun nnwarchive-set-default (type)
 162   (let ((defs (cdr (assq type nnwarchive-type-definition)))
 163         def)
 164     (dolist (def defs)
 165       (set (intern (concat "nnwarchive-" (symbol-name (car def))))
 166            (cdr def)))))
 167
 168 (deffoo nnwarchive-retrieve-headers (articles &optional group server fetch-old)
 169   (nnwarchive-possibly-change-server group server)
 170   (setq nnwarchive-headers (cdr (assoc group nnwarchive-headers-cache)))
 171   (save-excursion
 172     (set-buffer nnwarchive-buffer)
 173     (erase-buffer)
 174     (funcall nnwarchive-xover-files group articles))
 175   (save-excursion
 176     (set-buffer nntp-server-buffer)
 177     (erase-buffer)
 178     (let (header)
 179       (dolist (art articles)
 180         (if (setq header (assq art nnwarchive-headers))
 181             (nnheader-insert-nov (cdr header))))))
 182   (let ((elem (assoc group nnwarchive-headers-cache)))
 183     (if elem
 184         (setcdr elem nnwarchive-headers)
 185       (push (cons group nnwarchive-headers) nnwarchive-headers-cache)))
 186   'nov)
 187
 188 (deffoo nnwarchive-retrieve-groups (groups &optional server)
 189   "Retrieve group info on GROUPS."
 190   (nnwarchive-possibly-change-server nil server)
 191   (if nnwarchive-list-groups
 192       (funcall nnwarchive-list-groups groups))
 193   (nnwarchive-write-groups)
 194   (nnwarchive-generate-active)
 195   'active)
 196
 197 (deffoo nnwarchive-request-group (group &optional server dont-check)
 198   (nnwarchive-possibly-change-server nil server)
 199   (if nnwarchive-list-groups
 200       (funcall nnwarchive-list-groups (list group)))
 201   (nnwarchive-write-groups)
 202   (let ((elem (assoc group nnwarchive-groups)))
 203     (cond
 204      ((not elem)
 205       (nnheader-report 'nnwarchive "Group does not exist"))
 206      (t
 207       (nnheader-report 'nnwarchive "Opened group %s" group)
 208       (nnheader-insert
 209        "211 %d %d %d %s\n" (or (cadr elem) 0) 1 (or (cadr elem) 0)
 210        (prin1-to-string group))
 211       t))))
 212
 213 (deffoo nnwarchive-close-group (group &optional server)
 214   (nnwarchive-possibly-change-server group server)
 215   (when (gnus-buffer-live-p nnwarchive-buffer)
 216     (save-excursion
 217       (set-buffer nnwarchive-buffer)
 218       (kill-buffer nnwarchive-buffer)))
 219   t)
 220
 221 (deffoo nnwarchive-request-article (article &optional group server buffer)
 222   (nnwarchive-possibly-change-server group server)
 223   (let (contents)
 224     (save-excursion
 225       (set-buffer nnwarchive-buffer)
 226       (goto-char (point-min))
 227       (let ((article1 (- article nnwarchive-article-offset)))
 228         (nnwarchive-url nnwarchive-article-url))
 229       (setq contents (funcall nnwarchive-article-dissect group article)))
 230     (when contents
 231       (save-excursion
 232         (set-buffer (or buffer nntp-server-buffer))
 233         (erase-buffer)
 234         (insert contents)
 235         (nnheader-report 'nnwarchive "Fetched article %s" article)
 236         (cons group article)))))
 237
 238 (deffoo nnwarchive-close-server (&optional server)
 239   (when (and (nnwarchive-server-opened server)
 240              (gnus-buffer-live-p nnwarchive-buffer))
 241     (save-excursion
 242       (set-buffer nnwarchive-buffer)
 243       (kill-buffer nnwarchive-buffer)))
 244   (nnoo-close-server 'nnwarchive server))
 245
 246 (deffoo nnwarchive-request-list (&optional server)
 247   (nnwarchive-possibly-change-server nil server)
 248   (save-excursion
 249     (set-buffer nnwarchive-buffer)
 250     (erase-buffer)
 251     (if nnwarchive-list-url
 252         (nnwarchive-url nnwarchive-list-url))
 253     (if nnwarchive-list-dissect
 254         (funcall nnwarchive-list-dissect))
 255     (nnwarchive-write-groups)
 256     (nnwarchive-generate-active))
 257   'active)
 258
 259 (deffoo nnwarchive-request-newgroups (date &optional server)
 260   (nnwarchive-possibly-change-server nil server)
 261   (nnwarchive-write-groups)
 262   (nnwarchive-generate-active)
 263   'active)
 264
 265 (deffoo nnwarchive-asynchronous-p ()
 266   nil)
 267
 268 (deffoo nnwarchive-server-opened (&optional server)
 269   nnwarchive-opened)
 270
 271 (deffoo nnwarchive-open-server (server &optional defs connectionless)
 272   (nnwarchive-init server)
 273   (unless (nnwarchive-server-opened server)
 274     (when nnwarchive-authentication
 275       (setq nnwarchive-login
 276             (or nnwarchive-login
 277                 (read-string
 278                  (format "Login at %s: " server)
 279                  user-mail-address)))
 280       (setq nnwarchive-passwd
 281             (or nnwarchive-passwd
 282                 (mail-source-read-passwd
 283                  (format "Password for %s at %s: "
 284                          nnwarchive-login server)))))
 285     (unless nnwarchive-groups
 286       (nnwarchive-read-groups))
 287     (save-excursion
 288       (set-buffer nnwarchive-buffer)
 289       (erase-buffer)
 290       (if nnwarchive-open-url
 291           (nnwarchive-url nnwarchive-open-url))
 292       (if nnwarchive-open-dissect
 293           (funcall nnwarchive-open-dissect))
 294       (setq nnwarchive-opened t)))
 295   t)
 296
 297 (nnoo-define-skeleton nnwarchive)
 298
 299 ;;; Internal functions
 300
 301 (defun nnwarchive-possibly-change-server (&optional group server)
 302   (nnwarchive-init server)
 303   (when (and server
 304              (not (nnwarchive-server-opened server)))
 305     (nnwarchive-open-server server)))
 306
 307 (defun nnwarchive-read-groups ()
 308   (let ((file (expand-file-name (concat "groups-" nnwarchive-address)
 309                                 nnwarchive-directory)))
 310     (when (file-exists-p file)
 311       (with-temp-buffer
 312         (insert-file-contents file)
 313         (goto-char (point-min))
 314         (setq nnwarchive-groups (read (current-buffer)))))))
 315
 316 (defun nnwarchive-write-groups ()
 317   (with-temp-file (expand-file-name (concat "groups-" nnwarchive-address)
 318                                     nnwarchive-directory)
 319     (prin1 nnwarchive-groups (current-buffer))))
 320
 321 (defun nnwarchive-init (server)
 322   "Initialize buffers and such."
 323   (let ((type (intern server)) (defs nnwarchive-type-definition) def)
 324     (cond
 325      ((equal server "")
 326       (setq type nnwarchive-default-type))
 327      ((assq type nnwarchive-type-definition) t)
 328      (t
 329       (setq type nil)
 330       (while (setq def (pop defs))
 331         (when (equal (cdr (assq 'address (cdr def))) server)
 332           (setq defs nil)
 333           (setq type (car def))))
 334       (unless type
 335         (error "Undefined server %s" server))))
 336     (setq nnwarchive-type type))
 337   (unless (file-exists-p nnwarchive-directory)
 338     (gnus-make-directory nnwarchive-directory))
 339   (unless (gnus-buffer-live-p nnwarchive-buffer)
 340     (setq nnwarchive-buffer
 341           (save-excursion
 342             (nnheader-set-temp-buffer
 343              (format " *nnwarchive %s %s*" nnwarchive-type server)))))
 344   (nnwarchive-set-default nnwarchive-type))
 345
 346 (defun nnwarchive-encode-www-form-urlencoded (pairs)
 347   "Return PAIRS encoded for forms."
 348   (mapconcat
 349    (function
 350     (lambda (data)
 351       (concat (w3-form-encode-xwfu (car data)) "="
 352               (w3-form-encode-xwfu (cdr data)))))
 353    pairs "&"))
 354
 355 (defun nnwarchive-fetch-form (url pairs)
 356   (let ((url-request-data (nnwarchive-encode-www-form-urlencoded pairs))
 357         (url-request-method "POST")
 358         (url-request-extra-headers
 359          '(("Content-type" . "application/x-www-form-urlencoded"))))
 360     (nnweb-insert url))
 361   t)
 362
 363 (defun nnwarchive-eval (expr)
 364   (cond
 365    ((consp expr)
 366     (cons (nnwarchive-eval (car expr)) (nnwarchive-eval (cdr expr))))
 367    ((symbolp expr)
 368     (eval expr))
 369    (t
 370     expr)))
 371
 372 (defun nnwarchive-url (xurl)
 373   (let ((url-confirmation-func 'identity))
 374     (cond
 375      ((eq (car xurl) 'post)
 376       (pop xurl)
 377       (nnwarchive-fetch-form (car xurl) (nnwarchive-eval (cdr xurl))))
 378      (t
 379       (nnweb-insert (apply 'format (nnwarchive-eval xurl)))))))
 380
 381 (defun nnwarchive-decode-entities ()
 382   (goto-char (point-min))
 383   (while (re-search-forward "&\\(#[0-9]+\\|[a-z]+\\);" nil t)
 384     (replace-match (char-to-string
 385                     (if (eq (aref (match-string 1) 0) ?\#)
 386                         (string-to-number (substring (match-string 1) 1))
 387                       (or (cdr (assq (intern (match-string 1))
 388                                      w3-html-entities))
 389                           ?#)))
 390                    t t)))
 391
 392 (defun nnwarchive-decode-entities-string (str)
 393   (with-temp-buffer
 394     (insert str)
 395     (nnwarchive-decode-entities)
 396     (buffer-substring (point-min) (point-max))))
 397
 398 (defun nnwarchive-remove-markup ()
 399   (goto-char (point-min))
 400   (while (search-forward "<!--" nil t)
 401     (delete-region (match-beginning 0)
 402                    (or (search-forward "-->" nil t)
 403                        (point-max))))
 404   (goto-char (point-min))
 405   (while (re-search-forward "<[^>]+>" nil t)
 406     (replace-match "" t t)))
 407
 408 (defun nnwarchive-date-to-date (sdate)
 409   (let ((elem (split-string sdate)))
 410     (concat (substring (nth 0 elem) 0 3) " "
 411             (substring (nth 1 elem) 0 3) " "
 412             (substring (nth 2 elem) 0 2) " "
 413             (substring (nth 3 elem) 1 6) " "
 414             (format-time-string "%Y") " "
 415             (nth 4 elem))))
 416
 417 (defun nnwarchive-generate-active ()
 418   (save-excursion
 419     (set-buffer nntp-server-buffer)
 420     (erase-buffer)
 421     (dolist (elem nnwarchive-groups)
 422       (insert (prin1-to-string (car elem))
 423               " " (number-to-string (or (cadr elem) 0)) " 1 y\n"))))
 424
 425 (defun nnwarchive-paged (articles)
 426   (let (art narts next)
 427     (while (setq art (pop articles))
 428       (when (and (>= art (or next 0))
 429                  (not (assq art nnwarchive-headers)))
 430         (push art narts)
 431         (setq next (+ art nnwarchive-xover-page-size))))
 432     narts))
 433
 434 ;; egroups
 435
 436 (defun nnwarchive-egroups-list-groups (groups)
 437   (save-excursion
 438     (let (articles)
 439       (set-buffer nnwarchive-buffer)
 440       (dolist (group groups)
 441         (erase-buffer)
 442         (nnwarchive-url nnwarchive-xover-last-url)
 443         (goto-char (point-min))
 444         (when (re-search-forward "of \\([0-9]+\\)</title>" nil t)
 445           (setq articles (string-to-number (match-string 1))))
 446         (let ((elem (assoc group nnwarchive-groups)))
 447           (if elem
 448               (setcar (cdr elem) articles)
 449             (push (list group articles "") nnwarchive-groups)))
 450         (setq nnwarchive-headers (cdr (assoc group nnwarchive-headers-cache)))
 451         (nnwarchive-egroups-xover group)
 452         (let ((elem (assoc group nnwarchive-headers-cache)))
 453           (if elem
 454               (setcdr elem nnwarchive-headers)
 455             (push (cons group nnwarchive-headers) nnwarchive-headers-cache)))))))
 456
 457 (defun nnwarchive-egroups-list ()
 458   (let ((case-fold-search t)
 459         group description elem articles)
 460     (goto-char (point-min))
 461     (while
 462         (re-search-forward
 463          "/group/\\([^/]+\\)/info\\.html[^>]+>[^>]+>[\040\t]*-[\040\t]*\\([^<]+\\)<"
 464          nil t)
 465       (setq group (match-string 1)
 466             description (match-string 2))
 467       (forward-line 1)
 468       (when (re-search-forward ">\\([0-9]+\\)<" nil t)
 469         (setq articles (string-to-number (match-string 1))))
 470       (if (setq elem (assoc group nnwarchive-groups))
 471           (setcar (cdr elem) articles)
 472         (push (list group articles description) nnwarchive-groups))))
 473   t)
 474
 475 (defun nnwarchive-egroups-xover (group)
 476   (let (article subject from date)
 477     (goto-char (point-min))
 478     (while (re-search-forward
 479             "<a href=\"/group/\\([^/]+\\)/\\([0-9]+\\)\\.html[^>]+>\\([^<]+\\)<"
 480             nil t)
 481       (setq group  (match-string 1)
 482             article (string-to-number (match-string 2))
 483             subject (match-string 3))
 484       (forward-line 1)
 485       (unless (assq article nnwarchive-headers)
 486         (if (looking-at "<td[^>]+><font[^>]+>\\([^<]+\\)</font>")
 487             (setq from (match-string 1)))
 488         (forward-line 1)
 489         (if (looking-at "<td[^>]+><font[^>]+>\\([^<]+\\)</font>")
 490             (setq date (identity (match-string 1))))
 491         (push (cons
 492                article
 493                (make-full-mail-header
 494                 article
 495                 (nnwarchive-decode-entities-string subject)
 496                 (nnwarchive-decode-entities-string from)
 497                 date
 498                 (concat "<" group "%"
 499                         (number-to-string article)
 500                         "@egroup.com>")
 501                 ""
 502                 0 0 "")) nnwarchive-headers))))
 503   nnwarchive-headers)
 504
 505 (defun nnwarchive-egroups-article (group articles)
 506   (goto-char (point-min))
 507   (if (search-forward "<pre>" nil t)
 508       (delete-region (point-min) (point)))
 509   (goto-char (point-max))
 510   (if (search-backward "</pre>" nil t)
 511       (delete-region (point) (point-max)))
 512   (goto-char (point-min))
 513   (while (re-search-forward "<a[^>]+>\\([^<]+\\)</a>" nil t)
 514     (replace-match "<\\1>"))
 515   (nnwarchive-decode-entities)
 516   (buffer-substring (point-min) (point-max)))
 517
 518 (defun nnwarchive-egroups-xover-files (group articles)
 519   (let (aux auxs)
 520     (setq auxs (nnwarchive-paged (sort articles '<)))
 521     (while (setq aux (pop auxs))
 522       (goto-char (point-max))
 523       (nnwarchive-url nnwarchive-xover-url))
 524     (if nnwarchive-xover-dissect
 525         (nnwarchive-egroups-xover group))))
 526
 527 ;; mail-archive
 528
 529 (defun nnwarchive-mail-archive-list-groups (groups)
 530   (save-excursion
 531     (let (articles)
 532       (set-buffer nnwarchive-buffer)
 533       (dolist (group groups)
 534         (erase-buffer)
 535         (nnwarchive-url nnwarchive-xover-last-url)
 536         (goto-char (point-min))
 537         (when (re-search-forward "msg\\([0-9]+\\)\\.html" nil t)
 538           (setq articles (1+ (string-to-number (match-string 1)))))
 539         (let ((elem (assoc group nnwarchive-groups)))
 540           (if elem
 541               (setcar (cdr elem) articles)
 542             (push (list group articles "") nnwarchive-groups)))
 543         (setq nnwarchive-headers (cdr (assoc group nnwarchive-headers-cache)))
 544         (nnwarchive-mail-archive-xover group)
 545         (let ((elem (assoc group nnwarchive-headers-cache)))
 546           (if elem
 547               (setcdr elem nnwarchive-headers)
 548             (push (cons group nnwarchive-headers)
 549                   nnwarchive-headers-cache)))))))
 550
 551 (defun nnwarchive-mail-archive-list ()
 552   (let ((case-fold-search t)
 553         group description elem articles)
 554     (goto-char (point-min))
 555     (while (re-search-forward "<a href=\"\\([^/]+\\)/\">\\([^>]+\\)<" nil t)
 556       (setq group (match-string 1)
 557             description (match-string 2))
 558       (forward-line 1)
 559       (setq articles 0)
 560       (if (setq elem (assoc group nnwarchive-groups))
 561           (setcar (cdr elem) articles)
 562         (push (list group articles description) nnwarchive-groups))))
 563   t)
 564
 565 (defun nnwarchive-mail-archive-xover (group)
 566   (let (article subject from date)
 567     (goto-char (point-min))
 568     (while (re-search-forward
 569             "<A[^>]*HREF=\"msg\\([0-9]+\\)\\.html[^>]+>\\([^<]+\\)<"
 570             nil t)
 571       (setq article (1+ (string-to-number (match-string 1)))
 572             subject (match-string 2))
 573       (forward-line 1)
 574       (unless (assq article nnwarchive-headers)
 575         (if (looking-at "<UL><LI><EM>From</EM>:\\([^&]+\\)&lt;\\([^&]+\\)&gt;")
 576             (progn
 577               (setq from (match-string 1)
 578                     date (identity (match-string 2))))
 579           (setq from "" date ""))
 580         (push (cons
 581                article
 582                (make-full-mail-header
 583                 article
 584                 (nnwarchive-decode-entities-string subject)
 585                 (nnwarchive-decode-entities-string from)
 586                 date
 587                 (format "<%05d%%%s>\n" (1- article) group)
 588                 ""
 589                 0 0 "")) nnwarchive-headers))))
 590   nnwarchive-headers)
 591
 592 (defun nnwarchive-mail-archive-xover-files (group articles)
 593   (unless nnwarchive-headers
 594     (erase-buffer)
 595     (nnwarchive-url nnwarchive-xover-last-url)
 596     (goto-char (point-min))
 597     (nnwarchive-mail-archive-xover group))
 598   (let ((minart (apply 'min articles))
 599         (min (apply 'min (mapcar 'car nnwarchive-headers)))
 600         (aux 2))
 601     (while (> min minart)
 602       (erase-buffer)
 603       (nnwarchive-url nnwarchive-xover-url)
 604       (nnwarchive-mail-archive-xover group)
 605       (setq min (apply 'min (mapcar 'car nnwarchive-headers))))))
 606
 607 (defun nnwarchive-mail-archive-article (group article)
 608   (let (p refs url mime file)
 609     (save-restriction
 610       (goto-char (point-min))
 611       (when (search-forward "<ul>" nil t)
 612         (forward-line)
 613         (delete-region (point-min) (point))
 614         (search-forward "</ul>" nil t)
 615         (forward-line)
 616         (narrow-to-region (point-min) (point))
 617         (nnwarchive-remove-markup)
 618         (nnwarchive-decode-entities)
 619         (goto-char (point-min))
 620         (delete-blank-lines)
 621         (goto-char (point-max))
 622         (widen)
 623         (insert "\n"))
 624       (setq p (point))
 625       (when (search-forward "X-Body-of-Message" nil t)
 626           (forward-line)
 627           (delete-region p (point))
 628           (search-forward "X-Body-of-Message-End" nil t)
 629           (beginning-of-line)
 630           (save-restriction
 631             (narrow-to-region p (point))
 632             (goto-char (point-min))
 633             (if (looking-at "<PRE>")
 634                 (progn
 635                   (delete-char 5)
 636                   (setq p (point))
 637                   (when (search-forward "</PRE>" nil t)
 638                     (goto-char (match-beginning 0))
 639                     (delete-char 6)
 640                     (save-restriction
 641                       (narrow-to-region p (point))
 642                       (nnwarchive-remove-markup)
 643                       (nnwarchive-decode-entities)
 644                       (goto-char (point-max))))
 645                   (while (looking-at
 646                           "[\040\n\r\t]*<P><A HREF=\"\\([^\"]+\\)[^>]*><[^>]*>\\([^<]+\\)")
 647                     (setq url (match-string 1)
 648                           file (match-string 2))
 649                     (goto-char (match-beginning 1))
 650                     (beginning-of-line)
 651                     (setq p (point))
 652                     (delete-region p (progn (forward-line) (point)))
 653                     (insert (format "http://www.mail-archive.com/%s/%s\n"
 654                                     group url))))
 655               (setq mime t))
 656             (goto-char (point-max))))
 657       (setq p (point))
 658       (when (search-forward "X-References-End" nil t)
 659         (narrow-to-region p (point))
 660         (goto-char (point-min))
 661         (while (re-search-forward "msg\\([0-9]+\\)\\.html" nil t)
 662           (push (concat "<" (match-string 1) "%" group ">") refs))
 663         (widen))
 664       (delete-region p (point-max))
 665       (goto-char (point-min))
 666       (insert (format "Message-ID: <%05d%%%s>\n" (1- article) group))
 667       (when refs
 668         (insert "References:")
 669         (while refs
 670           (insert " " (pop refs)))
 671         (insert "\n"))
 672       (when mime
 673         (insert "MIME-Version: 1.0\n"
 674                 "Content-Type: text/html\n")))
 675     (buffer-string (point-min) (point-max))))
 676
 677 (provide 'nnwarchive)
 678
 679 ;;; nnwarchive.el ends here