(define black (make-rgba-color 0. 0. 0. 1.))
(define (->color spec operator)
+ (assert-glib-locked '->color)
(cond ((color? spec) spec)
((eq? spec 'WHITE) white)
((eq? spec 'BLACK) black)
(define (pango-color-parse spec)
(guarantee string? spec 'pango-color-parse)
+ (assert-glib-locked 'pango-color-parse)
(let ((rgb (malloc (C-sizeof "PangoColor") '|PangoColor|)))
(if (zero? (C-call "pango_color_parse" rgb (string->utf8 spec)))
(error:wrong-type-argument spec "a color spec" 'pango-color-parse)
(define (pango-layout-get-context layout)
(guarantee-pango-layout layout 'pango-layout-get-context)
+ (assert-glib-locked 'pango-layout-get-context)
(C-call "pango_layout_get_context"
(make-alien '|PangoContext|)
(gobject-alien layout)))
(define (pango-layout-context-changed layout)
(guarantee-pango-layout layout 'pango-layout-context-changed)
+ (assert-glib-locked 'pango-layout-context-changed)
(C-call "pango_layout_context_changed" (gobject-alien layout)))
(define (pango-layout-get-font-description layout)
(guarantee-pango-layout layout 'pango-layout-get-font-description)
+ (assert-glib-locked 'pango-layout-get-font-description)
(C-call "pango_layout_get_font_description"
(make-alien '|PangoFontDescription|)
(gobject-alien layout)))
(define (pango-layout-set-font-description layout font)
;; The toolkit makes a copy of FONT.
(guarantee-pango-font-description font 'pango-layout-set-font-description)
+ (assert-glib-locked 'pango-layout-set-font-description)
(C-call "pango_layout_set_font_description"
(gobject-alien layout) (if (not font) 0 font)))
(define (pango-layout-set-text layout text)
(guarantee-pango-layout layout 'pango-layout-set-text)
(guarantee string? text 'pango-layout-set-text)
+ (assert-glib-locked 'pango-layout-set-text)
(let ((text-bv (string->utf8 text)))
(C-call "pango_layout_set_text" (gobject-alien layout)
text-bv (bytevector-length text-bv))))
(define (pango-layout-set-markup layout markup)
(guarantee-pango-layout layout 'pango-layout-set-markup)
(guarantee string? markup 'pango-layout-set-markup)
+ (assert-glib-locked 'pango-layout-set-markup)
(let ((markup-bv (string->utf8 markup)))
(C-call "pango_layout_set_markup" (gobject-alien layout)
markup-bv (bytevector-length markup-bv))))
(define (pango-layout-get-pixel-extents layout receiver)
(guarantee-pango-layout layout 'pango-layout-set-text)
(guarantee-procedure-of-arity receiver 2 'pango-layout-set-text)
+ (assert-glib-locked 'pango-layout-get-pixel-extents)
(let (;(ink-extent (pango-rectangle))
(logical-extent (pango-rectangle)))
(C-call "pango_layout_get_pixel_extents"
(define (pango-layout-index-to-pos layout index receiver)
(guarantee-pango-layout layout 'pango-layout-index-to-pos)
(guarantee-procedure-of-arity receiver 4 'pango-layout-index-to-pos)
+ (assert-glib-locked 'pango-layout-index-to-pos)
(let ((rect (pango-rectangle)))
(C-call "pango_layout_index_to_pos" (gobject-alien layout) index rect)
(let ((x (pangos->pixels (C-> rect "PangoRectangle x")))
(define (pango-layout-xy-to-index layout x y)
(guarantee-pango-layout layout 'pango-layout-xy-to-index)
+ (assert-glib-locked 'pango-layout-xy-to-index)
(let ((index-alien (malloc (C-sizeof "int") 'int)))
(if (fix:= 0 (C-call "pango_layout_xy_to_index"
(gobject-alien layout)
(define (pango-layout-get-baseline layout)
(guarantee-pango-layout layout 'pango-layout-get-baseline)
+ (assert-glib-locked 'pango-layout-get-baseline)
(let ((iter (make-alien '|PangoLayoutIter|))
(copy (make-alien '|PangoLayoutIter|)))
(add-glib-cleanup iter (make-pango-layout-iter-cleanup copy))
(define (make-pango-layout-iter-cleanup alien)
(named-lambda (pango-layout-iter-cleanup)
- ;;without-interrupts
+ (assert-glib-locked 'pango-layout-iter-cleanup)
+ (assert-without-interruption 'pango-layout-iter-cleanup)
(if (not (alien-null? alien))
(begin
(C-call "pango_layout_iter_free" alien)
(alien-null! alien)))))
(define (pango-layout-iter-free iter)
- (without-interrupts
+ (assert-glib-locked 'pango-layout-iter-free)
+ (without-interruption
(lambda ()
(if (not (alien-null? iter))
(begin
(define (pango-font-description-from-string string)
;; The returned PangoFontDescription is owned by Scheme.
(guarantee string? string 'pango-font-description-from-string)
+ (assert-glib-locked 'pango-font-description-from-string)
(let ((font (make-alien '|PangoFontDescription|))
(copy (make-alien '|PangoFontDescription|))
(string-bv (string->utf8 string)))
(define (make-pango-font-description-cleanup alien)
(named-lambda (pango-font-description-cleanup)
- ;;without-interrupts
+ (assert-glib-locked 'pango-font-description-cleanup)
+ (assert-without-interruption 'pango-font-description-cleanup)
(if (not (alien-null? alien))
(begin
(C-call "pango_font_description_free" alien)
(define (pango-font-description-free font)
(guarantee-pango-font-description font 'pango-font-description-free)
- (without-interrupts
+ (assert-glib-locked 'pango-font-description-free)
+ (without-interruption
(lambda ()
(if (not (alien-null? font))
(begin
(define (pango-font-description-to-string font)
(guarantee-pango-font-description font 'pango-font-description-to-string)
+ (assert-glib-locked 'pango-font-description-to-string)
(if (alien-null? font)
"<null>"
- (without-interrupts
+ (without-interruption
(lambda ()
(let ((cstr (make-alien '|char|)))
(C-call "pango_font_description_to_string" cstr font)
(define (pango-font-description-copy font)
(guarantee-pango-font-description font 'pango-font-description-copy)
+ (assert-glib-locked 'pango-font-description-copy)
(let ((new (make-alien '|PangoFontDescription|))
(copy (make-alien '|PangoFontDescription|)))
(add-glib-cleanup new (make-pango-font-description-cleanup copy))
;; The returned PangoFontDescription is owned by the toolkit
;; (the PangoContext), not Scheme.
(guarantee-pango-context context 'pango-context-get-font-description)
+ (assert-glib-locked 'pango-context-get-font-description)
(C-call "pango_context_get_font_description"
(make-alien '|PangoFontDescription|) context))
;; FONT is still owned by Scheme. The toolkit makes a copy.
(guarantee-pango-context context 'pango-context-set-font-description)
(guarantee-pango-font-description font 'pango-context-set-font-description)
+ (assert-glib-locked 'pango-context-set-font-description)
(C-call "pango_context_set_font_description" context font))
(define (pango-context-get-metrics context font)
;; The new PangoFontMetrics is owned by Scheme.
(guarantee-pango-context context 'pango-context-get-metrics)
(guarantee-pango-font-description font 'pango-context-get-metrics)
+ (assert-glib-locked 'pango-context-get-metrics)
(let ((alien (make-alien '|PangoFontMetrics|))
(copy (make-alien '|PangoFontMetrics|)))
(add-glib-cleanup alien (make-pango-font-metrics-cleanup copy))
(define (pango-context-spacing context)
(guarantee-pango-context context 'pango-context-spacing)
+ (assert-glib-locked 'pango-context-spacing)
(let ((layout (make-alien '|PangoLayout|)))
(C-call "pango_layout_new" layout context)
(let ((spacing (C-call "pango_layout_get_spacing" layout)))
(define (make-pango-font-metrics-cleanup alien)
(named-lambda (pango-font-metrics-cleanup)
- ;;without-interrupts
+ (assert-glib-locked 'pango-font-metrics-cleanup)
+ (assert-without-interruption 'pango-font-metrics-cleanup)
(if (not (alien-null? alien))
(begin
(C-call "pango_font_metrics_unref" alien)
(define (pango-font-metrics-unref metrics)
(guarantee-pango-font-metrics metrics 'pango-font-metrics-unref)
- (without-interrupts
+ (assert-glib-locked 'pango-font-metrics-unref)
+ (without-interruption
(lambda ()
(if (not (alien-null? metrics))
(begin
(define (pango-font-metrics-get-ascent metrics)
(guarantee-live-pango-font-metrics metrics 'pango-font-metrics-get-ascent)
+ (assert-glib-locked 'pango-font-metrics-get-ascent)
(C-call "pango_font_metrics_get_ascent" metrics))
(define (pango-font-metrics-get-descent metrics)
(guarantee-live-pango-font-metrics metrics 'pango-font-metrics-get-descent)
+ (assert-glib-locked 'pango-font-metrics-get-descent)
(C-call "pango_font_metrics_get_descent" metrics))
(define (pango-font-metrics-get-approximate-char-width metrics)
(guarantee-live-pango-font-metrics metrics 'pango-font-metrics-get-approximate-char-width)
+ (assert-glib-locked 'pango-font-metrics-get-approximate-char-width)
(C-call "pango_font_metrics_get_approximate_char_width" metrics))
(define-integrable (guarantee-live-pango-font-metrics object operator)
(define-integrable (pixels->pangos pixel-units)
(* pixel-units 1024))
\f
-;;; Debugging hacks. No cleanups!
+;;; Debugging hacks. No cleanups! No locking!
(define (pango-context-list-families PangoContext)
(let ((data-arg (malloc (C-sizeof "*") '(* (* |PangoFontFamily|))))