autosetup
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 }