Working on url-encoding library

.gitignore

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

retropikzel/url-encoding.scm

@@ -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")
+  '((#\space "%20")
-        (list " " "+")
+    (#\% "%25")
-        (list "!" "%21")
+    (#\[ "%5B")
-        (list "#" "%23")
+    (#\] "%5D")
-        (list "$" "%24")
+    (#\> "%3E")
-        (list "%" "%25")
+    (#\< "%3C")
-        (list "&" "%26")
+    (#\\" "%5C")
-        (list "'" "%27")
+    (#\\" "%22")
-        (list "(" "%28")
+    (#\\" "%0A")
-        (list ")" "%29")
+    (#\\" "%0D")
-        (list "*" "%2A")
+    (#\^ "%5E")
-        (list "+" "%2B")
+    (#\{ "%7B")
-        (list "," "%2C")
+    (#\} "%7D")
-        (list "/" "%2F")
+    (#\| "%7C")
-        (list ":" "%3A")
+    (#\€ "%E2%82%AC")
-        (list ";" "%3B")
+    (#\ƒ "%C6%92")
-        (list "=" "%3D")
+    (#\„ "%E2%80%9E")
-        (list "?" "%3F")
+    (#\… "%E2%80%A6")
-        (list "@" "%40")
+    (#\† "%E2%80%A0")
-        (list "[" "%5B")
+    (#\‡ "%E2%80%A1")
-        (list "]" "%5D")
+    (#\ˆ "%CB%86")
-        (list "<" "%3C")
+    (#\‰ "%E2%80%B0")
-        (list ">" "%3E")
+    (#\Š "%C5%A0")
-        (list "\\" "%5C")
+    (#\‹ "%E2%80%B9")
-        (list "\"" "%22")
+    (#\Π"%C5%92")
-        (list "\n" "%0A")
+    (#\Ž "%C5%BD")
-        (list "\r" "%0D")))
+    (#\‘ "%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 (encode-url str)
-(define (url-decode str) (cond ((string? str) (endecode "decode" str)) (else 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)))

retropikzel/url-encoding.sld

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

retropikzel/url-encoding/test.scm

@@ -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")