Rewrote update-widgets' re-size! procedure to use x/y-sizes.
authorMatt Birkholz <matt@birkholz.chandler.az.us>
Wed, 7 Sep 2011 20:16:02 +0000 (13:16 -0700)
committerMatt Birkholz <matt@birkholz.chandler.az.us>
Wed, 7 Sep 2011 20:16:02 +0000 (13:16 -0700)
src/gtk-screen/gtk-screen.scm

index 481ebf428019073fc5696b398785f7f40d74b2e6..a3eebc2aef843a28d833b06e50abf54bef952948 100644 (file)
@@ -872,31 +872,26 @@ USA.
                                     box (cdr children) prefix)))))))
 
     (define (re-size! widget window)
-      (let* ((min-width (x-size->width screen (window-x-size window)))
-            (max-width (x-size->width screen (fix:1+ (window-x-size window))))
-            (min-height (y-size->height screen (window-y-size window)))
-            (max-height (y-size->height screen (fix:1+ (window-y-size window))))
-            (area (fix-layout-geometry widget))
-            (width (fix-rect-width area))
-            (height (fix-rect-height area))
-            ;; Snap to the ideal geometry -- no partial-column/row.
-            (new-width (cond ((not width) min-width)
-                             ((fix:< width min-width) min-width)
-                             ((fix:<= max-width width) min-width)
-                             (else width)))
-            (new-height (if (or (not height)
-                                (fix:< height min-height)
-                                (fix:<= max-height height))
-                            min-height
-                            height)))
-       (cond ((or (not width) (not height))
-              (%trace ";\t  re-size!: unrealized "widget"\n"))
-             ((not (and (fix:= new-width width) (fix:= new-height height)))
-              (%trace ";\t  re-size! "widget" from "width"x"height
-                      " to "new-width"x"new-height"\n")
-              (set-fix-layout-size! widget new-width new-height))
-             (else
-              (%trace ";\t  re-size!: no change\n")))))
+      (let ((area (fix-layout-geometry widget))
+           (window-x-size (window-x-size window))
+           (window-y-size (window-y-size window)))
+       (let ((width (fix-rect-width area))
+             (height (fix-rect-height area)))
+         (if (or (not width) (not height))
+             (%trace ";\t  re-size!: unrealized "widget"\n")
+             (let ((widget-x-size (width->x-size screen width))
+                   (widget-y-size (height->y-size screen height)))
+               (if (and (fix:= widget-x-size window-x-size)
+                        (fix:= widget-y-size window-y-size))
+                   (%trace ";\t  re-size!: no change\n")
+                   (let ((new-width (x-size->width screen window-x-size))
+                         (new-height (y-size->height screen window-y-size)))
+                     (%trace ";\t  re-size! "widget
+                             " from "widget-x-size"x"widget-y-size" "
+                             "("width"x"height")"
+                             " to "window-x-size"x"window-y-size" "
+                             "("new-width"x"new-height")\n")
+                     (set-fix-layout-size! widget new-width new-height))))))))
 
     (define (pack-new! box window prefix)
       (%trace ";     "prefix"pack-new! "box" "window"\n")