ui.tools.listener: position the input field next to the prompt

db4
Slava Pestov 2009-02-09 22:40:11 -06:00
parent 8654bfe921
commit a465da365f
5 changed files with 36 additions and 49 deletions

View File

@ -3,7 +3,7 @@ quotations ;
IN: ui.gadgets.panes IN: ui.gadgets.panes
HELP: pane 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> HELP: <pane>
{ $values { "pane" "a new " { $link pane } } } { $values { "pane" "a new " { $link pane } } }
@ -38,10 +38,6 @@ HELP: make-pane
{ $values { "quot" quotation } { "gadget" "a new " { $link gadget } } } { $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." } ; { $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> HELP: <pane-control>
{ $values { "model" model } { "quot" { $quotation "( value -- )" } } { "pane" "a new " { $link pane } } } { $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 } "." } ; { $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." "The " { $vocab-link "ui.gadgets.panes" } " vocabulary implements panes, which display formatted text."
{ $subsection pane } { $subsection pane }
{ $subsection <pane> } { $subsection <pane> }
{ $subsection <scrolling-pane> }
{ $subsection <pane-control> } { $subsection <pane-control> }
"Panes are written to by creating a special output stream:" "Panes are written to by creating a special output stream:"
{ $subsection pane-stream } { $subsection pane-stream }

View File

@ -17,7 +17,7 @@ IN: ui.gadgets.panes.tests
[ t ] [ #children "num-children" get = ] unit-test [ t ] [ #children "num-children" get = ] unit-test
: test-gadget-text : test-gadget-text ( quot -- ? )
dup make-pane gadget-text dup print "======" print dup make-pane gadget-text dup print "======" print
swap with-string-writer dup print "\n" ?tail drop "\n" ?tail drop = ; swap with-string-writer dup print "\n" ?tail drop "\n" ?tail drop = ;

View File

@ -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.labels ui.gadgets.scrollers ui.gadgets.paragraphs
ui.gadgets.incremental ui.gadgets.packs ui.gadgets.theme ui.gadgets.incremental ui.gadgets.packs ui.gadgets.theme
ui.gadgets.menus ui.clipboards ui.gestures ui.traverse ui.render 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 ; ui.gadgets.grid-lines colors call ;
IN: ui.gadgets.panes IN: ui.gadgets.panes
TUPLE: pane < pack TUPLE: pane < pack
output current prototype scrolls? output current input last-line prototype scrolls?
selection-color caret mark selecting? ; selection-color caret mark selecting? ;
: clear-selection ( pane -- pane ) : clear-selection ( pane -- pane )
f >>caret f >>mark ; f >>caret f >>mark ; inline
: add-output ( pane current -- pane ) : prepare-last-line ( pane -- )
[ >>output ] [ add-gadget ] bi ;
: add-current ( pane current -- pane )
[ >>current ] [ add-gadget ] bi ;
: prepare-line ( pane -- )
clear-selection 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 ) : pane-caret&mark ( pane -- caret mark )
[ caret>> ] [ mark>> ] bi ; [ caret>> ] [ mark>> ] bi ; inline
: selected-children ( pane -- seq ) : selected-children ( pane -- seq )
[ pane-caret&mark sort-pair ] keep gadget-subtree ; [ pane-caret&mark sort-pair ] keep gadget-subtree ;
@ -46,15 +49,17 @@ M: pane gadget-selection ( pane -- string/f )
[ current>> clear-gadget ] [ current>> clear-gadget ]
bi ; bi ;
: new-pane ( class -- pane ) : new-pane ( input class -- pane )
new-gadget new-gadget
swap >>input
1 >>fill
vertical >>orientation vertical >>orientation
<shelf> +baseline+ >>align >>prototype <shelf> +baseline+ >>align >>prototype
<incremental> add-output <incremental> [ >>output ] [ add-gadget ] bi
dup prepare-line dup prepare-last-line
selection-color >>selection-color ; selection-color >>selection-color ; inline
: <pane> ( -- pane ) pane new-pane ; : <pane> ( -- pane ) f pane new-pane ;
GENERIC: draw-selection ( loc obj -- ) GENERIC: draw-selection ( loc obj -- )
@ -104,8 +109,7 @@ C: <pane-stream> pane-stream
[ [
[ current>> [ unparent ] [ smash-line ] bi ] [ output>> ] bi [ current>> [ unparent ] [ smash-line ] bi ] [ output>> ] bi
add-incremental add-incremental
] ] [ prepare-last-line ] bi ;
[ prepare-line ] bi ;
: pane-write ( seq pane -- ) : pane-write ( seq pane -- )
[ pane-nl ] [ current>> stream-write ] [ pane-nl ] [ current>> stream-write ]
@ -141,8 +145,6 @@ M: style-stream write-gadget
: make-pane ( quot -- gadget ) : make-pane ( quot -- gadget )
<pane> [ swap with-pane ] keep smash-pane ; inline <pane> [ swap with-pane ] keep smash-pane ; inline
: <scrolling-pane> ( -- pane ) <pane> t >>scrolls? ;
TUPLE: pane-control < pane quot ; TUPLE: pane-control < pane quot ;
M: pane-control model-changed ( model pane-control -- ) M: pane-control model-changed ( model pane-control -- )
@ -150,7 +152,7 @@ M: pane-control model-changed ( model pane-control -- )
'[ _ call( value -- ) ] with-pane ; '[ _ call( value -- ) ] with-pane ;
: <pane-control> ( model quot -- pane ) : <pane-control> ( model quot -- pane )
pane-control new-pane f pane-control new-pane
swap >>quot swap >>quot
swap >>model ; swap >>model ;

View File

@ -8,10 +8,9 @@ io.styles kernel lexer listener math models models.delay models.filter
namespaces parser prettyprint quotations sequences strings threads namespaces parser prettyprint quotations sequences strings threads
tools.vocabs vocabs vocabs.loader vocabs.parser words ui ui.commands tools.vocabs vocabs vocabs.loader vocabs.parser words ui ui.commands
ui.render ui.gadgets ui.gadgets.buttons ui.gadgets.editors ui.render ui.gadgets ui.gadgets.buttons ui.gadgets.editors
ui.gadgets.frames ui.gadgets.grids ui.gadgets.labelled ui.gadgets.labelled ui.gadgets.panes ui.gadgets.scrollers
ui.gadgets.panes ui.gadgets.scrollers ui.gadgets.status-bar ui.gadgets.status-bar ui.gadgets.tracks ui.gadgets.borders ui.gestures
ui.gadgets.tracks ui.gadgets.borders ui.gestures ui.operations ui.operations ui.tools.browser ui.tools.common ui.tools.debugger
ui.tools.browser ui.tools.common ui.tools.debugger
ui.tools.listener.completion ui.tools.listener.popups ui.tools.listener.completion ui.tools.listener.popups
ui.tools.listener.history ; ui.tools.listener.history ;
IN: ui.tools.listener IN: ui.tools.listener
@ -66,13 +65,12 @@ M: char-completion (word-at-caret)
[ '[ _ word-at-caret ] ] bi [ '[ _ word-at-caret ] ] bi
<filter> ; <filter> ;
: <interactor> ( output -- gadget ) : <interactor> ( -- gadget )
interactor new-editor interactor new-editor
<flag> >>flag <flag> >>flag
dup one-word-elt <element-model> >>token-model dup one-word-elt <element-model> >>token-model
dup <word-model> >>word-model dup <word-model> >>word-model
dup model>> <history> >>history dup model>> <history> >>history ;
swap >>output ;
M: interactor graft* M: interactor graft*
[ call-next-method ] [ dup word-model>> add-connection ] bi ; [ 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 ) : listener-streams ( listener -- input output )
[ input>> ] [ output>> ] bi <pane-stream> ; [ input>> ] [ output>> ] bi <pane-stream> ;
: <listener-input> ( listener -- gadget )
output>> <pane-stream> <interactor> ;
: init-listener ( listener -- listener ) : init-listener ( listener -- listener )
<scrolling-pane> >>output <interactor>
dup <listener-input> >>input ; [ >>input ] [ pane new-pane t >>scrolls? >>output ] bi
dup listener-streams >>output drop ;
: <listener-scroller> ( listener -- scroller )
<frame>
over output>> @top grid-add
swap input>> @center grid-add
<scroller> ;
: <listener-gadget> ( -- gadget ) : <listener-gadget> ( -- gadget )
vertical listener-gadget new-track vertical listener-gadget new-track
add-toolbar add-toolbar
init-listener init-listener
dup <listener-scroller> >>scroller dup output>> <scroller> >>scroller
dup scroller>> 1 track-add ; dup scroller>> 1 track-add ;
M: listener-gadget focusable-child* M: listener-gadget focusable-child*

View File

@ -25,7 +25,7 @@ M: gesture-logger user-input*
: gesture-logger ( -- ) : gesture-logger ( -- )
[ [
<scrolling-pane> dup <scroller> <pane> t >>scrolls? dup <scroller>
"Gesture log" open-window "Gesture log" open-window
<pane-stream> <gesture-logger> <pane-stream> <gesture-logger>
"Gesture input" open-window "Gesture input" open-window