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.strings cocoa.messages cocoa cocoa.classes
   5 cocoa.runtime sequences init summary kernel.private
   6 assocs ;
   7 IN: cocoa.application
   8
   9 : <NSString> ( str -- alien ) <CFString> -> autorelease ;
  10
  11 ENUM: f
  12 NSApplicationDelegateReplySuccess
  13 NSApplicationDelegateReplyCancel
  14 NSApplicationDelegateReplyFailure ;
  15
  16 : with-autorelease-pool ( quot -- )
  17     NSAutoreleasePool -> new [ call ] [ -> release ] bi* ; inline
  18
  19 : NSApp ( -- app ) NSApplication -> sharedApplication ;
  20
  21 CONSTANT: NSAnyEventMask HEX: ffffffff
  22
  23 FUNCTION: void NSBeep ( ) ;
  24
  25 : with-cocoa ( quot -- )
  26     [ NSApp drop call ] with-autorelease-pool ; inline
  27
  28 : add-observer ( observer selector name object -- )
  29     [
  30         [ NSNotificationCenter -> defaultCenter ] 2dip
  31         sel_registerName
  32     ] 2dip -> addObserver:selector:name:object: ;
  33
  34 : remove-observer ( observer -- )
  35     [ NSNotificationCenter -> defaultCenter ] dip
  36     -> removeObserver: ;
  37
  38 : cocoa-app ( quot -- )
  39     [ call NSApp -> run ] with-cocoa ; inline
  40
  41 : install-delegate ( receiver delegate -- )
  42     -> alloc -> init -> setDelegate: ;
  43
  44 TUPLE: objc-error alien reason ;
  45
  46 : objc-error ( alien -- * )
  47     dup -> reason CF>string \ objc-error boa throw ;
  48
  49 M: objc-error summary ( error -- )
  50     drop "Objective C exception" ;
  51
  52 [ [ objc-error ] 19 set-special-object ] "cocoa.application" add-startup-hook
  53
  54 : running.app? ( -- ? )
  55     #! Test if we're running a .app.
  56     ".app"
  57     NSBundle -> mainBundle -> bundlePath CF>string
  58     subseq? ;
  59
  60 : assert.app ( message -- )
  61     running.app? [
  62         drop
  63     ] [
  64         "The " " requires you to run Factor from an application bundle."
  65         surround throw
  66     ] if ;