alien.libraries: add a "deploy-library" word that marks a library to have its dll deployed with applications that use it. add support to tools.deploy to find and copy deployed libraries into target bundle

basis/alien/libraries/libraries-docs.factor

@@ -60,6 +60,10 @@ $nl
 }
 "Note the parse time evaluation with " { $link POSTPONE: << } "." } ;
 
+HELP: deploy-library
+{ $values { "name" string } }
+{ $description "Specifies that the logical library named " { $snippet "name" } " should be included during " { $link "tools.deploy" } ". " { $snippet "name" } " must be the name of a library previously loaded with " { $link add-library } "." } ;
+
 HELP: remove-library
 { $values { "name" string } }
 { $description "Unloads a library and removes it from the internal list of libraries. The " { $snippet "name" } " parameter should be a name that was previously passed to " { $link add-library } ". If no library with that name exists, this word does nothing." } ;
@@ -72,4 +76,9 @@ ARTICLE: "loading-libs" "Loading native libraries"
 }
 "Once a library has been defined, you can try loading it to see if the path name is correct:"
 { $subsections load-library }
-"If the compiler cannot load a library, or cannot resolve a symbol in a library, a linkage error is reported using the compiler error mechanism (see " { $link "compiler-errors" } "). Once you install the right library, reload the source file containing the " { $link add-library } " form to force the compiler to try loading the library again." ;
+"If the compiler cannot load a library, or cannot resolve a symbol in a library, a linkage error is reported using the compiler error mechanism (see " { $link "compiler-errors" } "). Once you install the right library, reload the source file containing the " { $link add-library } " form to force the compiler to try loading the library again."
+$nl
+"Libraries that do not come standard with the operating system need to be included with deployed applications that use them. A word is provided to instruct " { $link "tools.deploy" } " that a library must be so deployed:"
+{ $subsections
+    deploy-library
+} ;

basis/alien/libraries/libraries.factor

@@ -1,7 +1,7 @@
 ! Copyright (C) 2009 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
 USING: accessors alien alien.strings assocs io.backend
-kernel namespaces destructors ;
+kernel namespaces destructors sequences system io.pathnames ;
 IN: alien.libraries
 
 : dlopen ( path -- dll ) native-string>alien (dlopen) ;
@@ -9,11 +9,15 @@ IN: alien.libraries
 : dlsym ( name dll -- alien ) [ string>symbol ] dip (dlsym) ;
 
 SYMBOL: libraries
+SYMBOL: deploy-libraries
 
 libraries [ H{ } clone ] initialize
+deploy-libraries [ V{ } clone ] initialize
 
 TUPLE: library path abi dll ;
 
+ERROR: no-library name ;
+
 : library ( name -- library ) libraries get at ;
 
 : <library> ( path abi -- library )
@@ -32,3 +36,19 @@ M: library dispose dll>> [ dispose ] when* ;
 : add-library ( name path abi -- )
     [ 2drop remove-library ]
     [ <library> swap libraries get set-at ] 3bi ;
+
+: deploy-library ( name -- )
+    dup libraries get key?
+    [ deploy-libraries get 2dup member? [ 2drop ] [ push ] if ]
+    [ no-library ] if ;
+
+<PRIVATE
+HOOK: >deployed-library-path os ( path -- path' )
+
+M: windows >deployed-library-path
+    file-name ;
+M: unix >deployed-library-path
+    file-name "$ORIGIN" prepend-path ;
+M: macosx >deployed-library-path
+    file-name "@executable_path/../Frameworks" prepend-path ;
+PRIVATE>

basis/tools/deploy/backend/backend.factor

@@ -8,14 +8,27 @@ io.streams.c io.files io.files.temp io.pathnames io.directories
 io.directories.hierarchy io.backend quotations io.launcher
 tools.deploy.config tools.deploy.config.editor bootstrap.image
 io.encodings.utf8 destructors accessors hashtables
-vocabs.metadata.resources ;
+tools.deploy.libraries vocabs.metadata.resources ;
 IN: tools.deploy.backend
 
 : copy-vm ( executable bundle-name -- vm )
     prepend-path vm over copy-file ;
 
+TUPLE: vocab-manifest vocabs libraries ;
+
 : copy-resources ( manifest name dir -- )
-    append-path swap [ copy-vocab-resources ] with each ;
+    append-path swap vocabs>> [ copy-vocab-resources ] with each ;
+
+ERROR: cant-deploy-library-file library ;
+<PRIVATE
+: copy-library ( dir library -- )
+    dup find-library-file
+    [ nip swap over file-name append-path copy-file ]
+    [ cant-deploy-library-file ] if* ;
+PRIVATE>
+
+: copy-libraries ( manifest name dir -- )
+    append-path swap libraries>> [ copy-library ] with each ;
 
 : image-name ( vocab bundle-name -- str )
     prepend-path ".image" append ;
@@ -99,10 +112,16 @@ DEFER: ?make-staging-image
         ] { } make
     ] bind ;
 
+: parse-vocab-manifest-file ( path -- vocab-manifest )
+    utf8 file-lines
+    dup first "VOCABS:" =
+    [ "LIBRARIES:" split1 vocab-manifest boa ]
+    [ "invalid vocab manifest!" throw ] if ;
+
 : make-deploy-image ( vm image vocab config -- manifest )
     make-boot-image
     over "vocab-manifest-" prepend temp-file
     [ swap deploy-command-line run-factor ]
-    [ utf8 file-lines ] bi ;
+    [ parse-vocab-manifest-file ] bi ;
 
 HOOK: deploy* os ( vocab -- )

basis/tools/deploy/libraries/libraries.factor

@@ -0,0 +1,11 @@
+! (c)2010 Joe Groff bsd license
+USING: alien.libraries io.pathnames io.pathnames.private kernel
+system vocabs.loader ;
+IN: tools.deploy.libraries
+
+HOOK: find-library-file os ( file -- path )
+
+os windows?
+"tools.deploy.libraries.windows"
+"tools.deploy.libraries.unix" ? require
+

basis/tools/deploy/libraries/tags.txt

@@ -0,0 +1 @@
+unportable

basis/tools/deploy/libraries/unix/tags.txt

@@ -0,0 +1 @@
+unportable

basis/tools/deploy/libraries/unix/unix.factor

@@ -0,0 +1,16 @@
+! (c)2010 Joe Groff bsd license
+USING: io.files io.pathnames io.pathnames.private kernel
+sequences system tools.deploy.libraries ;
+IN: tools.deploy.libraries.unix
+
+! stupid hack. better ways to find the library name would be open the library,
+! note a symbol address found in the library, then call dladdr (or use
+: ?exists ( path -- path/f )
+    dup exists? [ drop f ] unless ; inline
+
+M: unix find-library-file
+    dup absolute-path? [ ?exists ] [
+        { "/lib" "/usr/lib" "/usr/local/lib" }
+        [ prepend-path ?exists ] with map-find drop
+    ] if ;
+

basis/tools/deploy/libraries/windows/windows.factor

@@ -0,0 +1,16 @@
+! (c)2010 Joe Groff bsd license
+USING: alien.strings byte-arrays io.encodings.utf16n kernel
+specialized-arrays system tools.deploy.libraries windows.kernel32
+windows.types ;
+FROM: alien.c-types => ushort ;
+SPECIALIZED-ARRAY: ushort
+IN: tools.deploy.libraries.windows
+
+M: windows find-library-file
+    f DONT_RESOLVE_DLL_REFERENCES LoadLibraryEx [
+        [
+            32768 (ushort-array) [ 32768 GetModuleFileName drop ] keep
+            utf16n alien>string
+        ] [ FreeLibrary drop ] bi
+    ] [ f ] if* ;
+

basis/tools/deploy/macosx/macosx.factor

@@ -81,7 +81,9 @@ M: macosx deploy* ( vocab -- )
             [ bundle-name create-app-dir ] keep
             [ bundle-name deploy.app-image ] keep
             namespace make-deploy-image
-            bundle-name "Contents/Resources" copy-resources
+            bundle-name
+            [ "Contents/Resources" copy-resources ]
+            [ "Contents/Frameworks" copy-libraries ] 2bi
             bundle-name show-in-finder
         ] bind
     ] with-directory ;

basis/tools/deploy/shaker/shaker.factor

@@ -1,6 +1,6 @@
 ! Copyright (C) 2007, 2010 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: arrays accessors io.backend io.encodings.utf8 io.files
+USING: arrays alien.libraries accessors io.backend io.encodings.utf8 io.files
 io.streams.c init fry namespaces math make assocs kernel parser
 parser.notes lexer strings.parser vocabs sequences sequences.deep
 sequences.private words memory kernel.private continuations io
@@ -19,6 +19,7 @@ QUALIFIED: layouts
 QUALIFIED: source-files
 QUALIFIED: source-files.errors
 QUALIFIED: vocabs
+FROM: alien.libraries.private => >deployed-library-path ;
 IN: tools.deploy.shaker
 
 ! This file is some hairy shit.
@@ -505,11 +506,28 @@ SYMBOL: deploy-vocab
 
 : write-vocab-manifest ( vocab-manifest-out -- )
     "Writing vocabulary manifest to " write dup print flush
-    vocabs swap utf8 set-file-lines ;
+    vocabs "VOCABS:" prefix
+    deploy-libraries get [ libraries get path>> ] map "LIBRARIES:" prefix append
+    swap utf8 set-file-lines ;
+
+: prepare-deploy-libraries ( -- )
+    "Preparing deployed libraries" print flush
+    deploy-libraries get [
+        libraries get [
+            [ path>> >deployed-library-path ] [ abi>> ] bi <library>
+        ] change-at
+    ] each
+    
+    [
+        "deploy-libraries" "alien.libraries" lookup forget
+        "deploy-library" "alien.libraries" lookup forget
+        ">deployed-library-path" "alien.libraries.private" lookup forget
+    ] with-compilation-unit ;
 
 : strip ( vocab-manifest-out -- )
     [ write-vocab-manifest ] when*
     startup-stripper
+    prepare-deploy-libraries
     strip-libc
     strip-destructors
     strip-call

basis/tools/deploy/unix/unix.factor

@@ -19,7 +19,7 @@ M: unix deploy* ( vocab -- )
             [ bundle-name create-app-dir ] keep
             [ bundle-name image-name ] keep
             namespace make-deploy-image
-            bundle-name "" copy-resources
+            bundle-name "" [ copy-resources ] [ copy-libraries ] 3bi
             bundle-name normalize-path [ "Binary deployed to " % % "." % ] "" make print
         ] bind
     ] with-directory ;

basis/tools/deploy/windows/windows.factor

@@ -36,7 +36,7 @@ M: winnt deploy*
                 [ drop embed-ico ]
                 [ image-name ]
                 [ drop namespace make-deploy-image ]
-                [ nip "" copy-resources ]
+                [ nip "" [ copy-resources ] [ copy-libraries ] 3bi ]
                 [ nip open-in-explorer ]
             } 2cleave 
         ] bind

basis/windows/kernel32/kernel32.factor

@@ -90,6 +90,8 @@ CONSTANT: FILE_ACTION_MODIFIED 3
 CONSTANT: FILE_ACTION_RENAMED_OLD_NAME 4
 CONSTANT: FILE_ACTION_RENAMED_NEW_NAME 5
 
+CONSTANT: DONT_RESOLVE_DLL_REFERENCES 1
+
 STRUCT: FILE_NOTIFY_INFORMATION
     { NextEntryOffset DWORD }
     { Action DWORD }
@@ -1167,7 +1169,7 @@ FUNCTION: BOOL FreeConsole ( ) ;
 ! FUNCTION: FreeEnvironmentStringsA
 FUNCTION: BOOL FreeEnvironmentStringsW ( LPTCH lpszEnvironmentBlock ) ;
 ALIAS: FreeEnvironmentStrings FreeEnvironmentStringsW
-! FUNCTION: FreeLibrary
+FUNCTION: BOOL FreeLibrary ( HMODULE hModule ) ;
 ! FUNCTION: FreeLibraryAndExitThread
 ! FUNCTION: FreeResource
 ! FUNCTION: FreeUserPhysicalPages
@@ -1314,7 +1316,8 @@ FUNCTION: DWORD GetLogicalDrives ( ) ;
 ! FUNCTION: GetLongPathNameW
 ! FUNCTION: GetMailslotInfo
 ! FUNCTION: GetModuleFileNameA
-! FUNCTION: GetModuleFileNameW
+FUNCTION: DWORD GetModuleFileNameW ( HMODULE hModule, LPTSTR lpFilename, DWORD nSize ) ;
+ALIAS: GetModuleFileName GetModuleFileNameW
 FUNCTION: HMODULE GetModuleHandleW ( LPCWSTR lpModuleName ) ;
 ALIAS: GetModuleHandle GetModuleHandleW
 ! FUNCTION: GetModuleHandleExA