1 ! Copyright (C) 2006, 2007 Slava Pestov
2 ! See http://factorcode.org/license.txt for BSD license.
3 USING: alien alien.syntax io kernel namespaces core-foundation
4 core-foundation.run-loop cocoa.messages cocoa cocoa.classes
5 cocoa.runtime sequences threads debugger init summary
6 kernel.private assocs ;
9 : <NSString> ( str -- alien ) <CFString> -> autorelease ;
10 : <NSArray> ( seq -- alien ) <CFArray> -> autorelease ;
11 : <NSNumber> ( number -- alien ) <CFNumber> -> autorelease ;
12 : <NSData> ( byte-array -- alien ) <CFData> -> autorelease ;
13 : <NSDictionary> ( assoc -- alien )
14 NSMutableDictionary over assoc-size -> dictionaryWithCapacity:
17 spin -> setObject:forKey:
21 : NSApplicationDelegateReplySuccess 0 ;
22 : NSApplicationDelegateReplyCancel 1 ;
23 : NSApplicationDelegateReplyFailure 2 ;
25 : with-autorelease-pool ( quot -- )
26 NSAutoreleasePool -> new slip -> release ; inline
28 : NSApp ( -- app ) NSApplication -> sharedApplication ;
30 FUNCTION: void NSBeep ( ) ;
32 : with-cocoa ( quot -- )
33 [ NSApp drop call ] with-autorelease-pool ; inline
35 : next-event ( app -- event )
36 0 f CFRunLoopDefaultMode 1
37 -> nextEventMatchingMask:untilDate:inMode:dequeue: ;
39 : do-event ( app -- ? )
40 dup next-event [ -> sendEvent: t ] [ drop f ] if* ;
42 : add-observer ( observer selector name object -- )
43 >r >r >r >r NSNotificationCenter -> defaultCenter
44 r> r> sel_registerName
45 r> r> -> addObserver:selector:name:object: ;
47 : remove-observer ( observer -- )
48 >r NSNotificationCenter -> defaultCenter r>
51 : finish-launching ( -- ) NSApp -> finishLaunching ;
53 : install-delegate ( receiver delegate -- )
54 -> alloc -> init -> setDelegate: ;
56 TUPLE: objc-error alien reason ;
58 : objc-error ( alien -- * )
59 dup -> reason CF>string \ objc-error boa throw ;
61 M: objc-error summary ( error -- )
62 drop "Objective C exception" ;
64 [ [ objc-error ] 19 setenv ] "cocoa.application" add-init-hook
66 : running.app? ( -- ? )
67 #! Test if we're running a .app.
69 NSBundle -> mainBundle -> bundlePath CF>string
72 : assert.app ( message -- )
76 "The " swap " requires you to run Factor from an application bundle."