From 878fbd8b0ccbe69c99fc810391803dc2581cc6ef Mon Sep 17 00:00:00 2001 From: Matt Birkholz Date: Thu, 29 Sep 2011 18:20:26 -0700 Subject: [PATCH] Allow fix-resizer-resizee to be any gtk-widget. Using gtk-widget-get-size (new) and gtk-widget-set-size-request instead of fix-widget-geometry and set-fix-widget-size!. --- src/gtk/fix-layout.scm | 28 +++++++++------------------- src/gtk/gtk-object.scm | 5 +++++ src/gtk/gtk.pkg | 1 + 3 files changed, 15 insertions(+), 19 deletions(-) diff --git a/src/gtk/fix-layout.scm b/src/gtk/fix-layout.scm index 42e425fd5..9196a8e48 100644 --- a/src/gtk/fix-layout.scm +++ b/src/gtk/fix-layout.scm @@ -148,7 +148,7 @@ USA. (rect (fix-widget-geometry widget))) (%trace "; allocated "width"x"height" to "widget"\n") (set-fix-rect! rect x y width height) - ;; For the random toolkit GtkWidget method too. + ;; For gtk-widget-get-size and random toolkit methods. (C->= alien "GtkWidget allocation x" x) (C->= alien "GtkWidget allocation y" y) (C->= alien "GtkWidget allocation width" width) @@ -732,8 +732,7 @@ USA. (define-method initialize-instance ((widget ) width height) (call-next-method widget width height) - (guarantee-fix-widget (fix-resizer-resizee widget) - '(initialize-instance )) + (%trace "; (initialize-instance ) "widget" "width"x"height"\n") (let ((vertical? (or (and (fix:< width 1) (fix:> height 0)) (fix:< height width) (error "Ambiguous verticality:" widget width height)))) @@ -794,13 +793,12 @@ USA. (let* ((geom (fix-widget-geometry resizer)) (x-parent (fix:+ x (fix-rect-x geom))) (y-parent (fix:+ y (fix-rect-y geom))) - (geomee (fix-widget-geometry (fix-resizer-resizee resizer))) - (width (fix-rect-width geomee)) - (height (fix-rect-height geomee))) + (width.height (gtk-widget-get-size resizee))) (%trace "; drag start" - " at "x-parent","y-parent" with "width"x"height"!\n") + " at "x-parent","y-parent + " with "(car width.height)"x"(cdr width.height)"!\n") (set-fix-resizer-drag-start! resizer (cons (cons x-parent y-parent) - (cons width height))) + width.height)) (C-call "gtk_grab_add" (gobject-alien resizer))))) (define (resizer-release-handler resizer type button modifiers x y) @@ -840,17 +838,9 @@ USA. (fix:max (fix:+ height-start (fix:- y-parent y-start)) 2) height-start)) - (resizee (fix-resizer-resizee resizer)) - (geomee (fix-widget-geometry resizee)) - (width (fix-rect-width geomee)) - (height (fix-rect-height geomee))) - (if (not (and (fix:= width width-new) - (fix:= height height-new))) - (begin - (%trace "; resizing to "width-new"x"height-new"\n") - (set-fix-widget-size! resizee width-new height-new)) - (begin - (%trace "; fine with "width"x"height"\n")))) + (resizee (fix-resizer-resizee resizer))) + (%trace "; resizing to "width-new"x"height-new"\n") + (gtk-widget-set-size-request resizee width-new height-new)) (begin (%trace "; drag dropped!\n") (C-call "gtk_grab_remove" (gobject-alien resizer)) diff --git a/src/gtk/gtk-object.scm b/src/gtk/gtk-object.scm index 3cffdfacd..42beb702d 100644 --- a/src/gtk/gtk-object.scm +++ b/src/gtk/gtk-object.scm @@ -205,6 +205,11 @@ USA. (error-if-null layout "Could not create:" layout) layout)) +(define (gtk-widget-get-size widget) + (let ((alien (gobject-alien widget))) + (cons (C-> alien "GtkWidget allocation width") + (C-> alien "GtkWidget allocation height")))) + (define (gtk-widget-set-size-request widget width height) (C-call "gtk_widget_set_size_request" (gobject-alien widget) width height)) diff --git a/src/gtk/gtk.pkg b/src/gtk/gtk.pkg index 682cd352f..24b303144 100644 --- a/src/gtk/gtk.pkg +++ b/src/gtk/gtk.pkg @@ -146,6 +146,7 @@ USA. gtk-widget-get-colormap gtk-widget-get-pango-context gtk-widget-create-pango-layout + gtk-widget-get-size gtk-widget-set-size-request ;;gtk-widget-set-can-focus set-gtk-widget-size-allocate-callback! -- 2.25.1