* Gtk Label::
* Gtk Button::
* Gtk Check Button::
-* Gtk Box::
+* Gtk Grid::
* Gtk Frame::
* Gtk Scrolled Window::
* Scheme Widget::
@bref{pango-layout-context-changed} to re-lay-out the text.
@end deffn
-@anchor{gtk-widget-set-size-request}
+@deffn Procedure gtk-widget-get-size widget
+Gets @var{widget}'s size allocation, a pair of integers:
+@code{(width . height)}.
+@end deffn
+
+@deffn Procedure gtk-widget-set-hexpand widget expand?
+Set whether @var{widget} would like any available extra horizontal
+space or not, overriding the default expand behavior.
+@end deffn
+
+@deffn Procedure gtk-widget-set-vexpand widget expand?
+Set whether @var{widget} would like any available extra vertical
+space or not, overriding the default expand behavior.
+@end deffn
+
@deffn Procedure gtk-widget-set-size-request widget width height
Notify the toolkit of @var{widget}'s natural size. @var{Width} and
@var{height} should be positive. This is just a request.
@var{Widget}'s size-allocate callback will be applied when its size is
initialized or changed.
+Unfortunately this procedure also overrides the minimum width and
+height so that a top-level window cannot be resized to a smaller size.
@end deffn
-@deffn Procedure gtk-widget-get-size widget
-Gets @var{widget}'s size allocation, a pair of integers:
-@code{(width . height)}.
-@end deffn
+@anchor{gtk-widget-set-size-request}
@subsection Gtk Widget Colors & Fonts
be in a container. Typically used for GtkBins, where positioning the
child in the container is trivial. When applied to a more complex
container, the results may be unexpected. Consider a more specialized
-procedure like @bref{gtk-box-pack-start}.
+procedure like @bref{gtk-grid-attach}.
@end deffn
@deffn Procedure gtk-container-remove container child
Sets @var{window}'s default size to @var{width} x @var{height}. If
either dimension is -1, the default for that dimension is unset. If a
dimension is 0, it is treated like 1, which means ``as small as
-possible'' (which is effectively ``unset''?). With a default size
+possible''. With a default size
set, @var{window} may still request a larger size. The final size
will be clamped according to @var{window}'s geometry hints. If
@var{window} has already been shown, this procedure has no effect; it
@bref{gtk-window-set-default-size}.
These come from geometry hints, and a default constraint that windows
-not be sized smaller than their natural size. To force @var{window}'s
-``natural'' size, apply @bref{gtk-widget-set-size-request}.
+not be sized smaller than their natural size.
@end deffn
@deffn Procedure gtk-window-present window
@var{button} in @var{callback}'s closure, else it cannot be GCed.
@end deffn
-@node Gtk Check Button, Gtk Box, Gtk Button, API Reference
+@node Gtk Check Button, Gtk Grid, Gtk Button, API Reference
@section Gtk Check Button
@deffn Class <gtk-check-button>
@var{button} in @var{callback}'s closure, else it cannot be GCed.
@end deffn
-@node Gtk Box, Gtk Frame, Gtk Check Button, API Reference
-@section Gtk Box
+@node Gtk Grid, Gtk Frame, Gtk Check Button, API Reference
+@section Gtk Grid
-Gtk boxes can be vboxes or hboxes arranging their children vertically
-or horizontally, respectively.
+GtkGrids arrange their children in rows and columns.
-@anchor{gtk-box-pack-start}
-@deffn Procedure gtk-box-pack-start box child expand? fill? padding
-Adds @var{child} to @var{box} @emph{after} siblings previously packed
-with this procedure, and @emph{before} siblings previously packed with
-@bref{gtk-box-pack-end}. @var{Box} can be a gtk-vbox or gtk-hbox. If
-@var{expand?}, the new child is positioned within a share of any extra
-space. If @var{fill?} (and @var{expand?}), the child is allocated the
-share of extra space. @var{Padding} is the space around the child,
-e.g. between it and its neighbors @emph{and} the edge of the box.
+@deffn Class <gtk-grid>
+A direct subclass of gtk-container representing a reference to a GtkGrid.
@end deffn
-@anchor{gtk-box-pack-end}
-@deffn Procedure gtk-box-pack-end box child expand? fill? padding
-Just like @bref{gtk-box-pack-start}, except @var{child} is packed
-@emph{before} siblings previously packed with this procedure,
-@emph{after} siblings packed with gtk-box-pack-start.
+@deffn Procedure gtk-grid? object
+Type predicate.
@end deffn
-@deffn Class <gtk-vbox>
-A direct subclass of gtk-container representing a reference to a GtkVBox.
+@deffn Procedure guarantee-gtk-grid object operator
+Type guarantor.
@end deffn
-@deffn Procedure gtk-vbox? object
-Type predicate.
+@deffn Procedure gtk-grid-new
+A new gtk-grid.
@end deffn
-@deffn Procedure guarantee-gtk-vbox object operator
-Type guarantor.
+@deffn Procedure gtk-grid-set-row-spacing grid space
+Set the distance between rows of @var{grid} to @var{space} pixels.
@end deffn
-@deffn Procedure gtk-vbox-new homogeneous? spacing
-A new gtk-vbox. If @var{homogeneous?} is not #f, all children are
-given equal space allocations. @var{Spacing} is the distance between
-children.
+@deffn Procedure gtk-grid-set-column-spacing grid space
+Set the distance between columns of @var{grid} to @var{space} pixels.
@end deffn
-@deffn Class <gtk-hbox>
-A direct subclass of gtk-container representing a reference to a GtkHBox.
+@deffn Procedure gtk-grid-set-row-homogeneous grid homogeneous?
+Set the homogeneity of row heights. If @var{homogeneous?} is
+@code{#f}, rows can have different heights. Else they are all
+allocated the same height.
@end deffn
-@deffn Procedure gtk-hbox? object
-Type predicate.
+@deffn Procedure gtk-grid-set-column-homogeneous grid homogeneous?
+Set the homogeneity of column widths. If @var{homogeneous?} is
+@code{#f}, columns can have different widths. Else they are all
+allocated the same width.
@end deffn
-@deffn Procedure guarantee-gtk-hbox object operator
-Type guarantor.
+@anchor{gtk-grid-attach}
+@deffn Procedure gtk-grid-attach grid widget left top width height
+Place @var{widget} in @var{grid} at column @var{left} spanning
+@var{width} columns, and at row @var{top} spanning @var{height} rows.
@end deffn
-@deffn Procedure gtk-hbox-new homogeneous? spacing
-A new gtk-hbox. If @var{homogeneous?} is not #f, all children are
-given equal space allocations. @var{Spacing} is the distance between
-children.
+@deffn Procedure gtk-orientable-set-orientation orientable orientation
+Set a GtkOrientable to @var{orientation} which should be one of the
+symbols @code{horizontal} or @code{vertical}.
@end deffn
-@node Gtk Frame, Gtk Scrolled Window, Gtk Box, API Reference
+@node Gtk Frame, Gtk Scrolled Window, Gtk Grid, API Reference
@section Gtk Frame
A bin with a decorative frame and optional label.
@code{size_allocate} and @code{realize}. Its representative in
Scheme, a scm-widget instance, arranges to clean these up if it is
garbage collected, like any other gobject instance. Scheme widgets
-have a @code{set_scroll_adjustments} signal, like GtkLayout, allowing
-them to be placed in Gtk scrolled windows.
+implement the GtkScrollable interface, emitting a
+@code{set_scroll_adjustments} signal when the ``vadjustment'' or
+``hadjustment'' properties are set. They also participate in the
+width-for-height (or height-for-width) geometry management protocol
+in @code{GTK_SIZE_REQUEST_CONSTANT_SIZE} mode.
@deffn Class <scm-widget>
A direct subclass of gtk-widget representing a reference to a ScmWidget.
will be NULL when the widget's scrollbars are removed.
@end deffn
+@anchor{set-scm-widget-minimum-size!}
+@deffn Procedure set-scm-widget-minimum-size! widget width height
+Sets @var{widget}'s minimum width and height. This procedure does not
+request a resize; it only changes the values returned by ScmWidget
+methods like @code{get_preferred_width}.
+@end deffn
+
+@deffn Procedure set-scm-widget-natural-size! widget width height
+Sets @var{widget}'s natural width and height. This procedure does not
+request a resize; it only changes the values returned by ScmWidget
+methods like @code{get_preferred_height_for_width}.
+@end deffn
+
@section Fix Widget
This simple Scheme widget manages the GdkWindow on which more
(include "gdk")
(include "gtkadjustment")
-(include "gtkbox")
(include "gtkcontainer")
(include "gtkenums")
(include "gtkframe")
-(include "gtkhbox")
+(include "gtkgrid")
(include "gtklabel")
+(include "gtkorientable")
(include "gtkscrolledwindow")
(include "gtkstylecontext")
(include "gtktogglebutton")
(include "gtktypeutils")
-(include "gtkvbox")
(include "gtkwidget")
(include "gtkwindow")
\ No newline at end of file
+++ /dev/null
-#| -*-Scheme-*-
-
-gtk-2.0/gtk/gtkbox.h |#
-
-(extern void
- gtk_box_pack_start
- (box (* GtkBox))
- (child (* GtkWidget))
- (expand gboolean)
- (fill gboolean)
- (padding guint))
-
-(extern void
- gtk_box_pack_end
- (box (* GtkBox))
- (child (* GtkWidget))
- (expand gboolean)
- (fill gboolean)
- (padding guint))
\ No newline at end of file
#| -*-Scheme-*-
-gtk+-2.4.0/gtk/gtkcontainer.h |#
+gtk/gtkcontainer.h |#
(extern void
gtk_container_add
(extern void
gtk_container_set_border_width
(container (* GtkContainer))
- (border_width guint))
\ No newline at end of file
+ (border_width guint))
+
+(extern void
+ gtk_container_resize_children
+ (container (* GtkContainer)))
\ No newline at end of file
--- /dev/null
+#| -*-Scheme-*-
+
+gtk/gtkgrid.h |#
+
+(extern (* GtkWidget) gtk_grid_new)
+
+(extern void gtk_grid_attach
+ (grid (* GtkGrid))
+ (child (* GtkWidget))
+ (left gint)
+ (top gint)
+ (width gint)
+ (height gint))
+
+(extern void gtk_grid_set_row_homogeneous
+ (grid (* GtkGrid))
+ (homogeneous gboolean))
+
+(extern gboolean gtk_grid_get_row_homogeneous
+ (grid (* GtkGrid)))
+
+(extern void gtk_grid_set_row_spacing
+ (grid (* GtkGrid))
+ (spacing guint))
+
+(extern guint gtk_grid_get_row_spacing
+ (grid (* GtkGrid)))
+
+(extern void gtk_grid_set_column_homogeneous
+ (gri (* GtkGrid))
+ (homogeneous gboolean))
+
+(extern gboolean gtk_grid_get_column_homogeneous
+ (grid (* GtkGrid)))
+
+(extern void gtk_grid_set_column_spacing
+ (grid (* GtkGrid))
+ (spacing guint))
+
+(extern guint gtk_grid_get_column_spacing
+ (grid (* GtkGrid)))
\ No newline at end of file
+++ /dev/null
-#| -*-Scheme-*-
-
-gtk-2.0/gtk/gtkhbox.h |#
-
-(extern (* GtkWidget)
- gtk_hbox_new
- (homogeneous gboolean)
- (spacing gint))
\ No newline at end of file
--- /dev/null
+#| -*-Scheme-*-
+
+gtk/gtkorientable.h |#
+
+(extern void gtk_orientable_set_orientation
+ (orientable (* GtkOrientable))
+ (orientation GtkOrientation))
+
+(extern GtkOrientation gtk_orientable_get_orientation
+ (orientable (* GtkOrientable)))
\ No newline at end of file
+++ /dev/null
-#| -*-Scheme-*-
-
-gtk-2.0/gtk/gtkvbox.h |#
-
-(extern (* GtkWidget)
- gtk_vbox_new
- (homogeneous gboolean)
- (spacing gint))
\ No newline at end of file
(width gint)
(height gint))
+(extern void gtk_widget_set_hexpand
+ (widget (* GtkWidget))
+ (expand gboolean))
+
+(extern void gtk_widget_set_vexpand
+ (widget (* GtkWidget))
+ (expand gboolean))
+
(extern gint gtk_widget_get_events
(widget (* GtkWidget)))
(define spin? #t)
(define (make-fix-layout-demo)
- (let* ((window (gtk-window-new 'toplevel))
- (vbox (gtk-vbox-new #f 0))
+ (let* ((window (let ((w (gtk-window-new 'toplevel)))
+ (gtk-window-set-opacity w 0.90)
+ (gtk-window-set-title w "fix-layout-demo")
+ (set-gtk-window-delete-event-callback!
+ w (lambda (w) (%trace ";closed "w"\n") 0))
+ (gtk-container-set-border-width w 5)
+ w))
+ (vgrid (let ((g (gtk-grid-new)))
+ (gtk-orientable-set-orientation g 'vertical)
+ g))
(scroller1 (gtk-scrolled-window-new))
(scroller2 (gtk-scrolled-window-new))
- (layout1 (make-demo-layout 200 200))
- (layout2 (make-demo-layout 200 200))
- (resizer (make-fix-resizer -1 10)))
- (gtk-window-set-opacity window 0.90)
- (gtk-window-set-title window "fix-layout-demo")
- (gtk-window-set-default-size window 200 400)
- (set-gtk-window-delete-event-callback!
- window (lambda (w) (%trace ";closed "w"\n") 0))
- (gtk-container-set-border-width window 10)
+ (layout1 (let ((l (make-demo-layout 200 200)))
+ (gtk-widget-set-hexpand l #t)
+ (gtk-widget-set-vexpand l #t)
+ l))
+ (layout2 (let ((l (make-demo-layout 200 200)))
+ (gtk-widget-set-hexpand l #t)
+ (gtk-widget-set-vexpand l #t)
+ l))
+ (resizer (let ((r (make-fix-resizer 0 10)))
+ (gtk-widget-set-hexpand r #t)
+ r)))
+
(gtk-container-add scroller1 layout1)
- (gtk-box-pack-start vbox scroller1 #t #t 0)
+ (gtk-container-add vgrid scroller1)
(set-fix-resizer-before! resizer scroller1)
(set-fix-resizer-after! resizer scroller2)
- (gtk-box-pack-start vbox resizer #f #f 0)
+ (gtk-container-add vgrid resizer)
(gtk-container-add scroller2 layout2)
- (gtk-box-pack-start vbox scroller2 #t #t 0)
- (gtk-container-add window vbox)
+ (gtk-container-add vgrid scroller2)
+ (gtk-container-add window vgrid)
(gtk-widget-show-all window)
(let ((drawing (make-demo-drawing layout1)))
(define-guarantee fix-widget "a <fix-widget>")
-(define-method initialize-instance ((widget <fix-widget>) width height)
-
- (define-integrable (->requisition-fixnum obj)
- (if (and (fixnum? obj) (fix:> obj -2))
- obj
- (error:wrong-type-argument obj "a positive fixnum, 0 or -1"
- (list initialize-instance <fix-widget>))))
+(define-integrable guarantee-size guarantee-non-negative-fixnum)
+(define-method initialize-instance ((widget <fix-widget>) width height)
(call-next-method widget)
- (%trace "; (initialize-instance <fix-widget>) "widget" "width" "height"\n")
-
- (let ((alien (gobject-alien widget)))
- (let ((w (->requisition-fixnum width))
- (h (->requisition-fixnum height)))
- (set-scm-widget-size-request! widget 0 0 w h)
- ;; Init. size, for a realize signal arriving before an allocation.
- (set-fix-rect-size! (fix-widget-geometry widget) w h))
- (C-call "gtk_widget_set_has_window" alien 1))
+ (%trace "; (initialize-instance <fix-widget>) "widget" "width"x"height"\n")
+ (set-scm-widget-natural-size! widget width height)
+ ;; Init. size, for a realize signal arriving before an allocation.
+ (set-fix-rect-size! (fix-widget-geometry widget) width height)
+ (C-call "gtk_widget_set_has_window" (gobject-alien widget) 1)
(set-gtk-widget-realize-callback! widget fix-widget-realize-callback)
(set-gtk-widget-size-allocate-callback! widget allocate-callback)
(define-method initialize-instance ((widget <fix-layout>) width height)
(call-next-method widget width height)
- (%trace "; (initialize-instance <fix-layout>) "widget" "width" "height"\n")
+ (%trace "; (initialize-instance <fix-layout>) "widget" "width"x"height"\n")
(set-gtk-widget-draw-callback! widget layout-draw-callback)
(set-scm-widget-set-scroll-adjustments-callback! widget adjustments-callback)
(C-call "gtk_widget_set_can_focus" (gobject-alien widget) 1)
;; Tells WIDGET to adjust its scrollable extent. Notifies any
;; scrollbars.
(guarantee-fix-layout widget 'set-fix-layout-scroll-size!)
- (guarantee-non-negative-fixnum width 'set-fix-layout-scroll-size!)
- (guarantee-non-negative-fixnum height 'set-fix-layout-scroll-size!)
+ (guarantee-size width 'set-fix-layout-scroll-size!)
+ (guarantee-size height 'set-fix-layout-scroll-size!)
(let ((extent (fix-layout-scrollable-extent widget)))
(if (not (and (fix:= width (fix-rect-width extent))
(fix:= height (fix-rect-height extent))))
(let ((w (fix:+ (car w.h-before) dx))
(h (fix:+ (cdr w.h-before) dy)))
(%trace "; resizing "before" to "w"x"h"\n")
- (set-scm-widget-size-request! (gtk-bin-child before)
- 0 0 w h))
+ (set-scm-widget-natural-size! (gtk-bin-child before)
+ w h))
(let ((w (fix:- (car w.h-after) dx))
(h (fix:- (cdr w.h-after) dy)))
(%trace "; resizing "after" to "w"x"h"\n")
- (set-scm-widget-size-request! after 0 0 w h))))))
+ (set-scm-widget-natural-size! (gtk-bin-child after)
+ w h))
+ (C-call "gtk_container_resize_children"
+ (gobject-alien
+ (gtk-widget-parent resizer)))))))
(if (fix-resizer-stack-vertical? resizer)
(define (set-fix-drawing-size! drawing width height)
(guarantee-fix-drawing drawing 'set-fix-drawing-size!)
- (guarantee-non-negative-fixnum width 'set-drawing-size!)
- (guarantee-non-negative-fixnum height 'set-drawing-size!)
+ (guarantee-size width 'set-drawing-size!)
+ (guarantee-size height 'set-drawing-size!)
(set-fix-rect-size! (fix-drawing-extent drawing) width height)
(for-each
(lambda (widget) (set-fix-layout-scroll-size! widget width height))
(define (set-rectangle-ink! ink x y width height)
(guarantee-fixnum x 'set-rectangle-ink!)
(guarantee-fixnum y 'set-rectangle-ink!)
- (guarantee-non-negative-fixnum width 'set-rectangle-ink!)
- (guarantee-non-negative-fixnum height 'set-rectangle-ink!)
+ (guarantee-size width 'set-rectangle-ink!)
+ (guarantee-size height 'set-rectangle-ink!)
(without-interrupts
(lambda ()
(let ((rect (rectangle-ink-rect ink)))
(define (set-arc-ink! ink x y width height)
(guarantee-fixnum x 'set-arc-ink!)
(guarantee-fixnum y 'set-arc-ink!)
- (guarantee-non-negative-fixnum width 'set-arc-ink!)
- (guarantee-non-negative-fixnum height 'set-arc-ink!)
+ (guarantee-size width 'set-arc-ink!)
+ (guarantee-size height 'set-arc-ink!)
(without-interrupts
(lambda ()
(let ((rect (arc-ink-rect ink)))
(define (set-box-ink! ink x y width height)
(guarantee-fixnum x 'set-box-ink!)
(guarantee-fixnum y 'set-box-ink!)
- (guarantee-non-negative-fixnum width 'set-box-ink!)
- (guarantee-non-negative-fixnum height 'set-box-ink!)
+ (guarantee-size width 'set-box-ink!)
+ (guarantee-size height 'set-box-ink!)
(set-fix-ink! ink x y width height))
(define (set-box-ink-position! ink x y)
(define (gdk-rectangle #!optional x y width height)
(if (not (default-object? x)) (guarantee-fixnum x 'gdk-rectangle))
(if (not (default-object? y)) (guarantee-fixnum y 'gdk-rectangle))
- (if (not (default-object? width)) (guarantee-non-negative-fixnum width 'gdk-rectangle))
- (if (not (default-object? height)) (guarantee-non-negative-fixnum height 'gdk-rectangle))
+ (if (not (default-object? width)) (guarantee-size width 'gdk-rectangle))
+ (if (not (default-object? height)) (guarantee-size height 'gdk-rectangle))
(let ((alien (malloc (C-sizeof "GdkRectangle") '|GdkRectangle|)))
(if (default-object? x) alien
(begin
(free allocation)
(cons width height))))
+(define (guarantee-size object operator)
+ (if (and (fixnum? object) (fix:> object -2))
+ object
+ (error:wrong-type-argument object "a positive fixnum, 0 or -1" operator)))
+
(define (gtk-widget-set-size-request widget width height)
(guarantee-gtk-widget widget 'gtk-widget-set-size-request)
- (guarantee-non-negative-fixnum width 'gtk-widget-set-size-request)
- (guarantee-non-negative-fixnum height 'gtk-widget-set-size-request)
+ (guarantee-size width 'gtk-widget-set-size-request)
+ (guarantee-size height 'gtk-widget-set-size-request)
(C-call "gtk_widget_set_size_request" (gobject-alien widget) width height))
+(define (gtk-widget-set-hexpand widget expand?)
+ (C-call "gtk_widget_set_hexpand" (gobject-alien widget) (if expand? 1 0)))
+
+(define (gtk-widget-set-vexpand widget expand?)
+ (C-call "gtk_widget_set_vexpand" (gobject-alien widget) (if expand? 1 0)))
+
(define (set-gtk-widget-size-allocate-callback! widget callback)
(guarantee-gtk-widget widget 'set-gtk-widget-size-allocate-callback!)
(guarantee-procedure-of-arity callback 2 'set-gtk-widget-size-allocate-callback!)
(named-lambda (gtk-check-button-toggled-callback button)
(callback button)))
\f
-;;; GtkVBox
+;;; GtkGrids
-(define-class (<gtk-vbox> (constructor () (homogeneous? spacing)))
+(define-class (<gtk-grid> (constructor gtk-grid-new ()))
(<gtk-container>))
-(define-guarantee gtk-vbox "a <gtk-vbox>")
+(define-guarantee gtk-grid "a <gtk-grid>")
-(define-method initialize-instance ((vbox <gtk-vbox>) homogeneous? spacing)
- (call-next-method vbox)
- (let ((alien (gobject-alien vbox)))
- (C-call "gtk_vbox_new" alien (if homogeneous? 1 0) spacing)
- (error-if-null alien "Could not create:" vbox)
+(define-method initialize-instance ((grid <gtk-grid>))
+ (call-next-method grid)
+ (let ((alien (gobject-alien grid)))
+ (C-call "gtk_grid_new" alien)
+ (error-if-null alien "Could not create:" grid)
(C-call "g_object_ref_sink" alien alien))
- (set-gtk-widget-destroy-callback! vbox))
-
-(define (gtk-vbox-new homogeneous? spacing)
- (guarantee-boolean homogeneous? 'gtk-vbox-new)
- (guarantee-non-negative-fixnum spacing 'gtk-vbox-new)
- (make-gtk-vbox homogeneous? spacing))
-
-(define-integrable-operator (guarantee-boolean object operator)
- (if (not (or (eq? object #t) (eq? object #f)))
- (error:wrong-type-argument object "#t or #f" operator)))
-
-(define-class (<gtk-hbox> (constructor () (homogeneous? spacing)))
- (<gtk-container>))
-
-(define-guarantee gtk-hbox "a <gtk-hbox>")
-
-(define-method initialize-instance ((hbox <gtk-hbox>) homogeneous? spacing)
- (call-next-method hbox)
- (let ((alien (gobject-alien hbox)))
- (C-call "gtk_hbox_new" alien (if homogeneous? 1 0) spacing)
- (error-if-null alien "Could not create:" hbox)
- (C-call "g_object_ref_sink" alien alien))
- (set-gtk-widget-destroy-callback! hbox))
-
-(define (gtk-hbox-new homogeneous? spacing)
- (guarantee-boolean homogeneous? 'gtk-hbox-new)
- (guarantee-non-negative-fixnum spacing 'gtk-hbox-new)
- (make-gtk-hbox homogeneous? spacing))
-
-(define (gtk-box-pack-start box child expand? fill? padding)
- (container-add! box child)
- (C-call "gtk_box_pack_start" (gobject-alien box) (gobject-alien child)
- (if expand? 1 0) (if fill? 1 0) padding))
-
-(define (gtk-box-pack-end box child expand? fill? padding)
- (container-add! box child)
- (C-call "gtk_box_pack_end" (gobject-alien box) (gobject-alien child)
- (if expand? 1 0) (if fill? 1 0) padding))
+ (set-gtk-widget-destroy-callback! grid))
+
+(define (gtk-grid-set-row-homogeneous grid homogeneous?)
+ (guarantee-gtk-grid grid 'gtk-grid-set-row-homogeneous)
+ (C-call "gtk_grid_set_row_homogeneous" (gobject-alien grid)
+ (if homogeneous? 1 0)))
+
+(define (gtk-grid-set-column-homogeneous grid homogeneous?)
+ (guarantee-gtk-grid grid 'gtk-grid-set-column-homogeneous)
+ (C-call "gtk_grid_set_column_homogeneous" (gobject-alien grid)
+ (if homogeneous? 1 0)))
+
+(define (gtk-grid-set-row-spacing grid spacing)
+ (guarantee-gtk-grid grid 'gtk-grid-set-row-spacing)
+ (guarantee-non-negative-fixnum spacing 'gtk-grid-set-row-spacing)
+ (C-call "gtk_grid_set_row_spacing" (gobject-alien grid) spacing))
+
+(define (gtk-grid-set-column-spacing grid spacing)
+ (guarantee-gtk-grid grid 'gtk-grid-set-column-spacing)
+ (guarantee-non-negative-fixnum spacing 'gtk-grid-set-column-spacing)
+ (C-call "gtk_grid_set_column_spacing" (gobject-alien grid) spacing))
+
+(define (gtk-grid-attach grid widget left top width height)
+ (guarantee-gtk-grid grid 'gtk-grid-attach)
+ (guarantee-gtk-widget widget 'gtk-grid-attach)
+ (guarantee-fixnum left 'gtk-grid-attach)
+ (guarantee-fixnum top 'gtk-grid-attach)
+ (guarantee-fixnum width 'gtk-grid-attach)
+ (guarantee-fixnum height 'gtk-grid-attach)
+ (container-add! grid widget)
+ (C-call "gtk_grid_attach" (gobject-alien grid) (gobject-alien widget)
+ left top width height))
+
+(define (gtk-orientable-set-orientation orientable orientation)
+ (C-call "gtk_orientable_set_orientation" (gobject-alien orientable)
+ (case orientation
+ ((VERTICAL) (C-enum "GTK_ORIENTATION_VERTICAL"))
+ ((HORIZONTAL) (C-enum "GTK_ORIENTATION_HORIZONTAL"))
+ (else (error:wrong-type-argument
+ orientation
+ "an orientation (vertical or horizontal)"
+ 'gtk-orientable-set-orientation)))))
+\f
+;;; GtkFrames
(define-class (<gtk-frame> (constructor () (label))) (<gtk-container>))
gtk-widget-get-pango-context
gtk-widget-create-pango-layout
gtk-widget-get-size
+ gtk-widget-set-hexpand
+ gtk-widget-set-vexpand
gtk-widget-set-size-request
;;gtk-widget-set-can-focus
set-gtk-widget-size-allocate-callback!
gtk-check-button-new
gtk-check-button-get-active gtk-check-button-set-active
set-gtk-check-button-toggled-callback!
- <gtk-vbox> gtk-vbox? guarantee-gtk-vbox gtk-vbox-new
- <gtk-hbox> gtk-hbox? guarantee-gtk-hbox gtk-hbox-new
- gtk-box-pack-start gtk-box-pack-end
+ <gtk-grid> gtk-grid? guarantee-gtk-grid gtk-grid-new
+ gtk-grid-set-row-spacing
+ gtk-grid-set-column-spacing
+ gtk-grid-set-row-homogeneous
+ gtk-grid-set-column-homogeneous
+ gtk-grid-attach
+ gtk-orientable-set-orientation
<gtk-frame> gtk-frame? guarantee-gtk-frame gtk-frame-new
gtk-frame-set-shadow-type
<gtk-scrolled-window> gtk-scrolled-window?
(export (gtk)
<scm-widget>
set-scm-widget-set-scroll-adjustments-callback!
- set-scm-widget-size-request!))
+ set-scm-widget-minimum-size! set-scm-widget-natural-size!))
(define-package (gtk fix-layout)
(parent (gtk))
open_slice_window (void)
{
slice_window = gtk_window_new (GTK_WINDOW_TOPLEVEL);
- GtkWidget * vbox = gtk_vbox_new (FALSE, 5);
+ GtkWidget * grid = gtk_grid_new ();
status_label = gtk_label_new ("Channels:");
slice_label = gtk_label_new ("Scheme time-slice: 0");
g_signal_connect (slice_window, "delete_event",
G_CALLBACK (slice_window_delete_event), NULL);
- gtk_container_add (GTK_CONTAINER (slice_window), vbox);
- gtk_box_pack_start (GTK_BOX (vbox), status_label, FALSE, FALSE, 2);
- gtk_box_pack_end (GTK_BOX (vbox), slice_label, FALSE, FALSE, 2);
+ gtk_grid_set_row_spacing (GTK_GRID (grid), 5);
+ gtk_orientable_set_orientation (GTK_ORIENTABLE (grid),
+ GTK_ORIENTATION_VERTICAL);
+ gtk_container_add (GTK_CONTAINER (grid), status_label);
+ gtk_container_add (GTK_CONTAINER (grid), slice_label);
+ gtk_container_add (GTK_CONTAINER (slice_window), grid);
+ gtk_container_set_border_width (GTK_CONTAINER (slice_window), 2);
gtk_window_set_title (GTK_WINDOW (slice_window), "Scheme Time-Slice Counter");
gtk_window_set_type_hint (GTK_WINDOW (slice_window),
GDK_WINDOW_TYPE_HINT_UTILITY);
(guarantee-procedure-of-arity callback 3 'set-scm-widget-set-scroll-adjustments-callback!)
(g-signal-connect widget (C-callback "set_scroll_adjustments") callback))
-(define (set-scm-widget-size-request! widget
- minimum-width minimum-height
- natural-width natural-height)
- (guarantee-scm-widget widget 'set-scm-widget-size-request!)
- (guarantee-non-negative-fixnum minimum-width 'set-scm-widget-size-request!)
- (guarantee-non-negative-fixnum minimum-height 'set-scm-widget-size-request!)
- (guarantee-non-negative-fixnum natural-width 'set-scm-widget-size-request!)
- (guarantee-non-negative-fixnum natural-height 'set-scm-widget-size-request!)
+(define (set-scm-widget-minimum-size! widget width height)
+ (guarantee-scm-widget widget 'set-scm-widget-minimum-size!)
+ (guarantee-non-negative-fixnum width 'set-scm-widget-minimum-size!)
+ (guarantee-non-negative-fixnum height 'set-scm-widget-minimum-size!)
(let ((a (gobject-alien widget)))
- (C->= a "ScmWidget minimum_width" minimum-width)
- (C->= a "ScmWidget minimum_height" minimum-height)
- (C->= a "ScmWidget natural_width" natural-width)
- (C->= a "ScmWidget natural_height" natural-height)))
\ No newline at end of file
+ (C->= a "ScmWidget minimum_width" width)
+ (C->= a "ScmWidget minimum_height" height)))
+
+(define (set-scm-widget-natural-size! widget width height)
+ (guarantee-scm-widget widget 'set-scm-widget-natural-size!)
+ (guarantee-non-negative-fixnum width 'set-scm-widget-natural-size!)
+ (guarantee-non-negative-fixnum height 'set-scm-widget-natural-size!)
+ (let ((a (gobject-alien widget)))
+ (C->= a "ScmWidget natural_width" width)
+ (C->= a "ScmWidget natural_height" height)))
\ No newline at end of file
(swat-handlers define standard initial-value '()))
(define-method initialize-instance ((canvas <swat-canvas>) width height)
- (%trace ";(initialize-instance <swat-canvas>) "canvas" "width" "height"\n")
+ (%trace ";(initialize-instance <swat-canvas>) "canvas" "width"x"height"\n")
(call-next-method canvas width height)
(set-fix-layout-drawing! canvas (make-fix-drawing) 0 0))
(define (%open children title)
(let ((window (gtk-window-new 'toplevel))
- (box (gtk-hbox-new #f 5)))
- (for-each (lambda (child) (gtk-container-add box child)) children)
+ (grid (gtk-grid-new)))
+ (gtk-grid-set-row-spacing grid 5)
+ (gtk-grid-set-column-spacing grid 5)
+ (gtk-orientable-set-orientation grid 'horizontal)
+ (for-each (lambda (child) (gtk-container-add grid child)) children)
(gtk-window-set-title window title)
- (gtk-container-add window box)
+ (gtk-container-add window grid)
(gtk-widget-show-all window)
window))
;;; make-hbox, make-array-box.
(define (make-hbox . kids)
- (let ((box (gtk-hbox-new #f 0)))
- (for-each (lambda (kid) (gtk-container-add box kid)) kids)
- box))
+ (let ((grid (gtk-grid-new)))
+ (gtk-orientable-set-orientation grid 'horizontal)
+ (for-each (lambda (kid) (gtk-container-add grid kid)) kids)
+ grid))
(define (make-vbox . kids)
- (let ((box (gtk-vbox-new #f 0)))
- (for-each (lambda (kid) (gtk-container-add box kid)) kids)
- box))
+ (let ((grid (gtk-grid-new)))
+ (gtk-orientable-set-orientation grid 'vertical)
+ (for-each (lambda (kid) (gtk-container-add grid kid)) kids)
+ grid))
(define (box-children box)
(gtk-container-children box))
projects / mit-scheme.git / commitdiff