remove >r r> from various vocabs

db4
Doug Coleman 2008-11-29 13:29:19 -06:00
parent d5f2a00f6d
commit 4b6126f92a
4 changed files with 9 additions and 10 deletions

View File

@ -90,14 +90,14 @@ FUNCTION: CFTypeID CFGetTypeID ( CFTypeRef cf ) ;
: <CFArray> ( seq -- alien ) : <CFArray> ( seq -- alien )
[ f swap length f CFArrayCreateMutable ] keep [ f swap length f CFArrayCreateMutable ] keep
[ length ] keep [ length ] keep
[ >r dupd r> CFArraySetValueAtIndex ] 2each ; [ [ dupd ] dip CFArraySetValueAtIndex ] 2each ;
: <CFString> ( string -- alien ) : <CFString> ( string -- alien )
f swap dup length CFStringCreateWithCharacters ; f swap dup length CFStringCreateWithCharacters ;
: CF>string ( alien -- string ) : CF>string ( alien -- string )
dup CFStringGetLength 1+ "ushort" <c-array> [ dup CFStringGetLength 1+ "ushort" <c-array> [
>r 0 over CFStringGetLength r> CFStringGetCharacters [ 0 over CFStringGetLength ] dip CFStringGetCharacters
] keep utf16n alien>string ; ] keep utf16n alien>string ;
: CF>string-array ( alien -- seq ) : CF>string-array ( alien -- seq )
@ -107,8 +107,8 @@ FUNCTION: CFTypeID CFGetTypeID ( CFTypeRef cf ) ;
[ <CFString> ] map dup <CFArray> swap [ CFRelease ] each ; [ <CFString> ] map dup <CFArray> swap [ CFRelease ] each ;
: <CFFileSystemURL> ( string dir? -- url ) : <CFFileSystemURL> ( string dir? -- url )
>r <CFString> f over kCFURLPOSIXPathStyle [ <CFString> f over kCFURLPOSIXPathStyle ] dip
r> CFURLCreateWithFileSystemPath swap CFRelease ; CFURLCreateWithFileSystemPath swap CFRelease ;
: <CFURL> ( string -- url ) : <CFURL> ( string -- url )
<CFString> <CFString>

View File

@ -57,11 +57,11 @@ M: dlist-node node-value obj>> ;
: (dlist-find-node) ( dlist-node quot: ( node -- ? ) -- node/f ? ) : (dlist-find-node) ( dlist-node quot: ( node -- ? ) -- node/f ? )
over [ over [
[ call ] 2keep rot [ call ] 2keep rot
[ drop t ] [ >r next>> r> (dlist-find-node) ] if [ drop t ] [ [ next>> ] dip (dlist-find-node) ] if
] [ 2drop f f ] if ; inline recursive ] [ 2drop f f ] if ; inline recursive
: dlist-find-node ( dlist quot -- node/f ? ) : dlist-find-node ( dlist quot -- node/f ? )
>r front>> r> (dlist-find-node) ; inline [ front>> ] dip (dlist-find-node) ; inline
: dlist-each-node ( dlist quot -- ) : dlist-each-node ( dlist quot -- )
[ f ] compose dlist-find-node 2drop ; inline [ f ] compose dlist-find-node 2drop ; inline

View File

@ -26,8 +26,7 @@ SYMBOL: edit-hook
require ; require ;
: edit-location ( file line -- ) : edit-location ( file line -- )
>r (normalize-path) r> [ (normalize-path) ] dip edit-hook get-global
edit-hook get-global
[ call ] [ no-edit-hook edit-location ] if* ; [ call ] [ no-edit-hook edit-location ] if* ;
: edit ( defspec -- ) : edit ( defspec -- )

View File

@ -167,7 +167,7 @@ stand-alone
} cond ; } cond ;
: escape-link ( href text -- href-esc text-esc ) : escape-link ( href text -- href-esc text-esc )
>r check-url escape-quoted-string r> escape-string ; [ check-url escape-quoted-string ] dip escape-string ;
: write-link ( href text -- ) : write-link ( href text -- )
escape-link escape-link
@ -185,7 +185,7 @@ stand-alone
] if ; ] if ;
: render-code ( string mode -- string' ) : render-code ( string mode -- string' )
>r string-lines r> [ string-lines ] dip
[ [
<pre> <pre>
htmlize-lines htmlize-lines