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