start keyboard focus

diff --git a/TODO.FACTOR.txt b/TODO.FACTOR.txt
index 1c8bd032579158b0abfd7398ba3c3b7fdcbe85cd..029fbd05e2468c4d5c85181e0713cfb6e4681206 100644 (file)
--- a/TODO.FACTOR.txt
+++ b/TODO.FACTOR.txt
@@ -19,7 +19,6 @@
 - optimize away dispatch\r
 - layouts with gaps\r
 - alignment of gadgets inside their bounding boxes needs thought\r
-- WordPreview calls markTokens() -> NPE\r
 - faster completion\r
 - ppc register decls\r
 - rename f* words to stream-*\r
@@ -29,6 +28,7 @@
 - slot compile problem\r
 - sdl console crash\r
 - x86 register decl\r
+- UI: don't roll over if mouse button is down\r
 \r
 + compiler/ffi:\r
 \r

diff --git a/library/syntax/prettyprint.factor b/library/syntax/prettyprint.factor
index 8c6a069d9d335800f1ef0b5e9a6c314f6a3536d7..41f238b02ffd0d0b38f20d5a022b43c7219a4470 100644 (file)
--- a/library/syntax/prettyprint.factor
+++ b/library/syntax/prettyprint.factor
@@ -107,13 +107,9 @@ M: word prettyprint* ( indent word -- indent )
     ] ifte ;
 
 M: list prettyprint* ( indent list -- indent )
-    [
-        [
-            \ [ swap \ ] prettyprint-sequence
-        ] check-recursion
-    ] [
-        f unparse write
-    ] ifte* ;
+   [
+       \ [ swap \ ] prettyprint-sequence
+   ] check-recursion ;
 
 M: cons prettyprint* ( indent cons -- indent )
     #! Here we turn the cons into a list of two elements.

diff --git a/library/ui/gestures.factor b/library/ui/gestures.factor
index f87b52d7e5a20cc9455cc88b7809b73f2dd47980..76d4daadaf4e6404135bbaa2700f2b5af62ea6b0 100644 (file)
--- a/library/ui/gestures.factor
+++ b/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? [
-            drop f
-        ] [
-            [ mouse-enter ] swap handle-gesture* drop t
-        ] ifte
+        2dup inside? [ mouse-enter ] hierarchy-gesture
     ] 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? [
-            drop f
-        ] [
-            [ mouse-leave ] swap handle-gesture* drop t
-        ] ifte
+        2dup inside? [ mouse-leave ] hierarchy-gesture
+    ] each-parent drop ;
+
+: lose-focus ( old new -- )
+    #! 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 ;

diff --git a/library/ui/hand.factor b/library/ui/hand.factor
index b8a3ebe1b1b7969c09d78f4c27a0743a02e5371e..f1d609df225abe3460d979ae2680ec79a6f9310a 100644 (file)
--- a/library/ui/hand.factor
+++ b/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.
-TUPLE: hand click-pos clicked buttons gadget delegate ;
+! its contents. Some comments on the slots:
+! - 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 ;