basis/tools/deploy/shaker/strip-cocoa.factor

   1 ! Copyright (C) 2007, 2008 Slava Pestov
   2 ! See http://factorcode.org/license.txt for BSD license.
   3 USING: cocoa cocoa.messages cocoa.application cocoa.nibs assocs
   4 namespaces kernel kernel.private words compiler.units sequences
   5 init vocabs ;
   6 IN: tools.deploy.shaker.cocoa
   7
   8 : pool ( obj -- obj' ) \ pool get [ ] cache ;
   9
  10 : pool-array ( obj -- obj' ) [ pool ] map pool ;
  11
  12 : pool-keys ( assoc -- assoc' ) [ [ pool-array ] dip ] assoc-map ;
  13
  14 : pool-values ( assoc -- assoc' ) [ pool-array ] assoc-map ;
  15
  16 IN: cocoa.application
  17
  18 : objc-error ( error -- ) die ;
  19
  20 [ [ die ] 19 setenv ] "cocoa.application" add-init-hook
  21
  22 "stop-after-last-window?" get
  23
  24 H{ } clone \ pool [
  25     global [
  26         "stop-after-last-window?" "ui" lookup set
  27
  28         "ui.cocoa" vocab [
  29             [ "MiniFactor.nib" load-nib ]
  30             "cocoa-init-hook" "ui.cocoa" lookup set-global
  31         ] when
  32
  33         ! Only keeps those methods that we actually call
  34         sent-messages get super-sent-messages get assoc-union
  35         objc-methods [ assoc-intersect pool-values ] change
  36
  37         sent-messages get
  38         super-sent-messages get
  39         [ keys [ objc-methods get at dup ] H{ } map>assoc ] bi@
  40         super-message-senders [ assoc-intersect pool-keys ] change
  41         message-senders [ assoc-intersect pool-keys ] change
  42
  43         sent-messages off
  44         super-sent-messages off
  45
  46         alien>objc-types off
  47         objc>alien-types off
  48
  49         ! We need this for strip-stack-traces to work fully
  50         { message-senders super-message-senders }
  51         [ get values compile ] each
  52     ] bind
  53 ] with-variable