I'm trying to use GTK-server with SBCL. I'm starting from an example
that works in CLisp and I'm having trouble adapting it, because the
sockets API is different and I know nothing about sockets. I tried
installing CLOCC-POST, but didn't succeed; but even if I did, that would
require some changes too. I only need to get the socket working at
startup and not worry about it later.
Here is the CLisp part that I cannot translate successfully to SBCL:
(socket:socket-connect 50000 "localhost")
I found some source code from CLOCC-POST according to which I tried the
following:
(defun sbcl-socket-connect (port)
(let ((socket (make-instance 'sb-bsd-sockets:inet-socket :type
:stream :protocol :tcp)))
(sb-bsd-sockets:socket-connect
socket (sb-bsd-sockets:host-ent-address
(sb-bsd-sockets:get-host-by-name "localhost")) port)
(sb-bsd-sockets:socket-make-stream
socket :input t :output t :buffering :line
:element-type 'character)))
(sbcl-socket-connect 50000)
...but all it does is wait (there is a lot of code around this part
which launches the server and should then create widgets -- at least it
does in CLisp; I've not included here but if it can help just tell me).
Actually all I need is an equivalent of the socket:socket-connect
function. Any ideas?
Have you looked at trivial-sockets? It should do what you're asking
for, and it'll work on a bunch of other lisps.
<http://www.cliki.net/trivial-sockets>.
-Peter
On Thu, 09 Jun 2005 17:00:19 +0200, Philippe Lorin wrote:
> I'm trying to use GTK-server with SBCL.
That's how I've done it, using stdin method.
;;;; -*- Mode: Lisp; Syntax: ANSI-COMMON-LISP; -*-
;;;; gtk-server.lisp
(in-package :gtk-server)
(defparameter +gtk-server+ "gtk-server")
(defparameter +gtk-server-stdin+ (list "stdin"))
(defparameter *gtk-server* nil
"The gtk-server process.")
(defparameter *gtk-pipe* nil
"Stream used to communicate with gtk-server.")
(defparameter *gtk-init-done* nil)
(defparameter *gtk-server-log* t
"If this value is set to t the gtk-server will write a log
to #+linux \"/tmp/gtk-server.log\".")
(defun gtk-server-args ()
(if *gtk-server-log*
(append +gtk-server-stdin+ (list "log"))
+gtk-server-stdin+))
#+(or cmu sbcl)
(defun start-gtk-server ()
"Starts an gtk-server, unless we have one that is running already."
(unless (and (process-p *gtk-server*)
(eq (process-status *gtk-server*) :running))
(setf *gtk-server*
(run-program +gtk-server+ (gtk-server-args)
;; by default SBCL does not search in path.
#+sbcl :search #+sbcl t
:wait nil
:input :stream
:output :stream))
(setf *gtk-pipe*
(make-two-way-stream (process-output *gtk-server*)
(process-input *gtk-server*)))))
#+clisp
(defun start-gtk-server ()
(unless (streamp *gtk-pipe*)
(setf *gtk-pipe*
(ext:run-program "gtk-server"
:arguments (gtk-server-args)
:input :stream
:output :stream
:wait t))))
#+ecl
(defun start-gtk-server ()
(unless (streamp *gtk-pipe*)
(setf *gtk-pipe*
(ext:run-program "gtk-server"
(gtk-server-args)
:input :stream
:output :stream
:error :output))))
(defun gtk-server-send (string)
"Send a command to be executed to gtk-server, get the response.
This is either a widget/event id, a ``boolean'' (0/1), or just ok.
Always as a string."
(write-string string *gtk-pipe*)
(force-output *gtk-pipe*)
(read-line *gtk-pipe*))
(defun ask-gtk (fname &rest args)
"Send a command to be executed to gtk-server, and get the response."
(write-string fname *gtk-pipe*)
(dolist (arg args)
(write-char #\Space *gtk-pipe*)
(typecase arg
(string (write arg :stream *gtk-pipe* :escape t))
(t (write arg :stream *gtk-pipe* :escape nil))))
(force-output *gtk-pipe*)
(read-line *gtk-pipe*))
(defun gtk-init ()
"Not that is really necessary, Just Handy(TM)."
(gtk-server-send "gtk_init NULL NULL"))
(defun get-event (&key wait)
(ask-gtk "gtk_server_callback" (if wait "wait" "update")))
(defun ensure-gtk-server ()
(start-gtk-server)
(unless *gtk-init-done*
(gtk-init)
(setf *gtk-init-done* t)))
(defun stop-gtk-server ()
;; Just write, Do not wait for response.
(write-string "gtk_exit 0" *gtk-pipe*)
(force-output *gtk-pipe*)
(close *gtk-pipe*)
(setf *gtk-init-done* nil)
#+(or cmu sbcl)
(process-wait *gtk-server*))
;; with-gtk-server -- takes care of starting the server and shutting it
down
(defmacro with-gtk-server (&body body)
`(progn
(ensure-gtk-server)
(assert *gtk-pipe*);;
(unwind-protect
(progn
,@body)
(stop-gtk-server))))
O-MY-GLIFE wrote:
> That's how I've done it, using stdin method.
<snip>
Thank you! This is exactly what I needed. Can I use it in my own
projects (which will be open source), with due credit?
Philippe Lorin wrote:
> O-MY-GLIFE wrote:
> > That's how I've done it, using stdin method.
> <snip>
>
> Thank you! This is exactly what I needed. Can I use it in my own
> projects (which will be open source), with due credit?
Yes, if you find it useful. As everyone here.
And happy hacking.