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      (reference . nnweb-google-reference)
  69      (map . nnweb-google-create-mapping)
  70      (search . nnweb-google-search)
  71      (address . "http://groups.google.com/groups")
  72      (identifier . nnweb-google-identity))
  73 ;;;     (dejanews
  74 ;;;      (article . ignore)
  75 ;;;      (id . "http://search.dejanews.com/msgid.xp?MID=%s&fmt=text")
  76 ;;;      (map . nnweb-dejanews-create-mapping)
  77 ;;;      (search . nnweb-dejanews-search)
  78 ;;;      (address . "http://www.deja.com/=dnc/qs.xp")
  79 ;;;      (identifier . nnweb-dejanews-identity))
  80 ;;;     (dejanewsold
  81 ;;;      (article . ignore)
  82 ;;;      (map . nnweb-dejanews-create-mapping)
  83 ;;;      (search . nnweb-dejanewsold-search)
  84 ;;;      (address . "http://www.deja.com/dnquery.xp")
  85 ;;;      (identifier . nnweb-dejanews-identity))
  86     (reference
  87      (article . nnweb-reference-wash-article)
  88      (map . nnweb-reference-create-mapping)
  89      (search . nnweb-reference-search)
  90      (address . "http://www.reference.com/cgi-bin/pn/go")
  91      (identifier . identity))
  92     (altavista
  93      (article . nnweb-altavista-wash-article)
  94      (map . nnweb-altavista-create-mapping)
  95      (search . nnweb-altavista-search)
  96      (address . "http://www.altavista.digital.com/cgi-bin/query")
  97      (id . "/cgi-bin/news?id@%s")
  98      (identifier . identity)))
  99   "Type-definition alist.")
 100
 101 (defvoo nnweb-search nil
 102   "Search string to feed to DejaNews.")
 103
 104 (defvoo nnweb-max-hits 999
 105   "Maximum number of hits to display.")
 106
 107 (defvoo nnweb-ephemeral-p nil
 108   "Whether this nnweb server is ephemeral.")
 109
 110 ;;; Internal variables
 111
 112 (defvoo nnweb-articles nil)
 113 (defvoo nnweb-buffer nil)
 114 (defvoo nnweb-group-alist nil)
 115 (defvoo nnweb-group nil)
 116 (defvoo nnweb-hashtb nil)
 117
 118 ;;; Interface functions
 119
 120 (nnoo-define-basics nnweb)
 121
 122 (deffoo nnweb-retrieve-headers (articles &optional group server fetch-old)
 123   (nnweb-possibly-change-server group server)
 124   (save-excursion
 125     (set-buffer nntp-server-buffer)
 126     (erase-buffer)
 127     (let (article header)
 128       (mm-with-unibyte-current-buffer
 129         (while (setq article (pop articles))
 130           (when (setq header (cadr (assq article nnweb-articles)))
 131             (nnheader-insert-nov header))))
 132       'nov)))
 133
 134 (deffoo nnweb-request-scan (&optional group server)
 135   (nnweb-possibly-change-server group server)
 136   (funcall (nnweb-definition 'map))
 137   (unless nnweb-ephemeral-p
 138     (nnweb-write-active)
 139     (nnweb-write-overview group)))
 140
 141 (deffoo nnweb-request-group (group &optional server dont-check)
 142   (nnweb-possibly-change-server nil server)
 143   (when (and group
 144              (not (equal group nnweb-group))
 145              (not nnweb-ephemeral-p))
 146     (setq nnweb-group group
 147           nnweb-articles nil)
 148     (let ((info (assoc group nnweb-group-alist)))
 149       (when info
 150         (setq nnweb-type (nth 2 info))
 151         (setq nnweb-search (nth 3 info))
 152         (unless dont-check
 153           (nnweb-read-overview group)))))
 154   (cond
 155    ((not nnweb-articles)
 156     (nnheader-report 'nnweb "No matching articles"))
 157    (t
 158     (let ((active (if nnweb-ephemeral-p
 159                       (cons (caar nnweb-articles)
 160                             (caar (last nnweb-articles)))
 161                     (cadr (assoc group nnweb-group-alist)))))
 162       (nnheader-report 'nnweb "Opened group %s" group)
 163       (nnheader-insert
 164        "211 %d %d %d %s\n" (length nnweb-articles)
 165        (car active) (cdr active) group)))))
 166
 167 (deffoo nnweb-close-group (group &optional server)
 168   (nnweb-possibly-change-server group server)
 169   (when (gnus-buffer-live-p nnweb-buffer)
 170     (save-excursion
 171       (set-buffer nnweb-buffer)
 172       (set-buffer-modified-p nil)
 173       (kill-buffer nnweb-buffer)))
 174   t)
 175
 176 (deffoo nnweb-request-article (article &optional group server buffer)
 177   (nnweb-possibly-change-server group server)
 178   (save-excursion
 179     (set-buffer (or buffer nntp-server-buffer))
 180     (let* ((header (cadr (assq article nnweb-articles)))
 181            (url (and header (mail-header-xref header))))
 182       (when (or (and url
 183                      (mm-with-unibyte-current-buffer
 184                        (nnweb-fetch-url url)))
 185                 (and (stringp article)
 186                      (nnweb-definition 'id t)
 187                      (let ((fetch (nnweb-definition 'id))
 188                            art active)
 189                        (when (string-match "^<\\(.*\\)>$" article)
 190                          (setq art (match-string 1 article)))
 191                        (when (and fetch art)
 192                          (setq url (format fetch article))
 193                          (mm-with-unibyte-current-buffer
 194                            (nnweb-fetch-url url))
 195                          (if (nnweb-definition 'reference t)
 196                              (setq article
 197                                    (funcall (nnweb-definition
 198                                              'reference) article)))))))
 199         (unless nnheader-callback-function
 200           (funcall (nnweb-definition 'article))
 201           (nnweb-decode-entities))
 202         (nnheader-report 'nnweb "Fetched article %s" article)
 203         (cons group (and (numberp article) article))))))
 204
 205 (deffoo nnweb-close-server (&optional server)
 206   (when (and (nnweb-server-opened server)
 207              (gnus-buffer-live-p nnweb-buffer))
 208     (save-excursion
 209       (set-buffer nnweb-buffer)
 210       (set-buffer-modified-p nil)
 211       (kill-buffer nnweb-buffer)))
 212   (nnoo-close-server 'nnweb server))
 213
 214 (deffoo nnweb-request-list (&optional server)
 215   (nnweb-possibly-change-server nil server)
 216   (save-excursion
 217     (set-buffer nntp-server-buffer)
 218     (nnmail-generate-active nnweb-group-alist)
 219     t))
 220
 221 (deffoo nnweb-request-update-info (group info &optional server)
 222   (nnweb-possibly-change-server group server))
 223
 224 (deffoo nnweb-asynchronous-p ()
 225   t)
 226
 227 (deffoo nnweb-request-create-group (group &optional server args)
 228   (nnweb-possibly-change-server nil server)
 229   (nnweb-request-delete-group group)
 230   (push `(,group ,(cons 1 0) ,@args) nnweb-group-alist)
 231   (nnweb-write-active)
 232   t)
 233
 234 (deffoo nnweb-request-delete-group (group &optional force server)
 235   (nnweb-possibly-change-server group server)
 236   (gnus-pull group nnweb-group-alist t)
 237   (nnweb-write-active)
 238   (gnus-delete-file (nnweb-overview-file group))
 239   t)
 240
 241 (nnoo-define-skeleton nnweb)
 242
 243 ;;; Internal functions
 244
 245 (defun nnweb-read-overview (group)
 246   "Read the overview of GROUP and build the map."
 247   (when (file-exists-p (nnweb-overview-file group))