From: Chris Hanson <org/chris-hanson/cph>
Date: Fri, 20 May 2005 04:08:10 +0000 (+0000)
Subject: Implement URL:CHAR-SET:SCHEME and URL:PARSE:SCHEME.
X-Git-Tag: 20090517-FFI~1310
X-Git-Url: https://birchwood-abbey.net/git?a=commitdiff_plain;h=acb078e00904067ff354b00fb0fcc1e9a4d2fdf1;p=mit-scheme.git

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

diff --git a/v7/src/runtime/runtime.pkg b/v7/src/runtime/runtime.pkg
index 24798e4a6..e4cf6701c 100644
--- 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 00024a0f1..64785d179 100644
--- 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))
-
+
 (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)
-
-(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))))
+
+(define url:parse:scheme
+  (*parser
+   (map intern
+	(match (+ url:char-set:scheme)))))
+
 (define url:parse:hostport
   (*parser
    (seq (match url:match:host)