Open in-engine REPL upon error.

1 files changed, 17 insertions, 71 deletions

diff --git a/catbird/kernel.scm b/catbird/kernel.scm
index 5dc31a1..6560d47 100644
--- a/catbird/kernel.scm
+++ b/catbird/kernel.scm
@@ -48,6 +48,8 @@
             current-controller-focus
             current-kernel
             current-keyboard-focus
+            default-error-handler
+            error-handler
             find-region-by-name
             frames-per-second
             kill-region
@@ -307,78 +309,22 @@
 ;;; Error handling
 ;;;
 
-(define-method (on-error (kernel <kernel>) e s)
+(define (default-error-handler exception stack)
+  (when (quit-exception? exception)
+    (raise-exception exception))
+  (let ((port (current-error-port))
+        (key (exception-kind exception))
+        (args (exception-args exception)))
+    (print-exception port (stack-ref stack 0) key args)
+    (display "Backtrace:\n" port)
+    (display-backtrace stack port)
+    (newline port)))
+
+(define-method (on-error (kernel <kernel>) exception stack)
   (if developer-mode?
-      (let* ((window (current-window))
-             (title (window-title window)))
-        (set-window-title! window (string-append "[ERROR] " title))
-        (set! (stack kernel) s)
-        (set! (exception kernel) e)
-        (set! (debugging? kernel) #t)
-        (let ((port (current-error-port)))
-          (display "an error has occurred!\n\n" port)
-          (display "Backtrace:\n" port)
-          (display-backtrace s port)
-          (newline port)
-          (display (error-message kernel) port)
-          (newline port))
-        (display "waiting for developer to debug..." (current-error-port))
-        (while (debugging? kernel)
-          (poll-coop-repl-server (repl kernel))
-          (usleep 160000)
-          #t)
-        (set-window-title! window title)
-        (set! (stack kernel) #f)
-        (set! (exception kernel) #f))
-      (raise-exception e)))
-
-(define-method (error-message (kernel <kernel>))
-  (let* ((s (stack kernel))
-         (e (exception kernel))
-         (frame (stack-ref s 0)))
-    (format #f "~a: In procedure: ~a:~%In procedure: ~a: ~a~%"
-            (match (frame-source frame)
-              ((_ file-name line . column)
-               (format #f "~a:~a:~a"
-                       (if file-name
-                           (basename file-name)
-                           "unknown file")
-                       line column))
-              (_ "unknown"))
-            (or (frame-procedure-name frame)
-                "unknown")
-            (or (and (exception-with-origin? e)
-                     (exception-origin e))
-                "unknown")
-            (if (and (exception-with-message? e)
-                     (exception-with-irritants? e))
-                (apply format #f (exception-message e)
-                       (exception-irritants e))
-                ""))))
-
-(define-method (debugger (kernel <kernel>))
-  (let ((s (stack kernel))
-        (e (exception kernel)))
-    (if (and s e)
-        (let ((debug (make-debug (narrow-stack->vector s 0)
-                                 0
-                                 (error-message kernel))))
-          (format #t "~a~%" (debug-error-message debug))
-          (format #t "Entering a new prompt.  ")
-          (format #t "Type `,bt' for a backtrace or `,q' to resume the game loop.\n")
-          (start-repl #:debug debug)
-          (set! (debugging? kernel) #f))
-        (display "nothing to debug!\n"))))
-
-(define-meta-command ((debug-game catbird) repl)
-  "debug-game
-Enter a debugger for the current game loop error."
-  (debugger (current-kernel)))
-
-(define-meta-command ((resume-game catbird) repl)
-  "resume-game
-Resume the game loop without entering a debugger."
-  (set! (debugging? (current-kernel)) #f))
+      ((error-handler kernel) exception stack)
+      (raise-exception exception)))
+
 
 ;;;
 ;;; Global kernel API