presentations in UI of words and vocabs

diff --git a/library/ui/layouts.factor b/library/ui/layouts.factor
index 34fcad834b9c6af9e3e46264cddab040aaa8448d..89227ad18fe38f12d9f02755a25ccc90b378643d 100644 (file)
--- a/library/ui/layouts.factor
+++ b/library/ui/layouts.factor
@@ -27,10 +27,13 @@ namespaces sdl sequences ;
 : with-layout ( quot -- )
     [ 0 x set 0 y set call ] with-scope ; inline
 
-: packed-pref-dim ( children gap axis -- dim )
+: pref-dims ( gadget -- list )
+    gadget-children [ pref-dim ] map ;
+
+: packed-pref-dim ( gadget gap axis -- dim )
     #! The preferred size of the gadget, if all children are
     #! packed in the direction of the given axis.
     >r
-    over length 0 max v*n >r [ pref-dim ] map r>
+    over length 0 max v*n >r pref-dims r>
     2dup [ v+ ] reduce >r [ vmax ] reduce r>
     r> set-axis ;

diff --git a/library/ui/panes.factor b/library/ui/panes.factor
index 10de6e417371dc7d944f70822716206856545c29..05cf9bfda0565296c22e40c865a8b54f88942a9a 100644 (file)
--- a/library/ui/panes.factor
+++ b/library/ui/panes.factor
@@ -29,14 +29,15 @@ TUPLE: pane output active current input continuation ;
 : pop-continuation ( pane -- quot )
     dup pane-continuation f rot set-pane-continuation ;
 
-: pane-return ( pane -- )
-    [
-        pane-input [
-            commit-history line-text get line-clear
-        ] with-editor
-    ] keep
+: pane-eval ( line pane -- )
     2dup stream-write "\n" over stream-write
     pop-continuation in-thread drop ;
+
+: pane-return ( pane -- )
+    [
+        pane-input
+        [ commit-history line-text get line-clear ] with-editor
+    ] keep pane-eval ;
  
 : pane-actions ( line -- )
     [
@@ -55,15 +56,15 @@ C: pane ( -- pane )
     dup pane-paint
     dup pane-actions ;
 
-: pane-write-1 ( style pane text -- )
-    swap >r <styled-label> r> pane-current add-gadget ;
+: pane-write-1 ( style text pane -- )
+    [ <presentation> ] keep pane-current add-gadget ;
 
 : pane-terpri ( pane -- )
     dup pane-current over pane-output add-gadget
     <line-shelf> over set-pane-current init-active-line ;
 
 : pane-write ( style pane list -- )
-    3dup car pane-write-1 cdr dup
+    3dup car swap pane-write-1 cdr dup
     [ over pane-terpri pane-write ] [ 3drop ] ifte ;
 
 ! Panes are streams.

diff --git a/library/ui/piles.factor b/library/ui/piles.factor
index f23f9ac2abffad0eeb8991c411a3da56bc2e7aec..b41cb4396bf131ae31448826e6ce5d1467f9dcb8 100644 (file)
--- a/library/ui/piles.factor
+++ b/library/ui/piles.factor
@@ -32,7 +32,7 @@ C: pile ( align gap fill -- pile )
 : <line-pile> 0 { 0 0 0 } 1 <pile> ;
 
 M: pile pref-dim ( pile -- dim )
-    dup gadget-children swap pile-gap { 0 1 0 } packed-pref-dim ;
+    dup pile-gap { 0 1 0 } packed-pref-dim ;
 
 : w- swap shape-w swap pref-size drop - ;
 : pile-x/y ( pile gadget offset -- )

diff --git a/library/ui/presentations.factor b/library/ui/presentations.factor
index 72ebe2c0871b9ded059e892ee29769d9bab20fb6..8c4267db08c02d2ccf6d39d03401dbb1261473c1 100644 (file)
--- a/library/ui/presentations.factor
+++ b/library/ui/presentations.factor
@@ -4,13 +4,18 @@ IN: gadgets
 USING: hashtables io kernel lists namespaces parser prettyprint
 sequences ;
 
-: actions-menu ( -- )
-    "actions" get [ uncons [ eval ] append cons ] map
-    <menu> show-menu ;
+: actions-menu ( pane actions -- menu )
+    [ uncons rot [ pane-eval ] cons cons cons ] map-with <menu> ;
 
-: init-actions ( gadget -- )
-    [ "actions" get actions-menu ] button-gestures ;
+: init-actions ( gadget pane -- )
+    over "actions" paint-prop dup [
+        actions-menu [ show-menu ] cons button-gestures
+    ] [
+        3drop
+    ] ifte ;
 
 : <styled-label> ( style text -- label )
-    <label> "actions" pick assoc [ dup init-actions ] when
-    swap alist>hash over set-gadget-paint ;
+    <label> swap alist>hash over set-gadget-paint ;
+
+: <presentation> ( style text pane -- presentation )
+    >r <styled-label> dup r> init-actions ;

diff --git a/library/ui/scrolling.factor b/library/ui/scrolling.factor
index 858dcea33ecec1d3420ae25b43bcbe551c289c96..78c691aadd1a9b3962bd306c3c296b340369b0b6 100644 (file)
--- a/library/ui/scrolling.factor
+++ b/library/ui/scrolling.factor
@@ -123,7 +123,7 @@ TUPLE: scroller viewport x y ;
 : add-y-slider 2dup set-scroller-y add-right ;
 
 : viewport>bottom ( -- viewport )
-    dup viewport-dim vneg over viewport-origin
+    dup viewport-origin over viewport-dim vneg
     { 0 1 0 } set-axis swap scroll ;
 
 : (scroll>bottom) ( scroller -- )

diff --git a/library/ui/splitters.factor b/library/ui/splitters.factor
index 3bfbe20e8674cc1785aa3a4264d93864721aa86d..e9f8560d55c8aae139c19bbbc3ea44293a1e2bce 100644 (file)
--- a/library/ui/splitters.factor
+++ b/library/ui/splitters.factor
@@ -44,8 +44,7 @@ C: splitter ( first second vector -- splitter )
 : <y-splitter> { 1 0 0 } <splitter> ;
 
 M: splitter pref-dim
-    dup gadget-children swap splitter-vector
-    { 0 0 0 } swap packed-pref-dim ;
+    { 0 0 0 } over splitter-vector 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/native/alien.c b/native/alien.c
index 86fa3921b5581e8dfc8594f646f5a959e1d215ff..bacd06733813b487ec1f53266392e75f9ad9dedf 100644 (file)
--- a/native/alien.c
+++ b/native/alien.c
@@ -5,7 +5,10 @@ void primitive_expired(void)
        CELL object = dpeek();
 
        if(type_of(object) == ALIEN_TYPE)
+       {
+               ALIEN *alien = untag_alien_fast(object);
                drepl(tag_boolean(alien->expired));
+       }
        else
                drepl(F);
 }