From 781fb79816b6cba3ebaae6b9cb923c4a5741e70b Mon Sep 17 00:00:00 2001
From: Chris Hanson <org/chris-hanson/cph>
Date: Wed, 3 May 2000 20:28:42 +0000
Subject: [PATCH] Split out code to parse message headers for flags and
 properties. Eliminate MESSAGE->STRING.

---
 v7/src/imail/imail-core.scm | 20 ++++++++++----------
 v7/src/imail/imail-file.scm | 17 +++++++++++------
 2 files changed, 21 insertions(+), 16 deletions(-)

diff --git a/v7/src/imail/imail-core.scm b/v7/src/imail/imail-core.scm
index b5522f237..9f8493818 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.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)))
 
 ;;;; Message Navigation
 
diff --git a/v7/src/imail/imail-file.scm b/v7/src/imail/imail-file.scm
index af13eeee4..819de391b 100644
--- 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))))
 
-(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))
-- 
2.25.1