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
34 One of `mbox', `babyl', `digest', `news', `rnews', `mmdf',
35 `forward', `mime-digest', `standard-digest', `slack-digest', or
38 (defvar nndoc-type-alist
40 (article-begin . "^\^A\^A\^A\^A\n")
41 (body-end . "^\^A\^A\^A\^A\n"))
43 (article-begin . "^Path:"))
45 (article-begin . "^#! *rnews +\\([0-9]\\)+ *\n")
46 (body-end-function . nndoc-rnews-body-end))
49 ,(let ((delim (concat "^" rmail-unix-mail-delimiter)))
50 (if (string-match "\n\\'" delim)
51 (substring delim 0 (match-beginning 0))
53 (body-end-function . nndoc-mbox-body-end))
55 (article-begin . "\^_\^L *\n")
57 (head-begin . "^[0-9].*\n"))
59 (article-begin . "^-+ Start of forwarded message -+\n+")
60 (body-end . "^-+ End of forwarded message -+\n"))
62 (article-begin . "^------------------------------*[\n \t]+")
65 (file-end . "^End of")
66 (prepare-body . nndoc-prepare-digest-body))
72 (first-article . ,(concat "^" (make-string 70 ?-) "\n\n"))
73 (article-begin . ,(concat "\n\n" (make-string 30 ?-) "\n\n"))
74 (prepare-body . nndoc-prepare-digest-body)
75 (body-end-function . nndoc-digest-body-end)
76 (file-end . "^End of .* Digest"))
78 (guess . nndoc-guess-type))
80 (guess . nndoc-guess-digest-type))
85 (defvar nndoc-file-begin nil)
86 (defvar nndoc-first-article nil)
87 (defvar nndoc-article-end nil)
88 (defvar nndoc-article-begin nil)
89 (defvar nndoc-head-begin nil)
90 (defvar nndoc-head-end nil)
91 (defvar nndoc-file-end nil)
92 (defvar nndoc-body-begin nil)
93 (defvar nndoc-body-end-function nil)
94 (defvar nndoc-body-end nil)
95 (defvar nndoc-dissection-alist nil)
96 (defvar nndoc-prepare-body nil)
98 (defvar nndoc-current-server nil)
99 (defvar nndoc-server-alist nil)
100 (defvar nndoc-server-variables
102 (list 'nndoc-article-type nndoc-article-type)
103 '(nndoc-article-begin nil)
104 '(nndoc-article-end nil)
105 '(nndoc-head-begin nil)
106 '(nndoc-head-end nil)
107 '(nndoc-first-article nil)
108 '(nndoc-current-buffer nil)
109 '(nndoc-group-alist nil)
110 '(nndoc-end-of-file nil)
111 '(nndoc-body-begin nil)
112 '(nndoc-address nil)))
114 (defconst nndoc-version "nndoc 1.0"
117 (defvar nndoc-current-buffer nil
118 "Current nndoc news buffer.")
120 (defvar nndoc-address nil)
124 (defvar nndoc-status-string "")
126 (defvar nndoc-group-alist nil)
128 ;;; Interface functions
130 (defun nndoc-retrieve-headers (articles &optional newsgroup server fetch-old)
131 (when (nndoc-possibly-change-buffer newsgroup server)
133 (set-buffer nntp-server-buffer)
136 (if (stringp (car articles))
139 (setq entry (cdr (assq (setq article (pop articles))
140 nndoc-dissection-alist)))
141 (insert (format "221 %d Article retrieved.\n" article))
142 (insert-buffer-substring
143 nndoc-current-buffer (car entry) (nth 1 entry))
144 (goto-char (point-max))
145 (or (= (char-after (1- (point))) ?\n) (insert "\n"))
146 (insert (format "Lines: %d\n" (nth 4 entry)))
149 ;; Fold continuation lines.
150 (goto-char (point-min))
151 (while (re-search-forward "\\(\r?\n[ \t]+\\)+" nil t)
152 (replace-match " " t t))
155 (defun nndoc-open-server (server &optional defs)
156 (nnheader-init-server-buffer)
157 (if (equal server nndoc-current-server)
159 (if nndoc-current-server
160 (setq nndoc-server-alist
161 (cons (list nndoc-current-server
162 (nnheader-save-variables nndoc-server-variables))
163 nndoc-server-alist)))
164 (let ((state (assoc server nndoc-server-alist)))
167 (nnheader-restore-variables (nth 1 state))
168 (setq nndoc-server-alist (delq state nndoc-server-alist)))
169 (nnheader-set-init-variables nndoc-server-variables defs)))
170 (setq nndoc-current-server server)
173 (defun nndoc-close-server (&optional server)
176 (defun nndoc-server-opened (&optional server)
177 (and (equal server nndoc-current-server)
179 (buffer-name nntp-server-buffer)))
181 (defun nndoc-status-message (&optional server)
184 (defun nndoc-request-article (article &optional newsgroup server buffer)
185 (nndoc-possibly-change-buffer newsgroup server)
187 (let ((buffer (or buffer nntp-server-buffer))
188 (entry (cdr (assq article nndoc-dissection-alist)))
192 (if (stringp article)
194 (insert-buffer-substring
195 nndoc-current-buffer (car entry) (nth 1 entry))
198 (insert-buffer-substring
199 nndoc-current-buffer (nth 2 entry) (nth 3 entry))
201 (when nndoc-prepare-body
202 (funcall nndoc-prepare-body))
205 (defun nndoc-request-group (group &optional server dont-check)
208 (if (not (nndoc-possibly-change-buffer group server))
210 (setq nndoc-status-string "No such file or buffer")
215 (set-buffer nntp-server-buffer)
217 (let ((number (length nndoc-dissection-alist)))
220 (nndoc-close-group group)
222 (insert (format "211 %d %d %d %s\n" number 1 number group))
225 (defun nndoc-close-group (group &optional server)
226 (nndoc-possibly-change-buffer group server)
227 (and nndoc-current-buffer
228 (buffer-name nndoc-current-buffer)
229 (kill-buffer nndoc-current-buffer))
230 (setq nndoc-group-alist (delq (assoc group nndoc-group-alist)
232 (setq nndoc-current-buffer nil)
233 (setq nndoc-current-server nil)
234 (setq nndoc-dissection-alist nil)
237 (defun nndoc-request-list (&optional server)
240 (defun nndoc-request-newgroups (date &optional server)
243 (defun nndoc-request-list-newsgroups (&optional server)
246 (defalias 'nndoc-request-post 'nnmail-request-post)
249 ;;; Internal functions.
251 (defun nndoc-possibly-change-buffer (group source)
254 ;; The current buffer is this group's buffer.
255 ((and nndoc-current-buffer
256 (eq nndoc-current-buffer
257 (setq buf (cdr (assoc group nndoc-group-alist))))))
258 ;; We change buffers by taking an old from the group alist.
259 ;; `source' is either a string (a file name) or a buffer object.
261 (setq nndoc-current-buffer buf))
262 ;; It's a totally new group.
263 ((or (and (bufferp nndoc-address)
264 (buffer-name nndoc-address))
265 (and (stringp nndoc-address)
266 (file-exists-p nndoc-address)
267 (not (file-directory-p nndoc-address))))
268 (setq nndoc-group-alist
269 (cons (cons group (setq nndoc-current-buffer
271 (concat " *nndoc " group "*"))))
274 (set-buffer nndoc-current-buffer)
275 (buffer-disable-undo (current-buffer))
277 (if (stringp nndoc-address)
278 (insert-file-contents nndoc-address)
279 (insert-buffer-substring nndoc-address)))))
280 (when nndoc-current-buffer
282 (set-buffer nndoc-current-buffer)
284 (nndoc-dissect-buffer))
287 ;; MIME (RFC 1341) digest hack by Ulrik Dickow <dickow@nbi.dk>.
288 (defun nndoc-guess-digest-type ()
289 (let ((case-fold-search t) ; We match a bit too much, keep it simple.
290 boundary-id b-delimiter entry)
291 (goto-char (point-min))
296 (concat "\n\n\\|^Content-Type: *multipart/digest;[ \t\n]*[ \t]"
297 "boundary=\"\\([^\"\n]*[^\" \t\n]\\)\"")
300 (setq boundary-id (match-string 1)
301 b-delimiter (concat "\n--" boundary-id "[\n \t]+"))
302 (setq entry (assq 'mime-digest nndoc-type-alist))
305 (cons 'article-begin b-delimiter)
307 (concat "\n--" boundary-id "\\(--\\)?[\n \t]+"))
308 (cons 'file-end (concat "\n--" boundary-id "--[ \t]*$"))))
310 ((and (re-search-forward (concat "^" (make-string 70 ?-) "\n\n") nil t)
312 (concat "\n\n" (make-string 30 ?-) "\n\n") nil t))
318 (defun nndoc-guess-type ()
319 "Guess what document type is in the current buffer."
320 (goto-char (point-min))
322 ((looking-at rmail-unix-mail-delimiter)
324 ((looking-at "\^A\^A\^A\^A$")
326 ((looking-at "^Path:.*\n")
329 (and (re-search-forward "^-+ Start of forwarded message -+\n+" nil t)
330 (not (re-search-forward "^Subject:.*digest" nil t))))
332 ((re-search-forward "\^_\^L *\n" nil t)
334 ((re-search-forward "^Path: .*!" nil t)
339 (defun nndoc-set-delims ()
340 (let ((vars '(nndoc-file-begin
342 nndoc-article-end nndoc-head-begin nndoc-head-end
343 nndoc-file-end nndoc-article-begin
344 nndoc-body-begin nndoc-body-end-function nndoc-body-end
345 nndoc-prepare-body)))
347 (set (pop vars) nil)))
349 ;; Guess away until we find the real file type.
350 (while (setq defs (cdr (assq nndoc-article-type nndoc-type-alist))
351 guess (assq 'guess defs))
352 (setq nndoc-article-type (funcall (cdr guess))))
354 (set (intern (format "nndoc-%s" (car (car defs))))
357 (defun nndoc-search (regexp)
359 (re-search-forward regexp nil t)
360 (beginning-of-line)))
362 (defun nndoc-dissect-buffer ()
365 head-begin head-end body-begin body-end)
366 (setq nndoc-dissection-alist nil)
368 (set-buffer nndoc-current-buffer)
369 (goto-char (point-min))
370 ;; Find the beginning of the file.
371 (when nndoc-file-begin
372 (nndoc-search nndoc-file-begin))
373 ;; Go through the file.
374 (while (if (and first nndoc-first-article)
375 (nndoc-search nndoc-first-article)
376 (nndoc-search nndoc-article-begin))
378 (when nndoc-head-begin
379 (nndoc-search nndoc-head-begin))
380 (setq head-begin (point))
381 (nndoc-search (or nndoc-head-end "^$"))
382 (setq head-end (point))
383 (nndoc-search (or nndoc-body-begin "^\n"))
384 (setq body-begin (point))
385 (or (and nndoc-body-end-function
386 (funcall nndoc-body-end-function))
388 (nndoc-search nndoc-body-end))
389 (nndoc-search nndoc-article-begin)
391 (goto-char (point-max))
393 (and (re-search-backward nndoc-file-end nil t)
394 (beginning-of-line)))))
395 (setq body-end (point))
396 (push (list (incf i) head-begin head-end body-begin body-end
397 (count-lines body-begin body-end))
398 nndoc-dissection-alist)
401 (defun nndoc-prepare-digest-body ()
402 "Unquote quoted non-separators in digests."
403 (while (re-search-forward "^- -"nil t)
404 (replace-match "-" t t)))
406 (defun nndoc-digest-body-end ()
407 (and (re-search-forward nndoc-article-begin nil t)
408 (goto-char (match-beginning 0))))
410 (defun nndoc-mbox-body-end ()
415 (and (re-search-backward nndoc-article-begin nil t)
417 (search-forward "\n\n" beg t)
418 (re-search-backward "^Content-Length: \\([0-9]+\\) *$" end t)
419 (setq len (string-to-int (match-string 1)))
420 (search-forward "\n\n" beg t)
421 (or (= (setq len (+ (point) len)) (point-max))
422 (and (< len (point-max))
424 (looking-at nndoc-article-begin)))))
427 (defun nndoc-rnews-body-end ()
429 (and (re-search-backward nndoc-article-begin nil t)
430 (goto-char (+ (point) (string-to-int (match-string 1)))))))
434 ;;; nndoc.el ends here