From: Chris Hanson <org/chris-hanson/cph>
Date: Thu, 9 Jan 2003 19:44:03 +0000 (+0000)
Subject: Move URL support back to the runtime system.
X-Git-Tag: 20090517-FFI~2069
X-Git-Url: https://birchwood-abbey.net/git?a=commitdiff_plain;h=4896fba7e8033d63b578676843c2b6240006a902;p=mit-scheme.git

Move URL support back to the runtime system.
---

diff --git a/v7/src/imail/compile.scm b/v7/src/imail/compile.scm
index e89ab2976..5f8bf9026 100644
--- a/v7/src/imail/compile.scm
+++ b/v7/src/imail/compile.scm
@@ -1,8 +1,8 @@
 ;;; -*-Scheme-*-
 ;;;
-;;; $Id: compile.scm,v 1.17 2002/11/20 19:46:05 cph Exp $
+;;; $Id: compile.scm,v 1.18 2003/01/09 19:43:10 cph Exp $
 ;;;
-;;; Copyright (c) 2000-2001 Massachusetts Institute of Technology
+;;; Copyright (c) 2000,2001,2003 Massachusetts Institute of Technology
 ;;;
 ;;; This file is part of MIT Scheme.
 ;;;
@@ -28,7 +28,6 @@
 (load-option '*PARSER)
 (with-working-directory-pathname (directory-pathname (current-load-pathname))
   (lambda ()
-    (compile-file "url" '() (->environment '(RUNTIME)))
     (for-each (lambda (filename)
 		(compile-file filename '() (->environment '(EDWIN))))
 	      '("imail-browser"
diff --git a/v7/src/imail/ed-ffi.scm b/v7/src/imail/ed-ffi.scm
index 2cab7fbe1..ccbf8b774 100644
--- a/v7/src/imail/ed-ffi.scm
+++ b/v7/src/imail/ed-ffi.scm
@@ -1,8 +1,8 @@
 ;;; -*-Scheme-*-
 ;;;
-;;; $Id: ed-ffi.scm,v 1.19 2002/11/20 19:46:05 cph Exp $
+;;; $Id: ed-ffi.scm,v 1.20 2003/01/09 19:43:17 cph Exp $
 ;;;
-;;; Copyright (c) 2000-2001 Massachusetts Institute of Technology
+;;; Copyright (c) 2000,2001,2003 Massachusetts Institute of Technology
 ;;;
 ;;; This file is part of MIT Scheme.
 ;;;
@@ -34,5 +34,4 @@
     ("imail-umail"	(edwin imail file-folder umail-folder))
     ("imail-util"	(edwin imail))
     ("imap-response"	(edwin imail imap-response))
-    ("imap-syntax"	(edwin imail imap-syntax))
-    ("url"		(runtime url))))
\ No newline at end of file
+    ("imap-syntax"	(edwin imail imap-syntax))))
\ No newline at end of file
diff --git a/v7/src/imail/imail.pkg b/v7/src/imail/imail.pkg
index 5a7e57b94..bee38ead4 100644
--- a/v7/src/imail/imail.pkg
+++ b/v7/src/imail/imail.pkg
@@ -1,6 +1,6 @@
 ;;; -*-Scheme-*-
 ;;;
-;;; $Id: imail.pkg,v 1.97 2002/11/20 19:46:06 cph Exp $
+;;; $Id: imail.pkg,v 1.98 2003/01/09 19:43:23 cph Exp $
 ;;;
 ;;; Copyright (c) 2000-2001 Massachusetts Institute of Technology
 ;;;
@@ -28,32 +28,6 @@
 (global-definitions "../edwin/edwin")
 (global-definitions "../star-parser/parser")
 
-(define-package (runtime url)
-  (files "url")
-  (parent (runtime))
-  (export ()
-	  url:char-set:escaped
-	  url:char-set:extra
-	  url:char-set:national
-	  url:char-set:punctuation
-	  url:char-set:reserved
-	  url:char-set:safe
-	  url:char-set:unescaped
-	  url:char-set:unreserved
-	  url:decode-string
-	  url:decode-substring
-	  url:encode-string
-	  url:encode-substring
-	  url:match:escape
-	  url:match:host
-	  url:match:hostname
-	  url:match:hostnumber
-	  url:match:uchar
-	  url:match:xchar
-	  url:parse:hostport
-	  url:string-encoded?
-	  url:substring-encoded?))
-
 (define-package (edwin imail)
   (files "imail-util"
 	 "imail-core")
diff --git a/v7/src/imail/url.scm b/v7/src/imail/url.scm
deleted file mode 100644
index 7a736ca3a..000000000
--- a/v7/src/imail/url.scm
+++ /dev/null
@@ -1,179 +0,0 @@
-#| -*-Scheme-*-
-
-$Id: url.scm,v 1.12 2002/11/20 19:46:06 cph Exp $
-
-Copyright (c) 2000, 2001 Massachusetts Institute of Technology
-
-This file is part of MIT Scheme.
-
-MIT Scheme is free software; you can redistribute it and/or modify it
-under the terms of the GNU General Public License as published by the
-Free Software Foundation; either version 2 of the License, or (at your
-option) any later version.
-
-MIT Scheme is distributed in the hope that it will be useful, but
-WITHOUT ANY WARRANTY; without even the implied warranty of
-MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
-General Public License for more details.
-
-You should have received a copy of the GNU General Public License
-along with MIT Scheme; if not, write to the Free Software Foundation,
-Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
-
-|#
-
-;;;; URL Encoding
-
-(declare (usual-integrations))
-
-(define url:char-set:safe (string->char-set "$-_.+"))
-(define url:char-set:extra (string->char-set "!*'(),"))
-(define url:char-set:national (string->char-set "{}|\\^~[]`"))
-(define url:char-set:punctuation (string->char-set "<>#%\""))
-(define url:char-set:reserved (string->char-set ";/?:@&="))
-(define url:char-set:hex (string->char-set "0123456789abcdefABCDEF"))
-
-(define url:char-set:unreserved
-  (char-set-union char-set:alphanumeric
-		  url:char-set:safe
-		  url:char-set:extra))
-
-(define url:char-set:unescaped
-  (char-set-union url:char-set:unreserved
-		  url:char-set:reserved))
-
-(define url:char-set:escaped
-  (char-set-invert url:char-set:unescaped))
-
-(define url:match:escape
-  (*matcher
-   (seq "%"
-	(char-set url:char-set:hex)
-	(char-set url:char-set:hex))))
-
-(define url:match:uchar
-  (*matcher
-   (alt (char-set url:char-set:unreserved)
-	url:match:escape)))
-
-(define url:match:xchar
-  (*matcher
-   (alt (char-set url:char-set:unescaped)
-	url:match:escape)))
-
-(define url:parse:hostport
-  (*parser
-   (seq (match url:match:host)
-	(alt (map string->number
-		  (seq (noise ":")
-		       (match (+ (char-set char-set:numeric)))))
-	     (values #f)))))
-
-(define url:match:host
-  (*matcher (alt url:match:hostname url:match:hostnumber)))
-
-(define url:match:hostname
-  (let ((match-tail
-	 (*matcher
-	  (* (alt (char-set char-set:alphanumeric)
-		  (seq (+ #\-)
-		       (char-set char-set:alphanumeric)))))))
-    (*matcher
-     (seq (* (seq (char-set char-set:alphanumeric)
-		  match-tail
-		  "."))
-	  (char-set char-set:alphabetic)
-	  match-tail))))
-
-(define url:match:hostnumber
-  (*matcher
-   (seq (+ (char-set char-set:numeric))
-	"."
-	(+ (char-set char-set:numeric))
-	"."
-	(+ (char-set char-set:numeric))
-	"."
-	(+ (char-set char-set:numeric)))))
-
-(define (url:string-encoded? string)
-  (url:substring-encoded? string 0 (string-length string)))
-
-(define url:substring-encoded?
-  (let ((matcher (*matcher (complete (* url:match:xchar)))))
-    (lambda (string start end)
-      (matcher (substring->parser-buffer string start end)))))
-
-(define (url:encode-string string)
-  (url:encode-substring string 0 (string-length string)))
-
-(define (url:encode-substring string start end)
-  (let ((n-to-encode
-	 (let loop ((start start) (n-to-encode 0))
-	   (let ((index
-		  (substring-find-next-char-in-set string start end
-						   url:char-set:escaped)))
-	     (if index
-		 (loop (fix:+ index 1) (fix:+ n-to-encode 1))
-		 n-to-encode)))))
-    (if (fix:= 0 n-to-encode)
-	(substring string start end)
-	(let ((encoded
-	       (make-string (fix:+ (fix:- end start) (fix:* 2 n-to-encode))))
-	      (digits "0123456789ABCDEF"))
-	  (let loop ((start start) (i 0))
-	    (let ((index
-		   (substring-find-next-char-in-set string start end
-						    url:char-set:escaped)))
-	      (if index
-		  (begin
-		    (substring-move! string start index encoded i)
-		    (let ((i (fix:+ i (fix:- index start)))
-			  (code (vector-8b-ref string index)))
-		      (string-set! encoded i #\%)
-		      (string-set! encoded
-				   (fix:+ i 1)
-				   (string-ref digits (fix:lsh code -4)))
-		      (string-set! encoded
-				   (fix:+ i 2)
-				   (string-ref digits (fix:and code #x0F)))
-		      (loop (fix:+ index 1) (fix:+ i 3))))
-		  (substring-move! string start end encoded i))))
-	  encoded))))
-
-(define (url:decode-string string)
-  (url:decode-substring string 0 (string-length string)))
-
-(define (url:decode-substring string start end)
-  (let ((n-encoded
-	 (let loop ((start start) (n-encoded 0))
-	   (let ((index (substring-find-next-char string start end #\%)))
-	     (if index
-		 (loop (fix:+ index 1) (fix:+ n-encoded 1))
-		 n-encoded))))
-	(lose
-	 (lambda ()
-	   (error "Malformed encoded URL string:"
-		  (substring string start end)))))
-    (if (fix:= 0 n-encoded)
-	(substring string start end)
-	(let ((decoded
-	       (make-string (fix:- (fix:- end start) (fix:* 2 n-encoded)))))
-	  (let loop ((start start) (i 0))
-	    (let ((index (substring-find-next-char string start end #\%)))
-	      (if index
-		  (begin
-		    (if (not (fix:<= (fix:+ index 3) end))
-			(lose))
-		    (let ((k
-			   (substring->number string
-					      (fix:+ index 1)
-					      (fix:+ index 3)
-					      16))
-			  (i* (fix:+ i (fix:- index start))))
-		      (if (not k)
-			  (lose))
-		      (substring-move! string start index decoded i)
-		      (vector-8b-set! decoded i* k)
-		      (loop (fix:+ index 3) (fix:+ i* 1))))
-		  (substring-move! string start end decoded i))))
-	  decoded))))
\ No newline at end of file
diff --git a/v7/src/runtime/ed-ffi.scm b/v7/src/runtime/ed-ffi.scm
index 7ec391f43..0ac5b150b 100644
--- a/v7/src/runtime/ed-ffi.scm
+++ b/v7/src/runtime/ed-ffi.scm
@@ -1,8 +1,9 @@
 #| -*- Scheme -*-
 
-$Id: ed-ffi.scm,v 1.33 2002/11/20 19:46:19 cph Exp $
+$Id: ed-ffi.scm,v 1.34 2003/01/09 19:36:43 cph Exp $
 
-Copyright (c) 1988-2002 Massachusetts Institute of Technology
+Copyright (c) 1991,1996,1997,1999,2000 Massachusetts Institute of Technology
+Copyright (c) 2001,2002,2003 Massachusetts Institute of Technology
 
 This file is part of MIT Scheme.
 
@@ -164,6 +165,7 @@ Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
     ("unxprm"	(runtime os-primitives))
     ("unxpth"	(runtime pathname unix))
     ("uproc"	(runtime procedure))
+    ("url"	(runtime url))
     ("urtrap"	(runtime reference-trap))
     ("usrint"	(runtime user-interface))
     ("utabs"	(runtime microcode-tables))
diff --git a/v7/src/runtime/make.scm b/v7/src/runtime/make.scm
index f80f8409d..e7f09b84e 100644
--- a/v7/src/runtime/make.scm
+++ b/v7/src/runtime/make.scm
@@ -1,8 +1,10 @@
 #| -*-Scheme-*-
 
-$Id: make.scm,v 14.87 2002/11/20 19:46:21 cph Exp $
+$Id: make.scm,v 14.88 2003/01/09 19:40:16 cph Exp $
 
-Copyright (c) 1988-2002 Massachusetts Institute of Technology
+Copyright (c) 1988,1989,1990,1991,1992 Massachusetts Institute of Technology
+Copyright (c) 1993,1994,1995,1996,1997 Massachusetts Institute of Technology
+Copyright (c) 1998,2000,2001,2002,2003 Massachusetts Institute of Technology
 
 This file is part of MIT Scheme.
 
@@ -515,7 +517,8 @@ Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
    ;; Emacs -- last because it installs hooks everywhere which must be initted.
    (RUNTIME EMACS-INTERFACE)
    ;; More debugging
-   ((RUNTIME CONTINUATION-PARSER) INITIALIZE-SPECIAL-FRAMES! #f)))
+   ((RUNTIME CONTINUATION-PARSER) INITIALIZE-SPECIAL-FRAMES! #f)
+   (RUNTIME URL)))
 
 (let ((obj (file->object "site" #t #t)))
   (if obj
diff --git a/v7/src/runtime/runtime.pkg b/v7/src/runtime/runtime.pkg
index 7b43ebc38..d7c15e767 100644
--- a/v7/src/runtime/runtime.pkg
+++ b/v7/src/runtime/runtime.pkg
@@ -1,6 +1,6 @@
 #| -*-Scheme-*-
 
-$Id: runtime.pkg,v 14.421 2003/01/03 01:37:45 cph Exp $
+$Id: runtime.pkg,v 14.422 2003/01/09 19:36:50 cph Exp $
 
 Copyright (c) 1988,1989,1990,1991,1992 Massachusetts Institute of Technology
 Copyright (c) 1993,1994,1995,1996,1997 Massachusetts Institute of Technology
@@ -4468,4 +4468,30 @@ Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
 	  unicode-code-point?
 	  utf8-string->code-point
 	  well-formed-code-points-list?
-	  write-utf8-code-point))
\ No newline at end of file
+	  write-utf8-code-point))
+
+(define-package (runtime url)
+  (files "url")
+  (parent (runtime))
+  (export ()
+	  url:char-set:escaped
+	  url:char-set:extra
+	  url:char-set:national
+	  url:char-set:punctuation
+	  url:char-set:reserved
+	  url:char-set:safe
+	  url:char-set:unescaped
+	  url:char-set:unreserved
+	  url:decode-string
+	  url:decode-substring
+	  url:encode-string
+	  url:encode-substring
+	  url:match:escape
+	  url:match:host
+	  url:match:hostname
+	  url:match:hostnumber
+	  url:match:uchar
+	  url:match:xchar
+	  url:parse:hostport
+	  url:string-encoded?
+	  url:substring-encoded?))
\ No newline at end of file
diff --git a/v7/src/runtime/runtime.sf b/v7/src/runtime/runtime.sf
index a01e333cc..51085858a 100644
--- a/v7/src/runtime/runtime.sf
+++ b/v7/src/runtime/runtime.sf
@@ -1,8 +1,9 @@
 #| -*-Scheme-*-
 
-$Id: runtime.sf,v 14.18 2002/11/20 19:46:22 cph Exp $
+$Id: runtime.sf,v 14.19 2003/01/09 19:36:56 cph Exp $
 
-Copyright (c) 1988-2001 Massachusetts Institute of Technology
+Copyright (c) 1988,1989,1990,1991,1992 Massachusetts Institute of Technology
+Copyright (c) 1994,1995,1996,2001,2003 Massachusetts Institute of Technology
 
 This file is part of MIT Scheme.
 
@@ -22,6 +23,7 @@ Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
 
 |#
 
+(load-option '*PARSER)			;for url.scm
 (fluid-let ((sf/default-syntax-table (->environment '(RUNTIME))))
   (sf-conditionally "char")
   (sf-conditionally "chrset")
diff --git a/v7/src/runtime/url.scm b/v7/src/runtime/url.scm
index 8e972af9a..aa533f76b 100644
--- a/v7/src/runtime/url.scm
+++ b/v7/src/runtime/url.scm
@@ -1,6 +1,6 @@
 #| -*-Scheme-*-
 
-$Id: url.scm,v 1.12 2003/01/09 19:23:54 cph Exp $
+$Id: url.scm,v 1.13 2003/01/09 19:37:03 cph Exp $
 
 Copyright (c) 2000, 2001, 2003 Massachusetts Institute of Technology
 
@@ -26,24 +26,33 @@ Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
 
 (declare (usual-integrations))
 
-(define url:char-set:safe (string->char-set "$-_.+"))
-(define url:char-set:extra (string->char-set "!*'(),"))
-(define url:char-set:national (string->char-set "{}|\\^~[]`"))
-(define url:char-set:punctuation (string->char-set "<>#%\""))
-(define url:char-set:reserved (string->char-set ";/?:@&="))
-(define url:char-set:hex (string->char-set "0123456789abcdefABCDEF"))
-
-(define url:char-set:unreserved
-  (char-set-union char-set:alphanumeric
-		  url:char-set:safe
-		  url:char-set:extra))
-
-(define url:char-set:unescaped
-  (char-set-union url:char-set:unreserved
-		  url:char-set:reserved))
-
-(define url:char-set:escaped
-  (char-set-invert url:char-set:unescaped))
+(define url:char-set:safe)
+(define url:char-set:extra)
+(define url:char-set:national)
+(define url:char-set:punctuation)
+(define url:char-set:reserved)
+(define url:char-set:hex)
+(define url:char-set:unreserved)
+(define url:char-set:unescaped)
+(define url:char-set:escaped)
+
+(define (initialize-package!)
+  (set! url:char-set:safe (string->char-set "$-_.+"))
+  (set! url:char-set:extra (string->char-set "!*'(),"))
+  (set! url:char-set:national (string->char-set "{}|\\^~[]`"))
+  (set! url:char-set:punctuation (string->char-set "<>#%\""))
+  (set! url:char-set:reserved (string->char-set ";/?:@&="))
+  (set! url:char-set:hex (string->char-set "0123456789abcdefABCDEF"))
+  (set! url:char-set:unreserved
+	(char-set-union char-set:alphanumeric
+			url:char-set:safe
+			url:char-set:extra))
+  (set! url:char-set:unescaped
+	(char-set-union url:char-set:unreserved
+			url:char-set:reserved))
+  (set! url:char-set:escaped
+	(char-set-invert url:char-set:unescaped))
+  unspecific)
 
 (define url:match:escape
   (*matcher