cgit.sxemacs.org Git - gnus/blob - lisp/nnweb.el

   1 ;;; nnweb.el --- retrieving articles via web search engines
   2 ;; Copyright (C) 1996,97,98 Free Software Foundation, Inc.
   3
   4 ;; Author: Lars Magne Ingebrigtsen <larsi@ifi.uio.no>
   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
  33 (require 'nnoo)
  34 (require 'message)
  35 (require 'gnus-util)
  36 (require 'gnus)
  37 (require 'w3)
  38 (require 'url)
  39 (require 'nnmail)
  40 (ignore-errors
  41   (require 'w3-forms))
  42
  43 (nnoo-declare nnweb)
  44
  45 (defvoo nnweb-directory (nnheader-concat gnus-directory "nnweb/")
  46   "Where nnweb will save its files.")
  47
  48 (defvoo nnweb-type 'dejanews
  49   "What search engine type is being used.")
  50
  51 (defvoo nnweb-type-definition
  52   '((dejanews
  53      (article . nnweb-dejanews-wash-article)
  54      (map . nnweb-dejanews-create-mapping)
  55      (search . nnweb-dejanews-search)
  56      (address . "http://x8.dejanews.com/dnquery.xp")
  57      (identifier . nnweb-dejanews-identity))
  58     (dejanewsold
  59      (article . nnweb-dejanews-wash-article)
  60      (map . nnweb-dejanews-create-mapping)
  61      (search . nnweb-dejanewsold-search)
  62      (address . "http://x8.dejanews.com/dnquery.xp")
  63      (identifier . nnweb-dejanews-identity))
  64     (reference
  65      (article . nnweb-reference-wash-article)
  66      (map . nnweb-reference-create-mapping)
  67      (search . nnweb-reference-search)
  68      (address . "http://www.reference.com/cgi-bin/pn/go")
  69      (identifier . identity))
  70     (altavista
  71      (article . nnweb-altavista-wash-article)
  72      (map . nnweb-altavista-create-mapping)
  73      (search . nnweb-altavista-search)
  74      (address . "http://www.altavista.digital.com/cgi-bin/query")
  75      (id . "/cgi-bin/news?id@%s")
  76      (identifier . identity)))
  77   "Type-definition alist.")
  78
  79 (defvoo nnweb-search nil
  80   "Search string to feed to DejaNews.")
  81
  82 (defvoo nnweb-max-hits 999
  83   "Maximum number of hits to display.")
  84
  85 (defvoo nnweb-ephemeral-p nil
  86   "Whether this nnweb server is ephemeral.")
  87
  88 ;;; Internal variables
  89
  90 (defvoo nnweb-articles nil)
  91 (defvoo nnweb-buffer nil)
  92 (defvoo nnweb-group-alist nil)
  93 (defvoo nnweb-group nil)
  94 (defvoo nnweb-hashtb nil)
  95
  96 ;;; Interface functions
  97
  98 (nnoo-define-basics nnweb)
  99
 100 (deffoo nnweb-retrieve-headers (articles &optional group server fetch-old)
 101   (nnweb-possibly-change-server group server)
 102   (save-excursion
 103     (set-buffer nntp-server-buffer)
 104     (erase-buffer)
 105     (let (article header)
 106       (while (setq article (pop articles))
 107         (when (setq header (cadr (assq article nnweb-articles)))
 108           (nnheader-insert-nov header)))
 109       'nov)))
 110
 111 (deffoo nnweb-request-scan (&optional group server)
 112   (nnweb-possibly-change-server group server)
 113   (setq nnweb-hashtb (gnus-make-hashtable 4095))
 114   (funcall (nnweb-definition 'map))
 115   (unless nnweb-ephemeral-p
 116     (nnweb-write-active)
 117     (nnweb-write-overview group)))
 118
 119 (deffoo nnweb-request-group (group &optional server dont-check)
 120   (nnweb-possibly-change-server nil server)
 121   (when (and group
 122              (not (equal group nnweb-group))
 123              (not nnweb-ephemeral-p))
 124     (let ((info (assoc group nnweb-group-alist)))
 125       (setq nnweb-group group)
 126       (setq nnweb-type (nth 2 info))
 127       (setq nnweb-search (nth 3 info))
 128       (unless dont-check
 129         (nnweb-read-overview group))))
 130   (cond
 131    ((not nnweb-articles)
 132     (nnheader-report 'nnweb "No matching articles"))
 133    (t
 134     (let ((active (if nnweb-ephemeral-p
 135                       (cons (caar nnweb-articles)
 136                             (caar (last nnweb-articles)))
 137                     (cadr (assoc group nnweb-group-alist)))))
 138       (nnheader-report 'nnweb "Opened group %s" group)
 139       (nnheader-insert
 140        "211 %d %d %d %s\n" (length nnweb-articles)
 141        (car active) (cdr active) group)))))
 142
 143 (deffoo nnweb-close-group (group &optional server)
 144   (nnweb-possibly-change-server group server)
 145   (when (gnus-buffer-live-p nnweb-buffer)
 146     (save-excursion
 147       (set-buffer nnweb-buffer)
 148       (set-buffer-modified-p nil)
 149       (kill-buffer nnweb-buffer)))
 150   t)
 151
 152 (deffoo nnweb-request-article (article &optional group server buffer)
 153   (nnweb-possibly-change-server group server)
 154   (save-excursion
 155     (set-buffer (or buffer nntp-server-buffer))
 156     (let* ((header (cadr (assq article nnweb-articles)))
 157            (url (and header (mail-header-xref header))))
 158       (when (or (and url
 159                      (nnweb-fetch-url url))
 160                 (and (stringp article)
 161                      (nnweb-definition 'id t)
 162                      (let ((fetch (nnweb-definition 'id))
 163                            art)
 164                        (when (string-match "^<\\(.*\\)>$" article)
 165                          (setq art (match-string 1 article)))
 166                        (and fetch
 167                             art
 168                             (nnweb-fetch-url
 169                              (format fetch article))))))
 170         (unless nnheader-callback-function
 171           (funcall (nnweb-definition 'article))
 172           (nnweb-decode-entities))
 173         (nnheader-report 'nnweb "Fetched article %s" article)
 174         t))))
 175
 176 (deffoo nnweb-close-server (&optional server)
 177   (when (and (nnweb-server-opened server)
 178              (gnus-buffer-live-p nnweb-buffer))
 179     (save-excursion
 180       (set-buffer nnweb-buffer)
 181       (set-buffer-modified-p nil)
 182       (kill-buffer nnweb-buffer)))
 183   (nnoo-close-server 'nnweb server))
 184
 185 (deffoo nnweb-request-list (&optional server)
 186   (nnweb-possibly-change-server nil server)
 187   (save-excursion
 188     (set-buffer nntp-server-buffer)
 189     (nnmail-generate-active nnweb-group-alist)