Add core-foundation.launch-services for finding the path of a bundle. Add a new standard-paths vocabulary for finding files.

db4
Doug Coleman 2011-10-30 15:13:50 -07:00
parent 136ffc0671
commit ada631c202
15 changed files with 121 additions and 0 deletions

View File

@ -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 }

View File

@ -0,0 +1 @@
Doug Coleman

View File

@ -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 ;

View File

@ -0,0 +1 @@
macosx

View File

@ -0,0 +1 @@
Doug Coleman

View File

@ -0,0 +1 @@
Doug Coleman

View File

@ -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

View File

@ -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 ;

View File

@ -0,0 +1 @@
macosx

View File

@ -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

View File

@ -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

View File

@ -0,0 +1 @@
Doug Coleman

View File

@ -0,0 +1 @@
unix

View File

@ -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

View File

@ -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 ;