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