! Copyright (C) 2003, 2009 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
-USING: accessors colors colors.constants compiler.units
-continuations debugger fry io io.styles kernel lexer locals
-math math.parser namespaces parser parser.notes prettyprint
-sequences sets source-files.errors vocabs vocabs.loader
+USING: accessors colors colors.constants
+combinators.short-circuit compiler.units continuations debugger
+fry io io.styles kernel lexer literals locals math math.parser
+namespaces parser parser.notes prettyprint sequences sets
+source-files.errors system vocabs vocabs.loader
vocabs.parser ;
IN: listener
GENERIC# prompt. 1 ( stream prompt -- )
: prompt ( -- str )
- manifest get current-vocab>> [ name>> "IN: " prepend ] [ "" ] if*
+ manifest get current-vocab>> [ name>> "IN: " prepend ] [ "" ] if*
auto-use? get [ " auto-use" append ] when ;
+SYMBOL: prompt-style
+H{
+ { background T{ rgba f 1 0.7 0.7 1 } }
+ { foreground COLOR: black }
+} prompt-style set-global
+
M: object prompt.
- nip H{
- { background T{ rgba f 1 0.7 0.7 1 } }
- { foreground COLOR: black }
- } format bl flush ;
+ nip prompt-style get-global format bl flush ;
: parse-lines-interactive ( lines -- quot/f )
[ parse-lines ] with-compilation-unit ;
[ nl "--- Data stack:" title. trimmed-stack. ] unless-empty
] [ drop ] if ;
-:: (listener) ( datastack -- )
- parser-quiet? off
+:: listener-step ( datastack -- datastack' )
error-summary? get [ error-summary ] when
visible-vars.
datastack datastack.
[ call-error-hook datastack ]
[ rethrow ]
if
- ] recover
+ ] recover ;
- (listener) ;
+: (listener) ( datastack -- )
+ listener-step (listener) ;
PRIVATE>
"words"
} interactive-vocabs set-global
+: loaded-vocab? ( vocab-spec -- ? )
+ {
+ [ find-vocab-root not ]
+ [ source-loaded?>> +done+ eq? ]
+ } 1|| ;
+
: use-loaded-vocabs ( vocabs -- )
- [ lookup-vocab ] filter
[
- lookup-vocab
- [ find-vocab-root not ]
- [ source-loaded?>> +done+ eq? ] bi or
- ] filter
- [ use-vocab ] each ;
+ lookup-vocab [
+ dup loaded-vocab? [ use-vocab ] [ drop ] if
+ ] when*
+ ] each ;
: with-interactive-vocabs ( quot -- )
[
] with-manifest ; inline
: listener ( -- )
- [ [ { } (listener) ] with-return ] with-interactive-vocabs ;
+ [
+ parser-quiet? off
+ [ { } (listener) ] with-return
+ ] with-interactive-vocabs ;
+
+: listener-main ( -- )
+ version-info print flush listener ;
-MAIN: listener
+MAIN: listener-main