Preserve internal time when copying to rmail folder from any other

type of folder, by writing a distinguished header field into the rmail
file.

diff --git a/v7/src/imail/imail-file.scm b/v7/src/imail/imail-file.scm
index 58f620c27fcf48ceab1eee324074035a3e4cbdd8..2bab9b1a0276582045846d63c633f4e1d3e22e6c 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.48 2000/06/23 19:29:04 cph Exp $
+;;; $Id: imail-file.scm,v 1.49 2000/06/23 19:29:41 cph Exp $
 ;;;
 ;;; Copyright (c) 1999-2000 Massachusetts Institute of Technology
 ;;;
@@ -289,7 +289,7 @@
      (string-length (file-message-body message))))
 
 (define-method message-internal-time ((message <file-message>))
-  (header-fields->internal-time headers))
+  (header-fields->internal-time message))
 
 (define (header-fields->internal-time headers)
   (let loop ((headers (get-all-header-fields headers "received")) (winner #f))

diff --git a/v7/src/imail/imail-rmail.scm b/v7/src/imail/imail-rmail.scm
index 4b9b69143a02d140454c8ff704662bce1573ffda..7920a9c57399ff174d928d827b39b8644b9e5a67 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.43 2000/06/20 19:49:16 cph Exp $
+;;; $Id: imail-rmail.scm,v 1.44 2000/06/23 19:29:05 cph Exp $
 ;;;
 ;;; Copyright (c) 1999-2000 Massachusetts Institute of Technology
 ;;;
@@ -84,9 +84,11 @@
 
 (define-class (<rmail-message>
               (constructor (header-fields body flags
-                                          displayed-header-fields)))
+                                          displayed-header-fields
+                                          internal-time)))
     (<file-message>)
-  (displayed-header-fields define accessor))
+  (displayed-header-fields define accessor)
+  (internal-time accessor message-internal-time))
 
 (define-method rmail-message-displayed-header-fields ((message <message>))
   message
@@ -97,7 +99,8 @@
   (make-rmail-message (message-header-fields message)
                      (file-message-body message)
                      (list-copy (message-flags message))
-                     (rmail-message-displayed-header-fields message)))
+                     (rmail-message-displayed-header-fields message)
+                     (message-internal-time message)))
 \f
 ;;;; Read RMAIL file
 
@@ -145,7 +148,14 @@
             (body (read-to-eom port))
             (finish
              (lambda (headers displayed-headers)
-               (make-rmail-message headers body flags displayed-headers))))
+               (call-with-values
+                   (lambda () (rmail-internal-time-header headers))
+                 (lambda (headers time)
+                   (make-rmail-message headers body flags
+                                       displayed-headers
+                                       (or time
+                                           (header-fields->internal-time
+                                            headers))))))))
        (if formatted?
            (finish headers displayed-headers)
            (finish displayed-headers 'UNDEFINED))))))
@@ -180,6 +190,22 @@
              ((string=? rmail-message:headers-separator line)
               (make-eof-object port))
              (else line)))))))
+
+(define (rmail-internal-time-header headers)
+  (let ((header (get-first-header-field headers "X-IMAIL-INTERNAL-TIME" #f)))
+    (if header
+       (values (delq! header headers)
+               (let ((t
+                      (ignore-errors
+                       (lambda ()
+                         (string->universal-time
+                          (rfc822:tokens->string
+                           (rfc822:strip-comments
+                            (rfc822:string->tokens
+                             (header-field-value header)))))))))
+                 (and (not (condition? t))
+                      t)))
+       (values headers #f))))
 \f
 ;;;; Write RMAIL file
 
@@ -211,7 +237,16 @@
 (define (write-rmail-message message port)
   (write-char rmail-message:start-char port)
   (newline port)
-  (let ((headers (message-header-fields message))
+  (let ((headers
+        (let ((headers (message-header-fields message))
+              (time (message-internal-time message)))
+          (if time
+              (cons (make-header-field "X-IMAIL-INTERNAL-TIME"
+                                       (string-append
+                                        " "
+                                        (universal-time->string time)))
+                    headers)
+              headers)))
        (displayed-headers (rmail-message-displayed-header-fields message)))
     (let ((formatted? (not (eq? 'UNDEFINED displayed-headers))))
       (write-rmail-attributes-line message formatted? port)

diff --git a/v7/src/imail/todo.txt b/v7/src/imail/todo.txt
index c0f3ecfc354330067b12b7b7350c8cc76e696f6f..dc2e651d4ebd36794ebc12f36699348717423240 100644 (file)
--- a/v7/src/imail/todo.txt
+++ b/v7/src/imail/todo.txt
@@ -1,13 +1,9 @@
 IMAIL To-Do List
-$Id: todo.txt,v 1.95 2000/06/23 19:05:40 cph Exp $
+$Id: todo.txt,v 1.96 2000/06/23 19:29:07 cph Exp $
 
 Bug fixes
 ---------
 
-* Preserve internal-date when copying to rmail folder from any other
-  type of folder, by writing a distinguished header field into the
-  rmail file.
-
 * Must be able to handle malformed headers in incoming mail.
   Generating a low-level error in this situation is unacceptable.