Change code that handles sections to implement a parser rather than a
authorChris Hanson <org/chris-hanson/cph>
Sat, 22 Apr 2000 05:06:24 +0000 (05:06 +0000)
committerChris Hanson <org/chris-hanson/cph>
Sat, 22 Apr 2000 05:06:24 +0000 (05:06 +0000)
matcher.  Change usages of DECODING-PARSER to match new definition.

v7/src/imail/imap-syntax.scm

index 7dc4a361026fa7ffa3d65272b19452d407046240..11765dd4acd86d682b3c0149a2f26976f6e7dac2 100644 (file)
@@ -1,6 +1,6 @@
 ;;; -*-Scheme-*-
 ;;;
-;;; $Id: imap-syntax.scm,v 1.2 2000/04/22 01:53:48 cph Exp $
+;;; $Id: imap-syntax.scm,v 1.3 2000/04/22 05:06:24 cph Exp $
 ;;;
 ;;; Copyright (c) 2000 Massachusetts Institute of Technology
 ;;;
                                            date-text
                                            (string-matcher "\"")))))
 
-(define imap:match:section-text
-  (alternatives-matcher
-   (ci-string-matcher "header")
-   (sequence-matcher (ci-string-matcher "header.fields")
-                    (optional-matcher (ci-string-matcher ".not"))
-                    (string-matcher " ")
-                    (string-matcher "(")
-                    (+-matcher imap:match:astring)
-                    (string-matcher ")"))
-   (ci-string-matcher "text")))
-
-(define imap:match:section
-  (alternatives-matcher
-   imap:match:section-text
-   (sequence-matcher imap:match:nz-number
-                    (*-matcher (string-matcher ".")
-                               imap:match:nz-number)
-                    (optional-matcher (string-matcher ".")
-                                      (alternatives-matcher
-                                       imap:match:section-text
-                                       (ci-string-matcher "mime"))))))
-
-(define (url:decoding-parser match-encoded match-decoded keyword)
-  (decoding-parser match-encoded url:decode-substring match-decoded keyword))
+(define imap:parse:section-text
+  (alternatives-parser
+   (simple-parser (alternatives-matcher
+                  (ci-string-matcher "header")
+                  (ci-string-matcher "text"))
+                 'KEYWORD)
+   (sequence-parser
+    (simple-parser (sequence-matcher
+                   (ci-string-matcher "header.fields")
+                   (optional-matcher
+                    (ci-string-matcher ".not")))
+                  'KEYWORD)
+    (noise-parser (string-matcher " ("))
+    (list-parser imap:match:astring (string-matcher " ") 'HEADERS)
+    (noise-parser (string-matcher ")")))))
+
+(define imap:parse:section
+  (encapsulating-parser
+   (alternatives-parser
+    imap:parse:section-text
+    (sequence-parser
+     (list-parser imap:match:nz-number (string-matcher ".") 'NUMBER)
+     (optional-parser
+      (noise-parser (string-matcher "."))
+      (alternatives-parser
+       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) '()))
+          string->number
+          (or (parser-token pv 'NUMBER) '())))
+   'SECTION))
 \f
 (define imap:match:set
   (let ((range
                     (string-matcher " "))
    imap:match:search-key))
 \f
+;;;; URL parser
+
+(define (url:decoding-parser match-encoded match-decoded keyword)
+  (decoding-parser match-encoded
+                  url:decode-substring
+                  (simple-parser match-decoded keyword)))
+
 (define imap:parse:server
   (sequence-parser
    (optional-parser
    (optional-parser
     (noise-parser (string-matcher ":"))
     (simple-parser (rexp-matcher (rexp+ char-set:numeric)) 'PORT))))
-
+\f
 (define imap:parse:mailboxlist
   (sequence-parser
    (optional-parser
                   (simple-parser imap:match:nz-number 'UID)
                   (optional-parser
                    (noise-parser (ci-string-matcher "/;section="))
-                   (url:decoding-parser imap:match:bchar+
-                                        imap:match:section
-                                        'SECTION))))
+                   (decoding-parser imap:match:bchar+
+                                    url:decode-substring
+                                    imap:parse:section))))
 
 (define imap:parse:simple-message
   (sequence-parser imap:parse:enc-mailbox