From 503ccb5f2fc517b92cd06a4c1165d2ab1e0f8fc7 Mon Sep 17 00:00:00 2001 From: Matt Birkholz Date: Mon, 30 Jul 2012 21:25:04 -0700 Subject: [PATCH] gtk: Port to Gtk 3. Many changes: GtkObject is gone, colormaps and allocating colors are obsoleted, GdkColors are now GdkRGBAs, GtkStyle is now GtkStyleContext, expose events are now draw signals... --- doc/gtk/gtk.texinfo | 227 +++-- src/ffi/syntax.scm | 7 +- src/gtk/Includes/cairo.cdecl | 923 +-------------------- src/gtk/Includes/gdk.cdecl | 23 +- src/gtk/Includes/gdkcairo.cdecl | 27 +- src/gtk/Includes/gdkcolor.cdecl | 63 -- src/gtk/Includes/gdkcursor.cdecl | 15 +- src/gtk/Includes/gdkevents.cdecl | 106 +-- src/gtk/Includes/gdkkeys.cdecl | 55 +- src/gtk/Includes/gdkkeysyms.cdecl | 591 ++++++++++++- src/gtk/Includes/gdkrgb.cdecl | 13 - src/gtk/Includes/gdkrgba.cdecl | 14 + src/gtk/Includes/gdktypes.cdecl | 19 +- src/gtk/Includes/gdkwindow.cdecl | 36 +- src/gtk/Includes/gtk.cdecl | 150 +--- src/gtk/Includes/gtkadjustment.cdecl | 63 +- src/gtk/Includes/gtkenums.cdecl | 67 +- src/gtk/Includes/gtkobject.cdecl | 40 - src/gtk/Includes/gtkrc.cdecl | 30 - src/gtk/Includes/gtkstyle.cdecl | 137 --- src/gtk/Includes/gtkstylecontext.cdecl | 51 ++ src/gtk/Includes/gtktypeutils.cdecl | 18 +- src/gtk/Includes/gtkwidget.cdecl | 341 +------- src/gtk/Makefile-fragment | 16 +- src/gtk/cairo.scm | 6 +- src/gtk/compile.scm | 2 +- src/gtk/ed-ffi.scm | 2 +- src/gtk/fix-demo.scm | 15 +- src/gtk/fix-layout.scm | 514 +++++------- src/gtk/gtk-ev.scm | 222 +++-- src/gtk/gtk-shim.h | 32 +- src/gtk/{gtk-object.scm => gtk-widget.scm} | 466 +++++------ src/gtk/gtk.cdecl | 17 +- src/gtk/gtk.pkg | 54 +- src/gtk/gtk.scm | 26 +- src/gtk/make.scm | 2 +- src/gtk/pango.scm | 17 +- src/gtk/scm-widget.scm | 6 +- src/gtk/scmwidget.c.stay | 165 +++- src/gtk/scmwidget.h | 47 ++ src/gtk/swat.scm | 20 +- tests/gtk/gtk-tests.scm | 9 +- 42 files changed, 1701 insertions(+), 2953 deletions(-) delete mode 100644 src/gtk/Includes/gdkcolor.cdecl delete mode 100644 src/gtk/Includes/gdkrgb.cdecl create mode 100644 src/gtk/Includes/gdkrgba.cdecl delete mode 100644 src/gtk/Includes/gtkobject.cdecl delete mode 100644 src/gtk/Includes/gtkrc.cdecl delete mode 100644 src/gtk/Includes/gtkstyle.cdecl create mode 100644 src/gtk/Includes/gtkstylecontext.cdecl rename src/gtk/{gtk-object.scm => gtk-widget.scm} (70%) create mode 100644 src/gtk/scmwidget.h diff --git a/doc/gtk/gtk.texinfo b/doc/gtk/gtk.texinfo index eff5f9805..e9c74d052 100644 --- a/doc/gtk/gtk.texinfo +++ b/doc/gtk/gtk.texinfo @@ -37,7 +37,7 @@ Software Foundation raise funds for GNU development.'' @titlepage @title The Gtk Reference Manual @subtitle Schemely access (@value{VERSION}) to the GNOME toolkits -@subtitle for MIT/GNU Scheme version 9.0.1+ +@subtitle for MIT/GNU Scheme version 9.1 @author by Matt Birkholz (@email{birkholz@@alum.mit.edu}) @page @vskip 0pt plus 1filll @@ -202,7 +202,7 @@ the Gtk interface. * GIO:: * Pixbuf Loader:: * Pango Layout:: -* Gtk Object:: +* Cairo Context:: * Gtk Adjustment:: * Gtk Widget:: * Gtk Container:: @@ -402,7 +402,7 @@ Normally information about the target of a symlink is returned, rather than information about the symlink itself. However if @var{follow-symlinks?} is @code{#f}, information about the symlink itself will be returned. If the target does not exist, -information about the symlink itself will be returned. (Huh???) +information about the symlink itself will be returned. @end deffn There are many gfile attributes. Most have boolean or integer values. @@ -725,7 +725,7 @@ immediately. #f or a string describing any error encountered during the loading. @end deffn -@node Pango Layout, Gtk Object, Pixbuf Loader, API Reference +@node Pango Layout, Cairo Context, Pixbuf Loader, API Reference @section Pango Layout A simple wrapper for PangoLayout objects that ensures the toolkit @@ -781,6 +781,10 @@ toolkit object will be freed with @bref{pango-font-description-free}. A string that would parse as @var{font}, a PangoFontDescription alien. @end deffn +@deffn Procedure pango-font-description-copy font +A copy of @var{font}, a new PangoFontDescription alien. +@end deffn + @anchor{pango-font-description-free} @deffn Procedure pango-font-description-free font Frees @var{font}, an alien PangoFontDescription. @@ -832,43 +836,28 @@ Releases Scheme's reference to @var{metrics} with thereafter signal an error. @end deffn -@node Gtk Object, Gtk Adjustment, Pango Layout, API Reference -@section Gtk Object - -A gtk-object is a gobject that can be "destroyed". Each instance is -connected to the "destroy" signal of its GtkObject. The callback -@bref{gobject-unref!}'s the instance, allowing the toolkit to finalize -and dispose of the GtkObject. - -If a Gtk object is "dropped", never destroyed, eventually GCed, the -usual gobject cleanup will effect a @bref{gobject-unref!} and -(potentially) release the toolkit resources. - -@deffn Class -An abstract, direct subclass of gobject. -@end deffn - -@deffn Procedure gtk-object? object -Type predicate. -@end deffn +@node Cairo Context, Gtk Adjustment, Pango Layout, API Reference +@section Cairo Context -@deffn Procedure guarantee-gtk-object object operator -Type guarantor. -@end deffn +This simple wrapper for @code{cairo_t} objects ensures that the +toolkit object is de-referenced when the Scheme object is garbage +collected. The Scheme object is an alien of type @code{cairo_t} and +is used directly in calls to the library's C functions. -@deffn Procedure gtk-object-destroyed? object -#f if @var{object} has not been destroyed. +@deffn Procedure gdk-cairo-create window +Creates a cairo context targeting @var{window}. @end deffn -@deffn Procedure gtk-object-destroy object -Destroys @var{object}. +@deffn Procedure cairo-destroy cairo +De-references a @var{cairo} context object. Further operations on +@var{cairo} will produce an error. @end deffn -@node Gtk Adjustment, Gtk Widget, Gtk Object, API Reference +@node Gtk Adjustment, Gtk Widget, Cairo Context, API Reference @section Gtk Adjustment @deffn Class -A direct subclass of gtk-object representing a reference to a GtkAdjustment. +A direct subclass of gobject representing a reference to a GtkAdjustment. @end deffn @deffn Procedure gtk-adjustment? object @@ -910,10 +899,20 @@ is currently visible. @node Gtk Widget, Gtk Container, Gtk Adjustment, API Reference @section Gtk Widget -A Gtk object with a ``parent'' slot. +A gtk-widget is a gobject that can be "destroyed". Each instance is +connected to the "destroy" signal of its GtkWidget. The callback +@bref{gobject-unref!}'s the instance, allowing the toolkit to finalize +and dispose of the widget. + +If a Gtk Widget is "dropped", never destroyed, eventually GCed, the +usual gobject cleanup will effect a @bref{gobject-unref!} and +(potentially) release the toolkit resources. + +A Gtk Widget also has a ``parent'' slot --- a @bref{gtk-container} or +@code{#f}. @deffn Class -An abstract, direct subclass of gtk-object. +An abstract, direct subclass of gobject. @end deffn @deffn Procedure gtk-widget? object @@ -924,6 +923,14 @@ Type predicate. Type guarantor. @end deffn +@deffn Procedure gtk-widget-destroyed? widget +#f if @var{widget} has not been destroyed. +@end deffn + +@deffn Procedure gtk-widget-destroy widget +Destroys @var{widget}. +@end deffn + @deffn {Generic Procedure} gtk-widget-parent widget The parent gtk-container, or #f. @end deffn @@ -949,6 +956,11 @@ unrealized. Do @emph{not} capture @var{widget} in @var{callback}'s closure, else it cannot be GCed. @end deffn +@deffn Procedure set-gtk-widget-draw-callback! widget callback +Arranges for @var{callback} to be applied to @var{widget} and a cairo +context clipped to the area to be re-drawn. +@end deffn + @deffn Procedure set-gtk-widget-event-callback! widget callback Arrange for @var{callback} to be applied to @var{widget} and an alien GdkEvent whenever the widget receives an event. Do @emph{not} capture @@ -1009,10 +1021,6 @@ Schedules a complete re-draw of @var{widget}. (An expose event will be delivered when the toolkit is idle.) @end deffn -@deffn Procedure gtk-widget-get-colormap widget -An alien GdkColormap owned by the toolkit. It should not be freed. -@end deffn - @deffn Procedure gtk-widget-get-pango-context widget A PangoContext with the appropriate font map, font description, and base direction for @var{widget}. This context is owned by @@ -1047,24 +1055,38 @@ Gets @var{widget}'s size allocation, a pair of integers: @subsection Gtk Widget Colors & Fonts +Colors are floating-vectors containing four flonums between 0. and +1. inclusive: the red, green, blue and alpha components. For example +@code{#[floating-vector 42 0. 1. 0. 1.]} represents completely opaque +green. + +Colors can also be specified with a string: +@itemize +@item A standard color name (listed in the X11 rgb.txt file). +@item A hex value: 'RGB', 'RRGGBB', 'RRRGGGBBB', or 'RRRRGGGGBBBB'. +@item An RGB color: 'rgb(R,G,B)' where R, G and B are decimal +numbers between 0 and 255 inclusive or percentages. +@item An RGBA color: 'rgba(R,G,B,A)' where R, G and B are numbers or +percentages as above, and A is a floating point number between 0. and +1. inclusive. +@end itemize + @anchor{gtk-widget-parse-color} @deffn Procedure gtk-widget-parse-color widget spec -The color named by @var{spec} --- a (new!) vector: @code{"#(red green -blue)"}. The elements will be reals and can vary from 0.0 to 1.0 -(inclusive). @var{Spec} should be a string: a standard color name -(e.g. @code{"magenta"}), a hex format number (e.g. @code{"#F0F"}, -@code{"#FF00FF"}, @code{"#FFF000FFF"}, and @code{"#FFFF0000FFFF"}), or -one of @var{widget}'s symbolic color names. A ``standard'' color name -is found in the venerable X11 @file{rgb.txt} file. +Resolves @var{spec} into a color. A symbolic color name is resolved +according to @var{widget}'s style. @end deffn +Some colors depend on the state of a particular widget. The arguments +to the @code{gtk-widget-fg-color} procedure include a widget and an +optional ``state'', one of these symbols: @code{normal}, +@code{active}, @code{prelight}, @code{selected}, @code{insensitive}, +@code{inconsistent}, @code{focused} and @code{backdrop}. + @anchor{gtk-widget-fg-color} @deffn Procedure gtk-widget-fg-color widget #!optional state -The color used to draw @var{widget} when it is in @var{state} --- a -(new!) vector: #(red green blue). The color components are reals and -can vary from 0.0 to 1.0 inclusive. @var{State} may be one of the -symbols @code{normal}, @code{active}, @code{prelight}, @code{selected} -or @code{insensitive}, and defaults to @code{normal}. +The color used to draw @var{widget} when it is in @var{state}. +@var{State} defaults to @code{normal}. @end deffn @deffn Procedure gtk-widget-bg-color widget #!optional state @@ -1072,25 +1094,13 @@ or @code{insensitive}, and defaults to @code{normal}. @bref{gtk-widget-fg-color}. @end deffn -@deffn Procedure gtk-widget-text-color widget #!optional state -@var{Widget}'s text color --- the foreground color for drawing text. -Similar to @bref{gtk-widget-fg-color}. -@end deffn - -@deffn Procedure gtk-widget-base-color #!optional state -@var{Widget}'s base color --- the background color for drawing text. -Similar to @bref{gtk-widget-fg-color}. -@end deffn - @anchor{set-gtk-widget-fg-color!} @deffn Procedure set-gtk-widget-fg-color! widget color #!optional state Sets the foreground color used to draw @var{widget} when it is in -@var{state}. @var{State} may be one of the symbols @code{normal}, -@code{active}, @code{prelight}, @code{selected} or @code{insensitive}. -It defaults to @code{normal}. @var{Color} should be a string -acceptable to @bref{gtk-widget-parse-color}. @emph{Note} that the -effect of this procedure on widgets that have @emph{not} been realized -is undefined at best. +@var{state}. @var{State} defaults to @code{normal}. @var{Color} +should be a value acceptable to @bref{gtk-widget-parse-color}. +@emph{Note} that the effect of this procedure on widgets that have +@emph{not} been realized is undefined at best. @end deffn @deffn Procedure set-gtk-widget-bg-color! widget color #!optional state @@ -1098,24 +1108,13 @@ Sets the background color of @var{widget}. See @bref{set-gtk-widget-fg-color!}. @end deffn -@deffn Procedure set-gtk-widget-text-color! widget color #!optional state -Sets the foreground color used when drawing text in @var{widget}. See -@bref{set-gtk-widget-fg-color!}. -@end deffn - -@deffn Procedure set-gtk-widget-base-color! widget color #!optional state -Sets the background color used when drawing text in @var{widget}. See -@bref{set-gtk-widget-fg-color!}. -@end deffn - @deffn Procedure gtk-widget-font widget -A PangoFontDescription alien --- a toolkit object owned by -@var{widget}'s style. +A PangoFontDescription alien --- a toolkit object owned by @var{widget}. @end deffn @deffn Procedure set-gtk-widget-font! widget font -Set @var{widget}'s style to use @var{font}, a PangoFontDescription. -@var{Widget} will ref @var{font}. +Set @var{widget} to use @var{font}, a PangoFontDescription. +@var{Widget} will ref @var{font}; Scheme can free it. @end deffn @node Gtk Container, Gtk Window, Gtk Widget, API Reference @@ -1127,6 +1126,7 @@ toolkit code may add, remove or re-order children and this list will not be updated. This should probably be fixed with @code{add} and @code{remove} signal callbacks. +@anchor{gtk-container} @deffn Class An abstract, direct subclass of gtk-widget. @end deffn @@ -1642,11 +1642,6 @@ This procedure is called when @var{widget} is resized. This procedure is called when @var{widget} is being realized. @end deffn -@deffn Procedure set-fix-widget-expose-handler! widget handler -Arranges to apply @var{handler} to @var{widget} and four fixnums: the -x and y coordinates, and width and height of the exposed area. -@end deffn - @deffn Procedure set-fix-widget-map-handler! widget handler Arranges to apply @var{handler} to @var{widget} when it is mapped. @end deffn @@ -1959,11 +1954,24 @@ provided to @bref{set-line-ink-color!}. @anchor{set-line-ink-color!} @deffn Procedure set-line-ink-color! line color -Sets @var{line}'s foreground color. @var{Color} should be a string -acceptable to @bref{gtk-widget-parse-color} for every widget in which -@var{line} might appear. +Sets @var{line}'s foreground color. +@end deffn + +@deffn Procedure line-ink-dashes line +@code{()} if @var{line}'s dash pattern is not set, else the pattern last +provided to @bref{set-line-ink-dashes!}. @end deffn +@anchor{set-line-ink-dashes!} +@deffn Procedure set-line-ink-dashes! line dashes +@var{Dashes} must be a list of flonums specifying the lengths for +dashes and spaces. One flonum is the same as two of the same. An +empty list makes the line solid. Note that the +@bref{line-ink-dash-color} (if any) is painted along the line between +the dashes. +@end deffn + +@anchor{line-ink-dash-color} @deffn Procedure line-ink-dash-color line @code{()} if @var{line}'s dash color is not set, else the color last provided to @bref{set-line-ink-dash-color!}. @@ -1971,12 +1979,9 @@ provided to @bref{set-line-ink-dash-color!}. @anchor{set-line-ink-dash-color!} @deffn Procedure set-line-ink-dash-color! line color -Sets @var{line}'s dash color. @var{Color} can be any string -acceptable to @bref{gtk-widget-parse-color} for every widget in which -@var{line} might appear. This color will appear between the -foreground colored dashes along the line. @var{Color} may also be #t -if the space between dashes should not be drawn, or #f if @var{line} -should be solid. +Sets @var{line}'s dash color. This color will appear between the +foreground colored dashes along the line. Note that a dash pattern +must also be set using @bref{set-line-ink-dashes!}. @end deffn @subsection Rectangle Ink @@ -2007,9 +2012,7 @@ last provided to @bref{set-rectangle-ink-color!}. @anchor{set-rectangle-ink-color!} @deffn Procedure set-rectangle-ink-color! rectangle color -Sets @var{rectangle}'s line color. @var{Color} should be a string -acceptable to @bref{gtk-widget-parse-color} for every widget in which -@var{rectangle} might appear. This is not the fill color. +Sets @var{rectangle}'s line color (not the fill color). @end deffn @deffn Procedure rectangle-ink-width rectangle @@ -2029,10 +2032,8 @@ color last provided to @bref{set-rectangle-ink-fill-color!}. @anchor{set-rectangle-ink-fill-color!} @deffn Procedure set-rectangle-ink-fill-color! rectangle color -Sets @var{rectangle}'s fill color. @var{Color} should be a string -acceptable to @bref{gtk-widget-parse-color} for every widget in which -@var{rectangle} might appear. If @var{color} is #f, @var{rectangle} -is outlined, not filled. +Sets @var{rectangle}'s fill color. If @var{color} is #f, +@var{rectangle} is outlined, not filled. @end deffn @subsection Arc Ink @@ -2083,9 +2084,7 @@ provided to @bref{set-arc-ink-color!}. @anchor{set-arc-ink-color!} @deffn Procedure set-arc-ink-color! arc color -Sets @var{arc}'s line color. @var{Color} should be a string -acceptable to @bref{gtk-widget-parse-color} for every widget in which -@var{rectangle} might appear. This is not the fill color. +Sets @var{arc}'s line color (not the fill color). @end deffn @deffn Procedure arc-ink-width arc @@ -2105,9 +2104,7 @@ provided to @bref{set-arc-ink-fill-color!}. @anchor{set-arc-ink-fill-color!} @deffn Procedure set-arc-ink-fill-color! arc color -Sets @var{arc}'s fill color. @var{Color} should be a string -acceptable to @bref{gtk-widget-parse-color} for every widget in which -@var{arc} might appear. If @var{color} is #f, @var{arc} is not +Sets @var{arc}'s fill color. If @var{color} is #f, @var{arc} is not filled. @end deffn @@ -2149,9 +2146,7 @@ provided to @bref{set-text-ink-color!}. @anchor{set-text-ink-color!} @deffn Procedure set-text-ink-color! text color -Sets @var{text}'s default color. @var{Color} should be a string -acceptable to @bref{gtk-widget-parse-color} for every widget in which -@var{text} might appear. +Sets @var{text}'s default color. @end deffn @subsection Simple Text Ink @@ -2237,18 +2232,6 @@ Moves @var{box} to place its upper-left corner at point (@var{x}, procedure does nothing. @end deffn -@deffn Procedure box-ink-shadow box -The type of shadow with which @var{box} will be drawn --- one of the -symbols @code{none}, @code{in}, @code{out}, @code{etched-in}, or -@code{etched-out}. -@end deffn - -@deffn Procedure set-box-ink-shadow! box type -Sets @var{box}'s shadow to @var{type}, which should be one of the -symbols @code{none}, @code{in}, @code{out}, @code{etched-in}, or -@code{etched-out}. -@end deffn - @node Gdk Functions, Debugging Facilities, Fix Layout, API Reference @section Gdk Functions diff --git a/src/ffi/syntax.scm b/src/ffi/syntax.scm index f9a9895ed..aa977f669 100644 --- a/src/ffi/syntax.scm +++ b/src/ffi/syntax.scm @@ -173,7 +173,7 @@ USA. (define (expand-peek ctype alien-form offset value-form whole-form) (cond ((ctype/basic? ctype) - (if value-form (serror whole-form "ignoring extra (3rd) arg")) + (if value-form (swarn whole-form "ignoring extra (3rd) arg")) (let ((prim (or (ctype/primitive-accessor ctype) (serror whole-form "cannot peek basic type " ctype)))) `(,prim ,alien-form ,offset))) @@ -511,4 +511,7 @@ USA. (apply string-append (map (lambda (obj) (if (string? obj) obj (write-to-string obj))) - (cons message args))))))) \ No newline at end of file + (cons message args))))))) + +(define (swarn form message . args) + (warn (string-append messsage " in:") form)) \ No newline at end of file diff --git a/src/gtk/Includes/cairo.cdecl b/src/gtk/Includes/cairo.cdecl index 77ea7d2b4..1d6f774ab 100644 --- a/src/gtk/Includes/cairo.cdecl +++ b/src/gtk/Includes/cairo.cdecl @@ -1,29 +1,6 @@ #| -*-Scheme-*- -cairo/cairo.h (v1.4) |# - -;(include "cairo-features") -;(include "cairo-deprecated") - -;(extern int cairo_version) -;(extern (* (const char)) cairo_version_string) -;(typedef cairo_bool_t int) -;(typedef cairo_t (struct _cairo)) -;(typedef cairo_surface_t (struct _cairo_surface)) - -;(typedef cairo_matrix_t -; (struct _cairo_matrix -; (xx double) -; (yx double) -; (xy double) -; (yy double) -; (x0 double) -; (y0 double))) - -;(typedef cairo_pattern_t (struct _cairo_pattern)) - -;(typedef cairo_destroy_func_t (* (function void (data (* void))))) -;(typedef cairo_user_data_key_t (struct _cairo_user_data_key (unused int))) +cairo/cairo.h |# (typedef cairo_status_t (enum _cairo_status @@ -51,217 +28,48 @@ cairo/cairo.h (v1.4) |# (CAIRO_STATUS_INVALID_INDEX) (CAIRO_STATUS_CLIP_NOT_REPRESENTABLE))) -;(typedef cairo_content_t -; (enum _cairo_content -; (CAIRO_CONTENT_COLOR) -; (CAIRO_CONTENT_ALPHA) -; (CAIRO_CONTENT_COLOR_ALPHA))) - -;typedef cairo_status_t (*cairo_write_func_t) -; (void *closure, const unsigned char *data, unsigned int length); - -;typedef cairo_status_t (*cairo_read_func_t) -; (void *closure, unsigned char *data, unsigned int length); - - -;;; Functions for manipulating state objects - (extern (* cairo_t) cairo_create (target (* cairo_surface_t))) -;(extern (* cairo_t) cairo_reference (cr (* cairo_t))) - (extern void cairo_destroy (cr (* cairo_t))) -;(extern (unsigned int) cairo_get_reference_count (cr (* cairo_t))) - -;(extern (* void) cairo_get_user_data -; (cr (* cairo_t)) -; (key (* (const cairo_user_data_key_t)))) - -;(extern cairo_status_t cairo_set_user_data -; (cr (* cairo_t)) -; (key (* (const cairo_user_data_key_t))) -; (user_date (* void)) -; (destroy cairo_destroy_func_t)) - (extern void cairo_save (cr (* cairo_t))) (extern void cairo_restore (cr (* cairo_t))) -;(extern void cairo_push_group (cr (* cairo_t))) - -;(extern void cairo_push_group_with_content -; (cr (* cairo_t)) -; (content cairo_content_t)) - -;(extern (* cairo_pattern_t) cairo_pop_group (cr (* cairo_t))) - -;(extern void cairo_pop_group_to_source (cr (* cairo_t))) - - -;;; Modify state - -;(typedef cairo_operator_t -; (enum _cairo_operator -; (CAIRO_OPERATOR_CLEAR) -; -; (CAIRO_OPERATOR_SOURCE) -; (CAIRO_OPERATOR_OVER) -; (CAIRO_OPERATOR_IN) -; (CAIRO_OPERATOR_OUT) -; (CAIRO_OPERATOR_ATOP) -; -; (CAIRO_OPERATOR_DEST) -; (CAIRO_OPERATOR_DEST_OVER) -; (CAIRO_OPERATOR_DEST_IN) -; (CAIRO_OPERATOR_DEST_OUT) -; (CAIRO_OPERATOR_DEST_ATOP) -; -; (CAIRO_OPERATOR_XOR) -; (CAIRO_OPERATOR_ADD) -; (CAIRO_OPERATOR_SATURATE))) - -;(extern void cairo_set_operator (cr (* cairo_t)) (op cairo_operator_t)) - -;(extern void cairo_set_source (cr (* cairo_t)) (source (* cairo_pattern_t))) - -(extern void cairo_set_source_rgb - (cr (* cairo_t)) (red double)(green double)(blue double)) - -;(extern void cairo_set_source_rgba -; (cr (* cairo_t)) (red double)(green double)(blue double)(alpha double)) - -;(extern void cairo_set_source_surface -; (cr (* cairo_t)) (surface (* cairo_surface_t)) (x double) (y double)) - -;(extern void cairo_set_tolerance (cr (* cairo_t)) (tolerance double)) - -;(typedef cairo_antialias_t -; (enum _cairo_antialias -; (CAIRO_ANTIALIAS_DEFAULT) -; (CAIRO_ANTIALIAS_NONE) -; (CAIRO_ANTIALIAS_GRAY) -; (CAIRO_ANTIALIAS_SUBPIXEL))) - -;(extern void cairo_set_antialias -; (cr (* cairo_t)) (antialias cairo_antialias_t)) - -;(typedef cairo_fill_rule_t -; (enum _cairo_fill_rule -; (CAIRO_FILL_RULE_WINDING) -; (CAIRO_FILL_RULE_EVEN_ODD))) - -;(extern void cairo_set_fill_rule (cr (* cairo_t)) (fill_rule cairo_fill_rule_t)) +(extern void cairo_set_source_rgba + (cr (* cairo_t)) (red double)(green double)(blue double)(alpha double)) (extern void cairo_set_line_width (cr (* cairo_t)) (width double)) -;(typedef cairo_line_cap_t -; (enum _cairo_line_cap -; (CAIRO_LINE_CAP_BUTT) -; (CAIRO_LINE_CAP_ROUND) -; (CAIRO_LINE_CAP_SQUARE))) - -;(extern void cairo_set_line_cap (cr (* cairo_t)) (line_cap cairo_line_cap_t)) - -;(typedef cairo_line_join_t -; (enum _cairo_line_join -; (CAIRO_LINE_JOIN_MITER) -; (CAIRO_LINE_JOIN_ROUND) -; (CAIRO_LINE_JOIN_BEVEL))) - -;(extern void cairo_set_line_join (cr (* cairo_t)) (line_join cairo_line_join_t)) - (extern void cairo_set_dash (cr (* cairo_t)) (dashes (* (const double))) (num_dashes int) (offset double)) -;(extern void cairo_set_miter_limit (cr (* cairo_t)) (limit double)) - (extern void cairo_translate (cr (* cairo_t)) (tx double) (ty double)) (extern void cairo_scale (cr (* cairo_t)) (sx double) (sy double)) (extern void cairo_rotate (cr (* cairo_t)) (angle double)) -;(extern void cairo_transform -; (cr (* cairo_t)) (matrix (* (const cairo_matrix_t)))) - -;(extern void cairo_set_matrix -; (cr (* cairo_t)) (matrix (* (const cairo_matrix_t)))) - -;(extern void cairo_identity_matrix (cr (* cairo_t))) - -;(extern void cairo_user_to_device -; (cr (* cairo_t)) (x (* double)) (y (* double))) - -;(extern void cairo_user_to_device_distance -; (cr (* cairo_t)) (dx (* double)) (dy (* double))) - -;(extern void cairo_device_to_user -; (cr (* cairo_t)) (x (* double)) (x (* double))) - -;(extern void cairo_device_to_user_distance -; (cr (* cairo_t)) (dx (* double)) (dy (* double))) - - -;;; Path creation functions - -;(extern void cairo_new_path (cairo_t *cr); - (extern void cairo_move_to (cr (* cairo_t)) (x double) (y double)) -;(extern void cairo_new_sub_path (cairo_t *cr); - (extern void cairo_line_to (cr (* cairo_t)) (x double) (y double)) -;(extern void cairo_curve_to (cr (* cairo_t)) -; double x1, double y1, -; double x2, double y2, -; double x3, double y3); - (extern void cairo_arc (cr (* cairo_t)) (xc double) (yc double) (radius double) (angle1 double) (angle2 double)) -;(extern void cairo_arc_negative (cr (* cairo_t)) -; double xc, double yc, -; double radius, -; double angle1, double angle2); - (extern void cairo_rel_move_to (cr (* cairo_t)) (dx double) (dy double)) (extern void cairo_rel_line_to (cr (* cairo_t)) (dx double) (dy double)) -;(extern void cairo_rel_curve_to (cr (* cairo_t)) -; double dx1, double dy1, -; double dx2, double dy2, -; double dx3, double dy3); - (extern void cairo_rectangle (cr (* cairo_t)) (x double) (y double) (width double) (height double)) -;(extern void cairo_close_path (cairo_t *cr); - - -;;; Painting functions - (extern void cairo_paint (cr (* cairo_t))) -#| - - (extern void cairo_paint_with_alpha (cr (* cairo_t)) - double alpha); - - (extern void cairo_mask (cairo_t *cr, - cairo_pattern_t *pattern); - - (extern void cairo_mask_surface (cairo_t *cr, - cairo_surface_t *surface, - double surface_x, - double surface_y); -|# (extern void cairo_stroke (cr (* cairo_t))) (extern void cairo_stroke_preserve (cr (* cairo_t))) @@ -269,740 +77,39 @@ cairo/cairo.h (v1.4) |# (extern void cairo_fill (cr (* cairo_t))) (extern void cairo_fill_preserve (cr (* cairo_t))) -#| - - (extern void cairo_copy_page (cairo_t *cr); - - (extern void cairo_show_page (cairo_t *cr); - -;; Insideness testing - - (extern cairo_bool_t cairo_in_stroke (cr (* cairo_t)) double x, double y); - - (extern cairo_bool_t cairo_in_fill (cr (* cairo_t)) double x, double y); - -;; Rectangular extents - (extern void cairo_stroke_extents (cr (* cairo_t)) - double *x1, double *y1, - double *x2, double *y2); - - (extern void cairo_fill_extents (cr (* cairo_t)) - double *x1, double *y1, - double *x2, double *y2); - -;; Clipping - - (extern void cairo_reset_clip (cairo_t *cr); -|# (extern void cairo_clip (cr (* cairo_t))) -#| - (extern void cairo_clip_preserve (cairo_t *cr); - - (extern void cairo_clip_extents (cr (* cairo_t)) - double *x1, double *y1, - double *x2, double *y2); - - (typedef struct _cairo_rectangle { - double x, y, width, height; -} cairo_rectangle_t; - -typedef struct _cairo_rectangle_list { - cairo_status_t status; - cairo_rectangle_t *rectangles; - int num_rectangles; -} cairo_rectangle_list_t; - - (extern cairo_rectangle_list_t * cairo_copy_clip_rectangle_list (cairo_t *cr); - - (extern void cairo_rectangle_list_destroy (cairo_rectangle_list_t *rectangle_list); - - -;;; Font/Text functions - -typedef struct _cairo_scaled_font cairo_scaled_font_t; - -typedef struct _cairo_font_face cairo_font_face_t; - -typedef struct { - unsigned long index; - double x; - double y; -} cairo_glyph_t; - -typedef struct { - double x_bearing; - double y_bearing; - double width; - double height; - double x_advance; - double y_advance; -} cairo_text_extents_t; - -typedef struct { - double ascent; - double descent; - double height; - double max_x_advance; - double max_y_advance; -} cairo_font_extents_t; - -typedef enum _cairo_font_slant { - CAIRO_FONT_SLANT_NORMAL, - CAIRO_FONT_SLANT_ITALIC, - CAIRO_FONT_SLANT_OBLIQUE -} cairo_font_slant_t; - -typedef enum _cairo_font_weight { - CAIRO_FONT_WEIGHT_NORMAL, - CAIRO_FONT_WEIGHT_BOLD -} cairo_font_weight_t; - -typedef enum _cairo_subpixel_order { - CAIRO_SUBPIXEL_ORDER_DEFAULT, - CAIRO_SUBPIXEL_ORDER_RGB, - CAIRO_SUBPIXEL_ORDER_BGR, - CAIRO_SUBPIXEL_ORDER_VRGB, - CAIRO_SUBPIXEL_ORDER_VBGR -} cairo_subpixel_order_t; - -typedef enum _cairo_hint_style { - CAIRO_HINT_STYLE_DEFAULT, - CAIRO_HINT_STYLE_NONE, - CAIRO_HINT_STYLE_SLIGHT, - CAIRO_HINT_STYLE_MEDIUM, - CAIRO_HINT_STYLE_FULL -} cairo_hint_style_t; - -typedef enum _cairo_hint_metrics { - CAIRO_HINT_METRICS_DEFAULT, - CAIRO_HINT_METRICS_OFF, - CAIRO_HINT_METRICS_ON -} cairo_hint_metrics_t; - -typedef struct _cairo_font_options cairo_font_options_t; - - (extern cairo_font_options_t * cairo_font_options_create (void); - - (extern cairo_font_options_t * cairo_font_options_copy (const cairo_font_options_t *original); - - (extern void cairo_font_options_destroy (cairo_font_options_t *options); - - (extern cairo_status_t cairo_font_options_status (cairo_font_options_t *options); - - (extern void cairo_font_options_merge (cairo_font_options_t *options, - const cairo_font_options_t *other); - (extern cairo_bool_t cairo_font_options_equal (const cairo_font_options_t *options, - const cairo_font_options_t *other); - - (extern unsigned long -cairo_font_options_hash (const cairo_font_options_t *options); - - (extern void -cairo_font_options_set_antialias (cairo_font_options_t *options, - cairo_antialias_t antialias); - (extern cairo_antialias_t -cairo_font_options_get_antialias (const cairo_font_options_t *options); - - (extern void -cairo_font_options_set_subpixel_order (cairo_font_options_t *options, - cairo_subpixel_order_t subpixel_order); - (extern cairo_subpixel_order_t -cairo_font_options_get_subpixel_order (const cairo_font_options_t *options); - - (extern void -cairo_font_options_set_hint_style (cairo_font_options_t *options, - cairo_hint_style_t hint_style); - (extern cairo_hint_style_t -cairo_font_options_get_hint_style (const cairo_font_options_t *options); - - (extern void -cairo_font_options_set_hint_metrics (cairo_font_options_t *options, - cairo_hint_metrics_t hint_metrics); - (extern cairo_hint_metrics_t -cairo_font_options_get_hint_metrics (const cairo_font_options_t *options); - -/* This interface is for dealing with text as text, not caring about the - font object inside the the cairo_t. */ - - (extern void -cairo_select_font_face (cairo_t *cr, - const char *family, - cairo_font_slant_t slant, - cairo_font_weight_t weight); - - (extern void -cairo_set_font_size (cr (* cairo_t)) double size); - - (extern void -cairo_set_font_matrix (cairo_t *cr, - const cairo_matrix_t *matrix); - - (extern void -cairo_get_font_matrix (cr (* cairo_t)) - cairo_matrix_t *matrix); - - (extern void -cairo_set_font_options (cairo_t *cr, - const cairo_font_options_t *options); - - (extern void -cairo_get_font_options (cairo_t *cr, - cairo_font_options_t *options); - - (extern void -cairo_set_font_face (cr (* cairo_t)) cairo_font_face_t *font_face); - - (extern cairo_font_face_t * -cairo_get_font_face (cairo_t *cr); - - (extern void -cairo_set_scaled_font (cairo_t *cr, - const cairo_scaled_font_t *scaled_font); - - (extern cairo_scaled_font_t * -cairo_get_scaled_font (cairo_t *cr); - - (extern void -cairo_show_text (cr (* cairo_t)) const char *utf8); - - (extern void -cairo_show_glyphs (cr (* cairo_t)) const cairo_glyph_t *glyphs, int num_glyphs); - - (extern void -cairo_text_path (cr (* cairo_t)) const char *utf8); - - (extern void -cairo_glyph_path (cr (* cairo_t)) const cairo_glyph_t *glyphs, int num_glyphs); - - (extern void -cairo_text_extents (cairo_t *cr, - const char *utf8, - cairo_text_extents_t *extents); - - (extern void -cairo_glyph_extents (cairo_t *cr, - const cairo_glyph_t *glyphs, - int num_glyphs, - cairo_text_extents_t *extents); - - (extern void -cairo_font_extents (cairo_t *cr, - cairo_font_extents_t *extents); - -/* Generic identifier for a font style */ - - (extern cairo_font_face_t * -cairo_font_face_reference (cairo_font_face_t *font_face); - - (extern void -cairo_font_face_destroy (cairo_font_face_t *font_face); - (extern unsigned int -cairo_font_face_get_reference_count (cairo_font_face_t *font_face); - - (extern cairo_status_t -cairo_font_face_status (cairo_font_face_t *font_face); - -typedef enum _cairo_font_type { - CAIRO_FONT_TYPE_TOY, - CAIRO_FONT_TYPE_FT, - CAIRO_FONT_TYPE_WIN32, - CAIRO_FONT_TYPE_ATSUI -} cairo_font_type_t; - - (extern cairo_font_type_t -cairo_font_face_get_type (cairo_font_face_t *font_face); - - (extern void * -cairo_font_face_get_user_data (cairo_font_face_t *font_face, - const cairo_user_data_key_t *key); - - (extern cairo_status_t -cairo_font_face_set_user_data (cairo_font_face_t *font_face, - const cairo_user_data_key_t *key, - void *user_data, - cairo_destroy_func_t destroy); - -/* Portable interface to general font features. */ - - (extern cairo_scaled_font_t * -cairo_scaled_font_create (cairo_font_face_t *font_face, - const cairo_matrix_t *font_matrix, - const cairo_matrix_t *ctm, - const cairo_font_options_t *options); - - (extern cairo_scaled_font_t * -cairo_scaled_font_reference (cairo_scaled_font_t *scaled_font); - - (extern void -cairo_scaled_font_destroy (cairo_scaled_font_t *scaled_font); - - (extern unsigned int -cairo_scaled_font_get_reference_count (cairo_scaled_font_t *scaled_font); - - (extern cairo_status_t -cairo_scaled_font_status (cairo_scaled_font_t *scaled_font); - - (extern cairo_font_type_t -cairo_scaled_font_get_type (cairo_scaled_font_t *scaled_font); - - (extern void * -cairo_scaled_font_get_user_data (cairo_scaled_font_t *scaled_font, - const cairo_user_data_key_t *key); - - (extern cairo_status_t -cairo_scaled_font_set_user_data (cairo_scaled_font_t *scaled_font, - const cairo_user_data_key_t *key, - void *user_data, - cairo_destroy_func_t destroy); - - (extern void -cairo_scaled_font_extents (cairo_scaled_font_t *scaled_font, - cairo_font_extents_t *extents); - - (extern void -cairo_scaled_font_text_extents (cairo_scaled_font_t *scaled_font, - const char *utf8, - cairo_text_extents_t *extents); - - (extern void -cairo_scaled_font_glyph_extents (cairo_scaled_font_t *scaled_font, - const cairo_glyph_t *glyphs, - int num_glyphs, - cairo_text_extents_t *extents); - - (extern cairo_font_face_t * -cairo_scaled_font_get_font_face (cairo_scaled_font_t *scaled_font); - - (extern void -cairo_scaled_font_get_font_matrix (cairo_scaled_font_t *scaled_font, - cairo_matrix_t *font_matrix); - - (extern void -cairo_scaled_font_get_ctm (cairo_scaled_font_t *scaled_font, - cairo_matrix_t *ctm); - - (extern void -cairo_scaled_font_get_font_options (cairo_scaled_font_t *scaled_font, - cairo_font_options_t *options); - - -;;; Query functions - - (extern cairo_operator_t -cairo_get_operator (cairo_t *cr); - - (extern cairo_pattern_t * -cairo_get_source (cairo_t *cr); - - (extern double -cairo_get_tolerance (cairo_t *cr); - - (extern cairo_antialias_t -cairo_get_antialias (cairo_t *cr); - - (extern void -cairo_get_current_point (cr (* cairo_t)) double *x, double *y); - - (extern cairo_fill_rule_t -cairo_get_fill_rule (cairo_t *cr); - - (extern double -cairo_get_line_width (cairo_t *cr); - - (extern cairo_line_cap_t -cairo_get_line_cap (cairo_t *cr); - - (extern cairo_line_join_t -cairo_get_line_join (cairo_t *cr); - - (extern double -cairo_get_miter_limit (cairo_t *cr); - - (extern int -cairo_get_dash_count (cairo_t *cr); - - (extern void -cairo_get_dash (cr (* cairo_t)) double *dashes, double *offset); - - (extern void -cairo_get_matrix (cr (* cairo_t)) cairo_matrix_t *matrix); - - (extern cairo_surface_t * -cairo_get_target (cairo_t *cr); - - (extern cairo_surface_t * -cairo_get_group_target (cairo_t *cr); - -typedef enum _cairo_path_data_type { - CAIRO_PATH_MOVE_TO, - CAIRO_PATH_LINE_TO, - CAIRO_PATH_CURVE_TO, - CAIRO_PATH_CLOSE_PATH -} cairo_path_data_type_t; - -typedef union _cairo_path_data_t cairo_path_data_t; -union _cairo_path_data_t { - struct { - cairo_path_data_type_t type; - int length; - } header; - struct { - double x, y; - } point; -}; - -typedef struct cairo_path { - cairo_status_t status; - cairo_path_data_t *data; - int num_data; -} cairo_path_t; - - (extern cairo_path_t * -cairo_copy_path (cairo_t *cr); - - (extern cairo_path_t * -cairo_copy_path_flat (cairo_t *cr); - - (extern void -cairo_append_path (cairo_t *cr, - const cairo_path_t *path); - - (extern void -cairo_path_destroy (cairo_path_t *path); -|# - - -;;; Error status queries +(extern void cairo_clip_extents (cr (* cairo_t)) + (x1 (* double)) (y1 (* double)) + (x2 (* double)) (y2 (* double))) (extern cairo_status_t cairo_status (cr (* cairo_t))) - -(extern (* (const char)) cairo_status_to_string (status cairo_status_t)) -#| -;;; Surface manipulation - - (extern cairo_surface_t * -cairo_surface_create_similar (cairo_surface_t *other, - cairo_content_t content, - int width, - int height); - (extern cairo_surface_t * -cairo_surface_reference (cairo_surface_t *surface); +(extern (* (const char)) cairo_status_to_string (status cairo_status_t)) - (extern void -cairo_surface_finish (cairo_surface_t *surface); -|# (extern void cairo_surface_destroy (surface (* cairo_surface_t))) -#| - (extern unsigned int -cairo_surface_get_reference_count (cairo_surface_t *surface); - - (extern cairo_status_t -cairo_surface_status (cairo_surface_t *surface); - -typedef enum _cairo_surface_type { - CAIRO_SURFACE_TYPE_IMAGE, - CAIRO_SURFACE_TYPE_PDF, - CAIRO_SURFACE_TYPE_PS, - CAIRO_SURFACE_TYPE_XLIB, - CAIRO_SURFACE_TYPE_XCB, - CAIRO_SURFACE_TYPE_GLITZ, - CAIRO_SURFACE_TYPE_QUARTZ, - CAIRO_SURFACE_TYPE_WIN32, - CAIRO_SURFACE_TYPE_BEOS, - CAIRO_SURFACE_TYPE_DIRECTFB, - CAIRO_SURFACE_TYPE_SVG, - CAIRO_SURFACE_TYPE_OS2 -} cairo_surface_type_t; - - (extern cairo_surface_type_t -cairo_surface_get_type (cairo_surface_t *surface); - - (extern cairo_content_t -cairo_surface_get_content (cairo_surface_t *surface); - -#if CAIRO_HAS_PNG_FUNCTIONS -|# + (extern cairo_status_t cairo_surface_write_to_png (surface (* cairo_surface_t)) (filename (* (const char)))) -#| - (extern cairo_status_t -cairo_surface_write_to_png_stream (cairo_surface_t *surface, - cairo_write_func_t write_func, - void *closure); - -#endif - - (extern void * -cairo_surface_get_user_data (cairo_surface_t *surface, - const cairo_user_data_key_t *key); - - (extern cairo_status_t -cairo_surface_set_user_data (cairo_surface_t *surface, - const cairo_user_data_key_t *key, - void *user_data, - cairo_destroy_func_t destroy); - - (extern void -cairo_surface_get_font_options (cairo_surface_t *surface, - cairo_font_options_t *options); - - (extern void -cairo_surface_flush (cairo_surface_t *surface); - - (extern void -cairo_surface_mark_dirty (cairo_surface_t *surface); - - (extern void -cairo_surface_mark_dirty_rectangle (cairo_surface_t *surface, - int x, - int y, - int width, - int height); - - (extern void -cairo_surface_set_device_offset (cairo_surface_t *surface, - double x_offset, - double y_offset); - - (extern void -cairo_surface_get_device_offset (cairo_surface_t *surface, - double *x_offset, - double *y_offset); - - (extern void -cairo_surface_set_fallback_resolution (cairo_surface_t *surface, - double x_pixels_per_inch, - double y_pixels_per_inch); -|# (typedef cairo_format_t (enum _cairo_format (CAIRO_FORMAT_ARGB32) (CAIRO_FORMAT_RGB24) (CAIRO_FORMAT_A8) - (CAIRO_FORMAT_A1) - ;; Obsolete: CAIRO_FORMAT_RGB16_565 = 4 - )) + (CAIRO_FORMAT_A1))) (extern (* cairo_surface_t) cairo_image_surface_create (format cairo_format_t) (width int)(height int)) -#| - (extern cairo_surface_t * -cairo_image_surface_create_for_data (unsigned char *data, - cairo_format_t format, - int width, - int height, - int stride); - - (extern unsigned char * -cairo_image_surface_get_data (cairo_surface_t *surface); - - (extern cairo_format_t -cairo_image_surface_get_format (cairo_surface_t *surface); - - (extern int -cairo_image_surface_get_width (cairo_surface_t *surface); - - (extern int -cairo_image_surface_get_height (cairo_surface_t *surface); - - (extern int -cairo_image_surface_get_stride (cairo_surface_t *surface); - -#if CAIRO_HAS_PNG_FUNCTIONS - - (extern cairo_surface_t * -cairo_image_surface_create_from_png (const char *filename); - - (extern cairo_surface_t * -cairo_image_surface_create_from_png_stream (cairo_read_func_t read_func, - void *closure); - -#endif - - -;;; Pattern creation functions - - (extern cairo_pattern_t * -cairo_pattern_create_rgb (double red, double green, double blue); - - (extern cairo_pattern_t * -cairo_pattern_create_rgba (double red, double green, double blue, - double alpha); - - (extern cairo_pattern_t * -cairo_pattern_create_for_surface (cairo_surface_t *surface); - - (extern cairo_pattern_t * -cairo_pattern_create_linear (double x0, double y0, - double x1, double y1); - - (extern cairo_pattern_t * -cairo_pattern_create_radial (double cx0, double cy0, double radius0, - double cx1, double cy1, double radius1); - - (extern cairo_pattern_t * -cairo_pattern_reference (cairo_pattern_t *pattern); - - (extern void -cairo_pattern_destroy (cairo_pattern_t *pattern); - - (extern unsigned int -cairo_pattern_get_reference_count (cairo_pattern_t *pattern); - - (extern cairo_status_t -cairo_pattern_status (cairo_pattern_t *pattern); - - (extern void * -cairo_pattern_get_user_data (cairo_pattern_t *pattern, - const cairo_user_data_key_t *key); - - (extern cairo_status_t -cairo_pattern_set_user_data (cairo_pattern_t *pattern, - const cairo_user_data_key_t *key, - void *user_data, - cairo_destroy_func_t destroy); - -typedef enum _cairo_pattern_type { - CAIRO_PATTERN_TYPE_SOLID, - CAIRO_PATTERN_TYPE_SURFACE, - CAIRO_PATTERN_TYPE_LINEAR, - CAIRO_PATTERN_TYPE_RADIAL -} cairo_pattern_type_t; - - (extern cairo_pattern_type_t -cairo_pattern_get_type (cairo_pattern_t *pattern); - - (extern void -cairo_pattern_add_color_stop_rgb (cairo_pattern_t *pattern, - double offset, - double red, double green, double blue); - - (extern void -cairo_pattern_add_color_stop_rgba (cairo_pattern_t *pattern, - double offset, - double red, double green, double blue, - double alpha); - - (extern void -cairo_pattern_set_matrix (cairo_pattern_t *pattern, - const cairo_matrix_t *matrix); - - (extern void -cairo_pattern_get_matrix (cairo_pattern_t *pattern, - cairo_matrix_t *matrix); - -typedef enum _cairo_extend { - CAIRO_EXTEND_NONE, - CAIRO_EXTEND_REPEAT, - CAIRO_EXTEND_REFLECT, - CAIRO_EXTEND_PAD -} cairo_extend_t; - - (extern void -cairo_pattern_set_extend (cairo_pattern_t *pattern, cairo_extend_t extend); - - (extern cairo_extend_t -cairo_pattern_get_extend (cairo_pattern_t *pattern); - -typedef enum _cairo_filter { - CAIRO_FILTER_FAST, - CAIRO_FILTER_GOOD, - CAIRO_FILTER_BEST, - CAIRO_FILTER_NEAREST, - CAIRO_FILTER_BILINEAR, - CAIRO_FILTER_GAUSSIAN -} cairo_filter_t; - (extern void -cairo_pattern_set_filter (cairo_pattern_t *pattern, cairo_filter_t filter); - - (extern cairo_filter_t -cairo_pattern_get_filter (cairo_pattern_t *pattern); - - (extern cairo_status_t -cairo_pattern_get_rgba (cairo_pattern_t *pattern, - double *red, double *green, - double *blue, double *alpha); - - (extern cairo_status_t -cairo_pattern_get_surface (cairo_pattern_t *pattern, - cairo_surface_t **surface); - - (extern cairo_status_t -cairo_pattern_get_color_stop_rgba (cairo_pattern_t *pattern, - int index, double *offset, - double *red, double *green, - double *blue, double *alpha); - - (extern cairo_status_t -cairo_pattern_get_color_stop_count (cairo_pattern_t *pattern, - int *count); - - (extern cairo_status_t -cairo_pattern_get_linear_points (cairo_pattern_t *pattern, - double *x0, double *y0, - double *x1, double *y1); - - (extern cairo_status_t -cairo_pattern_get_radial_circles (cairo_pattern_t *pattern, - double *x0, double *y0, double *r0, - double *x1, double *y1, double *r1); - - -;;; Matrix functions - - (extern void -cairo_matrix_init (cairo_matrix_t *matrix, - double xx, double yx, - double xy, double yy, - double x0, double y0); - - (extern void -cairo_matrix_init_identity (cairo_matrix_t *matrix); - - (extern void -cairo_matrix_init_translate (cairo_matrix_t *matrix, - double tx, double ty); - - (extern void -cairo_matrix_init_scale (cairo_matrix_t *matrix, - double sx, double sy); - - (extern void -cairo_matrix_init_rotate (cairo_matrix_t *matrix, - double radians); - - (extern void -cairo_matrix_translate (cairo_matrix_t *matrix, double tx, double ty); - - (extern void -cairo_matrix_scale (cairo_matrix_t *matrix, double sx, double sy); - - (extern void -cairo_matrix_rotate (cairo_matrix_t *matrix, double radians); - - (extern cairo_status_t -cairo_matrix_invert (cairo_matrix_t *matrix); - - (extern void -cairo_matrix_multiply (cairo_matrix_t *result, - const cairo_matrix_t *a, - const cairo_matrix_t *b); - - (extern void -cairo_matrix_transform_distance (const cairo_matrix_t *matrix, - double *dx, double *dy); -|# - -;(extern void cairo_matrix_transform_point -; (matrix (* (const cairo_matrix_t))) -; (x (* double)) (y (* double))) +(typedef cairo_rectangle_int_t (struct _cairo_rectangle_int)) -;(extern void cairo_debug_reset_static_data) +(struct _cairo_rectangle_int + (x int) + (y int) + (width int) + (height int)) \ No newline at end of file diff --git a/src/gtk/Includes/gdk.cdecl b/src/gtk/Includes/gdk.cdecl index f41998277..eacd37a0f 100644 --- a/src/gtk/Includes/gdk.cdecl +++ b/src/gtk/Includes/gdk.cdecl @@ -1,32 +1,13 @@ #| -*-Scheme-*- -gtk-2.0/gdk/gdk.h |# +gdk/gdk.h |# (include "gdkcairo") -(include "gdkcolor") (include "gdkcursor") -;(include "gdkdisplay") -;(include "gdkdnd") -;(include "gdkdrawable") -;(include "gdkenumtypes") (include "gdkevents") -;(include "gdkfont") -;(include "gdkgc") -;(include "gdkimage") -;(include "gdkinput") (include "gdkkeys") -;(include "gdkdisplaymanager") -;(include "gdkpango") -;(include "gdkpixbuf") -;(include "gdkpixmap") -;(include "gdkproperty") -;(include "gdkregion") -(include "gdkrgb") -;(include "gdkscreen") -;(include "gdkselection") -;(include "gdkspawn") +(include "gdkrgba") (include "gdktypes") -;(include "gdkvisual") (include "gdkwindow") (extern gboolean gdk_rectangle_intersect diff --git a/src/gtk/Includes/gdkcairo.cdecl b/src/gtk/Includes/gdkcairo.cdecl index 43c98977d..97af7df27 100644 --- a/src/gtk/Includes/gdkcairo.cdecl +++ b/src/gtk/Includes/gdkcairo.cdecl @@ -1,34 +1,13 @@ #| -*-Scheme-*- -gtk-2.0/gdk/gdkcairo.h |# +gdk/gdkcairo.h |# -(include "gdkcolor") -;(include "gdkpixbuf") (include "pangocairo") (extern (* cairo_t) gdk_cairo_create - (drawable (* GdkDrawable))) -#;(extern void gdk_cairo_reset_clip - (cr (* cairo_t)) - (drawable (* GdkDrawable))) + (window (* GdkWindow))) -#;(extern void gdk_cairo_set_source_color - (cr (* cairo_t)) - (color (* (const GdkColor)))) (extern void gdk_cairo_set_source_pixbuf (cr (* cairo_t)) (pixbuf (* (const GdkPixbuf))) - (pixbuf_x double) - (pixbuf_y double)) -#;(extern void gdk_cairo_set_source_pixmap - (cr (* cairo_t)) - (pixmap (* GdkPixmap)) - (pixmap_x double) - (pixmap_y double)) - -#;(extern void gdk_cairo_rectangle - (cr (* cairo_t)) - (rectangle (* (const GdkRectangle)))) -#;(extern void gdk_cairo_region - (cr (* cairo_t)) - (region (* (const GdkRegion)))) \ No newline at end of file + (pixbuf_x double) (pixbuf_y double)) \ No newline at end of file diff --git a/src/gtk/Includes/gdkcolor.cdecl b/src/gtk/Includes/gdkcolor.cdecl deleted file mode 100644 index 7dadf5b4d..000000000 --- a/src/gtk/Includes/gdkcolor.cdecl +++ /dev/null @@ -1,63 +0,0 @@ -#| -*-Scheme-*- - -gtk-2.0/gdk/gdkcolor.h |# - -;(include "cairo") -;(include "gdktypes") - -(struct _GdkColor - (pixel guint32) - (red guint16) - (green guint16) - (blue guint16)) - -;(typedef GdkColormapClass (struct _GdkColormapClass)) - -(struct _GdkColormap - (parent_instance GObject) - (size gint) - (colors (* GdkColor)) - (visual (* GdkVisual)) - (windowing_data gpointer)) - -;(struct _GdkColormapClass -; (parent_class GObjectClass)) -; -;(extern GType gdk_colormap_get_type) -; -;(extern (* GdkColormap) gdk_colormap_new -; (visual (* GdkVisual)) (allocate gboolean)) -;(extern (* GdkScreen) gdk_colormap_get_screen -; (cmap (* GdkColormap))) -;(extern gint gdk_colormap_alloc_colors -; (colormap (* GdkColormap)) -; (colors (* GdkColor)) (ncolors gint) -; (writeable gboolean) (best_match gboolean) (success (* gboolean))) -;(extern gboolean gdk_colormap_alloc_color -; (colormap (* GdkColormap)) -; (color (* GdkColor)) -; (writeable gboolean) -; (best_match gboolean)) -;(extern void gdk_colormap_free_colors -; (colormap (* GdkColormap)) -; (colors (* GdkColor)) -; (ncolors gint)) -;(extern void gdk_colormap_query_color -; (colormap (* GdkColormap)) -; (pixel gulong) -; (result (* GdkColor))) -; -;(extern (* GdkVisual) gdk_colormap_get_visual -; (colormap (* GdkColormap))) -;(extern (* GdkColor) gdk_color_copy -; (color (* (const GdkColor)))) -;(extern void gdk_color_free -; (color (* GdkColor))) -(extern gint gdk_color_parse - (spec (* (const gchar))) - (color (* GdkColor))) -;(extern guint gdk_color_hash -; (colora (* (const GdkColor)))) -;(extern gboolean gdk_color_equal -; (colora (* (const GdkColor))) -; (colorb (* (const GdkColor)))) \ No newline at end of file diff --git a/src/gtk/Includes/gdkcursor.cdecl b/src/gtk/Includes/gdkcursor.cdecl index ba6f7fe45..b17bf152a 100644 --- a/src/gtk/Includes/gdkcursor.cdecl +++ b/src/gtk/Includes/gdkcursor.cdecl @@ -1,9 +1,6 @@ #| -*-Scheme-*- -gtk-2.0/gdk/gdkcursor.h |# - -;(include "gdktypes") -;(include "gdk-pixbuf") +gdk/gdkcursor.h |# (typedef GdkCursorType (enum @@ -87,13 +84,5 @@ gtk-2.0/gdk/gdkcursor.h |# (GDK_LAST_CURSOR) (GDK_CURSOR_IS_PIXMAP))) -(struct _GdkCursor - (type GdkCursorType) - ;; < private > - (ref_count guint)) - (extern (* GdkCursor) gdk_cursor_new - (cursor_type GdkCursorType)) - -(extern void gdk_cursor_unref - (cursor (* GdkCursor))) \ No newline at end of file + (cursor_type GdkCursorType)) \ No newline at end of file diff --git a/src/gtk/Includes/gdkevents.cdecl b/src/gtk/Includes/gdkevents.cdecl index db532eb60..0ff7d9816 100644 --- a/src/gtk/Includes/gdkevents.cdecl +++ b/src/gtk/Includes/gdkevents.cdecl @@ -1,22 +1,14 @@ #| -*-Scheme-*- -gtk-2.0/gdk/gdkevents.h |# - -;(include "gdkcolor") -;(include "gdktypes") -;(include "gdkdnd") -;(include "gdkinput") - -;(enum (GDK_PRIORITY_EVENTS) -; (GDK_PRIORITY_REDRAW)) +gdk/gdkevents.h |# (typedef GdkEventAny (struct _GdkEventAny)) (typedef GdkEventExpose (struct _GdkEventExpose)) -(typedef GdkEventNoExpose (struct _GdkEventNoExpose)) (typedef GdkEventVisibility (struct _GdkEventVisibility)) (typedef GdkEventMotion (struct _GdkEventMotion)) (typedef GdkEventButton (struct _GdkEventButton)) (typedef GdkEventScroll (struct _GdkEventScroll)) +(typedef GdkEventTouch (struct _GdkEventTouch)) (typedef GdkEventKey (struct _GdkEventKey)) (typedef GdkEventFocus (struct _GdkEventFocus)) (typedef GdkEventCrossing (struct _GdkEventCrossing)) @@ -25,7 +17,6 @@ gtk-2.0/gdk/gdkevents.h |# (typedef GdkEventSelection (struct _GdkEventSelection)) (typedef GdkEventOwnerChange (struct _GdkEventOwnerChange)) (typedef GdkEventProximity (struct _GdkEventProximity)) -(typedef GdkEventClient (struct _GdkEventClient)) (typedef GdkEventDND (struct _GdkEventDND)) (typedef GdkEventWindowState (struct _GdkEventWindowState)) (typedef GdkEventSetting (struct _GdkEventSetting)) @@ -37,8 +28,6 @@ gtk-2.0/gdk/gdkevents.h |# (event (* GdkEvent)) (data gpointer)))) -;(typedef GdkXEvent void) - (typedef GdkFilterReturn (enum (GDK_FILTER_CONTINUE) @@ -84,13 +73,17 @@ gtk-2.0/gdk/gdkevents.h |# (GDK_DROP_FINISHED) (GDK_CLIENT_EVENT) (GDK_VISIBILITY_NOTIFY) - (GDK_NO_EXPOSE) (GDK_SCROLL) (GDK_WINDOW_STATE) (GDK_SETTING) (GDK_OWNER_CHANGE) (GDK_GRAB_BROKEN) - (GDK_DAMAGE))) + (GDK_DAMAGE) + (GDK_TOUCH_BEGIN) + (GDK_TOUCH_UPDATE) + (GDK_TOUCH_END) + (GDK_TOUCH_CANCEL) + (GDK_EVENT_LAST))) (typedef GdkEventMask (enum @@ -185,11 +178,6 @@ gtk-2.0/gdk/gdkevents.h |# (region (* GdkRegion)) (count gint)) -(struct _GdkEventNoExpose - (type GdkEventType) - (window (* GdkWindow)) - (send_event gint8)) - (struct _GdkEventVisibility (type GdkEventType) (window (* GdkWindow)) @@ -224,6 +212,21 @@ gtk-2.0/gdk/gdkevents.h |# (x_root gdouble) (y_root gdouble)) +(struct _GdkEventTouch + (type GdkEventType) + (window (* GdkWindow)) + (send_event gint8) + (time guint32) + (x gdouble) + (y gdouble) + (axes (* gdouble)) + (state guint) + (sequence (* GdkEventSequence)) + (emulating_pointer gboolean) + (device (* GdkDevice)) + (x_root gdouble) + (y_root gdouble)) + (struct _GdkEventScroll (type GdkEventType) (window (* GdkWindow)) @@ -314,17 +317,6 @@ gtk-2.0/gdk/gdkevents.h |# (time guint32) (device (* GdkDevice))) -(struct _GdkEventClient - (type GdkEventType) - (window (* GdkWindow)) - (send_event gint8) - (message_type GdkAtom) - (data_format gushort) - (data (union - (b (array char 20)) - (s (array short 10)) - (l (array long 5))))) - (struct _GdkEventSetting (type GdkEventType) (window (* GdkWindow)) @@ -360,10 +352,10 @@ gtk-2.0/gdk/gdkevents.h |# (type GdkEventType) (any GdkEventAny) (expose GdkEventExpose) - (no_expose GdkEventNoExpose) (visibility GdkEventVisibility) (motion GdkEventMotion) (button GdkEventButton) + (touch GdkEventTouch) (scroll GdkEventScroll) (key GdkEventKey) (crossing GdkEventCrossing) @@ -373,58 +365,14 @@ gtk-2.0/gdk/gdkevents.h |# (selection GdkEventSelection) (owner_change GdkEventOwnerChange) (proximity GdkEventProximity) - (client GdkEventClient) (dnd GdkEventDND) (window_state GdkEventWindowState) (setting GdkEventSetting) - (grab_broken GdkEventGrabBroken)) - -;Most of these externs are commented out just to avoid inflating -;gtk.so with a lot of useless or redundant trampolines. -; -;(extern GType gdk_event_get_type) -;(extern gboolean gdk_events_pending) -;(extern (* GdkEvent) gdk_event_get) -;(extern (* GdkEvent) gdk_event_peek) -;(extern (* GdkEvent) gdk_event_get_graphics_expose -; (window (* GdkWindow))) -;(extern void gdk_event_put -; (event (* GdkEvent))) -; -;(extern (* GdkEvent) gdk_event_new -; (type GdkEventType)) + (grab_broken GdkEventGrabBroken)) + (extern (* GdkEvent) gdk_event_copy (event (* GdkEvent))) (extern void gdk_event_free (event (* GdkEvent))) (extern guint32 gdk_event_get_time - (event (* GdkEvent))) -;(extern gboolean gdk_event_get_state -; (event (* GdkEvent)) -; (state (* GdkModifierType))) -;(extern gboolean gdk_event_get_coords -; (event (* GdkEvent)) -; (x_win (* gdouble)) -; (y_win (* gdouble))) -;(extern gboolean gdk_event_get_root_coords -; (event (* GdkEvent)) -; (x_root (* gdouble)) -; (y_root (* gdouble))) -;(extern gboolean gdk_event_get_axis -; (event (* GdkEvent)) -; (axis_use GdkAxisUse) -; (value (* gdouble))) -;(extern void gdk_event_handler_set -; (func GdkEventFunc) -; (data gpointer) -; (notify GDestroyNotify)) -; -;(extern void gdk_event_set_screen -; (event (* GdkEvent)) (screen (* GdkScreen))) -; -;(extern (* GdkScreen) gdk_event_get_screen -; (event (* GdkEvent))) -; -;(extern void gdk_set_show_events -; (show_events gboolean)) -;(extern gboolean gdk_get_show_events) \ No newline at end of file + (event (* GdkEvent))) \ No newline at end of file diff --git a/src/gtk/Includes/gdkkeys.cdecl b/src/gtk/Includes/gdkkeys.cdecl index 5a212f49a..78cca06c8 100644 --- a/src/gtk/Includes/gdkkeys.cdecl +++ b/src/gtk/Includes/gdkkeys.cdecl @@ -1,8 +1,6 @@ #| -*-Scheme-*- -gtk-2.0/gdk/gdkkeys.h |# - -;(include "gdktypes") +gdk/gdkkeys.h |# (typedef GdkKeymapKey (struct _GdkKeymapKey)) @@ -11,53 +9,4 @@ gtk-2.0/gdk/gdkkeys.h |# (group gint) (level gint)) -(typedef GdkKeymap (struct _GdkKeymap)) -(typedef GdkKeymapClass (struct _GdkKeymapClass)) -(struct _GdkKeymap - (parent_instance GObject) - (display (* GdkDisplay))) - -(struct _GdkKeymapClass - (parent_class GObjectClass) - (direction_changed (* (function void (keymap (* GdkKeymap))))) - (keys_changed (* (function void (keymap (* GdkKeymap)))))) - -;(extern (* GdkKeymap) gdk_keymap_get_for_display -; (display (* GdkDisplay))) -; -;(extern guint gdk_keymap_lookup_key -; (keymap (* GdkKeymap)) -; (key (* (const GdkKeymapKey)))) -;(extern gboolean gdk_keymap_translate_keyboard_state -; (keymap (* GdkKeymap)) -; (hardware_keycode guint) -; (state GdkModifierType) -; (group gint) -; (keyval (* guint)) -; (effective_group (* gint)) -; (level (* gint)) -; (consumed_modifiers (* GdkModifierType))) -;(extern gboolean gdk_keymap_get_entries_for_keyval -; ((* GdkKeymap) keymap) -; (keyval guint) -; (keys (* (* GdkKeymapKey))) -; (n_keys (* gint))) -;(extern gboolean gdk_keymap_get_entries_for_keycode -; (keymap (* GdkKeymap)) -; (hardware_keycode guint) -; (keys (* (* GdkKeymapKey))) -; (keyvals (* (* guint))) -; (n_entries (* gint))) -;(extern PangoDirection gdk_keymap_get_direction (keymap (* GdkKeymap))) - -(extern (* gchar) gdk_keyval_name (keyval guint)) -;(extern guint gdk_keyval_from_name (keyval_name (* (const gchar)))) -;(extern void gdk_keyval_convert_case -; (symbol guint) (lower (* guint)) (upper (* guint))) -;(extern guint gdk_keyval_to_upper (keyval guint)) -;(extern guint gdk_keyval_to_lower (keyval guint)) -;(extern gboolean gdk_keyval_is_upper (keyval guint)) -;(extern gboolean gdk_keyval_is_lower (keyval guint)) -; -;(extern guint32 gdk_keyval_to_unicode (keyval guint)) -;(extern guint gdk_unicode_to_keyval (wc guint32)) \ No newline at end of file +(extern (* gchar) gdk_keyval_name (keyval guint)) \ No newline at end of file diff --git a/src/gtk/Includes/gdkkeysyms.cdecl b/src/gtk/Includes/gdkkeysyms.cdecl index 7c1ec2843..cac129e1d 100644 --- a/src/gtk/Includes/gdkkeysyms.cdecl +++ b/src/gtk/Includes/gdkkeysyms.cdecl @@ -1,6 +1,6 @@ #| -*-Scheme-*- -gtk-2.0/gdk/gdkkeysyms.h |# +gdk/gdkkeysyms.h |# (enum GdkKeysyms (GDK_KEY_VoidSymbol) @@ -180,6 +180,9 @@ gtk-2.0/gdk/gdkkeysyms.h |# (GDK_KEY_ISO_Level3_Shift) (GDK_KEY_ISO_Level3_Latch) (GDK_KEY_ISO_Level3_Lock) + (GDK_KEY_ISO_Level5_Shift) + (GDK_KEY_ISO_Level5_Latch) + (GDK_KEY_ISO_Level5_Lock) (GDK_KEY_ISO_Group_Shift) (GDK_KEY_ISO_Group_Latch) (GDK_KEY_ISO_Group_Lock) @@ -216,6 +219,7 @@ gtk-2.0/gdk/gdkkeysyms.h |# (GDK_KEY_dead_acute) (GDK_KEY_dead_circumflex) (GDK_KEY_dead_tilde) + (GDK_KEY_dead_perispomeni) (GDK_KEY_dead_macron) (GDK_KEY_dead_breve) (GDK_KEY_dead_abovedot) @@ -231,6 +235,34 @@ gtk-2.0/gdk/gdkkeysyms.h |# (GDK_KEY_dead_belowdot) (GDK_KEY_dead_hook) (GDK_KEY_dead_horn) + (GDK_KEY_dead_stroke) + (GDK_KEY_dead_abovecomma) + (GDK_KEY_dead_psili) + (GDK_KEY_dead_abovereversedcomma) + (GDK_KEY_dead_dasia) + (GDK_KEY_dead_doublegrave) + (GDK_KEY_dead_belowring) + (GDK_KEY_dead_belowmacron) + (GDK_KEY_dead_belowcircumflex) + (GDK_KEY_dead_belowtilde) + (GDK_KEY_dead_belowbreve) + (GDK_KEY_dead_belowdiaeresis) + (GDK_KEY_dead_invertedbreve) + (GDK_KEY_dead_belowcomma) + (GDK_KEY_dead_currency) + (GDK_KEY_dead_a) + (GDK_KEY_dead_A) + (GDK_KEY_dead_e) + (GDK_KEY_dead_E) + (GDK_KEY_dead_i) + (GDK_KEY_dead_I) + (GDK_KEY_dead_o) + (GDK_KEY_dead_O) + (GDK_KEY_dead_u) + (GDK_KEY_dead_U) + (GDK_KEY_dead_small_schwa) + (GDK_KEY_dead_capital_schwa) + (GDK_KEY_dead_greek) (GDK_KEY_First_Virtual_Screen) (GDK_KEY_Prev_Virtual_Screen) (GDK_KEY_Next_Virtual_Screen) @@ -277,6 +309,12 @@ gtk-2.0/gdk/gdkkeysyms.h |# (GDK_KEY_Pointer_Accelerate) (GDK_KEY_Pointer_DfltBtnNext) (GDK_KEY_Pointer_DfltBtnPrev) + (GDK_KEY_ch) + (GDK_KEY_Ch) + (GDK_KEY_CH) + (GDK_KEY_c_h) + (GDK_KEY_C_h) + (GDK_KEY_C_H) (GDK_KEY_3270_Duplicate) (GDK_KEY_3270_FieldMark) (GDK_KEY_3270_Right2) @@ -556,9 +594,9 @@ gtk-2.0/gdk/gdkkeysyms.h |# (GDK_KEY_nacute) (GDK_KEY_ncaron) (GDK_KEY_odoubleacute) - (GDK_KEY_udoubleacute) (GDK_KEY_rcaron) (GDK_KEY_uring) + (GDK_KEY_udoubleacute) (GDK_KEY_tcedilla) (GDK_KEY_abovedot) (GDK_KEY_Hstroke) @@ -619,32 +657,32 @@ gtk-2.0/gdk/gdkkeysyms.h |# (GDK_KEY_uogonek) (GDK_KEY_utilde) (GDK_KEY_umacron) + (GDK_KEY_Wcircumflex) + (GDK_KEY_wcircumflex) + (GDK_KEY_Ycircumflex) + (GDK_KEY_ycircumflex) (GDK_KEY_Babovedot) (GDK_KEY_babovedot) (GDK_KEY_Dabovedot) - (GDK_KEY_Wgrave) - (GDK_KEY_Wacute) (GDK_KEY_dabovedot) - (GDK_KEY_Ygrave) (GDK_KEY_Fabovedot) (GDK_KEY_fabovedot) (GDK_KEY_Mabovedot) (GDK_KEY_mabovedot) (GDK_KEY_Pabovedot) - (GDK_KEY_wgrave) (GDK_KEY_pabovedot) - (GDK_KEY_wacute) (GDK_KEY_Sabovedot) - (GDK_KEY_ygrave) - (GDK_KEY_Wdiaeresis) - (GDK_KEY_wdiaeresis) (GDK_KEY_sabovedot) - (GDK_KEY_Wcircumflex) (GDK_KEY_Tabovedot) - (GDK_KEY_Ycircumflex) - (GDK_KEY_wcircumflex) (GDK_KEY_tabovedot) - (GDK_KEY_ycircumflex) + (GDK_KEY_Wgrave) + (GDK_KEY_wgrave) + (GDK_KEY_Wacute) + (GDK_KEY_wacute) + (GDK_KEY_Wdiaeresis) + (GDK_KEY_wdiaeresis) + (GDK_KEY_Ygrave) + (GDK_KEY_ygrave) (GDK_KEY_OE) (GDK_KEY_oe) (GDK_KEY_Ydiaeresis) @@ -1139,6 +1177,7 @@ gtk-2.0/gdk/gdkkeysyms.h |# (GDK_KEY_leftdoublequotemark) (GDK_KEY_rightdoublequotemark) (GDK_KEY_prescription) + (GDK_KEY_permille) (GDK_KEY_minutes) (GDK_KEY_seconds) (GDK_KEY_latincross) @@ -1572,6 +1611,8 @@ gtk-2.0/gdk/gdkkeysyms.h |# (GDK_KEY_obarred) (GDK_KEY_SCHWA) (GDK_KEY_schwa) + (GDK_KEY_EZH) + (GDK_KEY_ezh) (GDK_KEY_Lbelowdot) (GDK_KEY_lbelowdot) (GDK_KEY_Abelowdot) @@ -1710,4 +1751,524 @@ gtk-2.0/gdk/gdkkeysyms.h |# (GDK_KEY_approxeq) (GDK_KEY_notapproxeq) (GDK_KEY_notidentical) - (GDK_KEY_stricteq)) \ No newline at end of file + (GDK_KEY_stricteq) + (GDK_KEY_braille_dot_1) + (GDK_KEY_braille_dot_2) + (GDK_KEY_braille_dot_3) + (GDK_KEY_braille_dot_4) + (GDK_KEY_braille_dot_5) + (GDK_KEY_braille_dot_6) + (GDK_KEY_braille_dot_7) + (GDK_KEY_braille_dot_8) + (GDK_KEY_braille_dot_9) + (GDK_KEY_braille_dot_10) + (GDK_KEY_braille_blank) + (GDK_KEY_braille_dots_1) + (GDK_KEY_braille_dots_2) + (GDK_KEY_braille_dots_12) + (GDK_KEY_braille_dots_3) + (GDK_KEY_braille_dots_13) + (GDK_KEY_braille_dots_23) + (GDK_KEY_braille_dots_123) + (GDK_KEY_braille_dots_4) + (GDK_KEY_braille_dots_14) + (GDK_KEY_braille_dots_24) + (GDK_KEY_braille_dots_124) + (GDK_KEY_braille_dots_34) + (GDK_KEY_braille_dots_134) + (GDK_KEY_braille_dots_234) + (GDK_KEY_braille_dots_1234) + (GDK_KEY_braille_dots_5) + (GDK_KEY_braille_dots_15) + (GDK_KEY_braille_dots_25) + (GDK_KEY_braille_dots_125) + (GDK_KEY_braille_dots_35) + (GDK_KEY_braille_dots_135) + (GDK_KEY_braille_dots_235) + (GDK_KEY_braille_dots_1235) + (GDK_KEY_braille_dots_45) + (GDK_KEY_braille_dots_145) + (GDK_KEY_braille_dots_245) + (GDK_KEY_braille_dots_1245) + (GDK_KEY_braille_dots_345) + (GDK_KEY_braille_dots_1345) + (GDK_KEY_braille_dots_2345) + (GDK_KEY_braille_dots_12345) + (GDK_KEY_braille_dots_6) + (GDK_KEY_braille_dots_16) + (GDK_KEY_braille_dots_26) + (GDK_KEY_braille_dots_126) + (GDK_KEY_braille_dots_36) + (GDK_KEY_braille_dots_136) + (GDK_KEY_braille_dots_236) + (GDK_KEY_braille_dots_1236) + (GDK_KEY_braille_dots_46) + (GDK_KEY_braille_dots_146) + (GDK_KEY_braille_dots_246) + (GDK_KEY_braille_dots_1246) + (GDK_KEY_braille_dots_346) + (GDK_KEY_braille_dots_1346) + (GDK_KEY_braille_dots_2346) + (GDK_KEY_braille_dots_12346) + (GDK_KEY_braille_dots_56) + (GDK_KEY_braille_dots_156) + (GDK_KEY_braille_dots_256) + (GDK_KEY_braille_dots_1256) + (GDK_KEY_braille_dots_356) + (GDK_KEY_braille_dots_1356) + (GDK_KEY_braille_dots_2356) + (GDK_KEY_braille_dots_12356) + (GDK_KEY_braille_dots_456) + (GDK_KEY_braille_dots_1456) + (GDK_KEY_braille_dots_2456) + (GDK_KEY_braille_dots_12456) + (GDK_KEY_braille_dots_3456) + (GDK_KEY_braille_dots_13456) + (GDK_KEY_braille_dots_23456) + (GDK_KEY_braille_dots_123456) + (GDK_KEY_braille_dots_7) + (GDK_KEY_braille_dots_17) + (GDK_KEY_braille_dots_27) + (GDK_KEY_braille_dots_127) + (GDK_KEY_braille_dots_37) + (GDK_KEY_braille_dots_137) + (GDK_KEY_braille_dots_237) + (GDK_KEY_braille_dots_1237) + (GDK_KEY_braille_dots_47) + (GDK_KEY_braille_dots_147) + (GDK_KEY_braille_dots_247) + (GDK_KEY_braille_dots_1247) + (GDK_KEY_braille_dots_347) + (GDK_KEY_braille_dots_1347) + (GDK_KEY_braille_dots_2347) + (GDK_KEY_braille_dots_12347) + (GDK_KEY_braille_dots_57) + (GDK_KEY_braille_dots_157) + (GDK_KEY_braille_dots_257) + (GDK_KEY_braille_dots_1257) + (GDK_KEY_braille_dots_357) + (GDK_KEY_braille_dots_1357) + (GDK_KEY_braille_dots_2357) + (GDK_KEY_braille_dots_12357) + (GDK_KEY_braille_dots_457) + (GDK_KEY_braille_dots_1457) + (GDK_KEY_braille_dots_2457) + (GDK_KEY_braille_dots_12457) + (GDK_KEY_braille_dots_3457) + (GDK_KEY_braille_dots_13457) + (GDK_KEY_braille_dots_23457) + (GDK_KEY_braille_dots_123457) + (GDK_KEY_braille_dots_67) + (GDK_KEY_braille_dots_167) + (GDK_KEY_braille_dots_267) + (GDK_KEY_braille_dots_1267) + (GDK_KEY_braille_dots_367) + (GDK_KEY_braille_dots_1367) + (GDK_KEY_braille_dots_2367) + (GDK_KEY_braille_dots_12367) + (GDK_KEY_braille_dots_467) + (GDK_KEY_braille_dots_1467) + (GDK_KEY_braille_dots_2467) + (GDK_KEY_braille_dots_12467) + (GDK_KEY_braille_dots_3467) + (GDK_KEY_braille_dots_13467) + (GDK_KEY_braille_dots_23467) + (GDK_KEY_braille_dots_123467) + (GDK_KEY_braille_dots_567) + (GDK_KEY_braille_dots_1567) + (GDK_KEY_braille_dots_2567) + (GDK_KEY_braille_dots_12567) + (GDK_KEY_braille_dots_3567) + (GDK_KEY_braille_dots_13567) + (GDK_KEY_braille_dots_23567) + (GDK_KEY_braille_dots_123567) + (GDK_KEY_braille_dots_4567) + (GDK_KEY_braille_dots_14567) + (GDK_KEY_braille_dots_24567) + (GDK_KEY_braille_dots_124567) + (GDK_KEY_braille_dots_34567) + (GDK_KEY_braille_dots_134567) + (GDK_KEY_braille_dots_234567) + (GDK_KEY_braille_dots_1234567) + (GDK_KEY_braille_dots_8) + (GDK_KEY_braille_dots_18) + (GDK_KEY_braille_dots_28) + (GDK_KEY_braille_dots_128) + (GDK_KEY_braille_dots_38) + (GDK_KEY_braille_dots_138) + (GDK_KEY_braille_dots_238) + (GDK_KEY_braille_dots_1238) + (GDK_KEY_braille_dots_48) + (GDK_KEY_braille_dots_148) + (GDK_KEY_braille_dots_248) + (GDK_KEY_braille_dots_1248) + (GDK_KEY_braille_dots_348) + (GDK_KEY_braille_dots_1348) + (GDK_KEY_braille_dots_2348) + (GDK_KEY_braille_dots_12348) + (GDK_KEY_braille_dots_58) + (GDK_KEY_braille_dots_158) + (GDK_KEY_braille_dots_258) + (GDK_KEY_braille_dots_1258) + (GDK_KEY_braille_dots_358) + (GDK_KEY_braille_dots_1358) + (GDK_KEY_braille_dots_2358) + (GDK_KEY_braille_dots_12358) + (GDK_KEY_braille_dots_458) + (GDK_KEY_braille_dots_1458) + (GDK_KEY_braille_dots_2458) + (GDK_KEY_braille_dots_12458) + (GDK_KEY_braille_dots_3458) + (GDK_KEY_braille_dots_13458) + (GDK_KEY_braille_dots_23458) + (GDK_KEY_braille_dots_123458) + (GDK_KEY_braille_dots_68) + (GDK_KEY_braille_dots_168) + (GDK_KEY_braille_dots_268) + (GDK_KEY_braille_dots_1268) + (GDK_KEY_braille_dots_368) + (GDK_KEY_braille_dots_1368) + (GDK_KEY_braille_dots_2368) + (GDK_KEY_braille_dots_12368) + (GDK_KEY_braille_dots_468) + (GDK_KEY_braille_dots_1468) + (GDK_KEY_braille_dots_2468) + (GDK_KEY_braille_dots_12468) + (GDK_KEY_braille_dots_3468) + (GDK_KEY_braille_dots_13468) + (GDK_KEY_braille_dots_23468) + (GDK_KEY_braille_dots_123468) + (GDK_KEY_braille_dots_568) + (GDK_KEY_braille_dots_1568) + (GDK_KEY_braille_dots_2568) + (GDK_KEY_braille_dots_12568) + (GDK_KEY_braille_dots_3568) + (GDK_KEY_braille_dots_13568) + (GDK_KEY_braille_dots_23568) + (GDK_KEY_braille_dots_123568) + (GDK_KEY_braille_dots_4568) + (GDK_KEY_braille_dots_14568) + (GDK_KEY_braille_dots_24568) + (GDK_KEY_braille_dots_124568) + (GDK_KEY_braille_dots_34568) + (GDK_KEY_braille_dots_134568) + (GDK_KEY_braille_dots_234568) + (GDK_KEY_braille_dots_1234568) + (GDK_KEY_braille_dots_78) + (GDK_KEY_braille_dots_178) + (GDK_KEY_braille_dots_278) + (GDK_KEY_braille_dots_1278) + (GDK_KEY_braille_dots_378) + (GDK_KEY_braille_dots_1378) + (GDK_KEY_braille_dots_2378) + (GDK_KEY_braille_dots_12378) + (GDK_KEY_braille_dots_478) + (GDK_KEY_braille_dots_1478) + (GDK_KEY_braille_dots_2478) + (GDK_KEY_braille_dots_12478) + (GDK_KEY_braille_dots_3478) + (GDK_KEY_braille_dots_13478) + (GDK_KEY_braille_dots_23478) + (GDK_KEY_braille_dots_123478) + (GDK_KEY_braille_dots_578) + (GDK_KEY_braille_dots_1578) + (GDK_KEY_braille_dots_2578) + (GDK_KEY_braille_dots_12578) + (GDK_KEY_braille_dots_3578) + (GDK_KEY_braille_dots_13578) + (GDK_KEY_braille_dots_23578) + (GDK_KEY_braille_dots_123578) + (GDK_KEY_braille_dots_4578) + (GDK_KEY_braille_dots_14578) + (GDK_KEY_braille_dots_24578) + (GDK_KEY_braille_dots_124578) + (GDK_KEY_braille_dots_34578) + (GDK_KEY_braille_dots_134578) + (GDK_KEY_braille_dots_234578) + (GDK_KEY_braille_dots_1234578) + (GDK_KEY_braille_dots_678) + (GDK_KEY_braille_dots_1678) + (GDK_KEY_braille_dots_2678) + (GDK_KEY_braille_dots_12678) + (GDK_KEY_braille_dots_3678) + (GDK_KEY_braille_dots_13678) + (GDK_KEY_braille_dots_23678) + (GDK_KEY_braille_dots_123678) + (GDK_KEY_braille_dots_4678) + (GDK_KEY_braille_dots_14678) + (GDK_KEY_braille_dots_24678) + (GDK_KEY_braille_dots_124678) + (GDK_KEY_braille_dots_34678) + (GDK_KEY_braille_dots_134678) + (GDK_KEY_braille_dots_234678) + (GDK_KEY_braille_dots_1234678) + (GDK_KEY_braille_dots_5678) + (GDK_KEY_braille_dots_15678) + (GDK_KEY_braille_dots_25678) + (GDK_KEY_braille_dots_125678) + (GDK_KEY_braille_dots_35678) + (GDK_KEY_braille_dots_135678) + (GDK_KEY_braille_dots_235678) + (GDK_KEY_braille_dots_1235678) + (GDK_KEY_braille_dots_45678) + (GDK_KEY_braille_dots_145678) + (GDK_KEY_braille_dots_245678) + (GDK_KEY_braille_dots_1245678) + (GDK_KEY_braille_dots_345678) + (GDK_KEY_braille_dots_1345678) + (GDK_KEY_braille_dots_2345678) + (GDK_KEY_braille_dots_12345678) + (GDK_KEY_Sinh_ng) + (GDK_KEY_Sinh_h2) + (GDK_KEY_Sinh_a) + (GDK_KEY_Sinh_aa) + (GDK_KEY_Sinh_ae) + (GDK_KEY_Sinh_aee) + (GDK_KEY_Sinh_i) + (GDK_KEY_Sinh_ii) + (GDK_KEY_Sinh_u) + (GDK_KEY_Sinh_uu) + (GDK_KEY_Sinh_ri) + (GDK_KEY_Sinh_rii) + (GDK_KEY_Sinh_lu) + (GDK_KEY_Sinh_luu) + (GDK_KEY_Sinh_e) + (GDK_KEY_Sinh_ee) + (GDK_KEY_Sinh_ai) + (GDK_KEY_Sinh_o) + (GDK_KEY_Sinh_oo) + (GDK_KEY_Sinh_au) + (GDK_KEY_Sinh_ka) + (GDK_KEY_Sinh_kha) + (GDK_KEY_Sinh_ga) + (GDK_KEY_Sinh_gha) + (GDK_KEY_Sinh_ng2) + (GDK_KEY_Sinh_nga) + (GDK_KEY_Sinh_ca) + (GDK_KEY_Sinh_cha) + (GDK_KEY_Sinh_ja) + (GDK_KEY_Sinh_jha) + (GDK_KEY_Sinh_nya) + (GDK_KEY_Sinh_jnya) + (GDK_KEY_Sinh_nja) + (GDK_KEY_Sinh_tta) + (GDK_KEY_Sinh_ttha) + (GDK_KEY_Sinh_dda) + (GDK_KEY_Sinh_ddha) + (GDK_KEY_Sinh_nna) + (GDK_KEY_Sinh_ndda) + (GDK_KEY_Sinh_tha) + (GDK_KEY_Sinh_thha) + (GDK_KEY_Sinh_dha) + (GDK_KEY_Sinh_dhha) + (GDK_KEY_Sinh_na) + (GDK_KEY_Sinh_ndha) + (GDK_KEY_Sinh_pa) + (GDK_KEY_Sinh_pha) + (GDK_KEY_Sinh_ba) + (GDK_KEY_Sinh_bha) + (GDK_KEY_Sinh_ma) + (GDK_KEY_Sinh_mba) + (GDK_KEY_Sinh_ya) + (GDK_KEY_Sinh_ra) + (GDK_KEY_Sinh_la) + (GDK_KEY_Sinh_va) + (GDK_KEY_Sinh_sha) + (GDK_KEY_Sinh_ssha) + (GDK_KEY_Sinh_sa) + (GDK_KEY_Sinh_ha) + (GDK_KEY_Sinh_lla) + (GDK_KEY_Sinh_fa) + (GDK_KEY_Sinh_al) + (GDK_KEY_Sinh_aa2) + (GDK_KEY_Sinh_ae2) + (GDK_KEY_Sinh_aee2) + (GDK_KEY_Sinh_i2) + (GDK_KEY_Sinh_ii2) + (GDK_KEY_Sinh_u2) + (GDK_KEY_Sinh_uu2) + (GDK_KEY_Sinh_ru2) + (GDK_KEY_Sinh_e2) + (GDK_KEY_Sinh_ee2) + (GDK_KEY_Sinh_ai2) + (GDK_KEY_Sinh_o2) + (GDK_KEY_Sinh_oo2) + (GDK_KEY_Sinh_au2) + (GDK_KEY_Sinh_lu2) + (GDK_KEY_Sinh_ruu2) + (GDK_KEY_Sinh_luu2) + (GDK_KEY_Sinh_kunddaliya) + (GDK_KEY_ModeLock) + (GDK_KEY_MonBrightnessUp) + (GDK_KEY_MonBrightnessDown) + (GDK_KEY_KbdLightOnOff) + (GDK_KEY_KbdBrightnessUp) + (GDK_KEY_KbdBrightnessDown) + (GDK_KEY_Standby) + (GDK_KEY_AudioLowerVolume) + (GDK_KEY_AudioMute) + (GDK_KEY_AudioRaiseVolume) + (GDK_KEY_AudioPlay) + (GDK_KEY_AudioStop) + (GDK_KEY_AudioPrev) + (GDK_KEY_AudioNext) + (GDK_KEY_HomePage) + (GDK_KEY_Mail) + (GDK_KEY_Start) + (GDK_KEY_Search) + (GDK_KEY_AudioRecord) + (GDK_KEY_Calculator) + (GDK_KEY_Memo) + (GDK_KEY_ToDoList) + (GDK_KEY_Calendar) + (GDK_KEY_PowerDown) + (GDK_KEY_ContrastAdjust) + (GDK_KEY_RockerUp) + (GDK_KEY_RockerDown) + (GDK_KEY_RockerEnter) + (GDK_KEY_Back) + (GDK_KEY_Forward) + (GDK_KEY_Stop) + (GDK_KEY_Refresh) + (GDK_KEY_PowerOff) + (GDK_KEY_WakeUp) + (GDK_KEY_Eject) + (GDK_KEY_ScreenSaver) + (GDK_KEY_WWW) + (GDK_KEY_Sleep) + (GDK_KEY_Favorites) + (GDK_KEY_AudioPause) + (GDK_KEY_AudioMedia) + (GDK_KEY_MyComputer) + (GDK_KEY_VendorHome) + (GDK_KEY_LightBulb) + (GDK_KEY_Shop) + (GDK_KEY_History) + (GDK_KEY_OpenURL) + (GDK_KEY_AddFavorite) + (GDK_KEY_HotLinks) + (GDK_KEY_BrightnessAdjust) + (GDK_KEY_Finance) + (GDK_KEY_Community) + (GDK_KEY_AudioRewind) + (GDK_KEY_BackForward) + (GDK_KEY_Launch0) + (GDK_KEY_Launch1) + (GDK_KEY_Launch2) + (GDK_KEY_Launch3) + (GDK_KEY_Launch4) + (GDK_KEY_Launch5) + (GDK_KEY_Launch6) + (GDK_KEY_Launch7) + (GDK_KEY_Launch8) + (GDK_KEY_Launch9) + (GDK_KEY_LaunchA) + (GDK_KEY_LaunchB) + (GDK_KEY_LaunchC) + (GDK_KEY_LaunchD) + (GDK_KEY_LaunchE) + (GDK_KEY_LaunchF) + (GDK_KEY_ApplicationLeft) + (GDK_KEY_ApplicationRight) + (GDK_KEY_Book) + (GDK_KEY_CD) + (GDK_KEY_WindowClear) + (GDK_KEY_Close) + (GDK_KEY_Copy) + (GDK_KEY_Cut) + (GDK_KEY_Display) + (GDK_KEY_DOS) + (GDK_KEY_Documents) + (GDK_KEY_Excel) + (GDK_KEY_Explorer) + (GDK_KEY_Game) + (GDK_KEY_Go) + (GDK_KEY_iTouch) + (GDK_KEY_LogOff) + (GDK_KEY_Market) + (GDK_KEY_Meeting) + (GDK_KEY_MenuKB) + (GDK_KEY_MenuPB) + (GDK_KEY_MySites) + (GDK_KEY_New) + (GDK_KEY_News) + (GDK_KEY_OfficeHome) + (GDK_KEY_Open) + (GDK_KEY_Option) + (GDK_KEY_Paste) + (GDK_KEY_Phone) + (GDK_KEY_Reply) + (GDK_KEY_Reload) + (GDK_KEY_RotateWindows) + (GDK_KEY_RotationPB) + (GDK_KEY_RotationKB) + (GDK_KEY_Save) + (GDK_KEY_ScrollUp) + (GDK_KEY_ScrollDown) + (GDK_KEY_ScrollClick) + (GDK_KEY_Send) + (GDK_KEY_Spell) + (GDK_KEY_SplitScreen) + (GDK_KEY_Support) + (GDK_KEY_TaskPane) + (GDK_KEY_Terminal) + (GDK_KEY_Tools) + (GDK_KEY_Travel) + (GDK_KEY_UserPB) + (GDK_KEY_User1KB) + (GDK_KEY_User2KB) + (GDK_KEY_Video) + (GDK_KEY_WheelButton) + (GDK_KEY_Word) + (GDK_KEY_Xfer) + (GDK_KEY_ZoomIn) + (GDK_KEY_ZoomOut) + (GDK_KEY_Away) + (GDK_KEY_Messenger) + (GDK_KEY_WebCam) + (GDK_KEY_MailForward) + (GDK_KEY_Pictures) + (GDK_KEY_Music) + (GDK_KEY_Battery) + (GDK_KEY_Bluetooth) + (GDK_KEY_WLAN) + (GDK_KEY_UWB) + (GDK_KEY_AudioForward) + (GDK_KEY_AudioRepeat) + (GDK_KEY_AudioRandomPlay) + (GDK_KEY_Subtitle) + (GDK_KEY_AudioCycleTrack) + (GDK_KEY_CycleAngle) + (GDK_KEY_FrameBack) + (GDK_KEY_FrameForward) + (GDK_KEY_Time) + (GDK_KEY_SelectButton) + (GDK_KEY_View) + (GDK_KEY_TopMenu) + (GDK_KEY_Red) + (GDK_KEY_Green) + (GDK_KEY_Yellow) + (GDK_KEY_Blue) + (GDK_KEY_Suspend) + (GDK_KEY_Hibernate) + (GDK_KEY_TouchpadToggle) + (GDK_KEY_TouchpadOn) + (GDK_KEY_TouchpadOff) + (GDK_KEY_Switch_VT_1) + (GDK_KEY_Switch_VT_2) + (GDK_KEY_Switch_VT_3) + (GDK_KEY_Switch_VT_4) + (GDK_KEY_Switch_VT_5) + (GDK_KEY_Switch_VT_6) + (GDK_KEY_Switch_VT_7) + (GDK_KEY_Switch_VT_8) + (GDK_KEY_Switch_VT_9) + (GDK_KEY_Switch_VT_10) + (GDK_KEY_Switch_VT_11) + (GDK_KEY_Switch_VT_12) + (GDK_KEY_Ungrab) + (GDK_KEY_ClearGrab) + (GDK_KEY_Next_VMode) + (GDK_KEY_Prev_VMode) + (GDK_KEY_LogWindowTree) + (GDK_KEY_LogGrabInfo)) \ No newline at end of file diff --git a/src/gtk/Includes/gdkrgb.cdecl b/src/gtk/Includes/gdkrgb.cdecl deleted file mode 100644 index 1fd29f421..000000000 --- a/src/gtk/Includes/gdkrgb.cdecl +++ /dev/null @@ -1,13 +0,0 @@ -#| -*-Scheme-*- - -gtk-2.0/gdk/gdkrgb.h |# - -(typedef GdkRgbDither - (enum - (GDK_RGB_DITHER_NONE) - (GDK_RGB_DITHER_NORMAL) - (GDK_RGB_DITHER_MAX))) - -(extern void gdk_rgb_find_color ;gtk+-2.8.20 - (colormap (* GdkColormap)) - (color (* GdkColor))) \ No newline at end of file diff --git a/src/gtk/Includes/gdkrgba.cdecl b/src/gtk/Includes/gdkrgba.cdecl new file mode 100644 index 000000000..1bb8ae75e --- /dev/null +++ b/src/gtk/Includes/gdkrgba.cdecl @@ -0,0 +1,14 @@ +#| -*-Scheme-*- + +gdk/gdkrgba.h |# + +(struct _GdkRGBA + (red gdouble) + (green gdouble) + (blue gdouble) + (alpha gdouble)) + +(extern gboolean + gdk_rgba_parse + (rgba (* GdkRGBA)) + (spec (* (const gchar)))) \ No newline at end of file diff --git a/src/gtk/Includes/gdktypes.cdecl b/src/gtk/Includes/gdktypes.cdecl index 3ada5ca8e..ab0e40a67 100644 --- a/src/gtk/Includes/gdktypes.cdecl +++ b/src/gtk/Includes/gdktypes.cdecl @@ -1,21 +1,16 @@ #| -*-Scheme-*- -gtk-2.0/gdk/gdktypes.h |# - -(include "glib") -(include "pango") +gdk/gdktypes.h |# (enum (GDK_CURRENT_TIME)) -(typedef GdkRectangle (struct _GdkRectangle)) +(typedef GdkRectangle cairo_rectangle_int_t) (typedef GdkAtom (* (struct _GdkAtom))) (typedef GdkNativeWindow gpointer) -(typedef GdkColor (struct _GdkColor)) -(typedef GdkColormap (struct _GdkColormap)) -(typedef GdkCursor (struct _GdkCursor)) +(typedef GdkRGBA (struct _GdkRGBA)) (typedef GdkModifierType (enum @@ -36,10 +31,4 @@ gtk-2.0/gdk/gdktypes.h |# (GDK_HYPER_MASK) (GDK_META_MASK) (GDK_RELEASE_MASK) - (GDK_MODIFIER_MASK))) - -(struct _GdkRectangle - (x gint) - (y gint) - (width gint) - (height gint)) \ No newline at end of file + (GDK_MODIFIER_MASK))) \ No newline at end of file diff --git a/src/gtk/Includes/gdkwindow.cdecl b/src/gtk/Includes/gdkwindow.cdecl index cfaf95771..c53ac3721 100644 --- a/src/gtk/Includes/gdkwindow.cdecl +++ b/src/gtk/Includes/gdkwindow.cdecl @@ -1,16 +1,11 @@ #| -*-Scheme-*- -gtk-2.0/gdk/gdkwindow.h |# - -;(include "gdkdrawable") -(include "gdktypes") -(include "gdkevents") +gdk/gdkwindow.h |# (typedef GdkGeometry (struct _GdkGeometry)) (typedef GdkWindowAttr (struct _GdkWindowAttr)) -(typedef GdkPointerHooks (struct _GdkPointerHooks)) -(typedef GdkWindowClass +(typedef GdkWindowWindowClass (enum (GDK_INPUT_OUTPUT) (GDK_INPUT_ONLY))) @@ -19,7 +14,6 @@ gtk-2.0/gdk/gdkwindow.h |# (GDK_WINDOW_ROOT) (GDK_WINDOW_TOPLEVEL) (GDK_WINDOW_CHILD) - (GDK_WINDOW_DIALOG) (GDK_WINDOW_TEMP) (GDK_WINDOW_FOREIGN))) @@ -29,7 +23,6 @@ gtk-2.0/gdk/gdkwindow.h |# (GDK_WA_X) (GDK_WA_Y) (GDK_WA_CURSOR) - (GDK_WA_COLORMAP) (GDK_WA_VISUAL) (GDK_WA_WMCLASS) (GDK_WA_NOREDIR))) @@ -107,9 +100,8 @@ gtk-2.0/gdk/gdkwindow.h |# (y gint) (width gint) (height gint) - (wclass GdkWindowClass) + (wclass GdkWindowWindowClass) (visual (* GdkVisual)) - (colormap (* GdkColormap)) (window_type GdkWindowType) (cursor (* GdkCursor)) (wmclass_name (* gchar)) @@ -130,17 +122,6 @@ gtk-2.0/gdk/gdkwindow.h |# (max_aspect gdouble) (win_gravity GdkGravity)) -(struct _GdkPointerHooks - (get_pointer (* (function (* GdkWindow) - (window (* GdkWindow)) - (x (* gint)) - (y (* gint)) - (mask (* GdkModifierType))))) - (window_at_pointer (* (function (* GdkWindow) - (screen (* GdkScreen)) - (win_x (* gint)) - (win_y (* gint)))))) - (extern (* GdkWindow) gdk_window_new (parent (* GdkWindow)) (attributes (* GdkWindowAttr)) @@ -160,9 +141,9 @@ gtk-2.0/gdk/gdkwindow.h |# (window (* GdkWindow)) (x gint) (y gint) (width gint) (height gint)) -(extern void gdk_window_set_background +(extern void gdk_window_set_background_rgba (window (* GdkWindow)) - (color (* (const GdkColor)))) + (rgba (* GdkRGBA))) (extern (* GdkWindow) gdk_window_get_pointer (window (* GdkWindow)) @@ -170,13 +151,6 @@ gtk-2.0/gdk/gdkwindow.h |# (y (* gint)) (mask (* GdkModifierType))) -(extern void gdk_window_clear_area - (window (* GdkWindow)) - (x gint) - (y gint) - (width gint) - (height gint)) - (extern void gdk_window_scroll (window (* GdkWindow)) (dx gint) diff --git a/src/gtk/Includes/gtk.cdecl b/src/gtk/Includes/gtk.cdecl index 0120e88f9..62d4f5994 100644 --- a/src/gtk/Includes/gtk.cdecl +++ b/src/gtk/Includes/gtk.cdecl @@ -1,165 +1,19 @@ #| -*-Scheme-*- -gtk-2.0/gtk/gtk.h |# +gtk/gtk.h |# (include "gdk") -;(include "gtkaboutdialog") -;(include "gtkaccelgroup") -;(include "gtkaccellabel") -;(include "gtkaccelmap") -;(include "gtkaccessible") -;(include "gtkaction") -;(include "gtkactiongroup") (include "gtkadjustment") -;(include "gtkalignment") -;(include "gtkarrow") -;(include "gtkaspectframe") -;(include "gtkbbox") -;(include "gtkbin") -;(include "gtkbindings") (include "gtkbox") -;(include "gtkbutton") -;(include "gtkcalendar") -;(include "gtkcelllayout") -;(include "gtkcellrenderer") -;(include "gtkcellrenderercombo") -;(include "gtkcellrendererpixbuf") -;(include "gtkcellrendererprogress") -;(include "gtkcellrenderertext") -;(include "gtkcellrenderertoggle") -;(include "gtkcellview") -;(include "gtkcheckbutton") -;(include "gtkcheckmenuitem") -;(include "gtkclipboard") -;(include "gtkclist") -;(include "gtkcolorbutton") -;(include "gtkcolorsel") -;(include "gtkcolorseldialog") -;(include "gtkcombo") -;(include "gtkcombobox") -;(include "gtkcomboboxentry") (include "gtkcontainer") -;(include "gtkctree") -;(include "gtkcurve") -;(include "gtkdialog") -;(include "gtkdnd") -;(include "gtkdrawingarea") -;(include "gtkeditable") -;(include "gtkentry") -;(include "gtkentrycompletion") (include "gtkenums") -;(include "gtkeventbox") -;(include "gtkexpander") -;(include "gtkfilesel") -;(include "gtkfixed") -;(include "gtkfilechooserbutton") -;(include "gtkfilechooserdialog") -;(include "gtkfilechooserwidget") -;(include "gtkfontbutton") -;(include "gtkfontsel") (include "gtkframe") -;(include "gtkgamma") -;(include "gtkgc") -;(include "gtkhandlebox") -;(include "gtkhbbox") (include "gtkhbox") -;(include "gtkhpaned") -;(include "gtkhruler") -;(include "gtkhscale") -;(include "gtkhscrollbar") -;(include "gtkhseparator") -;(include "gtkiconfactory") -;(include "gtkicontheme") -;(include "gtkiconview") -;(include "gtkimage") -;(include "gtkimagemenuitem") -;(include "gtkimcontext") -;(include "gtkimcontextsimple") -;(include "gtkimmulticontext") -;(include "gtkinputdialog") -;(include "gtkinvisible") -;(include "gtkitem") -;(include "gtkitemfactory") (include "gtklabel") -;(include "gtklayout") -;(include "gtklist") -;(include "gtklistitem") -;(include "gtkliststore") -;(include "gtkmain") -;(include "gtkmenu") -;(include "gtkmenubar") -;(include "gtkmenuitem") -;(include "gtkmenushell") -;(include "gtkmenutoolbutton") -;(include "gtkmessagedialog") -;(include "gtkmisc") -;(include "gtkmodules") -;(include "gtknotebook") -(include "gtkobject") -;(include "gtkoldeditable") -;(include "gtkoptionmenu") -;(include "gtkpaned") -;(include "gtkpixmap") -;(include "gtkplug") -;(include "gtkpreview") -;(include "gtkprogress") -;(include "gtkprogressbar") -;(include "gtkradioaction") -;(include "gtkradiobutton") -;(include "gtkradiomenuitem") -;(include "gtkradiotoolbutton") -;(include "gtkrange") -(include "gtkrc") -;(include "gtkruler") -;(include "gtkscale") -;(include "gtkscrollbar") (include "gtkscrolledwindow") -;(include "gtkselection") -;(include "gtkseparator") -;(include "gtkseparatormenuitem") -;(include "gtkseparatortoolitem") -;(include "gtksettings") -;(include "gtksignal") -;(include "gtksizegroup") -;(include "gtksocket") -;(include "gtkspinbutton") -;(include "gtkstatusbar") -;(include "gtkstock") -(include "gtkstyle") -;(include "gtktable") -;(include "gtktearoffmenuitem") -;(include "gtktext") -;(include "gtktextbuffer") -;(include "gtktextview") -;(include "gtktipsquery") -;(include "gtktoggleaction") +(include "gtkstylecontext") (include "gtktogglebutton") -;(include "gtktoggletoolbutton") -;(include "gtktoolbar") -;(include "gtktoolbar") -;(include "gtktoolbutton") -;(include "gtktoolitem") -;(include "gtktooltips") -;(include "gtktree") -;(include "gtktreednd") -;(include "gtktreeitem") -;(include "gtktreemodel") -;(include "gtktreemodelfilter") -;(include "gtktreemodelsort") -;(include "gtktreeselection") -;(include "gtktreestore") -;(include "gtktreeview") -;(include "gtktreeviewcolumn") (include "gtktypeutils") -;(include "gtkuimanager") -;(include "gtkvbbox") (include "gtkvbox") -;(include "gtkversion") -;(include "gtkviewport") -;(include "gtkvpaned") -;(include "gtkvruler") -;(include "gtkvscale") -;(include "gtkvscrollbar") -;(include "gtkvseparator") (include "gtkwidget") (include "gtkwindow") \ No newline at end of file diff --git a/src/gtk/Includes/gtkadjustment.cdecl b/src/gtk/Includes/gtkadjustment.cdecl index 49fc659d9..ea491a9b7 100644 --- a/src/gtk/Includes/gtkadjustment.cdecl +++ b/src/gtk/Includes/gtkadjustment.cdecl @@ -1,21 +1,10 @@ #| -*-Scheme-*- -gtk-2.0/gtk/gtkadjustment.h |# +gtk/gtkadjustment.h |# -(typedef GtkAdjustment (struct _GtkAdjustment)) +(typedef GtkAdjustment void) -(struct _GtkAdjustment - (parent_instance GtkObject) - (lower gdouble) - (upper gdouble) - (value gdouble) - (step_increment gdouble) - (page_increment gdouble) - (page_size gdouble)) - -;(extern GType gtk_adjustment_get_type) - -(extern (* GtkObject) gtk_adjustment_new +(extern (* GtkAdjustment) gtk_adjustment_new (value gdouble) (lower gdouble) (upper gdouble) @@ -29,14 +18,44 @@ gtk-2.0/gtk/gtkadjustment.h |# (extern void gtk_adjustment_value_changed (adjustment (* GtkAdjustment))) -;(extern void gtk_adjustment_clamp_page -; (adjustment (* GtkAdjustment)) -; (lower gdouble) -; (upper gdouble)) - (extern gdouble gtk_adjustment_get_value (adjustment (* GtkAdjustment))) -;(extern void gtk_adjustment_set_value -; (adjustment (* GtkAdjustment)) -; (value gdouble)) \ No newline at end of file +(extern void gtk_adjustment_set_value + (adjustment (* GtkAdjustment)) + (value gdouble)) + +(extern gdouble gtk_adjustment_get_lower + (adjustment (* GtkAdjustment))) + +(extern void gtk_adjustment_set_lower + (adjustment (* GtkAdjustment)) + (lower gdouble)) + +(extern gdouble gtk_adjustment_get_upper + (adjustment (* GtkAdjustment))) + +(extern void gtk_adjustment_set_upper + (adjustment (* GtkAdjustment)) + (upper gdouble)) + +(extern gdouble gtk_adjustment_get_step_increment + (adjustment (* GtkAdjustment))) + +(extern void gtk_adjustment_set_step_increment + (adjustment (* GtkAdjustment)) + (step_increment gdouble)) + +(extern gdouble gtk_adjustment_get_page_increment + (adjustment (* GtkAdjustment))) + +(extern void gtk_adjustment_set_page_increment + (adjustment (* GtkAdjustment)) + (page_increment gdouble)) + +(extern gdouble gtk_adjustment_get_page_size + (adjustment (* GtkAdjustment))) + +(extern void gtk_adjustment_set_page_size + (adjustment (* GtkAdjustment)) + (page_size gdouble)) \ No newline at end of file diff --git a/src/gtk/Includes/gtkenums.cdecl b/src/gtk/Includes/gtkenums.cdecl index 1fa8a7fcc..3a5c3f6bc 100644 --- a/src/gtk/Includes/gtkenums.cdecl +++ b/src/gtk/Includes/gtkenums.cdecl @@ -1,28 +1,6 @@ #| -*-Scheme-*- -gtk-2.0/gtk/gtkenums.h |# - -;(include "glib-object") - -(typedef GtkAnchorType - (enum - (GTK_ANCHOR_CENTER) - (GTK_ANCHOR_NORTH) - (GTK_ANCHOR_NORTH_WEST) - (GTK_ANCHOR_NORTH_EAST) - (GTK_ANCHOR_SOUTH) - (GTK_ANCHOR_SOUTH_WEST) - (GTK_ANCHOR_SOUTH_EAST) - (GTK_ANCHOR_WEST) - (GTK_ANCHOR_EAST) - (GTK_ANCHOR_N) - (GTK_ANCHOR_NW) - (GTK_ANCHOR_NE) - (GTK_ANCHOR_S) - (GTK_ANCHOR_SW) - (GTK_ANCHOR_SE) - (GTK_ANCHOR_W) - (GTK_ANCHOR_E))) +gtk/gtkenums.h |# (typedef GtkArrowType (enum @@ -39,18 +17,11 @@ gtk-2.0/gtk/gtkenums.h |# (typedef GtkButtonBoxStyle (enum - (GTK_BUTTONBOX_DEFAULT_STYLE) (GTK_BUTTONBOX_SPREAD) (GTK_BUTTONBOX_EDGE) (GTK_BUTTONBOX_START) (GTK_BUTTONBOX_END))) -(typedef GtkCurveType - (enum - (GTK_CURVE_TYPE_LINEAR) - (GTK_CURVE_TYPE_SPLINE) - (GTK_CURVE_TYPE_FREE))) - (typedef GtkDeleteType (enum (GTK_DELETE_CHARS) @@ -108,12 +79,6 @@ gtk-2.0/gtk/gtkenums.h |# (GTK_MENU_DIR_NEXT) (GTK_MENU_DIR_PREV))) -(typedef GtkMetricType - (enum - (GTK_PIXELS) - (GTK_INCHES) - (GTK_CENTIMETERS))) - (typedef GtkMovementStep (enum (GTK_MOVEMENT_LOGICAL_POSITIONS) @@ -218,8 +183,7 @@ gtk-2.0/gtk/gtkenums.h |# (GTK_SELECTION_NONE) (GTK_SELECTION_SINGLE) (GTK_SELECTION_BROWSE) - (GTK_SELECTION_MULTIPLE) - (GTK_SELECTION_EXTENDED))) + (GTK_SELECTION_MULTIPLE))) (typedef GtkShadowType (enum @@ -229,13 +193,16 @@ gtk-2.0/gtk/gtkenums.h |# (GTK_SHADOW_ETCHED_IN) (GTK_SHADOW_ETCHED_OUT))) -(typedef GtkStateType +(typedef GtkStateFlags (enum - (GTK_STATE_NORMAL) - (GTK_STATE_ACTIVE) - (GTK_STATE_PRELIGHT) - (GTK_STATE_SELECTED) - (GTK_STATE_INSENSITIVE))) + (GTK_STATE_FLAG_NORMAL) + (GTK_STATE_FLAG_ACTIVE) + (GTK_STATE_FLAG_PRELIGHT) + (GTK_STATE_FLAG_SELECTED) + (GTK_STATE_FLAG_INSENSITIVE) + (GTK_STATE_FLAG_INCONSISTENT) + (GTK_STATE_FLAG_FOCUSED) + (GTK_STATE_FLAG_BACKDROP))) (typedef GtkToolbarStyle (enum @@ -244,18 +211,6 @@ gtk-2.0/gtk/gtkenums.h |# (GTK_TOOLBAR_BOTH) (GTK_TOOLBAR_BOTH_HORIZ))) -(typedef GtkUpdateType - (enum - (GTK_UPDATE_CONTINUOUS) - (GTK_UPDATE_DISCONTINUOUS) - (GTK_UPDATE_DELAYED))) - -(typedef GtkVisibility - (enum - (GTK_VISIBILITY_NONE) - (GTK_VISIBILITY_PARTIAL) - (GTK_VISIBILITY_FULL))) - (typedef GtkWindowPosition (enum (GTK_WIN_POS_NONE) diff --git a/src/gtk/Includes/gtkobject.cdecl b/src/gtk/Includes/gtkobject.cdecl deleted file mode 100644 index 7eb1df5fb..000000000 --- a/src/gtk/Includes/gtkobject.cdecl +++ /dev/null @@ -1,40 +0,0 @@ -#| -*-Scheme-*- - -gtk-2.0/gtk/gtkobject.h |# - -;(include "gtkenums") -;(include "gtktypeutils") -;(include "gtkdebug") - -(typedef GtkObjectFlags - (enum - (GTK_IN_DESTRUCTION) - (GTK_FLOATING) - (GTK_RESERVED_1) - (GTK_RESERVED_2))) - -(typedef GtkObjectClass (struct _GtkObjectClass)) - -(struct _GtkObject - (parent_instance GObject) - ;; GtkWidgetFlags share these 32bits. - (flags guint32)) - -(struct _GtkObjectClass - (parent_class GObjectClass) - - ;; Non overridable class methods to set and get per class arguments - (set_arg (* (function void - (object (* GtkObject)) - (arg (* GtkArg)) - (arg_id guint)))) - (get_arg (* (function void - (object (* GtkObject)) - (arg (* GtkArg)) - (arg_id guint)))) - - (destroy (* (function void - (object (* GtkObject)))))) - -(extern void gtk_object_sink (object (* GtkObject))) -(extern void gtk_object_destroy (object (* GtkObject))) diff --git a/src/gtk/Includes/gtkrc.cdecl b/src/gtk/Includes/gtkrc.cdecl deleted file mode 100644 index 54a10956f..000000000 --- a/src/gtk/Includes/gtkrc.cdecl +++ /dev/null @@ -1,30 +0,0 @@ -#| -*-Scheme-*- - -gtk-2.0/gtk/gtkrc.h |# - -(typedef GtkRcFlags - (enum - (GTK_RC_FG) - (GTK_RC_BG) - (GTK_RC_TEXT) - (GTK_RC_BASE))) - -(struct _GtkRcStyle - (parent_instance GObject) - (name (* gchar)) - (bg_pixmap_name (array (* gchar) 5)) - (font_desc (* PangoFontDescription)) - (color_flags (array GtkRcFlags 5)) - (fg (array GdkColor 5)) - (bg (array GdkColor 5)) - (text (array GdkColor 5)) - (base (array GdkColor 5)) - (xthickness gint) - (ythickness gint) - ;; private - ;; (rc_properties (* GArray)) - ;; (rc_style_lists (* GSList)) - ;; (icon_factories (* GSList)) - ;; bit field - ;; (engine_specified guint) - ) \ No newline at end of file diff --git a/src/gtk/Includes/gtkstyle.cdecl b/src/gtk/Includes/gtkstyle.cdecl deleted file mode 100644 index cd8544669..000000000 --- a/src/gtk/Includes/gtkstyle.cdecl +++ /dev/null @@ -1,137 +0,0 @@ -#| -*-Scheme-*- - -gtk-2.0/gtk/gtkstyle.h |# - -(typedef GtkWidget (struct _GtkWidget)) - -(typedef GtkStyle (struct _GtkStyle)) -(typedef GtkRcStyle (struct _GtkRcStyle)) - -(struct _GtkStyle - (parent_instance GObject) - - (fg (array GdkColor 5)) - (bg (array GdkColor 5)) - (light (array GdkColor 5)) - (dark (array GdkColor 5)) - (mid (array GdkColor 5)) - (text (array GdkColor 5)) - (base (array GdkColor 5)) - (text_aa (array GdkColor 5)) - - (black GdkColor) - (white GdkColor) - (font_desc (* PangoFontDescription)) - - (xthickness gint) - (ythickness gint) - - (fg_gc (array (* GdkGC) 5)) - (bg_gc (array (* GdkGC) 5)) - (light_gc (array (* GdkGC) 5)) - (dark_gc (array (* GdkGC) 5)) - (mid_gc (array (* GdkGC) 5)) - (text_gc (array (* GdkGC) 5)) - (base_gc (array (* GdkGC) 5)) - (text_aa_gc (array (* GdkGC) 5)) - (black_gc (* GdkGC)) - (white_gc (* GdkGC)) - - (bg_pixmap (array (* GdkPixmap) 5)) - - ;; < private > - - (attach_count gint) - - (depth gint) - (colormap (* GdkColormap)) - (private_font (* GdkFont)) - (private_font_desc (* PangoFontDescription)) - - (rc_style (* GtkRcStyle)) - - (styles (* GSList)) - (property_cache (* GArray)) - (icon_factories (* GSList))) - -(extern (* GtkStyle) gtk_style_attach - (style (* GtkStyle)) - (window (* GdkWindow))) - -(extern void gtk_style_set_background - (style (* GtkStyle)) - (window (* GdkWindow)) - (state_type GtkStateType)) - -(extern gboolean gtk_style_lookup_color - (style (* GtkStyle)) - (color_name (* (const gchar))) - (color (* GdkColor))) - -#;(extern void gtk_paint_hline - (style (* GtkStyle)) - (window (* GdkWindow)) - (state_type GtkStateType) - (area (* GdkRectangle)) - (widget (* GtkWidget)) - (detail (* (const gchar))) - (x1 gint) - (x2 gint) - (y gint)) - -#;(extern void gtk_paint_vline - (style (* GtkStyle)) - (window (* GdkWindow)) - (state_type GtkStateType) - (area (* GdkRectangle)) - (widget (* GtkWidget)) - (detail (* (const gchar))) - (y1_ gint) - (y2_ gint) - (x gint)) - -(extern void gtk_paint_box - (style (* GtkStyle)) - (window (* GdkWindow)) - (state_type GtkStateType) - (shadow_type GtkShadowType) - (area (* GdkRectangle)) - (widget (* GtkWidget)) - (detail (* (const gchar))) - (x gint) - (y gint) - (width gint) - (height gint)) - -(extern void gtk_paint_focus - (style (* GtkStyle)) - (window (* GdkWindow)) - (state_type GtkStateType) - (area (* GdkRectangle)) - (widget (* GtkWidget)) - (detail (* (const gchar))) - (x gint) (y gint) - (width gint) (height gint)) - -(extern void gtk_paint_handle - (style (* GtkStyle)) - (window (* GdkWindow)) - (state_type GtkStateType) - (shadow_type GtkShadowType) - (area (* (const GdkRectangle))) - (widget (* GtkWidget)) - (detail (* (const gchar))) - (x gint) (y gint) - (width gint) (height gint) - (orientation GtkOrientation)) - -(extern void gtk_paint_layout - (style (* GtkStyle)) - (window (* GdkWindow)) - (state_type GtkStateType) - (use_text gboolean) - (area (* GdkRectangle)) - (widget (* GtkWidget)) - (detail (* (const gchar))) - (x gint) (y gint) - (layout (* PangoLayout))) \ No newline at end of file diff --git a/src/gtk/Includes/gtkstylecontext.cdecl b/src/gtk/Includes/gtkstylecontext.cdecl new file mode 100644 index 000000000..67289ad62 --- /dev/null +++ b/src/gtk/Includes/gtkstylecontext.cdecl @@ -0,0 +1,51 @@ +#| -*-Scheme-*- + +gtk/gtkstylecontext.h |# + +(extern void gtk_style_context_add_class + (context (* GtkStyleContext)) + (class_name (* (const gchar)))) + +(extern gboolean gtk_style_context_lookup_color + (context (* GtkStyleContext)) + (color_name (* (const gchar))) + (color (* GdkRGBA))) + +(extern void gtk_style_context_get_color + (context (* GtkStyleContext)) + (state GtkStateFlags) + (color (* GdkRGBA))) + +(extern void gtk_style_context_get_background_color + (context (* GtkStyleContext)) + (state GtkStateFlags) + (color (* GdkRGBA))) + +(extern (* (const PangoFontDescription)) + gtk_style_context_get_font + (context (* GtkStyleContext)) + (state GtkStateFlags)) + +(extern void gtk_style_context_set_background + (context (* GtkStyleContext)) + (window (* GdkWindow))) + +(extern void gtk_render_background + (context (* GtkStyleContext)) (cr (* cairo_t)) + (x gdouble) (y gdouble) (width gdouble) (height gdouble)) + +(extern void gtk_render_frame + (context (* GtkStyleContext)) (cr (* cairo_t)) + (x gdouble) (y gdouble) (width gdouble) (height gdouble)) + +(extern void gtk_render_focus + (context (* GtkStyleContext)) (cr (* cairo_t)) + (x gdouble) (y gdouble) (width gdouble) (height gdouble)) + +(extern void gtk_render_layout + (context (* GtkStyleContext)) (cr (* cairo_t)) + (x gdouble) (y gdouble) (layout (* PangoLayout))) + +(extern void gtk_render_handle + (context (* GtkStyleContext)) (cr (* cairo_t)) + (x gdouble) (y gdouble) (width gdouble) (height gdouble)) \ No newline at end of file diff --git a/src/gtk/Includes/gtktypeutils.cdecl b/src/gtk/Includes/gtktypeutils.cdecl index 38940c7eb..a89ca8d22 100644 --- a/src/gtk/Includes/gtktypeutils.cdecl +++ b/src/gtk/Includes/gtktypeutils.cdecl @@ -1,23 +1,13 @@ #| -*-Scheme-*- -gtk-2.0/gtk/gtktypeutils.h |# - -;(include "glib-object") +gtk/gtktypeutils.h |# (typedef GtkType GType) -;(include "gtktypebuiltins") - -;(typedef GtkArg (struct _GtkArg)) -(typedef GtkObject (struct _GtkObject)) (typedef GtkFunction (* (function gboolean (data gpointer)))) + (typedef GtkDestroyNotify (* (function void (data gpointer)))) -(typedef GtkCallbackMarshal - (* (function void - (object (* GtkObject)) - (data gpointer) - (n_args guint) - (args (* GtkArg))))) -(typedef GtkSignalFunc (* (function void))) + +(typedef GtkSignalFunc (* (function void))) \ No newline at end of file diff --git a/src/gtk/Includes/gtkwidget.cdecl b/src/gtk/Includes/gtkwidget.cdecl index 84f6182ae..df51b1428 100644 --- a/src/gtk/Includes/gtkwidget.cdecl +++ b/src/gtk/Includes/gtkwidget.cdecl @@ -1,52 +1,10 @@ #| -*-Scheme-*- -gtk-2.0/gtk/gtkwidget.h |# - -(include "gdk") -;(include "gtkaccelgroup") -(include "gtkobject") -(include "gtkadjustment") -(include "gtkstyle") -;(include "gtksettings") -;(include "atkobject") - -(typedef GtkWidgetFlags - (enum - (GTK_TOPLEVEL) - (GTK_NO_WINDOW) - (GTK_REALIZED) - (GTK_MAPPED) - - (GTK_VISIBLE) - (GTK_SENSITIVE) - (GTK_PARENT_SENSITIVE) - (GTK_CAN_FOCUS) - - (GTK_HAS_FOCUS) - (GTK_CAN_DEFAULT) - (GTK_HAS_DEFAULT) - (GTK_HAS_GRAB) - - (GTK_RC_STYLE) - (GTK_COMPOSITE_CHILD) - (GTK_NO_REPARENT) - (GTK_APP_PAINTABLE) - (GTK_RECEIVES_DEFAULT) - (GTK_DOUBLE_BUFFERED) - (GTK_NO_SHOW_ALL))) - -(typedef GtkWidgetHelpType - (enum - (GTK_WIDGET_HELP_TOOLTIP) - (GTK_WIDGET_HELP_WHATS_THIS))) +gtk/gtkwidget.h |# (typedef GtkRequisition (struct _GtkRequisition)) (typedef GtkAllocation GdkRectangle) -;(typedef GtkSelectionData (struct _GtkSelectionData)) -(typedef GtkWidgetClass (struct _GtkWidgetClass)) -(typedef GtkWidgetAuxInfo (struct _GtkWidgetAuxInfo)) -(typedef GtkWidgetShapeInfo (struct _GtkWidgetShapeInfo)) -;(typedef GtkClipboard (struct _GtkClipboard)) +(typedef GtkWidget (* mumble)) (typedef GtkCallback (* (function void (widget (* GtkWidget)) (data gpointer)))) @@ -54,238 +12,6 @@ gtk-2.0/gtk/gtkwidget.h |# (width gint) (height gint)) -(struct _GtkWidget - (object GtkObject) - (private_flags guint16) - (state guint8) - (saved_state guint8) - (name (* gchar)) - (style (* GtkStyle)) - (requisition GtkRequisition) - (allocation GtkAllocation) - (window (* GdkWindow)) - (parent (* GtkWidget))) - -(struct _GtkWidgetClass - (parent_class GtkObjectClass) - (activate_signal guint) - (set_scroll_adjustments_signal guint) - (dispatch_child_properties_changed - (* (function void - (widget (* GtkWidget)) - (n_pspecs guint) - (pspecs (* (* GParamSpec)))))) - (show (* (function void (widget (* GtkWidget))))) - (show_all (* (function void (widget (* GtkWidget))))) - (hide (* (function void (widget (* GtkWidget))))) - (hide_all (* (function void (widget (* GtkWidget))))) - (map (* (function void (widget (* GtkWidget))))) - (unmap (* (function void (widget (* GtkWidget))))) - (realize (* (function void (widget (* GtkWidget))))) - (unrealize (* (function void (widget (* GtkWidget))))) - (size_request - (* (function void - (widget (* GtkWidget)) - (requisition (* GtkRequisition))))) - (size_allocate - (* (function void - (widget (* GtkWidget)) (allocation (* GtkAllocation))))) - (state_changed - (* (function void - (widget (* GtkWidget)) (previous_state GtkStateType)))) - (parent_set - (* (function void - (widget (* GtkWidget)) (previous_parent (* GtkWidget))))) - (hierarchy_changed - (* (function void - (widget (* GtkWidget)) - (previous_toplevel (* GtkWidget))))) - (style_set - (* (function void - (widget (* GtkWidget)) (previous_style (* GtkStyle))))) - (direction_changed - (* (function void - (widget (* GtkWidget)) - (previous_direction GtkTextDirection)))) - (grab_notify - (* (function void - (widget (* GtkWidget)) (was_grabbed gboolean)))) - (child_notify - (* (function void - (widget (* GtkWidget)) (pspec (* GParamSpec))))) - (mnemonic_activate - (* (function gboolean - (widget (* GtkWidget)) (group_cycling gboolean)))) - (grab_focus (* (function void (widget (* GtkWidget))))) - (focus (* (function gboolean - (widget (* GtkWidget)) - (direction GtkDirectionType)))) - (event (* (function gboolean - (widget (* GtkWidget)) (event (* GdkEvent))))) - (button_press_event - (* (function gboolean - (widget (* GtkWidget)) (event (* GdkEventButton))))) - (button_release_event - (* (function gboolean - (widget (* GtkWidget)) (event (* GdkEventButton))))) - (scroll_event - (* (function gboolean - (widget (* GtkWidget)) (event (* GdkEventScroll))))) - (motion_notify_event - (* (function gboolean - (widget (* GtkWidget)) (event (* GdkEventMotion))))) - (delete_event - (* (function gboolean - (widget (* GtkWidget)) (event (* GdkEventAny))))) - (destroy_event - (* (function gboolean - (widget (* GtkWidget)) (event (* GdkEventAny))))) - (expose_event - (* (function gboolean - (widget (* GtkWidget)) (event (* GdkEventExpose))))) - (key_press_event - (* (function gboolean - (widget (* GtkWidget)) (event (* GdkEventKey))))) - (key_release_event - (* (function gboolean - (widget (* GtkWidget)) (event (* GdkEventKey))))) - (enter_notify_event - (* (function gboolean - (widget (* GtkWidget)) (event (* GdkEventCrossing))))) - (leave_notify_event - (* (function gboolean - (widget (* GtkWidget)) (event (* GdkEventCrossing))))) - (configure_event - (* (function gboolean - (widget (* GtkWidget)) (event (* GdkEventConfigure))))) - (focus_in_event - (* (function gboolean - (widget (* GtkWidget)) (event (* GdkEventFocus))))) - (focus_out_event - (* (function gboolean - (widget (* GtkWidget)) (event (* GdkEventFocus))))) - (map_event - (* (function gboolean - (widget (* GtkWidget)) (event (* GdkEventAny))))) - (unmap_event - (* (function gboolean - (widget (* GtkWidget)) (event (* GdkEventAny))))) - (property_notify_event - (* (function gboolean - (widget (* GtkWidget)) (event (* GdkEventProperty))))) - (selection_clear_event - (* (function gboolean - (widget (* GtkWidget)) (event (* GdkEventSelection))))) - (selection_request_event - (* (function gboolean - (widget (* GtkWidget)) (event (* GdkEventSelection))))) - (selection_notify_event - (* (function gboolean - (widget (* GtkWidget)) (event (* GdkEventSelection))))) - (proximity_in_event - (* (function gboolean - (widget (* GtkWidget)) (event (* GdkEventProximity))))) - (proximity_out_event - (* (function gboolean - (widget (* GtkWidget)) (event (* GdkEventProximity))))) - (visibility_notify_event - (* (function gboolean - (widget (* GtkWidget)) (event (* GdkEventVisibility))))) - (client_event - (* (function gboolean - (widget (* GtkWidget)) (event (* GdkEventClient))))) - (no_expose_event - (* (function gboolean - (widget (* GtkWidget)) (event (* GdkEventAny))))) - (window_state_event - (* (function gboolean - (widget (* GtkWidget)) (event (* GdkEventWindowState))))) - (selection_get - (* (function void - (widget (* GtkWidget)) - (selection_data (* GtkSelectionData)) - (info guint) - (time_ guint)))) - (selection_received - (* (function void - (widget (* GtkWidget)) - (selection_data (* GtkSelectionData)) - (time_ guint)))) - (drag_begin - (* (function void - (widget (* GtkWidget)) (context (* GdkDragContext))))) - (drag_end - (* (function void - (widget (* GtkWidget)) (context (* GdkDragContext))))) - (drag_data_get - (* (function void - (widget (* GtkWidget)) (context (* GdkDragContext)) - (selection_data (* GtkSelectionData)) - (info guint) - (time_ guint)))) - (drag_data_delete - (* (function void - (widget (* GtkWidget)) (context (* GdkDragContext))))) - (drag_leave - (* (function void - (widget (* GtkWidget)) (context (* GdkDragContext)) - (time_ guint)))) - (drag_motion - (* (function gboolean - (widget (* GtkWidget)) (context (* GdkDragContext)) - (x gint) (y gint) (time_ guint)))) - (drag_drop - (* (function gboolean - (widget (* GtkWidget)) (context (* GdkDragContext)) - (x gint) (y gint) (time_ guint)))) - (drag_data_received - (* (function void - (widget (* GtkWidget)) (context (* GdkDragContext)) - (x gint) (y gint) - (selection_data (* GtkSelectionData)) - (info guint) (time_ guint)))) - (popup_menu - (* (function gboolean - (widget (* GtkWidget))))) - (show_help - (* (function gboolean - (widget (* GtkWidget)) (help_type GtkWidgetHelpType)))) - (get_accessible - (* (function (* AtkObject) - (widget (* GtkWidget))))) - (screen_changed - (* (function void - (widget (* GtkWidget)) (previous_screen (* GdkScreen))))) - (can_activate_accel - (* (function gboolean - (widget (* GtkWidget)) (signal_id guint)))) - (grab_broken_event - (* (function gboolean - (widget (* GtkWidget)) (event (* GdkEventGrabBroken))))) - (composited_changed - (* (function void (widget (* GtkWidget))))) - (query_tooltip - (* (function gboolean - (widget (* GtkWidget)) (x gint) (y gint) - (keyboard_tooltip gboolean) - (tooltip (* GtkTooltip))))) - (_gtk_reserved5 (* (function void))) - (_gtk_reserved6 (* (function void))) - (_gtk_reserved7 (* (function void)))) - -(struct _GtkWidgetAuxInfo - (x gint) - (y gint) - (width gint) - (height gint) - ;;(_skip guint) - ) - -(struct _GtkWidgetShapeInfo - (offset_x gint16) - (offset_y gint16) - (shape_mask (* GdkBitmap))) - (extern void gtk_widget_destroy (widget (* GtkWidget))) @@ -312,21 +38,41 @@ gtk-2.0/gtk/gtkwidget.h |# (widget (* GtkWidget)) (can_focus gboolean)) +(extern gboolean gtk_widget_has_focus + (widget (* GtkWidget))) + (extern void gtk_widget_grab_focus (widget (* GtkWidget))) -(extern void gtk_widget_set_state +(extern void + gtk_widget_set_state_flags (widget (* GtkWidget)) - (state GtkStateType)) + (flags GtkStateFlags) + (clear gboolean)) + +(extern void + gtk_widget_unset_state_flags + (widget (* GtkWidget)) + (flags GtkStateFlags)) + +(extern GtkStateFlags + gtk_widget_get_state_flags + (widget (* GtkWidget))) (extern void gtk_widget_set_has_window (widget (* GtkWidget)) (has_window gboolean)) +(extern gboolean gtk_widget_is_drawable + (widget (* GtkWidget))) + (extern void gtk_widget_set_realized (widget (* GtkWidget)) (realized gboolean)) +(extern gboolean gtk_widget_get_realized + (widget (* GtkWidget))) + (extern (* GdkWindow) gtk_widget_get_parent_window (widget (* GtkWidget))) @@ -334,6 +80,10 @@ gtk-2.0/gtk/gtkwidget.h |# (widget (* GtkWidget)) (window (* GdkWindow))) +(extern void gtk_widget_get_allocation + (widget (* GtkWidget)) + (allocation (* GtkAllocation))) + (extern void gtk_widget_error_bell (widget (* GtkWidget))) @@ -342,30 +92,25 @@ gtk-2.0/gtk/gtkwidget.h |# (width gint) (height gint)) -(extern (* GdkColormap) gtk_widget_get_colormap - (widget (* GtkWidget))) - -;;(extern (* GdkVisual) gtk_widget_get_visual -;; (widget (* GtkWidget))) - -;;(extern void gtk_widget_set_colormap -;; (widget (* GtkWidget)) -;; (colormap (* GdkColormap))) - (extern gint gtk_widget_get_events (widget (* GtkWidget))) -;;; Widget styles. +(extern void gtk_widget_override_color + (widget (* GtkWidget)) + (state GtkStateFlags) + (color (* (const GdkRGBA)))) -(extern void gtk_widget_ensure_style - (widget (* GtkWidget))) +(extern void gtk_widget_override_background_color + (widget (* GtkWidget)) + (state GtkStateFlags) + (color (* (const GdkRGBA)))) -(extern void gtk_widget_modify_style +(extern void gtk_widget_override_font (widget (* GtkWidget)) - (style (* GtkRcStyle))) + (font_desc (* (const PangoFontDescription)))) -(extern (* GtkRcStyle) - gtk_widget_get_modifier_style +(extern gboolean + gtk_widget_is_composited (widget (* GtkWidget))) (extern (* PangoContext) @@ -376,6 +121,6 @@ gtk-2.0/gtk/gtkwidget.h |# (widget (* GtkWidget)) (text (* (const gchar)))) -(extern gboolean - gtk_widget_is_composited - (widget (* GtkWidget))) \ No newline at end of file +(extern (* GtkStyleContext) + gtk_widget_get_style_context + (width (* GtkWidget))) \ No newline at end of file diff --git a/src/gtk/Makefile-fragment b/src/gtk/Makefile-fragment index 51c2840d8..4c3dc3dbb 100644 --- a/src/gtk/Makefile-fragment +++ b/src/gtk/Makefile-fragment @@ -1,9 +1,9 @@ #-*-Makefile-*- # gtk/Makefile-fragment # -# Copyright (C) 2011 Matthew Birkholz +# Copyright (C) 2011, 2012 Matthew Birkholz # -# This file is part of MIT/GNU Scheme. +# This file is part of an extension to MIT/GNU Scheme. # # MIT/GNU Scheme is free software; you can redistribute it and/or # modify it under the terms of the GNU General Public License as @@ -61,10 +61,10 @@ install: gtk-shim.so: gtk-shim.o scmwidget.o gtkio.o $(SHIM_LOADER) $(LINK_SHIM) gtk-shim.o scmwidget.o gtkio.o \ - `pkg-config --libs gtk+-2.0 gthread-2.0` $(SHIM_LIBS) + `pkg-config --libs gtk+-3.0 gthread-2.0` $(SHIM_LIBS) scmwidget.o: scmwidget.c - $(COMPILE_SHIM) `pkg-config --cflags gtk+-2.0` -c scmwidget.c + $(COMPILE_SHIM) `pkg-config --cflags gtk+-3.0` -c scmwidget.c scmwidget.c: scmwidget.c.stay cp -p scmwidget.c.stay scmwidget.c @@ -73,13 +73,13 @@ scmwidget.c: scmwidget.c.stay # with config.h. This is COMPILE_SHIM without DEFS. gtkio.o: gtkio.c $(CC) $(CPPFLAGS) $(CFLAGS) $(SHIM_CFLAGS) \ - `pkg-config --cflags gtk+-2.0` -I../microcode -c $< + `pkg-config --cflags gtk+-3.0` -I../microcode -c $< gtkio.c: gtkio.c.stay cp -p gtkio.c.stay gtkio.c gtk-shim.o: gtk-shim.c gtk-shim.h ../lib/mit-scheme.h - $(COMPILE_SHIM) `pkg-config --cflags gtk+-2.0` -o $@ -c $< + $(COMPILE_SHIM) `pkg-config --cflags gtk+-3.0` -o $@ -c $< gtk-shim.c gtk-const.c gtk-types.bin: gtk-shim.h gtk.cdecl \ Includes/*.cdecl Includes/*/*.cdecl @@ -96,9 +96,9 @@ gtk-const.scm: gtk-const gtk-const: gtk-const.o @rm -f $@ - $(CCLD) $(CFLAGS) $(LDFLAGS) -o $@ $< `pkg-config --libs gtk+-2.0` + $(CCLD) $(CFLAGS) $(LDFLAGS) -o $@ $< `pkg-config --libs gtk+-3.0` gtk-const.o: gtk-const.c - $(CC) $(CFLAGS) `pkg-config --cflags gtk+-2.0` -o $@ -c $< + $(CC) $(CFLAGS) `pkg-config --cflags gtk+-3.0` -o $@ -c $< .PHONY: build install diff --git a/src/gtk/cairo.scm b/src/gtk/cairo.scm index 70bb6d45b..212cfa353 100644 --- a/src/gtk/cairo.scm +++ b/src/gtk/cairo.scm @@ -2,7 +2,7 @@ Copyright (C) 2012 Matthew Birkholz -This file is part of MIT/GNU Scheme. +This file is part of an extension to MIT/GNU Scheme. MIT/GNU Scheme is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by @@ -24,11 +24,11 @@ USA. ;;;; Cairo interface. ;;; package: (gtk cairo) -(define (gdk-cairo-create GdkDrawable) +(define (gdk-cairo-create GdkWindow) (let ((cairo (make-alien '|cairo_t|)) (copy (make-alien '|cairo_t|))) (add-gc-cleanup cairo (make-cairo-cleanup copy)) - (C-call "gdk_cairo_create" copy GdkDrawable) + (C-call "gdk_cairo_create" copy GdkWindow) (copy-alien-address! cairo copy) (check-cairo-status cairo) cairo)) diff --git a/src/gtk/compile.scm b/src/gtk/compile.scm index 2049eb9c6..daea3b901 100644 --- a/src/gtk/compile.scm +++ b/src/gtk/compile.scm @@ -33,7 +33,7 @@ ("gobject" ,@base) ("gio" ,@base) ("pango" ,@base) - ("gtk-object" ,@base) + ("gtk-widget" ,@base) ("scm-widget" ,@base) ("fix-layout" "pango" ,@base ,@c-types) ("keys" ,@base ,@c-types) diff --git a/src/gtk/ed-ffi.scm b/src/gtk/ed-ffi.scm index f5944313e..5063e7aab 100644 --- a/src/gtk/ed-ffi.scm +++ b/src/gtk/ed-ffi.scm @@ -7,7 +7,7 @@ GTK buffer packaging info |# ("gtk" (gtk)) ("gobject" (gtk gobject)) ("pango" (gtk pango)) - ("gtk-object" (gtk gtk-object)) + ("gtk-widget" (gtk gtk-widget)) ("scm-widget" (gtk widget)) ("fix-layout" (gtk fix-layout)) ("keys" (gtk keys)) diff --git a/src/gtk/fix-demo.scm b/src/gtk/fix-demo.scm index 5f00be218..f67123a44 100644 --- a/src/gtk/fix-demo.scm +++ b/src/gtk/fix-demo.scm @@ -1,8 +1,8 @@ #| -*-Scheme-*- -Copyright (C) 2007, 2008, 2009, 2010, 2011 Matthew Birkholz +Copyright (C) 2007, 2008, 2009, 2010, 2011, 2012 Matthew Birkholz -This file is part of MIT/GNU Scheme. +This file is part of an extension to MIT/GNU Scheme. MIT/GNU Scheme is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by @@ -22,7 +22,7 @@ USA. |# ;;;; A small drawing in two fix-layout widgets. -;;; package: (gtk demo) +;;; package: (gtk fix-layout demo) (define blink? #t) (define spin? #t) @@ -37,7 +37,8 @@ USA. (resizer (make-fix-resizer -1 10))) (gtk-window-set-opacity window 0.90) (gtk-window-set-title window "fix-layout-demo") - (gtk-window-set-geometry-hints window window 'min-width 10 'min-height 10) + ;;(gtk-window-set-geometry-hints window window 'min-width 10 'min-height 10) + (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) @@ -54,7 +55,6 @@ USA. (let ((drawing (make-demo-drawing layout1))) (let ((cursor1 (make-box-ink)) (cursor2 (make-box-ink))) - (set-box-ink-shadow! cursor1 'out) (fix-drawing-add-ink! drawing cursor1 'bottom) (fix-drawing-add-ink! drawing cursor2 'bottom) (set-demo-drawing-cursor-inks! @@ -87,7 +87,6 @@ USA. (define-method fix-widget-realize-callback ((widget )) (call-next-method widget) - (set-gtk-widget-bg-color! widget (gtk-widget-base-color widget)) (set-fix-widget-pointer-shape! widget 'crosshair)) (define (make-demo-drawing widget) @@ -111,12 +110,12 @@ USA. (set-line-ink-width! line3 3) (set-line-ink-color! line3 "blue") (set-line-ink-dash-color! line3 "green") + (set-line-ink-dashes! line3 '(5. 5. 10. 5.)) (fix-drawing-add-ink! drawing line3) (set-text-ink-position! text 250 250) (set-simple-text-ink-text! text widget "Hello, World!") (fix-drawing-add-ink! drawing text) (set-box-ink! box 220 220 20 20) - (set-box-ink-shadow! box 'etched-in) (fix-drawing-add-ink! drawing box) (set-image-ink! image 270 200) (fix-drawing-add-ink! drawing image) @@ -248,7 +247,7 @@ USA. (demo-drawing-cursor-inks drawing) (lambda (cursor.widgets) (there-exists? (cdr cursor.widgets) - (lambda (w) (not (gtk-object-destroyed? w)))))) + (lambda (w) (not (gtk-widget-destroyed? w)))))) (loop) (%trace ";blinking ended\n")))))) diff --git a/src/gtk/fix-layout.scm b/src/gtk/fix-layout.scm index 98a695d04..6035c3200 100644 --- a/src/gtk/fix-layout.scm +++ b/src/gtk/fix-layout.scm @@ -2,7 +2,7 @@ Copyright (C) 2007, 2008, 2009, 2010, 2011, 2012 Matthew Birkholz -This file is part of MIT/GNU Scheme. +This file is part of an extension to MIT/GNU Scheme. MIT/GNU Scheme is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by @@ -31,20 +31,9 @@ USA. (define-class ( (constructor () (width height))) () - ;; Our window and colormap -- GdkWindow and GdkColormap aliens - ;; respectively. Until realized, these are NULL pointers. + ;; Our window -- a GdkWindow alien. Until realized, a NULL pointer. (window define accessor initializer (lambda () (make-alien '|GdkWindow|))) - (colormap define accessor - initializer (lambda () (make-alien '|GdkColormap|))) - - ;; Our allocated colors -- an alist of color specs x malloced - ;; GdkColor structs with .pixels courtesy of gdk_rgb_find_color. - ;; This is oblivious to GtkStyle settings, e.g. set with - ;; set-gtk-widget-bg-color!. It may (re)allocate a previously set - ;; background color (but just once). Upon destruction, these are - ;; just freed -- no GdkColor de-allocating required. - (colors define standard initial-value '()) ;; Our window geometry (allocation) -- a rectangular extent in ;; fixnum device coordinates (e.g. size in pixels, offset within @@ -75,34 +64,26 @@ USA. (set-fix-rect-size! (fix-widget-geometry widget) w h)) (C-call "gtk_widget_set_has_window" alien 1)) ; WILL have when realized - (set-gtk-object-destroy-callback! widget) (set-gtk-widget-realize-callback! widget fix-widget-realize-callback) (set-gtk-widget-size-allocate-callback! widget allocate-callback) (set-gtk-widget-event-callback! widget event-callback)) -(define-method gtk-object-destroy-callback ((widget )) - (call-next-method widget) - (for-each (lambda (spec.gdkcolor) (free (cdr spec.gdkcolor))) - (fix-widget-colors widget))) - (define-generic fix-widget-realize-callback (widget)) +(define-integrable (widget-style-context widget) + (let ((style (make-alien '|GtkStyleContext|))) + (C-call "gtk_widget_get_style_context" style (gobject-alien widget)) + style)) + (define-method fix-widget-realize-callback ((widget )) (%trace "; (fix-widget-realize-callback ) "widget"\n") (let ((geometry (fix-widget-geometry widget)) (attr (malloc (C-sizeof "GdkWindowAttr") '|GdkWindowAttr|)) (main-GdkWindow (fix-widget-window widget)) (parent-GdkWindow (make-alien '|GdkWindow|)) - ;;(GdkVisual (make-alien '|GdkVisual|)) - (GdkColormap (fix-widget-colormap widget)) (GtkWidget (gobject-alien widget))) ;; Create widget window. - ;;(C-call "gtk_widget_get_visual" GdkVisual GtkWidget) - ;;(C-call "gdk_rgb_get_visual" GdkVisual) - ;;(error-if-null GdkVisual "Could not get GdkVisual:" widget) - (C-call "gtk_widget_get_colormap" GdkColormap GtkWidget) - (error-if-null GdkColormap "Could not get GdkColormap:" widget) (C->= attr "GdkWindowAttr window_type" (C-enum "GDK_WINDOW_CHILD")) (C->= attr "GdkWindowAttr wclass" (C-enum "GDK_INPUT_OUTPUT")) (let ((x (fix-rect-x geometry)) @@ -113,8 +94,6 @@ USA. (if y (C->= attr "GdkWindowAttr y" y)) (C->= attr "GdkWindowAttr width" width) (C->= attr "GdkWindowAttr height" height) - ;;(C->= attr "GdkWindowAttr visual" GdkVisual) - (C->= attr "GdkWindowAttr colormap" GdkColormap) (C->= attr "GdkWindowAttr event_mask" (C-enum "GDK_ALL_EVENTS_MASK")) (C-call "gtk_widget_get_parent_window" parent-GdkWindow GtkWidget) @@ -122,38 +101,33 @@ USA. (C-call "gdk_window_new" main-GdkWindow parent-GdkWindow attr (bit-ior (if x (C-enum "GDK_WA_X") 0) - (if y (C-enum "GDK_WA_Y") 0) - ;;(C-enum "GDK_WA_VISUAL") - (C-enum "GDK_WA_COLORMAP"))) + (if y (C-enum "GDK_WA_Y") 0))) (error-if-null main-GdkWindow "Could not create main window:" widget) (C-call "gtk_widget_set_window" GtkWidget main-GdkWindow) (C-call "gdk_window_set_user_data" main-GdkWindow GtkWidget) - (set-fix-rect! (fix-widget-geometry widget) x y width height) (%trace "; window: "main-GdkWindow"\n")) - (let ((alien (C-> GtkWidget "GtkWidget style"))) - (C-call "gtk_style_attach" alien alien main-GdkWindow) - (C-> GtkWidget "GtkWidget style" alien) - (C-> alien "GtkStyle bg" alien) - (C-array-loc! alien "GdkColor" (C-enum "GTK_STATE_NORMAL")) - (C-call "gdk_window_set_background" main-GdkWindow alien)) + #;(let ((style (widget-style-context widget))) + (C-call "gtk_style_context_add_class" style "view") + (C-call "gtk_style_context_set_background" style main-GdkWindow)) + (let ((rgba (malloc (C-sizeof "GdkRGBA") '|GdkRGBA|))) + (C->= rgba "GdkRGBA red" 1.0) + (C->= rgba "GdkRGBA green" 1.0) + (C->= rgba "GdkRGBA blue" 1.0) + (C->= rgba "GdkRGBA alpha" 1.0) + (C-call "gdk_window_set_background_rgba" main-GdkWindow rgba) + (free rgba)) unspecific)) (define (allocate-callback widget GtkAllocation) - (let ((alien (gobject-alien widget)) - (x (C-> GtkAllocation "GtkAllocation x")) + (let ((x (C-> GtkAllocation "GtkAllocation x")) (y (C-> GtkAllocation "GtkAllocation y")) (width (C-> GtkAllocation "GtkAllocation width")) (height (C-> GtkAllocation "GtkAllocation height")) (rect (fix-widget-geometry widget))) (%trace "; allocated "width"x"height" at "x","y" for "widget"\n") (set-fix-rect! rect x y width height) - ;; For gtk-widget-get-size and random toolkit methods. - (C->= alien "GtkWidget allocation x" x) - (C->= alien "GtkWidget allocation y" y) - (C->= alien "GtkWidget allocation width" width) - (C->= alien "GtkWidget allocation height" height) (if (fix-widget-realized? widget) (C-call "gdk_window_move_resize" (fix-widget-window widget) @@ -169,38 +143,6 @@ USA. (define (fix-widget-realized? widget) (not (alien-null? (fix-widget-window widget)))) -(define-integrable (allocate-color! widget spec) - (let* ((colors (fix-widget-colors widget)) - (entry (assoc spec colors))) - (if entry - (cdr entry) - (let ((gdkcolor (parse-gdkcolor spec widget))) - (if (not gdkcolor) - (begin - (warn "Invalid color spec:" spec widget) - #f) - (let ((colormap (fix-widget-colormap widget))) - (C-call "gdk_rgb_find_color" colormap gdkcolor) - (set-fix-widget-colors! widget - (cons (cons spec gdkcolor) colors)) - gdkcolor)))))) - -(define-method gtk-widget-get-colormap ((widget )) - (fix-widget-colormap widget)) - -(define-method set-gtk-widget-bg-color! ((widget ) color #!optional state) - ;; Set the window background (too). - (call-next-method widget color state) - (%trace "; (set-gtk-widget-bg-color! ) "widget" "color" "state"\n") - (if (and (fix-widget-realized? widget) - (or (default-object? state) (eq? state 'normal))) - (let ((alien (make-alien '|GdkColor|))) - (C-> (gobject-alien widget) "GtkWidget style" alien) - (C-> alien "GtkStyle bg" alien) - (C-array-loc! alien "GdkColor" (C-enum "GTK_STATE_NORMAL")) - ;; The GdkColor was allocated by the GtkStyle. - (C-call "gdk_window_set_background" (fix-widget-window widget) alien)))) - (define-syntax pointer-shapes (sc-macro-transformer (lambda (form usage-env) @@ -231,7 +173,7 @@ USA. ;; Not GC-protecting alien? (C-call "gdk_cursor_new" alien (cdr name.value)) (C-call "gdk_window_set_cursor" (fix-widget-window widget) alien) - (C-call "gdk_cursor_unref" alien))))) + (C-call "g_object_unref" alien))))) (define (event-callback widget GdkEvent) (%trace2 ";event-callback "widget) @@ -244,26 +186,6 @@ USA. ;; Unhandled 0)))) -(define (set-fix-widget-expose-handler! widget handler) - (guarantee-fix-widget widget 'set-fix-widget-expose-handler!) - (guarantee-procedure-of-arity handler 5 'set-fix-widget-expose-handler!) - (vector-set! - (fix-widget-event-handlers widget) (C-enum "GDK_EXPOSE") - (named-lambda (fix-widget-expose-handler widget GdkEvent) - (let ((event-window (C-> GdkEvent "GdkEvent any window")) - (x (C-> GdkEvent "GdkEventExpose area x")) - (y (C-> GdkEvent "GdkEventExpose area y")) - (width (C-> GdkEvent "GdkEventExpose area width")) - (height (C-> GdkEvent "GdkEventExpose area height")) - ;;(count (C-> GdkEvent "GdkEventExpose count")) - (widget-window (fix-widget-window widget))) - (if (not (alien=? event-window widget-window)) - (begin - (warn "Expose event on strange window:" - event-window widget-window) - #f) ;; not "handled" - (handler widget x y width height)))))) - (define (set-fix-widget-map-handler! widget handler) (guarantee-fix-widget widget 'set-fix-widget-map-handler!) (guarantee-procedure-of-arity handler 1 'set-fix-widget-map-handler!) @@ -447,32 +369,52 @@ USA. (define-method initialize-instance ((widget ) width height) (call-next-method widget width height) (%trace "; (initialize-instance ) "widget" "width" "height"\n") - (set-fix-widget-expose-handler! widget layout-expose-handler) + (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) widget) -(define-method gtk-object-destroy-callback ((layout )) +(define-method gtk-widget-destroy-callback ((layout )) (call-next-method layout) (let ((drawing (fix-layout-drawing layout))) (if drawing (fix-drawing-remove-widget! drawing layout)))) -(define (layout-expose-handler layout x y width height) +(define-integrable (clip-extents cairo receiver) + (let ((doubles (malloc (fix:* 4 (C-sizeof "double")) 'double))) + (let ((y1 (C-array-loc doubles "double" 1)) + (x2 (C-array-loc doubles "double" 2)) + (y2 (C-array-loc doubles "double" 3))) + (C-call "cairo_clip_extents" cairo doubles y1 x2 y2) + (let ((x1. (C-> doubles "double")) (y1. (C-> y1 "double")) + (x2. (C-> x2 "double")) (y2. (C-> y2 "double"))) + (free doubles) + (receiver x1. y1. x2. y2.))))) + +(define-integrable (fix:clip-region cr receiver) + (clip-extents cr + (lambda (x1. y1. x2. y2.) + (receiver (floor->exact x1.) (floor->exact y1.) + (floor->exact (flo:- x2. x1.)) ;width + (floor->exact (flo:- y2. y1.)) ;height + )))) + +(define (layout-draw-callback layout cr) (let ((window (fix-widget-window layout)) (drawing (fix-layout-drawing layout)) (view (fix-layout-view layout))) (let ((offx (fix-rect-x view)) (offy (fix-rect-y view))) - (if drawing - (begin - (%trace2 ";expose area "width"x"height" "x","y - " of "layout".\n") - (drawing-expose drawing layout window - (make-fix-rect - (fix:+ x offx) (fix:+ y offy) - width height))) - (%trace2 ";";expose area "width"x"height" "x","y - " of "layout" (no drawing!).\n"))))) + (fix:clip-region + cr (lambda (x y w h) + (if drawing + (begin + (%trace2 ";draw area "x","y" "w"x"h" of "layout".\n") + (drawing-expose drawing layout window cr + (make-fix-rect (fix:+ x offx) (fix:+ y offy) + w h))) + (%trace2 ";draw area "x","y" "w"x"h + " of "layout" (no drawing!).\n")))) + 1))) ;; handled (define-method set-gtk-widget-bg-color! ((widget ) color #!optional state) @@ -653,7 +595,6 @@ USA. (let ((new-adjustment (make-gtk-adjustment))) (copy-alien-address! (gobject-alien new-adjustment) new-alien) (C-call "g_object_ref_sink" new-alien new-alien) - (set-gtk-object-destroy-callback! new-adjustment) (setter widget new-adjustment) (g-signal-connect new-adjustment (C-callback "value_changed") @@ -708,8 +649,8 @@ USA. (set-gtk-adjustment! hadj value left right page-size step-incr page-incr))))) -;;; This is a simple that handles expose events by -;;; calling gtk_paint_handle(). +;;; This is a simple that handles the draw signal by +;;; calling gtk_render_handle(). ;;; Now that it frobs both before and after widgets, it is very ;;; similar to GPaned. The latter would, presumably, squeeze the @@ -751,46 +692,35 @@ USA. widget (if (fix-resizer-stack-vertical? widget) 'sb-v-double-arrow 'sb-h-double-arrow)) - (set-fix-widget-expose-handler! widget resizer-expose-handler) + (set-gtk-widget-draw-callback! widget resizer-draw-callback) (set-fix-widget-enter-notify-handler! widget resizer-enter-handler) (set-fix-widget-leave-notify-handler! widget resizer-leave-handler) (set-fix-widget-button-handler! widget 'press resizer-press-handler) (set-fix-widget-button-handler! widget 'release resizer-release-handler) (set-fix-widget-motion-handler! widget resizer-motion-handler)) -(define (resizer-expose-handler resizer x y width height) - (declare (ignore x y width height)) - (let ((alien (gobject-alien resizer))) - (let ((style (C-> alien "GtkWidget style")) - (window (fix-widget-window resizer)) - (state (C-> alien "GtkWidget state")) - (clip 0) - (widget 0) - (detail 0) - (geom (fix-widget-geometry resizer))) - (let ((orientation (if (fix-resizer-stack-vertical? resizer) - (C-enum "GTK_ORIENTATION_HORIZONTAL") - (C-enum "GTK_ORIENTATION_VERTICAL")))) - (C-call "gtk_paint_handle" - style window state (C-enum "GTK_SHADOW_NONE") - clip widget detail - 0 0 ;my gdkwindow's coords. - (fix-rect-width geom) (fix-rect-height geom) - orientation) - #t)))) +(define (resizer-draw-callback resizer cr) + (let ((geom (fix-widget-geometry resizer)) + (style (widget-style-context resizer))) + (C-call "gtk_render_handle" style cr + (->flonum (fix-rect-x geom)) + (->flonum (fix-rect-y geom)) + (->flonum (fix-rect-width geom)) + (->flonum (fix-rect-height geom))) + 1)) ;; handled (define (resizer-enter-handler resizer) (%trace ";resizer-enter-handler\n") (if (and (fix-resizer-before resizer) (fix-resizer-after resizer)) - (C-call "gtk_widget_set_state" - (gobject-alien resizer) (C-enum "GTK_STATE_PRELIGHT")))) + (C-call "gtk_widget_set_state_flags" + (gobject-alien resizer) (C-enum "GTK_STATE_FLAG_PRELIGHT") 0))) (define (resizer-leave-handler resizer) (%trace ";resizer-leave-handler\n") (if (not (fix-resizer-dragging? resizer)) - (C-call "gtk_widget_set_state" - (gobject-alien resizer) (C-enum "GTK_STATE_NORMAL")))) + (C-call "gtk_widget_unset_state_flags" + (gobject-alien resizer) (C-enum "GTK_STATE_FLAG_PRELIGHT")))) (define (resizer-press-handler resizer type button modifiers x y) ;;; (declare (ignore type)) ;; 'press @@ -908,7 +838,7 @@ USA. (let ((intersect (let ((v (fix-layout-view widget))) (and (fix-rect-nominal? v) (window-intersection v extent))))) - (if (and intersect (not (gtk-object-destroyed? widget))) + (if (and intersect (not (gtk-widget-destroyed? widget))) (C-call "gtk_widget_queue_draw_area" (gobject-alien widget) (fix-rect-x intersect) (fix-rect-y intersect) @@ -924,13 +854,16 @@ USA. (and (fix-ink-in-widget? ink widget) (point-in-fix-rect? x y (fix-ink-extent ink)))))) -(define (drawing-expose drawing widget window area) +(define (drawing-expose drawing widget window cr area) ;; AREA is in drawing coords. (if (fix-rect-nominal? area) (for-each (lambda (ink) (if (fix-ink-in? ink widget area) - (fix-ink-expose-callback ink widget window area))) + (begin + (C-call "cairo_save" cr) + (fix-ink-draw-callback ink widget window cr area) + (C-call "cairo_restore" cr)))) (fix-drawing-display-list drawing)))) (define (fix-ink-in? ink widget area) @@ -945,11 +878,11 @@ USA. (or (eq? #t widgets) (memq widget widgets)))) -(define-generic fix-ink-expose-callback (ink widget window expose-area) +(define-generic fix-ink-draw-callback (ink widget window cr exposed-area) ;; Due to the checks in drawing-expose, methods of this generic can ;; assume expose-area and the ink's extent are intersecting, and INK ;; is visible in the WIDGET. Methods may also assume the widget is - ;; realized and its window's (gc's) clipping is already set. The + ;; realized and its window's cairo's clipping is already set. The ;; widget's scroll offset (view extent) is also set. ) @@ -1130,7 +1063,7 @@ USA. (set-draw-ink-options! ink (delq! entry options)) (set-cdr! entry value)) (set-draw-ink-options! ink (cons (cons name value) options))) - #t)))) + #t)))) (define-class ( (constructor ())) () @@ -1138,12 +1071,11 @@ USA. (define-guarantee line-ink "a ") -(define-method fix-ink-expose-callback ((ink ) widget window area) +(define-method fix-ink-draw-callback ((ink ) widget window cr area) (declare (ignore window area)) (%trace2 ";drawing "ink" on "widget"\n") (let ((view (fix-layout-view widget)) - (vector (line-ink-vector ink)) - (cr (gdk-cairo-create (fix-widget-window widget)))) + (vector (line-ink-vector ink))) (with-fix-rect vector (lambda (x y dx dy) @@ -1151,33 +1083,31 @@ USA. (y (fix:- y (fix-rect-y view)))) (C-call "cairo_move_to" cr (->flonum x) (->flonum y)) (C-call "cairo_rel_line_to" cr (->flonum dx) (->flonum dy))))) - (set-line-options! cr ink widget) - (let ((color (get-option ink 'DASH '()))) - (if (and color (not (null? color)) (not (eq? #t color))) + (set-line-options! cr ink) + (let ((color (get-option ink 'DASH-COLOR '()))) + (if (not (null? color)) (begin (C-call "cairo_save" cr) - (set-source-rgb cr color widget) + (set-source-rgba cr color) (C-call "cairo_stroke_preserve" cr) (C-call "cairo_restore" cr)))) (set-line-dashes! cr ink) - (C-call "cairo_stroke" cr) - (cairo-destroy cr))) - -(define-integrable (set-source-rgb cr color widget) - (let ((gdkcolor (allocate-color! widget color))) - (if gdkcolor - (C-call "cairo_set_source_rgb" cr - (flo:/ (->flonum (C-> gdkcolor "GdkColor red")) 65535.) - (flo:/ (->flonum (C-> gdkcolor "GdkColor green")) 65535.) - (flo:/ (->flonum (C-> gdkcolor "GdkColor blue")) 65535.))))) - -(define (set-line-options! cr ink widget) + (C-call "cairo_stroke" cr))) + +(define-integrable (set-source-rgba cr color) + (C-call "cairo_set_source_rgba" cr + (flo:vector-ref color 0) + (flo:vector-ref color 1) + (flo:vector-ref color 2) + (flo:vector-ref color 3))) + +(define (set-line-options! cr ink) (for-each (lambda (entry) (let ((name (car entry)) (value (cdr entry))) (case name - ((COLOR) (set-source-rgb cr value widget)) + ((COLOR) (set-source-rgba cr value)) ;;((LINE-CAP) ...) ;;((LINE-JOIN) ...) ;;((LINE-MITER-LIMIT) ...) @@ -1185,20 +1115,18 @@ USA. (draw-ink-options ink))) (define (set-line-dashes! cr ink) - (let* ((value (get-option ink 'DASH '())) - (dashes (if (and value (not (null? value))) '(5.) #f))) - (if dashes - (let* ((num (length dashes)) - (alien (malloc (fix:* num (C-sizeof "double")) - `(array double ,num))) - (scan (copy-alien alien))) + (let ((entry (assq 'DASHES (draw-ink-options ink)))) + (if entry + (let* ((num (length (cdr entry))) + (dashes (malloc (fix:* num (C-sizeof "double")) 'double)) + (scan (copy-alien dashes))) (for-each (lambda (len) (C->= scan "double" len) - (alien-byte-increment! scan (C-sizeof "double") 'double)) - dashes) - (C-call "cairo_set_dash" cr alien num 0) - (free alien))))) + (alien-byte-increment! scan (C-sizeof "double"))) + (cdr entry)) + (C-call "cairo_set_dash" cr dashes num 0) + (free dashes))))) (define-integrable (half-line-width ink) (fix:max 1 (fix:1+ (floor->exact (quotient (get-option ink 'LINE-WIDTH 1.) @@ -1263,34 +1191,58 @@ USA. (if (set-option!? ink 'LINE-WIDTH (->flonum width)) (recache-line-extent! ink))))) -(define-integrable (guarantee-color-spec spec operator) - (cond ((string? spec) spec) - ((and (vector? spec) (fix:= (vector-length spec) 3)) spec) - (else (error:wrong-type-argument spec "a color" operator)))) - (define (line-ink-color ink) (guarantee-line-ink ink 'line-ink-color) (get-option ink 'COLOR '())) (define (set-line-ink-color! ink color) (guarantee-line-ink ink 'set-line-ink-color!) - (guarantee-color-spec color 'set-line-ink-color!) - (without-interrupts - (lambda () - (if (set-option!? ink 'COLOR color) - (drawing-damage ink))))) + (let ((color (->color color 'set-line-ink-color!))) + (without-interrupts + (lambda () + (if (set-option!? ink 'COLOR color) + (drawing-damage ink)))))) + +(define (->color spec operator) + (cond ((color? spec) spec) + ((string? spec) + (let ((rgba (malloc (C-sizeof "GdkRGBA") '|GdkRGBA|))) + (if (zero? (C-call "gdk_rgba_parse" rgba spec)) + (error:wrong-type-argument spec "a color spec" operator) + (let ((color (make-color))) + (set-color-red! color (C-> rgba "GdkRGBA red")) + (set-color-green! color (C-> rgba "GdkRGBA green")) + (set-color-blue! color (C-> rgba "GdkRGBA blue")) + (set-color-alpha! color (C-> rgba "GdkRGBA alpha")) + (free rgba) + color)))) + (else + (error:wrong-type-argument spec "a color spec" operator)))) (define (line-ink-dash-color ink) (guarantee-line-ink ink 'line-ink-dash-color) - (get-option ink 'DASH '())) + (get-option ink 'DASH-COLOR '())) (define (set-line-ink-dash-color! ink color) (guarantee-line-ink ink 'set-line-ink-dash-color!) - (if (not (or (eq? color #t) (eq? color #f))) - (guarantee-color-spec color 'set-line-ink-dash-color!)) + (let ((color (cond ((eq? color '()) '()) + (else (->color color 'set-line-ink-dash-color!))))) + (without-interrupts + (lambda () + (if (set-option!? ink 'DASH-COLOR color) + (drawing-damage ink)))))) + +(define (line-ink-dashes ink) + (guarantee-line-ink ink 'line-ink-dash-color) + (get-option ink 'DASHES '())) + +(define (set-line-ink-dashes! ink lengths) + (guarantee-line-ink ink 'set-line-ink-dashes!) + (guarantee-list-of-type lengths flo:flonum? + "list of flonums" 'set-line-ink-dashes!) (without-interrupts (lambda () - (if (set-option!? ink 'DASH color) + (if (set-option!? ink 'DASHES lengths) (drawing-damage ink))))) (define-class ( (constructor ())) @@ -1299,7 +1251,8 @@ USA. (define-guarantee rectangle-ink "a ") -(define-method fix-ink-expose-callback ((ink ) widget window area) +(define-method fix-ink-draw-callback ((ink ) + widget window cr area) (declare (ignore window area)) (%trace2 ";drawing "ink" on "widget"\n") (let ((view (fix-layout-view widget)) @@ -1308,8 +1261,7 @@ USA. rect (lambda (x y width height) (let ((x (fix:- x (fix-rect-x view))) - (y (fix:- y (fix-rect-y view))) - (cr (gdk-cairo-create (fix-widget-window widget)))) + (y (fix:- y (fix-rect-y view)))) (C-call "cairo_rectangle" cr (->flonum x) (->flonum y) (->flonum width) (->flonum height)) @@ -1317,34 +1269,34 @@ USA. (if (not (null? fill)) (begin (C-call "cairo_save" cr) - (set-fill-options! cr ink widget) + (set-fill-options! cr ink) (C-call "cairo_fill_preserve" cr) (C-call "cairo_restore" cr)))) (let ((outline (get-option ink 'OUTLINE '()))) (if (not (null? outline)) (begin - (set-outline-options! cr ink widget) - (C-call "cairo_stroke" cr)))) - (cairo-destroy cr)))))) + (set-outline-options! cr ink) + (C-call "cairo_stroke" cr))))))))) -(define (set-fill-options! cr ink widget) +(define (set-fill-options! cr ink) ;; For filling ovals, rectangles... (for-each (lambda (entry) (let ((name (car entry)) (value (cdr entry))) (case name - ((FILL) (set-source-rgb cr value widget))))) + ((FILL) (set-source-rgba cr value))))) (draw-ink-options ink))) -(define (set-outline-options! cr ink widget) +(define (set-outline-options! cr ink) (for-each (lambda (entry) (let ((name (car entry)) (value (cdr entry))) (case name - ((OUTLINE) (set-source-rgb cr value widget)) - ((LINE-WIDTH) (C-call "cairo_set_line_width" cr value))))) + ((OUTLINE) (set-source-rgba cr value)) + ((LINE-WIDTH) (C-call "cairo_set_line_width" cr value)) + ((DASHES) (set-line-dashes! cr ink))))) (draw-ink-options ink))) (define (recache-rectangle-extent! ink) @@ -1404,11 +1356,11 @@ USA. (define (set-rectangle-ink-color! ink color) (guarantee-rectangle-ink ink 'set-rectangle-ink-color!) - (guarantee-color-spec color 'set-rectangle-ink-color!) - (without-interrupts - (lambda () - (if (set-option!? ink 'OUTLINE color) - (drawing-damage ink))))) + (let ((color (->color color 'set-rectangle-ink-color!))) + (without-interrupts + (lambda () + (if (set-option!? ink 'OUTLINE color) + (drawing-damage ink)))))) (define (rectangle-ink-fill-color ink) (guarantee-rectangle-ink ink 'rectangle-ink-fill-color) @@ -1416,11 +1368,11 @@ USA. (define (set-rectangle-ink-fill-color! ink color) (guarantee-rectangle-ink ink 'set-rectangle-ink-fill-color!) - (guarantee-color-spec color 'set-rectangle-ink-fill-color!) - (without-interrupts - (lambda () - (if (set-option!? ink 'FILL color) - (drawing-damage ink))))) + (let ((color (->color color 'set-rectangle-ink-fill-color!))) + (without-interrupts + (lambda () + (if (set-option!? ink 'FILL color) + (drawing-damage ink)))))) (define-integrable flo:pi (flo:* 4. (flo:atan2 1. 1.))) @@ -1432,7 +1384,7 @@ USA. (define-guarantee arc-ink "an ") -(define-method fix-ink-expose-callback ((ink ) widget window area) +(define-method fix-ink-draw-callback ((ink ) widget window cr area) (declare (ignore window area)) (%trace2 ";drawing "ink" on "widget"\n") (let ((view (fix-layout-view widget)) @@ -1446,8 +1398,7 @@ USA. (height. (->flonum height)) (start. (arc-ink-%start-angle ink)) (end. (flo:+ (arc-ink-%start-angle ink) - (arc-ink-%sweep-angle ink))) - (cr (gdk-cairo-create (fix-widget-window widget)))) + (arc-ink-%sweep-angle ink)))) (C-call "cairo_save" cr) (C-call "cairo_translate" cr (flo:+ x. (flo:/ width. 2.)) @@ -1458,14 +1409,13 @@ USA. (let ((fill (get-option ink 'FILL '()))) (if (not (null? fill)) (begin - (set-fill-options! cr ink widget) + (set-fill-options! cr ink) (C-call "cairo_fill_preserve" cr)))) (let ((outline (get-option ink 'OUTLINE '()))) (if (not (null? outline)) (begin - (set-outline-options! cr ink widget) - (C-call "cairo_stroke" cr)))) - (cairo-destroy cr)))))) + (set-outline-options! cr ink) + (C-call "cairo_stroke" cr))))))))) (define (recache-arc-extent! ink) (with-fix-rect-bounds @@ -1550,11 +1500,11 @@ USA. (define (set-arc-ink-color! ink color) (guarantee-arc-ink ink 'set-arc-ink-color!) - (guarantee-color-spec color 'set-arc-ink-color!) - (without-interrupts - (lambda () - (if (set-option!? ink 'OUTLINE color) - (drawing-damage ink))))) + (let ((color (->color color 'set-arc-ink-color!))) + (without-interrupts + (lambda () + (if (set-option!? ink 'OUTLINE color) + (drawing-damage ink)))))) (define (arc-ink-fill-color ink) (guarantee-arc-ink ink 'arc-ink-fill-color) @@ -1562,11 +1512,11 @@ USA. (define (set-arc-ink-fill-color! ink color) (guarantee-arc-ink ink 'set-arc-ink-fill-color!) - (guarantee-color-spec color 'set-arc-ink-fill-color!) - (without-interrupts - (lambda () - (if (set-option!? ink 'FILL color) - (drawing-damage ink))))) + (let ((color (->color color 'set-arc-ink-fill-color!))) + (without-interrupts + (lambda () + (if (set-option!? ink 'FILL color) + (drawing-damage ink)))))) (define-class ( (constructor ())) ()) @@ -1575,7 +1525,7 @@ USA. (define-generic text-ink-pango-layout (ink)) -(define-method fix-ink-expose-callback ((ink ) widget window area) +(define-method fix-ink-draw-callback ((ink ) widget window cr area) (declare (ignore window area)) (%trace2 ";drawing "ink" on "widget"\n") (let ((layout (text-ink-pango-layout ink))) @@ -1583,20 +1533,18 @@ USA. (let ((view (fix-layout-view widget)) (rect (fix-ink-extent ink))) (let ((x (fix:- (fix-rect-x rect) (fix-rect-x view))) - (y (fix:- (fix-rect-y rect) (fix-rect-y view))) - (cr (gdk-cairo-create (fix-widget-window widget)))) - (set-text-options! cr ink widget) + (y (fix:- (fix-rect-y rect) (fix-rect-y view)))) + (set-text-options! cr ink) (C-call "cairo_move_to" cr (->flonum x) (->flonum y)) - (C-call "pango_cairo_show_layout" cr (gobject-alien layout)) - (cairo-destroy cr)))))) + (C-call "pango_cairo_show_layout" cr (gobject-alien layout))))))) -(define (set-text-options! cr ink widget) +(define (set-text-options! cr ink) (for-each (lambda (entry) (let ((name (car entry)) (value (cdr entry))) (case name - ((COLOR) (set-source-rgb cr value widget))))) + ((COLOR) (set-source-rgba cr value))))) (draw-ink-options ink))) (define (set-text-ink-position! ink x y) @@ -1636,11 +1584,11 @@ USA. (define (set-text-ink-color! ink color) (guarantee-text-ink ink 'set-text-ink-color!) - (guarantee-color-spec color 'set-text-ink-color!) - (without-interrupts - (lambda () - (if (set-option!? ink 'COLOR color) - (drawing-damage ink))))) + (let ((color (->color color 'set-text-ink-color!))) + (without-interrupts + (lambda () + (if (set-option!? ink 'COLOR color) + (drawing-damage ink)))))) (define (text-ink-xy-to-index ink x y) (let ((layout (text-ink-pango-layout ink))) @@ -1799,7 +1747,7 @@ USA. ;; input-port, for debugging purposes. unspecific)))) -(define-method fix-ink-expose-callback ((ink ) widget window area) +(define-method fix-ink-draw-callback ((ink ) widget window cr area) (declare (ignore window area)) (%trace2 ";drawing "ink" on "widget"\n") @@ -1807,13 +1755,11 @@ USA. (if p (gobject-alien p) #f)))) (if (and pixbuf (not (alien-null? pixbuf))) (let ((view (fix-layout-view widget)) - (extent (fix-ink-extent ink)) - (cr (gdk-cairo-create (fix-widget-window widget)))) + (extent (fix-ink-extent ink))) (let ((x. (->flonum (fix:- (fix-rect-x extent) (fix-rect-x view)))) (y. (->flonum (fix:- (fix-rect-y extent) (fix-rect-y view))))) (C-call "gdk_cairo_set_source_pixbuf" cr pixbuf x. y.) - (C-call "cairo_paint" cr) - (cairo-destroy cr)))))) + (C-call "cairo_paint" cr)))))) (define-method fix-ink-move! ((ink ) dx dy) (generic-fix-ink-move! ink dx dy)) @@ -1828,7 +1774,7 @@ USA. (guarantee-fixnum y 'set-image-ink-position!) (set-fix-ink-%position! ink x y)) -;;; Inks implemented by gtk_paint_*, using widget style/state. +;;; Inks implemented by gtk_render_*, using widget style/state. (define-class ( (constructor ())) () @@ -1836,21 +1782,18 @@ USA. ;; etc. do not drop ink beyond the ink-extent. (%shadow define standard initial-value (C-enum "GTK_SHADOW_NONE"))) -(define-method fix-ink-expose-callback ((ink ) widget window area) - (declare (ignore area)) +(define-method fix-ink-draw-callback ((ink ) widget window cr area) + (declare (ignore window area)) (%trace2 ";drawing "ink" on "widget"\n") - (let ((alien (gobject-alien widget)) - (view (fix-layout-view widget)) - (extent (fix-ink-extent ink))) - (let ((style (C-> alien "GtkWidget style")) - (state (C-> alien "GtkWidget state"))) - (C-call "gtk_paint_box" - style window state (C-enum "GTK_SHADOW_NONE") - 0 alien 0 ;area widget detail - (fix:- (fix-rect-x extent) (fix-rect-x view)) - (fix:- (fix-rect-y extent) (fix-rect-y view)) - (fix-rect-width extent) - (fix-rect-height extent))))) + (let ((view (fix-layout-view widget)) + (extent (fix-ink-extent ink)) + (style (widget-style-context widget))) + (let ((x (->flonum (fix:- (fix-rect-x extent) (fix-rect-x view)))) + (y (->flonum (fix:- (fix-rect-y extent) (fix-rect-y view)))) + (width (->flonum (fix-rect-width extent))) + (height (->flonum (fix-rect-height extent)))) + (C-call "gtk_render_background" style cr x y width height) + (C-call "gtk_render_frame" style cr x y width height)))) (define-method fix-ink-move! ((ink ) dx dy) (generic-fix-ink-move! ink dx dy)) @@ -1866,53 +1809,6 @@ USA. (guarantee-fixnum x 'set-box-ink!) (guarantee-fixnum y 'set-box-ink!) (set-fix-ink-%position! ink x y)) - -(define (box-ink-shadow ink) - (let ((shadow (box-ink-%shadow ink))) - (cond - ((int:= shadow (C-enum "GTK_SHADOW_NONE")) 'NONE) - ((int:= shadow (C-enum "GTK_SHADOW_IN")) 'IN) - ((int:= shadow (C-enum "GTK_SHADOW_OUT")) 'OUT) - ((int:= shadow (C-enum "GTK_SHADOW_ETCHED_IN")) 'ETCHED-IN) - ((int:= shadow (C-enum "GTK_SHADOW_ETCHED_OUT")) 'ETCHED-OUT) - (else (error "Invalid box-ink %shadow:" shadow))))) - -(define (set-box-ink-shadow! ink type) - (let ((new - (case type - ((NONE) (C-enum "GTK_SHADOW_NONE")) - ((IN) (C-enum "GTK_SHADOW_IN")) - ((OUT) (C-enum "GTK_SHADOW_OUT")) - ((ETCHED-IN) (C-enum "GTK_SHADOW_ETCHED_IN")) - ((ETCHED-OUT) (C-enum "GTK_SHADOW_ETCHED_OUT")) - (else (error:bad-range-argument type 'set-box-ink-shadow!))))) - (if (not (fix:= new (box-ink-%shadow ink))) - (begin - (set-box-ink-%shadow! ink new) - ;; Depending on the shadow type, adjust the inked extent?!!! - (drawing-damage ink))))) - -;; Punting the rest of gtk_paint_* until style members like -;; x/ythickness can be accounted for in the fix-ink-extent. - -#;(define-class ( (constructor ())) - ()) - -#;(define-method fix-ink-expose-callback ((ink ) widget window area) - (declare (ignore area)) - (%trace2 ";drawing "ink" on "widget"\n") - (let ((alien (gobject-alien widget)) - (view (fix-layout-view widget)) - (extent (fix-ink-extent ink))) - (let ((style (C-> alien "GtkWidget style")) - (state (C-> alien "GtkWidget state")) - (x (fix:- (fix-rect-x extent) (fix-rect-x view))) - (y (fix:- (fix-rect-y extent) (fix-rect-y view)))) - (C-call "gtk_paint_hline" - style window state - 0 alien 0 ;area widget detail - x (fix:+ x (fix-rect-width extent)) - y)))) ;;;; Fixnum Rectangles diff --git a/src/gtk/gtk-ev.scm b/src/gtk/gtk-ev.scm index ca93eb615..c72b10400 100644 --- a/src/gtk/gtk-ev.scm +++ b/src/gtk/gtk-ev.scm @@ -2,7 +2,7 @@ Copyright (C) 2007, 2008, 2009, 2011, 2012 Matthew Birkholz -This file is part of MIT/GNU Scheme. +This file is part of an extension to MIT/GNU Scheme. MIT/GNU Scheme is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by @@ -60,13 +60,14 @@ USA. (define-method initialize-instance ((widget )) (call-next-method widget) - (%trace ";\t(initialize-instance ) "widget")...\n") + (%trace ";\t(initialize-instance ) "widget"\n") (let ((alien (gobject-alien widget))) (C-call "gtk_widget_set_has_window" alien 1) (C-call "gtk_widget_set_can_focus" alien 1)) (set-gtk-widget-size-allocate-callback! widget size-allocate-callback) (set-gtk-widget-realize-callback! widget realize-callback) (set-gtk-widget-unrealize-callback! widget unrealize-callback) + (set-gtk-widget-draw-callback! widget draw-callback) (set-gtk-widget-event-callback! widget event-callback)) (define (realize-callback widget) @@ -76,8 +77,7 @@ USA. (main-GdkWindow (gtk-event-viewer-window widget)) (event-GdkWindow (gtk-event-viewer-event-window widget)) (parent-GdkWindow (make-alien '|GdkWindow|)) - (GdkCursor (make-alien '|GdkCursor|)) - (GtkStyle (make-alien '(struct |_GtkStyle|)))) + (GdkCursor (make-alien '|GdkCursor|))) ;; Main widget window. (C->= attr "GdkWindowAttr window_type" (C-enum "GDK_WINDOW_CHILD")) @@ -118,18 +118,19 @@ USA. (error-if-null event-GdkWindow "Could not create event window:" widget) (C-call "gdk_window_set_user_data" event-GdkWindow alien) (C-call "gdk_window_show" event-GdkWindow) - (C-call "gdk_cursor_unref" GdkCursor) - - ;; Style - (C-call "gtk_style_attach" GtkStyle - (C-> alien "GtkWidget style") main-GdkWindow) - (C->= alien "GtkWidget style" GtkStyle) - (C-call "gtk_style_set_background" - GtkStyle main-GdkWindow (C-enum "GTK_STATE_NORMAL")) - (C-call "gdk_window_set_background" - event-GdkWindow - (C-array-loc! (C-> GtkStyle "struct _GtkStyle base") - "GdkColor" (C-enum "GTK_STATE_NORMAL"))) + (C-call "g_object_unref" GdkCursor) + + #;(let ((style (gtk-widget-style-context widget))) + (C-call "gtk_style_context_add_class" style "view?") + (C-call "gtk_style_context_set_background" style event-GdkWindow)) + (let ((rgba (malloc (C-sizeof "GdkRGBA") '|GdkRGBA|))) + (C->= rgba "GdkRGBA red" 1.0) + (C->= rgba "GdkRGBA green" 1.0) + (C->= rgba "GdkRGBA blue" 1.0) + (C->= rgba "GdkRGBA alpha" 1.0) + (C-call "gdk_window_set_background_rgba" event-GdkWindow rgba) + (free rgba)) + unspecific)) (define (unrealize-callback widget) @@ -145,12 +146,13 @@ USA. unspecific) (define (size-allocate-callback widget GtkAllocation) - (%trace2 ";size-allocate "widget" "GtkAllocation"\n") + (%trace2 ";size-allocate "widget"\n") (let ((x (C-> GtkAllocation "GtkAllocation x")) (y (C-> GtkAllocation "GtkAllocation y")) (width (C-> GtkAllocation "GtkAllocation width")) (height (C-> GtkAllocation "GtkAllocation height")) (spacing 10)) + (%trace2 ";\t"x","y" "width"x"height"\n") (set-fix-rect! (gtk-event-viewer-geometry widget) x y width height) (let ((event-width (max (- width (* 2 spacing)) 0)) (event-height (max (- (quotient height 5) spacing) 0))) @@ -182,108 +184,88 @@ USA. (%trace "; "(C-enum "GdkEventType" type) " on window 0x"(alien/address-string window)".\n") - (if (not (and (alien=? window (gtk-event-viewer-window widget)) - (= type (C-enum "GDK_EXPOSE")))) - (push-text widget (event-to-text GdkEvent))) + (push-text widget (event-to-text GdkEvent)) - (if (= type (C-enum "GDK_EXPOSE")) - (expose-handler widget GdkEvent) - (begin - (if (and (= type (C-enum "GDK_KEY_PRESS")) - (= (C-> GdkEvent "GdkEvent key keyval") (C-enum "GDK_KEY_D"))) - ;; Test debugging in a callback. - (bkpt 'Test)) - - (if (= type (C-enum "GDK_MOTION_NOTIFY")) - (C-call "gdk_window_get_pointer" #f - (C-> GdkEvent "GdkEventMotion window") 0 0 0)) - 0 ;;FALSE -- not handled. - )))) - -(define (expose-handler widget GdkEventExpose) - (let ((window (C-> GdkEventExpose "GdkEventExpose window")) - (x (C-> GdkEventExpose "GdkEventExpose area x")) - (y (C-> GdkEventExpose "GdkEventExpose area y")) - (width (C-> GdkEventExpose "GdkEventExpose area width")) - (height (C-> GdkEventExpose "GdkEventExpose area height"))) - (%trace "; Expose "x","y" "width"x"height"\n") - (cond ((alien=? (gtk-event-viewer-window widget) window) - (paint-window widget x y width height)) - ((alien=? (gtk-event-viewer-event-window widget) window) - (paint-event-window widget x y width height)) - (else (error "gtk-event-viewer-expose: unexpected window:" window)))) - 1 ;;TRUE -- handled. - ) - -(define (paint-window widget x y width height) - (%trace2 ";(paint-window "widget" "x" "y" "width" "height")\n") + (if (and (= type (C-enum "GDK_KEY_PRESS")) + (= (C-> GdkEvent "GdkEvent key keyval") (C-enum "GDK_KEY_D"))) + ;; Test debugging in a callback. + (bkpt 'Test)) + + (if (= type (C-enum "GDK_MOTION_NOTIFY")) + (C-call "gdk_window_get_pointer" #f + (C-> GdkEvent "GdkEventMotion window") 0 0 0)) + 0 ;;FALSE -- continue handling. + )) + +(define (draw-callback widget cr) + (%trace "; Draw "widget"\n") + (paint-event-window widget cr) + (paint-window widget cr) + 1 ;;TRUE -- handled. + ) + +(define (paint-window widget cr) + (%trace2 ";(paint-window "widget" "cr")\n") (let ((alien (gobject-alien widget)) - (cr (gdk-cairo-create (gtk-event-viewer-window widget)))) - - ;; Draw a black rectangle around the event window. - (let ((box (gtk-event-viewer-event-box widget))) - (C-call "cairo_rectangle" cr - (->flonum (-1+ (fix-rect-x box))) - (->flonum (-1+ (fix-rect-y box))) - (->flonum (+ 2 (fix-rect-width box))) - (->flonum (+ 2 (fix-rect-height box)))) - (C-call "cairo_stroke" cr)) - - ;; Draw text in the description area. + (style (make-alien '|GtkStyleContext|)) + (event-box (gtk-event-viewer-event-box widget))) + + (C-call "cairo_rectangle" cr + (->flonum (-1+ (fix-rect-x event-box))) + (->flonum (-1+ (fix-rect-y event-box))) + (->flonum (+ 2 (fix-rect-width event-box))) + (->flonum (+ 2 (fix-rect-height event-box)))) + (C-call "cairo_stroke" cr) + + (C-call "gtk_widget_get_style_context" style alien) + + (if (gtk-widget-has-focus? widget) + (C-call "gtk_render_focus" style cr + (->flonum (fix:- (fix-rect-x event-box) 5)) + (->flonum (fix:- (fix-rect-y event-box) 5)) + (->flonum (fix:+ (fix-rect-width event-box) 10)) + (->flonum (fix:+ (fix-rect-height event-box) 10)))) + (if (gtk-event-viewer-buffer widget) (let ((descrip-box (gtk-event-viewer-description-box widget))) - (let ((space 2)) - (let ((desc-bottom (fix-rect-max-y descrip-box))) - (let ((layout (make-alien '|PangoLayout|))) - (C-call "cairo_rectangle" cr - (->flonum (fix-rect-x descrip-box)) - (->flonum (fix-rect-y descrip-box)) - (->flonum (fix-rect-width descrip-box)) - (->flonum (fix-rect-height descrip-box))) - (C-call "cairo_clip" cr) - (C-call "gtk_widget_create_pango_layout" layout alien 0) - (let loop ((y (fix-rect-y descrip-box)) - (lines (gtk-event-viewer-buffer widget))) - (if (null? lines) - unspecific - (let ((line (car lines)) - (iter (make-alien '|PangoLayoutIter|))) - (C-call "pango_layout_set_text" layout line -1) - (C-call "pango_layout_get_iter" iter layout) - (let ((baseline - (pangos->pixels - (C-call "pango_layout_iter_get_baseline" - iter)))) - (C-call "cairo_move_to" cr (->flonum 10) (->flonum y)) - (C-call "pango_cairo_show_layout" cr layout) - (C-call "pango_layout_iter_free" iter) - (alien-null! iter) - (let ((new-y (+ y (+ baseline space)))) - (if (> new-y desc-bottom) - (begin - (set-cdr! lines '()) - unspecific) - (loop new-y (cdr lines)))))))) - (C-call "g_object_unref" layout)))))) - (cairo-destroy cr) - - ;; Draw a focus indicator around the event window. - (if (gtk-widget-has-focus? widget) - (let ((window (gtk-event-viewer-window widget)) - (box (gtk-event-viewer-event-box widget)) - (style (C-> alien "GtkWidget style")) - (state (C-> alien "GtkWidget state"))) - (C-call "gtk_paint_focus" - style window state 0 alien "gtk-event-viewer" - (- (fix-rect-x box) 5) - (- (fix-rect-y box) 5) - (+ (fix-rect-width box) 10) - (+ (fix-rect-height box) 10)))))) - -(define (paint-event-window widget x y width height) - (%trace2 ";(paint-event-window "widget" "x" "y" "width" "height")\n") + (let ((desc-bottom (fix-rect-max-y descrip-box)) + (space 2) + (layout (make-alien '|PangoLayout|))) + (C-call "gtk_widget_create_pango_layout" layout alien 0) + (C-call "cairo_rectangle" cr + (->flonum (fix-rect-x descrip-box)) + (->flonum (fix-rect-y descrip-box)) + (->flonum (fix-rect-width descrip-box)) + (->flonum (fix-rect-height descrip-box))) + (C-call "cairo_clip" cr) + (let loop ((y (fix-rect-y descrip-box)) + (lines (gtk-event-viewer-buffer widget))) + (if (null? lines) + unspecific + (let ((line (car lines)) + (iter (make-alien '|PangoLayoutIter|))) + (C-call "pango_layout_set_text" layout line -1) + (C-call "pango_layout_get_iter" iter layout) + (let ((baseline + (pangos->pixels + (C-call "pango_layout_iter_get_baseline" + iter)))) + (C-call "pango_layout_iter_free" iter) + (C-call "cairo_move_to" cr 10. (->flonum y)) + (alien-null! iter) + (C-call "gtk_render_layout" style cr + 10. (->flonum y) layout) + (let ((new-y (fix:+ y (fix:+ baseline space)))) + (if (fix:> new-y desc-bottom) + (begin + (set-cdr! lines '()) + unspecific) + (loop new-y (cdr lines)))))))) + (C-call "g_object_unref" layout)))))) + +(define (paint-event-window widget cr) + (%trace2 ";(paint-event-window "widget" "cr")\n") (let* ((event-window (gtk-event-viewer-event-window widget)) - (cr (gdk-cairo-create event-window)) (extent (pango-rectangle)) (layout (make-alien '|PangoLayout|)) (title (string-append "Event Window (0x" @@ -297,11 +279,10 @@ USA. (quotient (- (fix-rect-width (gtk-event-viewer-event-box widget)) (C-> extent "PangoRectangle width")) 2)) - 0.) + 10.) (C-call "pango_cairo_show_layout" cr layout) (C-call "g_object_unref" layout) (free extent) - (cairo-destroy cr) unspecific)) (define (push-text ev lines) @@ -393,14 +374,7 @@ USA. (define (event-detail-line GdkEvent) (let ((type (C-> GdkEvent "GdkEvent any type"))) - (cond ((= type (C-enum "GDK_EXPOSE")) - (let ((x (C-> GdkEvent "GdkEvent expose area x")) - (y (C-> GdkEvent "GdkEvent expose area y")) - (width (C-> GdkEvent "GdkEvent expose area width")) - (height (C-> GdkEvent "GdkEvent expose area height")) - (count (C-> GdkEvent "GdkEvent expose count"))) - (cat "Area: "x","y" "width"x"height" Count: "count"\n"))) - ((= type (C-enum "GDK_MOTION_NOTIFY")) + (cond ((= type (C-enum "GDK_MOTION_NOTIFY")) (let ((x (C-> GdkEvent "GdkEvent motion x")) (y (C-> GdkEvent "GdkEvent motion y"))) (cat "x: "x" y: "y"\n"))) diff --git a/src/gtk/gtk-shim.h b/src/gtk/gtk-shim.h index b4fda5ae6..3949d085b 100644 --- a/src/gtk/gtk-shim.h +++ b/src/gtk/gtk-shim.h @@ -1,8 +1,8 @@ /* -*-C-*- -Copyright (C) 2007, 2008, 2009, 2010, 2011 Matthew Birkholz +Copyright (C) 2007, 2008, 2009, 2010, 2011, 2012 Matthew Birkholz -This file is part of MIT/GNU Scheme. +This file is part of an extension to MIT/GNU Scheme. MIT/GNU Scheme is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by @@ -23,31 +23,15 @@ USA. /* Header for gtk-shim.c, gtk-const.c and scmwidget.c. */ -#include -#include -#include -#include +#define GTK_DISABLE_SINGLE_INCLUDES 1 +#define GDK_DISABLE_DEPRECATED 1 +#define GTK_DISABLE_DEPRECATED 1 +#define GSEAL_ENABLE 1 -#define GTK_TYPE_SCMWIDGET (scm_widget_get_type ()) -#define GTK_SCMWIDGET(obj) (G_TYPE_CHECK_INSTANCE_CAST ((obj), GTK_TYPE_SCMWIDGET, ScmWidget)) -#define GTK_IS_SCMWIDGET(obj) (G_TYPE_CHECK_INSTANCE_TYPE ((obj), GTK_TYPE_SCMWIDGET)) +#include +#include "scmwidget.h" typedef unsigned int uint; -typedef struct _ScmWidgetClass ScmWidgetClass; -typedef struct _ScmWidget ScmWidget; - -struct _ScmWidgetClass -{ - GtkWidgetClass parent_class; -}; - -struct _ScmWidget -{ - GtkWidget widget; -}; - -extern GtkWidget* scm_widget_new (void); - extern gboolean start_gtk (int *argc, char ***argv); extern void stop_gtk (void); extern void run_gtk (unsigned long registry, double time); diff --git a/src/gtk/gtk-object.scm b/src/gtk/gtk-widget.scm similarity index 70% rename from src/gtk/gtk-object.scm rename to src/gtk/gtk-widget.scm index 71136da23..8604f62f7 100644 --- a/src/gtk/gtk-object.scm +++ b/src/gtk/gtk-widget.scm @@ -1,8 +1,8 @@ #| -*-Scheme-*- -Copyright (C) 2007, 2008, 2009, 2010, 2011 Matthew Birkholz +Copyright (C) 2007, 2008, 2009, 2010, 2011, 2012 Matthew Birkholz -This file is part of MIT/GNU Scheme. +This file is part of an extension to MIT/GNU Scheme. MIT/GNU Scheme is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by @@ -21,61 +21,10 @@ USA. |# -;;;; GtkObjects/GtkWidgets/GtkContainers -;;; package: (gtk gtk-object) +;;;; GtkWidgets/GtkContainers +;;; package: (gtk gtk-widget) -(define-class () - (destroyed? define standard initial-value #f)) - -(define-guarantee gtk-object "a ") - -;;; This is unfortunate. We rely on the most specialized method to -;;; call out, creating a specific type of GtkObject. We want the -;;; method to go first, as usual, to add a gc-cleanup, but -;;; this method to go last, AFTER the most specific (most unusual!) -;;; else it cannot connect its destroy-callback. To do both would -;;; take... a computed effective method procedure? For now, rely on -;;; the method that calls out to set-gtk-object-destroy-callback! as -;;; well as g_object_ref_sink. - -#;(define-method initialize-instance ((object )) - (call-next-method object) - (g-signal-connect object (C-callback "destroy") gtk-object-destroy-callback)) - -(define (set-gtk-object-destroy-callback! object) - (g-signal-connect object (C-callback "destroy") gtk-object-destroy-callback)) - -;;; Methods of this generic procedure should drop references to other -;;; gobject instances used by @var{object}. If these instances are -;;; not shared, they can be explicitly g-object-unref!ed. Else they -;;; should be dropped, e.g. replaced with #f, to be cleaned up by the -;;; garbage collector. -(define-generic gtk-object-destroy-callback (object)) - -(define-method gtk-object-destroy-callback ((object )) - (if (not (gtk-object-destroyed? object)) - (begin - (set-gtk-object-destroyed?! object #t) - (gobject-unref! object)))) - -(define (gtk-object-destroy object) - (guarantee-live-gtk-object object 'gtk-object-destroy) - (C-call "gtk_object_destroy" (gobject-alien object))) - -(define-integrable-operator (guarantee-live-gtk-object object operator) - (guarantee-gtk-object object operator) - (if (gtk-object-destroyed? object) - (error "Gtk-object destroyed:" object operator)) - (if (not (gobject-live? object)) - (error "Gtk-object dead:" object operator))) - -(define (gtk-object-flags object) - ;; Returns GTK_OBJECT(object)->flags. - (C-> (gobject-alien object) "GtkObject flags")) - -;;; GtkAdjustments - -(define-class ( (constructor ())) ()) +(define-class ( (constructor ())) ()) (define-guarantee gtk-adjustment "a ") @@ -101,24 +50,27 @@ USA. (new-page-size (f->e page-size)) (new-step-incr (f->e step-incr)) (new-page-incr (f->e page-incr))) - (let ((old-lower (f->e (C-> alien "GtkAdjustment lower"))) - (old-upper (f->e (C-> alien "GtkAdjustment upper"))) - (old-value (f->e (C-> alien "GtkAdjustment value"))) - (old-page-size (f->e (C-> alien "GtkAdjustment page_size"))) - (old-step-incr (f->e (C-> alien "GtkAdjustment step_increment"))) - (old-page-incr (f->e (C-> alien "GtkAdjustment page_increment")))) + (let ((old-lower (f->e (C-call "gtk_adjustment_get_lower" alien))) + (old-upper (f->e (C-call "gtk_adjustment_get_upper" alien))) + (old-value (f->e (C-call "gtk_adjustment_get_value" alien))) + (old-page-size (f->e (C-call "gtk_adjustment_get_page_size" alien))) + (old-step-incr (f->e (C-call "gtk_adjustment_get_step_increment" alien))) + (old-page-incr (f->e (C-call "gtk_adjustment_get_page_increment" alien)))) (if (not (int:= new-lower old-lower)) - (C->= alien "GtkAdjustment lower" new-lower)) + (C-call "gtk_adjustment_set_lower" (->flonum new-lower))) (if (not (int:= new-upper old-upper)) - (C->= alien "GtkAdjustment upper" new-upper)) + (C-call "gtk_adjustment_set_upper" alien (->flonum new-upper))) (if (not (int:= new-value old-value)) - (C->= alien "GtkAdjustment value" new-value)) + (C-call "gtk_adjustment_set_value" alien (->flonum new-value))) (if (not (int:= new-page-size old-page-size)) - (C->= alien "GtkAdjustment page_size" new-page-size)) + (C-call "gtk_adjustment_set_page_size" + alien (->flonum new-page-size))) (if (not (int:= new-step-incr old-step-incr)) - (C->= alien "GtkAdjustment step_increment" new-step-incr)) + (C-call "gtk_adjustment_set_step_increment" + alien (->flonum new-step-incr))) (if (not (int:= new-page-incr old-page-incr)) - (C->= alien "GtkAdjustment page_increment" new-page-incr)) + (C-call "gtk_adjustment_set_page_increment" + alien (->flonum new-page-incr))) (if (or (not (int:= new-lower old-lower)) (not (int:= new-upper old-upper)) (not (int:= new-page-size old-page-size)) @@ -131,43 +83,76 @@ USA. (define (peek-gtk-adjustment adjustment) ;; For debugging... (list - (C-> adjustment "GtkAdjustment lower") - (C-> adjustment "GtkAdjustment upper") - (C-> adjustment "GtkAdjustment value") - (C-> adjustment "GtkAdjustment page_size") - (C-> adjustment "GtkAdjustment step_increment") - (C-> adjustment "GtkAdjustment page_increment"))) + (C-call "gtk_adjustment_get_lower" adjustment) + (C-call "gtk_adjustment_get_upper" adjustment) + (C-call "gtk_adjustment_get_value" adjustment) + (C-call "gtk_adjustment_get_page_size" adjustment) + (C-call "gtk_adjustment_get_step_increment" adjustment) + (C-call "gtk_adjustment_get_page_increment" adjustment))) ;;; GtkWidgets -(define-class () +(define-class () + (destroyed? define standard initial-value #f) ;; The parent or #f. (parent define standard initial-value #f)) (define-guarantee gtk-widget "a ") -(define-method gtk-object-destroy-callback ((widget )) +;;; This is unfortunate. We rely on the most specialized method to +;;; call out, creating a specific type of GtkWidget. We want the +;;; method to go first, as usual, to add a gc-cleanup, but +;;; this method to go last, AFTER the most specific (most unusual!) +;;; else it cannot connect its destroy-callback. To do both would +;;; take... a computed effective method procedure? For now, rely on +;;; the method that calls out to set-gtk-widget-destroy-callback! as +;;; well as g_object_ref_sink. + +#;(define-method initialize-instance ((widget )) (call-next-method widget) - (let ((parent (gtk-widget-parent widget))) - (if (and parent (not (gtk-object-destroyed? parent))) - (container-remove! parent widget)))) + (g-signal-connect widget (C-callback "destroy") gtk-widget-destroy-callback)) + +(define (set-gtk-widget-destroy-callback! widget) + (g-signal-connect widget (C-callback "destroy") gtk-widget-destroy-callback)) + +;;; Methods of this generic procedure should drop references to other +;;; gobject instances used by @var{widget}. If these instances are +;;; not shared, they can be explicitly g-object-unref!ed. Else they +;;; should be dropped, e.g. replaced with #f, to be cleaned up by the +;;; garbage collector. +(define-generic gtk-widget-destroy-callback (widget)) + +(define (gtk-widget-destroy widget) + (guarantee-live-gtk-widget widget 'gtk-widget-destroy) + (C-call "gtk_widget_destroy" (gobject-alien widget))) + +(define-integrable-operator (guarantee-live-gtk-widget widget operator) + (guarantee-gtk-widget widget operator) + (if (gtk-widget-destroyed? widget) + (error "Gtk-widget destroyed:" widget operator)) + (if (not (gobject-live? widget)) + (error "Gtk-widget dead:" widget operator))) + +(define-method gtk-widget-destroy-callback ((widget )) + (if (not (gtk-widget-destroyed? widget)) + (let ((parent (gtk-widget-parent widget))) + (if (and parent (not (gtk-widget-destroyed? parent))) + (container-remove! parent widget)) + (set-gtk-widget-destroyed?! widget #t) + (gobject-unref! widget)))) (define (gtk-widget-realized? widget) - (guarantee-gtk-widget widget 'gtk-widget-realized?) - (let ((flags (gtk-object-flags widget))) - (bit? flags (C-enum "GTK_REALIZED")))) + (guarantee-live-gtk-widget widget 'gtk-widget-realized?) + (not (zero? (C-call "gtk_widget_get_realized" (gobject-alien widget))))) (define (gtk-widget-has-focus? widget) - (guarantee-gtk-widget widget 'gtk-widget-has-focus?) - (let ((flags (gtk-object-flags widget))) - (bit? flags (C-enum "GTK_HAS_FOCUS")))) + (guarantee-live-gtk-widget widget 'gtk-widget-has-focus?) + (not (zero? (C-call "gtk_widget_has_focus" (gobject-alien widget))))) (define (gtk-widget-drawable? widget) (guarantee-gtk-widget widget 'gtk-widget-drawable?) - (let ((flags (gtk-object-flags widget))) - (and (bit? flags (C-enum "GTK_VISIBLE")) - (bit? flags (C-enum "GTK_MAPPED"))))) + (not (zero? (C-call "gtk_widget_is_drawable" (gobject-alien widget))))) (define (gtk-widget-is-composited? widget) (guarantee-gtk-widget widget 'gtk-widget-is-composited?) @@ -210,9 +195,13 @@ USA. layout)) (define (gtk-widget-get-size widget) - (let ((alien (gobject-alien widget))) - (cons (C-> alien "GtkWidget allocation width") - (C-> alien "GtkWidget allocation height")))) + (let ((alien (gobject-alien widget)) + (allocation (malloc (C-sizeof "GtkAllocation") '|GtkAllocation|))) + (C-call "gtk_widget_get_allocation" alien allocation) + (let ((width (C-> allocation "GtkAllocation width")) + (height (C-> allocation "GtkAllocation height"))) + (free allocation) + (cons width height)))) (define (gtk-widget-set-size-request widget width height) (guarantee-gtk-widget widget 'gtk-widget-set-size-request) @@ -235,6 +224,11 @@ USA. (guarantee-procedure-of-arity callback 1 'set-gtk-widget-unrealize-callback!) (g-signal-connect widget (C-callback "unrealize") callback)) +(define (set-gtk-widget-draw-callback! widget callback) + (guarantee-gtk-widget widget 'set-gtk-widget-draw-callback!) + (guarantee-procedure-of-arity callback 2 'set-gtk-widget-draw-callback!) + (g-signal-connect widget (c-callback "draw") callback)) + (define (set-gtk-widget-event-callback! widget callback) (guarantee-gtk-widget widget 'set-gtk-widget-event-callback!) (guarantee-procedure-of-arity callback 2 'set-gtk-widget-event-callback!) @@ -242,41 +236,34 @@ USA. ;;; GtkWidget Font -(define (gtk-widget-font widget) +(define-integrable (gtk-widget-style-context widget) + (let ((style (make-alien '|GtkStyleContext|))) + (C-call "gtk_widget_get_style_context" style (gobject-alien widget)) + style)) + +(define-integrable-operator (guarantee-gtk-widget-realized widget operator) + (guarantee-gtk-widget widget operator) + (if (not (gtk-widget-realized? widget)) + (error "Not yet realized:" widget operator))) + +(define (gtk-widget-font widget #!optional state) (guarantee-gtk-widget-realized widget 'gtk-widget-font) - (let ((desc (make-alien '|PangoFontDescription|))) - (C-> (gobject-alien widget) "GtkWidget style" desc) - (C-> desc "GtkStyle font_desc" desc) + (let ((style (gtk-widget-style-context widget)) + (state (->gtk-widget-state state 'gtk-widget-font)) + (desc (make-alien '|PangoFontDescription|))) + (C-call "gtk_style_context_get_font" style state desc) desc)) (define (set-gtk-widget-font! widget desc) - (guarantee-gtk-widget-realized widget 'set-gtk-widget-font!) + (guarantee-gtk-widget widget 'set-gtk-widget-font!) (let ((font (->PangoFontDescription desc))) - (modify-rcstyle widget (lambda (rcstyle) - (set-rcstyle-font! rcstyle font))))) - -(define (modify-rcstyle widget modify) - ;; The _get_modifier_style(), modify, _modify_style() process. And - ;; _queue_draw all. - (let ((gtkwidget (gobject-alien widget)) - (rcstyle (make-alien '|GtkRcStyle|))) - (C-call "gtk_widget_get_modifier_style" rcstyle gtkwidget) - (modify rcstyle) - (C-call "gtk_widget_modify_style" gtkwidget rcstyle) ; rcstyle destroyed - (C-call "gtk_widget_queue_draw" gtkwidget))) - -(define (set-rcstyle-font! rcstyle pangofontdescription) - (let ((old (C-> rcstyle "GtkRcStyle font_desc")) - (new (C-call "pango_font_description_copy" - (make-alien 'PangoFontDescription) - pangofontdescription))) - (if (not (alien-null? old)) - (C-call "pango_font_description_free" old)) - (C->= rcstyle "GtkRcStyle font_desc" new))) + (C-call "gtk_widget_override_font" (gobject-alien widget) font) + (pango-font-description-free font) + (C-call "gtk_widget_queue_draw" (gobject-alien widget)))) (define (->PangoFontDescription desc) (cond ((and (alien? desc) (eq? '|PangoFontDescription| (alien/ctype desc))) - desc) + (pango-font-description-copy desc)) ((string? desc) (let ((alien (pango-font-description-from-string desc))) (if (alien-null? alien) @@ -288,174 +275,95 @@ USA. ;;; GtkWidget Colors -(define-generic gtk-widget-get-colormap (widget)) - -(define-method gtk-widget-get-colormap ((widget )) - (C-call "gtk_widget_get_colormap" - (make-alien '|GdkColormap|) - (gobject-alien widget))) - -(define (gtk-widget-parse-color widget spec) - (guarantee-gtk-widget widget 'gtk-widget-parse-color) - (guarantee-string spec 'gtk-widget-parse-color) - (let ((gdkcolor (parse-gdkcolor spec widget))) - (if gdkcolor - (let ((rgb (peek-gdkcolor gdkcolor))) - (free gdkcolor) - rgb) - #f))) - -(define-integrable-operator (peek-gdkcolor gdkcolor) - (vector (/ (C-> gdkcolor "GdkColor red") 65535) - (/ (C-> gdkcolor "GdkColor green") 65535) - (/ (C-> gdkcolor "GdkColor blue") 65535))) - -(define (parse-gdkcolor spec widget) - ;; Return a malloced GdkColor with its RGB components filled in from - ;; SPEC. Does not allocate the color. - (cond ((string? spec) (lookup-gdkcolor widget spec)) - ((symbol? spec) (lookup-gdkcolor widget (symbol-name spec))) - ((and (vector? spec) (= 3 (vector-length spec))) - (let ((new (malloc (C-sizeof "GdkColor") '|GdkColor|))) - (define-integrable (ref i) - (round->exact (* (vector-ref spec i) 65535))) - (C->= new "GdkColor red" (ref 0)) - (C->= new "GdkColor green" (ref 1)) - (C->= new "GdkColor blue" (ref 2)) - new)) - (else #f))) - -(define (lookup-gdkcolor widget string) - ;; Return a malloced GdkColor with the RGB components of a color - ;; named by STRING. Returns #f if the color name is unknown. - (let ((style (C-> (gobject-alien widget) "GtkWidget style")) - (gdkcolor (malloc (C-sizeof "GdkColor") '|GdkColor|))) - (if (and (zero? (C-call "gtk_style_lookup_color" style string gdkcolor)) - (zero? (C-call "gdk_color_parse" string gdkcolor))) - (begin - (free gdkcolor) - #f) - gdkcolor))) - -(define (->gdkcolor spec widget operator) - (or (parse-gdkcolor spec widget) - (error:wrong-type-argument spec "a Gtk color spec." operator))) - -(define-integrable-operator (guarantee-gtk-widget-realized widget operator) - (guarantee-gtk-widget widget operator) - (if (not (gtk-widget-realized? widget)) - (error "Not yet realized:" widget operator))) - (define (gtk-widget-fg-color widget #!optional state) (guarantee-gtk-widget-realized widget 'gtk-widget-fg-color) - (let ((state (->gtk-widget-state state 'gtk-widget-fg-color)) - (alien (make-alien '|GdkColor|))) - (C-> (gobject-alien widget) "GtkWidget style" alien) - (C-> alien "GtkStyle fg" alien) - (C-array-loc! alien "GdkColor" state) - (peek-gdkcolor alien))) + (let ((style (gtk-widget-style-context widget)) + (state (->gtk-widget-state state 'gtk-widget-fg-color)) + (rgba (malloc (C-sizeof "GdkRGBA") '|GdkRGBA|))) + (C-call "gtk_style_context_get_color" style state rgba) + (let ((color (peek-rgba rgba))) + (free rgba) + color))) (define (gtk-widget-bg-color widget #!optional state) (guarantee-gtk-widget-realized widget 'gtk-widget-bg-color) - (let ((state (->gtk-widget-state state 'gtk-widget-bg-color)) - (alien (make-alien '|GdkColor|))) - (C-> (gobject-alien widget) "GtkWidget style" alien) - (C-> alien "GtkStyle bg" alien) - (C-array-loc! alien "GdkColor" state) - (peek-gdkcolor alien))) - -(define (gtk-widget-text-color widget #!optional state) - (guarantee-gtk-widget-realized widget 'gtk-widget-text-color) - (let ((state (->gtk-widget-state state 'gtk-widget-text-color)) - (alien (make-alien '|GdkColor|))) - (C-> (gobject-alien widget) "GtkWidget style" alien) - (C-> alien "GtkStyle text" alien) - (C-array-loc! alien "GdkColor" state) - (peek-gdkcolor alien))) - -(define (gtk-widget-base-color widget #!optional state) - (guarantee-gtk-widget-realized widget 'gtk-widget-base-color) - (let ((state (->gtk-widget-state state 'gtk-widget-base-color)) - (alien (make-alien '|GdkColor|))) - (C-> (gobject-alien widget) "GtkWidget style" alien) - (C-> alien "GtkStyle base" alien) - (C-array-loc! alien "GdkColor" state) - (peek-gdkcolor alien))) + (let ((style (gtk-widget-style-context widget)) + (state (->gtk-widget-state state 'gtk-widget-bg-color)) + (rgba (malloc (C-sizeof "GdkRGBA") '|GdkRGBA|))) + (C-call "gtk_style_context_get_background_color" style state rgba) + (let ((color (peek-rgba rgba))) + (free rgba) + color))) (define (set-gtk-widget-fg-color! widget color #!optional state) - (guarantee-gtk-widget-realized widget 'set-gtk-widget-fg-color!) - (let ((gdkcolor (->gdkcolor color widget 'set-gtk-widget-fg-color!)) + (guarantee-gtk-widget widget 'set-gtk-widget-fg-color!) + (let ((rgba (->rgba color widget 'set-gtk-widget-fg-color!)) (state (->gtk-widget-state state 'set-gtk-widget-fg-color!))) - (modify-rcstyle widget (lambda (rcstyle) - (set-rcstyle-fg-color! rcstyle gdkcolor state))) - (free gdkcolor))) - -(define (set-rcstyle-fg-color! rcstyle gdkcolor state) - (set-rcstyle-gdkcolor! gdkcolor state - (C-> rcstyle "GtkRcStyle fg") - (C-> rcstyle "GtkRcStyle color_flags") - (C-enum "GTK_RC_FG"))) - -(define (set-rcstyle-gdkcolor! newcolor index colors flagss newflag) - (let ((color (C-array-loc! colors "GdkColor" index)) - (flags (C-array-loc! flagss "uint" index))) - (C->= color "GdkColor red" (C-> newcolor "GdkColor red")) - (C->= color "GdkColor green" (C-> newcolor "GdkColor green")) - (C->= color "GdkColor blue" (C-> newcolor "GdkColor blue")) - (C->= flags "GtkRcFlags" (fix:or newflag (C-> flags "GtkRcFlags"))))) + (C-call "gtk_widget_override_color" (gobject-alien widget) state rgba) + (free rgba))) (define-generic set-gtk-widget-bg-color! (widget color #!optional state)) (define-method set-gtk-widget-bg-color! ((widget ) color #!optional state) - (let ((gdkcolor (->gdkcolor color widget '(set-gtk-widget-bg-color! ))) + (let ((rgba (->rgba color widget '(set-gtk-widget-bg-color! ))) (state (->gtk-widget-state state '(set-gtk-widget-bg-color! )))) - (modify-rcstyle widget (lambda (rcstyle) - (set-rcstyle-bg-color! rcstyle gdkcolor state))) - (free gdkcolor))) - -(define (set-rcstyle-bg-color! rcstyle gdkcolor state) - (set-rcstyle-gdkcolor! gdkcolor state - (C-> rcstyle "GtkRcStyle bg") - (C-> rcstyle "GtkRcStyle color_flags") - (C-enum "GTK_RC_BG"))) - -(define (set-gtk-widget-text-color! widget color #!optional state) - (guarantee-gtk-widget-realized widget 'set-gtk-widget-text-color!) - (let ((gdkcolor (->gdkcolor color widget 'set-gtk-widget-text-color!)) - (state (->gtk-widget-state state 'set-gtk-widget-text-color!))) - (modify-rcstyle widget (lambda (rcstyle) - (set-rcstyle-text-color! rcstyle gdkcolor state))) - (free gdkcolor))) - -(define (set-rcstyle-text-color! rcstyle gdkcolor state) - (set-rcstyle-gdkcolor! gdkcolor state - (C-> rcstyle "GtkRcStyle text") - (C-> rcstyle "GtkRcStyle color_flags") - (C-enum "GTK_RC_TEXT"))) - -(define (set-gtk-widget-base-color! widget color #!optional state) - (guarantee-gtk-widget-realized widget 'set-gtk-widget-base-color!) - (let ((gdkcolor (->gdkcolor color widget 'set-gtk-widget-base-color!)) - (state (->gtk-widget-state state 'set-gtk-widget-base-color!))) - (modify-rcstyle widget (lambda (rcstyle) - (set-rcstyle-base-color! rcstyle gdkcolor state))) - (free gdkcolor))) - -(define (set-rcstyle-base-color! rcstyle gdkcolor state) - (set-rcstyle-gdkcolor! gdkcolor state - (C-> rcstyle "GtkRcStyle base") - (C-> rcstyle "GtkRcStyle color_flags") - (C-enum "GTK_RC_BASE"))) + (C-call "gtk_widget_override_background_color" + (gobject-alien widget) state rgba) + (free rgba))) (define (->gtk-widget-state object operator) (case (if (default-object? object) 'normal object) - ((NORMAL) (C-enum "GTK_STATE_NORMAL")) - ((ACTIVE) (C-enum "GTK_STATE_ACTIVE")) - ((PRELIGHT) (C-enum "GTK_STATE_PRELIGHT")) - ((SELECTED) (C-enum "GTK_STATE_SELECTED")) - ((INSENSITIVE) (C-enum "GTK_STATE_INSENSITIVE")) + ((NORMAL) (C-enum "GTK_STATE_FLAG_NORMAL")) + ((ACTIVE) (C-enum "GTK_STATE_FLAG_ACTIVE")) + ((PRELIGHT) (C-enum "GTK_STATE_FLAG_PRELIGHT")) + ((SELECTED) (C-enum "GTK_STATE_FLAG_SELECTED")) + ((INSENSITIVE) (C-enum "GTK_STATE_FLAG_INSENSITIVE")) + ((INCONSISTENT) (C-enum "GTK_STATE_FLAG_INCONSISTENT")) + ((FOCUSED) (C-enum "GTK_STATE_FLAG_FOCUSED")) + ((BACKDROP) (C-enum "GTK_STATE_FLAG_BACKDROP")) (else (error:wrong-type-argument object "a GtkWidget state" operator)))) + +(define-integrable-operator (peek-rgba rgba) + (let ((c (make-color))) + (set-color-red! c (C-> rgba "GdkRGBA red")) + (set-color-green! c (C-> rgba "GdkRGBA green")) + (set-color-blue! c (C-> rgba "GdkRGBA blue")) + (set-color-alpha! c (C-> rgba "GdkRGBA alpha")) + c)) + +(define (->rgba color widget operator) + (cond ((color? color) + (let ((rgba (malloc (C-sizeof "GdkRGBA") '|GdkRGBA|))) + (C->= rgba "GdkRGBA red" (color-red color)) + (C->= rgba "GdkRGBA green" (color-green color)) + (C->= rgba "GdkRGBA blue" (color-blue color)) + (C->= rgba "GdkRGBA alpha" (color-alpha color)) + rgba)) + ((string? color) + (let ((rgba (malloc (C-sizeof "GdkRGBA") '|GdkRGBA|))) + (or (and (not (zero? (C-call "gtk_style_context_lookup_color" + (gtk-widget-style-context widget) + color rgba))) + rgba) + (and (not (zero? (C-call "gdk_rgba_parse" rgba color))) + rgba) + (error:wrong-type-argument color "a color spec" operator)))) + (else + (error:wrong-type-argument color "a color spec" operator)))) + +(define (gtk-widget-parse-color widget spec) + (guarantee-gtk-widget-realized widget 'gtk-widget-parse-color) + (guarantee-string spec 'gtk-widget-parse-color) + (let ((style (gtk-widget-style-context widget)) + (rgba (malloc (C-sizeof "GdkRGBA") '|GdkRGBA|))) + (if (zero? (C-call "gtk_style_context_lookup_color" style spec rgba)) + (begin + (free rgba) + #f) + (let ((color (peek-rgba rgba))) + (free rgba) + color)))) ;;; GtkContainers @@ -464,9 +372,9 @@ USA. ;; they were added. (reverse-children define standard initial-value '())) -(define-method gtk-object-destroy-callback ((container )) +(define-method gtk-widget-destroy-callback ((container )) (call-next-method container) - (for-each gtk-object-destroy (gtk-container-reverse-children container))) + (for-each gtk-widget-destroy (gtk-container-reverse-children container))) (define-guarantee gtk-container "a ") @@ -528,7 +436,7 @@ USA. (C-call "gtk_label_new" alien string) (error-if-null alien "Could not create:" label string) (C-call "g_object_ref_sink" alien alien)) - (set-gtk-object-destroy-callback! label)) + (set-gtk-widget-destroy-callback! label)) (define (gtk-label-new string) (guarantee-string string 'gtk-label-new) @@ -561,7 +469,7 @@ USA. (C-call "gtk_button_new" alien) (error-if-null alien "Could not create:" button) (C-call "g_object_ref_sink" alien alien)) - (set-gtk-object-destroy-callback! button)) + (set-gtk-widget-destroy-callback! button)) (define (set-gtk-button-clicked-callback! button callback) (guarantee-gtk-button button 'set-gtk-button-clicked-callback!) @@ -584,7 +492,7 @@ USA. (C-call "gtk_check_button_new" alien) (error-if-null alien "Could not create:" button) (C-call "g_object_ref_sink" alien alien)) - (set-gtk-object-destroy-callback! button)) + (set-gtk-widget-destroy-callback! button)) (define (gtk-check-button-get-active button) (guarantee-gtk-check-button button 'gtk-check-button-get-active) @@ -619,7 +527,7 @@ USA. (C-call "gtk_vbox_new" alien (if homogeneous? 1 0) spacing) (error-if-null alien "Could not create:" vbox) (C-call "g_object_ref_sink" alien alien)) - (set-gtk-object-destroy-callback! vbox)) + (set-gtk-widget-destroy-callback! vbox)) (define (gtk-vbox-new homogeneous? spacing) (guarantee-boolean homogeneous? 'gtk-vbox-new) @@ -641,7 +549,7 @@ USA. (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-object-destroy-callback! hbox)) + (set-gtk-widget-destroy-callback! hbox)) (define (gtk-hbox-new homogeneous? spacing) (guarantee-boolean homogeneous? 'gtk-hbox-new) @@ -668,7 +576,7 @@ USA. (C-call "gtk_frame_new" alien label) (error-if-null alien "Could not create:" frame) (C-call "g_object_ref_sink" alien alien)) - (set-gtk-object-destroy-callback! frame)) + (set-gtk-widget-destroy-callback! frame)) (define (gtk-frame-new label) (guarantee-string label 'gtk-frame-new) @@ -701,7 +609,7 @@ USA. (C-call "gtk_scrolled_window_new" alien 0 0) (error-if-null alien "Could not create:" window) (C-call "g_object_ref_sink" alien alien) - (set-gtk-object-destroy-callback! window) + (set-gtk-widget-destroy-callback! window) window)) (define (gtk-scrolled-window-set-policy window horizontal vertical) @@ -750,12 +658,12 @@ USA. (C-call "gtk_window_new" alien type) (error-if-null alien "Could not create:" window type) (C-call "g_object_ref_sink" alien alien) - (set-gtk-object-destroy-callback! window) + (set-gtk-widget-destroy-callback! window) (set! toplevel-windows (cons window toplevel-windows)))) (define toplevel-windows '()) -(define-method gtk-object-destroy-callback ((window )) +(define-method gtk-widget-destroy-callback ((window )) (call-next-method window) (set! toplevel-windows (delq! window toplevel-windows))) diff --git a/src/gtk/gtk.cdecl b/src/gtk/gtk.cdecl index a0f2159ba..0c731a089 100644 --- a/src/gtk/gtk.cdecl +++ b/src/gtk/gtk.cdecl @@ -1,8 +1,8 @@ #| -*-Scheme-*- -Copyright (C) 2007, 2008, 2009, 2010, 2011 Matthew Birkholz +Copyright (C) 2007, 2008, 2009, 2010, 2011, 2012 Matthew Birkholz -This file is part of MIT/GNU Scheme. +This file is part of an extension to MIT/GNU Scheme. MIT/GNU Scheme is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by @@ -85,7 +85,11 @@ USA. (typedef ScmWidget (struct _ScmWidget - (widget GtkWidget))) + (widget GtkWidget) + (hadjustment (* GtkAdjustment)) + (vadjustment (* GtkAdjustment)) + (hscroll_policy guint) + (vscroll_policy guint))) (extern (* GtkWidget) scm_widget_new) @@ -109,7 +113,7 @@ USA. ;;; Signal handlers. (callback void destroy - (object (* GtkObject)) + (object (* GtkWidget)) (ID gpointer)) (callback void size_allocate @@ -125,6 +129,11 @@ USA. (widget (* GtkWidget)) (ID gpointer)) +(callback gboolean draw + (widget (* GtkWidget)) + (cr (* cairo_t)) + (ID gpointer)) + (callback gint event (widget (* GtkWidget)) (event (* GdkEvent)) diff --git a/src/gtk/gtk.pkg b/src/gtk/gtk.pkg index ef12d6c54..13ccbcd43 100644 --- a/src/gtk/gtk.pkg +++ b/src/gtk/gtk.pkg @@ -2,7 +2,7 @@ Copyright (C) 2007, 2008, 2009, 2010, 2011, 2012 Matthew Birkholz -This file is part of MIT/GNU Scheme. +This file is part of an extension to MIT/GNU Scheme. MIT/GNU Scheme is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by @@ -54,14 +54,6 @@ USA. gdk-window-process-updates)) -(define-package (gtk cairo) - (parent (gtk)) - (files "cairo") - (export (gtk) - gdk-cairo-create - cairo-destroy - check-cairo-status)) - (define-package (gtk gio) (parent (gtk)) (files "gio") @@ -123,6 +115,7 @@ USA. pango-font-description-from-string pango-font-description-to-string pango-font-description-free + pango-font-description-copy pango-context-get-font-description pango-context-set-font-description pango-context-get-metrics @@ -132,16 +125,22 @@ USA. pango-font-metrics-get-approximate-char-width pango-font-metrics-unref)) -(define-package (gtk gtk-object) +(define-package (gtk cairo) + (parent (gtk)) + (files "cairo") + (export (gtk) + gdk-cairo-create + cairo-destroy)) + +(define-package (gtk gtk-widget) (parent (gtk)) - (files "gtk-object") + (files "gtk-widget") ;;(depends-on "gtk.bin" "gtk" "../runtime/ffi") (export (gtk) - gtk-object? guarantee-gtk-object - gtk-object-destroyed? gtk-object-destroy gtk-adjustment? guarantee-gtk-adjustment make-gtk-adjustment set-gtk-adjustment! gtk-widget? guarantee-gtk-widget + gtk-widget-destroyed? gtk-widget-destroy gtk-widget-parent gtk-widget-realized? gtk-widget-drawable? gtk-widget-has-focus? @@ -151,7 +150,6 @@ USA. gtk-widget-show-all gtk-widget-error-bell gtk-widget-queue-draw - gtk-widget-get-colormap gtk-widget-get-pango-context gtk-widget-create-pango-layout gtk-widget-get-size @@ -160,14 +158,13 @@ USA. set-gtk-widget-size-allocate-callback! set-gtk-widget-realize-callback! set-gtk-widget-unrealize-callback! + set-gtk-widget-draw-callback! set-gtk-widget-event-callback! - gtk-widget-font set-gtk-widget-font! + gtk-widget-parse-color gtk-widget-fg-color gtk-widget-bg-color - gtk-widget-text-color gtk-widget-base-color set-gtk-widget-fg-color! set-gtk-widget-bg-color! - set-gtk-widget-text-color! set-gtk-widget-base-color! - gtk-widget-parse-color + gtk-widget-font set-gtk-widget-font! gtk-container? guarantee-gtk-container gtk-container-children gtk-bin-child @@ -211,8 +208,8 @@ USA. (parent (gtk)) (files "scm-widget") ;;(depends-on "gtk.bin" "gtk" "../runtime/ffi") - (import (gtk gtk-object) - set-gtk-object-destroy-callback!) + (import (gtk gtk-widget) + set-gtk-widget-destroy-callback!) (export (gtk) set-scm-widget-set-scroll-adjustments-callback!)) @@ -226,15 +223,14 @@ USA. c-enum-constant-values) (import (gtk pango) make-pango-layout pango-rectangle pangos->pixels pixels->pangos) - (import (gtk gtk-object) - parse-gdkcolor - set-gtk-object-destroy-callback! - gtk-object-destroy-callback) + (import (gtk gtk-widget) + set-gtk-widget-destroy-callback! + gtk-widget-destroy-callback + gtk-widget-style-context) (export (gtk) fix-widget? fix-widget-new-geometry-callback fix-widget-realize-callback set-fix-widget-pointer-shape! - set-fix-widget-expose-handler! set-fix-widget-map-handler! set-fix-widget-unmap-handler! set-fix-widget-enter-notify-handler! @@ -270,6 +266,7 @@ USA. line-ink-width set-line-ink-width! line-ink-color set-line-ink-color! line-ink-dash-color set-line-ink-dash-color! + line-ink-dashes set-line-ink-dashes! rectangle-ink? make-rectangle-ink set-rectangle-ink! rectangle-ink-color set-rectangle-ink-color! @@ -297,7 +294,6 @@ USA. box-ink? make-box-ink set-box-ink! set-box-ink-position! - box-ink-shadow set-box-ink-shadow! ;; make-hline-ink set-hline-ink-size! ;; make-vline-ink set-vline-ink-size! @@ -373,10 +369,10 @@ USA. (define-package (gtk swat) (parent (gtk)) (files "swat") - (import (gtk gtk-object) - gtk-object-destroy-callback) + (import (gtk gtk-widget) + gtk-widget-destroy-callback) (import (gtk fix-layout) - fix-layout-view fix-ink-extent fix-ink-expose-callback + fix-layout-view fix-ink-extent fix-ink-draw-callback fix-drawing-display-list set-fix-drawing-display-list! set-fix-ink-drawing! fix-ink-in-widget? fix-ink-in? fix-rect-x fix-rect-y with-fix-rect diff --git a/src/gtk/gtk.scm b/src/gtk/gtk.scm index d1885ea86..780cf46f3 100644 --- a/src/gtk/gtk.scm +++ b/src/gtk/gtk.scm @@ -1,8 +1,8 @@ #| -*-Scheme-*- -Copyright (C) 2007, 2008, 2009, 2010, 2011 Matthew Birkholz +Copyright (C) 2007, 2008, 2009, 2010, 2011, 2012 Matthew Birkholz -This file is part of MIT/GNU Scheme. +This file is part of an extension to MIT/GNU Scheme. MIT/GNU Scheme is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by @@ -78,4 +78,24 @@ USA. (declare (integrate-operator bit-ior)) (define (bit-ior . ints) - (reduce bitwise-ior 0 ints)) \ No newline at end of file + (reduce bitwise-ior 0 ints)) + +(define-integrable (color? object) + (and (flo:flonum? object) (fix:= 4 (flo:vector-length object)))) +(define-integrable (make-color) (flo:vector-cons 4)) +(define-integrable-operator (color-red o) + (if (color? o) (flo:vector-ref o 0) (error:wrong-type-argument o "a color"))) +(define-integrable-operator (color-green o) + (if (color? o) (flo:vector-ref o 1) (error:wrong-type-argument o "a color"))) +(define-integrable-operator (color-blue o) + (if (color? o) (flo:vector-ref o 2) (error:wrong-type-argument o "a color"))) +(define-integrable-operator (color-alpha o) + (if (color? o) (flo:vector-ref o 3) (error:wrong-type-argument o "a color"))) +(define-integrable-operator (set-color-red! o r) + (if (color? o) (flo:vector-set! o 0 r)(error:wrong-type-argument o"a color"))) +(define-integrable-operator (set-color-green! o g) + (if (color? o) (flo:vector-set! o 1 g)(error:wrong-type-argument o"a color"))) +(define-integrable-operator (set-color-blue! o b) + (if (color? o) (flo:vector-set! o 2 b)(error:wrong-type-argument o"a color"))) +(define-integrable-operator (set-color-alpha! o a) + (if (color? o) (flo:vector-set! o 3 a)(error:wrong-type-argument o"a color"))) \ No newline at end of file diff --git a/src/gtk/make.scm b/src/gtk/make.scm index 3562aa2be..70487a804 100644 --- a/src/gtk/make.scm +++ b/src/gtk/make.scm @@ -22,5 +22,5 @@ Load the Gtk option. |# (system-library-uri "gtk/") (lambda () (load-package-set "gtk")))) - (add-subsystem-identification! "Gtk" '(0 3)) + (add-subsystem-identification! "Gtk" '(0 4)) ((access gtk-start (->environment '(gtk main)))))) \ No newline at end of file diff --git a/src/gtk/pango.scm b/src/gtk/pango.scm index 66142d5d2..ff4967cb7 100644 --- a/src/gtk/pango.scm +++ b/src/gtk/pango.scm @@ -1,8 +1,8 @@ #| -*-Scheme-*- -Copyright (C) 2009, 2010, 2011 Matthew Birkholz +Copyright (C) 2009, 2010, 2011, 2012 Matthew Birkholz -This file is part of MIT/GNU Scheme. +This file is part of an extension to MIT/GNU Scheme. MIT/GNU Scheme is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by @@ -131,6 +131,19 @@ USA. (C-call "g_free" cstr) str)))))) +(define (pango-font-description-copy font) + (let ((new (make-alien '|PangoFontDescription|)) + (copy (make-alien '|PangoFontDescription|))) + (add-gc-cleanup new (make-pango-font-description-cleanup copy)) + (C-call "pango_font_description_copy" copy font) + (if (alien-null? copy) + (begin + (punt-gc-cleanup font) + #f) + (begin + (copy-alien-address! new copy) + new)))) + (define-integrable (guarantee-pango-font-description object operator) (if (not (and (alien? object) (eq? '|PangoFontDescription| (alien/ctype object)))) diff --git a/src/gtk/scm-widget.scm b/src/gtk/scm-widget.scm index a49635df7..683961d0f 100644 --- a/src/gtk/scm-widget.scm +++ b/src/gtk/scm-widget.scm @@ -1,8 +1,8 @@ #| -*-Scheme-*- -Copyright (C) 2007, 2008, 2009, 2010, 2011 Matthew Birkholz +Copyright (C) 2007, 2008, 2009, 2010, 2011, 2012 Matthew Birkholz -This file is part of MIT/GNU Scheme. +This file is part of an extension to MIT/GNU Scheme. MIT/GNU Scheme is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by @@ -35,7 +35,7 @@ USA. (if (alien-null? a) (error "Could not create: a Scheme widget.") (C-call "g_object_ref_sink" a a)) - (set-gtk-object-destroy-callback! new))) + (set-gtk-widget-destroy-callback! new))) (define (set-scm-widget-set-scroll-adjustments-callback! widget callback) (guarantee-scm-widget widget 'set-scm-widget-set-scroll-adjustments-callback!) diff --git a/src/gtk/scmwidget.c.stay b/src/gtk/scmwidget.c.stay index 4e241b176..96d9c5676 100644 --- a/src/gtk/scmwidget.c.stay +++ b/src/gtk/scmwidget.c.stay @@ -1,8 +1,8 @@ /* -*-C-*- -Copyright (C) 2007, 2008, 2009, 2010 Matthew Birkholz +Copyright (C) 2007, 2008, 2009, 2010, 2012 Matthew Birkholz -This file is part of MIT/GNU Scheme. +This file is part of an extension to MIT/GNU Scheme. MIT/GNU Scheme is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by @@ -23,42 +23,27 @@ USA. /* The ScmWidget, represented in Scheme by a . */ -#include +/* #include */ #include "gtk-shim.h" +/* #include */ +/* #include */ -static void scm_widget_class_init (ScmWidgetClass *klass); -static void scm_widget_realize (GtkWidget* widget); +enum { + PROP_0, + PROP_HADJUSTMENT, + PROP_VADJUSTMENT, + PROP_HSCROLL_POLICY, + PROP_VSCROLL_POLICY +}; -GType -scm_widget_get_type (void) -{ - static GType widget_type = 0; - - if (!widget_type) { - static const GTypeInfo widget_type_info = { - sizeof (ScmWidgetClass), - NULL, /* base_init */ - NULL, /* base_finalize */ - (GClassInitFunc) scm_widget_class_init, - NULL, /* class_finalize */ - NULL, /* class_data */ - sizeof (ScmWidget), - 0, /* n_preallocs */ - NULL, /* instance_init */ - NULL /* value_table */ - }; - - widget_type - = g_type_register_static (GTK_TYPE_WIDGET, "ScmWidget", - &widget_type_info, 0); - } - - return widget_type; -} +static void scm_widget_set_property (GObject *object, guint prop_id, + const GValue *value, GParamSpec *pspec); +static void scm_widget_get_property (GObject *object, guint prop_id, + GValue *value, GParamSpec *pspec); +static void scm_widget_realize (GtkWidget *widget); -static GtkWidgetClass *parent_class = NULL; +static guint set_scroll_adjustments_signal_id; -/* VOID:OBJECT,OBJECT (./gtkmarshalers.list:91) */ static void marshal_VOID__OBJECT_OBJECT (GClosure *closure, GValue *return_value G_GNUC_UNUSED, @@ -95,6 +80,18 @@ marshal_VOID__OBJECT_OBJECT (GClosure *closure, data2); } +G_DEFINE_TYPE_WITH_CODE (ScmWidget, scm_widget, GTK_TYPE_WIDGET, + G_IMPLEMENT_INTERFACE (GTK_TYPE_SCROLLABLE, NULL)) + +static void +scm_widget_init (ScmWidget *widget) +{ + widget->hadjustment = NULL; + widget->vadjustment = NULL; + widget->hscroll_policy = GTK_SCROLL_NATURAL; + widget->vscroll_policy = GTK_SCROLL_NATURAL; +} + static void scm_widget_class_init (ScmWidgetClass *klass) { @@ -104,10 +101,24 @@ scm_widget_class_init (ScmWidgetClass *klass) gobject_class = G_OBJECT_CLASS (klass); widget_class = (GtkWidgetClass*) klass; - parent_class = g_type_class_peek_parent (klass); + gobject_class->set_property = scm_widget_set_property; + gobject_class->get_property = scm_widget_get_property; widget_class->realize = scm_widget_realize; - widget_class->set_scroll_adjustments_signal = + + gtk_widget_class_set_accessible_role (widget_class, ATK_ROLE_VIEWPORT); + + /* GtkScrollable implementation */ + g_object_class_override_property + (gobject_class, PROP_HADJUSTMENT, "hadjustment"); + g_object_class_override_property + (gobject_class, PROP_VADJUSTMENT, "vadjustment"); + g_object_class_override_property + (gobject_class, PROP_HSCROLL_POLICY, "hscroll-policy"); + g_object_class_override_property + (gobject_class, PROP_VSCROLL_POLICY, "vscroll-policy"); + + set_scroll_adjustments_signal_id = g_signal_new ("set_scroll_adjustments", G_OBJECT_CLASS_TYPE (gobject_class), G_SIGNAL_RUN_LAST | G_SIGNAL_ACTION, @@ -118,6 +129,90 @@ scm_widget_class_init (ScmWidgetClass *klass) GTK_TYPE_ADJUSTMENT); } +static void +scm_widget_set_property (GObject *object, guint prop_id, + const GValue *value, GParamSpec *pspec) +{ + ScmWidget *widget = SCM_WIDGET (object); + + switch (prop_id) + { + case PROP_HADJUSTMENT: + { + GtkAdjustment *adjustment = g_value_get_object (value); + if (adjustment != widget->hadjustment) + { + widget->hadjustment = adjustment; + g_signal_emit (widget, set_scroll_adjustments_signal_id, + 0, adjustment, widget->vadjustment); + } + } + break; + case PROP_VADJUSTMENT: + { + GtkAdjustment *adjustment = g_value_get_object (value); + if (adjustment != widget->vadjustment) + { + widget->vadjustment = adjustment; + g_signal_emit (widget, set_scroll_adjustments_signal_id, + 0, widget->hadjustment, adjustment); + } + } + break; + case PROP_HSCROLL_POLICY: + { + guint policy = g_value_get_enum (value); + if (policy != widget->hscroll_policy) + { + widget->hscroll_policy = policy; + gtk_widget_queue_resize (GTK_WIDGET (widget)); + } + } + break; + case PROP_VSCROLL_POLICY: + { + guint policy = g_value_get_enum (value); + if (policy != widget->vscroll_policy) + { + widget->vscroll_policy = policy; + gtk_widget_queue_resize (GTK_WIDGET (widget)); + } + } + break; + default: + G_OBJECT_WARN_INVALID_PROPERTY_ID (object, prop_id, pspec); + break; + } +} + +static void +scm_widget_get_property (GObject *object, + guint prop_id, + GValue *value, + GParamSpec *pspec) +{ + ScmWidget *widget = SCM_WIDGET (object); + + switch (prop_id) + { + case PROP_HADJUSTMENT: + g_value_set_object (value, widget->hadjustment); + break; + case PROP_VADJUSTMENT: + g_value_set_object (value, widget->vadjustment); + break; + case PROP_HSCROLL_POLICY: + g_value_set_enum (value, widget->hscroll_policy); + break; + case PROP_VSCROLL_POLICY: + g_value_set_enum (value, widget->vscroll_policy); + break; + default: + G_OBJECT_WARN_INVALID_PROPERTY_ID (object, prop_id, pspec); + break; + } +} + GtkWidget * scm_widget_new (void) { diff --git a/src/gtk/scmwidget.h b/src/gtk/scmwidget.h new file mode 100644 index 000000000..ad84b0326 --- /dev/null +++ b/src/gtk/scmwidget.h @@ -0,0 +1,47 @@ +/* -*-C-*- + +Copyright (C) 2007, 2008, 2009, 2010, 2011, 2012 Matthew Birkholz + +This file is part of an extension to MIT/GNU Scheme. + +MIT/GNU Scheme is free software; you can redistribute it and/or modify +it under the terms of the GNU General Public License as published by +the Free Software Foundation; either version 2 of the License, or (at +your option) any later version. + +MIT/GNU Scheme is distributed in the hope that it will be useful, but +WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +General Public License for more details. + +You should have received a copy of the GNU General Public License +along with MIT/GNU Scheme; if not, write to the Free Software +Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301, +USA. + +*/ + +/* Header for scmwidget.c. */ + +#define GTK_TYPE_SCMWIDGET (scm_widget_get_type ()) +#define SCM_WIDGET(obj) (G_TYPE_CHECK_INSTANCE_CAST ((obj), GTK_TYPE_SCMWIDGET, ScmWidget)) +#define SCM_IS_WIDGET(obj) (G_TYPE_CHECK_INSTANCE_TYPE ((obj), GTK_TYPE_SCMWIDGET)) + +typedef struct _ScmWidgetClass ScmWidgetClass; +typedef struct _ScmWidget ScmWidget; + +struct _ScmWidgetClass +{ + GtkWidgetClass parent_class; +}; + +struct _ScmWidget +{ + GtkWidget widget; + GtkAdjustment *hadjustment; + GtkAdjustment *vadjustment; + guint hscroll_policy; + guint vscroll_policy; +}; + +extern GtkWidget* scm_widget_new (void); diff --git a/src/gtk/swat.scm b/src/gtk/swat.scm index a946d4ac6..14d4a82d4 100644 --- a/src/gtk/swat.scm +++ b/src/gtk/swat.scm @@ -1,8 +1,8 @@ #| -*-Scheme-*- -Copyright (C) 2010, 2011 Matthew Birkholz +Copyright (C) 2010, 2011, 2012 Matthew Birkholz -This file is part of MIT/GNU Scheme. +This file is part of an extension to MIT/GNU Scheme. MIT/GNU Scheme is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by @@ -50,7 +50,7 @@ USA. (if (not (fix-widget? widget)) (set-gtk-widget-realize-callback! widget realize-options))) -(define-method gtk-object-destroy-callback ((object )) +(define-method gtk-widget-destroy-callback ((object )) (call-next-method object) (let ((on-death (without-interrupts (lambda () @@ -115,9 +115,9 @@ USA. ;;; The implementation chosen here removes a group's items from the ;;; drawing's display-list, keeping them in the group's item list, and ;;; ensuring that the group's ink-extent encompasses all of its items' -;;; ink-extents. The layout expose handler can then skip entire +;;; ink-extents. The layout draw callback can then skip entire ;;; groups (assuming they are relatively compact) or descend and, in -;;; the group expose handler, perform a similar search-and-expose +;;; the group draw callback, perform a similar search-and-draw ;;; among the group's items, recursively. ;;; ;;; To make the group ink-extent guarantee, all of a group's items @@ -192,7 +192,7 @@ USA. (define (item-delete! item) (fix-ink-remove! item) - ;; No hurry here. Expose events are cut off (above). Some + ;; No hurry here. Draw callbacks are cut off (above). Some ;; unnecessary drawing damage may occur (if items are changed before ;; they lose their link to the drawing), but the redraws will still ;; be correct. @@ -231,10 +231,11 @@ USA. () (items define standard initial-value '())) -(define-method fix-ink-expose-callback ((group ) widget window area) +(define-method fix-ink-draw-callback ((group ) + widget window cr area) (for-each (lambda (ink) (if (fix-ink-in? ink widget area) - (fix-ink-expose-callback ink widget window area))) + (fix-ink-draw-callback ink widget window cr area))) (swat-group-items group))) (define-method fix-ink-move! ((group ) dx dy) @@ -620,6 +621,7 @@ USA. (else (warn "Cannot realize widget option:" name spec widget)))) (define (realize-options widget) + (set-swat-widget-realized?! widget #t) (for-each (lambda (option) (realize-option widget (car option) (cdr option))) (swat-widget-options widget))) @@ -1008,7 +1010,7 @@ USA. (let ((parent (gtk-widget-parent child))) (if parent (swat-close parent) (if (gtk-window? child) - (gtk-object-destroy child) + (gtk-widget-destroy child) (error "unexpected top-level widget" child))))) ;;; * widget diff --git a/tests/gtk/gtk-tests.scm b/tests/gtk/gtk-tests.scm index b85aa6c80..067f6ff36 100644 --- a/tests/gtk/gtk-tests.scm +++ b/tests/gtk/gtk-tests.scm @@ -1,11 +1,8 @@ #| -*-Scheme-*- -Copyright (C) 1986, 1987, 1988, 1989, 1990, 1991, 1992, 1993, 1994, - 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004, 2005, - 2006, 2007, 2008, 2009, 2010, 2011, 2012 Massachusetts Institute - of Technology +Copyright (C) 2010, 2011, 2012 Matthew Birkholz -This file is part of MIT/GNU Scheme. +This file is part of an extension to MIT/GNU Scheme. MIT/GNU Scheme is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by @@ -100,7 +97,7 @@ USA. (make-pole-zero) (let loop () (if (not (null? (access toplevel-windows - (->environment '(gtk gtk-object))))) + (->environment '(gtk gtk-widget))))) (begin (sleep-current-thread 1000) (loop))))) \ No newline at end of file -- 2.25.1