diff --git a/retropikzel/gtk-server.scm b/retropikzel/gtk-server.scm new file mode 100644 index 0000000..764bf5d --- /dev/null +++ b/retropikzel/gtk-server.scm @@ -0,0 +1,49 @@ +(define-c-library libc + '("stdlib.h" "stdio.h" "unistd.h") + libc-name + '((additional-versions ("0" "6")))) +(define-c-procedure c-tempnam libc 'tempnam 'pointer '(pointer pointer)) +(define temp-prefix (string->c-utf8 "scmgtk")) +(define (temp-name) (c-utf8->string (c-tempnam (make-c-null) temp-prefix))) +(define gtk-server-display pipe-write-string) +(define gtk-server-newline (lambda (pipe) (pipe-write-char #\newline pipe))) +(define (gtk-server-read-line pipe) + (let ((result (pipe-read-line pipe))) + (if (eof-object? result) + (gtk-server-read-line pipe) + result))) +(define input-path (temp-name)) +(define output-path (temp-name)) +(define (run-program program) + (let* ((shell-command (string-append program + " < " + output-path + " 1> " + input-path + " 2> " + input-path + " & "))) + (create-pipe input-path 0777) + (create-pipe output-path 0777) + (system shell-command) + (list (open-input-pipe input-path) + (open-output-pipe output-path)))) + +(define gtk-server-input #f) +(define gtk-server-output #f) + +(define gtk-server-start + (lambda log-file + (let ((pipes (if (null? log-file) + (run-program "gtk-server -stdin") + (run-program (string-append "gtk-server " + "-log=" (car log-file) + " -stdin"))))) + (set! gtk-server-input (cadr pipes)) + (set! gtk-server-output (car pipes))))) + + +(define (gtk command) + (gtk-server-display (string-append command (string #\newline)) + gtk-server-input) + (gtk-server-read-line gtk-server-output)) diff --git a/retropikzel/gtk-server.sld b/retropikzel/gtk-server.sld new file mode 100644 index 0000000..9dae49f --- /dev/null +++ b/retropikzel/gtk-server.sld @@ -0,0 +1,11 @@ +(define-library + (retropikzel gtk-server) + (import (scheme base) + (scheme write) + (scheme file) + (foreign c) + (retropikzel system) + (retropikzel named-pipes)) + (export gtk-server-start + gtk) + (include "gtk-server.scm")) diff --git a/retropikzel/gtk-server/LICENSE b/retropikzel/gtk-server/LICENSE new file mode 100644 index 0000000..0a04128 --- /dev/null +++ b/retropikzel/gtk-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/gtk-server/README.md b/retropikzel/gtk-server/README.md new file mode 100644 index 0000000..f39472d --- /dev/null +++ b/retropikzel/gtk-server/README.md @@ -0,0 +1,11 @@ +Scheme library for using [gtk-server](https://www.gtk-server.org). + +## Documentation + +(**gtk-server-start** _[log-path]_) + +Start gtk-server. + +(**gtk** _command_) + +Send command to the gtk-server, returns the server response as string. diff --git a/retropikzel/gtk-server/VERSION b/retropikzel/gtk-server/VERSION new file mode 100644 index 0000000..d917d3e --- /dev/null +++ b/retropikzel/gtk-server/VERSION @@ -0,0 +1 @@ +0.1.2 diff --git a/retropikzel/gtk-server/test.scm b/retropikzel/gtk-server/test.scm new file mode 100644 index 0000000..f0951d2 --- /dev/null +++ b/retropikzel/gtk-server/test.scm @@ -0,0 +1,47 @@ +(import (scheme base) + (scheme write) + (scheme process-context) + (retropikzel system) + (retropikzel named-pipes) + (retropikzel gtk-server)) + +(gtk-server-start "/tmp/scheme-gtkserver.log") + +(define gtk-server-version (gtk "gtk_server_version")) +(display gtk-server-version) +(newline) + +(gtk "gtk_init NULL NULL") +(define window (gtk "gtk_window_new 0")) +(gtk (string-append "gtk_window_set_title " window " 'Scheme gtk-server test'")) +(gtk (string-append "gtk_window_set_default_size " window " 400 200")) +(gtk (string-append "gtk_window_set_position " window " 1")) + +(define button (gtk "gtk_button_new_with_label 'Click to Quit'")) + +(define table (gtk "gtk_table_new 10 10 1")) +(gtk (string-append "gtk_table_attach_defaults " table " " button " 5 9 7 9")) + +(define entry (gtk "gtk_entry_new")) +(gtk (string-append "gtk_table_attach_defaults " table " " entry " 1 6 3 4")) +(gtk (string-append "gtk_container_add " window " " table)) + + +(gtk (string-append "gtk_widget_show_all " window)) + +(define (main event) + (when (not (string=? event "0")) + (display "Event: ") + (display event) + (newline) + (when (string=? entry event) + (display "You wrote: ") + (display (gtk (string-append "gtk_entry_get_text " entry))) + (newline)) + (when (string=? button event) (exit 0))) + (gtk "gtk_main_iteration") + (main (gtk "gtk_server_callback WAIT"))) + +(gtk "gtk_main_iteration") +(main (gtk "gtk_server_callback 0")) +(gtk "gtk_server_exit") diff --git a/retropikzel/gtk-webview.scm b/retropikzel/gtk-webview.scm new file mode 100644 index 0000000..048a765 --- /dev/null +++ b/retropikzel/gtk-webview.scm @@ -0,0 +1,52 @@ +(define-c-library gtk '("gtk/gtk.h") "gtk-4" '((additional-versions (0)))) +(define-c-library webkit '("webkit/webkit.h") "webkitgtk-6.0" '((additional-versions (4)))) +(define G-APPLICATION-DEFAULT-FLAGS 0) +(define G-PRIORITY-HIGH -100) +(define window (make-c-null)) +(define window-title (make-c-null)) +(define webview (make-c-null)) +(define webview-url (make-c-null)) +(define main-interval 1000) +(define main #f) +(define-c-callback main-callback 'int '() (lambda () (when main (main)) 1)) + +(define-c-procedure gtk-application-new gtk 'gtk_application_new 'pointer '(pointer int)) +(define-c-procedure gtk-application-window-new gtk 'gtk_application_window_new 'pointer '(pointer)) +(define-c-procedure g-signal-connect-data gtk 'g_signal_connect_data 'long '(pointer pointer callback pointer pointer int)) +(define-c-procedure g-timeout-add gtk 'g_timeout_add 'int '(int callback pointer)) +(define-c-procedure g-application-run gtk 'g_application_run 'int '(pointer int pointer)) +(define-c-procedure gtk-window-set-child gtk 'gtk_window_set_child 'void '(pointer pointer)) +(define-c-procedure gtk-window-set-title gtk 'gtk_window_set_title 'void '(pointer pointer)) +(define-c-procedure gtk-window-set-default-size gtk 'gtk_window_set_default_size 'void '(pointer int int)) +(define-c-procedure gtk-window-present gtk 'gtk_window_present 'void '(pointer)) +(define-c-procedure webkit-webview-new webkit 'webkit_web_view_new 'pointer '()) +(define-c-procedure webkit-web-view-load-uri webkit 'webkit_web_view_load_uri 'void '(pointer pointer)) + +(define-c-callback + activate + 'void + '(pointer pointer) + (lambda (app user-data) + (set! window (gtk-application-window-new app)) + (set! webview (webkit-webview-new)) + (gtk-window-set-child window webview) + (webkit-web-view-load-uri webview webview-url) + (gtk-window-set-title window window-title) + (gtk-window-set-default-size window 200 200) + (gtk-window-present window) + (g-timeout-add main-interval main-callback (make-c-null)))) + +(define (gtk-webview title url . options) + (when (and (not (null? options)) + (assoc 'main (car options))) + (set! main (cdr (assoc 'main (car options))))) + (set! window-title (string->c-utf8 title)) + (set! webview-url (string->c-utf8 url)) + (let* ((app (gtk-application-new (make-c-null) G-APPLICATION-DEFAULT-FLAGS))) + (g-signal-connect-data app + (string->c-utf8 "activate") + activate + (make-c-null) + (make-c-null) + 0) + (g-application-run app 0 (make-c-null)))) diff --git a/retropikzel/gtk-webview.sld b/retropikzel/gtk-webview.sld new file mode 100644 index 0000000..dc34ac4 --- /dev/null +++ b/retropikzel/gtk-webview.sld @@ -0,0 +1,7 @@ +(define-library + (retropikzel gtk-webview) + (import (scheme base) + (scheme write) + (foreign c)) + (export gtk-webview) + (include "gtk-webview.scm")) diff --git a/retropikzel/gtk-webview/test.scm b/retropikzel/gtk-webview/test.scm new file mode 100644 index 0000000..e4a764c --- /dev/null +++ b/retropikzel/gtk-webview/test.scm @@ -0,0 +1,9 @@ +(import (scheme base) + (scheme write) + (retropikzel gtk-webview)) + +(define (main) + (write "Hello") + (newline)) + +(gtk-webview "Hello world" "https://gnu.org" `((main . ,main))) diff --git a/retropikzel/pstk/README.md b/retropikzel/pstk/README.md new file mode 100644 index 0000000..746496b --- /dev/null +++ b/retropikzel/pstk/README.md @@ -0,0 +1,785 @@ +# pffi-pstk + +pffi-pstk is a library for using +[tk](https://en.wikipedia.org/wiki/Tk_(software)) gui library from Scheme +using [R7RS-PFFI](https://git.sr.ht/~retropikzel/r7rs-pffi). It is a new +chapter in the long continuation of porting the pstk library. + + +The starting code was taken from +[(rebottled pstk)](https://snow-fort.org/s/peterlane.info/peter/rebottled/pstk/1.7.0/index.html) +which can be found from snow-fort. + + +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 + +Get started with the following program: + + + + (import (scheme base) + (scheme write) + (rebottled pstk)) + + (let ((tk (tk-start))) ; **< 1>** + (tk/pack (tk 'create-widget ; **< 2>** + 'button 'text: "Hello" + 'command: (lambda () (display "Hello world") (newline))) ; **< 3>** + 'padx: 20 'pady: 20) + (tk-event-loop tk)) ; **< 4>** + + 1. Starts the TK shell working. The returned value is used to interact with the shell. + + 2. Creates a button with a label and command, and packs it onto the default frame. + + 3. Commands are given as Scheme functions of zero arguments. + + 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 + +The example above shows how widgets are created by sending instructions to the +Tk process. The manner of operation is very close to, but a little different +to that used in Tcl/Tk itself. In this section, some descriptions and examples +are given to help in translating the Tcl/Tk documentation into Scheme. + +In Tk, widgets are created using appropriately named functions, providing a +name for the new widget as a string. Tk parses this string to work out the +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 + + * create-widget: used to create a child widget + + * configure: used to alter parameters of a widget + + * 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`: + + + + sash> (hello 'configure 'text: "Goodbye") + () + sash> (hello 'cget 'text:) + "Goodbye" + +Apart from representing widgets as functions, most of the Tk parameters and +functions map across into Scheme. Consider the Tcl/Tk equivalent of the +example program above: + + + + button .hello -text Hello -command {puts stdout "Hello world"} + pack .hello -padx 20 -pady 20 + +The first line creates a widget named ".hello". The "." means it is attached +to the top-most frame. The widget is referred to in the second line, which +packs the widget into the frame. + +Comparing the second line with the Scheme program illustrates how direct most +conversions can be: + + + + pack -padx 20 -pady 20 + + + (tk/pack 'padx: 20 'pady: 20) + +Notice these three principles: + + 1. Instead of a string for the widget name, we have what is returned by creating the widget (a function); for the top-most frame ("." in tcl/tk) we have the return value of `tk-start` (called `tk` here). + + 2. The parameters `-padx` are converted to symbols with a trailing colon `'padx:` + + 3. The function name `pack` becomes `tk/pack` + +In addition, Scheme values are converted to Tcl values. So Scheme's #t/#f are +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" + 'command: (lambda () (display "Hello world") (newline)))) + +Instead of calling a `button` function, as in Tcl, the parent widget's +function is requested to create a button widget. The parameters defining the +button are the same as in the Tcl example, just mapped to Scheme equivalents. +This call returns a function defining the new button, which we can name in a +Scheme variable. + +Notice how the command `'create-widget` is passed as a symbol without a +trailing colon; compare with how the parameter `'text:` is given. + +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 +available widgets see any Tk documentation or +. + + + +### 1.3. Tk Functions + +These functions map directly onto underlying Tk functions. The names start +`tk/` with the remainder of the name mapping onto the Tk equivalent function: + + * `tk/bell` is equivalent to Tk's `bell` + + * `tk/choose-color` is equivalent to Tk's `tk_chooseColor` + + + +#### 1.3.1. `tk/after` + +`tk/after` takes a time in milliseconds and an optional function. After the +given time, it calls the function or continues processing. + +In the analogue clock example, the function to redraw the hands in the clock +uses `tk/after` to delay for a second before calling itself to draw the hands +in the new position and repeating. + + + + (define (hands canvas) + + ; code to redraw the clock + + (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") + "new name set" + 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` + +`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>** + "" + + 1. `tk` refers to the default, or top-most window, as it is the value returned by `tk-start`. + + 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 +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. + +See the Tk documentation for details: + + +#### 1.3.13. `tk/focus` + +`tk/focus` manages the input focus. + +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 +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 +frame. This geometry manager is probably the most important of the three, and +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) + (tk/grid (tk 'create-widget 'label 'text: "celsius") + 'column: 3 'row: 1 'sticky: 'w 'padx: 5 'pady: 5) ; **< 3>** + (tk/grid (tk 'create-widget 'label 'text: "is") + 'column: 1 'row: 2 'sticky: 'e 'padx: 5 'pady: 5) ; **< 4>** + (tk/grid (tk 'create-widget 'label 'text: "fahrenheit") + 'column: 3 'row: 2 'sticky: 'w 'padx: 5 'pady: 5) + + 1. Places the `celsius` widget in row 1, column 2. The `sticky` option means the widget will fill the space in the horizontal direction. The `pad` options place some space around the widget. Note, rows and columns are indexed from 1. + + 2. Similarly, the `label` is placed in column 2 row 2. + + 3. This option only has `w` for the `sticky` option: the text label is left-justified. + + 4. With the `e` option for `sticky`, this label is right-justified. + +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>** + "" + + 1. Loads an image from a file. The type should be `photo` or `bitmap`. + + 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 +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" + + * "ok" - which displays one button "ok" + + * "okcancel" - which displays two buttons "ok" or "cancel" + + * "retrycancel" + + * "yesno" + + * "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 +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 +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 +events to wait for. In case of visibility/window types, `tk-wait-for-window` +and `tk-wait-until-visible` are better choices. This function can also wait +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) + "1080" + + 1. The values are returned as _strings_ , use `string->number` to convert to numbers. + +Similarly, information about a named window: + + + + sash> (tk/winfo 'x tk) + "860" + sash> (tk/winfo 'y tk) + "464" + +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 +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 +send commands to Tk. An optional argument names the tcl/tk program to use: on +Linux, this program is "tclsh", but for easy distribution, you may wish to use +"tclkit". + + + + (let ((tk (tk-start "tclkit"))) ...) ; **< 1>** + + 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 +to widget controls. + +`tk-var` is used to register a new `tk-var` with the given symbol name. + +`tk-get-var` is used to retrieve the value of a `tk-var` + +`tk-set-var!` is used to change the value of a `tk-var` + +For example: + + + + (tk-var 'cb-value) ; **< 1>** + (tk 'create-widget 'checkbutton 'text: "Check me" + 'variable: (tk-var 'cb-value)) ; **< 2>** + (display (tk-get-var 'cb-value)) ; **< 3>** + + 1. Set up symbol `cb-value` as the name of variable + + 2. Associates the `cb-value` variable with the check button + + 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 +