diff --git a/Makefile b/Makefile
index 427cf5c..1e18a35 100644
--- a/Makefile
+++ b/Makefile
@@ -39,12 +39,13 @@ init-venv: build
@rm -rf venv
@scheme-venv ${SCHEME} ${RNRS} venv
@echo "(import (scheme base) (scheme write) (scheme read) (scheme char) (scheme file) (scheme process-context) (srfi 64) (retropikzel ${LIBRARY}))" > venv/test.scm
- @printf "#!r6rs\n(import (rnrs) (srfi :64) (retropikzel ${LIBRARY}))" > venv/test.sps
+ @printf "#!r6rs\n(import (rnrs) (srfi :64) (srfi :98) (retropikzel ${LIBRARY}))" > venv/test.sps
@cat ${TESTFILE} >> venv/test.scm
@cat ${TESTFILE} >> venv/test.sps
@if [ "${RNRS}" = "r6rs" ]; then if [ -d ../foreign-c ]; then cp -r ../foreign-c/foreign venv/lib/; fi; fi
+ @if [ "${RNRS}" = "r6rs" ]; then if [ -d ../foreign-c-srfis ]; then cp -r ../foreign-c-srfis/srfi venv/lib/; fi; fi
@if [ "${RNRS}" = "r6rs" ]; then cp -r retropikzel venv/lib/; fi
- @if [ "${SCHEME}" = "chezs" ]; then ./venv/bin/akku install akku-r7rs chez-srfi; fi
+ @if [ "${SCHEME}" = "chezscheme" ]; then ./venv/bin/akku install akku-r7rs chez-srfi; fi
@if [ "${SCHEME}" = "ikarus" ]; then ./venv/bin/akku install akku-r7rs chez-srfi; fi
@if [ "${SCHEME}" = "ironscheme" ]; then ./venv/bin/akku install akku-r7rs chez-srfi; fi
@if [ "${SCHEME}" = "racket" ]; then ./venv/bin/akku install akku-r7rs chez-srfi; fi
diff --git a/retropikzel/http-server.scm b/retropikzel/http-server.scm
new file mode 100644
index 0000000..15d98a9
--- /dev/null
+++ b/retropikzel/http-server.scm
@@ -0,0 +1,88 @@
+(define buffer-size 4000)
+(define response-line-end (string->utf8 "\r\n"))
+(define response-200 (string->utf8 "HTTP/1.1 200 OK\r\n"))
+(define response-404 (string->utf8 "HTTP/1.1 404 Not Found\r\n"))
+(define response-501 (string->utf8 "HTTP/1.1 501 Not Implemented\r\n"))
+(define header-content-type-text-html (string->utf8 "Content-type: text/html\r\n"))
+(define (header-content-length len)
+ (string->utf8 (string-append "Content-length: " (number->string len) "\r\n")))
+
+(define (logger msg) (display msg (current-error-port)))
+
+(define (receive-all socket bytes result)
+ (if (< (bytevector-length bytes) buffer-size)
+ (bytevector-append result bytes)
+ (receive-all socket
+ (socket-recv socket buffer-size)
+ (bytevector-append result bytes))))
+
+(define (read-until port character)
+ (letrec ((looper (lambda (result)
+ (let ((c (read-char port)))
+ (if (char=? c character)
+ (list->string (reverse result))
+ (looper (cons c result)))))))
+ (looper (list))))
+
+(define (read-until-eof port)
+ (letrec ((looper (lambda (result)
+ (let ((bytes (read-bytevector buffer-size)))
+ (if (eof-object? bytes)
+ result
+ (looper (bytevector-append result bytes)))))))
+ (looper (bytevector))))
+
+(define (send socket bytes)
+ ;(display "Sending: ")
+ ;(write (utf8->string bytes))
+ ;(newline)
+ (socket-send socket bytes))
+
+(define (http-server-listen server-socket document-root port)
+ (call-with-socket
+ (socket-accept server-socket)
+ (lambda (client-socket)
+ (let ((request-type (utf8->string (socket-recv client-socket 4))))
+ (cond
+ ((string=? request-type "GET ")
+ (logger "GET: ")
+ (let* ((request
+ (utf8->string
+ (receive-all client-socket
+ (socket-recv client-socket buffer-size)
+ (bytevector))))
+ (request-port (open-input-string request))
+ (request-path (url-decode (read-until request-port #\space)))
+ (request-full-path (string-append document-root request-path)))
+ (logger request-path)
+ (cond
+ ((file-exists? request-full-path)
+ (let ((contents
+ (with-input-from-file
+ request-full-path
+ (lambda ()
+ (read-until-eof (current-input-port))))))
+ (send client-socket response-200)
+ (send client-socket header-content-type-text-html)
+ (send client-socket
+ (header-content-length
+ (bytevector-length contents)))
+ (send client-socket response-line-end)
+ (send client-socket contents)
+ (send client-socket response-line-end)
+ (logger " -> 200 OK")
+ (logger #\newline)))
+ (else (send client-socket response-404)
+ (send client-socket response-line-end)
+ (logger " -> 404 Not found")
+ (logger #\newline)))))
+ (else (send client-socket response-501))))
+ (socket-close client-socket)
+ (http-server-listen server-socket document-root port))))
+
+(define (http-server document-root port)
+ (let ((server-socket
+ (make-server-socket (if (number? port) (number->string port) port))))
+ (when (char=? (car (reverse (string->list document-root))) #\/)
+ (error "document-root can not end with /" document-root))
+ (http-server-listen server-socket document-root port)))
diff --git a/retropikzel/http-server.sld b/retropikzel/http-server.sld
new file mode 100644
index 0000000..e6d9a5e
--- /dev/null
+++ b/retropikzel/http-server.sld
@@ -0,0 +1,11 @@
+(define-library
+ (retropikzel http-server)
+ (import (scheme base)
+ (scheme read)
+ (scheme write)
+ (scheme char)
+ (scheme file)
+ (retropikzel url-encoding)
+ (srfi 106))
+ (export http-server)
+ (include "http-server.scm"))
diff --git a/retropikzel/http-server/LICENSE b/retropikzel/http-server/LICENSE
new file mode 100644
index 0000000..0a04128
--- /dev/null
+++ b/retropikzel/http-server/LICENSE
@@ -0,0 +1,165 @@
+ GNU LESSER GENERAL PUBLIC LICENSE
+ Version 3, 29 June 2007
+
+ Copyright (C) 2007 Free Software Foundation, Inc.
+ 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.
diff --git a/retropikzel/http-server/README.md b/retropikzel/http-server/README.md
new file mode 100644
index 0000000..164c777
--- /dev/null
+++ b/retropikzel/http-server/README.md
@@ -0,0 +1 @@
+Simple HTTP server library for serving files on localhost
diff --git a/retropikzel/http-server/VERSION b/retropikzel/http-server/VERSION
new file mode 100644
index 0000000..6e8bf73
--- /dev/null
+++ b/retropikzel/http-server/VERSION
@@ -0,0 +1 @@
+0.1.0
diff --git a/retropikzel/http-server/test.scm b/retropikzel/http-server/test.scm
new file mode 100644
index 0000000..9139786
--- /dev/null
+++ b/retropikzel/http-server/test.scm
@@ -0,0 +1,2 @@
+(define document-root (string-append (get-environment-variable "PWD") "/retropikzel/http-server/www"))
+(http-server document-root "3005")
diff --git a/retropikzel/http-server/www/index.html b/retropikzel/http-server/www/index.html
new file mode 100644
index 0000000..668b192
--- /dev/null
+++ b/retropikzel/http-server/www/index.html
@@ -0,0 +1,7 @@
+
+
+
+
+ Hello
+
+
diff --git a/retropikzel/http-util.scm b/retropikzel/http-util.scm
new file mode 100644
index 0000000..202edc0
--- /dev/null
+++ b/retropikzel/http-util.scm
@@ -0,0 +1,253 @@
+(define chunk-size 4000)
+(define slash-r (bytevector-u8-ref (string->utf8 "\r") 0))
+(define slash-n (bytevector-u8-ref (string->utf8 "\n") 0))
+
+(define remove-leading-whitespate
+ (lambda (str)
+ (if (or (= (string-length str) 0)
+ (not (char-whitespace? (string-ref str 0))))
+ str
+ (remove-leading-whitespate (string-copy str )))))
+
+(define http-util-header-line->pair
+ (lambda (line)
+ (letrec* ((split
+ (lambda (first rest)
+ (if (or (= (string-length rest) 0)
+ (char=? #\: (string-ref rest 0)))
+ (cons (string->symbol (string-downcase first)) (remove-leading-whitespate (string-copy rest 2)))
+ (split (string-append first (string (string-ref rest 0)))
+ (string-copy rest 1))))))
+ (split "" line))))
+
+(define http-util-status-line->list
+ (lambda (line)
+ (letrec* ((split
+ (lambda (first second rest space-count)
+ (cond ((char=? #\space (string-ref rest 0))
+ (split first second (string-copy rest 1) (+ space-count 1)))
+ ((= space-count 0)
+ (split (string-append first (string-copy rest 0 1))
+ second
+ (string-copy rest 1)
+ space-count))
+ ((= space-count 1)
+ (split first
+ (string-append second (string-copy rest 0 1))
+ (string-copy rest 1)
+ space-count))
+ ((= space-count 2)
+ (list first (if (number? second)
+ (string->number second)
+ second)
+ rest))))))
+ (split "" "" line 0))))
+
+(define read-lines-until-empty
+ (lambda (port result)
+ (let ((line (read-line port)))
+ (if (string=? "" line)
+ result
+ (read-lines-until-empty port (append result (list line)))))))
+
+(define http-util-headers->string
+ (lambda (headers)
+ (apply string-append
+ (map
+ (lambda (header)
+ (string-append (symbol->string (car header))
+ ": "
+ (cdr header)
+ "\r\n"))
+ headers))))
+
+(define http-util-request-build
+ (lambda (type path headers body)
+ (string-append (string-upcase type)
+ " "
+ path
+ " "
+ "HTTP/1.1"
+ "\r\n"
+ (http-util-headers->string headers)
+ "\r\n"
+ body
+ "\r\n\r\n")))
+
+(define receive-all-from-socket
+ (lambda (socket)
+ (letrec ((looper (lambda (result-bytes)
+ (let ((bytes (socket-recv socket 4000)))
+ (if (or (eof-object? bytes)
+ (= (bytevector-length bytes) 0))
+ result-bytes
+ (looper (bytevector-append result-bytes bytes)))))))
+ (looper (bytevector)))))
+
+(define receive-http-request-from-socket
+ (lambda (socket)
+ (letrec* ((looper (lambda (result-bytes)
+ (let ((bytes (socket-recv socket 8)))
+ (if (or (eof-object? bytes)
+ (= (bytevector-length bytes) 0))
+ result-bytes
+ (begin
+ (display (utf8->string bytes))
+ (newline)
+ (looper (bytevector-append result-bytes bytes))))))))
+ (looper (bytevector)))))
+
+(define read-chunked-body
+ (lambda (port)
+ (letrec ((looper (lambda (body)
+ (let ((chunk-size (string-append "#x" (read-line port))))
+ (if (= (string->number chunk-size) 0)
+ body
+ (looper (string-append body
+ "\r\n"
+ (read-string (+ (string->number chunk-size) 2) port))))))))
+ (string->utf8 (looper "")))))
+
+(define http-util-read-http-response
+ (lambda (socket)
+ (let* ((response (receive-all-from-socket socket))
+ (port (open-input-string (utf8->string response)))
+ (status-line (http-util-status-line->list (read-line port)))
+ (headers (map http-util-header-line->pair (read-lines-until-empty port (list))))
+ (body (cond ((assoc 'content-length headers)
+ (read-bytevector (string->number (cdr (assoc 'content-length headers))) port))
+ ((and (assoc 'transfer-encoding headers)
+ (string=? (cdr (assoc 'transfer-encoding headers)) "chunked"))
+ (read-chunked-body port))
+ ((and (assoc 'connection headers)
+ (string=? (cdr (assoc 'connection headers)) "close"))
+ (letrec ((looper (lambda (result line)
+ (if (eof-object? line)
+ result
+ (looper (bytevector-append result line)
+ (read-bytevector 4000 port))))))
+ (looper (bytevector) (read-bytevector 4000 port))))
+ (else (bytevector)))))
+ (list (cons 'status-line status-line)
+ (cons 'protocol (list-ref status-line 0))
+ (cons 'status-code (string->number (list-ref status-line 1)))
+ (cons 'status-text (list-ref status-line 2))
+ (cons 'headers headers)
+ (cons 'body body)))))
+
+(define socket-receive-line
+ (lambda (socket)
+ (letrec ((looper (lambda (result-bytes)
+ (let ((byte (socket-recv socket 1)))
+ (cond ((= (bytevector-length byte) 0) result-bytes)
+ ((= (bytevector-u8-ref byte 0) slash-r)
+ (let ((next-byte (socket-recv socket 1)))
+ (if (or (= (bytevector-length next-byte) 0)
+ (= (bytevector-u8-ref next-byte 0) slash-n))
+ result-bytes
+ (looper (bytevector-append result-bytes byte next-byte)))))
+ (else (looper (bytevector-append result-bytes byte))))))))
+ (looper (bytevector)))))
+
+(define socket-receive-headers
+ (lambda (socket)
+ (letrec ((looper (lambda (result)
+ (let ((line (utf8->string (socket-receive-line socket))))
+ (if (string=? line "")
+ result
+ (looper (append result (list line))))))))
+ (map http-util-header-line->pair (looper (list))))))
+
+(define http-util-read-http-request
+ (lambda (socket)
+ (let* ((status-line (http-util-status-line->list (utf8->string (socket-receive-line socket))))
+ (headers (socket-receive-headers socket))
+ (body (let ((content-length (assoc 'content-length headers)))
+ (if content-length
+ (socket-recv socket (string->number (cdr content-length)))
+ ""))))
+ (list (cons 'status-line status-line)
+ (cons 'headers headers)
+ (list 'body body)))))
+
+(define http-util-download-file
+ (lambda (url path port headers output-file-path)
+ (let* ((headers-with-host (append headers
+ (list
+ (cons 'host
+ (string-append url ":" (number->string port))))))
+ (request (http-util-request-build "GET" path headers-with-host ""))
+ (socket (make-client-socket url (number->string port))))
+ (socket-send socket (string->utf8 request))
+ (let* ((socket-port (socket-input-port socket))
+ (status-line (http-util-status-line->list (read-line socket-port)))
+ (headers (map http-util-header-line->pair (read-lines-until-empty socket-port (list))))
+ (content-length (if (assoc 'content-length headers)
+ (string->number (cdr (assoc 'content-length headers)))
+ chunk-size))
+ (status-code (string->number (list-ref status-line 1))))
+ (if (not (= status-code 200))
+ (error (string-append "Could not download file from " url "/" path) headers))
+ (letrec* ((output-port (open-binary-output-file output-file-path))
+ (looper
+ (lambda (bytes)
+ (if (not (eof-object? bytes))
+ (begin
+ (write-bytevector bytes output-port)
+ (looper (read-bytevector chunk-size socket-port)))))))
+ (looper (read-bytevector content-length socket-port))
+ (close-port output-port)
+ (close-port socket-port)
+ (socket-close socket))))))
+
+(define http-util-request-make
+ (lambda (type url path port headers body)
+ (let* ((headers-with-host (append headers
+ (list
+ (cons 'host
+ (string-append url ":" (number->string port))))))
+ (request (http-util-request-build "GET" path headers-with-host body))
+ (socket (make-client-socket url (number->string port))))
+ (socket-send socket (string->utf8 request))
+ (let ((response (http-util-read-http-response socket)))
+ (socket-close socket)
+ response))))
+
+(define http-util-response-build
+ (lambda (code code-text headers body)
+ (let ((headers-with-content-length (append headers
+ (list (cons 'content-length
+ (number->string (string-length body)))))))
+
+ (string-append "HTTP/1.1"
+ " "
+ (number->string code)
+ " "
+ code-text
+ "\r\n"
+ (http-util-headers->string headers-with-content-length)
+ "\r\n"
+ body))))
+
+(define http-util-parameters-split
+ (lambda (body)
+ (cond ((and (string? body) (string=? "" body)) (list))
+ ((string? body) (let ((bodylist (string->list body)))
+ (map (lambda (x) (string-split x #\=))
+ (string-split (list->string
+ (if (string=? "?" (string (car bodylist)))
+ (cdr bodylist)
+ bodylist)) #\&))))
+ (else (list)))))
+
+(define http-util-parameter-get
+ (lambda (key params)
+ (let ((value #f))
+ (if (list? params)
+ (map (lambda (x)
+ (if (and (string? (car (cdr x)))
+ (string? (car x))
+ (string=? key (car x)))
+ (set! value (car (cdr x)))))
+ params))
+ value)))
diff --git a/retropikzel/http-util.sld b/retropikzel/http-util.sld
new file mode 100644
index 0000000..f7c167b
--- /dev/null
+++ b/retropikzel/http-util.sld
@@ -0,0 +1,20 @@
+(define-library
+ (retropikzel http-util)
+ (import (scheme base)
+ (scheme read)
+ (scheme write)
+ (scheme char)
+ (scheme file)
+ (srfi 106))
+ (export http-util-headers->string
+ http-util-header-line->pair
+ http-util-status-line->list
+ http-util-request-build
+ http-util-request-make
+ http-util-response-build
+ http-util-download-file
+ http-util-read-http-request
+ http-util-read-http-response
+ http-util-parameters-split
+ http-util-parameter-get)
+ (include "http-util.scm"))
diff --git a/retropikzel/url-encoding.scm b/retropikzel/url-encoding.scm
new file mode 100644
index 0000000..19d17e2
--- /dev/null
+++ b/retropikzel/url-encoding.scm
@@ -0,0 +1,59 @@
+(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")))
+
+(define decode-replacements (map reverse 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 (url-encode str) (cond ((string? str) (endecode "encode" str)) (else str)))
+(define (url-decode str) (cond ((string? str) (endecode "decode" str)) (else str)))
diff --git a/retropikzel/url-encoding.sld b/retropikzel/url-encoding.sld
new file mode 100644
index 0000000..1630274
--- /dev/null
+++ b/retropikzel/url-encoding.sld
@@ -0,0 +1,6 @@
+(define-library
+ (retropikzel url-encoding)
+ (import (scheme base))
+ (export url-encode
+ url-decode)
+ (include "url-encoding.scm"))
diff --git a/retropikzel/url-encoding/LICENSE b/retropikzel/url-encoding/LICENSE
new file mode 100644
index 0000000..0a04128
--- /dev/null
+++ b/retropikzel/url-encoding/LICENSE
@@ -0,0 +1,165 @@
+ GNU LESSER GENERAL PUBLIC LICENSE
+ Version 3, 29 June 2007
+
+ Copyright (C) 2007 Free Software Foundation, Inc.
+ 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.
diff --git a/retropikzel/url-encoding/README.md b/retropikzel/url-encoding/README.md
new file mode 100644
index 0000000..d60ebab
--- /dev/null
+++ b/retropikzel/url-encoding/README.md
@@ -0,0 +1 @@
+URL-encoding and decoding procedures
diff --git a/retropikzel/url-encoding/VERSION b/retropikzel/url-encoding/VERSION
new file mode 100644
index 0000000..3eefcb9
--- /dev/null
+++ b/retropikzel/url-encoding/VERSION
@@ -0,0 +1 @@
+1.0.0