basis: use lint.vocabs tool to trim using lists

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

diff --git a/basis/ui/ui.factor b/basis/ui/ui.factor
index 5cce30ac93a3e1c25b0bafb7315b1fc0fe590174..b2b556a42635f108fb64d89004876d68653b15b6 100644 (file)
--- a/basis/ui/ui.factor
+++ b/basis/ui/ui.factor
@@ -3,18 +3,18 @@
 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
-math.functions namespaces parser sequences sets strings threads
-ui.backend ui.gadgets ui.gadgets.private ui.gadgets.worlds
-ui.gestures ui.render vectors vocabs.parser words ;
+destructors dlists kernel lexer make math math.functions
+namespaces parser sequences sets strings threads ui.backend
+ui.gadgets ui.gadgets.private ui.gadgets.worlds ui.gestures
+ui.render vectors vocabs.parser words ;
 IN: ui
 
 <PRIVATE
 
-! Assoc mapping aliens to gadgets
-SYMBOL: ui-windows
+! Assoc mapping aliens to worlds
+SYMBOL: worlds
 
-: window ( handle -- world ) ui-windows get-global at ;
+: window ( handle -- world ) worlds get-global at ;
 
 : register-window ( world handle -- )
     ! Add the new window just below the topmost window. Why?
@@ -23,15 +23,15 @@ SYMBOL: ui-windows
     ! in the new window when it appears) Factor doesn't get
     ! confused and send workspace operations to the new window,
     ! etc.
-    swap 2array ui-windows get-global push
-    ui-windows get-global dup length 1 >
+    swap 2array worlds get-global push
+    worlds get-global dup length 1 >
     [ [ length 1 - dup 1 - ] keep exchange ] [ drop ] if ;
 
 : unregister-window ( handle -- )
-    ui-windows [ [ first = ] with reject ] change-global ;
+    worlds [ [ first = ] with reject ] change-global ;
 
 : raised-window ( world -- )
-    ui-windows get-global
+    worlds get-global
     [ [ second eq? ] with find drop ] keep
     [ nth ] [ remove-nth! drop ] [ nip ] 2tri push ;
 
@@ -105,13 +105,13 @@ M: world ungraft*
     <dlist> \ graft-queue set-global
     100 <vector> \ layout-queue set-global
     <dlist> \ gesture-queue set-global
-    V{ } clone ui-windows set-global ;
+    V{ } clone worlds set-global ;
 
 : update-hand ( world -- )
     dup hand-world get-global eq?
     [ hand-loc get-global swap move-hand ] [ drop ] if ;
 
-: slurp-vector ( .. seq quot: ( ... elt -- .. ) -- )
+: slurp-vector ( ... seq quot: ( ... elt -- ... ) -- ... )
     over '[ _ empty? not ] -rot '[ _ pop @ ] while ; inline
 
 : layout-queued ( -- seq )
@@ -134,28 +134,29 @@ M: world ungraft*
 
 SYMBOL: ui-running
 
-: with-ui-running ( quot -- )
-    t ui-running set-global
-    [ f ui-running set-global ] [ ] cleanup ; inline
-
 PRIVATE>
 
-: find-window ( quot: ( world -- ? ) -- world/f )
-    [ ui-windows get-global values ] dip
+: find-windows ( quot: ( world -- ? ) -- seq )
+    [ worlds get-global values ] dip
     '[ dup children>> [ ] [ nip first ] if-empty @ ]
-    find-last nip ; inline
+    filter ; inline
+
+: find-window ( quot: ( world -- ? ) -- world/f )
+    find-windows ?last ; inline
 
 : ui-running? ( -- ? )
     ui-running get-global ;
 
 <PRIVATE
 
+SYMBOL: ui-thread
+
 : update-ui-loop ( -- )
     ! Note the logic: if update-ui fails, we open an error window and
     ! run one iteration of update-ui. If that also fails, well, the
     ! whole UI subsystem is broken so we throw the error to terminate
     ! the update-ui-loop.
-    [ ui-running? ]
+    [ { [ ui-running? ] [ ui-thread get-global self eq? ] } 0&& ]
     [
         ui-notify-flag get lower-flag
         [ update-ui ] [
@@ -166,7 +167,8 @@ PRIVATE>
     ] while ;
 
 : start-ui-thread ( -- )
-    [ update-ui-loop ] "UI update" spawn drop ;
+    [ self ui-thread set-global update-ui-loop ]
+    "UI update" spawn drop ;
 
 : start-ui ( quot -- )
     call( -- ) notify-ui-thread start-ui-thread ;
@@ -199,17 +201,17 @@ PRIVATE>
     find-world raise-window* ;
 
 : topmost-window ( -- world )
-    ui-windows get-global last second ;
+    worlds get-global last second ;
 
 HOOK: close-window ui-backend ( gadget -- )
 
 M: object close-window
     find-world [ ungraft ] when* ;
 
-[
+STARTUP-HOOK: [
     f ui-running set-global
     <flag> ui-notify-flag set-global
-] "ui" add-startup-hook
+]
 
 HOOK: resize-window ui-backend ( world dim -- )
 M: object resize-window 2drop ;
@@ -219,7 +221,15 @@ M: object resize-window 2drop ;
     [ find-world [ dup pref-dim resize-window ] when* ] bi ;
 
 : with-ui ( quot: ( -- ) -- )
-    ui-running? [ call( -- ) ] [ '[ init-ui @ ] (with-ui) ] if ;
+    ui-running? [ call( -- ) ] [
+        t ui-running set-global '[
+            [ init-ui @ ] (with-ui)
+        ] [
+            f ui-running set-global
+            ! Give running ui threads a chance to finish.
+            notify-ui-thread yield
+        ] finally
+    ] if ;
 
 HOOK: beep ui-backend ( -- )