have tools.deploy.shaker write a manifest of loaded vocabs to a file. have tools.deploy.backend read in this manifest. have tools.deploy.macosx copy resources for the manifest vocabs to the deployed bundle

db4
Joe Groff 2010-02-14 11:29:37 -08:00
parent 072dd3b0d0
commit 9c77d7bde8
4 changed files with 53 additions and 29 deletions

View File

@ -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.streams.c io.files io.files.temp io.pathnames io.directories
io.directories.hierarchy io.backend quotations io.launcher io.directories.hierarchy io.backend quotations io.launcher
tools.deploy.config tools.deploy.config.editor bootstrap.image 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 IN: tools.deploy.backend
: copy-vm ( executable bundle-name -- vm ) : copy-vm ( executable bundle-name -- vm )
prepend-path vm over copy-file ; prepend-path vm over copy-file ;
CONSTANT: theme-path "basis/ui/gadgets/theme/" : copy-resources ( manifest name dir -- )
append-path swap [ copy-vocab-resources ] with each ;
: 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 ;
: image-name ( vocab bundle-name -- str ) : image-name ( vocab bundle-name -- str )
prepend-path ".image" append ; prepend-path ".image" append ;
@ -89,7 +83,7 @@ DEFER: ?make-staging-image
[ "deploy-config-" prepend temp-file ] bi [ "deploy-config-" prepend temp-file ] bi
[ utf8 set-file-contents ] keep ; [ 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 bootstrap-profile ?make-staging-image
@ -97,6 +91,7 @@ DEFER: ?make-staging-image
"-i=" bootstrap-profile staging-image-name append , "-i=" bootstrap-profile staging-image-name append ,
"-resource-path=" "" resource-path append , "-resource-path=" "" resource-path append ,
"-run=tools.deploy.shaker" , "-run=tools.deploy.shaker" ,
"-vocab-manifest-out=" prepend ,
[ "-deploy-vocab=" prepend , ] [ "-deploy-vocab=" prepend , ]
[ make-deploy-config "-deploy-config=" prepend , ] bi [ make-deploy-config "-deploy-config=" prepend , ] bi
"-output-image=" prepend , "-output-image=" prepend ,
@ -104,8 +99,10 @@ DEFER: ?make-staging-image
] { } make ] { } make
] bind ; ] bind ;
: make-deploy-image ( vm image vocab config -- ) : make-deploy-image ( vm image vocab config -- manifest )
make-boot-image 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 -- ) HOOK: deploy* os ( vocab -- )

View File

@ -46,7 +46,6 @@ IN: tools.deploy.macosx
[ copy-dll ] [ copy-dll ]
[ copy-nib ] [ copy-nib ]
[ "Contents/Resources" append-path make-directories ] [ "Contents/Resources" append-path make-directories ]
[ "Contents/Resources" copy-theme ]
} cleave } cleave
] ]
[ create-app-plist ] [ create-app-plist ]
@ -72,6 +71,7 @@ M: macosx deploy* ( vocab -- )
[ bundle-name create-app-dir ] keep [ bundle-name create-app-dir ] keep
[ bundle-name deploy.app-image ] keep [ bundle-name deploy.app-image ] keep
namespace make-deploy-image namespace make-deploy-image
bundle-name "Contents/Resources" copy-resources
bundle-name show-in-finder bundle-name show-in-finder
] bind ] bind
] with-directory ; ] with-directory ;

View File

@ -1,11 +1,11 @@
! Copyright (C) 2007, 2010 Slava Pestov. ! Copyright (C) 2007, 2010 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license. ! See http://factorcode.org/license.txt for BSD license.
USING: arrays accessors io.backend io.streams.c init fry USING: arrays accessors io.backend io.encodings.utf8 io.files
namespaces math make assocs kernel parser parser.notes lexer io.streams.c init fry namespaces math make assocs kernel parser
strings.parser vocabs sequences sequences.deep sequences.private parser.notes lexer strings.parser vocabs sequences sequences.deep
words memory kernel.private continuations io vocabs.loader sequences.private words memory kernel.private continuations io
system strings sets vectors quotations byte-arrays sorting vocabs.loader system strings sets vectors quotations byte-arrays
compiler.units definitions generic generic.standard sorting compiler.units definitions generic generic.standard
generic.single tools.deploy.config combinators classes generic.single tools.deploy.config combinators classes
classes.builtin slots.private grouping command-line ; classes.builtin slots.private grouping command-line ;
QUALIFIED: bootstrap.stage2 QUALIFIED: bootstrap.stage2
@ -465,7 +465,8 @@ SYMBOL: deploy-vocab
: startup-stripper ( -- ) : startup-stripper ( -- )
t "quiet" set-global 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 ) : next-method* ( method -- quot )
[ "method-class" word-prop ] [ "method-class" word-prop ]
@ -501,7 +502,12 @@ SYMBOL: deploy-vocab
"Clearing megamorphic caches" show "Clearing megamorphic caches" show
[ clear-megamorphic-cache ] each ; [ 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 startup-stripper
strip-libc strip-libc
strip-destructors strip-destructors
@ -535,7 +541,7 @@ SYMBOL: deploy-vocab
1 exit 1 exit
] recover ; inline ] 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 #! Does the actual work of a deployment in the slave
#! stage2 image #! stage2 image
[ [
@ -548,11 +554,11 @@ SYMBOL: deploy-vocab
"ui.debugger" require "ui.debugger" require
] when ] when
] unless ] unless
deploy-vocab set [ deploy-vocab set ] [ require ] [
deploy-vocab get require vocab-main [
deploy-vocab get vocab-main [ "Vocabulary has no MAIN: word." print flush 1 exit
"Vocabulary has no MAIN: word." print flush 1 exit ] unless
] unless ] tri
strip strip
"Saving final image" show "Saving final image" show
save-image-and-exit save-image-and-exit
@ -561,6 +567,7 @@ SYMBOL: deploy-vocab
: do-deploy ( -- ) : do-deploy ( -- )
"output-image" get "output-image" get
"vocab-manifest-out" get
"deploy-vocab" get "deploy-vocab" get
"Deploying " write dup write "..." print "Deploying " write dup write "..." print
"deploy-config" get parse-file first "deploy-config" get parse-file first

View File

@ -5,6 +5,7 @@ vocabs.metadata ;
IN: vocabs.metadata.resources IN: vocabs.metadata.resources
<PRIVATE <PRIVATE
: (expand-vocab-resource) ( resource-path -- filenames ) : (expand-vocab-resource) ( resource-path -- filenames )
dup file-info directory? dup file-info directory?
[ dup '[ _ directory-tree-files [ append-path ] with map ] [ prefix ] bi ] [ 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 ) : filter-resources ( vocab-files resource-globs -- resource-files )
'[ _ [ matches? ] with any? ] filter ; '[ _ [ 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> PRIVATE>
: vocab-dir-in-root ( vocab -- dir )
[ find-vocab-root ] [ vocab-dir ] bi append-path ;
: expand-vocab-resource-files ( vocab resource-glob-strings -- filenames ) : 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 _ filter-resources
[ (expand-vocab-resource) ] map concat [ (expand-vocab-resource) ] map concat
] with-directory-tree-files ; ] with-directory-tree-files ;
@ -23,3 +34,12 @@ PRIVATE>
: vocab-resource-files ( vocab -- filenames ) : vocab-resource-files ( vocab -- filenames )
dup vocab-resources dup vocab-resources
[ drop f ] [ expand-vocab-resource-files ] if-empty ; [ 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 ;