1 ! Copyright (C) 2007, 2009 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 memoize accessors ;
6 IN: tools.deploy.shaker.cocoa
8 : pool ( obj -- obj' ) \ pool get [ ] cache ;
10 : pool-array ( obj -- obj' ) [ pool ] map pool ;
12 : pool-keys ( assoc -- assoc' ) [ [ pool-array ] dip ] assoc-map ;
14 : pool-values ( assoc -- assoc' ) [ pool-array ] assoc-map ;
18 : objc-error ( error -- ) die ;
20 [ [ die ] 19 setenv ] "cocoa.application" add-init-hook
24 ! Only keeps those methods that we actually call
25 sent-messages get super-sent-messages get assoc-union
26 objc-methods [ assoc-intersect pool-values ] change
29 super-sent-messages get
30 [ keys [ objc-methods get at dup ] H{ } map>assoc ] bi@
31 super-message-senders [ assoc-intersect pool-keys ] change
32 message-senders [ assoc-intersect pool-keys ] change
35 super-sent-messages off
40 ! We need this for strip-stack-traces to work fully
41 { message-senders super-message-senders }
42 [ get values compile ] each
46 \ make-prepare-send reset-memoized
47 \ <selector> reset-memoized
49 \ (send) def>> second clear-assoc