Modify the listener vocabulary so that readline can hook in. Add the readline-listener listener that provides word completion and readline editing.

db4
Erik Charlebois 2011-05-22 03:44:36 -04:00
parent 215e720513
commit b504c9af47
6 changed files with 69 additions and 6 deletions

View File

@ -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 [

View File

@ -0,0 +1 @@
Erik Charlebois

View File

@ -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"

View File

@ -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

View File

@ -0,0 +1 @@
A listener that uses libreadline.

View File