commit 133c12c4366b3f23f00d5649e99d5292150bc185
parent 9c0cf13c0580d8bb1f99581694f30e19fc624d07
Author: Daniil Archangelsky <kiky.tokamuro@yandex.ru>
Date: Sat, 5 Mar 2022 15:37:25 +0300
Updated readme; Rewrited on Guile module; Changed "_IONBF" to 'none
Diffstat:
6 files changed, 107 insertions(+), 30 deletions(-)
diff --git a/README.md b/README.md
@@ -3,7 +3,13 @@ PS/TK version (http://mirror.informatimago.com/scheme/www.t3x.org/pstk/index.htm
### Install
1. Install the "tcl" and "tk" packages through your package manager.
-2. Copy pstk.scm to your project and load:
+2. Copy pstk.scm to your project and use:
```scheme
-(load "pstk.scm")
+(use-modules (pstk))
+```
+
+### Tested on
+```
+GNU Guile 3.0.1
+GNU Guile 2.2.7
```
diff --git a/examples/hello-color.scm b/examples/hello-color.scm
@@ -1,9 +1,12 @@
; PS/Tk Example Program "Hello World Color"
-; Copyright (C) 2021 Daniil Archangelsky aka Kiky Tokamuro
+; Copyright (C) 2021-2022 Daniil Archangelsky aka Kiky Tokamuro
; Copyright (C) 2006 Nils M Holm
; See the PS/Tk license for conditions of use.
-(load "../pstk.scm")
+(add-to-load-path "../")
+
+(use-modules (pstk))
+
(tk-start)
(let* ((label (tk 'create-widget 'label 'height: 5
'text: "Hello, World!" 'font: "Helvetica 20"
diff --git a/examples/hello.scm b/examples/hello.scm
@@ -1,9 +1,12 @@
; PS/Tk Example Program "Hello World"
-; Copyright (C) 2021 Daniil Archangelsky aka Kiky Tokamuro
+; Copyright (C) 2021-2022 Daniil Archangelsky aka Kiky Tokamuro
; Copyright (C) 2006 Nils M Holm
; See the PS/Tk license for conditions of use.
-(load "../pstk.scm")
+(add-to-load-path "../")
+
+(use-modules (pstk))
+
(tk-start)
(let* ((label (tk 'create-widget 'label
'width: 20
diff --git a/examples/themes.scm b/examples/themes.scm
@@ -1,9 +1,12 @@
; PS/Tk Example Program "Tile Themes"
-; Copyright (C) 2021 Daniil Archangelsky aka Kiky Tokamuro
+; Copyright (C) 2021-2022 Daniil Archangelsky aka Kiky Tokamuro
; Copyright (C) 2007 Nils M Holm
; See the PS/Tk license for conditions of use.
-(load "../pstk.scm")
+(add-to-load-path "../")
+
+(use-modules (pstk))
+
(tk-start)
(ttk-map-widgets 'all)
(let ((button
diff --git a/examples/ttt.scm b/examples/ttt.scm
@@ -1,9 +1,11 @@
; PS/Tk Example Program Tic Tac Toe
-; Copyright (C) 2021 Daniil Archangelsky aka Kiky Tokamuro
+; Copyright (C) 2021-2022 Daniil Archangelsky aka Kiky Tokamuro
; Copyright (C) 2006 Nils M Holm
; See the PS/Tk license for conditions of use.
-(load "../pstk.scm")
+(add-to-load-path "../")
+
+(use-modules (pstk))
(define Font "Courier 30")
@@ -18,23 +20,22 @@
(define Moves '(((_ o o) (o o o))
((o _ o) (o o o))
- ((o o _) (o o o))
- ((_ x x) (o x x))
- ((x _ x) (x o x))
- ((x x _) (x x o))
- ((_ x _) (o x _))
- ((_ _ x) (_ o x))
- ((x _ _) (x o _))
- ((_ x o) (o x o))
- ((_ o x) (o o x))
- ((x _ o) (x o o))
- ((x o _) (x o o))
- ((o _ x) (o o x))
- ((o x _) (o x o))
- ((_ _ o) (o _ o))
- ((_ o _) (o o _))
- ((o _ _) (o _ o))
- ((_ _ _) (_ o _))))
+ ((o o _) (o o o))
+ ((_ x x) (o x x))
+ ((x _ x) (x o x))
+ ((x x _) (x x o))
+ ((_ x _) (o x _))
+ ((_ _ x) (_ o x))
+ ((x _ _) (x o _))
+ ((_ x o) (o x o))
+ ((_ o x) (o o x))
+ ((x _ o) (x o o))
+ ((x o _) (x o o))
+ ((o _ x) (o o x))
+ ((o x _) (o x o))
+ ((_ _ o) (o _ o))
+ ((o _ _) (o _ o))
+ ((_ _ _) (_ o _))))
(define pattern car)
(define subst cadr)
diff --git a/pstk.scm b/pstk.scm
@@ -1,5 +1,5 @@
; PS/Tk -- A Portable Scheme Interface to the Tk GUI Toolkit
-; Copyright (C) 2021 Daniil Archangelsky aka Kiky Tokamuro
+; Copyright (C) 2021-2022 Daniil Archangelsky aka Kiky Tokamuro
; Copyright (C) 2008 Kenneth A Dickey
; Copyright (C) 2006-2008 Nils M Holm
; Copyright (C) 2004 Wolf-Dieter Busch
@@ -62,6 +62,8 @@
; Thank you!
;
; Change Log:
+; 2022-03-05 Rewrited on Guile module
+; Changed "_IONBF" to 'none
; 2021-12-01 Deleted all non Guile sections.
; Changed "set-batch-mode?!" to "ensure-batch-mode!".
; Deleted the "bottom" function call.
@@ -97,6 +99,65 @@
; 2006-12-02 Added Scheme 48 port, portable GENSYM, R5RS fixes.
; 2006-12-02 Added PLT/Windows port.
+(define-module (pstk)
+ #:export (*wish-program*
+ *wish-debug-input*
+ *wish-debug-output*
+ tk
+ tk-dispatch-event
+ tk-end
+ tk-eval
+ tk-event-loop
+ tk-get-var
+ tk-id->widget
+ tk-set-var!
+ tk-start
+ tk-var
+ tk-wait-for-window
+ tk-wait-until-visible
+ tk-with-lock
+ tk/after
+ tk/appname
+ tk/bell
+ tk/bgerror
+ tk/bind
+ tk/bindtags
+ tk/caret
+ tk/choose-color
+ tk/choose-directory
+ tk/clipboard
+ tk/destroy
+ tk/dialog
+ tk/event
+ tk/focus
+ tk/focus-follows-mouse
+ tk/focus-next
+ tk/focus-prev
+ tk/get-open-file
+ tk/get-save-file
+ tk/grab
+ tk/grid
+ tk/image
+ tk/lower
+ tk/message-box
+ tk/option
+ tk/pack
+ tk/place
+ tk/popup
+ tk/raise
+ tk/scaling
+ tk/selection
+ tk/update
+ tk/useinputmethods
+ tk/wait
+ tk/windowingsystem
+ tk/winfo
+ tk/wm
+ ttk-map-widgets
+ ttk/available-themes
+ ttk/set-theme
+ ttk/style))
+
(use-modules (srfi srfi-88))
(define *wish-program* "tclsh")
@@ -266,8 +327,8 @@
(lambda (prog . args)
(let ((c2p (pipe))
(p2c (pipe)))
- (setvbuf (cdr c2p) _IONBF)
- (setvbuf (cdr p2c) _IONBF)
+ (setvbuf (cdr c2p) 'none)
+ (setvbuf (cdr p2c) 'none)
(let ((pid (primitive-fork)))
(cond ((= pid 0)
(ensure-batch-mode!)
