From 5182bda14a70211cd921ee62d08fdcabae1e1fcd Mon Sep 17 00:00:00 2001 From: Matt Birkholz Date: Wed, 22 Jun 2011 09:01:12 -0700 Subject: [PATCH] Punt if-debugging syntax. --- src/gtk/gobject.scm | 9 +++------ src/gtk/gtk.scm | 16 ++-------------- 2 files changed, 5 insertions(+), 20 deletions(-) diff --git a/src/gtk/gobject.scm b/src/gtk/gobject.scm index f795185d1..971b2daef 100644 --- a/src/gtk/gobject.scm +++ b/src/gtk/gobject.scm @@ -21,7 +21,7 @@ USA. |# -;;;; GtkObjects +;;;; GObjects ;;; package: (gtk gobject) (c-include "gtk") @@ -106,12 +106,10 @@ USA. (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 that is already GC'ed:" name args)))) @@ -266,7 +264,6 @@ USA. 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|)) diff --git a/src/gtk/gtk.scm b/src/gtk/gtk.scm index 6f7c8024b..2ef3620a5 100644 --- a/src/gtk/gtk.scm +++ b/src/gtk/gtk.scm @@ -1,6 +1,6 @@ #| -*-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. @@ -22,7 +22,7 @@ USA. |# ;;;; Core utilities. -;;; package: (gtk utilities) +;;; package: (gtk) (define-syntax define-integrable-operator (er-macro-transformer @@ -38,18 +38,6 @@ USA. (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) -- 2.25.1