Redo how Cocoa event loop is done; fixes problem with expose, focus issue when closing windows

db4
Slava Pestov 2008-12-05 01:49:46 -06:00
parent 12c8ffc194
commit 0e0e79eb7e
4 changed files with 46 additions and 34 deletions
basis

View File

@ -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 ;

View File

@ -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 )

View File

@ -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 ;

View File

@ -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 -- )