Rename parent-dir to parent-directory, add copy-file and copy-directory words, start Windows deploy tool
parent
b2d2b47610
commit
6d2f1bc4bd
|
@ -7,7 +7,7 @@ ARTICLE: "file-streams" "Reading and writing files"
|
|||
{ $subsection <file-writer> }
|
||||
{ $subsection <file-appender> }
|
||||
"Pathname manipulation:"
|
||||
{ $subsection parent-dir }
|
||||
{ $subsection parent-directory }
|
||||
{ $subsection file-name }
|
||||
{ $subsection last-path-separator }
|
||||
{ $subsection path+ }
|
||||
|
@ -101,10 +101,10 @@ HELP: file-modified
|
|||
{ $values { "path" "a pathname string" } { "n" "a non-negative integer or " { $link f } } }
|
||||
{ $description "Outputs a file's last modification time, since midnight January 1, 1970. If the file does not exist, outputs " { $link f } "." } ;
|
||||
|
||||
HELP: parent-dir
|
||||
HELP: parent-directory
|
||||
{ $values { "path" "a pathname string" } { "parent" "a pathname string" } }
|
||||
{ $description "Strips the last component off a pathname." }
|
||||
{ $examples { $example "USE: io.files" "\"/etc/passwd\" parent-dir print" "/etc" } } ;
|
||||
{ $examples { $example "USE: io.files" "\"/etc/passwd\" parent-directory print" "/etc" } } ;
|
||||
|
||||
HELP: file-name
|
||||
{ $values { "path" "a pathname string" } { "string" string } }
|
||||
|
|
|
@ -1,8 +1,8 @@
|
|||
! Copyright (C) 2004, 2007 Slava Pestov.
|
||||
! See http://factorcode.org/license.txt for BSD license.
|
||||
IN: io.files
|
||||
USING: io.backend io.files.private hashtables kernel math memory
|
||||
namespaces sequences strings arrays definitions system
|
||||
USING: io.backend io.files.private io hashtables kernel math
|
||||
memory namespaces sequences strings arrays definitions system
|
||||
combinators splitting ;
|
||||
|
||||
HOOK: <file-reader> io-backend ( path -- stream )
|
||||
|
@ -58,13 +58,16 @@ M: object root-directory? ( path -- ? ) "/" = ;
|
|||
|
||||
TUPLE: no-parent-directory path ;
|
||||
|
||||
: parent-dir ( path -- parent )
|
||||
: no-parent-directory ( path -- * )
|
||||
\ no-parent-directory construct-boa throw ;
|
||||
|
||||
: parent-directory ( path -- parent )
|
||||
{
|
||||
{ [ dup root-directory? ] [ ] }
|
||||
{ [ dup "/\\" split ".." over member? "." rot member? or ]
|
||||
[ \ no-parent-directory construct-boa throw ] }
|
||||
[ no-parent-directory ] }
|
||||
{ [ t ] [ dup last-path-separator
|
||||
[ 1+ head ] [ 2drop "." ] if ] }
|
||||
[ 1+ head ] [ 2drop "." ] if ] }
|
||||
} cond ;
|
||||
|
||||
: file-name ( path -- string )
|
||||
|
@ -72,7 +75,7 @@ TUPLE: no-parent-directory path ;
|
|||
[ 1+ tail ] [ drop ] if ;
|
||||
|
||||
: resource-path ( path -- newpath )
|
||||
\ resource-path get [ image parent-dir ] unless*
|
||||
\ resource-path get [ image parent-directory ] unless*
|
||||
swap path+ ;
|
||||
|
||||
: ?resource-path ( path -- newpath )
|
||||
|
@ -86,7 +89,7 @@ TUPLE: no-parent-directory path ;
|
|||
{ [ dup empty? ] [ ] }
|
||||
{ [ dup exists? ] [ ] }
|
||||
{ [ t ] [
|
||||
dup parent-dir make-directories
|
||||
dup parent-directory make-directories
|
||||
dup make-directory
|
||||
] }
|
||||
} cond drop ;
|
||||
|
@ -103,3 +106,18 @@ M: pathname <=> [ pathname-string ] compare ;
|
|||
{ [ wince? ] [ "" resource-path ] }
|
||||
{ [ unix? ] [ "HOME" os-env ] }
|
||||
} cond ;
|
||||
|
||||
: copy-file ( from to -- )
|
||||
dup parent-directory make-directories
|
||||
<file-writer> [
|
||||
stdio get swap
|
||||
<file-reader> [
|
||||
stdio get swap stream-copy
|
||||
] with-stream
|
||||
] with-stream ;
|
||||
|
||||
: copy-directory ( from to -- )
|
||||
dup make-directories
|
||||
>r dup directory swap r> [
|
||||
>r >r first r> over path+ r> rot path+ copy-file
|
||||
] 2curry each ;
|
||||
|
|
|
@ -30,6 +30,11 @@ ARTICLE: "prepare-deploy" "Preparing to deploy an application"
|
|||
|
||||
ABOUT: "prepare-deploy"
|
||||
|
||||
HELP: deploy-name
|
||||
{ $description "Deploy setting. The name of the executable."
|
||||
$nl
|
||||
"On Mac OS X, this becomes the name of the application bundle, with " { $snippet ".app" } " appended. On Windows, this becomes the name of the directory containing the executable." } ;
|
||||
|
||||
HELP: deploy-word-props?
|
||||
{ $description "Deploy flag. If set, the deploy tool retains all word properties. Otherwise, it applies various heuristics to strip out un-needed word properties from words in the dictionary."
|
||||
$nl
|
||||
|
@ -95,8 +100,8 @@ HELP: deploy-reflection
|
|||
"The defalut value is 1, no reflection. Programs which use the above features will need to be deployed with a higher level of reflection support." } ;
|
||||
|
||||
HELP: default-config
|
||||
{ $values { "assoc" assoc } }
|
||||
{ $description "Outputs the default deployment configuration." } ;
|
||||
{ $values { "vocab" "a vocabulary specifier" } { "assoc" assoc } }
|
||||
{ $description "Outputs the default deployment configuration for a vocabulary." } ;
|
||||
|
||||
HELP: deploy-config
|
||||
{ $values { "vocab" "a vocabulary specifier" } { "assoc" assoc } }
|
||||
|
|
|
@ -1,9 +1,12 @@
|
|||
! Copyright (C) 2007 Slava Pestov.
|
||||
! See http://factorcode.org/license.txt for BSD license.
|
||||
USING: vocabs.loader io.files io kernel sequences assocs
|
||||
splitting parser prettyprint namespaces math ;
|
||||
splitting parser prettyprint namespaces math vocabs
|
||||
hashtables ;
|
||||
IN: tools.deploy.config
|
||||
|
||||
SYMBOL: deploy-name
|
||||
|
||||
SYMBOL: deploy-ui?
|
||||
SYMBOL: deploy-compiler?
|
||||
SYMBOL: deploy-math?
|
||||
|
@ -46,8 +49,8 @@ SYMBOL: deploy-c-types?
|
|||
SYMBOL: deploy-vm
|
||||
SYMBOL: deploy-image
|
||||
|
||||
: default-config ( -- assoc )
|
||||
V{
|
||||
: default-config ( vocab -- assoc )
|
||||
vocab-name deploy-name associate H{
|
||||
{ deploy-ui? f }
|
||||
{ deploy-io 2 }
|
||||
{ deploy-reflection 1 }
|
||||
|
@ -56,15 +59,15 @@ SYMBOL: deploy-image
|
|||
{ deploy-word-props? f }
|
||||
{ deploy-word-defs? f }
|
||||
{ deploy-c-types? f }
|
||||
! default value for deploy.app
|
||||
! default value for deploy.macosx
|
||||
{ "stop-after-last-window?" t }
|
||||
} clone ;
|
||||
} union ;
|
||||
|
||||
: deploy-config-path ( vocab -- string )
|
||||
vocab-dir "deploy.factor" path+ ;
|
||||
|
||||
: deploy-config ( vocab -- assoc )
|
||||
default-config swap
|
||||
dup default-config swap
|
||||
dup deploy-config-path vocab-file-contents
|
||||
parse-fresh dup empty? [ drop ] [ first union ] if ;
|
||||
|
||||
|
|
|
@ -49,7 +49,7 @@ IN: tools.deploy
|
|||
|
||||
"\"-output-image=" swap "\"" 3append ,
|
||||
|
||||
! "-no-stack-traces" ,
|
||||
"-no-stack-traces" ,
|
||||
|
||||
"-no-user-init" ,
|
||||
] { } make ;
|
||||
|
@ -59,6 +59,10 @@ PRIVATE>
|
|||
: deploy* ( vm image vocab config -- )
|
||||
deploy-command-line stage2 ;
|
||||
|
||||
: deploy ( vocab -- )
|
||||
"" resource-path cd
|
||||
vm over ".image" append rot dup deploy-config deploy* ;
|
||||
SYMBOL: deploy-implementation
|
||||
|
||||
HOOK: deploy deploy-implementation ( vocab -- )
|
||||
|
||||
USE-IF: macosx? tools.deploy.macosx
|
||||
|
||||
USE-IF: winnt? tools.deploy.windows
|
||||
|
|
39
extra/tools/deploy/app/app.factor → extra/tools/deploy/macosx/macosx.factor
Normal file → Executable file
39
extra/tools/deploy/app/app.factor → extra/tools/deploy/macosx/macosx.factor
Normal file → Executable file
|
@ -3,10 +3,7 @@
|
|||
USING: io io.files io.launcher kernel namespaces sequences
|
||||
system cocoa.plists cocoa.application tools.deploy
|
||||
tools.deploy.config assocs hashtables prettyprint ;
|
||||
IN: tools.deploy.app
|
||||
|
||||
: mkdir ( path -- )
|
||||
"mkdir -p \"" swap "\"" 3append run-process ;
|
||||
IN: tools.deploy.macosx
|
||||
|
||||
: touch ( path -- )
|
||||
"touch \"" swap "\"" 3append run-process ;
|
||||
|
@ -14,22 +11,19 @@ IN: tools.deploy.app
|
|||
: rm ( path -- )
|
||||
"rm -rf \"" swap "\"" 3append run-process ;
|
||||
|
||||
: cp ( from to -- )
|
||||
"Copying " write over write " to " write dup print
|
||||
dup parent-dir mkdir
|
||||
[ "cp -R \"" % swap % "\" \"" % % "\"" % ] "" make
|
||||
run-process ;
|
||||
: bundle-dir ( -- dir )
|
||||
vm parent-directory parent-directory ;
|
||||
|
||||
: copy-bundle-dir ( name dir -- )
|
||||
vm parent-dir parent-dir over path+ -rot
|
||||
>r "Contents" path+ r> path+ cp ;
|
||||
bundle-dir over path+ -rot
|
||||
>r "Contents" path+ r> path+ copy-directory ;
|
||||
|
||||
: copy-vm ( executable bundle-name -- vm )
|
||||
"Contents/MacOS/" path+ swap path+ vm swap [ cp ] keep ;
|
||||
"Contents/MacOS/" path+ swap path+ vm swap [ copy-file ] keep ;
|
||||
|
||||
: copy-fonts ( name -- )
|
||||
"fonts/" resource-path
|
||||
swap "Contents/Resources/fonts/" path+ cp ;
|
||||
swap "Contents/Resources/fonts/" path+ copy-directory ;
|
||||
|
||||
: print-app-plist ( executable bundle-name -- )
|
||||
[
|
||||
|
@ -57,16 +51,19 @@ IN: tools.deploy.app
|
|||
: deploy.app-image ( vocab bundle-name -- str )
|
||||
[ % "/Contents/Resources/" % % ".image" % ] "" make ;
|
||||
|
||||
: deploy.app-config ( vocab -- assoc )
|
||||
[ ".app" append "bundle-name" associate ] keep
|
||||
deploy-config union ;
|
||||
: bundle-name ( -- string )
|
||||
deploy-name get ".app" append ;
|
||||
|
||||
: deploy.app ( vocab -- )
|
||||
TUPLE: macosx-deploy-implementation ;
|
||||
|
||||
T{ macosx-deploy-implementation } deploy-implementation set-global
|
||||
|
||||
M: macosx-deploy-implementation deploy ( vocab -- )
|
||||
".app deploy tool" assert.app
|
||||
"." resource-path cd
|
||||
dup deploy.app-config [
|
||||
"bundle-name" get rm
|
||||
[ "bundle-name" get create-app-dir ] keep
|
||||
[ "bundle-name" get deploy.app-image ] keep
|
||||
dup deploy-config [
|
||||
bundle-name rm
|
||||
[ bundle-name create-app-dir ] keep
|
||||
[ bundle-name deploy.app-image ] keep
|
||||
namespace
|
||||
] bind deploy* ;
|
|
@ -0,0 +1 @@
|
|||
Deploying minimal stand-alone Windows executables
|
|
@ -0,0 +1 @@
|
|||
tools
|
|
@ -0,0 +1,41 @@
|
|||
! Copyright (C) 2007 Slava Pestov.
|
||||
! See http://factorcode.org/license.txt for BSD license.
|
||||
USING: io io.files kernel namespaces sequences system
|
||||
tools.deploy tools.deploy.config assocs hashtables prettyprint ;
|
||||
IN: tools.deploy.windows
|
||||
|
||||
: copy-vm ( executable bundle-name -- vm )
|
||||
swap path+ ".exe" append vm swap [ copy-file ] keep ;
|
||||
|
||||
: copy-fonts ( bundle-name -- )
|
||||
"fonts/" resource-path
|
||||
swap "fonts/" path+ copy-directory ;
|
||||
|
||||
: copy-dlls ( bundle-name -- )
|
||||
{
|
||||
"freetype6.dll"
|
||||
"zlib1.dll"
|
||||
"factor-nt.dll"
|
||||
} [
|
||||
dup resource-path -rot path+ copy-file
|
||||
] curry* each ;
|
||||
|
||||
: create-exe-dir ( vocab bundle-name -- vm )
|
||||
dup copy-dlls
|
||||
dup copy-fonts
|
||||
copy-vm ;
|
||||
|
||||
: image-name ( vocab bundle-name -- str )
|
||||
swap path+ ".image" append ;
|
||||
|
||||
TUPLE: windows-deploy-implementation ;
|
||||
|
||||
T{ windows-deploy-implementation } deploy-implementation set-global
|
||||
|
||||
M: windows-deploy-implementation deploy
|
||||
"." resource-path cd
|
||||
dup deploy-config [
|
||||
[ deploy-name get create-exe-dir ] keep
|
||||
[ deploy-name get image-name ] keep
|
||||
namespace
|
||||
] bind deploy* ;
|
Loading…
Reference in New Issue