Scrolling fixes

library/compiler/inference/known-words.factor

@@ -270,7 +270,7 @@ sequences strings vectors words prettyprint ;
 
 \ getenv [ [ fixnum ] [ object ] ] "infer-effect" set-word-prop
 \ setenv [ [ object fixnum ] [ ] ] "infer-effect" set-word-prop
-\ stat [ [ string ] [ array ] ] "infer-effect" set-word-prop
+\ stat [ [ string ] [ object ] ] "infer-effect" set-word-prop
 \ (directory) [ [ string ] [ array ] ] "infer-effect" set-word-prop
 \ gc [ [ integer ] [ ] ] "infer-effect" set-word-prop
 \ gc-time [ [ ] [ integer ] ] "infer-effect" set-word-prop

library/ui/gadgets.factor

@@ -23,6 +23,9 @@ M: array rect-dim drop { 0 0 } ;
 
 : <extent-rect> ( loc ext -- rect ) dupd swap [v-] <rect> ;
 
+: offset-rect ( loc rect -- rect )
+    rect-bounds >r origin get v+ r> <rect> ;
+
 : >absolute ( rect -- rect )
     rect-bounds >r origin get v+ r> <rect> ;
 

library/ui/gadgets/scrolling.factor

@@ -62,14 +62,15 @@ C: scroller ( gadget -- scroller )
 
 : scroll>point ( point scroller -- )
     [
-        scroller-viewport [ include-point ] keep
+        scroller-viewport
+        [ include-point ] keep
         [ rect-extent v+ ] 2apply v-
     ] keep dup scroller-origin rot v+ scroll ;
 
 : (scroll>rect) ( rect scroller -- )
     #! First ensure top left is visible, then bottom right.
-    >r rect-extent r> tuck
-    >r >r scroll>point r> r> scroll>point ;
+    [ >r rect-extent r> scroller-origin swap >r v- r> ] keep
+    tuck >r >r scroll>point r> r> scroll>point ;
 
 : scroll>rect ( rect gadget -- )
     find-scroller dup [ set-scroller-follows ] [ 2drop ] if ;
@@ -81,15 +82,15 @@ C: scroller ( gadget -- scroller )
     dup scroller-viewport viewport-dim { 0 1 } v* scroll ;
 
 : update-scroller ( scroller -- )
-    dup scroller-follows dup [
-        f pick set-scroller-follows
-        dup t eq? [
-            drop (scroll>bottom)
+    dup scroller-follows [
+        dup scroller-follows t eq? [
+            dup (scroll>bottom)
         ] [
-            swap (scroll>rect)
+            dup scroller-follows over (scroll>rect)
         ] if
+        f swap set-scroller-follows
     ] [
-        drop dup scroller-origin scroll
+        dup scroller-origin scroll
     ] if ;
 
 M: scroller layout* ( scroller -- )

library/ui/text/editor.factor

@@ -121,9 +121,12 @@ M: editor model-changed ( editor -- )
 : caret-rect ( editor -- dim )
     dup caret-loc swap caret-dim <rect> ;
 
+: scroll>caret ( editor -- )
+    dup caret-rect swap scroll>rect ;
+
 M: loc-monitor model-changed ( obj -- )
-    loc-monitor-editor dup caret-rect over scroll>rect
-    control-self relayout-1 ;
+    loc-monitor-editor dup scroll>caret
+    control-self relayout ;
 
 : draw-caret ( -- )
     editor get