1 ;;; nndoc.el --- single file access for Gnus
3 ;; Copyright (C) 1995 Free Software Foundation, Inc.
5 ;; Author: Lars Magne Ingebrigtsen <larsi@ifi.uio.no>
6 ;; Masanobu UMEDA <umerin@flab.flab.fujitsu.junet>
9 ;; This file is part of GNU Emacs.
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)
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.
21 ;; You should have received a copy of the GNU General Public License
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.
34 (defvar nndoc-article-type
'mbox
35 "*Type of the file - one of `mbox', `babyl' or `digest'.")
37 (defvar nndoc-digest-type
'traditional
38 "Type of the last digest. Auto-detected from the article header.
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).")
44 (defconst nndoc-type-to-regexp
46 (concat "^" rmail-unix-mail-delimiter
)
47 (concat "^" rmail-unix-mail-delimiter
)
49 (list 'babyl
"\^_\^L *\n" "\^_" "^[0-9].*\n" "^$" nil nil
50 "\\*\\*\\* EOOH \\*\\*\\*\n\\(^.+\n\\)*")
52 "^------------------------------*[\n \t]+"
53 "^------------------------------*[\n \t]+"
55 "^------------------------------*[\n \t]+"
57 "Regular expressions for articles of the various types.")
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
)
69 (defvar nndoc-current-server nil
)
70 (defvar nndoc-server-alist nil
)
71 (defvar nndoc-server-variables
73 (list 'nndoc-article-type nndoc-article-type
)
74 '(nndoc-article-begin nil
)
75 '(nndoc-article-end nil
)
76 '(nndoc-head-begin 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
)))
85 (defconst nndoc-version
"nndoc 1.0"
88 (defvar nndoc-current-buffer nil
89 "Current nndoc news buffer.")
91 (defvar nndoc-address nil
)
95 (defvar nndoc-status-string
"")
97 (defvar nndoc-group-alist nil
)
99 ;;; Interface functions
101 (defun nndoc-retrieve-headers (sequence &optional newsgroup server
)
103 (set-buffer nntp-server-buffer
)
107 (nndoc-possibly-change-buffer newsgroup server
)
108 (if (stringp (car sequence
))
110 (set-buffer nndoc-current-buffer
)
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
)
119 (setq article
(car sequence
))
120 (set-buffer nndoc-current-buffer
)
121 (if (not (nndoc-forward-article (max 0 (- article prev
))))
125 (re-search-backward nndoc-article-begin nil t
)
129 (setq lines
(count-lines
132 (and (re-search-forward nndoc-article-end nil t
)
133 (goto-char (match-beginning 0)))
134 (goto-char (point-max)))))
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
))
145 sequence
(cdr sequence
)))
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
))
154 (defun nndoc-open-server (server &optional defs
)
155 (nnheader-init-server-buffer)
156 (if (equal server nndoc-current-server
)
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
)))
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
)))
180 (defun nndoc-close-server (&optional server
)
183 (defun nndoc-server-opened (&optional server
)
184 (and (equal server nndoc-current-server
)
186 (buffer-name nntp-server-buffer
)))
188 (defun nndoc-status-message (&optional server
)
191 (defun nndoc-request-article (article &optional newsgroup server buffer
)
192 (nndoc-possibly-change-buffer newsgroup server
)
194 (let ((buffer (or buffer nntp-server-buffer
)))
197 (if (stringp article
)
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
))
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
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!
222 (defun nndoc-request-group (group &optional server dont-check
)
225 (if (not (nndoc-possibly-change-buffer group server
))
227 (setq nndoc-status-string
"No such file or buffer")
229 (nndoc-set-header-dependent-regexps) ; hack for MIME digests
233 (set-buffer nntp-server-buffer
)
235 (let ((number (nndoc-number-of-articles)))
238 (nndoc-close-group group
)
240 (insert (format "211 %d %d %d %s\n" number
1 number group
))
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
)
248 (setq nndoc-current-buffer nil
)
249 (setq nndoc-current-server nil
)
252 (defun nndoc-request-list (&optional server
)
255 (defun nndoc-request-newgroups (date &optional server
)
258 (defun nndoc-request-list-newsgroups (&optional server
)
261 (defalias 'nndoc-request-post
'nnmail-request-post
)
262 (defalias 'nndoc-request-post-buffer
'nnmail-request-post-buffer
)
265 ;;; Internal functions.
267 (defun nndoc-possibly-change-buffer (group source
)
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.
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
287 (concat " *nndoc " group
"*"))))
290 (set-buffer nndoc-current-buffer
)
291 (buffer-disable-undo (current-buffer))
293 (if (stringp nndoc-address
)
294 (insert-file-contents nndoc-address
)
296 (set-buffer nndoc-address
)
298 (insert-buffer-substring nndoc-address
))
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
))
305 (let ((case-fold-search t
) ; We match a bit too much, keep it simple.
306 (boundary-id) (b-delimiter))
308 (set-buffer nndoc-current-buffer
)
309 (goto-char (point-min))
312 (concat "\n\n\\|^Content-Type: *multipart/digest;[ \t\n]*[ \t]"
313 "boundary=\"\\([^\"\n]*[^\" \t\n]\\)\"")
316 (setq nndoc-digest-type
'rfc1341
317 boundary-id
(format "%s"
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
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
))))))
328 (defun nndoc-forward-article (n)
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
))
337 (defun nndoc-number-of-articles ()
339 (set-buffer nndoc-current-buffer
)
341 (goto-char (point-min))
343 (if (re-search-forward (or nndoc-first-article
344 nndoc-article-begin
) nil t
)
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
)))))
356 (defun nndoc-narrow-to-article (article)
358 (set-buffer nndoc-current-buffer
)
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
))
367 (or (and (re-search-forward nndoc-article-end nil t
)
372 ;; Insert article ARTICLE in the current buffer.
373 (defun nndoc-insert-article (article)
374 (let ((ibuf (current-buffer)))
376 (set-buffer nndoc-current-buffer
)
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
))
385 (or (and (re-search-forward nndoc-article-end nil t
)
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))
402 ;;; nndoc.el ends here