From: Stephen Adams <edu/mit/csail/zurich/adams>
Date: Wed, 31 Jul 1996 18:31:20 +0000 (+0000)
Subject: Fix thinko: only conditions are errors!
X-Git-Tag: 20090517-FFI~5402
X-Git-Url: https://birchwood-abbey.net/git?a=commitdiff_plain;h=31ff38b8a0ff345d9798d97ad215846699d79203;p=mit-scheme.git

Fix thinko: only conditions are errors!
---

diff --git a/v7/src/swat/scheme/tk-mit.scm b/v7/src/swat/scheme/tk-mit.scm
index c70ddcf88..648fcf88c 100644
--- a/v7/src/swat/scheme/tk-mit.scm
+++ b/v7/src/swat/scheme/tk-mit.scm
@@ -1,7 +1,7 @@
 ; -*- Scheme -*-
 ;;;;; C external interfaces to Tk procedures not associated with
 ;;;;; a particular widget.
-;;;; $Id: tk-mit.scm,v 1.2 1996/07/31 18:12:58 adams Exp $
+;;;; $Id: tk-mit.scm,v 1.3 1996/07/31 18:31:20 adams Exp $
 
 ;;;; This is the lowest level Scheme interface to general TK/TCL data
 ;;;; structures.  Primitives are defined in tk-mit.c and tk.c
@@ -349,19 +349,20 @@
 (define (apply-callback callback arglist)
   (cond ((ignore-errors
 	  (lambda () (apply callback arglist)))
-	 => (lambda (condition)
-	      (let ((port  (notification-output-port)))
-		(newline port)
-		(write-string "; Error in callback " port)
-		(display callback port)
-		(newline port)
-		(write-string ";" port)
-		(write-condition-report condition port)
-		(newline port)
-		(write-string ";To debug, type (debug (unhash " port)
-		(write (hash condition) port)
-		(write-string "))" port)
-		(newline port))))))
+	 => (lambda (result)
+	      (if (condition? result)
+		  (let ((port  (notification-output-port)))
+		    (newline port)
+		    (write-string ";Error in callback " port)
+		    (display callback port)
+		    (newline port)
+		    (write-string ";" port)
+		    (write-condition-report result port)
+		    (newline port)
+		    (write-string ";To debug, type (debug #@" port)
+		    (write (hash result) port)
+		    (write-string ")" port)
+		    (newline port)))))))
 
 
 (define *event-processing-mutex* (make-thread-mutex))