Working on url-encoding library

This commit is contained in:
retropikzel 2026-02-12 06:38:54 +02:00
parent a55cefcbd1
commit 627bb0e9f0
6 changed files with 11368 additions and 35 deletions

1
.gitignore vendored
View File

@ -4,6 +4,7 @@
*.tgz
*.log
.*
*.json
retropikzel/*/README.html
foreign
venv

View File

@ -1,41 +1,53 @@
;; Works same as Javascript encodeURI
;; https://developer.mozilla.org/en-US/docs/Web/JavaScript/Reference/Global_Objects/encodeURI
(define encode-replacements
(list (list " " "%20")
(list " " "+")
(list "!" "%21")
(list "#" "%23")
(list "$" "%24")
(list "%" "%25")
(list "&" "%26")
(list "'" "%27")
(list "(" "%28")
(list ")" "%29")
(list "*" "%2A")
(list "+" "%2B")
(list "," "%2C")
(list "/" "%2F")
(list ":" "%3A")
(list ";" "%3B")
(list "=" "%3D")
(list "?" "%3F")
(list "@" "%40")
(list "[" "%5B")
(list "]" "%5D")
(list "<" "%3C")
(list ">" "%3E")
(list "\\" "%5C")
(list "\"" "%22")
(list "\n" "%0A")
(list "\r" "%0D")))
'((#\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))
(define (get-replacement key mode)
#;(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)
#;(define (endecode mode s)
(if (not s)
""
(letrec ((s-length (string-length s))
@ -55,5 +67,30 @@
result))))
(looper 0 ""))))
(define (url-encode str) (cond ((string? str) (endecode "encode" str)) (else str)))
(define (url-decode str) (cond ((string? str) (endecode "decode" str)) (else str)))
(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)))

View File

@ -1,6 +1,9 @@
(define-library
(retropikzel url-encoding)
(import (scheme base))
(export url-encode
url-decode)
(import (scheme base)
(scheme write)
(scheme char))
(export encode-url
;decode-url
)
(include "url-encoding.scm"))

File diff suppressed because it is too large Load Diff

File diff suppressed because it is too large Load Diff

View File

@ -0,0 +1,17 @@
(test-begin "url-encoding")
(test-assert "url-encode-1"
(string=? (encode-url "https://retropikzel.neocities.org/blog/2025-12-24 - Making a Scheme script on windows.html")
"https://retropikzel.neocities.org/blog/2025-12-24%20-%20Making%20a%20Scheme%20script%20on%20windows.html"))
(write (encode-url "https://retropikzel.neocities.org/blog/2025-12-24 - Making a Scheme script on windows.html"))
(newline)
(define long-text (slurp "retropikzel/url-encoding/long-test-string.txt"))
(test-assert "url-encode long-text" (string? (encode-url long-text)))
(define long-text1 (slurp "retropikzel/url-encoding/long-test-string1.txt"))
(test-assert "url-encode long-text1" (string? (encode-url long-text1)))
(test-end "url-encoding")