From 0e0e79eb7ec5c6627c2bd979040d80f2c31deaf5 Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Fri, 5 Dec 2008 01:49:46 -0600 Subject: [PATCH] Redo how Cocoa event loop is done; fixes problem with expose, focus issue when closing windows --- basis/cocoa/application/application.factor | 19 +++++------- basis/cocoa/messages/messages.factor | 34 ++++++++++++---------- basis/ui/cocoa/cocoa.factor | 21 ++++++++++--- basis/ui/cocoa/tools/tools.factor | 6 ++-- 4 files changed, 46 insertions(+), 34 deletions(-) diff --git a/basis/cocoa/application/application.factor b/basis/cocoa/application/application.factor index c62fab0f15..ab12a93a31 100644 --- a/basis/cocoa/application/application.factor +++ b/basis/cocoa/application/application.factor @@ -27,17 +27,19 @@ IN: cocoa.application : NSApp ( -- app ) NSApplication -> sharedApplication ; +: NSAnyEventMask ( -- mask ) HEX: ffffffff ; inline + FUNCTION: void NSBeep ( ) ; : with-cocoa ( quot -- ) [ NSApp drop call ] with-autorelease-pool ; inline : next-event ( app -- event ) - 0 f CFRunLoopDefaultMode 1 + NSAnyEventMask f CFRunLoopDefaultMode 1 -> nextEventMatchingMask:untilDate:inMode:dequeue: ; : do-event ( app -- ? ) - dup next-event [ -> sendEvent: t ] [ drop f ] if* ; + dup next-event [ dupd -> sendEvent: -> updateWindows t ] [ drop f ] if* ; : add-observer ( observer selector name object -- ) [ @@ -49,14 +51,7 @@ FUNCTION: void NSBeep ( ) ; [ NSNotificationCenter -> defaultCenter ] dip -> removeObserver: ; -: finish-launching ( -- ) NSApp -> finishLaunching ; - -: cocoa-app ( quot -- ) - [ - call - finish-launching - NSApp -> run - ] with-cocoa ; inline +: cocoa-app ( quot -- ) [ call NSApp -> run ] with-cocoa ; inline : install-delegate ( receiver delegate -- ) -> alloc -> init -> setDelegate: ; @@ -81,6 +76,6 @@ M: objc-error summary ( error -- ) running.app? [ drop ] [ - "The " swap " requires you to run Factor from an application bundle." - 3append throw + "The " " requires you to run Factor from an application bundle." + surround throw ] if ; diff --git a/basis/cocoa/messages/messages.factor b/basis/cocoa/messages/messages.factor index 791674428b..4be90a5a95 100644 --- a/basis/cocoa/messages/messages.factor +++ b/basis/cocoa/messages/messages.factor @@ -85,9 +85,17 @@ MACRO: (send) ( selector super? -- quot ) \ super-send soft "break-after" set-word-prop ! Runtime introspection -: (objc-class) ( string word -- class ) - dupd execute - [ ] [ "No such class: " prepend throw ] ?if ; inline +SYMBOL: class-init-hooks + +class-init-hooks global [ H{ } clone or ] change-at + +: (objc-class) ( name word -- class ) + 2dup execute dup [ 2nip ] [ + drop over class-init-hooks get at [ call ] when* + 2dup execute dup [ 2nip ] [ + 2drop "No such class: " prepend throw + ] if + ] if ; inline : objc-class ( string -- class ) \ objc_getClass (objc-class) ; @@ -221,23 +229,19 @@ assoc-union alien>objc-types set-global : class-exists? ( string -- class ) objc_getClass >boolean ; -: unless-defined ( class quot -- ) - [ class-exists? ] dip unless ; inline - -: define-objc-class-word ( name quot -- ) +: define-objc-class-word ( quot name -- ) + [ class-init-hooks get set-at ] [ - over , , \ unless-defined , dup , \ objc-class , - ] [ ] make [ "cocoa.classes" create ] dip - (( -- class )) define-declared ; + [ "cocoa.classes" create ] [ '[ _ objc-class ] ] bi + (( -- class )) define-declared + ] bi ; : import-objc-class ( name quot -- ) - 2dup unless-defined - dupd define-objc-class-word + over define-objc-class-word '[ _ - dup - objc-class register-objc-methods - objc-meta-class register-objc-methods + [ objc-class register-objc-methods ] + [ objc-meta-class register-objc-methods ] bi ] try ; : root-class ( class -- root ) diff --git a/basis/ui/cocoa/cocoa.factor b/basis/ui/cocoa/cocoa.factor index a9b3b03b75..42063fbf73 100644 --- a/basis/ui/cocoa/cocoa.factor +++ b/basis/ui/cocoa/cocoa.factor @@ -1,6 +1,6 @@ ! Copyright (C) 2006, 2008 Slava Pestov. ! See http://factorcode.org/license.txt for BSD license. -USING: accessors math arrays cocoa cocoa.application +USING: accessors math arrays assocs cocoa cocoa.application command-line kernel memory namespaces cocoa.messages cocoa.runtime cocoa.subclassing cocoa.pasteboard cocoa.types cocoa.windows cocoa.classes cocoa.application sequences system @@ -96,16 +96,29 @@ M: cocoa-ui-backend flush-gl-context ( handle -- ) M: cocoa-ui-backend beep ( -- ) NSBeep ; +CLASS: { + { +superclass+ "NSObject" } + { +name+ "FactorApplicationDelegate" } +} + +{ "applicationDidFinishLaunching:" "void" { "id" "SEL" "id" } + [ 3drop event-loop ] +} ; + +: install-app-delegate ( -- ) + NSApp FactorApplicationDelegate install-delegate ; + SYMBOL: cocoa-init-hook +cocoa-init-hook global [ [ install-app-delegate ] or ] change-at + M: cocoa-ui-backend ui "UI" assert.app [ [ init-clipboard - cocoa-init-hook get [ call ] when* + cocoa-init-hook get call start-ui - finish-launching - event-loop + NSApp -> run ] ui-running ] with-cocoa ; diff --git a/basis/ui/cocoa/tools/tools.factor b/basis/ui/cocoa/tools/tools.factor index a8ade05a86..ccaae0c1ab 100644 --- a/basis/ui/cocoa/tools/tools.factor +++ b/basis/ui/cocoa/tools/tools.factor @@ -20,8 +20,8 @@ IN: ui.cocoa.tools ! Handle Open events from the Finder CLASS: { - { +superclass+ "NSObject" } - { +name+ "FactorApplicationDelegate" } + { +superclass+ "FactorApplicationDelegate" } + { +name+ "FactorWorkspaceApplicationDelegate" } } { "application:openFiles:" "void" { "id" "SEL" "id" "id" } @@ -49,7 +49,7 @@ CLASS: { } ; : install-app-delegate ( -- ) - NSApp FactorApplicationDelegate install-delegate ; + NSApp FactorWorkspaceApplicationDelegate install-delegate ; ! Service support; evaluate Factor code from other apps :: do-service ( pboard error quot -- )