basis/cocoa/application/application.factor

   1 ! Copyright (C) 2006, 2008 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.arrays core-foundation.data
   5 core-foundation.strings cocoa.messages cocoa cocoa.classes
   6 cocoa.runtime sequences threads init summary kernel.private
   7 assocs ;
   8 IN: cocoa.application
   9
  10 : <NSString> ( str -- alien ) <CFString> -> autorelease ;
  11 : <NSArray> ( seq -- alien ) <CFArray> -> autorelease ;
  12 : <NSNumber> ( number -- alien ) <CFNumber> -> autorelease ;
  13 : <NSData> ( byte-array -- alien ) <CFData> -> autorelease ;
  14 : <NSDictionary> ( assoc -- alien )
  15     NSMutableDictionary over assoc-size -> dictionaryWithCapacity:
  16     [
  17         [
  18             spin -> setObject:forKey:
  19         ] curry assoc-each
  20     ] keep ;
  21
  22 : NSApplicationDelegateReplySuccess 0 ;
  23 : NSApplicationDelegateReplyCancel  1 ;
  24 : NSApplicationDelegateReplyFailure 2 ;
  25
  26 : with-autorelease-pool ( quot -- )
  27     NSAutoreleasePool -> new slip -> release ; inline
  28
  29 : NSApp ( -- app ) NSApplication -> sharedApplication ;
  30
  31 : NSAnyEventMask ( -- mask ) HEX: ffffffff ; inline
  32
  33 FUNCTION: void NSBeep ( ) ;
  34
  35 : with-cocoa ( quot -- )
  36     [ NSApp drop call ] with-autorelease-pool ; inline
  37
  38 : add-observer ( observer selector name object -- )
  39     [
  40         [ NSNotificationCenter -> defaultCenter ] 2dip
  41         sel_registerName
  42     ] 2dip -> addObserver:selector:name:object: ;
  43
  44 : remove-observer ( observer -- )
  45     [ NSNotificationCenter -> defaultCenter ] dip
  46     -> removeObserver: ;
  47
  48 : cocoa-app ( quot -- ) [ call NSApp -> run ] with-cocoa ; inline
  49
  50 : install-delegate ( receiver delegate -- )
  51     -> alloc -> init -> setDelegate: ;
  52
  53 TUPLE: objc-error alien reason ;
  54
  55 : objc-error ( alien -- * )
  56     dup -> reason CF>string \ objc-error boa throw ;
  57
  58 M: objc-error summary ( error -- )
  59     drop "Objective C exception" ;
  60
  61 [ [ objc-error ] 19 setenv ] "cocoa.application" add-init-hook
  62
  63 : running.app? ( -- ? )
  64     #! Test if we're running a .app.
  65     ".app"
  66     NSBundle -> mainBundle -> bundlePath CF>string
  67     subseq? ;
  68
  69 : assert.app ( message -- )
  70     running.app? [
  71         drop
  72     ] [
  73         "The " " requires you to run Factor from an application bundle."
  74         surround throw
  75     ] if ;