]> gitweb.factorcode.org Git - factor.git/commitdiff
ui.tools.listener: position the input field next to the prompt
authorSlava Pestov <slava@slava-pestovs-macbook-pro.local>
Tue, 10 Feb 2009 04:40:11 +0000 (22:40 -0600)
committerSlava Pestov <slava@slava-pestovs-macbook-pro.local>
Tue, 10 Feb 2009 04:40:11 +0000 (22:40 -0600)
basis/ui/gadgets/panes/panes-docs.factor
basis/ui/gadgets/panes/panes-tests.factor
basis/ui/gadgets/panes/panes.factor
basis/ui/tools/listener/listener.factor
extra/gesture-logger/gesture-logger.factor

index 6718f9b7d80302a94a8c15c89f9a3d756e3a65a0..afb2307b1e2ed474404cfaac73e6a7f18e42fafc 100644 (file)
@@ -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 }
index 1c5123703504fd55ec43be1e6942ae77540c27a1..766e395ef25be332b154ffbb19131cd9ff3d0d79 100644 (file)
@@ -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 = ;
 
index 95b79fa3eed0e968f8c5abc162cf104d5d950aef..5d19b30a23662db9f47548034665440d81a6663f 100644 (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.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 ) 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
+    pane-control new-pane
         swap >>quot
         swap >>model ;
 
index 02e1e1e12eab64f6ef1b98f04b5587d3a36a11dc..61046787b087f8f984f02126499f5f65b94fe941 100644 (file)
@@ -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*
index 61dc8cf77e6a4335a1d203b8a65aeba4f68833f6..faf7056d0270d3a16acfd8e95c222134aec792ce 100644 (file)
@@ -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