@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
* GIO::
* Pixbuf Loader::
* Pango Layout::
-* Gtk Object::
+* Cairo Context::
* Gtk Adjustment::
* Gtk Widget::
* Gtk Container::
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.
#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
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.
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 <gtk-object>
-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 <gtk-adjustment>
-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
@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 <gtk-widget>
-An abstract, direct subclass of gtk-object.
+An abstract, direct subclass of gobject.
@end deffn
@deffn Procedure gtk-widget? object
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
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
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
@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
@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
@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
not be updated. This should probably be fixed with @code{add} and
@code{remove} signal callbacks.
+@anchor{gtk-container}
@deffn Class <gtk-container>
An abstract, direct subclass of gtk-widget.
@end deffn
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
@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!}.
@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
@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
@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
@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
@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
@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
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
(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)))
(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
#| -*-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
%window-tab-width)
(import (gtk pango)
pangos->pixels)
- (import (gtk gtk-object)
- gtk-object-destroy-callback
+ (import (gtk gtk-widget)
+ gtk-widget-destroy-callback
gtk-container-reverse-children)
(import (gtk fix-layout)
fix-widget-geometry
drawing-damage
fix-drawing-display-list
fix-drawing-extent
- fix-ink-expose-callback
fix-ink-extent
text-ink-pango-layout
gobject-alien gobject-unref!
gdk-window-process-updates
- gtk-object-destroyed? gtk-object-destroy
+ gtk-widget-destroyed? gtk-widget-destroy
gtk-widget? gtk-widget-parent
gtk-widget-grab-focus
gtk-widget-get-pango-context
gtk-widget-create-pango-layout
gtk-widget-set-size-request
- gtk-widget-text-color gtk-widget-base-color
- set-gtk-widget-text-color! set-gtk-widget-base-color!
- set-gtk-widget-fg-color! set-gtk-widget-bg-color!
+ gtk-widget-bg-color set-gtk-widget-bg-color!
+ gtk-widget-fg-color set-gtk-widget-fg-color!
gtk-container?
gtk-container-children gtk-container-add gtk-container-remove
gtk-window-new
gtk-window-present
- gtk-window-set-geometry-hints
gtk-window-set-title
gtk-window-set-opacity
- gtk-window-parse-geometry
+ gtk-window-set-default-size
pango-layout-get-pixel-extents
pango-layout-index-to-pos
fix-ink-remove!
<text-ink> text-ink? set-text-ink-position!
+ set-text-ink-color!
<simple-text-ink> simple-text-ink? make-simple-text-ink
simple-text-ink-text set-simple-text-ink-text!
- <box-ink> set-box-ink! set-box-ink-position!
- set-box-ink-shadow!))
\ No newline at end of file
+ <box-ink> set-box-ink! set-box-ink-position!))
\ No newline at end of file
#| -*-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
(guarantee-string geometry 'make-gtk-screen)
geometry))))
(gtk-window-set-opacity toplevel 0.95)
-
- ;; This does not get any re-allocations done.
- ;;(gtk-container-set-resize-mode toplevel 'immediate)
-
(set-gtk-screen-font! screen "Monospace 11")
(init-font-dimensions! screen)
(init-size! screen geometry*)
(set-screen-x-size! screen width)
(set-screen-y-size! screen height)
(let ((toplevel (gtk-screen-toplevel screen)))
- ;; This allows the user to resize to smaller sizes.
- (gtk-window-set-geometry-hints toplevel toplevel
- 'min-width 100 'min-height 100)))))
+ (gtk-window-set-default-size toplevel
+ (x-size->width screen width)
+ (+ (y-size->height screen (- height 2))
+ ;; Modeline.
+ (y-size->height screen 1)
+ ;; Typein.
+ (y-size->height screen 1)))))))
(define (parse-geometry geometry receiver)
(let* ((num "[0-9]+")
(define-method screen-discard! ((screen <gtk-screen>))
(set! screen-list (delq! screen screen-list))
- (gtk-object-destroy (gtk-screen-toplevel screen)))
+ (gtk-widget-destroy (gtk-screen-toplevel screen)))
(define-method screen-modeline-event! ((screen <gtk-screen>) window type)
(%trace "; screen-modeline-event! "screen" "window" "type"\n"))
1 ;;Handled.
))
(k (case key
- ((BACKSPACE) #\rubout)
- ((RETURN) #\c-m)
- ((LINEFEED) #\c-j)
- ((TAB) #\c-i)
+ ((#\backspace) #\rubout)
+ ((#\rubout) #\c-d)
+ ((#\return) #\c-m)
+ ((#\linefeed) #\c-j)
+ ((#\tab) #\c-i)
((Shift-L Shift-R Control-L Control-R Caps-Lock Shift-Lock
Meta-L Meta-R Alt-L Alt-R
Super-L Super-R Hyper-L Hyper-R)
((not (pair? windows)) ;extra children
(for-each (lambda (child)
(%trace "; "prefix"destroying extra "child"\n")
- (gtk-object-destroy child))
+ (gtk-widget-destroy child))
widgets)
(%trace "; "prefix"done, tossed extra children\n"))
;; and we will match the next...
(%trace "; "prefix"destroying "widget
", which mismatched "window"\n")
- (gtk-object-destroy widget)
+ (gtk-widget-destroy widget)
(re-pack-windows! windows (cdr widgets) box resizer prefix)))))))
(define (re-pack-resizer! windows widgets box resizer prefix)
(for-each
(lambda (w)
(outf-error "; "prefix"destroying unexpected "w"\n")
- (gtk-object-destroy w))
+ (gtk-widget-destroy w))
(cdr widgets))
(re-pack-windows! (cdr windows) '() box new prefix))))
;; Need NO resizer.
;;; (%trace "; drawing: "drawing"\n")
(let ((ink (make-simple-text-ink)))
(set-simple-text-ink-text! ink widget "Initial override message.")
+ (set-text-ink-color! ink "black")
(fix-drawing-add-ink! drawing ink)
(let ((extent (fix-ink-extent ink)))
(set-fix-drawing-size! drawing
(set-fix-widget-key-press-handler! widget key-press-handler)
widget)
-(define-method gtk-object-destroy-callback ((widget <text-widget>))
+(define-method gtk-widget-destroy-callback ((widget <text-widget>))
;; NOTE that this callback can be called before a widget is realized(!).
(call-next-method widget)
(let ((cursor (text-widget-cursor-ink widget)))
(%trace "; initialized geometry: "geometry"\n"))))
(call-next-method widget)
(realize-font! widget)
- ;; Since this is a text widget, fg/bg should be text/base.
- (set-gtk-widget-fg-color! widget (gtk-widget-text-color widget))
- (set-gtk-widget-bg-color! widget (gtk-widget-base-color widget)))
+ (set-gtk-widget-bg-color! widget "white"))
(define-method fix-widget-new-geometry-callback ((widget <text-widget>))
(%trace ";(fix-widget-new-geometry-callback <text-widget>) "widget"\n")
(let ((ink (make-simple-text-ink)))
(set-simple-text-ink-text!
ink widget "--------Initial mode line.--------------------------------")
+ (set-text-ink-color! ink "white")
(fix-drawing-add-ink! drawing ink)
(let ((extent (fix-ink-extent ink)))
(set-fix-drawing-size! drawing
(%trace "; initialized geometry: "geometry"\n"))))
(call-next-method widget)
(realize-font! widget)
- ;; Since this is a modeline widget, fg/bg (& text/base) should be base/text.
- (let ((text-color (gtk-widget-text-color widget))
- (base-color (gtk-widget-base-color widget)))
- (set-gtk-widget-text-color! widget base-color)
- (set-gtk-widget-base-color! widget text-color)
- (set-gtk-widget-fg-color! widget base-color)
- (set-gtk-widget-bg-color! widget text-color)))
+ (set-gtk-widget-bg-color! widget "black"))
(define-class (<buffer-frame-widget> (constructor ()))
(<gtk-vbox>)
;; looks selected, else visible.
(let ((selected (screen-cursor-window (window-screen window))))
(cond ((eq? window selected)
- (set-box-ink-shadow! cursor 'etched-in)
(visible! cursor #t))
((and (text-widget? widget)
(not (text-widget-modeline widget)))
- (set-box-ink-shadow! cursor 'etched-out)
(visible! cursor #f))
(else ;; text widget
- (set-box-ink-shadow! cursor 'etched-out)
(visible! cursor #t))))))
(define (redraw-cursor widget point)
(write-char #\- port)
(write (line-ink-end-index line) port))))
+(define-method initialize-instance ((ink <line-ink>))
+ (call-next-method ink)
+ (set-text-ink-color! ink "black"))
+
(define-method text-ink-pango-layout ((ink <line-ink>))
;; A cached pango layout is presumed to be all laid out. A cache
;; miss means a PangoLayout must be re-laid-up from the buffer text,
(if (or (eq? old #f)
(every (let ((old-extent (fix-ink-extent old)))
(lambda (widget)
- (or (gtk-object-destroyed? widget)
+ (or (gtk-widget-destroyed? widget)
(not (fix-rect-intersect?
old-extent
(fix-layout-view widget))))))
;; (restore its ink-widgets list) withOUT consing.
(widget-list define standard))
-#;(define-method initialize-instance ((ink <cursor-ink>))
- (call-next-method ink)
- (set-box-ink-shadow! ink 'etched-in))
-
(define (guarantee-cursor-ink object)
(if (cursor-ink? object) object
(error:wrong-type-argument object "<cursor-ink>" 'guarantee-cursor-ink)))
#| -*-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
(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);
-\f
-
-;;; 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)))
-\f
-
-;;; 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)))
-\f
-
-;;; 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);
-\f
-
-;;; 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)))
(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);
-\f
-
-;;; 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);
-\f
-
-;;; 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);
-|#
-\f
-
-;;; 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
-\f
-
-;;; 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);
-\f
-
-;;; 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
#| -*-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
#| -*-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
+++ /dev/null
-#| -*-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
#| -*-Scheme-*-
-gtk-2.0/gdk/gdkcursor.h |#
-
-;(include "gdktypes")
-;(include "gdk-pixbuf")
+gdk/gdkcursor.h |#
(typedef GdkCursorType
(enum
(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
#| -*-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))
(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))
(event (* GdkEvent))
(data gpointer))))
-;(typedef GdkXEvent void)
-
(typedef GdkFilterReturn
(enum
(GDK_FILTER_CONTINUE)
(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
(region (* GdkRegion))
(count gint))
-(struct _GdkEventNoExpose
- (type GdkEventType)
- (window (* GdkWindow))
- (send_event gint8))
-
(struct _GdkEventVisibility
(type GdkEventType)
(window (* GdkWindow))
(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))
(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))
(type GdkEventType)
(any GdkEventAny)
(expose GdkEventExpose)
- (no_expose GdkEventNoExpose)
(visibility GdkEventVisibility)
(motion GdkEventMotion)
(button GdkEventButton)
+ (touch GdkEventTouch)
(scroll GdkEventScroll)
(key GdkEventKey)
(crossing GdkEventCrossing)
(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
#| -*-Scheme-*-
-gtk-2.0/gdk/gdkkeys.h |#
-
-;(include "gdktypes")
+gdk/gdkkeys.h |#
(typedef GdkKeymapKey (struct _GdkKeymapKey))
(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
#| -*-Scheme-*-
-gtk-2.0/gdk/gdkkeysyms.h |#
+gdk/gdkkeysyms.h |#
(enum GdkKeysyms
(GDK_KEY_VoidSymbol)
(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)
(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)
(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)
(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)
(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)
(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)
(GDK_KEY_leftdoublequotemark)
(GDK_KEY_rightdoublequotemark)
(GDK_KEY_prescription)
+ (GDK_KEY_permille)
(GDK_KEY_minutes)
(GDK_KEY_seconds)
(GDK_KEY_latincross)
(GDK_KEY_obarred)
(GDK_KEY_SCHWA)
(GDK_KEY_schwa)
+ (GDK_KEY_EZH)
+ (GDK_KEY_ezh)
(GDK_KEY_Lbelowdot)
(GDK_KEY_lbelowdot)
(GDK_KEY_Abelowdot)
(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
+++ /dev/null
-#| -*-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
--- /dev/null
+#| -*-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
#| -*-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
(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
#| -*-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)))
(GDK_WINDOW_ROOT)
(GDK_WINDOW_TOPLEVEL)
(GDK_WINDOW_CHILD)
- (GDK_WINDOW_DIALOG)
(GDK_WINDOW_TEMP)
(GDK_WINDOW_FOREIGN)))
(GDK_WA_X)
(GDK_WA_Y)
(GDK_WA_CURSOR)
- (GDK_WA_COLORMAP)
(GDK_WA_VISUAL)
(GDK_WA_WMCLASS)
(GDK_WA_NOREDIR)))
(y gint)
(width gint)
(height gint)
- (wclass GdkWindowClass)
+ (wclass GdkWindowWindowClass)
(visual (* GdkVisual))
- (colormap (* GdkColormap))
(window_type GdkWindowType)
(cursor (* GdkCursor))
(wmclass_name (* gchar))
(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))
(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))
(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)
#| -*-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
#| -*-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)
(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
#| -*-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
(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)
(GTK_MENU_DIR_NEXT)
(GTK_MENU_DIR_PREV)))
-(typedef GtkMetricType
- (enum
- (GTK_PIXELS)
- (GTK_INCHES)
- (GTK_CENTIMETERS)))
-
(typedef GtkMovementStep
(enum
(GTK_MOVEMENT_LOGICAL_POSITIONS)
(GTK_SELECTION_NONE)
(GTK_SELECTION_SINGLE)
(GTK_SELECTION_BROWSE)
- (GTK_SELECTION_MULTIPLE)
- (GTK_SELECTION_EXTENDED)))
+ (GTK_SELECTION_MULTIPLE)))
(typedef GtkShadowType
(enum
(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
(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)
+++ /dev/null
-#| -*-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)))
+++ /dev/null
-#| -*-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
+++ /dev/null
-#| -*-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
--- /dev/null
+#| -*-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
#| -*-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
#| -*-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))))
(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)))
(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)))
(widget (* GtkWidget))
(window (* GdkWindow)))
+(extern void gtk_widget_get_allocation
+ (widget (* GtkWidget))
+ (allocation (* GtkAllocation)))
+
(extern void gtk_widget_error_bell
(widget (* GtkWidget)))
(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)
(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
#-*-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
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
# 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
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
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
;;;; 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))
("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)
("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))
#| -*-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
|#
;;;; A small drawing in two fix-layout widgets.
-;;; package: (gtk demo)
+;;; package: (gtk fix-layout demo)
(define blink? #t)
(define spin? #t)
(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-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)
(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!
(define-method fix-widget-realize-callback ((widget <demo-layout>))
(call-next-method widget)
- (set-gtk-widget-bg-color! widget (gtk-widget-base-color widget))
+ (set-gtk-widget-bg-color! widget "white")
(set-fix-widget-pointer-shape! widget 'crosshair))
(define (make-demo-drawing widget)
(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)
(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"))))))
\f
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
(define-class (<fix-widget> (constructor () (width height)))
(<scm-widget>)
- ;; 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
(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 <fix-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-method fix-widget-realize-callback ((widget <fix-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))
(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)
(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))
-
- unspecific))
+ (%trace "; window: "main-GdkWindow"\n"))))
(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)
(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>))
- (fix-widget-colormap widget))
-
-(define-method set-gtk-widget-bg-color! ((widget <fix-widget>) color #!optional state)
- ;; Set the window background (too).
- (call-next-method widget color state)
- (%trace "; (set-gtk-widget-bg-color! <fix-widget>) "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)
;; 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)))))
\f
(define (event-callback widget GdkEvent)
(%trace2 ";event-callback "widget)
;; 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!)
((= type (C-enum "GDK_2BUTTON_PRESS")) 'DOUBLE-PRESS)
((= type (C-enum "GDK_3BUTTON_PRESS")) 'TRIPLE-PRESS)
(else 'BOGUS)))
+
+(define-method set-gtk-widget-bg-color! ((widget <fix-widget>) color
+ #!optional state)
+ (call-next-method widget color state)
+ (%trace "; (set-gtk-widget-bg-color! <fix-layout>) "widget" "color" "state"\n")
+ (if (not (or (default-object? state) (eq? state 'normal)))
+ (warn "Fix-widget states are not (yet) supported:" widget color state))
+ (let ((style (gtk-widget-style-context widget)))
+ (C-call "gtk_style_context_set_background"
+ style (fix-widget-window widget))))
\f
(define-class (<fix-layout> (constructor () (width height)))
(<fix-widget>)
(define-method initialize-instance ((widget <fix-layout>) width height)
(call-next-method widget width height)
(%trace "; (initialize-instance <fix-layout>) "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 <fix-layout>))
+(define-method gtk-widget-destroy-callback ((layout <fix-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")))))
-
-(define-method set-gtk-widget-bg-color! ((widget <fix-layout>) color
- #!optional state)
- (call-next-method widget color state)
- (%trace "; (set-gtk-widget-bg-color! <fix-layout>) "widget" "color" "state"\n")
- (if (not (or (default-object? state) (eq? state 'normal)))
- (warn "Fix-layout states are not (yet) supported:" widget color state)))
+ (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 (set-fix-layout-scroll-size! widget width height)
;; Tells WIDGET to adjust its scrollable extent. Notifies any
(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")
(set-gtk-adjustment! hadj value left right
page-size step-incr page-incr)))))
\f
-;;; This is a simple <fix-widget> that handles expose events by
-;;; calling gtk_paint_handle().
+;;; This is a simple <fix-widget> 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
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 (gtk-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
(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)
(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)
(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.
)
(set-draw-ink-options! ink (delq! entry options))
(set-cdr! entry value))
(set-draw-ink-options! ink (cons (cons name value) options)))
- #t))))
+ #t))))
\f
(define-class (<line-ink> (constructor ()))
(<draw-ink>)
(define-guarantee line-ink "a <line-ink>")
-(define-method fix-ink-expose-callback ((ink <line-ink>) widget window area)
+(define-method fix-ink-draw-callback ((ink <line-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)
(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) ...)
(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.)
(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)))))
\f
(define-class (<rectangle-ink> (constructor ()))
(define-guarantee rectangle-ink "a <rectangle-ink>")
-(define-method fix-ink-expose-callback ((ink <rectangle-ink>) widget window area)
+(define-method fix-ink-draw-callback ((ink <rectangle-ink>)
+ widget window cr area)
(declare (ignore window area))
(%trace2 ";drawing "ink" on "widget"\n")
(let ((view (fix-layout-view widget))
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))
(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)
(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)
(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))))))
\f
(define-integrable flo:pi (flo:* 4. (flo:atan2 1. 1.)))
(define-guarantee arc-ink "an <arc-ink>")
-(define-method fix-ink-expose-callback ((ink <arc-ink>) widget window area)
+(define-method fix-ink-draw-callback ((ink <arc-ink>) widget window cr area)
(declare (ignore window area))
(%trace2 ";drawing "ink" on "widget"\n")
(let ((view (fix-layout-view widget))
(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.))
(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
(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)
(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))))))
\f
(define-class (<text-ink> (constructor ()))
(<draw-ink>))
(define-generic text-ink-pango-layout (ink))
-(define-method fix-ink-expose-callback ((ink <text-ink>) widget window area)
+(define-method fix-ink-draw-callback ((ink <text-ink>) widget window cr area)
(declare (ignore window area))
(%trace2 ";drawing "ink" on "widget"\n")
(let ((layout (text-ink-pango-layout ink)))
(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)
-
- ;; gdk-cairo-create leaves source rgb "black"?
- (if (not (assq 'COLOR (draw-ink-options ink)))
- (let ((alien (gobject-alien widget)))
- (let ((state (C-> alien "GtkWidget state"))
- (gdkcolor (make-alien '|GdkColor|)))
- (define-integrable (->flo c)
- (flo:/ (->flonum c) 65535.))
- (C-> alien "GtkWidget style" gdkcolor)
- (C-> gdkcolor "GtkStyle fg" gdkcolor)
- (C-array-loc! gdkcolor "GdkColor" state)
- (C-call "cairo_set_source_rgb" cr
- (->flo (C-> gdkcolor "GdkColor red"))
- (->flo (C-> gdkcolor "GdkColor green"))
- (->flo (C-> gdkcolor "GdkColor blue"))))))
-
+ (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)
(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)))
;; input-port, for debugging purposes.
unspecific))))
-(define-method fix-ink-expose-callback ((ink <image-ink>) widget window area)
+(define-method fix-ink-draw-callback ((ink <image-ink>) widget window cr area)
(declare (ignore window area))
(%trace2 ";drawing "ink" on "widget"\n")
(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 <image-ink>) dx dy)
(generic-fix-ink-move! ink dx dy))
(guarantee-fixnum y 'set-image-ink-position!)
(set-fix-ink-%position! ink x y))
\f
-;;; Inks implemented by gtk_paint_*, using widget style/state.
+;;; Inks implemented by gtk_render_*, using widget style/state.
(define-class (<box-ink> (constructor ()))
(<fix-ink>)
;; 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 <box-ink>) widget window area)
- (declare (ignore area))
+(define-method fix-ink-draw-callback ((ink <box-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 (gtk-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_focus" style cr x y width height))))
(define-method fix-ink-move! ((ink <box-ink>) dx dy)
(generic-fix-ink-move! ink dx dy))
(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 (<hline-ink> (constructor ()))
- (<fix-ink>))
-
-#;(define-method fix-ink-expose-callback ((ink <hline-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))))
\f
;;;; Fixnum Rectangles
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
(define-method initialize-instance ((widget <gtk-event-viewer>))
(call-next-method widget)
- (%trace ";\t(initialize-instance <gtk-event-viewer>) "widget")...\n")
+ (%trace ";\t(initialize-instance <gtk-event-viewer>) "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)
(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"))
(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)
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)))
(%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"
(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)
(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")))
(text (let ((alien (make-alien '|gchar|)))
(C-> GdkEvent "GdkEvent key string" alien)
(c-peek-cstring alien))))
- (cat "Keyval: "keyval" Text: "text"\n")))
+ (cat "Keyval: "keyval" Text: "(write-to-string text)"\n")))
(else
#f))))
\f
/* -*-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
/* Header for gtk-shim.c, gtk-const.c and scmwidget.c. */
-#include <gdk/gdkkeysyms.h>
-#include <gtk/gtk.h>
-#include <gtk/gtkwidget.h>
-#include <cairo/cairo.h>
+#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 <gtk/gtk.h>
+#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);
#| -*-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
|#
-;;;; GtkObjects/GtkWidgets/GtkContainers
-;;; package: (gtk gtk-object)
+;;;; GtkWidgets/GtkContainers
+;;; package: (gtk gtk-widget)
-(define-class <gtk-object> (<gobject>)
- (destroyed? define standard initial-value #f))
-
-(define-guarantee gtk-object "a <gtk-object>")
-
-;;; This is unfortunate. We rely on the most specialized method to
-;;; call out, creating a specific type of GtkObject. We want the
-;;; <gobject> 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 <gtk-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 <gtk-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"))
-\f
-;;; GtkAdjustments
-
-(define-class (<gtk-adjustment> (constructor ())) (<gtk-object>))
+(define-class (<gtk-adjustment> (constructor ())) (<gobject>))
(define-guarantee gtk-adjustment "a <gtk-adjustment>")
(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))
(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)))
\f
;;; GtkWidgets
-(define-class <gtk-widget> (<gtk-object>)
+(define-class <gtk-widget> (<gobject>)
+ (destroyed? define standard initial-value #f)
;; The parent <gtk-widget> or #f.
(parent define standard initial-value #f))
(define-guarantee gtk-widget "a <gtk-widget>")
-(define-method gtk-object-destroy-callback ((widget <gtk-widget>))
+;;; This is unfortunate. We rely on the most specialized method to
+;;; call out, creating a specific type of GtkWidget. We want the
+;;; <gobject> 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 <gtk-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 <gtk-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?)
+ (not (zero? (C-call "gtk_widget_is_composited" (gobject-alien widget)))))
(define (gtk-widget-grab-focus widget)
(guarantee-gtk-widget widget 'gtk-widget-grab-focus)
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)
+ (guarantee-non-negative-fixnum width 'gtk-widget-set-size-request)
+ (guarantee-non-negative-fixnum height 'gtk-widget-set-size-request)
(C-call "gtk_widget_set_size_request" (gobject-alien widget) width height))
(define (set-gtk-widget-size-allocate-callback! widget callback)
(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!)
\f
;;; 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)
\f
;;; GtkWidget Colors
-(define-generic gtk-widget-get-colormap (widget))
-
-(define-method gtk-widget-get-colormap ((widget <gtk-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 blue" (ref 1))
- (C->= new "GdkColor green" (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 <gtk-widget>) color
#!optional state)
- (let ((gdkcolor (->gdkcolor color widget '(set-gtk-widget-bg-color! <gtk-widget>)))
+ (let ((rgba (->rgba color widget '(set-gtk-widget-bg-color! <gtk-widget>)))
(state (->gtk-widget-state state '(set-gtk-widget-bg-color! <gtk-widget>))))
- (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))))
\f
;;; GtkContainers
;; they were added.
(reverse-children define standard initial-value '()))
-(define-method gtk-object-destroy-callback ((container <gtk-container>))
+(define-method gtk-widget-destroy-callback ((container <gtk-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 <gtk-container>")
(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)
(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!)
(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)
(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)
(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)
(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)
(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)
(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 <gtk-window>))
+(define-method gtk-widget-destroy-callback ((window <gtk-window>))
(call-next-method window)
(set! toplevel-windows (delq! window toplevel-windows)))
#| -*-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
(typedef ScmWidget
(struct _ScmWidget
- (widget GtkWidget)))
+ (widget GtkWidget)
+ (hadjustment (* GtkAdjustment))
+ (vadjustment (* GtkAdjustment))
+ (hscroll_policy guint)
+ (vscroll_policy guint)))
(extern (* GtkWidget) scm_widget_new)
;;; Signal handlers.
(callback void destroy
- (object (* GtkObject))
+ (object (* GtkWidget))
(ID gpointer))
(callback void size_allocate
(widget (* GtkWidget))
(ID gpointer))
+(callback gboolean draw
+ (widget (* GtkWidget))
+ (cr (* cairo_t))
+ (ID gpointer))
+
(callback gint event
(widget (* GtkWidget))
(event (* GdkEvent))
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
<pixbuf>
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")
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
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> gtk-object? guarantee-gtk-object
- gtk-object-destroyed? gtk-object-destroy
<gtk-adjustment> gtk-adjustment? guarantee-gtk-adjustment
make-gtk-adjustment set-gtk-adjustment!
<gtk-widget> gtk-widget? guarantee-gtk-widget
+ gtk-widget-destroyed? gtk-widget-destroy
gtk-widget-parent
gtk-widget-realized?
gtk-widget-drawable? gtk-widget-has-focus?
+ gtk-widget-is-composited?
gtk-widget-grab-focus
gtk-widget-show
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
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> gtk-container? guarantee-gtk-container
gtk-container-children gtk-bin-child
(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)
<scm-widget>
set-scm-widget-set-scroll-adjustments-callback!))
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?
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!
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> rectangle-ink? make-rectangle-ink set-rectangle-ink!
rectangle-ink-color set-rectangle-ink-color!
<box-ink> box-ink? make-box-ink
set-box-ink! set-box-ink-position!
- box-ink-shadow set-box-ink-shadow!
;;<hline-ink> make-hline-ink set-hline-ink-size!
;;<vline-ink> make-vline-ink set-vline-ink-size!
(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
#| -*-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
(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
(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
#| -*-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
(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))))
#| -*-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
(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!)
/* -*-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
/* The ScmWidget, represented in Scheme by a <scm-widget>. */
-#include <mit-scheme.h>
+/* #include <mit-scheme.h> */
#include "gtk-shim.h"
+/* #include <gtkadjustment.h> */
+/* #include <gtk/gtkscrollable.h> */
-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,
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)
{
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,
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)
{
--- /dev/null
+/* -*-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);
#| -*-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
(if (not (fix-widget? widget))
(set-gtk-widget-realize-callback! widget realize-options)))
-(define-method gtk-object-destroy-callback ((object <swat-widget>))
+(define-method gtk-widget-destroy-callback ((object <swat-widget>))
(call-next-method object)
(let ((on-death (without-interrupts
(lambda ()
;;; 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
(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.
(<swat-ink>)
(items define standard initial-value '()))
-(define-method fix-ink-expose-callback ((group <swat-group>) widget window area)
+(define-method fix-ink-draw-callback ((group <swat-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 <swat-group>) dx dy)
(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)))
(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
#| -*-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
(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
projects / mit-scheme.git / commitdiff