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
 | 
			
		||||
 | 
			
		||||
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 ;
 | 
			
		||||
| 
						 | 
				
			
			@ -82,7 +91,7 @@ t error-summary? set-global
 | 
			
		|||
            ] each
 | 
			
		||||
        ] tabular-output nl
 | 
			
		||||
    ] unless-empty ;
 | 
			
		||||
    
 | 
			
		||||
 | 
			
		||||
: trimmed-stack. ( seq -- )
 | 
			
		||||
    dup length max-stack-items get > [
 | 
			
		||||
        max-stack-items get cut*
 | 
			
		||||
| 
						 | 
				
			
			@ -97,15 +106,11 @@ t error-summary? set-global
 | 
			
		|||
        [ 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 [
 | 
			
		||||
| 
						 | 
				
			
			
 | 
			
		|||
| 
						 | 
				
			
			@ -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