scsh-conservatory
/
sunet
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

Indentation and comment fixes. As usual, fix Olin's atrocious 

line-breaking of IFs.
This commit is contained in:
sperber 2003-01-15 10:32:35 +00:00
parent abc0cdb34d
commit b85f09212e
1 changed files with 18 additions and 17 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

35
scheme/lib/url.scm
View File

@ -6,7 +6,7 @@
;;; For copyright information, see the file COPYING which comes with ;;; For copyright information, see the file COPYING which comes with
;;; the distribution. ;;; the distribution.
;;; I'm only implementing http URL's right now. ;;; I'm only implementing HTTP URL's right now.
;;; References: ;;; References:
;;; - http://www.w3.org/Addressing/rfc1738.txt ;;; - http://www.w3.org/Addressing/rfc1738.txt
@ -45,22 +45,21 @@
;;; it wins. CADDR drops the userhost portion of the path. In fact, ;;; it wins. CADDR drops the userhost portion of the path. In fact,
;;; fatal-syntax-error is called, if the path doesn't start with '//'. ;;; fatal-syntax-error is called, if the path doesn't start with '//'.
;
(define (parse-userhost path default) (define (parse-userhost path default)
(if (and (pair? path) ; The thing better begin (if (and (pair? path) ; The thing better begin
(string=? (car path) "") ; with // (i.e., have two (string=? (car path) "") ; with // (i.e., have two
(pair? (cdr path)) ; initial "" elements). (pair? (cdr path)) ; initial "" elements).
(string=? (cadr path) "")) (string=? (cadr path) ""))
(let* ((uhs (caddr path)) ; Userhost string. (let* ((uhs (caddr path)) ; Userhost string.
(uhs-len (string-length uhs)) (uhs-len (string-length uhs))
; Usr:passwd at-sign, (at (string-index uhs #\@)) ; Usr:passwd at-sign, if any.
(at (string-index uhs #\@)) ; if any.
(colon1 (and at (string-index uhs #\:))) ; Usr:passwd colon, (colon1 (and at (string-index uhs #\:))) ; Usr:passwd colon,
(colon1 (and colon1 (< colon1 at) colon1)) ; if any. (colon1 (and colon1 (< colon1 at) colon1)) ; if any.
(colon2 (string-index uhs #\: (or at 0)))) ; Host:port colon, (colon2 (string-index uhs #\: (or at 0)))) ; Host:port colon, if any.
; if any.
(make-userhost (if at (make-userhost (if at
(unescape-uri uhs 0 (or colon1 at)) (unescape-uri uhs 0 (or colon1 at))
(userhost-user default)) (userhost-user default))
@ -78,8 +77,8 @@
;;; Unparser ;;; Unparser
(define userhost-escaped-chars (define userhost-escaped-chars
(char-set-union uri-escaped-chars ; @ and : are also special (char-set-union uri-escaped-chars ; @ and : are also special
(string->char-set "@:"))) ; in UH strings. (string->char-set "@:"))) ; in UH strings.
(define (userhost->string uh) (define (userhost->string uh)
(let* ((us (userhost-user uh)) (let* ((us (userhost-user uh))
@ -90,9 +89,11 @@
;; Encode before assembly in case pieces contain colons or at-signs. ;; Encode before assembly in case pieces contain colons or at-signs.
(e (lambda (s) (escape-uri s userhost-escaped-chars))) (e (lambda (s) (escape-uri s userhost-escaped-chars)))
(user/passwd (if us `(,(e us) . ,(if pw `(":" ,(e pw) "@") '("@"))) (user/passwd (if us
`(,(e us) . ,(if pw `(":" ,(e pw) "@") '("@")))
'())) '()))
(host/port (if ho `(,(e ho) . ,(if po `(":" ,(e po)) '())) (host/port (if ho
`(,(e ho) . ,(if po `(":" ,(e po)) '()))
'()))) '())))
(apply string-append (append user/passwd host/port)))) (apply string-append (append user/passwd host/port))))
@ -131,9 +132,9 @@
(let ((uh (parse-userhost path default-http-userhost))) (let ((uh (parse-userhost path default-http-userhost)))
(if (or (userhost-user uh) (userhost-password uh)) (if (or (userhost-user uh) (userhost-password uh))
(fatal-syntax-error (fatal-syntax-error
"HTTP URL's may not specify a user or password field" path)) "HTTP URL's may not specify a user or password field" path))
(make-http-url uh (map unescape-uri (cdddr path)) search frag-id))) (make-http-url uh (map unescape-uri (cdddr path)) search frag-id)))
;;; Default http port is 80. ;;; Default http port is 80.