IN: listener
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 ] with-compilation-unit ;
] each
] tabular-output nl
] unless-empty ;
-
+
: trimmed-stack. ( seq -- )
dup length max-stack-items get > [
max-stack-items get cut*
[ nl "--- Data stack:" title. trimmed-stack. ] unless-empty
] [ 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 -- )
error-summary? get [ error-summary ] when
visible-vars.
datastack datastack.
- prompt.
+ input-stream get prompt prompt.
[
read-quot [
--- /dev/null
+Erik Charlebois
--- /dev/null
+! 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"
--- /dev/null
+! 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
--- /dev/null
+A listener that uses libreadline.