have tools.deploy.shaker write a manifest of loaded vocabs to a file. have tools...

diff --git a/basis/tools/deploy/backend/backend.factor b/basis/tools/deploy/backend/backend.factor
index fe8049e9e37c1b801cc5b3d6891a1b9f89a0d598..9d6b8d4c0805fba47028827720827351f05b7aec 100644 (file)
--- a/basis/tools/deploy/backend/backend.factor
+++ b/basis/tools/deploy/backend/backend.factor
@@ -7,21 +7,15 @@ summary layouts vocabs.loader prettyprint.config prettyprint debugger
 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 ;
+io.encodings.utf8 destructors accessors hashtables
+vocabs.metadata.resources ;
 IN: tools.deploy.backend
 
 : copy-vm ( executable bundle-name -- vm )
     prepend-path vm over copy-file ;
 
-CONSTANT: theme-path "basis/ui/gadgets/theme/"
-
-: copy-theme ( name dir -- )
-    deploy-ui? get [
-        append-path
-        theme-path append-path
-        [ make-directories ]
-        [ theme-path "resource:" prepend swap copy-tree ] bi
-    ] [ 2drop ] if ;
+: copy-resources ( manifest name dir -- )
+    append-path swap [ copy-vocab-resources ] with each ;
 
 : image-name ( vocab bundle-name -- str )
     prepend-path ".image" append ;
@@ -89,7 +83,7 @@ DEFER: ?make-staging-image
     [ "deploy-config-" prepend temp-file ] bi
     [ utf8 set-file-contents ] keep ;
 
-: deploy-command-line ( image vocab config -- flags )
+: deploy-command-line ( image vocab manifest-file config -- flags )
     [
         bootstrap-profile ?make-staging-image
 
@@ -97,6 +91,7 @@ DEFER: ?make-staging-image
             "-i=" bootstrap-profile staging-image-name append ,
             "-resource-path=" "" resource-path append ,
             "-run=tools.deploy.shaker" ,
+            "-vocab-manifest-out=" prepend ,
             [ "-deploy-vocab=" prepend , ]
             [ make-deploy-config "-deploy-config=" prepend , ] bi
             "-output-image=" prepend ,
@@ -104,8 +99,10 @@ DEFER: ?make-staging-image
         ] { } make
     ] bind ;
 
-: make-deploy-image ( vm image vocab config -- )
+: make-deploy-image ( vm image vocab config -- manifest )
     make-boot-image
-    deploy-command-line run-factor ;
+    over "vocab-manifest-" prepend temp-file
+    [ swap deploy-command-line run-factor ]
+    [ utf8 file-lines ] bi ;
 
 HOOK: deploy* os ( vocab -- )

diff --git a/basis/tools/deploy/macosx/macosx.factor b/basis/tools/deploy/macosx/macosx.factor
index f753e38fb2bf8c3a1e3355d37670d684d085278c..bec3e78cbdeb6e61ab3049a14b37a102967d2572 100644 (file)
--- a/basis/tools/deploy/macosx/macosx.factor
+++ b/basis/tools/deploy/macosx/macosx.factor
@@ -46,7 +46,6 @@ IN: tools.deploy.macosx
             [ copy-dll ]
             [ copy-nib ]
             [ "Contents/Resources" append-path make-directories ]
-            [ "Contents/Resources" copy-theme ]
         } cleave
     ]
     [ create-app-plist ]
@@ -72,6 +71,7 @@ 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 show-in-finder
         ] bind
     ] with-directory ;

diff --git a/basis/tools/deploy/shaker/shaker.factor b/basis/tools/deploy/shaker/shaker.factor
index 5897712a023f46fd647d6d2d4f35514d9bc3d9dc..e020980233507dd8bbe102b89e14323a377f1b9b 100755 (executable)
--- a/basis/tools/deploy/shaker/shaker.factor
+++ b/basis/tools/deploy/shaker/shaker.factor
@@ -1,11 +1,11 @@
 ! Copyright (C) 2007, 2010 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: arrays accessors io.backend 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 vocabs.loader
-system strings sets vectors quotations byte-arrays sorting
-compiler.units definitions generic generic.standard
+USING: arrays 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
+vocabs.loader system strings sets vectors quotations byte-arrays
+sorting compiler.units definitions generic generic.standard
 generic.single tools.deploy.config combinators classes
 classes.builtin slots.private grouping command-line ;
 QUALIFIED: bootstrap.stage2
@@ -465,7 +465,8 @@ SYMBOL: deploy-vocab
 
 : startup-stripper ( -- )
     t "quiet" set-global
-    f output-stream set-global ;
+    f output-stream set-global
+    V{ "resource:" } clone vocab-roots set-global ;
 
 : next-method* ( method -- quot )
     [ "method-class" word-prop ]
@@ -501,7 +502,12 @@ SYMBOL: deploy-vocab
     "Clearing megamorphic caches" show
     [ clear-megamorphic-cache ] each ;
 
-: strip ( -- )
+: write-vocab-manifest ( vocab-manifest-out -- )
+    "Writing vocabulary manifest to " write dup print flush
+    vocabs swap utf8 set-file-lines ;
+
+: strip ( vocab-manifest-out -- )
+    [ write-vocab-manifest ] when*
     startup-stripper
     strip-libc
     strip-destructors
@@ -535,7 +541,7 @@ SYMBOL: deploy-vocab
         1 exit
     ] recover ; inline
 
-: (deploy) ( final-image vocab config -- )
+: (deploy) ( final-image vocab-manifest-out vocab config -- )
     #! Does the actual work of a deployment in the slave
     #! stage2 image
     [
@@ -548,11 +554,11 @@ SYMBOL: deploy-vocab
                     "ui.debugger" require
                 ] when
             ] unless
-            deploy-vocab set
-            deploy-vocab get require
-            deploy-vocab get vocab-main [
-                "Vocabulary has no MAIN: word." print flush 1 exit
-            ] unless
+            [ deploy-vocab set ] [ require ] [
+                vocab-main [
+                    "Vocabulary has no MAIN: word." print flush 1 exit
+                ] unless
+            ] tri
             strip
             "Saving final image" show
             save-image-and-exit
@@ -561,6 +567,7 @@ SYMBOL: deploy-vocab
 
 : do-deploy ( -- )
     "output-image" get
+    "vocab-manifest-out" get
     "deploy-vocab" get
     "Deploying " write dup write "..." print
     "deploy-config" get parse-file first

diff --git a/basis/vocabs/metadata/resources/resources.factor b/basis/vocabs/metadata/resources/resources.factor
index e37bdc273f87cf6ad7b097dd568c9044f58e01a1..62036be4088e444898d6762c0066b4c653e3f15a 100644 (file)
--- a/basis/vocabs/metadata/resources/resources.factor
+++ b/basis/vocabs/metadata/resources/resources.factor
@@ -5,6 +5,7 @@ vocabs.metadata ;
 IN: vocabs.metadata.resources
 
 <PRIVATE
+
 : (expand-vocab-resource) ( resource-path -- filenames )
     dup file-info directory?
     [ dup '[ _ directory-tree-files [ append-path ] with map ] [ prefix ] bi ]
@@ -12,10 +13,20 @@ IN: vocabs.metadata.resources
 
 : filter-resources ( vocab-files resource-globs -- resource-files ) 
     '[ _ [ matches? ] with any? ] filter ;
+
+: copy-vocab-resource ( to from file -- )
+    [ append-path ] curry bi@
+    dup file-info directory?
+    [ drop make-directories ]
+    [ swap [ parent-directory make-directories ] [ copy-file ] bi ] if ;
+    
 PRIVATE>
 
+: vocab-dir-in-root ( vocab -- dir )
+    [ find-vocab-root ] [ vocab-dir ] bi append-path ;
+
 : expand-vocab-resource-files ( vocab resource-glob-strings -- filenames )
-    [ [ find-vocab-root ] [ vocab-dir ] bi append-path ] dip [ <glob> ] map '[
+    [ vocab-dir-in-root ] dip [ <glob> ] map '[
         _ filter-resources
         [ (expand-vocab-resource) ] map concat
     ] with-directory-tree-files ;
@@ -23,3 +34,12 @@ PRIVATE>
 : vocab-resource-files ( vocab -- filenames )
     dup vocab-resources
     [ drop f ] [ expand-vocab-resource-files ] if-empty ;
+
+: copy-vocab-resources ( dir vocab -- )
+    dup vocab-resource-files 
+    [ 2drop ] [
+        [ [ vocab-dir append-path P ] [ vocab-dir-in-root P ] bi ] dip
+        [ 2drop make-directories ]
+        [ [ copy-vocab-resource ] with with each ] 3bi
+    ] if-empty ;
+