From 805d73ca2266e94d3f160335da939cf6468e1216 Mon Sep 17 00:00:00 2001
From: slava <slava@factorcode.org>
Date: Sun, 28 May 2006 22:35:01 +0000
Subject: [PATCH] Top-level window focus handling

---
 library/tools/describe.factor        |  3 ++-
 library/ui/cocoa/window-utils.factor | 14 +++++++++++++-
 library/ui/gestures.factor           |  8 ++++++++
 3 files changed, 23 insertions(+), 2 deletions(-)

diff --git a/library/tools/describe.factor b/library/tools/describe.factor
index d68d1784ce..69f9c8ec34 100644
--- a/library/tools/describe.factor
+++ b/library/tools/describe.factor
@@ -63,7 +63,8 @@ M: word summary ( word -- )
     ] if ;
 
 M: input summary ( input -- )
-    "Input: " swap input-string unparse-short append ;
+    "Input: " swap input-string
+    dup string? [ unparse-short ] unless append ;
 
 : format-column ( list ? -- list )
     >r [ unparse-short ] map r> [
diff --git a/library/ui/cocoa/window-utils.factor b/library/ui/cocoa/window-utils.factor
index 42e05d8db6..513b85fd4a 100644
--- a/library/ui/cocoa/window-utils.factor
+++ b/library/ui/cocoa/window-utils.factor
@@ -55,7 +55,7 @@ sequences ;
             frame-content-rect
         ]
     }
-        
+
     {
         "windowDidMove:" "void" { "id" "SEL" "id" } [
             2nip [object]
@@ -63,6 +63,18 @@ sequences ;
             swap [contentView] window set-world-loc
         ]
     }
+
+    {
+        "windowDidBecomeKey:" "void" { "id" "SEL" "id" } [
+            2nip [object] [contentView] window focus-world
+        ]
+    }
+
+    {
+        "windowDidResignKey:" "void" { "id" "SEL" "id" } [
+            2nip [object] [contentView] window unfocus-world
+        ]
+    }
 } { } define-objc-class
 
 : install-window-delegate ( window -- )
diff --git a/library/ui/gestures.factor b/library/ui/gestures.factor
index abeee90b3e..b7c00bebfb 100644
--- a/library/ui/gestures.factor
+++ b/library/ui/gestures.factor
@@ -105,6 +105,14 @@ V{ } clone hand-buttons set-global
 : request-focus ( gadget -- )
     dup focusable-child swap find-world request-focus* ;
 
+: focus-world ( world -- )
+    #! Sent when native window receives focus
+    focused-ancestors f focus-gestures ;
+
+: unfocus-world ( world -- )
+    #! Sent when native window loses focus.
+    focused-ancestors f swap focus-gestures ;
+
 : modifier ( mod modifiers -- seq )
     [ second swap bitand 0 > ] subset-with
     [ first ] map f like ;