[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