@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
(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)))
projects / mit-scheme.git / commitdiff