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 1e5af88ac85fae96a994a4ba0adbfc52523c04ee..e1c8882cdd9080545e5170ed904dcc6130e88ac0 100644 (file)
--- a/basis/ui/ui.factor
+++ b/basis/ui/ui.factor
@@ -1,12 +1,13 @@
 ! Copyright (C) 2006, 2010 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: arrays assocs boxes io kernel math models namespaces make
-dlists deques sequences threads words continuations init
-combinators combinators.short-circuit hashtables
-concurrency.flags sets accessors calendar fry destructors
-ui.gadgets ui.gadgets.private ui.gadgets.worlds
-ui.gadgets.tracks ui.gestures ui.backend ui.render strings
-classes.tuple classes.tuple.parser lexer vocabs.parser parser ;
+USING: accessors arrays assocs boxes classes.tuple
+classes.tuple.parser combinators combinators.short-circuit
+concurrency.flags concurrency.promises continuations deques
+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
@@ -16,8 +17,6 @@ SYMBOL: windows
 
 : window ( handle -- world ) windows get-global at ;
 
-: window-focus ( handle -- gadget ) window world-focus ;
-
 : register-window ( world handle -- )
     #! Add the new window just below the topmost window. Why?
     #! So that if the new window doesn't actually receive focus
@@ -30,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
@@ -83,6 +82,9 @@ M: world graft*
         [ [ clean-up-broken-window ] [ ui-error ] bi* ] recover
     ] bi ;
 
+: dispose-window-resources ( world -- )
+    [ <reversed> [ [ dispose ] when* ] each V{ } clone ] change-window-resources drop ;
+
 M: world ungraft*
     {
         [ set-gl-context ]
@@ -91,9 +93,10 @@ M: world ungraft*
         [ hand-clicked close-global ]
         [ hand-gadget close-global ]
         [ end-world ]
-        [ [ <reversed> [ [ dispose ] when* ] each V{ } clone ] change-window-resources drop ]
-        [ [ (close-window) f ] change-handle drop ]
+        [ dispose-window-resources ]
         [ unfocus-world ]
+        [ [ (close-window) f ] change-handle drop ]
+        [ promise>> t swap fulfill ]
     } cleave ;
 
 : init-ui ( -- )
@@ -111,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 ;
@@ -139,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
 
@@ -168,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>
@@ -195,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 -- )
 
@@ -207,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 ;
 
@@ -219,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 ;