From 6d2f1bc4bd6d9c8477f356f41c703be8e7946c0a Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Mon, 5 Nov 2007 00:45:02 -0500 Subject: [PATCH] Rename parent-dir to parent-directory, add copy-file and copy-directory words, start Windows deploy tool --- core/io/files/files-docs.factor | 6 +-- core/io/files/files.factor | 32 +++++++++++---- extra/tools/deploy/config/config-docs.factor | 9 +++- extra/tools/deploy/config/config.factor | 15 ++++--- extra/tools/deploy/deploy.factor | 12 ++++-- .../{app/app.factor => macosx/macosx.factor} | 39 ++++++++---------- .../tools/deploy/{app => macosx}/summary.txt | 0 extra/tools/deploy/{app => macosx}/tags.txt | 0 extra/tools/deploy/windows/summary.txt | 1 + extra/tools/deploy/windows/tags.txt | 1 + extra/tools/deploy/windows/windows.factor | 41 +++++++++++++++++++ 11 files changed, 113 insertions(+), 43 deletions(-) mode change 100644 => 100755 core/io/files/files-docs.factor mode change 100644 => 100755 core/io/files/files.factor mode change 100644 => 100755 extra/tools/deploy/config/config-docs.factor mode change 100644 => 100755 extra/tools/deploy/config/config.factor mode change 100644 => 100755 extra/tools/deploy/deploy.factor rename extra/tools/deploy/{app/app.factor => macosx/macosx.factor} (65%) mode change 100644 => 100755 rename extra/tools/deploy/{app => macosx}/summary.txt (100%) rename extra/tools/deploy/{app => macosx}/tags.txt (100%) create mode 100644 extra/tools/deploy/windows/summary.txt create mode 100644 extra/tools/deploy/windows/tags.txt create mode 100755 extra/tools/deploy/windows/windows.factor diff --git a/core/io/files/files-docs.factor b/core/io/files/files-docs.factor old mode 100644 new mode 100755 index 66524959a2..fba91ded0a --- a/core/io/files/files-docs.factor +++ b/core/io/files/files-docs.factor @@ -7,7 +7,7 @@ ARTICLE: "file-streams" "Reading and writing files" { $subsection } { $subsection } "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 } } diff --git a/core/io/files/files.factor b/core/io/files/files.factor old mode 100644 new mode 100755 index da1c078525..441dcfbee3 --- a/core/io/files/files.factor +++ b/core/io/files/files.factor @@ -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: 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 + [ + stdio get swap + [ + 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 ; diff --git a/extra/tools/deploy/config/config-docs.factor b/extra/tools/deploy/config/config-docs.factor old mode 100644 new mode 100755 index 31f4883cf8..5b1efce25e --- a/extra/tools/deploy/config/config-docs.factor +++ b/extra/tools/deploy/config/config-docs.factor @@ -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 } } diff --git a/extra/tools/deploy/config/config.factor b/extra/tools/deploy/config/config.factor old mode 100644 new mode 100755 index 694eb36e0b..e6d03c2233 --- a/extra/tools/deploy/config/config.factor +++ b/extra/tools/deploy/config/config.factor @@ -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 ; diff --git a/extra/tools/deploy/deploy.factor b/extra/tools/deploy/deploy.factor old mode 100644 new mode 100755 index c11b41e09c..adee30a8bc --- a/extra/tools/deploy/deploy.factor +++ b/extra/tools/deploy/deploy.factor @@ -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 diff --git a/extra/tools/deploy/app/app.factor b/extra/tools/deploy/macosx/macosx.factor old mode 100644 new mode 100755 similarity index 65% rename from extra/tools/deploy/app/app.factor rename to extra/tools/deploy/macosx/macosx.factor index 3672c9a586..0b71ac5209 --- a/extra/tools/deploy/app/app.factor +++ b/extra/tools/deploy/macosx/macosx.factor @@ -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* ; diff --git a/extra/tools/deploy/app/summary.txt b/extra/tools/deploy/macosx/summary.txt similarity index 100% rename from extra/tools/deploy/app/summary.txt rename to extra/tools/deploy/macosx/summary.txt diff --git a/extra/tools/deploy/app/tags.txt b/extra/tools/deploy/macosx/tags.txt similarity index 100% rename from extra/tools/deploy/app/tags.txt rename to extra/tools/deploy/macosx/tags.txt diff --git a/extra/tools/deploy/windows/summary.txt b/extra/tools/deploy/windows/summary.txt new file mode 100644 index 0000000000..6b67694cc2 --- /dev/null +++ b/extra/tools/deploy/windows/summary.txt @@ -0,0 +1 @@ +Deploying minimal stand-alone Windows executables diff --git a/extra/tools/deploy/windows/tags.txt b/extra/tools/deploy/windows/tags.txt new file mode 100644 index 0000000000..ef1aab0d0e --- /dev/null +++ b/extra/tools/deploy/windows/tags.txt @@ -0,0 +1 @@ +tools diff --git a/extra/tools/deploy/windows/windows.factor b/extra/tools/deploy/windows/windows.factor new file mode 100755 index 0000000000..0d0241a5e0 --- /dev/null +++ b/extra/tools/deploy/windows/windows.factor @@ -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* ;