! Copyright (C) 2006, 2010 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
-USING: accessors alien alien.c-types alien.strings arrays assocs
-classes.struct continuations combinators compiler compiler.alien
+USING: accessors alien alien.c-types alien.data alien.strings
+arrays assocs classes.struct continuations combinators compiler
core-graphics.types stack-checker kernel math namespaces make
quotations sequences strings words cocoa.runtime cocoa.types io
-macros memoize io.encodings.utf8 effects layouts libc
-libc.private lexer init core-foundation fry generalizations
-specialized-arrays ;
+macros memoize io.encodings.utf8 effects layouts libc lexer init
+core-foundation fry generalizations specialized-arrays ;
QUALIFIED-WITH: alien.c-types c
IN: cocoa.messages
: super-send ( receiver args... selector -- return... ) t (send) ; inline
! Runtime introspection
-SYMBOL: class-startup-hooks
+SYMBOL: class-init-hooks
-class-startup-hooks [ H{ } clone ] initialize
+class-init-hooks [ H{ } clone ] initialize
: (objc-class) ( name word -- class )
2dup execute dup [ 2nip ] [
- drop over class-startup-hooks get at [ call( -- ) ] when*
+ drop over class-init-hooks get at [ call( -- ) ] when*
2dup execute dup [ 2nip ] [
2drop "No such class: " prepend throw
] if
{ "d" c:double }
{ "B" c:bool }
{ "v" c:void }
- { "*" c:char* }
+ { "*" c:c-string }
{ "?" unknown_type }
{ "@" id }
{ "#" Class }
objc-methods get set-at ;
: each-method-in-class ( class quot -- )
- [ 0 <uint> [ class_copyMethodList ] keep *uint ] dip
+ [ { uint } [ class_copyMethodList ] [ ] with-out-parameters ] dip
over 0 = [ 3drop ] [
[ <direct-void*-array> ] dip
[ each ] [ drop (free) ] 2bi
: class-exists? ( string -- class ) objc_getClass >boolean ;
: define-objc-class-word ( quot name -- )
- [ class-startup-hooks get set-at ]
+ [ class-init-hooks get set-at ]
[
[ "cocoa.classes" create ] [ '[ _ objc-class ] ] bi
(( -- class )) define-declared
] bi ;
: import-objc-class ( name quot -- )
- over define-objc-class-word
- [ objc-class register-objc-methods ]
- [ objc-meta-class register-objc-methods ] bi ;
+ 2dup swap define-objc-class-word
+ over class-exists? [ drop ] [ call( -- ) ] if
+ dup class-exists? [
+ [ objc_getClass register-objc-methods ]
+ [ objc_getMetaClass register-objc-methods ] bi
+ ] [ drop ] if ;
: root-class ( class -- root )
dup class_getSuperclass [ root-class ] [ ] ?if ;