Guard Qt key handler callback errors

ober

27598198776fc3abb3db3bf74832e72fc2d602a7

diff --git a/src/jerboa-emacs/qt/app.ss b/src/jerboa-emacs/qt/app.ss
index bb5f829..750a1b7 100644
--- a/src/jerboa-emacs/qt/app.ss
+++ b/src/jerboa-emacs/qt/app.ss
@@ -1,7 +1,8 @@
 ;;; -*- Gerbil -*-
 ;;; Qt application and event loop for jemacs
 
-(export qt-main qt-open-file! qt-do-init!)
+(export qt-main qt-open-file! qt-do-init!
+        qt-call-with-key-handler-errors)
 
 (import :std/sugar
         :std/misc/string
@@ -838,12 +839,17 @@
     (and value
          (not (string=? value ""))
          (not (string=? value "0")))))
-(defrule (with-key-handler-errors app body ...)
+(def (qt-call-with-key-handler-errors app thunk)
   (with-catch
     (lambda (e)
-      (verbose-log! "KEY-HANDLER-ERROR")
+      (verbose-log! "KEY-HANDLER-ERROR: "
+                    (with-output-to-string (lambda () (display-exception e))))
       (echo-error! (app-state-echo app) "Key handler error")
       (void))
+    thunk))
+
+(defrule (with-key-handler-errors app body ...)
+  (qt-call-with-key-handler-errors app
     (lambda ()
       body ...)))
 
diff --git a/tests/test-qt-part2.ss b/tests/test-qt-part2.ss
index 4e99a2f..c5458ec 100644
--- a/tests/test-qt-part2.ss
+++ b/tests/test-qt-part2.ss
@@ -17,6 +17,7 @@
         (jerboa-emacs snippets)
         (jerboa-emacs qt sci-shim)
         (jerboa-emacs qt window)
+        (only (jerboa-emacs qt app) qt-call-with-key-handler-errors)
         (jerboa-emacs qt commands)
         (only (jerboa-emacs qt commands-core) *so-long-threshold*)
         (only (jerboa-emacs qt commands-parity5) schedule-user-timer!)
@@ -98,7 +99,7 @@
       (loop (+ i 1)
             (cons (string-append "line " (number->string i) "\n") acc)))))
 
-(display "\n=== Qt Part2 Groups 44-56 ===\n")
+(display "\n=== Qt Part2 Groups 44-57 ===\n")
 
 (test-case "group44 qt key/mouse fidelity"
   (check (qt-key-event->string QT_KEY_RETURN 0 "") => "C-m")
@@ -222,9 +223,17 @@
     (qt-plain-text-edit-undo! ed)
     (check (qt-plain-text-edit-text ed) => "say hr!")))
 
+(test-case "group57 key handler guard catches callback errors"
+  (let-values (((ed w app) (make-qt-test-app "part2-57")))
+    (qt-call-with-key-handler-errors app
+      (lambda ()
+        (error 'group57 "callback exploded")))
+    (check (echo-state-error? (app-state-echo app)) => #t)
+    (check (echo-state-message (app-state-echo app)) => "Key handler error")))
+
 (newline)
 (let ([total (+ *pass* *fail*)])
-  (printf "Part2 results: ~a/~a tests passed (groups 44-56)~n" *pass* total)
+  (printf "Part2 results: ~a/~a tests passed (groups 44-57)~n" *pass* total)
   (when (> *fail* 0)
     (printf "FAILED: ~a test(s)~n" *fail*))
   (when (= *fail* 0)