*** empty log message ***
[gnus] / lisp / nndoc.el
index 30efcea..9c14e72 100644 (file)
@@ -1,4 +1,5 @@
-;; Copyright (C) 1995,96 Free Software Foundation, Inc.
+;;; nndoc.el --- single file access for Gnus
+;; Copyright (C) 1995,96,97 Free Software Foundation, Inc.
 
 ;; Author: Lars Magne Ingebrigtsen <larsi@ifi.uio.no>
 ;;     Masanobu UMEDA <umerin@flab.flab.fujitsu.junet>
 (defvoo nndoc-article-type 'guess
   "*Type of the file.
 One of `mbox', `babyl', `digest', `news', `rnews', `mmdf', `forward',
-`mime-digest', `standard-digest', `slack-digest', `clari-briefs' or
-`guess'.")
+`rfc934', `mime-digest', `standard-digest', `slack-digest',
+`clari-briefs' or `guess'.")
 
 (defvoo nndoc-post-type 'mail
   "*Whether the nndoc group is `mail' or `post'.")
 
-(defvar nndoc-type-alist 
-  `((mmdf 
+(defvar nndoc-type-alist
+  `((mmdf
      (article-begin .  "^\^A\^A\^A\^A\n")
      (body-end .  "^\^A\^A\^A\^A\n"))
     (news
@@ -51,14 +52,10 @@ One of `mbox', `babyl', `digest', `news', `rnews', `mmdf', `forward',
     (rnews
      (article-begin . "^#! *rnews +\\([0-9]+\\) *\n")
      (body-end-function . nndoc-rnews-body-end))
-    (mbox 
-     (article-begin . 
-                   ,(let ((delim (concat "^" message-unix-mail-delimiter)))
-                      (if (string-match "\n\\'" delim)
-                          (substring delim 0 (match-beginning 0))
-                        delim)))
+    (mbox
+     (article-begin-function . nndoc-mbox-article-begin)
      (body-end-function . nndoc-mbox-body-end))
-    (babyl 
+    (babyl
      (article-begin . "\^_\^L *\n")
      (body-end . "\^_")
      (body-begin-function . nndoc-babyl-body-begin)
@@ -67,6 +64,10 @@ One of `mbox', `babyl', `digest', `news', `rnews', `mmdf', `forward',
      (article-begin . "^-+ Start of forwarded message -+\n+")
      (body-end . "^-+ End of forwarded message -+$")
      (prepare-body-function . nndoc-unquote-dashes))
+    (rfc934
+     (article-begin . "^--.*\n+")
+     (body-end . "^--.*$")
+     (prepare-body-function . nndoc-unquote-dashes))
     (clari-briefs
      (article-begin . "^ \\*")
      (body-end . "^\t------*[ \t]^*\n^ \\*")
@@ -82,7 +83,7 @@ One of `mbox', `babyl', `digest', `news', `rnews', `mmdf', `forward',
      (subtype digest guess))
     (standard-digest
      (first-article . ,(concat "^" (make-string 70 ?-) "\n\n+"))
-     (article-begin . ,(concat "\n\n" (make-string 30 ?-) "\n\n+"))
+     (article-begin . ,(concat "^\n" (make-string 30 ?-) "\n\n+"))
      (prepare-body-function . nndoc-unquote-dashes)
      (body-end-function . nndoc-digest-body-end)
      (head-end . "^ ?$")
@@ -96,18 +97,18 @@ One of `mbox', `babyl', `digest', `news', `rnews', `mmdf', `forward',
      (body-begin . "^ ?$")
      (file-end . "^End of")
      (prepare-body-function . nndoc-unquote-dashes)
-     (subtype digest))  ;; impossible to really guess?
+     (subtype digest guess))
     (lanl-gov-announce
       (article-begin . "^\\\\\\\\\n")
       (head-begin . "^Paper.*:")
       (head-end   . "\\(^\\\\\\\\.*\n\\|-----------------\\)")
-      (body-begin . "")  
-      (body-end   . "-------------------------------------------------")     
+      (body-begin . "")
+      (body-end   . "-------------------------------------------------")
       (file-end   . "^Title: Recent Seminal")
       (generate-head-function . nndoc-generate-lanl-gov-head)
       (article-transform-function . nndoc-transform-lanl-gov-announce)
       (subtype preprints guess))
-    (guess 
+    (guess
      (guess . t)
      (subtype nil))
     (digest
@@ -136,6 +137,7 @@ One of `mbox', `babyl', `digest', `news', `rnews', `mmdf', `forward',
 (defvoo nndoc-prepare-body-function nil)
 (defvoo nndoc-generate-head-function nil)
 (defvoo nndoc-article-transform-function nil)
+(defvoo nndoc-article-begin-function nil)
 
 (defvoo nndoc-status-string "")
 (defvoo nndoc-group-alist nil)
@@ -169,7 +171,8 @@ One of `mbox', `babyl', `digest', `news', `rnews', `mmdf', `forward',
                (insert-buffer-substring
                 nndoc-current-buffer (car entry) (nth 1 entry)))
              (goto-char (point-max))
-             (or (= (char-after (1- (point))) ?\n) (insert "\n"))
+             (unless (= (char-after (1- (point))) ?\n)
+               (insert "\n"))
              (insert (format "Lines: %d\n" (nth 4 entry)))
              (insert ".\n")))
 
@@ -184,25 +187,26 @@ One of `mbox', `babyl', `digest', `news', `rnews', `mmdf', `forward',
          beg)
       (set-buffer buffer)
       (erase-buffer)
-      (if (stringp article)
-         nil
-       (insert-buffer-substring 
-        nndoc-current-buffer (car entry) (nth 1 entry))
-       (insert "\n")
-       (setq beg (point))
-       (insert-buffer-substring 
-        nndoc-current-buffer (nth 2 entry) (nth 3 entry))
-       (goto-char beg)
-       (when nndoc-prepare-body-function
-         (funcall nndoc-prepare-body-function))
-       (when nndoc-article-transform-function
-         (funcall nndoc-article-transform-function article))
-       t))))
+      (when entry
+       (if (stringp article)
+           nil
+         (insert-buffer-substring
+          nndoc-current-buffer (car entry) (nth 1 entry))
+         (insert "\n")
+         (setq beg (point))
+         (insert-buffer-substring
+          nndoc-current-buffer (nth 2 entry) (nth 3 entry))
+         (goto-char beg)
+         (when nndoc-prepare-body-function
+           (funcall nndoc-prepare-body-function))
+         (when nndoc-article-transform-function
+           (funcall nndoc-article-transform-function article))
+         t)))))
 
 (deffoo nndoc-request-group (group &optional server dont-check)
   "Select news GROUP."
   (let (number)
-    (cond 
+    (cond
      ((not (nndoc-possibly-change-buffer group server))
       (nnheader-report 'nndoc "No such file or buffer: %s"
                       nndoc-address))
@@ -246,24 +250,24 @@ One of `mbox', `babyl', `digest', `news', `rnews', `mmdf', `forward',
 
 (defun nndoc-possibly-change-buffer (group source)
   (let (buf)
-    (cond 
+    (cond
      ;; The current buffer is this group's buffer.
      ((and nndoc-current-buffer
           (buffer-name nndoc-current-buffer)
-          (eq nndoc-current-buffer 
+          (eq nndoc-current-buffer
               (setq buf (cdr (assoc group nndoc-group-alist))))))
      ;; We change buffers by taking an old from the group alist.
-     ;; `source' is either a string (a file name) or a buffer object. 
+     ;; `source' is either a string (a file name) or a buffer object.
      (buf
       (setq nndoc-current-buffer buf))
-     ;; It's a totally new group.    
+     ;; It's a totally new group.
      ((or (and (bufferp nndoc-address)
               (buffer-name nndoc-address))
          (and (stringp nndoc-address)
               (file-exists-p nndoc-address)
               (not (file-directory-p nndoc-address))))
-      (push (cons group (setq nndoc-current-buffer 
-                             (get-buffer-create 
+      (push (cons group (setq nndoc-current-buffer
+                             (get-buffer-create
                               (concat " *nndoc " group "*"))))
            nndoc-group-alist)
       (setq nndoc-dissection-alist nil)
@@ -272,7 +276,7 @@ One of `mbox', `babyl', `digest', `news', `rnews', `mmdf', `forward',
        (buffer-disable-undo (current-buffer))
        (erase-buffer)
        (if (stringp nndoc-address)
-           (insert-file-contents nndoc-address)
+           (nnheader-insert-file-contents nndoc-address)
          (insert-buffer-substring nndoc-address)))))
     ;; Initialize the nndoc structures according to this new document.
     (when (and nndoc-current-buffer
@@ -292,8 +296,8 @@ One of `mbox', `babyl', `digest', `news', `rnews', `mmdf', `forward',
 
 (defun nndoc-set-delims ()
   "Set the nndoc delimiter variables according to the type of the document."
-  (let ((vars '(nndoc-file-begin 
-               nndoc-first-article 
+  (let ((vars '(nndoc-file-begin
+               nndoc-first-article
                nndoc-article-end nndoc-head-begin nndoc-head-end
                nndoc-file-end nndoc-article-begin
                nndoc-body-begin nndoc-body-end-function nndoc-body-end
@@ -304,7 +308,7 @@ One of `mbox', `babyl', `digest', `news', `rnews', `mmdf', `forward',
       (set (pop vars) nil)))
   (let (defs)
     ;; Guess away until we find the real file type.
-    (while (assq 'guess (setq defs (cdr (assq nndoc-article-type 
+    (while (assq 'guess (setq defs (cdr (assq nndoc-article-type
                                              nndoc-type-alist))))
       (setq nndoc-article-type (nndoc-guess-type nndoc-article-type)))
     ;; Set the nndoc variables.
@@ -320,7 +324,7 @@ One of `mbox', `babyl', `digest', `news', `rnews', `mmdf', `forward',
       (when (memq subtype (or (cdr (assq 'subtype entry)) '(guess)))
        (goto-char (point-min))
        (when (numberp (setq result (funcall (intern
-                                             (format "nndoc-%s-type-p" 
+                                             (format "nndoc-%s-type-p"
                                                      (car entry))))))
          (push (cons result entry) results)
          (setq result nil))))
@@ -330,7 +334,7 @@ One of `mbox', `babyl', `digest', `news', `rnews', `mmdf', `forward',
        (car entry)
       (cadar (sort results (lambda (r1 r2) (< (car r1) (car r2))))))))
 
-;;; 
+;;;
 ;;; Built-in type predicates and functions
 ;;;
 
@@ -338,22 +342,27 @@ One of `mbox', `babyl', `digest', `news', `rnews', `mmdf', `forward',
   (when (looking-at message-unix-mail-delimiter)
     t))
 
+(defun nndoc-mbox-article-begin ()
+  (when (re-search-forward (concat "^" message-unix-mail-delimiter) nil t)
+    (goto-char (match-beginning 0))))
+
 (defun nndoc-mbox-body-end ()
   (let ((beg (point))
        len end)
     (when
        (save-excursion
-         (and (re-search-backward nndoc-article-begin nil t)
+         (and (re-search-backward
+               (concat "^" message-unix-mail-delimiter) nil t)
               (setq end (point))
               (search-forward "\n\n" beg t)
               (re-search-backward
                "^Content-Length:[ \t]*\\([0-9]+\\) *$" end t)
               (setq len (string-to-int (match-string 1)))
               (search-forward "\n\n" beg t)
-              (or (= (setq len (+ (point) len)) (point-max))
-                  (and (< len (point-max))
-                       (goto-char len)
-                       (looking-at nndoc-article-begin)))))
+              (unless (= (setq len (+ (point) len)) (point-max))
+                (and (< len (point-max))
+                     (goto-char len)
+                     (looking-at message-unix-mail-delimiter)))))
       (goto-char len))))
 
 (defun nndoc-mmdf-type-p ()
@@ -380,7 +389,14 @@ One of `mbox', `babyl', `digest', `news', `rnews', `mmdf', `forward',
 (defun nndoc-babyl-body-begin ()
   (re-search-forward "^\n" nil t)
   (when (looking-at "\*\*\* EOOH \*\*\*")
-    (re-search-forward "^\n" nil t)))
+    (let ((next (or (save-excursion
+                     (re-search-forward nndoc-article-begin nil t))
+                   (point-max))))
+      (unless (re-search-forward "^\n" next t)
+       (goto-char next)
+       (forward-line -1)
+       (insert "\n")
+       (forward-line -1)))))
 
 (defun nndoc-babyl-head-begin ()
   (when (re-search-forward "^[0-9].*\n" nil t)
@@ -390,7 +406,16 @@ One of `mbox', `babyl', `digest', `news', `rnews', `mmdf', `forward',
 
 (defun nndoc-forward-type-p ()
   (when (and (re-search-forward "^-+ Start of forwarded message -+\n+" nil t)
-            (not (re-search-forward "^Subject:.*digest" nil t)))
+            (not (re-search-forward "^Subject:.*digest" nil t))
+            (not (re-search-backward "^From:" nil t 2))
+            (not (re-search-forward "^From:" nil t 2)))
+    t))
+
+(defun nndoc-rfc934-type-p ()
+  (when (and (re-search-forward "^-+ Start of forwarded.*\n+" nil t)
+            (not (re-search-forward "^Subject:.*digest" nil t))
+            (not (re-search-backward "^From:" nil t 2))
+            (not (re-search-forward "^From:" nil t 2)))
     t))
 
 (defun nndoc-clari-briefs-type-p ()
@@ -427,27 +452,27 @@ One of `mbox', `babyl', `digest', `news', `rnews', `mmdf', `forward',
 (defun nndoc-mime-digest-type-p ()
   (let ((case-fold-search t)
        boundary-id b-delimiter entry)
-     (when (and
-           (re-search-forward
-            (concat "^Content-Type: *multipart/digest;[ \t\n]*[ \t]"
-                    "boundary=\"\\([^\"\n]*[^\" \t\n]\\)\"")
-            nil t)
-           (match-beginning 1))
-       (setq boundary-id (match-string 1)
-            b-delimiter (concat "\n--" boundary-id "[\n \t]+"))
-       (setq entry (assq 'mime-digest nndoc-type-alist))
-       (setcdr entry
-              (list
-               (cons 'head-end "^ ?$")
-               (cons 'body-begin "^ ?\n")
-               (cons 'article-begin b-delimiter)
-               (cons 'body-end-function 'nndoc-digest-body-end)
-               (cons 'file-end (concat "\n--" boundary-id "--[ \t]*$"))))
-       t)))
+    (when (and
+          (re-search-forward
+           (concat "^Content-Type: *multipart/digest;[ \t\n]*[ \t]"
+                   "boundary=\"\\([^\"\n]*[^\" \t\n]\\)\"")
+           nil t)
+          (match-beginning 1))
+      (setq boundary-id (match-string 1)
+           b-delimiter (concat "\n--" boundary-id "[\n \t]+"))
+      (setq entry (assq 'mime-digest nndoc-type-alist))
+      (setcdr entry
+             (list
+              (cons 'head-end "^ ?$")
+              (cons 'body-begin "^ ?\n")
+              (cons 'article-begin b-delimiter)
+              (cons 'body-end-function 'nndoc-digest-body-end)
+              (cons 'file-end (concat "\n--" boundary-id "--[ \t]*$"))))
+      t)))
 
 (defun nndoc-standard-digest-type-p ()
   (when (and (re-search-forward (concat "^" (make-string 70 ?-) "\n\n") nil t)
-            (re-search-forward 
+            (re-search-forward
              (concat "\n\n" (make-string 30 ?-) "\n\n") nil t))
     t))
 
@@ -470,7 +495,7 @@ One of `mbox', `babyl', `digest', `news', `rnews', `mmdf', `forward',
   ;;  (when (re-search-backward "^\\\\\\\\$" nil t)
   ;;    (replace-match "" t t))
   )
+
 (defun nndoc-generate-lanl-gov-head (article)
   (let ((entry (cdr (assq article nndoc-dissection-alist)))
        (e-mail "no address given")
@@ -493,7 +518,7 @@ One of `mbox', `babyl', `digest', `news', `rnews', `mmdf', `forward',
       (setq from (replace-match "" t t from)))
     (insert "From: "  (or from "unknown")
            "\nSubject: " (or subject "(no subject)") "\n")))
+
 
 
 ;;;
@@ -520,14 +545,15 @@ One of `mbox', `babyl', `digest', `news', `rnews', `mmdf', `forward',
       ;; Go through the file.
       (while (if (and first nndoc-first-article)
                 (nndoc-search nndoc-first-article)
-              (nndoc-search nndoc-article-begin))
+              (nndoc-article-begin))
        (setq first nil)
        (cond (nndoc-head-begin-function
               (funcall nndoc-head-begin-function))
-             (nndoc-head-begin 
+             (nndoc-head-begin
               (nndoc-search nndoc-head-begin)))
-       (if (or (>= (point) (point-max)) (and nndoc-file-end
-                (looking-at nndoc-file-end)))
+       (if (or (>= (point) (point-max))
+               (and nndoc-file-end
+                    (looking-at nndoc-file-end)))
            (goto-char (point-max))
          (setq head-begin (point))
          (nndoc-search (or nndoc-head-end "^$"))
@@ -540,7 +566,7 @@ One of `mbox', `babyl', `digest', `news', `rnews', `mmdf', `forward',
                   (funcall nndoc-body-end-function))
              (and nndoc-body-end
                   (nndoc-search nndoc-body-end))
-             (nndoc-search nndoc-article-begin)
+             (nndoc-article-begin)
              (progn
                (goto-char (point-max))
                (when nndoc-file-end
@@ -551,6 +577,12 @@ One of `mbox', `babyl', `digest', `news', `rnews', `mmdf', `forward',
                      (count-lines body-begin body-end))
                nndoc-dissection-alist))))))
 
+(defun nndoc-article-begin ()
+  (if nndoc-article-begin-function
+      (funcall nndoc-article-begin-function)
+    (ignore-errors
+      (nndoc-search nndoc-article-begin))))
+
 (defun nndoc-unquote-dashes ()
   "Unquote quoted non-separators in digests."
   (while (re-search-forward "^- -"nil t)