From: Chris Hanson <org/chris-hanson/cph>
Date: Mon, 8 May 2000 19:07:54 +0000 (+0000)
Subject: Eliminate MAKE-ATTACHED-MESSAGE.
X-Git-Tag: 20090517-FFI~3908
X-Git-Url: https://birchwood-abbey.net/git?a=commitdiff_plain;h=bb74feac0dc0a69f5e43cf3eb9bf85161b11cd59;p=mit-scheme.git

Eliminate MAKE-ATTACHED-MESSAGE.
---

diff --git a/v7/src/imail/imail-core.scm b/v7/src/imail/imail-core.scm
index 70751036e..80bda57a5 100644
--- a/v7/src/imail/imail-core.scm
+++ b/v7/src/imail/imail-core.scm
@@ -1,6 +1,6 @@
 ;;; -*-Scheme-*-
 ;;;
-;;; $Id: imail-core.scm,v 1.48 2000/05/08 19:02:42 cph Exp $
+;;; $Id: imail-core.scm,v 1.49 2000/05/08 19:07:47 cph Exp $
 ;;;
 ;;; Copyright (c) 1999-2000 Massachusetts Institute of Technology
 ;;;
@@ -374,11 +374,6 @@
 	   (loop (cdr headers) (cons (car headers) headers*) flags
 		 properties)))))
 
-(define (make-attached-message folder headers body)
-  (let ((message (make-detached-message headers body)))
-    (attach-message! message folder)
-    message))
-
 (define (copy-message message)
   (make-message (map copy-header-field (message-header-fields message))
 		(message-body message)
diff --git a/v7/src/imail/imail-umail.scm b/v7/src/imail/imail-umail.scm
index 84ff9bcd4..dc5718d07 100644
--- a/v7/src/imail/imail-umail.scm
+++ b/v7/src/imail/imail-umail.scm
@@ -1,6 +1,6 @@
 ;;; -*-Scheme-*-
 ;;;
-;;; $Id: imail-umail.scm,v 1.16 2000/05/03 19:29:48 cph Exp $
+;;; $Id: imail-umail.scm,v 1.17 2000/05/08 19:07:54 cph Exp $
 ;;;
 ;;; Copyright (c) 1999-2000 Massachusetts Institute of Technology
 ;;;
@@ -75,22 +75,21 @@
 		 (begin
 		   (if (not (umail-delimiter? from-line))
 		       (error "Malformed unix mail file:" port))
-		   (let loop ((from-line from-line) (messages '()))
+		   (let loop ((from-line from-line) (index 0) (messages '()))
 		     (call-with-values
-			 (lambda ()
-			   (read-umail-message folder from-line port))
+			 (lambda () (read-umail-message from-line port))
 		       (lambda (message from-line)
+			 (attach-message! message folder index)
 			 (let ((messages (cons message messages)))
 			   (if from-line
-			       (loop from-line messages)
+			       (loop from-line (+ index 1) messages)
 			       (reverse! messages)))))))))))))))
 
-(define (read-umail-message folder from-line port)
+(define (read-umail-message from-line port)
   (let read-headers ((header-lines '()))
     (let ((line (read-line port)))
       (cond ((eof-object? line)
-	     (values (make-umail-message folder
-					 from-line
+	     (values (make-umail-message from-line
 					 (reverse! header-lines)
 					 '())
 		     #f))
@@ -98,14 +97,12 @@
 	     (let read-body ((body-lines '()))
 	       (let ((line (read-line port)))
 		 (cond ((eof-object? line)
-			(values (make-umail-message folder
-						    from-line
+			(values (make-umail-message from-line
 						    (reverse! header-lines)
 						    (reverse! body-lines))
 				#f))
 		       ((umail-delimiter? line)
-			(values (make-umail-message folder
-						    from-line
+			(values (make-umail-message from-line
 						    (reverse! header-lines)
 						    (reverse! body-lines))
 				line))
@@ -114,10 +111,9 @@
 	    (else
 	     (read-headers (cons line header-lines)))))))
 
-(define (make-umail-message folder from-line header-lines body-lines)
+(define (make-umail-message from-line header-lines body-lines)
   (let ((message
-	 (make-attached-message
-	  folder
+	 (make-detached-message
 	  (lines->header-fields header-lines)
 	  (lines->string (map (lambda (line)
 				(if (string-prefix-ci? ">From " line)