[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