[mcclim-cvs] CVS mcclim/Backends/gtkairo

dlichteblau dlichteblau at common-lisp.net
Sun Nov 26 17:54:08 UTC 2006


Update of /project/mcclim/cvsroot/mcclim/Backends/gtkairo
In directory clnet:/tmp/cvs-serv3899

Modified Files:
	ffi.lisp gadgets.lisp 
Log Message:

Implement DE-/ACTIVATE-GADGET natively.

	* ffi.lisp: Regenerated.
	
	* gagets.lisp ((realize-native-widget :around) (activate-gadget
	:after native-widget-mixin) (deactivate-gadget
	:after native-widget-mixin)): De/activate the widget.


--- /project/mcclim/cvsroot/mcclim/Backends/gtkairo/ffi.lisp	2006/11/25 21:11:33	1.6
+++ /project/mcclim/cvsroot/mcclim/Backends/gtkairo/ffi.lisp	2006/11/26 17:54:08	1.7
@@ -1293,6 +1293,12 @@
   (events :int)                         ;gint
   )
 
+(defcfun "gtk_widget_set_sensitive"
+    :void
+  (widget :pointer)                     ;GtkWidget *
+  (sensitive :int)                      ;gboolean
+  )
+
 (defcfun "gtk_widget_set_size_request"
     :void
   (widget :pointer)                     ;GtkWidget *
--- /project/mcclim/cvsroot/mcclim/Backends/gtkairo/gadgets.lisp	2006/11/25 21:11:33	1.13
+++ /project/mcclim/cvsroot/mcclim/Backends/gtkairo/gadgets.lisp	2006/11/26 17:54:08	1.14
@@ -585,6 +585,21 @@
 	(gtk_toggle_button_set_active (mirror-widget mirror)
 				      (if value 1 0))))))
 
+(defmethod realize-native-widget :around ((gadget native-widget-mixin))
+  (let ((widget (call-next-method)))
+    (gtk_widget_set_sensitive widget (if (gadget-active-p gadget) 1 0))
+    widget))
+
+(defmethod activate-gadget :after ((gadget native-widget-mixin))
+  (with-gtk ()
+    (when (native-widget gadget)
+      (gtk_widget_set_sensitive (native-widget gadget) 1))))
+
+(defmethod deactivate-gadget :after ((gadget native-widget-mixin))
+  (with-gtk ()
+    (when (native-widget gadget)
+      (gtk_widget_set_sensitive (native-widget gadget) 0))))
+
 
 ;;; Scroll bars.
 




More information about the Mcclim-cvs mailing list