steve
/
factor
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

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.
db4
Björn Lindqvist 2015-10-14 03:05:16 +02:00
parent f9e5d4f22c
commit 420ca29795
2 changed files with 26 additions and 26 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

17
basis/ui/tools/listener/listener-tests.factor
View File

@ -1,9 +1,7 @@
USING: continuations documents USING: accessors arrays calendar concurrency.promises continuations
ui.tools.listener hashtables kernel namespaces parser sequences documents io kernel listener math namespaces parser threads tools.test
tools.test ui.commands ui.gadgets ui.gadgets.editors ui.gadgets.debug ui.gadgets.editors ui.gadgets.panes ui.gestures
ui.gadgets.panes vocabs words ui.gadgets.debug slots.private ui.tools.common ui.tools.listener ;
arrays generic threads accessors listener math
calendar concurrency.promises io ui.tools.common ;
IN: ui.tools.listener.tests IN: ui.tools.listener.tests
[ [
@ -198,3 +196,10 @@ CONSTANT: text "Hello world.\nThis is a test."
{ } [ <listener-gadget> "l" set ] unit-test { } [ <listener-gadget> "l" set ] unit-test
{ } [ "l" get com-scroll-up ] unit-test { } [ "l" get com-scroll-up ] unit-test
{ } [ "l" get com-scroll-down ] 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

35
basis/ui/tools/listener/listener.factor
View File

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