1 ;;; nndoc.el --- single file access for Gnus
2 ;; Copyright (C) 1995 Free Software Foundation, Inc.
4 ;; Author: Lars Magne Ingebrigtsen <larsi@ifi.uio.no>
5 ;; Masanobu UMEDA <umerin@flab.flab.fujitsu.junet>
8 ;; This file is part of GNU Emacs.
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)
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.
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.
32 (defvar nndoc-article-type 'mbox
33 "*Type of the file - one of `mbox', `babyl', `digest', or `forward'.")
35 (defvar nndoc-digest-type 'traditional
36 "Type of the last digest. Auto-detected from the article header.
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).")
42 (defconst nndoc-type-to-regexp
44 (, (concat "^" rmail-unix-mail-delimiter))
45 (, (concat "^" rmail-unix-mail-delimiter))
47 (babyl "\^_\^L *\n" "\^_" "^[0-9].*\n" "^$" nil nil
48 "\\*\\*\\* EOOH \\*\\*\\*\n\\(^.+\n\\)*")
50 "^------------------------------*[\n \t]+"
51 "^------------------------------*[\n \t]+"
53 "^------------------------------*[\n \t]+"
56 "^-+ Start of forwarded message -+\n+"
57 "^-+ End of forwarded message -+\n"
58 nil "^ ?$" nil nil nil)))
59 "Regular expressions for articles of the various types.
60 article-begin, article-end, head-begin, head-end,
61 first-article, end-of-file, body-begin.")
65 (defvar nndoc-article-begin nil)
66 (defvar nndoc-article-end nil)
67 (defvar nndoc-head-begin nil)
68 (defvar nndoc-head-end nil)
69 (defvar nndoc-first-article nil)
70 (defvar nndoc-end-of-file nil)
71 (defvar nndoc-body-begin nil)
73 (defvar nndoc-current-server nil)
74 (defvar nndoc-server-alist nil)
75 (defvar nndoc-server-variables
77 (list 'nndoc-article-type nndoc-article-type)
78 '(nndoc-article-begin nil)
79 '(nndoc-article-end nil)
80 '(nndoc-head-begin nil)
82 '(nndoc-first-article nil)
83 '(nndoc-current-buffer nil)
84 '(nndoc-group-alist nil)
85 '(nndoc-end-of-file nil)
86 '(nndoc-body-begin nil)
87 '(nndoc-address nil)))
89 (defconst nndoc-version "nndoc 1.0"
92 (defvar nndoc-current-buffer nil
93 "Current nndoc news buffer.")
95 (defvar nndoc-address nil)
99 (defvar nndoc-status-string "")
101 (defvar nndoc-group-alist nil)
103 ;;; Interface functions
105 (defun nndoc-retrieve-headers (sequence &optional newsgroup server fetch-old)
107 (set-buffer nntp-server-buffer)
111 (nndoc-possibly-change-buffer newsgroup server)
112 (if (stringp (car sequence))
114 (set-buffer nndoc-current-buffer)
116 (goto-char (point-min))
117 (re-search-forward (or nndoc-first-article
118 nndoc-article-begin) nil t)
119 (or (not nndoc-head-begin)
120 (re-search-forward nndoc-head-begin nil t))
121 (re-search-forward nndoc-head-end nil t)
123 (setq article (car sequence))
124 (set-buffer nndoc-current-buffer)
125 (if (not (nndoc-forward-article (max 0 (- article prev))))
129 (re-search-backward nndoc-article-begin nil t)
133 (setq lines (count-lines
136 (and (re-search-forward nndoc-article-end nil t)
137 (goto-char (match-beginning 0)))
138 (goto-char (point-max)))))
140 (set-buffer nntp-server-buffer)
141 (insert (format "221 %d Article retrieved.\n" article))
142 (insert-buffer-substring nndoc-current-buffer beg p)
143 (goto-char (point-max))
144 (or (= (char-after (1- (point))) ?\n) (insert "\n"))
145 (insert (format "Lines: %d\n" lines))
149 sequence (cdr sequence)))
151 ;; Fold continuation lines.
152 (set-buffer nntp-server-buffer)
153 (goto-char (point-min))
154 (while (re-search-forward "\\(\r?\n[ \t]+\\)+" nil t)
155 (replace-match " " t t))
158 (defun nndoc-open-server (server &optional defs)
159 (nnheader-init-server-buffer)
160 (if (equal server nndoc-current-server)
162 (if nndoc-current-server
163 (setq nndoc-server-alist
164 (cons (list nndoc-current-server
165 (nnheader-save-variables nndoc-server-variables))
166 nndoc-server-alist)))
167 (let ((state (assoc server nndoc-server-alist)))
170 (nnheader-restore-variables (nth 1 state))
171 (setq nndoc-server-alist (delq state nndoc-server-alist)))
172 (nnheader-set-init-variables nndoc-server-variables defs)))
173 (setq nndoc-current-server server)
174 (let ((defs (cdr (assq nndoc-article-type nndoc-type-to-regexp))))
175 (setq nndoc-article-begin (nth 0 defs))
176 (setq nndoc-article-end (nth 1 defs))
177 (setq nndoc-head-begin (nth 2 defs))
178 (setq nndoc-head-end (nth 3 defs))
179 (setq nndoc-first-article (nth 4 defs))
180 (setq nndoc-end-of-file (nth 5 defs))
181 (setq nndoc-body-begin (nth 6 defs)))
184 (defun nndoc-close-server (&optional server)
187 (defun nndoc-server-opened (&optional server)
188 (and (equal server nndoc-current-server)
190 (buffer-name nntp-server-buffer)))
192 (defun nndoc-status-message (&optional server)
195 (defun nndoc-request-article (article &optional newsgroup server buffer)
196 (nndoc-possibly-change-buffer newsgroup server)
198 (let ((buffer (or buffer nntp-server-buffer)))
201 (if (stringp article)
203 (nndoc-insert-article article)
204 ;; Unquote quoted non-separators in digests.
205 (if (and (eq nndoc-article-type 'digest)
206 (eq nndoc-digest-type 'traditional))
208 (goto-char (point-min))
209 (while (re-search-forward "^- -"nil t)
210 (replace-match "-" t t))))
211 ;; Some assholish digests do not have a blank line after the
213 (goto-char (point-min))
214 (if (search-forward "\n\n" nil t)
215 () ; We let this one pass.
216 (if (re-search-forward "^[ \t]+$" nil t)
217 (replace-match "" t t) ; We nix out a line of blanks.
218 (while (and (looking-at "[^ ]+:")
219 (zerop (forward-line 1))))
220 ;; We just insert a couple of lines. If you read digests
221 ;; that are so badly formatted, you don't deserve any
222 ;; better. Blphphpht!
226 (defun nndoc-request-group (group &optional server dont-check)
229 (if (not (nndoc-possibly-change-buffer group server))
231 (setq nndoc-status-string "No such file or buffer")
233 (nndoc-set-header-dependent-regexps) ; hack for MIME digests
237 (set-buffer nntp-server-buffer)
239 (let ((number (nndoc-number-of-articles)))
242 (nndoc-close-group group)
244 (insert (format "211 %d %d %d %s\n" number 1 number group))
247 (defun nndoc-close-group (group &optional server)
248 (nndoc-possibly-change-buffer group server)
249 (kill-buffer nndoc-current-buffer)
250 (setq nndoc-group-alist (delq (assoc group nndoc-group-alist)
252 (setq nndoc-current-buffer nil)
253 (setq nndoc-current-server nil)
256 (defun nndoc-request-list (&optional server)
259 (defun nndoc-request-newgroups (date &optional server)
262 (defun nndoc-request-list-newsgroups (&optional server)
265 (defalias 'nndoc-request-post 'nnmail-request-post)
268 ;;; Internal functions.
270 (defun nndoc-possibly-change-buffer (group source)
273 ;; The current buffer is this group's buffer.
274 ((and nndoc-current-buffer
275 (eq nndoc-current-buffer
276 (setq buf (cdr (assoc group nndoc-group-alist))))))
277 ;; We change buffers by taking an old from the group alist.
278 ;; `source' is either a string (a file name) or a buffer object.
280 (setq nndoc-current-buffer buf))
281 ;; It's a totally new group.
282 ((or (and (bufferp nndoc-address)
283 (buffer-name nndoc-address))
284 (and (stringp nndoc-address)
285 (file-exists-p nndoc-address)
286 (not (file-directory-p nndoc-address))))
287 (setq nndoc-group-alist
288 (cons (cons group (setq nndoc-current-buffer
290 (concat " *nndoc " group "*"))))
293 (set-buffer nndoc-current-buffer)
294 (buffer-disable-undo (current-buffer))
296 (if (stringp nndoc-address)
297 (insert-file-contents nndoc-address)
299 (set-buffer nndoc-address)
301 (insert-buffer-substring nndoc-address))
304 ;; MIME (RFC 1341) digest hack by Ulrik Dickow <dickow@nbi.dk>.
305 (defun nndoc-set-header-dependent-regexps ()
306 (if (not (eq nndoc-article-type 'digest))
308 (let ((case-fold-search t) ; We match a bit too much, keep it simple.
309 (boundary-id) (b-delimiter))
311 (set-buffer nndoc-current-buffer)
312 (goto-char (point-min))
315 (concat "\n\n\\|^Content-Type: *multipart/digest;[ \t\n]*[ \t]"
316 "boundary=\"\\([^\"\n]*[^\" \t\n]\\)\"")
319 (setq nndoc-digest-type 'rfc1341
320 boundary-id (format "%s"
322 (match-beginning 1) (match-end 1)))
323 b-delimiter (concat "\n--" boundary-id "[\n \t]+")
324 nndoc-article-begin b-delimiter ; Too strict: "[ \t]*$"
325 nndoc-article-end (concat "\n--" boundary-id
327 nndoc-first-article b-delimiter ; ^eof ends article too.
328 nndoc-end-of-file (concat "\n--" boundary-id "--[ \t]*$"))
329 (setq nndoc-digest-type 'traditional))))))
331 (defun nndoc-forward-article (n)
333 (re-search-forward nndoc-article-begin nil t)
334 (or (not nndoc-head-begin)
335 (re-search-forward nndoc-head-begin nil t))
336 (re-search-forward nndoc-head-end nil t))
340 (defun nndoc-number-of-articles ()
342 (set-buffer nndoc-current-buffer)
344 (goto-char (point-min))
346 (if (re-search-forward (or nndoc-first-article
347 nndoc-article-begin) nil t)
350 (while (and (re-search-forward nndoc-article-begin nil t)
351 (or (not nndoc-end-of-file)
352 (not (looking-at nndoc-end-of-file)))
353 (or (not nndoc-head-begin)
354 (re-search-forward nndoc-head-begin nil t))
355 (re-search-forward nndoc-head-end nil t))
356 (setq num (1+ num)))))
359 (defun nndoc-narrow-to-article (article)
361 (set-buffer nndoc-current-buffer)
363 (goto-char (point-min))
364 (while (and (re-search-forward nndoc-article-begin nil t)
365 (not (zerop (setq article (1- article))))))
366 (if (not (zerop article))
370 (or (and (re-search-forward nndoc-article-end nil t)
375 ;; Insert article ARTICLE in the current buffer.
376 (defun nndoc-insert-article (article)
377 (let ((ibuf (current-buffer)))
379 (set-buffer nndoc-current-buffer)
381 (goto-char (point-min))
382 (while (and (re-search-forward nndoc-article-begin nil t)
383 (not (zerop (setq article (1- article))))))
384 (if (not (zerop article))
388 (or (and (re-search-forward nndoc-article-end nil t)
391 (goto-char (point-min))
392 (and nndoc-head-begin
393 (re-search-forward nndoc-head-begin nil t)
394 (narrow-to-region (point) (point-max)))
395 (or (re-search-forward nndoc-head-end nil t)
396 (goto-char (point-max)))
397 (append-to-buffer ibuf (point-min) (point))
398 (and nndoc-body-begin
399 (re-search-forward nndoc-body-begin nil t))
400 (append-to-buffer ibuf (point) (point-max))
405 ;;; nndoc.el ends here