2008-12-08 17:02:31 -05:00
|
|
|
! Copyright (C) 2006, 2008 Slava Pestov
|
2007-09-20 18:09:08 -04:00
|
|
|
! See http://factorcode.org/license.txt for BSD license.
|
2008-06-05 23:06:38 -04:00
|
|
|
USING: alien alien.syntax io kernel namespaces core-foundation
|
2008-12-13 06:20:50 -05:00
|
|
|
core-foundation.strings cocoa.messages cocoa cocoa.classes
|
2009-03-31 09:03:27 -04:00
|
|
|
cocoa.runtime sequences init summary kernel.private
|
2008-12-13 06:20:50 -05:00
|
|
|
assocs ;
|
2007-09-20 18:09:08 -04:00
|
|
|
IN: cocoa.application
|
|
|
|
|
2008-01-09 01:36:11 -05:00
|
|
|
: <NSString> ( str -- alien ) <CFString> -> autorelease ;
|
|
|
|
|
2009-01-21 00:06:23 -05:00
|
|
|
C-ENUM:
|
|
|
|
NSApplicationDelegateReplySuccess
|
|
|
|
NSApplicationDelegateReplyCancel
|
|
|
|
NSApplicationDelegateReplyFailure ;
|
2007-09-20 18:09:08 -04:00
|
|
|
|
|
|
|
: with-autorelease-pool ( quot -- )
|
2009-05-10 16:28:22 -04:00
|
|
|
NSAutoreleasePool -> new [ call ] [ -> release ] bi* ; inline
|
2007-09-20 18:09:08 -04:00
|
|
|
|
|
|
|
: NSApp ( -- app ) NSApplication -> sharedApplication ;
|
|
|
|
|
2008-12-05 02:49:46 -05:00
|
|
|
: NSAnyEventMask ( -- mask ) HEX: ffffffff ; inline
|
|
|
|
|
2008-06-05 23:06:38 -04:00
|
|
|
FUNCTION: void NSBeep ( ) ;
|
|
|
|
|
2007-09-20 18:09:08 -04:00
|
|
|
: with-cocoa ( quot -- )
|
2008-10-02 08:10:22 -04:00
|
|
|
[ NSApp drop call ] with-autorelease-pool ; inline
|
2007-09-20 18:09:08 -04:00
|
|
|
|
|
|
|
: add-observer ( observer selector name object -- )
|
2008-11-29 14:47:45 -05:00
|
|
|
[
|
|
|
|
[ NSNotificationCenter -> defaultCenter ] 2dip
|
|
|
|
sel_registerName
|
|
|
|
] 2dip -> addObserver:selector:name:object: ;
|
2007-09-20 18:09:08 -04:00
|
|
|
|
|
|
|
: remove-observer ( observer -- )
|
2008-11-29 14:47:45 -05:00
|
|
|
[ NSNotificationCenter -> defaultCenter ] dip
|
2007-09-20 18:09:08 -04:00
|
|
|
-> removeObserver: ;
|
|
|
|
|
2009-01-21 00:06:23 -05:00
|
|
|
: cocoa-app ( quot -- )
|
|
|
|
[ call NSApp -> run ] with-cocoa ; inline
|
2008-10-02 11:53:12 -04:00
|
|
|
|
2007-09-20 18:09:08 -04:00
|
|
|
: install-delegate ( receiver delegate -- )
|
|
|
|
-> alloc -> init -> setDelegate: ;
|
|
|
|
|
|
|
|
TUPLE: objc-error alien reason ;
|
|
|
|
|
|
|
|
: objc-error ( alien -- * )
|
2008-04-13 16:06:27 -04:00
|
|
|
dup -> reason CF>string \ objc-error boa throw ;
|
2007-09-20 18:09:08 -04:00
|
|
|
|
|
|
|
M: objc-error summary ( error -- )
|
|
|
|
drop "Objective C exception" ;
|
|
|
|
|
|
|
|
[ [ objc-error ] 19 setenv ] "cocoa.application" add-init-hook
|
|
|
|
|
|
|
|
: running.app? ( -- ? )
|
|
|
|
#! Test if we're running a .app.
|
|
|
|
".app"
|
|
|
|
NSBundle -> mainBundle -> bundlePath CF>string
|
|
|
|
subseq? ;
|
|
|
|
|
|
|
|
: assert.app ( message -- )
|
|
|
|
running.app? [
|
|
|
|
drop
|
|
|
|
] [
|
2008-12-05 02:49:46 -05:00
|
|
|
"The " " requires you to run Factor from an application bundle."
|
|
|
|
surround throw
|
2007-09-20 18:09:08 -04:00
|
|
|
] if ;
|