Rename parent-dir to parent-directory, add copy-file and copy-directory words, start Windows deploy tool

release
Slava Pestov 2007-11-05 00:45:02 -05:00
parent b2d2b47610
commit 6d2f1bc4bd
11 changed files with 113 additions and 43 deletions

6
core/io/files/files-docs.factor Normal file → Executable file
View File

@ -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 } }

32
core/io/files/files.factor Normal file → Executable file
View File

@ -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 ;

9
extra/tools/deploy/config/config-docs.factor Normal file → Executable file
View File

@ -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 } }

15
extra/tools/deploy/config/config.factor Normal file → Executable file
View File

@ -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 ;

12
extra/tools/deploy/deploy.factor Normal file → Executable file
View File

@ -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

View 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* ;

View File

@ -0,0 +1 @@
Deploying minimal stand-alone Windows executables

View File

@ -0,0 +1 @@
tools

View File

@ -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* ;