From cd9f3b72a0af23e26f62174b736858ad87d6e095 Mon Sep 17 00:00:00 2001
From: slava <slava@factorcode.org>
Date: Mon, 10 Apr 2006 02:23:24 +0000
Subject: [PATCH] Slightly better error reporting in the UI

---
 library/tools/listener.factor | 10 +++++++++-
 library/ui/listener.factor    | 12 +++++++++---
 2 files changed, 18 insertions(+), 4 deletions(-)

diff --git a/library/tools/listener.factor b/library/tools/listener.factor
index 10a94dd78a..d37d1b0c40 100644
--- 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 052946f3c6..248a491db3 100644
--- 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* ;