;;; Tested with clisp-2.35 on Slackware 10.2
;;;
;;; Usage: clisp demo-stdin.clisp
;;;
;;; http://www.gtk-server.org/
;;; April 21, 2004 by Jörg Kalsbach.
;;;
;;; Revised for GTK-server 1.2 October 8, 2004 by PvE.
;;; Revised for CLISP and GTK-server 1.2.2 November 3, 2004 by Mark Carter
;;; Code cleanup November 9, 2004 by Mark Carter
;;; Revised for GTK-server 1.3 December 5, 2004 by PvE.
;;; Code cleanup December 10, 2005 by Daniel Lowe
;;;---------------------------------------------------

(defvar *gs-socket* nil
  "The I/O stream connected to GTK-server")

(defmacro with-gtk-server ((stream) &body body)
  "Executes gtk-server, setting up STREAM to communicate with it.  On exit, tells gtk-server to quit and closes the stream"
  `(let ((,stream (ext:run-program "gtk-server"
                                    :arguments '("stdin" "-log=/tmp/demo.log")
                                    :input :stream
                                    :output :stream
                                    :wait t)))
    (unwind-protect
         (when (open-stream-p ,stream)
           ,@body)
      (progn
        (princ "gtk_server_exit" ,stream)
        (close ,stream)))))

;;; Communication functions

(defun gtk (func &rest args)
  "Writes a gtk-server command to *gs-socket* and returns the result as a string"
  ;; FORMAT directly to the stream breaks gtk-server's lack of buffering,
  ;; so we have to build the string, then send it all at once.  God help
  ;; us if we have to send a large amount of text.
  (let ((msg (format nil "~a ~{~a~^ ~}" func args)))
    (princ msg *gs-socket*)
    (format t ">~a~%" msg))
  (finish-output *gs-socket*)
  (write-line (read-line *gs-socket*)))

(defun igtk (func &rest args)
  "Writes a gtk-server command to *gs-socket* and returns the result as an integer."
  (parse-integer (apply #'gtk func args) :junk-allowed t))

;;; Execution starts here

(with-gtk-server (*gs-socket*)
  ;; Initialize GTK
  (gtk "gtk_init" "NULL" "NULL")

  ;; Set up widgets
  (let ((win (igtk "gtk_window_new" 0))
        (table (igtk "gtk_table_new" 30 30 1))
        (button1 (igtk "gtk_button_new_with_label" "Exit"))
        (button2 (igtk "gtk_button_new_with_label" "\"Print text\""))
        (entry (igtk "gtk_entry_new")))
    (gtk "gtk_window_set_title" win "\"Clisp Demo\"")
    (gtk "gtk_window_set_default_size" win 100 100)
    (gtk "gtk_window_set_position" win 1)
    (gtk "gtk_container_add" win table)
    (gtk "gtk_table_attach_defaults" table button1 17 28 20 25)
    (gtk "gtk_table_attach_defaults" table button2 2 13 20 25)
    (gtk "gtk_table_attach_defaults" table entry 2 28 5 15)
    (gtk "gtk_widget_show_all" win)

    ;; Main loop
    (loop for event = (igtk "gtk_server_callback WAIT")
          until (or (= event button1) (= event win))
          when (or (= event button2) (= event entry))
          do (format t "### The field contains: ~a~%"
                     (gtk "gtk_entry_get_text" entry)))))