97 lines
3.4 KiB
Scheme
97 lines
3.4 KiB
Scheme
;; Works same as Javascript encodeURI
|
||
;; https://developer.mozilla.org/en-US/docs/Web/JavaScript/Reference/Global_Objects/encodeURI
|
||
|
||
(define encode-replacements
|
||
'((#\space "%20")
|
||
(#\% "%25")
|
||
(#\[ "%5B")
|
||
(#\] "%5D")
|
||
(#\> "%3E")
|
||
(#\< "%3C")
|
||
(#\\" "%5C")
|
||
(#\\" "%22")
|
||
(#\\" "%0A")
|
||
(#\\" "%0D")
|
||
(#\^ "%5E")
|
||
(#\{ "%7B")
|
||
(#\} "%7D")
|
||
(#\| "%7C")
|
||
(#\€ "%E2%82%AC")
|
||
(#\ƒ "%C6%92")
|
||
(#\„ "%E2%80%9E")
|
||
(#\… "%E2%80%A6")
|
||
(#\† "%E2%80%A0")
|
||
(#\‡ "%E2%80%A1")
|
||
(#\ˆ "%CB%86")
|
||
(#\‰ "%E2%80%B0")
|
||
(#\Š "%C5%A0")
|
||
(#\‹ "%E2%80%B9")
|
||
(#\Π"%C5%92")
|
||
(#\Ž "%C5%BD")
|
||
(#\‘ "%E2%80%98")
|
||
(#\' "%E2%80%99")
|
||
(#\“ "%E2%80%9C")
|
||
(#\” "%E2%80%9D")))
|
||
(define decode-replacements (map reverse encode-replacements))
|
||
;(define char-lookup-table (make-vector 10000 #f))
|
||
|
||
#;(for-each
|
||
(lambda (pair)
|
||
(vector-set! char-lookup-table (char->integer (car pair)) (cadr pair)))
|
||
encode-replacements)
|
||
|
||
|
||
#;(define (get-replacement key mode)
|
||
(let ((r (if (string=? mode "encode")
|
||
(assoc key encode-replacements)
|
||
(assoc key decode-replacements))))
|
||
(if r (car (cdr r)) key)))
|
||
|
||
#;(define (endecode mode s)
|
||
(if (not s)
|
||
""
|
||
(letrec ((s-length (string-length s))
|
||
(looper
|
||
(lambda (i result)
|
||
(if (< i s-length)
|
||
(let ((key-length (if (and (string=? mode "decode")
|
||
(string=? (string-copy s i (+ i 1)) "%")
|
||
(> s-length (+ i 2)))
|
||
3
|
||
1)))
|
||
(looper (+ i key-length)
|
||
(string-append result
|
||
(get-replacement
|
||
(string-copy s i (+ i key-length))
|
||
mode))))
|
||
result))))
|
||
(looper 0 ""))))
|
||
|
||
(define (encode-url str)
|
||
(when (not (string? str)) (error "encode-url: Can only encode strings" str))
|
||
(letrec* ((str-vector (list->vector (string->list str)))
|
||
(str-length (vector-length str-vector))
|
||
(looper (lambda (index result)
|
||
(if (= index str-length)
|
||
(list->string (reverse result))
|
||
(looper (+ index 1)
|
||
(cond
|
||
((char=? (vector-ref str-vector index) #\space)
|
||
(cons #\0 (cons #\2 (cons #\% result))))
|
||
((char=? (vector-ref str-vector index) #\%)
|
||
(cons #\5 (cons #\2 (cons #\% result))))
|
||
((char=? (vector-ref str-vector index) #\[)
|
||
(cons #\B (cons #\5 (cons #\% result))))
|
||
(else (cons (vector-ref str-vector index) result))))))))
|
||
(looper 0 '()))
|
||
#;(let ((result '()))
|
||
(for-each
|
||
(lambda (c)
|
||
;(set! result (cons (or (vector-ref char-lookup-table (char->integer c)) (string c)) result))
|
||
(set! result (cons c result))
|
||
)
|
||
(string->list str))
|
||
(list->string (reverse result))))
|
||
|
||
;(define (decode-url str) (cond ((string? str) (endecode "decode" str)) (else str)))
|