- elide documentation that's moved to uri.tex
- remove RESOLVE-URI (Whatever it was supposed to do (and we don't know what it was supposed to do), it didn't work, and there are no known clients for it.)
This commit is contained in:
parent
e2d36f3922
commit
d882315133
|
@ -14,39 +14,6 @@
|
|||
;;; - http://www.w3.org/hypertext/WWW/Addressing/URL/URI_Overview.html
|
||||
;;; General Web page of URI pointers.
|
||||
|
||||
;;; I wrote a URI parser that slavishly obeyed Tim Berners-Lee's
|
||||
;;; spec (rfc 1630). This was a waste of time, as most URL's do not
|
||||
;;; obey his spec, which is incomplete and inconsistent with the URL spec
|
||||
;;; in any event. This parser is much simpler. It parses a URI into four
|
||||
;;; fields:
|
||||
;;; [ <scheme> ] : <path> [ ? <search> ] [ # fragid ]
|
||||
;;; The returned fields are *not* unescaped, as the rules for parsing the
|
||||
;;; <path> component in particular need unescaped text, and are dependent
|
||||
;;; on <scheme>. The URL parser is responsible for doing this.
|
||||
;;; If the <scheme>, <search> or <fragid> portions are not specified,
|
||||
;;; they are #f. Otherwise, <scheme>, <search>, and <fragid> are strings;
|
||||
;;; <path> is a non-empty string list.
|
||||
|
||||
;;; The parsing technique is inwards from both ends.
|
||||
;;; - First we search forwards for the first reserved char (= ; / # ? : space)
|
||||
;;; If it's a colon, then that's the <scheme> part, otw no <scheme> part.
|
||||
;;; Remove it.
|
||||
;;; - Then we search backwards from the end for the last reserved char.
|
||||
;;; If it's a sharp, then that's the <fragment-id> part -- remove it.
|
||||
;;; - Then we search backwards from the end for the last reserved char.
|
||||
;;; If it's a question-mark, then that's the <search> part -- remove it.
|
||||
;;; - What's left is the path. Split at slashes. "" -> ("")
|
||||
;;;
|
||||
;;; This scheme is tolerant of the various ways people build broken
|
||||
;;; URI's out there on the Net , p.e. \#= is a reserved character, but
|
||||
;;; used unescaped in the search-part. It was given to me by Dan
|
||||
;;; Connolly of the W3C and slightly modified.
|
||||
|
||||
;;; Returns four values: scheme, path, search, frag-id. Each value is
|
||||
;;; either #f or a string except of the path, which is a nonempty list
|
||||
;;; of string (as mentioned above).
|
||||
|
||||
|
||||
(define uri-reserved (string->char-set ";/#?: ="))
|
||||
|
||||
(define (parse-uri s)
|
||||
|
@ -185,59 +152,6 @@
|
|||
s)
|
||||
ns)))))
|
||||
|
||||
|
||||
;;; Four args: context URI's <scheme> : <path> values, and
|
||||
;;; main URI's <scheme> : <path> values.
|
||||
;;; If the path cannot be resolved, return #f #f (this occurs if <path>
|
||||
;;; begins with n sequential slashes, and <context-path> doesn't
|
||||
;;; have that many sequential slashes anywhere). All paths are
|
||||
;;; represented as non-empty lists.
|
||||
|
||||
(define (resolve-uri cscheme cp scheme p)
|
||||
(if scheme (values scheme p) ; If URI has own <scheme>, it is absolute.
|
||||
|
||||
(if (and (pair? p) (string=? (car p) "")) ; Path P begins with a slash.
|
||||
|
||||
(receive (numsl p) ; Count and strip off initial
|
||||
(do ((i 1 (+ i 1)) ; slashes (i.e., initial ""'s)
|
||||
(q (cdr p) (cdr q)))
|
||||
((or (null? q) (not (string=? (car q) "")))
|
||||
(values i q)))
|
||||
|
||||
;; Skip through CP until we find that many sequential /'s.
|
||||
(let lp ((cp-tail cp)
|
||||
(rhead '()) ; CP prefix, reversed.
|
||||
(j 0)) ; J counts sequential /
|
||||
|
||||
(cond
|
||||
((and (pair? cp-tail) (string=? (car cp-tail) "")) ; More ""'s
|
||||
(lp (cdr cp-tail)
|
||||
(cons (car cp-tail) rhead)
|
||||
(+ j 0)))
|
||||
|
||||
((= j numsl) ; Win
|
||||
(values cscheme (simplify-uri-path (rev-append rhead p))))
|
||||
|
||||
((pair? cp-tail) ; Keep looking.
|
||||
(lp (cdr cp-tail)
|
||||
(cons (car cp-tail) rhead)
|
||||
1))
|
||||
|
||||
(else (values #f #f))))) ; Lose.
|
||||
|
||||
|
||||
;; P doesn't begin with a slash.
|
||||
(values cscheme (simplify-uri-path
|
||||
(rev-append (cdr (reverse cp)) ; Drop non-dir part
|
||||
p)))))) ; and append P.
|
||||
|
||||
|
||||
(define (rev-append a b) ; (append (reverse a) b)
|
||||
(let rev-app ((a a) (b b)) ; Should be defined in a list-proc
|
||||
(if (pair? a) ; package, not here.
|
||||
(rev-app (cdr a) (cons (car a) b))
|
||||
b)))
|
||||
|
||||
;;; Cribbed from scsh's fname.scm
|
||||
|
||||
(define (split-uri-path uri start end) ; Split at /'s (infix grammar).
|
||||
|
|
Loading…
Reference in New Issue