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