;;;; Example using gtk-server.dll, SBCL for Windows, and Glade. ;;;; Tested using SBCL 1.0.6, gtk-server 2.1.3, and Glade 3.2.2 ;;;; August 14, 2007 by John Stoneham ;; The "current working directory" should be the directory where this file, ;; gtk-server.dll, gtk-server.cfg, and the .glade file are located. If this ;; isn't done properly and gtk-server.dll can't find the cfg file, it will ;; crash itself and SBCL. (defparameter +current-working-directory+ "C:/Projects/lisp/test/gtk") ;; SBCL and Windows have different ideas of what "current working directory" ;; actually means, so we have to tell Windows where it is. Note that this ;; could be done with sb-posix:chdir, but there's no reason to load an entire ;; package just for one function. (load-shared-object "Kernel32.dll") (define-alien-routine "SetCurrentDirectoryA" int (arg c-string :in)) (if (eql 0 (SetCurrentDirectoryA +current-working-directory+)) (progn (format t "~%~%ERROR SETTING CURRENT WORKING DIRECTORY.~%~%") (break))) ;; Set up the ffi for gtk-server.dll (load-shared-object "gtk-server.dll") (declaim (inline gtk)) (define-alien-routine gtk c-string (arg c-string :in)) ;; utility function to make all arguments into one string (defun call-gtk (func &rest args) (gtk (format nil "~a ~{~a~^ ~}" func args))) ;; initialize gtk (call-gtk "gtk_init" "NULL" "NULL") ;; example of embedded glade xml string ;; Simply open the .glade file in a text editor and do a search-and-replace ;; for every " with \" then enclose the whole thing in a single pair of quotes, ;; and paste it into your source file as below. Or, to use the .glade itself, ;; use e.g. (call-gtk "gtk_server_glade_file test.glade") ;; NOTE: do not assign events or callbacks within Glade itself or the XML; do so ;; only in your source file using "gtk_server_connect". (call-gtk "gtk_server_glade_string" " GDK_POINTER_MOTION_MASK | GDK_POINTER_MOTION_HINT_MASK | GDK_BUTTON_PRESS_MASK | GDK_BUTTON_RELEASE_MASK SBCL DLL Test True GDK_POINTER_MOTION_MASK | GDK_POINTER_MOTION_HINT_MASK | GDK_BUTTON_PRESS_MASK | GDK_BUTTON_RELEASE_MASK 94 35 True True True GDK_POINTER_MOTION_MASK | GDK_POINTER_MOTION_HINT_MASK | GDK_BUTTON_PRESS_MASK | GDK_BUTTON_RELEASE_MASK OK 0 64 157 ") ;; get IDs for the wigets which are named in the glade file (let ((win (call-gtk "gtk_server_glade_widget" "window")) (btn (call-gtk "gtk_server_glade_widget" "ok_button"))) ;; connect events to the widgets (call-gtk "gtk_server_connect" win "destroy" "win-exit") (call-gtk "gtk_server_connect" btn "clicked" "btn-click") ;; display the window (call-gtk "gtk_widget_show_all" win) ;; Main Even Loop (loop for event = (call-gtk "gtk_server_callback" "wait") when (string= event "win-exit") do (return) when (string= event "btn-click") do (format t "Button Clicked~%")) ;; quit -- this causes the SBCL image to exit as well... (call-gtk "gtk_server_exit") )