! Copyright (C) 2003, 2009 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
-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
+USING: accessors colors combinators.short-circuit
+compiler.units continuations debugger fry io io.styles kernel lexer
+math math.parser namespaces parser parser.notes prettyprint
+sequences sets source-files.errors system vocabs vocabs.loader
vocabs.parser ;
IN: listener
GENERIC: stream-read-quot ( stream -- quot/f )
-GENERIC# prompt. 1 ( stream prompt -- )
+GENERIC#: prompt. 1 ( stream prompt -- )
: prompt ( -- str )
manifest get current-vocab>> [ name>> "IN: " prepend ] [ "" ] if*
- auto-use? get [ " auto-use" append ] when ;
+ auto-use? get [ dup empty? "" " " ? "auto-use" 3append ] when ;
SYMBOL: prompt-style
H{
} prompt-style set-global
M: object prompt.
- nip prompt-style get-global format bl flush ;
+ nip [ prompt-style get-global format bl ] unless-empty ;
+
+SYMBOL: handle-ctrl-break
+
+: maybe-enable-ctrl-break ( -- )
+ handle-ctrl-break get-global [ enable-ctrl-break ] when ;
: with-ctrl-break ( quot -- )
- enable-ctrl-break
- [ disable-ctrl-break ] [ ] cleanup ; inline
+ maybe-enable-ctrl-break
+ ! Always call disable-ctrl-break, no matter what handle-ctrl-break
+ ! says: it might've been changed just now by the user in the Listener.
+ ! It's a no-op if it's not enabled.
+ [ disable-ctrl-break ] finally ; inline
: parse-lines-interactive ( lines -- quot/f )
- [ [ parse-lines ] with-ctrl-break
- ] with-compilation-unit ;
+ [ [ parse-lines ] with-ctrl-break ] with-compilation-unit ;
: read-quot-step ( lines -- quot/f )
- [ parse-lines-interactive ] [
- dup error>> unexpected-eof?
- [ 2drop f ] [ rethrow ] if
- ] recover ;
+ '[ _ parse-lines-interactive ]
+ [ error>> unexpected-eof? ] ignore-error/f ;
: read-quot-loop ( stream accum -- quot/f )
over stream-readln dup [
: call-error-hook ( error -- )
error-continuation get error-hook get
- call( continuation error -- ) ;
+ call( error continuation -- ) ;
[ drop print-error-and-restarts ] error-hook set-global
] dip
] when stack. ;
-: datastack. ( datastack -- )
- display-stacks? get [
- [ nl "--- Data stack:" title. trimmed-stack. ] unless-empty
- ] [ drop ] if ;
+: ?datastack. ( datastack -- )
+ display-stacks? get [ datastack. ] [ drop ] if ;
:: listener-step ( datastack -- datastack' )
error-summary? get [ error-summary ] when
visible-vars.
- datastack datastack.
+ datastack ?datastack.
input-stream get prompt prompt.
-
+ flush
[
read-quot [
'[ [ datastack _ with-datastack ] with-ctrl-break ]
if
] recover ;
-: (listener) ( datastack -- )
- listener-step (listener) ;
+: listener-loop ( datastack -- )
+ listener-step listener-loop ;
PRIVATE>
: listener ( -- )
[
parser-quiet? off
- [ { } (listener) ] with-return
+ [ { } listener-loop ] with-return
] with-interactive-vocabs ;
: listener-main ( -- )
- version-info print flush listener ;
+ "q" get [ version-info print flush ] unless listener ;
MAIN: listener-main