From aa40a478571e6b167ca847eef1ee90d5ecd417a6 Mon Sep 17 00:00:00 2001
From: Chris Hanson <org/chris-hanson/cph>
Date: Fri, 28 Apr 2000 16:14:16 +0000
Subject: [PATCH] Define IMAP:RESPONSE:FETCH-ATTRIBUTE.

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

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))
-- 
2.25.1