From: Chris Hanson <org/chris-hanson/cph>
Date: Mon, 5 Nov 2001 21:24:54 +0000 (+0000)
Subject: Move URL support back to IMAIL from the runtime system.
X-Git-Tag: 20090517-FFI~2461
X-Git-Url: https://birchwood-abbey.net/git?a=commitdiff_plain;h=16934fdc77dbf8f9ef89ffe8da28d875edecfb50;p=mit-scheme.git

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

diff --git a/v7/src/imail/compile.scm b/v7/src/imail/compile.scm
index 51f666ebd..4fbef584f 100644
--- a/v7/src/imail/compile.scm
+++ b/v7/src/imail/compile.scm
@@ -1,6 +1,6 @@
 ;;; -*-Scheme-*-
 ;;;
-;;; $Id: compile.scm,v 1.14 2001/10/10 04:26:21 cph Exp $
+;;; $Id: compile.scm,v 1.15 2001/11/05 21:23:58 cph Exp $
 ;;;
 ;;; Copyright (c) 2000-2001 Massachusetts Institute of Technology
 ;;;
@@ -34,7 +34,8 @@
 		"imail-umail"
 		"imail-util"
 		"imap-response"
-		"imap-syntax"))
+		"imap-syntax"
+		"url"))
     (for-each (let ((syntax-table
 		     (access edwin-syntax-table (->environment '(EDWIN)))))
 		(lambda (filename)
diff --git a/v7/src/imail/ed-ffi.scm b/v7/src/imail/ed-ffi.scm
index eb49a7956..dd5cfe632 100644
--- a/v7/src/imail/ed-ffi.scm
+++ b/v7/src/imail/ed-ffi.scm
@@ -1,6 +1,6 @@
 ;;; -*-Scheme-*-
 ;;;
-;;; $Id: ed-ffi.scm,v 1.16 2001/10/10 04:27:31 cph Exp $
+;;; $Id: ed-ffi.scm,v 1.17 2001/11/05 21:20:20 cph Exp $
 ;;;
 ;;; Copyright (c) 2000-2001 Massachusetts Institute of Technology
 ;;;
@@ -43,4 +43,6 @@
     ("imap-response"	(edwin imail imap-response)
 			system-global-syntax-table)
     ("imap-syntax"	(edwin imail imap-syntax)
+			system-global-syntax-table)
+    ("url"		(runtime url)
 			system-global-syntax-table)))
\ No newline at end of file
diff --git a/v7/src/imail/imail.pkg b/v7/src/imail/imail.pkg
index 326052a6b..4ca1c0760 100644
--- a/v7/src/imail/imail.pkg
+++ b/v7/src/imail/imail.pkg
@@ -1,6 +1,6 @@
 ;;; -*-Scheme-*-
 ;;;
-;;; $Id: imail.pkg,v 1.91 2001/11/05 21:19:37 cph Exp $
+;;; $Id: imail.pkg,v 1.92 2001/11/05 21:21:12 cph Exp $
 ;;;
 ;;; Copyright (c) 2000-2001 Massachusetts Institute of Technology
 ;;;
@@ -27,9 +27,7 @@
 (global-definitions "../star-parser/parser")
 
 (define-package (runtime url)
-  (file-case options
-    ((load) "url")
-    (else))
+  (files "url")
   (parent ())
   (export ()
 	  url:char-set:escaped
diff --git a/v7/src/imail/load.scm b/v7/src/imail/load.scm
index ef010f23d..f1162cf29 100644
--- a/v7/src/imail/load.scm
+++ b/v7/src/imail/load.scm
@@ -1,6 +1,6 @@
 ;;; -*-Scheme-*-
 ;;;
-;;; $Id: load.scm,v 1.33 2001/10/10 04:27:10 cph Exp $
+;;; $Id: load.scm,v 1.34 2001/11/05 21:21:16 cph Exp $
 ;;;
 ;;; Copyright (c) 1999-2001 Massachusetts Institute of Technology
 ;;;
@@ -24,9 +24,8 @@
 (load-option 'HASH-TABLE)
 (load-option 'REGULAR-EXPRESSION)
 (load-option 'SOS)
-(load-option 'URL)
 (with-working-directory-pathname (directory-pathname (current-load-pathname))
   (lambda ()
     (fluid-let ((*allow-package-redefinition?* #t))
       (load-package-set "imail"))))
-(add-subsystem-identification! "IMAIL" '(1 15))
\ No newline at end of file
+(add-subsystem-identification! "IMAIL" '(1 16))
\ No newline at end of file
diff --git a/v7/src/runtime/ed-ffi.scm b/v7/src/runtime/ed-ffi.scm
index 091a38672..9f0f28c8e 100644
--- a/v7/src/runtime/ed-ffi.scm
+++ b/v7/src/runtime/ed-ffi.scm
@@ -1,6 +1,6 @@
 #| -*- Scheme -*-
 
-$Id: ed-ffi.scm,v 1.27 2001/10/05 15:58:12 cph Exp $
+$Id: ed-ffi.scm,v 1.28 2001/11/05 21:24:26 cph Exp $
 
 Copyright (c) 1988-2001 Massachusetts Institute of Technology
 
@@ -296,8 +296,6 @@ USA.
 		syntax-table/system-internal)
     ("uproc"	(runtime procedure)
 		syntax-table/system-internal)
-    ("url"	(runtime url)
-		syntax-table/system-internal)
     ("urtrap"	(runtime reference-trap)
 		syntax-table/system-internal)
     ("usrint"	(runtime user-interface)
diff --git a/v7/src/runtime/optiondb.scm b/v7/src/runtime/optiondb.scm
index 58df5448d..4c3f44d9b 100644
--- a/v7/src/runtime/optiondb.scm
+++ b/v7/src/runtime/optiondb.scm
@@ -1,6 +1,6 @@
 #| -*-Scheme-*-
 
-$Id: optiondb.scm,v 1.12 2001/10/09 17:52:00 cph Exp $
+$Id: optiondb.scm,v 1.13 2001/11/05 21:22:01 cph Exp $
 
 Copyright (c) 1994-2001 Massachusetts Institute of Technology
 
@@ -71,7 +71,6 @@ USA.
    (STEPPER	(RUNTIME STEPPER)	#F			"ystep")
    (SUBPROCESS	(RUNTIME SUBPROCESS)	(INITIALIZE-PACKAGE!)	"process")
    (SYNCHRONOUS-SUBPROCESS (RUNTIME SYNCHRONOUS-SUBPROCESS) #F	"syncproc")
-   (URL		(RUNTIME URL)		#F			"url")
    (WT-TREE	(RUNTIME WT-TREE)	#F			"wttree")
    ))
 
diff --git a/v7/src/runtime/runtime.pkg b/v7/src/runtime/runtime.pkg
index bcab6b134..26b8837c5 100644
--- a/v7/src/runtime/runtime.pkg
+++ b/v7/src/runtime/runtime.pkg
@@ -1,6 +1,6 @@
 #| -*-Scheme-*-
 
-$Id: runtime.pkg,v 14.380 2001/11/02 03:28:09 cph Exp $
+$Id: runtime.pkg,v 14.381 2001/11/05 21:24:29 cph Exp $
 
 Copyright (c) 1988-2001 Massachusetts Institute of Technology
 
@@ -3757,32 +3757,4 @@ Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA
 	  encode-quoted-printable:update
 	  make-decode-base64-port
 	  make-decode-binhex40-port
-	  make-decode-quoted-printable-port))
-
-(define-package (runtime url)
-  (file-case options
-    ((load) "url")
-    (else))
-  (parent ())
-  (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
+	  make-decode-quoted-printable-port))
\ No newline at end of file
diff --git a/v7/src/runtime/url.scm b/v7/src/runtime/url.scm
deleted file mode 100644
index 12c2f0f7d..000000000
--- a/v7/src/runtime/url.scm
+++ /dev/null
@@ -1,178 +0,0 @@
-#| -*-Scheme-*-
-
-$Id: url.scm,v 1.10 2001/10/10 04:52:12 cph Exp $
-
-Copyright (c) 2000, 2001 Massachusetts Institute of Technology
-
-This program 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.
-
-This program 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 this program; if not, write to the Free Software
-Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307,
-USA.
-|#
-
-;;;; URL Encoding
-
-(declare (usual-integrations))
-(load-option '*PARSER)
-
-(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/version.scm b/v7/src/runtime/version.scm
index 465ccc07c..d46c526a1 100644
--- a/v7/src/runtime/version.scm
+++ b/v7/src/runtime/version.scm
@@ -1,6 +1,6 @@
 #| -*-Scheme-*-
 
-$Id: version.scm,v 14.200 2001/08/15 02:57:00 cph Exp $
+$Id: version.scm,v 14.201 2001/11/05 21:24:54 cph Exp $
 
 Copyright (c) 1988-2001 Massachusetts Institute of Technology
 
@@ -29,7 +29,7 @@ Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA
   (add-subsystem-identification! "Release" '(7 5 18 "pre"))
   (snarf-microcode-version!)
   (add-event-receiver! event:after-restore snarf-microcode-version!)
-  (add-subsystem-identification! "Runtime" '(14 191)))
+  (add-subsystem-identification! "Runtime" '(14 192)))
 
 (define (snarf-microcode-version!)
   (add-subsystem-identification! "Microcode"