;;;; CMUCL <-> libgtk-server.so demo ;;;; Tested with CMUCL 19d and gtk-server-2.2.2 ;;;; ;;;; 22 Jan 2008 - Simon Saville ;;;; Shameless pilfering from other examples ;;;; ;;;; Use: (assuming CMUCL is /usr/bin/lisp, etc) ;;;; lisp -load cmucl-eg.lisp ;;; CMUCL foreign/alien call kung fu - just one function :) (ext:load-foreign "/usr/lib/libgtk-server.so") (declaim (inline gtk)) (alien:def-alien-routine gtk c-call:c-string (arg c-call:c-string :in)) ;;; Utility/wrapper function for the gtk call (defun c-gtk (func &rest args) (gtk (format nil "~a ~{~a~^ ~}" func args))) ;;; The main(), everything kicks off from here! (defun main () "Simple demo with a window and a textbox" (c-gtk "gtk_init" "NULL" "NULL") (let ((win (c-gtk "gtk_window_new" 0)) (table (c-gtk "gtk_table_new" 30 30 1)) (bt-exit (c-gtk "gtk_button_new_with_label" "Exit")) (bt-ok (c-gtk "gtk_button_new_with_label" "\"Print Text\"")) (entry (c-gtk "gtk_entry_new"))) (c-gtk "gtk_window_set_title" win "\"CMUCL demo\"") (c-gtk "gtk_entry_set_text" entry "NICE!") (c-gtk "gtk_window_set_default_size" win 100 100) (c-gtk "gtk_window_set_position" win 1) (c-gtk "gtk_container_add" win table) (c-gtk "gtk_table_attach_defaults" table bt-exit 17 28 20 25) (c-gtk "gtk_table_attach_defaults" table bt-ok 2 13 20 25) (c-gtk "gtk_table_attach_defaults" table entry 2 28 5 15) (c-gtk "gtk_widget_show_all" win) ;; Event loop (loop for event = (c-gtk "gtk_server_callback WAIT") when (string= event win) do (return) when (string= event bt-exit) do (return) when (string= event bt-ok) do (format t "You entered: ~a~%" (c-gtk "gtk_entry_get_text" entry))) (c-gtk "gtk_server_exit"))) (main)