From 5d7d152792c91f34fb0cef128ee19e2ff10af04b Mon Sep 17 00:00:00 2001
From: slava <slava@factorcode.org>
Date: Fri, 4 Aug 2006 00:05:54 +0000
Subject: [PATCH] Scrolling fixes

---
 library/compiler/inference/known-words.factor |  2 +-
 library/ui/gadgets.factor                     |  3 +++
 library/ui/gadgets/scrolling.factor           | 19 ++++++++++---------
 library/ui/text/editor.factor                 |  7 +++++--
 4 files changed, 19 insertions(+), 12 deletions(-)

diff --git a/library/compiler/inference/known-words.factor b/library/compiler/inference/known-words.factor
index b12a8860aa..a28058761f 100644
--- a/library/compiler/inference/known-words.factor
+++ b/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
diff --git a/library/ui/gadgets.factor b/library/ui/gadgets.factor
index d1340b868c..571713caa0 100644
--- a/library/ui/gadgets.factor
+++ b/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> ;
 
diff --git a/library/ui/gadgets/scrolling.factor b/library/ui/gadgets/scrolling.factor
index 37f4c9235e..6d57eb62a1 100644
--- a/library/ui/gadgets/scrolling.factor
+++ b/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 -- )
diff --git a/library/ui/text/editor.factor b/library/ui/text/editor.factor
index ca723e6261..0d6102b25a 100644
--- a/library/ui/text/editor.factor
+++ b/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