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