From 2da85091341eac0d94609dde3a0afd671f6d005b Mon Sep 17 00:00:00 2001
From: Slava Pestov <slava@factorcode.org>
Date: Sat, 24 Nov 2007 15:41:27 -0500
Subject: [PATCH] Update Cocoa UI backend for recent changes

---
 extra/ui/cocoa/cocoa.factor         | 10 +++++++++-
 extra/ui/cocoa/views/views.factor   | 11 ++++++++---
 extra/ui/tools/deploy/deploy.factor |  7 ++++++-
 extra/ui/ui.factor                  |  4 +++-
 4 files changed, 26 insertions(+), 6 deletions(-)

diff --git a/extra/ui/cocoa/cocoa.factor b/extra/ui/cocoa/cocoa.factor
index 52722a2fab..6607a22f50 100755
--- a/extra/ui/cocoa/cocoa.factor
+++ b/extra/ui/cocoa/cocoa.factor
@@ -60,11 +60,19 @@ M: cocoa-ui-backend set-title ( string world -- )
         drop
     ] if ;
 
-M: cocoa-ui-backend (open-world-window) ( world -- )
+M: cocoa-ui-backend (open-window) ( world -- )
     dup gadget-window
     dup auto-position
     world-handle second f -> makeKeyAndOrderFront: ;
 
+M: cocoa-ui-backend (close-window) ( handle -- )
+    first unregister-window ;
+
+M: cocoa-ui-backend close-window ( gadget -- )
+    find-world [
+        world-handle second f -> performClose:
+    ] when* ;
+
 M: cocoa-ui-backend raise-window ( world -- )
     world-handle [
         second dup f -> orderFront: -> makeKeyWindow
diff --git a/extra/ui/cocoa/views/views.factor b/extra/ui/cocoa/views/views.factor
index 31d6c89f8c..feac09ffc4 100644
--- a/extra/ui/cocoa/views/views.factor
+++ b/extra/ui/cocoa/views/views.factor
@@ -3,7 +3,8 @@
 USING: alien arrays assocs cocoa kernel math cocoa.messages
 cocoa.subclassing cocoa.classes cocoa.views cocoa.application
 cocoa.pasteboard cocoa.types cocoa.windows sequences ui
-ui.gadgets ui.gadgets.worlds ui.gestures core-foundation ;
+ui.gadgets ui.gadgets.worlds ui.gestures core-foundation
+threads ;
 IN: ui.cocoa.views
 
 : send-mouse-moved ( view event -- )
@@ -313,8 +314,6 @@ CLASS: {
 { "dealloc" "void" { "id" "SEL" }
     [
         drop
-        dup window stop-world
-        dup unregister-window
         dup remove-observer
         SUPER-> dealloc
     ]
@@ -347,6 +346,12 @@ CLASS: {
         forget-rollover
         2nip -> object -> contentView window unfocus-world
     ]
+}
+
+{ "windowShouldClose:" "bool" { "id" "SEL" "id" }
+    [
+        2nip -> contentView window ungraft t
+    ]
 } ;
 
 : install-window-delegate ( window -- )
diff --git a/extra/ui/tools/deploy/deploy.factor b/extra/ui/tools/deploy/deploy.factor
index c4b41e119f..e7d9161079 100755
--- a/extra/ui/tools/deploy/deploy.factor
+++ b/extra/ui/tools/deploy/deploy.factor
@@ -77,7 +77,8 @@ TUPLE: deploy-gadget vocab settings ;
 
 : com-deploy ( gadget -- )
     dup com-save
-    find-deploy-vocab [ deploy ] curry call-listener ;
+    dup find-deploy-vocab [ deploy ] curry call-listener
+    close-window ;
 
 : com-help ( -- )
     "ui-deploy" help-window ;
@@ -86,7 +87,11 @@ TUPLE: deploy-gadget vocab settings ;
     { +nullary+ t }
 } define-command
 
+: com-close ( gadget -- )
+    close-window ;
+
 deploy-gadget "toolbar" f {
+    { f com-close }
     { f com-help }
     { f com-revert }
     { f com-save }
diff --git a/extra/ui/ui.factor b/extra/ui/ui.factor
index 1f7f0dabca..98549a16f7 100755
--- a/extra/ui/ui.factor
+++ b/extra/ui/ui.factor
@@ -72,7 +72,9 @@ M: world ungraft*
     >r [ 1 track, ] { 0 1 } make-track r>
     f <world> open-world-window ;
 
-: close-window ( gadget -- )
+HOOK: close-window ui-backend ( gadget -- )
+
+M: object close-window
     find-world [ ungraft ] when* ;
 
 : find-window ( quot -- world )