diff --git a/.gitignore b/.gitignore index ccacbea..d23927a 100644 --- a/.gitignore +++ b/.gitignore @@ -19,4 +19,5 @@ test-r7rs.scm test-r7rs *.html *.rkt +example diff --git a/Makefile b/Makefile index ef76818..9355dea 100644 --- a/Makefile +++ b/Makefile @@ -2,6 +2,8 @@ .PHONY: test-r6rs test-r7rs SCHEME=chibi LIBRARY=system +EXAMPLE=editor +EXAMPLE_FILE=retropikzel/${LIBRARY}/examples/${EXAMPLE}.scm AUTHOR=Retropikzel LIBRARY_FILE=retropikzel/${LIBRARY}.sld @@ -40,6 +42,10 @@ 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} + COMPILE_R7RS=${SCHEME} compile-scheme -I . -o example ${EXAMPLE_FILE} + ./example + test-r6rs: echo "(import (rnrs) (foreign c) (retropikzel ${LIBRARY}) (srfi :64))" > test-r6rs.sps cat retropikzel/${LIBRARY}/test.scm >> test-r6rs.sps diff --git a/retropikzel/pstk.scm b/retropikzel/pstk.scm index 2fc086d..d4259cd 100644 --- a/retropikzel/pstk.scm +++ b/retropikzel/pstk.scm @@ -28,8 +28,8 @@ output-path " 1> " input-path - " 2> " - input-path + ;" 2> " + ;input-path " & "))) (create-pipe input-path 0777) (create-pipe output-path 0777) @@ -38,8 +38,8 @@ (open-output-pipe output-path)))) (define *wish-program* "tclsh") -(define *wish-debug-input* #f) -(define *wish-debug-output* #f) +(define *wish-debug-input* #t) +(define *wish-debug-output* #t) (define *use-keywords?* (cond-expand (chicken #t) @@ -200,7 +200,7 @@ (improper-list->string x #t)) ")")) ((eof-object? x) "#") - (else "#")))) + (else "#")))) (define string-translate (lambda (s map) @@ -487,7 +487,7 @@ (report-error (string-append "An error occurred inside Tcl/Tk" nl " --> " (form->string result) - " " (wish-read-line wish-output) + " " (form->string (wish-read-line wish-output)) ))) ((eq? (car result) 'return) (cadr result)) diff --git a/retropikzel/pstk.sld b/retropikzel/pstk.sld index c0effd6..0866946 100644 --- a/retropikzel/pstk.sld +++ b/retropikzel/pstk.sld @@ -63,7 +63,7 @@ ; Thank you! ; ; Change Log: -; 2025-06-08 MAde to work with named pipes and foreign-c library +; 2025-06-08 Made to work with named pipes and foreign-c library ; 2017-05-11 Optional argument to 'start' for input of wish/tclsh program name. ; 2017-05-11 Converted into an R7RS library with Chibi, Gauche and Sagittarius support. ; 2008-06-22 Added Larceny Scheme support. @@ -100,10 +100,18 @@ (define-library (retropikzel pstk) + (import (scheme base) + (scheme cxr) + (scheme read) + (scheme file) + (scheme write) + (foreign c) + (retropikzel named-pipes)) (export tk-eval tk-id->widget tk-var tk-get-var + tk-set-var! tk-start tk-end tk-dispatch-event @@ -152,12 +160,5 @@ ttk/available-themes ttk/set-theme ttk/style) - (import (scheme base) - (scheme cxr) - (scheme read) - (scheme file) - (scheme write) - (foreign c) - (retropikzel named-pipes)) (include "pstk.scm")) diff --git a/retropikzel/pstk/README.md b/retropikzel/pstk/README.md index 3c58823..70dec60 100644 --- a/retropikzel/pstk/README.md +++ b/retropikzel/pstk/README.md @@ -12,41 +12,6 @@ The library now uses (retropikzel named-pipes) library, which uses (foreign c) underneath. It should work on any implementation those libraries work on. -The rest of this document is the original readme, cleaned up from HTML to markdown. - - - -# Documentation for PS/Tk - -For more information -including compatibility, examples and test cases, see -[https://github.com/petercrlane/r7rs- -libs](https://github.com/petercrlane/r7rs-libs) ## 1. PS/Tk: Tk Graphical User -Interface Toolkit To use the library: (import (rebottled pstk)) The PS/Tk -library enables a Scheme program to interact with Tk, to create cross-platform -graphical user interfaces. Virtually all of Tcl/Tk is available through -Scheme. Other examples of using Tk in this way include [LTk](http://www.peter- -herth.de/ltk/) from Lisp, [Tkinter](https://wiki.python.org/moin/TkInter) from -Python, Perl/Tk and Ruby/Tk. PS/Tk must communicate with the separate Tcl/Tk -program, a process managed in an implementation-specific manner. The current -R7RS version of PS/Tk has support for, and has been tested on, the following: -\- Chibi Scheme: under Linux (calls to "/bin/sh") \- Gauche Scheme: under -Linux (calls to "/bin/sh") \- Sagittarius Scheme: under Linux and Windows. -(Should work on Mac OS too.) Further Scheme versions or platforms can be added -by extending the `cond-expand` statement in the source code. For more -information: \- Several small examples of using the library are available from -[a github repository](https://github.com/petercrlane/r7rs- -libs/tree/master/rebottled-examples/pstk) \- Some notes on using PS/Tk with -Sagittarius Scheme on Linux and Windows: [http://peterlane.info/notes/gui- -programs-with-sagittarius-scheme.html](http://peterlane.info/notes/gui- -programs-with-sagittarius-scheme.html) \- Documentation about Tk: -[https://www.tcl.tk/man/tcl8.6/TkCmd/contents.htm"](https://www.tcl.tk/man/tcl8.6/TkCmd/contents.htm) -\- Some documentation on using Tk from various languages: -[http://www.tkdocs.com/](http://www.tkdocs.com/) -![http://peterlane.info/images/pstk- -win.jpg](http://peterlane.info/images/pstk-win.jpg) - - ### 1.1. Simple Example @@ -73,9 +38,6 @@ Get started with the following program: 4. Starts the TK event loop. -![http://peterlane.info/images/pstk- -hello.png](http://peterlane.info/images/pstk-hello.png) - ### 1.2. Working with Widgets @@ -91,13 +53,13 @@ parent widget and provide some structure. In PS/Tk we instead represent widgets as functions; these functions take a _command_ and associated arguments. Commands that the widgets respond to include: - * get-id: returns the Tk id + * get-id: returns the Tk id - * create-widget: used to create a child widget + * create-widget: used to create a child widget - * configure: used to alter parameters of a widget + * configure: used to alter parameters of a widget - * cget: returns value of a configuration option + * cget: returns value of a configuration option For example, having created a button, we can later change the displayed text using `configure`, or retrieve the text using `cget`: @@ -145,11 +107,7 @@ Tcl's "1"/"0", symbols can be used in place of strings, etc. Creating a widget is done through the `create-widget` command mentioned above: - - button .hello -text Hello -command {puts stdout "Hello world"} - - (define hello (tk 'create-widget 'button 'text: "Hello" @@ -169,8 +127,6 @@ This use of symbols as commands arises elsewhere, for example with `winfo`: winfo screenwidth . # TCL version - - (tk/winfo 'screenwidth tk) ; Scheme version All the Tk widgets can be created and used in this way. For a list of @@ -190,6 +146,7 @@ These functions map directly onto underlying Tk functions. The names start + #### 1.3.1. `tk/after` `tk/after` takes a time in milliseconds and an optional function. After the @@ -207,12 +164,13 @@ in the new position and repeating. (tk/after 1000 (lambda () (hands canvas)))) + + + #### 1.3.2. `tk/appname` `tk/appname` gets or sets the application name. - - sash> (tk/appname) "tclsh" sash> (tk/appname "new name set") @@ -220,36 +178,47 @@ in the new position and repeating. sash> (tk/appname) "new name set" + + + #### 1.3.3. `tk/bell` `tk/bell` rings the bell. + + + #### 1.3.4. `tk/bgerror` `tk/bgerror` is used to tell the Tcl process that an error has occurred. -#### 1.3.5. `tk/bind` + + + +#### 1.3.5. `tk/bind!` `tk/bind` binds actions to events. For example, a function can be called when a mouse button is clicked, or a key pressed. First argument is a window, or the symbol `all`; second argument is the pattern for the event to bind to; and third argument is the function to call. - - (tk/bind 'all "" `(,(lambda (x) (display x) (newline) #f) %x)) + + + #### 1.3.6. `tk/bindtags` `tk/bindtags` gets or sets the binding tags of a given window. + + + #### 1.3.7. `tk/caret` `tk/caret` is used to query or set the current caret position in a given window. - - sash> (tk/caret tk) ; **< 1>** "-height 0 -x 0 -y 0" sash> (tk/caret tk 'height: 10 'x: 2 'y: 3) ; **< 2>** @@ -259,40 +228,39 @@ window. 2. Sets the height or x/y position of the caret in the given window. + + + #### 1.3.8. `tk/choose-color` `tk/choose-color` opens a dialog from which to select a colour. Returns the RGB code of the selected colour, or "" if cancel is clicked. - - sash> (tk/choose-color) "#7ce679" -![http://peterlane.info/images/color- -chooser.png](http://peterlane.info/images/color-chooser.png) - Optional parameters let you select the `initialcolor` `parent` and `title`. See the Tk documentation for details: + + + #### 1.3.9. `tk/choose-directory` `tk/choose-directory` opens a dialog from which to select a directory. Returns the directory name as a string or "" if cancel is clicked. - - sash> (tk/choose-directory) "/home/peter/Software/r7rs-libs" -![http://peterlane.info/images/directory- -chooser.png](http://peterlane.info/images/directory-chooser.png) - Optional parameters let you select the `initialdir` `parent` `title` and whether the chosen directory must exist. See the Tk documentation for details: + + + #### 1.3.10. `tk/clipboard` `tk/clipboard` provides access to the clipboard, with its parameter specifying @@ -301,10 +269,16 @@ an action: `append` `clear` `get` See Tk documentation for details: + + + #### 1.3.11. `tk/destroy` `tk/destroy` deletes the window or windows given as arguments. + + + #### 1.3.12. `tk/event` `tk/event` is used to create and manage events. @@ -312,6 +286,8 @@ See Tk documentation for details: See the Tk documentation for details: + + #### 1.3.13. `tk/focus` `tk/focus` manages the input focus. @@ -319,55 +295,63 @@ See the Tk documentation for details: See the Tk documentation for details: + + + #### 1.3.14. `tk/focus-follows-mouse` `tk/focus-follows-mouse` changes the focus status so it follows the mouse rather than changes with a click. + + + #### 1.3.15. `tk/focus-next` `tk/focus-next` returns the next window from the given window, in the focus order. + + + #### 1.3.16. `tk/focus-prev` `tk/focus-prev` returns the previous window from the given window, in the focus order. + + + #### 1.3.17. `tk/get-open-file` `tk/get-open-file` opens a dialog from which the user can select a file. Returns the file path in a string or "" if cancel is clicked. - - sash> (tk/get-open-file) "/home/peter/Software/r7rs-libs/rebottled-examples/pstk/example-menu.sps" -![http://peterlane.info/images/pstk-open-file- -chooser.png](http://peterlane.info/images/pstk-open-file-chooser.png) - Optional parameters let you select the `initialdir` `parent` `title` `filetypes` etc. See the Tk documentation for details: + + + #### 1.3.18. `tk/get-save-file` `tk/get-save-file` opens a dialog from which the user can select a file. Returns the file path in a string or "" if cancel is clicked. - - sash> (tk/get-save-file) "/home/peter/Software/r7rs-libs/rebottled-examples/pstk/newfile.txt" -![http://peterlane.info/images/pstk-save-file- -chooser.png](http://peterlane.info/images/pstk-save-file-chooser.png) - Optional parameters let you select the `initialdir` `parent` `title` `filetypes` etc. See the Tk documentation for details: + + + #### 1.3.19. `tk/grab` `tk/grab` provides a way to redirect mouse or keyboard events to specific @@ -376,6 +360,9 @@ windows. See Tk documentation for details: + + + #### 1.3.20. `tk/grid` `tk/grid` is the first of three techniques used to place widgets within a @@ -385,8 +372,6 @@ can be used to arrange widgets by row and column. The following sample, taken from the example "example-temp-conversion.sps" illustrates some of the possibilities: - - (tk/grid celsius 'column: 2 'row: 1 'sticky: 'we 'padx: 5 'pady: 5) ; **< 1>** (tk/grid label 'column: 2 'row: 2 'sticky: 'we 'padx: 5 'pady: 5) ; **< 2>** (tk/grid button 'column: 2 'row: 3 'sticky: 'we 'padx: 5 'pady: 5) @@ -407,18 +392,16 @@ illustrates some of the possibilities: The final layout is: -![http://peterlane.info/images/pstk- -temp.png](http://peterlane.info/images/pstk-temp.png) - For more of the many options, see: + + + #### 1.3.21. `tk/image` `tk/image` used to create, delete and query images. - - sash> (define im (tk/image 'create 'photo 'file: "doc/pstk-hello.png")) ; **< 1>** # sash> (tk/pack (tk 'create-widget 'label 'image: im)) ; **< 2>** @@ -428,17 +411,20 @@ For more of the many options, see: 2. Puts the image onto a label in the current frame. -![http://peterlane.info/images/pstk- -image.png](http://peterlane.info/images/pstk-image.png) - See the Tk documentation for more details: + + + #### 1.3.22. `tk/lower` `tk/lower` lowers the given window below all its siblings in the current stacking order. + + + #### 1.3.23. `tk/message-box` `tk/message-box` displays a Tk message box. These dialogs can be @@ -446,45 +432,38 @@ straightforward or display a range of options and an icon. The simplest information box shows a given message, and adds an "OK" button: - - sash> (tk/message-box 'message: "Hello") "ok" ; **< 1>** 1. The function returns the string label of the clicked button. -![http://peterlane.info/images/pstk- -box1.png](http://peterlane.info/images/pstk-box1.png) - We can also add a title to the box, and select an icon from one of: `(error info question warning)` The type of box specifies the buttons. The choices are: - * "abortretryignore" - which displays three buttons, "abort" "retry" "ignore" + * "abortretryignore" - which displays three buttons, "abort" "retry" "ignore" - * "ok" - which displays one button "ok" + * "ok" - which displays one button "ok" - * "okcancel" - which displays two buttons "ok" or "cancel" + * "okcancel" - which displays two buttons "ok" or "cancel" - * "retrycancel" + * "retrycancel" - * "yesno" + * "yesno" - * "yesnocancel" + * "yesnocancel" - - sash> (tk/message-box 'title: "Error on opening file" 'icon: 'question 'message: "What to do now?" 'type: "abortretryignore") "ignore" sash> (tk/message-box 'title: "Error on opening file" 'icon: 'question 'message: "What to do now?" 'type: "abortretryignore") "abort" -![http://peterlane.info/images/pstk- -box2.png](http://peterlane.info/images/pstk-box2.png) - For a full set of options, see the Tk documentation: + + + #### 1.3.24. `tk/option` `tk/option` is used to add or retrieve window options to or from the option @@ -493,45 +472,59 @@ database. For details see the Tk documentation: + + + #### 1.3.25. `tk/pack` `tk/pack` is the second of three techniques used to place widgets within a frame. - - (tk/pack command ...) The tk `pack` command takes a number of options to control the order and spacing of widgets placed within a frame. For the Tk documentation, see: + + + #### 1.3.26. `tk/place` `tk/place` is the third of three techniques used to place widgets within a frame. It provides a way to place widgets at specific coordinates. For the Tk documentation, see: + + + #### 1.3.27. `tk/popup` `tk/popup` takes three arguments, a menu and x/y coordinates. The function pops up a menu at the given position. + + + #### 1.3.28. `tk/raise` `tk/raise` raises the given window above its siblings in the current stacking order. + + + #### 1.3.29. `tk/scaling` `tk/scaling` is used to get or set the number of pixels per point on a display. An optional `displayof` argument is used to specify a window. - - sash> (tk/scaling) "1.3333333333333333" + + + #### 1.3.30. `tk/selection` `tk/selection` provides access to the X selection (e.g. text highlighted with @@ -540,30 +533,32 @@ the mouse). In the following image, the text "get-save" was highlighted with the mouse, and returned by calling the function with the symbol `'get`: -![http://peterlane.info/images/pstk- -selection.png](http://peterlane.info/images/pstk-selection.png) + + #### 1.3.31. `tk/update` `tk/update` updates any pending events - "Use with extreme care" (Nils Holm) + + + #### 1.3.32. `tk/useinputmethods` `tk/useinputmethods` is used for XIM filtering. According to the [Tcl wiki](http://wiki.tcl.tk/8695), this is useful in some locales, such as Japanese or Korean, to use particular input devices. This only works under X. - - (tk/useinputmethods ['displayof: window] [boolean]) For querying: - - sash> (tk/useinputmethods) "1" + + + #### 1.3.33. `tk/wait` `tk/wait` is a general-purpose wait function, where the arguments specify @@ -574,22 +569,24 @@ for changes to variables. See the Tk documentation for details: + + + #### 1.3.34. `tk/windowingsystem` `tk/windowingsystem` returns a string naming the underlying window system. - - sash> (tk/windowingsystem) "x11" + + + #### 1.3.35. `tk/winfo` `tk/winfo` is used to find out information about windows currently being managed by tk. For example, the screen width and height can be found using: - - sash> (tk/winfo 'screenwidth tk) "1920" ; **< 1>** sash> (tk/winfo 'screenheight tk) @@ -599,8 +596,6 @@ managed by tk. For example, the screen width and height can be found using: Similarly, information about a named window: - - sash> (tk/winfo 'x tk) "860" sash> (tk/winfo 'y tk) @@ -609,30 +604,34 @@ Similarly, information about a named window: There are many kinds of information that may be queried. For a full list, see the Tk documentation: + + + #### 1.3.36. `tk/wm` `tk/wm` is used to communicate with the Window Manager of the operating system. A simple use is to set the title of the top-most window: - - (tk/wm 'title tk "GMT Clock") More complex uses include fixing a window's size, specifying an operating- system-specific window type or setting an icon. For the Tk documentation, see: + + + #### 1.3.37. `ttk/available-themes` `ttk/available-themes` returns a list of the available themes. - - sash> (define tk (tk-start)) # sash> (ttk/available-themes) ("clam" "alt" "default" "classic") + + #### 1.3.38. `ttk-map-widgets` Tile is an alternative set of widgets for Tk supporting a more attractive set @@ -641,64 +640,73 @@ of themes as well as some additional widgets, such as a treeview. `ttk-map-widgets` is used to map native Tk widgets to their TTk equivalents. To use all the Tile widgets, call: - - (ttk-map-widgets 'all) (A value of `none` will not use any Tile widgets. Alternatively, list the specific widgets you want to map.) + + + #### 1.3.39. `ttk/set-theme` `ttk/set-theme` is used to set the theme to one of those available. - - sash> (ttk/set-theme "classic") "" + + + #### 1.3.40. `ttk/style` `ttk/style` is used to query or change the Tk style database. For the Tk documentation, see: + + ### 1.4. PS/Tk Functions These functions are included within the library but do not have direct Tk equivalents. (The function names start "tk-".) + + + #### 1.4.1. `tk-end` `tk-end` is used to shutdown the Tk process, and effectively end the program. - - (tk-end) + + + #### 1.4.2. `tk-eval` `tk-eval` evaluates a piece of TCL code, provided as a string. - - sash> (tk-eval "bell") "" sash> (tk-eval "puts 3") - An error occurred inside Tcl/Tk --> 3 # + + + #### 1.4.3. `tk-event-loop` `tk-event-loop` is used to enter the TK event loop. It takes the `tk` value returned from `tk-start` as a parameter, and does not end until `tk-end` is called. - - (tk-event-loop tk) + + + #### 1.4.4. `tk-start` `tk-start` is used to initiate the Tk process. It returns a function used to @@ -712,6 +720,9 @@ Linux, this program is "tclsh", but for easy distribution, you may wish to use 1. Starts the Tk program called "tclkit" and stores the result in the `tk` variable. + + + #### 1.4.5. `tk-var` `tk-get-var` `tk-set-var!` These three functions work as a group and deal with how variables are linked @@ -738,45 +749,30 @@ For example: 3. Retrieves the `cb-value` value to display the check button's state + + + #### 1.4.6. `tk-wait-for-window` `tk-wait-for-window` waits until the given window is destroyed (such as a dialog being closed). + + + #### 1.4.7. `tk-wait-until-visible` `tk-wait-until-visible` waits until the given window becomes visible. + + + #### 1.4.8. `tk-with-lock` `tk-with-lock` is used to protect functions which are working with state in a multi-threaded environment. - - (tk 'create-widget 'button 'command: (lambda () (tk-with-lock (lambda () do-something-critical)))) - -### 1.5. History - -The PSTK library has had a long history in the Scheme community and, in one -form or another, is available for many Scheme implementations. The current -file includes its history starting from an implementation of Chicken/Tk by -Wolf-Dieter Busch from 2004 based on earlier code by Sven Hartrumpf from 1997. -Nils Holm made the library portable, and so created PSTK. Ken Dickey created -an R6RS version. - -Some links to versions for other Scheme implementations and documentation: - - * - - * - - * - -* * * - -Last updated 2017-05-28 12:19:25 BST - diff --git a/retropikzel/pstk/examples/editor.scm b/retropikzel/pstk/examples/editor.scm new file mode 100644 index 0000000..7eb7ccc --- /dev/null +++ b/retropikzel/pstk/examples/editor.scm @@ -0,0 +1,47 @@ +(import (scheme base) + (scheme write) + (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 + "" + `(,(lambda (k) + (display "Key code: ") + (display k) + (newline) + (display "Text: ") + (write (text 'get 1.0 'end)) + (newline) + #f) + %k)) + +(tk-event-loop tk)