Split out code to parse message headers for flags and properties.

Eliminate MESSAGE->STRING.

diff --git a/v7/src/imail/imail-core.scm b/v7/src/imail/imail-core.scm
index b5522f237f75e1df7e10ec54ba01b9f33482b7e2..9f849381899d1ecb1c6298729ca894347afb5740 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.37 2000/05/03 19:29:33 cph Exp $
+;;; $Id: imail-core.scm,v 1.38 2000/05/03 20:28:38 cph Exp $
 ;;;
 ;;; Copyright (c) 1999-2000 Massachusetts Institute of Technology
 ;;;
@@ -329,9 +329,9 @@
   (header-fields define accessor)
   (body define accessor)
   (flags define standard)
+  (properties define standard)
   (modification-count define standard
                      initial-value 0)
-  (properties define standard)
   (folder define standard
          initial-value #f)
   (index define standard))
@@ -349,11 +349,16 @@
       (error:wrong-type-argument message "IMAIL message" procedure)))
 
 (define (make-detached-message headers body)
+  (call-with-values (lambda () (parse-imail-header-fields headers))
+    (lambda (headers flags properties)
+      (make-message headers body flags properties))))
+
+(define (parse-imail-header-fields headers)
   (let loop ((headers headers) (headers* '()) (flags '()) (properties '()))
     (cond ((not (pair? headers))
-          (make-message (reverse! headers*) body
-                        (remove-duplicates! (reverse! flags) string-ci=?)
-                        (reverse! properties)))
+          (values (reverse! headers*)
+                  (remove-duplicates! (reverse! flags) string-ci=?)
+                  (reverse! properties)))
          ((header-field->message-flags (car headers))
           => (lambda (flags*)
                (loop (cdr headers) headers*
@@ -394,11 +399,6 @@
      (let ((folder (message-folder message)))
        (if folder
           (folder-modified! folder))))))
-
-(define (message->string message)
-  (string-append (header-fields->string (message-header-fields message))
-                "\n"
-                (message-body message)))
 \f
 ;;;; Message Navigation
 

diff --git a/v7/src/imail/imail-file.scm b/v7/src/imail/imail-file.scm
index af13eeee45f326986b8c9a9fe01568be83bf87e0..819de391b32b7ceb1ca049364e1d2f3662f32670 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.15 2000/05/03 19:29:37 cph Exp $
+;;; $Id: imail-file.scm,v 1.16 2000/05/03 20:28:42 cph Exp $
 ;;;
 ;;; Copyright (c) 1999-2000 Massachusetts Institute of Technology
 ;;;
@@ -71,6 +71,8 @@
       (revert-file-folder folder))
   (%file-folder-messages folder))
 
+(define-generic revert-file-folder (folder))
+
 (define (file-folder-pathname folder)
   (file-url-pathname (folder-url folder)))
 
@@ -141,9 +143,14 @@
           (let loop ((index 0) (winners '()))
             (if (< index n)
                 (loop (+ index 1)
-                      (if (string-search-forward
-                           criteria
-                           (message->string (get-message folder index)))
+                      (if (let ((message (get-message folder index)))
+                            (or (string-search-forward
+                                 criteria
+                                 (header-fields->string
+                                  (message-header-fields message)))
+                                (string-search-forward
+                                 criteria
+                                 (message-body message))))
                           (cons index winners)
                           winners))
                 (reverse! winners)))))
@@ -152,8 +159,6 @@
                                    "search criteria"
                                    'SEARCH-FOLDER))))
 \f
-(define-generic revert-file-folder (folder))
-
 (define-method folder-sync-status ((folder <file-folder>))
   (let ((sync-time (file-folder-file-modification-time folder))
        (sync-count (file-folder-file-modification-count folder))