Add core-foundation.launch-services for finding the path of a bundle. Add a new stand...

diff --git a/basis/core-foundation/core-foundation.factor b/basis/core-foundation/core-foundation.factor
index ad4ea958314b2dfa9cf9ffb647d6829ad59e2bac..d02210f0c81cc8248f5e8a2f6adaceb1242f870d 100644 (file)
--- a/basis/core-foundation/core-foundation.factor
+++ b/basis/core-foundation/core-foundation.factor
@@ -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 }

diff --git a/basis/core-foundation/launch-services/authors.txt b/basis/core-foundation/launch-services/authors.txt
new file mode 100644 (file)
index 0000000..7c1b2f2
--- /dev/null
+++ b/basis/core-foundation/launch-services/authors.txt
@@ -0,0 +1 @@
+Doug Coleman

diff --git a/basis/core-foundation/launch-services/launch-services.factor b/basis/core-foundation/launch-services/launch-services.factor
new file mode 100644 (file)
index 0000000..88a5dc9
--- /dev/null
+++ b/basis/core-foundation/launch-services/launch-services.factor
@@ -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 ;
+    

diff --git a/basis/core-foundation/launch-services/platforms.txt b/basis/core-foundation/launch-services/platforms.txt
new file mode 100644 (file)
index 0000000..6e806f4
--- /dev/null
+++ b/basis/core-foundation/launch-services/platforms.txt
@@ -0,0 +1 @@
+macosx

diff --git a/basis/io/standard-paths/authors.txt b/basis/io/standard-paths/authors.txt
new file mode 100644 (file)
index 0000000..7c1b2f2
--- /dev/null
+++ b/basis/io/standard-paths/authors.txt
@@ -0,0 +1 @@
+Doug Coleman

diff --git a/basis/io/standard-paths/macosx/authors.txt b/basis/io/standard-paths/macosx/authors.txt
new file mode 100644 (file)
index 0000000..7c1b2f2
--- /dev/null
+++ b/basis/io/standard-paths/macosx/authors.txt
@@ -0,0 +1 @@
+Doug Coleman

diff --git a/basis/io/standard-paths/macosx/macosx-tests.factor b/basis/io/standard-paths/macosx/macosx-tests.factor
new file mode 100644 (file)
index 0000000..2502247
--- /dev/null
+++ b/basis/io/standard-paths/macosx/macosx-tests.factor
@@ -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
+
+

diff --git a/basis/io/standard-paths/macosx/macosx.factor b/basis/io/standard-paths/macosx/macosx.factor
new file mode 100644 (file)
index 0000000..8be2cc1
--- /dev/null
+++ b/basis/io/standard-paths/macosx/macosx.factor
@@ -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 ;

diff --git a/basis/io/standard-paths/macosx/platforms.txt b/basis/io/standard-paths/macosx/platforms.txt
new file mode 100644 (file)
index 0000000..6e806f4
--- /dev/null
+++ b/basis/io/standard-paths/macosx/platforms.txt
@@ -0,0 +1 @@
+macosx

diff --git a/basis/io/standard-paths/standard-paths-tests.factor b/basis/io/standard-paths/standard-paths-tests.factor
new file mode 100644 (file)
index 0000000..ead13a4
--- /dev/null
+++ b/basis/io/standard-paths/standard-paths-tests.factor
@@ -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

diff --git a/basis/io/standard-paths/standard-paths.factor b/basis/io/standard-paths/standard-paths.factor
new file mode 100644 (file)
index 0000000..ea9403e
--- /dev/null
+++ b/basis/io/standard-paths/standard-paths.factor
@@ -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
+

diff --git a/basis/io/standard-paths/unix/authors.txt b/basis/io/standard-paths/unix/authors.txt
new file mode 100644 (file)
index 0000000..7c1b2f2
--- /dev/null
+++ b/basis/io/standard-paths/unix/authors.txt
@@ -0,0 +1 @@
+Doug Coleman

diff --git a/basis/io/standard-paths/unix/platforms.txt b/basis/io/standard-paths/unix/platforms.txt
new file mode 100644 (file)
index 0000000..509143d
--- /dev/null
+++ b/basis/io/standard-paths/unix/platforms.txt
@@ -0,0 +1 @@
+unix

diff --git a/basis/io/standard-paths/unix/unix-tests.factor b/basis/io/standard-paths/unix/unix-tests.factor
new file mode 100644 (file)
index 0000000..7314193
--- /dev/null
+++ b/basis/io/standard-paths/unix/unix-tests.factor
@@ -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

diff --git a/basis/io/standard-paths/unix/unix.factor b/basis/io/standard-paths/unix/unix.factor
new file mode 100644 (file)
index 0000000..091f6b4
--- /dev/null
+++ b/basis/io/standard-paths/unix/unix.factor
@@ -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 ;
+