extra/cocoa/application/application.factor

   1 ! Copyright (C) 2006, 2007 Slava Pestov
   2 ! See http://factorcode.org/license.txt for BSD license.
   3 USING: alien io kernel namespaces core-foundation cocoa.messages
   4 cocoa cocoa.classes cocoa.runtime sequences threads debugger
   5 init inspector kernel.private ;
   6 IN: cocoa.application
   7
   8 : NSApplicationDelegateReplySuccess 0 ;
   9 : NSApplicationDelegateReplyCancel  1 ;
  10 : NSApplicationDelegateReplyFailure 2 ;
  11
  12 : with-autorelease-pool ( quot -- )
  13     NSAutoreleasePool -> new slip -> release ; inline
  14
  15 : NSApp ( -- app ) NSApplication -> sharedApplication ;
  16
  17 : with-cocoa ( quot -- )
  18     [ NSApp drop call ] with-autorelease-pool ;
  19
  20 : CFRunLoopDefaultMode "kCFRunLoopDefaultMode" <NSString> ;
  21
  22 : next-event ( app -- event )
  23     0 f CFRunLoopDefaultMode 1
  24     -> nextEventMatchingMask:untilDate:inMode:dequeue: ;
  25
  26 : do-event ( app -- ? )
  27     dup next-event [ -> sendEvent: t ] [ drop f ] if* ;
  28
  29 : do-events ( app -- )
  30     dup do-event [ do-events ] [ drop ] if ;
  31
  32 : add-observer ( observer selector name object -- )
  33     >r >r >r >r NSNotificationCenter -> defaultCenter
  34     r> r> sel_registerName
  35     r> r> -> addObserver:selector:name:object: ;
  36
  37 : remove-observer ( observer -- )
  38     >r NSNotificationCenter -> defaultCenter r>
  39     -> removeObserver: ;
  40
  41 : finish-launching ( -- ) NSApp -> finishLaunching ;
  42
  43 : install-delegate ( receiver delegate -- )
  44     -> alloc -> init -> setDelegate: ;
  45
  46 TUPLE: objc-error alien reason ;
  47
  48 : objc-error ( alien -- * )
  49     dup -> reason CF>string \ objc-error construct-boa throw ;
  50
  51 M: objc-error summary ( error -- )
  52     drop "Objective C exception" ;
  53
  54 [ [ objc-error ] 19 setenv ] "cocoa.application" add-init-hook
  55
  56 : running.app? ( -- ? )
  57     #! Test if we're running a .app.
  58     ".app"
  59     NSBundle -> mainBundle -> bundlePath CF>string
  60     subseq? ;
  61
  62 : assert.app ( message -- )
  63     running.app? [
  64         drop
  65     ] [
  66         "The " swap " requires you to run Factor from an application bundle."
  67         3append throw
  68     ] if ;