Add cache for MIME body parts.

diff --git a/v7/src/imail/imail-imap.scm b/v7/src/imail/imail-imap.scm
index 18abfe088042ab0ebabb61d8894c3c4038b96cb0..4aed273ea88fccae92dbec52da9fde720d7d62d3 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.105 2000/06/05 17:25:38 cph Exp $
+;;; $Id: imail-imap.scm,v 1.106 2000/06/05 17:29:29 cph Exp $
 ;;;
 ;;; Copyright (c) 1999-2000 Massachusetts Institute of Technology
 ;;;
@@ -649,7 +649,8 @@
   (uid)
   (length)
   (envelope)
-  (bodystructure))
+  (bodystructure)
+  (body-parts define standard initial-value '()))
 
 (define-generic imap-message-uid (message))
 (define-generic imap-message-length (message))
@@ -804,29 +805,42 @@
                    (+ x 1)
                    x))
              selector)))
-    (imap:response:fetch-body-part
-     (let ((suffix 
-           (string-append
-            " body part for message "
-            (number->string (+ (message-index message) 1)))))
-       ((imail-message-wrapper "Reading" suffix)
-       (lambda ()
-         (imap:read-literal-progress-hook imail-progress-meter
-           (lambda ()
-             (imap:command:uid-fetch
-              (imap-folder-connection (message-folder message))
-              (imap-message-uid message)
-              `(',(string-append "body["
-                                 (decorated-string-append
-                                  "" "." ""
-                                  (map (lambda (x)
-                                         (if (exact-nonnegative-integer? x)
-                                             (number->string x)
-                                             (symbol->string x)))
-                                       section))
-                                 "]"))))))))
-     section
-     #f)))
+    (let ((entry
+          (list-search-positive (imap-message-body-parts message)
+            (lambda (entry)
+              (equal? (car entry) section)))))
+      (if entry
+         (cdr entry)
+         (let ((part
+                (imap:response:fetch-body-part
+                 (let ((suffix 
+                        (string-append
+                         " body part for message "
+                         (number->string (+ (message-index message) 1)))))
+                   ((imail-message-wrapper "Reading" suffix)
+                    (lambda ()
+                      (imap:read-literal-progress-hook imail-progress-meter
+                        (lambda ()
+                          (imap:command:uid-fetch
+                           (imap-folder-connection (message-folder message))
+                           (imap-message-uid message)
+                           `(',(string-append
+                                "body["
+                                (decorated-string-append
+                                 "" "." ""
+                                 (map (lambda (x)
+                                        (if (exact-nonnegative-integer? x)
+                                            (number->string x)
+                                            (symbol->string x)))
+                                      section))
+                                "]"))))))))
+                 section
+                 #f)))
+           (set-imap-message-body-parts!
+            message
+            (cons (cons section part)
+                  (imap-message-body-parts message)))
+           part)))))
 \f
 (define (parse-mime-body body)
   (cond ((not (and (pair? body) (list? body))) (parse-mime-body:lose body))

diff --git a/v7/src/imail/todo.txt b/v7/src/imail/todo.txt
index f8e72a64d5e22dc139d669b25226e314a42b91cf..240f61c42a1801725a4e72d7b344c5d5055c8a14 100644 (file)
--- a/v7/src/imail/todo.txt
+++ b/v7/src/imail/todo.txt
@@ -1,5 +1,5 @@
 IMAIL To-Do List
-$Id: todo.txt,v 1.57 2000/06/05 13:28:19 cph Exp $
+$Id: todo.txt,v 1.58 2000/06/05 17:29:43 cph Exp $
 
 Bug fixes
 ---------
@@ -34,8 +34,6 @@ New features
 
 * Command to toggle the headers of a MIME message/rfc822 entity.
 
-* Caching of MIME BODY[] sections.
-
 * Need command to move to first unseen message in folder.
 
 * In M-x imail-copy-folder, default the target buffer to have the same