Implement URL:CHAR-SET:SCHEME and URL:PARSE:SCHEME.

diff --git a/v7/src/runtime/runtime.pkg b/v7/src/runtime/runtime.pkg
index 24798e4a62262785003bee75b5536990f3e6e879..e4cf6701ca30ab31a01ad1c879cd24c541820809 100644 (file)
--- a/v7/src/runtime/runtime.pkg
+++ b/v7/src/runtime/runtime.pkg
@@ -1,6 +1,6 @@
 #| -*-Scheme-*-
 
-$Id: runtime.pkg,v 14.542 2005/05/17 05:22:44 cph Exp $
+$Id: runtime.pkg,v 14.543 2005/05/20 04:08:10 cph Exp $
 
 Copyright 1988,1989,1990,1991,1992,1993 Massachusetts Institute of Technology
 Copyright 1994,1995,1996,1997,1998,1999 Massachusetts Institute of Technology
@@ -4737,6 +4737,7 @@ USA.
          url:char-set:punctuation
          url:char-set:reserved
          url:char-set:safe
+         url:char-set:scheme
          url:char-set:unescaped
          url:char-set:unreserved
          url:decode-string
@@ -4750,6 +4751,7 @@ USA.
          url:match:uchar
          url:match:xchar
          url:parse:hostport
+         url:parse:scheme
          url:string-encoded?
          url:substring-encoded?))
 

diff --git a/v7/src/runtime/url.scm b/v7/src/runtime/url.scm
index 00024a0f14c7feabc75062649427704bb28ffc3e..64785d179961ae872b781053c068e2cf30f43614 100644 (file)
--- a/v7/src/runtime/url.scm
+++ b/v7/src/runtime/url.scm
@@ -1,6 +1,6 @@
 #| -*-Scheme-*-
 
-$Id: url.scm,v 1.16 2005/05/17 05:22:51 cph Exp $
+$Id: url.scm,v 1.17 2005/05/20 04:07:54 cph Exp $
 
 Copyright 2000,2001,2003,2004,2005 Massachusetts Institute of Technology
 
@@ -26,11 +26,12 @@ USA.
 ;;;; URL Encoding
 
 (declare (usual-integrations))
-
+\f
 (define url:char-set:lowalpha)
 (define url:char-set:alpha)
 (define url:char-set:digit)
 (define url:char-set:alphadigit)
+(define url:char-set:scheme)
 (define url:char-set:safe)
 (define url:char-set:extra)
 (define url:char-set:national)
@@ -49,6 +50,8 @@ USA.
   (set! url:char-set:digit (string->char-set "0123456789"))
   (set! url:char-set:alphadigit
        (char-set-union url:char-set:alpha url:char-set:digit))
+  (set! url:char-set:scheme
+       (char-set-union url:char-set:alphadigit (string->char-set "+-.")))
   (set! url:char-set:safe (string->char-set "$-_.+"))
   (set! url:char-set:extra (string->char-set "!*'(),"))
   (set! url:char-set:national (string->char-set "{}|\\^~[]`"))
@@ -65,12 +68,6 @@ USA.
   (set! url:char-set:escaped
        (char-set-invert url:char-set:unescaped))
   unspecific)
-\f
-(define url:match:escape
-  (*matcher
-   (seq "%"
-       (char-set url:char-set:hex)
-       (char-set url:char-set:hex))))
 
 (define url:match:uchar
   (*matcher
@@ -82,6 +79,17 @@ USA.
    (alt (char-set url:char-set:unescaped)
        url:match:escape)))
 
+(define url:match:escape
+  (*matcher
+   (seq "%"
+       (char-set url:char-set:hex)
+       (char-set url:char-set:hex))))
+\f
+(define url:parse:scheme
+  (*parser
+   (map intern
+       (match (+ url:char-set:scheme)))))
+
 (define url:parse:hostport
   (*parser
    (seq (match url:match:host)