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 } } }
{ $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 } "." } ;
"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 }
[ 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 = ;
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 ;
[ 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 -- )
[
[ 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 ]
: 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 -- )
'[ _ call( value -- ) ] with-pane ;
: <pane-control> ( model quot -- pane )
- pane-control new-pane
+ f pane-control new-pane
swap >>quot
swap >>model ;
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
[ '[ _ 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 ;
: 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*
: gesture-logger ( -- )
[
- <scrolling-pane> dup <scroller>
+ <pane> t >>scrolls? dup <scroller>
"Gesture log" open-window
<pane-stream> <gesture-logger>
"Gesture input" open-window