Fossil

Check-in [a4efad7e]
Login

Many hyperlinks are disabled.
Use anonymous login to enable hyperlinks.

Overview
Comment:Update autosetup to the latest version - https://github.com/msteveb/autosetup/commit/e2a8949b420 .
Downloads: Tarball | ZIP archive | SQL archive
Timelines: family | ancestors | descendants | both | trunk
Files: files | file ages | folders
SHA1:a4efad7e61f2b997c7498f8acfc3fda7f004d541
User & Date: dan 2011-07-14 14:34:59
Context
2011-07-14
15:28
Add a commentary section to the check-in checklist. Also add the "verify makefiles" item. /doc/trunk/www/checkin.wiki check-in: 39624620 user: drh tags: trunk
14:34
Update autosetup to the latest version - https://github.com/msteveb/autosetup/commit/e2a8949b420 . check-in: a4efad7e user: dan tags: trunk
13:29
Update the pre-commit checklist: /doc/trunk/www/checkin.wiki check-in: 831306e1 user: drh tags: trunk
Changes
Hide Diffs Unified Diffs Ignore Whitespace Patch

Changes to autosetup/autosetup.

1
2
3
4
5
6
7
8
9
10
11
12
13
...
108
109
110
111
112
113
114






115
116
117
118
119
120
121
...
854
855
856
857
858
859
860
861
862
863
864
865
866
867
868
869
870
871
872
873
874
875
876
877
878
879
880
881
882
883
884
885
886
887
888
889
890
891
892
893
894
895
896
897
898
899
900
901
902
903
904
905
906
907
908
909
910
911
912
913
914
915
916
917
918
919
920
921
922
923
924
925
926
927
928
929
930
931
932
933
934
935
936
937
938
939
940
....
1053
1054
1055
1056
1057
1058
1059














































































































































































































































































































1060
1061
1062
1063
1064
1065
1066
....
1081
1082
1083
1084
1085
1086
1087
1088
1089
1090
1091
1092
1093
1094
1095
....
1140
1141
1142
1143
1144
1145
1146
1147
1148
1149
1150
1151
1152
1153

1154
1155
1156
1157
1158
1159
1160
1161


1162
1163
1164
1165
1166
1167
1168
1169
1170
1171
1172
1173
1174
1175
1176
1177
1178
1179
1180
1181
1182
1183
1184
1185
1186
1187
1188
1189
1190
1191
1192
1193
1194
1195
1196
1197
1198
1199
1200

1201
1202
1203









1204
1205
1206
1207
1208
1209
1210
1211
1212
1213
1214
1215
1216
1217
1218
1219
1220
1221
1222
1223
1224
1225
1226
1227
1228


1229

1230

1231
1232
1233
1234
1235
1236
1237
1238
1239
1240
1241
1242
1243
....
1394
1395
1396
1397
1398
1399
1400
1401
1402
1403
1404
1405
1406
1407
1408
1409
1410
1411
1412
1413



1414
1415


1416

1417


1418
1419
1420
1421
1422

1423



1424
1425
1426
1427
1428
1429
1430
1431
1432
1433
1434
1435


1436
1437
1438
1439
1440
1441
1442

1443
1444
1445
1446

1447
1448
1449
1450


1451

1452
1453
1454

1455
1456
1457
1458
1459
1460

1461
1462
1463
1464


1465
1466
1467
1468


1469
1470
1471
1472
1473
1474
1475
1476

1477
1478
1479

1480
1481
1482


1483
1484
1485
1486
1487

1488
1489
1490
1491
1492
1493
1494
1495
1496
1497
1498
1499
1500
1501
1502
1503
1504
1505
1506
1507
1508
1509
1510
1511
1512
1513
1514
1515
1516
1517
1518
1519
1520
1521
1522
1523
1524
1525
1526
1527
1528
1529
1530
1531
1532
1533
1534
1535
1536
1537
1538
1539
1540
1541
1542
1543
1544
1545
....
1600
1601
1602
1603
1604
1605
1606
1607
1608
1609
1610
1611
1612
1613
1614
1615
1616
1617
1618
1619
1620
1621
1622
1623
1624
1625
1626
1627
1628
1629
1630
1631
1632
1633
1634
1635
1636
1637
1638
1639
1640
1641
1642
1643
1644
1645
1646
1647
1648
1649
1650
1651
1652
1653
1654
1655
1656
1657
1658
1659
1660
1661
1662
1663
1664
1665
1666
1667
1668
1669
1670
1671
1672
1673
1674
1675
1676
1677
1678
1679
1680
1681
1682
1683
1684
1685
1686
1687
1688
1689
1690
1691
1692
1693
1694
1695
1696
1697
1698
1699
1700
1701
1702
1703
1704
1705
1706
1707
1708
1709
1710
1711
1712
1713
1714
1715
1716
1717
1718
1719
1720
1721
1722
1723
1724
1725
1726
1727
1728
1729
1730
1731
1732
1733
1734
1735
1736
1737
1738
1739
1740
1741
1742
1743
1744
1745
1746
1747
1748
1749
1750
1751
1752
1753
1754
1755
1756
1757
1758
1759
1760
1761
1762
1763
1764
1765
1766
1767
1768
1769
1770
1771
1772
1773
1774
#!/bin/sh
# Copyright (c) 2006-2010 WorkWare Systems http://www.workware.net.au/
# All rights reserved
# vim:se syntax=tcl:
# \
exec $($(dirname "$0")/find-tclsh || echo false) "$0" "$@"

set autosetup(version) 0.6.2

# Can be set to 1 to debug early-init problems
set autosetup(debug) 0

##################################################################
................................................................................
	}

	# Debugging output (set this early)
	incr autosetup(debug) [opt-bool debug]
	incr autosetup(force) [opt-bool force]
	incr autosetup(msg-quiet) [opt-bool quiet]
	incr autosetup(msg-timing) [opt-bool timing]







	if {[opt-val help] ne ""} {
		incr autosetup(showhelp)
		use help
		autosetup_help [opt-val help]
	}

................................................................................
set autosetup(start) [clock millis]
set autosetup(installed) 0
set autosetup(msg-checking) 0
set autosetup(msg-quiet) 0

# Embedded modules are inserted below here
set autosetup(installed) 1
# ----- module markdown-formatting -----

set modsource(markdown-formatting) {
# Copyright (c) 2010 WorkWare Systems http://www.workware.net.au/
# All rights reserved

# Module which provides text formatting
# markdown format (kramdown syntax)

use formatting

proc para {text} {
    regsub -all "\[ \t\n\]+" [string trim $text] " " text
    regsub -all {([^a-zA-Z])'([^']*)'} $text {\1**`\2`**} text
    regsub -all {^'([^']*)'} $text {**`\1`**} text
    regsub -all {(http[^ \t\n]*)} $text {[\1](\1)} text
    return $text
}
proc title {text} {
    underline [para $text] =
    nl
}
proc p {text} {
    puts [para $text]
    nl
}
proc codelines {lines} {
    puts "~~~~~~~~~~~~"
    foreach line $lines {
        puts $line
    }
    puts "~~~~~~~~~~~~"
    nl
}
proc code {text} {
    puts "~~~~~~~~~~~~"
    foreach line [parse_code_block $text] {
        puts $line
    }
    puts "~~~~~~~~~~~~"
    nl
}
proc nl {} {
    puts ""
}
proc underline {text char} {
    regexp "^(\[ \t\]*)(.*)" $text -> indent words
    puts $text
    puts $indent[string repeat $char [string length $words]]
}
proc section {text} {
    underline "[para $text]" -
    nl
}
proc subsection {text} {
    puts "### `$text`"
    nl
}
proc bullet {text} {
    puts "* [para $text]"
}
proc defn {first args} {
    puts "^"
    set defn [string trim [join $args \n]]
    if {$first ne ""} {
        puts "**${first}**"
        puts -nonewline ": "
        regsub -all "\n\n" $defn "\n: " defn
    }
    puts "$defn"
}
}

# ----- module asciidoc-formatting -----

set modsource(asciidoc-formatting) {
# Copyright (c) 2010 WorkWare Systems http://www.workware.net.au/
# All rights reserved

# Module which provides text formatting
................................................................................
        lappend lines [string range $line $min end]
    }

    # Return the result
    return $lines
}
}















































































































































































































































































































# ----- module install -----

set modsource(install) {
# Copyright (c) 2006-2010 WorkWare Systems http://www.workware.net.au/
# All rights reserved

................................................................................
				puts $f $buf
				continue
			}

			# Insert the static modules here
			# i.e. those which don't contain @synopsis:
			puts $f "set autosetup(installed) 1"
			foreach file [glob $::autosetup(libdir)/*.tcl] {
				set buf [readfile $file]
				if {[string match "*\n# @synopsis:*" $buf]} {
					lappend publicmodules $file
					continue
				}
				set modname [file rootname [file tail $file]]
				puts $f "# ----- module $modname -----"
................................................................................
}

if {$::autosetup(installed)} {
	user-error "autosetup can only be installed from development source, not from installed copy"
}
}

# ----- module text-formatting -----

set modsource(text-formatting) {
# Copyright (c) 2010 WorkWare Systems http://www.workware.net.au/
# All rights reserved

# Module which provides text formatting


use formatting

proc wordwrap {text length {firstprefix ""} {nextprefix ""}} {
    set len 0
    set space $firstprefix
    foreach word [split $text] {
        set word [string trim $word]


        if {$word == ""} {
            continue
        }
        if {$len && [string length $space$word] + $len >= $length} {
            puts ""
            set len 0
            set space $nextprefix
        }
        incr len [string length $space$word]

        # Use man-page conventions for highlighting 'quoted' and *quoted*
        # single words.
        # Use x^Hx for *bold* and _^Hx for 'underline'.
        #
        # less and more will both understand this.
        # Pipe through 'col -b' to remove them.
        if {[regexp {^'(.*)'([^a-zA-Z0-9_]*)$} $word -> bareword dot]} {
            regsub -all . $bareword "_\b&" word
            append word $dot
        } elseif {[regexp {^[*](.*)[*]([^a-zA-Z0-9_]*)$} $word -> bareword dot]} {
            regsub -all . $bareword "&\b&" word
            append word $dot
        }
        puts -nonewline $space$word
        set space " "
    }
    if {$len} {
        puts ""
    }
}
proc title {text} {
    underline [string trim $text] =
    nl
}
proc p {text} {
    wordwrap $text 80
    nl
}
proc codelines {lines} {

    foreach line $lines {
        puts "    $line"
    }









    nl
}
proc nl {} {
    puts ""
}
proc underline {text char} {
    regexp "^(\[ \t\]*)(.*)" $text -> indent words
    puts $text
    puts $indent[string repeat $char [string length $words]]
}
proc section {text} {
    underline "[string trim $text]" -
    nl
}
proc subsection {text} {
    underline "$text" ~
    nl
}
proc bullet {text} {
    wordwrap $text 76 "  * " "    "
}
proc indent {text} {
    wordwrap $text 76 "    " "    "
}
proc defn {first args} {


    if {$first ne ""} {

        underline "    $first" ~

    }
    foreach p $args {
        if {$p ne ""} {
            indent $p
        }
    }
}
}

# ----- module misc -----

set modsource(misc) {
# Copyright (c) 2007-2010 WorkWare Systems http://www.workware.net.au/
................................................................................
		}

		return "${prefix}Error: $msg\n[stackdump $newstacktrace]"
	}
}
}

# ----- module getopt -----

set modsource(getopt) {
# Copyright (c) 2006 WorkWare Systems http://www.workware.net.au/
# All rights reserved

# Simple getopt module

# Parse everything out of the argv list which looks like an option
# Knows about --enable-thing and --disable-thing as alternatives for --thing=0 or --thing=1
proc getopt {argvname} {
	upvar $argvname argv




	for {set i 0} {$i < [llength $argv]} {incr i} {
		set arg [lindex $argv $i]




		#dputs arg=$arg



		if {$arg eq "--"} {
			# End of options
			incr i
			break

		}




		if {[regexp {^--([^=][^=]+)=(.*)$} $arg -> name value]} {
			lappend opts($name) $value
		} elseif {[regexp {^--(enable-|disable-)?([^=]*)$} $arg -> prefix name]} {
			if {$prefix eq "disable-"} {
				set value 0
			} else {
				set value 1
			}
			lappend opts($name) $value
		} else {
			break


		}
	}

	#puts "getopt: argv=[join $argv] => [join [lrange $argv $i end]]"
	#parray opts

	set argv [lrange $argv $i end]


	return [array get opts]
}


proc opt_val {optarrayname options {default {}}} {
	upvar $optarrayname opts

	set result {}




	foreach o $options {
		if {[info exists opts($o)]} {
			lappend result {*}$opts($o)

		}
	}
	if {[llength $result] == 0} {
		return $default
	}
	return $result

}

proc opt_bool {optarrayname args} {
	upvar $optarrayname opts



	# Support the args being passed as a list
	if {[llength $args] == 1} {
		set args [lindex $args 0]


	}

	foreach o $args {
		if {[info exists opts($o)]} {
			if {"1" in $opts($o) || "yes" in $opts($o)} {
				return 1
			}
		}

	}
	return 0
}

}

# ----- module init -----



set modsource(init) {
# Copyright (c) 2010 WorkWare Systems http://www.workware.net.au/
# All rights reserved


# Module to help create auto.def and configure

proc autosetup_init {} {
	set create_configure 1
	if {[file exists configure]} {
		if {!$::autosetup(force)} {
			# Could this be an autosetup configure?
			if {![string match "*\nWRAPPER=*" [readfile configure]]} {
				puts "I see configure, but not created by autosetup, so I won't overwrite it."
				puts "Use autosetup --init --force to overwrite."
				set create_configure 0
			}
		} else {
			puts "I will overwrite the existing configure because you used --force."
		}
	} else {
		puts "I don't see configure, so I will create it."
	}
	if {$create_configure} {
		if {!$::autosetup(installed)} {
			user-notice "Warning: Initialising from the development version of autosetup"

			writefile configure "#!/bin/sh\nWRAPPER=\"\$0\" exec $::autosetup(dir)/autosetup \"\$@\"\n"
		} else {
			writefile configure \
{#!/bin/sh
dir="$(dirname "$0")/autosetup"
WRAPPER="$0" exec $("$dir/find-tclsh" || echo false) "$dir/autosetup" "$@"
}
		}
		catch {exec chmod 755 configure}
	}
	if {![file exists auto.def]} {
		puts "I don't see auto.def, so I will create a default one."
		writefile auto.def {# Initial auto.def created by 'autosetup --init'

use cc

# Add any user options here
options {
}

make-autoconf-h config.h
make-template Makefile.in
}
	}
	if {![file exists Makefile.in]} {
		puts "Note: I don't see Makefile.in. You will probably need to create one."
	}

	exit 0
}
}

# ----- module wiki-formatting -----

set modsource(wiki-formatting) {
# Copyright (c) 2010 WorkWare Systems http://www.workware.net.au/
................................................................................
        indent '''$first'''
    }

    foreach p $args {
        p $p
    }
}
}

# ----- module help -----

set modsource(help) {
# Copyright (c) 2010 WorkWare Systems http://workware.net.au/
# All rights reserved

# Module which provides usage, help and the command reference

proc autosetup_help {what} {
    use_pager

    puts "Usage: [file tail $::autosetup(exe)] \[options\] \[settings\]\n"
    puts "This is [autosetup_version], a build environment \"autoconfigurator\""
    puts "See the documentation online at http://msteveb.github.com/autosetup/\n"

    if {$what eq "local"} {
        if {[file exists $::autosetup(autodef)]} {
            # This relies on auto.def having a call to 'options'
            # which will display options and quit
            source $::autosetup(autodef)
        } else {
            options-show
        }
    } else {
        incr ::autosetup(showhelp)
        if {[catch {use $what}]} {
            user-error "Unknown module: $what"
        } else {
            options-show
        }
    }
    exit 0
}

# If not already paged and stdout is a tty, pipe the output through the pager
# This is done by reinvoking autosetup with --nopager added
proc use_pager {} {
    if {0 && ![opt-bool nopager] && [getenv PAGER ""] ne "" && ![string match "not a tty" [exec tty]]} {
        catch {
            exec [info nameofexecutable] $::argv0 --nopager {*}$::argv | [getenv PAGER] >@stdout <@stdin 2>/dev/null
        }
        exit 0
    }
}

# Outputs the autosetup references in one of several formats
proc autosetup_reference {{type text}} {

    use_pager

    switch -glob -- $type {
        wiki {use wiki-formatting}
        ascii* {use asciidoc-formatting}
        md - markdown {use markdown-formatting}
        default {use text-formatting}
    }

    title "[autosetup_version] -- Command Reference"

    section {Introduction}

    p {
        See http://msteveb.github.com/autosetup/ for the online documentation for 'autosetup'
    }

    p {
        'autosetup' provides a number of built-in commands which
        are documented below. These may be used from 'auto.def' to test
        for features, define variables, create files from templates and
        other similar actions.
    }

    automf_command_reference

    exit 0
}

proc autosetup_output_block {type lines} {
    if {[llength $lines]} {
        switch $type {
            code {
                codelines $lines
            }
            p {
                p [join $lines]
            }
            list {
                foreach line $lines {
                    bullet $line
                }
                nl
            }
        }
    }
}

# Generate a command reference from inline documentation
proc automf_command_reference {} {
    lappend files $::autosetup(prog)
    lappend files {*}[lsort [glob -nocomplain $::autosetup(libdir)/*.tcl]]

    section "Core Commands"
    set type p
    set lines {}
    set cmd {}

    foreach file $files {
        set f [open $file]
        while {![eof $f]} {
            set line [gets $f]

            # Find lines starting with "# @*" and continuing through the remaining comment lines
            if {![regexp {^# @(.*)} $line -> cmd]} {
                continue
            }

            # Synopsis or command?
            if {$cmd eq "synopsis:"} {
                section "Module: [file rootname [file tail $file]]"
            } else {
                subsection $cmd
            }

            set lines {}
            set type p

            # Now the description
            while {![eof $f]} {
                set line [gets $f]

                if {![regexp {^#(#)? ?(.*)} $line -> hash cmd]} {
                    break
                }
                if {$hash eq "#"} {
                    set t code
                } elseif {[regexp {^- (.*)} $cmd -> cmd]} {
                    set t list
                } else {
                    set t p
                }

                #puts "hash=$hash, oldhash=$oldhash, lines=[llength $lines], cmd=$cmd"

                if {$t ne $type || $cmd eq ""} {
                    # Finish the current block
                    autosetup_output_block $type $lines
                    set lines {}
                    set type $t
                }
                if {$cmd ne ""} {
                    lappend lines $cmd
                }
            }

            autosetup_output_block $type $lines
        }
        close $f
    }
}
}


##################################################################
#
# Entry/Exit
#





|







 







>
>
>
>
>
>







 







<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<







 







>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>







 







|







 







|

|




>



<
|
<
<
|
>
>
|
|
|
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<

|



|



>

|

>
>
>
>
>
>
>
>
>











|



|



|

<
<
<

>
>

>
|
>

<
|
<
<
<







 







|

|
|


|

|
<
<
<

>
>
>
|
|
>
>
|
>
|
>
>
|
<
<
<
<
>
|
>
>
>
|
<
<
<
<
<
|
|
|
|
|
|
>
>
|
<
<
|
|
|
|
>
|
<

<
>
|
|
|
|
>
>
|
>
|
<
<
>
|
<
<
|
|
|
>

<
|
|
>
>
|
<
<
|
>
>
|
<
<
|
|
|
|
|
>
|
<
|
>

<
|
>
>
|
<
<
|
<
>
|
|
<
<
<
<
<
<
<
<
<
|
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<







 







<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<







1
2
3
4
5
6
7
8
9
10
11
12
13
...
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
...
860
861
862
863
864
865
866









































































867
868
869
870
871
872
873
...
986
987
988
989
990
991
992
993
994
995
996
997
998
999
1000
1001
1002
1003
1004
1005
1006
1007
1008
1009
1010
1011
1012
1013
1014
1015
1016
1017
1018
1019
1020
1021
1022
1023
1024
1025
1026
1027
1028
1029
1030
1031
1032
1033
1034
1035
1036
1037
1038
1039
1040
1041
1042
1043
1044
1045
1046
1047
1048
1049
1050
1051
1052
1053
1054
1055
1056
1057
1058
1059
1060
1061
1062
1063
1064
1065
1066
1067
1068
1069
1070
1071
1072
1073
1074
1075
1076
1077
1078
1079
1080
1081
1082
1083
1084
1085
1086
1087
1088
1089
1090
1091
1092
1093
1094
1095
1096
1097
1098
1099
1100
1101
1102
1103
1104
1105
1106
1107
1108
1109
1110
1111
1112
1113
1114
1115
1116
1117
1118
1119
1120
1121
1122
1123
1124
1125
1126
1127
1128
1129
1130
1131
1132
1133
1134
1135
1136
1137
1138
1139
1140
1141
1142
1143
1144
1145
1146
1147
1148
1149
1150
1151
1152
1153
1154
1155
1156
1157
1158
1159
1160
1161
1162
1163
1164
1165
1166
1167
1168
1169
1170
1171
1172
1173
1174
1175
1176
1177
1178
1179
1180
1181
1182
1183
1184
1185
1186
1187
1188
1189
1190
1191
1192
1193
1194
1195
1196
1197
1198
1199
1200
1201
1202
1203
1204
1205
1206
1207
1208
1209
1210
1211
1212
1213
1214
1215
1216
1217
1218
1219
1220
1221
1222
1223
1224
1225
1226
1227
1228
1229
1230
1231
1232
1233
1234
1235
1236
1237
1238
1239
1240
1241
1242
1243
1244
1245
1246
1247
1248
1249
1250
1251
1252
1253
1254
1255
1256
1257
1258
1259
1260
1261
1262
1263
1264
1265
1266
1267
1268
1269
1270
1271
1272
1273
1274
1275
1276
1277
1278
1279
1280
1281
1282
1283
1284
1285
1286
1287
1288
1289
1290
1291
1292
1293
1294
1295
1296
1297
1298
1299
1300
1301
....
1316
1317
1318
1319
1320
1321
1322
1323
1324
1325
1326
1327
1328
1329
1330
....
1375
1376
1377
1378
1379
1380
1381
1382
1383
1384
1385
1386
1387
1388
1389
1390
1391
1392

1393


1394
1395
1396
1397
1398
1399



























1400
1401
1402
1403
1404
1405
1406
1407
1408
1409
1410
1411
1412
1413
1414
1415
1416
1417
1418
1419
1420
1421
1422
1423
1424
1425
1426
1427
1428
1429
1430
1431
1432
1433
1434
1435
1436
1437
1438
1439
1440
1441
1442



1443
1444
1445
1446
1447
1448
1449
1450

1451



1452
1453
1454
1455
1456
1457
1458
....
1609
1610
1611
1612
1613
1614
1615
1616
1617
1618
1619
1620
1621
1622
1623
1624



1625
1626
1627
1628
1629
1630
1631
1632
1633
1634
1635
1636
1637
1638




1639
1640
1641
1642
1643
1644





1645
1646
1647
1648
1649
1650
1651
1652
1653


1654
1655
1656
1657
1658
1659

1660

1661
1662
1663
1664
1665
1666
1667
1668
1669
1670


1671
1672


1673
1674
1675
1676
1677

1678
1679
1680
1681
1682


1683
1684
1685
1686


1687
1688
1689
1690
1691
1692
1693

1694
1695
1696

1697
1698
1699
1700


1701

1702
1703
1704









1705







































1706
1707
1708
1709
1710
1711
1712
....
1767
1768
1769
1770
1771
1772
1773

































































































































































1774
1775
1776
1777
1778
1779
1780
#!/bin/sh
# Copyright (c) 2006-2010 WorkWare Systems http://www.workware.net.au/
# All rights reserved
# vim:se syntax=tcl:
# \
dir=`dirname "$0"`; exec `"$dir/find-tclsh" || echo false` "$0" "$@"

set autosetup(version) 0.6.2

# Can be set to 1 to debug early-init problems
set autosetup(debug) 0

##################################################################
................................................................................
	}

	# Debugging output (set this early)
	incr autosetup(debug) [opt-bool debug]
	incr autosetup(force) [opt-bool force]
	incr autosetup(msg-quiet) [opt-bool quiet]
	incr autosetup(msg-timing) [opt-bool timing]

	# If the local module exists, source it now to allow for
	# project-local customisations
	if {[file exists $autosetup(libdir)/local.tcl]} {
		use local
	}

	if {[opt-val help] ne ""} {
		incr autosetup(showhelp)
		use help
		autosetup_help [opt-val help]
	}

................................................................................
set autosetup(start) [clock millis]
set autosetup(installed) 0
set autosetup(msg-checking) 0
set autosetup(msg-quiet) 0

# Embedded modules are inserted below here
set autosetup(installed) 1









































































# ----- module asciidoc-formatting -----

set modsource(asciidoc-formatting) {
# Copyright (c) 2010 WorkWare Systems http://www.workware.net.au/
# All rights reserved

# Module which provides text formatting
................................................................................
        lappend lines [string range $line $min end]
    }

    # Return the result
    return $lines
}
}

# ----- module getopt -----

set modsource(getopt) {
# Copyright (c) 2006 WorkWare Systems http://www.workware.net.au/
# All rights reserved

# Simple getopt module

# Parse everything out of the argv list which looks like an option
# Knows about --enable-thing and --disable-thing as alternatives for --thing=0 or --thing=1
proc getopt {argvname} {
	upvar $argvname argv

	for {set i 0} {$i < [llength $argv]} {incr i} {
		set arg [lindex $argv $i]

		#dputs arg=$arg

		if {$arg eq "--"} {
			# End of options
			incr i
			break
		}

		if {[regexp {^--([^=][^=]+)=(.*)$} $arg -> name value]} {
			lappend opts($name) $value
		} elseif {[regexp {^--(enable-|disable-)?([^=]*)$} $arg -> prefix name]} {
			if {$prefix eq "disable-"} {
				set value 0
			} else {
				set value 1
			}
			lappend opts($name) $value
		} else {
			break
		}
	}

	#puts "getopt: argv=[join $argv] => [join [lrange $argv $i end]]"
	#parray opts

	set argv [lrange $argv $i end]

	return [array get opts]
}

proc opt_val {optarrayname options {default {}}} {
	upvar $optarrayname opts

	set result {}

	foreach o $options {
		if {[info exists opts($o)]} {
			lappend result {*}$opts($o)
		}
	}
	if {[llength $result] == 0} {
		return $default
	}
	return $result
}

proc opt_bool {optarrayname args} {
	upvar $optarrayname opts

	# Support the args being passed as a list
	if {[llength $args] == 1} {
		set args [lindex $args 0]
	}

	foreach o $args {
		if {[info exists opts($o)]} {
			if {"1" in $opts($o) || "yes" in $opts($o)} {
				return 1
			}
		}
	}
	return 0
}
}

# ----- module help -----

set modsource(help) {
# Copyright (c) 2010 WorkWare Systems http://workware.net.au/
# All rights reserved

# Module which provides usage, help and the command reference

proc autosetup_help {what} {
    use_pager

    puts "Usage: [file tail $::autosetup(exe)] \[options\] \[settings\]\n"
    puts "This is [autosetup_version], a build environment \"autoconfigurator\""
    puts "See the documentation online at http://msteveb.github.com/autosetup/\n"

    if {$what eq "local"} {
        if {[file exists $::autosetup(autodef)]} {
            # This relies on auto.def having a call to 'options'
            # which will display options and quit
            source $::autosetup(autodef)
        } else {
            options-show
        }
    } else {
        incr ::autosetup(showhelp)
        if {[catch {use $what}]} {
            user-error "Unknown module: $what"
        } else {
            options-show
        }
    }
    exit 0
}

# If not already paged and stdout is a tty, pipe the output through the pager
# This is done by reinvoking autosetup with --nopager added
proc use_pager {} {
    if {![opt-bool nopager] && [getenv PAGER ""] ne "" && ![string match "not a tty" [exec tty]]} {
        catch {
            exec [info nameofexecutable] $::argv0 --nopager {*}$::argv | [getenv PAGER] >@stdout <@stdin 2>/dev/null
        }
        exit 0
    }
}

# Outputs the autosetup references in one of several formats
proc autosetup_reference {{type text}} {

    use_pager

    switch -glob -- $type {
        wiki {use wiki-formatting}
        ascii* {use asciidoc-formatting}
        md - markdown {use markdown-formatting}
        default {use text-formatting}
    }

    title "[autosetup_version] -- Command Reference"

    section {Introduction}

    p {
        See http://msteveb.github.com/autosetup/ for the online documentation for 'autosetup'
    }

    p {
        'autosetup' provides a number of built-in commands which
        are documented below. These may be used from 'auto.def' to test
        for features, define variables, create files from templates and
        other similar actions.
    }

    automf_command_reference

    exit 0
}

proc autosetup_output_block {type lines} {
    if {[llength $lines]} {
        switch $type {
            code {
                codelines $lines
            }
            p {
                p [join $lines]
            }
            list {
                foreach line $lines {
                    bullet $line
                }
                nl
            }
        }
    }
}

# Generate a command reference from inline documentation
proc automf_command_reference {} {
    lappend files $::autosetup(prog)
    lappend files {*}[lsort [glob -nocomplain $::autosetup(libdir)/*.tcl]]

    section "Core Commands"
    set type p
    set lines {}
    set cmd {}

    foreach file $files {
        set f [open $file]
        while {![eof $f]} {
            set line [gets $f]

            # Find lines starting with "# @*" and continuing through the remaining comment lines
            if {![regexp {^# @(.*)} $line -> cmd]} {
                continue
            }

            # Synopsis or command?
            if {$cmd eq "synopsis:"} {
                section "Module: [file rootname [file tail $file]]"
            } else {
                subsection $cmd
            }

            set lines {}
            set type p

            # Now the description
            while {![eof $f]} {
                set line [gets $f]

                if {![regexp {^#(#)? ?(.*)} $line -> hash cmd]} {
                    break
                }
                if {$hash eq "#"} {
                    set t code
                } elseif {[regexp {^- (.*)} $cmd -> cmd]} {
                    set t list
                } else {
                    set t p
                }

                #puts "hash=$hash, oldhash=$oldhash, lines=[llength $lines], cmd=$cmd"

                if {$t ne $type || $cmd eq ""} {
                    # Finish the current block
                    autosetup_output_block $type $lines
                    set lines {}
                    set type $t
                }
                if {$cmd ne ""} {
                    lappend lines $cmd
                }
            }

            autosetup_output_block $type $lines
        }
        close $f
    }
}
}

# ----- module init -----

set modsource(init) {
# Copyright (c) 2010 WorkWare Systems http://www.workware.net.au/
# All rights reserved

# Module to help create auto.def and configure

proc autosetup_init {} {
	set create_configure 1
	if {[file exists configure]} {
		if {!$::autosetup(force)} {
			# Could this be an autosetup configure?
			if {![string match "*\nWRAPPER=*" [readfile configure]]} {
				puts "I see configure, but not created by autosetup, so I won't overwrite it."
				puts "Use autosetup --init --force to overwrite."
				set create_configure 0
			}
		} else {
			puts "I will overwrite the existing configure because you used --force."
		}
	} else {
		puts "I don't see configure, so I will create it."
	}
	if {$create_configure} {
		if {!$::autosetup(installed)} {
			user-notice "Warning: Initialising from the development version of autosetup"

			writefile configure "#!/bin/sh\nWRAPPER=\"\$0\" exec $::autosetup(dir)/autosetup \"\$@\"\n"
		} else {
			writefile configure \
{#!/bin/sh
dir="`dirname "$0"`/autosetup"
WRAPPER="$0" exec `"$dir/find-tclsh" || echo false` "$dir/autosetup" "$@"
}
		}
		catch {exec chmod 755 configure}
	}
	if {![file exists auto.def]} {
		puts "I don't see auto.def, so I will create a default one."
		writefile auto.def {# Initial auto.def created by 'autosetup --init'

use cc

# Add any user options here
options {
}

make-autoconf-h config.h
make-template Makefile.in
}
	}
	if {![file exists Makefile.in]} {
		puts "Note: I don't see Makefile.in. You will probably need to create one."
	}

	exit 0
}
}

# ----- module install -----

set modsource(install) {
# Copyright (c) 2006-2010 WorkWare Systems http://www.workware.net.au/
# All rights reserved

................................................................................
				puts $f $buf
				continue
			}

			# Insert the static modules here
			# i.e. those which don't contain @synopsis:
			puts $f "set autosetup(installed) 1"
			foreach file [lsort [glob $::autosetup(libdir)/*.tcl]] {
				set buf [readfile $file]
				if {[string match "*\n# @synopsis:*" $buf]} {
					lappend publicmodules $file
					continue
				}
				set modname [file rootname [file tail $file]]
				puts $f "# ----- module $modname -----"
................................................................................
}

if {$::autosetup(installed)} {
	user-error "autosetup can only be installed from development source, not from installed copy"
}
}

# ----- module markdown-formatting -----

set modsource(markdown-formatting) {
# Copyright (c) 2010 WorkWare Systems http://www.workware.net.au/
# All rights reserved

# Module which provides text formatting
# markdown format (kramdown syntax)

use formatting


proc para {text} {


    regsub -all "\[ \t\n\]+" [string trim $text] " " text
    regsub -all {([^a-zA-Z])'([^']*)'} $text {\1**`\2`**} text
    regsub -all {^'([^']*)'} $text {**`\1`**} text
    regsub -all {(http[^ \t\n]*)} $text {[\1](\1)} text
    return $text
}



























proc title {text} {
    underline [para $text] =
    nl
}
proc p {text} {
    puts [para $text]
    nl
}
proc codelines {lines} {
    puts "~~~~~~~~~~~~"
    foreach line $lines {
        puts $line
    }
    puts "~~~~~~~~~~~~"
    nl
}
proc code {text} {
    puts "~~~~~~~~~~~~"
    foreach line [parse_code_block $text] {
        puts $line
    }
    puts "~~~~~~~~~~~~"
    nl
}
proc nl {} {
    puts ""
}
proc underline {text char} {
    regexp "^(\[ \t\]*)(.*)" $text -> indent words
    puts $text
    puts $indent[string repeat $char [string length $words]]
}
proc section {text} {
    underline "[para $text]" -
    nl
}
proc subsection {text} {
    puts "### `$text`"
    nl
}
proc bullet {text} {
    puts "* [para $text]"
}



proc defn {first args} {
    puts "^"
    set defn [string trim [join $args \n]]
    if {$first ne ""} {
        puts "**${first}**"
        puts -nonewline ": "
        regsub -all "\n\n" $defn "\n: " defn
    }

    puts "$defn"



}
}

# ----- module misc -----

set modsource(misc) {
# Copyright (c) 2007-2010 WorkWare Systems http://www.workware.net.au/
................................................................................
		}

		return "${prefix}Error: $msg\n[stackdump $newstacktrace]"
	}
}
}

# ----- module text-formatting -----

set modsource(text-formatting) {
# Copyright (c) 2010 WorkWare Systems http://www.workware.net.au/
# All rights reserved

# Module which provides text formatting

use formatting




proc wordwrap {text length {firstprefix ""} {nextprefix ""}} {
    set len 0
    set space $firstprefix
    foreach word [split $text] {
        set word [string trim $word]
        if {$word == ""} {
            continue
        }
        if {$len && [string length $space$word] + $len >= $length} {
            puts ""
            set len 0
            set space $nextprefix
        }




        incr len [string length $space$word]

        # Use man-page conventions for highlighting 'quoted' and *quoted*
        # single words.
        # Use x^Hx for *bold* and _^Hx for 'underline'.
        #





        # less and more will both understand this.
        # Pipe through 'col -b' to remove them.
        if {[regexp {^'(.*)'([^a-zA-Z0-9_]*)$} $word -> bareword dot]} {
            regsub -all . $bareword "_\b&" word
            append word $dot
        } elseif {[regexp {^[*](.*)[*]([^a-zA-Z0-9_]*)$} $word -> bareword dot]} {
            regsub -all . $bareword "&\b&" word
            append word $dot
        }


        puts -nonewline $space$word
        set space " "
    }
    if {$len} {
        puts ""
    }

}

proc title {text} {
    underline [string trim $text] =
    nl
}
proc p {text} {
    wordwrap $text 80
    nl
}
proc codelines {lines} {
    foreach line $lines {


        puts "    $line"
    }


    nl
}
proc nl {} {
    puts ""
}

proc underline {text char} {
    regexp "^(\[ \t\]*)(.*)" $text -> indent words
    puts $text
    puts $indent[string repeat $char [string length $words]]
}


proc section {text} {
    underline "[string trim $text]" -
    nl
}


proc subsection {text} {
    underline "$text" ~
    nl
}
proc bullet {text} {
    wordwrap $text 76 "  * " "    "
}

proc indent {text} {
    wordwrap $text 76 "    " "    "
}

proc defn {first args} {
    if {$first ne ""} {
        underline "    $first" ~
    }


    foreach p $args {

        if {$p ne ""} {
            indent $p
        }









    }







































}
}

# ----- module wiki-formatting -----

set modsource(wiki-formatting) {
# Copyright (c) 2010 WorkWare Systems http://www.workware.net.au/
................................................................................
        indent '''$first'''
    }

    foreach p $args {
        p $p
    }
}

































































































































































}


##################################################################
#
# Entry/Exit
#

Changes to autosetup/cc.tcl.

606
607
608
609
610
611
612
613
614
615
616
617
618
619
620
...
637
638
639
640
641
642
643







644
645
646
647
648
649
650
651
652
653

654
655
656
657
			}
		}
	}
	return ""
}

# Initialise some values from the environment or commandline or default settings
foreach i {LDFLAGS LIBS CPPFLAGS LINKFLAGS {CFLAGS "-g -O2"} {CC_FOR_BUILD cc}} {
	lassign $i var default
	define $var [get-env $var $default]
}

if {[env-is-set CC]} {
	# Set by the user, so don't try anything else
	set try [list [get-env CC ""]]
................................................................................
	define CXX [find-an-executable [get-define cross]c++ [get-define cross]g++ false]
}

# CXXFLAGS default to CFLAGS if not specified
define CXXFLAGS [get-env CXXFLAGS [get-define CFLAGS]]

cc-check-tools ld








define CCACHE [find-an-executable [get-env CCACHE ccache]]

# Initial cctest settings
cc-store-settings {-cflags {} -includes {} -declare {} -link 0 -lang c -libs {} -code {}}

msg-result "C compiler...[get-define CCACHE] [get-define CC] [get-define CFLAGS]"
if {[get-define CXX] ne "false"} {
	msg-result "C++ compiler...[get-define CCACHE] [get-define CXX] [get-define CXXFLAGS]"
}


if {![cc-check-includes stdlib.h]} {
	user-error "Compiler does not work. See config.log"
}







|







 







>
>
>
>
>
>
>










>




606
607
608
609
610
611
612
613
614
615
616
617
618
619
620
...
637
638
639
640
641
642
643
644
645
646
647
648
649
650
651
652
653
654
655
656
657
658
659
660
661
662
663
664
665
			}
		}
	}
	return ""
}

# Initialise some values from the environment or commandline or default settings
foreach i {LDFLAGS LIBS CPPFLAGS LINKFLAGS {CFLAGS "-g -O2"}} {
	lassign $i var default
	define $var [get-env $var $default]
}

if {[env-is-set CC]} {
	# Set by the user, so don't try anything else
	set try [list [get-env CC ""]]
................................................................................
	define CXX [find-an-executable [get-define cross]c++ [get-define cross]g++ false]
}

# CXXFLAGS default to CFLAGS if not specified
define CXXFLAGS [get-env CXXFLAGS [get-define CFLAGS]]

cc-check-tools ld

# May need a CC_FOR_BUILD, so look for one
define CC_FOR_BUILD [find-an-executable [get-env CC_FOR_BUILD ""] cc gcc false]

if {[get-define CC] eq ""} {
	user-error "Could not find a C compiler. Tried: [join $try ", "]"
}

define CCACHE [find-an-executable [get-env CCACHE ccache]]

# Initial cctest settings
cc-store-settings {-cflags {} -includes {} -declare {} -link 0 -lang c -libs {} -code {}}

msg-result "C compiler...[get-define CCACHE] [get-define CC] [get-define CFLAGS]"
if {[get-define CXX] ne "false"} {
	msg-result "C++ compiler...[get-define CCACHE] [get-define CXX] [get-define CXXFLAGS]"
}
msg-result "Build C compiler...[get-define CC_FOR_BUILD]"

if {![cc-check-includes stdlib.h]} {
	user-error "Compiler does not work. See config.log"
}

Changes to autosetup/find-tclsh.

1
2
3
4
5
6
7
8
9
10
11
12
13
14
#!/bin/sh
# Looks for a suitable tclsh or jimsh in the PATH
# If not found, builds a bootstrap jimsh from source
d=$(dirname "$0")
PATH="$PATH:$d"
for tclsh in jimsh tclsh tclsh8.6 tclsh8.5 jimsh0; do
	$tclsh "$d/test-tclsh" 2>/dev/null && exit 0
done
echo 1>&2 "No installed jimsh or tclsh, building local bootstrap jimsh0"
for cc in ${CC_FOR_BUILD:-cc} gcc; do
	$cc -o "$d/jimsh0" "$d/jimsh0.c" 2>/dev/null || continue
	"$d/jimsh0" "$d/test-tclsh" && exit 0
done
echo 1>&2 "No working C compiler found. Tried ${CC_FOR_BUILD:-cc} and gcc."



|

|
|



|



1
2
3
4
5
6
7
8
9
10
11
12
13
14
#!/bin/sh
# Looks for a suitable tclsh or jimsh in the PATH
# If not found, builds a bootstrap jimsh from source
d=`dirname "$0"`
PATH="$PATH:$d"
for tclsh in jimsh tclsh tclsh8.5 tclsh8.6 jimsh0; do
	{ $tclsh "$d/test-tclsh"; } 2>/dev/null && exit 0
done
echo 1>&2 "No installed jimsh or tclsh, building local bootstrap jimsh0"
for cc in ${CC_FOR_BUILD:-cc} gcc; do
	{ $cc -o "$d/jimsh0" "$d/jimsh0.c"; } 2>/dev/null || continue
	"$d/jimsh0" "$d/test-tclsh" && exit 0
done
echo 1>&2 "No working C compiler found. Tried ${CC_FOR_BUILD:-cc} and gcc."

Changes to autosetup/jimsh0.c.

17
18
19
20
21
22
23

24
25
26
27
28

29
30
31
32
33
34
35
...
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
...
597
598
599
600
601
602
603


604
605
606
607
608
609
610
...
615
616
617
618
619
620
621
622
623
624
625
626
627
628




629
630
631
632
633
634
635
....
1247
1248
1249
1250
1251
1252
1253



































1254
1255
1256
1257
1258
1259
1260
....
1494
1495
1496
1497
1498
1499
1500
1501
1502
1503
1504
1505
1506
1507
1508
1509
1510
1511
1512
....
4152
4153
4154
4155
4156
4157
4158




4159






4160
4161
4162
4163
4164
4165
4166
4167
4168
....
4169
4170
4171
4172
4173
4174
4175
4176
4177
4178
4179
4180
4181
4182
4183
....
6403
6404
6405
6406
6407
6408
6409



6410
6411
6412
6413
6414
6415
6416
6417
6418
6419
6420



6421
6422
6423
6424
6425
6426
6427
....
7837
7838
7839
7840
7841
7842
7843
7844







7845

7846


7847
7848

7849

7850
7851
7852
7853
7854
7855
7856
7857
7858
7859
7860
7861
7862
7863
7864
7865
7866
7867
7868
7869
7870
7871
7872
7873
7874
7875
7876
7877
7878
7879
7880
7881
7882
7883

7884

7885
7886
7887
7888
7889


7890
7891
7892
7893
7894
7895
7896
....
7909
7910
7911
7912
7913
7914
7915

7916



7917
7918
7919
7920
7921
7922
7923
7924
7925
7926
7927
7928
7929
7930
7931
7932
7933
7934
7935
7936
....
9845
9846
9847
9848
9849
9850
9851
9852
9853
9854
9855
9856
9857


9858







9859
9860
9861
9862
9863

9864


9865
9866
9867
9868
9869
9870
9871
9872
9873
9874
9875
9876
9877
9878
9879
9880
....
9925
9926
9927
9928
9929
9930
9931





















































9932
9933
9934
9935
9936
9937
9938
9939
9940
9941
9942
9943
9944
9945
9946
9947
9948
9949
....
9955
9956
9957
9958
9959
9960
9961
9962
9963
9964
9965
9966
9967
9968
9969
9970
9971
9972

9973

9974
9975
9976
9977
9978
9979
9980
.....
11249
11250
11251
11252
11253
11254
11255

11256
11257
11258
11259
11260
11261
11262
.....
11876
11877
11878
11879
11880
11881
11882
11883
11884
11885
11886
11887
11888
11889
11890
.....
11911
11912
11913
11914
11915
11916
11917
11918
11919
11920

11921
11922
11923
11924
11925
11926
11927
11928
11929
11930






11931
11932
11933
11934
11935
11936
11937
11938




11939
11940
11941
11942
11943
11944
11945
.....
12014
12015
12016
12017
12018
12019
12020
12021
12022
12023
12024
12025
12026
12027
12028
.....
14456
14457
14458
14459
14460
14461
14462

14463
14464
14465



14466
14467
14468
14469
14470
14471
14472

14473
14474
14475
14476
14477
14478
14479
.....
16431
16432
16433
16434
16435
16436
16437







































16438
16439
16440
16441
16442
16443
16444
16445
16446
16447
16448
16449
16450
16451
16452
16453
16454

16455
16456
16457
16458
16459
16460
16461
16462
16463
16464
16465
16466
16467
16468
16469
16470
16471
16472
16473
16474
16475
16476
16477
16478
16479
16480
16481
16482
16483
16484
16485
16486
16487
16488
16489
16490
16491
16492


16493
16494
16495
16496
16497
16498
16499
.....
16508
16509
16510
16511
16512
16513
16514
16515
16516
16517
16518

16519
16520

16521
16522
16523
16524
16525
16526

16527
16528
16529
16530
16531
16532
16533


16534
16535
16536
16537
16538


16539
16540
16541
16542
16543
16544
16545
16546
16547
16548
16549
16550
16551
16552
16553
16554
16555
16556
16557
16558
16559
16560

16561
16562
16563
16564
16565
16566
16567
16568
16569
16570
16571
16572
16573
16574
16575
16576
16577
16578
16579
16580
16581
16582
16583
16584
16585
16586
16587
16588
16589
16590
16591
16592
.....
16624
16625
16626
16627
16628
16629
16630
16631
16632
16633
16634
16635
16636
16637
16638
.....
18770
18771
18772
18773
18774
18775
18776
18777
18778
18779
18780
18781
18782
18783
18784
18785
18786
18787
18788
18789
18790
18791
18792
18793
18794
18795
18796
18797
18798
18799
18800
18801
18802
18803
18804
18805
18806
18807
18808
18809
18810
18811
18812
18813
18814
18815
18816
18817
18818
18819
18820
18821
18822
18823
18824
18825
18826
18827
18828
18829
18830
18831
18832
18833
18834
18835
18836
18837
18838
18839
18840
18841
18842
18843
18844
18845
18846
18847
18848
18849
18850
18851
18852
18853
18854
18855
18856
18857
18858
18859
18860
18861
18862
18863
18864
.....
21307
21308
21309
21310
21311
21312
21313
21314
21315
21316
21317
21318
21319
21320
21321
.....
23690
23691
23692
23693
23694
23695
23696
23697
23698
23699
23700
23701
23702
23703
23704
23705
23706
23707
23708
23709
23710
23711
23712
23713
23714
23715
23716
23717
23718
23719
23720
23721
23722
23723
23724
23725
23726
23727
23728
23729
23730
23731
.....
23757
23758
23759
23760
23761
23762
23763
23764
23765
23766
23767
23768
23769
23770
23771
#define jim_ext_clock
#define jim_ext_array
#define jim_ext_stdlib
#define jim_ext_tclcompat
#if defined(__MINGW32__)
#define TCL_PLATFORM_OS "mingw"
#define TCL_PLATFORM_PLATFORM "windows"

#define HAVE_MKDIR_ONE_ARG
#define HAVE_SYSTEM
#else
#define TCL_PLATFORM_OS "unknown"
#define TCL_PLATFORM_PLATFORM "unix"

#define HAVE_VFORK
#define HAVE_WAITPID
#endif
#ifndef UTF8_UTIL_H
#define UTF8_UTIL_H
/**
 * UTF-8 utility functions
................................................................................

#endif
/* Jim - A small embeddable Tcl interpreter
 *
 * Copyright 2005 Salvatore Sanfilippo <antirez@invece.org>
 * Copyright 2005 Clemens Hintze <c.hintze@gmx.net>
 * Copyright 2005 patthoyts - Pat Thoyts <patthoyts@users.sf.net> 
 * Copyright 2008 oharboe - Øyvind Harboe - oyvind.harboe@zylin.com
 * Copyright 2008 Andrew Lunn <andrew@lunn.ch>
 * Copyright 2008 Duane Ellis <openocd@duaneellis.com>
 * Copyright 2008 Uwe Klein <uklein@klein-messgeraete.de>
 * 
 * Redistribution and use in source and binary forms, with or without
 * modification, are permitted provided that the following conditions
 * are met:
................................................................................
    struct Jim_CallFrame *linkFramePtr;
} Jim_Var;

/* The cmd structure. */
typedef int (*Jim_CmdProc)(struct Jim_Interp *interp, int argc,
    Jim_Obj *const *argv);
typedef void (*Jim_DelCmdProc)(struct Jim_Interp *interp, void *privData);



/* A command is implemented in C if funcPtr is != NULL, otherwise
 * it's a Tcl procedure with the arglist and body represented by the
 * two objects referenced by arglistObjPtr and bodyoObjPtr. */
typedef struct Jim_Cmd {
    int inUse;           /* Reference count */
    int isproc;          /* Is this a procedure? */
................................................................................
            Jim_DelCmdProc delProc; /* Called when the command is deleted if != NULL */
            void *privData; /* command-private data available via Jim_CmdPrivData() */
        } native;
        struct {
            /* Tcl procedure */
            Jim_Obj *argListObjPtr;
            Jim_Obj *bodyObjPtr;
            Jim_HashTable *staticVars; /* Static vars hash table. NULL if no statics. */
            int leftArity;    /* Required args assigned from the left */
            int optionalArgs; /* Number of optional args (default values) */
            int rightArity;   /* Required args assigned from the right */
            int args;         /* True if 'args' specified */
            struct Jim_Cmd *prevCmd; /* Previous command defn if proc created 'local' */
            int upcall;       /* True if proc is currently in upcall */




        } proc;
    } u;
} Jim_Cmd;

/* Pseudo Random Number Generator State structure */
typedef struct Jim_PrngState {
    unsigned char sbox[256];
................................................................................
		return JIM_ERR;

	return Jim_Eval_Named(interp, 
"\n"
"\n"
"proc package {args} {}\n"
,"bootstrap.tcl", 1);



































}
int Jim_globInit(Jim_Interp *interp)
{
	if (Jim_PackageProvide(interp, "glob", "1.0", JIM_ERRMSG))
		return JIM_ERR;

	return Jim_Eval_Named(interp, 
................................................................................
"	string trim $result\n"
"}\n"
"\n"
"\n"
"\n"
"proc {info nameofexecutable} {} {\n"
"	if {[info exists ::jim_argv0]} {\n"
"		if {[string first \"/\" $::jim_argv0] >= 0} {\n"
"			return $::jim_argv0\n"
"		}\n"
"		foreach path [split [env PATH \"\"] :] {\n"
"			set exec [file join $path $::jim_argv0]\n"
"			if {[file executable $exec]} {\n"
"				return $exec\n"
"			}\n"
"		}\n"
"	}\n"
"	return \"\"\n"
"}\n"
................................................................................
        }
#if defined(__MINGW32__)
        else if (strchr(part, ':')) {
            /* Absolute compontent on mingw, so go back to the start */
            last = newname;
        }
#endif











        /* Add a slash if needed */
        if (last != newname) {
            *last++ = '/';
        }

        if (len) {
            if (last + len - newname >= MAXPATHLEN) {
                Jim_Free(newname);
                Jim_SetResultString(interp, "Path too long", -1);
................................................................................
                return JIM_ERR;
            }
            memcpy(last, part, len);
            last += len;
        }

        /* Remove a slash if needed */
        if (last != newname && last[-1] == '/') {
            *--last = 0;
        }
    }

    *last = 0;

    /* Probably need to handle some special cases ... */
................................................................................
#endif
#ifdef HAVE_CRT_EXTERNS_H
#include <crt_externs.h>
#endif

/* For INFINITY, even if math functions are not enabled */
#include <math.h>




/* For the no-autoconf case */
#ifndef TCL_LIBRARY
#define TCL_LIBRARY "."
#endif
#ifndef TCL_PLATFORM_OS
#define TCL_PLATFORM_OS "unknown"
#endif
#ifndef TCL_PLATFORM_PLATFORM
#define TCL_PLATFORM_PLATFORM "unknown"
#endif




/*#define DEBUG_SHOW_SCRIPT*/
/*#define DEBUG_SHOW_SCRIPT_TOKENS*/
/*#define DEBUG_SHOW_SUBST*/
/*#define DEBUG_SHOW_EXPR*/
/*#define DEBUG_SHOW_EXPR_TOKENS*/
/*#define JIM_DEBUG_GC*/
................................................................................
    pc->tline = pc->linenr;
    pc->tt = JimParseSubQuote(pc);
    return JIM_OK;
}

static int JimParseVar(struct JimParserCtx *pc)
{
    int brace = 0, stop = 0;







    int ttype = JIM_TT_VAR;




    pc->tstart = ++pc->p;
    pc->len--;                  /* skip the $ */

    pc->tline = pc->linenr;

    if (*pc->p == '{') {
        pc->tstart = ++pc->p;
        pc->len--;
        brace = 1;
    }
    if (brace) {
        while (!stop) {
            if (*pc->p == '}' || pc->len == 0) {
                pc->tend = pc->p - 1;
                stop = 1;
                if (pc->len == 0)
                    break;
            }
            else if (*pc->p == '\n')
                pc->linenr++;
            pc->p++;
            pc->len--;
        }
    }
    else {
        while (!stop) {
            /* Skip double colon, but not single colon! */
            if (pc->p[0] == ':' && pc->len > 1 && pc->p[1] == ':') {
                pc->p += 2;
                pc->len -= 2;
                continue;
            }
            if (!((*pc->p >= 'a' && *pc->p <= 'z') ||
                    (*pc->p >= 'A' && *pc->p <= 'Z') ||
                    (*pc->p >= '0' && *pc->p <= '9') || *pc->p == '_'))
                stop = 1;
            else {
                pc->p++;
                pc->len--;

            }

        }
        /* Parse [dict get] syntax sugar. */
        if (*pc->p == '(') {
            int count = 1;
            const char *paren = NULL;



            while (count && pc->len) {
                pc->p++;
                pc->len--;
                if (*pc->p == '\\' && pc->len >= 1) {
                    pc->p++;
                    pc->len--;
................................................................................
            }
            else if (paren) {
                /* Did not find a matching paren. Back up */
                paren++;
                pc->len += (pc->p - paren);
                pc->p = paren;
            }

            ttype = (*pc->tstart == '(') ? JIM_TT_EXPRSUGAR : JIM_TT_DICTSUGAR;



        }
        pc->tend = pc->p - 1;
    }
    /* Check if we parsed just the '$' character.
     * That's not a variable so an error is returned
     * to tell the state machine to consider this '$' just
     * a string. */
    if (pc->tstart == pc->p) {
        pc->p--;
        pc->len++;
        return JIM_ERR;
    }
    pc->tt = ttype;
    return JIM_OK;
}

static int JimParseStr(struct JimParserCtx *pc)
{
    int newword = (pc->tt == JIM_TT_SEP || pc->tt == JIM_TT_EOL ||
        pc->tt == JIM_TT_NONE || pc->tt == JIM_TT_STR);
................................................................................

    /* There is no need to increment the 'proc epoch' because
     * creation of a new procedure can never affect existing
     * cached commands. We don't do negative caching. */
    return JIM_OK;
}

static int JimCreateProcedure(Jim_Interp *interp, const char *cmdName,
    Jim_Obj *argListObjPtr, Jim_Obj *staticsListObjPtr, Jim_Obj *bodyObjPtr,
    int leftArity, int optionalArgs, int args, int rightArity)
{
    Jim_Cmd *cmdPtr;
    Jim_HashEntry *he;










    cmdPtr = Jim_Alloc(sizeof(*cmdPtr));
    memset(cmdPtr, 0, sizeof(*cmdPtr));
    cmdPtr->inUse = 1;
    cmdPtr->isproc = 1;
    cmdPtr->u.proc.argListObjPtr = argListObjPtr;

    cmdPtr->u.proc.bodyObjPtr = bodyObjPtr;


    Jim_IncrRefCount(argListObjPtr);
    Jim_IncrRefCount(bodyObjPtr);
    cmdPtr->u.proc.leftArity = leftArity;
    cmdPtr->u.proc.optionalArgs = optionalArgs;
    cmdPtr->u.proc.args = args;
    cmdPtr->u.proc.rightArity = rightArity;
    cmdPtr->u.proc.staticVars = NULL;
    cmdPtr->u.proc.prevCmd = NULL;
    cmdPtr->inUse = 1;

    /* Create the statics hash table. */
    if (staticsListObjPtr) {
        int len, i;

        len = Jim_ListLength(interp, staticsListObjPtr);
        if (len != 0) {
................................................................................
                    Jim_SetResultFormatted(interp, "too many fields in static specifier \"%#s\"",
                        objPtr);
                    goto err;
                }
            }
        }
    }






















































    /* Add the new command */

    /* It may already exist, so we try to delete the old one.
     * Note that reference count means that it won't be deleted yet if
     * it exists in the call stack.
     *
     * BUT, if 'local' is in force, instead of deleting the existing
     * proc, we stash a reference to the old proc here.
     */
    he = Jim_FindHashEntry(&interp->commands, cmdName);
    if (he) {
        /* There was an old procedure with the same name, this requires
         * a 'proc epoch' update. */

        /* If a procedure with the same name didn't existed there is no need
         * to increment the 'proc epoch' because creation of a new procedure
         * can never affect existing cached commands. We don't do
................................................................................
        /* Just push this proc over the top of the previous one */
        cmdPtr->u.proc.prevCmd = he->u.val;
        he->u.val = cmdPtr;
    }
    else {
        if (he) {
            /* Replace the existing proc */
            Jim_DeleteHashEntry(&interp->commands, cmdName);
        }

        Jim_AddHashEntry(&interp->commands, cmdName, cmdPtr);
    }

    /* Unlike Tcl, set the name of the proc as the result */
    Jim_SetResultString(interp, cmdName, -1);
    return JIM_OK;

  err:

    Jim_FreeHashTable(cmdPtr->u.proc.staticVars);

    Jim_Free(cmdPtr->u.proc.staticVars);
    Jim_DecrRefCount(interp, argListObjPtr);
    Jim_DecrRefCount(interp, bodyObjPtr);
    Jim_Free(cmdPtr);
    return JIM_ERR;
}

................................................................................

    /* Initialize key variables every interpreter should contain */
    Jim_SetVariableStrWithStr(i, JIM_LIBPATH, TCL_LIBRARY);
    Jim_SetVariableStrWithStr(i, JIM_INTERACTIVE, "0");

    Jim_SetVariableStrWithStr(i, "tcl_platform(os)", TCL_PLATFORM_OS);
    Jim_SetVariableStrWithStr(i, "tcl_platform(platform)", TCL_PLATFORM_PLATFORM);

    Jim_SetVariableStrWithStr(i, "tcl_platform(byteOrder)", JimIsBigEndian() ? "bigEndian" : "littleEndian");
    Jim_SetVariableStrWithStr(i, "tcl_platform(threaded)", "0");
    Jim_SetVariableStr(i, "tcl_platform(pointerSize)", Jim_NewIntObj(i, sizeof(void *)));
    Jim_SetVariableStr(i, "tcl_platform(wordSize)", Jim_NewIntObj(i, sizeof(jim_wide)));

    return i;
}
................................................................................
 * into a list element without any kind of quoting, surrounded by braces,
 * or using escapes to quote. */
#define JIM_ELESTR_SIMPLE 0
#define JIM_ELESTR_BRACE 1
#define JIM_ELESTR_QUOTE 2
static int ListElementQuotingType(const char *s, int len)
{
    int i, level, trySimple = 1;

    /* Try with the SIMPLE case */
    if (len == 0)
        return JIM_ELESTR_BRACE;
    if (s[0] == '#')
        return JIM_ELESTR_BRACE;
    if (s[0] == '"' || s[0] == '{') {
................................................................................
                goto testbrace;
        }
    }
    return JIM_ELESTR_SIMPLE;

  testbrace:
    /* Test if it's possible to do with braces */
    if (s[len - 1] == '\\' || s[len - 1] == ']')
        return JIM_ELESTR_QUOTE;
    level = 0;

    for (i = 0; i < len; i++) {
        switch (s[i]) {
            case '{':
                level++;
                break;
            case '}':
                level--;
                if (level < 0)
                    return JIM_ELESTR_QUOTE;
                break;






            case '\\':
                if (s[i + 1] == '\n')
                    return JIM_ELESTR_QUOTE;
                else if (s[i + 1] != '\0')
                    i++;
                break;
        }
    }




    if (level == 0) {
        if (!trySimple)
            return JIM_ELESTR_BRACE;
        for (i = 0; i < len; i++) {
            switch (s[i]) {
                case ' ':
                case '$':
................................................................................
        }
    }
    *p = '\0';
    *qlenPtr = p - q;
    return q;
}

void UpdateStringOfList(struct Jim_Obj *objPtr)
{
    int i, bufLen, realLength;
    const char *strRep;
    char *p;
    int *quotingType;
    Jim_Obj **ele = objPtr->internalRep.listValue.ele;

................................................................................
    }
    return JIM_OK;
}

static int ExprAddOperator(Jim_Interp *interp, ExprByteCode * expr, ParseToken *t)
{
    struct ScriptToken *token = &expr->token[expr->len];


    if (JimExprOperatorInfoByOpcode(t->type)->lazy == LAZY_OP) {
        return ExprAddLazyOperator(interp, expr, t);



    }
    else {
        token->objPtr = interp->emptyObj;
        token->type = t->type;
        expr->len++;
        return JIM_OK;
    }

}

/**
 * Returns the index of the COLON_LEFT to the left of 'right_index'
 * taking into account nesting.
 *
 * The expression *must* be well formed, thus a COLON_LEFT will always be found.
................................................................................
        Jim_DecrRefCount(interp, objPtr);
    }
    else {
        retcode = Jim_SetVariable(interp, argNameObj, argValObj);
    }
    return retcode;
}








































/* Call a procedure implemented in Tcl.
 * It's possible to speed-up a lot this function, currently
 * the callframes are not cached, but allocated and
 * destroied every time. What is expecially costly is
 * to create/destroy the local vars hash table every time.
 *
 * This can be fixed just implementing callframes caching
 * in JimCreateCallFrame() and JimFreeCallFrame(). */
int JimCallProcedure(Jim_Interp *interp, Jim_Cmd *cmd, const char *filename, int linenr, int argc,
    Jim_Obj *const *argv)
{
    int i, d, retcode;
    Jim_CallFrame *callFramePtr;
    Jim_Obj *argObjPtr;
    Jim_Obj *procname = argv[0];
    Jim_Stack *prevLocalProcs;


    /* Check arity */
    if (argc - 1 < cmd->u.proc.leftArity + cmd->u.proc.rightArity ||
        (!cmd->u.proc.args && argc - 1 > cmd->u.proc.leftArity + cmd->u.proc.rightArity + cmd->u.proc.optionalArgs)) {
        /* Create a nice error message, consistent with Tcl 8.5 */
        Jim_Obj *argmsg = Jim_NewStringObj(interp, "", 0);
        int arglen = Jim_ListLength(interp, cmd->u.proc.argListObjPtr);

        for (i = 0; i < arglen; i++) {
            Jim_Obj *objPtr;
            Jim_ListIndex(interp, cmd->u.proc.argListObjPtr, i, &argObjPtr, JIM_NONE);

            Jim_AppendString(interp, argmsg, " ", 1);

            if (i < cmd->u.proc.leftArity || i >= arglen - cmd->u.proc.rightArity) {
                Jim_AppendObj(interp, argmsg, argObjPtr);
            }
            else if (i == arglen - cmd->u.proc.rightArity - cmd->u.proc.args) {
                if (Jim_ListLength(interp, argObjPtr) == 1) {
                    /* We have plain args */
                    Jim_AppendString(interp, argmsg, "?argument ...?", -1);
                }
                else {
                    Jim_AppendString(interp, argmsg, "?", 1);
                    Jim_ListIndex(interp, argObjPtr, 1, &objPtr, JIM_NONE);
                    Jim_AppendObj(interp, argmsg, objPtr);
                    Jim_AppendString(interp, argmsg, " ...?", -1);
                }
            }
            else {
                Jim_AppendString(interp, argmsg, "?", 1);
                Jim_ListIndex(interp, argObjPtr, 0, &objPtr, JIM_NONE);
                Jim_AppendObj(interp, argmsg, objPtr);
                Jim_AppendString(interp, argmsg, "?", 1);
            }
        }
        Jim_SetResultFormatted(interp, "wrong # args: should be \"%#s%#s\"", procname, argmsg);
        Jim_FreeNewObj(interp, argmsg);


        return JIM_ERR;
    }

    /* Check if there are too nested calls */
    if (interp->framePtr->level == interp->maxNestingDepth) {
        Jim_SetResultString(interp, "Too many nested calls. Infinite recursion?", -1);
        return JIM_ERR;
................................................................................
    callFramePtr->staticVars = cmd->u.proc.staticVars;
    callFramePtr->filename = filename;
    callFramePtr->line = linenr;
    Jim_IncrRefCount(cmd->u.proc.argListObjPtr);
    Jim_IncrRefCount(cmd->u.proc.bodyObjPtr);
    interp->framePtr = callFramePtr;

    /* Simplify arg counting */
    argv++;
    argc--;


    /* Set arguments */


    /* Assign in this order:
     * leftArity required args.
     * rightArity required args (but actually do it last for simplicity)
     * optionalArgs optional args
     * remaining args into 'args' if 'args'
     */


    /* Note that 'd' steps along the arg list, whilst argc/argv follow the supplied args */

    /* leftArity required args */
    for (d = 0; d < cmd->u.proc.leftArity; d++) {
        Jim_ListIndex(interp, cmd->u.proc.argListObjPtr, d, &argObjPtr, JIM_NONE);
        retcode = JimSetProcArg(interp, argObjPtr, *argv++);


        if (retcode != JIM_OK) {
            goto badargset;
        }
        argc--;
    }



    /* Shorten our idea of the number of supplied args */
    argc -= cmd->u.proc.rightArity;

    /* optionalArgs optional args */
    for (i = 0; i < cmd->u.proc.optionalArgs; i++) {
        Jim_Obj *nameObjPtr;
        Jim_Obj *valueObjPtr;

        Jim_ListIndex(interp, cmd->u.proc.argListObjPtr, d++, &argObjPtr, JIM_NONE);

        /* The name is the first element of the list */
        Jim_ListIndex(interp, argObjPtr, 0, &nameObjPtr, JIM_NONE);
        if (argc) {
            valueObjPtr = *argv++;
            argc--;
        }
        else {
            /* No more values, so use default */
            /* The value is the second element of the list */
            Jim_ListIndex(interp, argObjPtr, 1, &valueObjPtr, JIM_NONE);
        }

        Jim_SetVariable(interp, nameObjPtr, valueObjPtr);
    }

    /* Any remaining args go to 'args' */
    if (cmd->u.proc.args) {
        Jim_Obj *listObjPtr = Jim_NewListObj(interp, argv, argc);

        /* Get the 'args' name from the procedure args */
        Jim_ListIndex(interp, cmd->u.proc.argListObjPtr, d, &argObjPtr, JIM_NONE);

        /* It is possible to rename args. */
        i = Jim_ListLength(interp, argObjPtr);
        if (i == 2) {
            Jim_ListIndex(interp, argObjPtr, 1, &argObjPtr, JIM_NONE);
        }

        Jim_SetVariable(interp, argObjPtr, listObjPtr);
        argv += argc;
        d++;
    }

    /* rightArity required args */
    for (i = 0; i < cmd->u.proc.rightArity; i++) {
        Jim_ListIndex(interp, cmd->u.proc.argListObjPtr, d++, &argObjPtr, JIM_NONE);
        retcode = JimSetProcArg(interp, argObjPtr, *argv++);
        if (retcode != JIM_OK) {
            goto badargset;
        }
    }

    /* Install a new stack for local procs */
    prevLocalProcs = interp->localProcs;
................................................................................
            interp->returnCode = JIM_OK;
            interp->returnLevel = 0;
        }
    }
    else if (retcode == JIM_ERR) {
        interp->addStackTrace++;
        Jim_DecrRefCount(interp, interp->errorProc);
        interp->errorProc = procname;
        Jim_IncrRefCount(interp->errorProc);
    }
    return retcode;
}

int Jim_Eval_Named(Jim_Interp *interp, const char *script, const char *filename, int lineno)
{
................................................................................
    Jim_SetResult(interp, objPtr);
    return JIM_EVAL;
}

/* [proc] */
static int Jim_ProcCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
{
    int argListLen;
    int leftArity, rightArity;
    int i;
    int optionalArgs = 0;
    int args = 0;

    if (argc != 4 && argc != 5) {
        Jim_WrongNumArgs(interp, 1, argv, "name arglist ?statics? body");
        return JIM_ERR;
    }

    if (JimValidName(interp, "procedure", argv[1]) != JIM_OK) {
        return JIM_ERR;
    }

    argListLen = Jim_ListLength(interp, argv[2]);
    leftArity = 0;
    rightArity = 0;

    /* Examine the argument list for default parameters and 'args' */
    for (i = 0; i < argListLen; i++) {
        Jim_Obj *argPtr;
        int len;

        /* Examine a parameter */
        Jim_ListIndex(interp, argv[2], i, &argPtr, JIM_NONE);
        len = Jim_ListLength(interp, argPtr);
        if (len == 0) {
            Jim_SetResultString(interp, "procedure has argument with no name", -1);
            return JIM_ERR;
        }
        if (len > 2) {
            Jim_SetResultString(interp, "procedure has argument with too many fields", -1);
            return JIM_ERR;
        }

        if (len == 2) {
            /* May be {args newname} */
            Jim_ListIndex(interp, argPtr, 0, &argPtr, JIM_NONE);
        }

        if (Jim_CompareStringImmediate(interp, argPtr, "args")) {
            if (args) {
                Jim_SetResultString(interp, "procedure has 'args' specified more than once", -1);
                return JIM_ERR;
            }
            if (rightArity) {
                Jim_SetResultString(interp, "procedure has 'args' in invalid position", -1);
                return JIM_ERR;
            }
            args = 1;
            continue;
        }

        /* Does this parameter have a default? */
        if (len == 1) {
            /* A required arg. Is it part of leftArity or rightArity? */
            if (optionalArgs || args) {
                rightArity++;
            }
            else {
                leftArity++;
            }
        }
        else {
            /* Optional arg. Can't be after rightArity */
            if (rightArity || args) {
                Jim_SetResultString(interp, "procedure has optional arg in invalid position", -1);
                return JIM_ERR;
            }
            optionalArgs++;
        }
    }

    if (argc == 4) {
        return JimCreateProcedure(interp, Jim_String(argv[1]),
            argv[2], NULL, argv[3], leftArity, optionalArgs, args, rightArity);
    }
    else {
        return JimCreateProcedure(interp, Jim_String(argv[1]),
            argv[2], argv[3], argv[4], leftArity, optionalArgs, args, rightArity);
    }
}

/* [local] */
static int Jim_LocalCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
{
    int retcode;
................................................................................
/* Extended table for codepoints where |delta| > 127 */
struct caseextmap {
    unsigned short lower;
    unsigned short upper;
};

/* Generated mapping tables */
#include "unicode_mapping.c"

#define NUMCASEMAP sizeof(unicode_case_mapping) / sizeof(*unicode_case_mapping)

static int cmp_casemap(const void *key, const void *cm)
{
    return *(int *)key - (int)((const struct casemap *)cm)->code;
}
................................................................................
 */

#include <stdio.h>
#include <stdlib.h>
#include <string.h>


/* Script to help initialise jimsh */
static const char jimsh_init[] = \
"proc _init {} {\n"
"\trename _init {}\n"
/* XXX This is a big ugly */
#if defined(__MINGW32__)
"\tlappend p {*}[split [env JIMLIB {}] {;}]\n"
#else
"\tlappend p {*}[split [env JIMLIB {}] :]\n"
#endif
"\tlappend p {*}$::auto_path\n"
"\tlappend p [file dirname [info nameofexecutable]]\n"
"\tset ::auto_path $p\n"
"\n"
"\tif {$::tcl_interactive && [env HOME {}] ne \"\"} {\n"
"\t\tforeach src {.jimrc jimrc.tcl} {\n"
"\t\t\tif {[file exists [env HOME]/$src]} {\n"
"\t\t\t\tuplevel #0 source [env HOME]/$src\n"
"\t\t\t\tbreak\n"
"\t\t\t}\n"
"\t\t}\n"
"\t}\n"
"}\n"
/* XXX This is a big ugly */
#if defined(__MINGW32__)
"set jim_argv0 [string map {\\\\ /} $jim_argv0]\n"
#endif
"_init\n";

static void JimSetArgv(Jim_Interp *interp, int argc, char *const argv[])
{
    int n;
    Jim_Obj *listObj = Jim_NewListObj(interp, NULL, 0);

    /* Populate argv global var */
................................................................................
    if (Jim_InitStaticExtensions(interp) != JIM_OK) {
        Jim_MakeErrorMessage(interp);
        fprintf(stderr, "%s\n", Jim_String(Jim_GetResult(interp)));
    }

    Jim_SetVariableStrWithStr(interp, "jim_argv0", argv[0]);
    Jim_SetVariableStrWithStr(interp, JIM_INTERACTIVE, argc == 1 ? "1" : "0");
    retcode = Jim_Eval(interp, jimsh_init);

    if (argc == 1) {
        if (retcode == JIM_ERR) {
            Jim_MakeErrorMessage(interp);
            fprintf(stderr, "%s\n", Jim_String(Jim_GetResult(interp)));
        }
        if (retcode != JIM_EXIT) {







>





>







 







|







 







>
>







 







|
|
|
|
|
|
|
>
>
>
>







 







>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>







 







|
|

|
|







 







>
>
>
>
|
>
>
>
>
>
>

|







 







|







 







>
>
>











>
>
>







 







|
>
>
>
>
>
>
>
|
>
|
>
>
|
<
>

>



|
|
|
|
|
|
|
|
|
|
<
<





|

|




|
<
<
<
<


>

>





>
>







 







>
|
>
>
>












<







 







|
|
<



>
>

>
>
>
>
>
>
>
|




>

>
>


<
<
<
<
<
<
<







 







>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>










|







 







|


|



|



>
|
>







 







>







 







|







 







|


>










>
>
>
>
>
>








>
>
>
>







 







|







 







>

|
|
>
>
>





<

>







 







>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>









|


<

<
<

>


|
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
>
>







 







|
|
<

>
|
<
>
|
|
|
|
|
<
>
|
|

|
|
|
<
>
>
|
|
|
<
|
>
>
|
<
<

|
|
|
<
|
<
<
<
<
<
<
<
<

<
<
<
<
>
|
|
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<







 







|







 







<
<
<
<
<
<





<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<

|
<


|
<







 







|







 







|
|
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<







 







|







17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
...
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
...
599
600
601
602
603
604
605
606
607
608
609
610
611
612
613
614
...
619
620
621
622
623
624
625
626
627
628
629
630
631
632
633
634
635
636
637
638
639
640
641
642
643
....
1255
1256
1257
1258
1259
1260
1261
1262
1263
1264
1265
1266
1267
1268
1269
1270
1271
1272
1273
1274
1275
1276
1277
1278
1279
1280
1281
1282
1283
1284
1285
1286
1287
1288
1289
1290
1291
1292
1293
1294
1295
1296
1297
1298
1299
1300
1301
1302
1303
....
1537
1538
1539
1540
1541
1542
1543
1544
1545
1546
1547
1548
1549
1550
1551
1552
1553
1554
1555
....
4195
4196
4197
4198
4199
4200
4201
4202
4203
4204
4205
4206
4207
4208
4209
4210
4211
4212
4213
4214
4215
4216
4217
4218
4219
4220
4221
....
4222
4223
4224
4225
4226
4227
4228
4229
4230
4231
4232
4233
4234
4235
4236
....
6456
6457
6458
6459
6460
6461
6462
6463
6464
6465
6466
6467
6468
6469
6470
6471
6472
6473
6474
6475
6476
6477
6478
6479
6480
6481
6482
6483
6484
6485
6486
....
7896
7897
7898
7899
7900
7901
7902
7903
7904
7905
7906
7907
7908
7909
7910
7911
7912
7913
7914
7915
7916

7917
7918
7919
7920
7921
7922
7923
7924
7925
7926
7927
7928
7929
7930
7931
7932


7933
7934
7935
7936
7937
7938
7939
7940
7941
7942
7943
7944
7945




7946
7947
7948
7949
7950
7951
7952
7953
7954
7955
7956
7957
7958
7959
7960
7961
7962
7963
7964
....
7977
7978
7979
7980
7981
7982
7983
7984
7985
7986
7987
7988
7989
7990
7991
7992
7993
7994
7995
7996
7997
7998
7999
8000

8001
8002
8003
8004
8005
8006
8007
....
9916
9917
9918
9919
9920
9921
9922
9923
9924

9925
9926
9927
9928
9929
9930
9931
9932
9933
9934
9935
9936
9937
9938
9939
9940
9941
9942
9943
9944
9945
9946
9947
9948







9949
9950
9951
9952
9953
9954
9955
.....
10000
10001
10002
10003
10004
10005
10006
10007
10008
10009
10010
10011
10012
10013
10014
10015
10016
10017
10018
10019
10020
10021
10022
10023
10024
10025
10026
10027
10028
10029
10030
10031
10032
10033
10034
10035
10036
10037
10038
10039
10040
10041
10042
10043
10044
10045
10046
10047
10048
10049
10050
10051
10052
10053
10054
10055
10056
10057
10058
10059
10060
10061
10062
10063
10064
10065
10066
10067
10068
10069
10070
10071
10072
10073
10074
10075
10076
10077
.....
10083
10084
10085
10086
10087
10088
10089
10090
10091
10092
10093
10094
10095
10096
10097
10098
10099
10100
10101
10102
10103
10104
10105
10106
10107
10108
10109
10110
.....
11379
11380
11381
11382
11383
11384
11385
11386
11387
11388
11389
11390
11391
11392
11393
.....
12007
12008
12009
12010
12011
12012
12013
12014
12015
12016
12017
12018
12019
12020
12021
.....
12042
12043
12044
12045
12046
12047
12048
12049
12050
12051
12052
12053
12054
12055
12056
12057
12058
12059
12060
12061
12062
12063
12064
12065
12066
12067
12068
12069
12070
12071
12072
12073
12074
12075
12076
12077
12078
12079
12080
12081
12082
12083
12084
12085
12086
12087
.....
12156
12157
12158
12159
12160
12161
12162
12163
12164
12165
12166
12167
12168
12169
12170
.....
14598
14599
14600
14601
14602
14603
14604
14605
14606
14607
14608
14609
14610
14611
14612
14613
14614
14615
14616

14617
14618
14619
14620
14621
14622
14623
14624
14625
.....
16577
16578
16579
16580
16581
16582
16583
16584
16585
16586
16587
16588
16589
16590
16591
16592
16593
16594
16595
16596
16597
16598
16599
16600
16601
16602
16603
16604
16605
16606
16607
16608
16609
16610
16611
16612
16613
16614
16615
16616
16617
16618
16619
16620
16621
16622
16623
16624
16625
16626
16627
16628
16629
16630
16631
16632
16633
16634

16635


16636
16637
16638
16639
16640



































16641
16642
16643
16644
16645
16646
16647
16648
16649
.....
16658
16659
16660
16661
16662
16663
16664
16665
16666

16667
16668
16669

16670
16671
16672
16673
16674
16675

16676
16677
16678
16679
16680
16681
16682

16683
16684
16685
16686
16687

16688
16689
16690
16691


16692
16693
16694
16695

16696








16697




16698
16699
16700























16701
16702
16703
16704
16705
16706
16707
.....
16739
16740
16741
16742
16743
16744
16745
16746
16747
16748
16749
16750
16751
16752
16753
.....
18885
18886
18887
18888
18889
18890
18891






18892
18893
18894
18895
18896































































18897
18898

18899
18900
18901

18902
18903
18904
18905
18906
18907
18908
.....
21351
21352
21353
21354
21355
21356
21357
21358
21359
21360
21361
21362
21363
21364
21365
.....
23734
23735
23736
23737
23738
23739
23740
23741
23742


























23743
23744
23745
23746
23747
23748
23749
.....
23775
23776
23777
23778
23779
23780
23781
23782
23783
23784
23785
23786
23787
23788
23789
#define jim_ext_clock
#define jim_ext_array
#define jim_ext_stdlib
#define jim_ext_tclcompat
#if defined(__MINGW32__)
#define TCL_PLATFORM_OS "mingw"
#define TCL_PLATFORM_PLATFORM "windows"
#define TCL_PLATFORM_PATH_SEPARATOR ";"
#define HAVE_MKDIR_ONE_ARG
#define HAVE_SYSTEM
#else
#define TCL_PLATFORM_OS "unknown"
#define TCL_PLATFORM_PLATFORM "unix"
#define TCL_PLATFORM_PATH_SEPARATOR ":"
#define HAVE_VFORK
#define HAVE_WAITPID
#endif
#ifndef UTF8_UTIL_H
#define UTF8_UTIL_H
/**
 * UTF-8 utility functions
................................................................................

#endif
/* Jim - A small embeddable Tcl interpreter
 *
 * Copyright 2005 Salvatore Sanfilippo <antirez@invece.org>
 * Copyright 2005 Clemens Hintze <c.hintze@gmx.net>
 * Copyright 2005 patthoyts - Pat Thoyts <patthoyts@users.sf.net> 
 * Copyright 2008 oharboe - yvind Harboe - oyvind.harboe@zylin.com
 * Copyright 2008 Andrew Lunn <andrew@lunn.ch>
 * Copyright 2008 Duane Ellis <openocd@duaneellis.com>
 * Copyright 2008 Uwe Klein <uklein@klein-messgeraete.de>
 * 
 * Redistribution and use in source and binary forms, with or without
 * modification, are permitted provided that the following conditions
 * are met:
................................................................................
    struct Jim_CallFrame *linkFramePtr;
} Jim_Var;

/* The cmd structure. */
typedef int (*Jim_CmdProc)(struct Jim_Interp *interp, int argc,
    Jim_Obj *const *argv);
typedef void (*Jim_DelCmdProc)(struct Jim_Interp *interp, void *privData);



/* A command is implemented in C if funcPtr is != NULL, otherwise
 * it's a Tcl procedure with the arglist and body represented by the
 * two objects referenced by arglistObjPtr and bodyoObjPtr. */
typedef struct Jim_Cmd {
    int inUse;           /* Reference count */
    int isproc;          /* Is this a procedure? */
................................................................................
            Jim_DelCmdProc delProc; /* Called when the command is deleted if != NULL */
            void *privData; /* command-private data available via Jim_CmdPrivData() */
        } native;
        struct {
            /* Tcl procedure */
            Jim_Obj *argListObjPtr;
            Jim_Obj *bodyObjPtr;
            Jim_HashTable *staticVars;  /* Static vars hash table. NULL if no statics. */
            struct Jim_Cmd *prevCmd;    /* Previous command defn if proc created 'local' */
            int argListLen;             /* Length of argListObjPtr */
            int reqArity;               /* Number of required parameters */
            int optArity;               /* Number of optional parameters */
            int argsPos;                /* Position of 'args', if specified, or -1 */
            int upcall;                 /* True if proc is currently in upcall */
            struct Jim_ProcArg {
                Jim_Obj *nameObjPtr;    /* Name of this arg */
                Jim_Obj *defaultObjPtr; /* Default value, (or rename for $args) */
            } *arglist;
        } proc;
    } u;
} Jim_Cmd;

/* Pseudo Random Number Generator State structure */
typedef struct Jim_PrngState {
    unsigned char sbox[256];
................................................................................
		return JIM_ERR;

	return Jim_Eval_Named(interp, 
"\n"
"\n"
"proc package {args} {}\n"
,"bootstrap.tcl", 1);
}
int Jim_initjimshInit(Jim_Interp *interp)
{
	if (Jim_PackageProvide(interp, "initjimsh", "1.0", JIM_ERRMSG))
		return JIM_ERR;

	return Jim_Eval_Named(interp, 
"\n"
"\n"
"\n"
"proc _jimsh_init {} {\n"
"	rename _jimsh_init {}\n"
"\n"
"\n"
"	lappend p {*}[split [env JIMLIB {}] $::tcl_platform(pathSeparator)]\n"
"	lappend p {*}$::auto_path\n"
"	lappend p [file dirname [info nameofexecutable]]\n"
"	set ::auto_path $p\n"
"\n"
"	if {$::tcl_interactive && [env HOME {}] ne \"\"} {\n"
"		foreach src {.jimrc jimrc.tcl} {\n"
"			if {[file exists [env HOME]/$src]} {\n"
"				uplevel #0 source [env HOME]/$src\n"
"				break\n"
"			}\n"
"		}\n"
"	}\n"
"}\n"
"\n"
"if {$tcl_platform(platform) eq \"windows\"} {\n"
"	set jim_argv0 [string map {\\\\ /} $jim_argv0]\n"
"}\n"
"\n"
"_jimsh_init\n"
,"initjimsh.tcl", 1);
}
int Jim_globInit(Jim_Interp *interp)
{
	if (Jim_PackageProvide(interp, "glob", "1.0", JIM_ERRMSG))
		return JIM_ERR;

	return Jim_Eval_Named(interp, 
................................................................................
"	string trim $result\n"
"}\n"
"\n"
"\n"
"\n"
"proc {info nameofexecutable} {} {\n"
"	if {[info exists ::jim_argv0]} {\n"
"		if {[string match \"*/*\" $::jim_argv0]} {\n"
"			return [file join [pwd] $::jim_argv0]\n"
"		}\n"
"		foreach path [split [env PATH \"\"] $::tcl_platform(pathSeparator)] {\n"
"			set exec [file join [pwd] $path $::jim_argv0]\n"
"			if {[file executable $exec]} {\n"
"				return $exec\n"
"			}\n"
"		}\n"
"	}\n"
"	return \"\"\n"
"}\n"
................................................................................
        }
#if defined(__MINGW32__)
        else if (strchr(part, ':')) {
            /* Absolute compontent on mingw, so go back to the start */
            last = newname;
        }
#endif
        else if (part[0] == '.') {
            if (part[1] == '/') {
                part += 2;
                len -= 2;
            }
            else if (part[1] == 0 && last != newname) {
                /* Adding '.' to an existing path does nothing */
                continue;
            }
        }

        /* Add a slash if needed */
        if (last != newname && last[-1] != '/') {
            *last++ = '/';
        }

        if (len) {
            if (last + len - newname >= MAXPATHLEN) {
                Jim_Free(newname);
                Jim_SetResultString(interp, "Path too long", -1);
................................................................................
                return JIM_ERR;
            }
            memcpy(last, part, len);
            last += len;
        }

        /* Remove a slash if needed */
        if (last > newname + 1 && last[-1] == '/') {
            *--last = 0;
        }
    }

    *last = 0;

    /* Probably need to handle some special cases ... */
................................................................................
#endif
#ifdef HAVE_CRT_EXTERNS_H
#include <crt_externs.h>
#endif

/* For INFINITY, even if math functions are not enabled */
#include <math.h>

/* We may decide to switch to using $[...] after all, so leave it as an option */
/*#define EXPRSUGAR_BRACKET*/

/* For the no-autoconf case */
#ifndef TCL_LIBRARY
#define TCL_LIBRARY "."
#endif
#ifndef TCL_PLATFORM_OS
#define TCL_PLATFORM_OS "unknown"
#endif
#ifndef TCL_PLATFORM_PLATFORM
#define TCL_PLATFORM_PLATFORM "unknown"
#endif
#ifndef TCL_PLATFORM_PATH_SEPARATOR
#define TCL_PLATFORM_PATH_SEPARATOR ":"
#endif

/*#define DEBUG_SHOW_SCRIPT*/
/*#define DEBUG_SHOW_SCRIPT_TOKENS*/
/*#define DEBUG_SHOW_SUBST*/
/*#define DEBUG_SHOW_EXPR*/
/*#define DEBUG_SHOW_EXPR_TOKENS*/
/*#define JIM_DEBUG_GC*/
................................................................................
    pc->tline = pc->linenr;
    pc->tt = JimParseSubQuote(pc);
    return JIM_OK;
}

static int JimParseVar(struct JimParserCtx *pc)
{
    /* skip the $ */
    pc->p++;
    pc->len--;

#ifdef EXPRSUGAR_BRACKET
    if (*pc->p == '[') {
        /* Parse $[...] expr shorthand syntax */
        JimParseCmd(pc);
        pc->tt = JIM_TT_EXPRSUGAR;
        return JIM_OK;
    }
#endif

    pc->tstart = pc->p;

    pc->tt = JIM_TT_VAR;
    pc->tline = pc->linenr;

    if (*pc->p == '{') {
        pc->tstart = ++pc->p;
        pc->len--;

        while (pc->len && *pc->p != '}') {
            if (*pc->p == '\n') {
                pc->linenr++;
            }
            pc->p++;
            pc->len--;
        }
        pc->tend = pc->p - 1;
        if (pc->len) {


            pc->p++;
            pc->len--;
        }
    }
    else {
        while (1) {
            /* Skip double colon, but not single colon! */
            if (pc->p[0] == ':' && pc->p[1] == ':') {
                pc->p += 2;
                pc->len -= 2;
                continue;
            }
            if (isalnum(UCHAR(*pc->p)) || *pc->p == '_') {




                pc->p++;
                pc->len--;
                continue;
            }
            break;
        }
        /* Parse [dict get] syntax sugar. */
        if (*pc->p == '(') {
            int count = 1;
            const char *paren = NULL;

            pc->tt = JIM_TT_DICTSUGAR;

            while (count && pc->len) {
                pc->p++;
                pc->len--;
                if (*pc->p == '\\' && pc->len >= 1) {
                    pc->p++;
                    pc->len--;
................................................................................
            }
            else if (paren) {
                /* Did not find a matching paren. Back up */
                paren++;
                pc->len += (pc->p - paren);
                pc->p = paren;
            }
#ifndef EXPRSUGAR_BRACKET
            if (*pc->tstart == '(') {
                pc->tt = JIM_TT_EXPRSUGAR;
            }
#endif
        }
        pc->tend = pc->p - 1;
    }
    /* Check if we parsed just the '$' character.
     * That's not a variable so an error is returned
     * to tell the state machine to consider this '$' just
     * a string. */
    if (pc->tstart == pc->p) {
        pc->p--;
        pc->len++;
        return JIM_ERR;
    }

    return JIM_OK;
}

static int JimParseStr(struct JimParserCtx *pc)
{
    int newword = (pc->tt == JIM_TT_SEP || pc->tt == JIM_TT_EOL ||
        pc->tt == JIM_TT_NONE || pc->tt == JIM_TT_STR);
................................................................................

    /* There is no need to increment the 'proc epoch' because
     * creation of a new procedure can never affect existing
     * cached commands. We don't do negative caching. */
    return JIM_OK;
}

static int JimCreateProcedure(Jim_Interp *interp, Jim_Obj *cmdName,
    Jim_Obj *argListObjPtr, Jim_Obj *staticsListObjPtr, Jim_Obj *bodyObjPtr)

{
    Jim_Cmd *cmdPtr;
    Jim_HashEntry *he;
    int argListLen;
    int i;

    if (JimValidName(interp, "procedure", cmdName) != JIM_OK) {
        return JIM_ERR;
    }

    argListLen = Jim_ListLength(interp, argListObjPtr);

    /* Allocate space for both the command pointer and the arg list */
    cmdPtr = Jim_Alloc(sizeof(*cmdPtr) + sizeof(struct Jim_ProcArg) * argListLen);
    memset(cmdPtr, 0, sizeof(*cmdPtr));
    cmdPtr->inUse = 1;
    cmdPtr->isproc = 1;
    cmdPtr->u.proc.argListObjPtr = argListObjPtr;
    cmdPtr->u.proc.argListLen = argListLen;
    cmdPtr->u.proc.bodyObjPtr = bodyObjPtr;
    cmdPtr->u.proc.argsPos = -1;
    cmdPtr->u.proc.arglist = (struct Jim_ProcArg *)(cmdPtr + 1);
    Jim_IncrRefCount(argListObjPtr);
    Jim_IncrRefCount(bodyObjPtr);








    /* Create the statics hash table. */
    if (staticsListObjPtr) {
        int len, i;

        len = Jim_ListLength(interp, staticsListObjPtr);
        if (len != 0) {
................................................................................
                    Jim_SetResultFormatted(interp, "too many fields in static specifier \"%#s\"",
                        objPtr);
                    goto err;
                }
            }
        }
    }

    /* Parse the args out into arglist, validating as we go */
    /* Examine the argument list for default parameters and 'args' */
    for (i = 0; i < argListLen; i++) {
        Jim_Obj *argPtr;
        Jim_Obj *nameObjPtr;
        Jim_Obj *defaultObjPtr;
        int len;
        int n = 1;

        /* Examine a parameter */
        Jim_ListIndex(interp, argListObjPtr, i, &argPtr, JIM_NONE);
        len = Jim_ListLength(interp, argPtr);
        if (len == 0) {
            Jim_SetResultString(interp, "procedure has argument with no name", -1);
            goto err;
        }
        if (len > 2) {
            Jim_SetResultString(interp, "procedure has argument with too many fields", -1);
            goto err;
        }

        if (len == 2) {
            /* Optional parameter */
            Jim_ListIndex(interp, argPtr, 0, &nameObjPtr, JIM_NONE);
            Jim_ListIndex(interp, argPtr, 1, &defaultObjPtr, JIM_NONE);
        }
        else {
            /* Required parameter */
            nameObjPtr = argPtr;
            defaultObjPtr = NULL;
        }


        if (Jim_CompareStringImmediate(interp, nameObjPtr, "args")) {
            if (cmdPtr->u.proc.argsPos >= 0) {
                Jim_SetResultString(interp, "procedure has 'args' specified more than once", -1);
                goto err;
            }
            cmdPtr->u.proc.argsPos = i;
        }
        else {
            if (len == 2) {
                cmdPtr->u.proc.optArity += n;
            }
            else {
                cmdPtr->u.proc.reqArity += n;
            }
        }

        cmdPtr->u.proc.arglist[i].nameObjPtr = nameObjPtr;
        cmdPtr->u.proc.arglist[i].defaultObjPtr = defaultObjPtr;
    }

    /* Add the new command */

    /* It may already exist, so we try to delete the old one.
     * Note that reference count means that it won't be deleted yet if
     * it exists in the call stack.
     *
     * BUT, if 'local' is in force, instead of deleting the existing
     * proc, we stash a reference to the old proc here.
     */
    he = Jim_FindHashEntry(&interp->commands, Jim_String(cmdName));
    if (he) {
        /* There was an old procedure with the same name, this requires
         * a 'proc epoch' update. */

        /* If a procedure with the same name didn't existed there is no need
         * to increment the 'proc epoch' because creation of a new procedure
         * can never affect existing cached commands. We don't do
................................................................................
        /* Just push this proc over the top of the previous one */
        cmdPtr->u.proc.prevCmd = he->u.val;
        he->u.val = cmdPtr;
    }
    else {
        if (he) {
            /* Replace the existing proc */
            Jim_DeleteHashEntry(&interp->commands, Jim_String(cmdName));
        }

        Jim_AddHashEntry(&interp->commands, Jim_String(cmdName), cmdPtr);
    }

    /* Unlike Tcl, set the name of the proc as the result */
    Jim_SetResult(interp, cmdName);
    return JIM_OK;

  err:
    if (cmdPtr->u.proc.staticVars) {
        Jim_FreeHashTable(cmdPtr->u.proc.staticVars);
    }
    Jim_Free(cmdPtr->u.proc.staticVars);
    Jim_DecrRefCount(interp, argListObjPtr);
    Jim_DecrRefCount(interp, bodyObjPtr);
    Jim_Free(cmdPtr);
    return JIM_ERR;
}

................................................................................

    /* Initialize key variables every interpreter should contain */
    Jim_SetVariableStrWithStr(i, JIM_LIBPATH, TCL_LIBRARY);
    Jim_SetVariableStrWithStr(i, JIM_INTERACTIVE, "0");

    Jim_SetVariableStrWithStr(i, "tcl_platform(os)", TCL_PLATFORM_OS);
    Jim_SetVariableStrWithStr(i, "tcl_platform(platform)", TCL_PLATFORM_PLATFORM);
    Jim_SetVariableStrWithStr(i, "tcl_platform(pathSeparator)", TCL_PLATFORM_PATH_SEPARATOR);
    Jim_SetVariableStrWithStr(i, "tcl_platform(byteOrder)", JimIsBigEndian() ? "bigEndian" : "littleEndian");
    Jim_SetVariableStrWithStr(i, "tcl_platform(threaded)", "0");
    Jim_SetVariableStr(i, "tcl_platform(pointerSize)", Jim_NewIntObj(i, sizeof(void *)));
    Jim_SetVariableStr(i, "tcl_platform(wordSize)", Jim_NewIntObj(i, sizeof(jim_wide)));

    return i;
}
................................................................................
 * into a list element without any kind of quoting, surrounded by braces,
 * or using escapes to quote. */
#define JIM_ELESTR_SIMPLE 0
#define JIM_ELESTR_BRACE 1
#define JIM_ELESTR_QUOTE 2
static int ListElementQuotingType(const char *s, int len)
{
    int i, level, blevel, trySimple = 1;

    /* Try with the SIMPLE case */
    if (len == 0)
        return JIM_ELESTR_BRACE;
    if (s[0] == '#')
        return JIM_ELESTR_BRACE;
    if (s[0] == '"' || s[0] == '{') {
................................................................................
                goto testbrace;
        }
    }
    return JIM_ELESTR_SIMPLE;

  testbrace:
    /* Test if it's possible to do with braces */
    if (s[len - 1] == '\\')
        return JIM_ELESTR_QUOTE;
    level = 0;
    blevel = 0;
    for (i = 0; i < len; i++) {
        switch (s[i]) {
            case '{':
                level++;
                break;
            case '}':
                level--;
                if (level < 0)
                    return JIM_ELESTR_QUOTE;
                break;
            case '[':
                blevel++;
                break;
            case ']':
                blevel--;
                break;
            case '\\':
                if (s[i + 1] == '\n')
                    return JIM_ELESTR_QUOTE;
                else if (s[i + 1] != '\0')
                    i++;
                break;
        }
    }
    if (blevel < 0) {
        return JIM_ELESTR_QUOTE;
    }

    if (level == 0) {
        if (!trySimple)
            return JIM_ELESTR_BRACE;
        for (i = 0; i < len; i++) {
            switch (s[i]) {
                case ' ':
                case '$':
................................................................................
        }
    }
    *p = '\0';
    *qlenPtr = p - q;
    return q;
}

static void UpdateStringOfList(struct Jim_Obj *objPtr)
{
    int i, bufLen, realLength;
    const char *strRep;
    char *p;
    int *quotingType;
    Jim_Obj **ele = objPtr->internalRep.listValue.ele;

................................................................................
    }
    return JIM_OK;
}

static int ExprAddOperator(Jim_Interp *interp, ExprByteCode * expr, ParseToken *t)
{
    struct ScriptToken *token = &expr->token[expr->len];
    const struct Jim_ExprOperator *op = JimExprOperatorInfoByOpcode(t->type);

    if (op->lazy == LAZY_OP) {
        if (ExprAddLazyOperator(interp, expr, t) != JIM_OK) {
            Jim_SetResultFormatted(interp, "Expression has bad operands to %s", op->name);
            return JIM_ERR;
        }
    }
    else {
        token->objPtr = interp->emptyObj;
        token->type = t->type;
        expr->len++;

    }
    return JIM_OK;
}

/**
 * Returns the index of the COLON_LEFT to the left of 'right_index'
 * taking into account nesting.
 *
 * The expression *must* be well formed, thus a COLON_LEFT will always be found.
................................................................................
        Jim_DecrRefCount(interp, objPtr);
    }
    else {
        retcode = Jim_SetVariable(interp, argNameObj, argValObj);
    }
    return retcode;
}

/**
 * Sets the interp result to be an error message indicating the required proc args.
 */
static void JimSetProcWrongArgs(Jim_Interp *interp, Jim_Obj *procNameObj, Jim_Cmd *cmd)
{
    /* Create a nice error message, consistent with Tcl 8.5 */
    Jim_Obj *argmsg = Jim_NewStringObj(interp, "", 0);
    int i;

    for (i = 0; i < cmd->u.proc.argListLen; i++) {
        Jim_AppendString(interp, argmsg, " ", 1);

        if (i == cmd->u.proc.argsPos) {
            if (cmd->u.proc.arglist[i].defaultObjPtr) {
                /* Renamed args */
                Jim_AppendString(interp, argmsg, "?", 1);
                Jim_AppendObj(interp, argmsg, cmd->u.proc.arglist[i].defaultObjPtr);
                Jim_AppendString(interp, argmsg, " ...?", -1);
            }
            else {
                /* We have plain args */
                Jim_AppendString(interp, argmsg, "?argument ...?", -1);
            }
        }
        else {
            if (cmd->u.proc.arglist[i].defaultObjPtr) {
                Jim_AppendString(interp, argmsg, "?", 1);
                Jim_AppendObj(interp, argmsg, cmd->u.proc.arglist[i].nameObjPtr);
                Jim_AppendString(interp, argmsg, "?", 1);
            }
            else {
                Jim_AppendObj(interp, argmsg, cmd->u.proc.arglist[i].nameObjPtr);
            }
        }
    }
    Jim_SetResultFormatted(interp, "wrong # args: should be \"%#s%#s\"", procNameObj, argmsg);
    Jim_FreeNewObj(interp, argmsg);
}

/* Call a procedure implemented in Tcl.
 * It's possible to speed-up a lot this function, currently
 * the callframes are not cached, but allocated and
 * destroied every time. What is expecially costly is
 * to create/destroy the local vars hash table every time.
 *
 * This can be fixed just implementing callframes caching
 * in JimCreateCallFrame() and JimFreeCallFrame(). */
static int JimCallProcedure(Jim_Interp *interp, Jim_Cmd *cmd, const char *filename, int linenr, int argc,
    Jim_Obj *const *argv)
{

    Jim_CallFrame *callFramePtr;


    Jim_Stack *prevLocalProcs;
    int i, d, retcode, optargs;

    /* Check arity */
    if (argc - 1 < cmd->u.proc.reqArity ||



































        (cmd->u.proc.argsPos < 0 && argc - 1 > cmd->u.proc.reqArity + cmd->u.proc.optArity)) {
        JimSetProcWrongArgs(interp, argv[0], cmd);
        return JIM_ERR;
    }

    /* Check if there are too nested calls */
    if (interp->framePtr->level == interp->maxNestingDepth) {
        Jim_SetResultString(interp, "Too many nested calls. Infinite recursion?", -1);
        return JIM_ERR;
................................................................................
    callFramePtr->staticVars = cmd->u.proc.staticVars;
    callFramePtr->filename = filename;
    callFramePtr->line = linenr;
    Jim_IncrRefCount(cmd->u.proc.argListObjPtr);
    Jim_IncrRefCount(cmd->u.proc.bodyObjPtr);
    interp->framePtr = callFramePtr;

    /* How many optional args are available */
    optargs = (argc - 1 - cmd->u.proc.reqArity);


    /* Step 'i' along the actual args, and step 'd' along the formal args */
    i = 1;

    for (d = 0; d < cmd->u.proc.argListLen; d++) {
        Jim_Obj *nameObjPtr = cmd->u.proc.arglist[d].nameObjPtr;
        if (d == cmd->u.proc.argsPos) {
            /* assign $args */
            int argsLen = 0;
            if (cmd->u.proc.reqArity + cmd->u.proc.optArity < argc - 1) {

                argsLen = argc - 1 - (cmd->u.proc.reqArity + cmd->u.proc.optArity);
            }
            Jim_Obj *listObjPtr = Jim_NewListObj(interp, &argv[i], argsLen);

            /* It is possible to rename args. */
            if (cmd->u.proc.arglist[d].defaultObjPtr) {
                nameObjPtr =cmd->u.proc.arglist[d].defaultObjPtr;

            }
            retcode = Jim_SetVariable(interp, nameObjPtr, listObjPtr);
            if (retcode != JIM_OK) {
                goto badargset;
            }


            i += argsLen;
            continue;
        }



        /* Optional or required? */
        if (cmd->u.proc.arglist[d].defaultObjPtr == NULL || optargs-- > 0) {
            retcode = JimSetProcArg(interp, nameObjPtr, argv[i++]);

        }








        else {




            /* Ran out, so use the default */
            retcode = Jim_SetVariable(interp, nameObjPtr, cmd->u.proc.arglist[d].defaultObjPtr);
        }























        if (retcode != JIM_OK) {
            goto badargset;
        }
    }

    /* Install a new stack for local procs */
    prevLocalProcs = interp->localProcs;
................................................................................
            interp->returnCode = JIM_OK;
            interp->returnLevel = 0;
        }
    }
    else if (retcode == JIM_ERR) {
        interp->addStackTrace++;
        Jim_DecrRefCount(interp, interp->errorProc);
        interp->errorProc = argv[0];
        Jim_IncrRefCount(interp->errorProc);
    }
    return retcode;
}

int Jim_Eval_Named(Jim_Interp *interp, const char *script, const char *filename, int lineno)
{
................................................................................
    Jim_SetResult(interp, objPtr);
    return JIM_EVAL;
}

/* [proc] */
static int Jim_ProcCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
{






    if (argc != 4 && argc != 5) {
        Jim_WrongNumArgs(interp, 1, argv, "name arglist ?statics? body");
        return JIM_ERR;
    }
































































    if (argc == 4) {
        return JimCreateProcedure(interp, argv[1], argv[2], NULL, argv[3]);

    }
    else {
        return JimCreateProcedure(interp, argv[1], argv[2], argv[3], argv[4]);

    }
}

/* [local] */
static int Jim_LocalCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
{
    int retcode;
................................................................................
/* Extended table for codepoints where |delta| > 127 */
struct caseextmap {
    unsigned short lower;
    unsigned short upper;
};

/* Generated mapping tables */
#include "_unicode_mapping.c"

#define NUMCASEMAP sizeof(unicode_case_mapping) / sizeof(*unicode_case_mapping)

static int cmp_casemap(const void *key, const void *cm)
{
    return *(int *)key - (int)((const struct casemap *)cm)->code;
}
................................................................................
 */

#include <stdio.h>
#include <stdlib.h>
#include <string.h>


/* From initjimsh.tcl */
extern int Jim_initjimshInit(Jim_Interp *interp);



























static void JimSetArgv(Jim_Interp *interp, int argc, char *const argv[])
{
    int n;
    Jim_Obj *listObj = Jim_NewListObj(interp, NULL, 0);

    /* Populate argv global var */
................................................................................
    if (Jim_InitStaticExtensions(interp) != JIM_OK) {
        Jim_MakeErrorMessage(interp);
        fprintf(stderr, "%s\n", Jim_String(Jim_GetResult(interp)));
    }

    Jim_SetVariableStrWithStr(interp, "jim_argv0", argv[0]);
    Jim_SetVariableStrWithStr(interp, JIM_INTERACTIVE, argc == 1 ? "1" : "0");
    retcode = Jim_initjimshInit(interp);

    if (argc == 1) {
        if (retcode == JIM_ERR) {
            Jim_MakeErrorMessage(interp);
            fprintf(stderr, "%s\n", Jim_String(Jim_GetResult(interp)));
        }
        if (retcode != JIM_EXIT) {

Changes to autosetup/test-tclsh.

1
2
3
4
5
6

7
8
9
10
11

12
13
14
15
16
17
18
19
20
21
# A small Tcl script to verify that the chosen
# interpreter works. Sometimes we might e.g. pick up
# an interpreter for a different arch.
# Outputs the full path to the interpreter

if {[catch {info version} version] == 0} {

	if {$version >= 0.70} {
		# Ensure that regexp works
		regexp a a

		# Unlike Tcl, [info nameofexecutable] can return a relative path

		puts [file join [pwd] [info nameofexecutable]]
		exit 0
	}
} elseif {[catch {info tclversion} version] == 0} {
	if {$version >= 8.5} {
		puts [info nameofexecutable]
		exit 0
	}
}
exit 1






>


|

<
>




|





1
2
3
4
5
6
7
8
9
10
11

12
13
14
15
16
17
18
19
20
21
22
# A small Tcl script to verify that the chosen
# interpreter works. Sometimes we might e.g. pick up
# an interpreter for a different arch.
# Outputs the full path to the interpreter

if {[catch {info version} version] == 0} {
	# This is Jim Tcl
	if {$version >= 0.70} {
		# Ensure that regexp works
		regexp (a.*?) a


		# Older versions of jimsh may return a relative path for [info nameofexecutable]
		puts [file join [pwd] [info nameofexecutable]]
		exit 0
	}
} elseif {[catch {info tclversion} version] == 0} {
	if {$version >= 8.5 && ![string match 8.5a* [info patchlevel]]} {
		puts [info nameofexecutable]
		exit 0
	}
}
exit 1

Changes to configure.

1
2
3
#!/bin/sh
dir="$(dirname "$0")/autosetup"
WRAPPER="$0" exec $("$dir/find-tclsh" || echo false) "$dir/autosetup" "$@"

|
|
1
2
3
#!/bin/sh
dir="`dirname "$0"`/autosetup"
WRAPPER="$0" exec `"$dir/find-tclsh" || echo false` "$dir/autosetup" "$@"