From: Erik Charlebois <erikcharlebois@gmail.com>
Date: Sun, 22 May 2011 07:44:36 +0000 (-0400)
Subject: Modify the listener vocabulary so that readline can hook in. Add the readline-listene... 
X-Git-Tag: 0.97~4323^2^2~3
X-Git-Url: https://gitweb.factorcode.org/gitweb.cgi?p=factor.git;a=commitdiff_plain;h=b504c9af476e38707594d28bcda6359ddcc69125

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

diff --git a/basis/listener/listener.factor b/basis/listener/listener.factor
index 96db935f07..f77c5262df 100644
--- a/basis/listener/listener.factor
+++ b/basis/listener/listener.factor
@@ -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 [
diff --git a/extra/readline-listener/authors.txt b/extra/readline-listener/authors.txt
new file mode 100644
index 0000000000..6f03a12101
--- /dev/null
+++ b/extra/readline-listener/authors.txt
@@ -0,0 +1 @@
+Erik Charlebois
diff --git a/extra/readline-listener/readline-listener-docs.factor b/extra/readline-listener/readline-listener-docs.factor
new file mode 100644
index 0000000000..c678b059a2
--- /dev/null
+++ b/extra/readline-listener/readline-listener-docs.factor
@@ -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"
diff --git a/extra/readline-listener/readline-listener.factor b/extra/readline-listener/readline-listener.factor
new file mode 100644
index 0000000000..4a7ff24fc0
--- /dev/null
+++ b/extra/readline-listener/readline-listener.factor
@@ -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
diff --git a/extra/readline-listener/summary.txt b/extra/readline-listener/summary.txt
new file mode 100644
index 0000000000..c582d234b0
--- /dev/null
+++ b/extra/readline-listener/summary.txt
@@ -0,0 +1 @@
+A listener that uses libreadline.
diff --git a/extra/readline-listener/tags.txt b/extra/readline-listener/tags.txt
new file mode 100644
index 0000000000..e69de29bb2