Making pstk to work on more implementations

.gitignore

@@ -19,5 +19,6 @@ test-r7rs.scm
 test-r7rs
 *.html
 *.rkt
+example.scm
+example.sps
 example
-

Makefile

@@ -1,9 +1,9 @@
 .SILENT: build install test-r6rs test-r6rs-docker test-r7rs test-r7rs-docker clean
-.PHONY: test-r6rs test-r7rs
+.PHONY: test-r6rs test-r7rs example.scm example.sps
 SCHEME=chibi
 LIBRARY=system
 EXAMPLE=editor
-EXAMPLE_FILE=retropikzel/${LIBRARY}/examples/${EXAMPLE}.scm
+EXAMPLE_FILE=retropikzel/${LIBRARY}/examples/${EXAMPLE}
 AUTHOR=Retropikzel
 
 LIBRARY_FILE=retropikzel/${LIBRARY}.sld
@@ -42,8 +42,11 @@ test-r7rs-docker:
 	docker build --build-arg IMAGE=${DOCKERIMG} --build-arg SCHEME=${SCHEME} --tag=foreign-c-library-test-${SCHEME} --quiet .
 	docker run -t foreign-c-library-test-${SCHEME} sh -c "make SCHEME=${SCHEME} LIBRARY=${LIBRARY} SNOW_CHIBI_ARGS=--always-yes build install test-r7rs"
 
-example-r7rs: ${EXAMPLE_FILE}
+example.scm: ${EXAMPLE_FILE}.scm
-	COMPILE_R7RS=${SCHEME} compile-scheme -I . -o example ${EXAMPLE_FILE}
+	cp ${EXAMPLE_FILE}.scm example.scm
+
+example-r7rs: example.scm
+	COMPILE_R7RS=${SCHEME} compile-scheme -I . -o example example.scm
 	./example
 
 test-r6rs:
@@ -58,5 +61,13 @@ test-r6rs-docker:
 	docker build --build-arg IMAGE=${DOCKERIMG} --build-arg SCHEME=${SCHEME} --tag=foreign-c-library-test-${SCHEME} --quiet .
 	docker run -t foreign-c-library-test-${SCHEME} sh -c "make SCHEME=${SCHEME} LIBRARY=${LIBRARY} test-r6rs"
 
+example.sps: ${EXAMPLE_FILE}.sps
+	cp ${EXAMPLE_FILE}.scm example.sps
+
+example-r6rs: example.sps
+	akku install akku-r7rs "(foreign c)"
+	COMPILE_R7RS=${SCHEME} compile-scheme -I .akku/lib -o example example.sps
+	./example
+
 clean:
 	git clean -X -f

retropikzel/pstk.scm

@@ -41,12 +41,7 @@
 (define *wish-debug-input* (if (get-environment-variable "PSTK_DEBUG") #t #f))
 (define *wish-debug-output* (if (get-environment-variable "PSTK_DEBUG") #t #f))
 
-(define *use-keywords?*
+(define *use-keywords?* #t)
-  (cond-expand (chicken #t)
-               (else (or (not (symbol? 'text:))
-                         (not (symbol? ':text))
-                         (string=? "text" (symbol->string 'text:))
-                         (string=? "text" (symbol->string ':text))))))
 
 (define (keyword? x) #f)        ;; TODO: handle keywords?
 (define (keyword->string x) x)

retropikzel/pstk.sld

@@ -105,6 +105,7 @@
           (scheme read)
           (scheme file)
           (scheme write)
+          (scheme process-context)
           (foreign c)
           (retropikzel named-pipes))
   (export tk-eval

retropikzel/pstk/VERSION

@@ -1 +1 @@
-1.0.4
+1.0.5

retropikzel/pstk/examples/editor.scm

@@ -39,7 +39,7 @@
               (display k)
               (newline)
               (display "Text: ")
-              (write (text 'get 1.0 'end))
+              (write (text 'get `(1.0 end)))
               (newline)
               #f)
             %k))

retropikzel/pstk/examples/editor.sps

@@ -0,0 +1,46 @@
+(import (rnrs)
+        (retropikzel pstk))
+
+(define tk (tk-start))
+(define text (tk 'create-widget 'text))
+(define open-file #f)
+
+(define (new-button-proc a)
+  (let ((dir (tk/choose-directory 'initialdir: "/tmp"
+                                  'mustexist: #t)))
+                    (display "Directory: ")
+                    (write dir)
+                    (newline)))
+(define new-button
+  (tk 'create-widget 'button 'text: "New" 'command: `(,new-button-proc 10)))
+
+(define (open-button-proc)
+  (tk/message-box 'message:
+                  "Warning! This editor is an example. Do not open any important files with it.")
+  (set! open-file (tk/get-open-file 'initialdir: "/tmp")))
+(define open-button
+  (tk 'create-widget 'button 'text: "Open" 'command: open-button-proc))
+
+(define (save-button-proc)
+                  (display "Saving file: ")
+                  (write open-file)
+                  (newline))
+(define save-button
+  (tk 'create-widget 'button 'text: "Save" 'command: save-button-proc))
+
+;(tk/pack text new-button open-button save-button 'padx: 20 'pady: 20)
+(tk/pack text 'padx: 20 'pady: 20)
+
+(tk/bind 'all
+         "<Key>"
+         `(,(lambda (k)
+              (display "Key code: ")
+              (display k)
+              (newline)
+              (display "Text: ")
+              (write (text 'get `(1.0 end)))
+              (newline)
+              #f)
+            %k))
+
+(tk-event-loop tk)