bring back method redefinition
parent
d0281c58d1
commit
fddcd3d475
|
@ -43,25 +43,25 @@ IN: cocoa.subclassing
|
||||||
: types= ( a b -- ? )
|
: types= ( a b -- ? )
|
||||||
[ ascii alien>string ] bi@ = ;
|
[ ascii alien>string ] bi@ = ;
|
||||||
|
|
||||||
! : (verify-method-type) ( class sel types -- )
|
: (verify-method-type) ( class sel types -- )
|
||||||
! [ class_getInstanceMethod method_getTypeEncoding ]
|
[ class_getInstanceMethod method_getTypeEncoding ]
|
||||||
! dip types=
|
dip types=
|
||||||
! [ "Objective-C method types cannot be changed once defined" throw ]
|
[ "Objective-C method types cannot be changed once defined" throw ]
|
||||||
! unless ;
|
unless ;
|
||||||
! : verify-method-type ( class sel imp types -- class sel imp types )
|
: verify-method-type ( class sel imp types -- class sel imp types )
|
||||||
! 4 ndup nip (verify-method-type) ;
|
4 ndup nip (verify-method-type) ;
|
||||||
|
|
||||||
! : (redefine-objc-method) ( class method -- )
|
: (redefine-objc-method) ( class method -- )
|
||||||
! init-method ! verify-method-type
|
init-method ! verify-method-type
|
||||||
! drop
|
drop
|
||||||
! [ class_getInstanceMethod ] dip method_setImplementation drop ;
|
[ class_getInstanceMethod ] dip method_setImplementation drop ;
|
||||||
!
|
|
||||||
! : redefine-objc-methods ( imeth name -- )
|
: redefine-objc-methods ( imeth name -- )
|
||||||
! dup class-exists? [
|
dup class-exists? [
|
||||||
! objc_getClass swap [ (redefine-objc-method) ] with each
|
objc_getClass swap [ (redefine-objc-method) ] with each
|
||||||
! ] [
|
] [
|
||||||
! 2drop
|
2drop
|
||||||
! ] if ;
|
] if ;
|
||||||
|
|
||||||
SYMBOL: +name+
|
SYMBOL: +name+
|
||||||
SYMBOL: +protocols+
|
SYMBOL: +protocols+
|
||||||
|
@ -71,7 +71,7 @@ SYMBOL: +superclass+
|
||||||
clone [
|
clone [
|
||||||
prepare-methods
|
prepare-methods
|
||||||
+name+ get "cocoa.classes" create drop
|
+name+ get "cocoa.classes" create drop
|
||||||
+name+ get swap [
|
+name+ get 2dup redefine-objc-methods swap [
|
||||||
+protocols+ get , +superclass+ get , +name+ get , ,
|
+protocols+ get , +superclass+ get , +name+ get , ,
|
||||||
\ (define-objc-class) ,
|
\ (define-objc-class) ,
|
||||||
] [ ] make import-objc-class
|
] [ ] make import-objc-class
|
||||||
|
|
Loading…
Reference in New Issue