Slightly better error reporting in the UI

diff --git a/library/tools/listener.factor b/library/tools/listener.factor
index 10a94dd78ade34fe911b6d5731471d0e04b0f4a3..d37d1b0c400ea6af7d7e90069fbf851de4399aff 100644 (file)
--- a/library/tools/listener.factor
+++ b/library/tools/listener.factor
@@ -9,8 +9,10 @@ SYMBOL: quit-flag
 
 SYMBOL: listener-hook
 SYMBOL: datastack-hook
+SYMBOL: error-hook
 
 "  " listener-prompt set-global
+[ drop terpri debug-help ] error-hook set-global
 
 : bye ( -- ) quit-flag on ;
 
@@ -28,10 +30,16 @@ SYMBOL: datastack-hook
 : read-multiline ( -- quot ? )
     [ f depth (read-multiline) >r reverse r> ] with-parser ;
 
+: listen-try
+    [
+        print-error error-continuation get error-hook get call
+    ] recover ;
+
 : listen ( -- )
     listener-hook get call
     listener-prompt get write flush
-    [ read-multiline [ call ] [ bye ] if ] try ;
+    [ read-multiline [ call ] [ bye ] if ]
+    listen-try ;
 
 : (listener) ( -- )
     quit-flag get [ quit-flag off ] [ listen (listener) ] if ;

diff --git a/library/ui/listener.factor b/library/ui/listener.factor
index 052946f3c6ff9bf5c9ed16d961b6dc2612c6bb8f..248a491db33a541bc55a06ee9eb84cd536aab888 100644 (file)
--- a/library/ui/listener.factor
+++ b/library/ui/listener.factor
@@ -3,9 +3,9 @@
 IN: gadgets-listener
 USING: arrays gadgets gadgets-editors gadgets-labels
 gadgets-layouts gadgets-panes gadgets-scrolling
-gadgets-splitters gadgets-theme generic hashtables
-io jedit kernel listener lists math
-namespaces parser prettyprint sequences threads words ;
+gadgets-splitters gadgets-theme generic hashtables io jedit
+kernel listener lists math namespaces parser prettyprint
+sequences styles threads words ;
 
 TUPLE: listener-gadget pane stack ;
 
@@ -32,9 +32,15 @@ TUPLE: listener-gadget pane stack ;
     ] keep
     listener-gadget-pane word-completion ;
 
+: ui-error-hook ( error -- )
+    terpri H{ { font-style bold } } [
+        "Debug this error" swap simple-object terpri
+    ] with-style ;
+
 : listener-thread ( listener -- )
     dup listener-gadget-pane [
         [ ui-listener-hook ] curry listener-hook set
+        [ ui-error-hook ] error-hook set
         print-banner listener
     ] with-stream* ;