basis/cocoa/application/application.factor

   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 ;
   7 IN: cocoa.application
   8
   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:
  15     [
  16         [
  17             spin -> setObject:forKey:
  18         ] curry assoc-each
  19     ] keep ;
  20
  21 : NSApplicationDelegateReplySuccess 0 ;
  22 : NSApplicationDelegateReplyCancel  1 ;
  23 : NSApplicationDelegateReplyFailure 2 ;
  24
  25 : with-autorelease-pool ( quot -- )
  26     NSAutoreleasePool -> new slip -> release ; inline
  27
  28 : NSApp ( -- app ) NSApplication -> sharedApplication ;
  29
  30 FUNCTION: void NSBeep ( ) ;
  31
  32 : with-cocoa ( quot -- )
  33     [ NSApp drop call ] with-autorelease-pool ; inline
  34
  35 : next-event ( app -- event )
  36     0 f CFRunLoopDefaultMode 1
  37     -> nextEventMatchingMask:untilDate:inMode:dequeue: ;
  38
  39 : do-event ( app -- ? )
  40     dup next-event [ -> sendEvent: t ] [ drop f ] if* ;
  41
  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: ;
  46
  47 : remove-observer ( observer -- )
  48     >r NSNotificationCenter -> defaultCenter r>
  49     -> removeObserver: ;
  50
  51 : finish-launching ( -- ) NSApp -> finishLaunching ;
  52
  53 : install-delegate ( receiver delegate -- )
  54     -> alloc -> init -> setDelegate: ;
  55
  56 TUPLE: objc-error alien reason ;
  57
  58 : objc-error ( alien -- * )
  59     dup -> reason CF>string \ objc-error boa throw ;
  60
  61 M: objc-error summary ( error -- )
  62     drop "Objective C exception" ;
  63
  64 [ [ objc-error ] 19 setenv ] "cocoa.application" add-init-hook
  65
  66 : running.app? ( -- ? )
  67     #! Test if we're running a .app.
  68     ".app"
  69     NSBundle -> mainBundle -> bundlePath CF>string
  70     subseq? ;
  71
  72 : assert.app ( message -- )
  73     running.app? [
  74         drop
  75     ] [
  76         "The " swap " requires you to run Factor from an application bundle."
  77         3append throw
  78     ] if ;