diff lisp/gnus/nndoc.el @ 24357:15fc6acbae7a

Upgrading to Gnus 5.7; see ChangeLog

--- a/lisp/gnus/nndoc.el	Sat Feb 20 13:52:45 1999 +0000
+++ b/lisp/gnus/nndoc.el	Sat Feb 20 14:05:57 1999 +0000
@@ -1,7 +1,7 @@
 ;;; nndoc.el --- single file access for Gnus
-;; Copyright (C) 1995,96,97 Free Software Foundation, Inc.
+;; Copyright (C) 1995,96,97,98 Free Software Foundation, Inc.
 
-;; Author: Lars Magne Ingebrigtsen <[e-mail]>
+;; Author: Lars Magne Ingebrigtsen <[e-mail]>
 ;; 	Masanobu UMEDA <[e-mail]>
 ;; Keywords: news
 
@@ -30,6 +30,7 @@
 (require 'message)
 (require 'nnmail)
 (require 'nnoo)
+(require 'gnus-util)
 (eval-when-compile (require 'cl))
 
 (nnoo-declare nndoc)
@@ -37,12 +38,17 @@
 (defvoo nndoc-article-type 'guess
   "*Type of the file.
 One of `mbox', `babyl', `digest', `news', `rnews', `mmdf', `forward',
-`rfc934', `rfc822-forward', `mime-digest', `standard-digest',
+`rfc934', `rfc822-forward', `mime-digest', `mime-parts', `standard-digest',
 `slack-digest', `clari-briefs' or `guess'.")
 
 (defvoo nndoc-post-type 'mail
   "*Whether the nndoc group is `mail' or `post'.")
 
+(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")
@@ -81,13 +87,16 @@
      (body-end . "")
      (file-end . "")
      (subtype digest guess))
+    (mime-parts
+     (generate-head-function . nndoc-generate-mime-parts-head)
+     (article-transform-function . nndoc-transform-mime-parts))
     (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
@@ -122,10 +131,8 @@
      (subtype nil))))
 
 
-
 (defvoo nndoc-file-begin nil)
 (defvoo nndoc-first-article nil)
-(defvoo nndoc-article-end nil)
 (defvoo nndoc-article-begin nil)
 (defvoo nndoc-head-begin nil)
 (defvoo nndoc-head-end nil)
@@ -135,6 +142,11 @@
 (defvoo nndoc-body-begin-function nil)
 (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 is an ordinal starting at 1.  HEAD-BEGIN,
+;; HEAD-END, BODY-BEGIN and BODY-END are positions in the `nndoc' buffer.
+;; LINE-COUNT is a count of lines in the body.  SUBJECT, MESSAGE-ID and
+;; REFERENCES, only present for MIME dissections, are field values.
 (defvoo nndoc-dissection-alist nil)
 (defvoo nndoc-prepare-body-function nil)
 (defvoo nndoc-generate-head-function nil)
@@ -146,6 +158,8 @@
 (defvoo nndoc-current-buffer nil
   "Current nndoc news buffer.")
 (defvoo nndoc-address nil)
+(defvoo nndoc-mime-header nil)
+(defvoo nndoc-mime-subject nil)
 
 (defconst nndoc-version "nndoc 1.0"
   "nndoc version.")
@@ -279,14 +293,17 @@
 	(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))
       (save-excursion
 	(set-buffer nndoc-current-buffer)
 	(nndoc-set-delims)
-	(nndoc-dissect-buffer)))
+	(if (eq nndoc-article-type 'mime-parts)
+	    (nndoc-dissect-mime-parts)
+	  (nndoc-dissect-buffer))))
     (unless nndoc-current-buffer
       (nndoc-close-server))
     ;; Return whether we managed to select a file.
@@ -300,7 +317,8 @@
   "Set the nndoc delimiter variables according to the type of the document."
   (let ((vars '(nndoc-file-begin
 		nndoc-first-article
-		nndoc-article-end nndoc-head-begin nndoc-head-end
+		nndoc-article-begin-function
+		nndoc-head-begin nndoc-head-end
 		nndoc-file-end nndoc-article-begin
 		nndoc-body-begin nndoc-body-end-function nndoc-body-end
 		nndoc-prepare-body-function nndoc-article-transform-function
@@ -334,7 +352,7 @@
       (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
@@ -390,7 +408,7 @@
 
 (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))))
@@ -402,7 +420,7 @@
 
 (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))
 
@@ -429,6 +447,44 @@
 (defun nndoc-rfc822-forward-body-end-function ()
   (goto-char (point-max)))
 
+(defun nndoc-mime-parts-type-p ()
+  (let ((case-fold-search t)
+	(limit (search-forward "\n\n" nil t)))
+    (goto-char (point-min))
+    (when (and limit
+		(re-search-forward
+		 (concat "\
+^Content-Type:[ \t]*multipart/[a-z]+;\\(.*;\\)*"
+			 "[ \t\n]*[ \t]boundary=\"?[^\"\n]*[^\" \t\n]")
+	   limit t))
+      t)))
+
+(defun nndoc-transform-mime-parts (article)
+  (unless (= article 1)
+    ;; Ensure some MIME-Version.
+    (goto-char (point-min))
+    (search-forward "\n\n")
+    (let ((case-fold-search nil)
+	  (limit (point)))
+      (goto-char (point-min))
+      (or (save-excursion (re-search-forward "^MIME-Version:" limit t))
+	  (insert "Mime-Version: 1.0\n")))
+    ;; Generate default header before entity fields.
+    (goto-char (point-min))
+    (nndoc-generate-mime-parts-head article t)))
+
+(defun nndoc-generate-mime-parts-head (article &optional body-present)
+  (let ((entry (cdr (assq (if body-present 1 article) nndoc-dissection-alist))))
+    (let ((subject (if body-present
+		       nndoc-mime-subject
+		     (concat "<" (nth 5 entry) ">")))
+	  (message-id (nth 6 entry))
+	  (references (nth 7 entry)))
+      (insert nndoc-mime-header)
+      (and subject (insert "Subject: " subject "\n"))
+      (and message-id (insert "Message-ID: " message-id "\n"))
+      (and references (insert "References: " references "\n")))))
+
 (defun nndoc-clari-briefs-type-p ()
   (when (let ((case-fold-search nil))
 	  (re-search-forward "^\t[^a-z]+ ([^a-z]+) --" nil t))
@@ -466,7 +522,7 @@
     (when (and
 	   (re-search-forward
 	    (concat "^Content-Type: *multipart/digest;[ \t\n]*[ \t]"
-		    "boundary=\"\\([^\"\n]*[^\" \t\n]\\)\"")
+		    "boundary=\"?\\([^\"\n]*[^\" \t\n]\\)")
 	    nil t)
 	   (match-beginning 1))
       (setq boundary-id (match-string 1)
@@ -530,6 +586,9 @@
     (insert "From: "  (or from "unknown")
  	    "\nSubject: " (or subject "(no subject)") "\n")))
 
+(deffoo nndoc-request-accept-article (group &optional server last)
+  nil)
+
 
 
 ;;;
@@ -562,7 +621,7 @@
 	       (funcall nndoc-head-begin-function))
 	      (nndoc-head-begin
 	       (nndoc-search nndoc-head-begin)))
- 	(if (or (>= (point) (point-max))
+ 	(if (or (eobp)
 		(and nndoc-file-end
 		     (looking-at nndoc-file-end)))
 	    (goto-char (point-max))
@@ -599,6 +658,104 @@
   (while (re-search-forward "^- -"nil t)
     (replace-match "-" t t)))
 
+;; Against compiler warnings.
+(defvar nndoc-mime-split-ordinal)
+
+(defun nndoc-dissect-mime-parts ()
+  "Go through a MIME composite article and partition it into sub-articles.
+When a MIME entity contains sub-entities, dissection produces one article for
+the header of this entity, and one article per sub-entity."
+  (setq nndoc-dissection-alist nil
+	nndoc-mime-split-ordinal 0)
+  (save-excursion
+    (set-buffer nndoc-current-buffer)
+    (message-narrow-to-head)
+    (let ((case-fold-search t)
+	  (message-id (message-fetch-field "Message-ID"))
+	  (references (message-fetch-field "References")))
+      (setq nndoc-mime-header (buffer-substring (point-min) (point-max))
+	    nndoc-mime-subject (message-fetch-field "Subject"))
+      (while (string-match "\
+^\\(Subject\\|Message-ID\\|References\\|Lines\\|\
+MIME-Version\\|Content-Type\\|Content-Transfer-Encoding\\|\
+\\):.*\n\\([ \t].*\n\\)*"
+			   nndoc-mime-header)
+	(setq nndoc-mime-header (replace-match "" t t nndoc-mime-header)))
+      (widen)
+      (nndoc-dissect-mime-parts-sub (point-min) (point-max)
+				    nil message-id references))))
+
+(defun nndoc-dissect-mime-parts-sub (begin end position message-id references)
+  "Dissect an entity within a composite MIME message.
+The article, which corresponds to a MIME entity, extends from BEGIN to END.
+The string POSITION holds a dotted decimal representation of the article
+position in the hierarchical structure, it is nil for the outer entity.
+The generated article should use MESSAGE-ID and REFERENCES field values."
+  ;; Note: `case-fold-search' is already `t' from the calling function.
+  (let ((head-begin begin)
+	(body-end end)
+	head-end body-begin type subtype composite comment)
+    (save-excursion
+      ;; 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 end
+	      body-begin end))
+      ;; Save MIME attributes.
+      (goto-char head-begin)
+      (if (re-search-forward "\
+^Content-Type: *\\([^ \t\n/;]+\\)/\\([^ \t\n/;]+\\)"
+			     head-end t)
+	  (setq type (downcase (match-string 1))
+		subtype (downcase (match-string 2)))
+	(setq type "text"
+	      subtype "plain"))
+      (setq composite (string= type "multipart")
+	    comment (concat position
+			    (when (and position composite) ".")
+			    (when composite "*")
+			    (when (or position composite) " ")
+			    (cond ((string= subtype "plain") type)
+				  ((string= subtype "basic") type)
+				  (t subtype))))
+      ;; 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)
+		  comment message-id references)
+	    nndoc-dissection-alist)
+      ;; Recurse for all sub-entities, if any.
+      (goto-char head-begin)
+      (when (re-search-forward
+	     (concat "\
+^Content-Type: *multipart/\\([a-z]+\\);\\(.*;\\)*"
+		     "[ \t\n]*[ \t]boundary=\"?\\([^\"\n]*[^\" \t\n]\\)")
+	   head-end t)
+	(let ((boundary (concat "\n--" (match-string 3) "\\(--\\)?[ \t]*\n"))
+	      (part-counter 0)
+	      begin end eof-flag)
+	  (goto-char head-end)
+	  (setq eof-flag (not (re-search-forward boundary body-end t)))
+	  (while (not eof-flag)
+	    (setq begin (point))
+	    (cond ((re-search-forward boundary body-end t)
+		   (or (not (match-string 1))
+		       (string= (match-string 1) "")
+		       (setq eof-flag t))
+		   (forward-line -1)
+		   (setq end (point))
+		   (forward-line 1))
+		  (t (setq end body-end
+			   eof-flag t)))
+	    (nndoc-dissect-mime-parts-sub begin end
+					  (concat position (when position ".")
+						  (format "%d"
+							  (incf part-counter)))
+					  (nnmail-message-id)
+					  message-id)))))))
+
 ;;;###autoload
 (defun nndoc-add-type (definition &optional position)
   "Add document DEFINITION to the list of nndoc document definitions.
@@ -607,9 +764,7 @@
 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))