ui.tools.listener: position the input field next to the prompt
Slava Pestov
parent
8654bfe921
commit
a465da365f
|
|
@ -3,7 +3,7 @@ quotations ;
|
|||
IN: ui.gadgets.panes
|
||||
|
||||
HELP: pane
|
||||
{ $class-description "A pane " { $link gadget } " displays formatted text which is written to a " { $link pane-stream } " targetting the pane. Panes are created by calling " { $link <pane> } ", " { $link <scrolling-pane> } " or " { $link <pane-control> } "." } ;
|
||||
{ $class-description "A pane " { $link gadget } " displays formatted text which is written to a " { $link pane-stream } " targetting the pane. Panes are created by calling " { $link <pane> } " or " { $link <pane-control> } "." } ;
|
||||
|
||||
HELP: <pane>
|
||||
{ $values { "pane" "a new " { $link pane } } }
|
||||
|
|
@ -38,10 +38,6 @@ HELP: make-pane
|
|||
{ $values { "quot" quotation } { "gadget" "a new " { $link gadget } } }
|
||||
{ $description "Calls the quotation in a new scope where " { $link output-stream } " is rebound to a " { $link pane-stream } " writing to a new pane. The output area of the new pane is output on the stack after the quotation returns. The pane itself is not output." } ;
|
||||
|
||||
HELP: <scrolling-pane>
|
||||
{ $values { "pane" "a new " { $link pane } } }
|
||||
{ $description "Creates a new " { $link pane } " gadget which scrolls any scroll pane containing it to the bottom on output. behaving much like a terminal or logger." } ;
|
||||
|
||||
HELP: <pane-control>
|
||||
{ $values { "model" model } { "quot" { $quotation "( value -- )" } } { "pane" "a new " { $link pane } } }
|
||||
{ $description "Creates a new control delegating to a " { $link pane } ". When the value of the model changes, the value is pushed on the stack and the quotation is called using " { $link with-pane } "." } ;
|
||||
|
|
@ -59,7 +55,6 @@ ARTICLE: "ui.gadgets.panes" "Pane gadgets"
|
|||
"The " { $vocab-link "ui.gadgets.panes" } " vocabulary implements panes, which display formatted text."
|
||||
{ $subsection pane }
|
||||
{ $subsection <pane> }
|
||||
{ $subsection <scrolling-pane> }
|
||||
{ $subsection <pane-control> }
|
||||
"Panes are written to by creating a special output stream:"
|
||||
{ $subsection pane-stream }
|
||||
|
|
|
|||
|
|
@ -17,7 +17,7 @@ IN: ui.gadgets.panes.tests
|
|||
|
||||
[ t ] [ #children "num-children" get = ] unit-test
|
||||
|
||||
: test-gadget-text
|
||||
: test-gadget-text ( quot -- ? )
|
||||
dup make-pane gadget-text dup print "======" print
|
||||
swap with-string-writer dup print "\n" ?tail drop "\n" ?tail drop = ;
|
||||
|
||||
|
|
|
|||
|
|
@ -8,29 +8,32 @@ fonts ui.gadgets ui.gadgets.private ui.gadgets.borders ui.gadgets.buttons
|
|||
ui.gadgets.labels ui.gadgets.scrollers ui.gadgets.paragraphs
|
||||
ui.gadgets.incremental ui.gadgets.packs ui.gadgets.theme
|
||||
ui.gadgets.menus ui.clipboards ui.gestures ui.traverse ui.render
|
||||
ui.text ui.gadgets.presentations ui.gadgets.grids
|
||||
ui.text ui.gadgets.presentations ui.gadgets.grids ui.gadgets.tracks
|
||||
ui.gadgets.grid-lines colors call ;
|
||||
IN: ui.gadgets.panes
|
||||
|
||||
TUPLE: pane < pack
|
||||
output current prototype scrolls?
|
||||
output current input last-line prototype scrolls?
|
||||
selection-color caret mark selecting? ;
|
||||
|
||||
: clear-selection ( pane -- pane )
|
||||
f >>caret f >>mark ;
|
||||
f >>caret f >>mark ; inline
|
||||
|
||||
: add-output ( pane current -- pane )
|
||||
[ >>output ] [ add-gadget ] bi ;
|
||||
|
||||
: add-current ( pane current -- pane )
|
||||
[ >>current ] [ add-gadget ] bi ;
|
||||
|
||||
: prepare-line ( pane -- )
|
||||
: prepare-last-line ( pane -- )
|
||||
clear-selection
|
||||
dup prototype>> clone add-current drop ;
|
||||
[ last-line>> unparent ]
|
||||
[
|
||||
[ horizontal <track> ] dip
|
||||
dup prototype>> clone >>current
|
||||
[ current>> f track-add ]
|
||||
[ input>> [ 1 track-add ] when* ]
|
||||
[ swap [ >>last-line ] [ add-gadget ] bi drop ]
|
||||
tri
|
||||
]
|
||||
[ input>> [ request-focus ] when* ] tri ;
|
||||
|
||||
: pane-caret&mark ( pane -- caret mark )
|
||||
[ caret>> ] [ mark>> ] bi ;
|
||||
[ caret>> ] [ mark>> ] bi ; inline
|
||||
|
||||
: selected-children ( pane -- seq )
|
||||
[ pane-caret&mark sort-pair ] keep gadget-subtree ;
|
||||
|
|
@ -46,15 +49,17 @@ M: pane gadget-selection ( pane -- string/f )
|
|||
[ current>> clear-gadget ]
|
||||
bi ;
|
||||
|
||||
: new-pane ( class -- pane )
|
||||
: new-pane ( input class -- pane )
|
||||
new-gadget
|
||||
swap >>input
|
||||
1 >>fill
|
||||
vertical >>orientation
|
||||
<shelf> +baseline+ >>align >>prototype
|
||||
<incremental> add-output
|
||||
dup prepare-line
|
||||
selection-color >>selection-color ;
|
||||
<incremental> [ >>output ] [ add-gadget ] bi
|
||||
dup prepare-last-line
|
||||
selection-color >>selection-color ; inline
|
||||
|
||||
: <pane> ( -- pane ) pane new-pane ;
|
||||
: <pane> ( -- pane ) f pane new-pane ;
|
||||
|
||||
GENERIC: draw-selection ( loc obj -- )
|
||||
|
||||
|
|
@ -104,8 +109,7 @@ C: <pane-stream> pane-stream
|
|||
[
|
||||
[ current>> [ unparent ] [ smash-line ] bi ] [ output>> ] bi
|
||||
add-incremental
|
||||
]
|
||||
[ prepare-line ] bi ;
|
||||
] [ prepare-last-line ] bi ;
|
||||
|
||||
: pane-write ( seq pane -- )
|
||||
[ pane-nl ] [ current>> stream-write ]
|
||||
|
|
@ -141,8 +145,6 @@ M: style-stream write-gadget
|
|||
: make-pane ( quot -- gadget )
|
||||
<pane> [ swap with-pane ] keep smash-pane ; inline
|
||||
|
||||
: <scrolling-pane> ( -- pane ) <pane> t >>scrolls? ;
|
||||
|
||||
TUPLE: pane-control < pane quot ;
|
||||
|
||||
M: pane-control model-changed ( model pane-control -- )
|
||||
|
|
@ -150,7 +152,7 @@ M: pane-control model-changed ( model pane-control -- )
|
|||
'[ _ call( value -- ) ] with-pane ;
|
||||
|
||||
: <pane-control> ( model quot -- pane )
|
||||
pane-control new-pane
|
||||
f pane-control new-pane
|
||||
swap >>quot
|
||||
swap >>model ;
|
||||
|
||||
|
|
|
|||
|
|
@ -8,10 +8,9 @@ io.styles kernel lexer listener math models models.delay models.filter
|
|||
namespaces parser prettyprint quotations sequences strings threads
|
||||
tools.vocabs vocabs vocabs.loader vocabs.parser words ui ui.commands
|
||||
ui.render ui.gadgets ui.gadgets.buttons ui.gadgets.editors
|
||||
ui.gadgets.frames ui.gadgets.grids ui.gadgets.labelled
|
||||
ui.gadgets.panes ui.gadgets.scrollers ui.gadgets.status-bar
|
||||
ui.gadgets.tracks ui.gadgets.borders ui.gestures ui.operations
|
||||
ui.tools.browser ui.tools.common ui.tools.debugger
|
||||
ui.gadgets.labelled ui.gadgets.panes ui.gadgets.scrollers
|
||||
ui.gadgets.status-bar ui.gadgets.tracks ui.gadgets.borders ui.gestures
|
||||
ui.operations ui.tools.browser ui.tools.common ui.tools.debugger
|
||||
ui.tools.listener.completion ui.tools.listener.popups
|
||||
ui.tools.listener.history ;
|
||||
IN: ui.tools.listener
|
||||
|
|
@ -66,13 +65,12 @@ M: char-completion (word-at-caret)
|
|||
[ '[ _ word-at-caret ] ] bi
|
||||
<filter> ;
|
||||
|
||||
: <interactor> ( output -- gadget )
|
||||
: <interactor> ( -- gadget )
|
||||
interactor new-editor
|
||||
<flag> >>flag
|
||||
dup one-word-elt <element-model> >>token-model
|
||||
dup <word-model> >>word-model
|
||||
dup model>> <history> >>history
|
||||
swap >>output ;
|
||||
dup model>> <history> >>history ;
|
||||
|
||||
M: interactor graft*
|
||||
[ call-next-method ] [ dup word-model>> add-connection ] bi ;
|
||||
|
|
@ -173,24 +171,16 @@ TUPLE: listener-gadget < tool input output scroller ;
|
|||
: listener-streams ( listener -- input output )
|
||||
[ input>> ] [ output>> ] bi <pane-stream> ;
|
||||
|
||||
: <listener-input> ( listener -- gadget )
|
||||
output>> <pane-stream> <interactor> ;
|
||||
|
||||
: init-listener ( listener -- listener )
|
||||
<scrolling-pane> >>output
|
||||
dup <listener-input> >>input ;
|
||||
|
||||
: <listener-scroller> ( listener -- scroller )
|
||||
<frame>
|
||||
over output>> @top grid-add
|
||||
swap input>> @center grid-add
|
||||
<scroller> ;
|
||||
<interactor>
|
||||
[ >>input ] [ pane new-pane t >>scrolls? >>output ] bi
|
||||
dup listener-streams >>output drop ;
|
||||
|
||||
: <listener-gadget> ( -- gadget )
|
||||
vertical listener-gadget new-track
|
||||
add-toolbar
|
||||
init-listener
|
||||
dup <listener-scroller> >>scroller
|
||||
dup output>> <scroller> >>scroller
|
||||
dup scroller>> 1 track-add ;
|
||||
|
||||
M: listener-gadget focusable-child*
|
||||
|
|
|
|||
|
|
@ -25,7 +25,7 @@ M: gesture-logger user-input*
|
|||
|
||||
: gesture-logger ( -- )
|
||||
[
|
||||
<scrolling-pane> dup <scroller>
|
||||
<pane> t >>scrolls? dup <scroller>
|
||||
"Gesture log" open-window
|
||||
<pane-stream> <gesture-logger>
|
||||
"Gesture input" open-window
|
||||
|
|
|
|||
Loading…
Reference in New Issue