Added update-sizes, run by set-screen-size input event.

diff --git a/src/gtk-screen/gtk-screen.pkg b/src/gtk-screen/gtk-screen.pkg
index 75c5d181a191a2e91f6faca829edf2b3126ee5f8..a8520bf9d2e0c75e473a37fbd6d61a26920ebb7b 100644 (file)
--- a/src/gtk-screen/gtk-screen.pkg
+++ b/src/gtk-screen/gtk-screen.pkg
@@ -58,7 +58,14 @@ USA.
          editor-frame-root-window
          window-inferiors inferior-window
          combination? combination-vertical?
-         set-window-size!
+         (%window-x-size window-x-size)
+         (%window-y-size window-y-size)
+         %set-window-x-size!
+         %set-window-y-size!
+         inferior-x-start
+         inferior-y-start
+         %set-inferior-start!
+         editor-frame
          buffer-frame?
          frame-modeline-inferior
          frame-text-inferior

diff --git a/src/gtk-screen/gtk-screen.scm b/src/gtk-screen/gtk-screen.scm
index a3eebc2aef843a28d833b06e50abf54bef952948..88bed9e6cb84eea7c568ad723439ace52691a9d6 100644 (file)
--- a/src/gtk-screen/gtk-screen.scm
+++ b/src/gtk-screen/gtk-screen.scm
@@ -873,8 +873,8 @@ USA.
 
     (define (re-size! widget window)
       (let ((area (fix-layout-geometry widget))
-           (window-x-size (window-x-size window))
-           (window-y-size (window-y-size window)))
+           (window-x-size (%text-x-size window))
+           (window-y-size (%text-y-size window)))
        (let ((width (fix-rect-width area))
              (height (fix-rect-height area)))
          (if (or (not width) (not height))
@@ -909,8 +909,8 @@ USA.
        ((buffer-frame? window)
        (let ((vbox (make-buffer-frame-widget))
              (text (make-text-widget screen
-                                     (window-x-size window)
-                                     (window-y-size window)))
+                                     (%text-x-size window)
+                                     (%text-y-size window)))
              (scroller (gtk-scrolled-window-new))
              (modeline (if (not (frame-modeline-inferior window))
                            #f
@@ -928,10 +928,9 @@ USA.
              ;; No modeline: the window/text-widget should NOT expand.
              (begin
                ;; This is also necessary! Why???
-               (gtk-widget-set-size-request
-                scroller
-                (x-size->width screen (window-x-size window))
-                (y-size->height screen (window-y-size window)))
+               (gtk-widget-set-size-request scroller
+                                            (%widget-x-size window screen)
+                                            (%widget-y-size window screen))
                (gtk-box-pack-end vbox scroller #f #f 0)
                ;;(%trace ";     "prefix"pack-new! showing "vbox"\n")
                ;;(gtk-widget-show-all vbox)
@@ -958,6 +957,18 @@ USA.
 
     (main)))
 
+(define-integrable (%text-x-size window)
+  (%window-x-size (frame-text-inferior window)))
+
+(define-integrable (%text-y-size window)
+  (%window-y-size (frame-text-inferior window)))
+
+(define-integrable (%widget-x-size window screen)
+  (x-size->width screen (%text-x-size window)))
+
+(define-integrable (%widget-y-size window screen)
+  (y-size->height screen (%text-y-size window)))
+
 (define (for-each-text-widget screen procedure)
   (every-child (lambda (widget)
                 (and (text-widget? widget)
@@ -1068,8 +1079,8 @@ USA.
              (screen (edwin-widget-screen widget)))
          (%trace "; uninitialized geometry: "geometry"\n")
          (set-fix-rect-size! geometry
-                             (x-size->width screen (window-x-size window))
-                             (y-size->height screen (window-y-size window)))
+                             (%widget-x-size window screen)
+                             (%widget-y-size window screen))
          (%trace "; initialized geometry: "geometry"\n"))))
   (call-next-method widget)
   (realize-font! widget)
@@ -1080,24 +1091,135 @@ USA.
 (define-method fix-layout-new-geometry-callback ((widget <text-widget>))
   (%trace ";((fix-layout-new-geometry-callback <text-widget>) "widget")\n")
   (call-next-method widget)
-  (let ((geometry (fix-layout-geometry widget))
-       (screen (edwin-widget-screen widget))
-       (window (text-widget-buffer-frame widget)))
-    (let ((x-size (width->x-size screen (fix-rect-width geometry)))
-         (y-size (height->y-size screen (fix-rect-height geometry))))
-      (if (not (and (fix:= x-size (window-x-size window))
-                   (fix:= y-size (window-y-size window))))
-         (thread-queue/queue-no-hang!
-          event-queue
-          (make-input-event
-           'SET-WINDOW-SIZE
-           (lambda (window x-size y-size)
-             (%trace ";  input event: set-window-size "window
-                    " to "x-size"x"y-size"\n")
-             (if (not (and (fix:= x-size (window-x-size window))
-                           (fix:= y-size (window-y-size window))))
-                 (set-window-size! window x-size y-size)))
-           window x-size y-size))))))
+  (thread-queue/queue-no-hang!
+   event-queue
+   (make-input-event
+    'SET-WINDOW-SIZE
+    (lambda (widget)
+      (%trace ";  input event: set-window-size "widget"\n")
+      (let ((geometry (fix-layout-geometry widget))
+           (screen (edwin-widget-screen widget))
+           (window (text-widget-buffer-frame widget)))
+       (let ((widget-x-size (width->x-size screen (fix-rect-width geometry)))
+             (widget-y-size (height->y-size screen (fix-rect-height geometry)))
+             (window-x-size (%text-x-size window))
+             (window-y-size (%text-y-size window)))
+         (%trace "; "widget": "geometry"\n")
+         (%trace "; "window": "window-x-size"x"window-y-size"\n")
+         (if (not (and (fix:= widget-x-size window-x-size)
+                       (fix:= widget-y-size window-y-size)))
+             (update-sizes screen)))))
+    widget)))
+
+(define (update-sizes screen)
+  ;; The underhanded way to adjust window sizes.  This procedure does
+  ;; not use the :set-size! method, which presumably adjusts the
+  ;; widget sizes.  It does the "opposite".  It leaves the widgets
+  ;; alone and adjusts Edwin's window and screen sizes (using %
+  ;; operators).
+
+  (define (%set-size! screen window prefix)
+    (cond
+     ((buffer-frame? window)
+      (let ((widget (window-text-widget* window)))
+       (if widget
+           (let* ((view (fix-layout-view widget))
+                  (width (fix-rect-width view))
+                  (height (fix-rect-height view))
+                  (x-size (width->x-size screen width))
+                  (y-size (height->y-size screen height))
+                  (x-size* (if (window-has-right-neighbor? window)
+                               (fix:1+ x-size) x-size))
+                  (y-size* (if (frame-modeline-inferior window)
+                               (fix:1+ y-size) y-size))
+                  (text (frame-text-inferior window)))
+
+             (%trace ";   "prefix""text": "x-size"x"y-size" "view"\n")
+             (%set-window-x-size! text x-size)
+             (%set-window-y-size! text y-size)
+             (%trace ";   "prefix""window": "x-size*"x"y-size*"\n")
+             (%set-window-x-size! window x-size*)
+             (%set-window-y-size! window y-size*))
+           (%trace ";   "prefix""window": no widget\n"))))
+
+     ((or (combination? window)
+         (editor-frame? window))
+      (let ((total-x-size #f)
+           (total-y-size #f)
+           (vertical? (or (editor-frame? window)
+                          (combination-vertical? window))))
+       (for-each
+         (lambda (inferior)
+           (let ((child (inferior-window inferior)))
+             (%set-size! screen child (string-append prefix "--"))
+             (if vertical?
+                 (let ((x-size (%window-x-size child))
+                       (y-size (%window-y-size child)))
+                   (if (not total-x-size)
+                       (set! total-x-size x-size)
+                       (if (not (fix:= x-size total-x-size))
+                           (warn "Wrong Edwin window width:"
+                                 x-size total-x-size window)))
+                   (if (not total-y-size)
+                       (set! total-y-size y-size)
+                       (set! total-y-size (fix:+ total-y-size y-size))))
+                 (let ((x-size (%window-x-size child))
+                       (y-size (%window-y-size child)))
+                   (if (not total-y-size)
+                       (set! total-y-size y-size)
+                       (if (not (fix:= y-size total-y-size))
+                           (warn "Wrong height:"
+                                 y-size total-y-size window)))
+                   (if (not total-x-size)
+                       (set! total-x-size x-size)
+                       (set! total-x-size (fix:+ total-x-size x-size)))))))
+         (window-inferiors window))
+       (%trace ";   "prefix""window": "total-x-size"x"total-y-size"\n")
+       (%set-window-x-size! window total-x-size)
+       (%set-window-y-size! window total-y-size)))
+
+     (else
+      (%trace ";   "prefix""window": unexpected type\n"))))
+
+  (define (%set-starts! inferiors parent prefix x y)
+    (if (pair? inferiors)
+       (let* ((inferior (car inferiors))
+              (window (inferior-window inferior)))
+         (%trace ";   "prefix""window" start: "x"x"y
+                 " (was "
+                 (inferior-x-start inferior)"x"(inferior-y-start inferior)
+                 ")\n")
+         (%set-inferior-start! inferior x y)
+         (if (or (editor-frame? window)
+                 (combination? window))
+             (%set-starts! (window-inferiors window) window
+                           (string-append prefix "--")
+                           x y))
+         (if (or (editor-frame? parent)
+                 (and (combination? parent)
+                      (combination-vertical? parent)))
+             (%set-starts! (cdr inferiors) parent prefix
+                           x
+                           (fix:+ y (%window-y-size window)))
+             (%set-starts! (cdr inferiors) parent prefix
+                           (fix:+ x (%window-x-size window))
+                           y)))))
+
+  (%trace "; update-sizes "screen"\n")
+  (let ((root (screen-root-window screen)))
+    (let ((x-size (%window-x-size root))
+         (y-size (%window-y-size root)))
+      (%trace ";   initial root size: "x-size"x"y-size"\n"))
+    (%set-size! screen root "--")
+    (let ((x-size (%window-x-size root))
+         (y-size (%window-y-size root)))
+      (%trace ";   screen: "x-size"x"y-size"\n")
+      (set-screen-x-size! screen x-size)
+      (set-screen-y-size! screen y-size))
+    (%set-starts! (window-inferiors root) root "--" 0 0)))
+
+(define-integrable (editor-frame? object)
+  (object-of-class? editor-frame object))
 
 (define-class (<modeline-widget> (constructor make-modeline-widget (screen)))
     (<edwin-widget>))
@@ -1457,7 +1579,7 @@ USA.
   (let* ((window (text-widget-buffer-frame widget))
         ;; Add a few columns so the text runs past scrollbars and
         ;; whatnot, off the right side of the widget.
-        (x-size (+ 5 (window-x-size window))))
+        (x-size (+ 5 (%window-x-size window))))
     (if widget
        (let ((modeline (text-widget-modeline widget)))
          (if modeline