fix set-length on vectors and sbufs to not shorten the underlying array

diff --git a/TODO.FACTOR.txt b/TODO.FACTOR.txt
index 1aca91c15a4676e692c59e742a908bd070ea6c91..b33a2afa1e7506ebeb9bb914673da8beb9d1cbb2 100644 (file)
--- a/TODO.FACTOR.txt
+++ b/TODO.FACTOR.txt
@@ -1,7 +1,6 @@
 76:\r
 ---\r
 \r
-- set-length should not shorten the underlying sequence\r
 - i/o: don't keep creating new sbufs\r
 - [ EAX 0 ] --> [ EAX ]\r
 - rollovers broken with menus\r
@@ -12,7 +11,6 @@
 - fix listener prompt display after presentation commands invoked\r
 - tutorial: clickable code snippets\r
 - theme abstraction in ui\r
-- stray gestures on stack\r
 \r
 + misc\r
 \r

diff --git a/library/collections/sbuf.factor b/library/collections/sbuf.factor
index 3af4b3942b05fac778d5e6a699b6162725046e7a..29025ba397d2403ba57ba24ec71b507f51071d30 100644 (file)
--- a/library/collections/sbuf.factor
+++ b/library/collections/sbuf.factor
@@ -15,11 +15,9 @@ BUILTIN: sbuf 13 sbuf?
     [ 1 length set-capacity ]
     [ 2 underlying set-underlying ] ;
 
-M: sbuf set-length ( n sbuf -- )
-    growable-check 2dup expand set-capacity ;
+M: sbuf set-length ( n sbuf -- ) grow-length ;
 
-M: sbuf nth ( n sbuf -- ch )
-    bounds-check underlying char-slot ;
+M: sbuf nth ( n sbuf -- ch ) bounds-check underlying char-slot ;
 
 M: sbuf set-nth ( ch n sbuf -- )
     growable-check 2dup ensure underlying

diff --git a/library/collections/sequences.factor b/library/collections/sequences.factor
index dd761645140328b52f62ca2f63d0e49f83aef471..72b1e7102a155f80b5f281dba233db963c96e56c 100644 (file)
--- a/library/collections/sequences.factor
+++ b/library/collections/sequences.factor
@@ -108,3 +108,7 @@ GENERIC: set-capacity
     ] [
         2drop
     ] ifte ;
+
+: grow-length ( len seq -- )
+    growable-check 2dup length > [ 2dup expand ] when
+    set-capacity ;

diff --git a/library/collections/vectors.factor b/library/collections/vectors.factor
index bf217329eafadb279347df431d904e7c1a9b926b..6b1498b0e500cf8eb9b487aa003b76229756cbd8 100644 (file)
--- a/library/collections/vectors.factor
+++ b/library/collections/vectors.factor
@@ -9,11 +9,9 @@ BUILTIN: vector 11 vector?
     [ 1 length set-capacity ]
     [ 2 underlying set-underlying ] ;
 
-M: vector set-length ( len vec -- )
-    growable-check 2dup expand set-capacity ;
+M: vector set-length ( len vec -- ) grow-length ;
 
-M: vector nth ( n vec -- obj )
-    bounds-check underlying array-nth ;
+M: vector nth ( n vec -- obj ) bounds-check underlying array-nth ;
 
 M: vector set-nth ( obj n vec -- )
     growable-check 2dup ensure underlying set-array-nth ;

diff --git a/library/ui/init-world.factor b/library/ui/init-world.factor
deleted file mode 100644 (file)
index a8e5e13..0000000
--- a/library/ui/init-world.factor
+++ /dev/null
@@ -1,58 +0,0 @@
-! Copyright (C) 2005 Slava Pestov.
-! See http://factor.sf.net/license.txt for BSD license.
-IN: help
-DEFER: tutorial
-
-IN: gadgets
-USING: generic help io kernel listener math namespaces
-prettyprint sequences styles threads words ;
-
-SYMBOL: stack-display
-
-: ui.s ( -- )
-    stack-display get dup pane-clear [
-        datastack reverse [ unparse. terpri ] each
-    ] with-stream* ;
-
-: init-world
-    global [
-        <world> world set
-        
-        {{
-            [[ background [ 255 255 255 ] ]]
-            [[ rollover-bg [ 216 216 255 ] ]]
-            [[ bevel-1 [ 160 160 160 ] ]]
-            [[ bevel-2 [ 216 216 216 ] ]]
-            [[ foreground [ 0 0 0 ] ]]
-            [[ reverse-video f ]]
-            [[ font "Sans Serif" ]]
-            [[ font-size 12 ]]
-            [[ font-style plain ]]
-        }} world get set-gadget-paint
-        
-        { 1024 768 0 } world get set-gadget-dim
-        
-        <plain-gadget> add-layer
-    
-        <pane> dup pane set <scroller>
-        <pane> dup stack-display set <scroller>
-        3/4 <y-splitter> add-layer
-        
-        [
-            pane get [
-                [ ui.s ] listener-hook set
-                clear print-banner
-                "Tutorial" [ drop [ tutorial ] pane get pane-call ] <button> gadget.
-                listener
-            ] with-stream
-        ] in-thread
-        
-        pane get request-focus
-    ] bind ;
-
-SYMBOL: first-time
-
-global [ first-time on ] bind
-
-: ?init-world
-    first-time get [ init-world first-time off ] when ;

diff --git a/library/ui/load.factor b/library/ui/load.factor
index 84a0e296558eeac6b20a8158a1e32524a1e7b251..b996162deb62f2f349ed0f53dd571cd0c95bbe7a 100644 (file)
--- a/library/ui/load.factor
+++ b/library/ui/load.factor
@@ -23,7 +23,6 @@ USING: kernel parser sequences io ;
     "/library/ui/panes.factor"
     "/library/ui/presentations.factor"
     "/library/ui/books.factor"
-    "/library/ui/init-world.factor"
     "/library/ui/ui.factor"
 ] [
     dup print run-resource

diff --git a/library/ui/ui.factor b/library/ui/ui.factor
index d713a4fa20767ffa810dd5f656f77fe1be931749..06532cc7f7b003374789d9fb1cb76a7e71253f6f 100644 (file)
--- a/library/ui/ui.factor
+++ b/library/ui/ui.factor
@@ -1,8 +1,61 @@
 ! Copyright (C) 2005 Slava Pestov.
 ! See http://factor.sf.net/license.txt for BSD license.
+IN: help
+DEFER: tutorial
+
 IN: gadgets
-USING: kernel namespaces sdl sequences ;
+USING: generic help io kernel listener math namespaces
+prettyprint sdl sequences styles threads words ;
+
+SYMBOL: stack-display
+
+: ui.s ( -- )
+    stack-display get dup pane-clear [
+        datastack reverse [ unparse. terpri ] each
+    ] with-stream* ;
+
+: init-world
+    global [
+        <world> world set
+        
+        {{
+            [[ background [ 255 255 255 ] ]]
+            [[ rollover-bg [ 216 216 255 ] ]]
+            [[ bevel-1 [ 160 160 160 ] ]]
+            [[ bevel-2 [ 216 216 216 ] ]]
+            [[ foreground [ 0 0 0 ] ]]
+            [[ reverse-video f ]]
+            [[ font "Sans Serif" ]]
+            [[ font-size 12 ]]
+            [[ font-style plain ]]
+        }} world get set-gadget-paint
+        
+        { 1024 768 0 } world get set-gadget-dim
+        
+        <plain-gadget> add-layer
+    
+        <pane> dup pane set <scroller>
+        <pane> dup stack-display set <scroller>
+        3/4 <y-splitter> add-layer
+        
+        [
+            pane get [
+                [ ui.s ] listener-hook set
+                clear print-banner
+                "Tutorial" [ drop [ tutorial ] pane get pane-call ] <button> gadget.
+                listener
+            ] with-stream
+        ] in-thread
+        
+        pane get request-focus
+    ] bind ;
+
+SYMBOL: first-time
+
+global [ first-time on ] bind
 
+: ?init-world
+    first-time get [ init-world first-time off ] when ;
 IN: shells
 
 : ui ( -- )