ui.tools.listener: make it so up/down arrows can be used for history

cycling

It's how it works in most CLIs so it's nice if it works in Factor too.

diff --git a/basis/ui/tools/listener/listener-tests.factor b/basis/ui/tools/listener/listener-tests.factor
index 4e1c583eb6f3a331fff93c7fb75091ec3ff4f019..87639e6624922573d1c419444cedb876b8b4cac3 100644 (file)
--- a/basis/ui/tools/listener/listener-tests.factor
+++ b/basis/ui/tools/listener/listener-tests.factor
@@ -1,9 +1,7 @@
-USING: continuations documents
-ui.tools.listener hashtables kernel namespaces parser sequences
-tools.test ui.commands ui.gadgets ui.gadgets.editors
-ui.gadgets.panes vocabs words ui.gadgets.debug slots.private
-arrays generic threads accessors listener math
-calendar concurrency.promises io ui.tools.common ;
+USING: accessors arrays calendar concurrency.promises continuations
+documents io kernel listener math namespaces parser threads tools.test
+ui.gadgets.debug ui.gadgets.editors ui.gadgets.panes ui.gestures
+ui.tools.common ui.tools.listener ;
 IN: ui.tools.listener.tests
 
 [
@@ -198,3 +196,10 @@ CONSTANT: text "Hello world.\nThis is a test."
 { } [ <listener-gadget> "l" set ] unit-test
 { } [ "l" get com-scroll-up ] unit-test
 { } [ "l" get com-scroll-down ] unit-test
+
+{ t t } [
+    T{ key-down f f "UP" } T{ key-down f { C+ } "p" }
+    [ <interactor> get-gesture-handler ] same?
+    T{ key-down f f "DOWN" } T{ key-down f { C+ } "n" }
+    [ <interactor> get-gesture-handler ] same?
+] unit-test

diff --git a/basis/ui/tools/listener/listener.factor b/basis/ui/tools/listener/listener.factor
index df16ebfb8be6ee9c152a961d6076d7a9759c767c..00a8e09d1450135da83b305e92eb824c2548959b 100644 (file)
--- a/basis/ui/tools/listener/listener.factor
+++ b/basis/ui/tools/listener/listener.factor
@@ -1,27 +1,23 @@
 ! Copyright (C) 2005, 2010 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: accessors arrays assocs calendar colors.constants
-combinators combinators.short-circuit concurrency.flags
-concurrency.mailboxes continuations destructors documents
-documents.elements fry hashtables help help.markup help.tips io
-io.styles kernel lexer listener locals make math models
-models.arrow models.delay namespaces parser prettyprint
-quotations sequences source-files.errors strings system threads
-tools.errors.model ui ui.commands ui.gadgets ui.gadgets.buttons
+USING: accessors arrays assocs calendar combinators
+combinators.short-circuit concurrency.flags concurrency.mailboxes
+continuations destructors documents documents.elements fry hashtables
+help help.markup help.tips io io.styles kernel lexer listener locals
+make math models models.arrow models.delay namespaces parser
+prettyprint quotations sequences source-files.errors strings system
+threads tools.errors.model ui ui.commands ui.gadgets
 ui.gadgets.editors ui.gadgets.glass ui.gadgets.labeled
 ui.gadgets.panes ui.gadgets.scrollers ui.gadgets.status-bar
-ui.gadgets.tracks ui.gadgets.toolbar ui.gadgets.theme
-ui.gestures ui.operations ui.pens.solid
-ui.tools.browser ui.tools.common ui.tools.debugger
-ui.tools.error-list ui.tools.listener.completion
+ui.gadgets.theme ui.gadgets.toolbar ui.gadgets.tracks ui.gestures
+ui.operations ui.pens.solid ui.tools.browser ui.tools.common
+ui.tools.debugger ui.tools.error-list ui.tools.listener.completion
 ui.tools.listener.history ui.tools.listener.popups vocabs
 vocabs.loader vocabs.parser vocabs.refresh words ;
 IN: ui.tools.listener
 
-! If waiting is t, we're waiting for user input, and invoking
-! evaluate-input resumes the thread.
 TUPLE: interactor < source-editor
-output history flag mailbox thread waiting token-model word-model popup ;
+    output history flag mailbox thread waiting token-model word-model popup ;
 
 INSTANCE: interactor input-stream
 
@@ -189,9 +185,6 @@ TUPLE: listener-gadget < tool error-summary output scroller input ;
 
 { 600 700 } listener-gadget set-tool-dim
 
-: find-listener ( gadget -- listener )
-    [ listener-gadget? ] find-parent ;
-
 : listener-streams ( listener -- input output )
     [ input>> ] [ output>> <pane-stream> ] bi ;
 
@@ -217,7 +210,7 @@ TUPLE: listener-gadget < tool error-summary output scroller input ;
 : init-error-summary ( listener -- listener )
     <error-summary> >>error-summary
     dup error-summary>> f track-add ;
-    
+
 : add-listener-area ( listener -- listener )
     dup output>> margins <scroller> >>scroller
     dup scroller>> white-interior 1 track-add ;
@@ -334,7 +327,7 @@ M: object accept-completion-hook 2drop ;
     parse-lines-interactive ;
 
 : <debugger-popup> ( error continuation -- popup )
-    over compute-restarts [ hide-glass ] <debugger> 
+    over compute-restarts [ hide-glass ] <debugger>
     "Error" debugger-color <framed-labeled> ;
 
 : debugger-popup ( interactor error continuation -- )
@@ -392,6 +385,8 @@ interactor "completion" f {
     { T{ key-down f f "TAB" } code-completion-popup }
     { T{ key-down f { C+ } "p" } recall-previous }
     { T{ key-down f { C+ } "n" } recall-next }
+    { T{ key-down f f "UP" } recall-previous }
+    { T{ key-down f f "DOWN" } recall-next }
     { T{ key-down f { C+ } "r" } history-completion-popup }
 } define-command-map