]> gitweb.factorcode.org Git - factor.git/blob - basis/tools/deploy/windows/windows.factor
Fix quirk in open-in-explorer -- msft explorer wouldn't go to previous directory...
[factor.git] / basis / tools / deploy / windows / windows.factor
1 ! Copyright (C) 2007, 2009 Slava Pestov.
2 ! See http://factorcode.org/license.txt for BSD license.
3 USING: io io.encodings.binary io.files io.pathnames io.directories
4 io.encodings.ascii kernel namespaces
5 sequences locals system splitting tools.deploy.backend
6 tools.deploy.config tools.deploy.config.editor assocs hashtables
7 prettyprint combinators windows.kernel32 windows.shell32 windows.user32
8 alien.c-types vocabs.metadata vocabs.loader tools.deploy.windows.ico
9 io.files.windows.nt ;
10 IN: tools.deploy.windows
11
12 CONSTANT: app-icon-resource-id "APPICON"
13
14 : copy-dll ( bundle-name -- )
15     "resource:factor.dll" swap copy-file-into ;
16
17 :: copy-vm ( executable bundle-name extension -- vm )
18     vm "." split1-last drop extension append
19     bundle-name executable ".exe" append append-path
20     [ copy-file ] keep ;
21
22 : create-exe-dir ( vocab bundle-name -- vm )
23     dup copy-dll
24     deploy-ui? get ".exe" ".com" ? copy-vm ;
25
26 : open-in-explorer ( dir -- )
27     [ f "open" ] dip absolute-path normalize-separators
28     f f SW_SHOWNORMAL ShellExecute drop ;
29
30 : embed-ico ( vm vocab -- )
31     dup vocab-windows-icon-path vocab-append-path dup exists?
32     [ binary file-contents app-icon-resource-id embed-icon-resource ]
33     [ 2drop ] if ;
34
35 M: winnt deploy*
36     "resource:" [
37         dup deploy-config [
38             deploy-name get
39             {
40                 [ create-exe-dir dup ]
41                 [ drop embed-ico ]
42                 [ image-name ]
43                 [ drop namespace make-deploy-image ]
44                 [ nip "" [ copy-resources ] [ copy-libraries ] 3bi ]
45                 [ nip open-in-explorer ]
46             } 2cleave 
47         ] bind
48     ] with-directory ;