Eliminate MAKE-ATTACHED-MESSAGE.
authorChris Hanson <org/chris-hanson/cph>
Mon, 8 May 2000 19:07:54 +0000 (19:07 +0000)
committerChris Hanson <org/chris-hanson/cph>
Mon, 8 May 2000 19:07:54 +0000 (19:07 +0000)
v7/src/imail/imail-core.scm
v7/src/imail/imail-umail.scm

index 70751036ea1f90b55d1c3be9b6a3862f610668d6..80bda57a544c328e98db10ebbf41e927d2b4f884 100644 (file)
@@ -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
 ;;;
           (loop (cdr headers) (cons (car headers) headers*) flags
                 properties)))))
 \f
-(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)
index 84ff9bcd4c4bcc4643041e60873c608908465425..dc5718d076fa14809ce617f8b4ec447e9e5265c7 100644 (file)
@@ -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
 ;;;
                 (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))
             (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))
            (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)