From d47615d5a4f33671730a2d7cb89974d3110961a2 Mon Sep 17 00:00:00 2001
From: Chris Hanson <org/chris-hanson/cph>
Date: Thu, 1 Jun 2000 18:44:41 +0000
Subject: [PATCH] Implement IMAP:RESPONSE:FETCH-BODY-PART.

---
 v7/src/imail/imail.pkg         |  3 ++-
 v7/src/imail/imap-response.scm | 20 ++++++++++++++++++--
 2 files changed, 20 insertions(+), 3 deletions(-)

diff --git a/v7/src/imail/imail.pkg b/v7/src/imail/imail.pkg
index 6c637fd83..41d258c46 100644
--- a/v7/src/imail/imail.pkg
+++ b/v7/src/imail/imail.pkg
@@ -1,6 +1,6 @@
 ;;; -*-Scheme-*-
 ;;;
-;;; $Id: imail.pkg,v 1.41 2000/06/01 18:23:58 cph Exp $
+;;; $Id: imail.pkg,v 1.42 2000/06/01 18:44:41 cph Exp $
 ;;;
 ;;; Copyright (c) 2000 Massachusetts Institute of Technology
 ;;;
@@ -191,6 +191,7 @@
 	  imap:response:expunge?
 	  imap:response:fetch-attribute
 	  imap:response:fetch-attribute-keywords
+	  imap:response:fetch-body-part
 	  imap:response:fetch-index
 	  imap:response:fetch?
 	  imap:response:flags
diff --git a/v7/src/imail/imap-response.scm b/v7/src/imail/imap-response.scm
index d0581a84a..761e154aa 100644
--- a/v7/src/imail/imap-response.scm
+++ b/v7/src/imail/imap-response.scm
@@ -1,6 +1,6 @@
 ;;; -*-Scheme-*-
 ;;;
-;;; $Id: imap-response.scm,v 1.31 2000/05/30 04:02:27 cph Exp $
+;;; $Id: imap-response.scm,v 1.32 2000/06/01 18:44:35 cph Exp $
 ;;;
 ;;; Copyright (c) 2000 Massachusetts Institute of Technology
 ;;;
@@ -632,7 +632,7 @@
     ((BAD NO OK) (cddr response))
     ((PREAUTH BYE) (cdr response))
     (else (error:bad-range-argument response 'IMAP:RESPONSE:RESPONSE-TEXT))))
-
+
 (define (imap:response:fetch-attribute-keywords response)
   (map car (cddr response)))
 
@@ -642,6 +642,22 @@
 	(error "Missing FETCH attribute:" keyword))
     (cadr entry)))
 
+(define (imap:response:fetch-body-part response section offset)
+  (let ((entry
+	 (list-search-positive (cddr response)
+	   (lambda (entry)
+	     (and (eq? (car entry) 'BODY)
+		  (equal? (cadr entry) section)
+		  (pair? (cddr entry))
+		  (eqv? offset (caddr entry))
+		  (pair? (cdddr entry))
+		  (or (not (cadddr entry))
+		      (string? (cadddr entry)))
+		  (null? (cddddr entry)))))))
+    (if (not entry)
+	(error "Missing FETCH body part:" section offset))
+    (cadddr entry)))
+
 (define (imap:response-code:alert? code) (eq? (car code) 'ALERT))
 (define (imap:response-code:appenduid? code) (eq? (car code) 'APPENDUID))
 (define (imap:response-code:badcharset? code) (eq? (car code) 'BADCHARSET))
-- 
2.25.1