Eliminate COPY-MESSAGE, which no longer worked.

diff --git a/v7/src/imail/imail-core.scm b/v7/src/imail/imail-core.scm
index c387914b5cbf3ec49ba4aa563cf900dc6f4e534a..2c2355834e5892f4723e39773bd5d620726a5554 100644 (file)
--- 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.61 2000/05/16 18:55:35 cph Exp $
+;;; $Id: imail-core.scm,v 1.62 2000/05/17 15:03:49 cph Exp $
 ;;;
 ;;; Copyright (c) 1999-2000 Massachusetts Institute of Technology
 ;;;
@@ -331,11 +331,6 @@
   (if (not (message? message))
       (error:wrong-type-argument message "IMAIL message" procedure)))
 
-(define (copy-message message)
-  (make-message (map copy-header-field (message-header-fields message))
-               (message-body message)
-               (list-copy (message-flags message))))
-
 (define (attach-message! message folder index)
   (guarantee-folder folder 'ATTACH-MESSAGE!)
   (set-message-folder! message folder)

diff --git a/v7/src/imail/imail-file.scm b/v7/src/imail/imail-file.scm
index f1f1bcb11bfac4d00fbbda411846886472a1c5bc..9c1fa0cacaf39d147d68e83df445bfc5222e6479 100644 (file)
--- a/v7/src/imail/imail-file.scm
+++ b/v7/src/imail/imail-file.scm
@@ -1,6 +1,6 @@
 ;;; -*-Scheme-*-
 ;;;
-;;; $Id: imail-file.scm,v 1.24 2000/05/15 19:17:12 cph Exp $
+;;; $Id: imail-file.scm,v 1.25 2000/05/17 15:03:15 cph Exp $
 ;;;
 ;;; Copyright (c) 1999-2000 Massachusetts Institute of Technology
 ;;;
@@ -92,7 +92,7 @@
 (define-method %append-message ((message <message>) (url <file-url>))
   (let ((folder (get-memoized-folder url)))
     (if folder
-       (let ((message (copy-message message)))
+       (let ((message (make-message-copy message folder)))
          (without-interrupts
           (lambda ()
             (set-file-folder-messages!
@@ -115,6 +115,7 @@
                      (list message))))))))
        (append-message-to-file message url))))
 
+(define-generic make-message-copy (message folder))
 (define-generic append-message-to-file (message url))
 \f
 (define-method expunge-deleted-messages ((folder <file-folder>))

diff --git a/v7/src/imail/imail-rmail.scm b/v7/src/imail/imail-rmail.scm
index a696bd445097c450ba72a60b985193bb45cad5f0..1b16d147820caef87a70e507135ccefc98c0e80b 100644 (file)
--- a/v7/src/imail/imail-rmail.scm
+++ b/v7/src/imail/imail-rmail.scm
@@ -1,6 +1,6 @@
 ;;; -*-Scheme-*-
 ;;;
-;;; $Id: imail-rmail.scm,v 1.28 2000/05/16 18:55:38 cph Exp $
+;;; $Id: imail-rmail.scm,v 1.29 2000/05/17 15:03:10 cph Exp $
 ;;;
 ;;; Copyright (c) 1999-2000 Massachusetts Institute of Technology
 ;;;
@@ -91,6 +91,12 @@
 (define-method rmail-message-displayed-header-fields ((message <message>))
   message
   'UNDEFINED)
+
+(define-method make-message-copy ((message <message>) (folder <rmail-folder>))
+  (make-rmail-message (message-header-fields message)
+                     (message-body message)
+                     (list-copy (message-flags message))
+                     (rmail-message-displayed-header-fields message)))
 \f
 ;;;; Read RMAIL file
 

diff --git a/v7/src/imail/imail-umail.scm b/v7/src/imail/imail-umail.scm
index 3cfb93dc924bfb211e6021c941509a6949ff6ef4..8d263a6eb589f14fa8345b3854878be33f3a5271 100644 (file)
--- 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.24 2000/05/16 04:14:42 cph Exp $
+;;; $Id: imail-umail.scm,v 1.25 2000/05/17 15:03:01 cph Exp $
 ;;;
 ;;; Copyright (c) 1999-2000 Massachusetts Institute of Technology
 ;;;
@@ -64,7 +64,9 @@
 
 ;;;; Message
 
-(define-class <umail-message> (<message>)
+(define-class (<umail-message>
+              (constructor (header-fields body flags from-line)))
+    (<message>)
   (from-line define accessor))
 
 (define-method umail-message-from-line ((message <message>))
@@ -75,7 +77,14 @@
                            (rfc822:first-address from)))
                     "unknown")
                 " "
-                (universal-time->local-ctime-string (get-universal-time))))
+                (universal-time->local-ctime-string
+                 (message-internal-time message))))
+
+(define-method make-message-copy ((message <message>) (folder <umail-folder>))
+  (make-umail-message (message-header-fields message)
+                     (message-body message)
+                     (list-copy (message-flags message))
+                     (umail-message-from-line message)))
 
 (define-method message-internal-time ((message <umail-message>))
   (or (extract-umail-from-time (umail-message-from-line message))
@@ -110,46 +119,42 @@
   (let read-headers ((header-lines '()))
     (let ((line (read-line port)))
       (cond ((eof-object? line)
-            (values (make-umail-message from-line
-                                        (reverse! header-lines)
-                                        '())
+            (values (read-umail-message-1 from-line
+                                          (reverse! header-lines)
+                                          '())
                     #f))
            ((string-null? line)
             (let read-body ((body-lines '()))
               (let ((line (read-line port)))
                 (cond ((eof-object? line)
-                       (values (make-umail-message from-line
-                                                   (reverse! header-lines)
-                                                   (reverse! body-lines))
+                       (values (read-umail-message-1 from-line
+                                                     (reverse! header-lines)
+                                                     (reverse! body-lines))
                                #f))
                       ((umail-delimiter? line)
-                       (values (make-umail-message from-line
-                                                   (reverse! header-lines)
-                                                   (reverse! body-lines))
+                       (values (read-umail-message-1 from-line
+                                                     (reverse! header-lines)
+                                                     (reverse! body-lines))
                                line))
                       (else
                        (read-body (cons line body-lines)))))))
            (else
             (read-headers (cons line header-lines)))))))
 
-(define make-umail-message
-  (let ((constructor
-        (instance-constructor <umail-message>
-                              '(HEADER-FIELDS BODY FLAGS FROM-LINE))))
-    (lambda (from-line header-lines body-lines)
-      (call-with-values
-         (lambda ()
-           (parse-imail-header-fields (lines->header-fields header-lines)))
-       (lambda (headers flags)
-         (constructor headers
-                      (lines->string
-                       (map (lambda (line)
-                              (if (string-prefix-ci? ">From " line)
-                                  (string-tail line 1)
-                                  line))
-                            body-lines))
-                      flags
-                      from-line))))))
+(define (read-umail-message-1 from-line header-lines body-lines)
+  (call-with-values
+      (lambda ()
+       (parse-imail-header-fields (lines->header-fields header-lines)))
+    (lambda (headers flags)
+      (make-umail-message headers
+                         (lines->string
+                          (map (lambda (line)
+                                 (if (string-prefix-ci? ">From " line)
+                                     (string-tail line 1)
+                                     line))
+                               body-lines))
+                         flags
+                         from-line))))
 
 (define (umail-delimiter? line)
   (re-string-match unix-mail-delimiter line))