regexp: add partial support for \A \Z matching
[jimtcl.git] / autosetup / autosetup
blobdf3317cad598a36dc30e6c0e234c07089284461e
1 #!/bin/sh
2 # Copyright (c) 2006-2011 WorkWare Systems http://www.workware.net.au/
3 # All rights reserved
4 # vim:se syntax=tcl:
5 # \
6 dir=`dirname "$0"`; exec "`$dir/find-tclsh`" "$0" "$@"
8 set autosetup(version) 0.6.5
10 # Can be set to 1 to debug early-init problems
11 set autosetup(debug) 0
13 ##################################################################
15 # Main flow of control, option handling
17 proc main {argv} {
18 global autosetup define
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
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
30 # This is also complicated by the fact that autosetup may
31 # have been run via the configure wrapper ([getenv WRAPPER] is set)
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]
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
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]
56 autosetup_add_dep $autosetup(prog)
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)]
66 set autosetup(autodef) [relative-path $autosetup(srcdir)/auto.def]
68 # (c)
69 set autosetup(builddir) [pwd]
71 set autosetup(argv) $argv
72 set autosetup(cmdline) {}
73 set autosetup(options) {}
74 set autosetup(optionhelp) {}
75 set autosetup(showhelp) 0
77 # Parse options
78 use getopt
80 array set ::useropts [getopt argv]
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:=help => "create initial auto.def, etc. Use --init=help for known types"
91 # Undocumented options
92 option-checking=1
93 nopager
94 quiet
95 timing
96 conf:
99 #parray ::useropts
100 if {[opt-bool version]} {
101 puts $autosetup(version)
102 exit 0
105 # autosetup --conf=alternate-auto.def
106 if {[opt-val conf] ne ""} {
107 set autosetup(autodef) [opt-val conf]
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]
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
122 # Now any auto-load modules
123 foreach file [glob -nocomplain $autosetup(libdir)/*.auto $autosetup(libdir)/*/*.auto] {
124 automf_load source $file
127 if {[opt-val help] ne ""} {
128 incr autosetup(showhelp)
129 use help
130 autosetup_help [opt-val help]
133 if {[opt-val {manual ref reference}] ne ""} {
134 use help
135 autosetup_reference [opt-val {manual ref reference}]
138 if {[opt-val init] ne ""} {
139 use init
140 autosetup_init [opt-val init]
143 if {[opt-val install] ne ""} {
144 use install
145 autosetup_install [opt-val install]
148 if {![file exists $autosetup(autodef)]} {
149 # Check for invalid option first
150 options {}
151 user-error "No auto.def found in \"$autosetup(srcdir)\" (use [file tail $::autosetup(exe)] --init to create one)"
154 # Parse extra arguments into autosetup(cmdline)
155 foreach arg $argv {
156 if {[regexp {([^=]*)=(.*)} $arg -> n v]} {
157 dict set autosetup(cmdline) $n $v
158 define $n $v
159 } else {
160 user-error "Unexpected parameter: $arg"
164 autosetup_add_dep $autosetup(autodef)
166 set cmd [file-normalize $autosetup(exe)]
167 foreach arg $autosetup(argv) {
168 append cmd " [quote-if-needed $arg]"
170 define AUTOREMAKE $cmd
172 # Log how we were invoked
173 configlog "Invoked as: [getenv WRAPPER $::argv0] [quote-argv $autosetup(argv)]"
175 # Note that auto.def is *not* loaded in the global scope
176 source $autosetup(autodef)
178 # Could warn here if options {} was not specified
180 show-notices
182 if {$autosetup(debug)} {
183 msg-result "Writing all defines to config.log"
184 configlog "================ defines ======================"
185 foreach n [lsort [array names define]] {
186 configlog "define $n $define($n)"
190 exit 0
193 # @opt-bool option ...
195 # Check each of the named, boolean options and return 1 if any of them have
196 # been set by the user.
198 proc opt-bool {args} {
199 option-check-names {*}$args
200 opt_bool ::useropts {*}$args
203 # @opt-val option-list ?default=""?
205 # Returns a list containing all the values given for the non-boolean options in 'option-list'.
206 # There will be one entry in the list for each option given by the user, including if the
207 # same option was used multiple times.
208 # If only a single value is required, use something like:
210 ## lindex [opt-val $names] end
212 # If no options were set, $default is returned (exactly, not as a list).
214 proc opt-val {names {default ""}} {
215 option-check-names {*}$names
216 join [opt_val ::useropts $names $default]
219 proc option-check-names {args} {
220 foreach o $args {
221 if {$o ni $::autosetup(options)} {
222 autosetup-error "Request for undeclared option --$o"
227 # Parse the option definition in $opts and update
228 # ::useropts() and ::autosetup(optionhelp) appropriately
230 proc options-add {opts {header ""}} {
231 global useropts autosetup
233 # First weed out comment lines
234 set realopts {}
235 foreach line [split $opts \n] {
236 if {![string match "#*" [string trimleft $line]]} {
237 append realopts $line \n
240 set opts $realopts
242 for {set i 0} {$i < [llength $opts]} {incr i} {
243 set opt [lindex $opts $i]
244 if {[string match =* $opt]} {
245 # This is a special heading
246 lappend autosetup(optionhelp) $opt ""
247 set header {}
248 continue
251 #puts "i=$i, opt=$opt"
252 regexp {^([^:=]*)(:)?(=)?(.*)$} $opt -> name colon equal value
253 if {$name in $autosetup(options)} {
254 autosetup-error "Option $name already specified"
257 #puts "$opt => $name $colon $equal $value"
259 # Find the corresponding value in the user options
260 # and set the default if necessary
261 if {[string match "-*" $opt]} {
262 # This is a documentation-only option, like "-C <dir>"
263 set opthelp $opt
264 } elseif {$colon eq ""} {
265 # Boolean option
266 lappend autosetup(options) $name
268 if {![info exists useropts($name)]} {
269 set useropts($name) $value
271 if {$value eq "1"} {
272 set opthelp "--disable-$name"
273 } else {
274 set opthelp "--$name"
276 } else {
277 # String option.
278 lappend autosetup(options) $name
280 if {$equal eq "="} {
281 if {[info exists useropts($name)]} {
282 # If the user specified the option with no value, the value will be "1"
283 # Replace with the default
284 if {$useropts($name) eq "1"} {
285 set useropts($name) $value
288 set opthelp "--$name?=$value?"
289 } else {
290 set opthelp "--$name=$value"
294 # Now create the help for this option if appropriate
295 if {[lindex $opts $i+1] eq "=>"} {
296 set desc [lindex $opts $i+2]
297 #string match \n* $desc
298 if {$header ne ""} {
299 lappend autosetup(optionhelp) $header ""
300 set header ""
302 # A multi-line description
303 lappend autosetup(optionhelp) $opthelp $desc
304 incr i 2
309 # @module-options optionlist
311 # Like 'options', but used within a module.
312 proc module-options {opts} {
313 set header ""
314 if {$::autosetup(showhelp) > 1 && [llength $opts]} {
315 set header "Module Options:"
317 options-add $opts $header
319 if {$::autosetup(showhelp)} {
320 # Ensure that the module isn't executed on --help
321 # We are running under eval or source, so use break
322 # to prevent further execution
323 #return -code break -level 2
324 return -code break
328 proc max {a b} {
329 expr {$a > $b ? $a : $b}
332 proc options-wrap-desc {text length firstprefix nextprefix initial} {
333 set len $initial
334 set space $firstprefix
335 foreach word [split $text] {
336 set word [string trim $word]
337 if {$word == ""} {
338 continue
340 if {$len && [string length $space$word] + $len >= $length} {
341 puts ""
342 set len 0
343 set space $nextprefix
345 incr len [string length $space$word]
346 puts -nonewline $space$word
347 set space " "
349 if {$len} {
350 puts ""
354 proc options-show {} {
355 # Determine the max option width
356 set max 0
357 foreach {opt desc} $::autosetup(optionhelp) {
358 if {[string match =* $opt] || [string match \n* $desc]} {
359 continue
361 set max [max $max [string length $opt]]
363 set indent [string repeat " " [expr $max+4]]
364 set cols [getenv COLUMNS 80]
365 catch {
366 lassign [exec stty size] rows cols
368 incr cols -1
369 # Now output
370 foreach {opt desc} $::autosetup(optionhelp) {
371 if {[string match =* $opt]} {
372 puts [string range $opt 1 end]
373 continue
375 puts -nonewline " [format %-${max}s $opt]"
376 if {[string match \n* $desc]} {
377 puts $desc
378 } else {
379 options-wrap-desc [string trim $desc] $cols " " $indent [expr $max + 2]
384 # @options options-spec
386 # Specifies configuration-time options which may be selected by the user
387 # and checked with opt-val and opt-bool. The format of options-spec follows.
389 # A boolean option is of the form:
391 ## name[=0|1] => "Description of this boolean option"
393 # The default is name=0, meaning that the option is disabled by default.
394 # If name=1 is used to make the option enabled by default, the description should reflect
395 # that with text like "Disable support for ...".
397 # An argument option (one which takes a parameter) is of the form:
399 ## name:[=]value => "Description of this option"
401 # If the name:value form is used, the value must be provided with the option (as --name=myvalue).
402 # If the name:=value form is used, the value is optional and the given value is used as the default
403 # if is not provided.
405 # Undocumented options are also supported by omitting the "=> description.
406 # These options are not displayed with --help and can be useful for internal options or as aliases.
408 # For example, --disable-lfs is an alias for --disable=largefile:
410 ## lfs=1 largefile=1 => "Disable large file support"
412 proc options {optlist} {
413 # Allow options as a list or args
414 options-add $optlist "Local Options:"
416 if {$::autosetup(showhelp)} {
417 options-show
418 exit 0
421 # Check for invalid options
422 if {[opt-bool option-checking]} {
423 foreach o [array names ::useropts] {
424 if {$o ni $::autosetup(options)} {
425 user-error "Unknown option --$o"
431 proc config_guess {} {
432 if {[file-isexec $::autosetup(dir)/config.guess]} {
433 exec-with-stderr sh $::autosetup(dir)/config.guess
434 if {[catch {exec-with-stderr sh $::autosetup(dir)/config.guess} alias]} {
435 user-error $alias
437 return $alias
438 } else {
439 configlog "No config.guess, so using uname"
440 string tolower [exec uname -p]-unknown-[exec uname -s][exec uname -r]
444 proc config_sub {alias} {
445 if {[file-isexec $::autosetup(dir)/config.sub]} {
446 if {[catch {exec-with-stderr sh $::autosetup(dir)/config.sub $alias} alias]} {
447 user-error $alias
450 return $alias
453 # @define name ?value=1?
455 # Defines the named variable to the given value.
456 # These (name, value) pairs represent the results of the configuration check
457 # and are available to be checked, modified and substituted.
459 proc define {name {value 1}} {
460 set ::define($name) $value
461 #dputs "$name <= $value"
464 # @define-append name value ...
466 # Appends the given value(s) to the given 'defined' variable.
467 # If the variable is not defined or empty, it is set to $value.
468 # Otherwise the value is appended, separated by a space.
469 # Any extra values are similarly appended.
470 # If any value is already contained in the variable (as a substring) it is omitted.
472 proc define-append {name args} {
473 if {[get-define $name ""] ne ""} {
474 # Make a token attempt to avoid duplicates
475 foreach arg $args {
476 if {[string first $arg $::define($name)] == -1} {
477 append ::define($name) " " $arg
480 } else {
481 set ::define($name) [join $args]
483 #dputs "$name += [join $args] => $::define($name)"
486 # @get-define name ?default=0?
488 # Returns the current value of the 'defined' variable, or $default
489 # if not set.
491 proc get-define {name {default 0}} {
492 if {[info exists ::define($name)]} {
493 #dputs "$name => $::define($name)"
494 return $::define($name)
496 #dputs "$name => $default"
497 return $default
500 # @is-defined name
502 # Returns 1 if the given variable is defined.
504 proc is-defined {name} {
505 info exists ::define($name)
508 # @all-defines
510 # Returns a dictionary (name value list) of all defined variables.
512 # This is suitable for use with 'dict', 'array set' or 'foreach'
513 # and allows for arbitrary processing of the defined variables.
515 proc all-defines {} {
516 array get ::define
520 # @get-env name default
522 # If $name was specified on the command line, return it.
523 # If $name was set in the environment, return it.
524 # Otherwise return $default.
526 proc get-env {name default} {
527 if {[dict exists $::autosetup(cmdline) $name]} {
528 return [dict get $::autosetup(cmdline) $name]
530 getenv $name $default
533 # @env-is-set name
535 # Returns 1 if the $name was specified on the command line or in the environment.
536 # Note that an empty environment variable is not considered to be set.
538 proc env-is-set {name} {
539 if {[dict exists $::autosetup(cmdline) $name]} {
540 return 1
542 if {[getenv $name ""] ne ""} {
543 return 1
545 return 0
548 # @readfile filename ?default=""?
550 # Return the contents of the file, without the trailing newline.
551 # If the doesn't exist or can't be read, returns $default.
553 proc readfile {filename {default_value ""}} {
554 set result $default_value
555 catch {
556 set f [open $filename]
557 set result [read -nonewline $f]
558 close $f
560 return $result
563 # @writefile filename value
565 # Creates the given file containing $value.
566 # Does not add an extra newline.
568 proc writefile {filename value} {
569 set f [open $filename w]
570 puts -nonewline $f $value
571 close $f
574 proc quote-if-needed {str} {
575 if {[string match {*[\" ]*} $str]} {
576 return \"[string map [list \" \\" \\ \\\\] $str]\"
578 return $str
581 proc quote-argv {argv} {
582 set args {}
583 foreach arg $argv {
584 lappend args [quote-if-needed $arg]
586 join $args
589 # @suffix suf list
591 # Takes a list and returns a new list with $suf appended
592 # to each element
594 ## suffix .c {a b c} => {a.c b.c c.c}
596 proc suffix {suf list} {
597 set result {}
598 foreach p $list {
599 lappend result $p$suf
601 return $result
604 # @prefix pre list
606 # Takes a list and returns a new list with $pre prepended
607 # to each element
609 ## prefix jim- {a.c b.c} => {jim-a.c jim-b.c}
611 proc prefix {pre list} {
612 set result {}
613 foreach p $list {
614 lappend result $pre$p
616 return $result
619 # @find-executable name
621 # Searches the path for an executable with the given name.
622 # Note that the name may include some parameters, e.g. "cc -mbig-endian",
623 # in which case the parameters are ignored.
624 # Returns 1 if found, or 0 if not.
626 proc find-executable {name} {
627 # Ignore any parameters
628 set name [lindex $name 0]
629 if {$name eq ""} {
630 # The empty string is never a valid executable
631 return 0
633 foreach p [split-path] {
634 dputs "Looking for $name in $p"
635 set exec [file join $p $name]
636 if {[file-isexec $exec]} {
637 dputs "Found $name -> $exec"
638 return 1
641 return 0
644 # @find-an-executable ?-required? name ...
646 # Given a list of possible executable names,
647 # searches for one of these on the path.
649 # Returns the name found, or "" if none found.
650 # If the first parameter is '-required', an error is generated
651 # if no executable is found.
653 proc find-an-executable {args} {
654 set required 0
655 if {[lindex $args 0] eq "-required"} {
656 set args [lrange $args 1 end]
657 incr required
659 foreach name $args {
660 if {[find-executable $name]} {
661 return $name
664 if {$required} {
665 if {[llength $args] == 1} {
666 user-error "failed to find: [join $args]"
667 } else {
668 user-error "failed to find one of: [join $args]"
671 return ""
674 # @configlog msg
676 # Writes the given message to the configuration log, config.log
678 proc configlog {msg} {
679 if {![info exists ::autosetup(logfh)]} {
680 set ::autosetup(logfh) [open config.log w]
682 puts $::autosetup(logfh) $msg
685 # @msg-checking msg
687 # Writes the message with no newline to stdout.
689 proc msg-checking {msg} {
690 if {$::autosetup(msg-quiet) == 0} {
691 maybe-show-timestamp
692 puts -nonewline $msg
693 set ::autosetup(msg-checking) 1
697 # @msg-result msg
699 # Writes the message to stdout.
701 proc msg-result {msg} {
702 if {$::autosetup(msg-quiet) == 0} {
703 maybe-show-timestamp
704 puts $msg
705 set ::autosetup(msg-checking) 0
706 show-notices
710 # @msg-quiet command ...
712 # msg-quiet evaluates it's arguments as a command with output
713 # from msg-checking and msg-result suppressed.
715 # This is useful if a check needs to run a subcheck which isn't
716 # of interest to the user.
717 proc msg-quiet {args} {
718 incr ::autosetup(msg-quiet)
719 set rc [uplevel 1 $args]
720 incr ::autosetup(msg-quiet) -1
721 return $rc
724 # Will be overridden by 'use misc'
725 proc error-stacktrace {msg} {
726 return $msg
729 proc error-location {msg} {
730 return $msg
733 ##################################################################
735 # Debugging output
737 proc dputs {msg} {
738 if {$::autosetup(debug)} {
739 puts $msg
743 ##################################################################
745 # User and system warnings and errors
747 # Usage errors such as wrong command line options
749 # @user-error msg
751 # Indicate incorrect usage to the user, including if required components
752 # or features are not found.
753 # autosetup exits with a non-zero return code.
755 proc user-error {msg} {
756 show-notices
757 puts stderr "Error: $msg"
758 puts stderr "Try: '[file tail $::autosetup(exe)] --help' for options"
759 exit 1
762 # @user-notice msg
764 # Output the given message to stderr.
766 proc user-notice {msg} {
767 lappend ::autosetup(notices) $msg
770 # Incorrect usage in the auto.def file. Identify the location.
771 proc autosetup-error {msg} {
772 autosetup-full-error [error-location $msg]
775 # Like autosetup-error, except $msg is the full error message.
776 proc autosetup-full-error {msg} {
777 show-notices
778 puts stderr $msg
779 exit 1
782 proc show-notices {} {
783 if {$::autosetup(msg-checking)} {
784 puts ""
785 set ::autosetup(msg-checking) 0
787 flush stdout
788 if {[info exists ::autosetup(notices)]} {
789 puts stderr [join $::autosetup(notices) \n]
790 unset ::autosetup(notices)
794 proc maybe-show-timestamp {} {
795 if {$::autosetup(msg-timing) && $::autosetup(msg-checking) == 0} {
796 puts -nonewline [format {[%6.2f] } [expr {([clock millis] - $::autosetup(start)) % 10000 / 1000.0}]]
800 proc autosetup_version {} {
801 return "autosetup v$::autosetup(version)"
804 ##################################################################
806 # Directory/path handling
809 proc realdir {dir} {
810 set oldpwd [pwd]
811 cd $dir
812 set pwd [pwd]
813 cd $oldpwd
814 return $pwd
817 # Follow symlinks until we get to something which is not a symlink
818 proc realpath {path} {
819 while {1} {
820 if {[catch {
821 set path [file readlink $path]
822 }]} {
823 # Not a link
824 break
827 return $path
830 # Convert absolute path, $path into a path relative
831 # to the given directory (or the current dir, if not given).
833 proc relative-path {path {pwd {}}} {
834 set diff 0
835 set same 0
836 set newf {}
837 set prefix {}
838 set path [file-normalize $path]
839 if {$pwd eq ""} {
840 set pwd [pwd]
841 } else {
842 set pwd [file-normalize $pwd]
845 if {$path eq $pwd} {
846 return .
849 # Try to make the filename relative to the current dir
850 foreach p [split $pwd /] f [split $path /] {
851 if {$p ne $f} {
852 incr diff
853 } elseif {!$diff} {
854 incr same
856 if {$diff} {
857 if {$p ne ""} {
858 # Add .. for sibling or parent dir
859 lappend prefix ..
861 if {$f ne ""} {
862 lappend newf $f
866 if {$same == 1 || [llength $prefix] > 3} {
867 return $path
870 file join [join $prefix /] [join $newf /]
873 # Add filename as a dependency to rerun autosetup
874 # The name will be normalised (converted to a full path)
876 proc autosetup_add_dep {filename} {
877 lappend ::autosetup(deps) [file-normalize $filename]
880 ##################################################################
882 # Library module support
885 # @use module ...
887 # Load the given library modules.
888 # e.g. 'use cc cc-shared'
890 # Note that module 'X' is implemented in either 'autosetup/X.tcl'
891 # or 'autosetup/X/init.tcl'
893 # The latter form is useful for a complex module which requires additional
894 # support file. In this form, '$::usedir' is set to the module directory
895 # when it is loaded.
897 proc use {args} {
898 foreach m $args {
899 if {[info exists ::libmodule($m)]} {
900 continue
902 set ::libmodule($m) 1
903 if {[info exists ::modsource($m)]} {
904 automf_load eval $::modsource($m)
905 } else {
906 set sources [list $::autosetup(libdir)/${m}.tcl $::autosetup(libdir)/${m}/init.tcl]
907 set found 0
908 foreach source $sources {
909 if {[file exists $source]} {
910 incr found
911 break
914 if {$found} {
915 # For the convenience of the "use" source, point to the directory
916 # it is being loaded from
917 set ::usedir [file dirname $source]
918 automf_load source $source
919 autosetup_add_dep $source
920 } else {
921 autosetup-error "use: No such module: $m"
927 # Load module source in the global scope by executing the given command
928 proc automf_load {args} {
929 if {[catch [list uplevel #0 $args] msg opts] ni {0 2 3}} {
930 autosetup-full-error [error-dump $msg $opts $::autosetup(debug)]
934 # Initial settings
935 set autosetup(exe) $::argv0
936 set autosetup(istcl) 1
937 set autosetup(start) [clock millis]
938 set autosetup(installed) 0
939 set autosetup(msg-checking) 0
940 set autosetup(msg-quiet) 0
942 # Embedded modules are inserted below here
943 set autosetup(installed) 1
944 # ----- module asciidoc-formatting -----
946 set modsource(asciidoc-formatting) {
947 # Copyright (c) 2010 WorkWare Systems http://www.workware.net.au/
948 # All rights reserved
950 # Module which provides text formatting
951 # asciidoc format
953 use formatting
955 proc para {text} {
956 regsub -all "\[ \t\n\]+" [string trim $text] " "
958 proc title {text} {
959 underline [para $text] =
962 proc p {text} {
963 puts [para $text]
966 proc code {text} {
967 foreach line [parse_code_block $text] {
968 puts " $line"
972 proc codelines {lines} {
973 foreach line $lines {
974 puts " $line"
978 proc nl {} {
979 puts ""
981 proc underline {text char} {
982 regexp "^(\[ \t\]*)(.*)" $text -> indent words
983 puts $text
984 puts $indent[string repeat $char [string length $words]]
986 proc section {text} {
987 underline "[para $text]" -
990 proc subsection {text} {
991 underline "$text" ~
994 proc bullet {text} {
995 puts "* [para $text]"
997 proc indent {text} {
998 puts " :: "
999 puts [para $text]
1001 proc defn {first args} {
1002 set sep ""
1003 if {$first ne ""} {
1004 puts "${first}::"
1005 } else {
1006 puts " :: "
1008 set defn [string trim [join $args \n]]
1009 regsub -all "\n\n" $defn "\n ::\n" defn
1010 puts $defn
1014 # ----- module formatting -----
1016 set modsource(formatting) {
1017 # Copyright (c) 2010 WorkWare Systems http://www.workware.net.au/
1018 # All rights reserved
1020 # Module which provides common text formatting
1022 # This is designed for documenation which looks like:
1023 # code {...}
1024 # or
1025 # code {
1026 # ...
1027 # ...
1029 # In the second case, we need to work out the indenting
1030 # and strip it from all lines but preserve the remaining indenting.
1031 # Note that all lines need to be indented with the same initial
1032 # spaces/tabs.
1034 # Returns a list of lines with the indenting removed.
1036 proc parse_code_block {text} {
1037 # If the text begins with newline, take the following text,
1038 # otherwise just return the original
1039 if {![regexp "^\n(.*)" $text -> text]} {
1040 return [list [string trim $text]]
1043 # And trip spaces off the end
1044 set text [string trimright $text]
1046 set min 100
1047 # Examine each line to determine the minimum indent
1048 foreach line [split $text \n] {
1049 if {$line eq ""} {
1050 # Ignore empty lines for the indent calculation
1051 continue
1053 regexp "^(\[ \t\]*)" $line -> indent
1054 set len [string length $indent]
1055 if {$len < $min} {
1056 set min $len
1060 # Now make a list of lines with this indent removed
1061 set lines {}
1062 foreach line [split $text \n] {
1063 lappend lines [string range $line $min end]
1066 # Return the result
1067 return $lines
1071 # ----- module getopt -----
1073 set modsource(getopt) {
1074 # Copyright (c) 2006 WorkWare Systems http://www.workware.net.au/
1075 # All rights reserved
1077 # Simple getopt module
1079 # Parse everything out of the argv list which looks like an option
1080 # Knows about --enable-thing and --disable-thing as alternatives for --thing=0 or --thing=1
1081 # Everything which doesn't look like an option, or is after --, is left unchanged
1082 proc getopt {argvname} {
1083 upvar $argvname argv
1084 set nargv {}
1086 for {set i 0} {$i < [llength $argv]} {incr i} {
1087 set arg [lindex $argv $i]
1089 #dputs arg=$arg
1091 if {$arg eq "--"} {
1092 # End of options
1093 incr i
1094 lappend nargv {*}[lrange $argv $i end]
1095 break
1098 if {[regexp {^--([^=][^=]+)=(.*)$} $arg -> name value]} {
1099 lappend opts($name) $value
1100 } elseif {[regexp {^--(enable-|disable-)?([^=]*)$} $arg -> prefix name]} {
1101 if {$prefix eq "disable-"} {
1102 set value 0
1103 } else {
1104 set value 1
1106 lappend opts($name) $value
1107 } else {
1108 lappend nargv $arg
1112 #puts "getopt: argv=[join $argv] => [join $nargv]"
1113 #parray opts
1115 set argv $nargv
1117 return [array get opts]
1120 proc opt_val {optarrayname options {default {}}} {
1121 upvar $optarrayname opts
1123 set result {}
1125 foreach o $options {
1126 if {[info exists opts($o)]} {
1127 lappend result {*}$opts($o)
1130 if {[llength $result] == 0} {
1131 return $default
1133 return $result
1136 proc opt_bool {optarrayname args} {
1137 upvar $optarrayname opts
1139 # Support the args being passed as a list
1140 if {[llength $args] == 1} {
1141 set args [lindex $args 0]
1144 foreach o $args {
1145 if {[info exists opts($o)]} {
1146 if {"1" in $opts($o) || "yes" in $opts($o)} {
1147 return 1
1151 return 0
1155 # ----- module help -----
1157 set modsource(help) {
1158 # Copyright (c) 2010 WorkWare Systems http://workware.net.au/
1159 # All rights reserved
1161 # Module which provides usage, help and the command reference
1163 proc autosetup_help {what} {
1164 use_pager
1166 puts "Usage: [file tail $::autosetup(exe)] \[options\] \[settings\]\n"
1167 puts "This is [autosetup_version], a build environment \"autoconfigurator\""
1168 puts "See the documentation online at http://msteveb.github.com/autosetup/\n"
1170 if {$what eq "local"} {
1171 if {[file exists $::autosetup(autodef)]} {
1172 # This relies on auto.def having a call to 'options'
1173 # which will display options and quit
1174 source $::autosetup(autodef)
1175 } else {
1176 options-show
1178 } else {
1179 incr ::autosetup(showhelp)
1180 if {[catch {use $what}]} {
1181 user-error "Unknown module: $what"
1182 } else {
1183 options-show
1186 exit 0
1189 # If not already paged and stdout is a tty, pipe the output through the pager
1190 # This is done by reinvoking autosetup with --nopager added
1191 proc use_pager {} {
1192 if {![opt-bool nopager] && [getenv PAGER ""] ne "" && [isatty? stdin] && [isatty? stdout]} {
1193 if {[catch {
1194 exec [info nameofexecutable] $::argv0 --nopager {*}$::argv |& {*}[getenv PAGER] >@stdout <@stdin 2>@stderr
1195 } msg opts] == 1} {
1196 if {[dict get $opts -errorcode] eq "NONE"} {
1197 # an internal/exec error
1198 puts stderr $msg
1199 exit 1
1202 exit 0
1206 # Outputs the autosetup references in one of several formats
1207 proc autosetup_reference {{type text}} {
1209 use_pager
1211 switch -glob -- $type {
1212 wiki {use wiki-formatting}
1213 ascii* {use asciidoc-formatting}
1214 md - markdown {use markdown-formatting}
1215 default {use text-formatting}
1218 title "[autosetup_version] -- Command Reference"
1220 section {Introduction}
1223 See http://msteveb.github.com/autosetup/ for the online documentation for 'autosetup'
1227 'autosetup' provides a number of built-in commands which
1228 are documented below. These may be used from 'auto.def' to test
1229 for features, define variables, create files from templates and
1230 other similar actions.
1233 automf_command_reference
1235 exit 0
1238 proc autosetup_output_block {type lines} {
1239 if {[llength $lines]} {
1240 switch $type {
1241 code {
1242 codelines $lines
1245 p [join $lines]
1247 list {
1248 foreach line $lines {
1249 bullet $line
1257 # Generate a command reference from inline documentation
1258 proc automf_command_reference {} {
1259 lappend files $::autosetup(prog)
1260 lappend files {*}[lsort [glob -nocomplain $::autosetup(libdir)/*.tcl]]
1262 section "Core Commands"
1263 set type p
1264 set lines {}
1265 set cmd {}
1267 foreach file $files {
1268 set f [open $file]
1269 while {![eof $f]} {
1270 set line [gets $f]
1272 # Find lines starting with "# @*" and continuing through the remaining comment lines
1273 if {![regexp {^# @(.*)} $line -> cmd]} {
1274 continue
1277 # Synopsis or command?
1278 if {$cmd eq "synopsis:"} {
1279 section "Module: [file rootname [file tail $file]]"
1280 } else {
1281 subsection $cmd
1284 set lines {}
1285 set type p
1287 # Now the description
1288 while {![eof $f]} {
1289 set line [gets $f]
1291 if {![regexp {^#(#)? ?(.*)} $line -> hash cmd]} {
1292 break
1294 if {$hash eq "#"} {
1295 set t code
1296 } elseif {[regexp {^- (.*)} $cmd -> cmd]} {
1297 set t list
1298 } else {
1299 set t p
1302 #puts "hash=$hash, oldhash=$oldhash, lines=[llength $lines], cmd=$cmd"
1304 if {$t ne $type || $cmd eq ""} {
1305 # Finish the current block
1306 autosetup_output_block $type $lines
1307 set lines {}
1308 set type $t
1310 if {$cmd ne ""} {
1311 lappend lines $cmd
1315 autosetup_output_block $type $lines
1317 close $f
1322 # ----- module init -----
1324 set modsource(init) {
1325 # Copyright (c) 2010 WorkWare Systems http://www.workware.net.au/
1326 # All rights reserved
1328 # Module to help create auto.def and configure
1330 proc autosetup_init {type} {
1331 set help 0
1332 if {$type in {? help}} {
1333 incr help
1334 } elseif {![dict exists $::autosetup(inittypes) $type]} {
1335 puts "Unknown type, --init=$type"
1336 incr help
1338 if {$help} {
1339 puts "Use one of the following types (e.g. --init=make)\n"
1340 foreach type [lsort [dict keys $::autosetup(inittypes)]] {
1341 lassign [dict get $::autosetup(inittypes) $type] desc
1342 # XXX: Use the options-show code to wrap the description
1343 puts [format "%-10s %s" $type $desc]
1345 exit 0
1347 lassign [dict get $::autosetup(inittypes) $type] desc script
1349 puts "Initialising $type: $desc\n"
1351 # All initialisations happens in the top level srcdir
1352 cd $::autosetup(srcdir)
1354 uplevel #0 $script
1356 exit 0
1359 proc autosetup_add_init_type {type desc script} {
1360 dict set ::autosetup(inittypes) $type [list $desc $script]
1363 # This is for in creating build-system init scripts
1365 # If the file doesn't exist, create it containing $contents
1366 # If the file does exist, only overwrite if --force is specified.
1368 proc autosetup_check_create {filename contents} {
1369 if {[file exists $filename]} {
1370 if {!$::autosetup(force)} {
1371 puts "I see $filename already exists."
1372 return
1373 } else {
1374 puts "I will overwrite the existing $filename because you used --force."
1376 } else {
1377 puts "I don't see $filename, so I will create it."
1379 writefile $filename $contents
1383 # ----- module install -----
1385 set modsource(install) {
1386 # Copyright (c) 2006-2010 WorkWare Systems http://www.workware.net.au/
1387 # All rights reserved
1389 # Module which can install autosetup
1391 proc autosetup_install {dir} {
1392 if {[catch {
1393 cd $dir
1394 file mkdir autosetup
1396 set f [open autosetup/autosetup w]
1398 set publicmodules $::autosetup(libdir)/default.auto
1400 # First the main script, but only up until "CUT HERE"
1401 set in [open $::autosetup(dir)/autosetup]
1402 while {[gets $in buf] >= 0} {
1403 if {$buf ne "##-- CUT HERE --##"} {
1404 puts $f $buf
1405 continue
1408 # Insert the static modules here
1409 # i.e. those which don't contain @synopsis:
1410 puts $f "set autosetup(installed) 1"
1411 foreach file [lsort [glob $::autosetup(libdir)/*.tcl]] {
1412 set buf [readfile $file]
1413 if {[string match "*\n# @synopsis:*" $buf]} {
1414 lappend publicmodules $file
1415 continue
1417 set modname [file rootname [file tail $file]]
1418 puts $f "# ----- module $modname -----"
1419 puts $f "\nset modsource($modname) \{"
1420 puts $f $buf
1421 puts $f "\}\n"
1424 close $in
1425 close $f
1426 exec chmod 755 autosetup/autosetup
1428 # Install public modules
1429 foreach file $publicmodules {
1430 autosetup_install_file $file autosetup
1433 # Install support files
1434 foreach file {config.guess config.sub jimsh0.c find-tclsh test-tclsh LICENSE} {
1435 autosetup_install_file $::autosetup(dir)/$file autosetup
1437 exec chmod 755 autosetup/config.sub autosetup/config.guess autosetup/find-tclsh
1439 writefile autosetup/README.autosetup \
1440 "This is [autosetup_version]. See http://msteveb.github.com/autosetup/\n"
1442 } error]} {
1443 user-error "Failed to install autosetup: $error"
1445 puts "Installed [autosetup_version] to autosetup/"
1447 # Now create 'configure' if necessary
1448 autosetup_create_configure
1450 exit 0
1453 proc autosetup_create_configure {} {
1454 if {[file exists configure]} {
1455 if {!$::autosetup(force)} {
1456 # Could this be an autosetup configure?
1457 if {![string match "*\nWRAPPER=*" [readfile configure]]} {
1458 puts "I see configure, but not created by autosetup, so I won't overwrite it."
1459 puts "Remove it or use --force to overwrite."
1460 return
1462 } else {
1463 puts "I will overwrite the existing configure because you used --force."
1465 } else {
1466 puts "I don't see configure, so I will create it."
1468 writefile configure \
1469 {#!/bin/sh
1470 dir="`dirname "$0"`/autosetup"
1471 WRAPPER="$0"; export WRAPPER; exec "`$dir/find-tclsh`" "$dir/autosetup" "$@"
1473 catch {exec chmod 755 configure}
1476 # Append the contents of $file to filehandle $f
1477 proc autosetup_install_append {f file} {
1478 set in [open $file]
1479 puts $f [read $in]
1480 close $in
1483 proc autosetup_install_file {file dir} {
1484 if {![file exists $file]} {
1485 error "Missing installation file '$file'"
1487 writefile [file join $dir [file tail $file]] [readfile $file]\n
1490 if {$::autosetup(installed)} {
1491 user-error "autosetup can only be installed from development source, not from installed copy"
1495 # ----- module markdown-formatting -----
1497 set modsource(markdown-formatting) {
1498 # Copyright (c) 2010 WorkWare Systems http://www.workware.net.au/
1499 # All rights reserved
1501 # Module which provides text formatting
1502 # markdown format (kramdown syntax)
1504 use formatting
1506 proc para {text} {
1507 regsub -all "\[ \t\n\]+" [string trim $text] " " text
1508 regsub -all {([^a-zA-Z])'([^']*)'} $text {\1**`\2`**} text
1509 regsub -all {^'([^']*)'} $text {**`\1`**} text
1510 regsub -all {(http[^ \t\n]*)} $text {[\1](\1)} text
1511 return $text
1513 proc title {text} {
1514 underline [para $text] =
1517 proc p {text} {
1518 puts [para $text]
1521 proc codelines {lines} {
1522 puts "~~~~~~~~~~~~"
1523 foreach line $lines {
1524 puts $line
1526 puts "~~~~~~~~~~~~"
1529 proc code {text} {
1530 puts "~~~~~~~~~~~~"
1531 foreach line [parse_code_block $text] {
1532 puts $line
1534 puts "~~~~~~~~~~~~"
1537 proc nl {} {
1538 puts ""
1540 proc underline {text char} {
1541 regexp "^(\[ \t\]*)(.*)" $text -> indent words
1542 puts $text
1543 puts $indent[string repeat $char [string length $words]]
1545 proc section {text} {
1546 underline "[para $text]" -
1549 proc subsection {text} {
1550 puts "### `$text`"
1553 proc bullet {text} {
1554 puts "* [para $text]"
1556 proc defn {first args} {
1557 puts "^"
1558 set defn [string trim [join $args \n]]
1559 if {$first ne ""} {
1560 puts "**${first}**"
1561 puts -nonewline ": "
1562 regsub -all "\n\n" $defn "\n: " defn
1564 puts "$defn"
1568 # ----- module misc -----
1570 set modsource(misc) {
1571 # Copyright (c) 2007-2010 WorkWare Systems http://www.workware.net.au/
1572 # All rights reserved
1574 # Module containing misc procs useful to modules
1575 # Largely for platform compatibility
1577 set autosetup(istcl) [info exists ::tcl_library]
1578 set autosetup(iswin) [string equal windows $tcl_platform(platform)]
1580 if {$autosetup(iswin)} {
1581 # mingw/windows separates $PATH with semicolons
1582 # and doesn't have an executable bit
1583 proc split-path {} {
1584 split [getenv PATH .] {;}
1586 proc file-isexec {exec} {
1587 # Basic test for windows. We ignore .bat
1588 if {[file isfile $exec] || [file isfile $exec.exe]} {
1589 return 1
1591 return 0
1593 } else {
1594 # unix separates $PATH with colons and has and executable bit
1595 proc split-path {} {
1596 split [getenv PATH .] :
1598 proc file-isexec {exec} {
1599 file executable $exec
1603 # Assume that exec can return stdout and stderr
1604 proc exec-with-stderr {args} {
1605 exec {*}$args 2>@1
1608 if {$autosetup(istcl)} {
1609 # Tcl doesn't have the env command
1610 proc getenv {name args} {
1611 if {[info exists ::env($name)]} {
1612 return $::env($name)
1614 if {[llength $args]} {
1615 return [lindex $args 0]
1617 return -code error "environment variable \"$name\" does not exist"
1619 proc isatty? {channel} {
1620 dict exists [fconfigure $channel] -xchar
1622 } else {
1623 if {$autosetup(iswin)} {
1624 # On Windows, backslash convert all environment variables
1625 # (Assume that Tcl does this for us)
1626 proc getenv {name args} {
1627 string map {\\ /} [env $name {*}$args]
1629 } else {
1630 # Jim on unix is simple
1631 alias getenv env
1633 proc isatty? {channel} {
1634 set tty 0
1635 catch {
1636 # isatty is a recent addition to Jim Tcl
1637 set tty [$channel isatty]
1639 return $tty
1643 # In case 'file normalize' doesn't exist
1645 proc file-normalize {path} {
1646 if {[catch {file normalize $path} result]} {
1647 if {$path eq ""} {
1648 return ""
1650 set oldpwd [pwd]
1651 if {[file isdir $path]} {
1652 cd $path
1653 set result [pwd]
1654 } else {
1655 cd [file dirname $path]
1656 set result [file join [pwd] [file tail $path]]
1658 cd $oldpwd
1660 return $result
1663 # If everything is working properly, the only errors which occur
1664 # should be generated in user code (e.g. auto.def).
1665 # By default, we only want to show the error location in user code.
1666 # We use [info frame] to achieve this, but it works differently on Tcl and Jim.
1668 # This is designed to be called for incorrect usage in auto.def, via autosetup-error
1670 proc error-location {msg} {
1671 if {$::autosetup(debug)} {
1672 return -code error $msg
1674 # Search back through the stack trace for the first error in a .def file
1675 for {set i 1} {$i < [info level]} {incr i} {
1676 if {$::autosetup(istcl)} {
1677 array set info [info frame -$i]
1678 } else {
1679 lassign [info frame -$i] info(caller) info(file) info(line)
1681 if {[string match *.def $info(file)]} {
1682 return "[relative-path $info(file)]:$info(line): Error: $msg"
1684 #puts "Skipping $info(file):$info(line)"
1686 return $msg
1689 # If everything is working properly, the only errors which occur
1690 # should be generated in user code (e.g. auto.def).
1691 # By default, we only want to show the error location in user code.
1692 # We use [info frame] to achieve this, but it works differently on Tcl and Jim.
1694 # This is designed to be called for incorrect usage in auto.def, via autosetup-error
1696 proc error-stacktrace {msg} {
1697 if {$::autosetup(debug)} {
1698 return -code error $msg
1700 # Search back through the stack trace for the first error in a .def file
1701 for {set i 1} {$i < [info level]} {incr i} {
1702 if {$::autosetup(istcl)} {
1703 array set info [info frame -$i]
1704 } else {
1705 lassign [info frame -$i] info(caller) info(file) info(line)
1707 if {[string match *.def $info(file)]} {
1708 return "[relative-path $info(file)]:$info(line): Error: $msg"
1710 #puts "Skipping $info(file):$info(line)"
1712 return $msg
1715 # Given the return from [catch {...} msg opts], returns an appropriate
1716 # error message. A nice one for Jim and a less-nice one for Tcl.
1717 # If 'fulltrace' is set, a full stack trace is provided.
1718 # Otherwise a simple message is provided.
1720 # This is designed for developer errors, e.g. in module code or auto.def code
1723 proc error-dump {msg opts fulltrace} {
1724 if {$::autosetup(istcl)} {
1725 if {$fulltrace} {
1726 return "Error: [dict get $opts -errorinfo]"
1727 } else {
1728 return "Error: $msg"
1730 } else {
1731 lassign $opts(-errorinfo) p f l
1732 if {$f ne ""} {
1733 set result "$f:$l: Error: "
1735 append result "$msg\n"
1736 if {$fulltrace} {
1737 append result [stackdump $opts(-errorinfo)]
1740 # Remove the trailing newline
1741 string trim $result
1746 # ----- module text-formatting -----
1748 set modsource(text-formatting) {
1749 # Copyright (c) 2010 WorkWare Systems http://www.workware.net.au/
1750 # All rights reserved
1752 # Module which provides text formatting
1754 use formatting
1756 proc wordwrap {text length {firstprefix ""} {nextprefix ""}} {
1757 set len 0
1758 set space $firstprefix
1759 foreach word [split $text] {
1760 set word [string trim $word]
1761 if {$word == ""} {
1762 continue
1764 if {$len && [string length $space$word] + $len >= $length} {
1765 puts ""
1766 set len 0
1767 set space $nextprefix
1769 incr len [string length $space$word]
1771 # Use man-page conventions for highlighting 'quoted' and *quoted*
1772 # single words.
1773 # Use x^Hx for *bold* and _^Hx for 'underline'.
1775 # less and more will both understand this.
1776 # Pipe through 'col -b' to remove them.
1777 if {[regexp {^'(.*)'([^a-zA-Z0-9_]*)$} $word -> bareword dot]} {
1778 regsub -all . $bareword "_\b&" word
1779 append word $dot
1780 } elseif {[regexp {^[*](.*)[*]([^a-zA-Z0-9_]*)$} $word -> bareword dot]} {
1781 regsub -all . $bareword "&\b&" word
1782 append word $dot
1784 puts -nonewline $space$word
1785 set space " "
1787 if {$len} {
1788 puts ""
1791 proc title {text} {
1792 underline [string trim $text] =
1795 proc p {text} {
1796 wordwrap $text 80
1799 proc codelines {lines} {
1800 foreach line $lines {
1801 puts " $line"
1805 proc nl {} {
1806 puts ""
1808 proc underline {text char} {
1809 regexp "^(\[ \t\]*)(.*)" $text -> indent words
1810 puts $text
1811 puts $indent[string repeat $char [string length $words]]
1813 proc section {text} {
1814 underline "[string trim $text]" -
1817 proc subsection {text} {
1818 underline "$text" ~
1821 proc bullet {text} {
1822 wordwrap $text 76 " * " " "
1824 proc indent {text} {
1825 wordwrap $text 76 " " " "
1827 proc defn {first args} {
1828 if {$first ne ""} {
1829 underline " $first" ~
1831 foreach p $args {
1832 if {$p ne ""} {
1833 indent $p
1839 # ----- module wiki-formatting -----
1841 set modsource(wiki-formatting) {
1842 # Copyright (c) 2010 WorkWare Systems http://www.workware.net.au/
1843 # All rights reserved
1845 # Module which provides text formatting
1846 # wiki.tcl.tk format output
1848 use formatting
1850 proc joinlines {text} {
1851 set lines {}
1852 foreach l [split [string trim $text] \n] {
1853 lappend lines [string trim $l]
1855 join $lines
1857 proc p {text} {
1858 puts [joinlines $text]
1859 puts ""
1861 proc title {text} {
1862 puts "*** [joinlines $text] ***"
1863 puts ""
1865 proc codelines {lines} {
1866 puts "======"
1867 foreach line $lines {
1868 puts " $line"
1870 puts "======"
1872 proc code {text} {
1873 puts "======"
1874 foreach line [parse_code_block $text] {
1875 puts " $line"
1877 puts "======"
1879 proc nl {} {
1881 proc section {text} {
1882 puts "'''$text'''"
1883 puts ""
1885 proc subsection {text} {
1886 puts "''$text''"
1887 puts ""
1889 proc bullet {text} {
1890 puts " * [joinlines $text]"
1892 proc indent {text} {
1893 puts " : [joinlines $text]"
1895 proc defn {first args} {
1896 if {$first ne ""} {
1897 indent '''$first'''
1900 foreach p $args {
1901 p $p
1907 ##################################################################
1909 # Entry/Exit
1911 if {$autosetup(debug)} {
1912 main $argv
1914 if {[catch {main $argv} msg opts] == 1} {
1915 show-notices
1916 autosetup-full-error [error-dump $msg $opts $::autosetup(debug)]
1917 if {!$autosetup(debug)} {
1918 puts stderr "Try: '[file tail $autosetup(exe)] --debug' for a full stack trace"
1920 exit 1