From 27b226b5a700dc62ab12fbe77c9bac0240b48879 Mon Sep 17 00:00:00 2001
From: Chris Hanson <org/chris-hanson/cph>
Date: Sun, 18 Mar 2001 06:26:13 +0000
Subject: [PATCH] Change implementation of Rmail folders to keep a copy of the
 Rmail file in an external string, and to refer to the message bodies using
 index pairs into the string.  This change should allow Scheme to handle much
 larger Rmail folders.

---
 v7/src/imail/imail-rmail.scm | 46 ++++++++++++++++++++++++++----------
 1 file changed, 34 insertions(+), 12 deletions(-)

diff --git a/v7/src/imail/imail-rmail.scm b/v7/src/imail/imail-rmail.scm
index bc785cf51..1ce0b79bf 100644
--- 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.52 2000/10/20 02:14:59 cph Exp $
+;;; $Id: imail-rmail.scm,v 1.53 2001/03/18 06:26:13 cph Exp $
 ;;;
 ;;; Copyright (c) 1999-2000 Massachusetts Institute of Technology
 ;;;
@@ -93,6 +93,17 @@
   (displayed-header-fields define accessor)
   (internal-time accessor message-internal-time))
 
+(define-method file-message-body ((message <rmail-message>))
+  (let ((body (call-next-method message)))
+    (if (string? body)
+	body
+	(let ((xstring (vector-ref body 0))
+	      (start (vector-ref body 1))
+	      (end (vector-ref body 2)))
+	  (let ((body (make-string (- end start))))
+	     (xsubstring-move! xstring start end body 0)
+	     body)))))
+
 (define-method rmail-message-displayed-header-fields ((message <message>))
   message
   'UNDEFINED)
@@ -116,16 +127,22 @@
 	   (if (not (eq? 'UNKNOWN messages))
 	       (for-each detach-message! messages)))
 	 (set-file-folder-messages! folder '())))
-      (call-with-binary-input-file pathname
-	(lambda (port)
-	  (set-rmail-folder-header-fields! folder (read-rmail-prolog port))
-	  (let loop ((line #f))
-	    (call-with-values (lambda () (read-rmail-message port line))
-	      (lambda (message line)
-		(if message
-		    (begin
-		      (append-message message (folder-url folder))
-		      (loop line)))))))))))
+      (call-with-input-xstring
+       (call-with-binary-input-file pathname
+	 (lambda (port)
+	   (let ((n-bytes ((port/operation port 'LENGTH) port)))
+	     (let ((xstring (allocate-external-string n-bytes)))
+	       (read-substring! xstring 0 n-bytes port)
+	       xstring))))
+       (lambda (port)
+	 (set-rmail-folder-header-fields! folder (read-rmail-prolog port))
+	 (let loop ((line #f))
+	   (call-with-values (lambda () (read-rmail-message port line))
+	     (lambda (message line)
+	       (if message
+		   (begin
+		     (append-message message (folder-url folder))
+		     (loop line)))))))))))
 
 (define (read-rmail-prolog port)
   (if (not (rmail-prolog-start-line? (read-required-line port)))
@@ -157,7 +174,12 @@
       (let* ((headers (read-rmail-header-fields port))
 	     (displayed-headers
 	      (lines->header-fields (read-header-lines port)))
-	     (body (read-to-eom port))
+	     (body
+	      (let ((start (xstring-port/position port)))
+		(discard-to-eom port)
+		(vector (xstring-port/xstring port)
+			start
+			(xstring-port/position port))))
 	     (finish
 	      (lambda (headers displayed-headers)
 		(call-with-values
-- 
2.25.1