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

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