source: git/libthread/autosetup/autosetup @ 54b24c

spielwiese
Last change on this file since 54b24c was 54b24c, checked in by Reimer Behrends <behrends@…>, 5 years ago
Finalizing thread support.
  • Property mode set to 100755
File size: 44.6 KB
Line 
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.5
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:=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:
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        # Now any auto-load modules
123        foreach file [glob -nocomplain $autosetup(libdir)/*.auto $autosetup(libdir)/*/*.auto] {
124                automf_load source $file
125        }
126
127        if {[opt-val help] ne ""} {
128                incr autosetup(showhelp)
129                use help
130                autosetup_help [opt-val help]
131        }
132
133        if {[opt-val {manual ref reference}] ne ""} {
134                use help
135                autosetup_reference [opt-val {manual ref reference}]
136        }
137
138        if {[opt-val init] ne ""} {
139                use init
140                autosetup_init [opt-val init]
141        }
142
143        if {[opt-val install] ne ""} {
144                use install
145                autosetup_install [opt-val install]
146        }
147
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)"
152        }
153
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"
161                }
162        }
163
164        autosetup_add_dep $autosetup(autodef)
165
166        set cmd [file-normalize $autosetup(exe)]
167        foreach arg $autosetup(argv) {
168                append cmd " [quote-if-needed $arg]"
169        }
170        define AUTOREMAKE $cmd
171
172        # Log how we were invoked
173        configlog "Invoked as: [getenv WRAPPER $::argv0] [quote-argv $autosetup(argv)]"
174
175        # Note that auto.def is *not* loaded in the global scope
176        source $autosetup(autodef)
177
178        # Could warn here if options {} was not specified
179
180        show-notices
181
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)"
187                }
188        }
189
190        exit 0
191}
192
193# @opt-bool option ...
194#
195# Check each of the named, boolean options and return 1 if any of them have
196# been set by the user.
197#
198proc opt-bool {args} {
199        option-check-names {*}$args
200        opt_bool ::useropts {*}$args
201}
202
203# @opt-val option-list ?default=""?
204#
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:
209#
210## lindex [opt-val $names] end
211#
212# If no options were set, $default is returned (exactly, not as a list).
213#
214proc opt-val {names {default ""}} {
215        option-check-names {*}$names
216        join [opt_val ::useropts $names $default]
217}
218
219proc option-check-names {args} {
220        foreach o $args {
221                if {$o ni $::autosetup(options)} {
222                        autosetup-error "Request for undeclared option --$o"
223                }
224        }
225}
226
227# Parse the option definition in $opts and update
228# ::useropts() and ::autosetup(optionhelp) appropriately
229#
230proc options-add {opts {header ""}} {
231        global useropts autosetup
232
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
238                }
239        }
240        set opts $realopts
241
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
249                }
250
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"
255                }
256
257                #puts "$opt => $name $colon $equal $value"
258
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
267
268                        if {![info exists useropts($name)]} {
269                                set useropts($name) $value
270                        }
271                        if {$value eq "1"} {
272                                set opthelp "--disable-$name"
273                        } else {
274                                set opthelp "--$name"
275                        }
276                } else {
277                        # String option.
278                        lappend autosetup(options) $name
279
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
286                                        }
287                                }
288                                set opthelp "--$name?=$value?"
289                        } else {
290                                set opthelp "--$name=$value"
291                        }
292                }
293
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 ""
301                        }
302                        # A multi-line description
303                        lappend autosetup(optionhelp) $opthelp $desc
304                        incr i 2
305                }
306        }
307}
308
309# @module-options optionlist
310#
311# Like 'options', but used within a module.
312proc module-options {opts} {
313        set header ""
314        if {$::autosetup(showhelp) > 1 && [llength $opts]} {
315                set header "Module Options:"
316        }
317        options-add $opts $header
318
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
325        }
326}
327
328proc max {a b} {
329        expr {$a > $b ? $a : $b}
330}
331
332proc 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
339                }
340                if {$len && [string length $space$word] + $len >= $length} {
341                        puts ""
342                        set len 0
343                        set space $nextprefix
344                }
345                incr len [string length $space$word]
346                puts -nonewline $space$word
347                set space " "
348        }
349        if {$len} {
350                puts ""
351        }
352}
353
354proc 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
360                }
361                set max [max $max [string length $opt]]
362        }
363        set indent [string repeat " " [expr $max+4]]
364        set cols [getenv COLUMNS 80]
365        catch {
366                lassign [exec stty size] rows cols
367        }
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
374                }
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]
380                }
381        }
382}
383
384# @options options-spec
385#
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.
388#
389# A boolean option is of the form:
390#
391## name[=0|1]  => "Description of this boolean option"
392#
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 ...".
396#
397# An argument option (one which takes a parameter) is of the form:
398#
399## name:[=]value  => "Description of this option"
400#
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.
404#
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.
407#
408# For example, --disable-lfs is an alias for --disable=largefile:
409#
410## lfs=1 largefile=1 => "Disable large file support"
411#
412proc options {optlist} {
413        # Allow options as a list or args
414        options-add $optlist "Local Options:"
415
416        if {$::autosetup(showhelp)} {
417                options-show
418                exit 0
419        }
420
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"
426                        }
427                }
428        }
429}
430
431proc 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
436                }
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]
441        }
442}
443
444proc 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
448                }
449        }
450        return $alias
451}
452
453# @define name ?value=1?
454#
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.
458#
459proc define {name {value 1}} {
460        set ::define($name) $value
461        #dputs "$name <= $value"
462}
463
464# @define-append name value ...
465#
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.
471#
472proc 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
478                        }
479                }
480        } else {
481                set ::define($name) [join $args]
482        }
483        #dputs "$name += [join $args] => $::define($name)"
484}
485
486# @get-define name ?default=0?
487#
488# Returns the current value of the 'defined' variable, or $default
489# if not set.
490#
491proc get-define {name {default 0}} {
492        if {[info exists ::define($name)]} {
493                #dputs "$name => $::define($name)"
494                return $::define($name)
495        }
496        #dputs "$name => $default"
497        return $default
498}
499
500# @is-defined name
501#
502# Returns 1 if the given variable is defined.
503#
504proc is-defined {name} {
505        info exists ::define($name)
506}
507
508# @all-defines
509#
510# Returns a dictionary (name value list) of all defined variables.
511#
512# This is suitable for use with 'dict', 'array set' or 'foreach'
513# and allows for arbitrary processing of the defined variables.
514#
515proc all-defines {} {
516        array get ::define
517}
518
519
520# @get-env name default
521#
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.
525#
526proc get-env {name default} {
527        if {[dict exists $::autosetup(cmdline) $name]} {
528                return [dict get $::autosetup(cmdline) $name]
529        }
530        getenv $name $default
531}
532
533# @env-is-set name
534#
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.
537#
538proc env-is-set {name} {
539        if {[dict exists $::autosetup(cmdline) $name]} {
540                return 1
541        }
542        if {[getenv $name ""] ne ""} {
543                return 1
544        }
545        return 0
546}
547
548# @readfile filename ?default=""?
549#
550# Return the contents of the file, without the trailing newline.
551# If the doesn't exist or can't be read, returns $default.
552#
553proc 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
559        }
560        return $result
561}
562
563# @writefile filename value
564#
565# Creates the given file containing $value.
566# Does not add an extra newline.
567#
568proc writefile {filename value} {
569        set f [open $filename w]
570        puts -nonewline $f $value
571        close $f
572}
573
574proc quote-if-needed {str} {
575        if {[string match {*[\" ]*} $str]} {
576                return \"[string map [list \" \\" \\ \\\\] $str]\"
577        }
578        return $str
579}
580
581proc quote-argv {argv} {
582        set args {}
583        foreach arg $argv {
584                lappend args [quote-if-needed $arg]
585        }
586        join $args
587}
588
589# @suffix suf list
590#
591# Takes a list and returns a new list with $suf appended
592# to each element
593#
594## suffix .c {a b c} => {a.c b.c c.c}
595#
596proc suffix {suf list} {
597        set result {}
598        foreach p $list {
599                lappend result $p$suf
600        }
601        return $result
602}
603
604# @prefix pre list
605#
606# Takes a list and returns a new list with $pre prepended
607# to each element
608#
609## prefix jim- {a.c b.c} => {jim-a.c jim-b.c}
610#
611proc prefix {pre list} {
612        set result {}
613        foreach p $list {
614                lappend result $pre$p
615        }
616        return $result
617}
618
619# @find-executable name
620#
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.
625#
626proc 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
632        }
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
639                }
640        }
641        return 0
642}
643
644# @find-an-executable ?-required? name ...
645#
646# Given a list of possible executable names,
647# searches for one of these on the path.
648#
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.
652#
653proc 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
658        }
659        foreach name $args {
660                if {[find-executable $name]} {
661                        return $name
662                }
663        }
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]"
669                }
670        }
671        return ""
672}
673
674# @configlog msg
675#
676# Writes the given message to the configuration log, config.log
677#
678proc configlog {msg} {
679        if {![info exists ::autosetup(logfh)]} {
680                set ::autosetup(logfh) [open config.log w]
681        }
682        puts $::autosetup(logfh) $msg
683}
684
685# @msg-checking msg
686#
687# Writes the message with no newline to stdout.
688#
689proc msg-checking {msg} {
690        if {$::autosetup(msg-quiet) == 0} {
691                maybe-show-timestamp
692                puts -nonewline $msg
693                set ::autosetup(msg-checking) 1
694        }
695}
696
697# @msg-result msg
698#
699# Writes the message to stdout.
700#
701proc 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
707        }
708}
709
710# @msg-quiet command ...
711#
712# msg-quiet evaluates it's arguments as a command with output
713# from msg-checking and msg-result suppressed.
714#
715# This is useful if a check needs to run a subcheck which isn't
716# of interest to the user.
717proc msg-quiet {args} {
718        incr ::autosetup(msg-quiet)
719        set rc [uplevel 1 $args]
720        incr ::autosetup(msg-quiet) -1
721        return $rc
722}
723
724# Will be overridden by 'use misc'
725proc error-stacktrace {msg} {
726        return $msg
727}
728
729proc error-location {msg} {
730        return $msg
731}
732
733##################################################################
734#
735# Debugging output
736#
737proc dputs {msg} {
738        if {$::autosetup(debug)} {
739                puts $msg
740        }
741}
742
743##################################################################
744#
745# User and system warnings and errors
746#
747# Usage errors such as wrong command line options
748
749# @user-error msg
750#
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.
754#
755proc 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
760}
761
762# @user-notice msg
763#
764# Output the given message to stderr.
765#
766proc user-notice {msg} {
767        lappend ::autosetup(notices) $msg
768}
769
770# Incorrect usage in the auto.def file. Identify the location.
771proc autosetup-error {msg} {
772        autosetup-full-error [error-location $msg]
773}
774
775# Like autosetup-error, except $msg is the full error message.
776proc autosetup-full-error {msg} {
777        show-notices
778        puts stderr $msg
779        exit 1
780}
781
782proc show-notices {} {
783        if {$::autosetup(msg-checking)} {
784                puts ""
785                set ::autosetup(msg-checking) 0
786        }
787        flush stdout
788        if {[info exists ::autosetup(notices)]} {
789                puts stderr [join $::autosetup(notices) \n]
790                unset ::autosetup(notices)
791        }
792}
793
794proc 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}]]
797        }
798}
799
800proc autosetup_version {} {
801        return "autosetup v$::autosetup(version)"
802}
803
804##################################################################
805#
806# Directory/path handling
807#
808
809proc realdir {dir} {
810        set oldpwd [pwd]
811        cd $dir
812        set pwd [pwd]
813        cd $oldpwd
814        return $pwd
815}
816
817# Follow symlinks until we get to something which is not a symlink
818proc realpath {path} {
819        while {1} {
820                if {[catch {
821                        set path [file readlink $path]
822                }]} {
823                        # Not a link
824                        break
825                }
826        }
827        return $path
828}
829
830# Convert absolute path, $path into a path relative
831# to the given directory (or the current dir, if not given).
832#
833proc 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]
843        }
844
845        if {$path eq $pwd} {
846                return .
847        }
848
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
855                }
856                if {$diff} {
857                        if {$p ne ""} {
858                                # Add .. for sibling or parent dir
859                                lappend prefix ..
860                        }
861                        if {$f ne ""} {
862                                lappend newf $f
863                        }
864                }
865        }
866        if {$same == 1 || [llength $prefix] > 3} {
867                return $path
868        }
869
870        file join [join $prefix /] [join $newf /]
871}
872
873# Add filename as a dependency to rerun autosetup
874# The name will be normalised (converted to a full path)
875#
876proc autosetup_add_dep {filename} {
877        lappend ::autosetup(deps) [file-normalize $filename]
878}
879
880##################################################################
881#
882# Library module support
883#
884
885# @use module ...
886#
887# Load the given library modules.
888# e.g. 'use cc cc-shared'
889#
890# Note that module 'X' is implemented in either 'autosetup/X.tcl'
891# or 'autosetup/X/init.tcl'
892#
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.
896#
897proc use {args} {
898        foreach m $args {
899                if {[info exists ::libmodule($m)]} {
900                        continue
901                }
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
912                                }
913                        }
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"
922                        }
923                }
924        }
925}
926
927# Load module source in the global scope by executing the given command
928proc 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)]
931        }
932}
933
934# Initial settings
935set autosetup(exe) $::argv0
936set autosetup(istcl) 1
937set autosetup(start) [clock millis]
938set autosetup(installed) 0
939set autosetup(msg-checking) 0
940set autosetup(msg-quiet) 0
941
942# Embedded modules are inserted below here
943set autosetup(installed) 1
944# ----- module asciidoc-formatting -----
945
946set modsource(asciidoc-formatting) {
947# Copyright (c) 2010 WorkWare Systems http://www.workware.net.au/
948# All rights reserved
949
950# Module which provides text formatting
951# asciidoc format
952
953use formatting
954
955proc para {text} {
956    regsub -all "\[ \t\n\]+" [string trim $text] " "
957}
958proc title {text} {
959    underline [para $text] =
960    nl
961}
962proc p {text} {
963    puts [para $text]
964    nl
965}
966proc code {text} {
967    foreach line [parse_code_block $text] {
968        puts "    $line"
969    }
970    nl
971}
972proc codelines {lines} {
973    foreach line $lines {
974        puts "    $line"
975    }
976    nl
977}
978proc nl {} {
979    puts ""
980}
981proc underline {text char} {
982    regexp "^(\[ \t\]*)(.*)" $text -> indent words
983    puts $text
984    puts $indent[string repeat $char [string length $words]]
985}
986proc section {text} {
987    underline "[para $text]" -
988    nl
989}
990proc subsection {text} {
991    underline "$text" ~
992    nl
993}
994proc bullet {text} {
995    puts "* [para $text]"
996}
997proc indent {text} {
998    puts " :: "
999    puts [para $text]
1000}
1001proc defn {first args} {
1002    set sep ""
1003    if {$first ne ""} {
1004        puts "${first}::"
1005    } else {
1006        puts " :: "
1007    }
1008    set defn [string trim [join $args \n]]
1009    regsub -all "\n\n" $defn "\n ::\n" defn
1010    puts $defn
1011}
1012}
1013
1014# ----- module formatting -----
1015
1016set modsource(formatting) {
1017# Copyright (c) 2010 WorkWare Systems http://www.workware.net.au/
1018# All rights reserved
1019
1020# Module which provides common text formatting
1021
1022# This is designed for documenation which looks like:
1023# code {...}
1024# or
1025# code {
1026#    ...
1027#    ...
1028# }
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.
1033#
1034# Returns a list of lines with the indenting removed.
1035#
1036proc 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]]
1041    }
1042
1043    # And trip spaces off the end
1044    set text [string trimright $text]
1045
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
1052        }
1053        regexp "^(\[ \t\]*)" $line -> indent
1054        set len [string length $indent]
1055        if {$len < $min} {
1056            set min $len
1057        }
1058    }
1059
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]
1064    }
1065
1066    # Return the result
1067    return $lines
1068}
1069}
1070
1071# ----- module getopt -----
1072
1073set modsource(getopt) {
1074# Copyright (c) 2006 WorkWare Systems http://www.workware.net.au/
1075# All rights reserved
1076
1077# Simple getopt module
1078
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
1082proc getopt {argvname} {
1083        upvar $argvname argv
1084        set nargv {}
1085
1086        for {set i 0} {$i < [llength $argv]} {incr i} {
1087                set arg [lindex $argv $i]
1088
1089                #dputs arg=$arg
1090
1091                if {$arg eq "--"} {
1092                        # End of options
1093                        incr i
1094                        lappend nargv {*}[lrange $argv $i end]
1095                        break
1096                }
1097
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
1105                        }
1106                        lappend opts($name) $value
1107                } else {
1108                        lappend nargv $arg
1109                }
1110        }
1111
1112        #puts "getopt: argv=[join $argv] => [join $nargv]"
1113        #parray opts
1114
1115        set argv $nargv
1116
1117        return [array get opts]
1118}
1119
1120proc opt_val {optarrayname options {default {}}} {
1121        upvar $optarrayname opts
1122
1123        set result {}
1124
1125        foreach o $options {
1126                if {[info exists opts($o)]} {
1127                        lappend result {*}$opts($o)
1128                }
1129        }
1130        if {[llength $result] == 0} {
1131                return $default
1132        }
1133        return $result
1134}
1135
1136proc opt_bool {optarrayname args} {
1137        upvar $optarrayname opts
1138
1139        # Support the args being passed as a list
1140        if {[llength $args] == 1} {
1141                set args [lindex $args 0]
1142        }
1143
1144        foreach o $args {
1145                if {[info exists opts($o)]} {
1146                        if {"1" in $opts($o) || "yes" in $opts($o)} {
1147                                return 1
1148                        }
1149                }
1150        }
1151        return 0
1152}
1153}
1154
1155# ----- module help -----
1156
1157set modsource(help) {
1158# Copyright (c) 2010 WorkWare Systems http://workware.net.au/
1159# All rights reserved
1160
1161# Module which provides usage, help and the command reference
1162
1163proc autosetup_help {what} {
1164    use_pager
1165
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"
1169
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
1177        }
1178    } else {
1179        incr ::autosetup(showhelp)
1180        if {[catch {use $what}]} {
1181            user-error "Unknown module: $what"
1182        } else {
1183            options-show
1184        }
1185    }
1186    exit 0
1187}
1188
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
1191proc 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
1200            }
1201        }
1202        exit 0
1203    }
1204}
1205
1206# Outputs the autosetup references in one of several formats
1207proc autosetup_reference {{type text}} {
1208
1209    use_pager
1210
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}
1216    }
1217
1218    title "[autosetup_version] -- Command Reference"
1219
1220    section {Introduction}
1221
1222    p {
1223        See http://msteveb.github.com/autosetup/ for the online documentation for 'autosetup'
1224    }
1225
1226    p {
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.
1231    }
1232
1233    automf_command_reference
1234
1235    exit 0
1236}
1237
1238proc autosetup_output_block {type lines} {
1239    if {[llength $lines]} {
1240        switch $type {
1241            code {
1242                codelines $lines
1243            }
1244            p {
1245                p [join $lines]
1246            }
1247            list {
1248                foreach line $lines {
1249                    bullet $line
1250                }
1251                nl
1252            }
1253        }
1254    }
1255}
1256
1257# Generate a command reference from inline documentation
1258proc automf_command_reference {} {
1259    lappend files $::autosetup(prog)
1260    lappend files {*}[lsort [glob -nocomplain $::autosetup(libdir)/*.tcl]]
1261
1262    section "Core Commands"
1263    set type p
1264    set lines {}
1265    set cmd {}
1266
1267    foreach file $files {
1268        set f [open $file]
1269        while {![eof $f]} {
1270            set line [gets $f]
1271
1272            # Find lines starting with "# @*" and continuing through the remaining comment lines
1273            if {![regexp {^# @(.*)} $line -> cmd]} {
1274                continue
1275            }
1276
1277            # Synopsis or command?
1278            if {$cmd eq "synopsis:"} {
1279                section "Module: [file rootname [file tail $file]]"
1280            } else {
1281                subsection $cmd
1282            }
1283
1284            set lines {}
1285            set type p
1286
1287            # Now the description
1288            while {![eof $f]} {
1289                set line [gets $f]
1290
1291                if {![regexp {^#(#)? ?(.*)} $line -> hash cmd]} {
1292                    break
1293                }
1294                if {$hash eq "#"} {
1295                    set t code
1296                } elseif {[regexp {^- (.*)} $cmd -> cmd]} {
1297                    set t list
1298                } else {
1299                    set t p
1300                }
1301
1302                #puts "hash=$hash, oldhash=$oldhash, lines=[llength $lines], cmd=$cmd"
1303
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
1309                }
1310                if {$cmd ne ""} {
1311                    lappend lines $cmd
1312                }
1313            }
1314
1315            autosetup_output_block $type $lines
1316        }
1317        close $f
1318    }
1319}
1320}
1321
1322# ----- module init -----
1323
1324set modsource(init) {
1325# Copyright (c) 2010 WorkWare Systems http://www.workware.net.au/
1326# All rights reserved
1327
1328# Module to help create auto.def and configure
1329
1330proc 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
1337        }
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]
1344                }
1345                exit 0
1346        }
1347        lassign [dict get $::autosetup(inittypes) $type] desc script
1348
1349        puts "Initialising $type: $desc\n"
1350
1351        # All initialisations happens in the top level srcdir
1352        cd $::autosetup(srcdir)
1353
1354        uplevel #0 $script
1355
1356        exit 0
1357}
1358
1359proc autosetup_add_init_type {type desc script} {
1360        dict set ::autosetup(inittypes) $type [list $desc $script]
1361}
1362
1363# This is for in creating build-system init scripts
1364#
1365# If the file doesn't exist, create it containing $contents
1366# If the file does exist, only overwrite if --force is specified.
1367#
1368proc 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."
1375                }
1376        } else {
1377                puts "I don't see $filename, so I will create it."
1378        }
1379        writefile $filename $contents
1380}
1381}
1382
1383# ----- module install -----
1384
1385set modsource(install) {
1386# Copyright (c) 2006-2010 WorkWare Systems http://www.workware.net.au/
1387# All rights reserved
1388
1389# Module which can install autosetup
1390
1391proc autosetup_install {dir} {
1392        if {[catch {
1393                cd $dir
1394                file mkdir autosetup
1395
1396                set f [open autosetup/autosetup w]
1397
1398                set publicmodules $::autosetup(libdir)/default.auto
1399
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
1406                        }
1407
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
1416                                }
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"
1422                        }
1423                }
1424                close $in
1425                close $f
1426                exec chmod 755 autosetup/autosetup
1427
1428                # Install public modules
1429                foreach file $publicmodules {
1430                        autosetup_install_file $file autosetup
1431                }
1432
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
1436                }
1437                exec chmod 755 autosetup/config.sub autosetup/config.guess autosetup/find-tclsh
1438
1439                writefile autosetup/README.autosetup \
1440                        "This is [autosetup_version]. See http://msteveb.github.com/autosetup/\n"
1441
1442        } error]} {
1443                user-error "Failed to install autosetup: $error"
1444        }
1445        puts "Installed [autosetup_version] to autosetup/"
1446
1447        # Now create 'configure' if necessary
1448        autosetup_create_configure
1449
1450        exit 0
1451}
1452
1453proc 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
1461                        }
1462                } else {
1463                        puts "I will overwrite the existing configure because you used --force."
1464                }
1465        } else {
1466                puts "I don't see configure, so I will create it."
1467        }
1468        writefile configure \
1469{#!/bin/sh
1470dir="`dirname "$0"`/autosetup"
1471WRAPPER="$0"; export WRAPPER; exec "`$dir/find-tclsh`" "$dir/autosetup" "$@"
1472}
1473        catch {exec chmod 755 configure}
1474}
1475
1476# Append the contents of $file to filehandle $f
1477proc autosetup_install_append {f file} {
1478        set in [open $file]
1479        puts $f [read $in]
1480        close $in
1481}
1482
1483proc autosetup_install_file {file dir} {
1484        if {![file exists $file]} {
1485                error "Missing installation file '$file'"
1486        }
1487        writefile [file join $dir [file tail $file]] [readfile $file]\n
1488}
1489
1490if {$::autosetup(installed)} {
1491        user-error "autosetup can only be installed from development source, not from installed copy"
1492}
1493}
1494
1495# ----- module markdown-formatting -----
1496
1497set modsource(markdown-formatting) {
1498# Copyright (c) 2010 WorkWare Systems http://www.workware.net.au/
1499# All rights reserved
1500
1501# Module which provides text formatting
1502# markdown format (kramdown syntax)
1503
1504use formatting
1505
1506proc 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
1512}
1513proc title {text} {
1514    underline [para $text] =
1515    nl
1516}
1517proc p {text} {
1518    puts [para $text]
1519    nl
1520}
1521proc codelines {lines} {
1522    puts "~~~~~~~~~~~~"
1523    foreach line $lines {
1524        puts $line
1525    }
1526    puts "~~~~~~~~~~~~"
1527    nl
1528}
1529proc code {text} {
1530    puts "~~~~~~~~~~~~"
1531    foreach line [parse_code_block $text] {
1532        puts $line
1533    }
1534    puts "~~~~~~~~~~~~"
1535    nl
1536}
1537proc nl {} {
1538    puts ""
1539}
1540proc underline {text char} {
1541    regexp "^(\[ \t\]*)(.*)" $text -> indent words
1542    puts $text
1543    puts $indent[string repeat $char [string length $words]]
1544}
1545proc section {text} {
1546    underline "[para $text]" -
1547    nl
1548}
1549proc subsection {text} {
1550    puts "### `$text`"
1551    nl
1552}
1553proc bullet {text} {
1554    puts "* [para $text]"
1555}
1556proc 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
1563    }
1564    puts "$defn"
1565}
1566}
1567
1568# ----- module misc -----
1569
1570set modsource(misc) {
1571# Copyright (c) 2007-2010 WorkWare Systems http://www.workware.net.au/
1572# All rights reserved
1573
1574# Module containing misc procs useful to modules
1575# Largely for platform compatibility
1576
1577set autosetup(istcl) [info exists ::tcl_library]
1578set autosetup(iswin) [string equal windows $tcl_platform(platform)]
1579
1580if {$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 .] {;}
1585        }
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
1590                }
1591                return 0
1592        }
1593} else {
1594        # unix separates $PATH with colons and has and executable bit
1595        proc split-path {} {
1596                split [getenv PATH .] :
1597        }
1598        proc file-isexec {exec} {
1599                file executable $exec
1600        }
1601}
1602
1603# Assume that exec can return stdout and stderr
1604proc exec-with-stderr {args} {
1605        exec {*}$args 2>@1
1606}
1607
1608if {$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)
1613                }
1614                if {[llength $args]} {
1615                        return [lindex $args 0]
1616                }
1617                return -code error "environment variable \"$name\" does not exist"
1618        }
1619        proc isatty? {channel} {
1620                dict exists [fconfigure $channel] -xchar
1621        }
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]
1628                }
1629        } else {
1630                # Jim on unix is simple
1631                alias getenv env
1632        }
1633        proc isatty? {channel} {
1634                set tty 0
1635                catch {
1636                        # isatty is a recent addition to Jim Tcl
1637                        set tty [$channel isatty]
1638                }
1639                return $tty
1640        }
1641}
1642
1643# In case 'file normalize' doesn't exist
1644#
1645proc file-normalize {path} {
1646        if {[catch {file normalize $path} result]} {
1647                if {$path eq ""} {
1648                        return ""
1649                }
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]]
1657                }
1658                cd $oldpwd
1659        }
1660        return $result
1661}
1662
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.
1667#
1668# This is designed to be called for incorrect usage in auto.def, via autosetup-error
1669#
1670proc error-location {msg} {
1671        if {$::autosetup(debug)} {
1672                return -code error $msg
1673        }
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)
1680                }
1681                if {[string match *.def $info(file)]} {
1682                        return "[relative-path $info(file)]:$info(line): Error: $msg"
1683                }
1684                #puts "Skipping $info(file):$info(line)"
1685        }
1686        return $msg
1687}
1688
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.
1693#
1694# This is designed to be called for incorrect usage in auto.def, via autosetup-error
1695#
1696proc error-stacktrace {msg} {
1697        if {$::autosetup(debug)} {
1698                return -code error $msg
1699        }
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)
1706                }
1707                if {[string match *.def $info(file)]} {
1708                        return "[relative-path $info(file)]:$info(line): Error: $msg"
1709                }
1710                #puts "Skipping $info(file):$info(line)"
1711        }
1712        return $msg
1713}
1714
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.
1719#
1720# This is designed for developer errors, e.g. in module code or auto.def code
1721#
1722#
1723proc 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"
1729                }
1730        } else {
1731                lassign $opts(-errorinfo) p f l
1732                if {$f ne ""} {
1733                        set result "$f:$l: Error: "
1734                }
1735                append result "$msg\n"
1736                if {$fulltrace} {
1737                        append result [stackdump $opts(-errorinfo)]
1738                }
1739
1740                # Remove the trailing newline
1741                string trim $result
1742        }
1743}
1744}
1745
1746# ----- module text-formatting -----
1747
1748set modsource(text-formatting) {
1749# Copyright (c) 2010 WorkWare Systems http://www.workware.net.au/
1750# All rights reserved
1751
1752# Module which provides text formatting
1753
1754use formatting
1755
1756proc 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
1763        }
1764        if {$len && [string length $space$word] + $len >= $length} {
1765            puts ""
1766            set len 0
1767            set space $nextprefix
1768        }
1769        incr len [string length $space$word]
1770
1771        # Use man-page conventions for highlighting 'quoted' and *quoted*
1772        # single words.
1773        # Use x^Hx for *bold* and _^Hx for 'underline'.
1774        #
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
1783        }
1784        puts -nonewline $space$word
1785        set space " "
1786    }
1787    if {$len} {
1788        puts ""
1789    }
1790}
1791proc title {text} {
1792    underline [string trim $text] =
1793    nl
1794}
1795proc p {text} {
1796    wordwrap $text 80
1797    nl
1798}
1799proc codelines {lines} {
1800    foreach line $lines {
1801        puts "    $line"
1802    }
1803    nl
1804}
1805proc nl {} {
1806    puts ""
1807}
1808proc underline {text char} {
1809    regexp "^(\[ \t\]*)(.*)" $text -> indent words
1810    puts $text
1811    puts $indent[string repeat $char [string length $words]]
1812}
1813proc section {text} {
1814    underline "[string trim $text]" -
1815    nl
1816}
1817proc subsection {text} {
1818    underline "$text" ~
1819    nl
1820}
1821proc bullet {text} {
1822    wordwrap $text 76 "  * " "    "
1823}
1824proc indent {text} {
1825    wordwrap $text 76 "    " "    "
1826}
1827proc defn {first args} {
1828    if {$first ne ""} {
1829        underline "    $first" ~
1830    }
1831    foreach p $args {
1832        if {$p ne ""} {
1833            indent $p
1834        }
1835    }
1836}
1837}
1838
1839# ----- module wiki-formatting -----
1840
1841set modsource(wiki-formatting) {
1842# Copyright (c) 2010 WorkWare Systems http://www.workware.net.au/
1843# All rights reserved
1844
1845# Module which provides text formatting
1846# wiki.tcl.tk format output
1847
1848use formatting
1849
1850proc joinlines {text} {
1851    set lines {}
1852    foreach l [split [string trim $text] \n] {
1853        lappend lines [string trim $l]
1854    }
1855    join $lines
1856}
1857proc p {text} {
1858    puts [joinlines $text]
1859    puts ""
1860}
1861proc title {text} {
1862    puts "*** [joinlines $text] ***"
1863    puts ""
1864}
1865proc codelines {lines} {
1866    puts "======"
1867    foreach line $lines {
1868        puts "    $line"
1869    }
1870    puts "======"
1871}
1872proc code {text} {
1873    puts "======"
1874    foreach line [parse_code_block $text] {
1875        puts "    $line"
1876    }
1877    puts "======"
1878}
1879proc nl {} {
1880}
1881proc section {text} {
1882    puts "'''$text'''"
1883    puts ""
1884}
1885proc subsection {text} {
1886    puts "''$text''"
1887    puts ""
1888}
1889proc bullet {text} {
1890    puts "   * [joinlines $text]"
1891}
1892proc indent {text} {
1893    puts "    :    [joinlines $text]"
1894}
1895proc defn {first args} {
1896    if {$first ne ""} {
1897        indent '''$first'''
1898    }
1899
1900    foreach p $args {
1901        p $p
1902    }
1903}
1904}
1905
1906
1907##################################################################
1908#
1909# Entry/Exit
1910#
1911if {$autosetup(debug)} {
1912        main $argv
1913}
1914if {[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"
1919        }
1920        exit 1
1921}
Note: See TracBrowser for help on using the repository browser.