use reject instead of [ ... not ] filter.

[factor.git] / basis / ui / ui.factor

diff --git a/basis/ui/ui.factor b/basis/ui/ui.factor
index 68bb064328d1769d501494859b99ce399b026583..e1c8882cdd9080545e5170ed904dcc6130e88ac0 100644 (file)
--- a/basis/ui/ui.factor
+++ b/basis/ui/ui.factor
@@ -7,6 +7,7 @@ destructors dlists fry init kernel lexer make math namespaces
 parser sequences sets strings threads ui.backend ui.gadgets
 ui.gadgets.private ui.gadgets.worlds ui.gestures vocabs.parser
 words ;
+FROM: namespaces => change-global ;
 IN: ui
 
 <PRIVATE
@@ -28,7 +29,7 @@ SYMBOL: windows
     [ [ length 1 - dup 1 - ] keep exchange ] [ drop ] if ;
 
 : unregister-window ( handle -- )
-    windows [ [ first = not ] with filter ] change-global ;
+    windows [ [ first = ] with reject ] change-global ;
 
 : raised-window ( world -- )
     windows get-global
@@ -113,13 +114,17 @@ M: world ungraft*
     dup hand-world get-global eq?
     [ hand-loc get-global swap move-hand ] [ drop ] if ;
 
-: layout-queued ( -- seq )
+: (layout-queued) ( deque -- seq )
     [
         in-layout? on
-        layout-queue [
+        [
             dup layout find-world [ , ] when*
         ] slurp-deque
-    ] { } make members ;
+    ] { } make members ; inline
+
+: layout-queued ( -- seq )
+    layout-queue dup deque-empty?
+    [ drop { } ] [ (layout-queued) ] if ;
 
 : redraw-worlds ( seq -- )
     [ dup update-hand draw-world ] each ;
@@ -141,8 +146,8 @@ SYMBOL: ui-thread
 
 PRIVATE>
 
-: find-window ( quot -- world )
-    [ windows get values ] dip
+: find-window ( quot: ( world -- ? ) -- world )
+    [ windows get-global values ] dip
     '[ dup children>> [ ] [ nip first ] if-empty @ ]
     find-last nip ; inline
 
@@ -170,7 +175,7 @@ PRIVATE>
     call( -- ) notify-ui-thread start-ui-thread ;
 
 : ?attributes ( gadget title/attributes -- attributes )
-    dup string? [ world-attributes new swap >>title ] [ clone ] if
+    dup string? [ <world-attributes> swap >>title ] [ clone ] if
     swap [ [ [ 1array ] [ f ] if* ] curry unless* ] curry change-gadgets ;
 
 PRIVATE>
@@ -197,7 +202,7 @@ PRIVATE>
     find-world raise-window* ;
 
 : topmost-window ( -- world )
-    windows get last second ;
+    windows get-global last second ;
 
 HOOK: close-window ui-backend ( gadget -- )
 
@@ -209,6 +214,13 @@ M: object close-window
     <flag> ui-notify-flag set-global
 ] "ui" add-startup-hook
 
+HOOK: resize-window ui-backend ( world dim -- )
+M: object resize-window 2drop ;
+
+: relayout-window ( gadget -- )
+    [ relayout ]
+    [ find-world [ dup pref-dim resize-window ] when* ] bi ;
+
 : with-ui ( quot: ( -- ) -- )
     ui-running? [ call( -- ) ] [ '[ init-ui @ ] (with-ui) ] if ;
 
@@ -221,11 +233,11 @@ HOOK: system-alert ui-backend ( caption text -- )
 
 : define-main-window ( word attributes quot -- )
     [
-        '[ [ f _ clone @ open-window ] with-ui ] (( -- )) define-declared
+        '[ [ f _ clone @ open-window ] with-ui ] ( -- ) define-declared
     ] [ 2drop current-vocab main<< ] 3bi ;
 
 SYNTAX: MAIN-WINDOW:
-    CREATE
+    scan-new-word
     world-attributes parse-main-window-attributes
     parse-definition
     define-main-window ;