Update of /project/lgtk/cvsroot/lgtk/src In directory common-lisp.net:/tmp/cvs-serv24716 Modified Files: gtkbindings.lisp gtklisp.lisp Log Message: Added signal connector for glade_xml (or at least, I hope so) Date: Thu Nov 25 21:21:56 2004 Author: mmommer Index: lgtk/src/gtkbindings.lisp diff -u lgtk/src/gtkbindings.lisp:1.7 lgtk/src/gtkbindings.lisp:1.8 --- lgtk/src/gtkbindings.lisp:1.7 Thu Nov 25 20:05:25 2004 +++ lgtk/src/gtkbindings.lisp Thu Nov 25 21:21:55 2004 @@ -21,6 +21,10 @@ (def-encapsulator gslist-encap gslist) +(defclass GladeXML (sapcapsule) ()) + +(def-encapsulator GladeXML-encap GladeXML) + ;; For types where nil is acceptable as an object (defun contents-nil (obj) (cond ((null obj) obj) @@ -38,6 +42,11 @@ :out 'gslist-encap :alien '(* t)) + (GladeXML + :in 'contents-nil + :out 'GladeXML-encap + :alien '(* t)) + ; (gtkwindowtype ; :in 'gtkwindowtype ; :alien :int) @@ -425,6 +434,12 @@ (guint data) (gfunc closurenotify) (gint flags))) + +(def-raw-binding "glade_xml_signal_connect_data" + (void (GladeXML xml) + (c-string name) + (gfunc fun) + (guint data))) (def-raw-binding "gtk_main" (void)) Index: lgtk/src/gtklisp.lisp diff -u lgtk/src/gtklisp.lisp:1.6 lgtk/src/gtklisp.lisp:1.7 --- lgtk/src/gtklisp.lisp:1.6 Sat Dec 13 12:10:17 2003 +++ lgtk/src/gtklisp.lisp Thu Nov 25 21:21:55 2004 @@ -48,6 +48,58 @@ (debugf t "Tacked callback id ~A to widget ~a for ~s.~%" (id it) wid (marker signal)))) +(defun g-signal-connect (wid signal func &key data (flags :g-connect-none)) +;; the data argument is a keyword arg because we do not need to fake +;; closures. + (declare (optimize (debug 3))) + (let* ((rw (contents wid)) + (it (make-instance 'gtk-object-callback + :object wid + :func func + :data data + :nexus *gtkcallbacks*)) + (meta (meta wid))) + + (setf (contents it) + (gtk-aliens::|g_signal_connect_data| + rw (marker signal) (trampoline signal) (id it) + nil (gconnectflags flags))) + + (if (eql signal gtkdestroy) + (pushnew (meta it) (destroyers meta)) + (pushnew (meta it) (callbacks meta))) + + (gcconnect it wid) + + (debugf t "Tacked callback id ~A to widget ~a for ~s.~%" + (id it) wid (marker signal)))) + +(defun glade-xml-signal-connect (wid signal func + &key data) +;; the data argument is a keyword arg because we do not need to fake +;; closures. + (declare (optimize (debug 3))) + (let* ((rw (contents wid)) + (it (make-instance 'gtk-object-callback + :object wid + :func func + :data data + :nexus *gtkcallbacks*)) + (meta (meta wid))) + + (setf (contents it) + (gtk-aliens::|glade_xml_signal_connect_data| + rw (marker signal) (trampoline signal) (id it))) + + (if (eql signal gtkdestroy) + (pushnew (meta it) (destroyers meta)) + (pushnew (meta it) (callbacks meta))) + + (gcconnect it wid) + + (debugf t "Tacked (glade) callback id ~A to widget ~a for ~s.~%" + (id it) wid (marker signal)))) + (defun g-signal-connect-swapped (wid signal func &key data (flags :g-connect-none))