[lgtk-cvs] CVS update: lgtk/src/gtkbindings.lisp lgtk/src/gtklisp.lisp

[Mario Mommer]

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))