[gambit-list] gtk-server
William James
w_a_x_man at yahoo.com
Sun Apr 10 23:56:25 EDT 2011
There's no Gambit example here:
http://www.turtle.dds.nl/gtk-server/examples.html
This seems to work:
;; NOTE: requires srfi-13 for "string-join".
(define *gtk-port* (open-process "gtk-server -stdin"))
(thread-sleep! 1)
(define (gtk-command . items)
(let ((strings
(map
(lambda (x) (if (string? x)
x
(object->string x)))
items)))
(display (string-join strings " ") *gtk-port*)
(newline *gtk-port*)
(force-output *gtk-port*)
(read-line *gtk-port*)))
(gtk-command "gtk_init NULL NULL")
(define *win* (gtk-command "gtk_window_new 0"))
(gtk-command "gtk_window_set_title" win
"\"Scheme GTK-server demo via stdin\"")
(gtk-command "gtk_window_set_default_size" *win* 400 200)
(gtk-command "gtk_window_set_position" *win* 1)
(define *tbl* (gtk-command "gtk_table_new 10 10 1"))
(gtk-command "gtk_container_add" *win* *tbl*)
(define *but* (gtk-command
"gtk_button_new_with_label \"Click to Quit\""))
(gtk-command "gtk_table_attach_defaults" *tbl* *but* 5 9 5 9)
(gtk-command "gtk_widget_show_all" win)
(let loop ()
(let ((event (gtk-command "gtk_server_callback WAIT")))
(if (not (member event (list *win* *but*)))
(loop))))
(display "gtk_server_exit" *gtk-port*)
(newline *gtk-port*)
(force-output *gtk-port*)
(close-port *gtk-port*)
More information about the Gambit-list
mailing list