From: Chris Hanson <org/chris-hanson/cph>
Date: Fri, 28 Apr 2000 16:14:16 +0000 (+0000)
Subject: Define IMAP:RESPONSE:FETCH-ATTRIBUTE.
X-Git-Tag: 20090517-FFI~3972
X-Git-Url: https://birchwood-abbey.net/git?a=commitdiff_plain;h=aa40a478571e6b167ca847eef1ee90d5ecd417a6;p=mit-scheme.git

Define IMAP:RESPONSE:FETCH-ATTRIBUTE.
---

diff --git a/v7/src/imail/imail.pkg b/v7/src/imail/imail.pkg
index 27c19a033..68fd5f6e4 100644
--- a/v7/src/imail/imail.pkg
+++ b/v7/src/imail/imail.pkg
@@ -1,6 +1,6 @@
 ;;; -*-Scheme-*-
 ;;;
-;;; $Id: imail.pkg,v 1.21 2000/04/28 05:30:25 cph Exp $
+;;; $Id: imail.pkg,v 1.22 2000/04/28 16:14:15 cph Exp $
 ;;;
 ;;; Copyright (c) 2000 Massachusetts Institute of Technology
 ;;;
@@ -157,6 +157,7 @@
 	  imap:response:exists?
 	  imap:response:expunge-index
 	  imap:response:expunge?
+	  imap:response:fetch-attribute
 	  imap:response:fetch?
 	  imap:response:flags
 	  imap:response:flags?
diff --git a/v7/src/imail/imap-response.scm b/v7/src/imail/imap-response.scm
index 5d1f4dd21..df1be000d 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.7 2000/04/27 02:35:13 cph Exp $
+;;; $Id: imap-response.scm,v 1.8 2000/04/28 16:14:16 cph Exp $
 ;;;
 ;;; Copyright (c) 2000 Massachusetts Institute of Technology
 ;;;
@@ -479,6 +479,12 @@
 (define (imap:response:recent-count response)
   (cadr response))
 
+(define (imap:response:fetch-attribute response keyword)
+  (let ((entry (assq keyword (cdr response))))
+    (if (not entry)
+	(error "Missing FETCH attribute:" keyword))
+    (cadr entry)))
+
 (define (imap:response-code:alert? code) (eq? (car code) 'ALERT))
 (define (imap:response-code:newname? code) (eq? (car code) 'NEWNAME))
 (define (imap:response-code:parse? code) (eq? (car code) 'PARSE))