steve
/
factor
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

remove >r r>

db4
Doug Coleman 2008-11-29 13:47:45 -06:00
parent 07615bd219
commit 338e592935
3 changed files with 12 additions and 11 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
basis/channels/remote/remote.factor
View File

@ -14,7 +14,7 @@ IN: channels.remote
PRIVATE> PRIVATE>
: publish ( channel -- id ) : publish ( channel -- id )
256 random-bits dup >r remote-channels set-at r> ; 256 random-bits dup [ remote-channels set-at ] dip ;
: get-channel ( id -- channel ) : get-channel ( id -- channel )
remote-channels at ; remote-channels at ;

9
basis/cocoa/application/application.factor
View File

@ -40,12 +40,13 @@ FUNCTION: void NSBeep ( ) ;
dup next-event [ -> sendEvent: t ] [ drop f ] if* ; dup next-event [ -> sendEvent: t ] [ drop f ] if* ;
: add-observer ( observer selector name object -- ) : add-observer ( observer selector name object -- )
>r >r >r >r NSNotificationCenter -> defaultCenter [
r> r> sel_registerName [ NSNotificationCenter -> defaultCenter ] 2dip
r> r> -> addObserver:selector:name:object: ; sel_registerName
] 2dip -> addObserver:selector:name:object: ;
: remove-observer ( observer -- ) : remove-observer ( observer -- )
>r NSNotificationCenter -> defaultCenter r> [ NSNotificationCenter -> defaultCenter ] dip
-> removeObserver: ; -> removeObserver: ;
: finish-launching ( -- ) NSApp -> finishLaunching ; : finish-launching ( -- ) NSApp -> finishLaunching ;

12
basis/cocoa/messages/messages.factor
View File

@ -27,7 +27,7 @@ super-message-senders global [ H{ } assoc-like ] change-at
: cache-stub ( method function hash -- ) : cache-stub ( method function hash -- )
[ [
over get [ 2drop ] [ over >r sender-stub r> set ] if over get [ 2drop ] [ over [ sender-stub ] dip set ] if
] bind ; ] bind ;
: cache-stubs ( method -- ) : cache-stubs ( method -- )
@ -37,7 +37,7 @@ super-message-senders global [ H{ } assoc-like ] change-at
: <super> ( receiver -- super ) : <super> ( receiver -- super )
"objc-super" <c-object> [ "objc-super" <c-object> [
>r dup object_getClass class_getSuperclass r> [ dup object_getClass class_getSuperclass ] dip
set-objc-super-class set-objc-super-class
] keep ] keep
[ set-objc-super-receiver ] keep ; [ set-objc-super-receiver ] keep ;
@ -75,7 +75,7 @@ MEMO: make-prepare-send ( selector method super? -- quot )
swap second length 2 - make-dip ; swap second length 2 - make-dip ;
MACRO: (send) ( selector super? -- quot ) MACRO: (send) ( selector super? -- quot )
>r dup lookup-method r> [ dup lookup-method ] dip
[ make-prepare-send ] 2keep [ make-prepare-send ] 2keep
super-message-senders message-senders ? get at super-message-senders message-senders ? get at
[ slip execute ] 2curry ; [ slip execute ] 2curry ;
@ -172,7 +172,7 @@ assoc-union alien>objc-types set-global
] unless ; ] unless ;
: (parse-objc-type) ( i string -- ctype ) : (parse-objc-type) ( i string -- ctype )
2dup nth >r >r 1+ r> r> { 2dup nth [ 1+ ] 2dip {
{ [ dup "rnNoORV" member? ] [ drop (parse-objc-type) ] } { [ dup "rnNoORV" member? ] [ drop (parse-objc-type) ] }
{ [ dup CHAR: ^ = ] [ 3drop "void*" ] } { [ dup CHAR: ^ = ] [ 3drop "void*" ] }
{ [ dup CHAR: { = ] [ drop objc-struct-type ] } { [ dup CHAR: { = ] [ drop objc-struct-type ] }
@ -223,12 +223,12 @@ assoc-union alien>objc-types set-global
: class-exists? ( string -- class ) objc_getClass >boolean ; : class-exists? ( string -- class ) objc_getClass >boolean ;
: unless-defined ( class quot -- ) : unless-defined ( class quot -- )
>r class-exists? r> unless ; inline [ class-exists? ] dip unless ; inline
: define-objc-class-word ( name quot -- ) : define-objc-class-word ( name quot -- )
[ [
over , , \ unless-defined , dup , \ objc-class , over , , \ unless-defined , dup , \ objc-class ,
] [ ] make >r "cocoa.classes" create r> ] [ ] make [ "cocoa.classes" create ] dip
(( -- class )) define-declared ; (( -- class )) define-declared ;
: import-objc-class ( name quot -- ) : import-objc-class ( name quot -- )