Slightly better error reporting in the UI

release
slava 2006-04-10 02:23:24 +00:00
parent 4b9d87f85f
commit cd9f3b72a0
2 changed files with 18 additions and 4 deletions

View File

@ -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 ;

View File

@ -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* ;