*** empty log message ***
[gnus] / lisp / nndoc.el
index cfa382a..0092ac0 100644 (file)
@@ -1,6 +1,7 @@
-;; Copyright (C) 1995,96 Free Software Foundation, Inc.
+;;; nndoc.el --- single file access for Gnus
+;; Copyright (C) 1995,96,97,98 Free Software Foundation, Inc.
 
-;; Author: Lars Magne Ingebrigtsen <larsi@ifi.uio.no>
+;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
 ;;     Masanobu UMEDA <umerin@flab.flab.fujitsu.junet>
 ;; Keywords: news
 
 (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', `rfc822-forward', `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 
+(defvoo nndoc-open-document-hook 'nnheader-ms-strip-cr
+  "Hook run after opening a document.
+The default function removes all trailing carriage returns
+from the document.")  
+
+(defvar nndoc-type-alist
+  `((mmdf
      (article-begin .  "^\^A\^A\^A\^A\n")
      (body-end .  "^\^A\^A\^A\^A\n"))
     (news
@@ -51,10 +57,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 
+    (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)
@@ -63,6 +69,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^ \\*")
@@ -77,12 +87,12 @@ One of `mbox', `babyl', `digest', `news', `rnews', `mmdf', `forward',
      (file-end . "")
      (subtype digest guess))
     (standard-digest
-     (first-article . ,(concat "^" (make-string 70 ?-) "\n\n+"))
-     (article-begin . ,(concat "^\n" (make-string 30 ?-) "\n\n+"))
+     (first-article . ,(concat "^" (make-string 70 ?-) "\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 . "^ ?$")
-     (body-begin . "^ ?\n")
+     (head-end . "^ *$")
+     (body-begin . "^ *\n")
      (file-end . "^End of .*digest.*[0-9].*\n\\*\\*\\|^End of.*Digest *$")
      (subtype digest guess))
     (slack-digest
@@ -94,16 +104,19 @@ One of `mbox', `babyl', `digest', `news', `rnews', `mmdf', `forward',
      (prepare-body-function . nndoc-unquote-dashes)
      (subtype digest guess))
     (lanl-gov-announce
-      (article-begin . "^\\\\\\\\\n")
-      (head-begin . "^Paper.*:")
-      (head-end   . "\\(^\\\\\\\\.*\n\\|-----------------\\)")
-      (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 
+     (article-begin . "^\\\\\\\\\n")
+     (head-begin . "^Paper.*:")
+     (head-end   . "\\(^\\\\\\\\.*\n\\|-----------------\\)")
+     (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))
+    (rfc822-forward
+     (article-begin . "^\n")
+     (body-end-function . nndoc-rfc822-forward-body-end-function))
+    (guess
      (guess . t)
      (subtype nil))
     (digest
@@ -111,8 +124,7 @@ One of `mbox', `babyl', `digest', `news', `rnews', `mmdf', `forward',
      (subtype nil))
     (preprints
      (guess . t)
-     (subtype nil))
-    ))
+     (subtype nil))))
 
 \f
 
@@ -185,11 +197,11 @@ One of `mbox', `babyl', `digest', `news', `rnews', `mmdf', `forward',
       (when entry
        (if (stringp article)
            nil
-         (insert-buffer-substring 
+         (insert-buffer-substring
           nndoc-current-buffer (car entry) (nth 1 entry))
          (insert "\n")
          (setq beg (point))
-         (insert-buffer-substring 
+         (insert-buffer-substring
           nndoc-current-buffer (nth 2 entry) (nth 3 entry))
          (goto-char beg)
          (when nndoc-prepare-body-function
@@ -201,7 +213,7 @@ One of `mbox', `babyl', `digest', `news', `rnews', `mmdf', `forward',
 (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))
@@ -245,24 +257,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 +284,8 @@ One of `mbox', `babyl', `digest', `news', `rnews', `mmdf', `forward',
        (erase-buffer)
        (if (stringp nndoc-address)
            (nnheader-insert-file-contents nndoc-address)
-         (insert-buffer-substring nndoc-address)))))
+         (insert-buffer-substring nndoc-address))
+       (run-hooks 'nndoc-open-document-hook))))
     ;; Initialize the nndoc structures according to this new document.
     (when (and nndoc-current-buffer
               (not nndoc-dissection-alist))
@@ -291,8 +304,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
@@ -303,7 +316,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.
@@ -319,7 +332,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))))
@@ -327,9 +340,9 @@ One of `mbox', `babyl', `digest', `news', `rnews', `mmdf', `forward',
       (error "Document is not of any recognized type"))
     (if result
        (car entry)
-      (cadar (sort results (lambda (r1 r2) (< (car r1) (car r2))))))))
+      (cadar (sort results 'car-less-than-car)))))
 
-;;; 
+;;;
 ;;; Built-in type predicates and functions
 ;;;
 
@@ -346,7 +359,7 @@ One of `mbox', `babyl', `digest', `news', `rnews', `mmdf', `forward',
        len end)
     (when
        (save-excursion
-         (and (re-search-backward 
+         (and (re-search-backward
                (concat "^" message-unix-mail-delimiter) nil t)
               (setq end (point))
               (search-forward "\n\n" beg t)
@@ -383,7 +396,7 @@ One of `mbox', `babyl', `digest', `news', `rnews', `mmdf', `forward',
 
 (defun nndoc-babyl-body-begin ()
   (re-search-forward "^\n" nil t)
-  (when (looking-at "\*\*\* EOOH \*\*\*")
+  (when (looking-at "\\*\\*\\* EOOH \\*\\*\\*")
     (let ((next (or (save-excursion
                      (re-search-forward nndoc-article-begin nil t))
                    (point-max))))
@@ -395,7 +408,7 @@ One of `mbox', `babyl', `digest', `news', `rnews', `mmdf', `forward',
 
 (defun nndoc-babyl-head-begin ()
   (when (re-search-forward "^[0-9].*\n" nil t)
-    (when (looking-at "\*\*\* EOOH \*\*\*")
+    (when (looking-at "\\*\\*\\* EOOH \\*\\*\\*")
       (forward-line 1))
     t))
 
@@ -406,6 +419,22 @@ One of `mbox', `babyl', `digest', `news', `rnews', `mmdf', `forward',
             (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-rfc822-forward-type-p ()
+  (save-restriction
+    (message-narrow-to-head)
+    (when (re-search-forward "^Content-Type: *message/rfc822" nil t)
+      t)))
+
+(defun nndoc-rfc822-forward-body-end-function ()
+  (goto-char (point-max)))
+
 (defun nndoc-clari-briefs-type-p ()
   (when (let ((case-fold-search nil))
          (re-search-forward "^\t[^a-z]+ ([^a-z]+) --" nil t))
@@ -460,7 +489,7 @@ One of `mbox', `babyl', `digest', `news', `rnews', `mmdf', `forward',
 
 (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))
 
@@ -483,7 +512,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")
@@ -506,7 +535,10 @@ 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")))
+
+(deffoo nndoc-request-accept-article (group &optional server last)
+  nil)
+
 
 
 ;;;
@@ -537,7 +569,7 @@ One of `mbox', `babyl', `digest', `news', `rnews', `mmdf', `forward',
        (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
@@ -584,9 +616,7 @@ as the last checked definition, if t or `first', add as the
 first definition, and if any other symbol, add after that
 symbol in the alist."
   ;; First remove any old instances.
-  (setq nndoc-type-alist
-       (delq (assq (car definition) nndoc-type-alist)
-             nndoc-type-alist))
+  (gnus-pull (car definition) nndoc-type-alist)
   ;; Then enter the new definition in the proper place.
   (cond
    ((or (null position) (eq position 'last))