git.chise.org Git - elisp/gnus.git-/blob - lisp/nnweb.el

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