Modify the listener vocabulary so that readline can hook in. Add the readline-listener listener that provides word completion and readline editing.
parent
215e720513
commit
b504c9af47
|
@ -8,6 +8,15 @@ sets vocabs.parser source-files.errors locals vocabs vocabs.loader ;
|
||||||
IN: listener
|
IN: listener
|
||||||
|
|
||||||
GENERIC: stream-read-quot ( stream -- quot/f )
|
GENERIC: stream-read-quot ( stream -- quot/f )
|
||||||
|
GENERIC# prompt. 1 ( stream prompt -- )
|
||||||
|
|
||||||
|
: prompt ( -- str )
|
||||||
|
current-vocab name>> auto-use? get [ " - auto" append ] when
|
||||||
|
"( " " )" surround ;
|
||||||
|
|
||||||
|
M: object prompt.
|
||||||
|
nip H{ { background T{ rgba f 1 0.7 0.7 1 } } } format bl
|
||||||
|
flush ;
|
||||||
|
|
||||||
: parse-lines-interactive ( lines -- quot/f )
|
: parse-lines-interactive ( lines -- quot/f )
|
||||||
[ parse-lines ] with-compilation-unit ;
|
[ parse-lines ] with-compilation-unit ;
|
||||||
|
@ -82,7 +91,7 @@ t error-summary? set-global
|
||||||
] each
|
] each
|
||||||
] tabular-output nl
|
] tabular-output nl
|
||||||
] unless-empty ;
|
] unless-empty ;
|
||||||
|
|
||||||
: trimmed-stack. ( seq -- )
|
: trimmed-stack. ( seq -- )
|
||||||
dup length max-stack-items get > [
|
dup length max-stack-items get > [
|
||||||
max-stack-items get cut*
|
max-stack-items get cut*
|
||||||
|
@ -97,15 +106,11 @@ t error-summary? set-global
|
||||||
[ nl "--- Data stack:" title. trimmed-stack. ] unless-empty
|
[ nl "--- Data stack:" title. trimmed-stack. ] unless-empty
|
||||||
] [ drop ] if ;
|
] [ drop ] if ;
|
||||||
|
|
||||||
: prompt. ( -- )
|
|
||||||
current-vocab name>> auto-use? get [ " - auto" append ] when "( " " )" surround
|
|
||||||
H{ { background T{ rgba f 1 0.7 0.7 1 } } } format bl flush ;
|
|
||||||
|
|
||||||
:: (listener) ( datastack -- )
|
:: (listener) ( datastack -- )
|
||||||
error-summary? get [ error-summary ] when
|
error-summary? get [ error-summary ] when
|
||||||
visible-vars.
|
visible-vars.
|
||||||
datastack datastack.
|
datastack datastack.
|
||||||
prompt.
|
input-stream get prompt prompt.
|
||||||
|
|
||||||
[
|
[
|
||||||
read-quot [
|
read-quot [
|
||||||
|
|
|
@ -0,0 +1 @@
|
||||||
|
Erik Charlebois
|
|
@ -0,0 +1,17 @@
|
||||||
|
! Copyright (C) 2011 Erik Charlebois.
|
||||||
|
! See http://factorcode.org/license.txt for BSD license.
|
||||||
|
USING: help.markup help.syntax vocabs.loader ;
|
||||||
|
IN: readline-listener
|
||||||
|
|
||||||
|
HELP: readline-listener
|
||||||
|
{ $description "Invokes a listener that uses libreadline for editing, history and word completion." } ;
|
||||||
|
|
||||||
|
ARTICLE: "readline-listener" "Readline listener"
|
||||||
|
{ $vocab-link "readline-listener" }
|
||||||
|
$nl
|
||||||
|
"By default, the terminal listener does not provide any command history or completion. This vocabulary uses libreadline to provide a listener with history, word completion and more convenient editing facilities."
|
||||||
|
$nl
|
||||||
|
{ $code "\"readline-listener\" run" }
|
||||||
|
;
|
||||||
|
|
||||||
|
ABOUT: "readline-listener"
|
|
@ -0,0 +1,39 @@
|
||||||
|
! Copyright (C) 2011 Erik Charlebois.
|
||||||
|
! See http://factorcode.org/license.txt for BSD license.
|
||||||
|
USING: accessors alien.data fry io io.encodings.utf8 kernel
|
||||||
|
listener namespaces readline sequences threads vocabs
|
||||||
|
command-line ;
|
||||||
|
QUALIFIED: readline.ffi
|
||||||
|
IN: readline-listener
|
||||||
|
|
||||||
|
<PRIVATE
|
||||||
|
SYMBOL: completions
|
||||||
|
|
||||||
|
: prefixed-words ( prefix -- words )
|
||||||
|
'[ name>> _ head? ] all-words swap filter [ name>> ] map ;
|
||||||
|
|
||||||
|
: clear-completions ( -- )
|
||||||
|
f completions tset ;
|
||||||
|
|
||||||
|
: get-completions ( prefix -- completions )
|
||||||
|
completions tget dup [ nip ] [ drop
|
||||||
|
prefixed-words dup completions tset
|
||||||
|
] if ;
|
||||||
|
|
||||||
|
TUPLE: readline-reader { prompt initial: f } ;
|
||||||
|
M: readline-reader stream-readln
|
||||||
|
flush [ prompt>> dup [ " " append ] [ ] if readline ]
|
||||||
|
keep f >>prompt drop ;
|
||||||
|
|
||||||
|
M: readline-reader prompt.
|
||||||
|
>>prompt drop ;
|
||||||
|
PRIVATE>
|
||||||
|
|
||||||
|
: readline-listener ( -- )
|
||||||
|
[
|
||||||
|
swap get-completions ?nth
|
||||||
|
[ clear-completions f ] unless*
|
||||||
|
] set-completion
|
||||||
|
readline-reader new [ listener ] with-input-stream* ;
|
||||||
|
|
||||||
|
MAIN: readline-listener
|
|
@ -0,0 +1 @@
|
||||||
|
A listener that uses libreadline.
|
Loading…
Reference in New Issue