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

   1 ;;; nnweb.el --- retrieving articles via web search engines
   2 ;; Copyright (C) 1996,97,98,99 Free Software Foundation, Inc.
   3
   4 ;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
   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 by
  11 ;; the Free Software Foundation; either version 2, or (at your option)
  12 ;; any later version.
  13
  14 ;; GNU Emacs is distributed in the hope that it will be useful,
  15 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  16 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  17 ;; GNU 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
  27 ;; backend to work.
  28
  29 ;;; Code:
  30
  31 (eval-when-compile (require 'cl))
  32
  33 (require 'nnoo)
  34 (require 'message)
  35 (require 'gnus-util)
  36 (require 'gnus)
  37 (require 'nnmail)
  38 (require 'mm-util)
  39 (eval-when-compile
  40   (ignore-errors
  41     (require 'w3)
  42     (require 'url)
  43     (require 'w3-forms)))
  44 ;; Report failure to find w3 at load time if appropriate.
  45 (eval '(progn
  46          (require 'w3)
  47          (require 'url)
  48          (require 'w3-forms)))
  49
  50 (nnoo-declare nnweb)
  51
  52 (defvoo nnweb-directory (nnheader-concat gnus-directory "nnweb/")
  53   "Where nnweb will save its files.")
  54
  55 (defvoo nnweb-type 'dejanews
  56   "What search engine type is being used.
  57 Valid types include `dejanews', `dejanewsold', `reference',
  58 and `altavista'.")
  59
  60 (defvar nnweb-type-definition
  61   '((dejanews
  62      (article . nnweb-dejanews-wash-article)
  63      (map . nnweb-dejanews-create-mapping)
  64      (search . nnweb-dejanews-search)
  65      (address . "http://www.deja.com/=dnc/qs.xp")
  66      (identifier . nnweb-dejanews-identity))
  67     (dejanewsold
  68      (article . nnweb-dejanews-wash-article)
  69      (map . nnweb-dejanews-create-mapping)
  70      (search . nnweb-dejanewsold-search)
  71      (address . "http://wwww.deja.com/dnquery.xp")
  72      (identifier . nnweb-dejanews-identity))
  73     (reference
  74      (article . nnweb-reference-wash-article)
  75      (map . nnweb-reference-create-mapping)
  76      (search . nnweb-reference-search)
  77      (address . "http://www.reference.com/cgi-bin/pn/go")
  78      (identifier . identity))
  79     (altavista
  80      (article . nnweb-altavista-wash-article)
  81      (map . nnweb-altavista-create-mapping)
  82      (search . nnweb-altavista-search)
  83      (address . "http://www.altavista.digital.com/cgi-bin/query")
  84      (id . "/cgi-bin/news?id@%s")
  85      (identifier . identity)))
  86   "Type-definition alist.")
  87
  88 (defvoo nnweb-search nil
  89   "Search string to feed to DejaNews.")
  90
  91 (defvoo nnweb-max-hits 999
  92   "Maximum number of hits to display.")
  93
  94 (defvoo nnweb-ephemeral-p nil
  95   "Whether this nnweb server is ephemeral.")
  96
  97 ;;; Internal variables
  98
  99 (defvoo nnweb-articles nil)
 100 (defvoo nnweb-buffer nil)
 101 (defvoo nnweb-group-alist nil)
 102 (defvoo nnweb-group nil)
 103 (defvoo nnweb-hashtb nil)
 104
 105 ;;; Interface functions
 106
 107 (nnoo-define-basics nnweb)
 108
 109 (deffoo nnweb-retrieve-headers (articles &optional group server fetch-old)
 110   (nnweb-possibly-change-server group server)
 111   (save-excursion
 112     (set-buffer nntp-server-buffer)
 113     (erase-buffer)
 114     (let (article header)
 115       (while (setq article (pop articles))
 116         (when (setq header (cadr (assq article nnweb-articles)))
 117           (nnheader-insert-nov header)))
 118       'nov)))
 119
 120 (deffoo nnweb-request-scan (&optional group server)
 121   (nnweb-possibly-change-server group server)
 122   (setq nnweb-hashtb (gnus-make-hashtable 4095))
 123   (funcall (nnweb-definition 'map))
 124   (unless nnweb-ephemeral-p
 125     (nnweb-write-active)
 126     (nnweb-write-overview group)))
 127
 128 (deffoo nnweb-request-group (group &optional server dont-check)
 129   (nnweb-possibly-change-server nil server)
 130   (when (and group
 131              (not (equal group nnweb-group))
 132              (not nnweb-ephemeral-p))
 133     (let ((info (assoc group nnweb-group-alist)))
 134       (when info
 135         (setq nnweb-group group)
 136         (setq nnweb-type (nth 2 info))
 137         (setq nnweb-search (nth 3 info))
 138         (unless dont-check
 139           (nnweb-read-overview group)))))
 140   (unless dont-check
 141     (nnweb-request-scan group))
 142   (cond
 143    ((not nnweb-articles)
 144     (nnheader-report 'nnweb "No matching articles"))
 145    (t
 146     (let ((active (if nnweb-ephemeral-p
 147                       (cons (caar nnweb-articles)
 148                             (caar (last nnweb-articles)))
 149                     (cadr (assoc group nnweb-group-alist)))))
 150       (nnheader-report 'nnweb "Opened group %s" group)
 151       (nnheader-insert
 152        "211 %d %d %d %s\n" (length nnweb-articles)
 153        (car active) (cdr active) group)))))
 154
 155 (deffoo nnweb-close-group (group &optional server)
 156   (nnweb-possibly-change-server group server)
 157   (when (gnus-buffer-live-p nnweb-buffer)
 158     (save-excursion
 159       (set-buffer nnweb-buffer)
 160       (set-buffer-modified-p nil)
 161       (kill-buffer nnweb-buffer)))
 162   t)
 163
 164 (deffoo nnweb-request-article (article &optional group server buffer)
 165   (nnweb-possibly-change-server group server)
 166   (save-excursion
 167     (set-buffer (or buffer nntp-server-buffer))
 168     (let* ((header (cadr (assq article nnweb-articles)))
 169            (url (and header (mail-header-xref header))))
 170       (when (or (and url
 171                      (nnweb-fetch-url url))
 172                 (and (stringp article)
 173                      (nnweb-definition 'id t)
 174                      (let ((fetch (nnweb-definition 'id))
 175                            art)
 176                        (when (string-match "^<\\(.*\\)>$" article)
 177                          (setq art (match-string 1 article)))
 178                        (and fetch
 179                             art
 180                             (nnweb-fetch-url
 181                              (format fetch article))))))
 182         (unless nnheader-callback-function
 183           (funcall (nnweb-definition 'article))
 184           (nnweb-decode-entities))
 185         (nnheader-report 'nnweb "Fetched article %s" article)
 186         t))))
 187
 188 (deffoo nnweb-close-server (&optional server)
 189   (when (and (nnweb-server-opened server)
 190              (gnus-buffer-live-p nnweb-buffer))
 191     (save-excursion
 192       (set-buffer nnweb-buffer)
 193       (set-buffer-modified-p nil)
 194       (kill-buffer nnweb-buffer)))
 195   (nnoo-close-server 'nnweb server))
 196
 197 (deffoo nnweb-request-list (&optional server)
 198   (nnweb-possibly-change-server nil server)
 199   (save-excursion
 200     (set-buffer nntp-server-buffer)
 201     (nnmail-generate-active nnweb-group-alist)
 202     t))
 203
 204 (deffoo nnweb-request-update-info (group info &optional server)
 205   (nnweb-possibly-change-server group server)
 206   ;;(setcar (cddr info) nil)
 207   )
 208
 209 (deffoo nnweb-asynchronous-p ()
 210   t)
 211
 212 (deffoo nnweb-request-create-group (group &optional server args)
 213   (nnweb-possibly-change-server nil server)
 214   (nnweb-request-delete-group group)
 215   (push `(,group ,(cons 1 0) ,@args) nnweb-group-alist)
 216   (nnweb-write-active)
 217   t)
 218
 219 (deffoo nnweb-request-delete-group (group &optional force server)
 220   (nnweb-possibly-change-server group server)
 221   (gnus-pull group nnweb-group-alist t)
 222   (nnweb-write-active)
 223   (gnus-delete-file (nnweb-overview-file group))
 224   t)
 225
 226 (nnoo-define-skeleton nnweb)
 227
 228 ;;; Internal functions
 229
 230 (defun nnweb-read-overview (group)
 231   "Read the overview of GROUP and build the map."
 232   (when (file-exists-p (nnweb-overview-file group))
 233     (with-temp-buffer
 234       (nnheader-insert-file-contents (nnweb-overview-file group))
 235       (goto-char (point-min))
 236       (let (header)
 237         (while (not (eobp))
 238           (setq header (nnheader-parse-nov))
 239           (forward-line 1)
 240           (push (list (mail-header-number header)
 241                       header (mail-header-xref header))
 242                 nnweb-articles)
 243           (nnweb-set-hashtb header (car nnweb-articles)))))))
 244
 245 (defun nnweb-write-overview (group)
 246   "Write the overview file for GROUP."
 247   (with-temp-file (nnweb-overview-file group)
 248     (let ((articles nnweb-articles))
 249       (while articles
 250         (nnheader-insert-nov (cadr (pop articles)))))))
 251
 252 (defun nnweb-set-hashtb (header data)
 253   (gnus-sethash (nnweb-identifier (mail-header-xref header))
 254                 data nnweb-hashtb))
 255
 256 (defun nnweb-get-hashtb (url)
 257   (gnus-gethash (nnweb-identifier url) nnweb-hashtb))
 258
 259 (defun nnweb-identifier (ident)
 260   (funcall (nnweb-definition 'identifier) ident))
 261
 262 (defun nnweb-overview-file (group)
 263   "Return the name of the overview file of GROUP."
 264   (nnheader-concat nnweb-directory group ".overview"))
 265
 266 (defun nnweb-write-active ()
 267   "Save the active file."
 268   (with-temp-file (nnheader-concat nnweb-directory "active")
 269     (prin1 `(setq nnweb-group-alist ',nnweb-group-alist) (current-buffer))))
 270
 271 (defun nnweb-read-active ()
 272   "Read the active file."
 273   (load (nnheader-concat nnweb-directory "active") t t t))
 274
 275 (defun nnweb-definition (type &optional noerror)
 276   "Return the definition of TYPE."
 277   (let ((def (cdr (assq type (assq nnweb-type nnweb-type-definition)))))
 278     (when (and (not def)
 279                (not noerror))
 280       (error "Undefined definition %s" type))
 281     def))
 282
 283 (defun nnweb-possibly-change-server (&optional group server)
 284   (nnweb-init server)
 285   (when server
 286     (unless (nnweb-server-opened server)
 287       (nnweb-open-server server)))
 288   (unless nnweb-group-alist
 289     (nnweb-read-active))
 290   (when group
 291     (when (and (not nnweb-ephemeral-p)
 292                (not (equal group nnweb-group)))
 293       (nnweb-request-group group nil t))))
 294
 295 (defun nnweb-init (server)
 296   "Initialize buffers and such."
 297   (unless (gnus-buffer-live-p nnweb-buffer)
 298     (setq nnweb-buffer
 299           (save-excursion
 300             (nnheader-set-temp-buffer
 301              (format " *nnweb %s %s %s*" nnweb-type nnweb-search server))))))
 302
 303 (defun nnweb-fetch-url (url)
 304   (save-excursion
 305     (if (not nnheader-callback-function)
 306         (let ((buf (current-buffer)))
 307           (save-excursion
 308             (set-buffer nnweb-buffer)
 309             (erase-buffer)
 310             (url-insert-file-contents url)
 311             (copy-to-buffer buf (point-min) (point-max))
 312             t))
 313       (nnweb-url-retrieve-asynch
 314        url 'nnweb-callback (current-buffer) nnheader-callback-function)
 315       t)))
 316
 317 (defun nnweb-callback (buffer callback)
 318   (when (gnus-buffer-live-p url-working-buffer)
 319     (save-excursion
 320       (set-buffer url-working-buffer)
 321       (funcall (nnweb-definition 'article))
 322       (nnweb-decode-entities)
 323       (set-buffer buffer)
 324       (goto-char (point-max))
 325       (insert-buffer-substring url-working-buffer))
 326     (funcall callback t)
 327     (gnus-kill-buffer url-working-buffer)))
 328
 329 (defun nnweb-url-retrieve-asynch (url callback &rest data)
 330   (let ((url-request-method "GET")
 331         (old-asynch url-be-asynchronous)
 332         (url-request-data nil)
 333         (url-request-extra-headers nil)
 334         (url-working-buffer (generate-new-buffer-name " *nnweb*")))
 335     (setq-default url-be-asynchronous t)
 336     (save-excursion
 337       (set-buffer (get-buffer-create url-working-buffer))
 338       (setq url-current-callback-data data
 339             url-be-asynchronous t
 340             url-current-callback-func callback)
 341       (url-retrieve url))
 342     (setq-default url-be-asynchronous old-asynch)))
 343
 344 ;;;
 345 ;;; DejaNews functions.
 346 ;;;
 347
 348 (defun nnweb-dejanews-create-mapping ()
 349   "Perform the search and create an number-to-url alist."
 350   (save-excursion
 351     (set-buffer nnweb-buffer)
 352     (erase-buffer)
 353     (when (funcall (nnweb-definition 'search) nnweb-search)
 354       (let ((i 0)
 355             (more t)
 356             (case-fold-search t)
 357             (active (or (cadr (assoc nnweb-group nnweb-group-alist))
 358                         (cons 1 0)))
 359             Subject (Score "0") Date Newsgroup Author
 360             map url)
 361         (while more
 362           ;; Go through all the article hits on this page.
 363           (goto-char (point-min))
 364           (nnweb-decode-entities)
 365           (goto-char (point-min))
 366           (while (re-search-forward "^ <P>\n" nil t)
 367             (narrow-to-region
 368              (point)
 369              (cond ((re-search-forward "^ <P>\n" nil t)
 370                     (match-beginning 0))
 371                    ((search-forward "\n\n" nil t)
 372                     (point))
 373                    (t
 374                     (point-max))))
 375             (goto-char (point-min))
 376             (looking-at ".*HREF=\"\\([^\"]+\\)\"\\(.*\\)")
 377             (setq url (match-string 1))
 378             (let ((begin (point)))
 379               (nnweb-remove-markup)
 380               (goto-char begin)
 381               (while (search-forward "\t" nil t)
 382                 (replace-match " "))
 383               (goto-char begin)
 384               (end-of-line)
 385               (setq Subject (buffer-substring begin (point)))
 386               (if (re-search-forward
 387                    "^ Newsgroup: \\(.*\\)\n Posted on \\([0-9/]+\\) by \\(.*\\)$" nil t)
 388                   (setq Newsgroup (match-string 1)
 389                         Date (match-string 2)
 390                         Author (match-string 3))))
 391             (widen)
 392             (incf i)
 393             (unless (nnweb-get-hashtb url)
 394               (push
 395                (list
 396                 (incf (cdr active))
 397                 (make-full-mail-header
 398                  (cdr active) Subject Author Date
 399                  (concat "<" (nnweb-identifier url) "@dejanews>")
 400                  nil 0 (string-to-int Score) url))
 401                map)
 402               (nnweb-set-hashtb (cadar map) (car map))))
 403           ;; See whether there is a "Get next 20 hits" button here.
 404           (if (or (not (re-search-forward
 405                         "HREF=\"\\([^\"]+\\)\"[<>b]+Next result" nil t))
 406                   (>= i nnweb-max-hits))
 407               (setq more nil)
 408             ;; Yup -- fetch it.
 409             (setq more (match-string 1))
 410             (erase-buffer)
 411             (url-insert-file-contents more)))
 412         ;; Return the articles in the right order.
 413         (setq nnweb-articles
 414               (sort (nconc nnweb-articles map) 'car-less-than-car))))))
 415
 416 (defun nnweb-dejanews-wash-article ()
 417   (let ((case-fold-search t))
 418     (goto-char (point-min))
 419     (re-search-forward "<PRE>" nil t)
 420     (delete-region (point-min) (point))
 421     (re-search-forward "</PRE>" nil t)
 422     (delete-region (point) (point-max))
 423     (nnweb-remove-markup)
 424     (goto-char (point-min))
 425     (while (and (looking-at " *$")
 426                 (not (eobp)))
 427       (gnus-delete-line))
 428     (while (looking-at "\\(^[^ ]+:\\) *")
 429       (replace-match "\\1 " t)
 430       (forward-line 1))
 431     (when (re-search-forward "\n\n+" nil t)
 432       (replace-match "\n" t t))
 433     (goto-char (point-min))
 434     (when (search-forward "[More Headers]" nil t)
 435       (replace-match "" t t))))
 436
 437 (defun nnweb-dejanews-search (search)
 438   (nnweb-insert
 439    (concat
 440     (nnweb-definition 'address)
 441     "?"
 442     (nnweb-encode-www-form-urlencoded
 443      `(("ST" . "PS")
 444        ("svcclass" . "dnyr")
 445        ("QRY" . ,search)
 446        ("defaultOp" . "AND")
 447        ("DBS" . "1")
 448        ("OP" . "dnquery.xp")
 449        ("LNG" . "ALL")
 450        ("maxhits" . "100")
 451        ("threaded" . "0")
 452        ("format" . "verbose2")
 453        ("showsort" . "date")
 454        ("agesign" . "1")
 455        ("ageweight" . "1")))))
 456   t)
 457
 458 (defun nnweb-dejanewsold-search (search)
 459   (nnweb-fetch-form
 460    (nnweb-definition 'address)
 461    `(("query" . ,search)
 462      ("defaultOp" . "AND")
 463      ("svcclass" . "dnold")
 464      ("maxhits" . "100")
 465      ("format" . "verbose2")
 466      ("threaded" . "0")
 467      ("showsort" . "date")
 468      ("agesign" . "1")
 469      ("ageweight" . "1")))
 470   t)
 471
 472 (defun nnweb-dejanews-identity (url)
 473   "Return an unique identifier based on URL."
 474   (if (string-match "recnum=\\([0-9]+\\)" url)
 475       (match-string 1 url)
 476     url))
 477
 478 ;;;
 479 ;;; InReference
 480 ;;;
 481
 482 (defun nnweb-reference-create-mapping ()
 483   "Perform the search and create an number-to-url alist."
 484   (save-excursion
 485     (set-buffer nnweb-buffer)
 486     (erase-buffer)
 487     (when (funcall (nnweb-definition 'search) nnweb-search)
 488       (let ((i 0)
 489             (more t)
 490             (case-fold-search t)
 491             (active (or (cadr (assoc nnweb-group nnweb-group-alist))
 492                         (cons 1 0)))
 493             Subject Score Date Newsgroups From Message-ID
 494             map url)
 495         (while more
 496           ;; Go through all the article hits on this page.
 497           (goto-char (point-min))
 498           (search-forward "</pre><hr>" nil t)
 499           (delete-region (point-min) (point))
 500                                         ;(nnweb-decode-entities)
 501           (goto-char (point-min))
 502           (while (re-search-forward "^ +[0-9]+\\." nil t)
 503             (narrow-to-region
 504              (point)
 505              (if (re-search-forward "^$" nil t)
 506                  (match-beginning 0)
 507                (point-max)))
 508             (goto-char (point-min))
 509             (when (looking-at ".*href=\"\\([^\"]+\\)\"")
 510               (setq url (match-string 1)))
 511             (nnweb-remove-markup)
 512             (goto-char (point-min))
 513             (while (search-forward "\t" nil t)
 514               (replace-match " "))
 515             (goto-char (point-min))
 516             (while (re-search-forward "^\\([^:]+\\): \\(.*\\)$" nil t)
 517               (set (intern (match-string 1)) (match-string 2)))
 518             (widen)
 519             (search-forward "</pre>" nil t)
 520             (incf i)
 521             (unless (nnweb-get-hashtb url)
 522               (push
 523                (list
 524                 (incf (cdr active))
 525                 (make-full-mail-header
 526                  (cdr active) (concat  "(" Newsgroups ") " Subject) From Date
 527                  Message-ID
 528                  nil 0 (string-to-int Score) url))
 529                map)
 530               (nnweb-set-hashtb (cadar map) (car map))))
 531           (setq more nil))
 532         ;; Return the articles in the right order.
 533         (setq nnweb-articles
 534               (sort (nconc nnweb-articles map) 'car-less-than-car))))))
 535
 536 (defun nnweb-reference-wash-article ()
 537   (let ((case-fold-search t))
 538     (goto-char (point-min))
 539     (re-search-forward "^</center><hr>" nil t)
 540     (delete-region (point-min) (point))
 541     (search-forward "<pre>" nil t)
 542     (forward-line -1)
 543     (let ((body (point-marker)))
 544       (search-forward "</pre>" nil t)
 545       (delete-region (point) (point-max))
 546       (nnweb-remove-markup)
 547       (goto-char (point-min))
 548       (while (looking-at " *$")
 549         (gnus-delete-line))
 550       (narrow-to-region (point-min) body)
 551       (while (and (re-search-forward "^$" nil t)
 552                   (not (eobp)))
 553         (gnus-delete-line))
 554       (goto-char (point-min))
 555       (while (looking-at "\\(^[^ ]+:\\) *")
 556         (replace-match "\\1 " t)
 557         (forward-line 1))
 558       (goto-char (point-min))
 559       (when (re-search-forward "^References:" nil t)
 560         (narrow-to-region
 561          (point) (if (re-search-forward "^$\\|^[^:]+:" nil t)
 562                      (match-beginning 0)
 563                    (point-max)))
 564         (goto-char (point-min))
 565         (while (not (eobp))
 566           (unless (looking-at "References")
 567             (insert "\t")
 568             (forward-line 1)))
 569         (goto-char (point-min))
 570         (while (search-forward "," nil t)
 571           (replace-match " " t t)))
 572       (widen)
 573       (set-marker body nil))))
 574
 575 (defun nnweb-reference-search (search)
 576   (url-insert-file-contents
 577    (concat
 578     (nnweb-definition 'address)
 579     "?"
 580     (nnweb-encode-www-form-urlencoded
 581      `(("search" . "advanced")
 582        ("querytext" . ,search)
 583        ("subj" . "")
 584        ("name" . "")
 585        ("login" . "")
 586        ("host" . "")
 587        ("organization" . "")
 588        ("groups" . "")
 589        ("keywords" . "")
 590        ("choice" . "Search")
 591        ("startmonth" . "Jul")
 592        ("startday" . "25")
 593        ("startyear" . "1996")
 594        ("endmonth" . "Aug")
 595        ("endday" . "24")
 596        ("endyear" . "1996")
 597        ("mode" . "Quick")
 598        ("verbosity" . "Verbose")
 599        ("ranking" . "Relevance")
 600        ("first" . "1")
 601        ("last" . "25")
 602        ("score" . "50")))))
 603   (setq buffer-file-name nil)
 604   t)
 605
 606 ;;;
 607 ;;; Alta Vista
 608 ;;;
 609
 610 (defun nnweb-altavista-create-mapping ()
 611   "Perform the search and create an number-to-url alist."
 612   (save-excursion
 613     (set-buffer nnweb-buffer)
 614     (erase-buffer)
 615     (let ((part 0))
 616       (when (funcall (nnweb-definition 'search) nnweb-search part)
 617         (let ((i 0)
 618               (more t)
 619               (case-fold-search t)
 620               (active (or (cadr (assoc nnweb-group nnweb-group-alist))
 621                           (cons 1 0)))
 622               subject date from id group
 623               map url)
 624           (while more
 625             ;; Go through all the article hits on this page.
 626             (goto-char (point-min))
 627             (search-forward "<dt>" nil t)
 628             (delete-region (point-min) (match-beginning 0))
 629             (goto-char (point-min))
 630             (while (search-forward "<dt>" nil t)
 631               (replace-match "\n<blubb>"))
 632             (nnweb-decode-entities)
 633             (goto-char (point-min))
 634             (while (re-search-forward "<blubb>.*href=\"\\([^\"]+\\)\"><strong>\\([^>]*\\)</strong></a><dd>\\([^-]+\\)- <b>\\([^<]+\\)<.*href=\"news:\\([^\"]+\\)\">.*\">\\(.+\\)</a><P>"
 635                                       nil t)
 636               (setq url (match-string 1)
 637                     subject (match-string 2)
 638                     date (match-string 3)
 639                     group (match-string 4)
 640                     id (concat "<" (match-string 5) ">")
 641                     from (match-string 6))
 642               (incf i)
 643               (unless (nnweb-get-hashtb url)
 644                 (push
 645                  (list
 646                   (incf (cdr active))
 647                   (make-full-mail-header
 648                    (cdr active) (concat  "(" group ") " subject) from date
 649                    id nil 0 0 url))
 650                  map)
 651                 (nnweb-set-hashtb (cadar map) (car map))))
 652             ;; See if we want more.
 653             (when (or (not nnweb-articles)
 654                       (>= i nnweb-max-hits)
 655                       (not (funcall (nnweb-definition 'search)
 656                                     nnweb-search (incf part))))
 657               (setq more nil)))
 658           ;; Return the articles in the right order.
 659           (setq nnweb-articles
 660                 (sort (nconc nnweb-articles map) 'car-less-than-car)))))))
 661
 662 (defun nnweb-altavista-wash-article ()
 663   (goto-char (point-min))
 664   (let ((case-fold-search t))
 665     (when (re-search-forward "^<strong>" nil t)
 666       (delete-region (point-min) (match-beginning 0)))
 667     (goto-char (point-min))
 668     (while (looking-at "<strong>\\([^ ]+\\) +</strong> +\\(.*\\)$")
 669       (replace-match "\\1: \\2" t)
 670       (forward-line 1))
 671     (when (re-search-backward "^References:" nil t)
 672       (narrow-to-region (point) (progn (forward-line 1) (point)))
 673       (goto-char (point-min))
 674       (while (re-search-forward "<A.*\\?id@\\([^\"]+\\)\">[0-9]+</A>" nil t)
 675         (replace-match "&lt;\\1&gt; " t)))
 676     (widen)
 677     (nnweb-remove-markup)))
 678
 679 (defun nnweb-altavista-search (search &optional part)
 680   (url-insert-file-contents
 681    (concat
 682     (nnweb-definition 'address)
 683     "?"
 684     (nnweb-encode-www-form-urlencoded
 685      `(("pg" . "aq")
 686        ("what" . "news")
 687        ,@(when part `(("stq" . ,(int-to-string (* part 30)))))
 688        ("fmt" . "d")
 689        ("q" . ,search)
 690        ("r" . "")
 691        ("d0" . "")
 692        ("d1" . "")))))
 693   (setq buffer-file-name nil)
 694   t)
 695
 696 ;;;
 697 ;;; General web/w3 interface utility functions
 698 ;;;
 699
 700 (defun nnweb-insert-html (parse)
 701   "Insert HTML based on a w3 parse tree."
 702   (if (stringp parse)
 703       (insert parse)
 704     (insert "<" (symbol-name (car parse)) " ")
 705     (insert (mapconcat
 706              (lambda (param)
 707                (concat (symbol-name (car param)) "="
 708                        (prin1-to-string
 709                         (if (consp (cdr param))
 710                             (cadr param)
 711                           (cdr param)))))
 712              (nth 1 parse)
 713              " "))
 714     (insert ">\n")
 715     (mapcar 'nnweb-insert-html (nth 2 parse))
 716     (insert "</" (symbol-name (car parse)) ">\n")))
 717
 718 (defun nnweb-encode-www-form-urlencoded (pairs)
 719   "Return PAIRS encoded for forms."
 720   (mapconcat
 721    (function
 722     (lambda (data)
 723       (concat (w3-form-encode-xwfu (car data)) "="
 724               (w3-form-encode-xwfu (cdr data)))))
 725    pairs "&"))
 726
 727 (defun nnweb-fetch-form (url pairs)
 728   "Fetch a form from URL with PAIRS as the data."
 729   (let ((url-request-data (nnweb-encode-www-form-urlencoded pairs))
 730         (url-request-method "POST")
 731         (url-request-extra-headers
 732          '(("Content-type" . "application/x-www-form-urlencoded"))))
 733     (url-insert-file-contents url)
 734     (setq buffer-file-name nil))
 735   t)
 736
 737 (defun nnweb-decode-entities ()
 738   "Decode all HTML entities."
 739   (goto-char (point-min))
 740   (while (re-search-forward "&\\([a-z]+\\);" nil t)
 741     (replace-match (char-to-string (or (cdr (assq (intern (match-string 1))
 742                                                   w3-html-entities))
 743                                        ?#))
 744                    t t)))
 745
 746 (defun nnweb-remove-markup ()
 747   "Remove all HTML markup, leaving just plain text."
 748   (goto-char (point-min))
 749   (while (search-forward "<!--" nil t)
 750     (delete-region (match-beginning 0)
 751                    (or (search-forward "-->" nil t)
 752                        (point-max))))
 753   (goto-char (point-min))
 754   (while (re-search-forward "<[^>]+>" nil t)
 755     (replace-match "" t t)))
 756
 757 (defun nnweb-insert (url)
 758   "Insert the contents from an URL in the current buffer."
 759   (let ((name buffer-file-name))
 760     (url-insert-file-contents url)
 761     (setq buffer-file-name name)))
 762
 763 (defun nnweb-parse-find (type parse &optional maxdepth)
 764   "Find the element of TYPE in PARSE."
 765   (catch 'found
 766     (nnweb-parse-find-1 type parse maxdepth)))
 767
 768 (defun nnweb-parse-find-1 (type contents maxdepth)
 769   (when (or (null maxdepth)
 770             (not (zerop maxdepth)))
 771     (when (consp contents)
 772       (when (eq (car contents) type)
 773         (throw 'found contents))
 774       (when (listp (cdr contents))
 775         (dolist (element contents)
 776           (when (consp element)
 777             (nnweb-parse-find-1 type element
 778                                 (and maxdepth (1- maxdepth)))))))))
 779
 780 (defun nnweb-parse-find-all (type parse)
 781   "Find all elements of TYPE in PARSE."
 782   (catch 'found
 783     (nnweb-parse-find-all-1 type parse)))
 784
 785 (defun nnweb-parse-find-all-1 (type contents)
 786   (let (result)
 787     (when (consp contents)
 788       (if (eq (car contents) type)
 789           (push contents result)
 790         (when (listp (cdr contents))
 791           (dolist (element contents)
 792             (when (consp element)
 793               (setq result
 794                     (nconc result (nnweb-parse-find-all-1 type element))))))))
 795     result))
 796
 797 (defvar nnweb-text)
 798 (defun nnweb-text (parse)
 799   "Return a list of text contents in PARSE."
 800   (let ((nnweb-text nil))
 801     (nnweb-text-1 parse)
 802     (nreverse nnweb-text)))
 803
 804 (defun nnweb-text-1 (contents)
 805   (dolist (element contents)
 806     (if (stringp element)
 807         (push element nnweb-text)
 808       (when (and (consp element)
 809                  (listp (cdr element)))
 810         (nnweb-text-1 element)))))
 811
 812 (provide 'nnweb)
 813
 814 ;;; nnweb.el ends here