Mercurial > emacs
comparison lisp/nndoc.el @ 13401:178d730efae2
entered into RCS
author | Lars Magne Ingebrigtsen <larsi@gnus.org> |
---|---|
date | Sat, 04 Nov 1995 03:54:42 +0000 |
parents | |
children | 83f275dcd93a |
comparison
equal
deleted
inserted
replaced
13400:4a57cda2a39a | 13401:178d730efae2 |
---|---|
1 ;;; nndoc.el --- single file access for Gnus | |
2 ;; Copyright (C) 1995 Free Software Foundation, Inc. | |
3 | |
4 ;; Author: Lars Magne Ingebrigtsen <larsi@ifi.uio.no> | |
5 ;; Masanobu UMEDA <umerin@flab.flab.fujitsu.junet> | |
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 | |
22 ;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. | |
23 | |
24 ;;; Commentary: | |
25 | |
26 ;;; Code: | |
27 | |
28 (require 'nnheader) | |
29 (require 'rmail) | |
30 (require 'nnmail) | |
31 | |
32 (defvar nndoc-article-type 'mbox | |
33 "*Type of the file - one of `mbox', `babyl' or `digest'.") | |
34 | |
35 (defvar nndoc-digest-type 'traditional | |
36 "Type of the last digest. Auto-detected from the article header. | |
37 Possible values: | |
38 `traditional' -- the \"lots of dashes\" (30+) rules used; | |
39 we currently also do unconditional RFC 934 unquoting. | |
40 `rfc1341' -- RFC 1341 digest (MIME, unique boundary, no quoting).") | |
41 | |
42 (defconst nndoc-type-to-regexp | |
43 (list (list 'mbox | |
44 (concat "^" rmail-unix-mail-delimiter) | |
45 (concat "^" rmail-unix-mail-delimiter) | |
46 nil "^$" nil nil nil) | |
47 (list 'babyl "\^_\^L *\n" "\^_" "^[0-9].*\n" "^$" nil nil | |
48 "\\*\\*\\* EOOH \\*\\*\\*\n\\(^.+\n\\)*") | |
49 (list 'digest | |
50 "^------------------------------*[\n \t]+" | |
51 "^------------------------------*[\n \t]+" | |
52 nil "^ ?$" | |
53 "^------------------------------*[\n \t]+" | |
54 "^End of" nil)) | |
55 "Regular expressions for articles of the various types.") | |
56 | |
57 | |
58 | |
59 (defvar nndoc-article-begin nil) | |
60 (defvar nndoc-article-end nil) | |
61 (defvar nndoc-head-begin nil) | |
62 (defvar nndoc-head-end nil) | |
63 (defvar nndoc-first-article nil) | |
64 (defvar nndoc-end-of-file nil) | |
65 (defvar nndoc-body-begin nil) | |
66 | |
67 (defvar nndoc-current-server nil) | |
68 (defvar nndoc-server-alist nil) | |
69 (defvar nndoc-server-variables | |
70 (list | |
71 (list 'nndoc-article-type nndoc-article-type) | |
72 '(nndoc-article-begin nil) | |
73 '(nndoc-article-end nil) | |
74 '(nndoc-head-begin nil) | |
75 '(nndoc-head-end nil) | |
76 '(nndoc-first-article nil) | |
77 '(nndoc-current-buffer nil) | |
78 '(nndoc-group-alist nil) | |
79 '(nndoc-end-of-file nil) | |
80 '(nndoc-body-begin nil) | |
81 '(nndoc-address nil))) | |
82 | |
83 (defconst nndoc-version "nndoc 1.0" | |
84 "nndoc version.") | |
85 | |
86 (defvar nndoc-current-buffer nil | |
87 "Current nndoc news buffer.") | |
88 | |
89 (defvar nndoc-address nil) | |
90 | |
91 | |
92 | |
93 (defvar nndoc-status-string "") | |
94 | |
95 (defvar nndoc-group-alist nil) | |
96 | |
97 ;;; Interface functions | |
98 | |
99 (defun nndoc-retrieve-headers (sequence &optional newsgroup server) | |
100 (save-excursion | |
101 (set-buffer nntp-server-buffer) | |
102 (erase-buffer) | |
103 (let ((prev 2) | |
104 article p beg lines) | |
105 (nndoc-possibly-change-buffer newsgroup server) | |
106 (if (stringp (car sequence)) | |
107 'headers | |
108 (set-buffer nndoc-current-buffer) | |
109 (widen) | |
110 (goto-char (point-min)) | |
111 (re-search-forward (or nndoc-first-article | |
112 nndoc-article-begin) nil t) | |
113 (or (not nndoc-head-begin) | |
114 (re-search-forward nndoc-head-begin nil t)) | |
115 (re-search-forward nndoc-head-end nil t) | |
116 (while sequence | |
117 (setq article (car sequence)) | |
118 (set-buffer nndoc-current-buffer) | |
119 (if (not (nndoc-forward-article (max 0 (- article prev)))) | |
120 () | |
121 (setq p (point)) | |
122 (setq beg (or (and | |
123 (re-search-backward nndoc-article-begin nil t) | |
124 (match-end 0)) | |
125 (point-min))) | |
126 (goto-char p) | |
127 (setq lines (count-lines | |
128 (point) | |
129 (or | |
130 (and (re-search-forward nndoc-article-end nil t) | |
131 (goto-char (match-beginning 0))) | |
132 (goto-char (point-max))))) | |
133 | |
134 (set-buffer nntp-server-buffer) | |
135 (insert (format "221 %d Article retrieved.\n" article)) | |
136 (insert-buffer-substring nndoc-current-buffer beg p) | |
137 (goto-char (point-max)) | |
138 (or (= (char-after (1- (point))) ?\n) (insert "\n")) | |
139 (insert (format "Lines: %d\n" lines)) | |
140 (insert ".\n")) | |
141 | |
142 (setq prev article | |
143 sequence (cdr sequence))) | |
144 | |
145 ;; Fold continuation lines. | |
146 (set-buffer nntp-server-buffer) | |
147 (goto-char (point-min)) | |
148 (while (re-search-forward "\\(\r?\n[ \t]+\\)+" nil t) | |
149 (replace-match " " t t)) | |
150 'headers)))) | |
151 | |
152 (defun nndoc-open-server (server &optional defs) | |
153 (nnheader-init-server-buffer) | |
154 (if (equal server nndoc-current-server) | |
155 t | |
156 (if nndoc-current-server | |
157 (setq nndoc-server-alist | |
158 (cons (list nndoc-current-server | |
159 (nnheader-save-variables nndoc-server-variables)) | |
160 nndoc-server-alist))) | |
161 (let ((state (assoc server nndoc-server-alist))) | |
162 (if state | |
163 (progn | |
164 (nnheader-restore-variables (nth 1 state)) | |
165 (setq nndoc-server-alist (delq state nndoc-server-alist))) | |
166 (nnheader-set-init-variables nndoc-server-variables defs))) | |
167 (setq nndoc-current-server server) | |
168 (let ((defs (cdr (assq nndoc-article-type nndoc-type-to-regexp)))) | |
169 (setq nndoc-article-begin (nth 0 defs)) | |
170 (setq nndoc-article-end (nth 1 defs)) | |
171 (setq nndoc-head-begin (nth 2 defs)) | |
172 (setq nndoc-head-end (nth 3 defs)) | |
173 (setq nndoc-first-article (nth 4 defs)) | |
174 (setq nndoc-end-of-file (nth 5 defs)) | |
175 (setq nndoc-body-begin (nth 6 defs))) | |
176 t)) | |
177 | |
178 (defun nndoc-close-server (&optional server) | |
179 t) | |
180 | |
181 (defun nndoc-server-opened (&optional server) | |
182 (and (equal server nndoc-current-server) | |
183 nntp-server-buffer | |
184 (buffer-name nntp-server-buffer))) | |
185 | |
186 (defun nndoc-status-message (&optional server) | |
187 nndoc-status-string) | |
188 | |
189 (defun nndoc-request-article (article &optional newsgroup server buffer) | |
190 (nndoc-possibly-change-buffer newsgroup server) | |
191 (save-excursion | |
192 (let ((buffer (or buffer nntp-server-buffer))) | |
193 (set-buffer buffer) | |
194 (erase-buffer) | |
195 (if (stringp article) | |
196 nil | |
197 (nndoc-insert-article article) | |
198 ;; Unquote quoted non-separators in digests. | |
199 (if (and (eq nndoc-article-type 'digest) | |
200 (eq nndoc-digest-type 'traditional)) | |
201 (progn | |
202 (goto-char (point-min)) | |
203 (while (re-search-forward "^- -"nil t) | |
204 (replace-match "-" t t)))) | |
205 ;; Some assholish digests do not have a blank line after the | |
206 ;; headers. Aargh! | |
207 (goto-char (point-min)) | |
208 (if (search-forward "\n\n" nil t) | |
209 () ; We let this one pass. | |
210 (if (re-search-forward "^[ \t]+$" nil t) | |
211 (replace-match "" t t) ; We nix out a line of blanks. | |
212 (while (and (looking-at "[^ ]+:") | |
213 (zerop (forward-line 1)))) | |
214 ;; We just insert a couple of lines. If you read digests | |
215 ;; that are so badly formatted, you don't deserve any | |
216 ;; better. Blphphpht! | |
217 (insert "\n\n"))) | |
218 t)))) | |
219 | |
220 (defun nndoc-request-group (group &optional server dont-check) | |
221 "Select news GROUP." | |
222 (save-excursion | |
223 (if (not (nndoc-possibly-change-buffer group server)) | |
224 (progn | |
225 (setq nndoc-status-string "No such file or buffer") | |
226 nil) | |
227 (nndoc-set-header-dependent-regexps) ; hack for MIME digests | |
228 (if dont-check | |
229 t | |
230 (save-excursion | |
231 (set-buffer nntp-server-buffer) | |
232 (erase-buffer) | |
233 (let ((number (nndoc-number-of-articles))) | |
234 (if (zerop number) | |
235 (progn | |
236 (nndoc-close-group group) | |
237 nil) | |
238 (insert (format "211 %d %d %d %s\n" number 1 number group)) | |
239 t))))))) | |
240 | |
241 (defun nndoc-close-group (group &optional server) | |
242 (nndoc-possibly-change-buffer group server) | |
243 (kill-buffer nndoc-current-buffer) | |
244 (setq nndoc-group-alist (delq (assoc group nndoc-group-alist) | |
245 nndoc-group-alist)) | |
246 (setq nndoc-current-buffer nil) | |
247 (setq nndoc-current-server nil) | |
248 t) | |
249 | |
250 (defun nndoc-request-list (&optional server) | |
251 nil) | |
252 | |
253 (defun nndoc-request-newgroups (date &optional server) | |
254 nil) | |
255 | |
256 (defun nndoc-request-list-newsgroups (&optional server) | |
257 nil) | |
258 | |
259 (defalias 'nndoc-request-post 'nnmail-request-post) | |
260 (defalias 'nndoc-request-post-buffer 'nnmail-request-post-buffer) | |
261 | |
262 | |
263 ;;; Internal functions. | |
264 | |
265 (defun nndoc-possibly-change-buffer (group source) | |
266 (let (buf) | |
267 (cond | |
268 ;; The current buffer is this group's buffer. | |
269 ((and nndoc-current-buffer | |
270 (eq nndoc-current-buffer | |
271 (setq buf (cdr (assoc group nndoc-group-alist)))))) | |
272 ;; We change buffers by taking an old from the group alist. | |
273 ;; `source' is either a string (a file name) or a buffer object. | |
274 (buf | |
275 (setq nndoc-current-buffer buf)) | |
276 ;; It's a totally new group. | |
277 ((or (and (bufferp nndoc-address) | |
278 (buffer-name nndoc-address)) | |
279 (and (stringp nndoc-address) | |
280 (file-exists-p nndoc-address) | |
281 (not (file-directory-p nndoc-address)))) | |
282 (setq nndoc-group-alist | |
283 (cons (cons group (setq nndoc-current-buffer | |
284 (get-buffer-create | |
285 (concat " *nndoc " group "*")))) | |
286 nndoc-group-alist)) | |
287 (save-excursion | |
288 (set-buffer nndoc-current-buffer) | |
289 (buffer-disable-undo (current-buffer)) | |
290 (erase-buffer) | |
291 (if (stringp nndoc-address) | |
292 (insert-file-contents nndoc-address) | |
293 (save-excursion | |
294 (set-buffer nndoc-address) | |
295 (widen)) | |
296 (insert-buffer-substring nndoc-address)) | |
297 t))))) | |
298 | |
299 ;; MIME (RFC 1341) digest hack by Ulrik Dickow <dickow@nbi.dk>. | |
300 (defun nndoc-set-header-dependent-regexps () | |
301 (if (not (eq nndoc-article-type 'digest)) | |
302 () | |
303 (let ((case-fold-search t) ; We match a bit too much, keep it simple. | |
304 (boundary-id) (b-delimiter)) | |
305 (save-excursion | |
306 (set-buffer nndoc-current-buffer) | |
307 (goto-char (point-min)) | |
308 (if (and | |
309 (re-search-forward | |
310 (concat "\n\n\\|^Content-Type: *multipart/digest;[ \t\n]*[ \t]" | |
311 "boundary=\"\\([^\"\n]*[^\" \t\n]\\)\"") | |
312 nil t) | |
313 (match-beginning 1)) | |
314 (setq nndoc-digest-type 'rfc1341 | |
315 boundary-id (format "%s" | |
316 (buffer-substring | |
317 (match-beginning 1) (match-end 1))) | |
318 b-delimiter (concat "\n--" boundary-id "[\n \t]+") | |
319 nndoc-article-begin b-delimiter ; Too strict: "[ \t]*$" | |
320 nndoc-article-end (concat "\n--" boundary-id | |
321 "\\(--\\)?[\n \t]+") | |
322 nndoc-first-article b-delimiter ; ^eof ends article too. | |
323 nndoc-end-of-file (concat "\n--" boundary-id "--[ \t]*$")) | |
324 (setq nndoc-digest-type 'traditional)))))) | |
325 | |
326 (defun nndoc-forward-article (n) | |
327 (while (and (> n 0) | |
328 (re-search-forward nndoc-article-begin nil t) | |
329 (or (not nndoc-head-begin) | |
330 (re-search-forward nndoc-head-begin nil t)) | |
331 (re-search-forward nndoc-head-end nil t)) | |
332 (setq n (1- n))) | |
333 (zerop n)) | |
334 | |
335 (defun nndoc-number-of-articles () | |
336 (save-excursion | |
337 (set-buffer nndoc-current-buffer) | |
338 (widen) | |
339 (goto-char (point-min)) | |
340 (let ((num 0)) | |
341 (if (re-search-forward (or nndoc-first-article | |
342 nndoc-article-begin) nil t) | |
343 (progn | |
344 (setq num 1) | |
345 (while (and (re-search-forward nndoc-article-begin nil t) | |
346 (or (not nndoc-end-of-file) | |
347 (not (looking-at nndoc-end-of-file))) | |
348 (or (not nndoc-head-begin) | |
349 (re-search-forward nndoc-head-begin nil t)) | |
350 (re-search-forward nndoc-head-end nil t)) | |
351 (setq num (1+ num))))) | |
352 num))) | |
353 | |
354 (defun nndoc-narrow-to-article (article) | |
355 (save-excursion | |
356 (set-buffer nndoc-current-buffer) | |
357 (widen) | |
358 (goto-char (point-min)) | |
359 (while (and (re-search-forward nndoc-article-begin nil t) | |
360 (not (zerop (setq article (1- article)))))) | |
361 (if (not (zerop article)) | |
362 () | |
363 (narrow-to-region | |
364 (match-end 0) | |
365 (or (and (re-search-forward nndoc-article-end nil t) | |
366 (match-beginning 0)) | |
367 (point-max))) | |
368 t))) | |
369 | |
370 ;; Insert article ARTICLE in the current buffer. | |
371 (defun nndoc-insert-article (article) | |
372 (let ((ibuf (current-buffer))) | |
373 (save-excursion | |
374 (set-buffer nndoc-current-buffer) | |
375 (widen) | |
376 (goto-char (point-min)) | |
377 (while (and (re-search-forward nndoc-article-begin nil t) | |
378 (not (zerop (setq article (1- article)))))) | |
379 (if (not (zerop article)) | |
380 () | |
381 (narrow-to-region | |
382 (match-end 0) | |
383 (or (and (re-search-forward nndoc-article-end nil t) | |
384 (match-beginning 0)) | |
385 (point-max))) | |
386 (goto-char (point-min)) | |
387 (and nndoc-head-begin | |
388 (re-search-forward nndoc-head-begin nil t) | |
389 (narrow-to-region (point) (point-max))) | |
390 (or (re-search-forward nndoc-head-end nil t) | |
391 (goto-char (point-max))) | |
392 (append-to-buffer ibuf (point-min) (point)) | |
393 (and nndoc-body-begin | |
394 (re-search-forward nndoc-body-begin nil t)) | |
395 (append-to-buffer ibuf (point) (point-max)) | |
396 t)))) | |
397 | |
398 (provide 'nndoc) | |
399 | |
400 ;;; nndoc.el ends here |