Importing Pterodactyl Gnus v0.96.
[elisp/gnus.git-] / lisp / nndoc.el
index 05669f6..66e24cb 100644 (file)
@@ -31,6 +31,7 @@
 (require 'nnmail)
 (require 'nnoo)
 (require 'gnus-util)
+(require 'mm-util)
 (eval-when-compile (require 'cl))
 
 (nnoo-declare nndoc)
@@ -38,8 +39,8 @@
 (defvoo nndoc-article-type 'guess
   "*Type of the file.
 One of `mbox', `babyl', `digest', `news', `rnews', `mmdf', `forward',
-`rfc934', `rfc822-forward', `mime-digest', `mime-parts', `standard-digest',
-`slack-digest', `clari-briefs' or `guess'.")
+`rfc934', `rfc822-forward', `mime-parts', `standard-digest',
+`slack-digest', `clari-briefs', `nsmail' or `guess'.")
 
 (defvoo nndoc-post-type 'mail
   "*Whether the nndoc group is `mail' or `post'.")
@@ -47,12 +48,14 @@ One of `mbox', `babyl', `digest', `news', `rnews', `mmdf', `forward',
 (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.")  
+from the document.")
 
 (defvar nndoc-type-alist
   `((mmdf
      (article-begin .  "^\^A\^A\^A\^A\n")
      (body-end .  "^\^A\^A\^A\^A\n"))
+    (nsmail
+     (article-begin .  "^From - "))
     (news
      (article-begin . "^Path:"))
     (rnews
@@ -81,12 +84,6 @@ from the document.")
      (head-end . "^\t")
      (generate-head-function . nndoc-generate-clari-briefs-head)
      (article-transform-function . nndoc-transform-clari-briefs))
-    (mime-digest
-     (article-begin . "")
-     (head-end . "^ ?$")
-     (body-end . "")
-     (file-end . "")
-     (subtype digest guess))
     (mime-parts
      (generate-head-function . nndoc-generate-mime-parts-head)
      (article-transform-function . nndoc-transform-mime-parts))
@@ -143,7 +140,7 @@ from the document.")
 (defvoo nndoc-head-begin-function nil)
 (defvoo nndoc-body-end nil)
 ;; nndoc-dissection-alist is a list of sublists.  Each sublist holds the
-;; following items.  ARTICLE act as the association key and is an ordinal
+;; following items.  ARTICLE acts as the association key and is an ordinal
 ;; starting at 1.  HEAD-BEGIN [0], HEAD-END [1], BODY-BEGIN [2] and BODY-END
 ;; [3] are positions in the `nndoc' buffer.  LINE-COUNT [4] is a count of
 ;; lines in the body.  For MIME dissections only, ARTICLE-INSERT [5] and
@@ -344,6 +341,9 @@ from the document.")
                (setq entry (pop alist)))
       (when (memq subtype (or (cdr (assq 'subtype entry)) '(guess)))
        (goto-char (point-min))
+       ;; Remove blank lines.
+       (while (eq (following-char) ?\n)
+         (delete-char 1))
        (when (numberp (setq result (funcall (intern
                                              (format "nndoc-%s-type-p"
                                                      (car entry))))))
@@ -455,7 +455,7 @@ from the document.")
     (when (and limit
               (re-search-forward
                (concat "\
-^Content-Type:[ \t]*multipart/[a-z]+ *;\\(\\(\n[ \t]\\)?.*;\\)*"
+^Content-Type:[ \t]*multipart/[a-z]+ *; *\\(\\(\n[ \t]\\)?.*;\\)*"
                        "\\(\n[ \t]\\)?[ \t]*boundary=\"?[^\"\n]*[^\" \t\n]")
                limit t))
       t)))
@@ -470,10 +470,13 @@ from the document.")
 (defun nndoc-generate-mime-parts-head (article)
   (let* ((entry (cdr (assq article nndoc-dissection-alist)))
         (headers (nth 6 entry)))
+    (save-restriction
+      (narrow-to-region (point) (point))
+      (insert-buffer-substring
+       nndoc-current-buffer (car entry) (nth 1 entry))
+      (goto-char (point-max)))
     (when headers
-      (insert headers))
-    (insert-buffer-substring
-     nndoc-current-buffer (car entry) (nth 1 entry))))
+      (insert headers))))
 
 (defun nndoc-clari-briefs-type-p ()
   (when (let ((case-fold-search nil))
@@ -506,27 +509,6 @@ from the document.")
     (insert "From: " "clari@clari.net (" (or from "unknown") ")"
            "\nSubject: " (or subject "(no subject)") "\n")))
 
-(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)))
-
 (defun nndoc-standard-digest-type-p ()
   (when (and (re-search-forward (concat "^" (make-string 70 ?-) "\n\n") nil t)
             (re-search-forward
@@ -576,11 +558,14 @@ from the document.")
     (insert "From: "  (or from "unknown")
            "\nSubject: " (or subject "(no subject)") "\n")))
 
+(defun nndoc-nsmail-type-p ()
+  (when (looking-at "From - ")
+    t))
+
 (deffoo nndoc-request-accept-article (group &optional server last)
   nil)
 
 
-
 ;;;
 ;;; Functions for dissecting the documents
 ;;;
@@ -599,6 +584,9 @@ from the document.")
     (save-excursion
       (set-buffer nndoc-current-buffer)
       (goto-char (point-min))
+      ;; Remove blank lines.
+      (while (eq (following-char) ?\n)
+       (delete-char 1))
       ;; Find the beginning of the file.
       (when nndoc-file-begin
        (nndoc-search nndoc-file-begin))
@@ -673,19 +661,20 @@ PARENT is the message-ID of the parent summary line, or nil for none."
        (message-id (nnmail-message-id))
        head-end body-begin summary-insert message-rfc822 multipart-any
        subject content-type type subtype boundary-regexp)
-      ;; Gracefully handle a missing body.
-      (goto-char head-begin)
-      (if (search-forward "\n\n" body-end t)
-         (setq head-end (1- (point))
-               body-begin (point))
+    ;; Gracefully handle a missing body.
+    (goto-char head-begin)
+    (if (search-forward "\n\n" body-end t)
+       (setq head-end (1- (point))
+             body-begin (point))
       (setq head-end body-end
            body-begin body-end))
     (narrow-to-region head-begin head-end)
-      ;; Save MIME attributes.
-      (goto-char head-begin)
+    ;; Save MIME attributes.
+    (goto-char head-begin)
     (setq content-type (message-fetch-field "Content-Type"))
     (when content-type
-      (when (string-match "^ *\\([^ \t\n/;]+\\)/\\([^ \t\n/;]+\\)" content-type)
+      (when (string-match
+            "^ *\\([^ \t\n/;]+\\)/\\([^ \t\n/;]+\\)" content-type)
        (setq type (downcase (match-string 1 content-type))
              subtype (downcase (match-string 2 content-type))
              message-rfc822 (and (string= type "message")
@@ -702,8 +691,8 @@ PARENT is the message-ID of the parent summary line, or nil for none."
       (when (or multipart-any (not article-insert))
        (setq subject (message-fetch-field "Subject"))))
     (unless type
-       (setq type "text"
-             subtype "plain"))
+      (setq type "text"
+           subtype "plain"))
     ;; Prepare the article and summary inserts.
     (unless article-insert
       (setq article-insert (buffer-substring (point-min) (point-max))
@@ -715,8 +704,8 @@ PARENT is the message-ID of the parent summary line, or nil for none."
                              (and position multipart-any ".")
                              (and multipart-any "*")
                              (and (or position multipart-any) " ")
-                           (cond ((string= subtype "plain") type)
-                                 ((string= subtype "basic") type)
+                             (cond ((string= subtype "plain") type)
+                                   ((string= subtype "basic") type)
                                    (t subtype))
                              ">"
                              (and subject " ")
@@ -739,13 +728,13 @@ PARENT is the message-ID of the parent summary line, or nil for none."
                                summary-insert)
                  (replace-match line t t summary-insert)
                (concat summary-insert line)))))
-      ;; Generate dissection information for this entity.
-      (push (list (incf nndoc-mime-split-ordinal)
-                 head-begin head-end body-begin body-end
-                 (count-lines body-begin body-end)
+    ;; Generate dissection information for this entity.
+    (push (list (incf nndoc-mime-split-ordinal)
+               head-begin head-end body-begin body-end
+               (count-lines body-begin body-end)
                article-insert summary-insert)
-           nndoc-dissection-alist)
-      ;; Recurse for all sub-entities, if any.
+         nndoc-dissection-alist)
+    ;; Recurse for all sub-entities, if any.
     (widen)
     (cond
      (message-rfc822