Add user-visible grab-input and ungrab-input words to cleanly toggle grabbing on...

diff --git a/basis/ui/gadgets/worlds/worlds-docs.factor b/basis/ui/gadgets/worlds/worlds-docs.factor
index d4e9790d89d8186f7f479c5bdea5367a10d143e2..c12c6b93aac42c983b2cedc1df80ed30bc08130b 100755 (executable)
--- a/basis/ui/gadgets/worlds/worlds-docs.factor
+++ b/basis/ui/gadgets/worlds/worlds-docs.factor
@@ -13,6 +13,17 @@ HELP: origin
 HELP: hand-world
 { $var-description "Global variable. The " { $link world } " containing the gadget at the mouse location." } ;
 
+HELP: grab-input
+{ $values { "gadget" gadget } }
+{ $description "Sets the " { $link world } " containing " { $snippet "gadget" } " to grab mouse and keyboard input while focused." }
+{ $notes "Normal mouse gestures may not be available while input is grabbed." } ;
+
+HELP: ungrab-input
+{ $values { "gadget" gadget } }
+{ $description "Sets the " { $link world } " containing " { $snippet "gadget" } " not to grab mouse and keyboard input while focused." } ;
+
+{ grab-input ungrab-input } related-words
+
 HELP: set-title
 { $values { "string" string } { "world" world } }
 { $description "Sets the title bar of the native window containing the world." }
@@ -42,6 +53,7 @@ HELP: world
         { { $snippet "focus" } " - the current owner of the keyboard focus in the world." }
         { { $snippet "focused?" } " - a boolean indicating if the native window containing the world has keyboard focus." }
         { { $snippet "fonts" } " - a hashtable used by the " { $link font-renderer } "." }
+        { { $snippet "grab-input?" } " - if set to " { $link t } ", the world will hide the mouse cursor and disable normal mouse input while focused. Use " { $link grab-input } " and " { $link ungrab-input } " to change this setting." }
         { { $snippet "handle" } " - a backend-specific native handle representing the native window containing the world, or " { $link f } " if the world is not grafted." }
         { { $snippet "window-loc" } " - the on-screen location of the native window containing the world. The co-ordinate system here is backend-specific." }
     }

diff --git a/basis/ui/gadgets/worlds/worlds.factor b/basis/ui/gadgets/worlds/worlds.factor
index a70d2053775e5aae5fb80f52f32b1b9b599afbbf..d85bba999215e2ab81dc3e41d6b14018795db719 100755 (executable)
--- a/basis/ui/gadgets/worlds/worlds.factor
+++ b/basis/ui/gadgets/worlds/worlds.factor
@@ -31,6 +31,20 @@ TUPLE: world-attributes
 
 : find-world ( gadget -- world/f ) [ world? ] find-parent ;
 
+: grab-input ( gadget -- )
+    find-world dup grab-input?>>
+    [ drop ] [
+        t >>grab-input?
+        dup focused?>> [ handle>> (grab-input) ] [ drop ] if
+    ] if ;
+
+: ungrab-input ( gadget -- )
+    find-world dup grab-input?>>
+    [
+        f >>grab-input?
+        dup focused?>> [ handle>> (ungrab-input) ] [ drop ] if
+    ] [ drop ] if ;
+    
 : show-status ( string/f gadget -- )
     dup find-world dup [
         dup status>> [