release/src/router/usbmodeswitch/jim/autosetup/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/find-tclsh`" "$0" "$@"
   7
   8 set autosetup(version) 0.6.3
   9
  10 # Can be set to 1 to debug early-init problems
  11 set autosetup(debug) 0
  12
  13 ##################################################################
  14 #
  15 # Main flow of control, option handling
  16 #
  17 proc main {argv} {
  18         global autosetup define
  19
  20         # There are 3 potential directories involved:
  21         # 1. The directory containing autosetup (this script)
  22         # 2. The directory containing auto.def
  23         # 3. The current directory
  24
  25         # From this we need to determine:
  26         # a. The path to this script (and related support files)
  27         # b. The path to auto.def
  28         # c. The build directory, where output files are created
  29
  30         # This is also complicated by the fact that autosetup may
  31         # have been run via the configure wrapper ([getenv WRAPPER] is set)
  32
  33         # Here are the rules.
  34         # a. This script is $::argv0
  35         #    => dir, prog, exe, libdir
  36         # b. auto.def is in the directory containing the configure wrapper,
  37         #    otherwise it is in the current directory.
  38         #    => srcdir, autodef
  39         # c. The build directory is the current directory
  40         #    => builddir, [pwd]
  41
  42         # 'misc' is needed before we can do anything, so set a temporary libdir
  43         # in case this is the development version
  44         set autosetup(libdir) [file dirname $::argv0]/lib
  45         use misc
  46
  47         # (a)
  48         set autosetup(dir) [realdir [file dirname [realpath $::argv0]]]
  49         set autosetup(prog) [file join $autosetup(dir) [file tail $::argv0]]
  50         set autosetup(exe) [getenv WRAPPER $autosetup(prog)]
  51         if {$autosetup(installed)} {
  52                 set autosetup(libdir) $autosetup(dir)
  53         } else {
  54                 set autosetup(libdir) [file join $autosetup(dir) lib]
  55         }
  56         autosetup_add_dep $autosetup(prog)
  57
  58         # (b)
  59         if {[getenv WRAPPER ""] eq ""} {
  60                 # Invoked directly
  61                 set autosetup(srcdir) [pwd]
  62         } else {
  63                 # Invoked via the configure wrapper
  64                 set autosetup(srcdir) [file dirname $autosetup(exe)]
  65         }
  66         set autosetup(autodef) [relative-path $autosetup(srcdir)/auto.def]
  67
  68         # (c)
  69         set autosetup(builddir) [pwd]
  70
  71         set autosetup(argv) $argv
  72         set autosetup(cmdline) {}
  73         set autosetup(options) {}
  74         set autosetup(optionhelp) {}
  75         set autosetup(showhelp) 0
  76
  77         # Parse options
  78         use getopt
  79
  80         array set ::useropts [getopt argv]
  81
  82         #"=Core Options:"
  83         options-add {
  84                 help:=local  => "display help and options. Optionally specify a module name, such as --help=system"
  85                 version      => "display the version of autosetup"
  86                 ref:=text manual:=text
  87                 reference:=text => "display the autosetup command reference. 'text', 'wiki', 'asciidoc' or 'markdown'"
  88                 debug        => "display debugging output as autosetup runs"
  89                 install:=.   => "install autosetup to the current or given directory (in the 'autosetup/' subdirectory)"
  90                 force init   => "create an initial 'configure' script if none exists"
  91                 # Undocumented options
  92                 option-checking=1
  93                 nopager
  94                 quiet
  95                 timing
  96                 conf:
  97         }
  98
  99         #parray ::useropts
 100         if {[opt-bool version]} {
 101                 puts $autosetup(version)
 102                 exit 0
 103         }
 104
 105         # autosetup --conf=alternate-auto.def
 106         if {[opt-val conf] ne ""} {
 107                 set autosetup(autodef) [opt-val conf]
 108         }
 109
 110         # Debugging output (set this early)
 111         incr autosetup(debug) [opt-bool debug]
 112         incr autosetup(force) [opt-bool force]
 113         incr autosetup(msg-quiet) [opt-bool quiet]
 114         incr autosetup(msg-timing) [opt-bool timing]
 115
 116         # If the local module exists, source it now to allow for
 117         # project-local customisations
 118         if {[file exists $autosetup(libdir)/local.tcl]} {
 119                 use local
 120         }
 121
 122         if {[opt-val help] ne ""} {
 123                 incr autosetup(showhelp)
 124                 use help
 125                 autosetup_help [opt-val help]
 126         }
 127
 128         if {[opt-val {manual ref reference}] ne ""} {
 129                 use help
 130                 autosetup_reference [opt-val {manual ref reference}]
 131         }
 132
 133         if {[opt-bool init]} {
 134                 use init
 135                 autosetup_init
 136         }
 137
 138         if {[opt-val install] ne ""} {
 139                 use install
 140                 autosetup_install [opt-val install]
 141         }
 142
 143         if {![file exists $autosetup(autodef)]} {
 144                 # Check for invalid option first
 145                 options {}
 146                 user-error "No auto.def found in $autosetup(srcdir)"
 147         }
 148
 149         # Parse extra arguments into autosetup(cmdline)
 150         foreach arg $argv {
 151                 if {[regexp {([^=]*)=(.*)} $arg -> n v]} {
 152                         dict set autosetup(cmdline) $n $v
 153                         define $n $v
 154                 } else {
 155                         user-error "Unexpected parameter: $arg"
 156                 }
 157         }
 158
 159         autosetup_add_dep $autosetup(autodef)
 160
 161         set cmd [file-normalize $autosetup(exe)]
 162         foreach arg $autosetup(argv) {
 163                 append cmd " [quote-if-needed $arg]"
 164         }
 165         define AUTOREMAKE $cmd
 166
 167         # Log how we were invoked
 168         configlog "Invoked as: [getenv WRAPPER $::argv0] [quote-argv $autosetup(argv)]"
 169
 170         source $autosetup(autodef)
 171
 172         # Could warn here if options {} was not specified
 173
 174         show-notices
 175
 176         if {$autosetup(debug)} {
 177                 parray define
 178         }
 179
 180         exit 0
 181 }
 182
 183 # @opt-bool option ...
 184 #
 185 # Check each of the named, boolean options and return 1 if any of them have
 186 # been set by the user.
 187 #
 188 proc opt-bool {args} {
 189         option-check-names {*}$args
 190         opt_bool ::useropts {*}$args
 191 }
 192
 193 # @opt-val option-list ?default=""?
 194 #
 195 # Returns a list containing all the values given for the non-boolean options in 'option-list'.
 196 # There will be one entry in the list for each option given by the user, including if the
 197 # same option was used multiple times.
 198 # If only a single value is required, use something like:
 199 #
 200 ## lindex [opt-val $names] end
 201 #
 202 # If no options were set, $default is returned (exactly, not as a list).
 203 #
 204 proc opt-val {names {default ""}} {
 205         option-check-names {*}$names
 206         join [opt_val ::useropts $names $default]
 207 }
 208
 209 proc option-check-names {args} {
 210         foreach o $args {
 211                 if {$o ni $::autosetup(options)} {
 212                         autosetup-error "Request for undeclared option --$o"
 213                 }
 214         }
 215 }
 216
 217 # Parse the option definition in $opts and update
 218 # ::useropts() and ::autosetup(optionhelp) appropriately
 219 #
 220 proc options-add {opts {header ""}} {
 221         global useropts autosetup
 222
 223         # First weed out comment lines
 224         set realopts {}
 225         foreach line [split $opts \n] {
 226                 if {![string match "#*" [string trimleft $line]]} {
 227                         append realopts $line \n
 228                 }
 229         }
 230         set opts $realopts
 231
 232         for {set i 0} {$i < [llength $opts]} {incr i} {
 233                 set opt [lindex $opts $i]
 234                 if {[string match =* $opt]} {
 235                         # This is a special heading
 236                         lappend autosetup(optionhelp) $opt ""
 237                         set header {}
 238                         continue
 239                 }
 240
 241                 #puts "i=$i, opt=$opt"
 242                 regexp {^([^:=]*)(:)?(=)?(.*)$} $opt -> name colon equal value
 243                 if {$name in $autosetup(options)} {
 244                         autosetup-error "Option $name already specified"
 245                 }
 246
 247                 #puts "$opt => $name $colon $equal $value"
 248
 249                 # Find the corresponding value in the user options
 250                 # and set the default if necessary
 251                 if {[string match "-*" $opt]} {
 252                         # This is a documentation-only option, like "-C <dir>"
 253                         set opthelp $opt
 254                 } elseif {$colon eq ""} {
 255                         # Boolean option
 256                         lappend autosetup(options) $name
 257
 258                         if {![info exists useropts($name)]} {
 259                                 set useropts($name) $value
 260                         }
 261                         if {$value eq "1"} {
 262                                 set opthelp "--disable-$name"
 263                         } else {
 264                                 set opthelp "--$name"
 265                         }
 266                 } else {
 267                         # String option.
 268                         lappend autosetup(options) $name
 269
 270                         if {$equal eq "="} {
 271                                 if {[info exists useropts($name)]} {
 272                                         # If the user specified the option with no value, the value will be "1"
 273                                         # Replace with the default
 274                                         if {$useropts($name) eq "1"} {
 275                                                 set useropts($name) $value
 276                                         }
 277                                 }
 278                                 set opthelp "--$name?=$value?"
 279                         } else {
 280                                 set opthelp "--$name=$value"
 281                         }
 282                 }
 283
 284                 # Now create the help for this option if appropriate
 285                 if {[lindex $opts $i+1] eq "=>"} {
 286                         set desc [lindex $opts $i+2]
 287                         #string match \n* $desc
 288                         if {$header ne ""} {
 289                                 lappend autosetup(optionhelp) $header ""
 290                                 set header ""
 291                         }
 292                         # A multi-line description
 293                         lappend autosetup(optionhelp) $opthelp $desc
 294                         incr i 2
 295                 }
 296         }
 297 }
 298
 299 # @module-options optionlist
 300 #
 301 # Like 'options', but used within a module.
 302 proc module-options {opts} {
 303         set header ""
 304         if {$::autosetup(showhelp) > 1 && [llength $opts]} {
 305                 set header "Module Options:"
 306         }
 307         options-add $opts $header
 308
 309         if {$::autosetup(showhelp)} {
 310                 # Ensure that the module isn't executed on --help
 311                 # We are running under eval or source, so use break
 312                 # to prevent further execution
 313                 #return -code break -level 2
 314                 return -code break
 315         }
 316 }
 317
 318 proc max {a b} {
 319         expr {$a > $b ? $a : $b}
 320 }
 321
 322 proc options-wrap-desc {text length firstprefix nextprefix initial} {
 323         set len $initial
 324         set space $firstprefix
 325         foreach word [split $text] {
 326                 set word [string trim $word]
 327                 if {$word == ""} {
 328                         continue
 329                 }
 330                 if {$len && [string length $space$word] + $len >= $length} {
 331                         puts ""
 332                         set len 0
 333                         set space $nextprefix
 334                 }
 335                 incr len [string length $space$word]
 336                 puts -nonewline $space$word
 337                 set space " "
 338         }
 339         if {$len} {
 340                 puts ""
 341         }
 342 }
 343
 344 proc options-show {} {
 345         # Determine the max option width
 346         set max 0
 347         foreach {opt desc} $::autosetup(optionhelp) {
 348                 if {[string match =* $opt] || [string match \n* $desc]} {
 349                         continue
 350                 }
 351                 set max [max $max [string length $opt]]
 352         }
 353         set indent [string repeat " " [expr $max+4]]
 354         set cols [getenv COLUMNS 80]
 355         catch {
 356                 lassign [exec stty size] rows cols
 357         }
 358         incr cols -1
 359         # Now output
 360         foreach {opt desc} $::autosetup(optionhelp) {
 361                 if {[string match =* $opt]} {
 362                         puts [string range $opt 1 end]
 363                         continue
 364                 }
 365                 puts -nonewline "  [format %-${max}s $opt]"
 366                 if {[string match \n* $desc]} {
 367                         puts $desc
 368                 } else {
 369                         options-wrap-desc [string trim $desc] $cols "  " $indent [expr $max + 2]
 370                 }
 371         }
 372 }
 373
 374 # @options options-spec
 375 #
 376 # Specifies configuration-time options which may be selected by the user
 377 # and checked with opt-val and opt-bool. The format of options-spec follows.
 378 #
 379 # A boolean option is of the form:
 380 #
 381 ## name[=0|1]  => "Description of this boolean option"
 382 #
 383 # The default is name=0, meaning that the option is disabled by default.
 384 # If name=1 is used to make the option enabled by default, the description should reflect
 385 # that with text like "Disable support for ...".
 386 #
 387 # An argument option (one which takes a parameter) is of the form:
 388 #
 389 ## name:[=]value  => "Description of this option"
 390 #
 391 # If the name:value form is used, the value must be provided with the option (as --name=myvalue).
 392 # If the name:=value form is used, the value is optional and the given value is used as the default
 393 # if is not provided.
 394 #
 395 # Undocumented options are also supported by omitting the "=> description.
 396 # These options are not displayed with --help and can be useful for internal options or as aliases.
 397 #
 398 # For example, --disable-lfs is an alias for --disable=largefile:
 399 #
 400 ## lfs=1 largefile=1 => "Disable large file support"
 401 #
 402 proc options {optlist} {
 403         # Allow options as a list or args
 404         options-add $optlist "Local Options:"
 405
 406         if {$::autosetup(showhelp)} {
 407                 options-show
 408                 exit 0
 409         }
 410
 411         # Check for invalid options
 412         if {[opt-bool option-checking]} {
 413                 foreach o [array names ::useropts] {
 414                         if {$o ni $::autosetup(options)} {
 415                                 user-error "Unknown option --$o"
 416                         }
 417                 }
 418         }
 419 }
 420
 421 proc config_guess {} {
 422         if {[file-isexec $::autosetup(dir)/config.guess]} {
 423                 exec-with-stderr sh $::autosetup(dir)/config.guess
 424         } else {
 425                 configlog "No config.guess, so using uname"
 426                 string tolower [exec uname -p]-unknown-[exec uname -s][exec uname -r]
 427         }
 428 }
 429
 430 proc config_sub {alias} {
 431         if {[file-isexec $::autosetup(dir)/config.sub]} {
 432                 exec-with-stderr sh $::autosetup(dir)/config.sub $alias
 433         } else {
 434                 return $alias
 435         }
 436 }
 437
 438 # @define name ?value=1?
 439 #
 440 # Defines the named variable to the given value.
 441 # These (name, value) pairs represent the results of the configuration check
 442 # and are available to be checked, modified and substituted.
 443 #
 444 proc define {name {value 1}} {
 445         set ::define($name) $value
 446         #dputs "$name <= $value"
 447 }
 448
 449 # @define-append name value ...
 450 #
 451 # Appends the given value(s) to the given 'defined' variable.
 452 # If the variable is not defined or empty, it is set to $value.
 453 # Otherwise the value is appended, separated by a space.
 454 # Any extra values are similarly appended.
 455 # If any value is already contained in the variable (as a substring) it is omitted.
 456 #
 457 proc define-append {name args} {
 458         if {[get-define $name ""] ne ""} {
 459                 # Make a token attempt to avoid duplicates
 460                 foreach arg $args {
 461                         if {[string first $arg $::define($name)] == -1} {
 462                                 append ::define($name) " " $arg
 463                         }
 464                 }
 465         } else {
 466                 set ::define($name) [join $args]
 467         }
 468         #dputs "$name += [join $args] => $::define($name)"
 469 }
 470
 471 # @get-define name ?default=0?
 472 #
 473 # Returns the current value of the 'defined' variable, or $default
 474 # if not set.
 475 #
 476 proc get-define {name {default 0}} {
 477         if {[info exists ::define($name)]} {
 478                 #dputs "$name => $::define($name)"
 479                 return $::define($name)
 480         }
 481         #dputs "$name => $default"
 482         return $default
 483 }
 484
 485 # @is-defined name
 486 #
 487 # Returns 1 if the given variable is defined.
 488 #
 489 proc is-defined {name} {
 490         info exists ::define($name)
 491 }
 492
 493 # @all-defines
 494 #
 495 # Returns a dictionary (name value list) of all defined variables.
 496 #
 497 # This is suitable for use with 'dict', 'array set' or 'foreach'
 498 # and allows for arbitrary processing of the defined variables.
 499 #
 500 proc all-defines {} {
 501         array get ::define
 502 }
 503
 504
 505 # @get-env name default
 506 #
 507 # If $name was specified on the command line, return it.
 508 # If $name was set in the environment, return it.
 509 # Otherwise return $default.
 510 #
 511 proc get-env {name default} {
 512         if {[dict exists $::autosetup(cmdline) $name]} {
 513                 return [dict get $::autosetup(cmdline) $name]
 514         }
 515         getenv $name $default
 516 }
 517
 518 # @env-is-set name
 519 #
 520 # Returns 1 if the $name was specified on the command line or in the environment.
 521 # Note that an empty environment variable is not considered to be set.
 522 #
 523 proc env-is-set {name} {
 524         if {[dict exists $::autosetup(cmdline) $name]} {
 525                 return 1
 526         }
 527         if {[getenv $name ""] ne ""} {
 528                 return 1
 529         }
 530         return 0
 531 }
 532
 533 # @readfile filename ?default=""?
 534 #
 535 # Return the contents of the file, without the trailing newline.
 536 # If the doesn't exist or can't be read, returns $default.
 537 #
 538 proc readfile {filename {default_value ""}} {
 539         set result $default_value
 540         catch {
 541                 set f [open $filename]
 542                 set result [read -nonewline $f]
 543                 close $f
 544         }
 545         return $result
 546 }
 547
 548 # @writefile filename value
 549 #
 550 # Creates the given file containing $value.
 551 # Does not add an extra newline.
 552 #
 553 proc writefile {filename value} {
 554         set f [open $filename w]
 555         puts -nonewline $f $value
 556         close $f
 557 }
 558
 559 proc quote-if-needed {str} {
 560         if {[string match {*[\" ]*} $str]} {
 561                 return \"[string map [list \" \\" \\ \\\\] $str]\"
 562         }
 563         return $str
 564 }
 565
 566 proc quote-argv {argv} {
 567         set args {}
 568         foreach arg $argv {
 569                 lappend args [quote-if-needed $arg]
 570         }
 571         join $args
 572 }
 573
 574 # @suffix suf list
 575 #
 576 # Takes a list and returns a new list with $suf appended
 577 # to each element
 578 #
 579 ## suffix .c {a b c} => {a.c b.c c.c}
 580 #
 581 proc suffix {suf list} {
 582         set result {}
 583         foreach p $list {
 584                 lappend result $p$suf
 585         }
 586         return $result
 587 }
 588
 589 # @prefix pre list
 590 #
 591 # Takes a list and returns a new list with $pre prepended
 592 # to each element
 593 #
 594 ## prefix jim- {a.c b.c} => {jim-a.c jim-b.c}
 595 #
 596 proc prefix {pre list} {
 597         set result {}
 598         foreach p $list {
 599                 lappend result $pre$p
 600         }
 601         return $result
 602 }
 603
 604 # @find-executable name
 605 #
 606 # Searches the path for an executable with the given name.
 607 # Note that the name may include some parameters, e.g. "cc -mbig-endian",
 608 # in which case the parameters are ignored.
 609 # Returns 1 if found, or 0 if not.
 610 #
 611 proc find-executable {name} {
 612         # Ignore any parameters
 613         set name [lindex $name 0]
 614         if {$name eq ""} {
 615                 # The empty string is never a valid executable
 616                 return 0
 617         }
 618         foreach p [split-path] {
 619                 dputs "Looking for $name in $p"
 620                 set exec [file join $p $name]
 621                 if {[file-isexec $exec]} {
 622                         dputs "Found $name -> $exec"
 623                         return 1
 624                 }
 625         }
 626         return 0
 627 }
 628
 629 # @find-an-executable ?-required? name ...
 630 #
 631 # Given a list of possible executable names,
 632 # searches for one of these on the path.
 633 #
 634 # Returns the name found, or "" if none found.
 635 # If the first parameter is '-required', an error is generated
 636 # if no executable is found.
 637 #
 638 proc find-an-executable {args} {
 639         set required 0
 640         if {[lindex $args 0] eq "-required"} {
 641                 set args [lrange $args 1 end]
 642                 incr required
 643         }
 644         foreach name $args {
 645                 if {[find-executable $name]} {
 646                         return $name
 647                 }
 648         }
 649         if {$required} {
 650                 if {[llength $args] == 1} {
 651                         user-error "failed to find: [join $args]"
 652                 } else {
 653                         user-error "failed to find one of: [join $args]"
 654                 }
 655         }
 656         return ""
 657 }
 658
 659 # @configlog msg
 660 #
 661 # Writes the given message to the configuration log, config.log
 662 #
 663 proc configlog {msg} {
 664         if {![info exists ::autosetup(logfh)]} {
 665                 set ::autosetup(logfh) [open config.log w]
 666         }
 667         puts $::autosetup(logfh) $msg
 668 }
 669
 670 # @msg-checking msg
 671 #
 672 # Writes the message with no newline to stdout.
 673 #
 674 proc msg-checking {msg} {
 675         if {$::autosetup(msg-quiet) == 0} {
 676                 maybe-show-timestamp
 677                 puts -nonewline $msg
 678                 set ::autosetup(msg-checking) 1
 679         }
 680 }
 681
 682 # @msg-result msg
 683 #
 684 # Writes the message to stdout.
 685 #
 686 proc msg-result {msg} {
 687         if {$::autosetup(msg-quiet) == 0} {
 688                 maybe-show-timestamp
 689                 puts $msg
 690                 set ::autosetup(msg-checking) 0
 691                 show-notices
 692         }
 693 }
 694
 695 # @msg-quiet command ...
 696 #
 697 # msg-quiet evaluates it's arguments as a command with output
 698 # from msg-checking and msg-result suppressed.
 699 #
 700 # This is useful if a check needs to run a subcheck which isn't
 701 # of interest to the user.
 702 proc msg-quiet {args} {
 703         incr ::autosetup(msg-quiet)
 704         set rc [uplevel 1 $args]
 705         incr ::autosetup(msg-quiet) -1
 706         return $rc
 707 }
 708
 709 # Will be overridden by 'use misc'
 710 proc error-stacktrace {msg} {
 711         return $msg
 712 }
 713
 714 proc error-location {msg} {
 715         return $msg
 716 }
 717
 718 ##################################################################
 719 #
 720 # Debugging output
 721 #
 722 proc dputs {msg} {
 723         if {$::autosetup(debug)} {
 724                 puts $msg
 725         }
 726 }
 727
 728 ##################################################################
 729 #
 730 # User and system warnings and errors
 731 #
 732 # Usage errors such as wrong command line options
 733
 734 # @user-error msg
 735 #
 736 # Indicate incorrect usage to the user, including if required components
 737 # or features are not found.
 738 # autosetup exits with a non-zero return code.
 739 #
 740 proc user-error {msg} {
 741         show-notices
 742         puts stderr "Error: $msg"
 743         puts stderr "Try: '[file tail $::autosetup(exe)] --help' for options"
 744         exit 1
 745 }
 746
 747 # @user-notice msg
 748 #
 749 # Output the given message to stderr.
 750 #
 751 proc user-notice {msg} {
 752         lappend ::autosetup(notices) $msg
 753 }
 754
 755 # Incorrect usage in the auto.def file. Identify the location.
 756 proc autosetup-error {msg} {
 757         show-notices
 758         puts stderr [error-location $msg]
 759         exit 1
 760 }
 761
 762 proc show-notices {} {
 763         if {$::autosetup(msg-checking)} {
 764                 puts ""
 765                 set ::autosetup(msg-checking) 0
 766         }
 767         flush stdout
 768         if {[info exists ::autosetup(notices)]} {
 769                 puts stderr [join $::autosetup(notices) \n]
 770                 unset ::autosetup(notices)
 771         }
 772 }
 773
 774 proc maybe-show-timestamp {} {
 775         if {$::autosetup(msg-timing) && $::autosetup(msg-checking) == 0} {
 776                 puts -nonewline [format {[%6.2f] } [expr {([clock millis] - $::autosetup(start)) % 10000 / 1000.0}]]
 777         }
 778 }
 779
 780 proc autosetup_version {} {
 781         return "autosetup v$::autosetup(version)"
 782 }
 783
 784 ##################################################################
 785 #
 786 # Directory/path handling
 787 #
 788
 789 proc realdir {dir} {
 790         set oldpwd [pwd]
 791         cd $dir
 792         set pwd [pwd]
 793         cd $oldpwd
 794         return $pwd
 795 }
 796
 797 # Follow symlinks until we get to something which is not a symlink
 798 proc realpath {path} {
 799         while {1} {
 800                 if {[catch {
 801                         set path [file link $path]
 802                 }]} {
 803                         # Not a link
 804                         break
 805                 }
 806         }
 807         return $path
 808 }
 809
 810 # Convert absolute path, $path into a path relative
 811 # to the given directory (or the current dir, if not given).
 812 #
 813 proc relative-path {path {pwd {}}} {
 814         set diff 0
 815         set same 0
 816         set newf {}
 817         set prefix {}
 818         set path [file-normalize $path]
 819         if {$pwd eq ""} {
 820                 set pwd [pwd]
 821         } else {
 822                 set pwd [file-normalize $pwd]
 823         }
 824
 825         if {$path eq $pwd} {
 826                 return .
 827         }
 828
 829         # Try to make the filename relative to the current dir
 830         foreach p [split $pwd /] f [split $path /] {
 831                 if {$p ne $f} {
 832                         incr diff
 833                 } elseif {!$diff} {
 834                         incr same
 835                 }
 836                 if {$diff} {
 837                         if {$p ne ""} {
 838                                 # Add .. for sibling or parent dir
 839                                 lappend prefix ..
 840                         }
 841                         if {$f ne ""} {
 842                                 lappend newf $f
 843                         }
 844                 }
 845         }
 846         if {$same == 1 || [llength $prefix] > 3} {
 847                 return $path
 848         }
 849
 850         file join [join $prefix /] [join $newf /]
 851 }
 852
 853 # Add filename as a dependency to rerun autosetup
 854 # The name will be normalised (converted to a full path)
 855 #
 856 proc autosetup_add_dep {filename} {
 857         lappend ::autosetup(deps) [file-normalize $filename]
 858 }
 859
 860 ##################################################################
 861 #
 862 # Library module support
 863 #
 864
 865 # @use module ...
 866 #
 867 # Load the given library modules.
 868 # e.g. use cc cc-shared
 869 #
 870 proc use {args} {
 871         foreach m $args {
 872                 if {[info exists ::libmodule($m)]} {
 873                         continue
 874                 }
 875                 set ::libmodule($m) 1
 876                 if {[info exists ::modsource($m)]} {
 877                         uplevel #0 eval $::modsource($m)
 878                 } else {
 879                         set source $::autosetup(libdir)/${m}.tcl
 880                         if {[file exists $source]} {
 881                                 uplevel #0 [list source $source]
 882                                 autosetup_add_dep $source
 883                         } else {
 884                                 puts "Looking for $source"
 885                                 autosetup-error "use: No such module: $m"
 886                         }
 887                 }
 888         }
 889 }
 890
 891 # Initial settings
 892 set autosetup(exe) $::argv0
 893 set autosetup(istcl) 1
 894 set autosetup(start) [clock millis]
 895 set autosetup(installed) 0
 896 set autosetup(msg-checking) 0
 897 set autosetup(msg-quiet) 0
 898
 899 # Embedded modules are inserted below here
 900 set autosetup(installed) 1
 901 # ----- module asciidoc-formatting -----
 902
 903 set modsource(asciidoc-formatting) {
 904 # Copyright (c) 2010 WorkWare Systems http://www.workware.net.au/
 905 # All rights reserved
 906
 907 # Module which provides text formatting
 908 # asciidoc format
 909
 910 use formatting
 911
 912 proc para {text} {
 913     regsub -all "\[ \t\n\]+" [string trim $text] " "
 914 }
 915 proc title {text} {
 916     underline [para $text] =
 917     nl
 918 }
 919 proc p {text} {
 920     puts [para $text]
 921     nl
 922 }
 923 proc code {text} {
 924     foreach line [parse_code_block $text] {
 925         puts "    $line"
 926     }
 927     nl
 928 }
 929 proc codelines {lines} {
 930     foreach line $lines {
 931         puts "    $line"
 932     }
 933     nl
 934 }
 935 proc nl {} {
 936     puts ""
 937 }
 938 proc underline {text char} {
 939     regexp "^(\[ \t\]*)(.*)" $text -> indent words
 940     puts $text
 941     puts $indent[string repeat $char [string length $words]]
 942 }
 943 proc section {text} {
 944     underline "[para $text]" -
 945     nl
 946 }
 947 proc subsection {text} {
 948     underline "$text" ~
 949     nl
 950 }
 951 proc bullet {text} {
 952     puts "* [para $text]"
 953 }
 954 proc indent {text} {
 955     puts " :: "
 956     puts [para $text]
 957 }
 958 proc defn {first args} {
 959     set sep ""
 960     if {$first ne ""} {
 961         puts "${first}::"
 962     } else {
 963         puts " :: "
 964     }
 965     set defn [string trim [join $args \n]]
 966     regsub -all "\n\n" $defn "\n ::\n" defn
 967     puts $defn
 968 }
 969 }
 970
 971 # ----- module formatting -----
 972
 973 set modsource(formatting) {
 974 # Copyright (c) 2010 WorkWare Systems http://www.workware.net.au/
 975 # All rights reserved
 976
 977 # Module which provides common text formatting
 978
 979 # This is designed for documenation which looks like:
 980 # code {...}
 981 # or
 982 # code {
 983 #    ...
 984 #    ...
 985 # }
 986 # In the second case, we need to work out the indenting
 987 # and strip it from all lines but preserve the remaining indenting.
 988 # Note that all lines need to be indented with the same initial
 989 # spaces/tabs.
 990 #
 991 # Returns a list of lines with the indenting removed.
 992 #
 993 proc parse_code_block {text} {
 994     # If the text begins with newline, take the following text,
 995     # otherwise just return the original
 996     if {![regexp "^\n(.*)" $text -> text]} {
 997         return [list [string trim $text]]
 998     }
 999
1000     # And trip spaces off the end
1001     set text [string trimright $text]
1002
1003     set min 100
1004     # Examine each line to determine the minimum indent
1005     foreach line [split $text \n] {
1006         if {$line eq ""} {
1007             # Ignore empty lines for the indent calculation
1008             continue
1009         }
1010         regexp "^(\[ \t\]*)" $line -> indent
1011         set len [string length $indent]
1012         if {$len < $min} {
1013             set min $len
1014         }
1015     }
1016
1017     # Now make a list of lines with this indent removed
1018     set lines {}
1019     foreach line [split $text \n] {
1020         lappend lines [string range $line $min end]
1021     }
1022
1023     # Return the result
1024     return $lines
1025 }
1026 }
1027
1028 # ----- module getopt -----
1029
1030 set modsource(getopt) {
1031 # Copyright (c) 2006 WorkWare Systems http://www.workware.net.au/
1032 # All rights reserved
1033
1034 # Simple getopt module
1035
1036 # Parse everything out of the argv list which looks like an option
1037 # Knows about --enable-thing and --disable-thing as alternatives for --thing=0 or --thing=1
1038 # Everything which doesn't look like an option, or is after --, is left unchanged
1039 proc getopt {argvname} {
1040         upvar $argvname argv
1041         set nargv {}
1042
1043         for {set i 0} {$i < [llength $argv]} {incr i} {
1044                 set arg [lindex $argv $i]
1045
1046                 #dputs arg=$arg
1047
1048                 if {$arg eq "--"} {
1049                         # End of options
1050                         incr i
1051                         lappend nargv {*}[lrange $argv $i end]
1052                         break
1053                 }
1054
1055                 if {[regexp {^--([^=][^=]+)=(.*)$} $arg -> name value]} {
1056                         lappend opts($name) $value
1057                 } elseif {[regexp {^--(enable-|disable-)?([^=]*)$} $arg -> prefix name]} {
1058                         if {$prefix eq "disable-"} {
1059                                 set value 0
1060                         } else {
1061                                 set value 1
1062                         }
1063                         lappend opts($name) $value
1064                 } else {
1065                         lappend nargv $arg
1066                 }
1067         }
1068
1069         #puts "getopt: argv=[join $argv] => [join $nargv]"
1070         #parray opts
1071
1072         set argv $nargv
1073
1074         return [array get opts]
1075 }
1076
1077 proc opt_val {optarrayname options {default {}}} {
1078         upvar $optarrayname opts
1079
1080         set result {}
1081
1082         foreach o $options {
1083                 if {[info exists opts($o)]} {
1084                         lappend result {*}$opts($o)
1085                 }
1086         }
1087         if {[llength $result] == 0} {
1088                 return $default
1089         }
1090         return $result
1091 }
1092
1093 proc opt_bool {optarrayname args} {
1094         upvar $optarrayname opts
1095
1096         # Support the args being passed as a list
1097         if {[llength $args] == 1} {
1098                 set args [lindex $args 0]
1099         }
1100
1101         foreach o $args {
1102                 if {[info exists opts($o)]} {
1103                         if {"1" in $opts($o) || "yes" in $opts($o)} {
1104                                 return 1
1105                         }
1106                 }
1107         }
1108         return 0
1109 }
1110 }
1111
1112 # ----- module help -----
1113
1114 set modsource(help) {
1115 # Copyright (c) 2010 WorkWare Systems http://workware.net.au/
1116 # All rights reserved
1117
1118 # Module which provides usage, help and the command reference
1119
1120 proc autosetup_help {what} {
1121     use_pager
1122
1123     puts "Usage: [file tail $::autosetup(exe)] \[options\] \[settings\]\n"
1124     puts "This is [autosetup_version], a build environment \"autoconfigurator\""
1125     puts "See the documentation online at http://msteveb.github.com/autosetup/\n"
1126
1127     if {$what eq "local"} {
1128         if {[file exists $::autosetup(autodef)]} {
1129             # This relies on auto.def having a call to 'options'
1130             # which will display options and quit
1131             source $::autosetup(autodef)
1132         } else {
1133             options-show
1134         }
1135     } else {
1136         incr ::autosetup(showhelp)
1137         if {[catch {use $what}]} {
1138             user-error "Unknown module: $what"
1139         } else {
1140             options-show
1141         }
1142     }
1143     exit 0
1144 }
1145
1146 # If not already paged and stdout is a tty, pipe the output through the pager
1147 # This is done by reinvoking autosetup with --nopager added
1148 proc use_pager {} {
1149     if {![opt-bool nopager] && [getenv PAGER ""] ne "" && ![string match "not a tty" [exec tty]]} {
1150         catch {
1151             exec [info nameofexecutable] $::argv0 --nopager {*}$::argv | [getenv PAGER] >@stdout <@stdin 2>/dev/null
1152         }
1153         exit 0
1154     }
1155 }
1156
1157 # Outputs the autosetup references in one of several formats
1158 proc autosetup_reference {{type text}} {
1159
1160     use_pager
1161
1162     switch -glob -- $type {
1163         wiki {use wiki-formatting}
1164         ascii* {use asciidoc-formatting}
1165         md - markdown {use markdown-formatting}
1166         default {use text-formatting}
1167     }
1168
1169     title "[autosetup_version] -- Command Reference"
1170
1171     section {Introduction}
1172
1173     p {
1174         See http://msteveb.github.com/autosetup/ for the online documentation for 'autosetup'
1175     }
1176
1177     p {
1178         'autosetup' provides a number of built-in commands which
1179         are documented below. These may be used from 'auto.def' to test
1180         for features, define variables, create files from templates and
1181         other similar actions.
1182     }
1183
1184     automf_command_reference
1185
1186     exit 0
1187 }
1188
1189 proc autosetup_output_block {type lines} {
1190     if {[llength $lines]} {
1191         switch $type {
1192             code {
1193                 codelines $lines
1194             }
1195             p {
1196                 p [join $lines]
1197             }
1198             list {
1199                 foreach line $lines {
1200                     bullet $line
1201                 }
1202                 nl
1203             }
1204         }
1205     }
1206 }
1207
1208 # Generate a command reference from inline documentation
1209 proc automf_command_reference {} {
1210     lappend files $::autosetup(prog)
1211     lappend files {*}[lsort [glob -nocomplain $::autosetup(libdir)/*.tcl]]
1212
1213     section "Core Commands"
1214     set type p
1215     set lines {}
1216     set cmd {}
1217
1218     foreach file $files {
1219         set f [open $file]
1220         while {![eof $f]} {
1221             set line [gets $f]
1222
1223             # Find lines starting with "# @*" and continuing through the remaining comment lines
1224             if {![regexp {^# @(.*)} $line -> cmd]} {
1225                 continue
1226             }
1227
1228             # Synopsis or command?
1229             if {$cmd eq "synopsis:"} {
1230                 section "Module: [file rootname [file tail $file]]"
1231             } else {
1232                 subsection $cmd
1233             }
1234
1235             set lines {}
1236             set type p
1237
1238             # Now the description
1239             while {![eof $f]} {
1240                 set line [gets $f]
1241
1242                 if {![regexp {^#(#)? ?(.*)} $line -> hash cmd]} {
1243                     break
1244                 }
1245                 if {$hash eq "#"} {
1246                     set t code
1247                 } elseif {[regexp {^- (.*)} $cmd -> cmd]} {
1248                     set t list
1249                 } else {
1250                     set t p
1251                 }
1252
1253                 #puts "hash=$hash, oldhash=$oldhash, lines=[llength $lines], cmd=$cmd"
1254
1255                 if {$t ne $type || $cmd eq ""} {
1256                     # Finish the current block
1257                     autosetup_output_block $type $lines
1258                     set lines {}
1259                     set type $t
1260                 }
1261                 if {$cmd ne ""} {
1262                     lappend lines $cmd
1263                 }
1264             }
1265
1266             autosetup_output_block $type $lines
1267         }
1268         close $f
1269     }
1270 }
1271 }
1272
1273 # ----- module init -----
1274
1275 set modsource(init) {
1276 # Copyright (c) 2010 WorkWare Systems http://www.workware.net.au/
1277 # All rights reserved
1278
1279 # Module to help create auto.def and configure
1280
1281 proc autosetup_init {} {
1282         set create_configure 1
1283         if {[file exists configure]} {
1284                 if {!$::autosetup(force)} {
1285                         # Could this be an autosetup configure?
1286                         if {![string match "*\nWRAPPER=*" [readfile configure]]} {
1287                                 puts "I see configure, but not created by autosetup, so I won't overwrite it."
1288                                 puts "Use autosetup --init --force to overwrite."
1289                                 set create_configure 0
1290                         }
1291                 } else {
1292                         puts "I will overwrite the existing configure because you used --force."
1293                 }
1294         } else {
1295                 puts "I don't see configure, so I will create it."
1296         }
1297         if {$create_configure} {
1298                 if {!$::autosetup(installed)} {
1299                         user-notice "Warning: Initialising from the development version of autosetup"
1300
1301                         writefile configure "#!/bin/sh\nWRAPPER=\"\$0\" exec $::autosetup(dir)/autosetup \"\$@\"\n"
1302                 } else {
1303                         writefile configure \
1304 {#!/bin/sh
1305 dir="`dirname "$0"`/autosetup"
1306 WRAPPER="$0" exec "`$dir/find-tclsh`" "$dir/autosetup" "$@"
1307 }
1308                 }
1309                 catch {exec chmod 755 configure}
1310         }
1311         if {![file exists auto.def]} {
1312                 puts "I don't see auto.def, so I will create a default one."
1313                 writefile auto.def {# Initial auto.def created by 'autosetup --init'
1314
1315 use cc
1316
1317 # Add any user options here
1318 options {
1319 }
1320
1321 make-config-header config.h
1322 make-template Makefile.in
1323 }
1324         }
1325         if {![file exists Makefile.in]} {
1326                 puts "Note: I don't see Makefile.in. You will probably need to create one."
1327         }
1328
1329         exit 0
1330 }
1331 }
1332
1333 # ----- module install -----
1334
1335 set modsource(install) {
1336 # Copyright (c) 2006-2010 WorkWare Systems http://www.workware.net.au/
1337 # All rights reserved
1338
1339 # Module which can install autosetup
1340
1341 proc autosetup_install {dir} {
1342         if {[catch {
1343                 cd $dir
1344                 file mkdir autosetup
1345
1346                 set f [open autosetup/autosetup w]
1347
1348                 set publicmodules {}
1349
1350                 # First the main script, but only up until "CUT HERE"
1351                 set in [open $::autosetup(dir)/autosetup]
1352                 while {[gets $in buf] >= 0} {
1353                         if {$buf ne "##-- CUT HERE --##"} {
1354                                 puts $f $buf
1355                                 continue
1356                         }
1357
1358                         # Insert the static modules here
1359                         # i.e. those which don't contain @synopsis:
1360                         puts $f "set autosetup(installed) 1"
1361                         foreach file [lsort [glob $::autosetup(libdir)/*.tcl]] {
1362                                 set buf [readfile $file]
1363                                 if {[string match "*\n# @synopsis:*" $buf]} {
1364                                         lappend publicmodules $file
1365                                         continue
1366                                 }
1367                                 set modname [file rootname [file tail $file]]
1368                                 puts $f "# ----- module $modname -----"
1369                                 puts $f "\nset modsource($modname) \{"
1370                                 puts $f $buf
1371                                 puts $f "\}\n"
1372                         }
1373                 }
1374                 close $in
1375                 close $f
1376                 exec chmod 755 autosetup/autosetup
1377
1378                 # Install public modules
1379                 foreach file $publicmodules {
1380                         autosetup_install_file $file autosetup
1381                 }
1382
1383                 # Install support files
1384                 foreach file {config.guess config.sub jimsh0.c find-tclsh test-tclsh LICENSE} {
1385                         autosetup_install_file $::autosetup(dir)/$file autosetup
1386                 }
1387                 exec chmod 755 autosetup/config.sub autosetup/config.guess autosetup/find-tclsh
1388
1389                 writefile autosetup/README.autosetup \
1390                         "This is [autosetup_version]. See http://msteveb.github.com/autosetup/\n"
1391
1392         } error]} {
1393                 user-error "Failed to install autosetup: $error"
1394         }
1395         puts "Installed [autosetup_version] to autosetup/"
1396         catch {exec [info nameofexecutable] autosetup/autosetup --init >@stdout 2>@stderr}
1397
1398         exit 0
1399 }
1400
1401 # Append the contents of $file to filehandle $f
1402 proc autosetup_install_append {f file} {
1403         set in [open $file]
1404         puts $f [read $in]
1405         close $in
1406 }
1407
1408 proc autosetup_install_file {file dir} {
1409         if {![file exists $file]} {
1410                 error "Missing installation file '$file'"
1411         }
1412         writefile [file join $dir [file tail $file]] [readfile $file]\n
1413 }
1414
1415 if {$::autosetup(installed)} {
1416         user-error "autosetup can only be installed from development source, not from installed copy"
1417 }
1418 }
1419
1420 # ----- module markdown-formatting -----
1421
1422 set modsource(markdown-formatting) {
1423 # Copyright (c) 2010 WorkWare Systems http://www.workware.net.au/
1424 # All rights reserved
1425
1426 # Module which provides text formatting
1427 # markdown format (kramdown syntax)
1428
1429 use formatting
1430
1431 proc para {text} {
1432     regsub -all "\[ \t\n\]+" [string trim $text] " " text
1433     regsub -all {([^a-zA-Z])'([^']*)'} $text {\1**`\2`**} text
1434     regsub -all {^'([^']*)'} $text {**`\1`**} text
1435     regsub -all {(http[^ \t\n]*)} $text {[\1](\1)} text
1436     return $text
1437 }
1438 proc title {text} {
1439     underline [para $text] =
1440     nl
1441 }
1442 proc p {text} {
1443     puts [para $text]
1444     nl
1445 }
1446 proc codelines {lines} {
1447     puts "~~~~~~~~~~~~"
1448     foreach line $lines {
1449         puts $line
1450     }
1451     puts "~~~~~~~~~~~~"
1452     nl
1453 }
1454 proc code {text} {
1455     puts "~~~~~~~~~~~~"
1456     foreach line [parse_code_block $text] {
1457         puts $line
1458     }
1459     puts "~~~~~~~~~~~~"
1460     nl
1461 }
1462 proc nl {} {
1463     puts ""
1464 }
1465 proc underline {text char} {
1466     regexp "^(\[ \t\]*)(.*)" $text -> indent words
1467     puts $text
1468     puts $indent[string repeat $char [string length $words]]
1469 }
1470 proc section {text} {
1471     underline "[para $text]" -
1472     nl
1473 }
1474 proc subsection {text} {
1475     puts "### `$text`"
1476     nl
1477 }
1478 proc bullet {text} {
1479     puts "* [para $text]"
1480 }
1481 proc defn {first args} {
1482     puts "^"
1483     set defn [string trim [join $args \n]]
1484     if {$first ne ""} {
1485         puts "**${first}**"
1486         puts -nonewline ": "
1487         regsub -all "\n\n" $defn "\n: " defn
1488     }
1489     puts "$defn"
1490 }
1491 }
1492
1493 # ----- module misc -----
1494
1495 set modsource(misc) {
1496 # Copyright (c) 2007-2010 WorkWare Systems http://www.workware.net.au/
1497 # All rights reserved
1498
1499 # Module containing misc procs useful to modules
1500 # Largely for platform compatibility
1501
1502 set autosetup(istcl) [info exists ::tcl_library]
1503 set autosetup(iswin) [string equal windows $tcl_platform(platform)]
1504
1505 if {$autosetup(iswin)} {
1506         # mingw/windows separates $PATH with semicolons
1507         # and doesn't have an executable bit
1508         proc split-path {} {
1509                 split [getenv PATH .] {;}
1510         }
1511         proc file-isexec {exec} {
1512                 # Basic test for windows. We ignore .bat
1513                 if {[file isfile $exec] || [file isfile $exec.exe]} {
1514                         return 1
1515                 }
1516                 return 0
1517         }
1518 } else {
1519         # unix separates $PATH with colons and has and executable bit
1520         proc split-path {} {
1521                 split [getenv PATH .] :
1522         }
1523         proc file-isexec {exec} {
1524                 file executable $exec
1525         }
1526 }
1527
1528 # Assume that exec can return stdout and stderr
1529 proc exec-with-stderr {args} {
1530         exec {*}$args 2>@1
1531 }
1532
1533 if {$autosetup(istcl)} {
1534         # Tcl doesn't have the env command
1535         proc getenv {name args} {
1536                 if {[info exists ::env($name)]} {
1537                         return $::env($name)
1538                 }
1539                 if {[llength $args]} {
1540                         return [lindex $args 0]
1541                 }
1542                 return -code error "environment variable \"$name\" does not exist"
1543         }
1544 } elseif {$autosetup(iswin)} {
1545         # On Windows, backslash convert all environment variables
1546         # (Assume that Tcl does this for us)
1547         proc getenv {name args} {
1548                 string map {\\ /} [env $name {*}$args]
1549         }
1550 } else {
1551         # Jim on unix is simple
1552         alias getenv env
1553 }
1554
1555 # In case 'file normalize' doesn't exist
1556 #
1557 proc file-normalize {path} {
1558         if {[catch {file normalize $path} result]} {
1559                 if {$path eq ""} {
1560                         return ""
1561                 }
1562                 set oldpwd [pwd]
1563                 if {[file isdir $path]} {
1564                         cd $path
1565                         set result [pwd]
1566                 } else {
1567                         cd [file dirname $path]
1568                         set result [file join [pwd] [file tail $path]]
1569                 }
1570                 cd $oldpwd
1571         }
1572         return $result
1573 }
1574
1575 # If everything is working properly, the only errors which occur
1576 # should be generated in user code (e.g. auto.def).
1577 # By default, we only want to show the error location in user code.
1578 # We use [info frame] to achieve this, but it works differently on Tcl and Jim.
1579 #
1580 # This is designed to be called for incorrect usage in auto.def, via autosetup-error
1581 #
1582 proc error-location {msg} {
1583         if {$::autosetup(debug)} {
1584                 return -code error $msg
1585         }
1586         # Search back through the stack trace for the first error in a .def file
1587         for {set i 1} {$i < [info level]} {incr i} {
1588                 if {$::autosetup(istcl)} {
1589                         array set info [info frame -$i]
1590                 } else {
1591                         lassign [info frame -$i] info(caller) info(file) info(line)
1592                 }
1593                 if {[string match *.def $info(file)]} {
1594                         return "[relative-path $info(file)]:$info(line): Error: $msg"
1595                 }
1596                 #puts "Skipping $info(file):$info(line)"
1597         }
1598         return $msg
1599 }
1600
1601 # Similar to error-location, but called when user code generates an error
1602 # In this case we want to show the stack trace in user code, but not in autosetup code
1603 # (unless --debug is enabled)
1604 #
1605 proc error-stacktrace {msg} {
1606         if {$::autosetup(istcl)} {
1607                 if {[regexp {file "([^ ]*)" line ([0-9]*)} $::errorInfo dummy file line]} {
1608                         return "[relative-path $file]:$line $msg\n$::errorInfo"
1609                 }
1610                 return $::errorInfo
1611         } else {
1612                 # Prepend a live stacktrace to the error stacktrace, omitting the current level
1613                 set stacktrace [concat [info stacktrace] [lrange [stacktrace] 3 end]]
1614
1615                 if {!$::autosetup(debug)} {
1616                         # Omit any levels from autosetup or with no file
1617                         set newstacktrace {}
1618                         foreach {p f l} $stacktrace {
1619                                 if {[string match "*autosetup" $f] || $f eq ""} {
1620                                         #puts "Skipping $p $f:$l"
1621                                         continue
1622                                 }
1623                                 lappend newstacktrace $p $f $l
1624                         }
1625                         set stacktrace $newstacktrace
1626                 }
1627
1628                 # Convert filenames to relative paths
1629                 set newstacktrace {}
1630                 foreach {p f l} $stacktrace {
1631                         lappend newstacktrace $p [relative-path $f] $l
1632                 }
1633                 lassign $newstacktrace p f l
1634                 if {$f ne ""} {
1635                         set prefix "$f:$l: "
1636                 } else {
1637                         set prefix ""
1638                 }
1639
1640                 return "${prefix}Error: $msg\n[stackdump $newstacktrace]"
1641         }
1642 }
1643 }
1644
1645 # ----- module text-formatting -----
1646
1647 set modsource(text-formatting) {
1648 # Copyright (c) 2010 WorkWare Systems http://www.workware.net.au/
1649 # All rights reserved
1650
1651 # Module which provides text formatting
1652
1653 use formatting
1654
1655 proc wordwrap {text length {firstprefix ""} {nextprefix ""}} {
1656     set len 0
1657     set space $firstprefix
1658     foreach word [split $text] {
1659         set word [string trim $word]
1660         if {$word == ""} {
1661             continue
1662         }
1663         if {$len && [string length $space$word] + $len >= $length} {
1664             puts ""
1665             set len 0
1666             set space $nextprefix
1667         }
1668         incr len [string length $space$word]
1669
1670         # Use man-page conventions for highlighting 'quoted' and *quoted*
1671         # single words.
1672         # Use x^Hx for *bold* and _^Hx for 'underline'.
1673         #
1674         # less and more will both understand this.
1675         # Pipe through 'col -b' to remove them.
1676         if {[regexp {^'(.*)'([^a-zA-Z0-9_]*)$} $word -> bareword dot]} {
1677             regsub -all . $bareword "_\b&" word
1678             append word $dot
1679         } elseif {[regexp {^[*](.*)[*]([^a-zA-Z0-9_]*)$} $word -> bareword dot]} {
1680             regsub -all . $bareword "&\b&" word
1681             append word $dot
1682         }
1683         puts -nonewline $space$word
1684         set space " "
1685     }
1686     if {$len} {
1687         puts ""
1688     }
1689 }
1690 proc title {text} {
1691     underline [string trim $text] =
1692     nl
1693 }
1694 proc p {text} {
1695     wordwrap $text 80
1696     nl
1697 }
1698 proc codelines {lines} {
1699     foreach line $lines {
1700         puts "    $line"
1701     }
1702     nl
1703 }
1704 proc nl {} {
1705     puts ""
1706 }
1707 proc underline {text char} {
1708     regexp "^(\[ \t\]*)(.*)" $text -> indent words
1709     puts $text
1710     puts $indent[string repeat $char [string length $words]]
1711 }
1712 proc section {text} {
1713     underline "[string trim $text]" -
1714     nl
1715 }
1716 proc subsection {text} {
1717     underline "$text" ~
1718     nl
1719 }
1720 proc bullet {text} {
1721     wordwrap $text 76 "  * " "    "
1722 }
1723 proc indent {text} {
1724     wordwrap $text 76 "    " "    "
1725 }
1726 proc defn {first args} {
1727     if {$first ne ""} {
1728         underline "    $first" ~
1729     }
1730     foreach p $args {
1731         if {$p ne ""} {
1732             indent $p
1733         }
1734     }
1735 }
1736 }
1737
1738 # ----- module wiki-formatting -----
1739
1740 set modsource(wiki-formatting) {
1741 # Copyright (c) 2010 WorkWare Systems http://www.workware.net.au/
1742 # All rights reserved
1743
1744 # Module which provides text formatting
1745 # wiki.tcl.tk format output
1746
1747 use formatting
1748
1749 proc joinlines {text} {
1750     set lines {}
1751     foreach l [split [string trim $text] \n] {
1752         lappend lines [string trim $l]
1753     }
1754     join $lines
1755 }
1756 proc p {text} {
1757     puts [joinlines $text]
1758     puts ""
1759 }
1760 proc title {text} {
1761     puts "*** [joinlines $text] ***"
1762     puts ""
1763 }
1764 proc codelines {lines} {
1765     puts "======"
1766     foreach line $lines {
1767         puts "    $line"
1768     }
1769     puts "======"
1770 }
1771 proc code {text} {
1772     puts "======"
1773     foreach line [parse_code_block $text] {
1774         puts "    $line"
1775     }
1776     puts "======"
1777 }
1778 proc nl {} {
1779 }
1780 proc section {text} {
1781     puts "'''$text'''"
1782     puts ""
1783 }
1784 proc subsection {text} {
1785     puts "''$text''"
1786     puts ""
1787 }
1788 proc bullet {text} {
1789     puts "   * [joinlines $text]"
1790 }
1791 proc indent {text} {
1792     puts "    :    [joinlines $text]"
1793 }
1794 proc defn {first args} {
1795     if {$first ne ""} {
1796         indent '''$first'''
1797     }
1798
1799     foreach p $args {
1800         p $p
1801     }
1802 }
1803 }
1804
1805
1806 ##################################################################
1807 #
1808 # Entry/Exit
1809 #
1810 if {$autosetup(debug)} {
1811         main $argv
1812 }
1813 if {[catch {main $argv} msg] == 1} {
1814         show-notices
1815         puts stderr [error-stacktrace $msg]
1816         if {!$autosetup(debug) && !$autosetup(istcl)} {
1817                 puts stderr "Try: '[file tail $autosetup(exe)] --debug' for a full stack trace"
1818         }
1819         exit 1
1820 }