# picoLisp + gtk-server example
# 26feb2009 Tomas Hlavaty
# $ ~/picolisp/p gtk-example.l -bye
# Tested with GTK-server 2.3.1

#-------- Embed GTK functions

(def '*GtkServer "gtk-server")

(de gtk @
   (out *GtkFifo
      (while (args)
         (prin " ")
         (let A (next)
            (if (str? A)
               (prin "'" A "'")
               (prin A) ) ) )
      (prinl)
      (flush) )
   (in *GtkFifo
      (line T) ) )

(de gtkCfg ()
   (in "gtk-server.cfg"
      (until (eof)
         (let L (line)
            (when (match '("F" "U" "N" @A "=" @B "," @C) L)
               (let N (intern (pack (clip @B)))
                  (def N (fill '(@ (pass gtk 'N)) 'N)) ) ) ) ) ) )

(gtkCfg)
(def '*GtkFifo (tmp "gtk.fifo"))
(call *GtkServer (pack "-fifo=" *GtkFifo) "-detach")
(push1 '*Bye (list 'kill (format (gtk_server_pid))))

#----------- The program

(gtk_init 'NULL 'NULL)
(setq W (gtk_window_new 0))
(gtk_window_set_title W "This is a title")
(gtk_window_set_default_size W 100 100)
(gtk_window_set_position W 1)
(setq G (gtk_table_new 30 30 1))
(gtk_container_add W G)
(setq B1 (gtk_button_new_with_label "Exit"))
(gtk_table_attach_defaults G B1 17 28 20 25)
(setq B2 (gtk_button_new_with_label "Print text"))
(gtk_table_attach_defaults G B2 2 13 20 25)
(setq E (gtk_entry_new))
(gtk_table_attach_defaults G E 2 28 5 15)
(gtk_widget_show_all W)
(let V 0
   (until (prog
             (setq V (gtk_server_callback 'wait))
             (or (= V B1) (= V W)) )
     (when (= V B2)
        (prinl "Contents: " (gtk_entry_get_text E)) ) ) )
(gtk_server_exit)