Allow fix-resizer-resizee to be any gtk-widget.
authorMatt Birkholz <matt@birkholz.chandler.az.us>
Fri, 30 Sep 2011 01:20:26 +0000 (18:20 -0700)
committerMatt Birkholz <matt@birkholz.chandler.az.us>
Fri, 30 Sep 2011 01:20:26 +0000 (18:20 -0700)
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
src/gtk/gtk-object.scm
src/gtk/gtk.pkg

index 42e425fd5397dedf6b58464cfffc821bd5c31316..9196a8e4813de04be5f3b896128c2b7e337d3c44 100644 (file)
@@ -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 <fix-resizer>) width height)
   (call-next-method widget width height)
-  (guarantee-fix-widget (fix-resizer-resizee widget)
-                       '(initialize-instance <fix-resizer>))
+  (%trace "; (initialize-instance <fix-resizer>) "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))
index 3cffdfacd2a6c3b5aa3a6bc3a2c7cae4579530df..42beb702de139f16eb8ae5ac520f9f81831656a6 100644 (file)
@@ -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))
 
index 682cd352fbe0aa18a20fed5e1b96bd2a98bf5586..24b3031443f0e559680e01b0b1215082e3b52622 100644 (file)
@@ -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!