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

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