more UI cleanups, fix jedit-stream bug

diff --git a/CHANGES.txt b/CHANGES.txt
index 078f88555c613ea54fddaf0426d1d53983912e18..ad8f08c68d9cb8d378323a870455819e3ae4f110 100644 (file)
--- a/CHANGES.txt
+++ b/CHANGES.txt
@@ -1,9 +1,7 @@
 Factor 0.76:
 ------------
 
-+ Framework
-
-- md5 hashing algorithm in contrib/crypto/ (Doug Coleman).
++ Core language
 
 - New words:
 
@@ -11,6 +9,17 @@ Factor 0.76:
   unparser hex-string ( str -- str )
   sequences fourth ( seq -- elt )
 
+- String input streams.
+
+  with-string is now string-out ( quot -- string )
+
+  new string-in ( string quot -- ) word, calls quot with stdio bound to
+  a stream that reads from the given string.
+
++ Framework
+
+- md5 hashing algorithm in contrib/crypto/ (Doug Coleman).
+
 Factor 0.75:
 ------------
 

diff --git a/library/alien/aliens.factor b/library/alien/aliens.factor
index c3e930c0cecdc0082719820ff43f1de0e5708536..4684658d4768897d521fbbcba98c6a9883930925 100644 (file)
--- a/library/alien/aliens.factor
+++ b/library/alien/aliens.factor
@@ -16,8 +16,6 @@ BUILTIN: displaced-alien 20 displaced-alien? ;
     #! C null value.
     0 <alien> ;
 
-: null? ( alien -- ? ) dup alien? [ alien-address 0 = ] when ;
-
 M: alien hashcode ( obj -- n )
     alien-address >fixnum ;
 

diff --git a/library/bootstrap/primitives.factor b/library/bootstrap/primitives.factor
index c2b3eb0f54698827b50e3f9c2c1f1023c272edd8..ba903cee1030d1e4b7c92150d01760dfd4b7164d 100644 (file)
--- a/library/bootstrap/primitives.factor
+++ b/library/bootstrap/primitives.factor
@@ -207,6 +207,7 @@ vocabularies get [
     [ "fwrite" "io-internals"                 [ [ string alien ] [ ] ] ]
     [ "fflush" "io-internals"                 [ [ alien ] [ ] ] ]
     [ "fclose" "io-internals"                 [ [ alien ] [ ] ] ]
+    [ "expired?" "alien"                      [ [ object ] [ boolean ] ] ]
 ] [
     make-primitive
 ] each drop

diff --git a/library/test/gadgets.factor b/library/test/gadgets.factor
index 5cb9df1a130e07ed57cd2b01dcfdd41e4dabb78e..8f0bf9f23cc8856d3b24b7ce4cd66e105f316c04 100644 (file)
--- a/library/test/gadgets.factor
+++ b/library/test/gadgets.factor
@@ -70,7 +70,7 @@ USING: gadgets kernel lists math namespaces test sequences ;
 [
     300 620
 ] [
-    0 10 0 <pile> "pile" set
+    0 { 10 10 10 } 0 <pile> "pile" set
     0 0 100 100 <rectangle> <gadget> "pile" get add-gadget
     0 0 200 200 <rectangle> <gadget> "pile" get add-gadget
     0 0 300 300 <rectangle> <gadget> "pile" get add-gadget

diff --git a/library/tools/jedit-wire.factor b/library/tools/jedit-wire.factor
index bf35f2ffe9c307dfcb918b9e7f09f1f2f03ccef8..1501f8aa4666c24726f5f1452d4cefdd5685b770 100644 (file)
--- a/library/tools/jedit-wire.factor
+++ b/library/tools/jedit-wire.factor
@@ -39,7 +39,7 @@ prettyprint sequences io strings words ;
 ! remaining -- input
 : jedit-write-attr ( str style -- )
     CHAR: w write
-    [ swap . . ] string-out
+    [ swap . "USE: styles" print . ] string-out
     dup write-len write ;
 
 TUPLE: jedit-stream ;

diff --git a/library/ui/borders.factor b/library/ui/borders.factor
index 56f27cd9a16dc56c63df22ac4d71f1578896d9ea..a7205167a5e349262d2cbb94e8e0402b806d4a27 100644 (file)
--- a/library/ui/borders.factor
+++ b/library/ui/borders.factor
@@ -2,7 +2,7 @@
 ! See http://factor.sf.net/license.txt for BSD license.
 IN: gadgets
 USING: errors generic hashtables kernel lists math namespaces
-sdl ;
+sdl vectors ;
 
 ! A border lays out its children on top of each other, all with
 ! a 5-pixel padding.
@@ -33,9 +33,9 @@ C: border ( child delegate size -- border )
     [ shape-h rot - ] keep
     gadget-child resize-gadget ;
 
-M: border pref-size ( border -- w h )
+M: border pref-dim ( border -- dim )
     [ border-size 2 * ] keep
-    gadget-child pref-size >r over + r> rot + ;
+    gadget-child pref-size >r over + r> rot + 0 3vector ;
 
 M: border layout* ( border -- )
     dup layout-border-x/y layout-border-w/h ;

diff --git a/library/ui/editors.factor b/library/ui/editors.factor
index a54d52d947e3915e0c2c4c09a05473d8113ea9cd..5c33d0da88e982fc3192bfcc83a7d819c1101808 100644 (file)
--- a/library/ui/editors.factor
+++ b/library/ui/editors.factor
@@ -2,7 +2,7 @@
 ! See http://factor.sf.net/license.txt for BSD license.
 IN: gadgets
 USING: generic kernel line-editor lists math namespaces sdl
-sequences strings styles ;
+sequences strings styles vectors ;
 
 ! An editor gadget wraps a line editor object and passes
 ! gestures to the line editor.
@@ -88,8 +88,8 @@ M: editor user-input* ( ch editor -- ? )
     [ [ insert-char ] with-editor ] keep
     scroll>bottom  t ;
 
-M: editor pref-size ( editor -- w h )
-    dup editor-text label-size >r 1 + r> ;
+M: editor pref-dim ( editor -- dim )
+    dup editor-text label-size >r 1 + r> 0 3vector ;
 
 M: editor layout* ( editor -- )
     dup editor-caret over caret-size rot resize-gadget

diff --git a/library/ui/fonts.factor b/library/ui/fonts.factor
index a446da6936173a0d97e46f3bb19ebd65630a6251..e00a683cffde2ddad96caf4a9b1e497667184cfd 100644 (file)
--- a/library/ui/fonts.factor
+++ b/library/ui/fonts.factor
@@ -35,7 +35,7 @@ global [ open-fonts nest drop ] bind
 
 : ttf-init ( -- )
     TTF_Init
-    open-fonts [ [ cdr null? not ] hash-subset ] change ;
+    open-fonts [ [ cdr expired? not ] hash-subset ] change ;
 
 : gadget-font ( gadget -- font )
     [ font paint-prop ] keep

diff --git a/library/ui/frames.factor b/library/ui/frames.factor
index e8e065ed2a067ba10d11757d9bb0571980f43832..c298e0c2cfc8af627cf82764a321d84504407d8c 100644 (file)
--- a/library/ui/frames.factor
+++ b/library/ui/frames.factor
@@ -2,7 +2,7 @@
 ! See http://factor.sf.net/license.txt for BSD license.
 IN: gadgets
 USING: gadgets generic kernel lists math namespaces sdl
-sequences words ;
+sequences vectors words ;
 
 ! A frame arranges left/right/top/bottom gadgets around a
 ! center gadget, which gets any leftover space.
@@ -43,7 +43,7 @@ C: frame ( -- frame )
 : add-h pref-size nip height [ + ] change ;
 : add-w pref-size drop width [ + ] change ;
 
-M: frame pref-size ( glue -- w h )
+M: frame pref-dim ( glue -- dim )
     [
         dup frame-major [ max-w ] each
         dup frame-minor [ max-h ] each
@@ -51,7 +51,7 @@ M: frame pref-size ( glue -- w h )
         dup frame-right add-w
         dup frame-top add-h
         frame-bottom add-h
-    ] with-pref-size ;
+    ] with-pref-size 0 3vector ;
 
 SYMBOL: frame-right-run
 SYMBOL: frame-bottom-run

diff --git a/library/ui/gadgets.factor b/library/ui/gadgets.factor
index 8610a394a91d95f8617dc4f66f4b852baff21e38..342faf3241c8e57e26d324081550968291614628 100644 (file)
--- a/library/ui/gadgets.factor
+++ b/library/ui/gadgets.factor
@@ -73,15 +73,15 @@ C: gadget ( shape -- gadget )
 : set-paint-prop ( gadget value key -- )
     rot gadget-paint set-hash ;
 
-GENERIC: pref-size ( gadget -- w h )
+GENERIC: pref-dim ( gadget -- dim )
 
-M: gadget pref-size shape-size ;
+M: gadget pref-dim shape-dim ;
 
-: pref-dim pref-size 0 3vector ;
+: pref-size pref-dim 3unseq drop ;
 
 GENERIC: layout* ( gadget -- )
 
-: prefer ( gadget -- ) [ pref-size ] keep resize-gadget ;
+: prefer ( gadget -- ) dup pref-dim swap set-gadget-dim ;
 
 M: gadget layout*
     #! Trivial layout gives each child its preferred size.

diff --git a/library/ui/labels.factor b/library/ui/labels.factor
index f7b71942597c9922a65a404e172050454bd18e57..72b8d9088ed2d8f3c87b00cbef40a2cc430eefb5 100644 (file)
--- a/library/ui/labels.factor
+++ b/library/ui/labels.factor
@@ -2,7 +2,7 @@
 ! See http://factor.sf.net/license.txt for BSD license.
 IN: gadgets
 USING: generic hashtables io kernel lists math namespaces sdl
-sequences styles ;
+sequences styles vectors ;
 
 ! A label gadget draws a string.
 TUPLE: label text ;
@@ -13,8 +13,8 @@ C: label ( text -- label )
 : label-size ( gadget text -- w h )
     >r gadget-font r> size-string ;
 
-M: label pref-size ( label -- w h )
-    dup label-text label-size ;
+M: label pref-dim ( label -- dim )
+    dup label-text label-size 0 3vector ;
 
 M: label draw-shape ( label -- )
     [ dup gadget-font swap label-text ] keep

diff --git a/library/ui/layouts.factor b/library/ui/layouts.factor
index 8ffbe1f877076753d5ba16818033275921e053dd..34fcad834b9c6af9e3e46264cddab040aaa8448d 100644 (file)
--- a/library/ui/layouts.factor
+++ b/library/ui/layouts.factor
@@ -27,8 +27,6 @@ namespaces sdl sequences ;
 : with-layout ( quot -- )
     [ 0 x set 0 y set call ] with-scope ; inline
 
-: default-gap 3 ;
-
 : packed-pref-dim ( children gap axis -- dim )
     #! The preferred size of the gadget, if all children are
     #! packed in the direction of the given axis.

diff --git a/library/ui/piles.factor b/library/ui/piles.factor
index ac8c33d329fcc0ad7da89c0b8ba6ecfd1e6cab7f..f23f9ac2abffad0eeb8991c411a3da56bc2e7aec 100644 (file)
--- a/library/ui/piles.factor
+++ b/library/ui/piles.factor
@@ -4,7 +4,20 @@ IN: gadgets
 USING: errors generic hashtables kernel lists math namespaces
 sdl sequences vectors ;
 
-! A pile is a box that lays out its contents vertically.
+! pile-align
+!
+! if the component is smaller than its allocated space, where to
+! place the component inside the allocated space.
+!
+! pile-gap
+! 
+! amount of space, in pixels, between components.
+! 
+! pile-fill
+! 
+! if the component is smaller than its allocated space, how much
+! to scale the size, where a value of 0 represents no scaling, and
+! a value of 1 represents resizing to fully fill allocated space.
 TUPLE: pile align gap fill ;
 
 C: pile ( align gap fill -- pile )
@@ -16,18 +29,16 @@ C: pile ( align gap fill -- pile )
     [ set-pile-gap ] keep
     [ set-pile-align ] keep ;
 
-: <default-pile> 1/2 default-gap 0 <pile> ;
-: <line-pile> 0 0 1 <pile> ;
+: <line-pile> 0 { 0 0 0 } 1 <pile> ;
 
-M: pile pref-size ( pile -- w h )
-    dup gadget-children swap pile-gap dup dup 3vector { 0 1 0 }
-    packed-pref-dim 3unseq drop ;
+M: pile pref-dim ( pile -- dim )
+    dup gadget-children swap pile-gap { 0 1 0 } packed-pref-dim ;
 
 : w- swap shape-w swap pref-size drop - ;
 : pile-x/y ( pile gadget offset -- )
     rot pile-align * >fixnum y get rot move-gadget ;
 : pile-w/h ( pile gadget offset -- )
-    rot dup pile-gap y [ + ] change
+    rot dup pile-gap first y [ + ] change
     pile-fill * >fixnum over pref-size dup y [ + ] change
     >r + r> rot resize-gadget ;
 : vertically ( pile gadget -- ) 2dup w- 3dup pile-x/y pile-w/h ;

diff --git a/library/ui/presentations.factor b/library/ui/presentations.factor
index ec260e5d6fb393c05023fc9d61961968fc315c77..72ebe2c0871b9ded059e892ee29769d9bab20fb6 100644 (file)
--- a/library/ui/presentations.factor
+++ b/library/ui/presentations.factor
@@ -1,10 +1,12 @@
 ! Copyright (C) 2005 Slava Pestov.
 ! See http://factor.sf.net/license.txt for BSD license.
 IN: gadgets
-USING: hashtables io kernel lists namespaces prettyprint ;
+USING: hashtables io kernel lists namespaces parser prettyprint
+sequences ;
 
 : actions-menu ( -- )
-    "actions" get <menu> show-menu ;
+    "actions" get [ uncons [ eval ] append cons ] map
+    <menu> show-menu ;
 
 : init-actions ( gadget -- )
     [ "actions" get actions-menu ] button-gestures ;

diff --git a/library/ui/scrolling.factor b/library/ui/scrolling.factor
index 94ec70e87e19b265804919634d9cd8eaf56ad541..858dcea33ecec1d3420ae25b43bcbe551c289c96 100644 (file)
--- a/library/ui/scrolling.factor
+++ b/library/ui/scrolling.factor
@@ -34,7 +34,7 @@ C: viewport ( content -- viewport )
     [ add-gadget ] keep
     { 0 0 0 } over set-viewport-origin ;
 
-M: viewport pref-size gadget-child pref-size ;
+M: viewport pref-dim gadget-child pref-dim ;
 
 M: viewport layout* ( viewport -- )
     dup viewport-origin
@@ -106,7 +106,7 @@ C: slider ( viewport vector -- slider )
 : thumb-dim ( slider -- h )
     [ shape-dim dup ] keep >thumb slider-dim vmax vmin ;
 
-M: slider pref-size drop slider-dim 3unseq drop ;
+M: slider pref-dim drop slider-dim ;
 
 M: slider layout* ( slider -- )
     dup thumb-loc over slider-vector v*
@@ -122,7 +122,9 @@ TUPLE: scroller viewport x y ;
 
 : add-y-slider 2dup set-scroller-y add-right ;
 
-: viewport>bottom -1 swap scroll-viewport ;
+: viewport>bottom ( -- viewport )
+    dup viewport-dim vneg over viewport-origin
+    { 0 1 0 } set-axis swap scroll ;
 
 : (scroll>bottom) ( scroller -- )
     dup scroller-viewport viewport>bottom

diff --git a/library/ui/shelves.factor b/library/ui/shelves.factor
index 157ad15bdd6ee6d17a89eb7bc188df203874568b..0aaf0f935437a63aa8bb731a0aae970143a1dec6 100644 (file)
--- a/library/ui/shelves.factor
+++ b/library/ui/shelves.factor
@@ -2,7 +2,7 @@
 ! See http://factor.sf.net/license.txt for BSD license.
 IN: gadgets
 USING: errors generic hashtables kernel lists math namespaces
-sdl sequences ;
+sdl sequences vectors ;
 
 ! A shelf is a box that lays out its contents horizontally.
 TUPLE: shelf gap align fill ;
@@ -16,10 +16,10 @@ C: shelf ( align gap fill -- shelf )
     [ set-shelf-gap ] keep
     [ set-shelf-align ] keep ;
 
-: <default-shelf> 1/2 default-gap 0 <shelf> ;
+: <default-shelf> 1/2 { 3 3 3 } 0 <shelf> ;
 : <line-shelf> 0 0 1 <shelf> ;
 
-M: shelf pref-size ( pile -- w h )
+M: shelf pref-dim ( pile -- dim )
     [
         dup shelf-gap swap gadget-children
         [ length 1 - 0 max * width set ] keep
@@ -28,7 +28,7 @@ M: shelf pref-size ( pile -- w h )
             height [ max ] change
             width [ + ] change
         ] each
-    ] with-pref-size ;
+    ] with-pref-size 0 3vector ;
 
 : h- swap shape-h swap pref-size nip - ;
 : shelf-x/y rot shelf-align * >fixnum >r x get r> rot move-gadget ;

diff --git a/library/ui/splitters.factor b/library/ui/splitters.factor
index d8e8bd84a673ac3e2f784c725d82af5916f8d687..3bfbe20e8674cc1785aa3a4264d93864721aa86d 100644 (file)
--- a/library/ui/splitters.factor
+++ b/library/ui/splitters.factor
@@ -8,7 +8,7 @@ TUPLE: divider splitter ;
 
 : divider-size { 8 8 0 } ;
 
-M: divider pref-size drop divider-size 3unseq drop ;
+M: divider pref-dim drop divider-size ;
 
 TUPLE: splitter vector split ;
 
@@ -43,9 +43,9 @@ C: splitter ( first second vector -- splitter )
 
 : <y-splitter> { 1 0 0 } <splitter> ;
 
-M: splitter pref-size
-    dup gadget-children swap splitter-vector { 0 0 0 } swap
-    packed-pref-dim 3unseq drop ;
+M: splitter pref-dim
+    dup gadget-children swap splitter-vector
+    { 0 0 0 } swap packed-pref-dim ;
 
 : splitter-part ( splitter -- vec )
     dup splitter-split swap shape-dim n*v divider-size 1/2 v*n v- ;

diff --git a/library/ui/stacks.factor b/library/ui/stacks.factor
index 08dbed1fd9e5aac50aed8a0f5a4909396d3ab5b4..7133200ca28085caa071bd1db7a2f047591760e0 100644 (file)
--- a/library/ui/stacks.factor
+++ b/library/ui/stacks.factor
@@ -13,7 +13,7 @@ C: stack ( list -- stack )
 : max-dim ( shapelist -- dim )
     { 0 0 0 } [ shape-dim vmax ] reduce ;
 
-M: stack pref-size gadget-children max-dim 3unseq drop ;
+M: stack pref-dim gadget-children max-dim ;
 
 M: stack layout* ( stack -- )
     dup shape-dim swap gadget-children

diff --git a/native/alien.c b/native/alien.c
index edd0ca24f3a1228cb129cc8f1c23b87823f322ce..86fa3921b5581e8dfc8594f646f5a959e1d215ff 100644 (file)
--- a/native/alien.c
+++ b/native/alien.c
@@ -1,5 +1,15 @@
 #include "factor.h"
 
+void primitive_expired(void)
+{
+       CELL object = dpeek();
+
+       if(type_of(object) == ALIEN_TYPE)
+               drepl(tag_boolean(alien->expired));
+       else
+               drepl(F);
+}
+
 INLINE void* alien_offset(CELL object)
 {
        ALIEN *alien;

diff --git a/native/alien.h b/native/alien.h
index c0ac4e6a257c1e9b8e574ff1b75a1e597aa1e8f3..4da239d77b63b4a13218248fc093e0a51c70e0ee 100644 (file)
--- a/native/alien.h
+++ b/native/alien.h
@@ -20,6 +20,7 @@ INLINE DISPLACED_ALIEN* untag_displaced_alien_fast(CELL tagged)
        return (DISPLACED_ALIEN*)UNTAG(tagged);
 }
 
+void primitive_expired(void);
 void primitive_alien(void);
 void primitive_displaced_alien(void);
 void primitive_alien_address(void);

diff --git a/native/primitives.c b/native/primitives.c
index e99328a3888b473b5dd1834182001384a0eb3529..d4a1f5407e09b1ee9ad4e95bcc7cce4c07ee8c27 100644 (file)
--- a/native/primitives.c
+++ b/native/primitives.c
@@ -172,7 +172,8 @@ void* primitives[] = {
        primitive_fgetc,
        primitive_fwrite,
        primitive_fflush,
-       primitive_fclose
+       primitive_fclose,
+       primitive_expired
 };
 
 CELL primitive_to_xt(CELL primitive)