From: Chris Hanson <org/chris-hanson/cph>
Date: Sun, 23 Apr 2000 00:40:34 +0000 (+0000)
Subject: Implement PREDICATED-PARSER.
X-Git-Tag: 20090517-FFI~3987
X-Git-Url: https://birchwood-abbey.net/git?a=commitdiff_plain;h=9df68918cba159b8ea1a85e01ba0bd177885c4be;p=mit-scheme.git

Implement PREDICATED-PARSER.
---

diff --git a/v7/src/imail/imail.pkg b/v7/src/imail/imail.pkg
index 574174b0f..2e43c4c7e 100644
--- a/v7/src/imail/imail.pkg
+++ b/v7/src/imail/imail.pkg
@@ -1,6 +1,6 @@
 ;;; -*-Scheme-*-
 ;;;
-;;; $Id: imail.pkg,v 1.17 2000/04/22 05:07:23 cph Exp $
+;;; $Id: imail.pkg,v 1.18 2000/04/23 00:40:29 cph Exp $
 ;;;
 ;;; Copyright (c) 2000 Massachusetts Institute of Technology
 ;;;
@@ -74,6 +74,7 @@
 	  parse-string
 	  parse-substring
 	  parser-token
+	  predicated-parser
 	  rexp-matcher
 	  sequence-matcher
 	  sequence-parser
diff --git a/v7/src/imail/imap-syntax.scm b/v7/src/imail/imap-syntax.scm
index 11765dd4a..6b172ddda 100644
--- a/v7/src/imail/imap-syntax.scm
+++ b/v7/src/imail/imap-syntax.scm
@@ -1,6 +1,6 @@
 ;;; -*-Scheme-*-
 ;;;
-;;; $Id: imap-syntax.scm,v 1.3 2000/04/22 05:06:24 cph Exp $
+;;; $Id: imap-syntax.scm,v 1.4 2000/04/23 00:40:34 cph Exp $
 ;;;
 ;;; Copyright (c) 2000 Massachusetts Institute of Technology
 ;;;
@@ -175,7 +175,10 @@
 		     (ci-string-matcher ".not")))
 		   'KEYWORD)
     (noise-parser (string-matcher " ("))
-    (list-parser imap:match:astring (string-matcher " ") 'HEADERS)
+    (predicated-parser (list-parser imap:match:astring
+				    (string-matcher " ")
+				    'HEADERS)
+		       (lambda (pv) (pair? (parser-token pv 'HEADERS))))
     (noise-parser (string-matcher ")")))))
 
 (define imap:parse:section
@@ -190,10 +193,11 @@
        imap:parse:section-text
        (simple-parser (ci-string-matcher "mime") 'KEYWORD)))))
    (lambda (pv)
-     (map* (cons (let ((keyword (parser-token pv 'KEYWORD)))
-		   (and keyword
-			(intern keyword)))
-		 (or (parser-token pv 'HEADERS) '()))
+     (map* (let ((keyword (parser-token pv 'KEYWORD)))
+	     (if keyword
+		 (cons (intern keyword)
+		       (or (parser-token pv 'HEADERS) '()))
+		 '()))
 	   string->number
 	   (or (parser-token pv 'NUMBER) '())))
    'SECTION))