steve
/
factor
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

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
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

10
library/tools/listener.factor
View File

@ -9,8 +9,10 @@ SYMBOL: quit-flag
SYMBOL: listener-hook SYMBOL: listener-hook
SYMBOL: datastack-hook SYMBOL: datastack-hook
SYMBOL: error-hook
" " listener-prompt set-global " " listener-prompt set-global
[ drop terpri debug-help ] error-hook set-global
: bye ( -- ) quit-flag on ; : bye ( -- ) quit-flag on ;
@ -28,10 +30,16 @@ SYMBOL: datastack-hook
: read-multiline ( -- quot ? ) : read-multiline ( -- quot ? )
[ f depth (read-multiline) >r reverse r> ] with-parser ; [ f depth (read-multiline) >r reverse r> ] with-parser ;
: listen-try
[
print-error error-continuation get error-hook get call
] recover ;
: listen ( -- ) : listen ( -- )
listener-hook get call listener-hook get call
listener-prompt get write flush listener-prompt get write flush
[ read-multiline [ call ] [ bye ] if ] try ; [ read-multiline [ call ] [ bye ] if ]
listen-try ;
: (listener) ( -- ) : (listener) ( -- )
quit-flag get [ quit-flag off ] [ listen (listener) ] if ; quit-flag get [ quit-flag off ] [ listen (listener) ] if ;

12
library/ui/listener.factor
View File

@ -3,9 +3,9 @@
IN: gadgets-listener IN: gadgets-listener
USING: arrays gadgets gadgets-editors gadgets-labels USING: arrays gadgets gadgets-editors gadgets-labels
gadgets-layouts gadgets-panes gadgets-scrolling gadgets-layouts gadgets-panes gadgets-scrolling
gadgets-splitters gadgets-theme generic hashtables gadgets-splitters gadgets-theme generic hashtables io jedit
io jedit kernel listener lists math kernel listener lists math namespaces parser prettyprint
namespaces parser prettyprint sequences threads words ; sequences styles threads words ;
TUPLE: listener-gadget pane stack ; TUPLE: listener-gadget pane stack ;
@ -32,9 +32,15 @@ TUPLE: listener-gadget pane stack ;
] keep ] keep
listener-gadget-pane word-completion ; 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 -- ) : listener-thread ( listener -- )
dup listener-gadget-pane [ dup listener-gadget-pane [
[ ui-listener-hook ] curry listener-hook set [ ui-listener-hook ] curry listener-hook set
[ ui-error-hook ] error-hook set
print-banner listener print-banner listener
] with-stream* ; ] with-stream* ;