Limit how small the fix-resizer will make its siblings.
authorMatt Birkholz <matt@birkholz.chandler.az.us>
Fri, 7 Oct 2011 04:01:36 +0000 (21:01 -0700)
committerMatt Birkholz <matt@birkholz.chandler.az.us>
Fri, 7 Oct 2011 04:01:36 +0000 (21:01 -0700)
src/gtk/fix-layout.scm

index 6a6fd067450bd2366e453d4dd8515dc6e4f99ed6..21536d9691eddde9e124780926c429d759486dc8 100644 (file)
@@ -825,34 +825,65 @@ USA.
   (%trace ";resizer-motion-handler "resizer" "modifiers" "x" "y"\n")
   (if (fix-resizer-dragging? resizer)
       (if (equal? modifiers '(button1))
-         (let ((geom (fix-widget-geometry resizer)))
-           (let ((dx
-                  (if (fix-resizer-stack-vertical? resizer)
-                      0
-                      ;; Before is left; if pointer is right of the
-                      ;; middle (at greater X), the before widget
-                      ;; should grow.
-                      (fix:- x (fix:quotient (fix-rect-width geom) 2))))
-                 (dy
-                  (if (fix-resizer-stack-vertical? resizer)
-                      ;; After is above; if pointer is below start
-                      ;; (at greater Y), resizee should grow.
-                      (fix:- y (fix:quotient (fix-rect-height geom) 2))
-                      0)))
-
-             (define (adjust widget dx dy)
-               (let ((w.h (gtk-widget-get-size widget)))
-                 (let ((w (fix:max 5 (fix:+ (car w.h) dx)))
-                       (h (fix:max 5 (fix:+ (cdr w.h) dy))))
-                   (%trace ";  resizing "widget" to "w"x"h"\n")
-                   (gtk-widget-set-size-request widget w h))))
-
-             (without-interrupts
-              (lambda ()
-                (adjust (fix-resizer-before resizer)
-                        dx dy)
-                (adjust (fix-resizer-after resizer)
-                        (fix:* -1 dx) (fix:* -1 dy))))))
+         (let ((geom (fix-widget-geometry resizer))
+               (before (fix-resizer-before resizer))
+               (after (fix-resizer-after resizer)))
+           (let ((w.h-before (gtk-widget-get-size before))
+                 (w.h-after (gtk-widget-get-size after)))
+
+             (define-integrable adjust!
+               (named-lambda (adjust! dx dy)
+                 (if (not (and (fix:zero? dx) (fix:zero? dy)))
+                     (begin
+                       (let ((w (fix:+ (car w.h-before) dx))
+                             (h (fix:+ (cdr w.h-before) dy)))
+                         (%trace ";  resizing "before" to "w"x"h"\n")
+                         (gtk-widget-set-size-request before w h))
+                       (let ((w (fix:- (car w.h-after) dx))
+                             (h (fix:- (cdr w.h-after) dy)))
+                         (%trace ";  resizing "after" to "w"x"h"\n")
+                         (gtk-widget-set-size-request after w h))))))
+
+             (if (fix-resizer-stack-vertical? resizer)
+
+                 (let* ((y-middle (fix:quotient (fix-rect-height geom) 2))
+                        ;; Before is above; if pointer is below the middle
+                        ;; (at greater Y), the before widget should grow.
+                        (dy (fix:- y y-middle))
+                        ;; Neither widget should be sized too small.
+                        (dy-clamped
+                         (if (fix:< 0 dy)
+                             ;; After should get only so small.
+                             (let ((dy-max
+                                    (fix:max 0
+                                             (fix:- (cdr w.h-after) 5))))
+                               (fix:min dy dy-max))
+                             ;; Before should get only so small.
+                             (let ((dy-min
+                                    (fix:min 0
+                                             (fix:*
+                                              -1 (fix:- (cdr w.h-before) 5)))))
+                               (fix:max dy-min dy)))))
+                   (adjust! 0 dy-clamped))
+
+                 (let* ((x-middle (fix:quotient (fix-rect-width geom) 2))
+                        ;; Before is left; if pointer is right of the
+                        ;; middle (at greater X), the before widget
+                        ;; should grow.
+                        (dx (fix:- x x-middle))
+                        (dx-clamped
+                         (if (fix:< 0 dx)
+                             ;; After should get only so small.
+                             (let ((dx-max
+                                    (fix:max 0
+                                             (fix:- (car w.h-after) 5))))
+                               (fix:min dx dx-max))
+                             ;; Before should get only so small.
+                             (let ((dx-min
+                                    (fix:max 0
+                                             (fix:- (car w.h-before) 5))))
+                               (fix:max dx-min dx)))))
+                   (adjust! dx-clamped 0)))))
          (begin
            (%trace ";  drag dropped!\n")
            (C-call "gtk_grab_remove" (gobject-alien resizer))