From: Chris Hanson <org/chris-hanson/cph>
Date: Mon, 5 Jun 2000 17:50:53 +0000 (+0000)
Subject: Change interface to MESSAGE-MIME-BODY-PART to specify whether to cache
X-Git-Tag: 20090517-FFI~3608
X-Git-Url: https://birchwood-abbey.net/git?a=commitdiff_plain;h=359c2a1543d46de0fc3e1b3c01431def76fc85d5;p=mit-scheme.git

Change interface to MESSAGE-MIME-BODY-PART to specify whether to cache
the part.
---

diff --git a/v7/src/imail/imail-core.scm b/v7/src/imail/imail-core.scm
index a8e37ac8e..ec2d893cb 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.96 2000/06/02 20:35:17 cph Exp $
+;;; $Id: imail-core.scm,v 1.97 2000/06/05 17:50:53 cph Exp $
 ;;;
 ;;; Copyright (c) 1999-2000 Massachusetts Institute of Technology
 ;;;
@@ -808,7 +808,12 @@
 ;;;; MIME structure
 
 (define-generic message-mime-body-structure (message))
-(define-generic message-mime-body-part (message selector))
+
+;; Cache is either a boolean or an exact nonnegative integer.
+;; #F means don't cache.
+;; #T means cache unconditionally.
+;; integer means cache if less than this length.
+(define-generic message-mime-body-part (message selector cache?))
 
 (define-class <mime-body> (<imail-object>)
   (parameters define accessor)
diff --git a/v7/src/imail/imail-imap.scm b/v7/src/imail/imail-imap.scm
index fbafa62de..9b9052d10 100644
--- a/v7/src/imail/imail-imap.scm
+++ b/v7/src/imail/imail-imap.scm
@@ -1,6 +1,6 @@
 ;;; -*-Scheme-*-
 ;;;
-;;; $Id: imail-imap.scm,v 1.107 2000/06/05 17:35:04 cph Exp $
+;;; $Id: imail-imap.scm,v 1.108 2000/06/05 17:50:45 cph Exp $
 ;;;
 ;;; Copyright (c) 1999-2000 Massachusetts Institute of Technology
 ;;;
@@ -798,7 +798,8 @@
 (define-method message-mime-body-structure ((message <imap-message>))
   (imap-message-bodystructure message))
 
-(define-method message-mime-body-part ((message <imap-message>) selector)
+(define-method message-mime-body-part
+    ((message <imap-message>) selector cache?)
   (let ((section
 	 (map (lambda (x)
 		(if (exact-nonnegative-integer? x)
@@ -836,10 +837,13 @@
 				 "]"))))))))
 		  section
 		  #f)))
-	    (set-imap-message-body-parts!
-	     message
-	     (cons (cons section part)
-		   (imap-message-body-parts message)))
+	    (if (and cache?
+		     (or (eq? cache? #t)
+			 (< (string-length part) cache?)))
+		(set-imap-message-body-parts!
+		 message
+		 (cons (cons section part)
+		       (imap-message-body-parts message))))
 	    part)))))
 
 (define (parse-mime-body body)
diff --git a/v7/src/imail/imail-top.scm b/v7/src/imail/imail-top.scm
index c90992e2b..e1dae82bf 100644
--- a/v7/src/imail/imail-top.scm
+++ b/v7/src/imail/imail-top.scm
@@ -1,6 +1,6 @@
 ;;; -*-Scheme-*-
 ;;;
-;;; $Id: imail-top.scm,v 1.126 2000/06/05 17:32:29 cph Exp $
+;;; $Id: imail-top.scm,v 1.127 2000/06/05 17:50:10 cph Exp $
 ;;;
 ;;; Copyright (c) 1999-2000 Massachusetts Institute of Technology
 ;;;
@@ -1038,7 +1038,8 @@ With prefix argument N moves backward N messages with these flags."
 		      (and (eq? (mime-body-type enclosure) 'MESSAGE)
 			   (eq? (mime-body-subtype enclosure) 'RFC822)))
 		  `(,@selector TEXT)
-		  selector))))
+		  selector)
+	      #t)))
 	(case (let ((encoding
 		     (and enclosure
 			  (eq? (mime-body-type enclosure) 'MESSAGE)
@@ -1070,7 +1071,7 @@ With prefix argument N moves backward N messages with these flags."
    (header-fields->string
     (maybe-reformat-headers
      (string->header-fields
-      (message-mime-body-part message `(,@selector HEADER)))
+      (message-mime-body-part message `(,@selector HEADER) #t))
      mark))
    mark)
   (insert-newline mark)
@@ -1589,7 +1590,7 @@ With prefix argument, prompt even when point is on an attachment."
 	(begin
 	  (call-with-binary-output-file filename
 	    (lambda (port)
-	      (let ((string (message-mime-body-part message selector)))
+	      (let ((string (message-mime-body-part message selector #f)))
 		(case (mime-body-one-part-encoding body)
 		  ((QUOTED-PRINTABLE)
 		   (decode-quoted-printable-string string port))