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 open-world-window ; -: close-window ( gadget -- ) +HOOK: close-window ui-backend ( gadget -- ) + +M: object close-window find-world [ ungraft ] when* ; : find-window ( quot -- world )