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 `url' and `w3' installed for this
  28 ;; backend to work.
  29
  30 ;;; Code:
  31
  32 (eval-when-compile (require 'cl))
  33
  34 (require 'nnoo)
  35 (require 'message)
  36 (require 'gnus-util)
  37 (require 'gnus)
  38 (require 'nnmail)
  39 (require 'mm-util)
  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                     (default-process-coding-system 'binary))
 335                 (nnweb-insert url))
 336               (setq buf (buffer-string)))
 337             (erase-buffer)
 338             (insert buf)
 339             t)
 340         (nnweb-url-retrieve-asynch
 341          url 'nnweb-callback (current-buffer) nnheader-callback-function)
 342         t))))
 343
 344 (defun nnweb-callback (buffer callback)
 345   (when (gnus-buffer-live-p url-working-buffer)
 346     (save-excursion
 347       (set-buffer url-working-buffer)
 348       (funcall (nnweb-definition 'article))
 349       (nnweb-decode-entities)
 350       (set-buffer buffer)
 351       (goto-char (point-max))
 352       (insert-buffer-substring url-working-buffer))
 353     (funcall callback t)
 354     (gnus-kill-buffer url-working-buffer)))
 355
 356 (defun nnweb-url-retrieve-asynch (url callback &rest data)
 357   (let ((url-request-method "GET")
 358         (old-asynch url-be-asynchronous)
 359         (url-request-data nil)
 360         (url-request-extra-headers nil)
 361         (url-working-buffer (generate-new-buffer-name " *nnweb*")))
 362     (setq-default url-be-asynchronous t)
 363     (save-excursion
 364       (set-buffer (get-buffer-create url-working-buffer))
 365       (setq url-current-callback-data data
 366             url-be-asynchronous t
 367             url-current-callback-func callback)
 368       (url-retrieve url nil))
 369     (setq-default url-be-asynchronous old-asynch)))
 370
 371 (if (fboundp 'url-retrieve-synchronously)
 372     (defun nnweb-url-retrieve-asynch (url callback &rest data)
 373       (url-retrieve url callback data)))
 374
 375 ;;;
 376 ;;; DejaNews functions.
 377 ;;;
 378
 379 (defun nnweb-dejanews-create-mapping ()
 380   "Perform the search and create an number-to-url alist."
 381   (save-excursion
 382     (set-buffer nnweb-buffer)
 383     (erase-buffer)
 384     (when (funcall (nnweb-definition 'search) nnweb-search)
 385       (let ((i 0)
 386             (more t)
 387             (case-fold-search t)
 388             (active (or (cadr (assoc nnweb-group nnweb-group-alist))
 389                         (cons 1 0)))
 390             subject date from
 391             map url parse a table group text)
 392         (while more
 393           ;; Go through all the article hits on this page.
 394           (goto-char (point-min))
 395           (setq parse (w3-parse-buffer (current-buffer))
 396                 table (nth 1 (nnweb-parse-find-all 'table parse)))
 397           (dolist (row (nth 2 (car (nth 2 table))))
 398             (setq a (nnweb-parse-find 'a row)
 399                   url (cdr (assq 'href (nth 1 a)))
 400                   text (nreverse (nnweb-text row)))
 401             (when a
 402               (setq subject (nth 4 text)
 403                     group (nth 2 text)
 404                     date (nth 1 text)
 405                     from (nth 0 text))
 406               (if (string-match "\\([0-9]+\\)/\\([0-9]+\\)/\\([0-9]+\\)" date)
 407                   (setq date (format "%s %s 00:00:00 %s"
 408                                      (car (rassq (string-to-number
 409                                                   (match-string 2 date))
 410                                                  parse-time-months))
 411                                      (match-string 3 date)
 412                                      (match-string 1 date)))
 413                 (setq date "Jan 1 00:00:00 0000"))
 414               (incf i)
 415               (setq url (concat url "&fmt=text"))
 416               (when (string-match "&context=[^&]+" url)
 417                 (setq url (replace-match "" t t url)))
 418               (unless (nnweb-get-hashtb url)
 419                 (push
 420                  (list
 421                   (incf (cdr active))
 422                   (make-full-mail-header
 423                    (cdr active) (concat subject " (" group ")") from date
 424                    (concat "<" (nnweb-identifier url) "@dejanews>")
 425                    nil 0 0 url))
 426                  map)
 427                 (nnweb-set-hashtb (cadar map) (car map)))))
 428           ;; See whether there is a "Get next 20 hits" button here.
 429           (goto-char (point-min))
 430           (if (or (not (re-search-forward
 431                         "HREF=\"\\([^\"]+\\)\"[<>b]+Next result" nil t))
 432                   (>= i nnweb-max-hits))
 433               (setq more nil)
 434             ;; Yup -- fetch it.
 435             (setq more (match-string 1))
 436             (erase-buffer)
 437             (url-insert-file-contents more)))
 438         ;; Return the articles in the right order.
 439         (setq nnweb-articles
 440               (sort (nconc nnweb-articles map) 'car-less-than-car))))))
 441
 442 (defun nnweb-dejanews-search (search)
 443   (nnweb-insert
 444    (concat
 445     (nnweb-definition 'address)
 446     "?"
 447     (nnweb-encode-www-form-urlencoded
 448      `(("ST" . "PS")
 449        ("svcclass" . "dnyr")
 450        ("QRY" . ,search)
 451        ("defaultOp" . "AND")
 452        ("DBS" . "1")
 453        ("OP" . "dnquery.xp")
 454        ("LNG" . "ALL")
 455        ("maxhits" . "100")
 456        ("threaded" . "0")
 457        ("format" . "verbose2")
 458        ("showsort" . "date")
 459        ("agesign" . "1")
 460        ("ageweight" . "1")))))
 461   t)
 462
 463 (defun nnweb-dejanewsold-search (search)
 464   (nnweb-fetch-form
 465    (nnweb-definition 'address)
 466    `(("query" . ,search)
 467      ("defaultOp" . "AND")
 468      ("svcclass" . "dnold")
 469      ("maxhits" . "100")
 470      ("format" . "verbose2")
 471      ("threaded" . "0")
 472      ("showsort" . "date")
 473      ("agesign" . "1")
 474      ("ageweight" . "1")))
 475   t)
 476
 477 (defun nnweb-dejanews-identity (url)
 478   "Return an unique identifier based on URL."
 479   (if (string-match "AN=\\([0-9]+\\)" url)
 480       (match-string 1 url)
 481     url))
 482
 483 ;;;
 484 ;;; InReference
 485 ;;;
 486
 487 (defun nnweb-reference-create-mapping ()
 488   "Perform the search and create an number-to-url alist."
 489   (save-excursion
 490     (set-buffer nnweb-buffer)
 491     (erase-buffer)
 492     (when (funcall (nnweb-definition 'search) nnweb-search)
 493       (let ((i 0)
 494             (more t)
 495             (case-fold-search t)
 496             (active (or (cadr (assoc nnweb-group nnweb-group-alist))
 497                         (cons 1 0)))
 498             Subject Score Date Newsgroups From Message-ID
 499             map url)
 500         (while more
 501           ;; Go through all the article hits on this page.
 502           (goto-char (point-min))
 503           (search-forward "</pre><hr>" nil t)
 504           (delete-region (point-min) (point))
 505           (goto-char (point-min))
 506           (while (re-search-forward "^ +[0-9]+\\." nil t)
 507             (narrow-to-region
 508              (point)
 509              (if (re-search-forward "^$" nil t)
 510                  (match-beginning 0)
 511                (point-max)))
 512             (goto-char (point-min))
 513             (when (looking-at ".*href=\"\\([^\"]+\\)\"")
 514               (setq url (match-string 1)))
 515             (nnweb-remove-markup)
 516             (goto-char (point-min))
 517             (while (search-forward "\t" nil t)
 518               (replace-match " "))
 519             (goto-char (point-min))
 520             (while (re-search-forward "^\\([^:]+\\): \\(.*\\)$" nil t)
 521               (set (intern (match-string 1)) (match-string 2)))
 522             (widen)
 523             (search-forward "</pre>" nil t)
 524             (incf i)
 525             (unless (nnweb-get-hashtb url)
 526               (push
 527                (list
 528                 (incf (cdr active))
 529                 (make-full-mail-header
 530                  (cdr active) (concat  "(" Newsgroups ") " Subject) From Date
 531                  Message-ID
 532                  nil 0 (string-to-int Score) url))
 533                map)
 534               (nnweb-set-hashtb (cadar map) (car map))))
 535           (setq more nil))
 536         ;; Return the articles in the right order.
 537         (setq nnweb-articles
 538               (sort (nconc nnweb-articles map) 'car-less-than-car))))))
 539
 540 (defun nnweb-reference-wash-article ()
 541   (let ((case-fold-search t))
 542     (goto-char (point-min))
 543     (re-search-forward "^</center><hr>" nil t)
 544     (delete-region (point-min) (point))
 545     (search-forward "<pre>" nil t)
 546     (forward-line -1)
 547     (let ((body (point-marker)))
 548       (search-forward "</pre>" nil t)
 549       (delete-region (point) (point-max))
 550       (nnweb-remove-markup)
 551       (goto-char (point-min))
 552       (while (looking-at " *$")
 553         (gnus-delete-line))
 554       (narrow-to-region (point-min) body)
 555       (while (and (re-search-forward "^$" nil t)
 556                   (not (eobp)))
 557         (gnus-delete-line))
 558       (goto-char (point-min))
 559       (while (looking-at "\\(^[^ ]+:\\) *")
 560         (replace-match "\\1 " t)
 561         (forward-line 1))
 562       (goto-char (point-min))
 563       (when (re-search-forward "^References:" nil t)
 564         (narrow-to-region
 565          (point) (if (re-search-forward "^$\\|^[^:]+:" nil t)
 566                      (match-beginning 0)
 567                    (point-max)))
 568         (goto-char (point-min))
 569         (while (not (eobp))
 570           (unless (looking-at "References")
 571             (insert "\t")
 572             (forward-line 1)))
 573         (goto-char (point-min))
 574         (while (search-forward "," nil t)
 575           (replace-match " " t t)))
 576       (widen)
 577       (nnweb-decode-entities)
 578       (set-marker body nil))))
 579
 580 (defun nnweb-reference-search (search)
 581   (url-insert-file-contents
 582    (concat
 583     (nnweb-definition 'address)
 584     "?"
 585     (nnweb-encode-www-form-urlencoded
 586      `(("search" . "advanced")
 587        ("querytext" . ,search)
 588        ("subj" . "")
 589        ("name" . "")
 590        ("login" . "")
 591        ("host" . "")
 592        ("organization" . "")
 593        ("groups" . "")
 594        ("keywords" . "")
 595        ("choice" . "Search")
 596        ("startmonth" . "Jul")
 597        ("startday" . "25")
 598        ("startyear" . "1996")
 599        ("endmonth" . "Aug")
 600        ("endday" . "24")
 601        ("endyear" . "1996")
 602        ("mode" . "Quick")
 603        ("verbosity" . "Verbose")
 604        ("ranking" . "Relevance")
 605        ("first" . "1")
 606        ("last" . "25")
 607        ("score" . "50")))))
 608   (setq buffer-file-name nil)
 609   t)
 610
 611 ;;;
 612 ;;; Alta Vista
 613 ;;;
 614
 615 (defun nnweb-altavista-create-mapping ()
 616   "Perform the search and create an number-to-url alist."
 617   (save-excursion
 618     (set-buffer nnweb-buffer)
 619     (erase-buffer)
 620     (let ((part 0))
 621       (when (funcall (nnweb-definition 'search) nnweb-search part)
 622         (let ((i 0)
 623               (more t)
 624               (case-fold-search t)
 625               (active (or (cadr (assoc nnweb-group nnweb-group-alist))
 626                           (cons 1 0)))
 627               subject date from id group
 628               map url)
 629           (while more
 630             ;; Go through all the article hits on this page.
 631             (goto-char (point-min))
 632             (search-forward "<dt>" nil t)
 633             (delete-region (point-min) (match-beginning 0))
 634             (goto-char (point-min))
 635             (while (search-forward "<dt>" nil t)
 636               (replace-match "\n<blubb>"))
 637             (nnweb-decode-entities)
 638             (goto-char (point-min))
 639             (while (re-search-forward "<blubb>.*href=\"\\([^\"]+\\)\"><strong>\\([^>]*\\)</strong></a><dd>\\([^-]+\\)- <b>\\([^<]+\\)<.*href=\"news:\\([^\"]+\\)\">.*\">\\(.+\\)</a><P>"
 640                                       nil t)
 641               (setq url (match-string 1)
 642                     subject (match-string 2)
 643                     date (match-string 3)
 644                     group (match-string 4)
 645                     id (concat "<" (match-string 5) ">")
 646                     from (match-string 6))
 647               (incf i)
 648               (unless (nnweb-get-hashtb url)
 649                 (push
 650                  (list
 651                   (incf (cdr active))
 652                   (make-full-mail-header
 653                    (cdr active) (concat  "(" group ") " subject) from date
 654                    id nil 0 0 url))
 655                  map)
 656                 (nnweb-set-hashtb (cadar map) (car map))))
 657             ;; See if we want more.
 658             (when (or (not nnweb-articles)
 659                       (>= i nnweb-max-hits)
 660                       (not (funcall (nnweb-definition 'search)
 661                                     nnweb-search (incf part))))
 662               (setq more nil)))
 663           ;; Return the articles in the right order.
 664           (setq nnweb-articles
 665                 (sort (nconc nnweb-articles map) 'car-less-than-car)))))))
 666
 667 (defun nnweb-altavista-wash-article ()
 668   (goto-char (point-min))
 669   (let ((case-fold-search t))
 670     (when (re-search-forward "^<strong>" nil t)
 671       (delete-region (point-min) (match-beginning 0)))
 672     (goto-char (point-min))
 673     (while (looking-at "<strong>\\([^ ]+\\) +</strong> +\\(.*\\)$")
 674       (replace-match "\\1: \\2" t)
 675       (forward-line 1))
 676     (when (re-search-backward "^References:" nil t)
 677       (narrow-to-region (point) (progn (forward-line 1) (point)))
 678       (goto-char (point-min))
 679       (while (re-search-forward "<A.*\\?id@\\([^\"]+\\)\">[0-9]+</A>" nil t)
 680         (replace-match "&lt;\\1&gt; " t)))
 681     (widen)
 682     (nnweb-remove-markup)
 683     (nnweb-decode-entities)))
 684
 685 (defun nnweb-altavista-search (search &optional part)
 686   (url-insert-file-contents
 687    (concat
 688     (nnweb-definition 'address)
 689     "?"
 690     (nnweb-encode-www-form-urlencoded
 691      `(("pg" . "aq")
 692        ("what" . "news")
 693        ,@(when part `(("stq" . ,(int-to-string (* part 30)))))
 694        ("fmt" . "d")
 695        ("q" . ,search)
 696        ("r" . "")
 697        ("d0" . "")
 698        ("d1" . "")))))
 699   (setq buffer-file-name nil)
 700   t)
 701
 702 ;;;
 703 ;;; Deja bought by google.com
 704 ;;;
 705
 706 (defun nnweb-google-wash-article ()
 707   (let ((case-fold-search t) url)
 708     (goto-char (point-min))
 709     (re-search-forward "^<pre>" nil t)
 710     (narrow-to-region (point-min) (point))
 711     (search-backward "<table " nil t 2)
 712     (delete-region (point-min) (point))
 713     (if (re-search-forward "Search Result [0-9]+" nil t)
 714         (replace-match ""))
 715     (if (re-search-forward "View complete thread ([0-9]+ articles?)" nil t)
 716         (replace-match ""))
 717     (goto-char (point-min))
 718     (while (search-forward "<br>" nil t)
 719       (replace-match "\n"))
 720     (nnweb-remove-markup)
 721     (goto-char (point-min))
 722     (while (re-search-forward "^[ \t]*\n" nil t)
 723       (replace-match ""))
 724     (goto-char (point-max))
 725     (insert "\n")
 726     (widen)
 727     (narrow-to-region (point) (point-max))
 728     (search-forward "</pre>" nil t)
 729     (delete-region (point) (point-max))
 730     (nnweb-remove-markup)
 731     (widen)))
 732
 733 (defun nnweb-google-parse-1 (&optional Message-ID)
 734   (let ((i 0)
 735         (case-fold-search t)
 736         (active (cadr (assoc nnweb-group nnweb-group-alist)))
 737         Subject Score Date Newsgroups From
 738         map url mid)
 739     (unless active
 740       (push (list nnweb-group (setq active (cons 1 0))
 741                   nnweb-type nnweb-search)
 742             nnweb-group-alist))
 743     ;; Go through all the article hits on this page.
 744     (goto-char (point-min))
 745     (while (re-search-forward
 746             "a href=/groups\\(\\?[^ \">]*selm=\\([^ &\">]+\\)\\)" nil t)
 747       (setq mid (match-string 2)
 748             url (format
 749                  "http://groups.google.com/groups?selm=%s&output=gplain" mid))
 750       (narrow-to-region (search-forward ">" nil t)
 751                         (search-forward "</a>" nil t))
 752       (nnweb-remove-markup)
 753       (nnweb-decode-entities)
 754       (setq Subject (buffer-string))
 755       (goto-char (point-max))
 756       (widen)
 757       (forward-line 2)
 758       (when (looking-at "<br><font[^>]+>")
 759         (goto-char (match-end 0)))
 760       (if (not (looking-at "<a[^>]+>"))
 761           (skip-chars-forward " \t")
 762         (narrow-to-region (point)
 763                           (search-forward "</a>" nil t))
 764         (nnweb-remove-markup)
 765         (nnweb-decode-entities)
 766         (setq Newsgroups (buffer-string))
 767         (goto-char (point-max))
 768         (widen)
 769         (skip-chars-forward "- \t"))
 770       (when (looking-at
 771              "\\([0-9]+[/ ][A-Za-z]+[/ ][0-9]+\\)[ \t]*by[ \t]*\\([^<]*\\) - <a")
 772         (setq From (match-string 2)
 773               Date (match-string 1)))
 774       (forward-line 1)
 775       (incf i)
 776       (unless (nnweb-get-hashtb url)
 777         (push
 778          (list
 779           (incf (cdr active))
 780           (make-full-mail-header
 781            (cdr active) (if Newsgroups
 782                             (concat  "(" Newsgroups ") " Subject)
 783                           Subject)
 784            From Date (or Message-ID mid)
 785            nil 0 0 url))
 786          map)
 787         (nnweb-set-hashtb (cadar map) (car map))))
 788     map))
 789
 790 (defun nnweb-google-reference (id)
 791   (let ((map (nnweb-google-parse-1 id)) header)
 792     (setq nnweb-articles
 793           (nconc nnweb-articles map))
 794     (when (setq header (cadar map))
 795       (mm-with-unibyte-current-buffer
 796         (nnweb-fetch-url (mail-header-xref header)))
 797       (caar map))))
 798
 799 (defun nnweb-google-create-mapping ()
 800   "Perform the search and create an number-to-url alist."
 801   (save-excursion
 802     (set-buffer nnweb-buffer)
 803     (erase-buffer)
 804     (when (funcall (nnweb-definition 'search) nnweb-search)
 805         (let ((more t))
 806           (while more
 807             (setq nnweb-articles
 808                   (nconc nnweb-articles (nnweb-google-parse-1)))
 809             ;; FIXME: There is more.
 810             (setq more nil))
 811           ;; Return the articles in the right order.
 812           (setq nnweb-articles
 813                 (sort nnweb-articles 'car-less-than-car))))))
 814
 815 (defun nnweb-google-search (search)
 816   (nnweb-insert
 817    (concat
 818     (nnweb-definition 'address)
 819     "?"
 820     (nnweb-encode-www-form-urlencoded
 821      `(("q" . ,search)
 822        ("num". "100")
 823        ("hq" . "")
 824        ("hl" . "")
 825        ("lr" . "")
 826        ("safe" . "off")
 827        ("sites" . "groups")))))
 828   t)
 829
 830 (defun nnweb-google-identity (url)
 831   "Return an unique identifier based on URL."
 832   (if (string-match "selm=\\([^ &>]+\\)" url)
 833       (match-string 1 url)
 834     url))
 835
 836 ;;;
 837 ;;; General web/w3 interface utility functions
 838 ;;;
 839
 840 (defun nnweb-insert-html (parse)
 841   "Insert HTML based on a w3 parse tree."
 842   (if (stringp parse)
 843       (insert (nnheader-string-as-multibyte parse))
 844     (insert "<" (symbol-name (car parse)) " ")
 845     (insert (mapconcat
 846              (lambda (param)
 847                (concat (symbol-name (car param)) "="
 848                        (prin1-to-string
 849                         (if (consp (cdr param))
 850                             (cadr param)
 851                           (cdr param)))))
 852              (nth 1 parse)
 853              " "))
 854     (insert ">\n")
 855     (mapcar 'nnweb-insert-html (nth 2 parse))
 856     (insert "</" (symbol-name (car parse)) ">\n")))
 857
 858 (defun nnweb-encode-www-form-urlencoded (pairs)
 859   "Return PAIRS encoded for forms."
 860   (mapconcat
 861    (function
 862     (lambda (data)
 863       (concat (w3-form-encode-xwfu (car data)) "="
 864               (w3-form-encode-xwfu (cdr data)))))
 865    pairs "&"))
 866
 867 (defun nnweb-fetch-form (url pairs)
 868   "Fetch a form from URL with PAIRS as the data using the POST method."
 869   (let ((url-request-data (nnweb-encode-www-form-urlencoded pairs))
 870         (url-request-method "POST")
 871         (url-request-extra-headers
 872          '(("Content-type" . "application/x-www-form-urlencoded"))))
 873     (url-insert-file-contents url)
 874     (setq buffer-file-name nil))
 875   t)
 876
 877 (defun nnweb-decode-entities ()
 878   "Decode all HTML entities."
 879   (goto-char (point-min))
 880   (while (re-search-forward "&\\(#[0-9]+\\|[a-z]+\\);" nil t)
 881     (let ((elem (if (eq (aref (match-string 1) 0) ?\#)
 882                         (let ((c
 883                                (string-to-number (substring
 884                                                   (match-string 1) 1))))
 885                           (if (mm-char-or-char-int-p c) c 32))
 886                       (or (cdr (assq (intern (match-string 1))
 887                                      w3-html-entities))
 888                           ?#))))
 889       (unless (stringp elem)
 890         (setq elem (char-to-string elem)))
 891       (replace-match elem t t))))
 892
 893 (defun nnweb-decode-entities-string (string)
 894   (with-temp-buffer
 895     (insert string)
 896     (nnweb-decode-entities)
 897     (buffer-substring (point-min) (point-max))))
 898
 899 (defun nnweb-remove-markup ()
 900   "Remove all HTML markup, leaving just plain text."
 901   (goto-char (point-min))
 902   (while (search-forward "<!--" nil t)
 903     (delete-region (match-beginning 0)
 904                    (or (search-forward "-->" nil t)
 905                        (point-max))))
 906   (goto-char (point-min))
 907   (while (re-search-forward "<[^>]+>" nil t)
 908     (replace-match "" t t)))
 909
 910 (defun nnweb-insert (url &optional follow-refresh)
 911   "Insert the contents from an URL in the current buffer.
 912 If FOLLOW-REFRESH is non-nil, redirect refresh url in META."
 913   (let ((name buffer-file-name))
 914     (if follow-refresh
 915         (save-restriction
 916           (narrow-to-region (point) (point))
 917           (url-insert-file-contents url)
 918           (goto-char (point-min))
 919           (when (re-search-forward
 920                  "<meta[ \t\r\n]*http-equiv=\"Refresh\"[^>]*URL=\\([^\"]+\\)\"" nil t)
 921             (let ((url (match-string 1)))
 922               (delete-region (point-min) (point-max))
 923               (nnweb-insert url t))))
 924       (url-insert-file-contents url))
 925     (setq buffer-file-name name)))
 926
 927 (defun nnweb-parse-find (type parse &optional maxdepth)
 928   "Find the element of TYPE in PARSE."
 929   (catch 'found
 930     (nnweb-parse-find-1 type parse maxdepth)))
 931
 932 (defun nnweb-parse-find-1 (type contents maxdepth)
 933   (when (or (null maxdepth)
 934             (not (zerop maxdepth)))
 935     (when (consp contents)
 936       (when (eq (car contents) type)
 937         (throw 'found contents))
 938       (when (listp (cdr contents))
 939         (dolist (element contents)
 940           (when (consp element)
 941             (nnweb-parse-find-1 type element
 942                                 (and maxdepth (1- maxdepth)))))))))
 943
 944 (defun nnweb-parse-find-all (type parse)
 945   "Find all elements of TYPE in PARSE."
 946   (catch 'found
 947     (nnweb-parse-find-all-1 type parse)))
 948
 949 (defun nnweb-parse-find-all-1 (type contents)
 950   (let (result)
 951     (when (consp contents)
 952       (if (eq (car contents) type)
 953           (push contents result)
 954         (when (listp (cdr contents))
 955           (dolist (element contents)
 956             (when (consp element)
 957               (setq result
 958                     (nconc result (nnweb-parse-find-all-1 type element))))))))
 959     result))
 960
 961 (defvar nnweb-text)
 962 (defun nnweb-text (parse)
 963   "Return a list of text contents in PARSE."
 964   (let ((nnweb-text nil))
 965     (nnweb-text-1 parse)
 966     (nreverse nnweb-text)))
 967
 968 (defun nnweb-text-1 (contents)
 969   (dolist (element contents)
 970     (if (stringp element)
 971         (push element nnweb-text)
 972       (when (and (consp element)
 973                  (listp (cdr element)))
 974         (nnweb-text-1 element)))))
 975
 976 (defun nnweb-replace-in-string (string match newtext)
 977   (while (string-match match string)
 978     (setq string (replace-match newtext t t string)))
 979   string)
 980
 981 (provide 'nnweb)
 982
 983 ;;; nnweb.el ends here