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