Working on url-encoding library

.gitignore

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

retropikzel/string.scm

@@ -0,0 +1,91 @@
+(define (string-replace str . replacements)
+  (letrec*
+    ((replacements-list (if (string? (car replacements))
+                          (list (list (car replacements) (cadr replacements)))
+                          replacements))
+     (first-chars (map (lambda (item) (string-ref (car item) 0)) replacements-list))
+     (replace-vectors (map (lambda (item) (string->vector (car item))) replacements-list))
+     (replace-with-vectors (map (lambda (item) (string->vector( cadr item))) replacements-list))
+     (longest-replace-length 32)
+     (str-vector (string->vector str))
+     (str-length (vector-length str-vector))
+     (str-index 0)
+     (result-block 4000)
+     (result-size result-block)
+     (result (make-vector result-size #\X))
+     (result-index 0)
+     (looper
+       (lambda ()
+         (when (>= result-index (- result-size longest-replace-length))
+           (set! result (vector-append result (make-vector result-block #\X)))
+           (set! result-size (+ result-size result-block)))
+         (when (< str-index str-length)
+           (for-each
+             (lambda (first-char replace-vector replace-with-vector)
+               (when (and (char=? first-char (vector-ref str-vector str-index))
+                          (<= (+ str-index (vector-length replace-vector)) str-length)
+                          (equal?  replace-vector
+                                   (vector-copy str-vector
+                                                str-index
+                                                (+ str-index (vector-length replace-vector))))
+                          )
+                 (vector-copy! result result-index replace-with-vector)
+                 (set! result-index (+ result-index (vector-length replace-with-vector)))
+                 (set! str-index (+ str-index (vector-length replace-vector)))))
+             first-chars
+             replace-vectors
+             replace-with-vectors)
+           (when (< str-index str-length)
+             (vector-set! result result-index (vector-ref str-vector str-index))
+             (set! str-index (+ str-index 1))
+             (set! result-index (+ result-index 1))
+             (looper))))))
+    (looper)
+    (vector->string (vector-copy result 0 result-index))))
+
+(define (string-format str vals)
+  (apply string-replace
+         (cons str
+               (map
+                 (lambda (pair)
+                   (list (string-append "{" (symbol->string (car pair)) "}")
+                         (if (number? (cadr pair))
+                           (number->string (cadr pair))
+                           (cadr pair))))
+                 vals))))
+
+(define (string-capitalize str)
+  (string-append (string (char-upcase (string-ref str 0))) (string-copy str 1)))
+
+;; TODO
+#;(define (string-center str len . char)
+  (let ((c (if (null? char)) #\space (car char)))
+    (string-append (string (char-upcase (string-ref str 0))) (string-copy str 1))))
+
+;; TODO
+#;(define (string-count str val)
+  (letrec*
+    ((str-vec (string->vector str))
+     (str-len (vector-length str-vec))
+     (str-index 0)
+     (val-len (string-length val))
+     (looper (lambda ()
+                      (when (< str-index (- str-len val-len))
+
+                        ))))
+    (looper)
+    ))
+
+(define (string-ends-with? str end-str)
+  (let* ((str-vec (string->vector str))
+         (str-len (vector-length str-vec))
+         (end-str-vec (string->vector end-str))
+         (end-str-len (vector-length end-str-vec)))
+    (and (> str-len end-str-len)
+         (equal? (vector-copy str-vec (- str-len end-str-len))
+                 end-str-vec))))
+
+
+(define (string-expand-tabs str size)
+  (let ((tab (make-string size #\space)))
+    (string-replace str (string #\tab) tab)))

retropikzel/string.sld

@@ -0,0 +1,18 @@
+(define-library
+  (retropikzel string)
+  (import (scheme base)
+          (scheme write)
+          (scheme char)
+          (scheme process-context))
+  (export string-replace
+          ;string-replace-times ;; TODO Replace given amount of occurances
+          ;; TODO www.w3schools.com/python/python_ref_string.asp
+          string-format
+          string-capitalize
+          string-ends-with?
+          string-expand-tabs
+          ;; TODO https://dlang.org/library/std/string.html
+          ;; TODO https://docs.ruby-lang.org/en/master/String.html
+          ;; TODO https://developer.mozilla.org/en-US/docs/Web/JavaScript/Reference/Template_literals
+          )
+  (include "string.scm"))

retropikzel/string/LICENSE

@@ -0,0 +1,165 @@
+                   GNU LESSER GENERAL PUBLIC LICENSE
+                       Version 3, 29 June 2007
+
+ Copyright (C) 2007 Free Software Foundation, Inc. <https://fsf.org/>
+ Everyone is permitted to copy and distribute verbatim copies
+ of this license document, but changing it is not allowed.
+
+
+  This version of the GNU Lesser General Public License incorporates
+the terms and conditions of version 3 of the GNU General Public
+License, supplemented by the additional permissions listed below.
+
+  0. Additional Definitions.
+
+  As used herein, "this License" refers to version 3 of the GNU Lesser
+General Public License, and the "GNU GPL" refers to version 3 of the GNU
+General Public License.
+
+  "The Library" refers to a covered work governed by this License,
+other than an Application or a Combined Work as defined below.
+
+  An "Application" is any work that makes use of an interface provided
+by the Library, but which is not otherwise based on the Library.
+Defining a subclass of a class defined by the Library is deemed a mode
+of using an interface provided by the Library.
+
+  A "Combined Work" is a work produced by combining or linking an
+Application with the Library.  The particular version of the Library
+with which the Combined Work was made is also called the "Linked
+Version".
+
+  The "Minimal Corresponding Source" for a Combined Work means the
+Corresponding Source for the Combined Work, excluding any source code
+for portions of the Combined Work that, considered in isolation, are
+based on the Application, and not on the Linked Version.
+
+  The "Corresponding Application Code" for a Combined Work means the
+object code and/or source code for the Application, including any data
+and utility programs needed for reproducing the Combined Work from the
+Application, but excluding the System Libraries of the Combined Work.
+
+  1. Exception to Section 3 of the GNU GPL.
+
+  You may convey a covered work under sections 3 and 4 of this License
+without being bound by section 3 of the GNU GPL.
+
+  2. Conveying Modified Versions.
+
+  If you modify a copy of the Library, and, in your modifications, a
+facility refers to a function or data to be supplied by an Application
+that uses the facility (other than as an argument passed when the
+facility is invoked), then you may convey a copy of the modified
+version:
+
+   a) under this License, provided that you make a good faith effort to
+   ensure that, in the event an Application does not supply the
+   function or data, the facility still operates, and performs
+   whatever part of its purpose remains meaningful, or
+
+   b) under the GNU GPL, with none of the additional permissions of
+   this License applicable to that copy.
+
+  3. Object Code Incorporating Material from Library Header Files.
+
+  The object code form of an Application may incorporate material from
+a header file that is part of the Library.  You may convey such object
+code under terms of your choice, provided that, if the incorporated
+material is not limited to numerical parameters, data structure
+layouts and accessors, or small macros, inline functions and templates
+(ten or fewer lines in length), you do both of the following:
+
+   a) Give prominent notice with each copy of the object code that the
+   Library is used in it and that the Library and its use are
+   covered by this License.
+
+   b) Accompany the object code with a copy of the GNU GPL and this license
+   document.
+
+  4. Combined Works.
+
+  You may convey a Combined Work under terms of your choice that,
+taken together, effectively do not restrict modification of the
+portions of the Library contained in the Combined Work and reverse
+engineering for debugging such modifications, if you also do each of
+the following:
+
+   a) Give prominent notice with each copy of the Combined Work that
+   the Library is used in it and that the Library and its use are
+   covered by this License.
+
+   b) Accompany the Combined Work with a copy of the GNU GPL and this license
+   document.
+
+   c) For a Combined Work that displays copyright notices during
+   execution, include the copyright notice for the Library among
+   these notices, as well as a reference directing the user to the
+   copies of the GNU GPL and this license document.
+
+   d) Do one of the following:
+
+       0) Convey the Minimal Corresponding Source under the terms of this
+       License, and the Corresponding Application Code in a form
+       suitable for, and under terms that permit, the user to
+       recombine or relink the Application with a modified version of
+       the Linked Version to produce a modified Combined Work, in the
+       manner specified by section 6 of the GNU GPL for conveying
+       Corresponding Source.
+
+       1) Use a suitable shared library mechanism for linking with the
+       Library.  A suitable mechanism is one that (a) uses at run time
+       a copy of the Library already present on the user's computer
+       system, and (b) will operate properly with a modified version
+       of the Library that is interface-compatible with the Linked
+       Version.
+
+   e) Provide Installation Information, but only if you would otherwise
+   be required to provide such information under section 6 of the
+   GNU GPL, and only to the extent that such information is
+   necessary to install and execute a modified version of the
+   Combined Work produced by recombining or relinking the
+   Application with a modified version of the Linked Version. (If
+   you use option 4d0, the Installation Information must accompany
+   the Minimal Corresponding Source and Corresponding Application
+   Code. If you use option 4d1, you must provide the Installation
+   Information in the manner specified by section 6 of the GNU GPL
+   for conveying Corresponding Source.)
+
+  5. Combined Libraries.
+
+  You may place library facilities that are a work based on the
+Library side by side in a single library together with other library
+facilities that are not Applications and are not covered by this
+License, and convey such a combined library under terms of your
+choice, if you do both of the following:
+
+   a) Accompany the combined library with a copy of the same work based
+   on the Library, uncombined with any other library facilities,
+   conveyed under the terms of this License.
+
+   b) Give prominent notice with the combined library that part of it
+   is a work based on the Library, and explaining where to find the
+   accompanying uncombined form of the same work.
+
+  6. Revised Versions of the GNU Lesser General Public License.
+
+  The Free Software Foundation may publish revised and/or new versions
+of the GNU Lesser General Public License from time to time. Such new
+versions will be similar in spirit to the present version, but may
+differ in detail to address new problems or concerns.
+
+  Each version is given a distinguishing version number. If the
+Library as you received it specifies that a certain numbered version
+of the GNU Lesser General Public License "or any later version"
+applies to it, you have the option of following the terms and
+conditions either of that published version or of any later version
+published by the Free Software Foundation. If the Library as you
+received it does not specify a version number of the GNU Lesser
+General Public License, you may choose any version of the GNU Lesser
+General Public License ever published by the Free Software Foundation.
+
+  If the Library as you received it specifies that a proxy can decide
+whether future versions of the GNU Lesser General Public License shall
+apply, that proxy's public statement of acceptance of any version is
+permanent authorization for you to choose that version for the
+Library.

retropikzel/string/README.md

@@ -0,0 +1,71 @@
+String utility library
+
+(*string-replace* str replace replace-with)
+(*string-replace* str (replace replace-with) ...)
+
+Replaces the first given string with second on on all occuranes. Or replaces
+all given (string string) on all occurances.
+
+
+Examples:
+
+    (string-replace "foo123bar" "123" "456")
+    > "foo456bar"
+
+    (string-replace "foo123bar-no" '("123" "456") '("no" "yes"))
+    > "foo456bar-yes"
+
+
+(*string-format* str vals)
+
+Str should be string containing keys of values surrounded by curly brackets.
+Vals should be list of lists containing keys as symbol and value as either
+string or number.
+
+Examples:
+
+    (string-format "Hello {name}, I count {n} parenthesis" '((name "Schemer") (n 7)))
+    > "Hello Schemer, I count 7 parenthesis"
+
+(*string-capitalize* str)
+
+Capitalizes the first character of given string.
+
+Examples:
+
+    (string-capitalize "hello")
+    > "Hello"
+
+(*string-center* str len . char)
+
+Center aligns the str to given len. If char is given it is used, otherwise
+space is used.
+
+Examples:
+
+    (string-center "hello" 15)
+    > "     hello     "
+
+(*string-ends-with?* str end-str)
+
+Returns #t if given str ends with end-str. #f otherwise.
+
+Examples:
+
+    (string-ends-with? "hello" \#o)
+    > #t
+
+    (string-ends-with? "hello" \#e)
+    > #f
+
+(*string-expand-tabs* str size)
+
+Expand any #\tab with spaces count size.
+
+Examples:
+
+    (string-expand-tabs "\thello" 2)
+    > "  hello"
+
+    (string-expand-tabs "\thello\t" 4)
+    > "    hello    "

retropikzel/string/VERSION

@@ -0,0 +1 @@
+0.1.0

retropikzel/string/test.scm

@@ -0,0 +1,36 @@
+(test-begin "string")
+
+(test-equal
+  "foo456bar"
+  (string-replace "foo123bar" "123" "456"))
+
+(test-equal
+  "foo456bar-yes"
+  (string-replace "foo123bar-no" '("123" "456") '("no" "yes")))
+
+(define long-text (slurp "retropikzel/string/long-test-string.txt"))
+(test-assert
+  "string-replace long-text"
+  (string? (string-replace long-text '("irure" "foobar"))))
+
+(test-equal
+  "Hello Schemer, I count 7 parenthesis"
+  (string-format "Hello {name}, I count {n} parenthesis"
+                 '((name "Schemer")
+                   (n 7))))
+
+;(define long-text1 (slurp "retropikzel/string/long-test-string1.txt"))
+;(test-assert "string-replace long-text1" (string? (string-replace long-text1 "irure" "foobar")))
+
+(test-equal "foo456bar-yes" (string-replace "foo123bar-no" '("123" "456") '("no" "yes")))
+
+(test-equal "Hello" (string-capitalize "hello"))
+
+(test-assert (string-ends-with? "hello" "lo"))
+
+(test-assert (not (string-ends-with? "hello" "e")))
+
+(test-equal "  hello" (string-expand-tabs "\thello" 2))
+(test-equal "    hello    " (string-expand-tabs "\thello\t" 4))
+
+(test-end "string")

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