Redo how Cocoa event loop is done; fixes problem with expose, focus issue when closing windows
parent
12c8ffc194
commit
0e0e79eb7e
|
@ -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 ;
|
||||
|
|
|
@ -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 )
|
||||
|
|
|
@ -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 ;
|
||||
|
||||
|
|
|
@ -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 -- )
|
||||
|
|
Loading…
Reference in New Issue