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' or `digest'.")
35 (defconst nndoc-type-to-regexp
37 (concat "^" rmail-unix-mail-delimiter)
38 (concat "^" rmail-unix-mail-delimiter)
40 (list 'babyl "\^_\^L *\n" "\^_" nil "^$" nil nil
41 "\\*\\*\\* EOOH \\*\\*\\*\n\\(^.+\n\\)*")
43 "^------------------------------*[\n \t]+"
44 "^------------------------------[\n \t]+"
46 "^------------------------------*[\n \t]+"
48 "Regular expressions for articles of the various types.")
52 (defvar nndoc-article-begin nil)
53 (defvar nndoc-article-end nil)
54 (defvar nndoc-head-begin nil)
55 (defvar nndoc-head-end nil)
56 (defvar nndoc-first-article nil)
57 (defvar nndoc-end-of-file nil)
58 (defvar nndoc-body-begin nil)
60 (defvar nndoc-current-server nil)
61 (defvar nndoc-server-alist nil)
62 (defvar nndoc-server-variables
64 (list 'nndoc-article-type nndoc-article-type)
65 '(nndoc-article-begin nil)
66 '(nndoc-article-end nil)
67 '(nndoc-head-begin nil)
69 '(nndoc-first-article nil)
70 '(nndoc-current-buffer nil)
71 '(nndoc-group-alist nil)
72 '(nndoc-end-of-file nil)
73 '(nndoc-body-begin nil)
74 '(nndoc-address nil)))
76 (defconst nndoc-version "nndoc 0.1"
79 (defvar nndoc-current-buffer nil
80 "Current nndoc news buffer.")
82 (defvar nndoc-address nil)
86 (defvar nndoc-status-string "")
88 (defvar nndoc-group-alist nil)
90 ;;; Interface functions
92 (defun nndoc-retrieve-headers (sequence &optional newsgroup server)
94 (set-buffer nntp-server-buffer)
98 (nndoc-possibly-change-buffer newsgroup server)
99 (if (stringp (car sequence))
101 (set-buffer nndoc-current-buffer)
102 (goto-char (point-min))
103 (re-search-forward (or nndoc-first-article
104 nndoc-article-begin) nil t)
105 (or (not nndoc-head-begin)
106 (re-search-forward nndoc-head-begin nil t))
107 (re-search-forward nndoc-head-end nil t)
109 (setq article (car sequence))
110 (set-buffer nndoc-current-buffer)
111 (if (not (nndoc-forward-article (max 0 (- article prev))))
115 (re-search-backward nndoc-article-begin nil t)
119 (setq lines (count-lines
122 (and (re-search-forward nndoc-article-end nil t)
123 (goto-char (match-beginning 0)))
124 (goto-char (point-max)))))
126 (set-buffer nntp-server-buffer)
127 (insert (format "221 %d Article retrieved.\n" article))
128 (insert-buffer-substring nndoc-current-buffer beg p)
129 (goto-char (point-max))
130 (insert (format "Lines: %d\n" lines))
134 sequence (cdr sequence)))
136 ;; Fold continuation lines.
137 (set-buffer nntp-server-buffer)
138 (goto-char (point-min))
139 (while (re-search-forward "\\(\r?\n[ \t]+\\)+" nil t)
140 (replace-match " " t t))
143 (defun nndoc-open-server (server &optional defs)
144 (nnheader-init-server-buffer)
145 (if (equal server nndoc-current-server)
147 (if nndoc-current-server
148 (setq nndoc-server-alist
149 (cons (list nndoc-current-server
150 (nnheader-save-variables nndoc-server-variables))
151 nndoc-server-alist)))
152 (let ((state (assoc server nndoc-server-alist)))
155 (nnheader-restore-variables (nth 1 state))
156 (setq nndoc-server-alist (delq state nndoc-server-alist)))
157 (nnheader-set-init-variables nndoc-server-variables defs)))
158 (setq nndoc-current-server server)
159 (let ((defs (cdr (assq nndoc-article-type nndoc-type-to-regexp))))
160 (setq nndoc-article-begin (nth 0 defs))
161 (setq nndoc-article-end (nth 1 defs))
162 (setq nndoc-head-begin (nth 2 defs))
163 (setq nndoc-head-end (nth 3 defs))
164 (setq nndoc-first-article (nth 4 defs))
165 (setq nndoc-end-of-file (nth 5 defs))
166 (setq nndoc-body-begin (nth 6 defs)))
169 (defun nndoc-close-server (&optional server)
172 (defun nndoc-server-opened (&optional server)
173 (and (equal server nndoc-current-server)
175 (buffer-name nntp-server-buffer)))
177 (defun nndoc-status-message (&optional server)
180 (defun nndoc-request-article (article &optional newsgroup server buffer)
181 (nndoc-possibly-change-buffer newsgroup server)
183 (let ((buffer (or buffer nntp-server-buffer)))
186 (if (stringp article)
188 (nndoc-insert-article article)
189 ;; Unquote quoted non-separators in digests.
190 (if (eq nndoc-article-type 'digest)
192 (goto-char (point-min))
193 (while (re-search-forward "^- -"nil t)
194 (replace-match "-" t t))))
197 (defun nndoc-request-group (group &optional server dont-check)
200 (if (not (nndoc-possibly-change-buffer group server))
202 (setq nndoc-status-string "No such file or buffer")
204 (nndoc-set-header-dependent-regexps) ; hack for MIME digests
208 (set-buffer nntp-server-buffer)
210 (let ((number (nndoc-number-of-articles)))
213 (nndoc-close-group group)
215 (insert (format "211 %d %d %d %s\n" number 1 number group))
218 (defun nndoc-close-group (group &optional server)
219 (nndoc-possibly-change-buffer group server)
220 (kill-buffer nndoc-current-buffer)
221 (setq nndoc-group-alist (delq (assoc group nndoc-group-alist)
223 (setq nndoc-current-buffer nil)
226 (defun nndoc-request-list (&optional server)
229 (defun nndoc-request-newgroups (date &optional server)
232 (defun nndoc-request-list-newsgroups (&optional server)
235 (defalias 'nndoc-request-post 'nnmail-request-post)
236 (defalias 'nndoc-request-post-buffer 'nnmail-request-post-buffer)
239 ;;; Internal functions.
241 (defun nndoc-possibly-change-buffer (group source)
244 ;; The current buffer is this group's buffer.
245 ((and nndoc-current-buffer
246 (eq nndoc-current-buffer
247 (setq buf (cdr (assoc group nndoc-group-alist))))))
248 ;; We change buffers by taking an old from the group alist.
249 ;; `source' is either a string (a file name) or a buffer object.
251 (setq nndoc-current-buffer buf))
252 ;; It's a totally new group.
253 ((or (and (bufferp nndoc-address)
254 (buffer-name nndoc-address))
255 (and (stringp nndoc-address)
256 (file-exists-p nndoc-address)
257 (not (file-directory-p nndoc-address))))
258 (setq nndoc-group-alist
259 (cons (cons group (setq nndoc-current-buffer
261 (concat " *nndoc " group "*"))))
264 (set-buffer nndoc-current-buffer)
265 (buffer-disable-undo (current-buffer))
267 (if (stringp nndoc-address)
268 (insert-file-contents nndoc-address)
270 (set-buffer nndoc-address)
272 (insert-buffer-substring nndoc-address))
275 ;; MIME (RFC 1341) digest hack by Ulrik Dickow <dickow@nbi.dk>.
276 (defun nndoc-set-header-dependent-regexps ()
277 (if (not (eq nndoc-article-type 'digest))
279 (let ((case-fold-search t) ; We match a bit too much, keep it simple.
280 (boundary-id) (b-delimiter))
282 (set-buffer nndoc-current-buffer)
283 (goto-char (point-min))
286 (concat "\n\n\\|^Content-Type: multipart/digest;[ \t\n]*[ \t]"
287 "boundary=\"\\([^\"\n]*[^\" \t\n]\\)\"")
290 (setq boundary-id (buffer-substring-no-properties (match-beginning 1)
292 b-delimiter (concat "\n--" boundary-id "[\n \t]+")
293 nndoc-article-begin b-delimiter ; Too strict: "[ \t]*$"
294 nndoc-article-end (concat "\n--" boundary-id
296 nndoc-first-article b-delimiter ; ^end-of-file ends article too.
297 nndoc-end-of-file (concat "\n--" boundary-id "--[ \t]*$")))))))
299 (defun nndoc-forward-article (n)
301 (re-search-forward nndoc-article-begin nil t)
302 (or (not nndoc-head-begin)
303 (re-search-forward nndoc-head-begin nil t))
304 (re-search-forward nndoc-head-end nil t))
308 (defun nndoc-number-of-articles ()
310 (set-buffer nndoc-current-buffer)
312 (goto-char (point-min))
314 (if (re-search-forward (or nndoc-first-article
315 nndoc-article-begin) nil t)
318 (while (and (re-search-forward nndoc-article-begin nil t)
319 (or (not nndoc-end-of-file)
320 (not (looking-at nndoc-end-of-file)))
321 (or (not nndoc-head-begin)
322 (re-search-forward nndoc-head-begin nil t))
323 (re-search-forward nndoc-head-end nil t))
324 (setq num (1+ num)))))
327 (defun nndoc-narrow-to-article (article)
329 (set-buffer nndoc-current-buffer)
331 (goto-char (point-min))
332 (while (and (re-search-forward nndoc-article-begin nil t)
333 (not (zerop (setq article (1- article))))))
334 (if (not (zerop article))
338 (or (and (re-search-forward nndoc-article-end nil t)
343 ;; Insert article ARTICLE in the current buffer.
344 (defun nndoc-insert-article (article)
345 (let ((ibuf (current-buffer)))
347 (set-buffer nndoc-current-buffer)
349 (goto-char (point-min))
350 (while (and (re-search-forward nndoc-article-begin nil t)
351 (not (zerop (setq article (1- article))))))
352 (if (not (zerop article))
356 (or (and (re-search-forward nndoc-article-end nil t)
359 (goto-char (point-min))
360 (and nndoc-head-begin
361 (re-search-forward nndoc-head-begin nil t)
362 (narrow-to-region (point) (point-max)))
363 (or (re-search-forward nndoc-head-end nil t)
364 (goto-char (point-max)))
365 (append-to-buffer ibuf (point-min) (point))
366 (and nndoc-body-begin
367 (re-search-forward nndoc-body-begin nil t))
368 (append-to-buffer ibuf (point) (point-max))
373 ;;; nndoc.el ends here