1999-05-20    <redman@scriptics.com>

	* library/init.tcl: Add the directory where the executable is, and
	the ../lib directory relative to that, to the auto_path variable.
	
1999-05-19    <stanton@scriptics.com>

	Merged in various changes submitted by Jeff Hobbs:
	
	* generic/tcl.decls: 
	* generic/tclUtf.c: Added Tcl_UniCharIs* functions for control,
	graph, print, and punct classes.

	* generic/tclUtil.c:
	* doc/StrMatch.3: Added Tcl_StringCaseMatch() implementation to
	support case-insensitive globbing.
	
	* doc/string.n: 
	* unix/mkLinks: 
	* tests/string.test: 
	* generic/tclCmdMZ.c: Added additional character class tests,
	added -nocase switch to "string match", changed string first/last
	to use offsets.

1999-05-19    <redman@scriptics.com>

	* generic/tcl.h: Add extern "C" block around entire header file for
	C++ compilers to fix linkage issues.  Submitted by Don Porter and
	Paul Duffin.

	* generic/tclRegexp.c: Fix bug when the regexp cache is empty
	and an empty pattern is used in regexp ( such as {} or "" ).

1999-05-18    <stanton@scriptics.com>

	* win/tclWinChan.c: Modified initialization code to avoid
	inherenting closed or invalid channels.  If the standard input is
	anything other than a console, file, serial port, or pipe, then we
	fall back to the standard Tk window console.

1999-05-14    <stanton@scriptics.com>

	* generic/tclCmdAH.c (Tcl_ForObjCmd): Fixed crash caused by
	failure to reset the result before evaluating the test
	expression. 

1999-05-14    <redman@scriptics.com>

	* generic/tclDate.c: Applied patch to fix 100-year and 400-year
	boundaries in leap year code, from Isaac Hollander.  [Bug: 2066]

1999-05-14    <stanton@scriptics.com>

	* unix/tclUnixInit.c (TclpSetInitialEncodings): Tcl now looks for
	an encoding subfield in the LANG/LC_ALL variables in cases where
	the locale is not found in the locale table.  Ensure that
	setlocale() is called at least once so X11 will initialize
	properly.  Also, forces the LC_NUMERIC locale to be "C" so numeric
	processing in scripts is not affected by the current locale
	setting. [Bug: 1989]

	* generic/tclRegexp.c: Increased per-thread regexp cache to 30
	slots.  This seems to be about the right number for larger
	applications like exmh.  [Bug: 1063]

1999-05-12    <stanton@scriptics.com>

	* doc/tclsh.1: Updated references to rc script names to accurately
	reflect the platform differences on Windows.

	* tests/regexp.test: 
	* generic/tclInt.h: 
	* generic/tclBasic.c: 
	* generic/tclRegexp.h:
	* generic/tclRegexp.c: Replaced the per-interpreter regexp cache
	with a per-thread cache.  Changed the Regexp object to take
	advantage of this extra cache.  Added a reference count to the
	TclRegexp type so regexps can be shared by multiple objects.
	Removed the per-interp regexp cache from the interpreter.  Now
	regexps can be used with no need for an interpreter. [Bug: 1063]

	* win/tclWinInit.c (TclpSetVariables): Avoid calling GetUserName
	if the value can be determined from the USERNAME environment
	variable.  GetUserName is very slow.

1999-05-07    <stanton@scriptics.com>

	* win/winDumpExts.c: 
	* win/makefile.vc: Removed incorrect patch. [Bug: 1998]
	
	* generic/tcl.decls: Replaced const with CONST.

	
	* generic/tclParse.c (Tcl_ParseCommand): Changed to avoid
	modifying eval'ed strings that are already null terminated.
	[Bug: 1793] 

	* tests/binary.test: 
	* generic/tclBinary.c (DupByteArrayInternalRep): Fixed bug where
	type was not being set in duplicated object. [Bug: 1975, 2047]

1999-04-30    <stanton@scriptics.com>
	
	* Changed version to 8.1.1.
	
1999-04-30    <stanton@scriptics.com>

Recent user-visible changes to Tcl:

RCS: @(#) $Id: changes,v 1.44.2.1 1999/05/25 20:22:44 stanton Exp $

1. No more [command1] [command2] construct for grouping multiple
commands on a single command line.

2. Semi-colon now available for grouping commands on a line.

3. For a command to span multiple lines, must now use backslash-return

ASCII as a subset. (stanton)

4/27/99 (bug fix) Added 'extern "C" {}' block around the stub table
pointer declaration so the stub library can be used from C++. (stanton)

--------------- Released 8.1 final, April 29, 1999 ----------------------

4/22/99 (bug fix) Changed Windows NT socket implementation to avoid
creating a communication window.  This avoids the problem where the
system hangs waiting for tclsh to respond to a system-wide synchronous
broadcast (e.g. if you change system colors). (redman)

4/22/99 (bug fix) Added call to TclWinInit from TclpInitPlatform when
building a static library since DllMain will not be invoked.  This
could break old code that explicitly called TclWinInit, but should be
simpler in the long run. (stanton)
*** POTENTIAL INCOMPATIBILITY ***

4/23/99 (bug fix) Added support for the koi8-r Cyrillic
encoding. [Bug: 1771] (stanton)

4/28/99 (bug fix) Changed internal Tcl_Obj usage to avoid freeing the
internal representation after the string representation has been
freed.  This makes it easier to debug extensions. (stanton)

4/30/99 (bug fix) Fixed a memory leak in CommandComplete. (stanton)

5/3/99 (bug fix) Fixed a bug where the Tcl_ObjType was not being set
in a duplicated Tcl_Obj. [Bug: 1975, 2047] (stanton)

5/3/99 (bug fix) Changed Tcl_ParseCommand to avoid modifying eval'ed
strings that are already null terminated.  [Bug: 1793] (stanton)

5/3/99 (new feature) Applied Jeff Hobbs's string patch which includes
the following changes:
    - added new subcommands: equal, repeat, map, is, replace 
    - added -length option to "string compare|equal"
    - added -nocase option to "string compare|equal|match"
    - string and list indices can be an integer or end?-integer?.
    - added optional first and last index args to string toupper, et al.
See the string.n manual entry for more details about the new string
features.  [Bug: 1845] (stanton)

5/6/99 (new feature) Added Tcl_UtfNcmp and Tcl_UtfNcasecmp to make Utf
string comparision easier. (stanton)

5/7/99 (bug fix) Improved OS/390 support. [Bug: 1976, 1997] (stanton)

5/12/99 (bug fix) Changed Windows initialization code to avoid using
GetUserName system call in favor of the env(USERNAME) variable.  This
provides a significant startup speed improvement. (stanton)

5/12/99 (bug fix) Replaced the per-interpreter regexp cache with a
per-thread cache.  Changed the Regexp object to take advantage of this
extra cache.  Added a reference count to the TclRegexp type so regexps
can be shared by multiple objects.  Removed the per-interp regexp cache
from the interpreter.  Now regexps can be used with no need for an
interpreter. This set of changes should provide significant speed
improvements for many Tcl scripts.  [Bug: 1063] (stanton)

5/14/99 (bug fix) Durining initialization on Unix, Tcl now extracts the
encoding subfield from the LANG/LC_ALL environment variables in cases
where the locale is not found in the built-in locale table.  It also
attempts to initialize the locale subsystem so X11 is happy. [Bug: 1989]
(stanton) 

5/14/99 (bug fix) Applied the patch to fix 100-year and 400-year
boundaries in leap year code, from Isaac Hollander.  [Bug: 2066] (redman)

5/14/99 (bug fix) Fixed a crash caused by a failure to reset the result
before evaluating the test expression in an uncompiled for
statement. (stanton)

5/18/99 (bug fix) Modified initialization code on Windows to avoid
inherenting closed or invalid channels.  If the standard input is
anything other than a console, file, serial port, or pipe, then we fall
back to the standard Tk window console. (stanton)

5/19/99 (bug fix) Added an extern "C" block around the entire tcl.h
header file to avoid C++ linkage issues. (redman)

5/19/99 (new feature) Applied Jeff Hobb's patch to add
Tcl_StringCaseMatch to support case insensitive glob style matching and
Tcl_UniCharIs* character classification functions. (stanton)

5/20/99 (bug fix) Added the directory containing the executuble and the
../lib directory relative to that to the auto_path variable. (redman)

--------------- Released 8.1.1, May 25, 1999 ----------------------

'\"
'\" Copyright (c) 1989-1993 The Regents of the University of California.
'\" Copyright (c) 1994-1996 Sun Microsystems, Inc.
'\"
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\" 
'\" RCS: @(#) $Id: StrMatch.3,v 1.2.8.1 1999/05/20 00:03:35 stanton Exp $
'\" 
.so man.macros
.TH Tcl_StringMatch 3 8.1 Tcl "Tcl Library Procedures"
.BS
.SH NAME
Tcl_StringMatch, Tcl_StringCaseMatch \- test whether a string matches a pattern
.SH SYNOPSIS
.nf
\fB#include <tcl.h>\fR
.sp
int
\fBTcl_StringMatch\fR(\fIstring\fR, \fIpattern\fR)
.VS 8.1
.sp
\fBTcl_StringCaseMatch\fR(\fIstring, pattern, nocase\fR)
.VE 8.1
.SH ARGUMENTS
.AP char *string in
String to test.
.AP char *pattern in
Pattern to match against string.  May contain special
characters from the set *?\e[].
.VS 8.1
.AP int nocase in
Specifies whether the match should be done case-sensitive (0) or
case-insensitive (1).
.VE 8.1
.BE

.SH DESCRIPTION
.PP
This utility procedure determines whether a string matches
a given pattern.  If it does, then \fBTcl_StringMatch\fR returns
1.  Otherwise \fBTcl_StringMatch\fR returns 0.  The algorithm
used for matching is the same algorithm used in the ``string match''
Tcl command and is similar to the algorithm used by the C-shell
for file name matching;  see the Tcl manual entry for details.
.VS 8.1
.PP
In \fBTcl_StringCaseMatch\fR, the algorithm is the same, but you have
the option to make the matching case-insensitive.  If you choose this
(by passing \fBnocase\fR as 1), then the string and pattern are
essentially matched in the lower case.
.VE 8.1

.SH KEYWORDS
match, pattern, string

'\"
'\" Copyright (c) 1993 The Regents of the University of California.
'\" Copyright (c) 1994-1996 Sun Microsystems, Inc.
'\"
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\" 
'\" RCS: @(#) $Id: string.n,v 1.9.2.2 1999/05/20 03:28:09 stanton Exp $
'\" 
.so man.macros
.TH string n 8.1 Tcl "Tcl Built-In Commands"
.BS
'\" Note:  do not modify the .SH NAME line immediately below!
.SH NAME
string \- Manipulate strings
.SH SYNOPSIS
\fBstring \fIoption arg \fR?\fIarg ...?\fR
.BE

.SH DESCRIPTION
.PP
Performs one of several string operations, depending on \fIoption\fR.
The legal \fIoption\fRs (which may be abbreviated) are:
.VS 8.1
.TP
\fBstring bytelength \fIstring\fR
Returns a decimal string giving the number of bytes used to represent
\fIstring\fR in memory.  Because UTF\-8 uses one to three bytes to
represent Unicode characters, the byte length will not be the same as
the character length in general.  The cases where a script cares about
the byte length are rare.  In almost all cases, you should use the
\fBstring length\fR operation.  Refer to the \fBTcl_NumUtfChars\fR
manual entry for more details on the UTF\-8 representation.
.TP
\fBstring compare ?\fB\-nocase\fR? ?\fB\-length int\fR? \fIstring1 string2\fR
.VE 8.1
Perform a character-by-character comparison of strings \fIstring1\fR and
\fIstring2\fR.  Returns
\-1, 0, or 1, depending on whether \fIstring1\fR is lexicographically
less than, equal to, or greater than \fIstring2\fR.
.VS 8.1
If \fB\-length\fR is specified, then only the first \fIlength\fR characters
are used in the comparison.  If \fB\-length\fR is negative, it is
ignored.  If \fB\-nocase\fR is specified, then the strings are
compared in a case-insensitive manner.
.TP
\fBstring equal ?\fB\-nocase\fR? ?\fB-length int\fR? \fIstring1
string2\fR Perform a character-by-character comparison of strings
\fIstring1\fR and \fIstring2\fR.  Returns 1 if \fIstring1\fR and
\fIstring2\fR are identical, or 0 when not.  If \fB\-length\fR is
specified, then only the first \fIlength\fR characters are used in the
comparison.  If \fB\-length\fR is negative, it is ignored.  If
\fB\-nocase\fR is specified, then the strings are compared in a
case-insensitive manner.
.TP
\fBstring first \fIstring1 string2\fR ?\fIstartIndex\fR?
.VE 8.1
Search \fIstring2\fR for a sequence of characters that exactly match
the characters in \fIstring1\fR.  If found, return the index of the
first character in the first such match within \fIstring2\fR.  If not
found, return \-1.
.VS 8.1
If \fIstartIndex\fR is specified (in any of the forms accepted by the
\fBindex\fR method), then the search is constrained to start with the
character in \fIstring2\fR specified by the index.  For example,
.RS
.CS
\fBstring first a 0a23456789abcdef 5\fR
.CE
will return \fB10\fR, but
.CS
\fBstring first a 0123456789abcdef 11\fR
.CE
will return \fB\-1\fR.
.RE
.VE 8.1
.TP
\fBstring index \fIstring charIndex\fR
Returns the \fIcharIndex\fR'th character of the \fIstring\fR
argument.  A \fIcharIndex\fR of 0 corresponds to the first
character of the string.  
.VS 8.1
\fIcharIndex\fR may be specified as
follows:
.RS
.IP \fIinteger\fR 10
The char specified at this integral index
.IP \fBend\fR 10
The last char of the string.
.IP \fBend\-\fIinteger\fR 10
The last char of the string minus the specified integer
offset (e.g. \fBend\-1\fR would refer to the "c" in "abcd").
.PP
.VE 8.1
If \fIcharIndex\fR is less than 0 or greater than
or equal to the length of the string then an empty string is
returned.
.RE
.VS 8.1
.TP
\fBstring is \fIclass\fR ?\fB\-strict\fR? ?\fB\-failindex \fIvarname\fR? \fIstring\fR
Returns 1 if \fIstring\fR is a valid member of the specified character
class, otherwise returns 0.  If \fB\-strict\fR is specified, then an
empty string returns 0, otherwise and empty string will return 1 on
any class.  If \fB\-failindex\fR is specified, then if the function
returns 0, the index in the string where the class was no longer valid
will be stored in the variable named \fIvarname\fR.  The \fIvarname\fR
will not be set if the function returns 1.  The following character classes
are recognized (the class name can be abbreviated):
.RS
.IP \fBalnum\fR 10
Any Unicode alphabet or digit character.
.IP \fBalpha\fR 10
Any Unicode alphabet character.
.IP \fBascii\fR 10
Any character with a value less than \\u0080 (those that
are in the 7\-bit ascii range).
.IP \fBboolean\fR 10
Any of the forms allowed to \fBTcl_GetBoolean\fR.
.IP \fBcontrol\fR 10
Any Unicode control character.
.IP \fBdigit\fR 10
Any Unicode digit character.
.IP \fBdouble\fR 10
Any of the valid forms for a double in Tcl, with optional surrounding
whitespace.  In case of under/overflow in the value, 0 is returned
and the \fIvarname\fR will contain \-1.
.IP \fBfalse\fR 10
Any of the forms allowed to \fBTcl_GetBoolean\fR where the value is false.
.IP \fBgraph\fR 10
Any Unicode printing character, except space.
.IP \fBinteger\fR 10
Any of the valid forms for an integer in Tcl, with optional surrounding
whitespace.  In case of under/overflow in the value, 0 is returned
and the \fIvarname\fR will contain \-1.
.IP \fBlower\fR 10
Any Unicode lower case alphabet character.
.IP \fBprint\fR 10
Any Unicode printing character, including space.
.IP \fBpunct\fR 10
Any Unicode printing character, except space or where \fBalnum\fR is true.
.IP \fBspace\fR 10
Any Unicode space character.
.IP \fBtrue\fR 10
Any of the forms allowed to \fBTcl_GetBoolean\fR where the value is true.
.IP \fBupper\fR 10
Any upper case alphabet character in the Unicode character set.
.IP \fBwordchar\fR 10
Any Unicode word character.  That is any alphanumeric character,
and any Unicode connector punctuation characters (e.g. underscore).
.IP \fBxdigit\fR 10
Any hexadecimal digit character ([0\-9A\-Fa\-f]).
.RE
In the case of \fBboolean\fR, \fBtrue\fR and \fBfalse\fR, if the
function will return 0, the \fIvarname\fR will always be set to 0,
due to the varied nature of a valid boolean value.

.TP
\fBstring last \fIstring1 string2\fR ?\fIstartIndex\fR?
.VE 8.1
Search \fIstring2\fR for a sequence of characters that exactly match
the characters in \fIstring1\fR.  If found, return the index of the
first character in the last such match within \fIstring2\fR.  If there
is no match, then return \-1.
.VS 8.1
If \fIstartIndex\fR is specified (in any of the forms accepted by the
\fBindex\fR method), then only the characters in \fIstring2\fR at or before the
specified \fIstartIndex\fR will be considered by the search.  For example,
.RS
.CS
\fBstring last a 0a23456789abcdef 15\fR
.CE
will return \fB10\fR, but
.CS
\fBstring last a 0a23456789abcdef 9\fR
.CE
will return \fB1\fR.
.RE
.VE 8.1
.TP
\fBstring length \fIstring\fR
Returns a decimal string giving the number of characters in
\fIstring\fR.  Note that this is not necessarily the same as the
number of bytes used to store the string.
.VS 8.1
.TP
\fBstring map\fR ?\fB\-nocase\fR? \fIcharMap string\fR
Replaces characters in \fIstring\fR based on the key-value pairs in
\fIcharMap\fR.  \fIcharMap\fR is a list of \fIkey value key value\fR ...
as in the form returned by \fBarray get\fR.  Each instance of a
key in the string will be replaced with its corresponding value.  If
\fB\-nocase\fR is specified, then matching is done without regard to
case differences. Both \fIkey\fR and \fIvalue\fR may be multiple
characters.  Replacement is done in an ordered manner, so the key appearing
first in the list will be checked first, and so on.  \fIstring\fR is
only iterated over once, so earlier key replacements will have no
affect for later key matches.  For example,
.RS
.CS
\fBstring map {abc 1 ab 2 a 3 1 0} 1abcaababcabababc\fR
.CE
will return the string \fB01321221\fR.
.RE

.TP
\fBstring match ?\fB\-nocase\fR? \fIpattern\fR \fIstring\fR
.VE 8.1
See if \fIpattern\fR matches \fIstring\fR; return 1 if it does, 0
if it doesn't.  
.VS 8.1
If \fB\-nocase\fR is specified, then the pattern attempts to match
against the string in a case insensitive manner.
.VE 8.1
For the two strings to match, their contents
must be identical except that the following special sequences
may appear in \fIpattern\fR:
.RS
.IP \fB*\fR 10
Matches any sequence of characters in \fIstring\fR,
including a null string.
.IP \fB?\fR 10
Matches any single character in \fIstring\fR.
.IP \fB[\fIchars\fB]\fR 10
Matches any character in the set given by \fIchars\fR.  If a sequence
of the form
\fIx\fB\-\fIy\fR appears in \fIchars\fR, then any character
between \fIx\fR and \fIy\fR, inclusive, will match.
.VS 8.1
When used with \fB\-nocase\fR, the end points of the range are converted
to lower case first.  Whereas {[A\-z]} matches '_' when matching
case-sensitively ('_' falls between the 'Z' and 'a'), with \fB\-nocase\fR
this is considered like {[A\-Za\-z]} (and probably what was meant in the
first place).
.VE 8.1
.IP \fB\e\fIx\fR 10
Matches the single character \fIx\fR.  This provides a way of
avoiding the special interpretation of the characters
\fB*?[]\e\fR in \fIpattern\fR.
.RE
.TP
\fBstring range \fIstring first last\fR

it is treated as if it were \fBend\fR.  If \fIfirst\fR is greater than
\fIlast\fR then an empty string is returned.
.VS 8.1
.TP
\fBstring repeat \fIstring count\fR
Returns \fIstring\fR repeated \fIcount\fR number of times.
.TP
\fBstring replace \fIstring first last\fR ?\fInewstring\fR?
Removes a range of consecutive characters from \fIstring\fR, starting
with the character whose index is \fIfirst\fR and ending with the
character whose index is \fIlast\fR.  An index of 0 refers to the
first character of the string.  \fIFirst\fR and \fIlast\fR may be
specified as for the \fBindex\fR method.  If \fInewstring\fR is
specified, then it is placed in the removed character range.
If \fIfirst\fR is less than zero then it is treated as if it were zero, and
if \fIlast\fR is greater than or equal to the length of the string then
it is treated as if it were \fBend\fR.  If \fIfirst\fR is greater than
\fIlast\fR or the length of the initial string, or \fIlast\fR is less
than 0, then the initial string is returned untouched.
.TP

specified as for the \fBindex\fR method.  A word is considered to be any
contiguous range of alphanumeric (Unicode letters or decimal digits)
or underscore (Unicode connector punctuation) characters, or any
single character other than these.
.VE 8.1

.SH KEYWORDS
case conversion, compare, index, match, pattern, string, word, equal, ctype

'\"
'\" Copyright (c) 1993 The Regents of the University of California.
'\" Copyright (c) 1994-1996 Sun Microsystems, Inc.
'\"
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\" 
'\" RCS: @(#) $Id: tclsh.1,v 1.2.8.1 1999/05/14 18:26:09 stanton Exp $
'\" 
.so man.macros
.TH tclsh 1 "" Tcl "Tcl Applications"
.BS
'\" Note:  do not modify the .SH NAME line immediately below!
.SH NAME
tclsh \- Simple shell containing Tcl interpreter
.SH SYNOPSIS
\fBtclsh\fR ?\fIfileName arg arg ...\fR?
.BE

.SH DESCRIPTION
.PP
\fBTclsh\fR is a shell-like application that reads Tcl commands
from its standard input or from a file and evaluates them.
If invoked with no arguments then it runs interactively, reading
Tcl commands from standard input and printing command results and
error messages to standard output.
It runs until the \fBexit\fR command is invoked or until it
reaches end-of-file on its standard input.
If there exists a file \fB.tclshrc\fR (or \fBtclshrc.tcl\fR on
the Windows platforms) in the home directory of
the user, \fBtclsh\fR evaluates the file as a Tcl script
just before reading the first command from standard input.

.SH "SCRIPT FILES"
.PP
If \fBtclsh\fR is invoked with arguments then the first argument
is the name of a script file and any additional arguments

# tcl.decls --
#
#	This file contains the declarations for all supported public
#	functions that are exported by the Tcl library via the stubs table.
#	This file is used to generate the tclDecls.h, tclPlatDecls.h,
#	tclStub.c, and tclPlatStub.c files.
#	
#
# Copyright (c) 1998-1999 by Scriptics Corporation.
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
# 
# RCS: @(#) $Id: tcl.decls,v 1.12.2.1 1999/05/20 00:03:35 stanton Exp $

library tcl

# Define the tcl interface with several sub interfaces:
#     tclPlat	 - platform specific public
#     tclInt	 - generic private
#     tclPlatInt - platform specific private

}
declare 369 generic {
    int Tcl_UtfNcmp(CONST char *s1, CONST char *s2, size_t n)
}
declare 370 generic {
    int Tcl_UtfNcasecmp(CONST char *s1, CONST char *s2, size_t n)
}
declare 371 generic {
    int Tcl_StringCaseMatch(CONST char *str, CONST char *pattern, int nocase)
}
declare 372 generic {
    int Tcl_UniCharIsControl(int ch)
}
declare 373 generic {
    int Tcl_UniCharIsGraph(int ch)
}
declare 374 generic {
    int Tcl_UniCharIsPrint(int ch)
}
declare 375 generic {
    int Tcl_UniCharIsPunct(int ch)
}

##############################################################################

# Define the platform specific public Tcl interface.  These functions are
# only available on the designated platform.

interface tclPlat

 * Copyright (c) 1993-1996 Lucent Technologies.
 * Copyright (c) 1994-1998 Sun Microsystems, Inc.
 * Copyright (c) 1998-1999 by Scriptics Corporation.
 *
 * See the file "license.terms" for information on usage and redistribution
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 *
 * RCS: @(#) $Id: tcl.h,v 1.43.2.1 1999/05/19 23:27:09 redman Exp $
 */

#ifndef _TCL
#define _TCL

/*
 * For C++ compilers, use extern "C"
 */

#ifdef __cplusplus
extern "C" {
#endif
    
/*
 * The following defines are used to indicate the various release levels.
 */

#define TCL_ALPHA_RELEASE	0
#define TCL_BETA_RELEASE	1
#define TCL_FINAL_RELEASE	2

EXTERN int		Tcl_AppInit _ANSI_ARGS_((Tcl_Interp *interp));

#endif /* RESOURCE_INCLUDED */

#undef TCL_STORAGE_CLASS
#define TCL_STORAGE_CLASS DLLIMPORT

/*
 * end block for C++
 */
    
#ifdef __cplusplus
}
#endif
    
#endif /* _TCL */

 * Copyright (c) 1987-1994 The Regents of the University of California.
 * Copyright (c) 1994-1997 Sun Microsystems, Inc.
 * Copyright (c) 1998-1999 by Scriptics Corporation.
 *
 * See the file "license.terms" for information on usage and redistribution
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 *
 * RCS: @(#) $Id: tclBasic.c,v 1.19.2.2 1999/05/17 18:11:00 surles Exp $
 */

#include "tclInt.h"
#include "tclCompile.h"
#ifndef TCL_GENERIC_ONLY
#   include "tclPort.h"
#endif

    iPtr->errorInfo = NULL;
    iPtr->errorCode = NULL;

    iPtr->appendResult = NULL;
    iPtr->appendAvl = 0;
    iPtr->appendUsed = 0;






    Tcl_InitHashTable(&iPtr->packageTable, TCL_STRING_KEYS);
    iPtr->packageUnknown = NULL;
    iPtr->cmdCount = 0;
    iPtr->termOffset = 0;
    TclInitLiteralTable(&(iPtr->literalTable));
    iPtr->compileEpoch = 0;
    iPtr->compiledProcPtr = NULL;

    Tcl_SetVar(interp, "tcl_patchLevel", TCL_PATCH_LEVEL, TCL_GLOBAL_ONLY);
    Tcl_SetVar(interp, "tcl_version", TCL_VERSION, TCL_GLOBAL_ONLY);
    Tcl_TraceVar2(interp, "tcl_precision", (char *) NULL,
	    TCL_GLOBAL_ONLY|TCL_TRACE_READS|TCL_TRACE_WRITES|TCL_TRACE_UNSETS,
	    TclPrecTraceProc, (ClientData) NULL);
    TclpSetVariables(interp);

#ifdef TCL_THREADS
    /*
     * The existence of the "threaded" element of the tcl_platform array indicates
     * that this particular Tcl shell has been compiled with threads turned on.
     * Using "info exists tcl_platform(threaded)" a Tcl script can introspect on the 
     * interpreter level of thread safety.
     */


    Tcl_SetVar2(interp, "tcl_platform", "threaded", "1",
	    TCL_GLOBAL_ONLY);
#endif

    /*
     * Register Tcl's version number.
     */

    Tcl_PkgProvideEx(interp, "Tcl", TCL_VERSION, (ClientData) &tclStubs);
    

    Tcl_Interp *interp;			/* Interpreter to delete. */
{
    Interp *iPtr = (Interp *) interp;
    Tcl_HashEntry *hPtr;
    Tcl_HashSearch search;
    Tcl_HashTable *hTablePtr;
    ResolverScheme *resPtr, *nextResPtr;


    /*
     * Punt if there is an error in the Tcl_Release/Tcl_Preserve matchup.
     */
    
    if (iPtr->numLevels > 0) {
        panic("DeleteInterpProc called with active evals");

	ckfree(iPtr->errorCode);
        iPtr->errorCode = NULL;
    }
    if (iPtr->appendResult != NULL) {
	ckfree(iPtr->appendResult);
        iPtr->appendResult = NULL;
    }








    TclFreePackageInfo(iPtr);
    while (iPtr->tracePtr != NULL) {
	Trace *nextPtr = iPtr->tracePtr->nextPtr;

	ckfree((char *) iPtr->tracePtr);
	iPtr->tracePtr = nextPtr;
    }

/* 
 * tclCmdAH.c --
 *
 *	This file contains the top-level command routines for most of
 *	the Tcl built-in commands whose names begin with the letters
 *	A to H.
 *
 * Copyright (c) 1987-1993 The Regents of the University of California.
 * Copyright (c) 1994-1997 Sun Microsystems, Inc.
 *
 * See the file "license.terms" for information on usage and redistribution
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 *
 * RCS: @(#) $Id: tclCmdAH.c,v 1.5.2.1 1999/05/14 22:18:05 stanton Exp $
 */

#include "tclInt.h"
#include "tclPort.h"
#include <locale.h>

typedef int (StatProc)_ANSI_ARGS_((CONST char *path, struct stat *buf));

    }
    return "unknown";
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_ForObjCmd --
 *
 *      This procedure is invoked to process the "for" Tcl command.
 *      See the user documentation for details on what it does.
 *
 *	With the bytecode compiler, this procedure is only called when
 *	a command name is computed at runtime, and is "for" or the name
 *	to which "for" was renamed: e.g.,

    if (result != TCL_OK) {
        if (result == TCL_ERROR) {
            Tcl_AddErrorInfo(interp, "\n    (\"for\" initial command)");
        }
        return result;
    }
    while (1) {
	/*
	 * We need to reset the result before passing it off to
	 * Tcl_ExprBooleanObj.  Otherwise, any error message will be appended
	 * to the result of the last evaluation.
	 */

	Tcl_ResetResult(interp);
        result = Tcl_ExprBooleanObj(interp, objv[2], &value);
        if (result != TCL_OK) {
            return result;
        }
        if (!value) {
            break;
        }

 * Copyright (c) 1987-1993 The Regents of the University of California.
 * Copyright (c) 1994-1997 Sun Microsystems, Inc.
 * Copyright (c) 1998-1999 by Scriptics Corporation.
 *
 * See the file "license.terms" for information on usage and redistribution
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 *
 * RCS: @(#) $Id: tclCmdMZ.c,v 1.8.2.1 1999/05/20 00:03:36 stanton Exp $
 */

#include "tclInt.h"
#include "tclPort.h"
#include "tclCompile.h"
#include "tclRegexp.h"

		 * the benfit of nocase
		 */
		if ((reqlength > 0) && (reqlength < length)) {
		    length = reqlength;
		}
		if (nocase) {
		    match = Tcl_UtfNcasecmp(string1, string2,
			    (unsigned) length);
		} else {
		    match = Tcl_UtfNcmp(string1, string2,
			    (unsigned) length);
		}
		if ((match == 0) && (reqlength > length)) {
		    match = length1 - length2;
		}
	    } else {
		match = memcmp(string1, string2, (unsigned) length);
		if (match == 0) {
		    match = length1 - length2;
		}
	    }

	    if ((enum options) index == STR_EQUAL) {
		Tcl_SetBooleanObj(resultPtr, (match) ? 0 : 1);
	    } else {
		Tcl_SetIntObj(resultPtr, ((match > 0) ? 1 :
					  (match < 0) ? -1 : 0));
	    }
	    break;
	}
	case STR_FIRST: {
	    register char *p, *end;
	    int match, utflen, start;

	    if (objc < 4 || objc > 5) {

	        Tcl_WrongNumArgs(interp, 2, objv,
				 "string1 string2 ?startIndex?");
		return TCL_ERROR;
	    }

	    /*
	     * This algorithm fails on improperly formed UTF strings.
	     * We are searching string2 for the sequence string1.
	     */

	    match = -1;
	    start = 0;
	    utflen = -1;
	    string1 = Tcl_GetStringFromObj(objv[2], &length1);
	    string2 = Tcl_GetStringFromObj(objv[3], &length2);

	    if (objc == 5) {
		/*
		 * If a startIndex is specified, we will need to fast forward
		 * to that point in the string before we think about a match
		 */
		utflen = Tcl_NumUtfChars(string2, length2);
		if (TclGetIntForIndex(interp, objv[4], utflen-1,
				      &start) != TCL_OK) {
		    return TCL_ERROR;
		}
		if (start >= utflen) {
		    goto str_first_done;
		} else if (start > 0) {
		    if (length2 == utflen) {
			/* no unicode chars */
			string2 += start;
		    } else {
			string2 = Tcl_UtfAtIndex(string2, start);
		    }
		}
	    }

	    if (length1 > 0) {
		end = string2 + length2 - length1 + 1;
		for (p = string2;  p < end;  p++) {
		    /*
		     * Scan forward to find the first character.
		     */

		    p = memchr(p, *string1, (unsigned) (end - p));
		    if (p == NULL) {
			break;
		    }
		    if (memcmp(string1, p, (unsigned) length1) == 0) {
			match = p - string2;
			break;
		    }
		}
	    }

	    /*
	     * Compute the character index of the matching string by
	     * counting the number of characters before the match.
	     */
	str_first_done:
	    if (match != -1) {
		if (objc == 4) {
		    match = Tcl_NumUtfChars(string2, match);
		} else if (length2 == utflen) {
		    /* no unicode chars */
		    match += start;
		} else {
		    match = start + Tcl_NumUtfChars(string2, match);
		}
	    }
	    Tcl_SetIntObj(resultPtr, match);
	    break;
	}
	case STR_INDEX: {
	    int index;


	    if (objc != 4) {
	        Tcl_WrongNumArgs(interp, 2, objv, "string charIndex");
		return TCL_ERROR;
	    }
	    string1 = Tcl_GetStringFromObj(objv[2], &length1);
	    /*
	     * establish what 'end' really means
	     */
	    length2 = Tcl_NumUtfChars(string1, length1);
	    if (TclGetIntForIndex(interp, objv[3], length2 - 1,
				  &index) != TCL_OK) {
	      return TCL_ERROR;
	    }
	    /*
	     * index must be between 0 and the UTF length to be valid
	     */
	    if ((index >= 0) && (index < length2)) {
		if (length1 == length2) {
		    /* no unicode chars */
		    Tcl_SetStringObj(resultPtr, string1+index, 1);
		} else {
		    char buf[TCL_UTF_MAX];

		    length2 = Tcl_UniCharToUtf(Tcl_UniCharAtIndex(string1,
								  index), buf);
		    Tcl_SetStringObj(resultPtr, buf, length2);
		}
	    }
	    break;
	}
	case STR_IS: {
	    char *end;
	    Tcl_UniChar ch;
	    int (*chcomp)(int) = NULL;	/* The UniChar comparison function */
	    int i, failat = 0, result = 1, strict = 0;
	    Tcl_Obj *objPtr, *failVarObj = NULL;

	    static char *isOptions[] = {
		"alnum",	"alpha",	"ascii",	"control",
		"boolean",	"digit",	"double",	"false",
		"graph",	"integer",	"lower",	"print",
		"punct",	"space",	"true",		"upper",
		"wordchar",	"xdigit",	(char *) NULL
	    };
	    enum isOptions {
		STR_IS_ALNUM,	STR_IS_ALPHA,	STR_IS_ASCII,	STR_IS_CONTROL,
		STR_IS_BOOL,	STR_IS_DIGIT,	STR_IS_DOUBLE,	STR_IS_FALSE,
		STR_IS_GRAPH,	STR_IS_INT,	STR_IS_LOWER,	STR_IS_PRINT,
		STR_IS_PUNCT,	STR_IS_SPACE,	STR_IS_TRUE,	STR_IS_UPPER,
		STR_IS_WORD,	STR_IS_XDIGIT
	    };

	    if (objc < 4 || objc > 7) {
		Tcl_WrongNumArgs(interp, 2, objv,
				 "class ?-strict? ?-failindex var? str");
		return TCL_ERROR;
	    }

			       (((enum isOptions) index == STR_IS_TRUE) &&
				i == 0) ||
			       (((enum isOptions) index == STR_IS_FALSE) &&
				i != 0)) {
			result = 0;
		    }
		    break;
		case STR_IS_CONTROL:
		    chcomp = Tcl_UniCharIsControl;
		    break;
		case STR_IS_DIGIT:
		    chcomp = Tcl_UniCharIsDigit;
		    break;
		case STR_IS_DOUBLE: {
		    char *stop;

		    if ((objPtr->typePtr == &tclDoubleType) ||

			 */
			failat = stop - string1;
			string1 = stop;
			chcomp = Tcl_UniCharIsSpace;
		    }
		    break;
		}
		case STR_IS_GRAPH:
		    chcomp = Tcl_UniCharIsGraph;
		    break;
		case STR_IS_INT: {
		    char *stop;

		    if ((objPtr->typePtr == &tclIntType) ||
			(Tcl_GetInt(NULL, string1, &i) == TCL_OK)) {
			break;
		    }
		    /*
		     * Like STR_IS_DOUBLE, but we use strtoul.
		     * Since Tcl_GetInt already failed, we set result to 0.
		     */
		    result = 0;
		    errno = 0;
		    strtoul(string1, &stop, 0); /* INTL: Tcl source. */
		    if (errno == ERANGE) {
			/*

			chcomp = Tcl_UniCharIsSpace;
		    }
		    break;
		}
		case STR_IS_LOWER:
		    chcomp = Tcl_UniCharIsLower;
		    break;
		case STR_IS_PRINT:
		    chcomp = Tcl_UniCharIsPrint;
		    break;
		case STR_IS_PUNCT:
		    chcomp = Tcl_UniCharIsPunct;
		    break;
		case STR_IS_SPACE:
		    chcomp = Tcl_UniCharIsSpace;
		    break;
		case STR_IS_UPPER:
		    chcomp = Tcl_UniCharIsUpper;
		    break;
		case STR_IS_WORD:
		    chcomp = Tcl_UniCharIsWordChar;
		    break;
		case STR_IS_XDIGIT: {
		    for (; string1 < end; string1++, failat++) {
			/* INTL: We assume unicode is bad for this class */
			if ((*((unsigned char *)string1) >= 0xC0) ||
			    !isxdigit(*(unsigned char *)string1)) {
			    result = 0;
			    break;
			}
		    }
		    break;
		}
	    }
	    if (chcomp != NULL) {
		for (; string1 < end; string1 += length2, failat++) {
		    length2 = Tcl_UtfToUniChar(string1, &ch);
		    if (!chcomp(ch)) {
			result = 0;
			break;

		return TCL_ERROR;
	    }
	    Tcl_SetBooleanObj(resultPtr, result);
	    break;
	}
	case STR_LAST: {
	    register char *p;
	    int match, utflen, start;

	    if (objc < 4 || objc > 5) {
	        Tcl_WrongNumArgs(interp, 2, objv,
				 "string1 string2 ?startIndex?");
		return TCL_ERROR;
	    }

	    /*
	     * This algorithm fails on improperly formed UTF strings.
	     */

	    match = -1;
	    start = 0;
	    utflen = -1;
	    string1 = Tcl_GetStringFromObj(objv[2], &length1);
	    string2 = Tcl_GetStringFromObj(objv[3], &length2);

	    if (objc == 5) {
		/*
		 * If a startIndex is specified, we will need to restrict
		 * the string range to that char index in the string
		 */
		utflen = Tcl_NumUtfChars(string2, length2);
		if (TclGetIntForIndex(interp, objv[4], utflen-1,
				      &start) != TCL_OK) {
		    return TCL_ERROR;
		}
		if (start < 0) {
		    goto str_last_done;
		} else if (start < utflen) {
		    if (length2 == utflen) {
			/* no unicode chars */
			p = string2 + start + 1 - length1;
		    } else {
			p = Tcl_UtfAtIndex(string2, start+1) - length1;
		    }
		} else {
		    p = string2 + length2 - length1;
		}
	    } else {
		p = string2 + length2 - length1;
	    }

	    if (length1 > 0) {
		for (;  p >= string2;  p--) {
		    /*
		     * Scan backwards to find the first character.
		     */

		    while ((p != string2) && (*p != *string1)) {
			p--;
		    }
		    if (memcmp(string1, p, (unsigned) length1) == 0) {
			match = p - string2;
			break;
		    }
		}
	    }

	    /*
	     * Compute the character index of the matching string by counting
	     * the number of characters before the match.
	     */
	str_last_done:
	    if (match != -1) {
		if ((objc == 4) || (length2 != utflen)) {
		    /* only check when we've got unicode chars */
		    match = Tcl_NumUtfChars(string2, match);
		}
	    }
	    Tcl_SetIntObj(resultPtr, match);
	    break;
	}
	case STR_BYTELENGTH:
	case STR_LENGTH: {
	    if (objc != 3) {

		} else {
		    length1 -= len;
		}
	    }
	    break;
	}
	case STR_MATCH: {
	    int nocase = 0;

	    if (objc < 4 || objc > 5) {
	        Tcl_WrongNumArgs(interp, 2, objv, "?-nocase? pattern string");
		return TCL_ERROR;
	    }

	    if (objc == 5) {
		string2 = Tcl_GetStringFromObj(objv[2], &length2);
		if ((length2 > 1) &&
		    strncmp(string2, "-nocase", (size_t) length2) == 0) {
		    nocase = 1;
		} else {
		    Tcl_AppendStringsToObj(resultPtr, "bad option \"",
					   string2, "\": must be -nocase",
					   (char *) NULL);
		    return TCL_ERROR;
		}
	    }

	    Tcl_SetBooleanObj(resultPtr,
			      Tcl_StringCaseMatch(Tcl_GetString(objv[objc-1]),
						  Tcl_GetString(objv[objc-2]),
						  nocase));
	    break;
	}
	case STR_RANGE: {
	    int first, last;

	    if (objc != 5) {
	        Tcl_WrongNumArgs(interp, 2, objv, "string first last");
		return TCL_ERROR;
	    }

	    string1 = Tcl_GetStringFromObj(objv[2], &length1);
	    length1 = Tcl_NumUtfChars(string1, length1) - 1;
	    if (TclGetIntForIndex(interp, objv[3], length1,
		    &first) != TCL_OK) {
		return TCL_ERROR;
	    }
	    if (TclGetIntForIndex(interp, objv[4], length1,
		    &last) != TCL_OK) {
		return TCL_ERROR;
	    }
	    if (first < 0) {
		first = 0;
	    }
	    if (last >= length1) {
		last = length1;
	    }
	    if (last >= first) {
		char *start, *end;

		start = Tcl_UtfAtIndex(string1, first);
		end = Tcl_UtfAtIndex(start, last - first + 1);
	        Tcl_SetStringObj(resultPtr, start, end - start);

		}
	    }
	    break;
	}
	case STR_REPLACE: {
	    int first, last;

	    if (objc < 5 || objc > 6) {
	        Tcl_WrongNumArgs(interp, 2, objv,
				 "string first last ?string?");
		return TCL_ERROR;
	    }

	    string1 = Tcl_GetStringFromObj(objv[2], &length1);
	    length1 = Tcl_NumUtfChars(string1, length1) - 1;
	    if (TclGetIntForIndex(interp, objv[3], length1,
				  &first) != TCL_OK) {

/* 
 * tclDate.c --
 *
 *	This file is generated from a yacc grammar defined in
 *	the file tclGetDate.y.  It should not be edited directly.
 *
 * Copyright (c) 1992-1995 Karl Lehenbauer and Mark Diekhans.
 * Copyright (c) 1995-1997 Sun Microsystems, Inc.
 *
 * See the file "license.terms" for information on usage and redistribution
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 *
 * RCS: @(#) $Id: tclDate.c,v 1.4.2.1 1999/05/14 17:27:18 redman Exp $ 
 */

#include "tclInt.h"
#include "tclPort.h"

#ifdef MAC_TCL
#   define EPOCH           1904

     || Day < 1 || Day > DaysInMonth[(int)--Month])
        return -1;

    for (Julian = Day - 1, i = 0; i < Month; i++)
        Julian += DaysInMonth[i];
    if (Year >= EPOCH) {
        for (i = EPOCH; i < Year; i++)
            Julian += 365 + (((i % 4) == 0) &&
	            (((i % 100) != 0) || ((i % 400) == 0)));
    } else {
        for (i = Year; i < EPOCH; i++)
            Julian -= 365 + (((i % 4) == 0) &&
	            (((i % 100) != 0) || ((i % 400) == 0)));
    }
    Julian *= SECSPERDAY;
    Julian += TclDateTimezone * 60L;
    if ((tod = ToSeconds(Hours, Minutes, Seconds, Meridian)) < 0)
        return -1;
    Julian += tod;
    if (DSTmode == DSTon

/*
 * tclDecls.h --
 *
 *	Declarations of functions in the platform independent public Tcl API.
 *
 * Copyright (c) 1998-1999 by Scriptics Corporation.
 *
 * See the file "license.terms" for information on usage and redistribution
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 *
 * RCS: @(#) $Id: tclDecls.h,v 1.12.2.1 1999/05/20 00:03:36 stanton Exp $
 */

#ifndef _TCLDECLS
#define _TCLDECLS

/*
 * WARNING: This file is automatically generated by the tools/genStubs.tcl

				struct stat * bufPtr));
/* 369 */
EXTERN int		Tcl_UtfNcmp _ANSI_ARGS_((CONST char * s1, 
				CONST char * s2, size_t n));
/* 370 */
EXTERN int		Tcl_UtfNcasecmp _ANSI_ARGS_((CONST char * s1, 
				CONST char * s2, size_t n));
/* 371 */
EXTERN int		Tcl_StringCaseMatch _ANSI_ARGS_((CONST char * str, 
				CONST char * pattern, int nocase));
/* 372 */
EXTERN int		Tcl_UniCharIsControl _ANSI_ARGS_((int ch));
/* 373 */
EXTERN int		Tcl_UniCharIsGraph _ANSI_ARGS_((int ch));
/* 374 */
EXTERN int		Tcl_UniCharIsPrint _ANSI_ARGS_((int ch));
/* 375 */
EXTERN int		Tcl_UniCharIsPunct _ANSI_ARGS_((int ch));

typedef struct TclStubHooks {
    struct TclPlatStubs *tclPlatStubs;
    struct TclIntStubs *tclIntStubs;
    struct TclIntPlatStubs *tclIntPlatStubs;
} TclStubHooks;

    int (*tcl_ParseVarName) _ANSI_ARGS_((Tcl_Interp * interp, char * string, int numBytes, Tcl_Parse * parsePtr, int append)); /* 364 */
    char * (*tcl_GetCwd) _ANSI_ARGS_((Tcl_Interp * interp, Tcl_DString * cwdPtr)); /* 365 */
    int (*tcl_Chdir) _ANSI_ARGS_((CONST char * dirName)); /* 366 */
    int (*tcl_Access) _ANSI_ARGS_((CONST char * path, int mode)); /* 367 */
    int (*tcl_Stat) _ANSI_ARGS_((CONST char * path, struct stat * bufPtr)); /* 368 */
    int (*tcl_UtfNcmp) _ANSI_ARGS_((CONST char * s1, CONST char * s2, size_t n)); /* 369 */
    int (*tcl_UtfNcasecmp) _ANSI_ARGS_((CONST char * s1, CONST char * s2, size_t n)); /* 370 */
    int (*tcl_StringCaseMatch) _ANSI_ARGS_((CONST char * str, CONST char * pattern, int nocase)); /* 371 */
    int (*tcl_UniCharIsControl) _ANSI_ARGS_((int ch)); /* 372 */
    int (*tcl_UniCharIsGraph) _ANSI_ARGS_((int ch)); /* 373 */
    int (*tcl_UniCharIsPrint) _ANSI_ARGS_((int ch)); /* 374 */
    int (*tcl_UniCharIsPunct) _ANSI_ARGS_((int ch)); /* 375 */
} TclStubs;

#ifdef __cplusplus
extern "C" {
#endif
extern TclStubs *tclStubsPtr;
#ifdef __cplusplus

#define Tcl_UtfNcmp \
	(tclStubsPtr->tcl_UtfNcmp) /* 369 */
#endif
#ifndef Tcl_UtfNcasecmp
#define Tcl_UtfNcasecmp \
	(tclStubsPtr->tcl_UtfNcasecmp) /* 370 */
#endif
#ifndef Tcl_StringCaseMatch
#define Tcl_StringCaseMatch \
	(tclStubsPtr->tcl_StringCaseMatch) /* 371 */
#endif
#ifndef Tcl_UniCharIsControl
#define Tcl_UniCharIsControl \
	(tclStubsPtr->tcl_UniCharIsControl) /* 372 */
#endif
#ifndef Tcl_UniCharIsGraph
#define Tcl_UniCharIsGraph \
	(tclStubsPtr->tcl_UniCharIsGraph) /* 373 */
#endif
#ifndef Tcl_UniCharIsPrint
#define Tcl_UniCharIsPrint \
	(tclStubsPtr->tcl_UniCharIsPrint) /* 374 */
#endif
#ifndef Tcl_UniCharIsPunct
#define Tcl_UniCharIsPunct \
	(tclStubsPtr->tcl_UniCharIsPunct) /* 375 */
#endif

#endif /* defined(USE_TCL_STUBS) && !defined(USE_TCL_STUB_PROCS) */

/* !END!: Do not edit above this line. */

#endif /* _TCLDECLS */

/*
 * tclInt.h --
 *
 *	Declarations of things used internally by the Tcl interpreter.
 *
 * Copyright (c) 1987-1993 The Regents of the University of California.
 * Copyright (c) 1993-1997 Lucent Technologies.
 * Copyright (c) 1994-1998 Sun Microsystems, Inc.
 * Copyright (c) 1998-1999 by Scriptics Corporation.
 *
 * See the file "license.terms" for information on usage and redistribution
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 *
 * RCS: @(#) $Id: tclInt.h,v 1.28.2.1 1999/05/14 18:26:10 stanton Exp $
 */

#ifndef _TCLINT
#define _TCLINT

/*
 * Common include files needed by most of the Tcl source files are

				 * by Tcl_AppendResult.	 Malloc-ed.  NULL
				 * means not yet allocated. */
    int appendAvl;		/* Total amount of space available at
				 * partialResult. */
    int appendUsed;		/* Number of non-null bytes currently
				 * stored at partialResult. */





















    /*
     * Information about packages.  Used only in tclPkg.c.
     */

    Tcl_HashTable packageTable;	/* Describes all of the packages loaded
				 * in or available to this interpreter.
				 * Keys are package names, values are

/* 
 * tclRegexp.c --
 *
 *	This file contains the public interfaces to the Tcl regular
 *	expression mechanism.
 *
 * Copyright (c) 1998 by Sun Microsystems, Inc.
 * Copyright (c) 1998-1999 by Scriptics Corporation.
 *
 * See the file "license.terms" for information on usage and redistribution
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 *
 * RCS: @(#) $Id: tclRegexp.c,v 1.2.2.2 1999/05/20 02:38:27 redman Exp $
 */

#include "tclInt.h"
#include "tclPort.h"
#include "tclRegexp.h"

/*

 *
 * *** NOTE: this code has been altered slightly for use in Tcl: ***
 * *** 1. Names have been changed, e.g. from re_comp to		 ***
 * ***    TclRegComp, to avoid clashes with other 		 ***
 * ***    regexp implementations used by applications. 		 ***
 */

/*
 * Thread local storage used to maintain a per-thread cache of compiled
 * regular expressions.
 */

#define NUM_REGEXPS 30

typedef struct ThreadSpecificData {
    int initialized;		/* Set to 1 when the module is initialized. */
    char *patterns[NUM_REGEXPS];/* Strings corresponding to compiled
				 * regular expression patterns.	 NULL
				 * means that this slot isn't used.
				 * Malloc-ed. */
    int patLengths[NUM_REGEXPS];/* Number of non-null characters in
				 * corresponding entry in patterns.
				 * -1 means entry isn't used. */
    struct TclRegexp *regexps[NUM_REGEXPS];
				/* Compiled forms of above strings.  Also
				 * malloc-ed, or NULL if not in use yet. */
} ThreadSpecificData;

static Tcl_ThreadDataKey dataKey;

/*
 * Declarations for functions used only in this file.
 */

static TclRegexp *	CompileRegexp _ANSI_ARGS_((Tcl_Interp *interp,
			    char *pattern, int length, int flags));
static void		DupRegexpInternalRep _ANSI_ARGS_((Tcl_Obj *srcPtr,
			    Tcl_Obj *copyPtr));
static void		FinalizeRegexp _ANSI_ARGS_((ClientData clientData));
static void		FreeRegexp _ANSI_ARGS_((TclRegexp *regexpPtr));
static void		FreeRegexpInternalRep _ANSI_ARGS_((Tcl_Obj *objPtr));
static int		SetRegexpFromAny _ANSI_ARGS_((Tcl_Interp *interp,
			    Tcl_Obj *objPtr));



/*
 * The regular expression Tcl object type.  This serves as a cache
 * of the compiled form of the regular expression.
 */

Tcl_ObjType tclRegexpType = {

 *	Updates the cache of compiled regexps.
 *
 *----------------------------------------------------------------------
 */

Tcl_RegExp
Tcl_RegExpCompile(interp, string)
    Tcl_Interp *interp;		/* For use in error reporting and
				 * to access the interp regexp cache. */
    char *string;		/* String for which to produce
				 * compiled regular expression. */
{




























    return (Tcl_RegExp) CompileRegexp(interp, string, (int) strlen(string),








	    REG_ADVANCED);























}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_RegExpExec --
 *

 *	Updates the native rep of the Tcl_Obj.
 *
 *----------------------------------------------------------------------
 */

Tcl_RegExp
Tcl_GetRegExpFromObj(interp, objPtr, flags)
    Tcl_Interp *interp;		/* For use in error reporting, and to access
				 * the interp regexp cache. */
    Tcl_Obj *objPtr;		/* Object whose string rep contains regular
				 * expression pattern.  Internal rep will be
				 * changed to compiled form of this regular
				 * expression. */
    int flags;			/* Regular expression compilation flags. */
{
    int length;
    Tcl_ObjType *typePtr;
    TclRegexp *regexpPtr;
    char *pattern;

    typePtr = objPtr->typePtr;
    regexpPtr = (TclRegexp *) objPtr->internalRep.otherValuePtr;

    if ((typePtr != &tclRegexpType) || (regexpPtr->flags != flags)) {
	pattern = Tcl_GetStringFromObj(objPtr, &length);

	regexpPtr = CompileRegexp(interp, pattern, length, flags);
	if (regexpPtr == NULL) {
	    return NULL;
	}

	/*
	 * Add a reference to the regexp so it will persist even if it is
	 * pushed out of the current thread's regexp cache.  This reference
	 * will be removed when the object's internal rep is freed.
	 */

	regexpPtr->refCount++;

	/*
	 * Free the old representation and set our type.
	 */

	if ((typePtr != NULL) && (typePtr->freeIntRepProc != NULL)) {
	    (*typePtr->freeIntRepProc)(objPtr);
	}

static void
FreeRegexpInternalRep(objPtr)
    Tcl_Obj *objPtr;		/* Regexp object with internal rep to free. */
{
    TclRegexp *regexpRepPtr = (TclRegexp *) objPtr->internalRep.otherValuePtr;

    /*
     * If this is the last reference to the regexp, free it.
     */

    if (--(regexpRepPtr->refCount) <= 0) {
	FreeRegexp(regexpRepPtr);
    }

}

/*
 *----------------------------------------------------------------------
 *
 * DupRegexpInternalRep --
 *
 *	We copy the reference to the compiled regexp and bump its
 *	reference count.
 *
 * Results:
 *	None.
 *
 * Side effects:
 *	Increments the reference count of the regexp.
 *
 *----------------------------------------------------------------------
 */

static void
DupRegexpInternalRep(srcPtr, copyPtr)
    Tcl_Obj *srcPtr;		/* Object with internal rep to copy. */
    Tcl_Obj *copyPtr;		/* Object with internal rep to set. */
{
    TclRegexp *regexpPtr = (TclRegexp *) srcPtr->internalRep.otherValuePtr;
    regexpPtr->refCount++;
    copyPtr->internalRep.otherValuePtr = srcPtr->internalRep.otherValuePtr;
    copyPtr->typePtr = &tclRegexpType;
}

/*
 *----------------------------------------------------------------------
 *
 * SetRegexpFromAny --
 *
 *	Attempt to generate a compiled regular expression for the Tcl object
 *	"objPtr".
 *
 * Results:
 *	The return value is TCL_OK or TCL_ERROR. If an error occurs during
 *	conversion, an error message is left in the interpreter's result
 *	unless "interp" is NULL.
 *
 * Side effects:
 *	If no error occurs, a regular expression is stored as "objPtr"s
 *	internal representation.
 *
 *----------------------------------------------------------------------
 */

static int
SetRegexpFromAny(interp, objPtr)
    Tcl_Interp *interp;		/* Used for error reporting if not NULL. */
    Tcl_Obj *objPtr;		/* The object to convert. */
{
    if (Tcl_GetRegExpFromObj(interp, objPtr, REG_ADVANCED) == NULL) {
	return TCL_ERROR;
    }
    return TCL_OK;
}

/*
 *---------------------------------------------------------------------------
 *
 * CompileRegexp --
 *
 *	Attempt to compile the given regexp pattern.  If the compiled
 *	regular expression can be found in the per-thread cache, it
 *	will be used instead of compiling a new copy.
 *
 * Results:
 *	The return value is a pointer to a newly allocated TclRegexp
 *	that represents the compiled pattern, or NULL if the pattern
 *	could not be compiled.  If NULL is returned, an error message is
 *	left in the interp's result.
 *
 * Side effects:
 *	The thread-local regexp cache is updated and a new TclRegexp may
 *	be allocated.
 *
 *----------------------------------------------------------------------
 */

static TclRegexp *
CompileRegexp(interp, string, length, flags)
    Tcl_Interp *interp;		/* Used for error reporting if not NULL. */
    char *string;		/* The regexp to compile (UTF-8). */
    int length;			/* The length of the string in bytes. */
    int flags;			/* Compilation flags. */
{
    TclRegexp *regexpPtr;
    Tcl_UniChar *uniString;
    int numChars;
    Tcl_DString stringBuf;
    int status, i;
    ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
 
    if (!tsdPtr->initialized) {
	tsdPtr->initialized = 1;
	Tcl_CreateThreadExitHandler(FinalizeRegexp, NULL);
    }

    /*
     * This routine maintains a second-level regular expression cache in
     * addition to the per-object regexp cache.  The per-thread cache is needed
     * to handle the case where for various reasons the object is lost between
     * invocations of the regexp command, but the literal pattern is the same.
     */

    /*
     * Check the per-thread compiled regexp cache.  We can only reuse
     * a regexp if it has the same pattern and the same flags.
     */

    for (i = 0; (i < NUM_REGEXPS) && (tsdPtr->patterns[i] != NULL); i++) {
	if ((length == tsdPtr->patLengths[i])
		&& (tsdPtr->regexps[i]->flags == flags)
		&& (strcmp(string, tsdPtr->patterns[i]) == 0)) {
	    /*
	     * Move the matched pattern to the first slot in the
	     * cache and shift the other patterns down one position.
	     */

	    if (i != 0) {
		int j;
		char *cachedString;

		cachedString = tsdPtr->patterns[i];
		regexpPtr = tsdPtr->regexps[i];
		for (j = i-1; j >= 0; j--) {
		    tsdPtr->patterns[j+1] = tsdPtr->patterns[j];
		    tsdPtr->patLengths[j+1] = tsdPtr->patLengths[j];
		    tsdPtr->regexps[j+1] = tsdPtr->regexps[j];
		}
		tsdPtr->patterns[0] = cachedString;
		tsdPtr->patLengths[0] = length;
		tsdPtr->regexps[0] = regexpPtr;
	    }
	    return tsdPtr->regexps[0];
	}
    }

    /*
     * This is a new expression, so compile it and add it to the cache.
     */
    
    regexpPtr = (TclRegexp *) ckalloc(sizeof(TclRegexp));

    /*
     * Get the up-to-date string representation and map to unicode.
     */

    Tcl_DStringInit(&stringBuf);

    status = TclReComp(&regexpPtr->re, uniString, (size_t) numChars, flags);
    Tcl_DStringFree(&stringBuf);

    if (status != REG_OKAY) {
	/*
	 * Clean up and report errors in the interpreter, if possible.
	 */

	ckfree((char *)regexpPtr);
	if (interp) {
	    TclRegError(interp,
		    "couldn't compile regular expression pattern: ",
		    status);
	}
	return NULL;
    }

    /*
     * Allocate enough space for all of the subexpressions, plus one
     * extra for the entire pattern.
     */

    regexpPtr->matches = (regmatch_t *) ckalloc(
	    sizeof(regmatch_t) * (regexpPtr->re.re_nsub + 1));

    /*
     * Initialize the refcount to one initially, since it is in the cache.
     */

    regexpPtr->refCount = 1;

    /*
     * Free the last regexp, if necessary, and make room at the head of the
     * list for the new regexp.
     */

    if (tsdPtr->patterns[NUM_REGEXPS-1] != NULL) {
	TclRegexp *oldRegexpPtr = tsdPtr->regexps[NUM_REGEXPS-1];
	if (--(oldRegexpPtr->refCount) <= 0) {
	    FreeRegexp(oldRegexpPtr);
	}
	ckfree(tsdPtr->patterns[NUM_REGEXPS-1]);
    }
    for (i = NUM_REGEXPS - 2; i >= 0; i--) {
	tsdPtr->patterns[i+1] = tsdPtr->patterns[i];
	tsdPtr->patLengths[i+1] = tsdPtr->patLengths[i];
	tsdPtr->regexps[i+1] = tsdPtr->regexps[i];
    }
    tsdPtr->patterns[0] = (char *) ckalloc((unsigned) (length+1));
    strcpy(tsdPtr->patterns[0], string);
    tsdPtr->patLengths[0] = length;
    tsdPtr->regexps[0] = regexpPtr;

    return regexpPtr;
}

/*
 *----------------------------------------------------------------------
 *
 * FreeRegexp --
 *
 *	Release the storage associated with a TclRegexp.
 *
 * Results:
 *	None.
 *
 * Side effects:
 *	None.
 *
 *----------------------------------------------------------------------
 */

static void
FreeRegexp(regexpPtr)
    TclRegexp *regexpPtr;	/* Compiled regular expression to free. */
{
    TclReFree(&regexpPtr->re);
    if (regexpPtr->matches) {
	ckfree((char *) regexpPtr->matches);
    }
    ckfree((char *) regexpPtr);
}

/*
 *----------------------------------------------------------------------
 *
 * FinalizeRegexp --
 *
 *	Release the storage associated with the per-thread regexp
 *	cache.
 *
 * Results:
 *	None.
 *
 * Side effects:
 *	None.
 *
 *----------------------------------------------------------------------
 */

static void
FinalizeRegexp(clientData)
    ClientData clientData;	/* Not used. */
{
    int i;
    TclRegexp *regexpPtr;
    ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);

    for (i = 0; (i < NUM_REGEXPS) && (tsdPtr->patterns[i] != NULL); i++) {
	regexpPtr = tsdPtr->regexps[i];
	if (--(regexpPtr->refCount) <= 0) {
	    FreeRegexp(regexpPtr);
	}
	ckfree(tsdPtr->patterns[i]);
    }
}

 * 
 * Copyright (c) 1998 by Sun Microsystems, Inc.
 * Copyright (c) 1998-1999 by Scriptics Corporation.
 *
 * See the file "license.terms" for information on usage and redistribution
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 *
 * RCS: @(#) $Id: tclRegexp.h,v 1.5.2.1 1999/05/14 18:26:12 stanton Exp $
 */

#ifndef _TCLREGEXP
#define _TCLREGEXP

#include "regex.h"

				 * (UTF-8), so Tcl_RegExpRange() can convert
				 * the matches from character indices to UTF-8
				 * byte offsets. */
    regmatch_t *matches;	/* Array of indices into the Tcl_UniChar
				 * representation of the last string matched
				 * with this regexp to indicate the location
				 * of subexpressions. */
    int refCount;		/* Count of number of references to this
				 * compiled regexp. */
} TclRegexp;

/*
 * Functions exported for use within the rest of Tcl.
 */

EXTERN int		TclRegAbout _ANSI_ARGS_((Tcl_Interp *interp,

/* 
 * tclStubInit.c --
 *
 *	This file contains the initializers for the Tcl stub vectors.
 *
 * Copyright (c) 1998-1999 by Scriptics Corporation.
 *
 * See the file "license.terms" for information on usage and redistribution
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 *
 * RCS: @(#) $Id: tclStubInit.c,v 1.13.2.1 1999/05/20 00:03:37 stanton Exp $
 */

#include "tclInt.h"
#include "tclPort.h"

/*
 * Remove macros that will interfere with the definitions below.

    Tcl_ParseVarName, /* 364 */
    Tcl_GetCwd, /* 365 */
    Tcl_Chdir, /* 366 */
    Tcl_Access, /* 367 */
    Tcl_Stat, /* 368 */
    Tcl_UtfNcmp, /* 369 */
    Tcl_UtfNcasecmp, /* 370 */
    Tcl_StringCaseMatch, /* 371 */
    Tcl_UniCharIsControl, /* 372 */
    Tcl_UniCharIsGraph, /* 373 */
    Tcl_UniCharIsPrint, /* 374 */
    Tcl_UniCharIsPunct, /* 375 */
};

/* !END!: Do not edit above this line. */

/*
 * tclUtf.c --
 *
 *	Routines for manipulating UTF-8 strings.
 *
 * Copyright (c) 1997-1998 Sun Microsystems, Inc.
 *
 * See the file "license.terms" for information on usage and redistribution
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 *
 * RCS: @(#) $Id: tclUtf.c,v 1.5.2.1 1999/05/20 00:03:38 stanton Exp $
 */

#include "tclInt.h"

/*
 * Include the static character classification tables and macros.
 */

#define DIGIT_BITS (1 << DECIMAL_DIGIT_NUMBER)

#define SPACE_BITS ((1 << SPACE_SEPARATOR) | (1 << LINE_SEPARATOR) \
    | (1 << PARAGRAPH_SEPARATOR))

#define CONNECTOR_BITS (1 << CONNECTOR_PUNCTUATION)

#define PRINT_BITS (ALPHA_BITS | DIGIT_BITS | SPACE_BITS | \
	    (1 << NON_SPACING_MARK) | (1 << ENCLOSING_MARK) | \
	    (1 << COMBINING_SPACING_MARK) | (1 << LETTER_NUMBER) | \
	    (1 << OTHER_NUMBER) | (1 << CONNECTOR_PUNCTUATION) | \
	    (1 << DASH_PUNCTUATION) | (1 << OPEN_PUNCTUATION) | \
	    (1 << CLOSE_PUNCTUATION) | (1 << INITIAL_QUOTE_PUNCTUATION) | \
	    (1 << FINAL_QUOTE_PUNCTUATION) | (1 << OTHER_PUNCTUATION) | \
	    (1 << MATH_SYMBOL) | (1 << CURRENCY_SYMBOL) | \
	    (1 << MODIFIER_SYMBOL) | (1 << OTHER_SYMBOL))

/*
 * Unicode characters less than this value are represented by themselves 
 * in UTF-8 strings. 
 */

#define UNICODE_SELF	0x80

    register int category = (GetUniCharInfo(ch) & UNICODE_CATEGORY_MASK);
    return ((ALPHA_BITS >> category) & 1);
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_UniCharIsControl --
 *
 *	Test if a character is a Unicode control character.
 *
 * Results:
 *	Returns non-zero if character is a control.
 *
 * Side effects:
 *	None.
 *
 *----------------------------------------------------------------------
 */

int
Tcl_UniCharIsControl(ch)
    int ch;			/* Unicode character to test. */
{
    return ((GetUniCharInfo(ch) & UNICODE_CATEGORY_MASK) == CONTROL);
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_UniCharIsDigit --
 *
 *	Test if a character is a numeric Unicode character.
 *
 * Results:
 *	Returns non-zero if character is a digit.
 *

    return ((GetUniCharInfo(ch) & UNICODE_CATEGORY_MASK)
	    == DECIMAL_DIGIT_NUMBER);
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_UniCharIsGraph --
 *
 *	Test if a character is any Unicode print character except space.
 *
 * Results:
 *	Returns non-zero if character is printable, but not space.
 *
 * Side effects:
 *	None.
 *
 *----------------------------------------------------------------------
 */

int
Tcl_UniCharIsGraph(ch)
    int ch;			/* Unicode character to test. */
{
    register int category = (GetUniCharInfo(ch) & UNICODE_CATEGORY_MASK);
    return (((PRINT_BITS >> category) & 1) && ((unsigned char) ch != ' '));
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_UniCharIsLower --
 *
 *	Test if a character is a lowercase Unicode character.
 *
 * Results:
 *	Returns non-zero if character is lowercase.
 *
 * Side effects:
 *	None.
 *
 *----------------------------------------------------------------------
 */

int
Tcl_UniCharIsLower(ch)
    int ch;			/* Unicode character to test. */
{
    return ((GetUniCharInfo(ch) & UNICODE_CATEGORY_MASK) == LOWERCASE_LETTER);
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_UniCharIsPrint --
 *
 *	Test if a character is a Unicode print character.
 *
 * Results:
 *	Returns non-zero if character is printable.
 *
 * Side effects:
 *	None.
 *
 *----------------------------------------------------------------------
 */

int
Tcl_UniCharIsPrint(ch)
    int ch;			/* Unicode character to test. */
{
    register int category = (GetUniCharInfo(ch) & UNICODE_CATEGORY_MASK);
    return ((PRINT_BITS >> category) & 1);
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_UniCharIsPunct --
 *
 *	Test if for any printing char that is neither space or an alnum.
 *
 * Results:
 *	Returns non-zero if character is punct.
 *
 * Side effects:
 *	None.
 *
 *----------------------------------------------------------------------
 */

int
Tcl_UniCharIsPunct(ch)
    int ch;			/* Unicode character to test. */
{
    register int category = (GetUniCharInfo(ch) & UNICODE_CATEGORY_MASK);
    return (((PRINT_BITS >> category) & 1) && ((unsigned char) ch != ' ')
	    && !(((ALPHA_BITS | DIGIT_BITS) >> category) & 1));
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_UniCharIsSpace --
 *
 *	Test if a character is a whitespace Unicode character.

/* 
 * tclUtil.c --
 *
 *	This file contains utility procedures that are used by many Tcl
 *	commands.
 *
 * Copyright (c) 1987-1993 The Regents of the University of California.
 * Copyright (c) 1994-1998 Sun Microsystems, Inc.
 *
 * See the file "license.terms" for information on usage and redistribution
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 *
 *  RCS: @(#) $Id: tclUtil.c,v 1.11.2.1 1999/05/20 00:03:38 stanton Exp $
 */

#include "tclInt.h"
#include "tclPort.h"

/*
 * The following variable holds the full path name of the binary

	if (s != p) {
	    return 0;
	}
	pattern++;
	string++;
    }
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_StringCaseMatch --
 *
 *	See if a particular string matches a particular pattern.
 *	Allows case insensitivity.
 *
 * Results:
 *	The return value is 1 if string matches pattern, and
 *	0 otherwise.  The matching operation permits the following
 *	special characters in the pattern: *?\[] (see the manual
 *	entry for details on what these mean).
 *
 * Side effects:
 *	None.
 *
 *----------------------------------------------------------------------
 */

int
Tcl_StringCaseMatch(string, pattern, nocase)
    CONST char *string;		/* String. */
    CONST char *pattern;	/* Pattern, which may contain special
				 * characters. */
    int nocase;			/* 0 for case sensitive, 1 for insensitive */
{
    int p, s;
    CONST char *pstart = pattern;
    Tcl_UniChar ch1, ch2;
    
    while (1) {
	p = *pattern;
	s = *string;
	
	/*
	 * See if we're at the end of both the pattern and the string.  If
	 * so, we succeeded.  If we're at the end of the pattern but not at
	 * the end of the string, we failed.
	 */
	
	if (p == '\0') {
	    return (s == '\0');
	}
	if ((s == '\0') && (p != '*')) {
	    return 0;
	}

	/* Check for a "*" as the next pattern character.  It matches
	 * any substring.  We handle this by calling ourselves
	 * recursively for each postfix of string, until either we
	 * match or we reach the end of the string.
	 */
	
	if (p == '*') {
	    pattern++;
	    if (*pattern == '\0') {
		return 1;
	    }
	    while (1) {
		if (Tcl_StringCaseMatch(string, pattern, nocase)) {
		    return 1;
		}
		if (*string == '\0') {
		    return 0;
		}
		string++;
	    }
	}

	/* Check for a "?" as the next pattern character.  It matches
	 * any single character.
	 */

	if (p == '?') {
	    pattern++;
	    string += Tcl_UtfToUniChar(string, &ch1);
	    continue;
	}

	/* Check for a "[" as the next pattern character.  It is followed
	 * by a list of characters that are acceptable, or by a range
	 * (two characters separated by "-").
	 */
	
	if (p == '[') {
	    Tcl_UniChar startChar, endChar;

	    pattern++;
	    string += Tcl_UtfToUniChar(string, &ch1);
	    if (nocase) {
		ch1 = Tcl_UniCharToLower(ch1);
	    }
	    while (1) {
		if ((*pattern == ']') || (*pattern == '\0')) {
		    return 0;
		}
		pattern += Tcl_UtfToUniChar(pattern, &startChar);
		if (nocase) {
		    startChar = Tcl_UniCharToLower(startChar);
		}
		if (*pattern == '-') {
		    pattern++;
		    if (*pattern == '\0') {
			return 0;
		    }
		    pattern += Tcl_UtfToUniChar(pattern, &endChar);
		    if (nocase) {
			endChar = Tcl_UniCharToLower(endChar);
		    }
		    if (((startChar <= ch1) && (ch1 <= endChar))
			    || ((endChar <= ch1) && (ch1 <= startChar))) {
			/*
			 * Matches ranges of form [a-z] or [z-a].
			 */

			break;
		    }
		} else if (startChar == ch1) {
		    break;
		}
	    }
	    while (*pattern != ']') {
		if (*pattern == '\0') {
		    pattern = Tcl_UtfPrev(pattern, pstart);
		    break;
		}
		pattern++;
	    }
	    pattern++;
	    continue;
	}
    
	/* If the next pattern character is '\', just strip off the '\'
	 * so we do exact matching on the character that follows.
	 */
	
	if (p == '\\') {
	    pattern++;
	    p = *pattern;
	    if (p == '\0') {
		return 0;
	    }
	}

	/* There's no special character.  Just make sure that the next
	 * bytes of each string match.
	 */
	
	string  += Tcl_UtfToUniChar(string, &ch1);
	pattern += Tcl_UtfToUniChar(pattern, &ch2);
	if (nocase) {
	    if (Tcl_UniCharToLower(ch1) != Tcl_UniCharToLower(ch2)) {
		return 0;
	    }
	} else if (ch1 != ch2) {
	    return 0;
	}
    }
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_DStringInit --
 *
 *	Initializes a dynamic string, discarding any previous contents

# init.tcl --
#
# Default system startup file for Tcl-based applications.  Defines
# "unknown" procedure and auto-load facilities.
#
# RCS: @(#) $Id: init.tcl,v 1.29.2.1 1999/05/21 00:04:29 redman Exp $
#
# Copyright (c) 1991-1993 The Regents of the University of California.
# Copyright (c) 1994-1996 Sun Microsystems, Inc.
# Copyright (c) 1998-1999 Scriptics Corporation.
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.

#
# tcl_library, which is the directory containing this init.tcl script.
# tclInitScript.h searches around for the directory containing this
# init.tcl and defines tcl_library to that location before sourcing it.
#
# The parent directory of tcl_library. Adding the parent
# means that packages in peer directories will be found automatically.
#
# Also add the directory where the executable is located, plus ../lib
# relative to that path.
#
# tcl_pkgPath, which is set by the platform-specific initialization routines
#	On UNIX it is compiled in
#       On Windows, it is not used
#	On Macintosh it is "Tool Command Language" in the Extensions folder

if {![info exists auto_path]} {
    if {[info exist env(TCLLIBPATH)]} {
	set auto_path $env(TCLLIBPATH)
    } else {
	set auto_path ""
    }
}
if {[string compare [info library] {}]} {
    foreach __dir [list [info library] [file dirname [info library]]] {
	if {[lsearch -exact $auto_path $__dir] < 0} {
	    lappend auto_path $__dir
	}
    }
}
foreach __dir [list [file dirname [info nameofexecutable]] \
	[file join [file dirname [file dirname \
	[info nameofexecutable]]] lib]] {
    if {[lsearch -exact $auto_path $__dir] < 0} {
	lappend auto_path $__dir
    }
}
if {[info exist tcl_pkgPath]} {
    foreach __dir $tcl_pkgPath {
	if {[lsearch -exact $auto_path $__dir] < 0} {
	    lappend auto_path $__dir
	}
    }

# The file tests the tclCmdAH.c file.
#
# This file contains a collection of tests for one or more of the Tcl
# built-in commands.  Sourcing this file into Tcl runs the tests and
# generates output for errors.  No output means no errors were found.
#
# Copyright (c) 1996-1998 by Sun Microsystems, Inc.
# Copyright (c) 1998-1999 by Scriptics Corporation.
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
#
# RCS: @(#) $Id: cmdAH.test,v 1.5.2.1 1999/05/14 22:18:06 stanton Exp $

if {[lsearch [namespace children] ::tcltest] == -1} {
    source [file join [pwd] [file dirname [info script]] defs.tcl]
}

global env
set cmdAHwd [pwd]

} link
test cmdAH-29.5 {Tcl_FileObjCmd: type} {
    string tolower [list [catch {file type _bogus_} msg] $msg $errorCode]
} {1 {could not read "_bogus_": no such file or directory} {posix enoent {no such file or directory}}}

# Error conditions

test cmdAH-30.1 {Tcl_FileObjCmd: error conditions} {
    list [catch {file gorp x} msg] $msg
} {1 {bad option "gorp": must be atime, attributes, copy, delete, dirname, executable, exists, extension, isdirectory, isfile, join, lstat, mtime, mkdir, nativename, owned, pathtype, readable, readlink, rename, rootname, size, split, stat, tail, type, volumes, or writable}}
test cmdAH-30.2 {Tcl_FileObjCmd: error conditions} {
    list [catch {file ex x} msg] $msg
} {1 {ambiguous option "ex": must be atime, attributes, copy, delete, dirname, executable, exists, extension, isdirectory, isfile, join, lstat, mtime, mkdir, nativename, owned, pathtype, readable, readlink, rename, rootname, size, split, stat, tail, type, volumes, or writable}}
test cmdAH-30.3 {Tcl_FileObjCmd: error conditions} {
    list [catch {file is x} msg] $msg
} {1 {ambiguous option "is": must be atime, attributes, copy, delete, dirname, executable, exists, extension, isdirectory, isfile, join, lstat, mtime, mkdir, nativename, owned, pathtype, readable, readlink, rename, rootname, size, split, stat, tail, type, volumes, or writable}}
test cmdAH-30.4 {Tcl_FileObjCmd: error conditions} {
    list [catch {file z x} msg] $msg
} {1 {bad option "z": must be atime, attributes, copy, delete, dirname, executable, exists, extension, isdirectory, isfile, join, lstat, mtime, mkdir, nativename, owned, pathtype, readable, readlink, rename, rootname, size, split, stat, tail, type, volumes, or writable}}
test cmdAH-30.5 {Tcl_FileObjCmd: error conditions} {
    list [catch {file read x} msg] $msg
} {1 {ambiguous option "read": must be atime, attributes, copy, delete, dirname, executable, exists, extension, isdirectory, isfile, join, lstat, mtime, mkdir, nativename, owned, pathtype, readable, readlink, rename, rootname, size, split, stat, tail, type, volumes, or writable}}
test cmdAH-30.6 {Tcl_FileObjCmd: error conditions} {
    list [catch {file s x} msg] $msg
} {1 {ambiguous option "s": must be atime, attributes, copy, delete, dirname, executable, exists, extension, isdirectory, isfile, join, lstat, mtime, mkdir, nativename, owned, pathtype, readable, readlink, rename, rootname, size, split, stat, tail, type, volumes, or writable}}
test cmdAH-30.7 {Tcl_FileObjCmd: error conditions} {
    list [catch {file t x} msg] $msg
} {1 {ambiguous option "t": must be atime, attributes, copy, delete, dirname, executable, exists, extension, isdirectory, isfile, join, lstat, mtime, mkdir, nativename, owned, pathtype, readable, readlink, rename, rootname, size, split, stat, tail, type, volumes, or writable}}
test cmdAH-30.8 {Tcl_FileObjCmd: error conditions} {
    list [catch {file dirname ~woohgy} msg] $msg
} {1 {user "woohgy" doesn't exist}}

# cleanup
catch {testsetplatform $platform}
catch {unset platform}

# Tcl_ForObjCmd is tested in for.test

catch {exec chmod 777 dir.file}
file delete -force dir.file
file delete gorp.file
file delete link.file

cd $cmdAHwd

# Commands covered:  for, continue, break
#
# This file contains a collection of tests for one or more of the Tcl
# built-in commands.  Sourcing this file into Tcl runs the tests and
# generates output for errors.  No output means no errors were found.
#
# Copyright (c) 1996 Sun Microsystems, Inc.
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
#
# RCS: @(#) $Id: for.test,v 1.3.2.1 1999/05/14 22:18:06 stanton Exp $

if {[lsearch [namespace children] ::tcltest] == -1} {
    source [file join [pwd] [file dirname [info script]] defs.tcl]
}

# Basic "for" operation.

        if [string match GLOBTESTDIR/dir2/* $z] {
            break
        }
    } j
    set j
} {}

# Test for incorrect "double evaluation" semantics

test for-5.1 {possible delayed substitution of increment command} {knownBug} {
    # Increment should be 5, and lappend should always append 5
    catch {unset a}
    catch {unset i}
    set a 5
    set i {}
    for {set a 1} {$a < 12} "incr a $a" {lappend i $a}
    set i
} {1 6 11}

test for-5.2 {possible delayed substitution of body command} {knownBug} {
    # Increment should be 5, and lappend should always append 5
    set a 5
    set i {}
    for {set a 1} {$a < 12} {incr a $a} "lappend i $a"
    set i
} {5 5 5 5}

# In the following tests we need to bypass the bytecode compiler by
# substituting the command from a variable.  This ensures that command
# procedure is invoked directly.


test for-6.1 {Tcl_ForObjCmd: number of args} {
    set z for
    catch {$z} msg
    set msg
} {wrong # args: should be "for start test next command"}
test for-6.2 {Tcl_ForObjCmd: number of args} {
    set z for
    catch {$z {set i 0}} msg
    set msg
} {wrong # args: should be "for start test next command"}



test for-6.3 {Tcl_ForObjCmd: number of args} {




    set z for
    catch {$z {set i 0} {$i < 5}} msg
    set msg
} {wrong # args: should be "for start test next command"}
test for-6.4 {Tcl_ForObjCmd: number of args} {
    set z for
    catch {$z {set i 0} {$i < 5} {incr i}} msg
    set msg
} {wrong # args: should be "for start test next command"}
test for-6.5 {Tcl_ForObjCmd: number of args} {
    set z for
    catch {$z {set i 0} {$i < 5} {incr i} {body} extra} msg
    set msg
} {wrong # args: should be "for start test next command"}
test for-6.6 {Tcl_ForObjCmd: error in initial command} {
    set z for
    list [catch {$z {set} {$i < 5} {incr i} {body}} msg] $msg $errorInfo
} {1 {wrong # args: should be "set varName ?newValue?"} {wrong # args: should be "set varName ?newValue?"
    while compiling
"set"
    ("for" initial command)
    invoked from within
"$z {set} {$i < 5} {incr i} {body}"}}
test for-6.7 {Tcl_ForObjCmd: error in test expression} {
    set z for
    list [catch {$z {set i 0} {i < 5} {incr i} {body}} msg] $msg $errorInfo
} {1 {syntax error in expression "i < 5"} {syntax error in expression "i < 5"
    while executing
"$z {set i 0} {i < 5} {incr i} {body}"}}
test for-6.8 {Tcl_ForObjCmd: test expression is enclosed in quotes} {
    set z for
    set i 0
    $z {set i 6} "$i > 5" {incr i} {set y $i}
    set i
} 6
test for-6.9 {Tcl_ForObjCmd: error executing command body} {
    set z for
    catch {$z {set i 0} {$i < 5} {incr i} {set}} msg
    set errorInfo
} {wrong # args: should be "set varName ?newValue?"
    while compiling
"set"
    ("for" body line 1)
    invoked from within
"$z {set i 0} {$i < 5} {incr i} {set}"}
test for-6.10 {Tcl_ForObjCmd: simple command body} {
    set z for
    set a {}
    $z {set i 1} {$i<6} {set i [expr $i+1]} {
	if $i==4 break
	set a [concat $a $i]
    }
    set a
} {1 2 3}
test for-6.11 {Tcl_ForObjCmd: command body in quotes} {
    set z for
    set a {}
    $z {set i 1} {$i<6} {set i [expr $i+1]} "append a x"
    set a
} {xxxxx}
test for-6.12 {Tcl_ForObjCmd: computed command body} {
    set z for
    catch {unset x1}
    catch {unset bb}
    catch {unset x2}
    set x1 {append a x1; }
    set bb {break}
    set x2 {; append a x2}
    set a {}
    $z {set i 1} {$i<6} {set i [expr $i+1]} $x1$bb$x2
    set a
} {x1}
test for-6.13 {Tcl_ForObjCmd: error in "next" command} {
    set z for
    catch {$z {set i 0} {$i < 5} {set} {set j 4}} msg
    set errorInfo
} {wrong # args: should be "set varName ?newValue?"
    while compiling
"set"
    ("for" loop-end command)
    invoked from within
"$z {set i 0} {$i < 5} {set} {set j 4}"}
test for-6.14 {Tcl_ForObjCmd: long command body} {
    set z for
    set a {}
    $z {set i 1} {$i<6} {set i [expr $i+1]} {
	if $i==4 break
	if $i>5 continue
	if {$i>6 && $tcl_platform(machine)=="xxx"} {
	    catch {set a $a} msg

	    catch {incr i 5} msg
	    catch {incr i -5} msg
	}
	set a [concat $a $i]
    }
    set a
} {1 2 3}
test for-6.15 {Tcl_ForObjCmd: for command result} {
    set z for
    set a [$z {set i 0} {$i < 5} {incr i} {}]
    set a
} {}
test for-6.16 {Tcl_ForObjCmd: for command result} {
    set z for
    set a [$z {set i 0} {$i < 5} {incr i} {if $i==3 break}]
    set a
} {}





















# cleanup
::tcltest::cleanupTests
return

# Commands covered:  regexp, regsub
#
# This file contains a collection of tests for one or more of the Tcl
# built-in commands.  Sourcing this file into Tcl runs the tests and
# generates output for errors.  No output means no errors were found.
#
# Copyright (c) 1991-1993 The Regents of the University of California.
# Copyright (c) 1998 Sun Microsystems, Inc.
# Copyright (c) 1998-1999 by Scriptics Corporation.
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
#
# RCS: @(#) $Id: regexp.test,v 1.3.2.2 1999/05/20 02:53:54 stanton Exp $

if {[lsearch [namespace children] ::tcltest] == -1} {
    source [file join [pwd] [file dirname [info script]] defs.tcl]
}

catch {unset foo}
test regexp-1.1 {basic regexp operation} {

	append filedata $line
    }
    for {set i 1} {$i<10} {incr i} {
	regsub -all "BEGIN_TABLE " $filedata "" newfiledata
    }
    set x done
} {done}

test regexp-13.1 {CompileRegexp: regexp cache} {
    regexp .*a b
    regexp .*b c
    regexp .*c d
    regexp .*d e
    regexp .*e f
    set x .
    append x *a
    regexp $x bbba
} 1
test regexp-13.2 {CompileRegexp: regexp cache, different flags} {
    regexp .*a b
    regexp .*b c
    regexp .*c d
    regexp .*d e
    regexp .*e f
    set x .
    append x *a
    regexp -nocase $x bbba
} 1
test regexp-13.3 {CompileRegexp: regexp cache, empty regexp and empty cache} {
    makeFile {puts [regexp {} foo]} junk.tcl
    exec $tcltest junk.tcl
} 1

set x 1
set y 2
regexp "$x$y" 123
    

# cleanup
::tcltest::cleanupTests
return

# Commands covered:  string
#
# This file contains a collection of tests for one or more of the Tcl
# built-in commands.  Sourcing this file into Tcl runs the tests and
# generates output for errors.  No output means no errors were found.
#
# Copyright (c) 1991-1993 The Regents of the University of California.
# Copyright (c) 1994 Sun Microsystems, Inc.
# Copyright (c) 1998-1999 by Scriptics Corporation.
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
#
# RCS: @(#) $Id: string.test,v 1.9.2.1 1999/05/20 00:03:38 stanton Exp $

if {[lsearch [namespace children] ::tcltest] == -1} {
    source [file join [pwd] [file dirname [info script]] defs.tcl]
}

test string-1.1 {error conditions} {
    list [catch {string gorp a b} msg] $msg

test string-3.7 {string equal -nocase} {
    string equal -nocase abcde abcde
} 1
test string-3.8 {string equal with length, unequal strings} {
    string equal -length 2 abc abde
} 1

test string-4.1 {string first, too few args} {
    list [catch {string first a} msg] $msg
} {1 {wrong # args: should be "string first string1 string2 ?startIndex?"}}
test string-4.2 {string first, bad args} {
    list [catch {string first a b c} msg] $msg
} {1 {bad index "c": must be integer or end?-integer?}}
test string-4.3 {string first, too many args} {
    list [catch {string first a b 5 d} msg] $msg
} {1 {wrong # args: should be "string first string1 string2 ?startIndex?"}}
test string-4.4 {string first} {
    string first bq abcdefgbcefgbqrs
} 12
test string-4.5 {string first} {
    string fir bcd abcdefgbcefgbqrs
} 1
test string-4.6 {string first} {
    string f b abcdefgbcefgbqrs
} 1
test string-4.7 {string first} {
    string first xxx x123xx345xxx789xxx012
} 9
test string-4.8 {string first} {
    string first "" x123xx345xxx789xxx012
} -1
test string-4.9 {string first, unicode} {
    string first x abc\u7266x
} 4
test string-4.10 {string first, unicode} {
    string first \u7266 abc\u7266x
} 3
test string-4.11 {string first, start index} {
    string first \u7266 abc\u7266x 3
} 3
test string-4.12 {string first, start index} {
    string first \u7266 abc\u7266x 4
} -1
test string-4.13 {string first, start index} {
    string first \u7266 abc\u7266x end-2
} 3
test string-4.14 {string first, start index} {
    string first a abcabc end-4
} 3

test string-5.1 {string index} {
    list [catch {string index} msg] $msg
} {1 {wrong # args: should be "string index string charIndex"}}
test string-5.2 {string index} {
    list [catch {string index a b c} msg] $msg

} b
test string-5.10 {string index, unicode} {
    string index abc\u7266d 4
} d
test string-5.11 {string index, unicode} {
    string index abc\u7266d 3
} \u7266
test string-5.12 {string index, unicode over char length, under byte length} {
    string index \334\374\334\374 6
} {}

test string-6.1 {string is, too few args} {
    list [catch {string is} msg] $msg
} {1 {wrong # args: should be "string is class ?-strict? ?-failindex var? str"}}
test string-6.2 {string is, too few args} {
    list [catch {string is alpha} msg] $msg
} {1 {wrong # args: should be "string is class ?-strict? ?-failindex var? str"}}
test string-6.3 {string is, bad args} {
    list [catch {string is alpha -failin str} msg] $msg
} {1 {wrong # args: should be "string is alpha ?-strict? ?-failindex var? str"}}
test string-6.4 {string is, too many args} {
    list [catch {string is alpha -failin var -strict str more} msg] $msg
} {1 {wrong # args: should be "string is class ?-strict? ?-failindex var? str"}}
test string-6.5 {string is, class check} {
    list [catch {string is bogus str} msg] $msg
} {1 {bad class "bogus": must be alnum, alpha, ascii, control, boolean, digit, double, false, graph, integer, lower, print, punct, space, true, upper, wordchar, or xdigit}}
test string-6.6 {string is, ambiguous class} {
    list [catch {string is al str} msg] $msg
} {1 {ambiguous class "al": must be alnum, alpha, ascii, control, boolean, digit, double, false, graph, integer, lower, print, punct, space, true, upper, wordchar, or xdigit}}
test string-6.7 {string is alpha, all ok} {
    string is alpha -strict -failindex var abc
} 1
test string-6.8 {string is, error in var} {
    list [string is alpha -failindex var abc5def] $var
} {0 3}
test string-6.9 {string is, var shouldn't get set} {

} 1
test string-6.82 {string is wordchar, false} {
    list [string is wordchar -fail var abcd.ef] $var
} {0 4}
test string-6.83 {string is wordchar, unicode false} {
    list [string is wordchar -fail var abc\u0080def] $var
} {0 3}
test string-6.84 {string is control} {
    ## Control chars are in the ranges
    ## 00..1F && 7F..9F
    list [string is control -fail var \x00\x01\x10\x1F\x7F\x80\x9F\x60] $var
} {0 7}
test string-6.85 {string is control} {
    string is control \u0100
} 0
test string-6.86 {string is graph} {
    ## graph is any print char, except space
    list [string is gra -fail var "0123abc!@#\$\u0100 "] $var
} {0 12}
test string-6.87 {string is print} {
    ## basically any printable char
    list [string is print -fail var "0123abc!@#\$\u0100 \u0010"] $var
} {0 13}
test string-6.88 {string is punct} {
    ## any graph char that isn't alnum
    list [string is punct -fail var "_=!@#\$\u00beq0"] $var
} {0 7}
test string-6.89 {string is xdigit} {
    list [string is xdigit -fail var 0123456789\u0061bcdefABCDEFg] $var
} {0 22}

test string-7.1 {string last, too few args} {
    list [catch {string last a} msg] $msg
} {1 {wrong # args: should be "string last string1 string2 ?startIndex?"}}
test string-7.2 {string last, bad args} {
    list [catch {string last a b c} msg] $msg
} {1 {bad index "c": must be integer or end?-integer?}}
test string-7.3 {string last, too many args} {
    list [catch {string last a b c d} msg] $msg
} {1 {wrong # args: should be "string last string1 string2 ?startIndex?"}}
test string-7.4 {string last} {
    string la xxx xxxx123xx345x678
} 1
test string-7.5 {string last} {
    string last xx xxxx123xx345x678
} 7
test string-7.6 {string last} {
    string las x xxxx123xx345x678
} 12
test string-7.7 {string last, unicode} {
    string las x xxxx12\u7266xx345x678
} 12
test string-7.8 {string last, unicode} {
    string las \u7266 xxxx12\u7266xx345x678
} 6
test string-7.9 {string last, stop index} {
    string las \u7266 xxxx12\u7266xx345x678
} 6
test string-7.10 {string last, unicode} {
    string las \u7266 xxxx12\u7266xx345x678
} 6
test string-7.11 {string last, start index} {
    string last \u7266 abc\u7266x 3
} 3
test string-7.12 {string last, start index} {
    string last \u7266 abc\u7266x 2
} -1
test string-7.13 {string last, start index} {
    ## Constrain to last 'a' should work
    string last ba badbad end-1
} 3
test string-7.14 {string last, start index} {
    ## Constrain to last 'b' should skip last 'ba'
    string last ba badbad end-2
} 0
test string-7.15 {string last, start index} {
    string last \334a \334ad\334ad 0
} -1
test string-7.16 {string last, start index} {
    string last \334a \334ad\334ad end-1
} 3

test string-8.1 {string bytelength} {
    list [catch {string bytelength} msg] $msg
} {1 {wrong # args: should be "string bytelength string"}}
test string-8.2 {string bytelength} {
    list [catch {string bytelength a b} msg] $msg
} {1 {wrong # args: should be "string bytelength string"}}
test string-8.3 {string bytelength} {
    string bytelength "\u00c7"
} 2
test string-8.4 {string bytelength} {
    string b ""
} 0

test string-9.1 {string length} {
    list [catch {string length} msg] $msg
} {1 {wrong # args: should be "string length string"}}
test string-9.2 {string length} {

test string-10.12 {string map, unicode} {
    string map [list \374 ue UE \334] "a\374ueUE\000EU"
} aueue\334\0EU
test string-10.13 {string map, -nocase unicode} {
    string map -nocase [list \374 ue UE \334] "a\374ueUE\000EU"
} aue\334\334\0EU

test string-11.1 {string match, too few args} {
    list [catch {string match a} msg] $msg
} {1 {wrong # args: should be "string match ?-nocase? pattern string"}}
test string-11.2 {string match, too many args} {
    list [catch {string match a b c d} msg] $msg
} {1 {wrong # args: should be "string match ?-nocase? pattern string"}}
test string-11.3 {string match} {
    string match abc abc
} 1
test string-11.4 {string match} {
    string mat abc abd
} 0
test string-11.5 {string match} {

    string match *. ""
} 0
test string-11.28 {string match} {
    string match "" ""
} 1
test string-11.29 {string match} {
    string match \[a a
} 1
test string-11.30 {string match, bad args} {
    list [catch {string match - b c} msg] $msg
} {1 {bad option "-": must be -nocase}}
test string-11.31 {string match case} {
    string match a A
} 0
test string-11.32 {string match nocase} {
    string match -n a A
} 1
test string-11.33 {string match nocase} {
    string match -nocase a\334 A\374
} 1
test string-11.34 {string match nocase} {
    string match -nocase a*f ABCDEf
} 1
test string-11.35 {string match case, false hope} {
    # This is true because '_' lies between the A-Z and a-z ranges
    string match {[A-z]} _
} 1
test string-11.36 {string match nocase range} {
    # This is false because although '_' lies between the A-Z and a-z ranges,
    # we lower case the end points before checking the ranges.
    string match -nocase {[A-z]} _
} 0
test string-11.37 {string match nocase} {
    string match -nocase {[A-fh-Z]} g
} 0
test string-11.38 {string match case, reverse range} {
    string match {[A-fh-Z]} g
} 1

test string-12.1 {string range} {
    list [catch {string range} msg] $msg
} {1 {wrong # args: should be "string range string first last"}}
test string-12.2 {string range} {
    list [catch {string range a 1} msg] $msg

# This makefile is used to convert Tcl manual pages into various
# alternate formats:
#
#    Windows help file:  1. Build the winhelp target on Unix
#			 2. Build the helpfile target on Windows
#
#    HTML:		 1. Build the html target on Unix

# RCS: @(#) $Id: Makefile.in,v 1.7.6.1 1999/05/20 03:28:09 stanton Exp $

TCL = tcl@TCL_VERSION@
TK = tk@TCL_VERSION@
VER=@TCL_WIN_VERSION@

TCL_BIN_DIR = @TCL_BIN_DIR@
TCL_SOURCE = @TCL_SRC_DIR@
TK_SOURCE = $(TCL_SOURCE)/../$(TK)
PRO_SOURCE = $(TCL_SOURCE)/../pro
ITCL_SOURCE = $(TCL_SOURCE)/../itcl3.0.1

TCL_DOCS = \
	$(TCL_SOURCE)/doc/*.[13n]

TK_DOCS = \
	$(TK_SOURCE)/doc/*.[13n]

PRO_DOCS = \
	$(PRO_SOURCE)/doc/man/procheck.1 \
	$(PRO_SOURCE)/doc/man/prodebug.1 \
	$(PRO_SOURCE)/doc/man/prodebug.n \
	$(PRO_SOURCE)/doc/man/prolicense.1

ITCL_DOCS = \
	$(ITCL_SOURCE)/itcl/doc/*.[13n] \
	$(ITCL_SOURCE)/itk/doc/*.[13n]

#	$(ITCL_SOURCE)/iwidgets3.0.0/doc/*.[13n]

COREDOCS = $(TCL_DOCS) $(TK_DOCS) 
#PRODOCS = $(COREDOCS) $(PRO_DOCS) $(ITCL_DOCS)
PRODOCS = $(COREDOCS) $(PRO_DOCS) 
TCLSH = $(TCL_BIN_DIR)/tclsh
CC=@CC@

all: core

pro:
	$(MAKE) DOCS="$(PRODOCS)" VER="" rtf

# genWinImage.tcl --
#
#	This script generates the Windows installer.
#
# Copyright (c) 1999 by Scriptics Corporation.
# All rights reserved.
# 
# RCS: @(#) $Id: genWinImage.tcl,v 1.3.2.1 1999/05/26 02:25:14 stanton Exp $


# This file is insensitive to the directory from which it is invoked.

namespace eval genWinImage {
    # toolsDir --
    #

    # image creation.  Note that we have to use this technique to set
    # the value of _WISE_ because wise32 won't use a /d switch for this
    # variable.

    set __TCLBASEDIR__ [file native $tclBuildDir]
    set __TKBASEDIR__ [file native $tkBuildDir]
    set __WISE__ [file native [file join $toolsDir wise]]

    set f [open [file join $__TCLBASEDIR__ generic/tcl.h] r]
    set s [read $f]
    close $f
    regexp {TCL_PATCH_LEVEL\s*\"([^\"]*)\"} $s dummy __TCL_PATCH_LEVEL__
    
    set f [open tcl.wse.in r]
    set s [read $f]
    close $f
    set s [subst -nocommands -nobackslashes $s]
    set f [open tcl.wse w]
    puts $f $s
    close $f

end
item: Set Variable
  Variable=VER
  Value=8.1
end
item: Set Variable
  Variable=PATCHLEVEL
  Value=${__TCL_PATCH_LEVEL__}
end
item: Set Variable
  Variable=APPTITLE
  Value=Tcl/Tk %PATCHLEVEL% for Windows
end
item: Set Variable
  Variable=URL

item: End Block
end
item: Self-Register OCXs/DLLs
  Description=Updating System Configuration, Please Wait...
end
item: Edit Registry
  Total Keys=1
  Key=SOFTWARE\Scriptics\Tcl\%VER%
  New Value=%MAINDIR%
  Value Name=Root
  Root=2
end
item: Edit Registry
  Total Keys=1
  Key=TclScript\DefaultIcon

dnl	This file is an input file used by the GNU "autoconf" program to
dnl	generate the file "configure", which is run during Tcl installation
dnl	to configure the system for the local environment.
AC_INIT(../generic/tcl.h)
# RCS: @(#) $Id: configure.in,v 1.36.2.1 1999/05/25 21:15:58 stanton Exp $

TCL_VERSION=8.1
TCL_MAJOR_VERSION=8
TCL_MINOR_VERSION=1
# The patch level should be blank for all patch releases (i.e. non-alpha/beta)
TCL_PATCH_LEVEL=
VERSION=${TCL_VERSION}

if test "${prefix}" = "NONE"; then
    prefix=/usr/local
fi
if test "${exec_prefix}" = "NONE"; then
    exec_prefix=$prefix

    rm -f Tcl_SetServiceMode.3
    ln Notifier.3 Tcl_SetServiceMode.3
fi
if test -r GetStdChan.3; then
    rm -f Tcl_SetStdChannel.3
    ln GetStdChan.3 Tcl_SetStdChannel.3
fi
if test -r StrMatch.3; then
    rm -f Tcl_StringCaseMatch.3
    ln StrMatch.3 Tcl_StringCaseMatch.3
fi
if test -r StringObj.3; then
    rm -f Tcl_SetStringObj.3
    ln StringObj.3 Tcl_SetStringObj.3
fi
if test -r Encoding.3; then
    rm -f Tcl_SetSystemEncoding.3
    ln Encoding.3 Tcl_SetSystemEncoding.3

/* 
 * tclUnixInit.c --
 *
 *	Contains the Unix-specific interpreter initialization functions.
 *
 * Copyright (c) 1995-1997 Sun Microsystems, Inc.
 *
 * See the file "license.terms" for information on usage and redistribution
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 *
 * RCS: @(#) $Id: tclUnixInit.c,v 1.14.4.1 1999/05/14 18:26:13 stanton Exp $
 */

#include "tclInt.h"
#include "tclPort.h"
#include <locale.h>
#if defined(__FreeBSD__)
#   include <floatingpoint.h>

 * Directory in which to look for packages (each package is typically
 * installed as a subdirectory of this directory).  The symbol is
 * defined by Makefile.
 */

static char pkgPath[sizeof(TCL_PACKAGE_PATH)+200] = TCL_PACKAGE_PATH;

/*
 * The following table is used to map from Unix locale strings to
 * encoding files.
 */

typedef struct LocaleTable {
    CONST char *lang;
    CONST char *encoding;
} LocaleTable;

static CONST LocaleTable localeTable[] = {
    {"ja_JP.SJIS",	"shiftjis"},

    {"ko",              "euc-kr"},
    {"ko_KR",           "euc-kr"},
    {"ko_KR.EUC",       "euc-kr"},
    {"ko_KR.euc",       "euc-kr"},
    {"ko_KR.eucKR",     "euc-kr"},
    {"korean",          "euc-kr"},

    {"ru",		"iso8859-5"},		
    {"ru_RU",		"iso8859-5"},		
    {"ru_SU",		"iso8859-5"},		

    {"zh",		"cp936"},

    {NULL, NULL}
};

/*
 *---------------------------------------------------------------------------

void
TclpSetInitialEncodings()
{
    CONST char *encoding;
    int i;
    Tcl_Obj *pathPtr;
    char *langEnv;
    Tcl_DString ds;

    /*
     * Determine the current encoding from the LC_* or LANG environment
     * variables.  We previously used setlocale() to determine the locale,
     * but this does not work on some systems (e.g. Linux/i386 RH 5.0).
     */

    langEnv = getenv("LC_ALL");

    if (langEnv == NULL || langEnv[0] == '\0') {
	langEnv = getenv("LC_CTYPE");
    }
    if (langEnv == NULL || langEnv[0] == '\0') {
	langEnv = getenv("LANG");
    }
    if (langEnv == NULL || langEnv[0] == '\0') {
	langEnv = NULL;
    }

    encoding = NULL;
    if (langEnv != NULL) {
	for (i = 0; localeTable[i].lang != NULL; i++) {
	    if (strcmp(localeTable[i].lang, langEnv) == 0) {
		encoding = localeTable[i].encoding;
		break;
	    }
	}
	/*
	 * There was no mapping in the locale table.  If there is an
	 * encoding subfield, we can try to guess from that.
	 */

	if (encoding == NULL) {
	    char *p;
	    for (p = langEnv; *p != '\0'; p++) {
		if (*p == '.') {
		    p++;
		    break;
		}
	    }
	    if (*p != '\0') {
		Tcl_DString ds;
		Tcl_DStringInit(&ds);
		Tcl_DStringAppend(&ds, p, -1);

		encoding = Tcl_DStringValue(&ds);
		Tcl_UtfToLower(Tcl_DStringValue(&ds));
		if (Tcl_SetSystemEncoding(NULL, encoding) == TCL_OK) {
		    Tcl_DStringFree(&ds);
		    goto resetPath;
		}
		Tcl_DStringFree(&ds);
		encoding = NULL;
	    }
	}
    }
    if (encoding == NULL) {
	encoding = "iso8859-1";
    }

    Tcl_SetSystemEncoding(NULL, encoding);

    /*
     * Initialize the C library's locale subsystem.  This is required
     * for input methods to work properly on X11. Note that we need to
     * retore the initial "C" locale so that Tcl can parse numbers
     * properly.  The side effect of setting the default locale should be to
     * load any locale specific modules that are needed by X.
     */
 
    Tcl_DStringInit(&ds);
    Tcl_DStringAppend(&ds, setlocale(LC_ALL, NULL), -1);
    setlocale(LC_ALL, "");
    setlocale(LC_ALL, Tcl_DStringValue(&ds));
    Tcl_DStringFree(&ds);

    /*
     * In case the initial locale is not "C", ensure that the numeric
     * processing is done in "C" locale regardless.  This is needed because
     * Tcl relies on routines like strtod, but should not have locale
     * dependent behavior.
     */

    setlocale(LC_NUMERIC, "C");
 

    /*
     * Until the system encoding was actually set, the library path was
     * actually in the native multi-byte encoding, and not really UTF-8
     * as advertised.  We cheated as follows:
     *
     * 1. It was safe to allow the Tcl_SetSystemEncoding() call to 

     * Now that the system encoding was actually successfully set,
     * translate all the names in the library path to UTF-8.  That way,
     * next time we search the library path, we'll translate the names 
     * from UTF-8 to the system encoding which will be the native 
     * encoding.
     */

    resetPath:
    pathPtr = TclGetLibraryPath();
    if (pathPtr != NULL) {
	int objc;
	Tcl_Obj **objv;
	
	objc = 0;
	Tcl_ListObjGetElements(NULL, pathPtr, &objc, &objv);

/* 
 * tclWinChan.c
 *
 *	Channel drivers for Windows channels based on files, command
 *	pipes and TCP sockets.
 *
 * Copyright (c) 1995-1997 Sun Microsystems, Inc.
 *
 * See the file "license.terms" for information on usage and redistribution
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 *
 * RCS: @(#) $Id: tclWinChan.c,v 1.6.2.3 1999/05/18 22:36:27 stanton Exp $
 */

#include "tclWinInt.h"

/*
 * State flags used in the info structures below.
 */

	}
	if (channelPermissions & TCL_WRITABLE)
	{
	    writeFile = TclWinMakeFile(handle);
	}
	channel = TclpCreateCommandChannel(readFile, writeFile, NULL, 0, NULL);
	break;
    case FILE_TYPE_DISK:

	channel = TclWinOpenFileChannel(handle, channelName,
					channelPermissions,
					(mode & O_APPEND) ? FILE_APPEND : 0);
	break;

    case FILE_TYPE_UNKNOWN:
    case FILE_TYPE_CHAR:
    default:
	/*
	 * The handle is of an unknown type, probably /dev/nul equivalent
	 * or possibly a closed handle.  Don't use it, otherwise Tk runs into
	 * trouble with the MS DevStudio debugger.
	 */
	
	channel = NULL;
	break;
    }

    Tcl_DStringFree(&buffer);
    Tcl_DStringFree(&ds);

    if (channel != NULL)
    {

	}
	if (mode & TCL_WRITABLE)
	{
	    writeFile = TclWinMakeFile(handle);
	}
	channel = TclpCreateCommandChannel(readFile, writeFile, NULL, 0, NULL);
	break;

    case FILE_TYPE_DISK:
	channel = TclWinOpenFileChannel(handle, channelName, mode, 0);
	break;
	
    case FILE_TYPE_UNKNOWN:
    case FILE_TYPE_CHAR:
    default:
	/*
	 * The handle is of an unknown type, probably /dev/nul equivalent
	 * or possibly a closed handle.  Don't use it, otherwise Tk runs into
	 * trouble with the MS DevStudio debugger.
	 */
	
	channel = NULL;
	break;

    }

    return channel;
}


/* 
 * tclWinInit.c --
 *
 *	Contains the Windows-specific interpreter initialization functions.
 *
 * Copyright (c) 1994-1997 Sun Microsystems, Inc.
 * Copyright (c) 1998-1999 by Scriptics Corporation.
 *
 * See the file "license.terms" for information on usage and redistribution
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 *
 * RCS: @(#) $Id: tclWinInit.c,v 1.16.2.1 1999/05/14 18:26:13 stanton Exp $
 */

#include "tclWinInt.h"
#include <winreg.h>
#include <winnt.h>
#include <winbase.h>

	    Tcl_SetVar2(interp, "env", "HOME", Tcl_DStringValue(&ds),
		    TCL_GLOBAL_ONLY);
	} else {
	    Tcl_SetVar2(interp, "env", "HOME", "c:\\", TCL_GLOBAL_ONLY);
	}
    }

    /*
     * Initialize the user name from the environment first, since this is much
     * faster than asking the system.
     */

    Tcl_DStringSetLength(&ds, 100);
    if (TclGetEnv("USERNAME", &ds) == NULL) {
	if (GetUserName(Tcl_DStringValue(&ds), &Tcl_DStringLength(&ds)) == 0) {
	    Tcl_DStringSetLength(&ds, 0);
	}
    }
    Tcl_SetVar2(interp, "tcl_platform", "user", Tcl_DStringValue(&ds),
	    TCL_GLOBAL_ONLY);



    Tcl_DStringFree(&ds);
}

/*
 *----------------------------------------------------------------------
 *
 * TclpFindVariable --