(define (make-glxgears-demo-device width height title)
(let ((window (gtk-window-new 'toplevel)))
- (gtk-window-set-opacity window 1.0)
(gtk-window-set-title window title)
(set-gtk-window-delete-event-callback!
window (lambda (w) (%trace "closed "w) 0))
gtk-widget-show-all
gtk-widget-queue-draw
set-gtk-widget-draw-callback!
- gtk-window-set-opacity
gtk-window-set-title
set-gtk-window-delete-event-callback!
gtk-container-set-border-width
gtk-widget-parent gtk-widget-show-all
set-gtk-widget-draw-callback!
gtk-container-add gtk-container-set-border-width
- gtk-window-new gtk-window-set-opacity gtk-window-set-title
+ gtk-window-new gtk-window-set-title
set-gtk-window-delete-event-callback!
fix-widget-new-geometry-callback
fix-widget-realize-callback
(GDK_LAST_CURSOR)
(GDK_CURSOR_IS_PIXMAP)))
-(extern (* GdkCursor) gdk_cursor_new
+(extern (* GdkCursor) gdk_cursor_new_for_display
+ (display (* GdkDisplay))
(cursor_type GdkCursorType))
\ No newline at end of file
(typedef guint16 ushort)
(typedef guint32 uint)
;(typedef guint64 ulonglong)
-;(typedef gssize int)
+(typedef gssize int)
(typedef gsize uint)
;(typedef gchar char)
(include "gdk")
(include "gtkadjustment")
(include "gtkcontainer")
+(include "gtkcssprovider")
(include "gtkenums")
(include "gtkframe")
(include "gtkgrid")
(include "gtkpaned")
(include "gtkscrolledwindow")
(include "gtkstylecontext")
+(include "gtkstyleprovider")
(include "gtktogglebutton")
(include "gtktypeutils")
(include "gtkwidget")
(extern void
gtk_container_set_border_width
(container (* GtkContainer))
- (border_width guint))
-
-(extern void
- gtk_container_resize_children
- (container (* GtkContainer)))
\ No newline at end of file
+ (border_width guint))
\ No newline at end of file
--- /dev/null
+#| -*-Scheme-*-
+
+gtk/gtkcssprovider.h |#
+
+(extern (* GtkCssProvider)
+ gtk_css_provider_new)
+
+(extern gboolean
+ gtk_css_provider_load_from_data
+ (css_provider (* GtkCssProvider))
+ (data (* (const gchar)))
+ (length gssize)
+ (error (* (* GError))))
+
+(extern gboolean
+ gtk_css_provider_load_from_file
+ (css_provider (* GtkCssProvider))
+ (file (* GFile))
+ (error (* (* GError))))
+
+(extern gboolean
+ gtk_css_provider_load_from_path
+ (css_provider (* GtkCssProvider))
+ (path (* (const gchar)))
+ (error (* (* GError))))
+
+(extern (* GtkCssProvider)
+ gtk_css_provider_get_default)
+
+(extern (* GtkCssProvider)
+ gtk_css_provider_get_named
+ (name (* (const gchar)))
+ (variant (* (const gchar))))
\ No newline at end of file
gtk/gtkstylecontext.h |#
-(extern void gtk_style_context_add_class
+(extern void gtk_style_context_add_provider
(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))
+ (provider (* GtkStyleProvider))
+ (priority guint))
(extern void gtk_style_context_set_background
(context (* GtkStyleContext))
--- /dev/null
+#| -*-Scheme-*-
+
+gtk/gtkstyleprovider.h |#
+
+(enum (GTK_STYLE_PROVIDER_PRIORITY_FALLBACK)
+ (GTK_STYLE_PROVIDER_PRIORITY_THEME)
+ (GTK_STYLE_PROVIDER_PRIORITY_SETTINGS)
+ (GTK_STYLE_PROVIDER_PRIORITY_APPLICATION)
+ (GTK_STYLE_PROVIDER_PRIORITY_USER))
\ No newline at end of file
(extern void gtk_widget_grab_focus
(widget (* GtkWidget)))
+(extern void gtk_widget_set_name
+ (widget (* GtkWidget))
+ (name (* (const gchar))))
+
(extern void
gtk_widget_set_state_flags
(widget (* GtkWidget))
(width gint)
(height gint))
+(extern void gtk_widget_set_opacity
+ (widget (* GtkWidget))
+ (opacity gdouble))
+
+(extern (* GdkDisplay) gtk_widget_get_display
+ (widget (* GtkWidget)))
+
(extern void gtk_widget_set_hexpand
(widget (* GtkWidget))
(expand gboolean))
(extern gint gtk_widget_get_events
(widget (* GtkWidget)))
-(extern void gtk_widget_override_color
- (widget (* GtkWidget))
- (state GtkStateFlags)
- (color (* (const GdkRGBA))))
-
-(extern void gtk_widget_override_background_color
- (widget (* GtkWidget))
- (state GtkStateFlags)
- (color (* (const GdkRGBA))))
-
-(extern void gtk_widget_override_font
- (widget (* GtkWidget))
- (font_desc (* (const PangoFontDescription))))
-
(extern gboolean
gtk_widget_is_composited
(widget (* GtkWidget)))
(window (* GtkWindow))
(title (* (const gchar))))
-(extern void
- gtk_window_set_opacity
- (window (* GtkWindow))
- (opacity gdouble))
-
(extern void
gtk_window_set_type_hint
(window (* GtkWindow))
(hint GdkWindowTypeHint))
-(extern gdouble
- gtk_window_get_opacity
- (window (* GtkWindow)))
-
(extern void
gtk_window_set_geometry_hints
(window (* GtkWindow))
(compile-file "fix-layout" '("gtk") (->environment '(gtk fix-layout)))
(compile-file "keys" '("gtk") (->environment '(gtk keys)))
(compile-file "main" '("gtk") (->environment '(gtk main)))
- ;(compile-file "thread" '("main") (->environment '(gtk thread)))
(compile-file "gtk-ev" '("gtk") (->environment '(gtk event-viewer)))
- (compile-file "gtk-graphics" '("gtk")
- (->environment '(runtime gtk-graphics)))
;; Users of the toolkit interface do NOT use the FFI directly,
;; and do not need integrable definitions.
+ (compile-file "gtk-graphics" '("gtk")
+ (->environment '(runtime gtk-graphics)))
(compile-file "fix-demo" '() (->environment '(gtk fix-layout demo)))
(compile-file "swat" '() (->environment '(gtk swat)))
(compile-file "swat-pole-zero" '() (->environment '(swat)))
(define (make-fix-layout-demo)
(let* ((window (let ((w (gtk-window-new 'toplevel)))
- (gtk-window-set-opacity w 0.90)
+ (gtk-widget-set-opacity w 0.90)
(gtk-window-set-title w "fix-layout-demo")
(set-gtk-window-delete-event-callback!
w (lambda (w) (%trace ";closed "w"\n") 0))
(define-method fix-widget-realize-callback ((widget <demo-layout>))
(call-next-method widget)
- (set-gtk-widget-bg-color! widget "white")
- (set-fix-widget-pointer-shape! widget 'crosshair))
+ (set-fix-widget-pointer-shape! widget 'crosshair)
+ (let ((style-provider (gtk-css-provider-new)))
+ (gtk-css-provider-load-from-data
+ style-provider "ScmWidget { background: white }")
+ (gtk-style-context-add-provider (gtk-widget-get-style-context widget)
+ style-provider 'fallback)
+ (gobject-unref! style-provider)))
(define (make-demo-drawing widget)
(let ((drawing (%make-demo-drawing)))
(let ((name.value (or (assq name alist)
(error "Not a pointer shape:" name
(map car alist))))
- (alien (make-alien '|GdkCursor|)))
- ;; 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 "g_object_unref" alien)))))
+ (cursor (make-alien '|GdkCursor|))
+ (display (make-alien '|GdkDisplay|)))
+ ;; GC-protect cursor!
+ (C-call "gtk_widget_get_display" display (gobject-alien widget))
+ (C-call "gdk_cursor_new_for_display" cursor display (cdr name.value))
+ (C-call "gdk_window_set_cursor" (fix-widget-window widget) cursor)
+ (C-call "g_object_unref" cursor)))))
\f
(define (event-callback widget GdkEvent)
(%trace2 ";event-callback "widget)
((= 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 fix-widget-realize-callback ((widget <fix-layout>))
(call-next-method widget)
(%trace "; (fix-widget-realize-callback <fix-layout>) "widget"\n")
+ #;(let ((style (gtk-widget-style-context widget)))
+ (C-call "gtk_style_context_set_background"
+ style (fix-widget-window widget)))
(adjust-adjustments widget))
(define (adjustments-callback widget hGtkAdjustment vGtkAdjustment)
(C-call "gdk_window_set_user_data" main-GdkWindow alien)
;; Event window
- (C-call "gdk_cursor_new" GdkCursor (C-enum "GDK_CROSSHAIR"))
+ (let ((GdkDisplay (make-alien '|GdkDisplay|)))
+ (C-call "gtk_widget_get_display" GdkDisplay alien)
+ (C-call "gdk_cursor_new_for_display" GdkCursor
+ GdkDisplay (C-enum "GDK_CROSSHAIR")))
(error-if-null GdkCursor "Could not create cursor:" widget)
(C->= attr "GdkWindowAttr window_type" (C-enum "GDK_WINDOW_CHILD"))
(let ((b (gtk-event-viewer-event-box widget)))
(C-call "gdk_window_show" event-GdkWindow)
(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)
((eq? handled? #f) 0)
(else (warn "Event callback not boolean:" callback)
0)))))
+
+(define (gtk-widget-set-opacity widget opacity)
+ (guarantee-gtk-widget widget 'gtk-widget-set-opacity)
+ (guarantee-real opacity 'gtk-widget-set-opacity)
+ (if (not (<= 0. opacity 1.))
+ (error:bad-range-argument opacity 'gtk-widget-set-opacity))
+ (C-call "gtk_widget_set_opacity" (gobject-alien widget) opacity))
+
+(define (gtk-widget-set-name widget name)
+ (guarantee-gtk-widget widget 'gtk-widget-set-name)
+ (guarantee-string name 'gtk-widget-set-name)
+ (C-call "gtk_widget_set_name" (gobject-alien widget) name))
\f
-;;; GtkWidget Font
+;;; GtkStyleContext & GtkCssProvider
(define-integrable (gtk-widget-style-context widget)
(let ((style (make-alien '|GtkStyleContext|)))
(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 ((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 widget 'set-gtk-widget-font!)
- (let ((font (->PangoFontDescription desc)))
- (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)))
- (pango-font-description-copy desc))
- ((string? desc)
- (let ((alien (pango-font-description-from-string desc)))
- (if (alien-null? alien)
- (error:wrong-type-argument desc "PangoFontDescription string"
- '->PangoFontDescription)
- alien)))
- (else (error:wrong-type-argument desc "PangoFontDescription"
- '->PangoFontDescription))))
-\f
-;;; GtkWidget Colors
-
-(define (gtk-widget-fg-color widget #!optional state)
- (guarantee-gtk-widget-realized widget 'gtk-widget-fg-color)
- (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 ((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 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!)))
- (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 ((rgba (->rgba color widget '(set-gtk-widget-bg-color! <gtk-widget>)))
- (state (->gtk-widget-state state '(set-gtk-widget-bg-color! <gtk-widget>))))
- (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_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))))
+ (warn "Not yet realized:" widget operator)))
+
+(define (gtk-widget-get-style-context widget)
+ (guarantee-gtk-widget-realized widget 'gtk-widget-get-style-context)
+ (gtk-widget-style-context widget))
+
+(define-integrable (gtk-style-context? object)
+ (and (alien? object) (eq? '|GtkStyleContext| (alien/ctype object))))
+
+(define-guarantee gtk-style-context "a GtkStyleContext alien")
+
+(define (gtk-style-context-add-provider style-context css-provider priority)
+ (guarantee-gtk-style-context style-context 'gtk-style-context-add-provider)
+ (guarantee-gtk-css-provider css-provider 'gtk-style-context-add-provider)
+ (C-call "gtk_style_context_add_provider"
+ style-context
+ (gobject-alien css-provider)
+ (->gtk-style-provider-priority priority
+ 'gtk-style-context-add-provider)))
+
+(define (->gtk-style-provider-priority priority operator)
+ (if (exact-nonnegative-integer? priority)
+ priority
+ (case priority
+ ((FALLBACK) (C-enum "GTK_STYLE_PROVIDER_PRIORITY_FALLBACK"))
+ ((THEME) (C-enum "GTK_STYLE_PROVIDER_PRIORITY_THEME"))
+ ((SETTINGS) (C-enum "GTK_STYLE_PROVIDER_PRIORITY_SETTINGS"))
+ ((APPLICATION) (C-enum "GTK_STYLE_PROVIDER_PRIORITY_APPLICATION"))
+ ((USER) (C-enum "GTK_STYLE_PROVIDER_PRIORITY_USER"))
+ (else (error:wrong-type-argument
+ priority "a GtkStylProvider priority" operator)))))
+
+(define-class <gobject-with-gerror*> (<gobject>)
+ ;; A <gobject> with associated *GError that gets freed when the
+ ;; <gobject> is GCed.
+ (gerror* define accessor accessor gobject-gerror*
+ initializer (lambda () (make-alien '(* |GError|)))))
+
+(define-method initialize-instance ((object <gobject-with-gerror*>))
+ (call-next-method object)
+ (let ((gerror* (gobject-gerror* object)))
+ (C-call "g_try_malloc0" gerror* (C-sizeof "* GError"))
+ (error-if-null gerror* "Could not allocate:" gerror*)
+ (add-glib-cleanup object (make-gerror*-cleanup gerror*))))
+
+(define (make-gerror*-cleanup gerror*)
+ (named-lambda (gerror*-cleanup)
+ (if (not (alien-null? gerror*))
+ (let ((gerror (make-alien '|GError|)))
+ (C-> gerror* "* GError" gerror)
+ (if (not (alien-null? gerror))
+ (C-call "g_error_free" gerror))
+ (C-call "g_free" gerror*)
+ (alien-null! gerror*)))))
+
+(define (error-if-gerror* gerror* message . data)
+ (let ((gerror (C-> gerror* "* GError")))
+ (if (not (alien-null? gerror))
+ (let ((errmsg (c-peek-cstring (C-> gerror "GError message"))))
+ (without-interruption
+ (lambda ()
+ (C->= gerror* "* GError" 0)
+ (C-call "g_error_free" gerror)))
+ (apply error message errmsg data)))))
+
+(define-class (<gtk-css-provider> (constructor ()))
+ (<gobject-with-gerror*>))
+
+(define-guarantee gtk-css-provider "a <gtk-css-provider>")
+
+(define (gtk-css-provider-new)
+ (let* ((object (make-gtk-css-provider))
+ (alien (gobject-alien object)))
+ (C-call "gtk_css_provider_new" alien)
+ (error-if-null alien "Could not create:" object)
+ (C-call "g_object_ref_sink" alien alien)
+ object))
+
+(define (gtk-css-provider-get-default)
+ (let* ((object (make-gtk-css-provider))
+ (alien (gobject-alien object)))
+ (C-call "gtk_css_provider_get_default" alien)
+ (error-if-null alien "Could not get default GtkCssProvider:" object)
+ (C-call "g_object_ref" alien alien)
+ object))
+
+(define (gtk-css-provider-get-named name variant)
+ (guarantee-string name 'gtk-css-provider-get-named)
+ (let* ((v (if (eq? #f variant)
+ 0
+ (begin
+ (guarantee-string variant 'gtk-css-provider-get-named)
+ variant)))
+ (object (make-gtk-css-provider))
+ (alien (gobject-alien object)))
+ (C-call "gtk_css_provider_get_named" alien name v)
+ (error-if-null alien "Could not get named GtkCssProvider:"
+ object name variant)
+ (C-call "g_object_ref" alien alien)
+ object))
+
+(define (gtk-css-provider-load-from-data provider string)
+ (guarantee-gtk-css-provider provider 'gtk-css-provider-load-from-data)
+ (guarantee-string string 'gtk-css-provider-load-from-data)
+ (let ((alien (gobject-alien provider))
+ (gerror* (gobject-gerror* provider)))
+ (C-call "gtk_css_provider_load_from_data" alien string -1 gerror*)
+ (error-if-gerror* gerror* "Could not load GtkCssProvider data:" provider)))
+
+(define-guarantee gfile "a <gfile>")
+
+(define (gtk-css-provider-load-from-file provider gfile)
+ (guarantee-gtk-css-provider provider 'gtk-css-provider-load-from-file)
+ (guarantee-gfile gfile 'gtk-css-provider-load-from-file)
+ (let ((alien (gobject-alien provider))
+ (gerror* (gobject-gerror* provider))
+ (gfile-alien (gobject-alien gfile)))
+ (C-call "gtk_css_provider_load_from_file" alien gfile-alien gerror*)
+ (error-if-gerror* gerror* "Could not load GtkCssProvider GFile:"
+ provider gfile)))
+
+(define (gtk-css-provider-load-from-path provider pathname)
+ (guarantee-gtk-css-provider provider 'gtk-css-provider-load-from-file)
+ (let ((namestring (->namestring
+ (pathname-simplify
+ (merge-pathnames pathname (working-directory-pathname)))))
+ (alien (gobject-alien provider))
+ (gerror* (gobject-gerror* provider)))
+ (C-call "gtk_css_provider_load_from_path" alien namestring gerror*)
+ (error-if-gerror* gerror* "Could not load GtkCssProvider path:"
+ provider namestring)))
\f
;;; GtkContainers
(guarantee-string title 'gtk-window-set-title)
(C-call "gtk_window_set_title" (gobject-alien window) title))
-(define (gtk-window-set-opacity window opacity)
- (guarantee-gtk-window window 'gtk-window-set-opacity)
- (guarantee-real opacity 'gtk-window-set-opacity)
- (if (not (<= 0. opacity 1.))
- (error:bad-range-argument opacity 'gtk-window-set-opacity))
- (C-call "gtk_window_set_opacity" (gobject-alien window) opacity))
-
(define (gtk-window-set-type-hint window hint)
(guarantee-gtk-window window 'gtk-window-set-type-hint)
(let ((type-hint (->type-hint hint 'gtk-window-set-type-hint)))
(define-package (gtk gtk-widget)
(parent (gtk))
(files "gtk-widget")
- ;;(depends-on "gtk.bin" "gtk" "../runtime/ffi")
+ ;;(depends-on "gtk.bin" "gtk" "../runtime/ffi" "../pango/" "../glib/")
(export (gtk)
<gtk-adjustment> gtk-adjustment? guarantee-gtk-adjustment
make-gtk-adjustment set-gtk-adjustment!
set-gtk-widget-unrealize-callback!
set-gtk-widget-draw-callback!
set-gtk-widget-event-callback!
-
- gtk-widget-parse-color
- gtk-widget-fg-color gtk-widget-bg-color
- set-gtk-widget-fg-color! set-gtk-widget-bg-color!
- gtk-widget-font set-gtk-widget-font!
+ gtk-widget-set-opacity
+ gtk-widget-set-name
+ gtk-widget-get-style-context
+ gtk-style-context?
+ gtk-style-context-add-provider
+
+ <gtk-css-provider> gtk-css-provider? guarantee-gtk-css-provider
+ gtk-css-provider-new
+ gtk-css-provider-get-default
+ gtk-css-provider-get-named
+ gtk-css-provider-load-from-data
+ gtk-css-provider-load-from-file
+ gtk-css-provider-load-from-path
<gtk-container> gtk-container? guarantee-gtk-container
gtk-container-children gtk-bin-child
gtk-window-new gtk-window-type
gtk-window-set-geometry-hints
gtk-window-set-title
- gtk-window-set-opacity
gtk-window-set-type-hint
gtk-window-set-default-size gtk-window-get-default-size
gtk-window-parse-geometry
gtk-paned-get-child1 gtk-paned-get-child2
gtk-paned-get-position gtk-paned-set-position
<gtk-paned-view> gtk-paned-view? gtk-paned-view-new)
- (import (pango) make-pango-layout guarantee-pango-font-description))
+ (import (pango) make-pango-layout guarantee-pango-font-description)
+ (import (gio) gfile?))
(define-package (gtk widget)
(parent (gtk))
(define-package (gtk fix-layout)
(parent (gtk))
(files "fix-layout")
- ;;(depends-on "pango" "cairo" "gtk.bin" gtk" "../runtime/ffi" "gtk-const.bin")
+ ;;(depends-on "pango" "cairo" "gtk.bin" "gtk" "../runtime/ffi" "gtk-const.bin")
(import (ffi)
find-c-includes
c-enum-constant-values)
(import (cairo)
cairo-identity-matrix cairo-matrix-scale! cairo-matrix-translate!
cairo-point x y cairo-transform! guarantee-flonum)
- (import (gtk fix-layout)
- fix-layout-view)
(export ()
make-fix-layout-demo))
@deffn Procedure gtk-graphics/set-foreground-color device color
@deffnx Procedure gtk-graphics/set-background-color device color
Sets the foreground and background colors for future drawing
-operations. @var{Color} can be a color name or specification.
-@xref{colors}.
+operations. @var{Color} should be a color name or specification
+understood by the Cairo plugin. @xref{colors, , Cairo Colors,
+mit-scheme-cairo, MIT/GNU Scheme Cairo Plugin}.
@end deffn
@deffn Procedure gtk-graphics/clear device
* Pixbuf Loader::
* Gtk Adjustment::
* Gtk Widget::
+* Gtk CSS Provider::
* Gtk Container::
* Gtk Window::
* Gtk Label::
@end table
@end deffn
-@node Gtk Widget, Gtk Container, Gtk Adjustment, API Reference
+@node Gtk Widget, Gtk CSS Provider, Gtk Adjustment, API Reference
@section Gtk Widget
A gtk-widget is a gobject that can be "destroyed". Each instance is
@code{#t} if @var{widget} has an alpha channel.
@end deffn
+@deffn Procedure gtk-widget-set-opacity widget opacity
+Request a partially transparent @var{widget}. @var{Opacity} can vary
+from 0.0 (fully transparent) to 1.0 (fully opaque). On X11 the
+request has no effect without a compositing manager.
+@xref{gtk-widget-is-composited?}.
+Note that setting a window's
+opacity after the window has been shown causes it to flicker once on
+Windows.
+@end deffn
+
@deffn Procedure gtk-widget-show widget
Indicates @var{widget} is ready to be displayed. If you want to show
all widgets in a container, it is easier to call
height so that a top-level window cannot be resized to a smaller size.
@end deffn
-@subsection Gtk Widget Colors & Fonts
-@anchor{colors}
+@node Gtk CSS Provider, Gtk Container, Gtk Widget, API Reference
-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.
+A GtkWidget's GtkStyleContext specifies its default font and colors
+per its state and theme. A GtkCssProvider can be added to the context
+to specify defaults (or overrides) using a language similar to
+Cascading Style Sheets (@acronym{CSS}). In this language, element
+names select widgets by class (e.g. @code{ScmWidget}) and element ids
+select widgets by name.
-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
+@deffn Procedure gtk-widget-set-name widget name
+Gives @var{widget} @var{name}. The style of the widget (its font,
+colors, etc.) can then be specified using @var{name} in syntax much
+like the id selectors of Cascading Style Sheets (@acronym{CSS}).
+@xref{Gtk CSS Provider}. Note that the CSS selector syntax allows
+only alphanumerics, dashes and underscores in widget names.
+@end deffn
-@anchor{gtk-widget-parse-color}
-@deffn Procedure gtk-widget-parse-color widget spec
-Resolves @var{spec} into a color. A symbolic color name is resolved
-according to @var{widget}'s style.
+@deffn Procedure gtk-widget-get-style-context widget
+Returns the GtkStyleContext associated with @var{widget}.
+@var{Widget} must be realized. The returned object is only valid
+until @var{widget} changes 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}.
+@deffn Procedure gtk-style-context? object
+Type predicate.
+@end deffn
-@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}.
-@var{State} defaults to @code{normal}.
+@deffn Procedure gtk-style-context-add-provider context provider priority
+Adds @var{provider}, a GtkStyleProvider, to the style @var{context}.
+@var{Priority} can be a non-negative integer or one of the symbols
+@code{fallback}, @code{theme}, @code{settings}, @code{application} or
+@code{user} (equivalent to the integers 1, 200, 400, 600 and 800
+respectively). Styles specified with high priority override lower
+priority specifications.
@end deffn
-@deffn Procedure gtk-widget-bg-color widget #!optional state
-@var{Widget}'s background color. Similar to
-@bref{gtk-widget-fg-color}.
+@deffn Class <gtk-css-provider>
+A direct subclass of gobject representing a reference to a
+GtkCssProvider.
@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} 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.
+@deffn Procedure gtk-css-provider?
+Type predicate.
+@end deffn
+
+@deffn Procedure guarantee-gtk-css-provider
+Type guarantor.
@end deffn
-@deffn Procedure set-gtk-widget-bg-color! widget color #!optional state
-Sets the background color of @var{widget}. See
-@bref{set-gtk-widget-fg-color!}.
+@deffn Procedure gtk-css-provider-new
+A new GtkCssProvider.
@end deffn
-@deffn Procedure gtk-widget-font widget
-A PangoFontDescription alien --- a toolkit object owned by @var{widget}.
+@deffn Procedure gtk-css-provider-get-default
+Returns the provider containing the style settings used as a fallback
+for all widgets.
@end deffn
-@deffn Procedure set-gtk-widget-font! widget font
-Set @var{widget} to use @var{font}, a PangoFontDescription.
-@var{Widget} will ref @var{font}; Scheme can free it.
+@deffn Procedure gtk-css-provider-get-named name variant
+Returns a GtkCssProvider in which a named theme has been loaded.
+@var{Name} must be a string. @var{Variant} can be @code{#f} or a
+string, for example: @code{"dark"}.
@end deffn
-@node Gtk Container, Gtk Window, Gtk Widget, API Reference
+@deffn Procedure gtk-css-provider-load-from-data provider string
+Loads the CSS-like @var{string} into @var{provider}, clearing any
+previously loaded information.
+@end deffn
+
+@deffn Procedure gtk-css-provider-load-from-file provider gfile
+Loads the CSS-like content of @var{gfile} (a GFile) into
+@var{provider}, clearing any previously loaded information.
+@end deffn
+
+@deffn Procedure gtk-css-provider-load-from-path provider path
+Loads the CSS-like content of the file named @var{path} (a string or
+pathname) into @var{provider}, clearing any previously loaded
+information.
+@end deffn
+
+@node Gtk Container, Gtk Window, Gtk CSS Provider, API Reference
@section Gtk Container
A Gtk widget with a list of ``children''. The list records only the
include the application name and current document.
@end deffn
-@deffn Procedure gtk-window-set-opacity window opacity
-Request a partially transparent @var{window}. @var{Opacity} can vary
-from 0.0 (fully transparent) to 1.0 (fully opaque). On X11 the
-request has no effect without a compositing manager.
-@xref{gtk-widget-is-composited?}.
-Note that setting a window's
-opacity after the window has been shown causes it to flicker once on
-Windows.
-@end deffn
-
@anchor{gtk-window-set-default-size}
@deffn Procedure gtk-window-set-default-size window width height
Sets @var{window}'s default size to @var{width} x @var{height}. If
(if (swat-widget-realized? widget) (realize-option widget name spec)))
(define (realize-option widget name spec)
- (case name
+ #;(case name
((foreground) (set-gtk-widget-fg-color! widget spec 'normal))
((background) (set-gtk-widget-bg-color! widget spec 'normal))
((activeforeground) (set-gtk-widget-fg-color! widget spec 'active))
((activebackground) (set-gtk-widget-bg-color! widget spec 'active))
((font) (set-gtk-widget-font! widget spec))
- (else (warn "Cannot realize widget option:" name spec widget))))
+ (else (warn "Cannot realize widget option:" name spec widget)))
+ (warn "Cannot realize widget option:" name spec widget))
(define (realize-options widget)
(set-swat-widget-realized?! widget #t)
projects / mit-scheme.git / commitdiff