[mcclim-cvs] CVS mcclim/Backends/gtkairo

[dlichteblau]

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

Modified Files:
	ffi.lisp frame-manager.lisp gadgets.lisp 
Log Message:

Native option panes.
	
	* ffi.lisp (gtk_combo_box_append_text, gtk_combo_box_get_active,
	gtk_combo_box_new_text, gtk_combo_box_set_active): New.
	
	* frame-manager.lisp (MAKE-PANE-2 GENERIC-OPTION-PANE): New.
	
	* gadgets.lisp (GTK-OPTION-PANE, REALIZE-NATIVE-WIDGET,
	OPTION-PANE-SET-ACTIVE, (SETF GADGET-VALUE,
	CONNECT-NATIVE-SIGNALS, HANDLE-EVENT)): New.


--- /project/mcclim/cvsroot/mcclim/Backends/gtkairo/ffi.lisp	2006/11/19 17:31:20	1.3
+++ /project/mcclim/cvsroot/mcclim/Backends/gtkairo/ffi.lisp	2006/11/19 18:08:16	1.4
@@ -934,6 +934,25 @@
   (label :string)                       ;const gchar *
   )
 
+(defcfun "gtk_combo_box_append_text"
+    :void
+  (combo_box :pointer)                  ;GtkComboBox *
+  (text :string)                        ;const gchar *
+  )
+
+(defcfun "gtk_combo_box_get_active"
+    :int
+  (combo_box :pointer)                  ;GtkComboBox *
+  )
+
+(defcfun "gtk_combo_box_new_text" :pointer)
+
+(defcfun "gtk_combo_box_set_active"
+    :void
+  (combo_box :pointer)                  ;GtkComboBox *
+  (index_ :int)                         ;gint
+  )
+
 (defcfun "gtk_container_add"
     :void
   (container :pointer)                  ;GtkContainer *
--- /project/mcclim/cvsroot/mcclim/Backends/gtkairo/frame-manager.lisp	2006/11/19 17:31:20	1.8
+++ /project/mcclim/cvsroot/mcclim/Backends/gtkairo/frame-manager.lisp	2006/11/19 18:08:16	1.9
@@ -99,6 +99,9 @@
 (defmethod make-pane-2 ((type (eql 'clim:label-pane)) &rest initargs)
   (apply #'make-instance 'gtk-label-pane initargs))
 
+(defmethod make-pane-2 ((type (eql 'clim:generic-option-pane)) &rest initargs)
+  (apply #'make-instance 'gtk-option-pane initargs))
+
 (defmethod adopt-frame :after
     ((fm gtkairo-frame-manager) (frame application-frame))
   ())
--- /project/mcclim/cvsroot/mcclim/Backends/gtkairo/gadgets.lisp	2006/11/19 17:31:20	1.11
+++ /project/mcclim/cvsroot/mcclim/Backends/gtkairo/gadgets.lisp	2006/11/19 18:08:16	1.12
@@ -51,6 +51,10 @@
     ((title :initarg :title :initform "" :accessor list-pane-title)
      (tree-view :accessor list-pane-tree-view)))
 
+(defclass gtk-option-pane
+    (native-widget-mixin option-pane climi::meta-list-pane)
+    ())
+
 (defclass native-slider (native-widget-mixin climi::slider-gadget)
     ((climi::show-value-p :type boolean
 			  :initform nil
@@ -174,6 +178,15 @@
 	 (cffi:null-pointer))
 	result))))
 
+(defmethod realize-native-widget ((sheet gtk-option-pane))
+  (let* ((widget (gtk_combo_box_new_text))
+	 (name-key (climi::list-pane-name-key sheet)))
+    (dolist (i (climi::list-pane-items sheet))
+      (cffi:with-foreign-string (n (funcall name-key i))
+	(gtk_combo_box_append_text widget n)))
+    (option-pane-set-active sheet widget)
+    widget))
+
 (defun gtk-list-select-value (sheet value)
   (let ((path
 	 (gtk_tree_path_new_from_indices
@@ -201,6 +214,22 @@
       (when mirror
 	(gtk-list-reset-selection gadget)))))
 
+(defun option-pane-set-active (sheet widget)
+  (gtk_combo_box_set_active
+   widget
+   (position (gadget-value sheet)
+	     (climi::list-pane-items sheet)
+	     :key (climi::list-pane-value-key sheet)
+	     :test (climi::list-pane-test sheet))))
+
+(defmethod (setf gadget-value) :after
+	   (value (gadget gtk-option-pane) &key invoke-callback)
+  (declare (ignore invoke-callback))
+  (with-gtk ()
+    (let ((mirror (sheet-direct-mirror gadget)))
+      (when mirror
+	(option-pane-set-active gadget (mirror-widget mirror))))))
+
 (defun make-scale (fn sheet)
   (let* ((min (df (gadget-min-value sheet)))
 	 (max (df (gadget-max-value sheet)))
@@ -364,6 +393,9 @@
   ;; no signals
   )
 
+(defmethod connect-native-signals ((sheet gtk-option-pane) widget)
+  (connect-signal widget "changed" 'magic-clicked-handler))
+
 
 ;;;; Event handling
 
@@ -451,6 +483,13 @@
 		    when (gethash i *list-selection-result*)
 		    collect (funcall value-key value)))))))
 
+(defmethod handle-event ((pane gtk-option-pane) (event magic-gadget-event))
+  (setf (gadget-value pane :invoke-callback t)
+	(funcall (climi::list-pane-value-key pane)
+		 (elt (climi::list-pane-items pane)
+		      (gtk_combo_box_get_active
+		       (mirror-widget (sheet-direct-mirror pane)))))))
+
 
 ;;; COMPOSE-SPACE