Fixed resizing to small sizes. Added parse-geometry.

Settled on an init-size! that sets a small (arbitrary) minimum size.

diff --git a/src/gtk-screen/gtk-screen.pkg b/src/gtk-screen/gtk-screen.pkg
index f7fb7050716c2b56a891ee9faa74c4d09caf33a6..fe9a01aafa3902d00e70d55cf32c5cdbf4350b66 100644 (file)
--- a/src/gtk-screen/gtk-screen.pkg
+++ b/src/gtk-screen/gtk-screen.pkg
@@ -136,10 +136,9 @@ USA.
          <gtk-vbox> gtk-vbox? gtk-vbox-new
          gtk-box-pack-end
 
-         gtk-window-get-default-size
          gtk-window-new
          gtk-window-present
-         gtk-window-set-default-size
+         gtk-window-set-geometry-hints
          gtk-window-set-title
          gtk-window-set-opacity
          gtk-window-parse-geometry

diff --git a/src/gtk-screen/gtk-screen.scm b/src/gtk-screen/gtk-screen.scm
index db4d711cb8fc4c1a577cf4962cfce792cf34a161..cba1bc9f5f2ea74535a351f1861f93ec66597408 100644 (file)
--- a/src/gtk-screen/gtk-screen.scm
+++ b/src/gtk-screen/gtk-screen.scm
@@ -122,67 +122,46 @@ USA.
          (set-gtk-screen-font! screen desc))
        (set-gtk-widget-font! widget font))))
 
-;;; This procedure produces a tiny gtk-window!
-(define (new-init-size! screen)
-  ;; SETS the window default size to -1x-1.  (Leaving it there did not
-  ;; work!)  Does NOT depend on font(!).
-  (%trace ";   init-size! "screen"\n")
-  (let ((toplevel (gtk-screen-toplevel screen))
-       (x-size 80)
-       (y-size 24))
-    (gtk-window-get-default-size
-     toplevel
-     (lambda (w h)
-       (%trace ";     window default: "w"x"h"\n")))
-;;;    (let ((toplevel (gtk-screen-toplevel screen))
-;;;      (width (x-size->width screen x-size))
-;;;      (height (y-size->height screen y-size)))
-;;;      (gtk-window-set-default-size toplevel width height))
-    (gtk-window-set-default-size toplevel -1 -1)
-    (set-screen-x-size! screen x-size)
-    (set-screen-y-size! screen y-size)))
-
-(define (old-init-size! screen)
-  ;; Set initial x-size and y-size.  Depends on default font
-  ;; dimensions.  Needs to deal with gtk_window_parse/set_geometry
-  ;; maybe, someday...
-  (%trace ";   init-size! "screen"\n")
-  (let ((toplevel (gtk-screen-toplevel screen))
-       (x-size 83)
-       (y-size 27))
-    (gtk-window-get-default-size
-     toplevel
-     (lambda (w h)
-       (%trace ";     window default: "w"x"h"\n")
-       (let ((w* (if (not (fix:= w -1)) w (x-size->width screen x-size)))
-            (h* (if (not (fix:= h -1)) h (y-size->height screen y-size))))
-        (if (or (fix:= w -1) (fix:= h -1))
-            (begin
-              (%trace ";     set window default: "w*"x"h*"\n")
-              (gtk-window-set-default-size toplevel w* h*)))
-        ;; The widget allocation callback will not do this soon enough!
-        (let ((x-size (width->x-size screen w*))
-              (y-size (height->y-size screen h*)))
-          (%trace ";     setting screen: "x-size"x"y-size"\n")
-          (set-screen-x-size! screen x-size)
-          (set-screen-y-size! screen y-size)))))))
-
 (define (init-size! screen geometry)
-  (declare (ignore geometry))
-  (%trace ";   init-size! "screen" 80x24\n")
-  ;; Just set the logical screen size.  This size sets window and
-  ;; widget sizes, which ultimately determine the GtkWindow size
-  ;; request.  Cannot set-screen-size! because there is no root window
-  ;; yet.  Must set screen size anyway; it is soon used by
-  ;; initialize-screen-root-window!.
-  (set-screen-x-size! screen 80)
-  (set-screen-y-size! screen 24)
-  (%trace ";   default size: "
-        (gtk-window-get-default-size
-         (gtk-screen-toplevel screen)
-         (lambda (w h) (string-append
-                        (number->string w)"x"(number->string h))))
-        "\n"))
+  (%trace ";   init-size! "screen" "geometry"\n")
+  ;; Sets the logical screen size.  This sets Edwin window and thus
+  ;; text-widget sizes, which ultimately determine the GtkWindow size
+  ;; request.  Sets a small (arbitrary) minimum size so that the luser
+  ;; can resize to a size smaller than the logical size.
+  (parse-geometry
+   geometry
+   (lambda (width height x y)
+     ;; Set-screen-size! will not work here.
+     (set-screen-x-size! screen width)
+     (set-screen-y-size! screen height)
+     (let ((toplevel (gtk-screen-toplevel screen)))
+       ;; This allows the luser to resize to smaller than the logical size.
+       (gtk-window-set-geometry-hints toplevel toplevel
+                                     'min-width 100 'min-height 100)))))
+
+(define (parse-geometry geometry receiver)
+  (let* ((num "[0-9]+")
+        (size-patt (string "\\("num"\\)x\\("num"\\)"))
+        (position-patt (string "\\([-+]"num"\\)\\([-+]"num"\\)"))
+        (extract (lambda (regs index)
+                   (string->number (re-match-extract geometry regs index)))))
+    (declare (integrate extract))
+    (cond ((re-string-match (string size-patt position-patt) geometry)
+          => (lambda (regs)
+               (receiver (extract regs 1) (extract regs 2)
+                         (extract regs 3) (extract regs 4))))
+         ((re-string-match position-patt geometry)
+          => (lambda (regs)
+               (receiver #f #f
+                         (extract regs 1) (extract regs 2))))
+         ((re-string-match size-patt geometry)
+          => (lambda (regs)
+               (receiver (extract regs 1) (extract regs 2)
+                         #f #f)))
+         (else
+          (error:wrong-type-argument geometry
+                                     "window geometry (e.g. \"80x40-0-0\")"
+                                     'parse-geometry)))))
 
 (define (x-size->width screen x-size)
   (fix:* x-size (gtk-screen-char-width screen)))