Fix race condition with gesture handling and grafting

basis/ui/cocoa/views/views.factor

@@ -60,7 +60,7 @@ IN: ui.cocoa.views
     dup event-modifiers swap key-code ;
 
 : send-key-event ( view gesture -- )
-    swap window-focus propagate-gesture ;
+    swap window propagate-key-gesture ;
 
 : interpret-key-event ( view event -- )
     NSArray swap -> arrayWithObject: -> interpretKeyEvents: ;
@@ -275,14 +275,14 @@ CLASS: {
 { "readSelectionFromPasteboard:" "char" { "id" "SEL" "id" }
     [
         pasteboard-string dup [
-            [ drop window-focus ] dip swap user-input 1
+            [ drop window ] dip swap user-input 1
         ] [ 3drop 0 ] if
     ]
 }
 
 ! Text input
 { "insertText:" "void" { "id" "SEL" "id" }
-    [ nip CF>string swap window-focus user-input ]
+    [ nip CF>string swap window user-input ]
 }
 
 { "hasMarkedText" "char" { "id" "SEL" }

basis/ui/gestures/gestures.factor

@@ -41,13 +41,25 @@ M: propagate-gesture send-queued-gesture
 : propagate-gesture ( gesture gadget -- )
     \ propagate-gesture queue-gesture ;
 
-TUPLE: user-input string gadget ;
+TUPLE: propagate-key-gesture gesture world ;
+
+: world-focus ( world -- gadget )
+    dup focus>> [ world-focus ] [ ] ?if ;
+
+M: propagate-key-gesture send-queued-gesture
+    [ gesture>> ] [ world>> world-focus ] bi
+    [ handle-gesture ] with each-parent drop ;
+
+: propagate-key-gesture ( gesture world -- )
+    \ propagate-key-gesture queue-gesture ;
+
+TUPLE: user-input string world ;
 
 M: user-input send-queued-gesture
-    [ string>> ] [ gadget>> ] bi
+    [ string>> ] [ world>> world-focus ] bi
     [ user-input* ] with each-parent drop ;
 
-: user-input ( string gadget -- )
+: user-input ( string world -- )
     '[ _ \ user-input queue-gesture ] unless-empty ;
 
 ! Gesture objects
@@ -261,9 +273,6 @@ SYMBOL: drag-timer
     scroll-direction set-global
     T{ mouse-scroll } hand-gadget get-global propagate-gesture ;
 
-: world-focus ( world -- gadget )
-    dup focus>> [ world-focus ] [ ] ?if ;
-
 : send-action ( world gesture -- )
     swap world-focus propagate-gesture ;
 

basis/ui/ui.factor

@@ -140,7 +140,7 @@ SYMBOL: ui-hook
     graft-queue [ notify ] slurp-deque ;
 
 : send-queued-gestures ( -- )
-    gesture-queue [ send-queued-gesture ] slurp-deque ;
+    gesture-queue [ send-queued-gesture notify-queued ] slurp-deque ;
 
 : update-ui ( -- )
     [

basis/ui/windows/windows.factor

@@ -181,7 +181,7 @@ SYMBOLS: msg-obj class-name-ptr mouse-captured ;
 
 : send-key-gesture ( sym action? quot hWnd -- )
     [ [ key-modifiers ] 3dip call ] dip
-    window-focus propagate-gesture ; inline
+    window propagate-key-gesture ; inline
 
 : send-key-down ( sym action? hWnd -- )
     [ [ <key-down> ] ] dip send-key-gesture ;
@@ -213,7 +213,7 @@ SYMBOLS: msg-obj class-name-ptr mouse-captured ;
         ctrl? alt? xor [
             wParam 1string
             [ f hWnd send-key-down ]
-            [ hWnd window-focus user-input ] bi
+            [ hWnd window user-input ] bi
         ] unless
     ] unless ;
 

basis/ui/x11/x11.factor

@@ -83,8 +83,7 @@ M: world configure-event
 
 M: world key-down-event
     [ key-down-event>gesture ] keep
-    world-focus
+    [ propagate-key-gesture drop ]
-    [ propagate-gesture drop ]
     [ 2over valid-input? [ nip user-input ] [ 3drop ] if ]
     3bi ;
 
@@ -92,7 +91,7 @@ M: world key-down-event
     dup event-modifiers swap 0 XLookupKeysym key-code <key-up> ;
 
 M: world key-up-event
-    [ key-up-event>gesture ] dip world-focus propagate-gesture ;
+    [ key-up-event>gesture ] dip propagate-key-gesture ;
 
 : mouse-event>gesture ( event -- modifiers button loc )
     [ event-modifiers ]
@@ -138,7 +137,7 @@ M: world focus-out-event
 
 M: world selection-notify-event
     [ handle>> window>> selection-from-event ] keep
-    world-focus user-input ;
+    world user-input ;
 
 : supported-type? ( atom -- ? )
     { "UTF8_STRING" "STRING" "TEXT" }