demo-tcp.clisp

gtk_server的源代码

;;; Tested with clisp-2.35 on Slackware 10.2
;;;
;;; Usage: clisp demo-tcp.clisp
;;;
;;; http://www.gtk-server.org/
;;; April 21, 2004 by J鰎g 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.
;;; Revised for GTK-server 2.1.4 at April 22, 2007
;;; Code cleanup December 10, 2005 by Daniel Lowe
;;;---------------------------------------------------

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

(defmacro with-tcp-gtk-server ((stream &key (host "localhost") (port nil))
                               &body body)
  "Executes gtk-server in TCP mode, and then connects to it via a TCP socket.  On exit, tells gtk-server to quit and closes the socket."
  `(progn
    ;; start gtk-server process
    (ext:run-program "gtk-server"
                     :arguments '("tcp=" ,(format nil "~a:~d" host port))
                     :wait nil)
    ;; open tcp socket to gtk-server
    (let ((,stream (socket:socket-connect 50000)))
      (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-tcp-gtk-server (*gs-socket* :port 50000)
  ;; 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)))))

;; end of file