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")