2009-01-28 02:57:46 -05:00
|
|
|
! Copyright (C) 2007, 2009 Slava Pestov.
|
2007-11-05 00:45:02 -05:00
|
|
|
! See http://factorcode.org/license.txt for BSD license.
|
2010-02-15 14:49:03 -05:00
|
|
|
USING: io io.encodings.binary io.files io.pathnames io.directories
|
|
|
|
io.encodings.ascii kernel namespaces
|
2009-01-28 02:57:46 -05:00
|
|
|
sequences locals system splitting tools.deploy.backend
|
|
|
|
tools.deploy.config tools.deploy.config.editor assocs hashtables
|
2010-02-15 14:49:03 -05:00
|
|
|
prettyprint combinators windows.kernel32 windows.shell32 windows.user32
|
2010-02-17 17:42:53 -05:00
|
|
|
alien.c-types vocabs.metadata vocabs.loader tools.deploy.windows.ico
|
|
|
|
io.files.windows.nt ;
|
2007-11-05 00:45:02 -05:00
|
|
|
IN: tools.deploy.windows
|
|
|
|
|
2010-02-15 14:49:03 -05:00
|
|
|
CONSTANT: app-icon-resource-id "APPICON"
|
|
|
|
|
2009-01-28 02:57:46 -05:00
|
|
|
:: copy-vm ( executable bundle-name extension -- vm )
|
|
|
|
vm "." split1-last drop extension append
|
|
|
|
bundle-name executable ".exe" append append-path
|
|
|
|
[ copy-file ] keep ;
|
|
|
|
|
2007-11-05 00:45:02 -05:00
|
|
|
: create-exe-dir ( vocab bundle-name -- vm )
|
2010-03-23 18:32:16 -04:00
|
|
|
deploy-console? get ".com" ".exe" ? copy-vm ;
|
2007-11-05 00:45:02 -05:00
|
|
|
|
2010-02-17 17:42:53 -05:00
|
|
|
: open-in-explorer ( dir -- )
|
|
|
|
[ f "open" ] dip absolute-path normalize-separators
|
|
|
|
f f SW_SHOWNORMAL ShellExecute drop ;
|
|
|
|
|
2010-02-15 14:49:03 -05:00
|
|
|
: embed-ico ( vm vocab -- )
|
|
|
|
dup vocab-windows-icon-path vocab-append-path dup exists?
|
2010-02-15 17:04:11 -05:00
|
|
|
[ binary file-contents app-icon-resource-id embed-icon-resource ]
|
2010-02-15 14:49:03 -05:00
|
|
|
[ 2drop ] if ;
|
|
|
|
|
2008-04-02 20:46:37 -04:00
|
|
|
M: winnt deploy*
|
2008-05-10 16:22:38 -04:00
|
|
|
"resource:" [
|
2008-11-09 18:27:51 -05:00
|
|
|
dup deploy-config [
|
|
|
|
deploy-name get
|
2010-02-15 02:10:05 -05:00
|
|
|
{
|
2010-02-15 14:49:03 -05:00
|
|
|
[ create-exe-dir dup ]
|
|
|
|
[ drop embed-ico ]
|
2008-05-10 16:22:38 -04:00
|
|
|
[ image-name ]
|
2010-02-15 02:10:05 -05:00
|
|
|
[ drop namespace make-deploy-image ]
|
2010-02-16 16:32:14 -05:00
|
|
|
[ nip "" [ copy-resources ] [ copy-libraries ] 3bi ]
|
2010-02-15 02:10:05 -05:00
|
|
|
[ nip open-in-explorer ]
|
|
|
|
} 2cleave
|
2008-11-09 18:27:51 -05:00
|
|
|
] bind
|
2008-02-28 02:21:30 -05:00
|
|
|
] with-directory ;
|