From 4bd6617f805c4aac569ee55ad44f4729f2a908c7 Mon Sep 17 00:00:00 2001 From: Matt Birkholz Date: Sun, 18 Sep 2011 15:58:44 -0700 Subject: [PATCH] Fixed gtk-window-set-geometry-hints. Used get-keyword-value and exported the binding. Simplified the documentation for gtk-window-parse-geometry. --- doc/gtk/gtk.texinfo | 12 ++++----- src/gtk/fix-layout.scm | 2 +- src/gtk/gtk-object.scm | 61 +++++++++++++++++++++++------------------- src/gtk/gtk.pkg | 4 ++- 4 files changed, 44 insertions(+), 35 deletions(-) diff --git a/doc/gtk/gtk.texinfo b/doc/gtk/gtk.texinfo index 404c32014..6509da40d 100644 --- a/doc/gtk/gtk.texinfo +++ b/doc/gtk/gtk.texinfo @@ -939,16 +939,16 @@ Applies @var{receiver} to @var{window}'s default width and height. @end deffn @deffn Procedure gtk-window-parse-geometry window string -Returns #f if not on X or @var{string} is not a standard X geometry -string. Otherwise returns #t and sets @var{window}'s user-requested -size and position. An X geometry string is something like +Returns #f if @var{string} is not a standard X geometry string. +Otherwise returns #t and sets @var{window}'s user-requested size +and/or position. An X geometry string is something like @code{"-0+0"}, meaning ``upper right hand corner''. The X manpage contains the full details. Note that for this procedure to work correctly (so that @var{window} is created at its final size and position --- no moving, resizing, etc.) the window should have any -geometry hints already set, and a "final" size already determined, -i.e. by previously setting any default size(?), and ``showing'' the -toplevel widget. See @bref{gtk-window-set-geometry-hints}. +geometry hints already set, and a final size already determined by +``showing'' the toplevel widget. See +@bref{gtk-window-set-geometry-hints}. @end deffn @deffn Procedure gtk-window-resize window width height diff --git a/src/gtk/fix-layout.scm b/src/gtk/fix-layout.scm index 31c7f46a4..c52c517ca 100644 --- a/src/gtk/fix-layout.scm +++ b/src/gtk/fix-layout.scm @@ -272,7 +272,7 @@ USA. (width (C-> GtkAllocation "GtkAllocation width")) (height (C-> GtkAllocation "GtkAllocation height")) (rect (fix-layout-geometry widget))) - (%trace "; "width"x"height" to "widget"\n") + (%trace "; allocated "width"x"height" to "widget"\n") (set-fix-rect! rect x y width height) (set-fix-rect-size! (fix-layout-view widget) width height) ;; For the random toolkit GtkWidget method too. diff --git a/src/gtk/gtk-object.scm b/src/gtk/gtk-object.scm index f8969b569..3cffdfacd 100644 --- a/src/gtk/gtk-object.scm +++ b/src/gtk/gtk-object.scm @@ -785,40 +785,47 @@ USA. (C-call "gtk_window_set_default_size" (gobject-alien window) width height)) (define (gtk-window-set-geometry-hints window widget . hints) - (let ((geometry (malloc (C-sizeof "GdkGeometry"))) + (guarantee-gtk-window window 'gtk-window-set-geometry-hints) + (guarantee-gtk-widget widget 'gtk-window-set-geometry-hints) + (guarantee-restricted-keyword-list + hints '(min-width min-height max-width max-height base-width base-height + width-increment height-increment min-aspect max-aspect + gravity) 'gtk-window-set-geometry-hints) + (let ((geometry (malloc (C-sizeof "GdkGeometry") '|GdkGeometry|)) (mask 0)) + (define-integrable (value key) + (get-keyword-value hints key)) + (define-integrable-operator (get-fixnum name) - (let ((entry (assq name hints))) - (and entry - (let ((v (cdr entry))) - (cond ((not (fixnum? v)) (error "Not a fixnum:" v name 'gtk-window-set-geometry-hints)) - ((fix:< v -1) (error "Negative:" v name 'gtk-window-set-geometry-hints)) - (else v)))))) + (let ((v (value name))) + (cond ((default-object? v) #f) + ((not (fixnum? v)) (error "Not a fixnum:" v name 'gtk-window-set-geometry-hints)) + ((fix:< v -1) (error "Negative:" v name 'gtk-window-set-geometry-hints)) + (else v)))) (define-integrable-operator (get-real name) - (let ((entry (assq name hints))) - (and entry - (let ((v (cdr entry))) - (if (not (real? v)) - (error "Not real:" v name 'gtk-window-set-geometry-hints) - v))))) + (let ((v (value name))) + (cond ((default-object? v) #f) + ((not (real? v)) (error "Not real:" v name 'gtk-window-set-geometry-hints)) + (else v)))) (define-integrable (get-gravity) - (let ((entry (assq 'gravity hints))) - (and entry - (case (cdr entry) - ((north) (C-enum "GDK_GRAVITY_NORTH")) - ((northeast) (C-enum "GDK_GRAVITY_NORTH_EAST")) - ((east) (C-enum "GDK_GRAVITY_EAST")) - ((southeast) (C-enum "GDK_GRAVITY_SOUTH_EAST")) - ((south) (C-enum "GDK_GRAVITY_SOUTH")) - ((southwest) (C-enum "GDK_GRAVITY_SOUTH_WEST")) - ((west) (C-enum "GDK_GRAVITY_WEST")) - ((northwest) (C-enum "GDK_GRAVITY_NORTH_WEST")) - ((center) (C-enum "GDK_GRAVITY_CENTER")) - ((static) (C-enum "GDK_GRAVITY_STATIC")) - (else (error "Not a gravity:" (cdr entry) 'gtk-window-set-geometry-hints)))))) + (let ((v (value 'gravity))) + (if (default-object? v) + #f + (case v + ((north) (C-enum "GDK_GRAVITY_NORTH")) + ((northeast) (C-enum "GDK_GRAVITY_NORTH_EAST")) + ((east) (C-enum "GDK_GRAVITY_EAST")) + ((southeast) (C-enum "GDK_GRAVITY_SOUTH_EAST")) + ((south) (C-enum "GDK_GRAVITY_SOUTH")) + ((southwest) (C-enum "GDK_GRAVITY_SOUTH_WEST")) + ((west) (C-enum "GDK_GRAVITY_WEST")) + ((northwest) (C-enum "GDK_GRAVITY_NORTH_WEST")) + ((center) (C-enum "GDK_GRAVITY_CENTER")) + ((static) (C-enum "GDK_GRAVITY_STATIC")) + (else (error "Not a gravity:" v 'gtk-window-set-geometry-hints)))))) (let ((width (get-fixnum 'min-width)) (height (get-fixnum 'min-height))) diff --git a/src/gtk/gtk.pkg b/src/gtk/gtk.pkg index c1041f6cd..d4b2fb6a7 100644 --- a/src/gtk/gtk.pkg +++ b/src/gtk/gtk.pkg @@ -168,7 +168,9 @@ USA. ;;gtk-container-check-resize gtk-window? guarantee-gtk-window - gtk-window-new gtk-window-set-title gtk-window-type + gtk-window-new gtk-window-type + gtk-window-set-geometry-hints + gtk-window-set-title gtk-window-set-opacity gtk-window-set-default-size gtk-window-get-default-size gtk-window-parse-geometry -- 2.25.1