From a465da365f61b355ab98b1419003f24e28c1cbc0 Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Mon, 9 Feb 2009 22:40:11 -0600 Subject: [PATCH] ui.tools.listener: position the input field next to the prompt --- basis/ui/gadgets/panes/panes-docs.factor | 7 +--- basis/ui/gadgets/panes/panes-tests.factor | 2 +- basis/ui/gadgets/panes/panes.factor | 46 +++++++++++----------- basis/ui/tools/listener/listener.factor | 28 +++++-------- extra/gesture-logger/gesture-logger.factor | 2 +- 5 files changed, 36 insertions(+), 49 deletions(-) diff --git a/basis/ui/gadgets/panes/panes-docs.factor b/basis/ui/gadgets/panes/panes-docs.factor index 6718f9b7d8..afb2307b1e 100644 --- a/basis/ui/gadgets/panes/panes-docs.factor +++ b/basis/ui/gadgets/panes/panes-docs.factor @@ -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 } ", " { $link } " or " { $link } "." } ; +{ $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 } " or " { $link } "." } ; HELP: { $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: -{ $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: { $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 } -{ $subsection } { $subsection } "Panes are written to by creating a special output stream:" { $subsection pane-stream } diff --git a/basis/ui/gadgets/panes/panes-tests.factor b/basis/ui/gadgets/panes/panes-tests.factor index 1c51237035..766e395ef2 100644 --- a/basis/ui/gadgets/panes/panes-tests.factor +++ b/basis/ui/gadgets/panes/panes-tests.factor @@ -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 = ; diff --git a/basis/ui/gadgets/panes/panes.factor b/basis/ui/gadgets/panes/panes.factor index 95b79fa3ee..5d19b30a23 100644 --- a/basis/ui/gadgets/panes/panes.factor +++ b/basis/ui/gadgets/panes/panes.factor @@ -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 ] 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 +baseline+ >>align >>prototype - add-output - dup prepare-line - selection-color >>selection-color ; + [ >>output ] [ add-gadget ] bi + dup prepare-last-line + selection-color >>selection-color ; inline -: ( -- pane ) pane new-pane ; +: ( -- pane ) f pane new-pane ; GENERIC: draw-selection ( loc obj -- ) @@ -104,8 +109,7 @@ C: 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 ) [ swap with-pane ] keep smash-pane ; inline -: ( -- 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 ; : ( model quot -- pane ) - pane-control new-pane + f pane-control new-pane swap >>quot swap >>model ; diff --git a/basis/ui/tools/listener/listener.factor b/basis/ui/tools/listener/listener.factor index 02e1e1e12e..61046787b0 100644 --- a/basis/ui/tools/listener/listener.factor +++ b/basis/ui/tools/listener/listener.factor @@ -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 ; -: ( output -- gadget ) +: ( -- gadget ) interactor new-editor >>flag dup one-word-elt >>token-model dup >>word-model - dup model>> >>history - swap >>output ; + dup model>> >>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 ; -: ( listener -- gadget ) - output>> ; - : init-listener ( listener -- listener ) - >>output - dup >>input ; - -: ( listener -- scroller ) - - over output>> @top grid-add - swap input>> @center grid-add - ; + + [ >>input ] [ pane new-pane t >>scrolls? >>output ] bi + dup listener-streams >>output drop ; : ( -- gadget ) vertical listener-gadget new-track add-toolbar init-listener - dup >>scroller + dup output>> >>scroller dup scroller>> 1 track-add ; M: listener-gadget focusable-child* diff --git a/extra/gesture-logger/gesture-logger.factor b/extra/gesture-logger/gesture-logger.factor index 61dc8cf77e..faf7056d02 100644 --- a/extra/gesture-logger/gesture-logger.factor +++ b/extra/gesture-logger/gesture-logger.factor @@ -25,7 +25,7 @@ M: gesture-logger user-input* : gesture-logger ( -- ) [ - dup + t >>scrolls? dup "Gesture log" open-window "Gesture input" open-window