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