2007-04-20  Kevin B. Kenny  <kennykb@acm.org>

	* doc/clock.n: Corrected a silly error (transposed 'uppercase'
	and 'lowercase' in clock.n. [Bug 1656002]
	Clarified that [clock scan] does not recognize a locale's
	alternative calendar.
	Deleted an entirely superfluous (and also incorrect) remark
	about the effect of Daylight Saving Time on relative times
	in [clock scan]. [Bug 1582951]
	* library/clock.tcl: Corrected an error in skipping over the
	%Ey field on input.
	* library/msgs/ja.msg:
	* tools/loadICU.tcl: Corrected several localisation faults in
	the Japanese locale (most notably, incorrect dates for the
	Emperors' eras). [Bug 1637471].  Many thanks to SourceForge
	user 'nyademo' for pointing this out and developing a fix.
	* generic/tclPathObj.c: Corrected a 'const'ness fault that
	caused bitter complaints from MSVC.
	* tests/clock.test (clock-40.1, clock-58.1, clock-59.1): Corrected a
	test case that depended on ":localtime" being able to handle
	dates prior to the Posix epoch, [Bug 1618445]  Added a test 
	case for the dates of the Japanese emperors. [Bug 1637471]
	Added a regression test for military time zone input conversion.
	[Bug 1586828].
	* generic/tclGetDate.y (MilitaryTable): Fixed an ancient bug where
	the military NZA time zones had the signs reversed [Bug 1586828].
	* generic/tclDate.c: Regenerated.
	* doc/Notifier.3: Documented Tcl_SetNotifier and
	Tcl_ServiceModeHook. Quite against my better judgment.
	[Bug 414933]
	* generic/tclBasic.c:
	* generic/tclCkalloc.c:
	* generic/tclClock.c:
	* generic/tclCmdIL.c:
	* generic/tclCmdMZ.c:
	* generic/tclFCmd.c:
	* generic/tclFileName.c:
	* generic/tclInterp.c: 
	* generic/tclIO.c:
	* generic/tclIOUtil.c:
	* generic/tclNamesp.c:
	* generic/tclObj.c: 
	* generic/tclPathObj.c:
	* generic/tclPipe.c: 
	* generic/tclPkg.c:
	* generic/tclResult.c:
	* generic/tclTest.c:
	* generic/tclTestObj.c:
	* generic/tclVar.c:
	* unix/tclUnixChan.c:
	* unix/tclUnixTest.c:
	* win/tclWinLoad.c:
	* win/tclWinSerial.c: Replaced commas in varargs with string
	                      concatenation where possible. [Patch 1515234]
	
2007-04-19  Donal K. Fellows  <donal.k.fellows@manchester.ac.uk>

	* generic/regcomp.c, generic/regc_cvec.c, generic/regc_lex.c,
	* generic/regc_locale.c: Improve the const-correctness of the RE
	compiler.

2007-04-18  Miguel Sofer  <msofer@users.sf.net>

'\"
'\" Copyright (c) 1998-1999 Scriptics Corporation
'\" 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: Notifier.3,v 1.9.4.4 2007/04/20 17:13:55 dgp Exp $
'\" 
.so man.macros
.TH Notifier 3 8.1 Tcl "Tcl Library Procedures"
.BS
.SH NAME
Tcl_CreateEventSource, Tcl_DeleteEventSource, Tcl_SetMaxBlockTime, Tcl_QueueEvent, Tcl_ThreadQueueEvent, Tcl_ThreadAlert, Tcl_GetCurrentThread, Tcl_DeleteEvents, Tcl_InitNotifier, Tcl_FinalizeNotifier, Tcl_WaitForEvent, Tcl_AlertNotifier, Tcl_SetTimer, Tcl_ServiceAll, Tcl_ServiceEvent, Tcl_GetServiceMode, Tcl_SetServiceMode \- the event queue and notifier interfaces
.SH SYNOPSIS

\fBTcl_ServiceEvent\fR(\fIflags\fR)
.sp
int
\fBTcl_GetServiceMode\fR()
.sp
int
\fBTcl_SetServiceMode\fR(\fImode\fR)
.sp
void
\fBTcl_ServiceModeHook\fR(\fImode\fR)
.sp
void
\fBTcl_SetNotifier\fR(\fInotifierProcPtr\fR)
.SH ARGUMENTS
.AS Tcl_EventDeleteProc *notifierProcPtr
.AP Tcl_EventSetupProc *setupProc in
Procedure to invoke to prepare for event wait in \fBTcl_DoOneEvent\fR.
.AP Tcl_EventCheckProc *checkProc in
Procedure for \fBTcl_DoOneEvent\fR to invoke after waiting for
events.  Checks to see if any events have occurred and, if so,
queues them.
.AP ClientData clientData in

Procedure to invoke for each queued event in \fBTcl_DeleteEvents\fR.
.AP int flags in
What types of events to service.  These flags are the same as those
passed to \fBTcl_DoOneEvent\fR.
.AP int mode in
Indicates whether events should be serviced by \fBTcl_ServiceAll\fR.
Must be one of \fBTCL_SERVICE_NONE\fR or \fBTCL_SERVICE_ALL\fR.
.AP Tcl_NotifierProcs* notifierProcPtr in
Structure of function pointers describing notifier procedures that are
to replace the ones installed in the executable.  See "REPLACING THE
NOTIFIER" for details.
.BE

.SH INTRODUCTION
.PP
The interfaces described here are used to customize the Tcl event
loop.  The two most common customizations are to add new sources of
events and to merge Tcl's event loop with some other event loop, such

.SH "CREATING A NEW NOTIFIER"
.PP
The notifier consists of all the procedures described in this manual
entry, plus \fBTcl_DoOneEvent\fR and \fBTcl_Sleep\fR, which are
available on all platforms, and \fBTcl_CreateFileHandler\fR and
\fBTcl_DeleteFileHandler\fR, which are Unix-specific.  Most of these
procedures are generic, in that they are the same for all notifiers.
However, none of the procedures are notifier-dependent:
\fBTcl_InitNotifier\fR, \fBTcl_AlertNotifier\fR, \fBTcl_FinalizeNotifier\fR, 
\fBTcl_SetTimer\fR, \fBTcl_Sleep\fR, \fBTcl_WaitForEvent\fR,
\fBTcl_CreateFileHandler\fR, \fBTcl_DeleteFileHandler\fR and
\fBTcl_ServiceModeHook.  To
support a new platform or to integrate Tcl with an
application-specific event loop, you must write new versions of these
procedures.
.PP
\fBTcl_InitNotifier\fR initializes the notifier state and returns
a handle to the notifier state.  Tcl calls this
procedure when initializing a Tcl interpreter.  Similarly,

time has been reduced.  \fBTcl_SetTimer\fR should arrange for the
external event loop to invoke \fBTcl_ServiceAll\fR after the specified
interval even if no events have occurred.  This interface is needed
because \fBTcl_WaitForEvent\fR isn't invoked when there is an external
event loop.  If the
notifier will only be used from \fBTcl_DoOneEvent\fR, then
\fBTcl_SetTimer\fR need not do anything.
.PP
\fBTcl_ServiceModeHook\R is called by the platform-independent portion
of the notifier when client code makes a call to
\fBTcl_SetServiceMode\fR. This hook is provided to support operating
systems that require special event handling when the application is in
a modal loop (the Windows notifier, for instance, uses this hook to
create a communication window).
.PP
On Unix systems, the file event source also needs support from the
notifier.  The file event source consists of the
\fBTcl_CreateFileHandler\fR and \fBTcl_DeleteFileHandler\fR
procedures, which are described in the \fBTcl_CreateFileHandler\fR
manual page.
.PP
The \fBTcl_Sleep\fR and \fBTcl_DoOneEvent\fR interfaces are described
in their respective manual pages.
.PP
The easiest way to create a new notifier is to look at the code
for an existing notifier, such as the files \fBunix/tclUnixNotfy.c\fR
or \fBwin/tclWinNotify.c\fR in the Tcl source distribution.

.SH "REPLACING THE NOTIFIER"
.PP
A notifier that has been written according to the conventions above
can also be installed in a running process in place of the standard
notifier.  This mechanism is used so that a single executable can be
used (with the standard notifier) as a stand-alone program and reused
(with a replacement notifier in a loadable extension) as an extension
to another program, such as a Web browser plugin.
.PP
To do this, the extension makes a call to \fBTcl_SetNotifier\fR
passing a pointer to a \fBTcl_NotifierProcs\fR data structure.  The
structure has the following layout:
.CS
typedef struct Tcl_NotifierProcs {
    Tcl_SetTimerProc *setTimerProc;
    Tcl_WaitForEventProc *waitForEventProc;
    Tcl_CreateFileHandlerProc *createFileHandlerProc;
    Tcl_DeleteFileHandlerProc *deleteFileHandlerProc;
    Tcl_InitNotifierProc *initNotifierProc;
    Tcl_FinalizeNotifierProc *finalizeNotifierProc;
    Tcl_AlertNotifierProc *alertNotifierProc;
    Tcl_ServiceModeHookProc *serviceModeHookProc;
} Tcl_NotifierProcs;
.CE
Following the call to \fBTcl_SetNotifier\fR, the pointers given in
the \fBTcl_NotifierProcs\fR structure replace whatever notifier had
been installed in the process.
.PP
It is extraordinarily unwise to replace a running notifier. Normally,
\fBTcl_SetNotifier\fR should be called at process initialization time
before the first call to \fBTcl_InitNotifier\fR.

.SH "EXTERNAL EVENT LOOPS"
.PP
The notifier interfaces are designed so that Tcl can be embedded into
applications that have their own private event loops.  In this case,
the application does not call \fBTcl_DoOneEvent\fR except in the case
of recursive event loops such as calls to the Tcl commands \fBupdate\fR
or \fBvwait\fR.  Most of the time is spent in the external event loop

groups specifying year of century, month and day of month; year of
century and day of year; or two-digit ISO8601 fiscal year, week of year,
and day of week; those groups are
combined and used to determine the date.  If more than one complete
set is present, the one at the rightmost position in the string is
used.  The year is presumed to lie in the range 1938 to 2037 inclusive.
.IP [5]
If the string entirely lacks any specification for the year
(or contains the year only on the locale's alternative calendar)
and contains a set of format groups specifying month and day of month,
day of year, or week of year and day of week, those groups are
combined and used to determine the date.  If more than one complete
set is present, the one at the rightmost position in the string is
used.  The year is determined by interpreting the base time in the given
time zone.
.IP [6]
If the string contains none of the above sets, but has a day

All of these format groups are synonymous with their counterparts
without the '\fBO\fR', except that the string is produced and parsed in the
locale-dependent alternative numerals.
.TP
\fB%p\fR
On output, produces an indicator for the part of the day, \fBAM\fR
or \fBPM\fR, appropriate to the given locale.  If the script of the
given locale supports multiple letterforms, lowercase is preferred.
On input, matches the representation \fBAM\fR or \fBPM\fR in
the given locale, in either case.
.TP
\fB%P\fR
On output, produces an indicator for the part of the day, \fBam\fR
or \fBpm\fR, appropriate to the given locale.  If the script of the
given locale supports multiple letterforms, uppercase is preferred.
On input, matches the representation \fBAM\fR or \fBPM\fR in
the given locale, in either case.
.TP
\fB%Q\fR
This format group is reserved for internal use within the Tcl library.
.TP
\fB%r\fR

Using that time as the base, day-of-week specifications are added.
Next, relative specifications are used.  If a date or day is
specified, and no absolute or relative time is given, midnight is
used.  Finally, a correction is applied so that the correct hour of
the day is produced after allowing for daylight savings time
differences and the correct date is given when going from the end
of a long month to a short month.












.SH "SEE ALSO"
msgcat
.SH "COPYRIGHT"
Copyright (c) 2004 Kevin B. Kenny <kennykb@acm.org>. All rights reserved.

 * Copyright (c) 1994-1997 Sun Microsystems, Inc.
 * Copyright (c) 1998-1999 by Scriptics Corporation.
 * Copyright (c) 2001, 2002 by Kevin B. Kenny.  All rights reserved.
 *
 * 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.82.2.53 2007/04/20 17:13:55 dgp Exp $
 */

#include "tclInt.h"
#include "tclCompile.h"
#include <float.h>
#include <limits.h>
#include <math.h>

     * But as we currently limit ourselves to the global namespace only for
     * the source, in order to avoid potential confusion, lets prevent "::" in
     * the token too. - dl
     */

    if (strstr(hiddenCmdToken, "::") != NULL) {
	Tcl_AppendResult(interp,
		"cannot use namespace qualifiers in hidden command"
		" token (rename)", NULL);
	return TCL_ERROR;
    }

    /*
     * Find the command to hide. An error is returned if cmdName can't be
     * found. Look up the command only from the global namespace. Full path of

    cmdPtr = (Command *) cmd;

    /*
     * Check that the command is really in global namespace
     */

    if (cmdPtr->nsPtr != iPtr->globalNsPtr) {
	Tcl_AppendResult(interp, "can only hide global namespace commands"
		" (use rename then hide)", NULL);
	return TCL_ERROR;
    }

    /*
     * Initialize the hidden command table if necessary.
     */

    /*
     * Check that we have a regular name for the command (that the user is not
     * trying to do an expose and a rename (to another namespace) at the same
     * time).
     */

    if (strstr(cmdName, "::") != NULL) {
	Tcl_AppendResult(interp, "cannot expose to a namespace "
		"(use expose to toplevel, then rename)", NULL);
	return TCL_ERROR;
    }

    /*
     * Get the command from the hidden command table:
     */

 * 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.
 *
 * This code contributed by Karl Lehenbauer and Mark Diekhans
 *
 * RCS: @(#) $Id: tclCkalloc.c,v 1.19.4.8 2007/04/20 17:13:56 dgp Exp $
 */

#include "tclInt.h"

#define FALSE	0
#define TRUE	1

	    goto bad_suboption;
	}
	validate_memory = (strcmp(argv[2],"on") == 0);
	return TCL_OK;
    }

    Tcl_AppendResult(interp, "bad option \"", argv[1],
	    "\": should be active, break_on_malloc, info, init, onexit, "
	    "tag, trace, trace_on_at_malloc, or validate", NULL);
    return TCL_ERROR;

  argError:
    Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
	    " ", argv[1], " count\"", NULL);
    return TCL_ERROR;

 * Copyright 1991-1995 Karl Lehenbauer and Mark Diekhans.
 * Copyright (c) 1995 Sun Microsystems, Inc.
 * Copyright (c) 2004 by Kevin B. Kenny.  All rights reserved.
 *
 * See the file "license.terms" for information on usage and redistribution of
 * this file, and for a DISCLAIMER OF ALL WARRANTIES.
 *
 * RCS: @(#) $Id: tclClock.c,v 1.23.2.19 2007/04/20 17:13:56 dgp Exp $
 */

#include "tclInt.h"

/*
 * Windows has mktime. The configurators do not check.
 */

	Tcl_SetErrorCode(interp, "CLOCK", "argTooLarge", NULL);
	return TCL_ERROR;
    }
    TzsetIfNecessary();
    timeVal = ThreadSafeLocalTime(&tock);
    if (timeVal == NULL) {
	Tcl_AppendResult(interp,
		"localtime failed (clock value may be too "
		"large/small to represent)", NULL);
	Tcl_SetErrorCode(interp, "CLOCK", "localtimeFailed", NULL);
	return TCL_ERROR;
    }

    /*
     * Fill in the date in 'fields' and use it to derive Julian Day.

 * Copyright (c) 1998-1999 by Scriptics Corporation.
 * Copyright (c) 2001 by Kevin B. Kenny. All rights reserved.
 * Copyright (c) 2005 Donal K. Fellows.
 *
 * See the file "license.terms" for information on usage and redistribution of
 * this file, and for a DISCLAIMER OF ALL WARRANTIES.
 *
 * RCS: @(#) $Id: tclCmdIL.c,v 1.50.2.23 2007/04/20 17:13:56 dgp Exp $
 */

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

/*
 * During execution of the "lsort" command, structures of the following type

	    break;
	case LSORT_COMMAND:
	    if (i == (objc-2)) {
		if (sortInfo.indexc > 1) {
		    ckfree((char *) sortInfo.indexv);
		}
		Tcl_AppendResult(interp,
			"\"-command\" option must be followed "
			"by comparison command", NULL);
		return TCL_ERROR;
	    }
	    sortInfo.sortMode = SORTMODE_COMMAND;
	    cmdPtr = objv[i+1];
	    i++;
	    break;

	    int j;
	    Tcl_Obj **indices;

	    if (sortInfo.indexc > 1) {
		ckfree((char *) sortInfo.indexv);
	    }
	    if (i == (objc-2)) {
		Tcl_AppendResult(interp, "\"-index\" option must be "
			"followed by list index", NULL);
		return TCL_ERROR;
	    }

	    /*
	     * Take copy to prevent shimmering problems.
	     */

 * Copyright (c) 1998-2000 Scriptics Corporation.
 * Copyright (c) 2002 ActiveState Corporation.
 * Copyright (c) 2003 Donal K. Fellows.
 *
 * 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.90.2.28 2007/04/20 17:13:56 dgp Exp $
 */

#include "tclInt.h"
#include "tclRegexp.h"

/*
 *----------------------------------------------------------------------

    /*
     * Check if the user requested -inline, but specified match variables; a
     * no-no.
     */

    if (doinline && ((objc - 2) != 0)) {
	Tcl_AppendResult(interp, "regexp match variables not allowed"
		" when using -inline", NULL);
	goto optionError;
    }

    /*
     * Handle the odd about case separately.
     */

	 * The following is an heuristic to detect the infamous "comment in
	 * switch" error: just check if a pattern begins with '#'.
	 */

	if (splitObjs) {
	    for (i=0 ; i<objc ; i+=2) {
		if (TclGetString(objv[i])[0] == '#') {
		    Tcl_AppendResult(interp, ", this may be due to a "
			    "comment incorrectly placed outside of a "
			    "switch body - see the \"switch\" "
			    "documentation", NULL);
		    break;
		}
	    }
	}

	return TCL_ERROR;

	    yyMonth = yyvsp[0].Number;
	;}
    break;

  case 38:

    {
	    if (yyvsp[-1].Number != HOUR( 7)) YYABORT;
	    yyYear = yyvsp[-2].Number / 10000;
	    yyMonth = (yyvsp[-2].Number % 10000)/100;
	    yyDay = yyvsp[-2].Number % 100;
	    yyHour = yyvsp[0].Number / 10000;
	    yyMinutes = (yyvsp[0].Number % 10000)/100;
	    yySeconds = yyvsp[0].Number % 100;
	;}
    break;

  case 39:

    {
	    if (yyvsp[-5].Number != HOUR( 7)) YYABORT;
	    yyYear = yyvsp[-6].Number / 10000;
	    yyMonth = (yyvsp[-6].Number % 10000)/100;
	    yyDay = yyvsp[-6].Number % 100;
	    yyHour = yyvsp[-4].Number;
	    yyMinutes = yyvsp[-2].Number;
	    yySeconds = yyvsp[0].Number;
	;}

};

/*
 * Military timezone table.
 */

static TABLE	MilitaryTable[] = {
    { "a",	tZONE,	-HOUR( 1) },
    { "b",	tZONE,	-HOUR( 2) },
    { "c",	tZONE,	-HOUR( 3) },
    { "d",	tZONE,	-HOUR( 4) },
    { "e",	tZONE,	-HOUR( 5) },
    { "f",	tZONE,	-HOUR( 6) },
    { "g",	tZONE,	-HOUR( 7) },
    { "h",	tZONE,	-HOUR( 8) },
    { "i",	tZONE,	-HOUR( 9) },
    { "k",	tZONE,	-HOUR(10) },
    { "l",	tZONE,	-HOUR(11) },
    { "m",	tZONE,	-HOUR(12) },
    { "n",	tZONE,	HOUR(  1) },
    { "o",	tZONE,	HOUR(  2) },
    { "p",	tZONE,	HOUR(  3) },
    { "q",	tZONE,	HOUR(  4) },
    { "r",	tZONE,	HOUR(  5) },
    { "s",	tZONE,	HOUR(  6) },
    { "t",	tZONE,	HOUR(  7) },
    { "u",	tZONE,	HOUR(  8) },
    { "v",	tZONE,	HOUR(  9) },
    { "w",	tZONE,	HOUR( 10) },
    { "x",	tZONE,	HOUR( 11) },
    { "y",	tZONE,	HOUR( 12) },
    { "z",	tZONE,	HOUR( 0) },
    { NULL }
};

/*
 * Dump error messages in the bit bucket.
 */

    }

    /*
     * Strip off any plural and try the units table again.
     */

    i = strlen(buff) - 1;
    if (i > 0 && buff[i] == 's') {
	buff[i] = '\0';
	for (tp = UnitsTable; tp->name; tp++) {
	    if (strcmp(buff, tp->name) == 0) {
		yylval.Number = tp->value;
		return tp->type;
	    }
	}

/*
 * tclFCmd.c
 *
 *	This file implements the generic portion of file manipulation
 *	subcommands of the "file" command.
 *
 * Copyright (c) 1996-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: tclFCmd.c,v 1.21.2.12 2007/04/20 17:13:56 dgp Exp $
 */

#include "tclInt.h"

/*
 * Declarations for local functions defined in this file:
 */

	if (result == TCL_OK) {
	    goto done;
	}

	if (errno == EINVAL) {
	    Tcl_AppendResult(interp, "error renaming \"",
		    TclGetString(source), "\" to \"", TclGetString(target),
		    "\": trying to rename a volume or "
		    "move a directory into itself", NULL);
	    goto done;
	} else if (errno != EXDEV) {
	    errfile = target;
	    goto done;
	}

/*
 * tclFileName.c --
 *
 *	This file contains routines for converting file names betwen native
 *	and network form.
 *
 * Copyright (c) 1995-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: tclFileName.c,v 1.41.2.25 2007/04/20 17:13:56 dgp Exp $
 */

#include "tclInt.h"
#include "tclRegexp.h"
#include "tclFileSystem.h" /* For TclGetPathType() */

/*

    if (*user == '\0') {
	Tcl_DString dirString;

	dir = TclGetEnv("HOME", &dirString);
	if (dir == NULL) {
	    if (interp) {
		Tcl_ResetResult(interp);
		Tcl_AppendResult(interp, "couldn't find HOME environment "
			"variable to expand path", (char *) NULL);
	    }
	    return NULL;
	}
	Tcl_JoinPath(1, &dir, resultPtr);
	Tcl_DStringFree(&dirString);
    } else if (TclpGetUserHome(user, resultPtr) == NULL) {

  endOfForLoop:
    if (objc - i < 1) {
	Tcl_WrongNumArgs(interp, 1, objv, "?switches? name ?name ...?");
	return TCL_ERROR;
    }
    if ((globFlags & TCL_GLOBMODE_TAILS) && (pathOrDir == NULL)) {
	Tcl_AppendResult(interp,
		"\"-tails\" must be used with either "
		"\"-directory\" or \"-path\"", NULL);
	return TCL_ERROR;
    }

    separators = NULL;		/* lint. */
    switch (tclPlatform) {
    case TCL_PLATFORM_UNIX:

 *
 * 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: tclGetDate.y,v 1.19.2.9 2007/04/20 17:13:56 dgp Exp $
 */

%{
/*
 * tclDate.c --
 *
 *	This file is generated from a yacc grammar defined in the file

	| tNEXT tUNUMBER tMONTH {
	    yyMonthOrdinal = $2;
	    yyMonth = $3;
	}
	;

iso	: tISOBASE tZONE tISOBASE {
	    if ($2 != HOUR( 7)) YYABORT;
	    yyYear = $1 / 10000;
	    yyMonth = ($1 % 10000)/100;
	    yyDay = $1 % 100;
	    yyHour = $3 / 10000;
	    yyMinutes = ($3 % 10000)/100;
	    yySeconds = $3 % 100;
	}
	| tISOBASE tZONE tUNUMBER ':' tUNUMBER ':' tUNUMBER {
	    if ($2 != HOUR( 7)) YYABORT;
	    yyYear = $1 / 10000;
	    yyMonth = ($1 % 10000)/100;
	    yyDay = $1 % 100;
	    yyHour = $3;
	    yyMinutes = $5;
	    yySeconds = $7;
	}

};

/*
 * Military timezone table.
 */

static TABLE	MilitaryTable[] = {
    { "a",	tZONE,	-HOUR( 1) },
    { "b",	tZONE,	-HOUR( 2) },
    { "c",	tZONE,	-HOUR( 3) },
    { "d",	tZONE,	-HOUR( 4) },
    { "e",	tZONE,	-HOUR( 5) },
    { "f",	tZONE,	-HOUR( 6) },
    { "g",	tZONE,	-HOUR( 7) },
    { "h",	tZONE,	-HOUR( 8) },
    { "i",	tZONE,	-HOUR( 9) },
    { "k",	tZONE,	-HOUR(10) },
    { "l",	tZONE,	-HOUR(11) },
    { "m",	tZONE,	-HOUR(12) },
    { "n",	tZONE,	HOUR(  1) },
    { "o",	tZONE,	HOUR(  2) },
    { "p",	tZONE,	HOUR(  3) },
    { "q",	tZONE,	HOUR(  4) },
    { "r",	tZONE,	HOUR(  5) },
    { "s",	tZONE,	HOUR(  6) },
    { "t",	tZONE,	HOUR(  7) },
    { "u",	tZONE,	HOUR(  8) },
    { "v",	tZONE,	HOUR(  9) },
    { "w",	tZONE,	HOUR( 10) },
    { "x",	tZONE,	HOUR( 11) },
    { "y",	tZONE,	HOUR( 12) },
    { "z",	tZONE,	HOUR( 0) },
    { NULL }
};

/*
 * Dump error messages in the bit bucket.
 */

    }

    /*
     * Strip off any plural and try the units table again.
     */

    i = strlen(buff) - 1;
    if (i > 0 && buff[i] == 's') {
	buff[i] = '\0';
	for (tp = UnitsTable; tp->name; tp++) {
	    if (strcmp(buff, tp->name) == 0) {
		yylval.Number = tp->value;
		return tp->type;
	    }
	}

/*
 * tclIO.c --
 *
 *	This file provides the generic portions (those that are the same on
 *	all platforms and for all channel types) of Tcl's IO facilities.
 *
 * Copyright (c) 1998-2000 Ajuba Solutions
 * 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: tclIO.c,v 1.68.2.25 2007/04/20 17:13:56 dgp Exp $
 */

#include "tclInt.h"
#include "tclIO.h"
#include <assert.h>

/*

{
    ChannelState *statePtr;	/* State of the real channel. */

    statePtr = ((Channel *) chan)->state->bottomChanPtr->state;

    if (statePtr->flags & CHANNEL_INCLOSE) {
	if (interp != NULL) {
	    Tcl_AppendResult(interp, "Illegal recursive call to close "
		    "through close-handler of channel", NULL);
	}
	return TCL_ERROR;
    }

    if (DetachChannel(interp, chan) != TCL_OK) {
	return TCL_OK;

    if (statePtr->refCount > 0) {
	Tcl_Panic("called Tcl_Close on channel with refCount > 0");
    }

    if (statePtr->flags & CHANNEL_INCLOSE) {
	if (interp) {
	    Tcl_AppendResult(interp, "Illegal recursive call to close "
		    "through close-handler of channel", NULL);
	}
	return TCL_ERROR;
    }
    statePtr->flags |= CHANNEL_INCLOSE;

    /*

    /*
     * If the channel is in the middle of a background copy, fail.
     */

    if (statePtr->csPtr) {
	if (interp) {
	    Tcl_AppendResult(interp, "unable to set channel options: "
		    "background copy in progress", NULL);
	}
	return TCL_ERROR;
    }

    /*
     * Disallow options on dead channels -- channels that have been closed but

	    statePtr->flags |= CHANNEL_LINEBUFFERED;
	} else if ((newValue[0] == 'n') &&
		(strncmp(newValue, "none", len) == 0)) {
	    statePtr->flags &= ~CHANNEL_LINEBUFFERED;
	    statePtr->flags |= CHANNEL_UNBUFFERED;
	} else {
	    if (interp) {
		Tcl_AppendResult(interp, "bad value for -buffering: "
			"must be one of full, line, or none", NULL);
		return TCL_ERROR;
	    }
	}
	return TCL_OK;
    } else if (HaveOpt(7, "-buffersize")) {
	int newBufferSize;

	    }
	    if (statePtr->flags & TCL_READABLE) {
		statePtr->inEofChar = (int) argv[0][0];
	    }
	} else if (argc != 2) {
	    if (interp) {
		Tcl_AppendResult(interp,
			"bad value for -eofchar: should be a list of zero,"
			" one, or two elements", NULL);
	    }
	    ckfree((char *) argv);
	    return TCL_ERROR;
	} else {
	    if (statePtr->flags & TCL_READABLE) {
		statePtr->inEofChar = (int) argv[0][0];

	    writeMode = (statePtr->flags & TCL_WRITABLE) ? argv[0] : NULL;
	} else if (argc == 2) {
	    readMode = (statePtr->flags & TCL_READABLE) ? argv[0] : NULL;
	    writeMode = (statePtr->flags & TCL_WRITABLE) ? argv[1] : NULL;
	} else {
	    if (interp) {
		Tcl_AppendResult(interp,
			"bad value for -translation: must be a one or two"
			" element list", NULL);
	    }
	    ckfree((char *) argv);
	    return TCL_ERROR;
	}

	if (readMode) {

	    } else if (strcmp(readMode, "crlf") == 0) {
		translation = TCL_TRANSLATE_CRLF;
	    } else if (strcmp(readMode, "platform") == 0) {
		translation = TCL_PLATFORM_TRANSLATION;
	    } else {
		if (interp) {
		    Tcl_AppendResult(interp,
			    "bad value for -translation: "
			    "must be one of auto, binary, cr, lf, crlf,"
			    " or platform", NULL);
		}
		ckfree((char *) argv);
		return TCL_ERROR;
	    }

	    /*

	    } else if (strcmp(writeMode, "crlf") == 0) {
		statePtr->outputTranslation = TCL_TRANSLATE_CRLF;
	    } else if (strcmp(writeMode, "platform") == 0) {
		statePtr->outputTranslation = TCL_PLATFORM_TRANSLATION;
	    } else {
		if (interp) {
		    Tcl_AppendResult(interp,
			    "bad value for -translation: "
			    "must be one of auto, binary, cr, lf, crlf,"
			    " or platform", NULL);
		}
		ckfree((char *) argv);
		return TCL_ERROR;
	    }
	}
	ckfree((char *) argv);

 * Copyright (c) 1991-1994 The Regents of the University of California.
 * Copyright (c) 1994-1997 Sun Microsystems, Inc.
 * Copyright (c) 2001-2004 Vincent Darley.
 *
 * See the file "license.terms" for information on usage and redistribution of
 * this file, and for a DISCLAIMER OF ALL WARRANTIES.
 *
 * RCS: @(#) $Id: tclIOUtil.c,v 1.81.2.30 2007/04/20 17:13:57 dgp Exp $
 */

#include "tclInt.h"
#ifdef __WIN32__
#   include "tclWinInt.h"
#endif
#include "tclFileSystem.h"

	}
    }

    ckfree((char *) modeArgv);

    if (!gotRW) {
	if (interp != NULL) {
	    Tcl_AppendResult(interp, "access mode must include either"
		    " RDONLY, WRONLY, or RDWR", NULL);
	}
	return -1;
    }
    return mode;
}


	    /*
	     * Apply appropriate flags parsed out above.
	     */

	    if (seekFlag && Tcl_Seek(retVal, (Tcl_WideInt)0,
		    SEEK_END) < (Tcl_WideInt)0) {
		if (interp != NULL) {
		    Tcl_AppendResult(interp, "could not seek to end "
			    "of file while opening \"", Tcl_GetString(pathPtr),
			    "\": ", Tcl_PosixError(interp), NULL);
		}
		Tcl_Close(NULL, retVal);
		return NULL;
	    }
	    if (binary) {

/*
 * tclInterp.c --
 *
 *	This file implements the "interp" command which allows creation and
 *	manipulation of Tcl interpreters from within Tcl scripts.
 *
 * Copyright (c) 1995-1997 Sun Microsystems, Inc.
 * Copyright (c) 2004 Donal K. Fellows
 *
 * See the file "license.terms" for information on usage and redistribution
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 *
 * RCS: @(#) $Id: tclInterp.c,v 1.22.2.18 2007/04/20 17:13:57 dgp Exp $
 */

#include "tclInt.h"

/*
 * A pointer to a string that holds an initialization script that if non-NULL
 * is evaluated in Tcl_Init() prior to the built-in initialization script

    Tcl_Obj *CONST objv[])	/* Argument strings. */
{
    Interp *iPtr;
    int limit;

    if (objc) {
	if (Tcl_IsSafe(interp)) {
	    Tcl_AppendResult(interp, "permission denied: "
		    "safe interpreters cannot change recursion limit",
		    (char *) NULL);
	    return TCL_ERROR;
	}
	if (Tcl_GetIntFromObj(interp, objv[0], &limit) == TCL_ERROR) {
	    return TCL_ERROR;
	}

		break;
	    case OPT_GRAN:
		granObj = objv[i+1];
		if (Tcl_GetIntFromObj(interp, objv[i+1], &gran) != TCL_OK) {
		    return TCL_ERROR;
		}
		if (gran < 1) {
		    Tcl_AppendResult(interp, "granularity must be at "
			    "least 1", NULL);
		    return TCL_ERROR;
		}
		break;
	    case OPT_VAL:
		limitObj = objv[i+1];
		(void) Tcl_GetStringFromObj(objv[i+1], &limitLen);
		if (limitLen == 0) {
		    break;
		}
		if (Tcl_GetIntFromObj(interp, objv[i+1], &limit) != TCL_OK) {
		    return TCL_ERROR;
		}
		if (limit < 0) {
		    Tcl_AppendResult(interp, "command limit value must be at "
			    "least 0", NULL);
		    return TCL_ERROR;
		}
		break;
	    }
	}
	if (scriptObj != NULL) {

		break;
	    case OPT_GRAN:
		granObj = objv[i+1];
		if (Tcl_GetIntFromObj(interp, objv[i+1], &gran) != TCL_OK) {
		    return TCL_ERROR;
		}
		if (gran < 1) {
		    Tcl_AppendResult(interp, "granularity must be at "
			    "least 1", NULL);
		    return TCL_ERROR;
		}
		break;
	    case OPT_MILLI:
		milliObj = objv[i+1];
		(void) Tcl_GetStringFromObj(objv[i+1], &milliLen);

	    if (milliObj != NULL) {
		/*
		 * Setting -milliseconds but clearing -seconds, or resetting
		 * -milliseconds but not resetting -seconds? Bad voodoo!
		 */

		if (secObj != NULL && secLen == 0 && milliLen > 0) {
		    Tcl_AppendResult(interp, "may only set -milliseconds "
			    "if -seconds is not also being reset", NULL);
		    return TCL_ERROR;
		}
		if (milliLen == 0 && (secObj == NULL || secLen > 0)) {
		    Tcl_AppendResult(interp, "may only reset -milliseconds "
			    "if -seconds is also being reset", NULL);
		    return TCL_ERROR;
		}
	    }

	    if (milliLen > 0 || secLen > 0) {
		/*

 *   Michael J. McLennan
 *   Bell Labs Innovations for Lucent Technologies
 *   mmclennan@lucent.com
 *
 * See the file "license.terms" for information on usage and redistribution of
 * this file, and for a DISCLAIMER OF ALL WARRANTIES.
 *
 * RCS: @(#) $Id: tclNamesp.c,v 1.31.4.31 2007/04/20 17:13:57 dgp Exp $
 */

#include "tclInt.h"

/*
 * Initial size of stack allocated space for tail list - used when resetting
 * shadowed command references in the function TclResetShadowedCmdRefs.

	 * a parent.
	 */

	parentPtr = NULL;
	simpleName = "";
    } else if (*name == '\0') {
	Tcl_ResetResult(interp);
	Tcl_AppendResult(interp, "can't create namespace \"\": "
		"only global namespace can have empty name", NULL);
	return NULL;
    } else {
	/*
	 * Find the parent for the new namespace.
	 */

 * Copyright (c) 1999 by Scriptics Corporation.
 * Copyright (c) 2001 by ActiveState Corporation.
 * Copyright (c) 2005 by Kevin B. Kenny.  All rights reserved.
 *
 * See the file "license.terms" for information on usage and redistribution of
 * this file, and for a DISCLAIMER OF ALL WARRANTIES.
 *
 * RCS: @(#) $Id: tclObj.c,v 1.46.2.36 2007/04/20 17:13:58 dgp Exp $
 */

#include "tclInt.h"
#include "tclCompile.h"
#include "tommath.h"
#include <float.h>

	tablePtr = tsdPtr->objThreadMap;
	if (!tablePtr) {
	    Tcl_Panic("object table not initialized");
	}
	hPtr = Tcl_FindHashEntry(tablePtr, (char *) objPtr);
	if (!hPtr) {
	    Tcl_Panic("%s%s",
		    "Trying to incr ref count of "
		    "Tcl_Obj allocated in another thread");
	}
    }
# endif
#endif
    ++(objPtr)->refCount;
}

	tablePtr = tsdPtr->objThreadMap;
	if (!tablePtr) {
	    Tcl_Panic("object table not initialized");
	}
	hPtr = Tcl_FindHashEntry(tablePtr, (char *) objPtr);
	if (!hPtr) {
	    Tcl_Panic("%s%s",
		    "Trying to decr ref count of "
		    "Tcl_Obj allocated in another thread");
	}

	/* If the Tcl_Obj is going to be deleted, remove the entry */
	if ((((objPtr)->refCount) - 1) <= 0) {
	    Tcl_DeleteHashEntry(hPtr);
	}

	tablePtr = tsdPtr->objThreadMap;
	if (!tablePtr) {
	    Tcl_Panic("object table not initialized");
	}
	hPtr = Tcl_FindHashEntry(tablePtr, (char *) objPtr);
	if (!hPtr) {
	    Tcl_Panic("%s%s",
		    "Trying to check shared status of"
		    "Tcl_Obj allocated in another thread");
	}
    }
# endif
#endif

#ifdef TCL_COMPILE_STATS

/*
 * tclPathObj.c --
 *
 *	This file contains the implementation of Tcl's "path" object type used
 *	to represent and manipulate a general (virtual) filesystem entity in
 *	an efficient manner.
 *
 * Copyright (c) 2003 Vince Darley.
 *
 * See the file "license.terms" for information on usage and redistribution of
 * this file, and for a DISCLAIMER OF ALL WARRANTIES.
 *
 * RCS: @(#) $Id: tclPathObj.c,v 1.3.2.25 2007/04/20 17:13:58 dgp Exp $
 */

#include "tclInt.h"
#include "tclFileSystem.h"

/*
 * Prototypes for functions defined later in this file.

	     */

	    if (pathPtr->typePtr != NULL) {
		if (pathPtr->bytes == NULL) {
		    if (pathPtr->typePtr->updateStringProc == NULL) {
			if (interp != NULL) {
			    Tcl_ResetResult(interp);
			    Tcl_AppendResult(interp, "can't find object"
				    "string representation", (char *) NULL);
			}
			return NULL;
		    }
		    pathPtr->typePtr->updateStringProc(pathPtr);
		}
		TclFreeIntRep(pathPtr);

     */

    if (pathPtr->typePtr != NULL) {
	if (pathPtr->bytes == NULL) {
	    if (pathPtr->typePtr->updateStringProc == NULL) {
		if (interp != NULL) {
		    Tcl_ResetResult(interp);
		    Tcl_AppendResult(interp, "can't find object"
			    "string representation", (char *) NULL);
		}
		return TCL_ERROR;
	    }
	    pathPtr->typePtr->updateStringProc(pathPtr);
	}
	TclFreeIntRep(pathPtr);

    Tcl_Interp *interp,
    Tcl_Obj *pathPtr)
{
    Tcl_Obj *transPtr = Tcl_FSGetTranslatedPath(interp, pathPtr);

    if (transPtr != NULL) {
	int len;
	const char* orig;
	char *result;

	orig = Tcl_GetStringFromObj(transPtr, &len);
	result = (char *) ckalloc((unsigned)(len+1));
	memcpy(result, orig, (size_t) (len+1));
	TclDecrRefCount(transPtr);
	return result;
    }

		name[split] = separator;
	    }

	    dir = TclGetEnv("HOME", &dirString);
	    if (dir == NULL) {
		if (interp) {
		    Tcl_ResetResult(interp);
		    Tcl_AppendResult(interp, "couldn't find HOME environment "
			    "variable to expand path", (char *) NULL);
		}
		return TCL_ERROR;
	    }
	    Tcl_DStringInit(&temp);
	    Tcl_JoinPath(1, &dir, &temp);
	    Tcl_DStringFree(&dirString);

/*
 * tclPipe.c --
 *
 *	This file contains the generic portion of the command channel driver
 *	as well as various utility routines used in managing subprocesses.
 *
 * Copyright (c) 1997 by 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: tclPipe.c,v 1.7.4.11 2007/04/20 17:13:58 dgp Exp $
 */

#include "tclInt.h"

/*
 * A linked list of the following structures is used to keep track of child
 * processes that have been detached but haven't exited yet, so we can make

    /*
     * Verify that the pipes that were created satisfy the readable/writable
     * constraints.
     */

    if (flags & TCL_ENFORCE_MODE) {
	if ((flags & TCL_STDOUT) && (outPipe == NULL)) {
	    Tcl_AppendResult(interp, "can't read output from command:"
		    " standard output was redirected", NULL);
	    goto error;
	}
	if ((flags & TCL_STDIN) && (inPipe == NULL)) {
	    Tcl_AppendResult(interp, "can't write input to command:"
		    " standard input was redirected", NULL);
	    goto error;
	}
    }

    channel = TclpCreateCommandChannel(outPipe, inPipe, errFile,
	    numPids, pidPtr);

/*
 * tclPkg.c --
 *
 *	This file implements package and version control for Tcl via the
 *	"package" command and a few C APIs.
 *
 * Copyright (c) 1996 Sun Microsystems, Inc.
 * Copyright (c) 2006 Andreas Kupries <andreas_kupries@users.sourceforge.net>
 *
 * See the file "license.terms" for information on usage and redistribution of
 * this file, and for a DISCLAIMER OF ALL WARRANTIES.
 *
 * RCS: @(#) $Id: tclPkg.c,v 1.9.4.9 2007/04/20 17:13:58 dgp Exp $
 *
 * TIP #268.
 * Heavily rewritten to handle the extend version numbers, and extended
 * package requirements.
 */

#include "tclInt.h"

	 * initialization of the Tcl library are not remedied, so be very
	 * careful about adding any other calls here without checking how they
	 * behave when initialization is incomplete.
	 */

	tclEmptyStringRep = &tclEmptyString;
	Tcl_AppendResult(interp, "Cannot load package \"", name,
		"\" in standalone executable: This package is not "
		"compiled with stub support", NULL);
	return NULL;
    }

    /* Translate between old and new API, and defer to the new function. */

    if (version == NULL) {

	/* 
	 * Check whether we're already attempting to load some version
	 * of this package (circular dependency detection).
	 */

	if (pkgPtr->clientData != NULL) {
	    Tcl_AppendResult(interp, "circular package dependency: "
		    "attempt to provide ", name, " ",
		    (char *) pkgPtr->clientData, " requires ", name, NULL);
	    AddRequirementsToResult(interp, reqc, reqv);
	    return TCL_ERROR;
	}

	/*

			}
		    }
		}
	    } else if (code != TCL_ERROR) {
		Tcl_Obj *codePtr = Tcl_NewIntObj(code);
		Tcl_ResetResult(interp);
		Tcl_AppendResult(interp, "attempt to provide package ",
			name, " ", versionToProvide, " failed: "
			"bad return code: ", TclGetString(codePtr), NULL);
		TclDecrRefCount(codePtr);
		code = TCL_ERROR;
	    }

	    if (code == TCL_ERROR) {
		Tcl_AppendObjToErrorInfo(interp, Tcl_ObjPrintf(

/*
 * tclResult.c --
 *
 *	This file contains code to manage the interpreter result.
 *
 * Copyright (c) 1997 by 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: tclResult.c,v 1.6.2.16 2007/04/20 17:13:59 dgp Exp $
 */

#include "tclInt.h"

/*
 * Indices of the standard return options dictionary keys.
 */

	    /*
	     * Value is not a legal return code.
	     */

	    Tcl_ResetResult(interp);
	    Tcl_AppendResult(interp, "bad completion code \"",
		    TclGetString(valuePtr),
		    "\": must be ok, error, return, break, "
		    "continue, or an integer", NULL);
	    goto error;
	}
	Tcl_DictObjRemove(NULL, returnOpts, keys[KEY_CODE]);
    }

    /*
     * Check for bogus -level value.
     */

    Tcl_DictObjGet(NULL, returnOpts, keys[KEY_LEVEL], &valuePtr);
    if (valuePtr != NULL) {
	if ((TCL_ERROR == Tcl_GetIntFromObj(NULL, valuePtr, &level))
		|| (level < 0)) {
	    /*
	     * Value is not a legal level.
	     */

	    Tcl_ResetResult(interp);
	    Tcl_AppendResult(interp, "bad -level value: "
		    "expected non-negative integer but got \"",
		    TclGetString(valuePtr), "\"", NULL);
	    goto error;
	}
	Tcl_DictObjRemove(NULL, returnOpts, keys[KEY_LEVEL]);
    }

 * Copyright (c) 1994-1997 Sun Microsystems, Inc.
 * Copyright (c) 1998-2000 Ajuba Solutions.
 * Copyright (c) 2003 by Kevin B. Kenny.  All rights reserved.
 *
 * See the file "license.terms" for information on usage and redistribution of
 * this file, and for a DISCLAIMER OF ALL WARRANTIES.
 *
 * RCS: @(#) $Id: tclTest.c,v 1.67.2.25 2007/04/20 17:13:59 dgp Exp $
 */

#define TCL_TEST
#include "tclInt.h"

/*
 * Required for Testregexp*Cmd

    } else if (strcmp(argv[1], "start") == 0) {
	if (argc != 2) {
	    goto wrongNumArgs;
	}
	Tcl_DStringStartSublist(&dstring);
    } else {
	Tcl_AppendResult(interp, "bad option \"", argv[1],
		"\": must be append, element, end, free, get, length, "
		"result, trunc, or start", NULL);
	return TCL_ERROR;
    }
    return TCL_OK;
}

/*

    static int created = 0;
    char buffer[2*TCL_DOUBLE_SPACE];
    int writable, flag;
    Tcl_Obj *tmp;

    if (argc < 2) {
	Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
		" option ?arg arg arg arg arg arg arg arg arg arg arg arg"
		" arg arg?\"", NULL);
	return TCL_ERROR;
    }
    if (strcmp(argv[1], "create") == 0) {
	if (argc != 16) {
	    Tcl_AppendResult(interp, "wrong # args: should be \"",
		argv[0], " ", argv[1],
		" intRO realRO boolRO stringRO wideRO charRO ucharRO shortRO"
		" ushortRO uintRO longRO ulongRO floatRO uwideRO\"", NULL);
	    return TCL_ERROR;
	}
	if (created) {
	    Tcl_UnlinkVar(interp, "int");
	    Tcl_UnlinkVar(interp, "real");
	    Tcl_UnlinkVar(interp, "bool");

	Tcl_DecrRefCount(tmp);
    } else if (strcmp(argv[1], "set") == 0) {
	int v;

	if (argc != 16) {
	    Tcl_AppendResult(interp, "wrong # args: should be \"",
		    argv[0], " ", argv[1],
		    " intValue realValue boolValue stringValue wideValue"
		    " charValue ucharValue shortValue ushortValue uintValue"
		    " longValue ulongValue floatValue uwideValue\"", NULL);
	    return TCL_ERROR;
	}
	if (argv[2][0] != 0) {
	    if (Tcl_GetInt(interp, argv[2], &intVar) != TCL_OK) {
		return TCL_ERROR;
	    }

	}
    } else if (strcmp(argv[1], "update") == 0) {
	int v;

	if (argc != 16) {
	    Tcl_AppendResult(interp, "wrong # args: should be \"",
		    argv[0], " ", argv[1],
		    " intValue realValue boolValue stringValue wideValue"
		    " charValue ucharValue shortValue ushortValue uintValue"
		    " longValue ulongValue floatValue uwideValue\"", NULL);
	    return TCL_ERROR;
	}
	if (argv[2][0] != 0) {
	    if (Tcl_GetInt(interp, argv[2], &intVar) != TCL_OK) {
		return TCL_ERROR;
	    }

    length = strlen(argv[1]);
    if (strncmp(argv[1], "unix", length) == 0) {
	*platform = TCL_PLATFORM_UNIX;
    } else if (strncmp(argv[1], "windows", length) == 0) {
	*platform = TCL_PLATFORM_WINDOWS;
    } else {
	Tcl_AppendResult(interp, "unsupported platform: should be one of "
		"unix, or windows", NULL);
	return TCL_ERROR;
    }
    return TCL_OK;
}

/*

    } else if (strcmp(argv[2], "TestStatProc1") == 0) {
	proc = TestStatProc1;
    } else if (strcmp(argv[2], "TestStatProc2") == 0) {
	proc = TestStatProc2;
    } else if (strcmp(argv[2], "TestStatProc3") == 0) {
	proc = TestStatProc3;
    } else {
	Tcl_AppendResult(interp, "bad arg \"", argv[1], "\": "
		"must be TclpStat, "
		"TestStatProc1, TestStatProc2, or TestStatProc3", NULL);
	return TCL_ERROR;
    }

    if (strcmp(argv[1], "insert") == 0) {
	if (proc == PretendTclpStat) {
	    Tcl_AppendResult(interp, "bad arg \"", argv[1], "\": "
		   "must be "
		   "TestStatProc1, TestStatProc2, or TestStatProc3", NULL);
	    return TCL_ERROR;
	}
	retVal = TclStatInsertProc(proc);
    } else if (strcmp(argv[1], "delete") == 0) {
	retVal = TclStatDeleteProc(proc);
    } else {
	Tcl_AppendResult(interp, "bad option \"", argv[1], "\": "
		"must be insert or delete", NULL);
	return TCL_ERROR;
    }

    if (retVal == TCL_ERROR) {
	Tcl_AppendResult(interp, "\"", argv[2], "\": "
		"could not be ", argv[1], "ed", NULL);
    }

    return retVal;
}

static int

    } else if (strcmp(argv[2], "TestAccessProc1") == 0) {
	proc = TestAccessProc1;
    } else if (strcmp(argv[2], "TestAccessProc2") == 0) {
	proc = TestAccessProc2;
    } else if (strcmp(argv[2], "TestAccessProc3") == 0) {
	proc = TestAccessProc3;
    } else {
	Tcl_AppendResult(interp, "bad arg \"", argv[1], "\": "
		"must be TclpAccess, "
		"TestAccessProc1, TestAccessProc2, or TestAccessProc3", NULL);
	return TCL_ERROR;
    }

    if (strcmp(argv[1], "insert") == 0) {
	if (proc == PretendTclpAccess) {
	    Tcl_AppendResult(interp, "bad arg \"", argv[1], "\": must be "
		   "TestAccessProc1, TestAccessProc2, or TestAccessProc3"
		   NULL);
	    return TCL_ERROR;
	}
	retVal = TclAccessInsertProc(proc);
    } else if (strcmp(argv[1], "delete") == 0) {
	retVal = TclAccessDeleteProc(proc);
    } else {
	Tcl_AppendResult(interp, "bad option \"", argv[1], "\": "
		"must be insert or delete", NULL);
	return TCL_ERROR;
    }

    if (retVal == TCL_ERROR) {
	Tcl_AppendResult(interp, "\"", argv[2], "\": "
		"could not be ", argv[1], "ed", NULL);
    }

    return retVal;
}

static int

    } else if (strcmp(argv[2], "TestOpenFileChannelProc1") == 0) {
	proc = TestOpenFileChannelProc1;
    } else if (strcmp(argv[2], "TestOpenFileChannelProc2") == 0) {
	proc = TestOpenFileChannelProc2;
    } else if (strcmp(argv[2], "TestOpenFileChannelProc3") == 0) {
	proc = TestOpenFileChannelProc3;
    } else {
	Tcl_AppendResult(interp, "bad arg \"", argv[1], "\": "
		"must be TclpOpenFileChannel, "
		"TestOpenFileChannelProc1, TestOpenFileChannelProc2, or "
		"TestOpenFileChannelProc3", NULL);
	return TCL_ERROR;
    }

    if (strcmp(argv[1], "insert") == 0) {
	if (proc == PretendTclpOpenFileChannel) {
	    Tcl_AppendResult(interp, "bad arg \"", argv[1], "\": "
		   "must be "
		   "TestOpenFileChannelProc1, TestOpenFileChannelProc2, or "
		   "TestOpenFileChannelProc3", NULL);
	    return TCL_ERROR;
	}
	retVal = TclOpenFileChannelInsertProc(proc);
    } else if (strcmp(argv[1], "delete") == 0) {
	retVal = TclOpenFileChannelDeleteProc(proc);
    } else {
	Tcl_AppendResult(interp, "bad option \"", argv[1], "\": "
		"must be insert or delete", NULL);
	return TCL_ERROR;
    }

    if (retVal == TCL_ERROR) {
	Tcl_AppendResult(interp, "\"", argv[2], "\": "
		"could not be ", argv[1], "ed", NULL);
    }

    return retVal;
}

static Tcl_Channel

	    Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
		    " unstack channel\"", NULL);
	    return TCL_ERROR;
	}
	return Tcl_UnstackChannel(interp, chan);
    }

    Tcl_AppendResult(interp, "bad option \"", cmdName, "\": should be "
	    "cut, clearchannelhandlers, info, isshared, mode, open, "
	    "readable, splice, writable, transform, unstack", NULL);
    return TCL_ERROR;
}

/*
 *----------------------------------------------------------------------

	    return TCL_ERROR;
	}
	esPtr->mask = mask;
	Tcl_CreateChannelHandler((Tcl_Channel) chanPtr, mask,
		TclChannelEventScriptInvoker, (ClientData) esPtr);
	return TCL_OK;
    }
    Tcl_AppendResult(interp, "bad command ", cmd, ", must be one of "
	    "add, delete, list, set, or removeall", NULL);
    return TCL_ERROR;
}

/*
 *----------------------------------------------------------------------
 *

 * Copyright (c) 1995-1998 Sun Microsystems, Inc.
 * Copyright (c) 1999 by Scriptics Corporation.
 * Copyright (c) 2005 by Kevin B. Kenny.  All rights reserved.
 *
 * See the file "license.terms" for information on usage and redistribution of
 * this file, and for a DISCLAIMER OF ALL WARRANTIES.
 *
 * RCS: @(#) $Id: tclTestObj.c,v 1.12.4.7 2007/04/20 17:13:59 dgp Exp $
 */

#include "tclInt.h"
#include "tommath.h"

/*
 * An array of Tcl_Obj pointers used in the commands that operate on or get

	if (Tcl_AppendAllObjTypes(interp,
		Tcl_GetObjResult(interp)) != TCL_OK) {
	    return TCL_ERROR;
	}
    } else {
	Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
		"bad option \"", Tcl_GetString(objv[1]),
		"\": must be assign, convert, duplicate, freeallvars, "
		"newobj, objcount, objtype, refcount, type, or types", NULL);
	return TCL_ERROR;
    }
    return TCL_OK;
}

/*

 * Copyright (c) 1994-1997 Sun Microsystems, Inc.
 * Copyright (c) 1998-1999 by Scriptics Corporation.
 * Copyright (c) 2001 by Kevin B. Kenny. All rights reserved.
 *
 * See the file "license.terms" for information on usage and redistribution of
 * this file, and for a DISCLAIMER OF ALL WARRANTIES.
 *
 * RCS: @(#) $Id: tclVar.c,v 1.73.2.26 2007/04/20 17:13:59 dgp Exp $
 */

#include "tclInt.h"

/*
 * The strings below are used to indicate what went wrong when a variable
 * access is denied.

    if (index < 0) {
	if (((arrayPtr ? arrayPtr->nsPtr : otherPtr->nsPtr) == NULL)
		&& ((myFlags & (TCL_GLOBAL_ONLY | TCL_NAMESPACE_ONLY))
			|| (varFramePtr == NULL)
			|| !HasLocalVars(varFramePtr)
			|| (strstr(myName, "::") != NULL))) {
	    Tcl_AppendResult((Tcl_Interp *) iPtr, "bad variable name \"",
		    myName, "\": upvar won't create namespace variable that "
		    "refers to procedure variable", NULL);
	    return TCL_ERROR;
	}
    }

    return TclPtrMakeUpvar(interp, otherPtr, myName, myFlags, index);
}

	    p += strlen(p)-1;
	    if (*p == ')') {
		/*
		 * myName looks like an array reference.
		 */

		Tcl_AppendResult((Tcl_Interp *) iPtr, "bad variable name \"",
			myName, "\": upvar won't create a scalar variable "
			"that looks like an array element", NULL);
		return TCL_ERROR;
	    }
	}

	/*
	 * Lookup and eventually create the new variable. Set the flag bit

#
#----------------------------------------------------------------------
#
# Copyright (c) 2004,2005,2006,2007 by Kevin B. Kenny
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
#
# RCS: @(#) $Id: clock.tcl,v 1.4.2.17 2007/04/20 17:13:59 dgp Exp $
#
#----------------------------------------------------------------------

# We must have message catalogs that support the root locale, and
# we need access to the Registry on Windows systems.

uplevel \#0 {

			set d {}
			foreach triple [mc LOCALE_ERAS] {
			    foreach {t symbol year} $triple break
			    dict set d $symbol $year
			}
			foreach { regex lookup } [UniquePrefixRegexp $d] break
			append re (?: $regex )

		    }
		    E {
			set l {}
			dict set l [mc BCE] BCE
			dict set l [mc CE] CE
			dict set l B.C.E. BCE
			dict set l C.E. CE

			    [incr captureCount] \
			    "\]\n"
		    }
		    y {			# Locale-dependent year of the era
			foreach {regex lookup} \
			    [LocaleNumeralMatcher $locale] break
			append re $regex
			incr captureCount
		    }
		    default {
			append re %E
			if { ! [string is alnum $c] } {
			    append re \\
			    }
			append re $c

        "\u65e5\u66dc\u65e5"\
        "\u6708\u66dc\u65e5"\
        "\u706b\u66dc\u65e5"\
        "\u6c34\u66dc\u65e5"\
        "\u6728\u66dc\u65e5"\
        "\u91d1\u66dc\u65e5"\
        "\u571f\u66dc\u65e5"]














    ::msgcat::mcset ja MONTHS_FULL [list \
        "1\u6708"\
        "2\u6708"\
        "3\u6708"\
        "4\u6708"\
        "5\u6708"\
        "6\u6708"\
        "7\u6708"\
        "8\u6708"\
        "9\u6708"\
        "10\u6708"\
        "11\u6708"\
        "12\u6708"]

    ::msgcat::mcset ja BCE "\u7d00\u5143\u524d"
    ::msgcat::mcset ja CE "\u897f\u66a6"
    ::msgcat::mcset ja AM "\u5348\u524d"
    ::msgcat::mcset ja PM "\u5348\u5f8c"
    ::msgcat::mcset ja DATE_FORMAT "%Y/%m/%d"
    ::msgcat::mcset ja TIME_FORMAT "%k:%M:%S"
    ::msgcat::mcset ja TIME_FORMAT_12 "%P %I:%M:%S"
    ::msgcat::mcset ja DATE_TIME_FORMAT "%Y/%m/%d %k:%M:%S %z"

    ::msgcat::mcset ja LOCALE_DATE_FORMAT "%EY\u5e74%m\u6708%d\u65e5"
    ::msgcat::mcset ja LOCALE_TIME_FORMAT "%H\u6642%M\u5206%S\u79d2"
    ::msgcat::mcset ja LOCALE_DATE_TIME_FORMAT "%EY\u5e74%m\u6708%d\u65e5 (%a) %H\u6642%M\u5206%S\u79d2 %z"
    ::msgcat::mcset ja LOCALE_ERAS "\u007b-9223372036854775808 \u897f\u66a6 0\u007d \u007b-3061011600 \u660e\u6cbb 1867\u007d \u007b-1812186000 \u5927\u6b63 1911\u007d \u007b-1357635600 \u662d\u548c 1925\u007d \u007b600220800 \u5e73\u6210 1988\u007d"
}

#
# Copyright (c) 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: basic.test,v 1.27.2.14 2007/04/20 17:13:59 dgp Exp $
#

package require tcltest 2
namespace import -force ::tcltest::*

testConstraint testevalex [llength [info commands testevalex]]
testConstraint testcmdtoken [llength [info commands testcmdtoken]]

         [test_ns_basic::hideCmd] \
         [catch {cmd} msg] $msg \
         [test_ns_basic::exposeCmd] \
         [test_ns_basic::callCmd] \
         [namespace delete test_ns_basic]
} {:: {} 1 {invalid command name "cmd"} {} :: {}}

test basic-13.1 {Tcl_ExposeCommand, a command stays in the global namespace and cannot go to another namespace} {
    catch {namespace delete test_ns_basic}
    catch {rename cmd ""}
    proc cmd {} {   ;# note that this is global
        return [namespace current]
    }
    namespace eval test_ns_basic {
        proc hideCmd {} {

    }
    list [test_ns_basic::callCmd] \
         [test_ns_basic::hideCmd] \
         [catch {test_ns_basic::exposeCmdFailing} msg] $msg \
         [test_ns_basic::exposeCmdWorkAround] \
         [test_ns_basic::newCmd] \
         [namespace delete test_ns_basic]
} {:: {} 1 {cannot expose to a namespace (use expose to toplevel, then rename)} {} ::test_ns_basic {}}
test basic-13.2 {Tcl_ExposeCommand, invalidate cached refs to cmd now being exposed} {
    catch {rename p ""}
    catch {rename cmd ""}
    proc p {} {
        cmd
    }
    proc cmd {} {

# clock.test --
#
#	This test file covers the 'clock' command that manipulates time.
#
# 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) 2004 by Kevin B. Kenny.  All rights reserved.
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
#
# RCS: @(#) $Id: clock.test,v 1.23.2.21 2007/04/20 17:14:00 dgp Exp $

if {[lsearch [namespace children] ::tcltest] == -1} {
    package require tcltest 2
    namespace import -force ::tcltest::*
}

if {[testConstraint win]} {

    -setup {
	if { [info exists env(TZ)] } {
	    set oldTZ $env(TZ)
	}
	set env(TZ) UTC0
    } \
    -body {
	clock scan 2000-01-01T00:00:00 -timezone :localtime \
	    -format %Y-%m-%dT%H:%M:%S
    } \
    -cleanup {
	if { [info exists oldTZ] } {
	    set env(TZ) $oldTZ
	    unset oldTZ
	} else {
	    unset env(TZ)
	}
    } \
    -result 946684800

test clock-41.1 {regression test - format group %k when hour is 0 } {
    clock format 0 -format %k -gmt true
} { 0}

test clock-42.1 {regression test - %z in :localtime when west of Greenwich } \
    -setup {

    }
    -result {2040-07-01 00:00:00 PDT}
}

test clock-57.1 {clock scan - abbreviated options} {
    clock scan 1970-01-01 -f %Y-%m-%d -g true
} 0

test clock-58.1 {clock l10n - Japanese localisation} {*}{
    -setup {
	proc backslashify { string } {
	    
	    set retval {}
	    foreach char [split $string {}] {
		scan $char %c ccode
		if { $ccode >= 0x0020 && $ccode < 0x007f
		     && $char ne "\{" && $char ne "\}" && $char ne "\["
		     && $char ne "\]" && $char ne "\\" && $char ne "\$" } {
		    append retval $char
		} else {
		    append retval \\u [format %04x $ccode]
		}
	    }
	    return $retval
	}
    }
    -body {
	set trouble {}
	foreach {date jdate} [list \
	    1872-12-31 \u897f\u66a61872\u5e7412\u670831\u65e5 \
	    1873-01-01 \u660e\u6cbb06\u5e7401\u670801\u65e5 \
	    1912-07-29 \u660e\u6cbb45\u5e7407\u670829\u65e5 \
	    1912-07-30 \u5927\u6b6301\u5e7407\u670830\u65e5 \
	    1926-12-24 \u5927\u6b6315\u5e7412\u670824\u65e5 \
	    1926-12-25 \u662d\u548c01\u5e7412\u670825\u65e5 \
	    1989-01-07 \u662d\u548c64\u5e7401\u670807\u65e5 \
	    1989-01-08 \u5e73\u621001\u5e7401\u670808\u65e5 \
	] {
	    set status [catch {
		set secs [clock scan $date \
			      -timezone +0900 \
			      -locale ja_JP \
			      -format %Y-%m-%d]
		set jda [clock format $secs \
			     -timezone +0900 \
			     -locale ja_JP \
			     -format %Ex]
	    } result]
	    if {$status != 0} {
		append trouble \n $date " gives error " $result
	    } elseif {$jda ne $jdate} {
		append trouble \n $date " converts to " \
		    [backslashify $jda] " and should be " \
		    [backslashify $jdate]
	    }
	    # There is no code for scanning dates on the locale's
	    # alternative calendar.
	    continue
	    set status [catch {
		set secs [clock scan $jdate \
			      -timezone +0900 \
			      -locale ja_JP \
			      -format %Ex]
		set da [clock format $secs \
			    -timezone +0900 \
			    -locale ja_JP \
			    -format %Y-%m-%d]
	    } result]
	    if {$status != 0} {
		append trouble \n [backslashify $jdate] " gives error " $result
	    } elseif {$da ne $date} {
		append trouble \n [backslashify $jdate] " converts to " \
		    $da " and should be " $date
	    }
	}
	set trouble
    }
    -cleanup {
	rename backslashify {}
    }
    -result {}
}

test clock-59.1 {military time zones} {
    set hour 0
    set base [clock scan "20000101 000000" -format "%Y%m%d %H%M%S" -gmt 1]
    set trouble {}
    foreach {pzone mzone} {
	Z Z  A N  B O  C P  D Q  E R  F S  G T  H U  I V  K W  L X  M Y
    } {
	catch {clock scan "20000101 000000 $pzone" \
		   -format "%Y%m%d %H%M%S %Z"} ps1
	catch {clock scan "20000101 000000 $pzone"} ps2
	catch {clock scan "20000101 000000 $mzone" \
		   -format "%Y%m%d %H%M%S %Z"} ms1
	catch {clock scan "20000101 000000 $mzone"} ms2
	if {$ps1 != $base - 3600 * $hour} {
	    lappend trouble [list pzone $pzone hour $hour ps1 is $ps1]
	}
	if {$ps2 != $base - 3600 * $hour} {
	    lappend trouble [list pzone $pzone ps2 is $ps2]
	}
	if {$ms1 != $base + 3600 * $hour} {
	    lappend trouble [list mzone $mzone ms1 is $ms1]
	}
	if {$ms2 != $base + 3600 * $hour} {
	    lappend trouble [list mzone $mzone ms2 is $ms2]
	}
	incr hour
    }
    join $trouble \n
} {}

# cleanup

namespace delete ::testClock
::tcl::clock::ClearCaches
::tcltest::cleanupTests
return

# Local Variables:
# mode: tcl
# End:

# registry.test --
#
# This file contains a collection of tests for the registry command.
# Sourcing this file into Tcl runs the tests and generates output for
# errors.  No output means no errors were found.
#
# In order for these tests to run, the registry package must be on the
# auto_path or the registry package must have been loaded already.
#
# Copyright (c) 1997 by Sun Microsystems, Inc.  All rights reserved.
# Copyright (c) 1998-1999 by Scriptics Corporation.
#
# RCS: @(#) $Id: registry.test,v 1.14.2.7 2007/04/20 17:14:01 dgp Exp $

if {[lsearch [namespace children] ::tcltest] == -1} {
    package require tcltest 2
    namespace import -force ::tcltest::*
}

testConstraint reg 0

    registry set HKEY_CLASSES_ROOT\\TclFoobar\\blat
    registry set HKEY_CLASSES_ROOT\\TclFoobar\\foo
    set result [lsort [registry keys HKEY_CLASSES_ROOT\\TclFoobar b*]]
    registry delete HKEY_CLASSES_ROOT\\TclFoobar
    set result
} "baz\u30b7bar blat"
test registry-4.9 {GetKeyNames: very long key [Bug 1682211]} {*}{
    -constraints {win reg}
    -setup {
	registry set HKEY_CLASSES_ROOT\\TclFoobar\\a
	registry set HKEY_CLASSES_ROOT\\TclFoobar\\b[string repeat x 254]
	registry set HKEY_CLASSES_ROOT\\TclFoobar\\c
    }
    -body {
	lsort [registry keys HKEY_CLASSES_ROOT\\TclFoobar]

#
#----------------------------------------------------------------------
#
# Copyright (c) 2004 by Kevin B. Kenny.  All rights reserved.
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
#
# RCS: @(#) $Id: loadICU.tcl,v 1.1.2.3 2007/04/20 17:14:01 dgp Exp $
#
#----------------------------------------------------------------------

# Calculate the Chinese numerals from zero to ninety-nine.

set zhDigits [list {} \u4e00 \u4e8c \u4e09 \u56db \
		  \u4e94 \u516d \u4e03 \u516b \u4e5d]

    }
    incr t 10
}

# Set format overrides for various locales.

set format(zh,LOCALE_NUMERALS) $zhNumbers

set format(ja,LOCALE_ERAS) [list \
				[list -9223372036854775808 \u897f\u66a6 0 ] \
				[list -3061011600 \u660e\u6cbb 1867] \
				[list -1812186000 \u5927\u6b63 1911] \
				[list -1357635600 \u662d\u548c 1925] \
				[list 600220800 \u5e73\u6210 1988]]
set format(zh,LOCALE_DATE_FORMAT) "\u516c\u5143%Y\u5e74%B%Od\u65E5"
set format(ja,LOCALE_DATE_FORMAT) "%EY\u5e74%m\u6708%d\u65E5"
set format(ko,LOCALE_DATE_FORMAT) "%Y\ub144%B%Od\uc77c"
set format(zh,LOCALE_TIME_FORMAT) "%OH\u65f6%OM\u5206%OS\u79d2"
set format(ja,LOCALE_TIME_FORMAT) "%H\u6642%M\u5206%S\u79d2"
set format(ko,LOCALE_TIME_FORMAT) "%H\uc2dc%M\ubd84%S\ucd08"
set format(zh,LOCALE_DATE_TIME_FORMAT) "%A %Y\u5e74%B%Od\u65E5%OH\u65f6%OM\u5206%OS\u79d2 %z"
set format(ja,LOCALE_DATE_TIME_FORMAT) "%EY\u5e74%m\u6708%d\u65E5 (%a) %H\u6642%M\u5206%S\u79d2 %z"
set format(ko,LOCALE_DATE_TIME_FORMAT) "%A %Y\ub144%B%Od\uc77c%H\uc2dc%M\ubd84%S\ucd08 %z"
set format(ja,TIME_FORMAT_12) {%P %I:%M:%S}

# The next set of format overrides were obtained from the glibc
# localization strings.

set format(cs_CZ,DATE_FORMAT) %d.%m.%Y
set format(cs_CZ,DATE_TIME_FORMAT) {%a %e. %B %Y, %H:%M:%S %z}
set format(cs_CZ,TIME_FORMAT) %H:%M:%S

/*
 * tclUnixChan.c
 *
 *	Common channel driver for Unix channels based on files, command pipes
 *	and TCP sockets.
 *
 * Copyright (c) 1995-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: tclUnixChan.c,v 1.42.4.23 2007/04/20 17:14:01 dgp Exp $
 */

#include "tclInt.h"	/* Internal definitions for Tcl. */
#include "tclIO.h"	/* To get Channel type declaration. */

/*
 * sys/ioctl.h has already been included by tclPort.h. Including termios.h or

	    return TCL_ERROR;
#endif /* CRTSCTS */
	} else if (strncasecmp(value, "DTRDSR", vlen) == 0) {
	    UNSUPPORTED_OPTION("-handshake DTRDSR");
	    return TCL_ERROR;
	} else {
	    if (interp) {
		Tcl_AppendResult(interp, "bad value for -handshake: "
			"must be one of xonxoff, rtscts, dtrdsr or none",
			NULL);
	    }
	    return TCL_ERROR;
	}
	SETIOSTATE(fsPtr->fd, &iostate);
	return TCL_OK;

	int i;
	if (Tcl_SplitList(interp, value, &argc, &argv) == TCL_ERROR) {
	    return TCL_ERROR;
	}
	if ((argc % 2) == 1) {
	    if (interp) {
		Tcl_AppendResult(interp,
			"bad value for -ttycontrol: should be a list of"
			"signal,value pairs", NULL);
	    }
	    ckfree((char *) argv);
	    return TCL_ERROR;
	}

	GETCONTROL(fsPtr->fd, &control);

		UNSUPPORTED_OPTION("-ttycontrol BREAK");
		ckfree((char *) argv);
		return TCL_ERROR;
#endif /* SETBREAK */
	    } else {
		if (interp) {
		    Tcl_AppendResult(interp, "bad signal \"", argv[i],
			    "\" for -ttycontrol: must be "
			    "DTR, RTS or BREAK", NULL);
		}
		ckfree((char *) argv);
		return TCL_ERROR;
	    }
	} /* -ttycontrol options loop */

/*
 * tclUnixTest.c --
 *
 *	Contains platform specific test commands for the Unix platform.
 *
 * Copyright (c) 1996-1997 Sun Microsystems, Inc.
 * Copyright (c) 1998 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: tclUnixTest.c,v 1.14.4.12 2007/04/20 17:14:01 dgp Exp $
 */

#include "tclInt.h"

/*
 * The headers are needed for the testalarm command that verifies the use of
 * SA_RESTART in signal handlers.

	if (i & TCL_WRITABLE) {
	    Tcl_AppendElement(interp, "writable");
	}
    } else if (strcmp(argv[1], "windowevent") == 0) {
	Tcl_DoOneEvent(TCL_WINDOW_EVENTS|TCL_DONT_WAIT);
    } else {
	Tcl_AppendResult(interp, "bad option \"", argv[1],
		"\": must be close, clear, counts, create, empty, fill, "
		"fillpartial, oneevent, wait, or windowevent", NULL);
	return TCL_ERROR;
    }
    return TCL_OK;
}

static void

/*
 * tclWinLoad.c --
 *
 *	This function provides a version of the TclLoadFile that works with
 *	the Windows "LoadLibrary" and "GetProcAddress" API for dynamic
 *	loading.
 *
 * 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: tclWinLoad.c,v 1.15.4.4 2007/04/20 17:14:01 dgp Exp $
 */

#include "tclWinInt.h"


/*
 *----------------------------------------------------------------------

	 * about any problem, but it's better than nothing. It'd be even
	 * better if there was a way to get what DLLs
	 */

	switch (lastError) {
	case ERROR_MOD_NOT_FOUND:
	case ERROR_DLL_NOT_FOUND:
	    Tcl_AppendResult(interp, "this library or a dependent library"
		    " could not be found in library path", NULL);
	    break;
	case ERROR_PROC_NOT_FOUND:
	    Tcl_AppendResult(interp, "A function specified in the import"
		    " table could not be resolved by the system.  Windows"
		    " is not telling which one, I'm sorry.", NULL);
	    break;
	case ERROR_INVALID_DLL:
	    Tcl_AppendResult(interp, "this library or a dependent library"
		    " is damaged", NULL);
	    break;
	case ERROR_DLL_INIT_FAILED:
	    Tcl_AppendResult(interp, "the library initialization"
		    " routine failed", NULL);
	    break;
	default:
	    TclWinConvertError(lastError);
	    Tcl_AppendResult(interp, Tcl_PosixError(interp), NULL);
	}
	return TCL_ERROR;

/*
 * tclWinSerial.c --
 *
 *	This file implements the Windows-specific serial port functions, and
 *	the "serial" channel driver.
 *
 * Copyright (c) 1999 by Scriptics Corp.
 *
 * See the file "license.terms" for information on usage and redistribution of
 * this file, and for a DISCLAIMER OF ALL WARRANTIES.
 *
 * Serial functionality implemented by Rolf.Schroedter@dlr.de
 *
 * RCS: @(#) $Id: tclWinSerial.c,v 1.26.2.7 2007/04/20 17:14:02 dgp Exp $
 */

#include "tclWinInt.h"

#include <fcntl.h>
#include <io.h>
#include <sys/stat.h>

	    dcb.fRtsControl = RTS_CONTROL_HANDSHAKE;
	} else if (strnicmp(value, "DTRDSR", vlen) == 0) {
	    dcb.fOutxDsrFlow = TRUE;
	    dcb.fDtrControl = DTR_CONTROL_HANDSHAKE;
	} else {
	    if (interp != NULL) {
		Tcl_AppendResult(interp, "bad value \"", value,
			"\" for -handshake: must be one of xonxoff, rtscts, "
			"dtrdsr or none", NULL);
	    }
	    return TCL_ERROR;
	}

	if (!SetCommState(infoPtr->handle, &dcb)) {
	    if (interp != NULL) {

	if (Tcl_SplitList(interp, value, &argc, &argv) == TCL_ERROR) {
	    return TCL_ERROR;
	}
	if (argc != 2) {
	badXchar:
	    if (interp != NULL) {
		Tcl_AppendResult(interp, "bad value for -xchar: should be "
			"a list of two elements with each a single character",
			NULL);
	    }
	    ckfree((char *) argv);
	    return TCL_ERROR;
	}

	if (Tcl_SplitList(interp, value, &argc, &argv) == TCL_ERROR) {
	    return TCL_ERROR;
	}
	if ((argc % 2) == 1) {
	    if (interp != NULL) {
		Tcl_AppendResult(interp, "bad value \"", value,
			"\" for -ttycontrol: should be a list of "
			"signal,value pairs", NULL);
	    }
	    ckfree((char *) argv);
	    return TCL_ERROR;
	}

	for (i = 0; i < argc - 1; i += 2) {

	    outSize = atoi(argv[1]);
	}
	ckfree((char *) argv);

	if ((argc < 1) || (argc > 2) || (inSize <= 0) || (outSize <= 0)) {
	    if (interp != NULL) {
		Tcl_AppendResult(interp, "bad value \"", value,
			"\" for -sysbuffer: should be a list of one or two "
			"integers > 0", NULL);
	    }
	    return TCL_ERROR;
	}

	if (!SetupComm(infoPtr->handle, inSize, outSize)) {
	    if (interp != NULL) {