suzanne.soy/compatibility
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

Fix CVS crap

Browse Source 
original commit: cc9a1fe584a421095441c48197ad18bb0dae06b7
This commit is contained in:
Michael Burns 2004-08-28 05:24:53 +00:00
parent 9c29860de8
commit a06af27c72
1 changed files with 36 additions and 33 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

39
collects/net/uri-codec-unit.ss
View File

@ -73,6 +73,7 @@
(require (lib "unitsig.ss")
(lib "match.ss")
(lib "string.ss")
"uri-codec-sig.ss")
(provide uri-codec@)
@ -80,14 +81,14 @@
;; Macro to loop over integers from n (inclusive) to m (exclusive)
;; Extracted from iteration.ss in macro package at Schematics
(define-syntax for
(syntax-rules ()
((for (i n m) forms ...)
(let ((fixed-m m))
(let loop ((i n))
(if (< i fixed-m)
(begin
forms ...
(loop (+ i 1)))))))))
(syntax-rules ()
((for (i n m) forms ...)
(let ((fixed-m m))
(let loop ((i n))
(if (< i fixed-m)
(begin
forms ...
(loop (+ i 1)))))))))
(define uri-codec@
(unit/sig net:uri-codec^
@ -107,13 +108,13 @@
;; Characters that sometimes map to themselves
(define safe-mapping
(map (lambda (char)
(map (lambda (char)
(cons char char))
'(#\- #\_ #\. #\! #\~ #\* #\' #\( #\))))
;; The strict URI mapping
(define uri-mapping
(append alphanumeric-mapping safe-mapping))
(append alphanumeric-mapping safe-mapping))
;; The form-urlencoded mapping
(define form-urlencoded-mapping
@ -161,7 +162,7 @@
;; vector string -> string
(define (encode table str)
(apply string-append
(apply string-append
(map (lambda (char)
(vector-ref table (char->integer char)))
(string->list str))))
@ -225,7 +226,9 @@
#f
(match (regexp-match-positions key-regexp str start)
[((start . end))
(vector (form-urlencoded-decode (substring str start end))
(vector (let ([s (form-urlencoded-decode (substring str start end))])
(string-lowercase! s)
(string->symbol s))
(add1 end))]
[#f #f])))
(define (next-value str start)
@ -245,16 +248,16 @@
[#f
(vector (cons key "") (string-length str))])]
[#f #f]))
(let loop ((start 0)
(end (string-length str))
(alist '()))
(let loop ([start 0]
[end (string-length str)]
[make-alist (lambda (x) x)])
(cond
[(>= start end) alist]
[(>= start end) (make-alist '())]
[else
(match (next-pair str start)
[#(pair next-start)
(loop next-start end (cons pair alist))]
[#f alist])])))
(loop next-start end (lambda (x) (make-alist (cons pair x))))]
[#f (make-alist '())])])))
))
)