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