|#
-;;;; GtkObjects
+;;;; GObjects
;;; package: (gtk gobject)
(c-include "gtk")
(define (make-gobject-signal-callback name weak-pair callback)
(named-lambda (gobject-signal-callback instance . args)
;; Callbacks run without-interrupts.
- instance ;ignore
(if (weak-pair/car? weak-pair)
(let ((gobject (weak-car weak-pair)))
- (if-debugging
- (if (not (alien=? (gobject-alien gobject) instance))
- (warn "Signal instance / gobject mismatch:" instance gobject)))
+ (if (not (alien=? (gobject-alien gobject) instance))
+ (warn "Signal instance / gobject mismatch:" instance gobject))
(apply callback gobject args))
(error "Cannot signal a <gobject> that is already GC'ed:" name args))))
value)))
(define (gobject-set-properties gobject . property-list)
- ;; WAS primitive G-OBJECT-SET-PROPERTIES [gtk.c]
(let* ((gobject-alien (gobject-alien gobject))
(gvalue (malloc (C-sizeof "GValue") '|GValue|))
(pspec (malloc (C-sizeof "GParamSpec") '|GParamSpec|))
#| -*-Scheme-*-
-Copyright (C) 2007, 2008, 2009, 2010 Matthew Birkholz
+Copyright (C) 2007, 2008, 2009, 2010, 2011 Matthew Birkholz
This file is part of MIT/GNU Scheme.
|#
;;;; Core utilities.
-;;; package: (gtk utilities)
+;;; package: (gtk)
(define-syntax define-integrable-operator
(er-macro-transformer
(else
(ill-formed-syntax form))))))
-(define-syntax if-debugging
- (er-macro-transformer
- (lambda (form rename compare)
- (declare (ignore compare))
- (let ((r-begin (rename 'BEGIN)))
- (if debugging?
- `(,r-begin ,@(cdr form))
- `(,r-begin))))))
-
-;; Setting this affects only newly-compiled code.
-(define debugging? #f)
-
(define-syntax error-if-null
(syntax-rules ()
((_ ALIEN . MESSAGE)