start keyboard focus

TODO.FACTOR.txt

@@ -19,7 +19,6 @@
 - optimize away dispatch
 - layouts with gaps
 - alignment of gadgets inside their bounding boxes needs thought
-- WordPreview calls markTokens() -> NPE
 - faster completion
 - ppc register decls
 - rename f* words to stream-*
@@ -29,6 +28,7 @@
 - slot compile problem
 - sdl console crash
 - x86 register decl
+- UI: don't roll over if mouse button is down
 
 + compiler/ffi:
 

library/syntax/prettyprint.factor

@@ -107,13 +107,9 @@ M: word prettyprint* ( indent word -- indent )
     ] ifte ;
 
 M: list prettyprint* ( indent list -- indent )
-    [
+   [
-        [
+       \ [ swap \ ] prettyprint-sequence
-            \ [ swap \ ] prettyprint-sequence
+   ] check-recursion ;
-        ] check-recursion
-    ] [
-        f unparse write
-    ] ifte* ;
 
 M: cons prettyprint* ( indent cons -- indent )
     #! Here we turn the cons into a list of two elements.

library/ui/gestures.factor

@@ -27,17 +27,20 @@ SYMBOL: motion
 SYMBOL: button-up
 SYMBOL: button-down
 
+: hierarchy-gesture ( gadget ? gesture -- ? )
+    swap [
+        2drop f
+    ] [
+        swap handle-gesture* drop t
+    ] ifte ;
+
 : mouse-enter ( point gadget -- )
     #! If the old point is inside the new gadget, do not fire an
     #! enter gesture, since the mouse did not enter. Otherwise,
     #! fire an enter gesture and go on to the parent.
     [
         [ shape-pos + ] keep
-        2dup inside? [
+        2dup inside? [ mouse-enter ] hierarchy-gesture
-            drop f
-        ] [
-            [ mouse-enter ] swap handle-gesture* drop t
-        ] ifte
     ] each-parent drop ;
 
 : mouse-leave ( point gadget -- )
@@ -46,9 +49,23 @@ SYMBOL: button-down
     #! fire a leave gesture and go on to the parent.
     [
         [ shape-pos + ] keep
-        2dup inside? [
+        2dup inside? [ mouse-leave ] hierarchy-gesture
-            drop f
+    ] each-parent drop ;
-        ] [
+
-            [ mouse-leave ] swap handle-gesture* drop t
+: lose-focus ( old new -- )
-        ] ifte
+    #! If the old focus owner is a child of the new owner, do
+    #! not fire a focus lost gesture, since the focus was not
+    #! lost. Otherwise, fire a focus lost gesture and go to the
+    #! parent.
+    [
+        2dup child? [ lose-focus ] hierarchy-gesture
+    ] each-parent drop ;
+
+: gain-focus ( old new -- )
+    #! If the old focus owner is a child of the new owner, do
+    #! not fire a focus gained gesture, since the focus was not
+    #! gained. Otherwise, fire a focus gained gesture and go on
+    #! to the parent.
+    [
+        2dup child? [ gain-focus ] hierarchy-gesture
     ] each-parent drop ;

library/ui/hand.factor

@@ -43,8 +43,11 @@ DEFER: world
 ! The hand is a special gadget that holds mouse position and
 ! mouse button click state. The hand's parent is the world, but
 ! it is special in that the world does not list it as part of
-! its contents.
+! its contents. Some comments on the slots:
-TUPLE: hand click-pos clicked buttons gadget delegate ;
+! - hand-gadget is the gadget under the mouse position
+! - hand-clicked is the most recently clicked gadget
+! - hand-focus is the gadget holding keyboard focus
+TUPLE: hand click-pos clicked buttons gadget focus delegate ;
 
 C: hand ( world -- hand )
     0 0 0 0 <rectangle> <gadget>
@@ -81,3 +84,9 @@ C: hand ( world -- hand )
     dup r> fire-leave
     dup fire-motion
     r> swap fire-enter ;
+
+: request-focus ( gadget -- )
+    my-hand hand-focus swap
+    2dup lose-focus
+    2dup my-hand set-hand-focus
+    gain-focus ;