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 (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 (list 'babyl "\^_\^L *\n" "\^_" "^[0-9].*\n" "^$" nil nil
48 "\\*\\*\\* EOOH \\*\\*\\*\n\\(^.+\n\\)*")
50 "^------------------------------*[\n \t]+"
51 "^------------------------------*[\n \t]+"
53 "^------------------------------*[\n \t]+"
55 "Regular expressions for articles of the various types.")
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)
67 (defvar nndoc-current-server nil)
68 (defvar nndoc-server-alist nil)
69 (defvar nndoc-server-variables
71 (list 'nndoc-article-type nndoc-article-type)
72 '(nndoc-article-begin nil)
73 '(nndoc-article-end nil)
74 '(nndoc-head-begin 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)))
83 (defconst nndoc-version "nndoc 0.1"
86 (defvar nndoc-current-buffer nil
87 "Current nndoc news buffer.")
89 (defvar nndoc-address nil)
93 (defvar nndoc-status-string "")
95 (defvar nndoc-group-alist nil)
97 ;;; Interface functions
99 (defun nndoc-retrieve-headers (sequence &optional newsgroup server)
101 (set-buffer nntp-server-buffer)
105 (nndoc-possibly-change-buffer newsgroup server)
106 (if (stringp (car sequence))
108 (set-buffer nndoc-current-buffer)
109 (goto-char (point-min))
110 (re-search-forward (or nndoc-first-article
111 nndoc-article-begin) nil t)
112 (or (not nndoc-head-begin)
113 (re-search-forward nndoc-head-begin nil t))
114 (re-search-forward nndoc-head-end nil t)
116 (setq article (car sequence))
117 (set-buffer nndoc-current-buffer)
118 (if (not (nndoc-forward-article (max 0 (- article prev))))
122 (re-search-backward nndoc-article-begin nil t)
126 (setq lines (count-lines
129 (and (re-search-forward nndoc-article-end nil t)
130 (goto-char (match-beginning 0)))
131 (goto-char (point-max)))))
133 (set-buffer nntp-server-buffer)
134 (insert (format "221 %d Article retrieved.\n" article))
135 (insert-buffer-substring nndoc-current-buffer beg p)
136 (goto-char (point-max))
137 (or (= (char-after (1- (point))) ?\n) (insert "\n"))
138 (insert (format "Lines: %d\n" lines))
142 sequence (cdr sequence)))
144 ;; Fold continuation lines.
145 (set-buffer nntp-server-buffer)
146 (goto-char (point-min))
147 (while (re-search-forward "\\(\r?\n[ \t]+\\)+" nil t)
148 (replace-match " " t t))
151 (defun nndoc-open-server (server &optional defs)
152 (nnheader-init-server-buffer)
153 (if (equal server nndoc-current-server)
155 (if nndoc-current-server
156 (setq nndoc-server-alist
157 (cons (list nndoc-current-server
158 (nnheader-save-variables nndoc-server-variables))
159 nndoc-server-alist)))
160 (let ((state (assoc server nndoc-server-alist)))
163 (nnheader-restore-variables (nth 1 state))
164 (setq nndoc-server-alist (delq state nndoc-server-alist)))
165 (nnheader-set-init-variables nndoc-server-variables defs)))
166 (setq nndoc-current-server server)
167 (let ((defs (cdr (assq nndoc-article-type nndoc-type-to-regexp))))
168 (setq nndoc-article-begin (nth 0 defs))
169 (setq nndoc-article-end (nth 1 defs))
170 (setq nndoc-head-begin (nth 2 defs))
171 (setq nndoc-head-end (nth 3 defs))
172 (setq nndoc-first-article (nth 4 defs))
173 (setq nndoc-end-of-file (nth 5 defs))
174 (setq nndoc-body-begin (nth 6 defs)))
177 (defun nndoc-close-server (&optional server)
180 (defun nndoc-server-opened (&optional server)
181 (and (equal server nndoc-current-server)
183 (buffer-name nntp-server-buffer)))
185 (defun nndoc-status-message (&optional server)
188 (defun nndoc-request-article (article &optional newsgroup server buffer)
189 (nndoc-possibly-change-buffer newsgroup server)
191 (let ((buffer (or buffer nntp-server-buffer)))
194 (if (stringp article)
196 (nndoc-insert-article article)
197 ;; Unquote quoted non-separators in digests.
198 (if (and (eq nndoc-article-type 'digest)
199 (eq nndoc-digest-type 'traditional))
201 (goto-char (point-min))
202 (while (re-search-forward "^- -"nil t)
203 (replace-match "-" t t))))
204 ;; Some assholish digests do not have a blank line after the
206 (goto-char (point-min))
207 (if (search-forward "\n\n" nil t)
208 () ; We let this one pass.
209 (if (re-search-forward "^[ \t]+$" nil t)
210 (replace-match "" t t) ; We nix out a line of blanks.
211 (while (and (looking-at "[^ ]+:")
212 (zerop (forward-line 1))))
213 ;; We just insert a couple of lines. If you read digests
214 ;; that are so badly formatted, you don't deserve any
215 ;; better. Blphphpht!
219 (defun nndoc-request-group (group &optional server dont-check)
222 (if (not (nndoc-possibly-change-buffer group server))
224 (setq nndoc-status-string "No such file or buffer")
226 (nndoc-set-header-dependent-regexps) ; hack for MIME digests
230 (set-buffer nntp-server-buffer)
232 (let ((number (nndoc-number-of-articles)))
235 (nndoc-close-group group)
237 (insert (format "211 %d %d %d %s\n" number 1 number group))
240 (defun nndoc-close-group (group &optional server)
241 (nndoc-possibly-change-buffer group server)
242 (kill-buffer nndoc-current-buffer)
243 (setq nndoc-group-alist (delq (assoc group nndoc-group-alist)
245 (setq nndoc-current-buffer nil)
246 (setq nndoc-current-server nil)
249 (defun nndoc-request-list (&optional server)
252 (defun nndoc-request-newgroups (date &optional server)
255 (defun nndoc-request-list-newsgroups (&optional server)
258 (defalias 'nndoc-request-post 'nnmail-request-post)
259 (defalias 'nndoc-request-post-buffer 'nnmail-request-post-buffer)
262 ;;; Internal functions.
264 (defun nndoc-possibly-change-buffer (group source)
267 ;; The current buffer is this group's buffer.
268 ((and nndoc-current-buffer
269 (eq nndoc-current-buffer
270 (setq buf (cdr (assoc group nndoc-group-alist))))))
271 ;; We change buffers by taking an old from the group alist.
272 ;; `source' is either a string (a file name) or a buffer object.
274 (setq nndoc-current-buffer buf))
275 ;; It's a totally new group.
276 ((or (and (bufferp nndoc-address)
277 (buffer-name nndoc-address))
278 (and (stringp nndoc-address)
279 (file-exists-p nndoc-address)
280 (not (file-directory-p nndoc-address))))
281 (setq nndoc-group-alist
282 (cons (cons group (setq nndoc-current-buffer
284 (concat " *nndoc " group "*"))))
287 (set-buffer nndoc-current-buffer)
288 (buffer-disable-undo (current-buffer))
290 (if (stringp nndoc-address)
291 (insert-file-contents nndoc-address)
293 (set-buffer nndoc-address)
295 (insert-buffer-substring nndoc-address))
298 ;; MIME (RFC 1341) digest hack by Ulrik Dickow <dickow@nbi.dk>.
299 (defun nndoc-set-header-dependent-regexps ()
300 (if (not (eq nndoc-article-type 'digest))
302 (let ((case-fold-search t) ; We match a bit too much, keep it simple.
303 (boundary-id) (b-delimiter))
305 (set-buffer nndoc-current-buffer)
306 (goto-char (point-min))
309 (concat "\n\n\\|^Content-Type: *multipart/digest;[ \t\n]*[ \t]"
310 "boundary=\"\\([^\"\n]*[^\" \t\n]\\)\"")
313 (setq nndoc-digest-type 'rfc1341
314 boundary-id (format "%s"
316 (match-beginning 1) (match-end 1)))
317 b-delimiter (concat "\n--" boundary-id "[\n \t]+")
318 nndoc-article-begin b-delimiter ; Too strict: "[ \t]*$"
319 nndoc-article-end (concat "\n--" boundary-id
321 nndoc-first-article b-delimiter ; ^eof ends article too.
322 nndoc-end-of-file (concat "\n--" boundary-id "--[ \t]*$"))
323 (setq nndoc-digest-type 'traditional))))))
325 (defun nndoc-forward-article (n)
327 (re-search-forward nndoc-article-begin nil t)
328 (or (not nndoc-head-begin)
329 (re-search-forward nndoc-head-begin nil t))
330 (re-search-forward nndoc-head-end nil t))
334 (defun nndoc-number-of-articles ()
336 (set-buffer nndoc-current-buffer)
338 (goto-char (point-min))
340 (if (re-search-forward (or nndoc-first-article
341 nndoc-article-begin) nil t)
344 (while (and (re-search-forward nndoc-article-begin nil t)
345 (or (not nndoc-end-of-file)
346 (not (looking-at nndoc-end-of-file)))
347 (or (not nndoc-head-begin)
348 (re-search-forward nndoc-head-begin nil t))
349 (re-search-forward nndoc-head-end nil t))
350 (setq num (1+ num)))))
353 (defun nndoc-narrow-to-article (article)
355 (set-buffer nndoc-current-buffer)
357 (goto-char (point-min))
358 (while (and (re-search-forward nndoc-article-begin nil t)
359 (not (zerop (setq article (1- article))))))
360 (if (not (zerop article))
364 (or (and (re-search-forward nndoc-article-end nil t)
369 ;; Insert article ARTICLE in the current buffer.
370 (defun nndoc-insert-article (article)
371 (let ((ibuf (current-buffer)))
373 (set-buffer nndoc-current-buffer)
375 (goto-char (point-min))
376 (while (and (re-search-forward nndoc-article-begin nil t)
377 (not (zerop (setq article (1- article))))))
378 (if (not (zerop article))
382 (or (and (re-search-forward nndoc-article-end nil t)
385 (goto-char (point-min))
386 (and nndoc-head-begin
387 (re-search-forward nndoc-head-begin nil t)
388 (narrow-to-region (point) (point-max)))
389 (or (re-search-forward nndoc-head-end nil t)
390 (goto-char (point-max)))
391 (append-to-buffer ibuf (point-min) (point))
392 (and nndoc-body-begin
393 (re-search-forward nndoc-body-begin nil t))
394 (append-to-buffer ibuf (point) (point-max))
399 ;;; nndoc.el ends here