| 
									
										
										
										
											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.arrays core-foundation.data | 
					
						
							|  |  |  | core-foundation.strings cocoa.messages cocoa cocoa.classes | 
					
						
							|  |  |  | cocoa.runtime sequences threads init summary kernel.private | 
					
						
							|  |  |  | 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 ;
 | 
					
						
							|  |  |  | : <NSArray> ( seq -- alien ) <CFArray> -> autorelease ;
 | 
					
						
							| 
									
										
										
										
											2008-07-13 22:19:16 -04:00
										 |  |  | : <NSNumber> ( number -- alien ) <CFNumber> -> autorelease ;
 | 
					
						
							|  |  |  | : <NSData> ( byte-array -- alien ) <CFData> -> autorelease ;
 | 
					
						
							|  |  |  | : <NSDictionary> ( assoc -- alien )
 | 
					
						
							|  |  |  |     NSMutableDictionary over assoc-size -> dictionaryWithCapacity: | 
					
						
							|  |  |  |     [ | 
					
						
							|  |  |  |         [ | 
					
						
							|  |  |  |             spin -> setObject:forKey: | 
					
						
							|  |  |  |         ] curry assoc-each
 | 
					
						
							|  |  |  |     ] keep ;
 | 
					
						
							| 
									
										
										
										
											2008-01-09 01:36:11 -05:00
										 |  |  | 
 | 
					
						
							| 
									
										
										
										
											2007-09-20 18:09:08 -04:00
										 |  |  | : NSApplicationDelegateReplySuccess 0 ;
 | 
					
						
							|  |  |  | : NSApplicationDelegateReplyCancel  1 ;
 | 
					
						
							|  |  |  | : NSApplicationDelegateReplyFailure 2 ;
 | 
					
						
							|  |  |  | 
 | 
					
						
							|  |  |  | : with-autorelease-pool ( quot -- )
 | 
					
						
							|  |  |  |     NSAutoreleasePool -> new slip -> release ; inline
 | 
					
						
							|  |  |  | 
 | 
					
						
							|  |  |  | : 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: ;
 | 
					
						
							|  |  |  | 
 | 
					
						
							| 
									
										
										
										
											2008-12-05 02:49:46 -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 ;
 |