From: Matt Birkholz <matt@birkholz.chandler.az.us>
Date: Thu, 31 Jan 2013 16:46:53 +0000 (-0700)
Subject: gtk-screen: Unset GtkPanedView positions when resizing windows.
X-Git-Tag: mit-scheme-pucked-9.2.12~366^2~65
X-Git-Url: https://birchwood-abbey.net/git?a=commitdiff_plain;h=49168d83eb7e3ab3fea0a9f570dd82ac5181ef34;p=mit-scheme.git

gtk-screen: Unset GtkPanedView positions when resizing windows.
---

diff --git a/src/gtk-screen/gtk-screen.pkg b/src/gtk-screen/gtk-screen.pkg
index 269af10a2..40b392957 100644
--- a/src/gtk-screen/gtk-screen.pkg
+++ b/src/gtk-screen/gtk-screen.pkg
@@ -86,7 +86,7 @@ USA.
   (import (gtk gtk-widget)
 	  gtk-widget-destroy-callback
 	  gtk-container-reverse-children
-	  <gtk-paned-view> gtk-paned-view-init)
+	  gtk-paned-view-init)
   (import (gtk fix-layout)
 	  fix-widget-geometry
 
@@ -133,8 +133,10 @@ USA.
 	  gtk-scrolled-window-set-policy gtk-scrolled-window-set-placement
 	  gtk-scrolled-view-new
 
+	  gtk-paned?
 	  gtk-paned-pack1 gtk-paned-pack2
 	  gtk-paned-get-child1 gtk-paned-get-child2
+	  gtk-paned-set-position
 	  <gtk-paned-view> gtk-paned-view-new
 
 	  gtk-window-new
diff --git a/src/gtk-screen/gtk-screen.scm b/src/gtk-screen/gtk-screen.scm
index d31dbf3f1..4e0f773b6 100644
--- a/src/gtk-screen/gtk-screen.scm
+++ b/src/gtk-screen/gtk-screen.scm
@@ -890,6 +890,13 @@ USA.
 			      "("width"x"height")"
 			      " to "window-x-size"x"window-y-size" "
 			      "("new-width"x"new-height")\n")
+		      (let unset-pos ((w (gtk-screen-toplevel screen)))
+			(if (gtk-container? w)
+			    (begin
+			      (for-each unset-pos
+					(gtk-container-reverse-children w))
+			      (if (gtk-paned? w)
+				  (gtk-paned-set-position w -1)))))
 		      (set-scm-widget-natural-size!
 		       widget new-width new-height)
 		      (gtk-widget-queue-resize-no-redraw widget))))))))
diff --git a/src/gtk/Includes/gtkpaned.cdecl b/src/gtk/Includes/gtkpaned.cdecl
index b67011e18..846444ae5 100644
--- a/src/gtk/Includes/gtkpaned.cdecl
+++ b/src/gtk/Includes/gtkpaned.cdecl
@@ -18,4 +18,13 @@ gtk-3.0/gtk/gtkpaned.h |#
 	(paned (* GtkPaned))
 	(child (* GtkWidget))
 	(resize gboolean)
-	(shrink gboolean))
\ No newline at end of file
+	(shrink gboolean))
+
+(extern gint
+	gtk_paned_get_position
+	(paned (* GtkPaned)))
+
+(extern void
+	gtk_paned_set_position
+	(paned (* GtkPaned))
+	(position gint))
\ No newline at end of file
diff --git a/src/gtk/gtk-widget.scm b/src/gtk/gtk-widget.scm
index 4c3b46998..407b3b737 100644
--- a/src/gtk/gtk-widget.scm
+++ b/src/gtk/gtk-widget.scm
@@ -1,6 +1,6 @@
 #| -*-Scheme-*-
 
-Copyright (C) 2007, 2008, 2009, 2010, 2011, 2012  Matthew Birkholz
+Copyright (C) 2007, 2008, 2009, 2010, 2011, 2012, 2013  Matthew Birkholz
 
 This file is part of an extension to MIT/GNU Scheme.
 
@@ -768,6 +768,12 @@ USA.
   (C-call "gtk_paned_pack2" (gobject-alien paned) (gobject-alien child2)
 	  (if resize? 1 0) (if shrink? 1 0)))
 
+(define (gtk-paned-get-position paned)
+  (C-call "gtk_paned_get_position" (gobject-alien paned)))
+
+(define (gtk-paned-set-position paned child1-size)
+  (C-call "gtk_paned_set_position" (gobject-alien paned) child1-size))
+
 (define-class (<gtk-paned-view> (constructor ()))
     (<gtk-paned>))
 
diff --git a/src/gtk/gtk.pkg b/src/gtk/gtk.pkg
index c3aa43dcd..a2e690e39 100644
--- a/src/gtk/gtk.pkg
+++ b/src/gtk/gtk.pkg
@@ -1,6 +1,6 @@
 #| -*-Scheme-*-
 
-Copyright (C) 2007, 2008, 2009, 2010, 2011, 2012  Matthew Birkholz
+Copyright (C) 2007, 2008, 2009, 2010, 2011, 2012, 2013  Matthew Birkholz
 
 This file is part of an extension to MIT/GNU Scheme.
 
@@ -214,6 +214,7 @@ USA.
 	  <gtk-paned> gtk-paned? gtk-paned-new
 	  gtk-paned-pack1 gtk-paned-pack2
 	  gtk-paned-get-child1 gtk-paned-get-child2
+	  gtk-paned-get-position gtk-paned-set-position
 	  <gtk-paned-view> gtk-paned-view? gtk-paned-view-new)
   (import (gtk pango) make-pango-layout guarantee-pango-font-description))