3
exec tclsh "$0" ${1+"$@"}
4
set me [file normalize [info script]]
5
set packages {selfcompanion}
7
global argv tcl_platform tag
9
if {![llength $argv]} {
10
if {$tcl_platform(platform) eq "windows"} {
21
proc usage {{status 1}} {
23
if {[info exists errorInfo] && ($errorInfo ne {}) &&
24
![string match {invalid command name "_*"*} $errorInfo]
26
puts stderr $::errorInfo
32
foreach c [lsort -dict [info commands _*]] {
33
set c [string range $c 1 end]
37
puts stderr "$prefix$argv0 $c args...\n"
39
puts stderr "$prefix$argv0 $c $res\n"
58
if {[lindex $args 0] eq "-nonewline"} {
60
set args [lrange $args 1 end]
62
if {[llength $args] == 2} {
63
lassign $args chan text
64
if {$chan ni {stdout stderr}} {
65
::_puts {*}[lrange [info level 0] 1 end]
69
set text [lindex $args 0]
72
# chan <=> tag, if not overriden
73
if {[string match {Files left*} $text]} {
77
if {$tag eq {}} { set tag $chan }
80
.t insert end-1c $text $tag
90
catch { file attributes $path -permissions u+x }
93
proc grep {file pattern} {
94
set lines [split [read [set chan [open $file r]]] \n]
96
return [lsearch -all -inline -glob $lines $pattern]
99
set provisions [grep $file {*package provide*}]
101
return [lindex $provisions 0 3]
103
proc Hhelp {} { return "\n\tPrint this help" }
108
proc Hrecipes {} { return "\n\tList all brew commands, without details." }
111
foreach c [info commands _*] {
112
lappend r [string range $c 1 end]
114
puts [lsort -dict $r]
117
proc Hinstall {} { return "?destination?\n\tInstall all packages, and application.\n\tdestination = path of package directory, default \[info library\]." }
118
proc _install {{ldir {}}} {
120
if {[llength [info level 0]] < 2} {
121
set ldir [info library]
122
set idir [file dirname [file dirname $ldir]]/include
124
set idir [file dirname $ldir]/include
127
# Create directories, might not exist.
131
package require critcl::app
133
foreach p $packages {
134
set src [file dirname $::me]/$p.tcl
135
set version [version $src]
137
file delete -force [pwd]/BUILD
138
critcl::app::main [list -cache [pwd]/BUILD -libdir $ldir -includedir $idir -pkg $src]
140
if {![file exists $ldir/$p]} {
141
set ::NOTE {warn {DONE, with FAILURES}}
145
file delete -force $ldir/$p$version
146
file rename $ldir/$p $ldir/$p$version
148
puts -nonewline "Installed package: "
150
puts $ldir/$p$version
154
proc Hdebug {} { return "?destination?\n\tInstall debug builds of all packages.\n\tdestination = path of package directory, default \[info library\]." }
155
proc _debug {{ldir {}}} {
157
if {[llength [info level 0]] < 2} {
158
set ldir [info library]
159
set idir [file dirname [file dirname $ldir]]/include
161
set idir [file dirname $ldir]/include
164
# Create directories, might not exist.
168
package require critcl::app
170
foreach p $packages {
171
set src [file dirname $::me]/$p.tcl
172
set version [version $src]
174
file delete -force [pwd]/BUILD.$p
175
critcl::app::main [list -cache [pwd]/BUILD.$p -keep -debug all -libdir $ldir -includedir $idir -pkg $src]
177
if {![file exists $ldir/$p]} {
178
set ::NOTE {warn {DONE, with FAILURES}}
182
file delete -force $ldir/$p$version
183
file rename $ldir/$p $ldir/$p$version
185
puts -nonewline "Installed package: "
187
puts $ldir/$p$version
191
proc Hgui {} { return "\n\tInstall all packages, and application.\n\tDone from a small GUI." }
195
package require widget::scrolledwindow
197
wm protocol . WM_DELETE_WINDOW ::_exit
199
label .l -text {Install Path: }
200
entry .e -textvariable ::INSTALLPATH
201
button .i -command Install -text Install
203
widget::scrolledwindow .st -borderwidth 1 -relief sunken
207
.t tag configure stdout -font {Helvetica 8}
208
.t tag configure stderr -background red -font {Helvetica 12}
209
.t tag configure ok -background green -font {Helvetica 8}
210
.t tag configure warn -background yellow -font {Helvetica 12}
212
grid .l -row 0 -column 0 -sticky new
213
grid .e -row 0 -column 1 -sticky new
214
grid .i -row 0 -column 2 -sticky new
215
grid .st -row 1 -column 0 -sticky swen -columnspan 2
217
grid rowconfigure . 0 -weight 0
218
grid rowconfigure . 1 -weight 1
220
grid columnconfigure . 0 -weight 0
221
grid columnconfigure . 1 -weight 1
222
grid columnconfigure . 2 -weight 0
224
set INSTALLPATH [info library]
226
# Redirect all output into our log window, and disable uncontrolled exit.
227
rename ::puts ::_puts
229
rename ::exit ::_exit
230
rename ::myexit ::exit
232
# And start to interact with the user.
237
global INSTALLPATH NOTE
238
.i configure -state disabled
242
_install $INSTALLPATH
246
puts [lindex $NOTE 1]
249
.i configure -state normal
250
.i configure -command ::_exit -text Exit -bg green
258
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." }
259
proc _wrap4tea {{dst {}}} {
262
if {[llength [info level 0]] < 2} {
263
set dst [file join [pwd] tea]
268
package require critcl::app
270
foreach p $packages {
271
set src [file dirname $::me]/$p.tcl
272
set version [version $src]
274
file delete -force [pwd]/BUILD
275
critcl::app::main [list -cache [pwd]/BUILD -libdir $dst -tea $src]
276
file delete -force $dst/$p$version
277
file rename $dst/$p $dst/$p$version
279
puts "Wrapped package: $dst/$p$version"