]> gitweb.factorcode.org Git - factor.git/commitdiff
ui.tools: change scrolling behavior
authorJohn Benediktsson <mrjbq7@gmail.com>
Thu, 3 Mar 2022 22:53:34 +0000 (14:53 -0800)
committerJohn Benediktsson <mrjbq7@gmail.com>
Thu, 3 Mar 2022 22:53:34 +0000 (14:53 -0800)
When we are already to the bottom, keep scrolling to show new input.

When we are not, just add the input and keep the scroll position.

basis/ui/gadgets/panes/panes.factor
basis/ui/tools/listener/listener.factor

index 644f2b9ab30b4262b0b5d60312068173b2a89750..0d5248cceac926bafd13fd6b962750caf3b36cfb 100644 (file)
@@ -1,6 +1,6 @@
 ! Copyright (C) 2005, 2010 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: accessors assocs classes combinators destructors
+USING: accessors arrays assocs classes combinators destructors
 documents.private fonts io io.styles kernel math math.rectangles
 math.vectors models namespaces sequences sets sorting splitting
 strings ui.baseline-alignment ui.clipboards ui.gadgets
@@ -46,7 +46,6 @@ DEFER: write-gadget
     input>> [ request-focus ] when* ;
 
 : next-line ( pane -- )
-    clear-selection
     [ input>> unparent ]
     [ init-current prepare-last-line ]
     [ focus-input ] tri ;
@@ -120,8 +119,24 @@ GENERIC: pane-line ( str style gadget -- )
 : pane-write1 ( char pane -- )
     [ 1string H{ } ] dip current>> pane-line ;
 
-: do-pane-stream ( pane-stream quot -- )
-    [ pane>> ] dip keep scroll-pane ; inline
+:: do-pane-stream ( pane-stream quot -- )
+    pane-stream pane>> :> pane
+    pane find-scroller :> scroller
+    scroller [
+        model>> {
+            [ range-value second ]
+            [ range-page-value second + ]
+            [ range-max-value second >= ]
+        } cleave
+    ] [ f ] if* :> bottom?
+    pane quot call
+    pane scrolls?>> bottom? and scroller and [
+        scroller {
+            [ model>> range-value first ]
+            [ model>> range-max-value second 2array ]
+            [ set-scroll-position ]
+        } cleave
+    ] when ; inline
 
 M: pane-stream stream-nl
     [ pane-nl ] do-pane-stream ;
@@ -181,7 +196,7 @@ M: filter-writer write-gadget
     stream>> write-gadget ;
 
 M: pane-stream write-gadget
-    pane>> current>> swap add-gadget drop ;
+    [ current>> swap add-gadget drop ] do-pane-stream ;
 
 : print-gadget ( gadget stream -- )
     [ write-gadget ] [ nip stream-nl ] 2bi ;
index 06a1386b77fc5cad62ebb595f7755fbd2f0f628c..bc55368ae4ba38938d61cc716e92111f0adcc7b0 100644 (file)
@@ -117,7 +117,7 @@ M: word (print-input)
     output>> [ (print-input) ] with-output-stream* ;
 
 : interactor-continue ( obj interactor -- )
-    mailbox>> mailbox-put ;
+    [ mailbox>> mailbox-put ] [ scroll>bottom ] bi ;
 
 : interactor-finish ( interactor -- )
     [ history>> history-add ] keep