summaryrefslogtreecommitdiff
path: root/tcl/tools/genWinImage.tcl
blob: a28ddcbdd94630e33011a9f631ea30161decb147 (plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
# genWinImage.tcl --
#
#	This script generates the Windows installer.
#
# Copyright (c) 1999 by Scriptics Corporation.
# All rights reserved.
# 
# RCS: @(#) $Id$


# This file is insensitive to the directory from which it is invoked.

namespace eval genWinImage {
    # toolsDir --
    #
    # This variable points to the platform specific tools directory.

    variable toolsDir

    # tclBuildDir --
    #
    # This variable points to the directory containing the Tcl built tree.

    variable tclBuildDir

    # tkBuildDir --
    #
    # This variable points to the directory containing the Tk built tree.

    variable tkBuildDir

    # our script name at runtime
    variable script [info script]
}

# genWinImage::init --
#
#	This is the main entry point.
#
# Arguments:
#	None.
#
# Results:
#	None.

proc genWinImage::init {} {
    global tcl_platform argv argv0
    variable tclBuildDir
    variable tkBuildDir
    variable toolsDir
    variable script
 
    puts "\n--- $script started: \
	    [clock format [clock seconds] -format "%Y%m%d-%H:%M"] --\n"

    if {$tcl_platform(platform) != "windows"} {
	puts stderr "ERROR: Cannot build TCL.EXE on Unix systems"
	exit 1
    }

    if {[llength $argv] != 3} {
	puts stderr "usage: $argv0 <tclBuildDir> <tkBuildDir> <toolsDir>"
	exit 0
    }

    set tclBuildDir [lindex $argv 0]
    set tkBuildDir [lindex $argv 1]
    set toolsDir [lindex $argv 2]

    generateInstallers
 
    puts "\n--- $script finished: \
	    [clock format [clock seconds] -format "%Y%m%d-%H:%M"] --\n\n"
}

# genWinImage::makeTextFile --
#
#	Convert the input file into a CRLF terminated text file.
#
# Arguments:
#	infile		The input file to convert.
#	outfile		The location where the text file should be stored.
#
# Results:
#	None.

proc genWinImage::makeTextFile {infile outfile} {
    set f [open $infile r]
    set text [read $f]
    close $f
    set f [open $outfile w]
    fconfigure $f -translation crlf
    puts -nonewline $f $text
    close $f
}

# genWinImage::generateInstallers --
#
#	Perform substitutions on the pro.wse.in file and then
#	invoke the WSE script twice; once for CD and once for web.
#
# Arguments:
#	None.
#
# Results:
#	Leaves proweb.exe and procd.exe sitting in the curent directory.

proc genWinImage::generateInstallers {} {
    variable toolsDir
    variable tclBuildDir
    variable tkBuildDir

    # Now read the "pro/srcs/install/pro.wse.in" file, have Tcl make
    # appropriate substitutions, write out the resulting file in a
    # current-working-directory.  Use this new file to perform installation
    # image creation.  Note that we have to use this technique to set
    # the value of _WISE_ because wise32 won't use a /d switch for this
    # variable.

    set __TCLBASEDIR__ [file native $tclBuildDir]
    set __TKBASEDIR__ [file native $tkBuildDir]
    set __WISE__ [file native [file join $toolsDir wise]]

    set f [open [file join $__TCLBASEDIR__ generic/tcl.h] r]
    set s [read $f]
    close $f
    regexp {TCL_PATCH_LEVEL\s*\"([^\"]*)\"} $s dummy __TCL_PATCH_LEVEL__
    
    set f [open tcl.wse.in r]
    set s [read $f]
    close $f
    set s [subst -nocommands -nobackslashes $s]
    set f [open tcl.wse w]
    puts $f $s
    close $f

    # Ensure the text files are CRLF terminated

    makeTextFile [file join $tclBuildDir win/README.binary] \
	    [file join $tclBuildDir win/readme.txt]
    makeTextFile [file join $tclBuildDir license.terms] \
	    [file join $tclBuildDir license.txt]

    set wise32ProgFilePath [file native [file join $__WISE__ wise32.exe]]

    # Run the Wise installer to create the Windows install images.

    if {[catch {exec [file native $wise32ProgFilePath] /c tcl.wse} errMsg]} {
	puts stderr "ERROR: $errMsg"
    } else {
	puts "\"TCL.EXE\" created."
    }

    return
}

genWinImage::init