1 ;;; nnweb.el --- retrieving articles via web search engines
2 ;; Copyright (C) 1996,97,98,99 Free Software Foundation, Inc.
4 ;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
7 ;; This file is part of GNU Emacs.
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)
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.
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.
26 ;; Note: You need to have `url' and `w3' installed for this
31 (eval-when-compile (require 'cl))
44 ;; Report failure to find w3 at load time if appropriate.
52 (defvoo nnweb-directory (nnheader-concat gnus-directory "nnweb/")
53 "Where nnweb will save its files.")
55 (defvoo nnweb-type 'dejanews
56 "What search engine type is being used.
57 Valid types include `dejanews', `dejanewsold', `reference',
60 (defvar nnweb-type-definition
63 (id . "http://search.dejanews.com/msgid.xp?MID=%s&fmt=text")
64 (map . nnweb-dejanews-create-mapping)
65 (search . nnweb-dejanews-search)
66 (address . "http://www.deja.com/=dnc/qs.xp")
67 (identifier . nnweb-dejanews-identity))
70 (map . nnweb-dejanews-create-mapping)
71 (search . nnweb-dejanewsold-search)
72 (address . "http://www.deja.com/dnquery.xp")
73 (identifier . nnweb-dejanews-identity))
75 (article . nnweb-reference-wash-article)
76 (map . nnweb-reference-create-mapping)
77 (search . nnweb-reference-search)
78 (address . "http://www.reference.com/cgi-bin/pn/go")
79 (identifier . identity))
81 (article . nnweb-altavista-wash-article)
82 (map . nnweb-altavista-create-mapping)
83 (search . nnweb-altavista-search)
84 (address . "http://www.altavista.digital.com/cgi-bin/query")
85 (id . "/cgi-bin/news?id@%s")
86 (identifier . identity)))
87 "Type-definition alist.")
89 (defvoo nnweb-search nil
90 "Search string to feed to DejaNews.")
92 (defvoo nnweb-max-hits 999
93 "Maximum number of hits to display.")
95 (defvoo nnweb-ephemeral-p nil
96 "Whether this nnweb server is ephemeral.")
98 ;;; Internal variables
100 (defvoo nnweb-articles nil)
101 (defvoo nnweb-buffer nil)
102 (defvoo nnweb-group-alist nil)
103 (defvoo nnweb-group nil)
104 (defvoo nnweb-hashtb nil)
106 ;;; Interface functions
108 (nnoo-define-basics nnweb)
110 (deffoo nnweb-retrieve-headers (articles &optional group server fetch-old)
111 (nnweb-possibly-change-server group server)
113 (set-buffer nntp-server-buffer)
115 (let (article header)
116 (mm-with-unibyte-current-buffer
117 (while (setq article (pop articles))
118 (when (setq header (cadr (assq article nnweb-articles)))
119 (nnheader-insert-nov header))))
122 (deffoo nnweb-request-scan (&optional group server)
123 (nnweb-possibly-change-server group server)
124 (setq nnweb-hashtb (gnus-make-hashtable 4095))
125 (funcall (nnweb-definition 'map))
126 (unless nnweb-ephemeral-p
128 (nnweb-write-overview group)))
130 (deffoo nnweb-request-group (group &optional server dont-check)
131 (nnweb-possibly-change-server nil server)
133 (not (equal group nnweb-group))
134 (not nnweb-ephemeral-p))
135 (let ((info (assoc group nnweb-group-alist)))
137 (setq nnweb-group group)
138 (setq nnweb-type (nth 2 info))
139 (setq nnweb-search (nth 3 info))
141 (nnweb-read-overview group)))))
143 (nnweb-request-scan group))
145 ((not nnweb-articles)
146 (nnheader-report 'nnweb "No matching articles"))
148 (let ((active (if nnweb-ephemeral-p
149 (cons (caar nnweb-articles)
150 (caar (last nnweb-articles)))
151 (cadr (assoc group nnweb-group-alist)))))
152 (nnheader-report 'nnweb "Opened group %s" group)
154 "211 %d %d %d %s\n" (length nnweb-articles)
155 (car active) (cdr active) group)))))
157 (deffoo nnweb-close-group (group &optional server)
158 (nnweb-possibly-change-server group server)
159 (when (gnus-buffer-live-p nnweb-buffer)
161 (set-buffer nnweb-buffer)
162 (set-buffer-modified-p nil)
163 (kill-buffer nnweb-buffer)))
166 (deffoo nnweb-request-article (article &optional group server buffer)
167 (nnweb-possibly-change-server group server)
169 (set-buffer (or buffer nntp-server-buffer))
170 (let* ((header (cadr (assq article nnweb-articles)))
171 (url (and header (mail-header-xref header))))
173 (mm-with-unibyte-current-buffer
174 (nnweb-fetch-url url)))
175 (and (stringp article)
176 (nnweb-definition 'id t)
177 (let ((fetch (nnweb-definition 'id))
179 (when (string-match "^<\\(.*\\)>$" article)
180 (setq art (match-string 1 article)))
183 (mm-with-unibyte-current-buffer
185 (format fetch article)))))))
186 (unless nnheader-callback-function
187 (funcall (nnweb-definition 'article))
188 (nnweb-decode-entities))
189 (nnheader-report 'nnweb "Fetched article %s" article)
190 (cons group (and (numberp article) article))))))
192 (deffoo nnweb-close-server (&optional server)
193 (when (and (nnweb-server-opened server)
194 (gnus-buffer-live-p nnweb-buffer))
196 (set-buffer nnweb-buffer)
197 (set-buffer-modified-p nil)
198 (kill-buffer nnweb-buffer)))
199 (nnoo-close-server 'nnweb server))
201 (deffoo nnweb-request-list (&optional server)
202 (nnweb-possibly-change-server nil server)
204 (set-buffer nntp-server-buffer)
205 (nnmail-generate-active nnweb-group-alist)
208 (deffoo nnweb-request-update-info (group info &optional server)
209 (nnweb-possibly-change-server group server))
211 (deffoo nnweb-asynchronous-p ()
214 (deffoo nnweb-request-create-group (group &optional server args)
215 (nnweb-possibly-change-server nil server)
216 (nnweb-request-delete-group group)
217 (push `(,group ,(cons 1 0) ,@args) nnweb-group-alist)
221 (deffoo nnweb-request-delete-group (group &optional force server)
222 (nnweb-possibly-change-server group server)
223 (gnus-pull group nnweb-group-alist t)
225 (gnus-delete-file (nnweb-overview-file group))
228 (nnoo-define-skeleton nnweb)
230 ;;; Internal functions
232 (defun nnweb-read-overview (group)
233 "Read the overview of GROUP and build the map."
234 (when (file-exists-p (nnweb-overview-file group))
235 (mm-with-unibyte-buffer
236 (nnheader-insert-file-contents (nnweb-overview-file group))
237 (goto-char (point-min))
240 (setq header (nnheader-parse-nov))
242 (push (list (mail-header-number header)
243 header (mail-header-xref header))
245 (nnweb-set-hashtb header (car nnweb-articles)))))))
247 (defun nnweb-write-overview (group)
248 "Write the overview file for GROUP."
249 (with-temp-file (nnweb-overview-file group)
250 (let ((articles nnweb-articles))
252 (nnheader-insert-nov (cadr (pop articles)))))))
254 (defun nnweb-set-hashtb (header data)
255 (gnus-sethash (nnweb-identifier (mail-header-xref header))
258 (defun nnweb-get-hashtb (url)
259 (gnus-gethash (nnweb-identifier url) nnweb-hashtb))
261 (defun nnweb-identifier (ident)
262 (funcall (nnweb-definition 'identifier) ident))
264 (defun nnweb-overview-file (group)
265 "Return the name of the overview file of GROUP."
266 (nnheader-concat nnweb-directory group ".overview"))
268 (defun nnweb-write-active ()
269 "Save the active file."
270 (gnus-make-directory nnweb-directory)
271 (with-temp-file (nnheader-concat nnweb-directory "active")
272 (prin1 `(setq nnweb-group-alist ',nnweb-group-alist) (current-buffer))))
274 (defun nnweb-read-active ()
275 "Read the active file."
276 (load (nnheader-concat nnweb-directory "active") t t t))
278 (defun nnweb-definition (type &optional noerror)
279 "Return the definition of TYPE."
280 (let ((def (cdr (assq type (assq nnweb-type nnweb-type-definition)))))
283 (error "Undefined definition %s" type))
286 (defun nnweb-possibly-change-server (&optional group server)
289 (unless (nnweb-server-opened server)
290 (nnweb-open-server server)))
291 (unless nnweb-group-alist
294 (when (and (not nnweb-ephemeral-p)
295 (not (equal group nnweb-group)))
296 (nnweb-request-group group nil t))))
298 (defun nnweb-init (server)
299 "Initialize buffers and such."
300 (unless (gnus-buffer-live-p nnweb-buffer)
304 (nnheader-set-temp-buffer
305 (format " *nnweb %s %s %s*"
306 nnweb-type nnweb-search server))
307 (current-buffer))))))
309 (defun nnweb-fetch-url (url)
312 (if (not nnheader-callback-function)
315 (mm-enable-multibyte)
316 (let ((coding-system-for-read 'binary)
317 (coding-system-for-write 'binary)
318 (default-process-coding-system 'binary))
320 (setq buf (buffer-string)))
324 (nnweb-url-retrieve-asynch
325 url 'nnweb-callback (current-buffer) nnheader-callback-function)
328 (defun nnweb-callback (buffer callback)
329 (when (gnus-buffer-live-p url-working-buffer)
331 (set-buffer url-working-buffer)
332 (funcall (nnweb-definition 'article))
333 (nnweb-decode-entities)
335 (goto-char (point-max))
336 (insert-buffer-substring url-working-buffer))
338 (gnus-kill-buffer url-working-buffer)))
340 (defun nnweb-url-retrieve-asynch (url callback &rest data)
341 (let ((url-request-method "GET")
342 (old-asynch url-be-asynchronous)
343 (url-request-data nil)