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