[mcclim-cvs] CVS mcclim/Backends/gtkairo

[dlichteblau]

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

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

Second attempt at label pane layouting.
(demodemo beautiful again, but probably not quite there yet, see bug 24)
	
	* ffi.lisp: Regenerated.
	
	* frame-manager.lisp (MAKE-PANE-2 GENERIC-OPTION-PANE): New.
	
	* gadgets.lisp (LABEL-PANE-EXTRA-WIDTH, -HEIGHT): New slots.
	((REALIZE-NATIVE-WIDGET GTK-LABEL-PANE)): Set the inner gtk widget
	size according to our child's space requirements, then retrieve
	the outer gtk widget's size and save the diferrence.
	(COMPOSE-SPACE, *USE-FRONTEND-COMPOSE-SPACE*): Removed *u-f-c-s*
	again.  ((COMPOSE-SPACE GTK-LABEL-PANE)): Removed.
	((ALLOCATE-SPACE GTK-LABEL-PANE)): New method, takes size
	difference into account.


--- /project/mcclim/cvsroot/mcclim/Backends/gtkairo/BUGS	2006/11/05 18:49:13	1.12
+++ /project/mcclim/cvsroot/mcclim/Backends/gtkairo/BUGS	2006/11/25 21:11:33	1.13
@@ -124,3 +124,9 @@
    interactor.  Replacing the :min-height 800 in receivers.lisp with
    :min-height 400 :max-height 400 fixes that, but CLX doesn't have the
    same problem.
+
+24.
+   Weird problem in the text size test with the drei gadget in the label
+   pane: Resizing ends up resizing the one-line drei gadget, and doesn't
+   even do it in one step.  Instead, it enlarges itself in a smooth
+   animation, taking several seconds to stabilize.
--- /project/mcclim/cvsroot/mcclim/Backends/gtkairo/ffi.lisp	2006/11/20 19:53:44	1.5
+++ /project/mcclim/cvsroot/mcclim/Backends/gtkairo/ffi.lisp	2006/11/25 21:11:33	1.6
@@ -1234,6 +1234,12 @@
   (widget :pointer)                     ;GtkWidget *
   )
 
+(defcfun "gtk_widget_get_child_requisition"
+    :void
+  (widget :pointer)                     ;GtkWidget *
+  (requisition :pointer)                ;GtkRequisition *
+  )
+
 (defcfun "gtk_widget_get_events"
     :int
   (widget :pointer)                     ;GtkWidget *
@@ -1246,6 +1252,13 @@
   (y :pointer)                          ;gint *
   )
 
+(defcfun "gtk_widget_get_size_request"
+    :void
+  (widget :pointer)                     ;GtkWidget *
+  (width :pointer)                      ;gint *
+  (height :pointer)                     ;gint *
+  )
+
 (defcfun "gtk_widget_grab_focus"
     :void
   (widget :pointer)                     ;GtkWidget *
--- /project/mcclim/cvsroot/mcclim/Backends/gtkairo/gadgets.lisp	2006/11/19 18:08:16	1.12
+++ /project/mcclim/cvsroot/mcclim/Backends/gtkairo/gadgets.lisp	2006/11/25 21:11:33	1.13
@@ -74,7 +74,9 @@
 (defclass gtk-hscrollbar (native-scrollbar) ())
 
 (defclass gtk-label-pane (native-widget-mixin label-pane)
-    ((label-pane-fixed :accessor label-pane-fixed)))
+    ((label-pane-fixed :accessor label-pane-fixed)
+     (label-pane-extra-width :accessor label-pane-extra-width)
+     (label-pane-extra-height :accessor label-pane-extra-height)))
 
 ;;;; Constructors
 
@@ -94,9 +96,21 @@
 
 (defmethod realize-native-widget ((sheet gtk-label-pane))
   (let ((frame (gtk_frame_new (climi::label-pane-label sheet)))
-	(fixed (gtk_fixed_new)))
-    (setf (label-pane-fixed sheet) fixed)
+	(fixed (gtk_fixed_new))
+	(child (car (sheet-children sheet))))
     (gtk_container_add frame fixed)
+    (gtk_widget_show fixed)
+    (when child
+      (let* ((q (compose-space child))
+	     (width1 (space-requirement-width q))
+	     (height1 (space-requirement-height q)))
+	(gtk_widget_set_size_request fixed width1 height1)
+	(cffi:with-foreign-object (r 'gtkrequisition)
+	  (gtk_widget_size_request frame r)
+	  (cffi:with-foreign-slots ((width height) r gtkrequisition)
+	    (setf (label-pane-extra-width sheet) (- width width1))
+	    (setf (label-pane-extra-height sheet) (- height height1))))))
+    (setf (label-pane-fixed sheet) fixed)
     frame))
 
 (defmethod container-put ((parent gtk-label-pane) parent-widget child x y)
@@ -493,25 +507,21 @@
 
 ;;; COMPOSE-SPACE
 
-(defvar *use-frontend-compose-space* nil)
-
 ;; KLUDGE: this is getting called before the sheet has been realized.
 (defmethod compose-space ((gadget native-widget-mixin) &key width height)
   (declare (ignore width height))
-  (if *use-frontend-compose-space*
-      (let ((*use-frontend-compose-space* nil))
-	(call-next-method))
-      (let* ((widget (native-widget gadget))
-	     (widgetp widget))
-	(unless widgetp
-	  (setf widget (realize-native-widget gadget)))
-	(prog1
-	    (cffi:with-foreign-object (r 'gtkrequisition)
-	      (gtk_widget_size_request widget r)
-	      (cffi:with-foreign-slots ((width height) r gtkrequisition)
-		(make-space-requirement :width width :height height)))
-	  (unless widgetp
-	    (gtk_widget_destroy widget))))))
+  (let* ((widget (native-widget gadget))
+	 (widgetp widget))
+    (unless widgetp
+      (setf widget (realize-native-widget gadget)))
+    (prog1
+	(cffi:with-foreign-object (r 'gtkrequisition)
+	  (gtk_widget_size_request widget r)
+	  (cffi:with-foreign-slots ((width height) r gtkrequisition)
+	    (make-space-requirement :width width :height height)))
+      (unless widgetp
+	(gtk_widget_destroy widget)
+	(setf (native-widget gadget) nil)))))
 
 (defmethod compose-space ((gadget gtk-menu-bar) &key width height)
   (declare (ignore width height))
@@ -531,12 +541,15 @@
 				    :min-height height
 				    :max-height height)))
       (unless widgetp
-	(gtk_widget_destroy widget)))))
+	(gtk_widget_destroy widget)
+	(setf (native-widget gadget) nil)))))
 
-(defmethod compose-space ((gadget gtk-label-pane) &key width height)
-  (declare (ignore width height))
-  (let ((*use-frontend-compose-space* t))
-    (call-next-method)))
+(defmethod allocate-space ((pane label-pane) width height)
+  (when (sheet-children pane)
+    (move-sheet (first (sheet-children pane)) 0 0)
+    (allocate-space (first (sheet-children pane))
+		    (- width (label-pane-extra-width pane))
+		    (- height (label-pane-extra-height pane)))))
 
 
 ;;; Vermischtes