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 a8e37ac8e08adf5c6bfdb629b18ee126aba7209d..ec2d893cb3ae483a6f9259b89d347dcf5611c344 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.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 fbafa62de231d8f5c8afed901f62fde0dc532ba7..9b9052d10e41e1441a8af9679c07cb4654628d2c 100644 (file)
--- 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)))))
 \f
 (define (parse-mime-body body)

diff --git a/v7/src/imail/imail-top.scm b/v7/src/imail/imail-top.scm
index c90992e2bf651649c4c9d578bc5a81b36f7dfd62..e1dae82bf78984ed4aeb709a6207b7a1eb52e837 100644 (file)
--- 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))