From c48446ba7f3a4328622c6a34688578d3213f6052 Mon Sep 17 00:00:00 2001
From: vibr <vibr>
Date: Mon, 18 Oct 2004 16:37:32 +0000
Subject: [PATCH] *remove ESCAPE-URI (didn't reliably differentiate between
 different portions of a URI) *move INT->HEXCHAR to url.scm

---
 scheme/lib/uri.scm | 107 ---------------------------------------------
 1 file changed, 107 deletions(-)

diff --git a/scheme/lib/uri.scm b/scheme/lib/uri.scm
index a76ebdd..4ec9834 100644
--- a/scheme/lib/uri.scm
+++ b/scheme/lib/uri.scm
@@ -5,110 +5,3 @@
 ;;; Copyright (c) 1995 by Olin Shivers.
 ;;; For copyright information, see the file COPYING which comes with
 ;;; the distribution.
-
-;;; URI syntax -- [scheme] : path [? search ] [# fragmentid]
-
-;;; References:
-;;; - http://www.w3.org/Addressing/rfc1630.txt
-;;;   Original RFC
-;;; - http://www.w3.org/hypertext/WWW/Addressing/URL/URI_Overview.html
-;;;   General Web page of URI pointers.	
-
-
-(define int->hexchar
-  (let ((table '#(#\0 #\1 #\2 #\3 #\4 #\5 #\6 #\7 #\8 #\9
-		  #\A #\B #\C #\D #\E #\F)))
-    (lambda (i) (vector-ref table i))))
-  
-
-;;; Caution:
-;;; All reserved chars (e.g., slash, sharp, colon) get escaped: "=;/#?: "
-;;; So don't apply this proc to chunks of text with syntactically meaningful
-;;; reserved chars (e.g., paths with URI slashes or colons) -- they'll be 
-;;; escaped, and lose their special meaning. E.g. it would be a mistake
-;;; to apply ESCAPE-URI to "//lcs.mit.edu:8001/foo/bar.html" because the
-;;; slashes and colons would be escaped.
-
-(define uri-escaped-chars
-  (char-set-complement 
-   ;; RFC 2396 (URI Generic Syntax) specifies unreserved = alphanum | mark
-   (char-set-union char-set:letter+digit
-                   (string->char-set "-_.!~*'()"))))
-
-;;; Takes a set of chars to escape. This is because we sometimes need to
-;;; escape larger sets of chars for different parts of a URI.
-
-(define (escape-uri s . maybe-escaped-chars)
-  (let-optionals maybe-escaped-chars ((escaped-chars uri-escaped-chars))
-    (let ((nlen (string-fold
-		 (lambda (c i)
-		   (+ i
-		      (if (char-set-contains? escaped-chars c)
-			  3
-			  1)))
-		 0
-		 s)))    ; new length of escaped string
-      (if (= nlen (string-length s))
-	  s
-	  (let ((ns (make-string nlen))) 
-	    (string-fold
-	     (lambda (c i)     ; replace each occurance of an
-			       ; character to escape with %ff where ff
-			       ; is the ascii-code in hexadecimal
-			       ; notation
-	       (+ i (cond 
-		     ((char-set-contains? escaped-chars c)
-		      (string-set! ns i #\%)
-		      (let* ((d (char->ascii c))
-			     (dhi (bitwise-and (arithmetic-shift d -4) #xF))
-			     (dlo (bitwise-and d #xF)))
-			(string-set! ns (+ i 1)
-				     (int->hexchar dhi))
-			(string-set! ns (+ i 2)
-				     (int->hexchar dlo)))
-		      3)
-		     (else (string-set! ns i c)
-			   1))))
-	     0
-	     s)
-	    ns)))))
-
-;;; Cribbed from scsh's fname.scm
-
-(define (split-uri uri start end)		; Split at /'s (infix grammar).
-  (let split ((i start))			; "" -> ("")
-    (cond
-     ((>= i end) '(""))
-     ((string-index uri #\/ i) =>
-      (lambda (slash)
-	(cons (substring uri i slash)
-	      (split (+ slash 1)))))
-     (else (list (substring uri i end))))))
-
-
-;;; The elements of PLIST must be escaped in case they contain slashes.
-;;; This procedure doesn't escape them for you; you must do that yourself:
-;;;     (uri-path->uri (map escape-uri pathlist))
-
-(define (uri-path->uri plist)
-  (string-join plist "/"))		; Insert slashes between elts of PLIST.
-
-(define (simplify-uri-path p)    
-  (if (null? p)
-      #f				; P must be non-null
-      (let lp ((path-list (cdr p))
-	       (stack (list (car p))))
-	(if (null? path-list)		; we're done
-	    (reverse stack)
-	    (cond
-	     ((string=? (car path-list) "..") ; back up
-					; neither the empty path nor root
-	      (if (not (or (null? stack) (string=? (car stack) "")))  
-		  (lp (cdr path-list) (cdr stack))
-		  #f))
-	     ((string=? (car path-list) ".") ; leave this
-	      (lp (cdr path-list) stack))
-	     ((string=? (car path-list) "") ; back to root
-	      (lp (cdr path-list) '("")))
-	     (else			; usual segment
-	      (lp (cdr path-list) (cons (car path-list) stack))))))))