From: Chris Hanson <org/chris-hanson/cph>
Date: Thu, 1 Jun 2000 18:46:59 +0000 (+0000)
Subject: Implement MESSAGE-MIME-BODY-PART.
X-Git-Tag: 20090517-FFI~3646
X-Git-Url: https://birchwood-abbey.net/git?a=commitdiff_plain;h=b6574b15ce05cfeb49b88263b9228983c953e094;p=mit-scheme.git

Implement MESSAGE-MIME-BODY-PART.
---

diff --git a/v7/src/imail/imail-core.scm b/v7/src/imail/imail-core.scm
index 0cb0cbf62..48be09e20 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.92 2000/06/01 05:10:09 cph Exp $
+;;; $Id: imail-core.scm,v 1.93 2000/06/01 18:46:44 cph Exp $
 ;;;
 ;;; Copyright (c) 1999-2000 Massachusetts Institute of Technology
 ;;;
@@ -808,6 +808,7 @@
 ;;;; MIME structure
 
 (define-generic message-mime-body-structure (message))
+(define-generic message-mime-body-part (message selector))
 
 (define-class <mime-body> ()
   (parameters define accessor)
diff --git a/v7/src/imail/imail-imap.scm b/v7/src/imail/imail-imap.scm
index bf88bd760..aca834309 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.96 2000/06/01 05:10:16 cph Exp $
+;;; $Id: imail-imap.scm,v 1.97 2000/06/01 18:46:59 cph Exp $
 ;;;
 ;;; Copyright (c) 1999-2000 Massachusetts Institute of Technology
 ;;;
@@ -777,6 +777,19 @@
 (define-method message-mime-body-structure ((message <imap-message>))
   (parse-mime-body (imap-message-bodystructure message)))
 
+(define-method message-mime-body-part ((message <imap-message>) selector)
+  (let ((section (map (lambda (n) (+ n 1)) selector)))
+    (imap:response:fetch-body-part
+     (imap:command:uid-fetch
+      (imap-folder-connection (message-folder message))
+      (imap-message-uid message)
+      `(',(string-append "body["
+			 (decorated-string-append
+			  "" "." "" (map number->string section))
+			 "]")))
+     section
+     #f)))
+
 (define (parse-mime-body body)
   (cond ((not (and (pair? body) (list? body))) (parse-mime-body:lose body))
 	((string? (car body)) (parse-mime-body:one-part body))