[gtk-server] demo-stdin.clisp created

Good news: I've managed to get gtk-server to work with CLISP on both 
Linux and Windows platforms. I attach code with this email, and list it 
below. Enjoy!
;; Tested with clisp-2.33.1 on Windows XP
;; Tested with clisp 2.33.2 on Debian 2.4.27-1-386
;;
;; Usage: clisp demo-stdin.clisp
;;
;; Requirements: gtk-server installion in this scripts' directory
;; 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
;;---------------------------------------------------

(setf *gs-socket* (ext:run-program "gtk-server" :arguments '("stdin" "log")
        :input :stream :output :stream :wait t))

(defun send-gs-socket (text)
            (format *gs-socket* "~A~%" text)
              (force-output *gs-socket*))


;; Define communication function
(defun gtk (str)
  (send-gs-socket str )
  (write-line (read-line  *gs-socket*)))

;; Design the GUI
(gtk "gtk_init(NULL, NULL)")
(setq win (gtk "gtk_window_new(0)"))
(gtk (concatenate 'string "gtk_window_set_title (" win ",Clisp Demo)"))
(gtk (concatenate 'string "gtk_window_set_default_size (" win ", 100, 
100)"))
(gtk (concatenate 'string "gtk_window_set_position (" win ", 1 )"))
(setq table (gtk "gtk_table_new(30, 30, 1 )"))
(gtk (concatenate 'string "gtk_container_add (" win "," table ")"))
(setq button1 (gtk "gtk_button_new_with_label (Exit)"))
(gtk (concatenate 'string "gtk_table_attach_defaults("
                  table ", " button1 ", 17, 28, 20, 25)"))
(setq button2 (gtk "gtk_button_new_with_label (Print text)"))
(gtk (concatenate 'string "gtk_table_attach_defaults ("
                  table ", " button2 ", 2, 13, 20, 25)"))
(setq entry (gtk "gtk_entry_new()"))
(gtk (concatenate 'string "gtk_table_attach_defaults ("
                  table ", " entry ", 2, 28, 5, 15)"))
(gtk (concatenate 'string "gtk_widget_show_all(" win ")"))

;; This is the mainloop
(do ((event 0 (setq event (parse-integer
                           (gtk "gtk_server_callback(WAIT)")))))
    ((or (= event (parse-integer button1)) (= event (parse-integer win))))
  (when (or (= event (parse-integer button2))
            (= event (parse-integer entry)))
    (setq tmp (gtk (concatenate 'string "gtk_entry_get_text(" entry ")")))
    (print (concatenate 'string "This is the contents: " tmp)))
  )

;; Exit GTK explicitly only with a write
(send-gs-socket "gtk_exit(0)" )

(close *gs-socket*)

;; end of file





-- Attached file included as plaintext by Ecartis --
-- File: demo-stdin.clisp

;; Tested with clisp-2.33.1 on Windows XP
;; Tested with clisp 2.33.2 on Debian 2.4.27-1-386
;;
;; Usage: clisp demo-stdin.clisp
;;
;; Requirements: gtk-server installion in this scripts' directory
;; 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
;;---------------------------------------------------

(setf *gs-socket* (ext:run-program "gtk-server" :arguments '("stdin" "log")
        :input :stream :output :stream :wait t))

(defun send-gs-socket (text)
            (format *gs-socket* "~A~%" text)
              (force-output *gs-socket*))
              

;; Define communication function
(defun gtk (str)
  (send-gs-socket str )
  (write-line (read-line  *gs-socket*)))

;; Design the GUI
(gtk "gtk_init(NULL, NULL)")
(setq win (gtk "gtk_window_new(0)"))
(gtk (concatenate 'string "gtk_window_set_title (" win ",Clisp Demo)"))
(gtk (concatenate 'string "gtk_window_set_default_size (" win ", 100, 100)"))
(gtk (concatenate 'string "gtk_window_set_position (" win ", 1 )"))
(setq table (gtk "gtk_table_new(30, 30, 1 )"))
(gtk (concatenate 'string "gtk_container_add (" win "," table ")"))
(setq button1 (gtk "gtk_button_new_with_label (Exit)"))
(gtk (concatenate 'string "gtk_table_attach_defaults(" 
                  table ", " button1 ", 17, 28, 20, 25)"))
(setq button2 (gtk "gtk_button_new_with_label (Print text)"))
(gtk (concatenate 'string "gtk_table_attach_defaults (" 
                  table ", " button2 ", 2, 13, 20, 25)"))
(setq entry (gtk "gtk_entry_new()"))
(gtk (concatenate 'string "gtk_table_attach_defaults (" 
                  table ", " entry ", 2, 28, 5, 15)"))
(gtk (concatenate 'string "gtk_widget_show_all(" win ")"))

;; This is the mainloop
(do ((event 0 (setq event (parse-integer 
                           (gtk "gtk_server_callback(WAIT)")))))    
    ((or (= event (parse-integer button1)) (= event (parse-integer win))))
  (when (or (= event (parse-integer button2)) 
            (= event (parse-integer entry)))
    (setq tmp (gtk (concatenate 'string "gtk_entry_get_text(" entry ")")))
    (print (concatenate 'string "This is the contents: " tmp)))
  )

;; Exit GTK explicitly only with a write
(send-gs-socket "gtk_exit(0)" )

(close *gs-socket*)

;; end of file

Other related posts: