Add core-foundation.launch-services for finding the path of a bundle. Add a new standard-paths vocabulary for finding files.
parent
136ffc0671
commit
ada631c202
|
@ -22,6 +22,12 @@ TYPEDEF: longlong SInt64
|
|||
TYPEDEF: ulong CFTypeID
|
||||
TYPEDEF: UInt32 CFOptionFlags
|
||||
TYPEDEF: void* CFUUIDRef
|
||||
TYPEDEF: SInt32 OSStatus
|
||||
TYPEDEF: uchar[4] FourCharCode
|
||||
TYPEDEF: FourCharCode OSType
|
||||
|
||||
STRUCT: FSRef
|
||||
{ opaque uchar[80] } ;
|
||||
|
||||
STRUCT: CFRange
|
||||
{ location CFIndex }
|
||||
|
|
|
@ -0,0 +1 @@
|
|||
Doug Coleman
|
|
@ -0,0 +1,49 @@
|
|||
! Copyright (C) 2011 Doug Coleman.
|
||||
! See http://factorcode.org/license.txt for BSD license.
|
||||
USING: alien.c-types alien.data alien.syntax classes.struct
|
||||
continuations core-foundation core-foundation.strings
|
||||
core-foundation.urls destructors kernel sequences
|
||||
specialized-arrays.instances.alien.c-types.char strings
|
||||
unix.ffi ;
|
||||
IN: core-foundation.launch-services
|
||||
|
||||
FUNCTION: OSStatus LSFindApplicationForInfo (
|
||||
OSType inCreator,
|
||||
CFStringRef inBundleID,
|
||||
CFStringRef inName,
|
||||
FSRef *outAppRef,
|
||||
CFURLRef *outAppURL
|
||||
) ;
|
||||
|
||||
FUNCTION: OSStatus FSRefMakePath (
|
||||
FSRef *ref,
|
||||
UInt8 *path,
|
||||
UInt32 maxPathSize
|
||||
) ;
|
||||
|
||||
CONSTANT: kCFAllocatorDefault f
|
||||
CONSTANT: kLSUnknownCreator f
|
||||
|
||||
ERROR: core-foundation-error n ;
|
||||
|
||||
: cf-error ( n -- )
|
||||
dup 0 = [ drop ] [ core-foundation-error ] if ;
|
||||
|
||||
: fsref>string ( fsref -- string )
|
||||
MAXPATHLEN [ <char-array> ] [ ] bi
|
||||
[ FSRefMakePath cf-error ] [ drop ] 2bi
|
||||
[ 0 = ] trim-tail >string ;
|
||||
|
||||
: (launch-services-path) ( string -- string' )
|
||||
[
|
||||
kLSUnknownCreator
|
||||
swap <CFString> &CFRelease
|
||||
f
|
||||
FSRef <struct>
|
||||
[ f LSFindApplicationForInfo cf-error ] keep
|
||||
fsref>string
|
||||
] with-destructors ;
|
||||
|
||||
: launch-services-path ( string -- path/f )
|
||||
[ (launch-services-path) ] [ 2drop f ] recover ;
|
||||
|
|
@ -0,0 +1 @@
|
|||
macosx
|
|
@ -0,0 +1 @@
|
|||
Doug Coleman
|
|
@ -0,0 +1 @@
|
|||
Doug Coleman
|
|
@ -0,0 +1,9 @@
|
|||
! Copyright (C) 2011 Doug Coleman.
|
||||
! See http://factorcode.org/license.txt for BSD license.
|
||||
USING: io.standard-paths io.standard-paths.macosx tools.test ;
|
||||
IN: io.standard-paths.macosx.tests
|
||||
|
||||
[ "/System/Library/CoreServices/Finder.app" ]
|
||||
[ "com.apple.finder" find-native-bundle ] unit-test
|
||||
|
||||
|
|
@ -0,0 +1,7 @@
|
|||
! Copyright (C) 2011 Doug Coleman.
|
||||
! See http://factorcode.org/license.txt for BSD license.
|
||||
USING: core-foundation.launch-services io.standard-paths
|
||||
io.standard-paths.unix system ;
|
||||
IN: io.standard-paths.macosx
|
||||
|
||||
M: macosx find-native-bundle launch-services-path ;
|
|
@ -0,0 +1 @@
|
|||
macosx
|
|
@ -0,0 +1,4 @@
|
|||
! Copyright (C) 2011 Doug Coleman.
|
||||
! See http://factorcode.org/license.txt for BSD license.
|
||||
USING: tools.test io.standard-paths ;
|
||||
IN: io.standard-paths.tests
|
|
@ -0,0 +1,21 @@
|
|||
! Copyright (C) 2011 Doug Coleman.
|
||||
! See http://factorcode.org/license.txt for BSD license.
|
||||
USING: combinators io.pathnames kernel sequences system
|
||||
vocabs.loader ;
|
||||
IN: io.standard-paths
|
||||
|
||||
HOOK: find-native-bundle os ( string -- path )
|
||||
|
||||
HOOK: find-path* os ( string -- path/f )
|
||||
|
||||
: find-path ( string -- path/f )
|
||||
[ f ]
|
||||
[ [ find-path* ] keep over [ append-path ] [ 2drop f ] if ]
|
||||
if-empty ;
|
||||
|
||||
os {
|
||||
{ [ dup macosx? ] [ drop "io.standard-paths.macosx" require ] }
|
||||
{ [ dup unix? ] [ drop "io.standard-paths.unix" require ] }
|
||||
{ [ dup windows? ] [ "drop io.standard-paths.windows" require ] }
|
||||
} cond
|
||||
|
|
@ -0,0 +1 @@
|
|||
Doug Coleman
|
|
@ -0,0 +1 @@
|
|||
unix
|
|
@ -0,0 +1,8 @@
|
|||
! Copyright (C) 2011 Doug Coleman.
|
||||
! See http://factorcode.org/license.txt for BSD license.
|
||||
USING: io.standard-paths io.standard-paths.unix tools.test ;
|
||||
IN: io.standard-paths.unix.tests
|
||||
|
||||
[ f ] [ "" find-path ] unit-test
|
||||
[ "/bin/ls" ] [ "ls" find-path ] unit-test
|
||||
[ "/sbin/ifconfig" ] [ "ifconfig" find-path ] unit-test
|
|
@ -0,0 +1,10 @@
|
|||
! Copyright (C) 2011 Doug Coleman.
|
||||
! See http://factorcode.org/license.txt for BSD license.
|
||||
USING: environment fry io.files io.pathnames io.standard-paths
|
||||
kernel sequences splitting system ;
|
||||
IN: io.standard-paths.unix
|
||||
|
||||
M: unix find-path*
|
||||
[ "PATH" os-env ":" split ] dip
|
||||
'[ _ append-path exists? ] find nip ;
|
||||
|
Loading…
Reference in New Issue