|
1
|
#!/bin/sh |
|
2
|
# Copyright (c) 2006-2011 WorkWare Systems http://www.workware.net.au/ |
|
3
|
# All rights reserved |
|
4
|
# vim:se syntax=tcl: |
|
5
|
# \ |
|
6
|
dir=`dirname "$0"`; exec "`$dir/autosetup-find-tclsh`" "$0" "$@" |
|
7
|
|
|
8
|
# Note that the version has a trailing + on unreleased versions |
|
9
|
set autosetup(version) 0.7.2 |
|
10
|
|
|
11
|
# Can be set to 1 to debug early-init problems |
|
12
|
set autosetup(debug) [expr {"--debug" in $argv}] |
|
13
|
|
|
14
|
################################################################## |
|
15
|
# |
|
16
|
# Main flow of control, option handling |
|
17
|
# |
|
18
|
proc main {argv} { |
|
19
|
global autosetup define |
|
20
|
|
|
21
|
# There are 3 potential directories involved: |
|
22
|
# 1. The directory containing autosetup (this script) |
|
23
|
# 2. The directory containing auto.def |
|
24
|
# 3. The current directory |
|
25
|
|
|
26
|
# From this we need to determine: |
|
27
|
# a. The path to this script (and related support files) |
|
28
|
# b. The path to auto.def |
|
29
|
# c. The build directory, where output files are created |
|
30
|
|
|
31
|
# This is also complicated by the fact that autosetup may |
|
32
|
# have been run via the configure wrapper ([getenv WRAPPER] is set) |
|
33
|
|
|
34
|
# Here are the rules. |
|
35
|
# a. This script is $::argv0 |
|
36
|
# => dir, prog, exe, libdir |
|
37
|
# b. auto.def is in the directory containing the configure wrapper, |
|
38
|
# otherwise it is in the current directory. |
|
39
|
# => srcdir, autodef |
|
40
|
# c. The build directory is the current directory |
|
41
|
# => builddir, [pwd] |
|
42
|
|
|
43
|
# 'misc' is needed before we can do anything, so set a temporary libdir |
|
44
|
# in case this is the development version |
|
45
|
set autosetup(libdir) [file dirname $::argv0]/lib |
|
46
|
use misc |
|
47
|
|
|
48
|
# (a) |
|
49
|
set autosetup(dir) [realdir [file dirname [realpath $::argv0]]] |
|
50
|
set autosetup(prog) [file join $autosetup(dir) [file tail $::argv0]] |
|
51
|
set autosetup(exe) [getenv WRAPPER $autosetup(prog)] |
|
52
|
if {$autosetup(installed)} { |
|
53
|
set autosetup(libdir) $autosetup(dir) |
|
54
|
} else { |
|
55
|
set autosetup(libdir) [file join $autosetup(dir) lib] |
|
56
|
} |
|
57
|
autosetup_add_dep $autosetup(prog) |
|
58
|
|
|
59
|
# (b) |
|
60
|
if {[getenv WRAPPER ""] eq ""} { |
|
61
|
# Invoked directly |
|
62
|
set autosetup(srcdir) [pwd] |
|
63
|
} else { |
|
64
|
# Invoked via the configure wrapper |
|
65
|
set autosetup(srcdir) [file-normalize [file dirname $autosetup(exe)]] |
|
66
|
} |
|
67
|
set autosetup(autodef) [relative-path $autosetup(srcdir)/auto.def] |
|
68
|
|
|
69
|
# (c) |
|
70
|
set autosetup(builddir) [pwd] |
|
71
|
|
|
72
|
set autosetup(argv) $argv |
|
73
|
set autosetup(cmdline) {} |
|
74
|
# options is a list of known options |
|
75
|
set autosetup(options) {} |
|
76
|
# optset is a dictionary of option values set by the user based on getopt |
|
77
|
set autosetup(optset) {} |
|
78
|
# optdefault is a dictionary of default values |
|
79
|
set autosetup(optdefault) {} |
|
80
|
# options-defaults is a dictionary of overrides for default values for options |
|
81
|
set autosetup(options-defaults) {} |
|
82
|
set autosetup(optionhelp) {} |
|
83
|
set autosetup(showhelp) 0 |
|
84
|
|
|
85
|
use util |
|
86
|
|
|
87
|
# Parse options |
|
88
|
use getopt |
|
89
|
|
|
90
|
# At the is point we don't know what is a valid option |
|
91
|
# We simply parse anything that looks like an option |
|
92
|
set autosetup(getopt) [getopt argv] |
|
93
|
|
|
94
|
#"=Core Options:" |
|
95
|
options-add { |
|
96
|
help:=all => "display help and options. Optional: module name, such as --help=system" |
|
97
|
licence license => "display the autosetup license" |
|
98
|
version => "display the version of autosetup" |
|
99
|
ref:=text manual:=text |
|
100
|
reference:=text => "display the autosetup command reference. 'text', 'wiki', 'asciidoc' or 'markdown'" |
|
101
|
debug => "display debugging output as autosetup runs" |
|
102
|
install:=. => "install autosetup to the current or given directory" |
|
103
|
} |
|
104
|
if {$autosetup(installed)} { |
|
105
|
# hidden options so we can produce a nice error |
|
106
|
options-add { |
|
107
|
sysinstall:path |
|
108
|
} |
|
109
|
} else { |
|
110
|
options-add { |
|
111
|
sysinstall:path => "install standalone autosetup to the given directory (e.g.: /usr/local)" |
|
112
|
} |
|
113
|
} |
|
114
|
options-add { |
|
115
|
force init:=help => "create initial auto.def, etc. Use --init=help for known types" |
|
116
|
# Undocumented options |
|
117
|
option-checking=1 |
|
118
|
nopager |
|
119
|
quiet |
|
120
|
timing |
|
121
|
conf: |
|
122
|
} |
|
123
|
|
|
124
|
if {[opt-bool version]} { |
|
125
|
puts $autosetup(version) |
|
126
|
exit 0 |
|
127
|
} |
|
128
|
|
|
129
|
# autosetup --conf=alternate-auto.def |
|
130
|
if {[opt-str conf o]} { |
|
131
|
set autosetup(autodef) $o |
|
132
|
} |
|
133
|
|
|
134
|
# Debugging output (set this early) |
|
135
|
incr autosetup(debug) [opt-bool debug] |
|
136
|
incr autosetup(force) [opt-bool force] |
|
137
|
incr autosetup(msg-quiet) [opt-bool quiet] |
|
138
|
incr autosetup(msg-timing) [opt-bool timing] |
|
139
|
|
|
140
|
# If the local module exists, source it now to allow for |
|
141
|
# project-local customisations |
|
142
|
if {[file exists $autosetup(libdir)/local.tcl]} { |
|
143
|
use local |
|
144
|
} |
|
145
|
|
|
146
|
# Now any auto-load modules |
|
147
|
autosetup_load_auto_modules |
|
148
|
|
|
149
|
if {[opt-str help o]} { |
|
150
|
incr autosetup(showhelp) |
|
151
|
use help |
|
152
|
autosetup_help $o |
|
153
|
} |
|
154
|
|
|
155
|
if {[opt-bool licence license]} { |
|
156
|
use help |
|
157
|
autosetup_show_license |
|
158
|
exit 0 |
|
159
|
} |
|
160
|
|
|
161
|
if {[opt-str {manual ref reference} o]} { |
|
162
|
use help |
|
163
|
autosetup_reference $o |
|
164
|
} |
|
165
|
|
|
166
|
# Allow combining --install and --init |
|
167
|
set earlyexit 0 |
|
168
|
if {[opt-str install o]} { |
|
169
|
use install |
|
170
|
autosetup_install $o |
|
171
|
incr earlyexit |
|
172
|
} |
|
173
|
|
|
174
|
if {[opt-str init o]} { |
|
175
|
use init |
|
176
|
autosetup_init $o |
|
177
|
incr earlyexit |
|
178
|
} |
|
179
|
|
|
180
|
if {$earlyexit} { |
|
181
|
exit 0 |
|
182
|
} |
|
183
|
if {[opt-str sysinstall o]} { |
|
184
|
use install |
|
185
|
autosetup_install $o 1 |
|
186
|
exit 0 |
|
187
|
} |
|
188
|
|
|
189
|
if {![file exists $autosetup(autodef)]} { |
|
190
|
# Check for invalid option first |
|
191
|
options {} |
|
192
|
user-error "No auto.def found in \"$autosetup(srcdir)\" (use [file tail $::autosetup(exe)] --init to create one)" |
|
193
|
} |
|
194
|
|
|
195
|
# Parse extra arguments into autosetup(cmdline) |
|
196
|
foreach arg $argv { |
|
197
|
if {[regexp {([^=]*)=(.*)} $arg -> n v]} { |
|
198
|
dict set autosetup(cmdline) $n $v |
|
199
|
define $n $v |
|
200
|
} else { |
|
201
|
user-error "Unexpected parameter: $arg" |
|
202
|
} |
|
203
|
} |
|
204
|
|
|
205
|
autosetup_add_dep $autosetup(autodef) |
|
206
|
|
|
207
|
# Add $argv to CONFIGURE_OPTS |
|
208
|
define-append-argv CONFIGURE_OPTS {*}$autosetup(argv) |
|
209
|
# Set up AUTOREMAKE to reconfigure with the same args |
|
210
|
define-append-argv AUTOREMAKE {*}$autosetup(exe) {*}$autosetup(argv) |
|
211
|
|
|
212
|
# Log how we were invoked |
|
213
|
configlog "Invoked as: [getenv WRAPPER $::argv0] [quote-argv $autosetup(argv)]" |
|
214
|
configlog "Tclsh: [info nameofexecutable]" |
|
215
|
|
|
216
|
# Load auto.def as module "auto.def" |
|
217
|
autosetup_load_module auto.def source $autosetup(autodef) |
|
218
|
|
|
219
|
# Could warn here if options {} was not specified |
|
220
|
|
|
221
|
show-notices |
|
222
|
|
|
223
|
if {$autosetup(debug)} { |
|
224
|
msg-result "Writing all defines to config.log" |
|
225
|
configlog "================ defines ======================" |
|
226
|
foreach n [lsort [array names define]] { |
|
227
|
configlog "define $n $define($n)" |
|
228
|
} |
|
229
|
} |
|
230
|
|
|
231
|
exit 0 |
|
232
|
} |
|
233
|
|
|
234
|
# @section Option Handling |
|
235
|
|
|
236
|
# @opt-bool ?-nodefault? option ... |
|
237
|
# |
|
238
|
# Check each of the named, boolean options and if any have been explicitly enabled |
|
239
|
# or disabled by the user, return 1 or 0 accordingly. |
|
240
|
# |
|
241
|
# If the option was specified more than once, the last value wins. |
|
242
|
# e.g. With '--enable-foo --disable-foo', '[opt-bool foo]' will return 0 |
|
243
|
# |
|
244
|
# If no value was specified by the user, returns the default value for the |
|
245
|
# first option. If '-nodefault' is given, this behaviour changes and |
|
246
|
# -1 is returned instead. |
|
247
|
# |
|
248
|
proc opt-bool {args} { |
|
249
|
set nodefault 0 |
|
250
|
if {[lindex $args 0] eq "-nodefault"} { |
|
251
|
set nodefault 1 |
|
252
|
set args [lrange $args 1 end] |
|
253
|
} |
|
254
|
option-check-names {*}$args |
|
255
|
|
|
256
|
foreach opt $args { |
|
257
|
if {[dict exists $::autosetup(optset) $opt]} { |
|
258
|
return [dict get $::autosetup(optset) $opt] |
|
259
|
} |
|
260
|
} |
|
261
|
|
|
262
|
if {$nodefault} { |
|
263
|
return -1 |
|
264
|
} |
|
265
|
# Default value is the default for the first option |
|
266
|
return [dict get $::autosetup(optdefault) [lindex $args 0]] |
|
267
|
} |
|
268
|
|
|
269
|
# @opt-val optionlist ?default=""? |
|
270
|
# |
|
271
|
# Returns a list containing all the values given for the non-boolean options in '$optionlist'. |
|
272
|
# There will be one entry in the list for each option given by the user, including if the |
|
273
|
# same option was used multiple times. |
|
274
|
# |
|
275
|
# If no options were set, '$default' is returned (exactly, not as a list). |
|
276
|
# |
|
277
|
# Note: For most use cases, 'opt-str' should be preferred. |
|
278
|
# |
|
279
|
proc opt-val {names {default ""}} { |
|
280
|
option-check-names {*}$names |
|
281
|
|
|
282
|
foreach opt $names { |
|
283
|
if {[dict exists $::autosetup(optset) $opt]} { |
|
284
|
lappend result {*}[dict get $::autosetup(optset) $opt] |
|
285
|
} |
|
286
|
} |
|
287
|
if {[info exists result]} { |
|
288
|
return $result |
|
289
|
} |
|
290
|
return $default |
|
291
|
} |
|
292
|
|
|
293
|
# @opt-str optionlist varname ?default? |
|
294
|
# |
|
295
|
# Sets '$varname' in the callers scope to the value for one of the given options. |
|
296
|
# |
|
297
|
# For the list of options given in '$optionlist', if any value is set for any option, |
|
298
|
# the option value is taken to be the *last* value of the last option (in the order given). |
|
299
|
# |
|
300
|
# If no option was given, and a default was specified with 'options-defaults', |
|
301
|
# that value is used. |
|
302
|
# |
|
303
|
# If no 'options-defaults' value was given and '$default' was given, it is used. |
|
304
|
# |
|
305
|
# If none of the above provided a value, no value is set. |
|
306
|
# |
|
307
|
# The return value depends on whether '$default' was specified. |
|
308
|
# If it was, the option value is returned. |
|
309
|
# If it was not, 1 is returns if a value was set, or 0 if not. |
|
310
|
# |
|
311
|
# Typical usage is as follows: |
|
312
|
# |
|
313
|
## if {[opt-str {myopt altname} o]} { |
|
314
|
## do something with $o |
|
315
|
## } |
|
316
|
# |
|
317
|
# Or: |
|
318
|
## define myname [opt-str {myopt altname} o "/usr/local"] |
|
319
|
# |
|
320
|
proc opt-str {names varname args} { |
|
321
|
global autosetup |
|
322
|
|
|
323
|
option-check-names {*}$names |
|
324
|
upvar $varname value |
|
325
|
|
|
326
|
if {[llength $args]} { |
|
327
|
# A default was given, so always return the string value of the option |
|
328
|
set default [lindex $args 0] |
|
329
|
set retopt 1 |
|
330
|
} else { |
|
331
|
# No default, so return 0 or 1 to indicate if a value was found |
|
332
|
set retopt 0 |
|
333
|
} |
|
334
|
|
|
335
|
foreach opt $names { |
|
336
|
if {[dict exists $::autosetup(optset) $opt]} { |
|
337
|
set result [lindex [dict get $::autosetup(optset) $opt] end] |
|
338
|
} |
|
339
|
} |
|
340
|
|
|
341
|
if {![info exists result]} { |
|
342
|
# No user-specified value. Has options-defaults been set? |
|
343
|
foreach opt $names { |
|
344
|
if {[dict exists $::autosetup(optdefault) $opt]} { |
|
345
|
set result [dict get $autosetup(optdefault) $opt] |
|
346
|
} |
|
347
|
} |
|
348
|
} |
|
349
|
|
|
350
|
if {[info exists result]} { |
|
351
|
set value $result |
|
352
|
if {$retopt} { |
|
353
|
return $value |
|
354
|
} |
|
355
|
return 1 |
|
356
|
} |
|
357
|
|
|
358
|
if {$retopt} { |
|
359
|
set value $default |
|
360
|
return $value |
|
361
|
} |
|
362
|
|
|
363
|
return 0 |
|
364
|
} |
|
365
|
|
|
366
|
proc option-check-names {args} { |
|
367
|
foreach o $args { |
|
368
|
if {$o ni $::autosetup(options)} { |
|
369
|
autosetup-error "Request for undeclared option --$o" |
|
370
|
} |
|
371
|
} |
|
372
|
} |
|
373
|
|
|
374
|
# Parse the option definition in $opts and update |
|
375
|
# ::autosetup(setoptions) and ::autosetup(optionhelp) appropriately |
|
376
|
# |
|
377
|
proc options-add {opts} { |
|
378
|
global autosetup |
|
379
|
|
|
380
|
# First weed out comment lines |
|
381
|
set realopts {} |
|
382
|
foreach line [split $opts \n] { |
|
383
|
if {![string match "#*" [string trimleft $line]]} { |
|
384
|
append realopts $line \n |
|
385
|
} |
|
386
|
} |
|
387
|
set opts $realopts |
|
388
|
|
|
389
|
for {set i 0} {$i < [llength $opts]} {incr i} { |
|
390
|
set opt [lindex $opts $i] |
|
391
|
if {[string match =* $opt]} { |
|
392
|
# This is a special heading |
|
393
|
lappend autosetup(optionhelp) [list $opt $autosetup(module)] |
|
394
|
continue |
|
395
|
} |
|
396
|
unset -nocomplain defaultvalue equal value |
|
397
|
|
|
398
|
#puts "i=$i, opt=$opt" |
|
399
|
regexp {^([^:=]*)(:)?(=)?(.*)$} $opt -> name colon equal value |
|
400
|
if {$name in $autosetup(options)} { |
|
401
|
autosetup-error "Option $name already specified" |
|
402
|
} |
|
403
|
|
|
404
|
#puts "$opt => $name $colon $equal $value" |
|
405
|
|
|
406
|
# Find the corresponding value in the user options |
|
407
|
# and set the default if necessary |
|
408
|
if {[string match "-*" $opt]} { |
|
409
|
# This is a documentation-only option, like "-C <dir>" |
|
410
|
set opthelp $opt |
|
411
|
} elseif {$colon eq ""} { |
|
412
|
# Boolean option |
|
413
|
lappend autosetup(options) $name |
|
414
|
|
|
415
|
# Check for override |
|
416
|
if {[dict exists $autosetup(options-defaults) $name]} { |
|
417
|
# A default was specified with options-defaults, so use it |
|
418
|
set value [dict get $autosetup(options-defaults) $name] |
|
419
|
} |
|
420
|
|
|
421
|
if {$value eq "1"} { |
|
422
|
set opthelp "--disable-$name" |
|
423
|
} else { |
|
424
|
set opthelp "--$name" |
|
425
|
} |
|
426
|
|
|
427
|
# Set the default |
|
428
|
if {$value eq ""} { |
|
429
|
set value 0 |
|
430
|
} |
|
431
|
set defaultvalue $value |
|
432
|
dict set autosetup(optdefault) $name $defaultvalue |
|
433
|
|
|
434
|
if {[dict exists $autosetup(getopt) $name]} { |
|
435
|
# The option was specified by the user. Look at the last value. |
|
436
|
lassign [lindex [dict get $autosetup(getopt) $name] end] type setvalue |
|
437
|
if {$type eq "str"} { |
|
438
|
# Can we convert the value to a boolean? |
|
439
|
if {$setvalue in {1 enabled yes}} { |
|
440
|
set setvalue 1 |
|
441
|
} elseif {$setvalue in {0 disabled no}} { |
|
442
|
set setvalue 0 |
|
443
|
} else { |
|
444
|
user-error "Boolean option $name given as --$name=$setvalue" |
|
445
|
} |
|
446
|
} |
|
447
|
dict set autosetup(optset) $name $setvalue |
|
448
|
#puts "Found boolean option --$name=$setvalue" |
|
449
|
} |
|
450
|
} else { |
|
451
|
# String option. |
|
452
|
lappend autosetup(options) $name |
|
453
|
|
|
454
|
if {$equal ne "="} { |
|
455
|
# Was the option given as "name:value=default"? |
|
456
|
# If so, set $value to the display name and $defaultvalue to the default |
|
457
|
# (This is the preferred way to set a default value for a string option) |
|
458
|
if {[regexp {^([^=]+)=(.*)$} $value -> value defaultvalue]} { |
|
459
|
dict set autosetup(optdefault) $name $defaultvalue |
|
460
|
} |
|
461
|
} |
|
462
|
|
|
463
|
# Maybe override the default value |
|
464
|
if {[dict exists $autosetup(options-defaults) $name]} { |
|
465
|
# A default was specified with options-defaults, so use it |
|
466
|
set defaultvalue [dict get $autosetup(options-defaults) $name] |
|
467
|
dict set autosetup(optdefault) $name $defaultvalue |
|
468
|
} elseif {![info exists defaultvalue]} { |
|
469
|
# No default value was given by value=default or options-defaults |
|
470
|
# so use the value as the default when the plain option with no |
|
471
|
# value is given (.e.g. just --opt instead of --opt=value) |
|
472
|
set defaultvalue $value |
|
473
|
} |
|
474
|
|
|
475
|
if {$equal eq "="} { |
|
476
|
# String option with optional value |
|
477
|
set opthelp "--$name?=$value?" |
|
478
|
} else { |
|
479
|
# String option with required value |
|
480
|
set opthelp "--$name=$value" |
|
481
|
} |
|
482
|
|
|
483
|
# Get the values specified by the user |
|
484
|
if {[dict exists $autosetup(getopt) $name]} { |
|
485
|
set listvalue {} |
|
486
|
|
|
487
|
foreach pair [dict get $autosetup(getopt) $name] { |
|
488
|
lassign $pair type setvalue |
|
489
|
if {$type eq "bool" && $setvalue} { |
|
490
|
if {$equal ne "="} { |
|
491
|
user-error "Option --$name requires a value" |
|
492
|
} |
|
493
|
# If given as a boolean, use the default value |
|
494
|
set setvalue $defaultvalue |
|
495
|
} |
|
496
|
lappend listvalue $setvalue |
|
497
|
} |
|
498
|
|
|
499
|
#puts "Found string option --$name=$listvalue" |
|
500
|
dict set autosetup(optset) $name $listvalue |
|
501
|
} |
|
502
|
} |
|
503
|
|
|
504
|
# Now create the help for this option if appropriate |
|
505
|
if {[lindex $opts $i+1] eq "=>"} { |
|
506
|
set desc [lindex $opts $i+2] |
|
507
|
if {[info exists defaultvalue]} { |
|
508
|
set desc [string map [list @default@ $defaultvalue] $desc] |
|
509
|
} |
|
510
|
# A multi-line description |
|
511
|
lappend autosetup(optionhelp) [list $opthelp $autosetup(module) $desc] |
|
512
|
incr i 2 |
|
513
|
} |
|
514
|
} |
|
515
|
} |
|
516
|
|
|
517
|
# @module-options optionlist |
|
518
|
# |
|
519
|
# Deprecated. Simply use 'options' from within a module. |
|
520
|
proc module-options {opts} { |
|
521
|
options $opts |
|
522
|
} |
|
523
|
|
|
524
|
proc max {a b} { |
|
525
|
expr {$a > $b ? $a : $b} |
|
526
|
} |
|
527
|
|
|
528
|
proc options-wrap-desc {text length firstprefix nextprefix initial} { |
|
529
|
set len $initial |
|
530
|
set space $firstprefix |
|
531
|
foreach word [split $text] { |
|
532
|
set word [string trim $word] |
|
533
|
if {$word == ""} { |
|
534
|
continue |
|
535
|
} |
|
536
|
if {$len && [string length $space$word] + $len >= $length} { |
|
537
|
puts "" |
|
538
|
set len 0 |
|
539
|
set space $nextprefix |
|
540
|
} |
|
541
|
incr len [string length $space$word] |
|
542
|
puts -nonewline $space$word |
|
543
|
set space " " |
|
544
|
} |
|
545
|
if {$len} { |
|
546
|
puts "" |
|
547
|
} |
|
548
|
} |
|
549
|
|
|
550
|
# Display options (from $autosetup(optionhelp)) for modules that match |
|
551
|
# glob pattern $what |
|
552
|
proc options-show {what} { |
|
553
|
set local 0 |
|
554
|
# Determine the max option width |
|
555
|
set max 0 |
|
556
|
foreach help $::autosetup(optionhelp) { |
|
557
|
lassign $help opt module desc |
|
558
|
if {![string match $what $module]} { |
|
559
|
continue |
|
560
|
} |
|
561
|
if {[string match =* $opt] || [string match \n* $desc]} { |
|
562
|
continue |
|
563
|
} |
|
564
|
set max [max $max [string length $opt]] |
|
565
|
} |
|
566
|
set indent [string repeat " " [expr {$max+4}]] |
|
567
|
set cols [getenv COLUMNS 80] |
|
568
|
catch { |
|
569
|
lassign [exec stty size] _ sttycols |
|
570
|
if {[string is integer -strict $sttycols]} { |
|
571
|
set cols $sttycols |
|
572
|
} |
|
573
|
} |
|
574
|
incr cols -1 |
|
575
|
# Now output |
|
576
|
foreach help $::autosetup(optionhelp) { |
|
577
|
lassign $help opt module desc |
|
578
|
if {![string match $what $module]} { |
|
579
|
continue |
|
580
|
} |
|
581
|
if {$local == 0 && $module eq "auto.def"} { |
|
582
|
puts "Local Options:" |
|
583
|
incr local |
|
584
|
} |
|
585
|
if {[string match =* $opt]} { |
|
586
|
# Output a special heading line" |
|
587
|
puts [string range $opt 1 end] |
|
588
|
continue |
|
589
|
} |
|
590
|
puts -nonewline " [format %-${max}s $opt]" |
|
591
|
if {[string match \n* $desc]} { |
|
592
|
# Output a pre-formatted help description as-is |
|
593
|
puts $desc |
|
594
|
} else { |
|
595
|
options-wrap-desc [string trim $desc] $cols " " $indent [expr {$max+2}] |
|
596
|
} |
|
597
|
} |
|
598
|
} |
|
599
|
|
|
600
|
# @options optionspec |
|
601
|
# |
|
602
|
# Specifies configuration-time options which may be selected by the user |
|
603
|
# and checked with 'opt-str' and 'opt-bool'. '$optionspec' contains a series |
|
604
|
# of options specifications separated by newlines, as follows: |
|
605
|
# |
|
606
|
# A boolean option is of the form: |
|
607
|
# |
|
608
|
## name[=0|1] => "Description of this boolean option" |
|
609
|
# |
|
610
|
# The default is 'name=0', meaning that the option is disabled by default. |
|
611
|
# If 'name=1' is used to make the option enabled by default, the description should reflect |
|
612
|
# that with text like "Disable support for ...". |
|
613
|
# |
|
614
|
# An argument option (one which takes a parameter) is of one of the following forms: |
|
615
|
# |
|
616
|
## name:value => "Description of this option" |
|
617
|
## name:value=default => "Description of this option with a default value" |
|
618
|
## name:=value => "Description of this option with an optional value" |
|
619
|
# |
|
620
|
# If the 'name:value' form is used, the value must be provided with the option (as '--name=myvalue'). |
|
621
|
# If the 'name:value=default' form is used, the option has the given default value even if not |
|
622
|
# specified by the user. |
|
623
|
# If the 'name:=value' form is used, the value is optional and the given value is used |
|
624
|
# if it is not provided. |
|
625
|
# |
|
626
|
# The description may contain '@default@', in which case it will be replaced with the default |
|
627
|
# value for the option (taking into account defaults specified with 'options-defaults'. |
|
628
|
# |
|
629
|
# Undocumented options are also supported by omitting the '=> description'. |
|
630
|
# These options are not displayed with '--help' and can be useful for internal options or as aliases. |
|
631
|
# |
|
632
|
# For example, '--disable-lfs' is an alias for '--disable=largefile': |
|
633
|
# |
|
634
|
## lfs=1 largefile=1 => "Disable large file support" |
|
635
|
# |
|
636
|
proc options {optlist} { |
|
637
|
global autosetup |
|
638
|
|
|
639
|
options-add $optlist |
|
640
|
|
|
641
|
if {$autosetup(showhelp)} { |
|
642
|
# If --help, stop now to show help |
|
643
|
return -code break |
|
644
|
} |
|
645
|
|
|
646
|
if {$autosetup(module) eq "auto.def"} { |
|
647
|
# Check for invalid options |
|
648
|
if {[opt-bool option-checking]} { |
|
649
|
foreach o [dict keys $::autosetup(getopt)] { |
|
650
|
if {$o ni $::autosetup(options)} { |
|
651
|
user-error "Unknown option --$o" |
|
652
|
} |
|
653
|
} |
|
654
|
} |
|
655
|
} |
|
656
|
} |
|
657
|
|
|
658
|
# @options-defaults dictionary |
|
659
|
# |
|
660
|
# Specifies a dictionary of options and a new default value for each of those options. |
|
661
|
# Use before any 'use' statements in 'auto.def' to change the defaults for |
|
662
|
# subsequently included modules. |
|
663
|
proc options-defaults {dict} { |
|
664
|
foreach {n v} $dict { |
|
665
|
dict set ::autosetup(options-defaults) $n $v |
|
666
|
} |
|
667
|
} |
|
668
|
|
|
669
|
proc config_guess {} { |
|
670
|
if {[file-isexec $::autosetup(dir)/autosetup-config.guess]} { |
|
671
|
if {[catch {exec-with-stderr sh $::autosetup(dir)/autosetup-config.guess} alias]} { |
|
672
|
user-error $alias |
|
673
|
} |
|
674
|
return $alias |
|
675
|
} else { |
|
676
|
configlog "No autosetup-config.guess, so using uname" |
|
677
|
string tolower [exec uname -p]-unknown-[exec uname -s][exec uname -r] |
|
678
|
} |
|
679
|
} |
|
680
|
|
|
681
|
proc config_sub {alias} { |
|
682
|
if {[file-isexec $::autosetup(dir)/autosetup-config.sub]} { |
|
683
|
if {[catch {exec-with-stderr sh $::autosetup(dir)/autosetup-config.sub $alias} alias]} { |
|
684
|
user-error $alias |
|
685
|
} |
|
686
|
} |
|
687
|
return $alias |
|
688
|
} |
|
689
|
|
|
690
|
# @section Variable Definitions (defines) |
|
691
|
|
|
692
|
# @define name ?value=1? |
|
693
|
# |
|
694
|
# Defines the named variable to the given value. |
|
695
|
# These (name, value) pairs represent the results of the configuration check |
|
696
|
# and are available to be subsequently checked, modified and substituted. |
|
697
|
# |
|
698
|
proc define {name {value 1}} { |
|
699
|
set ::define($name) $value |
|
700
|
#dputs "$name <= $value" |
|
701
|
} |
|
702
|
|
|
703
|
# @define-push {name ...} script |
|
704
|
# |
|
705
|
# Save the values of the given defines, evaluation the script, then restore. |
|
706
|
# For example, to avoid updating AS_FLAGS and AS_CXXFLAGS: |
|
707
|
## define-push {AS_CFLAGS AS_CXXFLAGS} { |
|
708
|
## cc-check-flags -Wno-error |
|
709
|
## } |
|
710
|
proc define-push {names script} { |
|
711
|
array set unset {} |
|
712
|
foreach name $names { |
|
713
|
if {[is-defined $name]} { |
|
714
|
set save($name) [get-define $name] |
|
715
|
} else { |
|
716
|
set unset($name) 1 |
|
717
|
} |
|
718
|
} |
|
719
|
uplevel 1 $script |
|
720
|
array set ::define [array get save] |
|
721
|
foreach name [array names unset] { |
|
722
|
unset -nocomplain ::define($name) |
|
723
|
} |
|
724
|
} |
|
725
|
|
|
726
|
# @undefine name |
|
727
|
# |
|
728
|
# Undefine the named variable. |
|
729
|
# |
|
730
|
proc undefine {name} { |
|
731
|
unset -nocomplain ::define($name) |
|
732
|
#dputs "$name <= <undef>" |
|
733
|
} |
|
734
|
|
|
735
|
# @define-append name value ... |
|
736
|
# |
|
737
|
# Appends the given value(s) to the given "defined" variable. |
|
738
|
# If the variable is not defined or empty, it is set to '$value'. |
|
739
|
# Otherwise the value is appended, separated by a space. |
|
740
|
# Any extra values are similarly appended. |
|
741
|
# |
|
742
|
# Note that define-append is not designed to add values containing spaces. |
|
743
|
# If values may contain spaces, consider define-append-argv instead. |
|
744
|
# |
|
745
|
proc define-append {name args} { |
|
746
|
if {[get-define $name ""] ne ""} { |
|
747
|
foreach arg $args { |
|
748
|
if {$arg eq ""} { |
|
749
|
continue |
|
750
|
} |
|
751
|
append ::define($name) " " $arg |
|
752
|
} |
|
753
|
} else { |
|
754
|
set ::define($name) [join $args] |
|
755
|
} |
|
756
|
#dputs "$name += [join $args] => $::define($name)" |
|
757
|
} |
|
758
|
|
|
759
|
# @define-append-argv name value ... |
|
760
|
# |
|
761
|
# Similar to define-append except designed to construct shell command |
|
762
|
# lines, including correct handling of parameters with spaces. |
|
763
|
# |
|
764
|
# Each non-empty value is quoted if necessary and then appended to the given variable |
|
765
|
# if it does not already exist. |
|
766
|
# |
|
767
|
proc define-append-argv {name args} { |
|
768
|
set seen {} |
|
769
|
set new {} |
|
770
|
foreach val [list {*}[get-define $name ""] {*}$args] { |
|
771
|
if {$val ne {} && ![dict exists $seen $val]} { |
|
772
|
lappend new [quote-if-needed $val] |
|
773
|
dict set seen $val 1 |
|
774
|
} |
|
775
|
} |
|
776
|
set ::define($name) [join $new " "] |
|
777
|
#dputs "$name += [join $args] => $::define($name)" |
|
778
|
} |
|
779
|
|
|
780
|
# @get-define name ?default=0? |
|
781
|
# |
|
782
|
# Returns the current value of the "defined" variable, or '$default' |
|
783
|
# if not set. |
|
784
|
# |
|
785
|
proc get-define {name {default 0}} { |
|
786
|
if {[info exists ::define($name)]} { |
|
787
|
#dputs "$name => $::define($name)" |
|
788
|
return $::define($name) |
|
789
|
} |
|
790
|
#dputs "$name => $default" |
|
791
|
return $default |
|
792
|
} |
|
793
|
|
|
794
|
# @is-defined name |
|
795
|
# |
|
796
|
# Returns 1 if the given variable is defined. |
|
797
|
# |
|
798
|
proc is-defined {name} { |
|
799
|
info exists ::define($name) |
|
800
|
} |
|
801
|
|
|
802
|
# @is-define-set name |
|
803
|
# |
|
804
|
# Returns 1 if the given variable is defined and is set |
|
805
|
# to a value other than "" or 0 |
|
806
|
# |
|
807
|
proc is-define-set {name} { |
|
808
|
if {[get-define $name] in {0 ""}} { |
|
809
|
return 0 |
|
810
|
} |
|
811
|
return 1 |
|
812
|
} |
|
813
|
|
|
814
|
# @all-defines |
|
815
|
# |
|
816
|
# Returns a dictionary (name, value list) of all defined variables. |
|
817
|
# |
|
818
|
# This is suitable for use with 'dict', 'array set' or 'foreach' |
|
819
|
# and allows for arbitrary processing of the defined variables. |
|
820
|
# |
|
821
|
proc all-defines {} { |
|
822
|
array get ::define |
|
823
|
} |
|
824
|
|
|
825
|
# @section Environment/Helpers |
|
826
|
|
|
827
|
# @get-env name default |
|
828
|
# |
|
829
|
# If '$name' was specified on the command line, return it. |
|
830
|
# Otherwise if '$name' was set in the environment, return it. |
|
831
|
# Otherwise return '$default'. |
|
832
|
# |
|
833
|
proc get-env {name default} { |
|
834
|
if {[dict exists $::autosetup(cmdline) $name]} { |
|
835
|
return [dict get $::autosetup(cmdline) $name] |
|
836
|
} |
|
837
|
getenv $name $default |
|
838
|
} |
|
839
|
|
|
840
|
# @env-is-set name |
|
841
|
# |
|
842
|
# Returns 1 if '$name' was specified on the command line or in the environment. |
|
843
|
# Note that an empty environment variable is not considered to be set. |
|
844
|
# |
|
845
|
proc env-is-set {name} { |
|
846
|
if {[dict exists $::autosetup(cmdline) $name]} { |
|
847
|
return 1 |
|
848
|
} |
|
849
|
if {[getenv $name ""] ne ""} { |
|
850
|
return 1 |
|
851
|
} |
|
852
|
return 0 |
|
853
|
} |
|
854
|
|
|
855
|
# @readfile filename ?default=""? |
|
856
|
# |
|
857
|
# Return the contents of the file, without the trailing newline. |
|
858
|
# If the file doesn't exist or can't be read, returns '$default'. |
|
859
|
# |
|
860
|
proc readfile {filename {default_value ""}} { |
|
861
|
set result $default_value |
|
862
|
catch { |
|
863
|
set f [open $filename] |
|
864
|
set result [read -nonewline $f] |
|
865
|
close $f |
|
866
|
} |
|
867
|
return $result |
|
868
|
} |
|
869
|
|
|
870
|
# @writefile filename value |
|
871
|
# |
|
872
|
# Creates the given file containing '$value'. |
|
873
|
# Does not add an extra newline. |
|
874
|
# |
|
875
|
proc writefile {filename value} { |
|
876
|
set f [open $filename w] |
|
877
|
puts -nonewline $f $value |
|
878
|
close $f |
|
879
|
} |
|
880
|
|
|
881
|
proc quote-if-needed {str} { |
|
882
|
if {[string match {*[\" ]*} $str]} { |
|
883
|
return \"[string map [list \" \\" \\ \\\\] $str]\" |
|
884
|
} |
|
885
|
return $str |
|
886
|
} |
|
887
|
|
|
888
|
proc quote-argv {argv} { |
|
889
|
set args {} |
|
890
|
foreach arg $argv { |
|
891
|
lappend args [quote-if-needed $arg] |
|
892
|
} |
|
893
|
join $args |
|
894
|
} |
|
895
|
|
|
896
|
# @list-non-empty list |
|
897
|
# |
|
898
|
# Returns a copy of the given list with empty elements removed |
|
899
|
proc list-non-empty {list} { |
|
900
|
set result {} |
|
901
|
foreach p $list { |
|
902
|
if {$p ne ""} { |
|
903
|
lappend result $p |
|
904
|
} |
|
905
|
} |
|
906
|
return $result |
|
907
|
} |
|
908
|
|
|
909
|
# @section Paths, Searching |
|
910
|
|
|
911
|
# @find-executable-path name |
|
912
|
# |
|
913
|
# Searches the path for an executable with the given name. |
|
914
|
# Note that the name may include some parameters, e.g. 'cc -mbig-endian', |
|
915
|
# in which case the parameters are ignored. |
|
916
|
# Returns the full path to the executable if found, or "" if not found. |
|
917
|
# |
|
918
|
proc find-executable-path {name} { |
|
919
|
# Ignore any parameters |
|
920
|
set name [lindex $name 0] |
|
921
|
# The empty string is never a valid executable |
|
922
|
if {$name ne ""} { |
|
923
|
foreach p [split-path] { |
|
924
|
dputs "Looking for $name in $p" |
|
925
|
set exec [file join $p $name] |
|
926
|
if {[file-isexec $exec]} { |
|
927
|
dputs "Found $name -> $exec" |
|
928
|
return $exec |
|
929
|
} |
|
930
|
} |
|
931
|
} |
|
932
|
return {} |
|
933
|
} |
|
934
|
|
|
935
|
# @find-executable name |
|
936
|
# |
|
937
|
# Searches the path for an executable with the given name. |
|
938
|
# Note that the name may include some parameters, e.g. 'cc -mbig-endian', |
|
939
|
# in which case the parameters are ignored. |
|
940
|
# Returns 1 if found, or 0 if not. |
|
941
|
# |
|
942
|
proc find-executable {name} { |
|
943
|
if {[find-executable-path $name] eq {}} { |
|
944
|
return 0 |
|
945
|
} |
|
946
|
return 1 |
|
947
|
} |
|
948
|
|
|
949
|
# @find-an-executable ?-required? name ... |
|
950
|
# |
|
951
|
# Given a list of possible executable names, |
|
952
|
# searches for one of these on the path. |
|
953
|
# |
|
954
|
# Returns the name found, or "" if none found. |
|
955
|
# If the first parameter is '-required', an error is generated |
|
956
|
# if no executable is found. |
|
957
|
# |
|
958
|
proc find-an-executable {args} { |
|
959
|
set required 0 |
|
960
|
if {[lindex $args 0] eq "-required"} { |
|
961
|
set args [lrange $args 1 end] |
|
962
|
incr required |
|
963
|
} |
|
964
|
foreach name $args { |
|
965
|
if {[find-executable $name]} { |
|
966
|
return $name |
|
967
|
} |
|
968
|
} |
|
969
|
if {$required} { |
|
970
|
if {[llength $args] == 1} { |
|
971
|
user-error "failed to find: [join $args]" |
|
972
|
} else { |
|
973
|
user-error "failed to find one of: [join $args]" |
|
974
|
} |
|
975
|
} |
|
976
|
return "" |
|
977
|
} |
|
978
|
|
|
979
|
# @section Logging, Messages and Errors |
|
980
|
|
|
981
|
# @configlog msg |
|
982
|
# |
|
983
|
# Writes the given message to the configuration log, 'config.log'. |
|
984
|
# |
|
985
|
proc configlog {msg} { |
|
986
|
if {![info exists ::autosetup(logfh)]} { |
|
987
|
set ::autosetup(logfh) [open config.log w] |
|
988
|
} |
|
989
|
puts $::autosetup(logfh) $msg |
|
990
|
} |
|
991
|
|
|
992
|
# @msg-checking msg |
|
993
|
# |
|
994
|
# Writes the message with no newline to stdout. |
|
995
|
# |
|
996
|
proc msg-checking {msg} { |
|
997
|
if {$::autosetup(msg-quiet) == 0} { |
|
998
|
maybe-show-timestamp |
|
999
|
puts -nonewline $msg |
|
1000
|
set ::autosetup(msg-checking) 1 |
|
1001
|
} |
|
1002
|
} |
|
1003
|
|
|
1004
|
# @msg-result msg |
|
1005
|
# |
|
1006
|
# Writes the message to stdout. |
|
1007
|
# |
|
1008
|
proc msg-result {msg} { |
|
1009
|
if {$::autosetup(msg-quiet) == 0} { |
|
1010
|
maybe-show-timestamp |
|
1011
|
puts $msg |
|
1012
|
set ::autosetup(msg-checking) 0 |
|
1013
|
show-notices |
|
1014
|
} |
|
1015
|
} |
|
1016
|
|
|
1017
|
# @msg-quiet command ... |
|
1018
|
# |
|
1019
|
# 'msg-quiet' evaluates it's arguments as a command with output |
|
1020
|
# from 'msg-checking' and 'msg-result' suppressed. |
|
1021
|
# |
|
1022
|
# This is useful if a check needs to run a subcheck which isn't |
|
1023
|
# of interest to the user. |
|
1024
|
proc msg-quiet {args} { |
|
1025
|
incr ::autosetup(msg-quiet) |
|
1026
|
set rc [uplevel 1 $args] |
|
1027
|
incr ::autosetup(msg-quiet) -1 |
|
1028
|
return $rc |
|
1029
|
} |
|
1030
|
|
|
1031
|
# Will be overridden by 'use misc' |
|
1032
|
proc error-stacktrace {msg} { |
|
1033
|
return $msg |
|
1034
|
} |
|
1035
|
|
|
1036
|
proc error-location {msg} { |
|
1037
|
return $msg |
|
1038
|
} |
|
1039
|
|
|
1040
|
################################################################## |
|
1041
|
# |
|
1042
|
# Debugging output |
|
1043
|
# |
|
1044
|
proc dputs {msg} { |
|
1045
|
if {$::autosetup(debug)} { |
|
1046
|
puts $msg |
|
1047
|
} |
|
1048
|
} |
|
1049
|
|
|
1050
|
################################################################## |
|
1051
|
# |
|
1052
|
# User and system warnings and errors |
|
1053
|
# |
|
1054
|
# Usage errors such as wrong command line options |
|
1055
|
|
|
1056
|
# @user-error msg |
|
1057
|
# |
|
1058
|
# Indicate incorrect usage to the user, including if required components |
|
1059
|
# or features are not found. |
|
1060
|
# 'autosetup' exits with a non-zero return code. |
|
1061
|
# |
|
1062
|
proc user-error {msg} { |
|
1063
|
show-notices |
|
1064
|
puts stderr "Error: $msg" |
|
1065
|
puts stderr "Try: '[file tail $::autosetup(exe)] --help' for options" |
|
1066
|
exit 1 |
|
1067
|
} |
|
1068
|
|
|
1069
|
# @user-notice msg |
|
1070
|
# |
|
1071
|
# Output the given message to stderr. |
|
1072
|
# |
|
1073
|
proc user-notice {msg} { |
|
1074
|
lappend ::autosetup(notices) $msg |
|
1075
|
} |
|
1076
|
|
|
1077
|
# Incorrect usage in the auto.def file. Identify the location. |
|
1078
|
proc autosetup-error {msg} { |
|
1079
|
autosetup-full-error [error-location $msg] |
|
1080
|
} |
|
1081
|
|
|
1082
|
# Like autosetup-error, except $msg is the full error message. |
|
1083
|
proc autosetup-full-error {msg} { |
|
1084
|
show-notices |
|
1085
|
puts stderr $msg |
|
1086
|
exit 1 |
|
1087
|
} |
|
1088
|
|
|
1089
|
proc show-notices {} { |
|
1090
|
if {$::autosetup(msg-checking)} { |
|
1091
|
puts "" |
|
1092
|
set ::autosetup(msg-checking) 0 |
|
1093
|
} |
|
1094
|
flush stdout |
|
1095
|
if {[info exists ::autosetup(notices)]} { |
|
1096
|
puts stderr [join $::autosetup(notices) \n] |
|
1097
|
unset ::autosetup(notices) |
|
1098
|
} |
|
1099
|
} |
|
1100
|
|
|
1101
|
proc maybe-show-timestamp {} { |
|
1102
|
if {$::autosetup(msg-timing) && $::autosetup(msg-checking) == 0} { |
|
1103
|
puts -nonewline [format {[%6.2f] } [expr {([clock millis] - $::autosetup(start)) % 10000 / 1000.0}]] |
|
1104
|
} |
|
1105
|
} |
|
1106
|
|
|
1107
|
# @autosetup-require-version required |
|
1108
|
# |
|
1109
|
# Checks the current version of 'autosetup' against '$required'. |
|
1110
|
# A fatal error is generated if the current version is less than that required. |
|
1111
|
# |
|
1112
|
proc autosetup-require-version {required} { |
|
1113
|
if {[compare-versions $::autosetup(version) $required] < 0} { |
|
1114
|
user-error "autosetup version $required is required, but this is $::autosetup(version)" |
|
1115
|
} |
|
1116
|
} |
|
1117
|
|
|
1118
|
proc autosetup_version {} { |
|
1119
|
return "autosetup v$::autosetup(version)" |
|
1120
|
} |
|
1121
|
|
|
1122
|
################################################################## |
|
1123
|
# |
|
1124
|
# Directory/path handling |
|
1125
|
# |
|
1126
|
|
|
1127
|
proc realdir {dir} { |
|
1128
|
set oldpwd [pwd] |
|
1129
|
cd $dir |
|
1130
|
set pwd [pwd] |
|
1131
|
cd $oldpwd |
|
1132
|
return $pwd |
|
1133
|
} |
|
1134
|
|
|
1135
|
# Follow symlinks until we get to something which is not a symlink |
|
1136
|
proc realpath {path} { |
|
1137
|
while {1} { |
|
1138
|
if {[catch { |
|
1139
|
set path [file readlink $path] |
|
1140
|
}]} { |
|
1141
|
# Not a link |
|
1142
|
break |
|
1143
|
} |
|
1144
|
} |
|
1145
|
return $path |
|
1146
|
} |
|
1147
|
|
|
1148
|
# Convert absolute path, $path into a path relative |
|
1149
|
# to the given directory (or the current dir, if not given). |
|
1150
|
# |
|
1151
|
proc relative-path {path {pwd {}}} { |
|
1152
|
set diff 0 |
|
1153
|
set same 0 |
|
1154
|
set newf {} |
|
1155
|
set prefix {} |
|
1156
|
set path [file-normalize $path] |
|
1157
|
if {$pwd eq ""} { |
|
1158
|
set pwd [pwd] |
|
1159
|
} else { |
|
1160
|
set pwd [file-normalize $pwd] |
|
1161
|
} |
|
1162
|
|
|
1163
|
if {$path eq $pwd} { |
|
1164
|
return . |
|
1165
|
} |
|
1166
|
|
|
1167
|
# Try to make the filename relative to the current dir |
|
1168
|
foreach p [split $pwd /] f [split $path /] { |
|
1169
|
if {$p ne $f} { |
|
1170
|
incr diff |
|
1171
|
} elseif {!$diff} { |
|
1172
|
incr same |
|
1173
|
} |
|
1174
|
if {$diff} { |
|
1175
|
if {$p ne ""} { |
|
1176
|
# Add .. for sibling or parent dir |
|
1177
|
lappend prefix .. |
|
1178
|
} |
|
1179
|
if {$f ne ""} { |
|
1180
|
lappend newf $f |
|
1181
|
} |
|
1182
|
} |
|
1183
|
} |
|
1184
|
if {$same == 1 || [llength $prefix] > 3} { |
|
1185
|
return $path |
|
1186
|
} |
|
1187
|
|
|
1188
|
file join [join $prefix /] [join $newf /] |
|
1189
|
} |
|
1190
|
|
|
1191
|
# Add filename as a dependency to rerun autosetup |
|
1192
|
# The name will be normalised (converted to a full path) |
|
1193
|
# |
|
1194
|
proc autosetup_add_dep {filename} { |
|
1195
|
lappend ::autosetup(deps) [file-normalize $filename] |
|
1196
|
} |
|
1197
|
|
|
1198
|
# @section Modules Support |
|
1199
|
|
|
1200
|
################################################################## |
|
1201
|
# |
|
1202
|
# Library module support |
|
1203
|
# |
|
1204
|
|
|
1205
|
# @use module ... |
|
1206
|
# |
|
1207
|
# Load the given library modules. |
|
1208
|
# e.g. 'use cc cc-shared' |
|
1209
|
# |
|
1210
|
# Note that module 'X' is implemented in either 'autosetup/X.tcl' |
|
1211
|
# or 'autosetup/X/init.tcl' |
|
1212
|
# |
|
1213
|
# The latter form is useful for a complex module which requires additional |
|
1214
|
# support file. In this form, '$::usedir' is set to the module directory |
|
1215
|
# when it is loaded. |
|
1216
|
# |
|
1217
|
proc use {args} { |
|
1218
|
global autosetup libmodule modsource |
|
1219
|
|
|
1220
|
set dirs [list $autosetup(libdir)] |
|
1221
|
if {[info exists autosetup(srcdir)]} { |
|
1222
|
lappend dirs $autosetup(srcdir)/autosetup |
|
1223
|
} |
|
1224
|
foreach m $args { |
|
1225
|
if {[info exists libmodule($m)]} { |
|
1226
|
continue |
|
1227
|
} |
|
1228
|
set libmodule($m) 1 |
|
1229
|
|
|
1230
|
if {[info exists modsource(${m}.tcl)]} { |
|
1231
|
autosetup_load_module $m eval $modsource(${m}.tcl) |
|
1232
|
} else { |
|
1233
|
set locs [list ${m}.tcl ${m}/init.tcl] |
|
1234
|
set found 0 |
|
1235
|
foreach dir $dirs { |
|
1236
|
foreach loc $locs { |
|
1237
|
set source $dir/$loc |
|
1238
|
if {[file exists $source]} { |
|
1239
|
incr found |
|
1240
|
break |
|
1241
|
} |
|
1242
|
} |
|
1243
|
if {$found} { |
|
1244
|
break |
|
1245
|
} |
|
1246
|
} |
|
1247
|
if {$found} { |
|
1248
|
# For the convenience of the "use" source, point to the directory |
|
1249
|
# it is being loaded from |
|
1250
|
set ::usedir [file dirname $source] |
|
1251
|
autosetup_load_module $m source $source |
|
1252
|
autosetup_add_dep $source |
|
1253
|
} else { |
|
1254
|
autosetup-error "use: No such module: $m" |
|
1255
|
} |
|
1256
|
} |
|
1257
|
} |
|
1258
|
} |
|
1259
|
|
|
1260
|
proc autosetup_load_auto_modules {} { |
|
1261
|
global autosetup modsource |
|
1262
|
# First load any embedded auto modules |
|
1263
|
foreach mod [array names modsource *.auto] { |
|
1264
|
autosetup_load_module $mod eval $modsource($mod) |
|
1265
|
} |
|
1266
|
# Now any external auto modules |
|
1267
|
foreach file [glob -nocomplain $autosetup(libdir)/*.auto $autosetup(libdir)/*/*.auto] { |
|
1268
|
autosetup_load_module [file tail $file] source $file |
|
1269
|
} |
|
1270
|
} |
|
1271
|
|
|
1272
|
# Load module source in the global scope by executing the given command |
|
1273
|
proc autosetup_load_module {module args} { |
|
1274
|
global autosetup |
|
1275
|
set prev $autosetup(module) |
|
1276
|
set autosetup(module) $module |
|
1277
|
|
|
1278
|
if {[catch [list uplevel #0 $args] msg opts] ni {0 2 3}} { |
|
1279
|
autosetup-full-error [error-dump $msg $opts $::autosetup(debug)] |
|
1280
|
} |
|
1281
|
set autosetup(module) $prev |
|
1282
|
} |
|
1283
|
|
|
1284
|
# Initial settings |
|
1285
|
set autosetup(exe) $::argv0 |
|
1286
|
set autosetup(istcl) 1 |
|
1287
|
set autosetup(start) [clock millis] |
|
1288
|
set autosetup(installed) 0 |
|
1289
|
set autosetup(sysinstall) 0 |
|
1290
|
set autosetup(msg-checking) 0 |
|
1291
|
set autosetup(msg-quiet) 0 |
|
1292
|
set autosetup(inittypes) {} |
|
1293
|
set autosetup(module) autosetup |
|
1294
|
|
|
1295
|
# Embedded modules are inserted below here |
|
1296
|
set autosetup(installed) 1 |
|
1297
|
set autosetup(sysinstall) 0 |
|
1298
|
# ----- @module asciidoc-formatting.tcl ----- |
|
1299
|
|
|
1300
|
set modsource(asciidoc-formatting.tcl) { |
|
1301
|
# Copyright (c) 2010 WorkWare Systems http://www.workware.net.au/ |
|
1302
|
# All rights reserved |
|
1303
|
|
|
1304
|
# Module which provides text formatting |
|
1305
|
# asciidoc format |
|
1306
|
|
|
1307
|
use formatting |
|
1308
|
|
|
1309
|
proc para {text} { |
|
1310
|
regsub -all "\[ \t\n\]+" [string trim $text] " " |
|
1311
|
} |
|
1312
|
proc title {text} { |
|
1313
|
underline [para $text] = |
|
1314
|
nl |
|
1315
|
} |
|
1316
|
proc p {text} { |
|
1317
|
puts [para $text] |
|
1318
|
nl |
|
1319
|
} |
|
1320
|
proc code {text} { |
|
1321
|
foreach line [parse_code_block $text] { |
|
1322
|
puts " $line" |
|
1323
|
} |
|
1324
|
nl |
|
1325
|
} |
|
1326
|
proc codelines {lines} { |
|
1327
|
foreach line $lines { |
|
1328
|
puts " $line" |
|
1329
|
} |
|
1330
|
nl |
|
1331
|
} |
|
1332
|
proc nl {} { |
|
1333
|
puts "" |
|
1334
|
} |
|
1335
|
proc underline {text char} { |
|
1336
|
regexp "^(\[ \t\]*)(.*)" $text -> indent words |
|
1337
|
puts $text |
|
1338
|
puts $indent[string repeat $char [string length $words]] |
|
1339
|
} |
|
1340
|
proc section {text} { |
|
1341
|
underline "[para $text]" - |
|
1342
|
nl |
|
1343
|
} |
|
1344
|
proc subsection {text} { |
|
1345
|
underline "$text" ~ |
|
1346
|
nl |
|
1347
|
} |
|
1348
|
proc bullet {text} { |
|
1349
|
puts "* [para $text]" |
|
1350
|
} |
|
1351
|
proc indent {text} { |
|
1352
|
puts " :: " |
|
1353
|
puts [para $text] |
|
1354
|
} |
|
1355
|
proc defn {first args} { |
|
1356
|
set sep "" |
|
1357
|
if {$first ne ""} { |
|
1358
|
puts "${first}::" |
|
1359
|
} else { |
|
1360
|
puts " :: " |
|
1361
|
} |
|
1362
|
set defn [string trim [join $args \n]] |
|
1363
|
regsub -all "\n\n" $defn "\n ::\n" defn |
|
1364
|
puts $defn |
|
1365
|
} |
|
1366
|
} |
|
1367
|
|
|
1368
|
# ----- @module formatting.tcl ----- |
|
1369
|
|
|
1370
|
set modsource(formatting.tcl) { |
|
1371
|
# Copyright (c) 2010 WorkWare Systems http://www.workware.net.au/ |
|
1372
|
# All rights reserved |
|
1373
|
|
|
1374
|
# Module which provides common text formatting |
|
1375
|
|
|
1376
|
# This is designed for documentation which looks like: |
|
1377
|
# code {...} |
|
1378
|
# or |
|
1379
|
# code { |
|
1380
|
# ... |
|
1381
|
# ... |
|
1382
|
# } |
|
1383
|
# In the second case, we need to work out the indenting |
|
1384
|
# and strip it from all lines but preserve the remaining indenting. |
|
1385
|
# Note that all lines need to be indented with the same initial |
|
1386
|
# spaces/tabs. |
|
1387
|
# |
|
1388
|
# Returns a list of lines with the indenting removed. |
|
1389
|
# |
|
1390
|
proc parse_code_block {text} { |
|
1391
|
# If the text begins with newline, take the following text, |
|
1392
|
# otherwise just return the original |
|
1393
|
if {![regexp "^\n(.*)" $text -> text]} { |
|
1394
|
return [list [string trim $text]] |
|
1395
|
} |
|
1396
|
|
|
1397
|
# And trip spaces off the end |
|
1398
|
set text [string trimright $text] |
|
1399
|
|
|
1400
|
set min 100 |
|
1401
|
# Examine each line to determine the minimum indent |
|
1402
|
foreach line [split $text \n] { |
|
1403
|
if {$line eq ""} { |
|
1404
|
# Ignore empty lines for the indent calculation |
|
1405
|
continue |
|
1406
|
} |
|
1407
|
regexp "^(\[ \t\]*)" $line -> indent |
|
1408
|
set len [string length $indent] |
|
1409
|
if {$len < $min} { |
|
1410
|
set min $len |
|
1411
|
} |
|
1412
|
} |
|
1413
|
|
|
1414
|
# Now make a list of lines with this indent removed |
|
1415
|
set lines {} |
|
1416
|
foreach line [split $text \n] { |
|
1417
|
lappend lines [string range $line $min end] |
|
1418
|
} |
|
1419
|
|
|
1420
|
# Return the result |
|
1421
|
return $lines |
|
1422
|
} |
|
1423
|
} |
|
1424
|
|
|
1425
|
# ----- @module getopt.tcl ----- |
|
1426
|
|
|
1427
|
set modsource(getopt.tcl) { |
|
1428
|
# Copyright (c) 2006 WorkWare Systems http://www.workware.net.au/ |
|
1429
|
# All rights reserved |
|
1430
|
|
|
1431
|
# Simple getopt module |
|
1432
|
|
|
1433
|
# Parse everything out of the argv list which looks like an option |
|
1434
|
# Everything which doesn't look like an option, or is after --, is left unchanged |
|
1435
|
# Understands --enable-xxx as a synonym for --xxx to enable the boolean option xxx. |
|
1436
|
# Understands --disable-xxx to disable the boolean option xxx. |
|
1437
|
# |
|
1438
|
# The returned value is a dictionary keyed by option name |
|
1439
|
# Each value is a list of {type value} ... where type is "bool" or "str". |
|
1440
|
# The value for a boolean option is 0 or 1. The value of a string option is the value given. |
|
1441
|
proc getopt {argvname} { |
|
1442
|
upvar $argvname argv |
|
1443
|
set nargv {} |
|
1444
|
|
|
1445
|
set opts {} |
|
1446
|
|
|
1447
|
for {set i 0} {$i < [llength $argv]} {incr i} { |
|
1448
|
set arg [lindex $argv $i] |
|
1449
|
|
|
1450
|
#dputs arg=$arg |
|
1451
|
|
|
1452
|
if {$arg eq "--"} { |
|
1453
|
# End of options |
|
1454
|
incr i |
|
1455
|
lappend nargv {*}[lrange $argv $i end] |
|
1456
|
break |
|
1457
|
} |
|
1458
|
|
|
1459
|
if {[regexp {^--([^=][^=]+)=(.*)$} $arg -> name value]} { |
|
1460
|
# --name=value |
|
1461
|
dict lappend opts $name [list str $value] |
|
1462
|
} elseif {[regexp {^--(enable-|disable-)?([^=]*)$} $arg -> prefix name]} { |
|
1463
|
if {$prefix in {enable- ""}} { |
|
1464
|
set value 1 |
|
1465
|
} else { |
|
1466
|
set value 0 |
|
1467
|
} |
|
1468
|
dict lappend opts $name [list bool $value] |
|
1469
|
} else { |
|
1470
|
lappend nargv $arg |
|
1471
|
} |
|
1472
|
} |
|
1473
|
|
|
1474
|
#puts "getopt: argv=[join $argv] => [join $nargv]" |
|
1475
|
#array set getopt $opts |
|
1476
|
#parray getopt |
|
1477
|
|
|
1478
|
set argv $nargv |
|
1479
|
|
|
1480
|
return $opts |
|
1481
|
} |
|
1482
|
} |
|
1483
|
|
|
1484
|
# ----- @module help.tcl ----- |
|
1485
|
|
|
1486
|
set modsource(help.tcl) { |
|
1487
|
# Copyright (c) 2010 WorkWare Systems http://workware.net.au/ |
|
1488
|
# All rights reserved |
|
1489
|
|
|
1490
|
# Module which provides usage, help and the command reference |
|
1491
|
|
|
1492
|
proc autosetup_help {what} { |
|
1493
|
use_pager |
|
1494
|
|
|
1495
|
puts "Usage: [file tail $::autosetup(exe)] \[options\] \[settings\]\n" |
|
1496
|
puts "This is [autosetup_version], a build environment \"autoconfigurator\"" |
|
1497
|
puts "See the documentation online at https://msteveb.github.io/autosetup/\n" |
|
1498
|
|
|
1499
|
if {$what in {all local}} { |
|
1500
|
# Need to load auto.def now |
|
1501
|
if {[file exists $::autosetup(autodef)]} { |
|
1502
|
# Load auto.def as module "auto.def" |
|
1503
|
autosetup_load_module auto.def source $::autosetup(autodef) |
|
1504
|
} |
|
1505
|
if {$what eq "all"} { |
|
1506
|
set what * |
|
1507
|
} else { |
|
1508
|
set what auto.def |
|
1509
|
} |
|
1510
|
} else { |
|
1511
|
use $what |
|
1512
|
puts "Options for module $what:" |
|
1513
|
} |
|
1514
|
options-show $what |
|
1515
|
exit 0 |
|
1516
|
} |
|
1517
|
|
|
1518
|
proc autosetup_show_license {} { |
|
1519
|
global modsource autosetup |
|
1520
|
use_pager |
|
1521
|
|
|
1522
|
if {[info exists modsource(LICENSE)]} { |
|
1523
|
puts $modsource(LICENSE) |
|
1524
|
return |
|
1525
|
} |
|
1526
|
foreach dir [list $autosetup(libdir) $autosetup(srcdir)] { |
|
1527
|
set path [file join $dir LICENSE] |
|
1528
|
if {[file exists $path]} { |
|
1529
|
puts [readfile $path] |
|
1530
|
return |
|
1531
|
} |
|
1532
|
} |
|
1533
|
puts "LICENSE not found" |
|
1534
|
} |
|
1535
|
|
|
1536
|
# If not already paged and stdout is a tty, pipe the output through the pager |
|
1537
|
# This is done by reinvoking autosetup with --nopager added |
|
1538
|
proc use_pager {} { |
|
1539
|
if {![opt-bool nopager] && [getenv PAGER ""] ne "" && [isatty? stdin] && [isatty? stdout]} { |
|
1540
|
if {[catch { |
|
1541
|
exec [info nameofexecutable] $::argv0 --nopager {*}$::argv |& {*}[getenv PAGER] >@stdout <@stdin 2>@stderr |
|
1542
|
} msg opts] == 1} { |
|
1543
|
if {[dict get $opts -errorcode] eq "NONE"} { |
|
1544
|
# an internal/exec error |
|
1545
|
puts stderr $msg |
|
1546
|
exit 1 |
|
1547
|
} |
|
1548
|
} |
|
1549
|
exit 0 |
|
1550
|
} |
|
1551
|
} |
|
1552
|
|
|
1553
|
# Outputs the autosetup references in one of several formats |
|
1554
|
proc autosetup_reference {{type text}} { |
|
1555
|
|
|
1556
|
use_pager |
|
1557
|
|
|
1558
|
switch -glob -- $type { |
|
1559
|
wiki {use wiki-formatting} |
|
1560
|
ascii* {use asciidoc-formatting} |
|
1561
|
md - markdown {use markdown-formatting} |
|
1562
|
default {use text-formatting} |
|
1563
|
} |
|
1564
|
|
|
1565
|
title "[autosetup_version] -- Command Reference" |
|
1566
|
|
|
1567
|
section {Introduction} |
|
1568
|
|
|
1569
|
p { |
|
1570
|
See https://msteveb.github.io/autosetup/ for the online documentation for 'autosetup'. |
|
1571
|
This documentation can also be accessed locally with `autosetup --ref`. |
|
1572
|
} |
|
1573
|
|
|
1574
|
p { |
|
1575
|
'autosetup' provides a number of built-in commands which |
|
1576
|
are documented below. These may be used from 'auto.def' to test |
|
1577
|
for features, define variables, create files from templates and |
|
1578
|
other similar actions. |
|
1579
|
} |
|
1580
|
|
|
1581
|
automf_command_reference |
|
1582
|
|
|
1583
|
exit 0 |
|
1584
|
} |
|
1585
|
|
|
1586
|
proc autosetup_output_block {type lines} { |
|
1587
|
if {[llength $lines]} { |
|
1588
|
switch $type { |
|
1589
|
section { |
|
1590
|
section $lines |
|
1591
|
} |
|
1592
|
subsection { |
|
1593
|
subsection $lines |
|
1594
|
} |
|
1595
|
code { |
|
1596
|
codelines $lines |
|
1597
|
} |
|
1598
|
p { |
|
1599
|
p [join $lines] |
|
1600
|
} |
|
1601
|
list { |
|
1602
|
foreach line $lines { |
|
1603
|
bullet $line |
|
1604
|
} |
|
1605
|
nl |
|
1606
|
} |
|
1607
|
} |
|
1608
|
} |
|
1609
|
} |
|
1610
|
|
|
1611
|
# Generate a command reference from inline documentation |
|
1612
|
proc automf_command_reference {} { |
|
1613
|
lappend files $::autosetup(prog) |
|
1614
|
lappend files {*}[lsort [glob -nocomplain $::autosetup(libdir)/*.tcl]] |
|
1615
|
|
|
1616
|
# We want to process all non-module files before module files |
|
1617
|
# and then modules in alphabetical order. |
|
1618
|
# So examine all files and extract docs into doc($modulename) and doc(_core_) |
|
1619
|
# |
|
1620
|
# Each entry is a list of {type data} where $type is one of: section, subsection, code, list, p |
|
1621
|
# and $data is a string for section, subsection or a list of text lines for other types. |
|
1622
|
|
|
1623
|
# XXX: Should commands be in alphabetical order too? Currently they are in file order. |
|
1624
|
|
|
1625
|
set doc(_core_) {} |
|
1626
|
lappend doc(_core_) [list section "Core Commands"] |
|
1627
|
|
|
1628
|
foreach file $files { |
|
1629
|
set modulename [file rootname [file tail $file]] |
|
1630
|
set current _core_ |
|
1631
|
set f [open $file] |
|
1632
|
while {![eof $f]} { |
|
1633
|
set line [gets $f] |
|
1634
|
|
|
1635
|
if {[regexp {^#.*@section (.*)$} $line -> section]} { |
|
1636
|
lappend doc($current) [list section $section] |
|
1637
|
continue |
|
1638
|
} |
|
1639
|
|
|
1640
|
# Find embedded module names |
|
1641
|
if {[regexp {^#.*@module ([^ ]*)} $line -> modulename]} { |
|
1642
|
continue |
|
1643
|
} |
|
1644
|
|
|
1645
|
# Find lines starting with "# @*" and continuing through the remaining comment lines |
|
1646
|
if {![regexp {^# @(.*)} $line -> cmd]} { |
|
1647
|
continue |
|
1648
|
} |
|
1649
|
|
|
1650
|
# Synopsis or command? |
|
1651
|
if {$cmd eq "synopsis:"} { |
|
1652
|
set current $modulename |
|
1653
|
lappend doc($current) [list section "Module: $modulename"] |
|
1654
|
} else { |
|
1655
|
lappend doc($current) [list subsection $cmd] |
|
1656
|
} |
|
1657
|
|
|
1658
|
set lines {} |
|
1659
|
set type p |
|
1660
|
|
|
1661
|
# Now the description |
|
1662
|
while {![eof $f]} { |
|
1663
|
set line [gets $f] |
|
1664
|
|
|
1665
|
if {![regexp {^#(#)? ?(.*)} $line -> hash cmd]} { |
|
1666
|
break |
|
1667
|
} |
|
1668
|
if {$hash eq "#"} { |
|
1669
|
set t code |
|
1670
|
} elseif {[regexp {^- (.*)} $cmd -> cmd]} { |
|
1671
|
set t list |
|
1672
|
} else { |
|
1673
|
set t p |
|
1674
|
} |
|
1675
|
|
|
1676
|
#puts "hash=$hash, oldhash=$oldhash, lines=[llength $lines], cmd=$cmd" |
|
1677
|
|
|
1678
|
if {$t ne $type || $cmd eq ""} { |
|
1679
|
# Finish the current block |
|
1680
|
lappend doc($current) [list $type $lines] |
|
1681
|
set lines {} |
|
1682
|
set type $t |
|
1683
|
} |
|
1684
|
if {$cmd ne ""} { |
|
1685
|
lappend lines $cmd |
|
1686
|
} |
|
1687
|
} |
|
1688
|
|
|
1689
|
lappend doc($current) [list $type $lines] |
|
1690
|
} |
|
1691
|
close $f |
|
1692
|
} |
|
1693
|
|
|
1694
|
# Now format and output the results |
|
1695
|
|
|
1696
|
# _core_ will sort first |
|
1697
|
foreach module [lsort [array names doc]] { |
|
1698
|
foreach item $doc($module) { |
|
1699
|
autosetup_output_block {*}$item |
|
1700
|
} |
|
1701
|
} |
|
1702
|
} |
|
1703
|
} |
|
1704
|
|
|
1705
|
# ----- @module init.tcl ----- |
|
1706
|
|
|
1707
|
set modsource(init.tcl) { |
|
1708
|
# Copyright (c) 2010 WorkWare Systems http://www.workware.net.au/ |
|
1709
|
# All rights reserved |
|
1710
|
|
|
1711
|
# Module to help create auto.def and configure |
|
1712
|
|
|
1713
|
proc autosetup_init {type} { |
|
1714
|
set help 0 |
|
1715
|
if {$type in {? help}} { |
|
1716
|
incr help |
|
1717
|
} elseif {![dict exists $::autosetup(inittypes) $type]} { |
|
1718
|
puts "Unknown type, --init=$type" |
|
1719
|
incr help |
|
1720
|
} |
|
1721
|
if {$help} { |
|
1722
|
puts "Use one of the following types (e.g. --init=make)\n" |
|
1723
|
foreach type [lsort [dict keys $::autosetup(inittypes)]] { |
|
1724
|
lassign [dict get $::autosetup(inittypes) $type] desc |
|
1725
|
# XXX: Use the options-show code to wrap the description |
|
1726
|
puts [format "%-10s %s" $type $desc] |
|
1727
|
} |
|
1728
|
return |
|
1729
|
} |
|
1730
|
lassign [dict get $::autosetup(inittypes) $type] desc script |
|
1731
|
|
|
1732
|
puts "Initialising $type: $desc\n" |
|
1733
|
|
|
1734
|
# All initialisations happens in the top level srcdir |
|
1735
|
cd $::autosetup(srcdir) |
|
1736
|
|
|
1737
|
uplevel #0 $script |
|
1738
|
} |
|
1739
|
|
|
1740
|
proc autosetup_add_init_type {type desc script} { |
|
1741
|
dict set ::autosetup(inittypes) $type [list $desc $script] |
|
1742
|
} |
|
1743
|
|
|
1744
|
# This is for in creating build-system init scripts |
|
1745
|
# |
|
1746
|
# If the file doesn't exist, create it containing $contents |
|
1747
|
# If the file does exist, only overwrite if --force is specified. |
|
1748
|
# |
|
1749
|
proc autosetup_check_create {filename contents} { |
|
1750
|
if {[file exists $filename]} { |
|
1751
|
if {!$::autosetup(force)} { |
|
1752
|
puts "I see $filename already exists." |
|
1753
|
return |
|
1754
|
} else { |
|
1755
|
puts "I will overwrite the existing $filename because you used --force." |
|
1756
|
} |
|
1757
|
} else { |
|
1758
|
puts "I don't see $filename, so I will create it." |
|
1759
|
} |
|
1760
|
writefile $filename $contents |
|
1761
|
} |
|
1762
|
} |
|
1763
|
|
|
1764
|
# ----- @module install.tcl ----- |
|
1765
|
|
|
1766
|
set modsource(install.tcl) { |
|
1767
|
# Copyright (c) 2006-2010 WorkWare Systems http://www.workware.net.au/ |
|
1768
|
# All rights reserved |
|
1769
|
|
|
1770
|
# Module which can install autosetup |
|
1771
|
|
|
1772
|
# autosetup(installed)=1 means that autosetup is not running from source |
|
1773
|
# autosetup(sysinstall)=1 means that autosetup is running from a sysinstall version |
|
1774
|
# shared=1 means that we are trying to do a sysinstall. This is only possible from the development source. |
|
1775
|
|
|
1776
|
proc autosetup_install {dir {shared 0}} { |
|
1777
|
global autosetup |
|
1778
|
if {$shared} { |
|
1779
|
if {$autosetup(installed) || $autosetup(sysinstall)} { |
|
1780
|
user-error "Can only --sysinstall from development sources" |
|
1781
|
} |
|
1782
|
} elseif {$autosetup(installed) && !$autosetup(sysinstall)} { |
|
1783
|
user-error "Can't --install from project install" |
|
1784
|
} |
|
1785
|
|
|
1786
|
if {$autosetup(sysinstall)} { |
|
1787
|
# This is the sysinstall version, so install just uses references |
|
1788
|
cd $dir |
|
1789
|
|
|
1790
|
puts "[autosetup_version] creating configure to use system-installed autosetup" |
|
1791
|
autosetup_create_configure 1 |
|
1792
|
puts "Creating autosetup/README.autosetup" |
|
1793
|
file mkdir autosetup |
|
1794
|
autosetup_install_readme autosetup/README.autosetup 1 |
|
1795
|
return |
|
1796
|
} |
|
1797
|
|
|
1798
|
if {[catch { |
|
1799
|
if {$shared} { |
|
1800
|
set target $dir/bin/autosetup |
|
1801
|
set installedas $target |
|
1802
|
} else { |
|
1803
|
if {$dir eq "."} { |
|
1804
|
set installedas autosetup |
|
1805
|
} else { |
|
1806
|
set installedas $dir/autosetup |
|
1807
|
} |
|
1808
|
cd $dir |
|
1809
|
file mkdir autosetup |
|
1810
|
set target autosetup/autosetup |
|
1811
|
} |
|
1812
|
set targetdir [file dirname $target] |
|
1813
|
file mkdir $targetdir |
|
1814
|
|
|
1815
|
set f [open $target w] |
|
1816
|
|
|
1817
|
set publicmodules {} |
|
1818
|
|
|
1819
|
# First the main script, but only up until "CUT HERE" |
|
1820
|
set in [open $autosetup(dir)/autosetup] |
|
1821
|
while {[gets $in buf] >= 0} { |
|
1822
|
if {$buf ne "##-- CUT HERE --##"} { |
|
1823
|
puts $f $buf |
|
1824
|
continue |
|
1825
|
} |
|
1826
|
|
|
1827
|
# Insert the static modules here |
|
1828
|
# i.e. those which don't contain @synopsis: |
|
1829
|
# All modules are inserted if $shared is set |
|
1830
|
puts $f "set autosetup(installed) 1" |
|
1831
|
puts $f "set autosetup(sysinstall) $shared" |
|
1832
|
foreach file [lsort [glob $autosetup(libdir)/*.{tcl,auto}]] { |
|
1833
|
set modname [file tail $file] |
|
1834
|
set ext [file ext $modname] |
|
1835
|
set buf [readfile $file] |
|
1836
|
if {!$shared} { |
|
1837
|
if {$ext eq ".auto" || [string match "*\n# @synopsis:*" $buf]} { |
|
1838
|
lappend publicmodules $file |
|
1839
|
continue |
|
1840
|
} |
|
1841
|
} |
|
1842
|
dputs "install: importing lib/[file tail $file]" |
|
1843
|
puts $f "# ----- @module $modname -----" |
|
1844
|
puts $f "\nset modsource($modname) \{" |
|
1845
|
puts $f $buf |
|
1846
|
puts $f "\}\n" |
|
1847
|
} |
|
1848
|
if {$shared} { |
|
1849
|
foreach {srcname destname} [list $autosetup(libdir)/README.autosetup-lib README.autosetup \ |
|
1850
|
$autosetup(srcdir)/LICENSE LICENSE] { |
|
1851
|
dputs "install: importing $srcname as $destname" |
|
1852
|
puts $f "\nset modsource($destname) \\\n[list [readfile $srcname]\n]\n" |
|
1853
|
} |
|
1854
|
} |
|
1855
|
} |
|
1856
|
close $in |
|
1857
|
close $f |
|
1858
|
catch {exec chmod 755 $target} |
|
1859
|
|
|
1860
|
set installfiles {autosetup-config.guess autosetup-config.sub autosetup-test-tclsh} |
|
1861
|
set removefiles {} |
|
1862
|
|
|
1863
|
if {!$shared} { |
|
1864
|
autosetup_install_readme $targetdir/README.autosetup 0 |
|
1865
|
|
|
1866
|
# Install public modules |
|
1867
|
foreach file $publicmodules { |
|
1868
|
set tail [file tail $file] |
|
1869
|
autosetup_install_file $file $targetdir/$tail |
|
1870
|
} |
|
1871
|
lappend installfiles jimsh0.c autosetup-find-tclsh LICENSE |
|
1872
|
lappend removefiles config.guess config.sub test-tclsh find-tclsh |
|
1873
|
} else { |
|
1874
|
lappend installfiles {sys-find-tclsh autosetup-find-tclsh} |
|
1875
|
} |
|
1876
|
|
|
1877
|
# Install support files |
|
1878
|
foreach fileinfo $installfiles { |
|
1879
|
if {[llength $fileinfo] == 2} { |
|
1880
|
lassign $fileinfo source dest |
|
1881
|
} else { |
|
1882
|
lassign $fileinfo source |
|
1883
|
set dest $source |
|
1884
|
} |
|
1885
|
autosetup_install_file $autosetup(dir)/$source $targetdir/$dest |
|
1886
|
} |
|
1887
|
|
|
1888
|
# Remove obsolete files |
|
1889
|
foreach file $removefiles { |
|
1890
|
if {[file exists $targetdir/$file]} { |
|
1891
|
file delete $targetdir/$file |
|
1892
|
} |
|
1893
|
} |
|
1894
|
} error]} { |
|
1895
|
user-error "Failed to install autosetup: $error" |
|
1896
|
} |
|
1897
|
if {$shared} { |
|
1898
|
set type "system" |
|
1899
|
} else { |
|
1900
|
set type "local" |
|
1901
|
} |
|
1902
|
puts "Installed $type [autosetup_version] to $installedas" |
|
1903
|
|
|
1904
|
if {!$shared} { |
|
1905
|
# Now create 'configure' if necessary |
|
1906
|
autosetup_create_configure 0 |
|
1907
|
} |
|
1908
|
} |
|
1909
|
|
|
1910
|
proc autosetup_create_configure {shared} { |
|
1911
|
if {[file exists configure]} { |
|
1912
|
if {!$::autosetup(force)} { |
|
1913
|
# Could this be an autosetup configure? |
|
1914
|
if {![string match "*\nWRAPPER=*" [readfile configure]]} { |
|
1915
|
puts "I see configure, but not created by autosetup, so I won't overwrite it." |
|
1916
|
puts "Remove it or use --force to overwrite." |
|
1917
|
return |
|
1918
|
} |
|
1919
|
} else { |
|
1920
|
puts "I will overwrite the existing configure because you used --force." |
|
1921
|
} |
|
1922
|
} else { |
|
1923
|
puts "I don't see configure, so I will create it." |
|
1924
|
} |
|
1925
|
if {$shared} { |
|
1926
|
writefile configure \ |
|
1927
|
{#!/bin/sh |
|
1928
|
WRAPPER="$0"; export WRAPPER; "autosetup" "$@" |
|
1929
|
} |
|
1930
|
} else { |
|
1931
|
writefile configure \ |
|
1932
|
{#!/bin/sh |
|
1933
|
dir="`dirname "$0"`/autosetup" |
|
1934
|
#@@INITCHECK@@# |
|
1935
|
WRAPPER="$0"; export WRAPPER; exec "`"$dir/autosetup-find-tclsh"`" "$dir/autosetup" "$@" |
|
1936
|
} |
|
1937
|
} |
|
1938
|
catch {exec chmod 755 configure} |
|
1939
|
} |
|
1940
|
|
|
1941
|
# Append the contents of $file to filehandle $f |
|
1942
|
proc autosetup_install_append {f file} { |
|
1943
|
dputs "install: include $file" |
|
1944
|
set in [open $file] |
|
1945
|
puts $f [read $in] |
|
1946
|
close $in |
|
1947
|
} |
|
1948
|
|
|
1949
|
proc autosetup_install_file {source target} { |
|
1950
|
dputs "install: $source => $target" |
|
1951
|
if {![file exists $source]} { |
|
1952
|
error "Missing installation file '$source'" |
|
1953
|
} |
|
1954
|
writefile $target [readfile $source]\n |
|
1955
|
# If possible, copy the file mode |
|
1956
|
file stat $source stat |
|
1957
|
set mode [format %o [expr {$stat(mode) & 0x1ff}]] |
|
1958
|
catch {exec chmod $mode $target} |
|
1959
|
} |
|
1960
|
|
|
1961
|
proc autosetup_install_readme {target sysinstall} { |
|
1962
|
set readme "README.autosetup created by [autosetup_version]\n\n" |
|
1963
|
if {$sysinstall} { |
|
1964
|
append readme \ |
|
1965
|
{This is the autosetup directory for a system install of autosetup. |
|
1966
|
Loadable modules can be added here. |
|
1967
|
} |
|
1968
|
} else { |
|
1969
|
append readme \ |
|
1970
|
{This is the autosetup directory for a local install of autosetup. |
|
1971
|
It contains autosetup, support files and loadable modules. |
|
1972
|
} |
|
1973
|
} |
|
1974
|
|
|
1975
|
append readme { |
|
1976
|
*.tcl files in this directory are optional modules which |
|
1977
|
can be loaded with the 'use' directive. |
|
1978
|
|
|
1979
|
*.auto files in this directory are auto-loaded. |
|
1980
|
|
|
1981
|
For more information, see https://msteveb.github.io/autosetup/ |
|
1982
|
} |
|
1983
|
dputs "install: autosetup/README.autosetup" |
|
1984
|
writefile $target $readme |
|
1985
|
} |
|
1986
|
} |
|
1987
|
|
|
1988
|
# ----- @module markdown-formatting.tcl ----- |
|
1989
|
|
|
1990
|
set modsource(markdown-formatting.tcl) { |
|
1991
|
# Copyright (c) 2010 WorkWare Systems http://www.workware.net.au/ |
|
1992
|
# All rights reserved |
|
1993
|
|
|
1994
|
# Module which provides text formatting |
|
1995
|
# markdown format (kramdown syntax) |
|
1996
|
|
|
1997
|
use formatting |
|
1998
|
|
|
1999
|
proc para {text} { |
|
2000
|
regsub -all "\[ \t\n\]+" [string trim $text] " " text |
|
2001
|
regsub -all {([^a-zA-Z])'([^']*)'} $text {\1**`\2`**} text |
|
2002
|
regsub -all {^'([^']*)'} $text {**`\1`**} text |
|
2003
|
regsub -all {(http[^ \t\n]*)} $text {[\1](\1)} text |
|
2004
|
return $text |
|
2005
|
} |
|
2006
|
proc title {text} { |
|
2007
|
underline [para $text] = |
|
2008
|
nl |
|
2009
|
} |
|
2010
|
proc p {text} { |
|
2011
|
puts [para $text] |
|
2012
|
nl |
|
2013
|
} |
|
2014
|
proc codelines {lines} { |
|
2015
|
puts "~~~~~~~~~~~~" |
|
2016
|
foreach line $lines { |
|
2017
|
puts $line |
|
2018
|
} |
|
2019
|
puts "~~~~~~~~~~~~" |
|
2020
|
nl |
|
2021
|
} |
|
2022
|
proc code {text} { |
|
2023
|
puts "~~~~~~~~~~~~" |
|
2024
|
foreach line [parse_code_block $text] { |
|
2025
|
puts $line |
|
2026
|
} |
|
2027
|
puts "~~~~~~~~~~~~" |
|
2028
|
nl |
|
2029
|
} |
|
2030
|
proc nl {} { |
|
2031
|
puts "" |
|
2032
|
} |
|
2033
|
proc underline {text char} { |
|
2034
|
regexp "^(\[ \t\]*)(.*)" $text -> indent words |
|
2035
|
puts $text |
|
2036
|
puts $indent[string repeat $char [string length $words]] |
|
2037
|
} |
|
2038
|
proc section {text} { |
|
2039
|
underline "[para $text]" - |
|
2040
|
nl |
|
2041
|
} |
|
2042
|
proc subsection {text} { |
|
2043
|
puts "### `$text`" |
|
2044
|
nl |
|
2045
|
} |
|
2046
|
proc bullet {text} { |
|
2047
|
puts "* [para $text]" |
|
2048
|
} |
|
2049
|
proc defn {first args} { |
|
2050
|
puts "^" |
|
2051
|
set defn [string trim [join $args \n]] |
|
2052
|
if {$first ne ""} { |
|
2053
|
puts "**${first}**" |
|
2054
|
puts -nonewline ": " |
|
2055
|
regsub -all "\n\n" $defn "\n: " defn |
|
2056
|
} |
|
2057
|
puts "$defn" |
|
2058
|
} |
|
2059
|
} |
|
2060
|
|
|
2061
|
# ----- @module misc.tcl ----- |
|
2062
|
|
|
2063
|
set modsource(misc.tcl) { |
|
2064
|
# Copyright (c) 2007-2010 WorkWare Systems http://www.workware.net.au/ |
|
2065
|
# All rights reserved |
|
2066
|
|
|
2067
|
# Module containing misc procs useful to modules |
|
2068
|
# Largely for platform compatibility |
|
2069
|
|
|
2070
|
set autosetup(istcl) [info exists ::tcl_library] |
|
2071
|
set autosetup(iswin) [string equal windows $tcl_platform(platform)] |
|
2072
|
|
|
2073
|
if {$autosetup(iswin)} { |
|
2074
|
# mingw/windows separates $PATH with semicolons |
|
2075
|
# and doesn't have an executable bit |
|
2076
|
proc split-path {} { |
|
2077
|
split [getenv PATH .] {;} |
|
2078
|
} |
|
2079
|
proc file-isexec {exec} { |
|
2080
|
# Basic test for windows. We ignore .bat |
|
2081
|
if {[file isfile $exec] || [file isfile $exec.exe]} { |
|
2082
|
return 1 |
|
2083
|
} |
|
2084
|
return 0 |
|
2085
|
} |
|
2086
|
} else { |
|
2087
|
# unix separates $PATH with colons and has and executable bit |
|
2088
|
proc split-path {} { |
|
2089
|
split [getenv PATH .] : |
|
2090
|
} |
|
2091
|
proc file-isexec {exec} { |
|
2092
|
file executable $exec |
|
2093
|
} |
|
2094
|
} |
|
2095
|
|
|
2096
|
# Assume that exec can return stdout and stderr |
|
2097
|
proc exec-with-stderr {args} { |
|
2098
|
exec {*}$args 2>@1 |
|
2099
|
} |
|
2100
|
|
|
2101
|
if {$autosetup(istcl)} { |
|
2102
|
# Tcl doesn't have the env command |
|
2103
|
proc getenv {name args} { |
|
2104
|
if {[info exists ::env($name)]} { |
|
2105
|
return $::env($name) |
|
2106
|
} |
|
2107
|
if {[llength $args]} { |
|
2108
|
return [lindex $args 0] |
|
2109
|
} |
|
2110
|
return -code error "environment variable \"$name\" does not exist" |
|
2111
|
} |
|
2112
|
proc isatty? {channel} { |
|
2113
|
dict exists [fconfigure $channel] -xchar |
|
2114
|
} |
|
2115
|
# Jim-compatible stacktrace using info frame |
|
2116
|
proc stacktrace {} { |
|
2117
|
set stacktrace {} |
|
2118
|
# 2 to skip the current frame |
|
2119
|
for {set i 2} {$i < [info frame]} {incr i} { |
|
2120
|
set frame [info frame -$i] |
|
2121
|
if {[dict exists $frame file]} { |
|
2122
|
# We don't need proc, so use "" |
|
2123
|
lappend stacktrace "" [dict get $frame file] [dict get $frame line] |
|
2124
|
} |
|
2125
|
} |
|
2126
|
return $stacktrace |
|
2127
|
} |
|
2128
|
} else { |
|
2129
|
if {$autosetup(iswin)} { |
|
2130
|
# On Windows, backslash convert all environment variables |
|
2131
|
# (Assume that Tcl does this for us) |
|
2132
|
proc getenv {name args} { |
|
2133
|
string map {\\ /} [env $name {*}$args] |
|
2134
|
} |
|
2135
|
} else { |
|
2136
|
# Jim on unix is simple |
|
2137
|
alias getenv env |
|
2138
|
} |
|
2139
|
proc isatty? {channel} { |
|
2140
|
set tty 0 |
|
2141
|
catch { |
|
2142
|
# isatty is a recent addition to Jim Tcl |
|
2143
|
set tty [$channel isatty] |
|
2144
|
} |
|
2145
|
return $tty |
|
2146
|
} |
|
2147
|
} |
|
2148
|
|
|
2149
|
# In case 'file normalize' doesn't exist |
|
2150
|
# |
|
2151
|
proc file-normalize {path} { |
|
2152
|
if {[catch {file normalize $path} result]} { |
|
2153
|
if {$path eq ""} { |
|
2154
|
return "" |
|
2155
|
} |
|
2156
|
set oldpwd [pwd] |
|
2157
|
if {[file isdir $path]} { |
|
2158
|
cd $path |
|
2159
|
set result [pwd] |
|
2160
|
} else { |
|
2161
|
cd [file dirname $path] |
|
2162
|
set result [file join [pwd] [file tail $path]] |
|
2163
|
} |
|
2164
|
cd $oldpwd |
|
2165
|
} |
|
2166
|
return $result |
|
2167
|
} |
|
2168
|
|
|
2169
|
# If everything is working properly, the only errors which occur |
|
2170
|
# should be generated in user code (e.g. auto.def). |
|
2171
|
# By default, we only want to show the error location in user code. |
|
2172
|
# We use [info frame] to achieve this, but it works differently on Tcl and Jim. |
|
2173
|
# |
|
2174
|
# This is designed to be called for incorrect usage in auto.def, via autosetup-error |
|
2175
|
# |
|
2176
|
proc error-location {msg} { |
|
2177
|
if {$::autosetup(debug)} { |
|
2178
|
return -code error $msg |
|
2179
|
} |
|
2180
|
# Search back through the stack trace for the first error in a .def file |
|
2181
|
foreach {p f l} [stacktrace] { |
|
2182
|
if {[string match *.def $f]} { |
|
2183
|
return "[relative-path $f]:$l: Error: $msg" |
|
2184
|
} |
|
2185
|
#puts "Skipping $f:$l" |
|
2186
|
} |
|
2187
|
return $msg |
|
2188
|
} |
|
2189
|
|
|
2190
|
# If everything is working properly, the only errors which occur |
|
2191
|
# should be generated in user code (e.g. auto.def). |
|
2192
|
# By default, we only want to show the error location in user code. |
|
2193
|
# We use [info frame] to achieve this, but it works differently on Tcl and Jim. |
|
2194
|
# |
|
2195
|
# This is designed to be called for incorrect usage in auto.def, via autosetup-error |
|
2196
|
# |
|
2197
|
proc error-stacktrace {msg} { |
|
2198
|
if {$::autosetup(debug)} { |
|
2199
|
return -code error $msg |
|
2200
|
} |
|
2201
|
# Search back through the stack trace for the first error in a .def file |
|
2202
|
for {set i 1} {$i < [info level]} {incr i} { |
|
2203
|
if {$::autosetup(istcl)} { |
|
2204
|
array set info [info frame -$i] |
|
2205
|
} else { |
|
2206
|
lassign [info frame -$i] info(caller) info(file) info(line) |
|
2207
|
} |
|
2208
|
if {[string match *.def $info(file)]} { |
|
2209
|
return "[relative-path $info(file)]:$info(line): Error: $msg" |
|
2210
|
} |
|
2211
|
#puts "Skipping $info(file):$info(line)" |
|
2212
|
} |
|
2213
|
return $msg |
|
2214
|
} |
|
2215
|
|
|
2216
|
# Given the return from [catch {...} msg opts], returns an appropriate |
|
2217
|
# error message. A nice one for Jim and a less-nice one for Tcl. |
|
2218
|
# If 'fulltrace' is set, a full stack trace is provided. |
|
2219
|
# Otherwise a simple message is provided. |
|
2220
|
# |
|
2221
|
# This is designed for developer errors, e.g. in module code or auto.def code |
|
2222
|
# |
|
2223
|
# |
|
2224
|
proc error-dump {msg opts fulltrace} { |
|
2225
|
if {$::autosetup(istcl)} { |
|
2226
|
if {$fulltrace} { |
|
2227
|
return "Error: [dict get $opts -errorinfo]" |
|
2228
|
} else { |
|
2229
|
return "Error: $msg" |
|
2230
|
} |
|
2231
|
} else { |
|
2232
|
lassign $opts(-errorinfo) p f l |
|
2233
|
if {$f ne ""} { |
|
2234
|
set result "$f:$l: Error: " |
|
2235
|
} |
|
2236
|
append result "$msg\n" |
|
2237
|
if {$fulltrace} { |
|
2238
|
append result [stackdump $opts(-errorinfo)] |
|
2239
|
} |
|
2240
|
|
|
2241
|
# Remove the trailing newline |
|
2242
|
string trim $result |
|
2243
|
} |
|
2244
|
} |
|
2245
|
} |
|
2246
|
|
|
2247
|
# ----- @module text-formatting.tcl ----- |
|
2248
|
|
|
2249
|
set modsource(text-formatting.tcl) { |
|
2250
|
# Copyright (c) 2010 WorkWare Systems http://www.workware.net.au/ |
|
2251
|
# All rights reserved |
|
2252
|
|
|
2253
|
# Module which provides text formatting |
|
2254
|
|
|
2255
|
use formatting |
|
2256
|
|
|
2257
|
proc wordwrap {text length {firstprefix ""} {nextprefix ""}} { |
|
2258
|
set len 0 |
|
2259
|
set space $firstprefix |
|
2260
|
|
|
2261
|
foreach word [split $text] { |
|
2262
|
set word [string trim $word] |
|
2263
|
if {$word eq ""} { |
|
2264
|
continue |
|
2265
|
} |
|
2266
|
if {[info exists partial]} { |
|
2267
|
append partial " " $word |
|
2268
|
if {[string first $quote $word] < 0} { |
|
2269
|
# Haven't found end of quoted word |
|
2270
|
continue |
|
2271
|
} |
|
2272
|
# Finished quoted word |
|
2273
|
set word $partial |
|
2274
|
unset partial |
|
2275
|
unset quote |
|
2276
|
} else { |
|
2277
|
set quote [string index $word 0] |
|
2278
|
if {$quote in {' *}} { |
|
2279
|
if {[string first $quote $word 1] < 0} { |
|
2280
|
# Haven't found end of quoted word |
|
2281
|
# Not a whole word. |
|
2282
|
set first [string index $word 0] |
|
2283
|
# Start of quoted word |
|
2284
|
set partial $word |
|
2285
|
continue |
|
2286
|
} |
|
2287
|
} |
|
2288
|
} |
|
2289
|
|
|
2290
|
if {$len && [string length $space$word] + $len >= $length} { |
|
2291
|
puts "" |
|
2292
|
set len 0 |
|
2293
|
set space $nextprefix |
|
2294
|
} |
|
2295
|
incr len [string length $space$word] |
|
2296
|
|
|
2297
|
# Use man-page conventions for highlighting 'quoted' and *quoted* |
|
2298
|
# single words. |
|
2299
|
# Use x^Hx for *bold* and _^Hx for 'underline'. |
|
2300
|
# |
|
2301
|
# less and more will both understand this. |
|
2302
|
# Pipe through 'col -b' to remove them. |
|
2303
|
if {[regexp {^'(.*)'(.*)} $word -> quoted after]} { |
|
2304
|
set quoted [string map {~ " "} $quoted] |
|
2305
|
regsub -all . $quoted "&\b&" quoted |
|
2306
|
set word $quoted$after |
|
2307
|
} elseif {[regexp {^[*](.*)[*](.*)} $word -> quoted after]} { |
|
2308
|
set quoted [string map {~ " "} $quoted] |
|
2309
|
regsub -all . $quoted "_\b&" quoted |
|
2310
|
set word $quoted$after |
|
2311
|
} |
|
2312
|
puts -nonewline $space$word |
|
2313
|
set space " " |
|
2314
|
} |
|
2315
|
if {[info exists partial]} { |
|
2316
|
# Missing end of quote |
|
2317
|
puts -nonewline $space$partial |
|
2318
|
} |
|
2319
|
if {$len} { |
|
2320
|
puts "" |
|
2321
|
} |
|
2322
|
} |
|
2323
|
proc title {text} { |
|
2324
|
underline [string trim $text] = |
|
2325
|
nl |
|
2326
|
} |
|
2327
|
proc p {text} { |
|
2328
|
wordwrap $text 80 |
|
2329
|
nl |
|
2330
|
} |
|
2331
|
proc codelines {lines} { |
|
2332
|
foreach line $lines { |
|
2333
|
puts " $line" |
|
2334
|
} |
|
2335
|
nl |
|
2336
|
} |
|
2337
|
proc nl {} { |
|
2338
|
puts "" |
|
2339
|
} |
|
2340
|
proc underline {text char} { |
|
2341
|
regexp "^(\[ \t\]*)(.*)" $text -> indent words |
|
2342
|
puts $text |
|
2343
|
puts $indent[string repeat $char [string length $words]] |
|
2344
|
} |
|
2345
|
proc section {text} { |
|
2346
|
underline "[string trim $text]" - |
|
2347
|
nl |
|
2348
|
} |
|
2349
|
proc subsection {text} { |
|
2350
|
underline "$text" ~ |
|
2351
|
nl |
|
2352
|
} |
|
2353
|
proc bullet {text} { |
|
2354
|
wordwrap $text 76 " * " " " |
|
2355
|
} |
|
2356
|
proc indent {text} { |
|
2357
|
wordwrap $text 76 " " " " |
|
2358
|
} |
|
2359
|
proc defn {first args} { |
|
2360
|
if {$first ne ""} { |
|
2361
|
underline " $first" ~ |
|
2362
|
} |
|
2363
|
foreach p $args { |
|
2364
|
if {$p ne ""} { |
|
2365
|
indent $p |
|
2366
|
} |
|
2367
|
} |
|
2368
|
} |
|
2369
|
} |
|
2370
|
|
|
2371
|
# ----- @module util.tcl ----- |
|
2372
|
|
|
2373
|
set modsource(util.tcl) { |
|
2374
|
# Copyright (c) 2012 WorkWare Systems http://www.workware.net.au/ |
|
2375
|
# All rights reserved |
|
2376
|
|
|
2377
|
# Module which contains miscellaneous utility functions |
|
2378
|
|
|
2379
|
# @section Utilities |
|
2380
|
|
|
2381
|
# @compare-versions version1 version2 |
|
2382
|
# |
|
2383
|
# Versions are of the form 'a.b.c' (may be any number of numeric components) |
|
2384
|
# |
|
2385
|
# Compares the two versions and returns: |
|
2386
|
## -1 if v1 < v2 |
|
2387
|
## 0 if v1 == v2 |
|
2388
|
## 1 if v1 > v2 |
|
2389
|
# |
|
2390
|
# If one version has fewer components than the other, 0 is substituted to the right. e.g. |
|
2391
|
## 0.2 < 0.3 |
|
2392
|
## 0.2.5 > 0.2 |
|
2393
|
## 1.1 == 1.1.0 |
|
2394
|
# |
|
2395
|
proc compare-versions {v1 v2} { |
|
2396
|
foreach c1 [split $v1 .] c2 [split $v2 .] { |
|
2397
|
if {$c1 eq ""} { |
|
2398
|
set c1 0 |
|
2399
|
} |
|
2400
|
if {$c2 eq ""} { |
|
2401
|
set c2 0 |
|
2402
|
} |
|
2403
|
if {$c1 < $c2} { |
|
2404
|
return -1 |
|
2405
|
} |
|
2406
|
if {$c1 > $c2} { |
|
2407
|
return 1 |
|
2408
|
} |
|
2409
|
} |
|
2410
|
return 0 |
|
2411
|
} |
|
2412
|
|
|
2413
|
# @suffix suf list |
|
2414
|
# |
|
2415
|
# Takes a list and returns a new list with '$suf' appended |
|
2416
|
# to each element |
|
2417
|
# |
|
2418
|
## suffix .c {a b c} => {a.c b.c c.c} |
|
2419
|
# |
|
2420
|
proc suffix {suf list} { |
|
2421
|
set result {} |
|
2422
|
foreach p $list { |
|
2423
|
lappend result $p$suf |
|
2424
|
} |
|
2425
|
return $result |
|
2426
|
} |
|
2427
|
|
|
2428
|
# @prefix pre list |
|
2429
|
# |
|
2430
|
# Takes a list and returns a new list with '$pre' prepended |
|
2431
|
# to each element |
|
2432
|
# |
|
2433
|
## prefix jim- {a.c b.c} => {jim-a.c jim-b.c} |
|
2434
|
# |
|
2435
|
proc prefix {pre list} { |
|
2436
|
set result {} |
|
2437
|
foreach p $list { |
|
2438
|
lappend result $pre$p |
|
2439
|
} |
|
2440
|
return $result |
|
2441
|
} |
|
2442
|
|
|
2443
|
# @lpop list |
|
2444
|
# |
|
2445
|
# Removes the last entry from the given list and returns it. |
|
2446
|
proc lpop {listname} { |
|
2447
|
upvar $listname list |
|
2448
|
set val [lindex $list end] |
|
2449
|
set list [lrange $list 0 end-1] |
|
2450
|
return $val |
|
2451
|
} |
|
2452
|
} |
|
2453
|
|
|
2454
|
# ----- @module wiki-formatting.tcl ----- |
|
2455
|
|
|
2456
|
set modsource(wiki-formatting.tcl) { |
|
2457
|
# Copyright (c) 2010 WorkWare Systems http://www.workware.net.au/ |
|
2458
|
# All rights reserved |
|
2459
|
|
|
2460
|
# Module which provides text formatting |
|
2461
|
# wiki.tcl.tk format output |
|
2462
|
|
|
2463
|
use formatting |
|
2464
|
|
|
2465
|
proc joinlines {text} { |
|
2466
|
set lines {} |
|
2467
|
foreach l [split [string trim $text] \n] { |
|
2468
|
lappend lines [string trim $l] |
|
2469
|
} |
|
2470
|
join $lines |
|
2471
|
} |
|
2472
|
proc p {text} { |
|
2473
|
puts [joinlines $text] |
|
2474
|
puts "" |
|
2475
|
} |
|
2476
|
proc title {text} { |
|
2477
|
puts "*** [joinlines $text] ***" |
|
2478
|
puts "" |
|
2479
|
} |
|
2480
|
proc codelines {lines} { |
|
2481
|
puts "======" |
|
2482
|
foreach line $lines { |
|
2483
|
puts " $line" |
|
2484
|
} |
|
2485
|
puts "======" |
|
2486
|
} |
|
2487
|
proc code {text} { |
|
2488
|
puts "======" |
|
2489
|
foreach line [parse_code_block $text] { |
|
2490
|
puts " $line" |
|
2491
|
} |
|
2492
|
puts "======" |
|
2493
|
} |
|
2494
|
proc nl {} { |
|
2495
|
} |
|
2496
|
proc section {text} { |
|
2497
|
puts "'''$text'''" |
|
2498
|
puts "" |
|
2499
|
} |
|
2500
|
proc subsection {text} { |
|
2501
|
puts "''$text''" |
|
2502
|
puts "" |
|
2503
|
} |
|
2504
|
proc bullet {text} { |
|
2505
|
puts " * [joinlines $text]" |
|
2506
|
} |
|
2507
|
proc indent {text} { |
|
2508
|
puts " : [joinlines $text]" |
|
2509
|
} |
|
2510
|
proc defn {first args} { |
|
2511
|
if {$first ne ""} { |
|
2512
|
indent '''$first''' |
|
2513
|
} |
|
2514
|
|
|
2515
|
foreach p $args { |
|
2516
|
p $p |
|
2517
|
} |
|
2518
|
} |
|
2519
|
} |
|
2520
|
|
|
2521
|
|
|
2522
|
################################################################## |
|
2523
|
# |
|
2524
|
# Entry/Exit |
|
2525
|
# |
|
2526
|
if {$autosetup(debug)} { |
|
2527
|
main $argv |
|
2528
|
} |
|
2529
|
if {[catch {main $argv} msg opts] == 1} { |
|
2530
|
show-notices |
|
2531
|
autosetup-full-error [error-dump $msg $opts $autosetup(debug)] |
|
2532
|
if {!$autosetup(debug)} { |
|
2533
|
puts stderr "Try: '[file tail $autosetup(exe)] --debug' for a full stack trace" |
|
2534
|
} |
|
2535
|
exit 1 |
|
2536
|
} |
|
2537
|
|