forked from andreas-kupries/critcl
-
Notifications
You must be signed in to change notification settings - Fork 0
/
build.tcl
executable file
·249 lines (219 loc) · 5.89 KB
/
build.tcl
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
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
#!/bin/sh
# -*- tcl -*- \
exec tclsh "$0" ${1+"$@"}
set me [file normalize [info script]]
set packages {zlib}
proc main {} {
global argv tcl_platform tag
set tag {}
if {![llength $argv]} {
if {$tcl_platform(platform) eq "windows"} {
set argv gui
} else {
set argv help
}
}
if {[catch {
eval _$argv
}]} usage
exit 0
}
proc usage {{status 1}} {
global errorInfo
if {($errorInfo ne {}) &&
![string match {invalid command name "_*"*} $errorInfo]
} {
puts stderr $::errorInfo
exit
}
global argv0
set prefix "Usage: "
foreach c [lsort -dict [info commands _*]] {
set c [string range $c 1 end]
if {[catch {
H${c}
} res]} {
puts stderr "$prefix$argv0 $c args...\n"
} else {
puts stderr "$prefix$argv0 $c $res\n"
}
set prefix " "
}
exit $status
}
proc tag {t} {
global tag
set tag $t
return
}
proc myexit {} {
tag ok
puts DONE
return
}
proc log {args} {
global tag
set newline 1
if {[lindex $args 0] eq "-nonewline"} {
set newline 0
set args [lrange $args 1 end]
}
if {[llength $args] == 2} {
lassign $args chan text
if {$chan ni {stdout stderr}} {
::_puts {*}[lrange [info level 0] 1 end]
return
}
} else {
set text [lindex $args 0]
set chan stdout
}
# chan <=> tag, if not overriden
if {[string match {Files left*} $text]} {
set tag warn
set text \n$text
}
if {$tag eq {}} { set tag $chan }
#::_puts $tag/$text
.t insert end-1c $text $tag
set tag {}
if {$newline} {
.t insert end-1c \n
}
update
return
}
proc +x {path} {
catch { file attributes $path -permissions u+x }
return
}
proc grep {file pattern} {
set lines [split [read [set chan [open $file r]]] \n]
close $chan
return [lsearch -all -inline -glob $lines $pattern]
}
proc version {file} {
set provisions [grep $file {*package provide*}]
#puts /$provisions/
return [lindex $provisions 0 3]
}
proc Hhelp {} { return "\n\tPrint this help" }
proc _help {} {
usage 0
return
}
proc Hrecipes {} { return "\n\tList all brew commands, without details." }
proc _recipes {} {
set r {}
foreach c [info commands _*] {
lappend r [string range $c 1 end]
}
puts [lsort -dict $r]
return
}
proc Hinstall {} { return "?destination? ?mode?\n\tInstall all packages, and application.\n\tdestination = path of package directory, default \[info library\].\n\tmode = Build mode, one of system, system-static, or local. Default is system." }
proc _install {{ldir {}} {mode {}}} {
global packages
if {$ldir eq {}} {
set ldir [info library]
set idir [file dirname [file dirname $ldir]]/include
} else {
set idir [file dirname $ldir]/include
}
# Create directories, might not exist.
file mkdir $idir
file mkdir $ldir
package require critcl::app
foreach p $packages {
set src [file dirname $::me]/$p.tcl
set version [version $src]
file delete -force [pwd]/BUILD
if {$mode eq {}} {
critcl::app::main [list -cache [pwd]/BUILD -libdir $ldir -includedir $idir -pkg $src]
} else {
critcl::app::main [list -with-mode $mode -cache [pwd]/BUILD -libdir $ldir -includedir $idir -pkg $src]
}
if {![file exists $ldir/$p]} {
set ::NOTE {warn {DONE, with FAILURES}}
break
}
file delete -force $ldir/$p$version
file rename $ldir/$p $ldir/$p$version
puts -nonewline "Installed package: "
tag ok
puts $ldir/$p$version
}
return
}
proc Hgui {} { return "\n\tInstall all packages, and application.\n\tDone from a small GUI." }
proc _gui {} {
global INSTALLPATH
package require Tk
package require widget::scrolledwindow
wm protocol . WM_DELETE_WINDOW ::_exit
label .l -text {Install Path: }
entry .e -textvariable ::INSTALLPATH
button .i -command Install -text Install
widget::scrolledwindow .st -borderwidth 1 -relief sunken
text .t
.st setwidget .t
.t tag configure stdout -font {Helvetica 8}
.t tag configure stderr -background red -font {Helvetica 12}
.t tag configure ok -background green -font {Helvetica 8}
.t tag configure warn -background yellow -font {Helvetica 12}
grid .l -row 0 -column 0 -sticky new
grid .e -row 0 -column 1 -sticky new
grid .i -row 0 -column 2 -sticky new
grid .st -row 1 -column 0 -sticky swen -columnspan 2
grid rowconfigure . 0 -weight 0
grid rowconfigure . 1 -weight 1
grid columnconfigure . 0 -weight 0
grid columnconfigure . 1 -weight 1
grid columnconfigure . 2 -weight 0
set INSTALLPATH [info library]
# Redirect all output into our log window, and disable uncontrolled exit.
rename ::puts ::_puts
rename ::log ::puts
rename ::exit ::_exit
rename ::myexit ::exit
# And start to interact with the user.
vwait forever
return
}
proc Install {} {
global INSTALLPATH NOTE
.i configure -state disabled
set NOTE {ok DONE}
set fail [catch {
_install $INSTALLPATH
puts ""
tag [lindex $NOTE 0]
puts [lindex $NOTE 1]
} e o]
.i configure -state normal
.i configure -command ::_exit -text Exit -bg green
if {$fail} {
# rethrow
return {*}$o $e
}
return
}
proc Hwrap4tea {} { return "?destination?\n\tGenerate a source package with TEA-based build system wrapped around critcl.\n\tdestination = path of source package directory, default is sub-directory 'tea' of the CWD." }
proc _wrap4tea {{dst {}}} {
global packages
if {[llength [info level 0]] < 2} {
set dst [file join [pwd] tea]
}
package require critcl::app
foreach p $packages {
set src [file dirname $::me]/$p.tcl
set version [version $src]
file delete -force [pwd]/BUILD
critcl::app::main [list -cache [pwd]/BUILD -libdir $dst -tea $src]
file delete -force $dst/$p$version
file rename $dst/$p $dst/$p$version
puts "Wrapped package: $dst/$p$version"
}
return
}
main