[ global [ "Error in print-error!" print drop ] bind ]
recover ;
-SYMBOL: error-hook
-
-[
++: print-error-and-restarts ( error -- )
+ print-error
+ restarts.
+ nl
- "Type :help for debugging help." print flush
-] error-hook set-global
++ "Type :help for debugging help." print flush ;
+
: try ( quot -- )
- [
- print-error
- restarts.
- nl
- "Type :help for debugging help." print flush
- ] recover ;
- [ error-hook get call ] recover ;
++ [ print-error-and-restarts ] recover ;
ERROR: assert got expect ;
"( " in get " )" 3append
H{ { background { 1 0.7 0.7 1 } } } format bl flush ;
+SYMBOL: error-hook
+
++[ print-error-and-restarts ] error-hook set-global
++
: listen ( -- )
listener-hook get call prompt.
- [ read-quot [ try ] [ bye ] if* ]
+ [ read-quot [ [ error-hook get call ] recover ] [ bye ] if* ]
[
dup parse-error? [
error-hook get call
[ sleep-queue heap-peek nip millis [-] ]
} cond ;
+ DEFER: stop
+
<PRIVATE
-: schedule-sleep ( thread ms -- )
+: schedule-sleep ( thread dt -- )
>r check-registered dup r> sleep-queue heap-push*
>>sleep-entry drop ;
! Copyright (C) 2006, 2008 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
USING: arrays assocs combinators continuations documents
- hashtables io io.styles kernel math
- math.vectors models namespaces parser prettyprint quotations
- sequences strings threads listener
- classes.tuple ui.commands ui.gadgets ui.gadgets.editors
- ui.gadgets.presentations ui.gadgets.worlds ui.gestures
- definitions boxes calendar concurrency.flags ui.tools.workspace
- accessors math.order ;
-hashtables io io.styles kernel math math.vectors models
-namespaces parser prettyprint quotations sequences strings
-threads listener classes.tuple ui.commands ui.gadgets
++hashtables io io.styles kernel math math.order math.vectors
++models namespaces parser prettyprint quotations sequences
++strings threads listener classes.tuple ui.commands ui.gadgets
+ ui.gadgets.editors ui.gadgets.presentations ui.gadgets.worlds
+ ui.gestures definitions calendar concurrency.flags
+ ui.tools.workspace accessors ;
IN: ui.tools.interactor
- TUPLE: interactor history output flag thread help ;
+ ! If waiting is t, we're waiting for user input, and invoking
+ ! evaluate-input resumes the thread.
+ TUPLE: interactor output history flag thread waiting help ;
+
+ : register-self ( interactor -- )
+ self >>thread drop ;
: interactor-continuation ( interactor -- continuation )
- interactor-thread box-value
- thread-continuation box-value ;
+ thread>> continuation>> value>> ;
: interactor-busy? ( interactor -- ? )
- interactor-thread box-full? not ;
+ #! We're busy if there's no thread to resume.
+ [ waiting>> ]
+ [ thread>> dup [ thread-registered? ] when ]
+ bi and not ;
: interactor-use ( interactor -- seq )
dup interactor-busy? [ drop f ] [
[ H{ { font-style bold } } format ] with-nesting ;
: interactor-input. ( string interactor -- )
- interactor-output [
+ output>> [
dup string? [ dup write-input nl ] [ short. ] if
- ] with-stream* ;
+ ] with-output-stream* ;
: add-interactor-history ( str interactor -- )
over empty? [ 2drop ] [ interactor-history push-new ] if ;
<scrolling-pane> g-> set-listener-gadget-output
<scroller> "Output" <labelled-gadget> 1 track, ;
-: <listener-stream> ( listener -- stream )
- [ input>> ] [ output>> <pane-stream> ] bi <duplex-stream> ;
+: listener-streams ( listener -- input output )
+ [ input>> ] [ output>> <pane-stream> ] bi ;
: <listener-input> ( listener -- gadget )
- listener-gadget-output <pane-stream> <interactor> ;
+ output>> <pane-stream> <interactor> ;
: listener-input, ( -- )
g <listener-input> g-> set-listener-gadget-input
swap show-tool inspect-object ;
: listener-thread ( listener -- )
- dup <listener-stream> [
- [ [ ui-listener-hook ] curry listener-hook set ]
- [ [ ui-error-hook ] curry error-hook set ]
+ dup listener-streams [
- [
- [ [ ui-listener-hook ] curry listener-hook set ]
- [ [ ui-error-hook ] curry error-hook set ]
- [ [ ui-inspector-hook ] curry inspector-hook set ] tri
- welcome.
- listener
- ] with-input-stream*
- ] with-output-stream* ;
++ [ [ ui-listener-hook ] curry listener-hook set ]
++ [ [ ui-error-hook ] curry error-hook set ]
+ [ [ ui-inspector-hook ] curry inspector-hook set ] tri
+ welcome.
+ listener
- ] with-stream* ;
++ ] with-streams* ;
: start-listener-thread ( listener -- )
- [ listener-thread ] curry "Listener" spawn drop ;
+ [
+ [ input>> register-self ] [ listener-thread ] bi
+ ] curry "Listener" spawn drop ;
: restart-listener ( listener -- )
#! Returns when listener is ready to receive input.