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