summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authorsebres <sebres@users.sourceforge.net>2017-05-10 12:28:46 (GMT)
committersebres <sebres@users.sourceforge.net>2017-05-10 12:28:46 (GMT)
commitee3d72e1e146c1a087e6a8a15e25ca97cbfed33a (patch)
treeb2f7992afa76a26e513ab92ab8e7b65f9faf8593
parent2752a9f58b6ee57703c3bc087133751e0192f150 (diff)
parent30dc72c0aa2b66c459e1f9d5d4ce1290f7f8779b (diff)
downloadtcl-ee3d72e1e146c1a087e6a8a15e25ca97cbfed33a.zip
tcl-ee3d72e1e146c1a087e6a8a15e25ca97cbfed33a.tar.gz
tcl-ee3d72e1e146c1a087e6a8a15e25ca97cbfed33a.tar.bz2
[interim-merge-commit] back-ported branch sebres-clock-speedup (from trunk to 8.6): tcl-clock functionality rewritten in C.
-rw-r--r--generic/tclClock.c2506
-rw-r--r--generic/tclDate.c558
-rw-r--r--generic/tclDictObj.c99
-rw-r--r--generic/tclEnv.c9
-rw-r--r--generic/tclGetDate.y196
-rw-r--r--generic/tclInt.h8
-rw-r--r--library/clock.tcl2840
-rw-r--r--library/init.tcl20
-rw-r--r--library/msgcat/msgcat.tcl125
-rw-r--r--tests/clock.test366
-rw-r--r--tests/msgcat.test2
-rw-r--r--unix/Makefile.in12
-rw-r--r--win/Makefile.in2
-rw-r--r--win/makefile.vc2486
14 files changed, 4560 insertions, 4669 deletions
diff --git a/generic/tclClock.c b/generic/tclClock.c
index a24b126..8e176b6 100644
--- a/generic/tclClock.c
+++ b/generic/tclClock.c
@@ -8,12 +8,15 @@
* Copyright 1991-1995 Karl Lehenbauer and Mark Diekhans.
* Copyright (c) 1995 Sun Microsystems, Inc.
* Copyright (c) 2004 by Kevin B. Kenny. All rights reserved.
+ * Copyright (c) 2015 by Sergey G. Brester aka sebres. All rights reserved.
*
* See the file "license.terms" for information on usage and redistribution of
* this file, and for a DISCLAIMER OF ALL WARRANTIES.
*/
#include "tclInt.h"
+#include "tclStrIdxTree.h"
+#include "tclDate.h"
/*
* Windows has mktime. The configurators do not check.
@@ -24,21 +27,6 @@
#endif
/*
- * Constants
- */
-
-#define JULIAN_DAY_POSIX_EPOCH 2440588
-#define SECONDS_PER_DAY 86400
-#define JULIAN_SEC_POSIX_EPOCH (((Tcl_WideInt) JULIAN_DAY_POSIX_EPOCH) \
- * SECONDS_PER_DAY)
-#define FOUR_CENTURIES 146097 /* days */
-#define JDAY_1_JAN_1_CE_JULIAN 1721424
-#define JDAY_1_JAN_1_CE_GREGORIAN 1721426
-#define ONE_CENTURY_GREGORIAN 36524 /* days */
-#define FOUR_YEARS 1461 /* days */
-#define ONE_YEAR 365 /* days */
-
-/*
* Table of the days in each month, leap and common years
*/
@@ -55,70 +43,13 @@ static const int daysInPriorMonths[2][13] = {
* Enumeration of the string literals used in [clock]
*/
-typedef enum ClockLiteral {
- LIT__NIL,
- LIT__DEFAULT_FORMAT,
- LIT_BCE, LIT_C,
- LIT_CANNOT_USE_GMT_AND_TIMEZONE,
- LIT_CE,
- LIT_DAYOFMONTH, LIT_DAYOFWEEK, LIT_DAYOFYEAR,
- LIT_ERA, LIT_GMT, LIT_GREGORIAN,
- LIT_INTEGER_VALUE_TOO_LARGE,
- LIT_ISO8601WEEK, LIT_ISO8601YEAR,
- LIT_JULIANDAY, LIT_LOCALSECONDS,
- LIT_MONTH,
- LIT_SECONDS, LIT_TZNAME, LIT_TZOFFSET,
- LIT_YEAR,
- LIT__END
-} ClockLiteral;
-static const char *const literals[] = {
- "",
- "%a %b %d %H:%M:%S %Z %Y",
- "BCE", "C",
- "cannot use -gmt and -timezone in same call",
- "CE",
- "dayOfMonth", "dayOfWeek", "dayOfYear",
- "era", ":GMT", "gregorian",
- "integer value too large to represent",
- "iso8601Week", "iso8601Year",
- "julianDay", "localSeconds",
- "month",
- "seconds", "tzName", "tzOffset",
- "year"
-};
-
-/*
- * Structure containing the client data for [clock]
- */
-
-typedef struct ClockClientData {
- int refCount; /* Number of live references. */
- Tcl_Obj **literals; /* Pool of object literals. */
-} ClockClientData;
+CLOCK_LITERAL_ARRAY(Literals);
-/*
- * Structure containing the fields used in [clock format] and [clock scan]
- */
+/* Msgcat literals for exact match (mcKey) */
+CLOCK_LOCALE_LITERAL_ARRAY(MsgCtLiterals, "");
+/* Msgcat index literals prefixed with _IDX_, used for quick dictionary search */
+CLOCK_LOCALE_LITERAL_ARRAY(MsgCtLitIdxs, "_IDX_");
-typedef struct TclDateFields {
- Tcl_WideInt seconds; /* Time expressed in seconds from the Posix
- * epoch */
- Tcl_WideInt localSeconds; /* Local time expressed in nominal seconds
- * from the Posix epoch */
- int tzOffset; /* Time zone offset in seconds east of
- * Greenwich */
- Tcl_Obj *tzName; /* Time zone name */
- int julianDay; /* Julian Day Number in local time zone */
- enum {BCE=1, CE=0} era; /* Era */
- int gregorian; /* Flag == 1 if the date is Gregorian */
- int year; /* Year of the era */
- int dayOfYear; /* Day of the year (1 January == 1) */
- int month; /* Month number */
- int dayOfMonth; /* Day of the month */
- int iso8601Year; /* ISO8601 week-based year */
- int iso8601Week; /* ISO8601 week number */
- int dayOfWeek; /* Day of the week */
-} TclDateFields;
static const char *const eras[] = { "CE", "BCE", NULL };
/*
@@ -139,26 +70,23 @@ TCL_DECLARE_MUTEX(clockMutex)
* Function prototypes for local procedures in this file:
*/
-static int ConvertUTCToLocal(Tcl_Interp *,
- TclDateFields *, Tcl_Obj *, int);
static int ConvertUTCToLocalUsingTable(Tcl_Interp *,
- TclDateFields *, int, Tcl_Obj *const[]);
+ TclDateFields *, int, Tcl_Obj *const[],
+ Tcl_WideInt rangesVal[2]);
static int ConvertUTCToLocalUsingC(Tcl_Interp *,
TclDateFields *, int);
-static int ConvertLocalToUTC(Tcl_Interp *,
- TclDateFields *, Tcl_Obj *, int);
+static int ConvertLocalToUTC(ClientData clientData, Tcl_Interp *,
+ TclDateFields *, Tcl_Obj *timezoneObj, int);
static int ConvertLocalToUTCUsingTable(Tcl_Interp *,
- TclDateFields *, int, Tcl_Obj *const[]);
+ TclDateFields *, int, Tcl_Obj *const[],
+ Tcl_WideInt rangesVal[2]);
static int ConvertLocalToUTCUsingC(Tcl_Interp *,
TclDateFields *, int);
-static Tcl_Obj * LookupLastTransition(Tcl_Interp *, Tcl_WideInt,
- int, Tcl_Obj *const *);
+static int ClockConfigureObjCmd(ClientData clientData,
+ Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]);
static void GetYearWeekDay(TclDateFields *, int);
static void GetGregorianEraYearDay(TclDateFields *, int);
static void GetMonthDay(TclDateFields *);
-static void GetJulianDayFromEraYearWeekDay(TclDateFields *, int);
-static void GetJulianDayFromEraYearMonthDay(TclDateFields *, int);
-static int IsGregorianLeapYear(TclDateFields *);
static int WeekdayOnOrBefore(int, int);
static int ClockClicksObjCmd(
ClientData clientData, Tcl_Interp *interp,
@@ -166,6 +94,10 @@ static int ClockClicksObjCmd(
static int ClockConvertlocaltoutcObjCmd(
ClientData clientData, Tcl_Interp *interp,
int objc, Tcl_Obj *const objv[]);
+
+static int ClockGetDateFields(ClientData clientData,
+ Tcl_Interp *interp, TclDateFields *fields,
+ Tcl_Obj *timezoneObj, int changeover);
static int ClockGetdatefieldsObjCmd(
ClientData clientData, Tcl_Interp *interp,
int objc, Tcl_Obj *const objv[]);
@@ -184,13 +116,28 @@ static int ClockMicrosecondsObjCmd(
static int ClockMillisecondsObjCmd(
ClientData clientData, Tcl_Interp *interp,
int objc, Tcl_Obj *const objv[]);
-static int ClockParseformatargsObjCmd(
+static int ClockSecondsObjCmd(
ClientData clientData, Tcl_Interp *interp,
int objc, Tcl_Obj *const objv[]);
-static int ClockSecondsObjCmd(
+static int ClockFormatObjCmd(
+ ClientData clientData, Tcl_Interp *interp,
+ int objc, Tcl_Obj *const objv[]);
+static int ClockScanObjCmd(
+ ClientData clientData, Tcl_Interp *interp,
+ int objc, Tcl_Obj *const objv[]);
+static int ClockScanCommit(
+ ClientData clientData, register DateInfo *info,
+ register ClockFmtScnCmdArgs *opts);
+static int ClockFreeScan(
+ register DateInfo *info,
+ Tcl_Obj *strObj, ClockFmtScnCmdArgs *opts);
+static int ClockCalcRelTime(
+ register DateInfo *info, ClockFmtScnCmdArgs *opts);
+static int ClockAddObjCmd(
ClientData clientData, Tcl_Interp *interp,
int objc, Tcl_Obj *const objv[]);
static struct tm * ThreadSafeLocalTime(const time_t *);
+static unsigned long TzsetGetEpoch(void);
static void TzsetIfNecessary(void);
static void ClockDeleteCmdProc(ClientData);
@@ -209,6 +156,9 @@ struct ClockCommand {
static const struct ClockCommand clockCommands[] = {
{ "getenv", ClockGetenvObjCmd },
+ { "format", ClockFormatObjCmd },
+ { "scan", ClockScanObjCmd },
+ { "configure", ClockConfigureObjCmd },
{ "Oldscan", TclClockOldscanObjCmd },
{ "ConvertLocalToUTC", ClockConvertlocaltoutcObjCmd },
{ "GetDateFields", ClockGetdatefieldsObjCmd },
@@ -216,7 +166,6 @@ static const struct ClockCommand clockCommands[] = {
ClockGetjuliandayfromerayearmonthdayObjCmd },
{ "GetJulianDayFromEraYearWeekDay",
ClockGetjuliandayfromerayearweekdayObjCmd },
- { "ParseFormatArgs", ClockParseformatargsObjCmd },
{ NULL, NULL }
};
@@ -279,9 +228,33 @@ TclClockInit(
data->refCount = 0;
data->literals = ckalloc(LIT__END * sizeof(Tcl_Obj*));
for (i = 0; i < LIT__END; ++i) {
- data->literals[i] = Tcl_NewStringObj(literals[i], -1);
- Tcl_IncrRefCount(data->literals[i]);
+ Tcl_InitObjRef(data->literals[i], Tcl_NewStringObj(Literals[i], -1));
}
+ data->mcLiterals = NULL;
+ data->mcLitIdxs = NULL;
+ data->LastTZEpoch = 0;
+ data->currentYearCentury = ClockDefaultYearCentury;
+ data->yearOfCenturySwitch = ClockDefaultCenturySwitch;
+ data->SystemTimeZone = NULL;
+ data->SystemSetupTZData = NULL;
+ data->GMTSetupTimeZone = NULL;
+ data->GMTSetupTZData = NULL;
+ data->AnySetupTimeZone = NULL;
+ data->AnySetupTZData = NULL;
+ data->LastUnnormSetupTimeZone = NULL;
+ data->LastSetupTimeZone = NULL;
+ data->LastSetupTZData = NULL;
+
+ data->CurrentLocale = NULL;
+ data->CurrentLocaleDict = NULL;
+ data->LastUnnormUsedLocale = NULL;
+ data->LastUsedLocale = NULL;
+ data->LastUsedLocaleDict = NULL;
+
+ data->lastBase.timezoneObj = NULL;
+ data->UTC2Local.timezoneObj = NULL;
+ data->UTC2Local.tzName = NULL;
+ data->Local2UTC.timezoneObj = NULL;
/*
* Install the commands.
@@ -305,17 +278,881 @@ TclClockInit(
/*
*----------------------------------------------------------------------
*
+ * ClockConfigureClear --
+ *
+ * Clean up cached resp. run-time storages used in clock commands.
+ *
+ * Shared usage for clean-up (ClockDeleteCmdProc) and "configure -clear".
+ *
+ * Results:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+ClockConfigureClear(
+ ClockClientData *data)
+{
+ ClockFrmScnClearCaches();
+
+ data->LastTZEpoch = 0;
+ Tcl_UnsetObjRef(data->SystemTimeZone);
+ Tcl_UnsetObjRef(data->SystemSetupTZData);
+ Tcl_UnsetObjRef(data->GMTSetupTimeZone);
+ Tcl_UnsetObjRef(data->GMTSetupTZData);
+ Tcl_UnsetObjRef(data->AnySetupTimeZone);
+ Tcl_UnsetObjRef(data->AnySetupTZData);
+ Tcl_UnsetObjRef(data->LastUnnormSetupTimeZone);
+ Tcl_UnsetObjRef(data->LastSetupTimeZone);
+ Tcl_UnsetObjRef(data->LastSetupTZData);
+
+ Tcl_UnsetObjRef(data->CurrentLocale);
+ Tcl_UnsetObjRef(data->CurrentLocaleDict);
+ Tcl_UnsetObjRef(data->LastUnnormUsedLocale);
+ Tcl_UnsetObjRef(data->LastUsedLocale);
+ Tcl_UnsetObjRef(data->LastUsedLocaleDict);
+
+ Tcl_UnsetObjRef(data->lastBase.timezoneObj);
+ Tcl_UnsetObjRef(data->UTC2Local.timezoneObj);
+ Tcl_UnsetObjRef(data->UTC2Local.tzName);
+ Tcl_UnsetObjRef(data->Local2UTC.timezoneObj);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * ClockDeleteCmdProc --
+ *
+ * Remove a reference to the clock client data, and clean up memory
+ * when it's all gone.
+ *
+ * Results:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+static void
+ClockDeleteCmdProc(
+ ClientData clientData) /* Opaque pointer to the client data */
+{
+ ClockClientData *data = clientData;
+ int i;
+
+ if (data->refCount-- <= 1) {
+ for (i = 0; i < LIT__END; ++i) {
+ Tcl_DecrRefCount(data->literals[i]);
+ }
+ if (data->mcLiterals != NULL) {
+ for (i = 0; i < MCLIT__END; ++i) {
+ Tcl_DecrRefCount(data->mcLiterals[i]);
+ }
+ data->mcLiterals = NULL;
+ }
+ if (data->mcLitIdxs != NULL) {
+ for (i = 0; i < MCLIT__END; ++i) {
+ Tcl_DecrRefCount(data->mcLitIdxs[i]);
+ }
+ data->mcLitIdxs = NULL;
+ }
+
+ ClockConfigureClear(data);
+
+ ckfree(data->literals);
+ ckfree(data);
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * NormTimezoneObj --
+ *
+ * Normalizes the timezone object (used for caching puposes).
+ *
+ * If already cached time zone could be found, returns this
+ * object (last setup or last used, system (current) or gmt).
+ *
+ * Results:
+ * Normalized tcl object pointer.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static inline Tcl_Obj *
+NormTimezoneObj(
+ ClockClientData *dataPtr, /* Client data containing literal pool */
+ Tcl_Obj *timezoneObj)
+{
+ const char *tz;
+ if ( timezoneObj == dataPtr->LastUnnormSetupTimeZone
+ && dataPtr->LastSetupTimeZone != NULL
+ ) {
+ return dataPtr->LastSetupTimeZone;
+ }
+ if ( timezoneObj == dataPtr->LastSetupTimeZone
+ || timezoneObj == dataPtr->literals[LIT_GMT]
+ || timezoneObj == dataPtr->SystemTimeZone
+ || timezoneObj == dataPtr->AnySetupTimeZone
+ ) {
+ return timezoneObj;
+ }
+
+ tz = TclGetString(timezoneObj);
+ if (dataPtr->AnySetupTimeZone != NULL &&
+ (timezoneObj == dataPtr->AnySetupTimeZone
+ || strcmp(tz, TclGetString(dataPtr->AnySetupTimeZone)) == 0
+ )
+ ) {
+ timezoneObj = dataPtr->AnySetupTimeZone;
+ }
+ else
+ if (dataPtr->SystemTimeZone != NULL &&
+ (timezoneObj == dataPtr->SystemTimeZone
+ || strcmp(tz, TclGetString(dataPtr->SystemTimeZone)) == 0
+ )
+ ) {
+ timezoneObj = dataPtr->SystemTimeZone;
+ }
+ else
+ if (
+ strcmp(tz, Literals[LIT_GMT]) == 0
+ ) {
+ timezoneObj = dataPtr->literals[LIT_GMT];
+ }
+ return timezoneObj;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * ClockGetSystemLocale --
+ *
+ * Returns system locale.
+ *
+ * Executes ::tcl::clock::GetSystemLocale in given interpreter.
+ *
+ * Results:
+ * Returns system locale tcl object.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static inline Tcl_Obj *
+ClockGetSystemLocale(
+ ClockClientData *dataPtr, /* Opaque pointer to literal pool, etc. */
+ Tcl_Interp *interp) /* Tcl interpreter */
+{
+ if (Tcl_EvalObjv(interp, 1, &dataPtr->literals[LIT_GETSYSTEMLOCALE], 0) != TCL_OK) {
+ return NULL;
+ }
+
+ return Tcl_GetObjResult(interp);
+}
+/*
+ *----------------------------------------------------------------------
+ *
+ * ClockGetCurrentLocale --
+ *
+ * Returns current locale.
+ *
+ * Executes ::tcl::clock::mclocale in given interpreter.
+ *
+ * Results:
+ * Returns current locale tcl object.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static inline Tcl_Obj *
+ClockGetCurrentLocale(
+ ClockClientData *dataPtr, /* Client data containing literal pool */
+ Tcl_Interp *interp) /* Tcl interpreter */
+{
+ if (Tcl_EvalObjv(interp, 1, &dataPtr->literals[LIT_GETCURRENTLOCALE], 0) != TCL_OK) {
+ return NULL;
+ }
+
+ Tcl_SetObjRef(dataPtr->CurrentLocale, Tcl_GetObjResult(interp));
+ Tcl_UnsetObjRef(dataPtr->CurrentLocaleDict);
+
+ return dataPtr->CurrentLocale;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * NormLocaleObj --
+ *
+ * Normalizes the locale object (used for caching puposes).
+ *
+ * If already cached locale could be found, returns this
+ * object (current, system (OS) or last used locales).
+ *
+ * Results:
+ * Normalized tcl object pointer.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static Tcl_Obj *
+NormLocaleObj(
+ ClockClientData *dataPtr, /* Client data containing literal pool */
+ Tcl_Interp *interp, /* Tcl interpreter */
+ Tcl_Obj *localeObj,
+ Tcl_Obj **mcDictObj)
+{
+ const char *loc;
+ if ( localeObj == NULL || localeObj == dataPtr->CurrentLocale
+ || localeObj == dataPtr->literals[LIT_C]
+ || localeObj == dataPtr->literals[LIT_CURRENT]
+ ) {
+ if (dataPtr->CurrentLocale == NULL) {
+ ClockGetCurrentLocale(dataPtr, interp);
+ }
+ *mcDictObj = dataPtr->CurrentLocaleDict;
+ return dataPtr->CurrentLocale;
+ }
+ if ( localeObj == dataPtr->LastUsedLocale
+ || localeObj == dataPtr->LastUnnormUsedLocale
+ ) {
+ *mcDictObj = dataPtr->LastUsedLocaleDict;
+ return dataPtr->LastUsedLocale;
+ }
+
+ loc = TclGetString(localeObj);
+ if ( dataPtr->CurrentLocale != NULL
+ && ( localeObj == dataPtr->CurrentLocale
+ || (localeObj->length == dataPtr->CurrentLocale->length
+ && strcmp(loc, TclGetString(dataPtr->CurrentLocale)) == 0
+ )
+ )
+ ) {
+ *mcDictObj = dataPtr->CurrentLocaleDict;
+ localeObj = dataPtr->CurrentLocale;
+ }
+ else
+ if ( dataPtr->LastUsedLocale != NULL
+ && ( localeObj == dataPtr->LastUsedLocale
+ || (localeObj->length == dataPtr->LastUsedLocale->length
+ && strcmp(loc, TclGetString(dataPtr->LastUsedLocale)) == 0
+ )
+ )
+ ) {
+ *mcDictObj = dataPtr->LastUsedLocaleDict;
+ Tcl_SetObjRef(dataPtr->LastUnnormUsedLocale, localeObj);
+ localeObj = dataPtr->LastUsedLocale;
+ }
+ else
+ if (
+ (localeObj->length == 1 /* C */
+ && strncasecmp(loc, Literals[LIT_C], localeObj->length) == 0)
+ || (localeObj->length == 7 /* current */
+ && strncasecmp(loc, Literals[LIT_CURRENT], localeObj->length) == 0)
+ ) {
+ if (dataPtr->CurrentLocale == NULL) {
+ ClockGetCurrentLocale(dataPtr, interp);
+ }
+ *mcDictObj = dataPtr->CurrentLocaleDict;
+ localeObj = dataPtr->CurrentLocale;
+ }
+ else
+ if (
+ (localeObj->length == 6 /* system */
+ && strncasecmp(loc, Literals[LIT_SYSTEM], localeObj->length) == 0)
+ ) {
+ Tcl_SetObjRef(dataPtr->LastUnnormUsedLocale, localeObj);
+ localeObj = ClockGetSystemLocale(dataPtr, interp);
+ Tcl_SetObjRef(dataPtr->LastUsedLocale, localeObj);
+ *mcDictObj = NULL;
+ }
+ else
+ {
+ *mcDictObj = NULL;
+ }
+ return localeObj;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * ClockMCDict --
+ *
+ * Retrieves a localized storage dictionary object for the given
+ * locale object.
+ *
+ * This corresponds with call `::tcl::clock::mcget locale`.
+ * Cached representation stored in options (for further access).
+ *
+ * Results:
+ * Tcl-object contains smart reference to msgcat dictionary.
+ *
+ *----------------------------------------------------------------------
+ */
+
+MODULE_SCOPE Tcl_Obj *
+ClockMCDict(ClockFmtScnCmdArgs *opts)
+{
+ ClockClientData *dataPtr = opts->clientData;
+
+ /* if dict not yet retrieved */
+ if (opts->mcDictObj == NULL) {
+
+ /* if locale was not yet used */
+ if ( !(opts->flags & CLF_LOCALE_USED) ) {
+
+ opts->localeObj = NormLocaleObj(opts->clientData, opts->interp,
+ opts->localeObj, &opts->mcDictObj);
+
+ if (opts->localeObj == NULL) {
+ Tcl_SetResult(opts->interp,
+ "locale not specified and no default locale set", TCL_STATIC);
+ Tcl_SetErrorCode(opts->interp, "CLOCK", "badOption", NULL);
+ return NULL;
+ }
+ opts->flags |= CLF_LOCALE_USED;
+
+ /* check locale literals already available (on demand creation) */
+ if (dataPtr->mcLiterals == NULL) {
+ int i;
+ dataPtr->mcLiterals = ckalloc(MCLIT__END * sizeof(Tcl_Obj*));
+ for (i = 0; i < MCLIT__END; ++i) {
+ Tcl_InitObjRef(dataPtr->mcLiterals[i],
+ Tcl_NewStringObj(MsgCtLiterals[i], -1));
+ }
+ }
+ }
+
+ if (opts->mcDictObj == NULL) {
+ Tcl_Obj *callargs[2];
+ /* get msgcat dictionary - ::tcl::clock::mcget locale */
+ callargs[0] = dataPtr->literals[LIT_MCGET];
+ callargs[1] = opts->localeObj;
+
+ if (Tcl_EvalObjv(opts->interp, 2, callargs, 0) != TCL_OK) {
+ return NULL;
+ }
+
+ opts->mcDictObj = Tcl_GetObjResult(opts->interp);
+ /* be sure that object reference not increases (dict changeable) */
+ if (opts->mcDictObj->refCount > 0) {
+ /* smart reference (shared dict as object with no ref-counter) */
+ opts->mcDictObj = Tcl_DictObjSmartRef(opts->interp, opts->mcDictObj);
+ }
+ if ( opts->localeObj == dataPtr->CurrentLocale ) {
+ Tcl_SetObjRef(dataPtr->CurrentLocaleDict, opts->mcDictObj);
+ } else if ( opts->localeObj == dataPtr->LastUsedLocale ) {
+ Tcl_SetObjRef(dataPtr->LastUsedLocaleDict, opts->mcDictObj);
+ } else {
+ Tcl_SetObjRef(dataPtr->LastUsedLocale, opts->localeObj);
+ Tcl_UnsetObjRef(dataPtr->LastUnnormUsedLocale);
+ Tcl_SetObjRef(dataPtr->LastUsedLocaleDict, opts->mcDictObj);
+ }
+ Tcl_ResetResult(opts->interp);
+ }
+ }
+
+ return opts->mcDictObj;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * ClockMCGet --
+ *
+ * Retrieves a msgcat value for the given literal integer mcKey
+ * from localized storage (corresponding given locale object)
+ * by mcLiterals[mcKey] (e. g. MONTHS_FULL).
+ *
+ * Results:
+ * Tcl-object contains localized value.
+ *
+ *----------------------------------------------------------------------
+ */
+
+MODULE_SCOPE Tcl_Obj *
+ClockMCGet(
+ ClockFmtScnCmdArgs *opts,
+ int mcKey)
+{
+ ClockClientData *dataPtr = opts->clientData;
+
+ Tcl_Obj *valObj = NULL;
+
+ if (opts->mcDictObj == NULL) {
+ ClockMCDict(opts);
+ if (opts->mcDictObj == NULL)
+ return NULL;
+ }
+
+ Tcl_DictObjGet(opts->interp, opts->mcDictObj,
+ dataPtr->mcLiterals[mcKey], &valObj);
+
+ return valObj; /* or NULL in obscure case if Tcl_DictObjGet failed */
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * ClockMCGetIdx --
+ *
+ * Retrieves an indexed msgcat value for the given literal integer mcKey
+ * from localized storage (corresponding given locale object)
+ * by mcLitIdxs[mcKey] (e. g. _IDX_MONTHS_FULL).
+ *
+ * Results:
+ * Tcl-object contains localized indexed value.
+ *
+ *----------------------------------------------------------------------
+ */
+
+MODULE_SCOPE Tcl_Obj *
+ClockMCGetIdx(
+ ClockFmtScnCmdArgs *opts,
+ int mcKey)
+{
+ ClockClientData *dataPtr = opts->clientData;
+
+ Tcl_Obj *valObj = NULL;
+
+ if (opts->mcDictObj == NULL) {
+ ClockMCDict(opts);
+ if (opts->mcDictObj == NULL)
+ return NULL;
+ }
+
+ /* try to get indices object */
+ if (dataPtr->mcLitIdxs == NULL) {
+ return NULL;
+ }
+
+ if (Tcl_DictObjGet(NULL, opts->mcDictObj,
+ dataPtr->mcLitIdxs[mcKey], &valObj) != TCL_OK
+ ) {
+ return NULL;
+ }
+
+ return valObj;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * ClockMCSetIdx --
+ *
+ * Sets an indexed msgcat value for the given literal integer mcKey
+ * in localized storage (corresponding given locale object)
+ * by mcLitIdxs[mcKey] (e. g. _IDX_MONTHS_FULL).
+ *
+ * Results:
+ * Returns a standard Tcl result.
+ *
+ *----------------------------------------------------------------------
+ */
+
+MODULE_SCOPE int
+ClockMCSetIdx(
+ ClockFmtScnCmdArgs *opts,
+ int mcKey, Tcl_Obj *valObj)
+{
+ ClockClientData *dataPtr = opts->clientData;
+
+ if (opts->mcDictObj == NULL) {
+ ClockMCDict(opts);
+ if (opts->mcDictObj == NULL)
+ return TCL_ERROR;
+ }
+
+ /* if literal storage for indices not yet created */
+ if (dataPtr->mcLitIdxs == NULL) {
+ int i;
+ dataPtr->mcLitIdxs = ckalloc(MCLIT__END * sizeof(Tcl_Obj*));
+ for (i = 0; i < MCLIT__END; ++i) {
+ Tcl_InitObjRef(dataPtr->mcLitIdxs[i],
+ Tcl_NewStringObj(MsgCtLitIdxs[i], -1));
+ }
+ }
+
+ return Tcl_DictObjPut(opts->interp, opts->mcDictObj,
+ dataPtr->mcLitIdxs[mcKey], valObj);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * ClockConfigureObjCmd --
+ *
+ * This function is invoked to process the Tcl "clock configure" command.
+ *
+ * Usage:
+ * ::tcl::clock::configure ?-option ?value??
+ *
+ * Results:
+ * Returns a standard Tcl result.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+ClockConfigureObjCmd(
+ ClientData clientData, /* Client data containing literal pool */
+ Tcl_Interp *interp, /* Tcl interpreter */
+ int objc, /* Parameter count */
+ Tcl_Obj *const objv[]) /* Parameter vector */
+{
+ ClockClientData *dataPtr = clientData;
+
+ static const char *const options[] = {
+ "-system-tz", "-setup-tz", "-default-locale",
+ "-clear",
+ "-year-century", "-century-switch",
+ NULL
+ };
+ enum optionInd {
+ CLOCK_SYSTEM_TZ, CLOCK_SETUP_TZ, CLOCK_CURRENT_LOCALE,
+ CLOCK_CLEAR_CACHE,
+ CLOCK_YEAR_CENTURY, CLOCK_CENTURY_SWITCH,
+ CLOCK_SETUP_GMT, CLOCK_SETUP_NOP
+ };
+ int optionIndex; /* Index of an option. */
+ int i;
+
+ for (i = 1; i < objc; i++) {
+ if (Tcl_GetIndexFromObj(interp, objv[i++], options,
+ "option", 0, &optionIndex) != TCL_OK) {
+ Tcl_SetErrorCode(interp, "CLOCK", "badOption",
+ Tcl_GetString(objv[i-1]), NULL);
+ return TCL_ERROR;
+ }
+ switch (optionIndex) {
+ case CLOCK_SYSTEM_TZ:
+ if (1) {
+ /* validate current tz-epoch */
+ unsigned long lastTZEpoch = TzsetGetEpoch();
+ if (i < objc) {
+ if (dataPtr->SystemTimeZone != objv[i]) {
+ Tcl_SetObjRef(dataPtr->SystemTimeZone, objv[i]);
+ Tcl_UnsetObjRef(dataPtr->SystemSetupTZData);
+ }
+ dataPtr->LastTZEpoch = lastTZEpoch;
+ }
+ if (i+1 >= objc && dataPtr->SystemTimeZone != NULL
+ && dataPtr->LastTZEpoch == lastTZEpoch) {
+ Tcl_SetObjResult(interp, dataPtr->SystemTimeZone);
+ }
+ }
+ break;
+ case CLOCK_SETUP_TZ:
+ if (i < objc) {
+ /* differentiate GMT and system zones, because used often */
+ Tcl_Obj *timezoneObj = NormTimezoneObj(dataPtr, objv[i]);
+ Tcl_SetObjRef(dataPtr->LastUnnormSetupTimeZone, objv[i]);
+ if (dataPtr->LastSetupTimeZone != timezoneObj) {
+ Tcl_SetObjRef(dataPtr->LastSetupTimeZone, timezoneObj);
+ Tcl_UnsetObjRef(dataPtr->LastSetupTZData);
+ }
+ if (timezoneObj == dataPtr->literals[LIT_GMT]) {
+ optionIndex = CLOCK_SETUP_GMT;
+ } else if (timezoneObj == dataPtr->SystemTimeZone) {
+ optionIndex = CLOCK_SETUP_NOP;
+ }
+ switch (optionIndex) {
+ case CLOCK_SETUP_GMT:
+ if (i < objc) {
+ if (dataPtr->GMTSetupTimeZone != timezoneObj) {
+ Tcl_SetObjRef(dataPtr->GMTSetupTimeZone, timezoneObj);
+ Tcl_UnsetObjRef(dataPtr->GMTSetupTZData);
+ }
+ }
+ break;
+ case CLOCK_SETUP_TZ:
+ if (i < objc) {
+ if (dataPtr->AnySetupTimeZone != timezoneObj) {
+ Tcl_SetObjRef(dataPtr->AnySetupTimeZone, timezoneObj);
+ Tcl_UnsetObjRef(dataPtr->AnySetupTZData);
+ }
+ }
+ break;
+ }
+ }
+ if (i+1 >= objc && dataPtr->LastSetupTimeZone != NULL) {
+ Tcl_SetObjResult(interp, dataPtr->LastSetupTimeZone);
+ }
+ break;
+ case CLOCK_CURRENT_LOCALE:
+ if (i < objc) {
+ if (dataPtr->CurrentLocale != objv[i]) {
+ Tcl_SetObjRef(dataPtr->CurrentLocale, objv[i]);
+ Tcl_UnsetObjRef(dataPtr->CurrentLocaleDict);
+ }
+ }
+ if (i+1 >= objc && dataPtr->CurrentLocale != NULL) {
+ Tcl_SetObjResult(interp, dataPtr->CurrentLocale);
+ }
+ break;
+ case CLOCK_YEAR_CENTURY:
+ if (i < objc) {
+ int year;
+ if (TclGetIntFromObj(interp, objv[i], &year) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ dataPtr->currentYearCentury = year;
+ if (i+1 >= objc) {
+ Tcl_SetObjResult(interp, objv[i]);
+ }
+ continue;
+ }
+ if (i+1 >= objc) {
+ Tcl_SetObjResult(interp,
+ Tcl_NewIntObj(dataPtr->currentYearCentury));
+ }
+ break;
+ case CLOCK_CENTURY_SWITCH:
+ if (i < objc) {
+ int year;
+ if (TclGetIntFromObj(interp, objv[i], &year) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ dataPtr->yearOfCenturySwitch = year;
+ Tcl_SetObjResult(interp, objv[i]);
+ continue;
+ }
+ if (i+1 >= objc) {
+ Tcl_SetObjResult(interp,
+ Tcl_NewIntObj(dataPtr->yearOfCenturySwitch));
+ }
+ break;
+ case CLOCK_CLEAR_CACHE:
+ ClockConfigureClear(dataPtr);
+ break;
+ }
+ }
+
+ return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * ClockGetTZData --
+ *
+ * Retrieves tzdata table for given normalized timezone.
+ *
+ * Results:
+ * Returns a tcl object with tzdata.
+ *
+ * Side effects:
+ * The tzdata can be cached in ClockClientData structure.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static inline Tcl_Obj *
+ClockGetTZData(
+ ClientData clientData, /* Opaque pointer to literal pool, etc. */
+ Tcl_Interp *interp, /* Tcl interpreter */
+ Tcl_Obj *timezoneObj) /* Name of the timezone */
+{
+ ClockClientData *dataPtr = clientData;
+ Tcl_Obj **literals = dataPtr->literals;
+ Tcl_Obj *ret, **out = NULL;
+
+ /* if cached (if already setup this one) */
+ if ( dataPtr->LastSetupTZData != NULL
+ && ( timezoneObj == dataPtr->LastSetupTimeZone
+ || timezoneObj == dataPtr->LastUnnormSetupTimeZone
+ )
+ ) {
+ return dataPtr->LastSetupTZData;
+ }
+
+ /* differentiate GMT and system zones, because used often */
+ /* simple caching, because almost used the tz-data of last timezone
+ */
+ if (timezoneObj == dataPtr->SystemTimeZone) {
+ if (dataPtr->SystemSetupTZData != NULL) {
+ return dataPtr->SystemSetupTZData;
+ }
+ out = &dataPtr->SystemSetupTZData;
+ }
+ else
+ if (timezoneObj == dataPtr->GMTSetupTimeZone) {
+ if (dataPtr->GMTSetupTZData != NULL) {
+ return dataPtr->GMTSetupTZData;
+ }
+ out = &dataPtr->GMTSetupTZData;
+ }
+ else
+ if (timezoneObj == dataPtr->AnySetupTimeZone) {
+ if (dataPtr->AnySetupTZData != NULL) {
+ return dataPtr->AnySetupTZData;
+ }
+ out = &dataPtr->AnySetupTZData;
+ }
+
+ ret = Tcl_ObjGetVar2(interp, literals[LIT_TZDATA],
+ timezoneObj, TCL_LEAVE_ERR_MSG);
+
+ /* cache using corresponding slot and as last used */
+ if (out != NULL) {
+ Tcl_SetObjRef(*out, ret);
+ }
+ Tcl_SetObjRef(dataPtr->LastSetupTZData, ret);
+ if (dataPtr->LastSetupTimeZone != timezoneObj) {
+ Tcl_SetObjRef(dataPtr->LastSetupTimeZone, timezoneObj);
+ Tcl_UnsetObjRef(dataPtr->LastUnnormSetupTimeZone);
+ }
+ return ret;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * ClockGetSystemTimeZone --
+ *
+ * Returns system (current) timezone.
+ *
+ * If system zone not yet cached, it executes ::tcl::clock::GetSystemTimeZone
+ * in given interpreter and caches its result.
+ *
+ * Results:
+ * Returns normalized timezone object.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static Tcl_Obj *
+ClockGetSystemTimeZone(
+ ClientData clientData, /* Opaque pointer to literal pool, etc. */
+ Tcl_Interp *interp) /* Tcl interpreter */
+{
+ ClockClientData *dataPtr = clientData;
+ Tcl_Obj **literals;
+
+ /* if known (cached and same epoch) - return now */
+ if (dataPtr->SystemTimeZone != NULL
+ && dataPtr->LastTZEpoch == TzsetGetEpoch()) {
+ return dataPtr->SystemTimeZone;
+ }
+
+ Tcl_UnsetObjRef(dataPtr->SystemTimeZone);
+ Tcl_UnsetObjRef(dataPtr->SystemSetupTZData);
+
+ literals = dataPtr->literals;
+
+ if (Tcl_EvalObjv(interp, 1, &literals[LIT_GETSYSTEMTIMEZONE], 0) != TCL_OK) {
+ return NULL;
+ }
+ if (dataPtr->SystemTimeZone == NULL) {
+ Tcl_SetObjRef(dataPtr->SystemTimeZone, Tcl_GetObjResult(interp));
+ }
+ return dataPtr->SystemTimeZone;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * ClockSetupTimeZone --
+ *
+ * Sets up the timezone. Loads tzdata, etc.
+ *
+ * Results:
+ * Returns normalized timezone object.
+ *
+ *----------------------------------------------------------------------
+ */
+
+MODULE_SCOPE Tcl_Obj *
+ClockSetupTimeZone(
+ ClientData clientData, /* Opaque pointer to literal pool, etc. */
+ Tcl_Interp *interp, /* Tcl interpreter */
+ Tcl_Obj *timezoneObj)
+{
+ ClockClientData *dataPtr = clientData;
+ Tcl_Obj **literals = dataPtr->literals;
+ Tcl_Obj *callargs[2];
+
+ /* if cached (if already setup this one) */
+ if ( dataPtr->LastSetupTimeZone != NULL
+ && ( timezoneObj == dataPtr->LastSetupTimeZone
+ || timezoneObj == dataPtr->LastUnnormSetupTimeZone
+ )
+ ) {
+ return dataPtr->LastSetupTimeZone;
+ }
+
+ /* differentiate GMT and system zones, because used often and already set */
+ timezoneObj = NormTimezoneObj(dataPtr, timezoneObj);
+ if ( timezoneObj == dataPtr->GMTSetupTimeZone
+ || timezoneObj == dataPtr->SystemTimeZone
+ || timezoneObj == dataPtr->AnySetupTimeZone
+ ) {
+ return timezoneObj;
+ }
+
+ callargs[0] = literals[LIT_SETUPTIMEZONE];
+ callargs[1] = timezoneObj;
+
+ if (Tcl_EvalObjv(interp, 2, callargs, 0) == TCL_OK) {
+ return dataPtr->LastSetupTimeZone;
+ }
+ return NULL;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * ClockFormatNumericTimeZone --
+ *
+ * Formats a time zone as +hhmmss
+ *
+ * Parameters:
+ * z - Time zone in seconds east of Greenwich
+ *
+ * Results:
+ * Returns the time zone object (formatted in a numeric form)
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+Tcl_Obj *
+ClockFormatNumericTimeZone(int z) {
+ char sign = '+';
+ int h, m;
+ if ( z < 0 ) {
+ z = -z;
+ sign = '-';
+ }
+ h = z / 3600;
+ z %= 3600;
+ m = z / 60;
+ z %= 60;
+ if (z != 0) {
+ return Tcl_ObjPrintf("%c%02d%02d%02d", sign, h, m, z);
+ }
+ return Tcl_ObjPrintf("%c%02d%02d", sign, h, m);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
* ClockConvertlocaltoutcObjCmd --
*
* Tcl command that converts a UTC time to a local time by whatever means
* is available.
*
* Usage:
- * ::tcl::clock::ConvertUTCToLocal dictionary tzdata changeover
+ * ::tcl::clock::ConvertUTCToLocal dictionary timezone changeover
*
* Parameters:
* dict - Dictionary containing a 'localSeconds' entry.
- * tzdata - Time zone data
+ * timezone - Time zone
* changeover - Julian Day of the adoption of the Gregorian calendar.
*
* Results:
@@ -345,12 +1182,13 @@ ClockConvertlocaltoutcObjCmd(
int created = 0;
int status;
+ fields.tzName = NULL;
/*
* Check params and convert time.
*/
if (objc != 4) {
- Tcl_WrongNumArgs(interp, 1, objv, "dict tzdata changeover");
+ Tcl_WrongNumArgs(interp, 1, objv, "dict timezone changeover");
return TCL_ERROR;
}
dict = objv[1];
@@ -363,10 +1201,10 @@ ClockConvertlocaltoutcObjCmd(
"found in dictionary", -1));
return TCL_ERROR;
}
- if ((Tcl_GetWideIntFromObj(interp, secondsObj,
+ if ((TclGetWideIntFromObj(interp, secondsObj,
&fields.localSeconds) != TCL_OK)
|| (TclGetIntFromObj(interp, objv[3], &changeover) != TCL_OK)
- || ConvertLocalToUTC(interp, &fields, objv[2], changeover)) {
+ || ConvertLocalToUTC(clientData, interp, &fields, objv[2], changeover)) {
return TCL_ERROR;
}
@@ -400,12 +1238,11 @@ ClockConvertlocaltoutcObjCmd(
* formatting a date, and populates a dictionary with them.
*
* Usage:
- * ::tcl::clock::GetDateFields seconds tzdata changeover
+ * ::tcl::clock::GetDateFields seconds timezone changeover
*
* Parameters:
* seconds - Time expressed in seconds from the Posix epoch.
- * tzdata - Time zone data of the time zone in which time is to be
- * expressed.
+ * timezone - Time zone in which time is to be expressed.
* changeover - Julian Day Number at which the current locale adopted
* the Gregorian calendar
*
@@ -434,15 +1271,17 @@ ClockGetdatefieldsObjCmd(
Tcl_Obj *const *literals = data->literals;
int changeover;
+ fields.tzName = NULL;
+
/*
* Check params.
*/
if (objc != 4) {
- Tcl_WrongNumArgs(interp, 1, objv, "seconds tzdata changeover");
+ Tcl_WrongNumArgs(interp, 1, objv, "seconds timezone changeover");
return TCL_ERROR;
}
- if (Tcl_GetWideIntFromObj(interp, objv[1], &fields.seconds) != TCL_OK
+ if (TclGetWideIntFromObj(interp, objv[1], &fields.seconds) != TCL_OK
|| TclGetIntFromObj(interp, objv[3], &changeover) != TCL_OK) {
return TCL_ERROR;
}
@@ -457,28 +1296,14 @@ ClockGetdatefieldsObjCmd(
return TCL_ERROR;
}
- /*
- * Convert UTC time to local.
- */
+ /* Extract fields */
- if (ConvertUTCToLocal(interp, &fields, objv[2], changeover) != TCL_OK) {
+ if (ClockGetDateFields(clientData, interp, &fields, objv[2],
+ changeover) != TCL_OK) {
return TCL_ERROR;
}
- /*
- * Extract Julian day.
- */
-
- fields.julianDay = (int) ((fields.localSeconds + JULIAN_SEC_POSIX_EPOCH)
- / SECONDS_PER_DAY);
-
- /*
- * Convert to Julian or Gregorian calendar.
- */
-
- GetGregorianEraYearDay(&fields, changeover);
- GetMonthDay(&fields);
- GetYearWeekDay(&fields, changeover);
+ /* Make dict of fields */
dict = Tcl_NewDictObj();
Tcl_DictObjPut(NULL, dict, literals[LIT_LOCALSECONDS],
@@ -517,6 +1342,58 @@ ClockGetdatefieldsObjCmd(
/*
*----------------------------------------------------------------------
*
+ * ClockGetDateFields --
+ *
+ * Converts given UTC time (seconds in a TclDateFields structure)
+ * to local time and determines the values that clock routines will
+ * use in scanning or formatting a date.
+ *
+ * Results:
+ * Date-time values are stored in structure "fields".
+ * Returns a standard Tcl result.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+ClockGetDateFields(
+ ClientData clientData, /* Client data of the interpreter */
+ Tcl_Interp *interp, /* Tcl interpreter */
+ TclDateFields *fields, /* Pointer to result fields, where
+ * fields->seconds contains date to extract */
+ Tcl_Obj *timezoneObj, /* Time zone object or NULL for gmt */
+ int changeover) /* Julian Day Number */
+{
+ /*
+ * Convert UTC time to local.
+ */
+
+ if (ConvertUTCToLocal(clientData, interp, fields, timezoneObj,
+ changeover) != TCL_OK) {
+ return TCL_ERROR;
+ }
+
+ /*
+ * Extract Julian day.
+ */
+
+ fields->julianDay = (int) ((fields->localSeconds + JULIAN_SEC_POSIX_EPOCH)
+ / SECONDS_PER_DAY);
+
+ /*
+ * Convert to Julian or Gregorian calendar.
+ */
+
+ GetGregorianEraYearDay(fields, changeover);
+ GetMonthDay(fields);
+ GetYearWeekDay(fields, changeover);
+
+ return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
* ClockGetjuliandayfromerayearmonthdayObjCmd --
*
* Tcl command that converts a time from era-year-month-day to a Julian
@@ -591,6 +1468,8 @@ ClockGetjuliandayfromerayearmonthdayObjCmd(
int status;
int era = 0;
+ fields.tzName = NULL;
+
/*
* Check params.
*/
@@ -675,6 +1554,8 @@ ClockGetjuliandayfromerayearweekdayObjCmd(
int status;
int era = 0;
+ fields.tzName = NULL;
+
/*
* Check params.
*/
@@ -742,18 +1623,70 @@ ClockGetjuliandayfromerayearweekdayObjCmd(
static int
ConvertLocalToUTC(
+ ClientData clientData, /* Client data of the interpreter */
Tcl_Interp *interp, /* Tcl interpreter */
TclDateFields *fields, /* Fields of the time */
- Tcl_Obj *tzdata, /* Time zone data */
+ Tcl_Obj *timezoneObj, /* Time zone */
int changeover) /* Julian Day of the Gregorian transition */
{
+ ClockClientData *dataPtr = clientData;
+ Tcl_Obj *tzdata; /* Time zone data */
int rowc; /* Number of rows in tzdata */
Tcl_Obj **rowv; /* Pointers to the rows */
+ Tcl_WideInt seconds;
+
+ /* fast phase-out for shared GMT-object (don't need to convert UTC 2 UTC) */
+ if (timezoneObj == dataPtr->GMTSetupTimeZone && dataPtr->GMTSetupTimeZone != NULL) {
+ fields->seconds = fields->localSeconds;
+ fields->tzOffset = 0;
+ return TCL_OK;
+ }
+
+ /*
+ * Check cacheable conversion could be used
+ * (last-period Local2UTC cache within the same TZ)
+ */
+ seconds = fields->localSeconds - dataPtr->Local2UTC.tzOffset;
+ if ( timezoneObj == dataPtr->Local2UTC.timezoneObj
+ && ( fields->localSeconds == dataPtr->Local2UTC.localSeconds
+ || ( seconds >= dataPtr->Local2UTC.rangesVal[0]
+ && seconds < dataPtr->Local2UTC.rangesVal[1])
+ )
+ && changeover == dataPtr->Local2UTC.changeover
+ ) {
+ /* the same time zone and offset (UTC time inside the last minute) */
+ fields->tzOffset = dataPtr->Local2UTC.tzOffset;
+ fields->seconds = seconds;
+ return TCL_OK;
+ }
+
+ /*
+ * Check cacheable back-conversion could be used
+ * (last-period UTC2Local cache within the same TZ)
+ */
+ seconds = fields->localSeconds - dataPtr->UTC2Local.tzOffset;
+ if ( timezoneObj == dataPtr->UTC2Local.timezoneObj
+ && ( seconds == dataPtr->UTC2Local.seconds
+ || ( seconds >= dataPtr->UTC2Local.rangesVal[0]
+ && seconds < dataPtr->UTC2Local.rangesVal[1])
+ )
+ && changeover == dataPtr->UTC2Local.changeover
+ ) {
+ /* the same time zone and offset (UTC time inside the last minute) */
+ fields->tzOffset = dataPtr->UTC2Local.tzOffset;
+ fields->seconds = seconds;
+ return TCL_OK;
+ }
/*
* Unpack the tz data.
*/
+ tzdata = ClockGetTZData(clientData, interp, timezoneObj);
+ if (tzdata == NULL) {
+ return TCL_ERROR;
+ }
+
if (TclListObjGetElements(interp, tzdata, &rowc, &rowv) != TCL_OK) {
return TCL_ERROR;
}
@@ -764,10 +1697,26 @@ ConvertLocalToUTC(
*/
if (rowc == 0) {
- return ConvertLocalToUTCUsingC(interp, fields, changeover);
+ dataPtr->Local2UTC.rangesVal[0] = 0;
+ dataPtr->Local2UTC.rangesVal[1] = 0;
+
+ if (ConvertLocalToUTCUsingC(interp, fields, changeover) != TCL_OK) {
+ return TCL_ERROR;
+ };
} else {
- return ConvertLocalToUTCUsingTable(interp, fields, rowc, rowv);
+ if (ConvertLocalToUTCUsingTable(interp, fields, rowc, rowv,
+ dataPtr->Local2UTC.rangesVal) != TCL_OK) {
+ return TCL_ERROR;
+ };
}
+
+ /* Cache the last conversion */
+ Tcl_SetObjRef(dataPtr->Local2UTC.timezoneObj, timezoneObj);
+ dataPtr->Local2UTC.localSeconds = fields->localSeconds;
+ dataPtr->Local2UTC.changeover = changeover;
+ dataPtr->Local2UTC.tzOffset = fields->tzOffset;
+
+ return TCL_OK;
}
/*
@@ -793,7 +1742,8 @@ ConvertLocalToUTCUsingTable(
Tcl_Interp *interp, /* Tcl interpreter */
TclDateFields *fields, /* Time to convert, with 'seconds' filled in */
int rowc, /* Number of points at which time changes */
- Tcl_Obj *const rowv[]) /* Points at which time changes */
+ Tcl_Obj *const rowv[], /* Points at which time changes */
+ Tcl_WideInt rangesVal[2]) /* Return bounds for time period */
{
Tcl_Obj *row;
int cellc;
@@ -817,7 +1767,8 @@ ConvertLocalToUTCUsingTable(
fields->tzOffset = 0;
fields->seconds = fields->localSeconds;
while (!found) {
- row = LookupLastTransition(interp, fields->seconds, rowc, rowv);
+ row = LookupLastTransition(interp, fields->seconds, rowc, rowv,
+ rangesVal);
if ((row == NULL)
|| TclListObjGetElements(interp, row, &cellc,
&cellv) != TCL_OK
@@ -842,6 +1793,41 @@ ConvertLocalToUTCUsingTable(
}
fields->tzOffset = have[i];
fields->seconds = fields->localSeconds - fields->tzOffset;
+
+#if 0
+ /* currently unused, test purposes only */
+ /*
+ * Convert back from UTC, if local times are different - wrong local time
+ * (local time seems to be in between DST-hole).
+ */
+ if (fields->tzOffset) {
+
+ int corrOffset;
+ Tcl_WideInt backCompVal;
+ /* check DST-hole interval contains UTC time */
+ TclGetWideIntFromObj(NULL, cellv[0], &backCompVal);
+ if ( fields->seconds >= backCompVal - fields->tzOffset
+ && fields->seconds <= backCompVal + fields->tzOffset
+ ) {
+ row = LookupLastTransition(interp, fields->seconds, rowc, rowv);
+ if (row == NULL ||
+ TclListObjGetElements(interp, row, &cellc, &cellv) != TCL_OK ||
+ TclGetIntFromObj(interp, cellv[1], &corrOffset) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ if (fields->localSeconds != fields->seconds + corrOffset) {
+ Tcl_Panic("wrong local time %ld by LocalToUTC conversion,"
+ " local time seems to be in between DST-hole",
+ fields->localSeconds);
+ /* correcting offset * /
+ fields->tzOffset -= corrOffset;
+ fields->seconds += fields->tzOffset;
+ */
+ }
+ }
+ }
+#endif
+
return TCL_OK;
}
@@ -943,20 +1929,61 @@ ConvertLocalToUTCUsingC(
*----------------------------------------------------------------------
*/
-static int
+MODULE_SCOPE int
ConvertUTCToLocal(
+ ClientData clientData, /* Client data of the interpreter */
Tcl_Interp *interp, /* Tcl interpreter */
TclDateFields *fields, /* Fields of the time */
- Tcl_Obj *tzdata, /* Time zone data */
+ Tcl_Obj *timezoneObj, /* Time zone */
int changeover) /* Julian Day of the Gregorian transition */
{
+ ClockClientData *dataPtr = clientData;
+ Tcl_Obj *tzdata; /* Time zone data */
int rowc; /* Number of rows in tzdata */
Tcl_Obj **rowv; /* Pointers to the rows */
+ /* fast phase-out for shared GMT-object (don't need to convert UTC 2 UTC) */
+ if (timezoneObj == dataPtr->GMTSetupTimeZone
+ && dataPtr->GMTSetupTimeZone != NULL
+ && dataPtr->GMTSetupTZData != NULL
+ ) {
+ fields->localSeconds = fields->seconds;
+ fields->tzOffset = 0;
+ if ( TclListObjGetElements(interp, dataPtr->GMTSetupTZData, &rowc, &rowv) != TCL_OK
+ || Tcl_ListObjIndex(interp, rowv[0], 3, &fields->tzName) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ Tcl_IncrRefCount(fields->tzName);
+ return TCL_OK;
+ }
+
+ /*
+ * Check cacheable conversion could be used
+ * (last-period UTC2Local cache within the same TZ)
+ */
+ if ( timezoneObj == dataPtr->UTC2Local.timezoneObj
+ && ( fields->seconds == dataPtr->UTC2Local.seconds
+ || ( fields->seconds >= dataPtr->UTC2Local.rangesVal[0]
+ && fields->seconds < dataPtr->UTC2Local.rangesVal[1])
+ )
+ && changeover == dataPtr->UTC2Local.changeover
+ ) {
+ /* the same time zone and offset (UTC time inside the last minute) */
+ Tcl_SetObjRef(fields->tzName, dataPtr->UTC2Local.tzName);
+ fields->tzOffset = dataPtr->UTC2Local.tzOffset;
+ fields->localSeconds = fields->seconds + fields->tzOffset;
+ return TCL_OK;
+ }
+
/*
* Unpack the tz data.
*/
+ tzdata = ClockGetTZData(clientData, interp, timezoneObj);
+ if (tzdata == NULL) {
+ return TCL_ERROR;
+ }
+
if (TclListObjGetElements(interp, tzdata, &rowc, &rowv) != TCL_OK) {
return TCL_ERROR;
}
@@ -967,10 +1994,26 @@ ConvertUTCToLocal(
*/
if (rowc == 0) {
- return ConvertUTCToLocalUsingC(interp, fields, changeover);
+ dataPtr->UTC2Local.rangesVal[0] = 0;
+ dataPtr->UTC2Local.rangesVal[1] = 0;
+
+ if (ConvertUTCToLocalUsingC(interp, fields, changeover) != TCL_OK) {
+ return TCL_ERROR;
+ }
} else {
- return ConvertUTCToLocalUsingTable(interp, fields, rowc, rowv);
+ if (ConvertUTCToLocalUsingTable(interp, fields, rowc, rowv,
+ dataPtr->UTC2Local.rangesVal) != TCL_OK) {
+ return TCL_ERROR;
+ }
}
+
+ /* Cache the last conversion */
+ Tcl_SetObjRef(dataPtr->UTC2Local.timezoneObj, timezoneObj);
+ dataPtr->UTC2Local.seconds = fields->seconds;
+ dataPtr->UTC2Local.changeover = changeover;
+ dataPtr->UTC2Local.tzOffset = fields->tzOffset;
+ Tcl_SetObjRef(dataPtr->UTC2Local.tzName, fields->tzName);
+ return TCL_OK;
}
/*
@@ -997,7 +2040,8 @@ ConvertUTCToLocalUsingTable(
TclDateFields *fields, /* Fields of the date */
int rowc, /* Number of rows in the conversion table
* (>= 1) */
- Tcl_Obj *const rowv[]) /* Rows of the conversion table */
+ Tcl_Obj *const rowv[], /* Rows of the conversion table */
+ Tcl_WideInt rangesVal[2]) /* Return bounds for time period */
{
Tcl_Obj *row; /* Row containing the current information */
int cellc; /* Count of cells in the row (must be 4) */
@@ -1007,7 +2051,7 @@ ConvertUTCToLocalUsingTable(
* Look up the nearest transition time.
*/
- row = LookupLastTransition(interp, fields->seconds, rowc, rowv);
+ row = LookupLastTransition(interp, fields->seconds, rowc, rowv, rangesVal);
if (row == NULL ||
TclListObjGetElements(interp, row, &cellc, &cellv) != TCL_OK ||
TclGetIntFromObj(interp, cellv[1], &fields->tzOffset) != TCL_OK) {
@@ -1018,8 +2062,7 @@ ConvertUTCToLocalUsingTable(
* Convert the time.
*/
- fields->tzName = cellv[3];
- Tcl_IncrRefCount(fields->tzName);
+ Tcl_SetObjRef(fields->tzName, cellv[3]);
fields->localSeconds = fields->seconds + fields->tzOffset;
return TCL_OK;
}
@@ -1112,8 +2155,7 @@ ConvertUTCToLocalUsingC(
if (diff > 0) {
sprintf(buffer+5, "%02d", diff);
}
- fields->tzName = Tcl_NewStringObj(buffer, -1);
- Tcl_IncrRefCount(fields->tzName);
+ Tcl_SetObjRef(fields->tzName, Tcl_NewStringObj(buffer, -1));
return TCL_OK;
}
@@ -1131,24 +2173,25 @@ ConvertUTCToLocalUsingC(
*----------------------------------------------------------------------
*/
-static Tcl_Obj *
+MODULE_SCOPE Tcl_Obj *
LookupLastTransition(
Tcl_Interp *interp, /* Interpreter for error messages */
Tcl_WideInt tick, /* Time from the epoch */
int rowc, /* Number of rows of tzdata */
- Tcl_Obj *const *rowv) /* Rows in tzdata */
+ Tcl_Obj *const *rowv, /* Rows in tzdata */
+ Tcl_WideInt rangesVal[2]) /* Return bounds for time period */
{
- int l;
+ int l = 0;
int u;
Tcl_Obj *compObj;
- Tcl_WideInt compVal;
+ Tcl_WideInt compVal, fromVal = tick, toVal = tick;
/*
* Examine the first row to make sure we're in bounds.
*/
if (Tcl_ListObjIndex(interp, rowv[0], 0, &compObj) != TCL_OK
- || Tcl_GetWideIntFromObj(interp, compObj, &compVal) != TCL_OK) {
+ || TclGetWideIntFromObj(interp, compObj, &compVal) != TCL_OK) {
return NULL;
}
@@ -1158,28 +2201,36 @@ LookupLastTransition(
*/
if (tick < compVal) {
- return rowv[0];
+ goto done;
}
/*
* Binary-search to find the transition.
*/
- l = 0;
u = rowc-1;
while (l < u) {
int m = (l + u + 1) / 2;
if (Tcl_ListObjIndex(interp, rowv[m], 0, &compObj) != TCL_OK ||
- Tcl_GetWideIntFromObj(interp, compObj, &compVal) != TCL_OK) {
+ TclGetWideIntFromObj(interp, compObj, &compVal) != TCL_OK) {
return NULL;
}
if (tick >= compVal) {
l = m;
+ fromVal = compVal;
} else {
u = m-1;
+ toVal = compVal;
}
}
+
+done:
+
+ if (rangesVal) {
+ rangesVal[0] = fromVal;
+ rangesVal[1] = toVal;
+ }
return rowv[l];
}
@@ -1210,6 +2261,8 @@ GetYearWeekDay(
TclDateFields temp;
int dayOfFiscalYear;
+ temp.tzName = NULL;
+
/*
* Find the given date, minus three days, plus one year. That date's
* iso8601 year is an upper bound on the ISO8601 year of the given date.
@@ -1416,7 +2469,7 @@ GetMonthDay(
*----------------------------------------------------------------------
*/
-static void
+MODULE_SCOPE void
GetJulianDayFromEraYearWeekDay(
TclDateFields *fields, /* Date to convert */
int changeover) /* Julian Day Number of the Gregorian
@@ -1426,6 +2479,8 @@ GetJulianDayFromEraYearWeekDay(
* given year */
TclDateFields firstWeek;
+ firstWeek.tzName = NULL;
+
/*
* Find January 4 in the ISO8601 year, which will always be in week 1.
*/
@@ -1467,7 +2522,7 @@ GetJulianDayFromEraYearWeekDay(
*----------------------------------------------------------------------
*/
-static void
+MODULE_SCOPE void
GetJulianDayFromEraYearMonthDay(
TclDateFields *fields, /* Date to convert */
int changeover) /* Gregorian transition date as a Julian Day */
@@ -1563,6 +2618,61 @@ GetJulianDayFromEraYearMonthDay(
/*
*----------------------------------------------------------------------
*
+ * GetJulianDayFromEraYearDay --
+ *
+ * Given era, year, and dayOfYear (in TclDateFields), and the
+ * Gregorian transition date, computes the Julian Day Number.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Stores day number in 'julianDay'
+ *
+ *----------------------------------------------------------------------
+ */
+
+
+MODULE_SCOPE void
+GetJulianDayFromEraYearDay(
+ TclDateFields *fields, /* Date to convert */
+ int changeover) /* Gregorian transition date as a Julian Day */
+{
+ int year, ym1;
+
+ /* Get absolute year number from the civil year */
+ if (fields->era == BCE) {
+ year = 1 - fields->year;
+ } else {
+ year = fields->year;
+ }
+
+ ym1 = year - 1;
+
+ /* Try the Gregorian calendar first. */
+ fields->gregorian = 1;
+ fields->julianDay =
+ 1721425
+ + fields->dayOfYear
+ + ( 365 * ym1 )
+ + ( ym1 / 4 )
+ - ( ym1 / 100 )
+ + ( ym1 / 400 );
+
+ /* If the date is before the Gregorian change, use the Julian calendar. */
+
+ if ( fields->julianDay < changeover ) {
+ fields->gregorian = 0;
+ fields->julianDay =
+ 1721423
+ + fields->dayOfYear
+ + ( 365 * ym1 )
+ + ( ym1 / 4 );
+ }
+}
+/*
+ *----------------------------------------------------------------------
+ *
* IsGregorianLeapYear --
*
* Tests whether a given year is a leap year, in either Julian or
@@ -1574,16 +2684,14 @@ GetJulianDayFromEraYearMonthDay(
*----------------------------------------------------------------------
*/
-static int
+MODULE_SCOPE int
IsGregorianLeapYear(
TclDateFields *fields) /* Date to test */
{
- int year;
+ int year = fields->year;
if (fields->era == BCE) {
- year = 1 - fields->year;
- } else {
- year = fields->year;
+ year = 1 - year;
}
if (year%4 != 0) {
return 0;
@@ -1852,122 +2960,1030 @@ ClockMicrosecondsObjCmd(
return TCL_OK;
}
+static inline void
+ClockInitFmtScnArgs(
+ ClientData clientData,
+ Tcl_Interp *interp,
+ ClockFmtScnCmdArgs *opts)
+{
+ memset(opts, 0, sizeof(*opts));
+ opts->clientData = clientData;
+ opts->interp = interp;
+}
+
/*
*-----------------------------------------------------------------------------
*
- * ClockParseformatargsObjCmd --
+ * ClockParseFmtScnArgs --
*
- * Parses the arguments for [clock format].
+ * Parses the arguments for [clock scan] and [clock format].
*
* Results:
- * Returns a standard Tcl result, whose value is a four-element list
- * comprising the time format, the locale, and the timezone.
- *
- * This function exists because the loop that parses the [clock format]
- * options is a known performance "hot spot", and is implemented in an effort
- * to speed that particular code up.
+ * Returns a standard Tcl result, and stores parsed options
+ * (format, the locale, timezone and base) in structure "opts".
*
*-----------------------------------------------------------------------------
*/
+#define CLC_FMT_ARGS (0)
+#define CLC_SCN_ARGS (1 << 0)
+#define CLC_ADD_ARGS (1 << 1)
+
static int
-ClockParseformatargsObjCmd(
- ClientData clientData, /* Client data containing literal pool */
- Tcl_Interp *interp, /* Tcl interpreter */
+ClockParseFmtScnArgs(
+ register
+ ClockFmtScnCmdArgs *opts, /* Result vector: format, locale, timezone... */
+ TclDateFields *date, /* Extracted date-time corresponding base
+ * (by scan or add) resp. clockval (by format) */
int objc, /* Parameter count */
- Tcl_Obj *const objv[]) /* Parameter vector */
-{
- ClockClientData *dataPtr = clientData;
- Tcl_Obj **litPtr = dataPtr->literals;
- Tcl_Obj *results[3]; /* Format, locale and timezone */
-#define formatObj results[0]
-#define localeObj results[1]
-#define timezoneObj results[2]
+ Tcl_Obj *const objv[], /* Parameter vector */
+ int flags /* Flags, differentiates between format, scan, add */
+) {
+ Tcl_Interp *interp = opts->interp;
+ ClockClientData *dataPtr = opts->clientData;
int gmtFlag = 0;
- static const char *const options[] = { /* Command line options expected */
+ static const char *const options[] = {
"-format", "-gmt", "-locale",
- "-timezone", NULL };
+ "-timezone", "-base", NULL
+ };
enum optionInd {
- CLOCK_FORMAT_FORMAT, CLOCK_FORMAT_GMT, CLOCK_FORMAT_LOCALE,
- CLOCK_FORMAT_TIMEZONE
+ CLC_ARGS_FORMAT, CLC_ARGS_GMT, CLC_ARGS_LOCALE,
+ CLC_ARGS_TIMEZONE, CLC_ARGS_BASE
};
int optionIndex; /* Index of an option. */
int saw = 0; /* Flag == 1 if option was seen already. */
- Tcl_WideInt clockVal; /* Clock value - just used to parse. */
int i;
+ Tcl_WideInt baseVal; /* Base time, expressed in seconds from the Epoch */
- /*
- * Args consist of a time followed by keyword-value pairs.
- */
-
- if (objc < 2 || (objc % 2) != 0) {
- Tcl_WrongNumArgs(interp, 0, objv,
- "clock format clockval ?-format string? "
- "?-gmt boolean? ?-locale LOCALE? ?-timezone ZONE?");
- Tcl_SetErrorCode(interp, "CLOCK", "wrongNumArgs", NULL);
- return TCL_ERROR;
+ /* clock value (as current base) */
+ if ( !(flags & (CLC_SCN_ARGS)) ) {
+ opts->baseObj = objv[1];
+ saw |= (1 << CLC_ARGS_BASE);
}
/*
* Extract values for the keywords.
*/
- formatObj = litPtr[LIT__DEFAULT_FORMAT];
- localeObj = litPtr[LIT_C];
- timezoneObj = litPtr[LIT__NIL];
for (i = 2; i < objc; i+=2) {
- if (Tcl_GetIndexFromObj(interp, objv[i], options, "option", 0,
- &optionIndex) != TCL_OK) {
- Tcl_SetErrorCode(interp, "CLOCK", "badOption",
- Tcl_GetString(objv[i]), NULL);
- return TCL_ERROR;
+ /* bypass integers (offsets) by "clock add" */
+ if (flags & CLC_ADD_ARGS) {
+ Tcl_WideInt num;
+ if (TclGetWideIntFromObj(NULL, objv[i], &num) == TCL_OK) {
+ continue;
+ }
+ }
+ /* get option */
+ if (Tcl_GetIndexFromObj(interp, objv[i], options,
+ "option", 0, &optionIndex) != TCL_OK) {
+ goto badOption;
+ }
+ /* if already specified */
+ if (saw & (1 << optionIndex)) {
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "bad option \"%s\": doubly present",
+ TclGetString(objv[i]))
+ );
+ goto badOption;
}
switch (optionIndex) {
- case CLOCK_FORMAT_FORMAT:
- formatObj = objv[i+1];
+ case CLC_ARGS_FORMAT:
+ if (flags & CLC_ADD_ARGS) {
+ goto badOptionMsg;
+ }
+ opts->formatObj = objv[i+1];
break;
- case CLOCK_FORMAT_GMT:
+ case CLC_ARGS_GMT:
if (Tcl_GetBooleanFromObj(interp, objv[i+1], &gmtFlag) != TCL_OK){
return TCL_ERROR;
}
break;
- case CLOCK_FORMAT_LOCALE:
- localeObj = objv[i+1];
+ case CLC_ARGS_LOCALE:
+ opts->localeObj = objv[i+1];
break;
- case CLOCK_FORMAT_TIMEZONE:
- timezoneObj = objv[i+1];
+ case CLC_ARGS_TIMEZONE:
+ opts->timezoneObj = objv[i+1];
break;
+ case CLC_ARGS_BASE:
+ if ( !(flags & (CLC_SCN_ARGS)) ) {
+ goto badOptionMsg;
}
- saw |= 1 << optionIndex;
+ opts->baseObj = objv[i+1];
+ break;
+ }
+ saw |= (1 << optionIndex);
}
/*
* Check options.
*/
- if (Tcl_GetWideIntFromObj(interp, objv[1], &clockVal) != TCL_OK) {
- return TCL_ERROR;
- }
- if ((saw & (1 << CLOCK_FORMAT_GMT))
- && (saw & (1 << CLOCK_FORMAT_TIMEZONE))) {
- Tcl_SetObjResult(interp, litPtr[LIT_CANNOT_USE_GMT_AND_TIMEZONE]);
+ if ((saw & (1 << CLC_ARGS_GMT))
+ && (saw & (1 << CLC_ARGS_TIMEZONE))) {
+ Tcl_SetResult(interp, "cannot use -gmt and -timezone in same call", TCL_STATIC);
Tcl_SetErrorCode(interp, "CLOCK", "gmtWithTimezone", NULL);
return TCL_ERROR;
}
if (gmtFlag) {
- timezoneObj = litPtr[LIT_GMT];
+ opts->timezoneObj = dataPtr->literals[LIT_GMT];
+ }
+
+ /* If time zone not specified use system time zone */
+
+ if ( opts->timezoneObj == NULL
+ || TclGetString(opts->timezoneObj) == NULL
+ || opts->timezoneObj->length == 0
+ ) {
+ opts->timezoneObj = ClockGetSystemTimeZone(opts->clientData, interp);
+ if (opts->timezoneObj == NULL) {
+ return TCL_ERROR;
+ }
+ }
+
+ /* Setup timezone (normalize object if needed and load TZ on demand) */
+
+ opts->timezoneObj = ClockSetupTimeZone(opts->clientData, interp, opts->timezoneObj);
+ if (opts->timezoneObj == NULL) {
+ return TCL_ERROR;
+ }
+
+ /* Base (by scan or add) or clock value (by format) */
+
+ if (opts->baseObj != NULL) {
+ if (TclGetWideIntFromObj(NULL, opts->baseObj, &baseVal) != TCL_OK) {
+
+ /* we accept "-now" as current date-time */
+ const char *const nowOpts[] = {
+ "-now", NULL
+ };
+ int idx;
+ if (Tcl_GetIndexFromObj(NULL, opts->baseObj, nowOpts, "seconds or -now",
+ TCL_EXACT, &idx) == TCL_OK
+ ) {
+ goto baseNow;
+ }
+
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "expected integer but got \"%s\"",
+ Tcl_GetString(opts->baseObj)));
+ Tcl_SetErrorCode(interp, "TCL", "VALUE", "INTEGER", NULL);
+ i = 1;
+ goto badOption;
+ }
+ /*
+ * seconds could be an unsigned number that overflowed. Make sure
+ * that it isn't.
+ */
+
+ if (opts->baseObj->typePtr == &tclBignumType) {
+ Tcl_SetObjResult(interp, dataPtr->literals[LIT_INTEGER_VALUE_TOO_LARGE]);
+ return TCL_ERROR;
+ }
+
+ } else {
+
+baseNow:
+ {
+ Tcl_Time now;
+ Tcl_GetTime(&now);
+ baseVal = (Tcl_WideInt) now.sec;
+ }
+ }
+
+ /*
+ * Extract year, month and day from the base time for the parser to use as
+ * defaults
+ */
+
+ /* check base fields already cached (by TZ, last-second cache) */
+ if ( dataPtr->lastBase.timezoneObj == opts->timezoneObj
+ && dataPtr->lastBase.Date.seconds == baseVal) {
+ memcpy(date, &dataPtr->lastBase.Date, ClockCacheableDateFieldsSize);
+ } else {
+ /* extact fields from base */
+ date->seconds = baseVal;
+ if (ClockGetDateFields(opts->clientData, interp, date, opts->timezoneObj,
+ GREGORIAN_CHANGE_DATE) != TCL_OK) { /* TODO - GREGORIAN_CHANGE_DATE should be locale-dependent */
+ return TCL_ERROR;
+ }
+ /* cache last base */
+ memcpy(&dataPtr->lastBase.Date, date, ClockCacheableDateFieldsSize);
+ Tcl_SetObjRef(dataPtr->lastBase.timezoneObj, opts->timezoneObj);
+ }
+
+ return TCL_OK;
+
+badOptionMsg:
+
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "bad option \"%s\": unexpected for command \"%s\"",
+ TclGetString(objv[i]), TclGetString(objv[0]))
+ );
+
+badOption:
+
+ Tcl_SetErrorCode(interp, "CLOCK", "badOption",
+ i < objc ? Tcl_GetString(objv[i]) : NULL, NULL);
+
+ return TCL_ERROR;
+}
+
+/*----------------------------------------------------------------------
+ *
+ * ClockFormatObjCmd -- , clock format --
+ *
+ * This function is invoked to process the Tcl "clock format" command.
+ *
+ * Formats a count of seconds since the Posix Epoch as a time of day.
+ *
+ * The 'clock format' command formats times of day for output. Refer
+ * to the user documentation to see what it does.
+ *
+ * Results:
+ * Returns a standard Tcl result.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+ClockFormatObjCmd(
+ ClientData clientData, /* Client data containing literal pool */
+ Tcl_Interp *interp, /* Tcl interpreter */
+ int objc, /* Parameter count */
+ Tcl_Obj *const objv[]) /* Parameter values */
+{
+ ClockClientData *dataPtr = clientData;
+
+ int ret;
+ ClockFmtScnCmdArgs opts; /* Format, locale, timezone and base */
+ DateFormat dateFmt; /* Common structure used for formatting */
+
+ /* even number of arguments */
+ if ((objc & 1) == 1) {
+ Tcl_WrongNumArgs(interp, 1, objv, "clockval|-now "
+ "?-format string? "
+ "?-gmt boolean? "
+ "?-locale LOCALE? ?-timezone ZONE?");
+ Tcl_SetErrorCode(interp, "CLOCK", "wrongNumArgs", NULL);
+ return TCL_ERROR;
+ }
+
+ memset(&dateFmt, 0, sizeof(dateFmt));
+
+ /*
+ * Extract values for the keywords.
+ */
+
+ ClockInitFmtScnArgs(clientData, interp, &opts);
+ ret = ClockParseFmtScnArgs(&opts, &dateFmt.date, objc, objv,
+ CLC_FMT_ARGS);
+ if (ret != TCL_OK) {
+ goto done;
+ }
+
+ /* Default format */
+ if (opts.formatObj == NULL) {
+ opts.formatObj = dataPtr->literals[LIT__DEFAULT_FORMAT];
+ }
+
+ /* Use compiled version of Format - */
+
+ ret = ClockFormat(&dateFmt, &opts);
+
+done:
+
+ Tcl_UnsetObjRef(dateFmt.date.tzName);
+
+ if (ret != TCL_OK) {
+ return ret;
+ }
+
+ return TCL_OK;
+}
+
+/*----------------------------------------------------------------------
+ *
+ * ClockScanObjCmd -- , clock scan --
+ *
+ * This function is invoked to process the Tcl "clock scan" command.
+ *
+ * Inputs a count of seconds since the Posix Epoch as a time of day.
+ *
+ * The 'clock scan' command scans times of day on input. Refer to the
+ * user documentation to see what it does.
+ *
+ * Results:
+ * Returns a standard Tcl result.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+ClockScanObjCmd(
+ ClientData clientData, /* Client data containing literal pool */
+ Tcl_Interp *interp, /* Tcl interpreter */
+ int objc, /* Parameter count */
+ Tcl_Obj *const objv[]) /* Parameter values */
+{
+ int ret;
+ ClockFmtScnCmdArgs opts; /* Format, locale, timezone and base */
+ DateInfo yy; /* Common structure used for parsing */
+ DateInfo *info = &yy;
+
+ /* even number of arguments */
+ if ((objc & 1) == 1) {
+ Tcl_WrongNumArgs(interp, 1, objv, "string "
+ "?-base seconds? "
+ "?-format string? "
+ "?-gmt boolean? "
+ "?-locale LOCALE? ?-timezone ZONE?");
+ Tcl_SetErrorCode(interp, "CLOCK", "wrongNumArgs", NULL);
+ return TCL_ERROR;
+ }
+
+ ClockInitDateInfo(&yy);
+
+ /*
+ * Extract values for the keywords.
+ */
+
+ ClockInitFmtScnArgs(clientData, interp, &opts);
+ ret = ClockParseFmtScnArgs(&opts, &yy.date, objc, objv,
+ CLC_SCN_ARGS);
+ if (ret != TCL_OK) {
+ goto done;
+ }
+
+ /* seconds are in localSeconds (relative base date), so reset time here */
+ yyHour = 0; yyMinutes = 0; yySeconds = 0; yyMeridian = MER24;
+
+ /* If free scan */
+ if (opts.formatObj == NULL) {
+ /* Use compiled version of FreeScan - */
+
+ /* [SB] TODO: Perhaps someday we'll localize the legacy code. Right now, it's not localized. */
+ if (opts.localeObj != NULL) {
+ Tcl_SetResult(interp,
+ "legacy [clock scan] does not support -locale", TCL_STATIC);
+ Tcl_SetErrorCode(interp, "CLOCK", "flagWithLegacyFormat", NULL);
+ return TCL_ERROR;
+ }
+ ret = ClockFreeScan(&yy, objv[1], &opts);
+ }
+ else {
+ /* Use compiled version of Scan - */
+
+ ret = ClockScan(&yy, objv[1], &opts);
+ }
+
+ /* Convert date info structure into UTC seconds */
+
+ if (ret == TCL_OK) {
+ ret = ClockScanCommit(clientData, &yy, &opts);
+ }
+
+done:
+
+ Tcl_UnsetObjRef(yy.date.tzName);
+
+ if (ret != TCL_OK) {
+ return ret;
+ }
+
+ Tcl_SetObjResult(interp, Tcl_NewWideIntObj(yy.date.seconds));
+ return TCL_OK;
+}
+
+/*----------------------------------------------------------------------
+ *
+ * ClockScanCommit --
+ *
+ * Converts date info structure into UTC seconds.
+ *
+ * Results:
+ * Returns a standard Tcl result.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+ClockScanCommit(
+ ClientData clientData, /* Client data containing literal pool */
+ register DateInfo *info, /* Clock scan info structure */
+ register
+ ClockFmtScnCmdArgs *opts) /* Format, locale, timezone and base */
+{
+ /* If needed assemble julianDay using year, month, etc. */
+ if (info->flags & CLF_ASSEMBLE_JULIANDAY) {
+ if ((info->flags & CLF_ISO8601)) {
+ GetJulianDayFromEraYearWeekDay(&yydate, GREGORIAN_CHANGE_DATE);
+ }
+ else
+ if (!(info->flags & CLF_DAYOFYEAR)) {
+ GetJulianDayFromEraYearMonthDay(&yydate, GREGORIAN_CHANGE_DATE);
+ } else {
+ GetJulianDayFromEraYearDay(&yydate, GREGORIAN_CHANGE_DATE);
+ }
+ }
+
+ /* some overflow checks, if not extended */
+ if (!(opts->flags & CLF_EXTENDED)) {
+ if (yydate.julianDay > 5373484) {
+ Tcl_SetObjResult(opts->interp, Tcl_NewStringObj(
+ "requested date too large to represent", -1));
+ Tcl_SetErrorCode(opts->interp, "CLOCK", "dateTooLarge", NULL);
+ return TCL_ERROR;
+ }
+ }
+
+ /* Local seconds to UTC (stored in yydate.seconds) */
+
+ if (info->flags & (CLF_ASSEMBLE_SECONDS|CLF_ASSEMBLE_JULIANDAY)) {
+ yydate.localSeconds =
+ -210866803200L
+ + ( SECONDS_PER_DAY * (Tcl_WideInt)yydate.julianDay )
+ + ( yySeconds % SECONDS_PER_DAY );
+ }
+
+ if (info->flags & (CLF_ASSEMBLE_SECONDS|CLF_ASSEMBLE_JULIANDAY|CLF_LOCALSEC)) {
+ if (ConvertLocalToUTC(clientData, opts->interp, &yydate, opts->timezoneObj,
+ GREGORIAN_CHANGE_DATE) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ }
+
+ /* Increment UTC seconds with relative time */
+
+ yydate.seconds += yyRelSeconds;
+
+ return TCL_OK;
+}
+
+/*----------------------------------------------------------------------
+ *
+ * ClockFreeScan --
+ *
+ * Used by ClockScanObjCmd for free scanning without format.
+ *
+ * Results:
+ * Returns a standard Tcl result.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+ClockFreeScan(
+ register
+ DateInfo *info, /* Date fields used for parsing & converting
+ * simultaneously a yy-parse structure of the
+ * TclClockFreeScan */
+ Tcl_Obj *strObj, /* String containing the time to scan */
+ ClockFmtScnCmdArgs *opts) /* Command options */
+{
+ Tcl_Interp *interp = opts->interp;
+ ClockClientData *dataPtr = opts->clientData;
+
+ int ret = TCL_ERROR;
+
+ /*
+ * Parse the date. The parser will fill a structure "info" with date,
+ * time, time zone, relative month/day/seconds, relative weekday, ordinal
+ * month.
+ * Notice that many yy-defines point to values in the "info" or "date"
+ * structure, e. g. yySeconds -> info->date.secondOfDay or
+ * yySeconds -> info->date.month (same as yydate.month)
+ */
+ yyInput = Tcl_GetString(strObj);
+
+ if (TclClockFreeScan(interp, info) != TCL_OK) {
+ Tcl_Obj *msg = Tcl_NewObj();
+ Tcl_AppendPrintfToObj(msg, "unable to convert date-time string \"%s\": %s",
+ Tcl_GetString(strObj), TclGetString(Tcl_GetObjResult(interp)));
+ Tcl_SetObjResult(interp, msg);
+ goto done;
+ }
+
+ /*
+ * If the caller supplied a date in the string, update the date with
+ * the value. If the caller didn't specify a time with the date, default to
+ * midnight.
+ */
+
+ if (yyHaveDate) {
+ if (yyYear < 100) {
+ if (yyYear >= dataPtr->yearOfCenturySwitch) {
+ yyYear -= 100;
+ }
+ yyYear += dataPtr->currentYearCentury;
+ }
+ yydate.era = CE;
+ if (yyHaveTime == 0) {
+ yyHaveTime = -1;
+ }
+ info->flags |= CLF_ASSEMBLE_JULIANDAY|CLF_ASSEMBLE_SECONDS;
+ }
+
+ /*
+ * If the caller supplied a time zone in the string, make it into a time
+ * zone indicator of +-hhmm and setup this time zone.
+ */
+
+ if (yyHaveZone) {
+ Tcl_Obj *tzObjStor = NULL;
+ int minEast = -yyTimezone;
+ int dstFlag = 1 - yyDSTmode;
+ tzObjStor = ClockFormatNumericTimeZone(
+ 60 * minEast + 3600 * dstFlag);
+ Tcl_IncrRefCount(tzObjStor);
+
+ opts->timezoneObj = ClockSetupTimeZone(dataPtr, interp, tzObjStor);
+
+ Tcl_DecrRefCount(tzObjStor);
+ if (opts->timezoneObj == NULL) {
+ goto done;
+ }
+
+ // Tcl_SetObjRef(yydate.tzName, opts->timezoneObj);
+
+ info->flags |= CLF_ASSEMBLE_SECONDS;
+ }
+
+ /*
+ * Assemble date, time, zone into seconds-from-epoch
+ */
+
+ if (yyHaveTime == -1) {
+ yySeconds = 0;
+ info->flags |= CLF_ASSEMBLE_SECONDS;
+ }
+ else
+ if (yyHaveTime) {
+ yySeconds = ToSeconds(yyHour, yyMinutes,
+ yySeconds, yyMeridian);
+ info->flags |= CLF_ASSEMBLE_SECONDS;
+ }
+ else
+ if ( (yyHaveDay && !yyHaveDate)
+ || yyHaveOrdinalMonth
+ || ( yyHaveRel
+ && ( yyRelMonth != 0
+ || yyRelDay != 0 ) )
+ ) {
+ yySeconds = 0;
+ info->flags |= CLF_ASSEMBLE_SECONDS;
+ }
+ else {
+ yySeconds = yydate.localSeconds % SECONDS_PER_DAY;
}
/*
- * Return options as a list.
+ * Do relative times
*/
- Tcl_SetObjResult(interp, Tcl_NewListObj(3, results));
+ ret = ClockCalcRelTime(info, opts);
+
+ /* Free scanning completed - date ready */
+
+done:
+
+ return ret;
+}
+
+/*----------------------------------------------------------------------
+ *
+ * ClockCalcRelTime --
+ *
+ * Used for calculating of relative times.
+ *
+ * Results:
+ * Returns a standard Tcl result.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+int
+ClockCalcRelTime(
+ register
+ DateInfo *info, /* Date fields used for converting */
+ ClockFmtScnCmdArgs *opts) /* Command options */
+{
+ /*
+ * Because some calculations require in-between conversion of the
+ * julian day, we can repeat this processing multiple times
+ */
+repeat_rel:
+
+ if (yyHaveRel) {
+
+ /*
+ * Relative conversion normally possible in UTC time only, because
+ * of possible wrong local time increment if ignores in-between DST-hole.
+ * (see test-cases clock-34.53, clock-34.54).
+ * So increment date in julianDay, but time inside day in UTC (seconds).
+ */
+
+ /* add months (or years in months) */
+
+ if (yyRelMonth != 0) {
+ int m, h;
+
+ /* if needed extract year, month, etc. again */
+ if (info->flags & CLF_ASSEMBLE_DATE) {
+ GetGregorianEraYearDay(&yydate, GREGORIAN_CHANGE_DATE);
+ GetMonthDay(&yydate);
+ GetYearWeekDay(&yydate, GREGORIAN_CHANGE_DATE);
+ info->flags &= ~CLF_ASSEMBLE_DATE;
+ }
+
+ /* add the requisite number of months */
+ yyMonth += yyRelMonth - 1;
+ yyYear += yyMonth / 12;
+ m = yyMonth % 12;
+ yyMonth = m + 1;
+
+ /* if the day doesn't exist in the current month, repair it */
+ h = hath[IsGregorianLeapYear(&yydate)][m];
+ if (yyDay > h) {
+ yyDay = h;
+ }
+
+ /* on demand (lazy) assemble julianDay using new year, month, etc. */
+ info->flags |= CLF_ASSEMBLE_JULIANDAY|CLF_ASSEMBLE_SECONDS;
+
+ yyRelMonth = 0;
+ }
+
+ /* add days (or other parts aligned to days) */
+ if (yyRelDay) {
+
+ /* assemble julianDay using new year, month, etc. */
+ if (info->flags & CLF_ASSEMBLE_JULIANDAY) {
+ GetJulianDayFromEraYearMonthDay(&yydate, GREGORIAN_CHANGE_DATE);
+ info->flags &= ~CLF_ASSEMBLE_JULIANDAY;
+ }
+ yydate.julianDay += yyRelDay;
+
+ /* julianDay was changed, on demand (lazy) extract year, month, etc. again */
+ info->flags |= CLF_ASSEMBLE_DATE|CLF_ASSEMBLE_SECONDS;
+
+ yyRelDay = 0;
+ }
+
+ /* relative time (seconds), if exceeds current date, do the day conversion and
+ * leave rest of the increment in yyRelSeconds to add it hereafter in UTC seconds */
+ if (yyRelSeconds) {
+ int newSecs = yySeconds + yyRelSeconds;
+
+ /* if seconds increment outside of current date, increment day */
+ if (newSecs / SECONDS_PER_DAY != yySeconds / SECONDS_PER_DAY) {
+
+ yyRelDay += newSecs / SECONDS_PER_DAY;
+ yySeconds = 0;
+ yyRelSeconds = newSecs % SECONDS_PER_DAY;
+
+ goto repeat_rel;
+ }
+ }
+
+ yyHaveRel = 0;
+ }
+
+ /*
+ * Do relative (ordinal) month
+ */
+
+ if (yyHaveOrdinalMonth) {
+ int monthDiff;
+
+ /* if needed extract year, month, etc. again */
+ if (info->flags & CLF_ASSEMBLE_DATE) {
+ GetGregorianEraYearDay(&yydate, GREGORIAN_CHANGE_DATE);
+ GetMonthDay(&yydate);
+ GetYearWeekDay(&yydate, GREGORIAN_CHANGE_DATE);
+ info->flags &= ~CLF_ASSEMBLE_DATE;
+ }
+
+ if (yyMonthOrdinalIncr > 0) {
+ monthDiff = yyMonthOrdinal - yyMonth;
+ if (monthDiff <= 0) {
+ monthDiff += 12;
+ }
+ yyMonthOrdinalIncr--;
+ } else {
+ monthDiff = yyMonth - yyMonthOrdinal;
+ if (monthDiff >= 0) {
+ monthDiff -= 12;
+ }
+ yyMonthOrdinalIncr++;
+ }
+
+ /* process it further via relative times */
+ yyHaveRel++;
+ yyYear += yyMonthOrdinalIncr;
+ yyRelMonth += monthDiff;
+ yyHaveOrdinalMonth = 0;
+
+ info->flags |= CLF_ASSEMBLE_JULIANDAY|CLF_ASSEMBLE_SECONDS;
+
+ goto repeat_rel;
+ }
+
+ /*
+ * Do relative weekday
+ */
+
+ if (yyHaveDay && !yyHaveDate) {
+
+ /* if needed assemble julianDay now */
+ if (info->flags & CLF_ASSEMBLE_JULIANDAY) {
+ GetJulianDayFromEraYearMonthDay(&yydate, GREGORIAN_CHANGE_DATE);
+ info->flags &= ~CLF_ASSEMBLE_JULIANDAY;
+ }
+
+ yydate.era = CE;
+ yydate.julianDay = WeekdayOnOrBefore(yyDayNumber, yydate.julianDay + 6)
+ + 7 * yyDayOrdinal;
+ if (yyDayOrdinal > 0) {
+ yydate.julianDay -= 7;
+ }
+ info->flags |= CLF_ASSEMBLE_DATE|CLF_ASSEMBLE_SECONDS;
+ }
+
return TCL_OK;
+}
-#undef timezoneObj
-#undef localeObj
-#undef formatObj
+
+/*----------------------------------------------------------------------
+ *
+ * ClockWeekdaysOffs --
+ *
+ * Get offset in days for the number of week days corresponding the
+ * given day of week (skipping Saturdays and Sundays).
+ *
+ *
+ * Results:
+ * Returns a day increment adjusted the given weekdays
+ *
+ *----------------------------------------------------------------------
+ */
+
+static inline int
+ClockWeekdaysOffs(
+ register int dayOfWeek,
+ register int offs)
+{
+ register int weeks, resDayOfWeek;
+
+ /* offset in days */
+ weeks = offs / 5;
+ offs = offs % 5;
+ /* compiler fix for negative offs - wrap (0, -1) -> (-1, 4) */
+ if (offs < 0) {
+ weeks--;
+ offs = 5 + offs;
+ }
+ offs += 7 * weeks;
+
+ /* resulting day of week */
+ {
+ register int day = (offs % 7);
+ /* compiler fix for negative offs - wrap (0, -1) -> (-1, 6) */
+ if (day < 0) {
+ day = 7 + day;
+ }
+ resDayOfWeek = dayOfWeek + day;
+ }
+
+ /* adjust if we start from a weekend */
+ if (dayOfWeek > 5) {
+ int adj = 5 - dayOfWeek;
+ offs += adj;
+ resDayOfWeek += adj;
+ }
+
+ /* adjust if we end up on a weekend */
+ if (resDayOfWeek > 5) {
+ offs += 2;
+ }
+
+ return offs;
+}
+
+
+
+/*----------------------------------------------------------------------
+ *
+ * ClockAddObjCmd -- , clock add --
+ *
+ * Adds an offset to a given time.
+ *
+ * Refer to the user documentation to see what it exactly does.
+ *
+ * Syntax:
+ * clock add clockval ?count unit?... ?-option value?
+ *
+ * Parameters:
+ * clockval -- Starting time value
+ * count -- Amount of a unit of time to add
+ * unit -- Unit of time to add, must be one of:
+ * years year months month weeks week
+ * days day hours hour minutes minute
+ * seconds second
+ *
+ * Options:
+ * -gmt BOOLEAN
+ * Flag synonymous with '-timezone :GMT'
+ * -timezone ZONE
+ * Name of the time zone in which calculations are to be done.
+ * -locale NAME
+ * Name of the locale in which calculations are to be done.
+ * Used to determine the Gregorian change date.
+ *
+ * Results:
+ * Returns a standard Tcl result with the given time adjusted
+ * by the given offset(s) in order.
+ *
+ * Notes:
+ * It is possible that adding a number of months or years will adjust the
+ * day of the month as well. For instance, the time at one month after
+ * 31 January is either 28 or 29 February, because February has fewer
+ * than 31 days.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+ClockAddObjCmd(
+ ClientData clientData, /* Client data containing literal pool */
+ Tcl_Interp *interp, /* Tcl interpreter */
+ int objc, /* Parameter count */
+ Tcl_Obj *const objv[]) /* Parameter values */
+{
+ ClockClientData *dataPtr = clientData;
+ int ret;
+ ClockFmtScnCmdArgs opts; /* Format, locale, timezone and base */
+ DateInfo yy; /* Common structure used for parsing */
+ DateInfo *info = &yy;
+
+ /* add "week" to units also (because otherwise ambiguous) */
+ static const char *const units[] = {
+ "years", "months", "week", "weeks",
+ "days", "weekdays",
+ "hours", "minutes", "seconds",
+ NULL
+ };
+ enum unitInd {
+ CLC_ADD_YEARS, CLC_ADD_MONTHS, CLC_ADD_WEEK, CLC_ADD_WEEKS,
+ CLC_ADD_DAYS, CLC_ADD_WEEKDAYS,
+ CLC_ADD_HOURS, CLC_ADD_MINUTES, CLC_ADD_SECONDS
+ };
+ int unitIndex; /* Index of an option. */
+ int i;
+ Tcl_WideInt offs;
+
+ /* even number of arguments */
+ if ((objc & 1) == 1) {
+ Tcl_WrongNumArgs(interp, 1, objv, "clockval|-now ?number units?..."
+ "?-gmt boolean? "
+ "?-locale LOCALE? ?-timezone ZONE?");
+ Tcl_SetErrorCode(interp, "CLOCK", "wrongNumArgs", NULL);
+ return TCL_ERROR;
+ }
+
+ ClockInitDateInfo(&yy);
+
+ /*
+ * Extract values for the keywords.
+ */
+
+ ClockInitFmtScnArgs(clientData, interp, &opts);
+ ret = ClockParseFmtScnArgs(&opts, &yy.date, objc, objv,
+ CLC_ADD_ARGS);
+ if (ret != TCL_OK) {
+ goto done;
+ }
+
+ /* time together as seconds of the day */
+ yySeconds = yydate.localSeconds % SECONDS_PER_DAY;
+ /* seconds are in localSeconds (relative base date), so reset time here */
+ yyHour = 0; yyMinutes = 0; yyMeridian = MER24;
+
+ ret = TCL_ERROR;
+
+ /*
+ * Find each offset and process date increment
+ */
+
+ for (i = 2; i < objc; i+=2) {
+ /* bypass not integers (options, allready processed above) */
+ if (TclGetWideIntFromObj(NULL, objv[i], &offs) != TCL_OK) {
+ continue;
+ }
+ if (objv[i]->typePtr == &tclBignumType) {
+ Tcl_SetObjResult(interp, dataPtr->literals[LIT_INTEGER_VALUE_TOO_LARGE]);
+ goto done;
+ }
+ /* get unit */
+ if (Tcl_GetIndexFromObj(interp, objv[i+1], units, "unit", 0,
+ &unitIndex) != TCL_OK) {
+ goto done;
+ }
+
+ /* nothing to do if zero quantity */
+ if (!offs) {
+ continue;
+ }
+
+ /* if in-between conversion needed (already have relative date/time),
+ * correct date info, because the date may be changed,
+ * so refresh it now */
+
+ if ( yyHaveRel
+ && ( unitIndex == CLC_ADD_WEEKDAYS
+ /* some months can be shorter as another */
+ || yyRelMonth || yyRelDay
+ /* day changed */
+ || yySeconds + yyRelSeconds > SECONDS_PER_DAY
+ || yySeconds + yyRelSeconds < 0
+ )
+ ) {
+ if (ClockCalcRelTime(info, &opts) != TCL_OK) {
+ goto done;
+ }
+ }
+
+ /* process increment by offset + unit */
+ yyHaveRel++;
+ switch (unitIndex) {
+ case CLC_ADD_YEARS:
+ yyRelMonth += offs * 12;
+ break;
+ case CLC_ADD_MONTHS:
+ yyRelMonth += offs;
+ break;
+ case CLC_ADD_WEEK:
+ case CLC_ADD_WEEKS:
+ yyRelDay += offs * 7;
+ break;
+ case CLC_ADD_DAYS:
+ yyRelDay += offs;
+ break;
+ case CLC_ADD_WEEKDAYS:
+ /* add number of week days (skipping Saturdays and Sundays)
+ * to a relative days value. */
+ offs = ClockWeekdaysOffs(yy.date.dayOfWeek, offs);
+ yyRelDay += offs;
+ break;
+ case CLC_ADD_HOURS:
+ yyRelSeconds += offs * 60 * 60;
+ break;
+ case CLC_ADD_MINUTES:
+ yyRelSeconds += offs * 60;
+ break;
+ case CLC_ADD_SECONDS:
+ yyRelSeconds += offs;
+ break;
+ }
+ }
+
+ /*
+ * Do relative times (if not yet already processed interim):
+ */
+
+ if (yyHaveRel) {
+ if (ClockCalcRelTime(info, &opts) != TCL_OK) {
+ goto done;
+ }
+ }
+
+ /* Convert date info structure into UTC seconds */
+
+ ret = ClockScanCommit(clientData, &yy, &opts);
+
+done:
+
+ Tcl_UnsetObjRef(yy.date.tzName);
+
+ if (ret != TCL_OK) {
+ return ret;
+ }
+
+ Tcl_SetObjResult(interp, Tcl_NewWideIntObj(yy.date.seconds));
+ return TCL_OK;
}
/*----------------------------------------------------------------------
@@ -2009,7 +4025,7 @@ ClockSecondsObjCmd(
/*
*----------------------------------------------------------------------
*
- * TzsetIfNecessary --
+ * TzsetGetEpoch --, TzsetIfNecessary --
*
* Calls the tzset() library function if the contents of the TZ
* environment variable has changed.
@@ -2023,15 +4039,37 @@ ClockSecondsObjCmd(
*----------------------------------------------------------------------
*/
-static void
-TzsetIfNecessary(void)
+static unsigned long
+TzsetGetEpoch(void)
{
static char* tzWas = INT2PTR(-1); /* Previous value of TZ, protected by
* clockMutex. */
+ static long tzLastRefresh = 0; /* Used for latency before next refresh */
+ static unsigned long tzWasEpoch = 0; /* Epoch, signals that TZ changed */
+ static unsigned long tzEnvEpoch = 0; /* Last env epoch, for faster signaling,
+ that TZ changed via TCL */
+
const char *tzIsNow; /* Current value of TZ */
+
+ /*
+ * Prevent performance regression on some platforms by resolving of system time zone:
+ * small latency for check whether environment was changed (once per second)
+ * no latency if environment was chaned with tcl-env (compare both epoch values)
+ */
+ Tcl_Time now;
+ Tcl_GetTime(&now);
+ if (now.sec == tzLastRefresh && tzEnvEpoch == TclEnvEpoch) {
+ return tzWasEpoch;
+ }
+ tzEnvEpoch = TclEnvEpoch;
+ tzLastRefresh = now.sec;
+ /* check in lock */
Tcl_MutexLock(&clockMutex);
+ tzIsNow = getenv("TCL_TZ");
+ if (tzIsNow == NULL) {
tzIsNow = getenv("TZ");
+ }
if (tzIsNow != NULL && (tzWas == NULL || tzWas == INT2PTR(-1)
|| strcmp(tzIsNow, tzWas) != 0)) {
tzset();
@@ -2040,43 +4078,21 @@ TzsetIfNecessary(void)
}
tzWas = ckalloc(strlen(tzIsNow) + 1);
strcpy(tzWas, tzIsNow);
+ tzWasEpoch++;
} else if (tzIsNow == NULL && tzWas != NULL) {
tzset();
if (tzWas != INT2PTR(-1)) ckfree(tzWas);
tzWas = NULL;
+ tzWasEpoch++;
}
Tcl_MutexUnlock(&clockMutex);
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * ClockDeleteCmdProc --
- *
- * Remove a reference to the clock client data, and clean up memory
- * when it's all gone.
- *
- * Results:
- * None.
- *
- *----------------------------------------------------------------------
- */
-static void
-ClockDeleteCmdProc(
- ClientData clientData) /* Opaque pointer to the client data */
+ return tzWasEpoch;
+}
+ static void
+TzsetIfNecessary(void)
{
- ClockClientData *data = clientData;
- int i;
-
- data->refCount--;
- if (data->refCount == 0) {
- for (i = 0; i < LIT__END; ++i) {
- Tcl_DecrRefCount(data->literals[i]);
- }
- ckfree(data->literals);
- ckfree(data);
- }
+ TzsetGetEpoch();
}
/*
diff --git a/generic/tclDate.c b/generic/tclDate.c
index e4dd000..64cb804 100644
--- a/generic/tclDate.c
+++ b/generic/tclDate.c
@@ -1,24 +1,22 @@
-/* A Bison parser, made by GNU Bison 2.3. */
+/* A Bison parser, made by GNU Bison 2.4.2. */
/* Skeleton implementation for Bison's Yacc-like parsers in C
-
- Copyright (C) 1984, 1989, 1990, 2000, 2001, 2002, 2003, 2004, 2005, 2006
- Free Software Foundation, Inc.
-
- This program is free software; you can redistribute it and/or modify
+
+ Copyright (C) 1984, 1989-1990, 2000-2006, 2009-2010 Free Software
+ Foundation, Inc.
+
+ This program is free software: you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
- the Free Software Foundation; either version 2, or (at your option)
- any later version.
-
+ the Free Software Foundation, either version 3 of the License, or
+ (at your option) any later version.
+
This program is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
GNU General Public License for more details.
-
+
You should have received a copy of the GNU General Public License
- along with this program; if not, write to the Free Software
- Foundation, Inc., 51 Franklin Street, Fifth Floor,
- Boston, MA 02110-1301, USA. */
+ along with this program. If not, see <http://www.gnu.org/licenses/>. */
/* As a special exception, you may create a larger work that contains
part or all of the Bison parser skeleton and distribute that work
@@ -29,7 +27,7 @@
special exception, which will cause the skeleton and the resulting
Bison output files to be licensed under the GNU General Public
License without this special exception.
-
+
This special exception was added by the Free Software Foundation in
version 2.2 of Bison. */
@@ -47,7 +45,7 @@
#define YYBISON 1
/* Bison version. */
-#define YYBISON_VERSION "2.3"
+#define YYBISON_VERSION "2.4.2"
/* Skeleton name. */
#define YYSKELETON_NAME "yacc.c"
@@ -55,65 +53,24 @@
/* Pure parsers. */
#define YYPURE 1
+/* Push parsers. */
+#define YYPUSH 0
+
+/* Pull parsers. */
+#define YYPULL 1
+
/* Using locations. */
#define YYLSP_NEEDED 1
/* Substitute the variable and function names. */
-#define yyparse TclDateparse
-#define yylex TclDatelex
-#define yyerror TclDateerror
-#define yylval TclDatelval
-#define yychar TclDatechar
-#define yydebug TclDatedebug
-#define yynerrs TclDatenerrs
-#define yylloc TclDatelloc
-
-/* Tokens. */
-#ifndef YYTOKENTYPE
-# define YYTOKENTYPE
- /* Put the tokens into the symbol table, so that GDB and other debuggers
- know about them. */
- enum yytokentype {
- tAGO = 258,
- tDAY = 259,
- tDAYZONE = 260,
- tID = 261,
- tMERIDIAN = 262,
- tMONTH = 263,
- tMONTH_UNIT = 264,
- tSTARDATE = 265,
- tSEC_UNIT = 266,
- tSNUMBER = 267,
- tUNUMBER = 268,
- tZONE = 269,
- tEPOCH = 270,
- tDST = 271,
- tISOBASE = 272,
- tDAY_UNIT = 273,
- tNEXT = 274
- };
-#endif
-/* Tokens. */
-#define tAGO 258
-#define tDAY 259
-#define tDAYZONE 260
-#define tID 261
-#define tMERIDIAN 262
-#define tMONTH 263
-#define tMONTH_UNIT 264
-#define tSTARDATE 265
-#define tSEC_UNIT 266
-#define tSNUMBER 267
-#define tUNUMBER 268
-#define tZONE 269
-#define tEPOCH 270
-#define tDST 271
-#define tISOBASE 272
-#define tDAY_UNIT 273
-#define tNEXT 274
-
-
-
+#define yyparse TclDateparse
+#define yylex TclDatelex
+#define yyerror TclDateerror
+#define yylval TclDatelval
+#define yychar TclDatechar
+#define yydebug TclDatedebug
+#define yynerrs TclDatenerrs
+#define yylloc TclDatelloc
/* Copy the first part of user declarations. */
@@ -129,6 +86,7 @@
*
* See the file "license.terms" for information on usage and redistribution of
* this file, and for a DISCLAIMER OF ALL WARRANTIES.
+ *
*/
#include "tclInt.h"
@@ -146,73 +104,11 @@
* parsed fields will be returned.
*/
-typedef struct DateInfo {
-
- Tcl_Obj* messages; /* Error messages */
- const char* separatrix; /* String separating messages */
-
- time_t dateYear;
- time_t dateMonth;
- time_t dateDay;
- int dateHaveDate;
-
- time_t dateHour;
- time_t dateMinutes;
- time_t dateSeconds;
- int dateMeridian;
- int dateHaveTime;
-
- time_t dateTimezone;
- int dateDSTmode;
- int dateHaveZone;
-
- time_t dateRelMonth;
- time_t dateRelDay;
- time_t dateRelSeconds;
- int dateHaveRel;
-
- time_t dateMonthOrdinal;
- int dateHaveOrdinalMonth;
-
- time_t dateDayOrdinal;
- time_t dateDayNumber;
- int dateHaveDay;
-
- const char *dateStart;
- const char *dateInput;
- time_t *dateRelPointer;
-
- int dateDigitCount;
-} DateInfo;
+#include "tclDate.h"
#define YYMALLOC ckalloc
#define YYFREE(x) (ckfree((void*) (x)))
-#define yyDSTmode (info->dateDSTmode)
-#define yyDayOrdinal (info->dateDayOrdinal)
-#define yyDayNumber (info->dateDayNumber)
-#define yyMonthOrdinal (info->dateMonthOrdinal)
-#define yyHaveDate (info->dateHaveDate)
-#define yyHaveDay (info->dateHaveDay)
-#define yyHaveOrdinalMonth (info->dateHaveOrdinalMonth)
-#define yyHaveRel (info->dateHaveRel)
-#define yyHaveTime (info->dateHaveTime)
-#define yyHaveZone (info->dateHaveZone)
-#define yyTimezone (info->dateTimezone)
-#define yyDay (info->dateDay)
-#define yyMonth (info->dateMonth)
-#define yyYear (info->dateYear)
-#define yyHour (info->dateHour)
-#define yyMinutes (info->dateMinutes)
-#define yySeconds (info->dateSeconds)
-#define yyMeridian (info->dateMeridian)
-#define yyRelMonth (info->dateRelMonth)
-#define yyRelDay (info->dateRelDay)
-#define yyRelSeconds (info->dateRelSeconds)
-#define yyRelPointer (info->dateRelPointer)
-#define yyInput (info->dateInput)
-#define yyDigitCount (info->dateDigitCount)
-
#define EPOCH 1970
#define START_OF_TIME 1902
#define END_OF_TIME 2037
@@ -246,13 +142,6 @@ typedef enum _DSTMODE {
DSTon, DSToff, DSTmaybe
} DSTMODE;
-/*
- * Meridian: am, pm, or 24-hour style.
- */
-
-typedef enum _MERIDIAN {
- MERam, MERpm, MER24
-} MERIDIAN;
@@ -274,19 +163,49 @@ typedef enum _MERIDIAN {
# define YYTOKEN_TABLE 0
#endif
+
+/* Tokens. */
+#ifndef YYTOKENTYPE
+# define YYTOKENTYPE
+ /* Put the tokens into the symbol table, so that GDB and other debuggers
+ know about them. */
+ enum yytokentype {
+ tAGO = 258,
+ tDAY = 259,
+ tDAYZONE = 260,
+ tID = 261,
+ tMERIDIAN = 262,
+ tMONTH = 263,
+ tMONTH_UNIT = 264,
+ tSTARDATE = 265,
+ tSEC_UNIT = 266,
+ tSNUMBER = 267,
+ tUNUMBER = 268,
+ tZONE = 269,
+ tEPOCH = 270,
+ tDST = 271,
+ tISOBASE = 272,
+ tDAY_UNIT = 273,
+ tNEXT = 274
+ };
+#endif
+
+
+
#if ! defined YYSTYPE && ! defined YYSTYPE_IS_DECLARED
typedef union YYSTYPE
-
{
+
+
time_t Number;
enum _MERIDIAN Meridian;
-}
-/* Line 187 of yacc.c. */
- YYSTYPE;
+
+
+} YYSTYPE;
+# define YYSTYPE_IS_TRIVIAL 1
# define yystype YYSTYPE /* obsolescent; will be withdrawn */
# define YYSTYPE_IS_DECLARED 1
-# define YYSTYPE_IS_TRIVIAL 1
#endif
#if ! defined YYLTYPE && ! defined YYLTYPE_IS_DECLARED
@@ -316,14 +235,10 @@ static int LookupWord(YYSTYPE* yylvalPtr, char *buff);
DateInfo* info, const char *s);
static int TclDatelex(YYSTYPE* yylvalPtr, YYLTYPE* location,
DateInfo* info);
-static time_t ToSeconds(time_t Hours, time_t Minutes,
- time_t Seconds, MERIDIAN Meridian);
MODULE_SCOPE int yyparse(DateInfo*);
-/* Line 216 of yacc.c. */
-
#ifdef short
# undef short
@@ -359,15 +274,21 @@ typedef short int yytype_int16;
#ifndef YYSIZE_T
# ifdef __SIZE_TYPE__
# define YYSIZE_T __SIZE_TYPE__
-# else
+# elif defined size_t
+# define YYSIZE_T size_t
+# elif ! defined YYSIZE_T && (defined __STDC__ || defined __C99__FUNC__ \
+ || defined __cplusplus || defined _MSC_VER)
+# include <stddef.h> /* INFRINGES ON USER NAME SPACE */
# define YYSIZE_T size_t
+# else
+# define YYSIZE_T unsigned int
# endif
#endif
#define YYSIZE_MAXIMUM ((YYSIZE_T) -1)
#ifndef YY_
-# if YYENABLE_NLS
+# if defined YYENABLE_NLS && YYENABLE_NLS
# if ENABLE_NLS
# include <libintl.h> /* INFRINGES ON USER NAME SPACE */
# define YY_(msgid) dgettext ("bison-runtime", msgid)
@@ -392,14 +313,14 @@ typedef short int yytype_int16;
#if (defined __STDC__ || defined __C99__FUNC__ \
|| defined __cplusplus || defined _MSC_VER)
static int
-YYID (int i)
+YYID (int yyi)
#else
static int
-YYID (i)
- int i;
+YYID (yyi)
+ int yyi;
#endif
{
- return i;
+ return yyi;
}
#endif
@@ -481,9 +402,9 @@ void free (void *); /* INFRINGES ON USER NAME SPACE */
/* A type that is properly aligned for any stack member. */
union yyalloc
{
- yytype_int16 yyss;
- YYSTYPE yyvs;
- YYLTYPE yyls;
+ yytype_int16 yyss_alloc;
+ YYSTYPE yyvs_alloc;
+ YYLTYPE yyls_alloc;
};
/* The size of the maximum gap between one aligned stack and the next. */
@@ -518,12 +439,12 @@ union yyalloc
elements in the stack, and YYPTR gives the new location of the
stack. Advance YYPTR to a properly aligned location for the next
stack. */
-# define YYSTACK_RELOCATE(Stack) \
+# define YYSTACK_RELOCATE(Stack_alloc, Stack) \
do \
{ \
YYSIZE_T yynewbytes; \
- YYCOPY (&yyptr->Stack, Stack, yysize); \
- Stack = &yyptr->Stack; \
+ YYCOPY (&yyptr->Stack_alloc, Stack, yysize); \
+ Stack = &yyptr->Stack_alloc; \
yynewbytes = yystacksize * sizeof (*Stack) + YYSTACK_GAP_MAXIMUM; \
yyptr += yynewbytes / sizeof (*yyptr); \
} \
@@ -624,12 +545,12 @@ static const yytype_int8 yyrhs[] =
/* YYRLINE[YYN] -- source line where rule number YYN was defined. */
static const yytype_uint16 yyrline[] =
{
- 0, 225, 225, 226, 229, 232, 235, 238, 241, 244,
- 247, 251, 256, 259, 265, 271, 279, 285, 296, 300,
- 304, 310, 314, 318, 322, 326, 332, 336, 341, 346,
- 351, 356, 360, 365, 369, 374, 381, 385, 391, 400,
- 409, 419, 433, 438, 441, 444, 447, 450, 453, 458,
- 461, 466, 470, 474, 480, 498, 501
+ 0, 152, 152, 153, 156, 159, 162, 165, 168, 171,
+ 174, 178, 183, 186, 192, 198, 206, 212, 223, 227,
+ 231, 237, 241, 245, 249, 253, 259, 263, 268, 273,
+ 278, 283, 287, 292, 296, 301, 308, 312, 318, 327,
+ 336, 346, 360, 365, 368, 371, 374, 377, 380, 385,
+ 388, 393, 397, 401, 407, 425, 428
};
#endif
@@ -783,9 +704,18 @@ static const yytype_uint8 yystos[] =
/* Like YYERROR except do call yyerror. This remains here temporarily
to ease the transition to the new meaning of YYERROR, for GCC.
- Once GCC version 2 has supplanted version 1, this can go. */
+ Once GCC version 2 has supplanted version 1, this can go. However,
+ YYFAIL appears to be in use. Nevertheless, it is formally deprecated
+ in Bison 2.4.2's NEWS entry, where a plan to phase it out is
+ discussed. */
#define YYFAIL goto yyerrlab
+#if defined YYFAIL
+ /* This is here to suppress warnings from the GCC cpp's
+ -Wunused-macros. Normally we don't worry about that warning, but
+ some users do, and we want to make it easy for users to remove
+ YYFAIL uses, which will produce warnings from Bison 2.5. */
+#endif
#define YYRECOVERING() (!!yyerrstatus)
@@ -842,7 +772,7 @@ while (YYID (0))
we won't break user code: when these are the locations we know. */
#ifndef YY_LOCATION_PRINT
-# if YYLTYPE_IS_TRIVIAL
+# if defined YYLTYPE_IS_TRIVIAL && YYLTYPE_IS_TRIVIAL
# define YY_LOCATION_PRINT(File, Loc) \
fprintf (File, "%d.%d-%d.%d", \
(Loc).first_line, (Loc).first_column, \
@@ -961,17 +891,20 @@ yy_symbol_print (yyoutput, yytype, yyvaluep, yylocationp, info)
#if (defined __STDC__ || defined __C99__FUNC__ \
|| defined __cplusplus || defined _MSC_VER)
static void
-yy_stack_print (yytype_int16 *bottom, yytype_int16 *top)
+yy_stack_print (yytype_int16 *yybottom, yytype_int16 *yytop)
#else
static void
-yy_stack_print (bottom, top)
- yytype_int16 *bottom;
- yytype_int16 *top;
+yy_stack_print (yybottom, yytop)
+ yytype_int16 *yybottom;
+ yytype_int16 *yytop;
#endif
{
YYFPRINTF (stderr, "Stack now");
- for (; bottom <= top; ++bottom)
- YYFPRINTF (stderr, " %d", *bottom);
+ for (; yybottom <= yytop; yybottom++)
+ {
+ int yybot = *yybottom;
+ YYFPRINTF (stderr, " %d", yybot);
+ }
YYFPRINTF (stderr, "\n");
}
@@ -1007,11 +940,11 @@ yy_reduce_print (yyvsp, yylsp, yyrule, info)
/* The symbols being reduced. */
for (yyi = 0; yyi < yynrhs; yyi++)
{
- fprintf (stderr, " $%d = ", yyi + 1);
+ YYFPRINTF (stderr, " $%d = ", yyi + 1);
yy_symbol_print (stderr, yyrhs[yyprhs[yyrule] + yyi],
&(yyvsp[(yyi + 1) - (yynrhs)])
, &(yylsp[(yyi + 1) - (yynrhs)]) , info);
- fprintf (stderr, "\n");
+ YYFPRINTF (stderr, "\n");
}
}
@@ -1295,10 +1228,8 @@ yydestruct (yymsg, yytype, yyvaluep, yylocationp, info)
break;
}
}
-
/* Prevent warnings from -Wmissing-prototypes. */
-
#ifdef YYPARSE_PARAM
#if defined __STDC__ || defined __cplusplus
int yyparse (void *YYPARSE_PARAM);
@@ -1317,10 +1248,9 @@ int yyparse ();
-
-/*----------.
-| yyparse. |
-`----------*/
+/*-------------------------.
+| yyparse or yypush_parse. |
+`-------------------------*/
#ifdef YYPARSE_PARAM
#if (defined __STDC__ || defined __C99__FUNC__ \
@@ -1344,88 +1274,97 @@ yyparse (info)
#endif
#endif
{
- /* The look-ahead symbol. */
+/* The lookahead symbol. */
int yychar;
-/* The semantic value of the look-ahead symbol. */
+/* The semantic value of the lookahead symbol. */
YYSTYPE yylval;
-/* Number of syntax errors so far. */
-int yynerrs;
-/* Location data for the look-ahead symbol. */
+/* Location data for the lookahead symbol. */
YYLTYPE yylloc;
- int yystate;
- int yyn;
- int yyresult;
- /* Number of tokens to shift before error messages enabled. */
- int yyerrstatus;
- /* Look-ahead token as an internal (translated) token number. */
- int yytoken = 0;
-#if YYERROR_VERBOSE
- /* Buffer for error messages, and its allocated size. */
- char yymsgbuf[128];
- char *yymsg = yymsgbuf;
- YYSIZE_T yymsg_alloc = sizeof yymsgbuf;
-#endif
+ /* Number of syntax errors so far. */
+ int yynerrs;
- /* Three stacks and their tools:
- `yyss': related to states,
- `yyvs': related to semantic values,
- `yyls': related to locations.
+ int yystate;
+ /* Number of tokens to shift before error messages enabled. */
+ int yyerrstatus;
- Refer to the stacks thru separate pointers, to allow yyoverflow
- to reallocate them elsewhere. */
+ /* The stacks and their tools:
+ `yyss': related to states.
+ `yyvs': related to semantic values.
+ `yyls': related to locations.
- /* The state stack. */
- yytype_int16 yyssa[YYINITDEPTH];
- yytype_int16 *yyss = yyssa;
- yytype_int16 *yyssp;
+ Refer to the stacks thru separate pointers, to allow yyoverflow
+ to reallocate them elsewhere. */
- /* The semantic value stack. */
- YYSTYPE yyvsa[YYINITDEPTH];
- YYSTYPE *yyvs = yyvsa;
- YYSTYPE *yyvsp;
+ /* The state stack. */
+ yytype_int16 yyssa[YYINITDEPTH];
+ yytype_int16 *yyss;
+ yytype_int16 *yyssp;
- /* The location stack. */
- YYLTYPE yylsa[YYINITDEPTH];
- YYLTYPE *yyls = yylsa;
- YYLTYPE *yylsp;
- /* The locations where the error started and ended. */
- YYLTYPE yyerror_range[2];
+ /* The semantic value stack. */
+ YYSTYPE yyvsa[YYINITDEPTH];
+ YYSTYPE *yyvs;
+ YYSTYPE *yyvsp;
-#define YYPOPSTACK(N) (yyvsp -= (N), yyssp -= (N), yylsp -= (N))
+ /* The location stack. */
+ YYLTYPE yylsa[YYINITDEPTH];
+ YYLTYPE *yyls;
+ YYLTYPE *yylsp;
- YYSIZE_T yystacksize = YYINITDEPTH;
+ /* The locations where the error started and ended. */
+ YYLTYPE yyerror_range[2];
+ YYSIZE_T yystacksize;
+
+ int yyn;
+ int yyresult;
+ /* Lookahead token as an internal (translated) token number. */
+ int yytoken;
/* The variables used to return semantic value and location from the
action routines. */
YYSTYPE yyval;
YYLTYPE yyloc;
+#if YYERROR_VERBOSE
+ /* Buffer for error messages, and its allocated size. */
+ char yymsgbuf[128];
+ char *yymsg = yymsgbuf;
+ YYSIZE_T yymsg_alloc = sizeof yymsgbuf;
+#endif
+
+#define YYPOPSTACK(N) (yyvsp -= (N), yyssp -= (N), yylsp -= (N))
+
/* The number of symbols on the RHS of the reduced rule.
Keep to zero when no symbol should be popped. */
int yylen = 0;
+ yytoken = 0;
+ yyss = yyssa;
+ yyvs = yyvsa;
+ yyls = yylsa;
+ yystacksize = YYINITDEPTH;
+
YYDPRINTF ((stderr, "Starting parse\n"));
yystate = 0;
yyerrstatus = 0;
yynerrs = 0;
- yychar = YYEMPTY; /* Cause a token to be read. */
+ yychar = YYEMPTY; /* Cause a token to be read. */
/* Initialize stack pointers.
Waste one element of value and location stack
so that they stay on the same level as the state stack.
The wasted elements are never initialized. */
-
yyssp = yyss;
yyvsp = yyvs;
yylsp = yyls;
-#if YYLTYPE_IS_TRIVIAL
+
+#if defined YYLTYPE_IS_TRIVIAL && YYLTYPE_IS_TRIVIAL
/* Initialize the default location before parsing starts. */
yylloc.first_line = yylloc.last_line = 1;
- yylloc.first_column = yylloc.last_column = 0;
+ yylloc.first_column = yylloc.last_column = 1;
#endif
goto yysetstate;
@@ -1464,6 +1403,7 @@ YYLTYPE yylloc;
&yyvs1, yysize * sizeof (*yyvsp),
&yyls1, yysize * sizeof (*yylsp),
&yystacksize);
+
yyls = yyls1;
yyss = yyss1;
yyvs = yyvs1;
@@ -1485,9 +1425,9 @@ YYLTYPE yylloc;
(union yyalloc *) YYSTACK_ALLOC (YYSTACK_BYTES (yystacksize));
if (! yyptr)
goto yyexhaustedlab;
- YYSTACK_RELOCATE (yyss);
- YYSTACK_RELOCATE (yyvs);
- YYSTACK_RELOCATE (yyls);
+ YYSTACK_RELOCATE (yyss_alloc, yyss);
+ YYSTACK_RELOCATE (yyvs_alloc, yyvs);
+ YYSTACK_RELOCATE (yyls_alloc, yyls);
# undef YYSTACK_RELOCATE
if (yyss1 != yyssa)
YYSTACK_FREE (yyss1);
@@ -1508,6 +1448,9 @@ YYLTYPE yylloc;
YYDPRINTF ((stderr, "Entering state %d\n", yystate));
+ if (yystate == YYFINAL)
+ YYACCEPT;
+
goto yybackup;
/*-----------.
@@ -1516,16 +1459,16 @@ YYLTYPE yylloc;
yybackup:
/* Do appropriate processing given the current state. Read a
- look-ahead token if we need one and don't already have one. */
+ lookahead token if we need one and don't already have one. */
- /* First try to decide what to do without reference to look-ahead token. */
+ /* First try to decide what to do without reference to lookahead token. */
yyn = yypact[yystate];
if (yyn == YYPACT_NINF)
goto yydefault;
- /* Not known => get a look-ahead token if don't already have one. */
+ /* Not known => get a lookahead token if don't already have one. */
- /* YYCHAR is either YYEMPTY or YYEOF or a valid look-ahead symbol. */
+ /* YYCHAR is either YYEMPTY or YYEOF or a valid lookahead symbol. */
if (yychar == YYEMPTY)
{
YYDPRINTF ((stderr, "Reading a token: "));
@@ -1557,20 +1500,16 @@ yybackup:
goto yyreduce;
}
- if (yyn == YYFINAL)
- YYACCEPT;
-
/* Count tokens shifted since error; after three, turn off error
status. */
if (yyerrstatus)
yyerrstatus--;
- /* Shift the look-ahead token. */
+ /* Shift the lookahead token. */
YY_SYMBOL_PRINT ("Shifting", yytoken, &yylval, &yylloc);
- /* Discard the shifted token unless it is eof. */
- if (yychar != YYEOF)
- yychar = YYEMPTY;
+ /* Discard the shifted token. */
+ yychar = YYEMPTY;
yystate = yyn;
*++yyvsp = yylval;
@@ -1878,16 +1817,16 @@ yyreduce:
case 36:
{
- yyMonthOrdinal = 1;
- yyMonth = (yyvsp[(2) - (2)].Number);
+ yyMonthOrdinalIncr = 1;
+ yyMonthOrdinal = (yyvsp[(2) - (2)].Number);
;}
break;
case 37:
{
- yyMonthOrdinal = (yyvsp[(2) - (3)].Number);
- yyMonth = (yyvsp[(3) - (3)].Number);
+ yyMonthOrdinalIncr = (yyvsp[(2) - (3)].Number);
+ yyMonthOrdinal = (yyvsp[(3) - (3)].Number);
;}
break;
@@ -2062,7 +2001,6 @@ yyreduce:
break;
-/* Line 1267 of yacc.c. */
default: break;
}
@@ -2139,7 +2077,7 @@ yyerrlab:
if (yyerrstatus == 3)
{
- /* If just tried and failed to reuse look-ahead token after an
+ /* If just tried and failed to reuse lookahead token after an
error, discard it. */
if (yychar <= YYEOF)
@@ -2156,7 +2094,7 @@ yyerrlab:
}
}
- /* Else will try to reuse look-ahead token after shifting the error
+ /* Else will try to reuse lookahead token after shifting the error
token. */
goto yyerrlab1;
@@ -2214,14 +2152,11 @@ yyerrlab1:
YY_STACK_PRINT (yyss, yyssp);
}
- if (yyn == YYFINAL)
- YYACCEPT;
-
*++yyvsp = yylval;
yyerror_range[1] = yylloc;
/* Using YYLLOC is tempting, but would change the location of
- the look-ahead. YYLOC is available though. */
+ the lookahead. YYLOC is available though. */
YYLLOC_DEFAULT (yyloc, (yyerror_range - 1), 2);
*++yylsp = yyloc;
@@ -2246,7 +2181,7 @@ yyabortlab:
yyresult = 1;
goto yyreturn;
-#ifndef yyoverflow
+#if !defined(yyoverflow) || YYERROR_VERBOSE
/*-------------------------------------------------.
| yyexhaustedlab -- memory exhaustion comes here. |
`-------------------------------------------------*/
@@ -2257,7 +2192,7 @@ yyexhaustedlab:
#endif
yyreturn:
- if (yychar != YYEOF && yychar != YYEMPTY)
+ if (yychar != YYEMPTY)
yydestruct ("Cleanup: discarding lookahead",
yytoken, &yylval, &yylloc, info);
/* Do not reclaim the symbols of the rule which action triggered
@@ -2513,11 +2448,11 @@ TclDateerror(
infoPtr->separatrix = "\n";
}
-static time_t
+MODULE_SCOPE int
ToSeconds(
- time_t Hours,
- time_t Minutes,
- time_t Seconds,
+ int Hours,
+ int Minutes,
+ int Seconds,
MERIDIAN Meridian)
{
if (Minutes < 0 || Minutes > 59 || Seconds < 0 || Seconds > 59) {
@@ -2680,7 +2615,7 @@ TclDatelex(
location->first_column = yyInput - info->dateStart;
for ( ; ; ) {
- while (TclIsSpaceProc(*yyInput)) {
+ while (isspace(UCHAR(*yyInput))) {
yyInput++;
}
@@ -2740,65 +2675,36 @@ TclDatelex(
} while (Count > 0);
}
}
-
+
int
-TclClockOldscanObjCmd(
- ClientData clientData, /* Unused */
+TclClockFreeScan(
Tcl_Interp *interp, /* Tcl interpreter */
- int objc, /* Count of paraneters */
- Tcl_Obj *const *objv) /* Parameters */
+ DateInfo *info) /* Input and result parameters */
{
- Tcl_Obj *result, *resultElement;
- int yr, mo, da;
- DateInfo dateInfo;
- DateInfo* info = &dateInfo;
int status;
- if (objc != 5) {
- Tcl_WrongNumArgs(interp, 1, objv,
- "stringToParse baseYear baseMonth baseDay" );
- return TCL_ERROR;
- }
-
- yyInput = Tcl_GetString( objv[1] );
- dateInfo.dateStart = yyInput;
-
- yyHaveDate = 0;
- if (Tcl_GetIntFromObj(interp, objv[2], &yr) != TCL_OK
- || Tcl_GetIntFromObj(interp, objv[3], &mo) != TCL_OK
- || Tcl_GetIntFromObj(interp, objv[4], &da) != TCL_OK) {
- return TCL_ERROR;
- }
- yyYear = yr; yyMonth = mo; yyDay = da;
-
- yyHaveTime = 0;
- yyHour = 0; yyMinutes = 0; yySeconds = 0; yyMeridian = MER24;
-
- yyHaveZone = 0;
- yyTimezone = 0; yyDSTmode = DSTmaybe;
-
- yyHaveOrdinalMonth = 0;
- yyMonthOrdinal = 0;
-
- yyHaveDay = 0;
- yyDayOrdinal = 0; yyDayNumber = 0;
+ /*
+ * yyInput = stringToParse;
+ *
+ * ClockInitDateInfo(info) should be executed to pre-init info;
+ */
- yyHaveRel = 0;
- yyRelMonth = 0; yyRelDay = 0; yyRelSeconds = 0; yyRelPointer = NULL;
+ yyDSTmode = DSTmaybe;
- dateInfo.messages = Tcl_NewObj();
- dateInfo.separatrix = "";
- Tcl_IncrRefCount(dateInfo.messages);
+ info->messages = Tcl_NewObj();
+ info->separatrix = "";
+ Tcl_IncrRefCount(info->messages);
- status = yyparse(&dateInfo);
+ info->dateStart = yyInput;
+ status = yyparse(info);
if (status == 1) {
- Tcl_SetObjResult(interp, dateInfo.messages);
- Tcl_DecrRefCount(dateInfo.messages);
+ Tcl_SetObjResult(interp, info->messages);
+ Tcl_DecrRefCount(info->messages);
Tcl_SetErrorCode(interp, "TCL", "VALUE", "DATE", "PARSE", NULL);
return TCL_ERROR;
} else if (status == 2) {
Tcl_SetObjResult(interp, Tcl_NewStringObj("memory exhausted", -1));
- Tcl_DecrRefCount(dateInfo.messages);
+ Tcl_DecrRefCount(info->messages);
Tcl_SetErrorCode(interp, "TCL", "MEMORY", NULL);
return TCL_ERROR;
} else if (status != 0) {
@@ -2806,11 +2712,11 @@ TclClockOldscanObjCmd(
"from date parser. Please "
"report this error as a "
"bug in Tcl.", -1));
- Tcl_DecrRefCount(dateInfo.messages);
+ Tcl_DecrRefCount(info->messages);
Tcl_SetErrorCode(interp, "TCL", "BUG", NULL);
return TCL_ERROR;
}
- Tcl_DecrRefCount(dateInfo.messages);
+ Tcl_DecrRefCount(info->messages);
if (yyHaveDate > 1) {
Tcl_SetObjResult(interp,
@@ -2843,6 +2749,40 @@ TclClockOldscanObjCmd(
return TCL_ERROR;
}
+ return TCL_OK;
+}
+
+int
+TclClockOldscanObjCmd(
+ ClientData clientData, /* Unused */
+ Tcl_Interp *interp, /* Tcl interpreter */
+ int objc, /* Count of paraneters */
+ Tcl_Obj *const *objv) /* Parameters */
+{
+ Tcl_Obj *result, *resultElement;
+ int yr, mo, da;
+ DateInfo dateInfo;
+ DateInfo* info = &dateInfo;
+
+ if (objc != 5) {
+ Tcl_WrongNumArgs(interp, 1, objv,
+ "stringToParse baseYear baseMonth baseDay" );
+ return TCL_ERROR;
+ }
+
+ yyInput = Tcl_GetString( objv[1] );
+
+ if (Tcl_GetIntFromObj(interp, objv[2], &yr) != TCL_OK
+ || Tcl_GetIntFromObj(interp, objv[3], &mo) != TCL_OK
+ || Tcl_GetIntFromObj(interp, objv[4], &da) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ yyYear = yr; yyMonth = mo; yyDay = da;
+
+ if (TclClockFreeScan(interp, info) != TCL_OK) {
+ return TCL_ERROR;
+ }
+
result = Tcl_NewObj();
resultElement = Tcl_NewObj();
if (yyHaveDate) {
@@ -2894,9 +2834,9 @@ TclClockOldscanObjCmd(
resultElement = Tcl_NewObj();
if (yyHaveOrdinalMonth) {
Tcl_ListObjAppendElement(interp, resultElement,
- Tcl_NewIntObj((int) yyMonthOrdinal));
+ Tcl_NewIntObj((int) yyMonthOrdinalIncr));
Tcl_ListObjAppendElement(interp, resultElement,
- Tcl_NewIntObj((int) yyMonth));
+ Tcl_NewIntObj((int) yyMonthOrdinal));
}
Tcl_ListObjAppendElement(interp, result, resultElement);
diff --git a/generic/tclDictObj.c b/generic/tclDictObj.c
index 428173d..4088883 100644
--- a/generic/tclDictObj.c
+++ b/generic/tclDictObj.c
@@ -51,6 +51,8 @@ static int DictSetCmd(ClientData dummy, Tcl_Interp *interp,
int objc, Tcl_Obj *const *objv);
static int DictSizeCmd(ClientData dummy, Tcl_Interp *interp,
int objc, Tcl_Obj *const *objv);
+static int DictSmartRefCmd(ClientData dummy, Tcl_Interp *interp,
+ int objc, Tcl_Obj *const *objv);
static int DictUnsetCmd(ClientData dummy, Tcl_Interp *interp,
int objc, Tcl_Obj *const *objv);
static int DictUpdateCmd(ClientData dummy, Tcl_Interp *interp,
@@ -98,6 +100,7 @@ static const EnsembleImplMap implementationMap[] = {
{"replace", DictReplaceCmd, NULL, NULL, NULL, 0 },
{"set", DictSetCmd, TclCompileDictSetCmd, NULL, NULL, 0 },
{"size", DictSizeCmd, TclCompileBasic1ArgCmd, NULL, NULL, 0 },
+ {"smartref",DictSmartRefCmd,NULL, NULL, NULL, 0 },
{"unset", DictUnsetCmd, TclCompileDictUnsetCmd, NULL, NULL, 0 },
{"update", DictUpdateCmd, TclCompileDictUpdateCmd, NULL, NULL, 0 },
{"values", DictValuesCmd, TclCompileBasic1Or2ArgCmd, NULL, NULL, 0 },
@@ -1960,6 +1963,102 @@ DictSizeCmd(
/*
*----------------------------------------------------------------------
*
+ * Tcl_DictObjSmartRef --
+ *
+ * This function returns new tcl-object with the smart reference to
+ * dictionary object.
+ *
+ * Object returned with this function is a smart reference (pointer),
+ * so new object of type tclDictType, that directly references given
+ * dictionary object (with internally increased refCount).
+ *
+ * The usage of such pointer objects allows to hold more as one
+ * reference to the same real dictionary object, allows to make a pointer
+ * to part of another dictionary, allows to change the dictionary without
+ * regarding of the "shared" state of the dictionary object.
+ *
+ * Prevents "called with shared object" exception if object is multiple
+ * referenced.
+ *
+ * Results:
+ * The newly create object (contains smart reference) is returned.
+ * The returned object has a ref count of 0.
+ *
+ * Side effects:
+ * Increases ref count of the referenced dictionary.
+ *
+ *----------------------------------------------------------------------
+ */
+
+Tcl_Obj *
+Tcl_DictObjSmartRef(
+ Tcl_Interp *interp,
+ Tcl_Obj *dictPtr)
+{
+ Tcl_Obj *result;
+ Dict *dict;
+
+ if (dictPtr->typePtr != &tclDictType
+ && SetDictFromAny(interp, dictPtr) != TCL_OK) {
+ return NULL;
+ }
+
+ dict = DICT(dictPtr);
+
+ result = Tcl_NewObj();
+ DICT(result) = dict;
+ dict->refCount++;
+ result->internalRep.twoPtrValue.ptr2 = NULL;
+ result->typePtr = &tclDictType;
+
+ return result;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * DictSmartRefCmd --
+ *
+ * This function implements the "dict smartref" Tcl command.
+ *
+ * See description of Tcl_DictObjSmartRef for details.
+ *
+ * Results:
+ * A standard Tcl result.
+ *
+ * Side effects:
+ * See the user documentation.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+DictSmartRefCmd(
+ ClientData dummy,
+ Tcl_Interp *interp,
+ int objc,
+ Tcl_Obj *const *objv)
+{
+ Tcl_Obj *result;
+
+ if (objc != 2) {
+ Tcl_WrongNumArgs(interp, 1, objv, "dictionary");
+ return TCL_ERROR;
+ }
+
+ result = Tcl_DictObjSmartRef(interp, objv[1]);
+ if (result == NULL) {
+ return TCL_ERROR;
+ }
+
+ Tcl_SetObjResult(interp, result);
+
+ return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
* DictExistsCmd --
*
* This function implements the "dict exists" Tcl command. See the user
diff --git a/generic/tclEnv.c b/generic/tclEnv.c
index 66ddb57..0041a40 100644
--- a/generic/tclEnv.c
+++ b/generic/tclEnv.c
@@ -17,6 +17,11 @@
TCL_DECLARE_MUTEX(envMutex) /* To serialize access to environ. */
+
+/* MODULE_SCOPE */
+unsigned long TclEnvEpoch = 0; /* Epoch of the tcl environment
+ * (if changed with tcl-env). */
+
static struct {
int cacheSize; /* Number of env strings in cache. */
char **cache; /* Array containing all of the environment
@@ -371,6 +376,7 @@ Tcl_PutEnv(
value[0] = '\0';
TclSetEnv(name, value+1);
}
+ TclEnvEpoch++;
Tcl_DStringFree(&nameString);
return 0;
@@ -579,6 +585,7 @@ EnvTraceProc(
if (flags & TCL_TRACE_ARRAY) {
TclSetupEnv(interp);
+ TclEnvEpoch++;
return NULL;
}
@@ -599,6 +606,7 @@ EnvTraceProc(
value = Tcl_GetVar2(interp, "env", name2, TCL_GLOBAL_ONLY);
TclSetEnv(name2, value);
+ TclEnvEpoch++;
}
/*
@@ -622,6 +630,7 @@ EnvTraceProc(
if (flags & TCL_TRACE_UNSETS) {
TclUnsetEnv(name2);
+ TclEnvEpoch++;
}
return NULL;
}
diff --git a/generic/tclGetDate.y b/generic/tclGetDate.y
index da4c3fd..6d6a0d0 100644
--- a/generic/tclGetDate.y
+++ b/generic/tclGetDate.y
@@ -9,6 +9,7 @@
*
* Copyright (c) 1992-1995 Karl Lehenbauer and Mark Diekhans.
* Copyright (c) 1995-1997 Sun Microsystems, Inc.
+ * Copyright (c) 2015 Sergey G. Brester aka sebres.
*
* See the file "license.terms" for information on usage and redistribution of
* this file, and for a DISCLAIMER OF ALL WARRANTIES.
@@ -50,73 +51,11 @@
* parsed fields will be returned.
*/
-typedef struct DateInfo {
-
- Tcl_Obj* messages; /* Error messages */
- const char* separatrix; /* String separating messages */
-
- time_t dateYear;
- time_t dateMonth;
- time_t dateDay;
- int dateHaveDate;
-
- time_t dateHour;
- time_t dateMinutes;
- time_t dateSeconds;
- int dateMeridian;
- int dateHaveTime;
-
- time_t dateTimezone;
- int dateDSTmode;
- int dateHaveZone;
-
- time_t dateRelMonth;
- time_t dateRelDay;
- time_t dateRelSeconds;
- int dateHaveRel;
-
- time_t dateMonthOrdinal;
- int dateHaveOrdinalMonth;
-
- time_t dateDayOrdinal;
- time_t dateDayNumber;
- int dateHaveDay;
-
- const char *dateStart;
- const char *dateInput;
- time_t *dateRelPointer;
-
- int dateDigitCount;
-} DateInfo;
+#include "tclDate.h"
#define YYMALLOC ckalloc
#define YYFREE(x) (ckfree((void*) (x)))
-#define yyDSTmode (info->dateDSTmode)
-#define yyDayOrdinal (info->dateDayOrdinal)
-#define yyDayNumber (info->dateDayNumber)
-#define yyMonthOrdinal (info->dateMonthOrdinal)
-#define yyHaveDate (info->dateHaveDate)
-#define yyHaveDay (info->dateHaveDay)
-#define yyHaveOrdinalMonth (info->dateHaveOrdinalMonth)
-#define yyHaveRel (info->dateHaveRel)
-#define yyHaveTime (info->dateHaveTime)
-#define yyHaveZone (info->dateHaveZone)
-#define yyTimezone (info->dateTimezone)
-#define yyDay (info->dateDay)
-#define yyMonth (info->dateMonth)
-#define yyYear (info->dateYear)
-#define yyHour (info->dateHour)
-#define yyMinutes (info->dateMinutes)
-#define yySeconds (info->dateSeconds)
-#define yyMeridian (info->dateMeridian)
-#define yyRelMonth (info->dateRelMonth)
-#define yyRelDay (info->dateRelDay)
-#define yyRelSeconds (info->dateRelSeconds)
-#define yyRelPointer (info->dateRelPointer)
-#define yyInput (info->dateInput)
-#define yyDigitCount (info->dateDigitCount)
-
#define EPOCH 1970
#define START_OF_TIME 1902
#define END_OF_TIME 2037
@@ -150,14 +89,6 @@ typedef enum _DSTMODE {
DSTon, DSToff, DSTmaybe
} DSTMODE;
-/*
- * Meridian: am, pm, or 24-hour style.
- */
-
-typedef enum _MERIDIAN {
- MERam, MERpm, MER24
-} MERIDIAN;
-
%}
%union {
@@ -176,8 +107,6 @@ static int LookupWord(YYSTYPE* yylvalPtr, char *buff);
DateInfo* info, const char *s);
static int TclDatelex(YYSTYPE* yylvalPtr, YYLTYPE* location,
DateInfo* info);
-static time_t ToSeconds(time_t Hours, time_t Minutes,
- time_t Seconds, MERIDIAN Meridian);
MODULE_SCOPE int yyparse(DateInfo*);
%}
@@ -377,12 +306,12 @@ date : tUNUMBER '/' tUNUMBER {
;
ordMonth: tNEXT tMONTH {
- yyMonthOrdinal = 1;
- yyMonth = $2;
+ yyMonthOrdinalIncr = 1;
+ yyMonthOrdinal = $2;
}
| tNEXT tUNUMBER tMONTH {
- yyMonthOrdinal = $2;
- yyMonth = $3;
+ yyMonthOrdinalIncr = $2;
+ yyMonthOrdinal = $3;
}
;
@@ -730,11 +659,11 @@ TclDateerror(
infoPtr->separatrix = "\n";
}
-static time_t
+MODULE_SCOPE int
ToSeconds(
- time_t Hours,
- time_t Minutes,
- time_t Seconds,
+ int Hours,
+ int Minutes,
+ int Seconds,
MERIDIAN Meridian)
{
if (Minutes < 0 || Minutes > 59 || Seconds < 0 || Seconds > 59) {
@@ -957,65 +886,36 @@ TclDatelex(
} while (Count > 0);
}
}
-
+
int
-TclClockOldscanObjCmd(
- ClientData clientData, /* Unused */
+TclClockFreeScan(
Tcl_Interp *interp, /* Tcl interpreter */
- int objc, /* Count of paraneters */
- Tcl_Obj *const *objv) /* Parameters */
+ DateInfo *info) /* Input and result parameters */
{
- Tcl_Obj *result, *resultElement;
- int yr, mo, da;
- DateInfo dateInfo;
- DateInfo* info = &dateInfo;
int status;
- if (objc != 5) {
- Tcl_WrongNumArgs(interp, 1, objv,
- "stringToParse baseYear baseMonth baseDay" );
- return TCL_ERROR;
- }
-
- yyInput = Tcl_GetString( objv[1] );
- dateInfo.dateStart = yyInput;
-
- yyHaveDate = 0;
- if (Tcl_GetIntFromObj(interp, objv[2], &yr) != TCL_OK
- || Tcl_GetIntFromObj(interp, objv[3], &mo) != TCL_OK
- || Tcl_GetIntFromObj(interp, objv[4], &da) != TCL_OK) {
- return TCL_ERROR;
- }
- yyYear = yr; yyMonth = mo; yyDay = da;
-
- yyHaveTime = 0;
- yyHour = 0; yyMinutes = 0; yySeconds = 0; yyMeridian = MER24;
-
- yyHaveZone = 0;
- yyTimezone = 0; yyDSTmode = DSTmaybe;
-
- yyHaveOrdinalMonth = 0;
- yyMonthOrdinal = 0;
-
- yyHaveDay = 0;
- yyDayOrdinal = 0; yyDayNumber = 0;
+ /*
+ * yyInput = stringToParse;
+ *
+ * ClockInitDateInfo(info) should be executed to pre-init info;
+ */
- yyHaveRel = 0;
- yyRelMonth = 0; yyRelDay = 0; yyRelSeconds = 0; yyRelPointer = NULL;
+ yyDSTmode = DSTmaybe;
- dateInfo.messages = Tcl_NewObj();
- dateInfo.separatrix = "";
- Tcl_IncrRefCount(dateInfo.messages);
+ info->messages = Tcl_NewObj();
+ info->separatrix = "";
+ Tcl_IncrRefCount(info->messages);
- status = yyparse(&dateInfo);
+ info->dateStart = yyInput;
+ status = yyparse(info);
if (status == 1) {
- Tcl_SetObjResult(interp, dateInfo.messages);
- Tcl_DecrRefCount(dateInfo.messages);
+ Tcl_SetObjResult(interp, info->messages);
+ Tcl_DecrRefCount(info->messages);
Tcl_SetErrorCode(interp, "TCL", "VALUE", "DATE", "PARSE", NULL);
return TCL_ERROR;
} else if (status == 2) {
Tcl_SetObjResult(interp, Tcl_NewStringObj("memory exhausted", -1));
- Tcl_DecrRefCount(dateInfo.messages);
+ Tcl_DecrRefCount(info->messages);
Tcl_SetErrorCode(interp, "TCL", "MEMORY", NULL);
return TCL_ERROR;
} else if (status != 0) {
@@ -1023,11 +923,11 @@ TclClockOldscanObjCmd(
"from date parser. Please "
"report this error as a "
"bug in Tcl.", -1));
- Tcl_DecrRefCount(dateInfo.messages);
+ Tcl_DecrRefCount(info->messages);
Tcl_SetErrorCode(interp, "TCL", "BUG", NULL);
return TCL_ERROR;
}
- Tcl_DecrRefCount(dateInfo.messages);
+ Tcl_DecrRefCount(info->messages);
if (yyHaveDate > 1) {
Tcl_SetObjResult(interp,
@@ -1060,6 +960,40 @@ TclClockOldscanObjCmd(
return TCL_ERROR;
}
+ return TCL_OK;
+}
+
+int
+TclClockOldscanObjCmd(
+ ClientData clientData, /* Unused */
+ Tcl_Interp *interp, /* Tcl interpreter */
+ int objc, /* Count of paraneters */
+ Tcl_Obj *const *objv) /* Parameters */
+{
+ Tcl_Obj *result, *resultElement;
+ int yr, mo, da;
+ DateInfo dateInfo;
+ DateInfo* info = &dateInfo;
+
+ if (objc != 5) {
+ Tcl_WrongNumArgs(interp, 1, objv,
+ "stringToParse baseYear baseMonth baseDay" );
+ return TCL_ERROR;
+ }
+
+ yyInput = Tcl_GetString( objv[1] );
+
+ if (Tcl_GetIntFromObj(interp, objv[2], &yr) != TCL_OK
+ || Tcl_GetIntFromObj(interp, objv[3], &mo) != TCL_OK
+ || Tcl_GetIntFromObj(interp, objv[4], &da) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ yyYear = yr; yyMonth = mo; yyDay = da;
+
+ if (TclClockFreeScan(interp, info) != TCL_OK) {
+ return TCL_ERROR;
+ }
+
result = Tcl_NewObj();
resultElement = Tcl_NewObj();
if (yyHaveDate) {
@@ -1111,9 +1045,9 @@ TclClockOldscanObjCmd(
resultElement = Tcl_NewObj();
if (yyHaveOrdinalMonth) {
Tcl_ListObjAppendElement(interp, resultElement,
- Tcl_NewIntObj((int) yyMonthOrdinal));
+ Tcl_NewIntObj((int) yyMonthOrdinalIncr));
Tcl_ListObjAppendElement(interp, resultElement,
- Tcl_NewIntObj((int) yyMonth));
+ Tcl_NewIntObj((int) yyMonthOrdinal));
}
Tcl_ListObjAppendElement(interp, result, resultElement);
diff --git a/generic/tclInt.h b/generic/tclInt.h
index b369f58..ea4c73e 100644
--- a/generic/tclInt.h
+++ b/generic/tclInt.h
@@ -2884,6 +2884,7 @@ MODULE_SCOPE int TclFindDictElement(Tcl_Interp *interp,
const char *dict, int dictLength,
const char **elementPtr, const char **nextPtr,
int *sizePtr, int *literalPtr);
+MODULE_SCOPE Tcl_Obj * Tcl_DictObjSmartRef(Tcl_Interp *interp, Tcl_Obj *);
/* TIP #280 - Modified token based evulation, with line information. */
MODULE_SCOPE int TclEvalEx(Tcl_Interp *interp, const char *script,
int numBytes, int flags, int line,
@@ -4873,6 +4874,13 @@ typedef struct NRE_callback {
#define Tcl_Free(ptr) TclpFree(ptr)
#endif
+/*
+ * Other externals.
+ */
+
+MODULE_SCOPE unsigned long TclEnvEpoch; /* Epoch of the tcl environment
+ * (if changed with tcl-env). */
+
#endif /* _TCLINT */
/*
diff --git a/library/clock.tcl b/library/clock.tcl
index 8e4b657..94d2341 100644
--- a/library/clock.tcl
+++ b/library/clock.tcl
@@ -10,6 +10,7 @@
#----------------------------------------------------------------------
#
# Copyright (c) 2004,2005,2006,2007 by Kevin B. Kenny
+# Copyright (c) 2015 by Sergey G. Brester aka sebres.
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
#
@@ -287,6 +288,12 @@ proc ::tcl::clock::Initialize {} {
variable FEB_28 58
+ # Default configuration
+
+ configure -default-locale [mclocale]
+ #configure -year-century 2000 \
+ # -century-switch 38
+
# Translation table to map Windows TZI onto cities, so that the Olson
# rules can apply. In some cases the mapping is ambiguous, so it's wise
# to specify $::env(TCL_TZ) rather than simply depending on the system
@@ -383,152 +390,6 @@ proc ::tcl::clock::Initialize {} {
{46800 0 3600 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0} :Pacific/Tongatapu
}]
- # Groups of fields that specify the date, priorities, and code bursts that
- # determine Julian Day Number given those groups. The code in [clock
- # scan] will choose the highest priority (lowest numbered) set of fields
- # that determines the date.
-
- variable DateParseActions {
-
- { seconds } 0 {}
-
- { julianDay } 1 {}
-
- { era century yearOfCentury month dayOfMonth } 2 {
- dict set date year [expr { 100 * [dict get $date century]
- + [dict get $date yearOfCentury] }]
- set date [GetJulianDayFromEraYearMonthDay $date[set date {}] \
- $changeover]
- }
- { era century yearOfCentury dayOfYear } 2 {
- dict set date year [expr { 100 * [dict get $date century]
- + [dict get $date yearOfCentury] }]
- set date [GetJulianDayFromEraYearDay $date[set date {}] \
- $changeover]
- }
-
- { century yearOfCentury month dayOfMonth } 3 {
- dict set date era CE
- dict set date year [expr { 100 * [dict get $date century]
- + [dict get $date yearOfCentury] }]
- set date [GetJulianDayFromEraYearMonthDay $date[set date {}] \
- $changeover]
- }
- { century yearOfCentury dayOfYear } 3 {
- dict set date era CE
- dict set date year [expr { 100 * [dict get $date century]
- + [dict get $date yearOfCentury] }]
- set date [GetJulianDayFromEraYearDay $date[set date {}] \
- $changeover]
- }
- { iso8601Century iso8601YearOfCentury iso8601Week dayOfWeek } 3 {
- dict set date era CE
- dict set date iso8601Year \
- [expr { 100 * [dict get $date iso8601Century]
- + [dict get $date iso8601YearOfCentury] }]
- set date [GetJulianDayFromEraYearWeekDay $date[set date {}] \
- $changeover]
- }
-
- { yearOfCentury month dayOfMonth } 4 {
- set date [InterpretTwoDigitYear $date[set date {}] $baseTime]
- dict set date era CE
- set date [GetJulianDayFromEraYearMonthDay $date[set date {}] \
- $changeover]
- }
- { yearOfCentury dayOfYear } 4 {
- set date [InterpretTwoDigitYear $date[set date {}] $baseTime]
- dict set date era CE
- set date [GetJulianDayFromEraYearDay $date[set date {}] \
- $changeover]
- }
- { iso8601YearOfCentury iso8601Week dayOfWeek } 4 {
- set date [InterpretTwoDigitYear \
- $date[set date {}] $baseTime \
- iso8601YearOfCentury iso8601Year]
- dict set date era CE
- set date [GetJulianDayFromEraYearWeekDay $date[set date {}] \
- $changeover]
- }
-
- { month dayOfMonth } 5 {
- set date [AssignBaseYear $date[set date {}] \
- $baseTime $timeZone $changeover]
- set date [GetJulianDayFromEraYearMonthDay $date[set date {}] \
- $changeover]
- }
- { dayOfYear } 5 {
- set date [AssignBaseYear $date[set date {}] \
- $baseTime $timeZone $changeover]
- set date [GetJulianDayFromEraYearDay $date[set date {}] \
- $changeover]
- }
- { iso8601Week dayOfWeek } 5 {
- set date [AssignBaseIso8601Year $date[set date {}] \
- $baseTime $timeZone $changeover]
- set date [GetJulianDayFromEraYearWeekDay $date[set date {}] \
- $changeover]
- }
-
- { dayOfMonth } 6 {
- set date [AssignBaseMonth $date[set date {}] \
- $baseTime $timeZone $changeover]
- set date [GetJulianDayFromEraYearMonthDay $date[set date {}] \
- $changeover]
- }
-
- { dayOfWeek } 7 {
- set date [AssignBaseWeek $date[set date {}] \
- $baseTime $timeZone $changeover]
- set date [GetJulianDayFromEraYearWeekDay $date[set date {}] \
- $changeover]
- }
-
- {} 8 {
- set date [AssignBaseJulianDay $date[set date {}] \
- $baseTime $timeZone $changeover]
- }
- }
-
- # Groups of fields that specify time of day, priorities, and code that
- # processes them
-
- variable TimeParseActions {
-
- seconds 1 {}
-
- { hourAMPM minute second amPmIndicator } 2 {
- dict set date secondOfDay [InterpretHMSP $date]
- }
- { hour minute second } 2 {
- dict set date secondOfDay [InterpretHMS $date]
- }
-
- { hourAMPM minute amPmIndicator } 3 {
- dict set date second 0
- dict set date secondOfDay [InterpretHMSP $date]
- }
- { hour minute } 3 {
- dict set date second 0
- dict set date secondOfDay [InterpretHMS $date]
- }
-
- { hourAMPM amPmIndicator } 4 {
- dict set date minute 0
- dict set date second 0
- dict set date secondOfDay [InterpretHMSP $date]
- }
- { hour } 4 {
- dict set date minute 0
- dict set date second 0
- dict set date secondOfDay [InterpretHMS $date]
- }
-
- { } 5 {
- dict set date secondOfDay 0
- }
- }
-
# Legacy time zones, used primarily for parsing RFC822 dates.
variable LegacyTimeZone [dict create \
@@ -623,17 +484,17 @@ proc ::tcl::clock::Initialize {} {
# Caches
- variable LocaleNumeralCache {}; # Dictionary whose keys are locale
+ variable LocaleFormats \
+ [dict create]; # Dictionary with localized formats
+
+ variable LocaleNumeralCache \
+ [dict create]; # Dictionary whose keys are locale
# names and whose values are pairs
# comprising regexes matching numerals
# in the given locales and dictionaries
# mapping the numerals to their numeric
# values.
- # variable CachedSystemTimeZone; # If 'CachedSystemTimeZone' exists,
- # it contains the value of the
- # system time zone, as determined from
- # the environment.
- variable TimeZoneBad {}; # Dictionary whose keys are time zone
+ variable TimeZoneBad [dict create]; # Dictionary whose keys are time zone
# names and whose values are 1 if
# the time zone is unknown and 0
# if it is known.
@@ -649,1640 +510,58 @@ proc ::tcl::clock::Initialize {} {
::tcl::clock::Initialize
#----------------------------------------------------------------------
-#
-# clock format --
-#
-# Formats a count of seconds since the Posix Epoch as a time of day.
-#
-# The 'clock format' command formats times of day for output. Refer to the
-# user documentation to see what it does.
-#
-#----------------------------------------------------------------------
-
-proc ::tcl::clock::format { args } {
-
- variable FormatProc
- variable TZData
-
- lassign [ParseFormatArgs {*}$args] format locale timezone
- set locale [string tolower $locale]
- set clockval [lindex $args 0]
-
- # Get the data for time changes in the given zone
-
- if {$timezone eq ""} {
- set timezone [GetSystemTimeZone]
- }
- if {![info exists TZData($timezone)]} {
- if {[catch {SetupTimeZone $timezone} retval opts]} {
- dict unset opts -errorinfo
- return -options $opts $retval
- }
- }
-
- # Build a procedure to format the result. Cache the built procedure's name
- # in the 'FormatProc' array to avoid losing its internal representation,
- # which contains the name resolution.
-
- set procName formatproc'$format'$locale
- set procName [namespace current]::[string map {: {\:} \\ {\\}} $procName]
- if {[info exists FormatProc($procName)]} {
- set procName $FormatProc($procName)
- } else {
- set FormatProc($procName) \
- [ParseClockFormatFormat $procName $format $locale]
- }
-
- return [$procName $clockval $timezone]
-
-}
-
-#----------------------------------------------------------------------
-#
-# ParseClockFormatFormat --
-#
-# Builds and caches a procedure that formats a time value.
-#
-# Parameters:
-# format -- Format string to use
-# locale -- Locale in which the format string is to be interpreted
-#
-# Results:
-# Returns the name of the newly-built procedure.
-#
-#----------------------------------------------------------------------
-
-proc ::tcl::clock::ParseClockFormatFormat {procName format locale} {
-
- if {[namespace which $procName] ne {}} {
- return $procName
- }
-
- # Map away the locale-dependent composite format groups
-
- EnterLocale $locale
-
- # Change locale if a fresh locale has been given on the command line.
-
- try {
- return [ParseClockFormatFormat2 $format $locale $procName]
- } trap CLOCK {result opts} {
- dict unset opts -errorinfo
- return -options $opts $result
- }
-}
-
-proc ::tcl::clock::ParseClockFormatFormat2 {format locale procName} {
- set didLocaleEra 0
- set didLocaleNumerals 0
- set preFormatCode \
- [string map [list @GREGORIAN_CHANGE_DATE@ \
- [mc GREGORIAN_CHANGE_DATE]] \
- {
- variable TZData
- set date [GetDateFields $clockval \
- $TZData($timezone) \
- @GREGORIAN_CHANGE_DATE@]
- }]
- set formatString {}
- set substituents {}
- set state {}
-
- set format [LocalizeFormat $locale $format]
-
- foreach char [split $format {}] {
- switch -exact -- $state {
- {} {
- if { [string equal % $char] } {
- set state percent
- } else {
- append formatString $char
- }
- }
- percent { # Character following a '%' character
- set state {}
- switch -exact -- $char {
- % { # A literal character, '%'
- append formatString %%
- }
- a { # Day of week, abbreviated
- append formatString %s
- append substituents \
- [string map \
- [list @DAYS_OF_WEEK_ABBREV@ \
- [list [mc DAYS_OF_WEEK_ABBREV]]] \
- { [lindex @DAYS_OF_WEEK_ABBREV@ \
- [expr {[dict get $date dayOfWeek] \
- % 7}]]}]
- }
- A { # Day of week, spelt out.
- append formatString %s
- append substituents \
- [string map \
- [list @DAYS_OF_WEEK_FULL@ \
- [list [mc DAYS_OF_WEEK_FULL]]] \
- { [lindex @DAYS_OF_WEEK_FULL@ \
- [expr {[dict get $date dayOfWeek] \
- % 7}]]}]
- }
- b - h { # Name of month, abbreviated.
- append formatString %s
- append substituents \
- [string map \
- [list @MONTHS_ABBREV@ \
- [list [mc MONTHS_ABBREV]]] \
- { [lindex @MONTHS_ABBREV@ \
- [expr {[dict get $date month]-1}]]}]
- }
- B { # Name of month, spelt out
- append formatString %s
- append substituents \
- [string map \
- [list @MONTHS_FULL@ \
- [list [mc MONTHS_FULL]]] \
- { [lindex @MONTHS_FULL@ \
- [expr {[dict get $date month]-1}]]}]
- }
- C { # Century number
- append formatString %02d
- append substituents \
- { [expr {[dict get $date year] / 100}]}
- }
- d { # Day of month, with leading zero
- append formatString %02d
- append substituents { [dict get $date dayOfMonth]}
- }
- e { # Day of month, without leading zero
- append formatString %2d
- append substituents { [dict get $date dayOfMonth]}
- }
- E { # Format group in a locale-dependent
- # alternative era
- set state percentE
- if {!$didLocaleEra} {
- append preFormatCode \
- [string map \
- [list @LOCALE_ERAS@ \
- [list [mc LOCALE_ERAS]]] \
- {
- set date [GetLocaleEra \
- $date[set date {}] \
- @LOCALE_ERAS@]}] \n
- set didLocaleEra 1
- }
- if {!$didLocaleNumerals} {
- append preFormatCode \
- [list set localeNumerals \
- [mc LOCALE_NUMERALS]] \n
- set didLocaleNumerals 1
- }
- }
- g { # Two-digit year relative to ISO8601
- # week number
- append formatString %02d
- append substituents \
- { [expr { [dict get $date iso8601Year] % 100 }]}
- }
- G { # Four-digit year relative to ISO8601
- # week number
- append formatString %02d
- append substituents { [dict get $date iso8601Year]}
- }
- H { # Hour in the 24-hour day, leading zero
- append formatString %02d
- append substituents \
- { [expr { [dict get $date localSeconds] \
- / 3600 % 24}]}
- }
- I { # Hour AM/PM, with leading zero
- append formatString %02d
- append substituents \
- { [expr { ( ( ( [dict get $date localSeconds] \
- % 86400 ) \
- + 86400 \
- - 3600 ) \
- / 3600 ) \
- % 12 + 1 }] }
- }
- j { # Day of year (001-366)
- append formatString %03d
- append substituents { [dict get $date dayOfYear]}
- }
- J { # Julian Day Number
- append formatString %07ld
- append substituents { [dict get $date julianDay]}
- }
- k { # Hour (0-23), no leading zero
- append formatString %2d
- append substituents \
- { [expr { [dict get $date localSeconds]
- / 3600
- % 24 }]}
- }
- l { # Hour (12-11), no leading zero
- append formatString %2d
- append substituents \
- { [expr { ( ( ( [dict get $date localSeconds]
- % 86400 )
- + 86400
- - 3600 )
- / 3600 )
- % 12 + 1 }]}
- }
- m { # Month number, leading zero
- append formatString %02d
- append substituents { [dict get $date month]}
- }
- M { # Minute of the hour, leading zero
- append formatString %02d
- append substituents \
- { [expr { [dict get $date localSeconds]
- / 60
- % 60 }]}
- }
- n { # A literal newline
- append formatString \n
- }
- N { # Month number, no leading zero
- append formatString %2d
- append substituents { [dict get $date month]}
- }
- O { # A format group in the locale's
- # alternative numerals
- set state percentO
- if {!$didLocaleNumerals} {
- append preFormatCode \
- [list set localeNumerals \
- [mc LOCALE_NUMERALS]] \n
- set didLocaleNumerals 1
- }
- }
- p { # Localized 'AM' or 'PM' indicator
- # converted to uppercase
- append formatString %s
- append preFormatCode \
- [list set AM [string toupper [mc AM]]] \n \
- [list set PM [string toupper [mc PM]]] \n
- append substituents \
- { [expr {(([dict get $date localSeconds]
- % 86400) < 43200) ?
- $AM : $PM}]}
- }
- P { # Localized 'AM' or 'PM' indicator
- append formatString %s
- append preFormatCode \
- [list set am [mc AM]] \n \
- [list set pm [mc PM]] \n
- append substituents \
- { [expr {(([dict get $date localSeconds]
- % 86400) < 43200) ?
- $am : $pm}]}
-
- }
- Q { # Hi, Jeff!
- append formatString %s
- append substituents { [FormatStarDate $date]}
- }
- s { # Seconds from the Posix Epoch
- append formatString %s
- append substituents { [dict get $date seconds]}
- }
- S { # Second of the minute, with
- # leading zero
- append formatString %02d
- append substituents \
- { [expr { [dict get $date localSeconds]
- % 60 }]}
- }
- t { # A literal tab character
- append formatString \t
- }
- u { # Day of the week (1-Monday, 7-Sunday)
- append formatString %1d
- append substituents { [dict get $date dayOfWeek]}
- }
- U { # Week of the year (00-53). The
- # first Sunday of the year is the
- # first day of week 01
- append formatString %02d
- append preFormatCode {
- set dow [dict get $date dayOfWeek]
- if { $dow == 7 } {
- set dow 0
- }
- incr dow
- set UweekNumber \
- [expr { ( [dict get $date dayOfYear]
- - $dow + 7 )
- / 7 }]
- }
- append substituents { $UweekNumber}
- }
- V { # The ISO8601 week number
- append formatString %02d
- append substituents { [dict get $date iso8601Week]}
- }
- w { # Day of the week (0-Sunday,
- # 6-Saturday)
- append formatString %1d
- append substituents \
- { [expr { [dict get $date dayOfWeek] % 7 }]}
- }
- W { # Week of the year (00-53). The first
- # Monday of the year is the first day
- # of week 01.
- append preFormatCode {
- set WweekNumber \
- [expr { ( [dict get $date dayOfYear]
- - [dict get $date dayOfWeek]
- + 7 )
- / 7 }]
- }
- append formatString %02d
- append substituents { $WweekNumber}
- }
- y { # The two-digit year of the century
- append formatString %02d
- append substituents \
- { [expr { [dict get $date year] % 100 }]}
- }
- Y { # The four-digit year
- append formatString %04d
- append substituents { [dict get $date year]}
- }
- z { # The time zone as hours and minutes
- # east (+) or west (-) of Greenwich
- append formatString %s
- append substituents { [FormatNumericTimeZone \
- [dict get $date tzOffset]]}
- }
- Z { # The name of the time zone
- append formatString %s
- append substituents { [dict get $date tzName]}
- }
- % { # A literal percent character
- append formatString %%
- }
- default { # An unknown escape sequence
- append formatString %% $char
- }
- }
- }
- percentE { # Character following %E
- set state {}
- switch -exact -- $char {
- E {
- append formatString %s
- append substituents { } \
- [string map \
- [list @BCE@ [list [mc BCE]] \
- @CE@ [list [mc CE]]] \
- {[dict get {BCE @BCE@ CE @CE@} \
- [dict get $date era]]}]
- }
- C { # Locale-dependent era
- append formatString %s
- append substituents { [dict get $date localeEra]}
- }
- y { # Locale-dependent year of the era
- append preFormatCode {
- set y [dict get $date localeYear]
- if { $y >= 0 && $y < 100 } {
- set Eyear [lindex $localeNumerals $y]
- } else {
- set Eyear $y
- }
- }
- append formatString %s
- append substituents { $Eyear}
- }
- default { # Unknown %E format group
- append formatString %%E $char
- }
- }
- }
- percentO { # Character following %O
- set state {}
- switch -exact -- $char {
- d - e { # Day of the month in alternative
- # numerals
- append formatString %s
- append substituents \
- { [lindex $localeNumerals \
- [dict get $date dayOfMonth]]}
- }
- H - k { # Hour of the day in alternative
- # numerals
- append formatString %s
- append substituents \
- { [lindex $localeNumerals \
- [expr { [dict get $date localSeconds]
- / 3600
- % 24 }]]}
- }
- I - l { # Hour (12-11) AM/PM in alternative
- # numerals
- append formatString %s
- append substituents \
- { [lindex $localeNumerals \
- [expr { ( ( ( [dict get $date localSeconds]
- % 86400 )
- + 86400
- - 3600 )
- / 3600 )
- % 12 + 1 }]]}
- }
- m { # Month number in alternative numerals
- append formatString %s
- append substituents \
- { [lindex $localeNumerals [dict get $date month]]}
- }
- M { # Minute of the hour in alternative
- # numerals
- append formatString %s
- append substituents \
- { [lindex $localeNumerals \
- [expr { [dict get $date localSeconds]
- / 60
- % 60 }]]}
- }
- S { # Second of the minute in alternative
- # numerals
- append formatString %s
- append substituents \
- { [lindex $localeNumerals \
- [expr { [dict get $date localSeconds]
- % 60 }]]}
- }
- u { # Day of the week (Monday=1,Sunday=7)
- # in alternative numerals
- append formatString %s
- append substituents \
- { [lindex $localeNumerals \
- [dict get $date dayOfWeek]]}
- }
- w { # Day of the week (Sunday=0,Saturday=6)
- # in alternative numerals
- append formatString %s
- append substituents \
- { [lindex $localeNumerals \
- [expr { [dict get $date dayOfWeek] % 7 }]]}
- }
- y { # Year of the century in alternative
- # numerals
- append formatString %s
- append substituents \
- { [lindex $localeNumerals \
- [expr { [dict get $date year] % 100 }]]}
- }
- default { # Unknown format group
- append formatString %%O $char
- }
- }
- }
- }
- }
-
- # Clean up any improperly terminated groups
-
- switch -exact -- $state {
- percent {
- append formatString %%
- }
- percentE {
- append retval %%E
- }
- percentO {
- append retval %%O
- }
- }
-
- proc $procName {clockval timezone} "
- $preFormatCode
- return \[::format [list $formatString] $substituents\]
- "
-
- # puts [list $procName [info args $procName] [info body $procName]]
-
- return $procName
-}
-
-#----------------------------------------------------------------------
-#
-# clock scan --
-#
-# Inputs a count of seconds since the Posix Epoch as a time of day.
-#
-# The 'clock format' command scans times of day on input. Refer to the user
-# documentation to see what it does.
-#
-#----------------------------------------------------------------------
-
-proc ::tcl::clock::scan { args } {
-
- set format {}
-
- # Check the count of args
-
- if { [llength $args] < 1 || [llength $args] % 2 != 1 } {
- set cmdName "clock scan"
- return -code error \
- -errorcode [list CLOCK wrongNumArgs] \
- "wrong \# args: should be\
- \"$cmdName string\
- ?-base seconds?\
- ?-format string? ?-gmt boolean?\
- ?-locale LOCALE? ?-timezone ZONE?\""
- }
-
- # Set defaults
-
- set base [clock seconds]
- set string [lindex $args 0]
- set format {}
- set gmt 0
- set locale c
- set timezone [GetSystemTimeZone]
-
- # Pick up command line options.
-
- foreach { flag value } [lreplace $args 0 0] {
- set saw($flag) {}
- switch -exact -- $flag {
- -b - -ba - -bas - -base {
- set base $value
- }
- -f - -fo - -for - -form - -forma - -format {
- set format $value
- }
- -g - -gm - -gmt {
- set gmt $value
- }
- -l - -lo - -loc - -loca - -local - -locale {
- set locale [string tolower $value]
- }
- -t - -ti - -tim - -time - -timez - -timezo - -timezon - -timezone {
- set timezone $value
- }
- default {
- return -code error \
- -errorcode [list CLOCK badOption $flag] \
- "bad option \"$flag\",\
- must be -base, -format, -gmt, -locale or -timezone"
- }
- }
- }
-
- # Check options for validity
-
- if { [info exists saw(-gmt)] && [info exists saw(-timezone)] } {
- return -code error \
- -errorcode [list CLOCK gmtWithTimezone] \
- "cannot use -gmt and -timezone in same call"
- }
- if { [catch { expr { wide($base) } } result] } {
- return -code error "expected integer but got \"$base\""
- }
- if { ![string is boolean -strict $gmt] } {
- return -code error "expected boolean value but got \"$gmt\""
- } elseif { $gmt } {
- set timezone :GMT
- }
-
- if { ![info exists saw(-format)] } {
- # Perhaps someday we'll localize the legacy code. Right now, it's not
- # localized.
- if { [info exists saw(-locale)] } {
- return -code error \
- -errorcode [list CLOCK flagWithLegacyFormat] \
- "legacy \[clock scan\] does not support -locale"
-
- }
- return [FreeScan $string $base $timezone $locale]
- }
-
- # Change locale if a fresh locale has been given on the command line.
-
- EnterLocale $locale
-
- try {
- # Map away the locale-dependent composite format groups
-
- set scanner [ParseClockScanFormat $format $locale]
- return [$scanner $string $base $timezone]
- } trap CLOCK {result opts} {
- # Conceal location of generation of expected errors
- dict unset opts -errorinfo
- return -options $opts $result
- }
-}
-
-#----------------------------------------------------------------------
-#
-# FreeScan --
-#
-# Scans a time in free format
-#
-# Parameters:
-# string - String containing the time to scan
-# base - Base time, expressed in seconds from the Epoch
-# timezone - Default time zone in which the time will be expressed
-# locale - (Unused) Name of the locale where the time will be scanned.
-#
-# Results:
-# Returns the date and time extracted from the string in seconds from
-# the epoch
-#
-#----------------------------------------------------------------------
-
-proc ::tcl::clock::FreeScan { string base timezone locale } {
-
- variable TZData
-
- # Get the data for time changes in the given zone
-
- try {
- SetupTimeZone $timezone
- } on error {retval opts} {
- dict unset opts -errorinfo
- return -options $opts $retval
- }
-
- # Extract year, month and day from the base time for the parser to use as
- # defaults
-
- set date [GetDateFields $base $TZData($timezone) 2361222]
- dict set date secondOfDay [expr {
- [dict get $date localSeconds] % 86400
- }]
-
- # Parse the date. The parser will return a list comprising date, time,
- # time zone, relative month/day/seconds, relative weekday, ordinal month.
-
- try {
- set scanned [Oldscan $string \
- [dict get $date year] \
- [dict get $date month] \
- [dict get $date dayOfMonth]]
- lassign $scanned \
- parseDate parseTime parseZone parseRel \
- parseWeekday parseOrdinalMonth
- } on error message {
- return -code error \
- "unable to convert date-time string \"$string\": $message"
- }
-
- # If the caller supplied a date in the string, update the 'date' dict with
- # the value. If the caller didn't specify a time with the date, default to
- # midnight.
-
- if { [llength $parseDate] > 0 } {
- lassign $parseDate y m d
- if { $y < 100 } {
- if { $y >= 39 } {
- incr y 1900
- } else {
- incr y 2000
- }
- }
- dict set date era CE
- dict set date year $y
- dict set date month $m
- dict set date dayOfMonth $d
- if { $parseTime eq {} } {
- set parseTime 0
- }
- }
-
- # If the caller supplied a time zone in the string, it comes back as a
- # two-element list; the first element is the number of minutes east of
- # Greenwich, and the second is a Daylight Saving Time indicator (1 == yes,
- # 0 == no, -1 == unknown). We make it into a time zone indicator of
- # +-hhmm.
-
- if { [llength $parseZone] > 0 } {
- lassign $parseZone minEast dstFlag
- set timezone [FormatNumericTimeZone \
- [expr { 60 * $minEast + 3600 * $dstFlag }]]
- SetupTimeZone $timezone
- }
- dict set date tzName $timezone
-
- # Assemble date, time, zone into seconds-from-epoch
-
- set date [GetJulianDayFromEraYearMonthDay $date[set date {}] 2361222]
- if { $parseTime ne {} } {
- dict set date secondOfDay $parseTime
- } elseif { [llength $parseWeekday] != 0
- || [llength $parseOrdinalMonth] != 0
- || ( [llength $parseRel] != 0
- && ( [lindex $parseRel 0] != 0
- || [lindex $parseRel 1] != 0 ) ) } {
- dict set date secondOfDay 0
- }
-
- dict set date localSeconds [expr {
- -210866803200
- + ( 86400 * wide([dict get $date julianDay]) )
- + [dict get $date secondOfDay]
- }]
- dict set date tzName $timezone
- set date [ConvertLocalToUTC $date[set date {}] $TZData($timezone) 2361222]
- set seconds [dict get $date seconds]
-
- # Do relative times
-
- if { [llength $parseRel] > 0 } {
- lassign $parseRel relMonth relDay relSecond
- set seconds [add $seconds \
- $relMonth months $relDay days $relSecond seconds \
- -timezone $timezone -locale $locale]
- }
-
- # Do relative weekday
-
- if { [llength $parseWeekday] > 0 } {
- lassign $parseWeekday dayOrdinal dayOfWeek
- set date2 [GetDateFields $seconds $TZData($timezone) 2361222]
- dict set date2 era CE
- set jdwkday [WeekdayOnOrBefore $dayOfWeek [expr {
- [dict get $date2 julianDay] + 6
- }]]
- incr jdwkday [expr { 7 * $dayOrdinal }]
- if { $dayOrdinal > 0 } {
- incr jdwkday -7
- }
- dict set date2 secondOfDay \
- [expr { [dict get $date2 localSeconds] % 86400 }]
- dict set date2 julianDay $jdwkday
- dict set date2 localSeconds [expr {
- -210866803200
- + ( 86400 * wide([dict get $date2 julianDay]) )
- + [dict get $date secondOfDay]
- }]
- dict set date2 tzName $timezone
- set date2 [ConvertLocalToUTC $date2[set date2 {}] $TZData($timezone) \
- 2361222]
- set seconds [dict get $date2 seconds]
-
- }
-
- # Do relative month
-
- if { [llength $parseOrdinalMonth] > 0 } {
- lassign $parseOrdinalMonth monthOrdinal monthNumber
- if { $monthOrdinal > 0 } {
- set monthDiff [expr { $monthNumber - [dict get $date month] }]
- if { $monthDiff <= 0 } {
- incr monthDiff 12
- }
- incr monthOrdinal -1
- } else {
- set monthDiff [expr { [dict get $date month] - $monthNumber }]
- if { $monthDiff >= 0 } {
- incr monthDiff -12
- }
- incr monthOrdinal
- }
- set seconds [add $seconds $monthOrdinal years $monthDiff months \
- -timezone $timezone -locale $locale]
- }
-
- return $seconds
-}
-
-
-#----------------------------------------------------------------------
-#
-# ParseClockScanFormat --
-#
-# Parses a format string given to [clock scan -format]
-#
-# Parameters:
-# formatString - The format being parsed
-# locale - The current locale
-#
-# Results:
-# Constructs and returns a procedure that accepts the string being
-# scanned, the base time, and the time zone. The procedure will either
-# return the scanned time or else throw an error that should be rethrown
-# to the caller of [clock scan]
-#
-# Side effects:
-# The given procedure is defined in the ::tcl::clock namespace. Scan
-# procedures are not deleted once installed.
-#
-# Why do we parse dates by defining a procedure to parse them? The reason is
-# that by doing so, we have one convenient place to cache all the information:
-# the regular expressions that match the patterns (which will be compiled),
-# the code that assembles the date information, everything lands in one place.
-# In this way, when a given format is reused at run time, all the information
-# of how to apply it is available in a single place.
-#
-#----------------------------------------------------------------------
-
-proc ::tcl::clock::ParseClockScanFormat {formatString locale} {
- # Check whether the format has been parsed previously, and return the
- # existing recognizer if it has.
-
- set procName scanproc'$formatString'$locale
- set procName [namespace current]::[string map {: {\:} \\ {\\}} $procName]
- if { [namespace which $procName] != {} } {
- return $procName
- }
-
- variable DateParseActions
- variable TimeParseActions
-
- # Localize the %x, %X, etc. groups
-
- set formatString [LocalizeFormat $locale $formatString]
-
- # Condense whitespace
-
- regsub -all {[[:space:]]+} $formatString { } formatString
-
- # Walk through the groups of the format string. In this loop, we
- # accumulate:
- # - a regular expression that matches the string,
- # - the count of capturing brackets in the regexp
- # - a set of code that post-processes the fields captured by the regexp,
- # - a dictionary whose keys are the names of fields that are present
- # in the format string.
-
- set re {^[[:space:]]*}
- set captureCount 0
- set postcode {}
- set fieldSet [dict create]
- set fieldCount 0
- set postSep {}
- set state {}
-
- foreach c [split $formatString {}] {
- switch -exact -- $state {
- {} {
- if { $c eq "%" } {
- set state %
- } elseif { $c eq " " } {
- append re {[[:space:]]+}
- } else {
- if { ! [string is alnum $c] } {
- append re "\\"
- }
- append re $c
- }
- }
- % {
- set state {}
- switch -exact -- $c {
- % {
- append re %
- }
- { } {
- append re "\[\[:space:\]\]*"
- }
- a - A { # Day of week, in words
- set l {}
- foreach \
- i {7 1 2 3 4 5 6} \
- abr [mc DAYS_OF_WEEK_ABBREV] \
- full [mc DAYS_OF_WEEK_FULL] {
- dict set l [string tolower $abr] $i
- dict set l [string tolower $full] $i
- incr i
- }
- lassign [UniquePrefixRegexp $l] regex lookup
- append re ( $regex )
- dict set fieldSet dayOfWeek [incr fieldCount]
- append postcode "dict set date dayOfWeek \[" \
- "dict get " [list $lookup] " " \
- \[ {string tolower $field} [incr captureCount] \] \
- "\]\n"
- }
- b - B - h { # Name of month
- set i 0
- set l {}
- foreach \
- abr [mc MONTHS_ABBREV] \
- full [mc MONTHS_FULL] {
- incr i
- dict set l [string tolower $abr] $i
- dict set l [string tolower $full] $i
- }
- lassign [UniquePrefixRegexp $l] regex lookup
- append re ( $regex )
- dict set fieldSet month [incr fieldCount]
- append postcode "dict set date month \[" \
- "dict get " [list $lookup] \
- " " \[ {string tolower $field} \
- [incr captureCount] \] \
- "\]\n"
- }
- C { # Gregorian century
- append re \\s*(\\d\\d?)
- dict set fieldSet century [incr fieldCount]
- append postcode "dict set date century \[" \
- "::scan \$field" [incr captureCount] " %d" \
- "\]\n"
- }
- d - e { # Day of month
- append re \\s*(\\d\\d?)
- dict set fieldSet dayOfMonth [incr fieldCount]
- append postcode "dict set date dayOfMonth \[" \
- "::scan \$field" [incr captureCount] " %d" \
- "\]\n"
- }
- E { # Prefix for locale-specific codes
- set state %E
- }
- g { # ISO8601 2-digit year
- append re \\s*(\\d\\d)
- dict set fieldSet iso8601YearOfCentury \
- [incr fieldCount]
- append postcode \
- "dict set date iso8601YearOfCentury \[" \
- "::scan \$field" [incr captureCount] " %d" \
- "\]\n"
- }
- G { # ISO8601 4-digit year
- append re \\s*(\\d\\d)(\\d\\d)
- dict set fieldSet iso8601Century [incr fieldCount]
- dict set fieldSet iso8601YearOfCentury \
- [incr fieldCount]
- append postcode \
- "dict set date iso8601Century \[" \
- "::scan \$field" [incr captureCount] " %d" \
- "\]\n" \
- "dict set date iso8601YearOfCentury \[" \
- "::scan \$field" [incr captureCount] " %d" \
- "\]\n"
- }
- H - k { # Hour of day
- append re \\s*(\\d\\d?)
- dict set fieldSet hour [incr fieldCount]
- append postcode "dict set date hour \[" \
- "::scan \$field" [incr captureCount] " %d" \
- "\]\n"
- }
- I - l { # Hour, AM/PM
- append re \\s*(\\d\\d?)
- dict set fieldSet hourAMPM [incr fieldCount]
- append postcode "dict set date hourAMPM \[" \
- "::scan \$field" [incr captureCount] " %d" \
- "\]\n"
- }
- j { # Day of year
- append re \\s*(\\d\\d?\\d?)
- dict set fieldSet dayOfYear [incr fieldCount]
- append postcode "dict set date dayOfYear \[" \
- "::scan \$field" [incr captureCount] " %d" \
- "\]\n"
- }
- J { # Julian Day Number
- append re \\s*(\\d+)
- dict set fieldSet julianDay [incr fieldCount]
- append postcode "dict set date julianDay \[" \
- "::scan \$field" [incr captureCount] " %ld" \
- "\]\n"
- }
- m - N { # Month number
- append re \\s*(\\d\\d?)
- dict set fieldSet month [incr fieldCount]
- append postcode "dict set date month \[" \
- "::scan \$field" [incr captureCount] " %d" \
- "\]\n"
- }
- M { # Minute
- append re \\s*(\\d\\d?)
- dict set fieldSet minute [incr fieldCount]
- append postcode "dict set date minute \[" \
- "::scan \$field" [incr captureCount] " %d" \
- "\]\n"
- }
- n { # Literal newline
- append re \\n
- }
- O { # Prefix for locale numerics
- set state %O
- }
- p - P { # AM/PM indicator
- set l [list [string tolower [mc AM]] 0 \
- [string tolower [mc PM]] 1]
- lassign [UniquePrefixRegexp $l] regex lookup
- append re ( $regex )
- dict set fieldSet amPmIndicator [incr fieldCount]
- append postcode "dict set date amPmIndicator \[" \
- "dict get " [list $lookup] " \[string tolower " \
- "\$field" \
- [incr captureCount] \
- "\]\]\n"
- }
- Q { # Hi, Jeff!
- append re {Stardate\s+([-+]?\d+)(\d\d\d)[.](\d)}
- incr captureCount
- dict set fieldSet seconds [incr fieldCount]
- append postcode {dict set date seconds } \[ \
- {ParseStarDate $field} [incr captureCount] \
- { $field} [incr captureCount] \
- { $field} [incr captureCount] \
- \] \n
- }
- s { # Seconds from Posix Epoch
- # This next case is insanely difficult, because it's
- # problematic to determine whether the field is
- # actually within the range of a wide integer.
- append re {\s*([-+]?\d+)}
- dict set fieldSet seconds [incr fieldCount]
- append postcode {dict set date seconds } \[ \
- {ScanWide $field} [incr captureCount] \] \n
- }
- S { # Second
- append re \\s*(\\d\\d?)
- dict set fieldSet second [incr fieldCount]
- append postcode "dict set date second \[" \
- "::scan \$field" [incr captureCount] " %d" \
- "\]\n"
- }
- t { # Literal tab character
- append re \\t
- }
- u - w { # Day number within week, 0 or 7 == Sun
- # 1=Mon, 6=Sat
- append re \\s*(\\d)
- dict set fieldSet dayOfWeek [incr fieldCount]
- append postcode {::scan $field} [incr captureCount] \
- { %d dow} \n \
- {
- if { $dow == 0 } {
- set dow 7
- } elseif { $dow > 7 } {
- return -code error \
- -errorcode [list CLOCK badDayOfWeek] \
- "day of week is greater than 7"
- }
- dict set date dayOfWeek $dow
- }
- }
- U { # Week of year. The first Sunday of
- # the year is the first day of week
- # 01. No scan rule uses this group.
- append re \\s*\\d\\d?
- }
- V { # Week of ISO8601 year
-
- append re \\s*(\\d\\d?)
- dict set fieldSet iso8601Week [incr fieldCount]
- append postcode "dict set date iso8601Week \[" \
- "::scan \$field" [incr captureCount] " %d" \
- "\]\n"
- }
- W { # Week of the year (00-53). The first
- # Monday of the year is the first day
- # of week 01. No scan rule uses this
- # group.
- append re \\s*\\d\\d?
- }
- y { # Two-digit Gregorian year
- append re \\s*(\\d\\d?)
- dict set fieldSet yearOfCentury [incr fieldCount]
- append postcode "dict set date yearOfCentury \[" \
- "::scan \$field" [incr captureCount] " %d" \
- "\]\n"
- }
- Y { # 4-digit Gregorian year
- append re \\s*(\\d\\d)(\\d\\d)
- dict set fieldSet century [incr fieldCount]
- dict set fieldSet yearOfCentury [incr fieldCount]
- append postcode \
- "dict set date century \[" \
- "::scan \$field" [incr captureCount] " %d" \
- "\]\n" \
- "dict set date yearOfCentury \[" \
- "::scan \$field" [incr captureCount] " %d" \
- "\]\n"
- }
- z - Z { # Time zone name
- append re {(?:([-+]\d\d(?::?\d\d(?::?\d\d)?)?)|([[:alnum:]]{1,4}))}
- dict set fieldSet tzName [incr fieldCount]
- append postcode \
- {if } \{ { $field} [incr captureCount] \
- { ne "" } \} { } \{ \n \
- {dict set date tzName $field} \
- $captureCount \n \
- \} { else } \{ \n \
- {dict set date tzName } \[ \
- {ConvertLegacyTimeZone $field} \
- [incr captureCount] \] \n \
- \} \n \
- }
- % { # Literal percent character
- append re %
- }
- default {
- append re %
- if { ! [string is alnum $c] } {
- append re \\
- }
- append re $c
- }
- }
- }
- %E {
- switch -exact -- $c {
- C { # Locale-dependent era
- set d {}
- foreach triple [mc LOCALE_ERAS] {
- lassign $triple t symbol year
- dict set d [string tolower $symbol] $year
- }
- lassign [UniquePrefixRegexp $d] regex lookup
- append re (?: $regex )
- }
- E {
- set l {}
- dict set l [string tolower [mc BCE]] BCE
- dict set l [string tolower [mc CE]] CE
- dict set l b.c.e. BCE
- dict set l c.e. CE
- dict set l b.c. BCE
- dict set l a.d. CE
- lassign [UniquePrefixRegexp $l] regex lookup
- append re ( $regex )
- dict set fieldSet era [incr fieldCount]
- append postcode "dict set date era \["\
- "dict get " [list $lookup] \
- { } \[ {string tolower $field} \
- [incr captureCount] \] \
- "\]\n"
- }
- y { # Locale-dependent year of the era
- lassign [LocaleNumeralMatcher $locale] regex lookup
- append re $regex
- incr captureCount
- }
- default {
- append re %E
- if { ! [string is alnum $c] } {
- append re \\
- }
- append re $c
- }
- }
- set state {}
- }
- %O {
- switch -exact -- $c {
- d - e {
- lassign [LocaleNumeralMatcher $locale] regex lookup
- append re $regex
- dict set fieldSet dayOfMonth [incr fieldCount]
- append postcode "dict set date dayOfMonth \[" \
- "dict get " [list $lookup] " \$field" \
- [incr captureCount] \
- "\]\n"
- }
- H - k {
- lassign [LocaleNumeralMatcher $locale] regex lookup
- append re $regex
- dict set fieldSet hour [incr fieldCount]
- append postcode "dict set date hour \[" \
- "dict get " [list $lookup] " \$field" \
- [incr captureCount] \
- "\]\n"
- }
- I - l {
- lassign [LocaleNumeralMatcher $locale] regex lookup
- append re $regex
- dict set fieldSet hourAMPM [incr fieldCount]
- append postcode "dict set date hourAMPM \[" \
- "dict get " [list $lookup] " \$field" \
- [incr captureCount] \
- "\]\n"
- }
- m {
- lassign [LocaleNumeralMatcher $locale] regex lookup
- append re $regex
- dict set fieldSet month [incr fieldCount]
- append postcode "dict set date month \[" \
- "dict get " [list $lookup] " \$field" \
- [incr captureCount] \
- "\]\n"
- }
- M {
- lassign [LocaleNumeralMatcher $locale] regex lookup
- append re $regex
- dict set fieldSet minute [incr fieldCount]
- append postcode "dict set date minute \[" \
- "dict get " [list $lookup] " \$field" \
- [incr captureCount] \
- "\]\n"
- }
- S {
- lassign [LocaleNumeralMatcher $locale] regex lookup
- append re $regex
- dict set fieldSet second [incr fieldCount]
- append postcode "dict set date second \[" \
- "dict get " [list $lookup] " \$field" \
- [incr captureCount] \
- "\]\n"
- }
- u - w {
- lassign [LocaleNumeralMatcher $locale] regex lookup
- append re $regex
- dict set fieldSet dayOfWeek [incr fieldCount]
- append postcode "set dow \[dict get " [list $lookup] \
- { $field} [incr captureCount] \] \n \
- {
- if { $dow == 0 } {
- set dow 7
- } elseif { $dow > 7 } {
- return -code error \
- -errorcode [list CLOCK badDayOfWeek] \
- "day of week is greater than 7"
- }
- dict set date dayOfWeek $dow
- }
- }
- y {
- lassign [LocaleNumeralMatcher $locale] regex lookup
- append re $regex
- dict set fieldSet yearOfCentury [incr fieldCount]
- append postcode {dict set date yearOfCentury } \[ \
- {dict get } [list $lookup] { $field} \
- [incr captureCount] \] \n
- }
- default {
- append re %O
- if { ! [string is alnum $c] } {
- append re \\
- }
- append re $c
- }
- }
- set state {}
- }
- }
- }
-
- # Clean up any unfinished format groups
-
- append re $state \\s*\$
-
- # Build the procedure
-
- set procBody {}
- append procBody "variable ::tcl::clock::TZData" \n
- append procBody "if \{ !\[ regexp -nocase [list $re] \$string ->"
- for { set i 1 } { $i <= $captureCount } { incr i } {
- append procBody " " field $i
- }
- append procBody "\] \} \{" \n
- append procBody {
- return -code error -errorcode [list CLOCK badInputString] \
- {input string does not match supplied format}
- }
- append procBody \}\n
- append procBody "set date \[dict create\]" \n
- append procBody {dict set date tzName $timeZone} \n
- append procBody $postcode
- append procBody [list set changeover [mc GREGORIAN_CHANGE_DATE]] \n
-
- # Set up the time zone before doing anything with a default base date
- # that might need a timezone to interpret it.
-
- if { ![dict exists $fieldSet seconds]
- && ![dict exists $fieldSet starDate] } {
- if { [dict exists $fieldSet tzName] } {
- append procBody {
- set timeZone [dict get $date tzName]
- }
- }
- append procBody {
- ::tcl::clock::SetupTimeZone $timeZone
- }
- }
-
- # Add code that gets Julian Day Number from the fields.
-
- append procBody [MakeParseCodeFromFields $fieldSet $DateParseActions]
-
- # Get time of day
-
- append procBody [MakeParseCodeFromFields $fieldSet $TimeParseActions]
-
- # Assemble seconds from the Julian day and second of the day.
- # Convert to local time unless epoch seconds or stardate are
- # being processed - they're always absolute
-
- if { ![dict exists $fieldSet seconds]
- && ![dict exists $fieldSet starDate] } {
- append procBody {
- if { [dict get $date julianDay] > 5373484 } {
- return -code error -errorcode [list CLOCK dateTooLarge] \
- "requested date too large to represent"
- }
- dict set date localSeconds [expr {
- -210866803200
- + ( 86400 * wide([dict get $date julianDay]) )
- + [dict get $date secondOfDay]
- }]
- }
-
- # Finally, convert the date to local time
-
- append procBody {
- set date [::tcl::clock::ConvertLocalToUTC $date[set date {}] \
- $TZData($timeZone) $changeover]
- }
- }
-
- # Return result
-
- append procBody {return [dict get $date seconds]} \n
-
- proc $procName { string baseTime timeZone } $procBody
-
- # puts [list proc $procName [list string baseTime timeZone] $procBody]
-
- return $procName
-}
-
-#----------------------------------------------------------------------
-#
-# LocaleNumeralMatcher --
-#
-# Composes a regexp that captures the numerals in the given locale, and
-# a dictionary to map them to conventional numerals.
-#
-# Parameters:
-# locale - Name of the current locale
-#
-# Results:
-# Returns a two-element list comprising the regexp and the dictionary.
-#
-# Side effects:
-# Caches the result.
-#
-#----------------------------------------------------------------------
-
-proc ::tcl::clock::LocaleNumeralMatcher {l} {
- variable LocaleNumeralCache
-
- if { ![dict exists $LocaleNumeralCache $l] } {
- set d {}
- set i 0
- set sep \(
- foreach n [mc LOCALE_NUMERALS] {
- dict set d $n $i
- regsub -all {[^[:alnum:]]} $n \\\\& subex
- append re $sep $subex
- set sep |
- incr i
- }
- append re \)
- dict set LocaleNumeralCache $l [list $re $d]
- }
- return [dict get $LocaleNumeralCache $l]
-}
-
-
-
-#----------------------------------------------------------------------
-#
-# UniquePrefixRegexp --
-#
-# Composes a regexp that performs unique-prefix matching. The RE
-# matches one of a supplied set of strings, or any unique prefix
-# thereof.
-#
-# Parameters:
-# data - List of alternating match-strings and values.
-# Match-strings with distinct values are considered
-# distinct.
-#
-# Results:
-# Returns a two-element list. The first is a regexp that matches any
-# unique prefix of any of the strings. The second is a dictionary whose
-# keys are match values from the regexp and whose values are the
-# corresponding values from 'data'.
-#
-# Side effects:
-# None.
-#
-#----------------------------------------------------------------------
-
-proc ::tcl::clock::UniquePrefixRegexp { data } {
- # The 'successors' dictionary will contain, for each string that is a
- # prefix of any key, all characters that may follow that prefix. The
- # 'prefixMapping' dictionary will have keys that are prefixes of keys and
- # values that correspond to the keys.
-
- set prefixMapping [dict create]
- set successors [dict create {} {}]
- # Walk the key-value pairs
-
- foreach { key value } $data {
- # Construct all prefixes of the key;
-
- set prefix {}
- foreach char [split $key {}] {
- set oldPrefix $prefix
- dict set successors $oldPrefix $char {}
- append prefix $char
-
- # Put the prefixes in the 'prefixMapping' and 'successors'
- # dictionaries
-
- dict lappend prefixMapping $prefix $value
- if { ![dict exists $successors $prefix] } {
- dict set successors $prefix {}
- }
- }
- }
-
- # Identify those prefixes that designate unique values, and those that are
- # the full keys
-
- set uniquePrefixMapping {}
- dict for { key valueList } $prefixMapping {
- if { [llength $valueList] == 1 } {
- dict set uniquePrefixMapping $key [lindex $valueList 0]
- }
- }
- foreach { key value } $data {
- dict set uniquePrefixMapping $key $value
+proc mcget {locale args} {
+ switch -- $locale system {
+ set locale [GetSystemLocale]
+ } current {
+ set locale [mclocale]
}
-
- # Construct the re.
-
- return [list \
- [MakeUniquePrefixRegexp $successors $uniquePrefixMapping {}] \
- $uniquePrefixMapping]
+ msgcat::mcget ::tcl::clock $locale {*}$args
}
#----------------------------------------------------------------------
#
-# MakeUniquePrefixRegexp --
+# GetSystemLocale --
#
-# Service procedure for 'UniquePrefixRegexp' that constructs a regular
-# expresison that matches the unique prefixes.
+# Determines the system locale, which corresponds to "system"
+# keyword for locale parameter of 'clock' command.
#
# Parameters:
-# successors - Dictionary whose keys are all prefixes
-# of keys passed to 'UniquePrefixRegexp' and whose
-# values are dictionaries whose keys are the characters
-# that may follow those prefixes.
-# uniquePrefixMapping - Dictionary whose keys are the unique
-# prefixes and whose values are not examined.
-# prefixString - Current prefix being processed.
-#
-# Results:
-# Returns a constructed regular expression that matches the set of
-# unique prefixes beginning with the 'prefixString'.
-#
-# Side effects:
# None.
#
-#----------------------------------------------------------------------
-
-proc ::tcl::clock::MakeUniquePrefixRegexp { successors
- uniquePrefixMapping
- prefixString } {
-
- # Get the characters that may follow the current prefix string
-
- set schars [lsort -ascii [dict keys [dict get $successors $prefixString]]]
- if { [llength $schars] == 0 } {
- return {}
- }
-
- # If there is more than one successor character, or if the current prefix
- # is a unique prefix, surround the generated re with non-capturing
- # parentheses.
-
- set re {}
- if {
- [dict exists $uniquePrefixMapping $prefixString]
- || [llength $schars] > 1
- } then {
- append re "(?:"
- }
-
- # Generate a regexp that matches the successors.
-
- set sep ""
- foreach { c } $schars {
- set nextPrefix $prefixString$c
- regsub -all {[^[:alnum:]]} $c \\\\& rechar
- append re $sep $rechar \
- [MakeUniquePrefixRegexp \
- $successors $uniquePrefixMapping $nextPrefix]
- set sep |
- }
-
- # If the current prefix is a unique prefix, make all following text
- # optional. Otherwise, if there is more than one successor character,
- # close the non-capturing parentheses.
-
- if { [dict exists $uniquePrefixMapping $prefixString] } {
- append re ")?"
- } elseif { [llength $schars] > 1 } {
- append re ")"
- }
-
- return $re
-}
-
-#----------------------------------------------------------------------
-#
-# MakeParseCodeFromFields --
-#
-# Composes Tcl code to extract the Julian Day Number from a dictionary
-# containing date fields.
-#
-# Parameters:
-# dateFields -- Dictionary whose keys are fields of the date,
-# and whose values are the rightmost positions
-# at which those fields appear.
-# parseActions -- List of triples: field set, priority, and
-# code to emit. Smaller priorities are better, and
-# the list must be in ascending order by priority
-#
# Results:
-# Returns a burst of code that extracts the day number from the given
-# date.
+# Returns the system locale.
#
# Side effects:
-# None.
+# None
#
#----------------------------------------------------------------------
-proc ::tcl::clock::MakeParseCodeFromFields { dateFields parseActions } {
+proc ::tcl::clock::GetSystemLocale {} {
+ if { $::tcl_platform(platform) ne {windows} } {
+ # On a non-windows platform, the 'system' locale is the same as
+ # the 'current' locale
- set currPrio 999
- set currFieldPos [list]
- set currCodeBurst {
- error "in ::tcl::clock::MakeParseCodeFromFields: can't happen"
+ return [mclocale]
}
- foreach { fieldSet prio parseAction } $parseActions {
- # If we've found an answer that's better than any that follow, quit
- # now.
-
- if { $prio > $currPrio } {
- break
- }
-
- # Accumulate the field positions that are used in the current field
- # grouping.
-
- set fieldPos [list]
- set ok true
- foreach field $fieldSet {
- if { ! [dict exists $dateFields $field] } {
- set ok 0
- break
- }
- lappend fieldPos [dict get $dateFields $field]
- }
-
- # Quit if we don't have a complete set of fields
- if { !$ok } {
- continue
- }
+ # On a windows platform, the 'system' locale is adapted from the
+ # 'current' locale by applying the date and time formats from the
+ # Control Panel. First, load the 'current' locale if it's not yet
+ # loaded
- # Determine whether the current answer is better than the last.
+ mcpackagelocale set [mclocale]
- set fPos [lsort -integer -decreasing $fieldPos]
+ # Make a new locale string for the system locale, and get the
+ # Control Panel information
- if { $prio == $currPrio } {
- foreach currPos $currFieldPos newPos $fPos {
- if {
- ![string is integer $newPos]
- || ![string is integer $currPos]
- || $newPos > $currPos
- } then {
- break
- }
- if { $newPos < $currPos } {
- set ok 0
- break
- }
- }
- }
- if { !$ok } {
- continue
- }
-
- # Remember the best possibility for extracting date information
-
- set currPrio $prio
- set currFieldPos $fPos
- set currCodeBurst $parseAction
+ set locale [mclocale]_windows
+ if { ! [mcpackagelocale present $locale] } {
+ LoadWindowsDateTimeFormats $locale
}
- return $currCodeBurst
+ return $locale
}
#----------------------------------------------------------------------
@@ -2303,34 +582,14 @@ proc ::tcl::clock::MakeParseCodeFromFields { dateFields parseActions } {
#----------------------------------------------------------------------
proc ::tcl::clock::EnterLocale { locale } {
- if { $locale eq {system} } {
- if { $::tcl_platform(platform) ne {windows} } {
- # On a non-windows platform, the 'system' locale is the same as
- # the 'current' locale
-
- set locale current
- } else {
- # On a windows platform, the 'system' locale is adapted from the
- # 'current' locale by applying the date and time formats from the
- # Control Panel. First, load the 'current' locale if it's not yet
- # loaded
-
- mcpackagelocale set [mclocale]
-
- # Make a new locale string for the system locale, and get the
- # Control Panel information
-
- set locale [mclocale]_windows
- if { ! [mcpackagelocale present $locale] } {
- LoadWindowsDateTimeFormats $locale
- }
- }
- }
- if { $locale eq {current}} {
+ switch -- $locale system {
+ set locale [GetSystemLocale]
+ } current {
set locale [mclocale]
}
- # Eventually load the locale
+ # Select the locale, eventually load it
mcpackagelocale set $locale
+ return $locale
}
#----------------------------------------------------------------------
@@ -2480,485 +739,64 @@ proc ::tcl::clock::LoadWindowsDateTimeFormats { locale } {
#
#----------------------------------------------------------------------
-proc ::tcl::clock::LocalizeFormat { locale format } {
-
- # message catalog key to cache this format
- set key FORMAT_$format
-
- if { [::msgcat::mcexists -exactlocale -exactnamespace $key] } {
- return [mc $key]
- }
- # Handle locale-dependent format groups by mapping them out of the format
- # string. Note that the order of the [string map] operations is
- # significant because later formats can refer to later ones; for example
- # %c can refer to %X, which in turn can refer to %T.
-
- set list {
- %% %%
- %D %m/%d/%Y
- %+ {%a %b %e %H:%M:%S %Z %Y}
- }
- lappend list %EY [string map $list [mc LOCALE_YEAR_FORMAT]]
- lappend list %T [string map $list [mc TIME_FORMAT_24_SECS]]
- lappend list %R [string map $list [mc TIME_FORMAT_24]]
- lappend list %r [string map $list [mc TIME_FORMAT_12]]
- lappend list %X [string map $list [mc TIME_FORMAT]]
- lappend list %EX [string map $list [mc LOCALE_TIME_FORMAT]]
- lappend list %x [string map $list [mc DATE_FORMAT]]
- lappend list %Ex [string map $list [mc LOCALE_DATE_FORMAT]]
- lappend list %c [string map $list [mc DATE_TIME_FORMAT]]
- lappend list %Ec [string map $list [mc LOCALE_DATE_TIME_FORMAT]]
- set format [string map $list $format]
-
- ::msgcat::mcset $locale $key $format
- return $format
-}
-
-#----------------------------------------------------------------------
-#
-# FormatNumericTimeZone --
-#
-# Formats a time zone as +hhmmss
-#
-# Parameters:
-# z - Time zone in seconds east of Greenwich
-#
-# Results:
-# Returns the time zone formatted in a numeric form
-#
-# Side effects:
-# None.
-#
-#----------------------------------------------------------------------
-
-proc ::tcl::clock::FormatNumericTimeZone { z } {
- if { $z < 0 } {
- set z [expr { - $z }]
- set retval -
- } else {
- set retval +
- }
- append retval [::format %02d [expr { $z / 3600 }]]
- set z [expr { $z % 3600 }]
- append retval [::format %02d [expr { $z / 60 }]]
- set z [expr { $z % 60 }]
- if { $z != 0 } {
- append retval [::format %02d $z]
- }
- return $retval
-}
-
-#----------------------------------------------------------------------
-#
-# FormatStarDate --
-#
-# Formats a date as a StarDate.
-#
-# Parameters:
-# date - Dictionary containing 'year', 'dayOfYear', and
-# 'localSeconds' fields.
-#
-# Results:
-# Returns the given date formatted as a StarDate.
-#
-# Side effects:
-# None.
-#
-# Jeff Hobbs put this in to support an atrocious pun about Tcl being
-# "Enterprise ready." Now we're stuck with it.
-#
-#----------------------------------------------------------------------
-
-proc ::tcl::clock::FormatStarDate { date } {
- variable Roddenberry
-
- # Get day of year, zero based
-
- set doy [expr { [dict get $date dayOfYear] - 1 }]
+proc ::tcl::clock::LocalizeFormat { locale format {fmtkey {}} } {
+ variable LocaleFormats
+
+ if { $fmtkey eq {} } { set fmtkey FMT_$format }
+ if { [catch {
+ set locfmt [dict get $LocaleFormats $locale $fmtkey]
+ }] } {
- # Determine whether the year is a leap year
+ # get map list cached or build it:
+ if { [catch {
+ set mlst [dict get $LocaleFormats $locale MLST]
+ }] } {
+
+ # message catalog dictionary:
+ set mcd [mcget $locale]
+
+ # Handle locale-dependent format groups by mapping them out of the format
+ # string. Note that the order of the [string map] operations is
+ # significant because later formats can refer to later ones; for example
+ # %c can refer to %X, which in turn can refer to %T.
+
+ set mlst {
+ %% %%
+ %D %m/%d/%Y
+ %+ {%a %b %e %H:%M:%S %Z %Y}
+ }
+ lappend mlst %EY [string map $mlst [dict get $mcd LOCALE_YEAR_FORMAT]]
+ lappend mlst %T [string map $mlst [dict get $mcd TIME_FORMAT_24_SECS]]
+ lappend mlst %R [string map $mlst [dict get $mcd TIME_FORMAT_24]]
+ lappend mlst %r [string map $mlst [dict get $mcd TIME_FORMAT_12]]
+ lappend mlst %X [string map $mlst [dict get $mcd TIME_FORMAT]]
+ lappend mlst %EX [string map $mlst [dict get $mcd LOCALE_TIME_FORMAT]]
+ lappend mlst %x [string map $mlst [dict get $mcd DATE_FORMAT]]
+ lappend mlst %Ex [string map $mlst [dict get $mcd LOCALE_DATE_FORMAT]]
+ lappend mlst %c [string map $mlst [dict get $mcd DATE_TIME_FORMAT]]
+ lappend mlst %Ec [string map $mlst [dict get $mcd LOCALE_DATE_TIME_FORMAT]]
- set lp [IsGregorianLeapYear $date]
+ dict set LocaleFormats $locale MLST $mlst
+ }
- # Convert day of year to a fractional year
+ # translate copy of format (don't use format object here, because otherwise
+ # it can lose its internal representation (string map - convert to unicode)
+ set locfmt [string map $mlst [string range " $format" 1 end]]
- if { $lp } {
- set fractYear [expr { 1000 * $doy / 366 }]
- } else {
- set fractYear [expr { 1000 * $doy / 365 }]
+ # cache it:
+ dict set LocaleFormats $locale $fmtkey $locfmt
}
- # Put together the StarDate
-
- return [::format "Stardate %02d%03d.%1d" \
- [expr { [dict get $date year] - $Roddenberry }] \
- $fractYear \
- [expr { [dict get $date localSeconds] % 86400
- / ( 86400 / 10 ) }]]
-}
-
-#----------------------------------------------------------------------
-#
-# ParseStarDate --
-#
-# Parses a StarDate
-#
-# Parameters:
-# year - Year from the Roddenberry epoch
-# fractYear - Fraction of a year specifiying the day of year.
-# fractDay - Fraction of a day
-#
-# Results:
-# Returns a count of seconds from the Posix epoch.
-#
-# Side effects:
-# None.
-#
-# Jeff Hobbs put this in to support an atrocious pun about Tcl being
-# "Enterprise ready." Now we're stuck with it.
-#
-#----------------------------------------------------------------------
-
-proc ::tcl::clock::ParseStarDate { year fractYear fractDay } {
- variable Roddenberry
-
- # Build a tentative date from year and fraction.
-
- set date [dict create \
- gregorian 1 \
- era CE \
- year [expr { $year + $Roddenberry }] \
- dayOfYear [expr { $fractYear * 365 / 1000 + 1 }]]
- set date [GetJulianDayFromGregorianEraYearDay $date[set date {}]]
-
- # Determine whether the given year is a leap year
-
- set lp [IsGregorianLeapYear $date]
-
- # Reconvert the fractional year according to whether the given year is a
- # leap year
-
- if { $lp } {
- dict set date dayOfYear \
- [expr { $fractYear * 366 / 1000 + 1 }]
- } else {
- dict set date dayOfYear \
- [expr { $fractYear * 365 / 1000 + 1 }]
+ # Save original format as long as possible, because of internal
+ # representation (performance).
+ # Note that in this case such format will be never localized (also
+ # using another locales). To prevent this return a duplicate (but
+ # it may be slower).
+ if {$locfmt eq $format} {
+ set locfmt $format
}
- dict unset date julianDay
- dict unset date gregorian
- set date [GetJulianDayFromGregorianEraYearDay $date[set date {}]]
-
- return [expr {
- 86400 * [dict get $date julianDay]
- - 210866803200
- + ( 86400 / 10 ) * $fractDay
- }]
-}
-#----------------------------------------------------------------------
-#
-# ScanWide --
-#
-# Scans a wide integer from an input
-#
-# Parameters:
-# str - String containing a decimal wide integer
-#
-# Results:
-# Returns the string as a pure wide integer. Throws an error if the
-# string is misformatted or out of range.
-#
-#----------------------------------------------------------------------
-
-proc ::tcl::clock::ScanWide { str } {
- set count [::scan $str {%ld %c} result junk]
- if { $count != 1 } {
- return -code error -errorcode [list CLOCK notAnInteger $str] \
- "\"$str\" is not an integer"
- }
- if { [incr result 0] != $str } {
- return -code error -errorcode [list CLOCK integervalueTooLarge] \
- "integer value too large to represent"
- }
- return $result
-}
-
-#----------------------------------------------------------------------
-#
-# InterpretTwoDigitYear --
-#
-# Given a date that contains only the year of the century, determines
-# the target value of a two-digit year.
-#
-# Parameters:
-# date - Dictionary containing fields of the date.
-# baseTime - Base time relative to which the date is expressed.
-# twoDigitField - Name of the field that stores the two-digit year.
-# Default is 'yearOfCentury'
-# fourDigitField - Name of the field that will receive the four-digit
-# year. Default is 'year'
-#
-# Results:
-# Returns the dictionary augmented with the four-digit year, stored in
-# the given key.
-#
-# Side effects:
-# None.
-#
-# The current rule for interpreting a two-digit year is that the year shall be
-# between 1937 and 2037, thus staying within the range of a 32-bit signed
-# value for time. This rule may change to a sliding window in future
-# versions, so the 'baseTime' parameter (which is currently ignored) is
-# provided in the procedure signature.
-#
-#----------------------------------------------------------------------
-
-proc ::tcl::clock::InterpretTwoDigitYear { date baseTime
- { twoDigitField yearOfCentury }
- { fourDigitField year } } {
- set yr [dict get $date $twoDigitField]
- if { $yr <= 37 } {
- dict set date $fourDigitField [expr { $yr + 2000 }]
- } else {
- dict set date $fourDigitField [expr { $yr + 1900 }]
- }
- return $date
-}
-
-#----------------------------------------------------------------------
-#
-# AssignBaseYear --
-#
-# Places the number of the current year into a dictionary.
-#
-# Parameters:
-# date - Dictionary value to update
-# baseTime - Base time from which to extract the year, expressed
-# in seconds from the Posix epoch
-# timezone - the time zone in which the date is being scanned
-# changeover - the Julian Day on which the Gregorian calendar
-# was adopted in the target locale.
-#
-# Results:
-# Returns the dictionary with the current year assigned.
-#
-# Side effects:
-# None.
-#
-#----------------------------------------------------------------------
-
-proc ::tcl::clock::AssignBaseYear { date baseTime timezone changeover } {
- variable TZData
-
- # Find the Julian Day Number corresponding to the base time, and
- # find the Gregorian year corresponding to that Julian Day.
-
- set date2 [GetDateFields $baseTime $TZData($timezone) $changeover]
-
- # Store the converted year
-
- dict set date era [dict get $date2 era]
- dict set date year [dict get $date2 year]
-
- return $date
-}
-
-#----------------------------------------------------------------------
-#
-# AssignBaseIso8601Year --
-#
-# Determines the base year in the ISO8601 fiscal calendar.
-#
-# Parameters:
-# date - Dictionary containing the fields of the date that
-# is to be augmented with the base year.
-# baseTime - Base time expressed in seconds from the Posix epoch.
-# timeZone - Target time zone
-# changeover - Julian Day of adoption of the Gregorian calendar in
-# the target locale.
-#
-# Results:
-# Returns the given date with "iso8601Year" set to the
-# base year.
-#
-# Side effects:
-# None.
-#
-#----------------------------------------------------------------------
-
-proc ::tcl::clock::AssignBaseIso8601Year {date baseTime timeZone changeover} {
- variable TZData
-
- # Find the Julian Day Number corresponding to the base time
-
- set date2 [GetDateFields $baseTime $TZData($timeZone) $changeover]
-
- # Calculate the ISO8601 date and transfer the year
-
- dict set date era CE
- dict set date iso8601Year [dict get $date2 iso8601Year]
- return $date
-}
-
-#----------------------------------------------------------------------
-#
-# AssignBaseMonth --
-#
-# Places the number of the current year and month into a
-# dictionary.
-#
-# Parameters:
-# date - Dictionary value to update
-# baseTime - Time from which the year and month are to be
-# obtained, expressed in seconds from the Posix epoch.
-# timezone - Name of the desired time zone
-# changeover - Julian Day on which the Gregorian calendar was adopted.
-#
-# Results:
-# Returns the dictionary with the base year and month assigned.
-#
-# Side effects:
-# None.
-#
-#----------------------------------------------------------------------
-
-proc ::tcl::clock::AssignBaseMonth {date baseTime timezone changeover} {
- variable TZData
-
- # Find the year and month corresponding to the base time
-
- set date2 [GetDateFields $baseTime $TZData($timezone) $changeover]
- dict set date era [dict get $date2 era]
- dict set date year [dict get $date2 year]
- dict set date month [dict get $date2 month]
- return $date
-}
-
-#----------------------------------------------------------------------
-#
-# AssignBaseWeek --
-#
-# Determines the base year and week in the ISO8601 fiscal calendar.
-#
-# Parameters:
-# date - Dictionary containing the fields of the date that
-# is to be augmented with the base year and week.
-# baseTime - Base time expressed in seconds from the Posix epoch.
-# changeover - Julian Day on which the Gregorian calendar was adopted
-# in the target locale.
-#
-# Results:
-# Returns the given date with "iso8601Year" set to the
-# base year and "iso8601Week" to the week number.
-#
-# Side effects:
-# None.
-#
-#----------------------------------------------------------------------
-
-proc ::tcl::clock::AssignBaseWeek {date baseTime timeZone changeover} {
- variable TZData
-
- # Find the Julian Day Number corresponding to the base time
-
- set date2 [GetDateFields $baseTime $TZData($timeZone) $changeover]
-
- # Calculate the ISO8601 date and transfer the year
-
- dict set date era CE
- dict set date iso8601Year [dict get $date2 iso8601Year]
- dict set date iso8601Week [dict get $date2 iso8601Week]
- return $date
-}
-
-#----------------------------------------------------------------------
-#
-# AssignBaseJulianDay --
-#
-# Determines the base day for a time-of-day conversion.
-#
-# Parameters:
-# date - Dictionary that is to get the base day
-# baseTime - Base time expressed in seconds from the Posix epoch
-# changeover - Julian day on which the Gregorian calendar was
-# adpoted in the target locale.
-#
-# Results:
-# Returns the given dictionary augmented with a 'julianDay' field
-# that contains the base day.
-#
-# Side effects:
-# None.
-#
-#----------------------------------------------------------------------
-
-proc ::tcl::clock::AssignBaseJulianDay { date baseTime timeZone changeover } {
- variable TZData
-
- # Find the Julian Day Number corresponding to the base time
-
- set date2 [GetDateFields $baseTime $TZData($timeZone) $changeover]
- dict set date julianDay [dict get $date2 julianDay]
-
- return $date
-}
-
-#----------------------------------------------------------------------
-#
-# InterpretHMSP --
-#
-# Interprets a time in the form "hh:mm:ss am".
-#
-# Parameters:
-# date -- Dictionary containing "hourAMPM", "minute", "second"
-# and "amPmIndicator" fields.
-#
-# Results:
-# Returns the number of seconds from local midnight.
-#
-# Side effects:
-# None.
-#
-#----------------------------------------------------------------------
-
-proc ::tcl::clock::InterpretHMSP { date } {
- set hr [dict get $date hourAMPM]
- if { $hr == 12 } {
- set hr 0
- }
- if { [dict get $date amPmIndicator] } {
- incr hr 12
- }
- dict set date hour $hr
- return [InterpretHMS $date[set date {}]]
-}
-
-#----------------------------------------------------------------------
-#
-# InterpretHMS --
-#
-# Interprets a 24-hour time "hh:mm:ss"
-#
-# Parameters:
-# date -- Dictionary containing the "hour", "minute" and "second"
-# fields.
-#
-# Results:
-# Returns the given dictionary augmented with a "secondOfDay"
-# field containing the number of seconds from local midnight.
-#
-# Side effects:
-# None.
-#
-#----------------------------------------------------------------------
-
-proc ::tcl::clock::InterpretHMS { date } {
- return [expr {
- ( [dict get $date hour] * 60
- + [dict get $date minute] ) * 60
- + [dict get $date second]
- }]
+ return $locfmt
}
#----------------------------------------------------------------------
@@ -2975,13 +813,12 @@ proc ::tcl::clock::InterpretHMS { date } {
# Returns the system time zone.
#
# Side effects:
-# Stores the sustem time zone in the 'CachedSystemTimeZone'
-# variable, since determining it may be an expensive process.
+# Stores the sustem time zone in engine configuration, since
+# determining it may be an expensive process.
#
#----------------------------------------------------------------------
proc ::tcl::clock::GetSystemTimeZone {} {
- variable CachedSystemTimeZone
variable TimeZoneBad
if {[set result [getenv TCL_TZ]] ne {}} {
@@ -2990,61 +827,33 @@ proc ::tcl::clock::GetSystemTimeZone {} {
set timezone $result
}
if {![info exists timezone]} {
- # Cache the time zone only if it was detected by one of the
- # expensive methods.
- if { [info exists CachedSystemTimeZone] } {
- set timezone $CachedSystemTimeZone
- } elseif { $::tcl_platform(platform) eq {windows} } {
- set timezone [GuessWindowsTimeZone]
- } elseif { [file exists /etc/localtime]
- && ![catch {ReadZoneinfoFile \
- Tcl/Localtime /etc/localtime}] } {
- set timezone :Tcl/Localtime
- } else {
- set timezone :localtime
+ # ask engine for the cached timezone:
+ set timezone [configure -system-tz]
+ if { $timezone ne "" } {
+ return $timezone
}
- set CachedSystemTimeZone $timezone
+ if { $::tcl_platform(platform) eq {windows} } {
+ set timezone [GuessWindowsTimeZone]
+ } elseif { [file exists /etc/localtime]
+ && ![catch {ReadZoneinfoFile \
+ Tcl/Localtime /etc/localtime}] } {
+ set timezone :Tcl/Localtime
+ } else {
+ set timezone :localtime
+ }
}
if { ![dict exists $TimeZoneBad $timezone] } {
- dict set TimeZoneBad $timezone [catch {SetupTimeZone $timezone}]
+ catch {set timezone [SetupTimeZone $timezone]}
}
- if { [dict get $TimeZoneBad $timezone] } {
- return :localtime
- } else {
- return $timezone
- }
-}
-#----------------------------------------------------------------------
-#
-# ConvertLegacyTimeZone --
-#
-# Given an alphanumeric time zone identifier and the system time zone,
-# convert the alphanumeric identifier to an unambiguous time zone.
-#
-# Parameters:
-# tzname - Name of the time zone to convert
-#
-# Results:
-# Returns a time zone name corresponding to tzname, but in an
-# unambiguous form, generally +hhmm.
-#
-# This procedure is implemented primarily to allow the parsing of RFC822
-# date/time strings. Processing a time zone name on input is not recommended
-# practice, because there is considerable room for ambiguity; for instance, is
-# BST Brazilian Standard Time, or British Summer Time?
-#
-#----------------------------------------------------------------------
-
-proc ::tcl::clock::ConvertLegacyTimeZone { tzname } {
- variable LegacyTimeZone
-
- set tzname [string tolower $tzname]
- if { ![dict exists $LegacyTimeZone $tzname] } {
- return -code error -errorcode [list CLOCK badTZName $tzname] \
- "time zone \"$tzname\" not found"
+ if { [dict exists $TimeZoneBad $timezone] } {
+ set timezone :localtime
}
- return [dict get $LegacyTimeZone $tzname]
+
+ # tell backend - current system timezone:
+ configure -system-tz $timezone
+
+ return $timezone
}
#----------------------------------------------------------------------
@@ -3064,10 +873,17 @@ proc ::tcl::clock::ConvertLegacyTimeZone { tzname } {
#
#----------------------------------------------------------------------
-proc ::tcl::clock::SetupTimeZone { timezone } {
+proc ::tcl::clock::SetupTimeZone { timezone {alias {}} } {
variable TZData
if {! [info exists TZData($timezone)] } {
+
+ variable TimeZoneBad
+ if { [dict exists $TimeZoneBad $timezone] } {
+ return -code error \
+ -errorcode [list CLOCK badTimeZone $timezone] \
+ "time zone \"$timezone\" not found"
+ }
variable MINWIDE
if { $timezone eq {:localtime} } {
# Nothing to do, we'll convert using the localtime function
@@ -3105,6 +921,7 @@ proc ::tcl::clock::SetupTimeZone { timezone } {
LoadZoneinfoFile [string range $timezone 1 end]
}]
} then {
+ dict set TimeZoneBad $timezone 1
return -code error \
-errorcode [list CLOCK badTimeZone $timezone] \
"time zone \"$timezone\" not found"
@@ -3116,25 +933,43 @@ proc ::tcl::clock::SetupTimeZone { timezone } {
if { [lindex [dict get $opts -errorcode] 0] eq {CLOCK} } {
dict unset opts -errorinfo
}
+ dict set TimeZoneBad $timezone 1
return -options $opts $data
} else {
set TZData($timezone) $data
}
} else {
+
+ variable LegacyTimeZone
+
# We couldn't parse this as a POSIX time zone. Try again with a
# time zone file - this time without a colon
if { [catch { LoadTimeZoneFile $timezone }]
&& [catch { LoadZoneinfoFile $timezone } - opts] } {
+
+ # Check may be a legacy zone:
+
+ if { $alias eq {} && ![catch {
+ set tzname [dict get $LegacyTimeZone [string tolower $timezone]]
+ }] } {
+ set tzname [::tcl::clock::SetupTimeZone $tzname $timezone]
+ set TZData($timezone) $TZData($tzname)
+ # tell backend - timezone is initialized and return shared timezone object:
+ return [configure -setup-tz $timezone]
+ }
+
dict unset opts -errorinfo
+ dict set TimeZoneBad $timezone 1
return -options $opts "time zone $timezone not found"
}
set TZData($timezone) $TZData(:$timezone)
}
}
- return
+ # tell backend - timezone is initialized and return shared timezone object:
+ configure -setup-tz $timezone
}
#----------------------------------------------------------------------
@@ -3205,12 +1040,12 @@ proc ::tcl::clock::GuessWindowsTimeZone {} {
if { [dict exists $WinZoneInfo $data] } {
set tzname [dict get $WinZoneInfo $data]
if { ! [dict exists $TimeZoneBad $tzname] } {
- dict set TimeZoneBad $tzname [catch {SetupTimeZone $tzname}]
+ catch {set tzname [SetupTimeZone $tzname]}
}
} else {
set tzname {}
}
- if { $tzname eq {} || [dict get $TimeZoneBad $tzname] } {
+ if { $tzname eq {} || [dict exists $TimeZoneBad $tzname] } {
lassign $data \
bias stdBias dstBias \
stdYear stdMonth stdDayOfWeek stdDayOfMonth \
@@ -3937,43 +1772,6 @@ proc ::tcl::clock::DeterminePosixDSTTime { z bound y } {
#----------------------------------------------------------------------
#
-# GetLocaleEra --
-#
-# Given local time expressed in seconds from the Posix epoch,
-# determine localized era and year within the era.
-#
-# Parameters:
-# date - Dictionary that must contain the keys, 'localSeconds',
-# whose value is expressed as the appropriate local time;
-# and 'year', whose value is the Gregorian year.
-# etable - Value of the LOCALE_ERAS key in the message catalogue
-# for the target locale.
-#
-# Results:
-# Returns the dictionary, augmented with the keys, 'localeEra' and
-# 'localeYear'.
-#
-#----------------------------------------------------------------------
-
-proc ::tcl::clock::GetLocaleEra { date etable } {
- set index [BSearch $etable [dict get $date localSeconds]]
- if { $index < 0} {
- dict set date localeEra \
- [::format %02d [expr { [dict get $date year] / 100 }]]
- dict set date localeYear [expr {
- [dict get $date year] % 100
- }]
- } else {
- dict set date localeEra [lindex $etable $index 1]
- dict set date localeYear [expr {
- [dict get $date year] - [lindex $etable $index 2]
- }]
- }
- return $date
-}
-
-#----------------------------------------------------------------------
-#
# GetJulianDayFromEraYearDay --
#
# Given a year, month and day on the Gregorian calendar, determines
@@ -4151,331 +1949,6 @@ proc ::tcl::clock::WeekdayOnOrBefore { weekday j } {
#----------------------------------------------------------------------
#
-# BSearch --
-#
-# Service procedure that does binary search in several places inside the
-# 'clock' command.
-#
-# Parameters:
-# list - List of lists, sorted in ascending order by the
-# first elements
-# key - Value to search for
-#
-# Results:
-# Returns the index of the greatest element in $list that is less than
-# or equal to $key.
-#
-# Side effects:
-# None.
-#
-#----------------------------------------------------------------------
-
-proc ::tcl::clock::BSearch { list key } {
- if {[llength $list] == 0} {
- return -1
- }
- if { $key < [lindex $list 0 0] } {
- return -1
- }
-
- set l 0
- set u [expr { [llength $list] - 1 }]
-
- while { $l < $u } {
- # At this point, we know that
- # $k >= [lindex $list $l 0]
- # Either $u == [llength $list] or else $k < [lindex $list $u+1 0]
- # We find the midpoint of the interval {l,u} rounded UP, compare
- # against it, and set l or u to maintain the invariant. Note that the
- # interval shrinks at each step, guaranteeing convergence.
-
- set m [expr { ( $l + $u + 1 ) / 2 }]
- if { $key >= [lindex $list $m 0] } {
- set l $m
- } else {
- set u [expr { $m - 1 }]
- }
- }
-
- return $l
-}
-
-#----------------------------------------------------------------------
-#
-# clock add --
-#
-# Adds an offset to a given time.
-#
-# Syntax:
-# clock add clockval ?count unit?... ?-option value?
-#
-# Parameters:
-# clockval -- Starting time value
-# count -- Amount of a unit of time to add
-# unit -- Unit of time to add, must be one of:
-# years year months month weeks week
-# days day hours hour minutes minute
-# seconds second
-#
-# Options:
-# -gmt BOOLEAN
-# (Deprecated) Flag synonymous with '-timezone :GMT'
-# -timezone ZONE
-# Name of the time zone in which calculations are to be done.
-# -locale NAME
-# Name of the locale in which calculations are to be done.
-# Used to determine the Gregorian change date.
-#
-# Results:
-# Returns the given time adjusted by the given offset(s) in
-# order.
-#
-# Notes:
-# It is possible that adding a number of months or years will adjust the
-# day of the month as well. For instance, the time at one month after
-# 31 January is either 28 or 29 February, because February has fewer
-# than 31 days.
-#
-#----------------------------------------------------------------------
-
-proc ::tcl::clock::add { clockval args } {
- if { [llength $args] % 2 != 0 } {
- set cmdName "clock add"
- return -code error \
- -errorcode [list CLOCK wrongNumArgs] \
- "wrong \# args: should be\
- \"$cmdName clockval ?number units?...\
- ?-gmt boolean? ?-locale LOCALE? ?-timezone ZONE?\""
- }
- if { [catch { expr {wide($clockval)} } result] } {
- return -code error $result
- }
-
- set offsets {}
- set gmt 0
- set locale c
- set timezone [GetSystemTimeZone]
-
- foreach { a b } $args {
- if { [string is integer -strict $a] } {
- lappend offsets $a $b
- } else {
- switch -exact -- $a {
- -g - -gm - -gmt {
- set gmt $b
- }
- -l - -lo - -loc - -loca - -local - -locale {
- set locale [string tolower $b]
- }
- -t - -ti - -tim - -time - -timez - -timezo - -timezon -
- -timezone {
- set timezone $b
- }
- default {
- throw [list CLOCK badOption $a] \
- "bad option \"$a\",\
- must be -gmt, -locale or -timezone"
- }
- }
- }
- }
-
- # Check options for validity
-
- if { [info exists saw(-gmt)] && [info exists saw(-timezone)] } {
- return -code error \
- -errorcode [list CLOCK gmtWithTimezone] \
- "cannot use -gmt and -timezone in same call"
- }
- if { [catch { expr { wide($clockval) } } result] } {
- return -code error "expected integer but got \"$clockval\""
- }
- if { ![string is boolean -strict $gmt] } {
- return -code error "expected boolean value but got \"$gmt\""
- } elseif { $gmt } {
- set timezone :GMT
- }
-
- EnterLocale $locale
-
- set changeover [mc GREGORIAN_CHANGE_DATE]
-
- if {[catch {SetupTimeZone $timezone} retval opts]} {
- dict unset opts -errorinfo
- return -options $opts $retval
- }
-
- try {
- foreach { quantity unit } $offsets {
- switch -exact -- $unit {
- years - year {
- set clockval [AddMonths [expr { 12 * $quantity }] \
- $clockval $timezone $changeover]
- }
- months - month {
- set clockval [AddMonths $quantity $clockval $timezone \
- $changeover]
- }
-
- weeks - week {
- set clockval [AddDays [expr { 7 * $quantity }] \
- $clockval $timezone $changeover]
- }
- days - day {
- set clockval [AddDays $quantity $clockval $timezone \
- $changeover]
- }
-
- hours - hour {
- set clockval [expr { 3600 * $quantity + $clockval }]
- }
- minutes - minute {
- set clockval [expr { 60 * $quantity + $clockval }]
- }
- seconds - second {
- set clockval [expr { $quantity + $clockval }]
- }
-
- default {
- throw [list CLOCK badUnit $unit] \
- "unknown unit \"$unit\", must be \
- years, months, weeks, days, hours, minutes or seconds"
- }
- }
- }
- return $clockval
- } trap CLOCK {result opts} {
- # Conceal the innards of [clock] when it's an expected error
- dict unset opts -errorinfo
- return -options $opts $result
- }
-}
-
-#----------------------------------------------------------------------
-#
-# AddMonths --
-#
-# Add a given number of months to a given clock value in a given
-# time zone.
-#
-# Parameters:
-# months - Number of months to add (may be negative)
-# clockval - Seconds since the epoch before the operation
-# timezone - Time zone in which the operation is to be performed
-#
-# Results:
-# Returns the new clock value as a number of seconds since
-# the epoch.
-#
-# Side effects:
-# None.
-#
-#----------------------------------------------------------------------
-
-proc ::tcl::clock::AddMonths { months clockval timezone changeover } {
- variable DaysInRomanMonthInCommonYear
- variable DaysInRomanMonthInLeapYear
- variable TZData
-
- # Convert the time to year, month, day, and fraction of day.
-
- set date [GetDateFields $clockval $TZData($timezone) $changeover]
- dict set date secondOfDay [expr {
- [dict get $date localSeconds] % 86400
- }]
- dict set date tzName $timezone
-
- # Add the requisite number of months
-
- set m [dict get $date month]
- incr m $months
- incr m -1
- set delta [expr { $m / 12 }]
- set mm [expr { $m % 12 }]
- dict set date month [expr { $mm + 1 }]
- dict incr date year $delta
-
- # If the date doesn't exist in the current month, repair it
-
- if { [IsGregorianLeapYear $date] } {
- set hath [lindex $DaysInRomanMonthInLeapYear $mm]
- } else {
- set hath [lindex $DaysInRomanMonthInCommonYear $mm]
- }
- if { [dict get $date dayOfMonth] > $hath } {
- dict set date dayOfMonth $hath
- }
-
- # Reconvert to a number of seconds
-
- set date [GetJulianDayFromEraYearMonthDay \
- $date[set date {}]\
- $changeover]
- dict set date localSeconds [expr {
- -210866803200
- + ( 86400 * wide([dict get $date julianDay]) )
- + [dict get $date secondOfDay]
- }]
- set date [ConvertLocalToUTC $date[set date {}] $TZData($timezone) \
- $changeover]
-
- return [dict get $date seconds]
-
-}
-
-#----------------------------------------------------------------------
-#
-# AddDays --
-#
-# Add a given number of days to a given clock value in a given time
-# zone.
-#
-# Parameters:
-# days - Number of days to add (may be negative)
-# clockval - Seconds since the epoch before the operation
-# timezone - Time zone in which the operation is to be performed
-# changeover - Julian Day on which the Gregorian calendar was adopted
-# in the target locale.
-#
-# Results:
-# Returns the new clock value as a number of seconds since the epoch.
-#
-# Side effects:
-# None.
-#
-#----------------------------------------------------------------------
-
-proc ::tcl::clock::AddDays { days clockval timezone changeover } {
- variable TZData
-
- # Convert the time to Julian Day
-
- set date [GetDateFields $clockval $TZData($timezone) $changeover]
- dict set date secondOfDay [expr {
- [dict get $date localSeconds] % 86400
- }]
- dict set date tzName $timezone
-
- # Add the requisite number of days
-
- dict incr date julianDay $days
-
- # Reconvert to a number of seconds
-
- dict set date localSeconds [expr {
- -210866803200
- + ( 86400 * wide([dict get $date julianDay]) )
- + [dict get $date secondOfDay]
- }]
- set date [ConvertLocalToUTC $date[set date {}] $TZData($timezone) \
- $changeover]
-
- return [dict get $date seconds]
-
-}
-
-#----------------------------------------------------------------------
-#
# ChangeCurrentLocale --
#
# The global locale was changed within msgcat.
@@ -4493,10 +1966,11 @@ proc ::tcl::clock::AddDays { days clockval timezone changeover } {
#----------------------------------------------------------------------
proc ::tcl::clock::ChangeCurrentLocale {args} {
+
+ configure -default-locale [lindex $args 0]
+
variable FormatProc
variable LocaleNumeralCache
- variable CachedSystemTimeZone
- variable TimeZoneBad
foreach p [info procs [namespace current]::scanproc'*'current] {
rename $p {}
@@ -4528,10 +2002,16 @@ proc ::tcl::clock::ChangeCurrentLocale {args} {
proc ::tcl::clock::ClearCaches {} {
variable FormatProc
+ variable LocaleFormats
variable LocaleNumeralCache
- variable CachedSystemTimeZone
variable TimeZoneBad
+ # tell backend - should invalidate:
+ configure -clear
+
+ # clear msgcat cache:
+ msgcat::ClearCaches ::tcl::clock
+
foreach p [info procs [namespace current]::scanproc'*] {
rename $p {}
}
@@ -4539,9 +2019,9 @@ proc ::tcl::clock::ClearCaches {} {
rename $p {}
}
- catch {unset FormatProc}
+ unset -nocomplain FormatProc
+ set LocaleFormats {}
set LocaleNumeralCache {}
- catch {unset CachedSystemTimeZone}
set TimeZoneBad {}
InitTZData
}
diff --git a/library/init.tcl b/library/init.tcl
index a202054..87e84e4 100644
--- a/library/init.tcl
+++ b/library/init.tcl
@@ -66,12 +66,12 @@ namespace eval tcl {
}
if {![interp issafe]} {
- variable Path [encoding dirs]
- set Dir [file join $::tcl_library encoding]
- if {$Dir ni $Path} {
+ variable Path [encoding dirs]
+ set Dir [file join $::tcl_library encoding]
+ if {$Dir ni $Path} {
lappend Path $Dir
encoding dirs $Path
- }
+ }
}
# TIP #255 min and max functions
@@ -172,7 +172,7 @@ if {[interp issafe]} {
proc ::tcl::initClock {} {
# Auto-loading stubs for 'clock.tcl'
- foreach cmd {add format scan} {
+ foreach cmd {mcget LocalizeFormat SetupTimeZone GetSystemTimeZone} {
proc ::tcl::clock::$cmd args {
variable TclLibDir
source -encoding utf-8 [file join $TclLibDir clock.tcl]
@@ -595,12 +595,12 @@ proc auto_import {pattern} {
auto_load_index
foreach pattern $patternList {
- foreach name [array names auto_index $pattern] {
- if {([namespace which -command $name] eq "")
+ foreach name [array names auto_index $pattern] {
+ if {([namespace which -command $name] eq "")
&& ([namespace qualifiers $pattern] eq [namespace qualifiers $name])} {
- namespace eval :: $auto_index($name)
- }
- }
+ namespace eval :: $auto_index($name)
+ }
+ }
}
}
diff --git a/library/msgcat/msgcat.tcl b/library/msgcat/msgcat.tcl
index 928474d..f9f57db 100644
--- a/library/msgcat/msgcat.tcl
+++ b/library/msgcat/msgcat.tcl
@@ -225,6 +225,65 @@ proc msgcat::mc {src args} {
}
}
+# msgcat::mcget --
+#
+# Return the translation for the given string based on the given
+# locale setting or the whole dictionary object of the package/locale.
+# Searching of catalog is similar to "msgcat::mc".
+#
+# Contrary to "msgcat::mc" may additionally load a package catalog
+# on demand.
+#
+# Arguments:
+# ns The package namespace (as catalog selector).
+# loc The locale used for translation.
+# {src} The string to translate.
+# {args} Args to pass to the format command
+#
+# Results:
+# Returns the translated string. Propagates errors thrown by the
+# format command.
+
+proc msgcat::mcget {ns loc args} {
+ if {$loc eq {C}} {
+ set loclist [PackagePreferences $ns]
+ set loc [lindex $loclist 0]
+ } else {
+ set loc [string tolower $loc]
+ variable PackageConfig
+ # get locales list for given locale (de_de -> {de_de de {}})
+ if {[catch {
+ set loclist [dict get $PackageConfig locales $ns $loc]
+ }]} {
+ # lazy load catalog on demand
+ mcpackagelocale load $loc $ns
+ set loclist [dict get $PackageConfig locales $ns $loc]
+ }
+ }
+ if {![llength $args]} {
+ # get whole catalog:
+ return [msgcat::Merge $ns $loclist]
+ }
+ set src [lindex $args 0]
+ # search translation for each locale (regarding parent namespaces)
+ for {set nscur $ns} {$nscur != ""} {set nscur [namespace parent $nscur]} {
+ foreach loc $loclist {
+ set msgs [mcget $nscur $loc]
+ if {![catch { set val [dict get $msgs $src] }]} {
+ if {[llength $args] == 1} {
+ return $val
+ }
+ return [format $val {*}[lrange $args 1 end]]
+ }
+ }
+ }
+ # no translation :
+ if {[llength $args] == 1} {
+ return $src
+ }
+ return [format $src {*}[lrange $args 1 end]]
+}
+
# msgcat::mcexists --
#
# Check if a catalog item is set or if mc would invoke mcunknown.
@@ -415,6 +474,10 @@ proc msgcat::mcloadedlocales {subcommand} {
# items, if the former locale was the default locale.
# Returns the normalized set locale.
# The default locale is taken, if locale is not given.
+# load
+# Load a package locale without set it (lazy loading from mcget).
+# Returns the normalized set locale.
+# The default locale is taken, if locale is not given.
# get
# Get the locale valid for this package.
# isset
@@ -442,7 +505,7 @@ proc msgcat::mcloadedlocales {subcommand} {
# Results:
# Empty string, if not stated differently for the subcommand
-proc msgcat::mcpackagelocale {subcommand {locale ""}} {
+proc msgcat::mcpackagelocale {subcommand {locale ""} {ns ""}} {
# todo: implement using an ensemble
variable Loclist
variable LoadedLocales
@@ -462,7 +525,9 @@ proc msgcat::mcpackagelocale {subcommand {locale ""}} {
}
set locale [string tolower $locale]
}
- set ns [uplevel 1 {::namespace current}]
+ if {$ns eq ""} {
+ set ns [uplevel 1 {::namespace current}]
+ }
switch -exact -- $subcommand {
get { return [lindex [PackagePreferences $ns] 0] }
@@ -470,7 +535,7 @@ proc msgcat::mcpackagelocale {subcommand {locale ""}} {
loaded { return [PackageLocales $ns] }
present { return [expr {$locale in [PackageLocales $ns]} ]}
isset { return [dict exists $PackageConfig loclist $ns] }
- set { # set a package locale or add a package locale
+ set - load { # set a package locale or add a package locale
# Copy the default locale if no package locale set so far
if {![dict exists $PackageConfig loclist $ns]} {
@@ -480,17 +545,21 @@ proc msgcat::mcpackagelocale {subcommand {locale ""}} {
# Check if changed
set loclist [dict get $PackageConfig loclist $ns]
- if {! [info exists locale] || $locale eq [lindex $loclist 0] } {
+ if {[llength [info level 0]] == 2 || $locale eq [lindex $loclist 0] } {
return [lindex $loclist 0]
}
# Change loclist
set loclist [GetPreferences $locale]
set locale [lindex $loclist 0]
- dict set PackageConfig loclist $ns $loclist
+ if {$subcommand eq {set}} {
+ # set loclist
+ dict set PackageConfig loclist $ns $loclist
+ }
# load eventual missing locales
set loadedLocales [dict get $PackageConfig loadedlocales $ns]
+ dict set PackageConfig locales $ns $locale $loclist
if {$locale in $loadedLocales} { return $locale }
set loadLocales [ListComplement $loadedLocales $loclist]
dict set PackageConfig loadedlocales $ns\
@@ -521,6 +590,7 @@ proc msgcat::mcpackagelocale {subcommand {locale ""}} {
[dict get $PackageConfig loadedlocales $ns] $LoadedLocales]
dict unset PackageConfig loadedlocales $ns
dict unset PackageConfig loclist $ns
+ dict unset PackageConfig locales $ns
# unset keys not in global loaded locales
if {[dict exists $Msgs $ns]} {
@@ -847,6 +917,47 @@ proc msgcat::Load {ns locales {callbackonly 0}} {
return $x
}
+# msgcat::Merge --
+#
+# Merge message catalog dictionaries to one dictionary.
+#
+# Arguments:
+# ns Namespace (equal package) to load the message catalog.
+# locales List of locales to merge.
+#
+# Results:
+# Returns the merged dictionary of message catalogs.
+proc msgcat::Merge {ns locales} {
+ variable Merged
+ if {![catch {
+ set mrgcat [dict get $Merged $ns [set loc [lindex $locales 0]]]
+ }]} {
+ return $mrgcat
+ }
+ variable Msgs
+ # Merge sequential locales (in reverse order, e. g. {} -> en -> en_en):
+ if {[llength $locales] > 1} {
+ set mrgcat [msgcat::Merge $ns [lrange $locales 1 end]]
+ catch {
+ set mrgcat [dict merge $mrgcat [dict get $Msgs $ns $loc]]
+ }
+ } else {
+ if {[catch {
+ set mrgcat [dict get $Msgs $ns $loc]
+ }]} {
+ set mrgcat [dict create]
+ }
+ }
+ dict set Merged $ns $loc $mrgcat
+ # return smart reference (shared dict as object with exact one ref-counter)
+ return [dict smartref $mrgcat]
+}
+
+proc msgcat::ClearCaches {ns} {
+ variable Merged
+ dict unset Merged $ns
+}
+
# msgcat::Invoke --
#
# Invoke a set of registered callbacks.
@@ -919,6 +1030,7 @@ proc msgcat::Invoke {index arglist {ns ""} {resultname ""} {failerror 0}} {
proc msgcat::mcset {locale src {dest ""}} {
variable Msgs
+ variable Merged
if {[llength [info level 0]] == 3} { ;# dest not specified
set dest $src
}
@@ -928,6 +1040,7 @@ proc msgcat::mcset {locale src {dest ""}} {
set locale [string tolower $locale]
dict set Msgs $ns $locale $src $dest
+ dict unset Merged $ns
return $dest
}
@@ -967,6 +1080,7 @@ proc msgcat::mcflset {src {dest ""}} {
proc msgcat::mcmset {locale pairs} {
variable Msgs
+ variable Merged
set length [llength $pairs]
if {$length % 2} {
@@ -980,6 +1094,7 @@ proc msgcat::mcmset {locale pairs} {
foreach {src dest} $pairs {
dict set Msgs $ns $locale $src $dest
}
+ dict unset Merged $ns
return [expr {$length / 2}]
}
diff --git a/tests/clock.test b/tests/clock.test
index 4e44348..103f254 100644
--- a/tests/clock.test
+++ b/tests/clock.test
@@ -7,6 +7,7 @@
# generates output for errors. No output means no errors were found.
#
# Copyright (c) 2004 by Kevin B. Kenny. All rights reserved.
+# Copyright (c) 2015 by Sergey G. Brester aka sebres.
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
@@ -254,7 +255,7 @@ proc ::testClock::registry { cmd path key } {
test clock-1.0 "clock format - wrong # args" {
list [catch {clock format} msg] $msg $::errorCode
-} {1 {wrong # args: should be "clock format clockval ?-format string? ?-gmt boolean? ?-locale LOCALE? ?-timezone ZONE?"} {CLOCK wrongNumArgs}}
+} {1 {wrong # args: should be "clock format clockval|-now ?-format string? ?-gmt boolean? ?-locale LOCALE? ?-timezone ZONE?"} {CLOCK wrongNumArgs}}
test clock-1.1 "clock format - bad time" {
list [catch {clock format foo} msg] $msg
@@ -270,10 +271,11 @@ test clock-1.3 "clock format - empty val" {
test clock-1.4 "clock format - bad flag" {*}{
-body {
- list [catch {clock format 0 -oops badflag} msg] $msg $::errorCode
+ # range error message for possible extensions:
+ list [catch {clock format 0 -oops badflag} msg] [string range $msg 0 60] $::errorCode
}
-match glob
- -result {1 {bad option "-oops": must be -format, -gmt, -locale, or -timezone} {CLOCK badOption -oops}}
+ -result {1 {bad option "-oops": must be -format, -gmt, -locale, -timezone} {CLOCK badOption -oops}}
}
test clock-1.5 "clock format - bad timezone" {
@@ -288,6 +290,16 @@ test clock-1.7 "clock format - option abbreviations" {
clock format 0 -g true -f "%Y-%m-%d"
} 1970-01-01
+test clock-1.8 "clock format -now" {
+ # give one second more for test (if on boundary of the current second):
+ set n [clock format [clock seconds] -g 1 -f "%s"]
+ expr {[clock format -now -g 1 -f "%s"] in [list $n [incr n]]}
+} 1
+
+test clock-1.9 "clock arguments: option doubly present" {
+ list [catch {clock format 0 -gmt 1 -gmt 0} result] $result
+} {1 {bad option "-gmt": doubly present}}
+
# BEGIN testcases2
# Test formatting of Gregorian year, month, day, all formats
@@ -18553,17 +18565,156 @@ test clock-6.8 {input of seconds} {
} 9223372036854775807
test clock-6.9 {input of seconds - overflow} {
- list [catch {clock scan -9223372036854775809 -format %s -gmt true} result] $result
-} {1 {integer value too large to represent}}
+ list [catch {clock scan -9223372036854775809 -format %s -gmt true} result] $result $::errorCode
+} {1 {requested date too large to represent} {CLOCK dateTooLarge}}
test clock-6.10 {input of seconds - overflow} {
- list [catch {clock scan 9223372036854775808 -format %s -gmt true} result] $result
-} {1 {integer value too large to represent}}
+ list [catch {clock scan 9223372036854775808 -format %s -gmt true} result] $result $::errorCode
+} {1 {requested date too large to represent} {CLOCK dateTooLarge}}
test clock-6.11 {input of seconds - two values} {
clock scan {1 2} -format {%s %s} -gmt true
} 2
+test clock-6.12 {input of unambiguous short locale token (%b)} {
+ list [clock scan "12 Ja 2001" -format "%d %b %Y" -locale en_US_roman -gmt 1] \
+ [clock scan "12 Au 2001" -format "%d %b %Y" -locale en_US_roman -gmt 1]
+} {979257600 997574400}
+test clock-6.13 {input of lowercase locale token (%b)} {
+ list [clock scan "12 ja 2001" -format "%d %b %Y" -locale en_US_roman -gmt 1] \
+ [clock scan "12 au 2001" -format "%d %b %Y" -locale en_US_roman -gmt 1]
+} {979257600 997574400}
+test clock-6.14 {input of uppercase locale token (%b)} {
+ list [clock scan "12 JA 2001" -format "%d %b %Y" -locale en_US_roman -gmt 1] \
+ [clock scan "12 AU 2001" -format "%d %b %Y" -locale en_US_roman -gmt 1]
+} {979257600 997574400}
+test clock-6.15 {input of ambiguous short locale token (%b)} {
+ list [catch {
+ clock scan "12 J 2001" -format "%d %b %Y" -locale en_US_roman -gmt 1
+ } result] $result $errorCode
+} {1 {input string does not match supplied format} {CLOCK badInputString}}
+test clock-6.16 {input of ambiguous short locale token (%b)} {
+ list [catch {
+ clock scan "12 Ju 2001" -format "%d %b %Y" -locale en_US_roman -gmt 1
+ } result] $result $errorCode
+} {1 {input string does not match supplied format} {CLOCK badInputString}}
+
+test clock-6.17 {spaces are always optional in non-strict mode (default)} {
+ list [clock scan "2009-06-30T18:30:00+02:00" -format "%Y-%m-%dT%H:%M:%S%z" -gmt 1] \
+ [clock scan "2009-06-30T18:30:00 +02:00" -format "%Y-%m-%dT%H:%M:%S%z" -gmt 1] \
+ [clock scan "2009-06-30T18:30:00Z" -format "%Y-%m-%dT%H:%M:%S%z" -timezone CET] \
+ [clock scan "2009-06-30T18:30:00 Z" -format "%Y-%m-%dT%H:%M:%S%z" -timezone CET]
+} {1246379400 1246379400 1246386600 1246386600}
+
+test clock-6.18 {zone token (%z) is optional} {
+ list [clock scan "2009-06-30T18:30:00 -01:00" -format "%Y-%m-%dT%H:%M:%S%z" -gmt 1] \
+ [clock scan "2009-06-30T18:30:00" -format "%Y-%m-%dT%H:%M:%S%z" -gmt 1] \
+ [clock scan " 2009-06-30T18:30:00 " -format "%Y-%m-%dT%H:%M:%S%z" -gmt 1] \
+} {1246390200 1246386600 1246386600}
+
+test clock-6.19 {no token parsing} {
+ list [catch { clock scan "%E%O%" -format "%E%O%" }] \
+ [catch { clock scan "...%..." -format "...%%..." }]
+} {0 0}
+
+test clock-6.20 {special char tokens %n, %t} {
+ clock scan "30\t06\t2009\n18\t30" -format "%d%t%m%t%Y%n%H%t%M" -gmt 1
+} 1246386600
+
+# Hi, Jeff!
+test clock-6.21.0 {Stardate 0 day} {
+ list [set d [clock format -757382400 -format "%Q" -gmt 1]] \
+ [clock scan $d -format "%Q" -gmt 1]
+} [list "Stardate 00000.0" -757382400]
+test clock-6.21.1 {Stardate} {
+ list [set d [clock format 1482857280 -format "%Q" -gmt 1]] \
+ [clock scan $d -format "%Q" -gmt 1]
+} [list "Stardate 70986.7" 1482857280]
+test clock-6.21.2 {Stardate next time} {
+ list [set d [clock format 1482865920 -format "%Q" -gmt 1]] \
+ [clock scan $d -format "%Q" -gmt 1]
+} [list "Stardate 70986.8" 1482865920]
+test clock-6.21.3 {Stardate correct scan over year (leap year, begin, middle and end of the year)} -body {
+ set s [clock scan "01.01.2016" -f "%d.%m.%Y" -g 1]
+ set s [set i [clock scan [clock format $s -f "%Q" -g 1] -g 1]]
+ set wrong {}
+ while {[incr i 86400] < $s + 86400*366*2} {
+ set d [clock format $i -f "%Q" -g 1]
+ set i2 [clock scan $d -f "%Q" -g 1]
+ if {$i != $i2} {
+ lappend wrong "$d -- ($i != $i2) -- [clock format $i -g 1]"
+ }
+ }
+ join $wrong \n
+} -result {} -cleanup {
+ unset -nocomplain wrong i i2 s d
+}
+
+test clock-6.22.1 {Greedy match} {
+ clock format [clock scan "111" -format "%d%m%y" -gmt 1] -locale en -gmt 1
+} {Mon Jan 01 00:00:00 GMT 2001}
+test clock-6.22.2 {Greedy match} {
+ clock format [clock scan "1111" -format "%d%m%y" -gmt 1] -locale en -gmt 1
+} {Thu Jan 11 00:00:00 GMT 2001}
+test clock-6.22.3 {Greedy match} {
+ clock format [clock scan "11111" -format "%d%m%y" -gmt 1] -locale en -gmt 1
+} {Sun Nov 11 00:00:00 GMT 2001}
+test clock-6.22.4 {Greedy match} {
+ clock format [clock scan "111111" -format "%d%m%y" -gmt 1] -locale en -gmt 1
+} {Fri Nov 11 00:00:00 GMT 2011}
+test clock-6.22.5 {Greedy match} {
+ clock format [clock scan "1 1 1" -format "%d%m%y" -gmt 1] -locale en -gmt 1
+} {Mon Jan 01 00:00:00 GMT 2001}
+test clock-6.22.6 {Greedy match} {
+ clock format [clock scan "111 1" -format "%d%m%y" -gmt 1] -locale en -gmt 1
+} {Thu Jan 11 00:00:00 GMT 2001}
+test clock-6.22.7 {Greedy match} {
+ clock format [clock scan "1 111" -format "%d%m%y" -gmt 1] -locale en -gmt 1
+} {Thu Nov 01 00:00:00 GMT 2001}
+test clock-6.22.8 {Greedy match} {
+ clock format [clock scan "1 11 1" -format "%d%m%y" -gmt 1] -locale en -gmt 1
+} {Thu Nov 01 00:00:00 GMT 2001}
+test clock-6.22.9 {Greedy match} {
+ clock format [clock scan "1 11 11" -format "%d%m%y" -gmt 1] -locale en -gmt 1
+} {Tue Nov 01 00:00:00 GMT 2011}
+test clock-6.22.10 {Greedy match} {
+ clock format [clock scan "11 11 11" -format "%d%m%y" -gmt 1] -locale en -gmt 1
+} {Fri Nov 11 00:00:00 GMT 2011}
+test clock-6.22.11 {Greedy match} {
+ clock format [clock scan "1111 120" -format "%y%m%d %H%M%S" -gmt 1] -locale en -gmt 1
+} {Sat Jan 01 01:02:00 GMT 2011}
+test clock-6.22.12 {Greedy match} {
+ clock format [clock scan "11 1 120" -format "%y%m%d %H%M%S" -gmt 1] -locale en -gmt 1
+} {Mon Jan 01 01:02:00 GMT 2001}
+test clock-6.22.13 {Greedy match} {
+ clock format [clock scan "1 11 120" -format "%y%m%d %H%M%S" -gmt 1] -locale en -gmt 1
+} {Mon Jan 01 01:02:00 GMT 2001}
+test clock-6.22.14 {Greedy match} {
+ clock format [clock scan "111120" -format "%y%m%d%H%M%S" -gmt 1] -locale en -gmt 1
+} {Mon Jan 01 01:02:00 GMT 2001}
+test clock-6.22.15 {Greedy match} {
+ clock format [clock scan "1111120" -format "%y%m%d%H%M%S" -gmt 1] -locale en -gmt 1
+} {Sat Jan 01 01:02:00 GMT 2011}
+test clock-6.22.16 {Greedy match} {
+ clock format [clock scan "11121120" -format "%y%m%d%H%M%S" -gmt 1] -locale en -gmt 1
+} {Thu Dec 01 01:02:00 GMT 2011}
+test clock-6.22.17 {Greedy match} {
+ clock format [clock scan "111213120" -format "%y%m%d%H%M%S" -gmt 1] -locale en -gmt 1
+} {Tue Dec 13 01:02:00 GMT 2011}
+test clock-6.22.17 {Greedy match (space wins as date-time separator)} {
+ clock format [clock scan "1112 13120" -format "%y%m%d %H%M%S" -gmt 1] -locale en -gmt 1
+} {Sun Jan 02 13:12:00 GMT 2011}
+test clock-6.22.18 {Greedy match (second space wins as date-time separator)} {
+ clock format [clock scan "1112 13 120" -format "%y%m%d %H%M%S" -gmt 1] -locale en -gmt 1
+} {Tue Dec 13 01:02:00 GMT 2011}
+test clock-6.22.19 {Greedy match (space wins as date-time separator)} {
+ clock format [clock scan "111 213120" -format "%y%m%d %H%M%S" -gmt 1] -locale en -gmt 1
+} {Mon Jan 01 21:31:20 GMT 2001}
+test clock-6.22.20 {Greedy match (second space wins as date-time separator)} {
+ clock format [clock scan "111 2 13120" -format "%y%m%d %H%M%S" -gmt 1] -locale en -gmt 1
+} {Sun Jan 02 13:12:00 GMT 2011}
+
+
test clock-7.1 {Julian Day} {
clock scan 0 -format %J -gmt true
} -210866803200
@@ -21070,78 +21221,78 @@ test clock-10.10 {julian day takes precedence over ccyyddd} {
# BEGIN testcases11
-# Test precedence among yyyymmdd and yyyyddd
+# Test precedence yyyymmdd over yyyyddd
-test clock-11.1 {precedence of ccyyddd and ccyymmdd} {
+test clock-11.1 {precedence of ccyymmdd over ccyyddd} {
clock scan 19700101002 -format %Y%m%d%j -gmt 1
-} 86400
-test clock-11.2 {precedence of ccyyddd and ccyymmdd} {
+} 0
+test clock-11.2 {precedence of ccyymmdd over ccyyddd} {
clock scan 01197001002 -format %m%Y%d%j -gmt 1
-} 86400
-test clock-11.3 {precedence of ccyyddd and ccyymmdd} {
+} 0
+test clock-11.3 {precedence of ccyymmdd over ccyyddd} {
clock scan 01197001002 -format %d%Y%m%j -gmt 1
-} 86400
-test clock-11.4 {precedence of ccyyddd and ccyymmdd} {
+} 0
+test clock-11.4 {precedence of ccyymmdd over ccyyddd} {
clock scan 00219700101 -format %j%Y%m%d -gmt 1
} 0
-test clock-11.5 {precedence of ccyyddd and ccyymmdd} {
+test clock-11.5 {precedence of ccyymmdd over ccyyddd} {
clock scan 19700100201 -format %Y%m%j%d -gmt 1
} 0
-test clock-11.6 {precedence of ccyyddd and ccyymmdd} {
+test clock-11.6 {precedence of ccyymmdd over ccyyddd} {
clock scan 01197000201 -format %m%Y%j%d -gmt 1
} 0
-test clock-11.7 {precedence of ccyyddd and ccyymmdd} {
+test clock-11.7 {precedence of ccyymmdd over ccyyddd} {
clock scan 01197000201 -format %d%Y%j%m -gmt 1
} 0
-test clock-11.8 {precedence of ccyyddd and ccyymmdd} {
+test clock-11.8 {precedence of ccyymmdd over ccyyddd} {
clock scan 00219700101 -format %j%Y%d%m -gmt 1
} 0
-test clock-11.9 {precedence of ccyyddd and ccyymmdd} {
+test clock-11.9 {precedence of ccyymmdd over ccyyddd} {
clock scan 19700101002 -format %Y%d%m%j -gmt 1
-} 86400
-test clock-11.10 {precedence of ccyyddd and ccyymmdd} {
+} 0
+test clock-11.10 {precedence of ccyymmdd over ccyyddd} {
clock scan 01011970002 -format %m%d%Y%j -gmt 1
-} 86400
-test clock-11.11 {precedence of ccyyddd and ccyymmdd} {
+} 0
+test clock-11.11 {precedence of ccyymmdd over ccyyddd} {
clock scan 01011970002 -format %d%m%Y%j -gmt 1
-} 86400
-test clock-11.12 {precedence of ccyyddd and ccyymmdd} {
+} 0
+test clock-11.12 {precedence of ccyymmdd over ccyyddd} {
clock scan 00201197001 -format %j%m%Y%d -gmt 1
} 0
-test clock-11.13 {precedence of ccyyddd and ccyymmdd} {
+test clock-11.13 {precedence of ccyymmdd over ccyyddd} {
clock scan 19700100201 -format %Y%d%j%m -gmt 1
} 0
-test clock-11.14 {precedence of ccyyddd and ccyymmdd} {
+test clock-11.14 {precedence of ccyymmdd over ccyyddd} {
clock scan 01010021970 -format %m%d%j%Y -gmt 1
-} 86400
-test clock-11.15 {precedence of ccyyddd and ccyymmdd} {
+} 0
+test clock-11.15 {precedence of ccyymmdd over ccyyddd} {
clock scan 01010021970 -format %d%m%j%Y -gmt 1
-} 86400
-test clock-11.16 {precedence of ccyyddd and ccyymmdd} {
+} 0
+test clock-11.16 {precedence of ccyymmdd over ccyyddd} {
clock scan 00201011970 -format %j%m%d%Y -gmt 1
} 0
-test clock-11.17 {precedence of ccyyddd and ccyymmdd} {
+test clock-11.17 {precedence of ccyymmdd over ccyyddd} {
clock scan 19700020101 -format %Y%j%m%d -gmt 1
} 0
-test clock-11.18 {precedence of ccyyddd and ccyymmdd} {
+test clock-11.18 {precedence of ccyymmdd over ccyyddd} {
clock scan 01002197001 -format %m%j%Y%d -gmt 1
} 0
-test clock-11.19 {precedence of ccyyddd and ccyymmdd} {
+test clock-11.19 {precedence of ccyymmdd over ccyyddd} {
clock scan 01002197001 -format %d%j%Y%m -gmt 1
} 0
-test clock-11.20 {precedence of ccyyddd and ccyymmdd} {
+test clock-11.20 {precedence of ccyymmdd over ccyyddd} {
clock scan 00201197001 -format %j%d%Y%m -gmt 1
} 0
-test clock-11.21 {precedence of ccyyddd and ccyymmdd} {
+test clock-11.21 {precedence of ccyymmdd over ccyyddd} {
clock scan 19700020101 -format %Y%j%d%m -gmt 1
} 0
-test clock-11.22 {precedence of ccyyddd and ccyymmdd} {
+test clock-11.22 {precedence of ccyymmdd over ccyyddd} {
clock scan 01002011970 -format %m%j%d%Y -gmt 1
} 0
-test clock-11.23 {precedence of ccyyddd and ccyymmdd} {
+test clock-11.23 {precedence of ccyymmdd over ccyyddd} {
clock scan 01002011970 -format %d%j%m%Y -gmt 1
} 0
-test clock-11.24 {precedence of ccyyddd and ccyymmdd} {
+test clock-11.24 {precedence of ccyymmdd over ccyyddd} {
clock scan 00201011970 -format %j%d%m%Y -gmt 1
} 0
# END testcases11
@@ -35607,7 +35758,7 @@ test clock-34.8 {clock scan tests} {
} {Oct 23,1992 15:00 GMT}
test clock-34.9 {clock scan tests} {
list [catch {clock scan "Jan 12" -bad arg} msg] $msg
-} {1 {bad option "-bad", must be -base, -format, -gmt, -locale or -timezone}}
+} {1 {bad option "-bad": must be -format, -gmt, -locale, -timezone, or -base}}
# The following two two tests test the two year date policy
test clock-34.10 {clock scan tests} {
set time [clock scan "1/1/71" -gmt true]
@@ -35617,7 +35768,15 @@ test clock-34.11 {clock scan tests} {
set time [clock scan "1/1/37" -gmt true]
clock format $time -format {%b %d,%Y %H:%M GMT} -gmt true
} {Jan 01,2037 00:00 GMT}
-
+test clock-34.11.1 {clock scan tests: same century switch} {
+ set times [clock scan "1/1/37" -gmt true]
+} [clock scan "1/1/37" -format "%m/%d/%y" -gmt true]
+test clock-34.11.2 {clock scan tests: same century switch} {
+ set times [clock scan "1/1/38" -gmt true]
+} [clock scan "1/1/38" -format "%m/%d/%y" -gmt true]
+test clock-34.11.3 {clock scan tests: same century switch} {
+ set times [clock scan "1/1/39" -gmt true]
+} [clock scan "1/1/39" -format "%m/%d/%y" -gmt true]
test clock-34.12 {clock scan, relative times} {
set time [clock scan "Oct 23, 1992 -1 day"]
clock format $time -format {%b %d, %Y}
@@ -35740,6 +35899,27 @@ test clock-34.40 {clock scan, next day of week} {
clock format [clock scan "next thursday" -base [clock scan 20000112]] \
-format {%b %d, %Y}
} "Jan 20, 2000"
+test clock-34.40.1 {clock scan, ordinal month after relative date} {
+ # This will fail without the bug fix (clock.tcl), as still missing
+ # month/julian day conversion before ordinal month increment
+ clock format [ \
+ clock scan "5 years 18 months 387 days" -base 0 -gmt 1
+ ] -format {%a, %b %d, %Y} -gmt 1 -locale en_US_roman
+} "Sat, Jul 23, 1977"
+test clock-34.40.2 {clock scan, ordinal month after relative date} {
+ # This will fail without the bug fix (clock.tcl), as still missing
+ # month/julian day conversion before ordinal month increment
+ clock format [ \
+ clock scan "5 years 18 months 387 days next Jan" -base 0 -gmt 1
+ ] -format {%a, %b %d, %Y} -gmt 1 -locale en_US_roman
+} "Mon, Jan 23, 1978"
+test clock-34.40.3 {clock scan, day of week after ordinal date} {
+ # This will fail without the bug fix (clock.tcl), because the relative
+ # week day should be applied after whole date conversion
+ clock format [ \
+ clock scan "5 years 18 months 387 days next January Fri" -base 0 -gmt 1
+ ] -format {%a, %b %d, %Y} -gmt 1 -locale en_US_roman
+} "Fri, Jan 27, 1978"
# weekday specification and base.
test clock-34.41 {2nd monday in november} {
@@ -35833,7 +36013,94 @@ test clock-34.52 {more than one ordinal month} {*}{
-result {unable to convert date-time string "next January next March": more than one ordinal month in string}
}
+test clock-34.53.1 {relative from base, date switch} {
+ set base [clock scan "12/31/2016 23:59:59" -gmt 1]
+ clock format [clock scan "+1 second" \
+ -base $base -gmt 1] -gmt 1 -format {%Y-%m-%d %H:%M:%S}
+} {2017-01-01 00:00:00}
+
+test clock-34.53.2 {relative time, daylight switch} {
+ set base [clock scan "03/27/2016" -timezone CET]
+ set res {}
+ lappend res [clock format [clock scan "+1 hour" \
+ -base $base -timezone CET] -timezone CET -format {%Y-%m-%d %H:%M:%S %Z}]
+ lappend res [clock format [clock scan "+2 hour" \
+ -base $base -timezone CET] -timezone CET -format {%Y-%m-%d %H:%M:%S %Z}]
+} {{2016-03-27 01:00:00 CET} {2016-03-27 03:00:00 CEST}}
+
+test clock-34.53.3 {relative time with day increment / daylight switch} {
+ set base [clock scan "03/27/2016" -timezone CET]
+ set res {}
+ lappend res [clock format [clock scan "+5 day +25 hour" \
+ -base [expr {$base - 6*24*60*60}] -timezone CET] -timezone CET -format {%Y-%m-%d %H:%M:%S %Z}]
+ lappend res [clock format [clock scan "+5 day +26 hour" \
+ -base [expr {$base - 6*24*60*60}] -timezone CET] -timezone CET -format {%Y-%m-%d %H:%M:%S %Z}]
+} {{2016-03-27 01:00:00 CET} {2016-03-27 03:00:00 CEST}}
+
+test clock-34.53.4 {relative time with month & day increment / daylight switch} {
+ set base [clock scan "03/27/2016" -timezone CET]
+ set res {}
+ lappend res [clock format [clock scan "next Mar +5 day +25 hour" \
+ -base [expr {$base - 35*24*60*60}] -timezone CET] -timezone CET -format {%Y-%m-%d %H:%M:%S %Z}]
+ lappend res [clock format [clock scan "next Mar +5 day +26 hour" \
+ -base [expr {$base - 35*24*60*60}] -timezone CET] -timezone CET -format {%Y-%m-%d %H:%M:%S %Z}]
+} {{2016-03-27 01:00:00 CET} {2016-03-27 03:00:00 CEST}}
+
+test clock-34.54.1 {check date in DST-hole: daylight switch CET -> CEST} {
+ set res {}
+ # forwards
+ set base 1459033200
+ for {set i 0} {$i <= 3} {incr i} {
+ set d [clock scan "+$i hour" -base $base -timezone CET]
+ lappend res "$d = [clock format $d -timezone CET -format {%Y-%m-%d %H:%M:%S %Z}]"
+ }
+ lappend res "#--"
+ # backwards
+ set base 1459044000
+ for {set i 0} {$i <= 3} {incr i} {
+ set d [clock scan "-$i hour" -base $base -timezone CET]
+ lappend res "$d = [clock format $d -timezone CET -format {%Y-%m-%d %H:%M:%S %Z}]"
+ }
+ set res
+} [split [regsub -all {^\n|\n$} {
+1459033200 = 2016-03-27 00:00:00 CET
+1459036800 = 2016-03-27 01:00:00 CET
+1459040400 = 2016-03-27 03:00:00 CEST
+1459044000 = 2016-03-27 04:00:00 CEST
+#--
+1459044000 = 2016-03-27 04:00:00 CEST
+1459040400 = 2016-03-27 03:00:00 CEST
+1459036800 = 2016-03-27 01:00:00 CET
+1459033200 = 2016-03-27 00:00:00 CET
+} {}] \n]
+test clock-34.54.2 {check date in DST-hole: daylight switch CEST -> CET} {
+ set res {}
+ # forwards
+ set base 1477782000
+ for {set i 0} {$i <= 3} {incr i} {
+ set d [clock scan "+$i hour" -base $base -timezone CET]
+ lappend res "$d = [clock format $d -timezone CET -format {%Y-%m-%d %H:%M:%S %Z}]"
+ }
+ lappend res "#--"
+ # backwards
+ set base 1477792800
+ for {set i 0} {$i <= 3} {incr i} {
+ set d [clock scan "-$i hour" -base $base -timezone CET]
+ lappend res "$d = [clock format $d -timezone CET -format {%Y-%m-%d %H:%M:%S %Z}]"
+ }
+ set res
+} [split [regsub -all {^\n|\n$} {
+1477782000 = 2016-10-30 01:00:00 CEST
+1477785600 = 2016-10-30 02:00:00 CEST
+1477789200 = 2016-10-30 02:00:00 CET
+1477792800 = 2016-10-30 03:00:00 CET
+#--
+1477792800 = 2016-10-30 03:00:00 CET
+1477789200 = 2016-10-30 02:00:00 CET
+1477785600 = 2016-10-30 02:00:00 CEST
+1477782000 = 2016-10-30 01:00:00 CEST
+} {}] \n]
# clock seconds
test clock-35.1 {clock seconds tests} {
@@ -35868,10 +36135,21 @@ test clock-37.1 {%s gmt testing} {
set s [clock seconds]
set a [clock format $s -format %s -gmt 0]
set b [clock format $s -format %s -gmt 1]
+ set c [clock scan $s -format %s -gmt 0]
+ set d [clock scan $s -format %s -gmt 1]
# %s, being the difference between local and Greenwich, does not
# depend on the time zone.
- set c [expr {$b-$a}]
-} {0}
+ list [expr {$b-$a}] [expr {$d-$c}]
+} {0 0}
+test clock-37.2 {%Es gmt testing} {
+ set s [clock seconds]
+ set a [clock format $s -format %Es -timezone CET]
+ set b [clock format $s -format %Es -gmt 1]
+ set c [clock scan $s -format %Es -timezone CET]
+ set d [clock scan $s -format %Es -gmt 1]
+ # %Es depend on the time zone (local seconds instead of posix seconds).
+ list [expr {$b-$a}] [expr {$d-$c}]
+} {-3600 3600}
test clock-38.1 {regression - convertUTCToLocalViaC - east of Greenwich} \
-setup {
diff --git a/tests/msgcat.test b/tests/msgcat.test
index 1c3ce58..584e420 100644
--- a/tests/msgcat.test
+++ b/tests/msgcat.test
@@ -811,7 +811,7 @@ namespace eval ::msgcat::test {
test msgcat-12.1 {mcpackagelocale no subcommand} -body {
mcpackagelocale
} -returnCodes 1\
- -result {wrong # args: should be "mcpackagelocale subcommand ?locale?"}
+ -result {wrong # args: should be "mcpackagelocale subcommand ?locale? ?ns?"}
test msgcat-12.2 {mclpackagelocale wrong subcommand} -body {
mcpackagelocale junk
diff --git a/unix/Makefile.in b/unix/Makefile.in
index fe9ca40..eda50de 100644
--- a/unix/Makefile.in
+++ b/unix/Makefile.in
@@ -292,7 +292,7 @@ XTTEST_OBJS = xtTestInit.o tclTest.o tclTestObj.o tclTestProcBodyObj.o \
GENERIC_OBJS = regcomp.o regexec.o regfree.o regerror.o tclAlloc.o \
tclAssembly.o tclAsync.o tclBasic.o tclBinary.o tclCkalloc.o \
- tclClock.o tclCmdAH.o tclCmdIL.o tclCmdMZ.o \
+ tclClock.o tclClockFmt.o tclCmdAH.o tclCmdIL.o tclCmdMZ.o \
tclCompCmds.o tclCompCmdsGR.o tclCompCmdsSZ.o tclCompExpr.o \
tclCompile.o tclConfig.o tclDate.o tclDictObj.o tclDisassemble.o \
tclEncoding.o tclEnsemble.o \
@@ -304,7 +304,7 @@ GENERIC_OBJS = regcomp.o regexec.o regfree.o regerror.o tclAlloc.o \
tclObj.o tclOptimize.o tclPanic.o tclParse.o tclPathObj.o tclPipe.o \
tclPkg.o tclPkgConfig.o tclPosixStr.o \
tclPreserve.o tclProc.o tclRegexp.o \
- tclResolve.o tclResult.o tclScan.o tclStringObj.o \
+ tclResolve.o tclResult.o tclScan.o tclStringObj.o tclStrIdxTree.o \
tclStrToD.o tclThread.o \
tclThreadAlloc.o tclThreadJoin.o tclThreadStorage.o tclStubInit.o \
tclTimer.o tclTrace.o tclUtf.o tclUtil.o tclVar.o tclZlib.o \
@@ -396,6 +396,7 @@ GENERIC_SRCS = \
$(GENERIC_DIR)/tclBinary.c \
$(GENERIC_DIR)/tclCkalloc.c \
$(GENERIC_DIR)/tclClock.c \
+ $(GENERIC_DIR)/tclClockFmt.c \
$(GENERIC_DIR)/tclCmdAH.c \
$(GENERIC_DIR)/tclCmdIL.c \
$(GENERIC_DIR)/tclCmdMZ.c \
@@ -450,6 +451,7 @@ GENERIC_SRCS = \
$(GENERIC_DIR)/tclScan.c \
$(GENERIC_DIR)/tclStubInit.c \
$(GENERIC_DIR)/tclStringObj.c \
+ $(GENERIC_DIR)/tclStrIdxTree.c \
$(GENERIC_DIR)/tclStrToD.c \
$(GENERIC_DIR)/tclTest.c \
$(GENERIC_DIR)/tclTestObj.c \
@@ -1072,6 +1074,9 @@ tclCkalloc.o: $(GENERIC_DIR)/tclCkalloc.c
tclClock.o: $(GENERIC_DIR)/tclClock.c
$(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tclClock.c
+tclClockFmt.o: $(GENERIC_DIR)/tclClockFmt.c
+ $(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tclClockFmt.c
+
tclCmdAH.o: $(GENERIC_DIR)/tclCmdAH.c
$(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tclCmdAH.c
@@ -1300,6 +1305,9 @@ tclScan.o: $(GENERIC_DIR)/tclScan.c
tclStringObj.o: $(GENERIC_DIR)/tclStringObj.c $(MATHHDRS)
$(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tclStringObj.c
+tclStrIdxTree.o: $(GENERIC_DIR)/tclStrIdxTree.c $(MATHHDRS)
+ $(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tclStrIdxTree.c
+
tclStrToD.o: $(GENERIC_DIR)/tclStrToD.c $(MATHHDRS)
$(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tclStrToD.c
diff --git a/win/Makefile.in b/win/Makefile.in
index 71df19a..5e7d613 100644
--- a/win/Makefile.in
+++ b/win/Makefile.in
@@ -228,6 +228,7 @@ GENERIC_OBJS = \
tclBinary.$(OBJEXT) \
tclCkalloc.$(OBJEXT) \
tclClock.$(OBJEXT) \
+ tclClockFmt.$(OBJEXT) \
tclCmdAH.$(OBJEXT) \
tclCmdIL.$(OBJEXT) \
tclCmdMZ.$(OBJEXT) \
@@ -290,6 +291,7 @@ GENERIC_OBJS = \
tclResult.$(OBJEXT) \
tclScan.$(OBJEXT) \
tclStringObj.$(OBJEXT) \
+ tclStrIdxTree.$(OBJEXT) \
tclStrToD.$(OBJEXT) \
tclStubInit.$(OBJEXT) \
tclThread.$(OBJEXT) \
diff --git a/win/makefile.vc b/win/makefile.vc
index ada08cc..555357e 100644
--- a/win/makefile.vc
+++ b/win/makefile.vc
@@ -1,1242 +1,1244 @@
-#-------------------------------------------------------------
-# makefile.vc --
-#
-# Microsoft Visual C++ makefile for use with nmake.exe v1.62+ (VC++ 5.0+)
-#
-# See the file "license.terms" for information on usage and redistribution
-# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
-#
-# Copyright (c) 1995-1996 Sun Microsystems, Inc.
-# Copyright (c) 1998-2000 Ajuba Solutions.
-# Copyright (c) 2001-2005 ActiveState Corporation.
-# Copyright (c) 2001-2004 David Gravereaux.
-# Copyright (c) 2003-2008 Pat Thoyts.
-#------------------------------------------------------------------------------
-
-# Check to see we are configured to build with MSVC (MSDEVDIR, MSVCDIR or
-# VCINSTALLDIR) or with the MS Platform SDK (MSSDK or WindowsSDKDir)
-!if !defined(MSDEVDIR) && !defined(MSVCDIR) && !defined(VCINSTALLDIR) && !defined(MSSDK) && !defined(WINDOWSSDKDIR)
-MSG = ^
-You need to run vcvars32.bat from Developer Studio or setenv.bat from the^
-Platform SDK first to setup the environment. Jump to this line to read^
-the build instructions.
-!error $(MSG)
-!endif
-
-#------------------------------------------------------------------------------
-# HOW TO USE this makefile:
-#
-# 1) It is now necessary to have MSVCDir, MSDevDir or MSSDK set in the
-# environment. This is used as a check to see if vcvars32.bat had been
-# run prior to running nmake or during the installation of Microsoft
-# Visual C++, MSVCDir had been set globally and the PATH adjusted.
-# Either way is valid.
-#
-# You'll need to run vcvars32.bat contained in the MsDev's vc(98)/bin
-# directory to setup the proper environment, if needed, for your
-# current setup. This is a needed bootstrap requirement and allows the
-# swapping of different environments to be easier.
-#
-# 2) To use the Platform SDK (not expressly needed), run setenv.bat after
-# vcvars32.bat according to the instructions for it. This can also
-# turn on the 64-bit compiler, if your SDK has it.
-#
-# 3) Targets are:
-# release -- Builds the core, the shell and the dlls. (default)
-# dlls -- Just builds the windows extensions
-# shell -- Just builds the shell and the core.
-# core -- Only builds the core [tclXX.(dll|lib)].
-# all -- Builds everything.
-# test -- Builds and runs the test suite.
-# tcltest -- Just builds the test shell.
-# install -- Installs the built binaries and libraries to $(INSTALLDIR)
-# as the root of the install tree.
-# tidy/clean/hose -- varying levels of cleaning.
-# genstubs -- Rebuilds the Stubs table and support files (dev only).
-# depend -- Generates an accurate set of source dependancies for this
-# makefile. Helpful to avoid problems when the sources are
-# refreshed and you rebuild, but can "overbuild" when common
-# headers like tclInt.h just get small changes.
-# htmlhelp -- Builds a Windows .chm help file for Tcl and Tk from the
-# troff manual pages found in $(ROOT)\doc. You need to
-# have installed the HTML Help Compiler package from Microsoft
-# to produce the .chm file.
-# winhelp -- (deprecated) Builds the windows .hlp file for Tcl from
-# the troff man files found in $(ROOT)\doc. This type of
-# help file is deprecated by Microsoft in favour of html
-# help files (.chm)
-#
-# 4) Macros usable on the commandline:
-# INSTALLDIR=<path>
-# Sets where to install Tcl from the built binaries.
-# C:\Progra~1\Tcl is assumed when not specified.
-#
-# OPTS=loimpact,msvcrt,nothreads,pdbs,profile,static,staticpkg,symbols,thrdalloc,tclalloc,unchecked,none
-# Sets special options for the core. The default is for none.
-# Any combination of the above may be used (comma separated).
-# 'none' will over-ride everything to nothing.
-#
-# loimpact = Adds a flag for how NT treats the heap to keep memory
-# in use, low. This is said to impact alloc performance.
-# msvcrt = Affects the static option only to switch it from
-# using libcmt(d) as the C runtime [by default] to
-# msvcrt(d). This is useful for static embedding
-# support.
-# nothreads= Turns off full multithreading support.
-# pdbs = Build detached symbols for release builds.
-# profile = Adds profiling hooks. Map file is assumed.
-# static = Builds a static library of the core instead of a
-# dll. The static library will contain the dde and reg
-# extensions. External applications who want to use
-# this, need to link with the stub library as well as
-# the static Tcl library.The shell will be static (and
-# large), as well.
-# staticpkg = Affects the static option only to switch
-# tclshXX.exe to have the dde and reg extension linked
-# inside it.
-# symbols = Debug build. Links to the debug C runtime, disables
-# optimizations and creates pdb symbols files.
-# thrdalloc = Use the thread allocator (shared global free pool)
-# This is the default on threaded builds.
-# tclalloc = Use the old non-thread allocator
-# unchecked= Allows a symbols build to not use the debug
-# enabled runtime (msvcrt.dll not msvcrtd.dll
-# or libcmt.lib not libcmtd.lib).
-#
-# STATS=compdbg,memdbg,none
-# Sets optional memory and bytecode compiler debugging code added
-# to the core. The default is for none. Any combination of the
-# above may be used (comma separated). 'none' will over-ride
-# everything to nothing.
-#
-# compdbg = Enables byte compilation logging.
-# memdbg = Enables the debugging memory allocator.
-#
-# CHECKS=64bit,fullwarn,nodep,none
-# Sets special macros for checking compatibility.
-#
-# 64bit = Enable 64bit portability warnings (if available)
-# fullwarn = Builds with full compiler and link warnings enabled.
-# Very verbose.
-# nodep = Turns off compatibility macros to ensure the core
-# isn't being built with deprecated functions.
-#
-# MACHINE=(ALPHA|AMD64|IA64|IX86)
-# Set the machine type used for the compiler, linker, and
-# resource compiler. This hook is needed to tell the tools
-# when alternate platforms are requested. IX86 is the default
-# when not specified. If the CPU environment variable has been
-# set (ie: recent Platform SDK) then MACHINE is set from CPU.
-#
-# TMP_DIR=<path>
-# OUT_DIR=<path>
-# Hooks to allow the intermediate and output directories to be
-# changed. $(OUT_DIR) is assumed to be
-# $(BINROOT)\(Release|Debug) based on if symbols are requested.
-# $(TMP_DIR) will de $(OUT_DIR)\<buildtype> by default.
-#
-# TESTPAT=<file>
-# Reads the tests requested to be run from this file.
-#
-# CFG_ENCODING=encoding
-# name of encoding for configuration information. Defaults
-# to cp1252
-#
-# 5) Examples:
-#
-# Basic syntax of calling nmake looks like this:
-# nmake [-nologo] -f makefile.vc [target|macrodef [target|macrodef] [...]]
-#
-# Standard (no frills)
-# c:\tcl_src\win\>c:\progra~1\micros~1\vc98\bin\vcvars32.bat
-# Setting environment for using Microsoft Visual C++ tools.
-# c:\tcl_src\win\>nmake -f makefile.vc release
-# c:\tcl_src\win\>nmake -f makefile.vc install INSTALLDIR=c:\progra~1\tcl
-#
-# Building for Win64
-# c:\tcl_src\win\>c:\progra~1\micros~1\vc98\bin\vcvars32.bat
-# Setting environment for using Microsoft Visual C++ tools.
-# c:\tcl_src\win\>c:\progra~1\platfo~1\setenv.bat /pre64 /RETAIL
-# Targeting Windows pre64 RETAIL
-# c:\tcl_src\win\>nmake -f makefile.vc MACHINE=IA64
-#
-#------------------------------------------------------------------------------
-#==============================================================================
-###############################################################################
-
-
-# //==================================================================\\
-# >>[ -> Do not modify below this line. <- ]<<
-# >>[ Please, use the commandline macros to modify how Tcl is built. ]<<
-# >>[ If you need more features, send us a patch for more macros. ]<<
-# \\==================================================================//
-
-
-###############################################################################
-#==============================================================================
-#------------------------------------------------------------------------------
-
-!if !exist("makefile.vc")
-MSG = ^
-You must run this makefile only from the directory it is in.^
-Please `cd` to its location first.
-!error $(MSG)
-!endif
-
-PROJECT = tcl
-!include "rules.vc"
-
-STUBPREFIX = $(PROJECT)stub
-DOTVERSION = $(TCL_MAJOR_VERSION).$(TCL_MINOR_VERSION)
-VERSION = $(TCL_MAJOR_VERSION)$(TCL_MINOR_VERSION)
-
-DDEDOTVERSION = 1.4
-DDEVERSION = $(DDEDOTVERSION:.=)
-
-REGDOTVERSION = 1.3
-REGVERSION = $(REGDOTVERSION:.=)
-
-BINROOT = $(MAKEDIR) # originally .
-ROOT = $(MAKEDIR)\.. # originally ..
-
-TCLIMPLIB = $(OUT_DIR)\$(PROJECT)$(VERSION)$(SUFX).lib
-TCLLIBNAME = $(PROJECT)$(VERSION)$(SUFX).$(EXT)
-TCLLIB = $(OUT_DIR)\$(TCLLIBNAME)
-
-TCLSTUBLIBNAME = $(STUBPREFIX)$(VERSION).lib
-TCLSTUBLIB = $(OUT_DIR)\$(TCLSTUBLIBNAME)
-
-TCLSHNAME = $(PROJECT)sh$(VERSION)$(SUFX).exe
-TCLSH = $(OUT_DIR)\$(TCLSHNAME)
-
-TCLREGLIBNAME = $(PROJECT)reg$(REGVERSION)$(SUFX:t=).$(EXT)
-TCLREGLIB = $(OUT_DIR)\$(TCLREGLIBNAME)
-
-TCLDDELIBNAME = $(PROJECT)dde$(DDEVERSION)$(SUFX:t=).$(EXT)
-TCLDDELIB = $(OUT_DIR)\$(TCLDDELIBNAME)
-
-TCLTEST = $(OUT_DIR)\$(PROJECT)test.exe
-CAT32 = $(OUT_DIR)\cat32.exe
-
-# Can we run what we build? IX86 runs on all architectures.
-!ifndef TCLSH_NATIVE
-!if "$(MACHINE)" == "IX86" || "$(MACHINE)" == "$(NATIVE_ARCH)"
-TCLSH_NATIVE = $(TCLSH)
-!else
-!error You must explicitly set TCLSH_NATIVE for cross-compilation
-!endif
-!endif
-
-### Make sure we use backslash only.
-LIB_INSTALL_DIR = $(_INSTALLDIR)\lib
-BIN_INSTALL_DIR = $(_INSTALLDIR)\bin
-DOC_INSTALL_DIR = $(_INSTALLDIR)\doc
-SCRIPT_INSTALL_DIR = $(_INSTALLDIR)\lib\tcl$(DOTVERSION)
-INCLUDE_INSTALL_DIR = $(_INSTALLDIR)\include
-
-TCLSHOBJS = \
- $(TMP_DIR)\tclAppInit.obj \
-!if !$(STATIC_BUILD)
-!if $(TCL_USE_STATIC_PACKAGES)
- $(TMP_DIR)\tclWinReg.obj \
- $(TMP_DIR)\tclWinDde.obj \
-!endif
-!endif
- $(TMP_DIR)\tclsh.res
-
-TCLTESTOBJS = \
- $(TMP_DIR)\tclTest.obj \
- $(TMP_DIR)\tclTestObj.obj \
- $(TMP_DIR)\tclTestProcBodyObj.obj \
- $(TMP_DIR)\tclThreadTest.obj \
- $(TMP_DIR)\tclWinTest.obj \
-!if !$(STATIC_BUILD)
-!if $(TCL_USE_STATIC_PACKAGES)
- $(TMP_DIR)\tclWinReg.obj \
- $(TMP_DIR)\tclWinDde.obj \
-!endif
-!endif
- $(TMP_DIR)\testMain.obj
-
-COREOBJS = \
- $(TMP_DIR)\regcomp.obj \
- $(TMP_DIR)\regerror.obj \
- $(TMP_DIR)\regexec.obj \
- $(TMP_DIR)\regfree.obj \
- $(TMP_DIR)\tclAlloc.obj \
- $(TMP_DIR)\tclAssembly.obj \
- $(TMP_DIR)\tclAsync.obj \
- $(TMP_DIR)\tclBasic.obj \
- $(TMP_DIR)\tclBinary.obj \
- $(TMP_DIR)\tclCkalloc.obj \
- $(TMP_DIR)\tclClock.obj \
- $(TMP_DIR)\tclCmdAH.obj \
- $(TMP_DIR)\tclCmdIL.obj \
- $(TMP_DIR)\tclCmdMZ.obj \
- $(TMP_DIR)\tclCompCmds.obj \
- $(TMP_DIR)\tclCompCmdsGR.obj \
- $(TMP_DIR)\tclCompCmdsSZ.obj \
- $(TMP_DIR)\tclCompExpr.obj \
- $(TMP_DIR)\tclCompile.obj \
- $(TMP_DIR)\tclConfig.obj \
- $(TMP_DIR)\tclDate.obj \
- $(TMP_DIR)\tclDictObj.obj \
- $(TMP_DIR)\tclDisassemble.obj \
- $(TMP_DIR)\tclEncoding.obj \
- $(TMP_DIR)\tclEnsemble.obj \
- $(TMP_DIR)\tclEnv.obj \
- $(TMP_DIR)\tclEvent.obj \
- $(TMP_DIR)\tclExecute.obj \
- $(TMP_DIR)\tclFCmd.obj \
- $(TMP_DIR)\tclFileName.obj \
- $(TMP_DIR)\tclGet.obj \
- $(TMP_DIR)\tclHash.obj \
- $(TMP_DIR)\tclHistory.obj \
- $(TMP_DIR)\tclIndexObj.obj \
- $(TMP_DIR)\tclInterp.obj \
- $(TMP_DIR)\tclIO.obj \
- $(TMP_DIR)\tclIOCmd.obj \
- $(TMP_DIR)\tclIOGT.obj \
- $(TMP_DIR)\tclIOSock.obj \
- $(TMP_DIR)\tclIOUtil.obj \
- $(TMP_DIR)\tclIORChan.obj \
- $(TMP_DIR)\tclIORTrans.obj \
- $(TMP_DIR)\tclLink.obj \
- $(TMP_DIR)\tclListObj.obj \
- $(TMP_DIR)\tclLiteral.obj \
- $(TMP_DIR)\tclLoad.obj \
- $(TMP_DIR)\tclMain.obj \
- $(TMP_DIR)\tclMain2.obj \
- $(TMP_DIR)\tclNamesp.obj \
- $(TMP_DIR)\tclNotify.obj \
- $(TMP_DIR)\tclOO.obj \
- $(TMP_DIR)\tclOOBasic.obj \
- $(TMP_DIR)\tclOOCall.obj \
- $(TMP_DIR)\tclOODefineCmds.obj \
- $(TMP_DIR)\tclOOInfo.obj \
- $(TMP_DIR)\tclOOMethod.obj \
- $(TMP_DIR)\tclOOStubInit.obj \
- $(TMP_DIR)\tclObj.obj \
- $(TMP_DIR)\tclOptimize.obj \
- $(TMP_DIR)\tclPanic.obj \
- $(TMP_DIR)\tclParse.obj \
- $(TMP_DIR)\tclPathObj.obj \
- $(TMP_DIR)\tclPipe.obj \
- $(TMP_DIR)\tclPkg.obj \
- $(TMP_DIR)\tclPkgConfig.obj \
- $(TMP_DIR)\tclPosixStr.obj \
- $(TMP_DIR)\tclPreserve.obj \
- $(TMP_DIR)\tclProc.obj \
- $(TMP_DIR)\tclRegexp.obj \
- $(TMP_DIR)\tclResolve.obj \
- $(TMP_DIR)\tclResult.obj \
- $(TMP_DIR)\tclScan.obj \
- $(TMP_DIR)\tclStringObj.obj \
- $(TMP_DIR)\tclStrToD.obj \
- $(TMP_DIR)\tclStubInit.obj \
- $(TMP_DIR)\tclThread.obj \
- $(TMP_DIR)\tclThreadAlloc.obj \
- $(TMP_DIR)\tclThreadJoin.obj \
- $(TMP_DIR)\tclThreadStorage.obj \
- $(TMP_DIR)\tclTimer.obj \
- $(TMP_DIR)\tclTomMathInterface.obj \
- $(TMP_DIR)\tclTrace.obj \
- $(TMP_DIR)\tclUtf.obj \
- $(TMP_DIR)\tclUtil.obj \
- $(TMP_DIR)\tclVar.obj \
- $(TMP_DIR)\tclZlib.obj
-
-ZLIBOBJS = \
- $(TMP_DIR)\adler32.obj \
- $(TMP_DIR)\compress.obj \
- $(TMP_DIR)\crc32.obj \
- $(TMP_DIR)\deflate.obj \
- $(TMP_DIR)\infback.obj \
- $(TMP_DIR)\inffast.obj \
- $(TMP_DIR)\inflate.obj \
- $(TMP_DIR)\inftrees.obj \
- $(TMP_DIR)\trees.obj \
- $(TMP_DIR)\uncompr.obj \
- $(TMP_DIR)\zutil.obj
-
-TOMMATHOBJS = \
- $(TMP_DIR)\bncore.obj \
- $(TMP_DIR)\bn_reverse.obj \
- $(TMP_DIR)\bn_fast_s_mp_mul_digs.obj \
- $(TMP_DIR)\bn_fast_s_mp_sqr.obj \
- $(TMP_DIR)\bn_mp_add.obj \
- $(TMP_DIR)\bn_mp_add_d.obj \
- $(TMP_DIR)\bn_mp_and.obj \
- $(TMP_DIR)\bn_mp_clamp.obj \
- $(TMP_DIR)\bn_mp_clear.obj \
- $(TMP_DIR)\bn_mp_clear_multi.obj \
- $(TMP_DIR)\bn_mp_cmp.obj \
- $(TMP_DIR)\bn_mp_cmp_d.obj \
- $(TMP_DIR)\bn_mp_cmp_mag.obj \
- $(TMP_DIR)\bn_mp_cnt_lsb.obj \
- $(TMP_DIR)\bn_mp_copy.obj \
- $(TMP_DIR)\bn_mp_count_bits.obj \
- $(TMP_DIR)\bn_mp_div.obj \
- $(TMP_DIR)\bn_mp_div_d.obj \
- $(TMP_DIR)\bn_mp_div_2.obj \
- $(TMP_DIR)\bn_mp_div_2d.obj \
- $(TMP_DIR)\bn_mp_div_3.obj \
- $(TMP_DIR)\bn_mp_exch.obj \
- $(TMP_DIR)\bn_mp_expt_d.obj \
- $(TMP_DIR)\bn_mp_grow.obj \
- $(TMP_DIR)\bn_mp_init.obj \
- $(TMP_DIR)\bn_mp_init_copy.obj \
- $(TMP_DIR)\bn_mp_init_multi.obj \
- $(TMP_DIR)\bn_mp_init_set.obj \
- $(TMP_DIR)\bn_mp_init_set_int.obj \
- $(TMP_DIR)\bn_mp_init_size.obj \
- $(TMP_DIR)\bn_mp_karatsuba_mul.obj \
- $(TMP_DIR)\bn_mp_karatsuba_sqr.obj \
- $(TMP_DIR)\bn_mp_lshd.obj \
- $(TMP_DIR)\bn_mp_mod.obj \
- $(TMP_DIR)\bn_mp_mod_2d.obj \
- $(TMP_DIR)\bn_mp_mul.obj \
- $(TMP_DIR)\bn_mp_mul_2.obj \
- $(TMP_DIR)\bn_mp_mul_2d.obj \
- $(TMP_DIR)\bn_mp_mul_d.obj \
- $(TMP_DIR)\bn_mp_neg.obj \
- $(TMP_DIR)\bn_mp_or.obj \
- $(TMP_DIR)\bn_mp_radix_size.obj \
- $(TMP_DIR)\bn_mp_radix_smap.obj \
- $(TMP_DIR)\bn_mp_read_radix.obj \
- $(TMP_DIR)\bn_mp_rshd.obj \
- $(TMP_DIR)\bn_mp_set.obj \
- $(TMP_DIR)\bn_mp_set_int.obj \
- $(TMP_DIR)\bn_mp_shrink.obj \
- $(TMP_DIR)\bn_mp_sqr.obj \
- $(TMP_DIR)\bn_mp_sqrt.obj \
- $(TMP_DIR)\bn_mp_sub.obj \
- $(TMP_DIR)\bn_mp_sub_d.obj \
- $(TMP_DIR)\bn_mp_to_unsigned_bin.obj \
- $(TMP_DIR)\bn_mp_to_unsigned_bin_n.obj \
- $(TMP_DIR)\bn_mp_toom_mul.obj \
- $(TMP_DIR)\bn_mp_toom_sqr.obj \
- $(TMP_DIR)\bn_mp_toradix_n.obj \
- $(TMP_DIR)\bn_mp_unsigned_bin_size.obj \
- $(TMP_DIR)\bn_mp_xor.obj \
- $(TMP_DIR)\bn_mp_zero.obj \
- $(TMP_DIR)\bn_s_mp_add.obj \
- $(TMP_DIR)\bn_s_mp_mul_digs.obj \
- $(TMP_DIR)\bn_s_mp_sqr.obj \
- $(TMP_DIR)\bn_s_mp_sub.obj
-
-PLATFORMOBJS = \
- $(TMP_DIR)\tclWin32Dll.obj \
- $(TMP_DIR)\tclWinChan.obj \
- $(TMP_DIR)\tclWinConsole.obj \
- $(TMP_DIR)\tclWinError.obj \
- $(TMP_DIR)\tclWinFCmd.obj \
- $(TMP_DIR)\tclWinFile.obj \
- $(TMP_DIR)\tclWinInit.obj \
- $(TMP_DIR)\tclWinLoad.obj \
- $(TMP_DIR)\tclWinNotify.obj \
- $(TMP_DIR)\tclWinPipe.obj \
- $(TMP_DIR)\tclWinSerial.obj \
- $(TMP_DIR)\tclWinSock.obj \
- $(TMP_DIR)\tclWinThrd.obj \
- $(TMP_DIR)\tclWinTime.obj \
-!if $(STATIC_BUILD)
- $(TMP_DIR)\tclWinReg.obj \
- $(TMP_DIR)\tclWinDde.obj \
-!else
- $(TMP_DIR)\tcl.res
-!endif
-
-TCLOBJS = $(COREOBJS) $(ZLIBOBJS) $(TOMMATHOBJS) $(PLATFORMOBJS)
-
-TCLSTUBOBJS = \
- $(TMP_DIR)\tclStubLib.obj \
- $(TMP_DIR)\tclTomMathStubLib.obj \
- $(TMP_DIR)\tclOOStubLib.obj
-
-### The following paths CANNOT have spaces in them.
-COMPATDIR = $(ROOT)\compat
-DOCDIR = $(ROOT)\doc
-GENERICDIR = $(ROOT)\generic
-TOMMATHDIR = $(ROOT)\libtommath
-TOOLSDIR = $(ROOT)\tools
-WINDIR = $(ROOT)\win
-PKGSDIR = $(ROOT)\pkgs
-
-#---------------------------------------------------------------------
-# Compile flags
-#---------------------------------------------------------------------
-
-!if !$(DEBUG)
-!if $(OPTIMIZING)
-### This cranks the optimization level to maximize speed
-cdebug = -O2 $(OPTIMIZATIONS)
-!else
-cdebug =
-!endif
-!if $(SYMBOLS)
-cdebug = $(cdebug) -Zi
-!endif
-!else if "$(MACHINE)" == "IA64" || "$(MACHINE)" == "AMD64"
-### Warnings are too many, can't support warnings into errors.
-cdebug = -Zi -Od $(DEBUGFLAGS)
-!else
-cdebug = -Zi -WX $(DEBUGFLAGS)
-!endif
-
-### Declarations common to all compiler options
-cwarn = $(WARNINGS) -D _CRT_SECURE_NO_DEPRECATE -D _CRT_NONSTDC_NO_DEPRECATE
-cflags = -nologo -c $(COMPILERFLAGS) $(cwarn) -Fp$(TMP_DIR)^\
-
-!if $(MSVCRT)
-!if $(DEBUG) && !$(UNCHECKED)
-crt = -MDd
-!else
-crt = -MD
-!endif
-!else
-!if $(DEBUG) && !$(UNCHECKED)
-crt = -MTd
-!else
-crt = -MT
-!endif
-!endif
-
-TCL_INCLUDES = -I"$(WINDIR)" -I"$(GENERICDIR)" -I"$(TOMMATHDIR)"
-TCL_DEFINES = -DTCL_TOMMATH -DMP_PREC=4 -Dinline=__inline -DHAVE_ZLIB=1
-BASE_CFLAGS = $(cflags) $(cdebug) $(crt) $(TCL_INCLUDES) $(TCL_DEFINES)
-CON_CFLAGS = $(cflags) $(cdebug) $(crt) -DCONSOLE
-TCL_CFLAGS = $(BASE_CFLAGS) $(OPTDEFINES)
-STUB_CFLAGS = $(cflags) $(cdebug) $(OPTDEFINES)
-
-
-#---------------------------------------------------------------------
-# Link flags
-#---------------------------------------------------------------------
-
-!if $(DEBUG)
-ldebug = -debug -debugtype:cv
-!else
-ldebug = -release -opt:ref -opt:icf,3
-!if $(SYMBOLS)
-ldebug = $(ldebug) -debug -debugtype:cv
-!endif
-!endif
-
-### Declarations common to all linker options
-lflags = -nologo -machine:$(MACHINE) $(LINKERFLAGS) $(ldebug)
-
-!if $(PROFILE)
-lflags = $(lflags) -profile
-!endif
-
-!if $(MSVCRT) && !($(DEBUG) && !$(UNCHECKED)) && $(VCVERSION) >= 1900
-lflags = $(lflags) -nodefaultlib:libucrt.lib
-!endif
-
-!if $(ALIGN98_HACK) && !$(STATIC_BUILD)
-### Align sections for PE size savings.
-lflags = $(lflags) -opt:nowin98
-!else if !$(ALIGN98_HACK) && $(STATIC_BUILD)
-### Align sections for speed in loading by choosing the virtual page size.
-lflags = $(lflags) -align:4096
-!endif
-
-!if $(LOIMPACT)
-lflags = $(lflags) -ws:aggressive
-!endif
-
-dlllflags = $(lflags) -dll
-conlflags = $(lflags) -subsystem:console
-guilflags = $(lflags) -subsystem:windows
-
-baselibs = netapi32.lib kernel32.lib user32.lib advapi32.lib userenv.lib ws2_32.lib
-# Avoid 'unresolved external symbol __security_cookie' errors.
-# c.f. http://support.microsoft.com/?id=894573
-!if "$(MACHINE)" == "IA64" || "$(MACHINE)" == "AMD64"
-!if $(VCVERSION) > 1399 && $(VCVERSION) < 1500
-baselibs = $(baselibs) bufferoverflowU.lib
-!endif
-!endif
-!if $(MSVCRT) && !($(DEBUG) && !$(UNCHECKED)) && $(VCVERSION) >= 1900
-baselibs = $(baselibs) ucrt.lib
-!endif
-
-#---------------------------------------------------------------------
-# TclTest flags
-#---------------------------------------------------------------------
-
-!if "$(TESTPAT)" != ""
-TESTFLAGS = $(TESTFLAGS) -file $(TESTPAT)
-!endif
-
-
-#---------------------------------------------------------------------
-# Project specific targets
-#---------------------------------------------------------------------
-
-release: setup $(TCLSH) $(TCLSTUBLIB) dlls pkgs
-core: setup $(TCLLIB) $(TCLSTUBLIB)
-shell: setup $(TCLSH)
-dlls: setup $(TCLREGLIB) $(TCLDDELIB)
-all: setup $(TCLSH) $(TCLSTUBLIB) dlls $(CAT32) pkgs
-tcltest: setup $(TCLTEST) dlls $(CAT32)
-install: install-binaries install-libraries install-docs install-pkgs
-
-test: test-core test-pkgs
-test-core: setup $(TCLTEST) dlls $(CAT32)
- set TCL_LIBRARY=$(ROOT:\=/)/library
-!if "$(OS)" == "Windows_NT" || "$(MSVCDIR)" == "IDE"
- $(DEBUGGER) $(TCLTEST) "$(ROOT:\=/)/tests/all.tcl" $(TESTFLAGS) -loadfile <<
- package ifneeded dde 1.4.0 [list load "$(TCLDDELIB:\=/)" dde]
- package ifneeded registry 1.3.2 [list load "$(TCLREGLIB:\=/)" registry]
-<<
-!else
- @echo Please wait while the tests are collected...
- $(TCLTEST) "$(ROOT:\=/)/tests/all.tcl" $(TESTFLAGS) -loadfile << > tests.log
- package ifneeded dde 1.4.0 "$(TCLDDELIB:\=/)" dde]
- package ifneeded registry 1.3.2 "$(TCLREGLIB:\=/)" registry]
-<<
- type tests.log | more
-!endif
-
-runtest: setup $(TCLTEST) dlls $(CAT32)
- set TCL_LIBRARY=$(ROOT:\=/)/library
- $(DEBUGGER) $(TCLTEST) $(SCRIPT)
-
-runshell: setup $(TCLSH) dlls
- set TCL_LIBRARY=$(ROOT:\=/)/library
- $(DEBUGGER) $(TCLSH) $(SCRIPT)
-
-setup:
- @if not exist $(OUT_DIR)\nul mkdir $(OUT_DIR)
- @if not exist $(TMP_DIR)\nul mkdir $(TMP_DIR)
-
-!if !$(STATIC_BUILD)
-$(TCLIMPLIB): $(TCLLIB)
-!endif
-
-$(TCLLIB): $(TCLOBJS)
-!if $(STATIC_BUILD)
- $(lib32) -nologo $(LINKERFLAGS) -out:$@ @<<
-$**
-<<
-!else
- $(link32) $(dlllflags) -base:@$(WINDIR)\coffbase.txt,tcl -out:$@ \
- $(baselibs) @<<
-$**
-<<
- $(_VC_MANIFEST_EMBED_DLL)
-!endif
-
-$(TCLSTUBLIB): $(TCLSTUBOBJS)
- $(lib32) -nologo $(LINKERFLAGS) -nodefaultlib -out:$@ $(TCLSTUBOBJS)
-
-$(TCLSH): $(TCLSHOBJS) $(TCLSTUBLIB) $(TCLIMPLIB)
- $(link32) $(conlflags) -stack:2300000 -out:$@ $(baselibs) $**
- $(_VC_MANIFEST_EMBED_EXE)
-
-$(TCLTEST): $(TCLTESTOBJS) $(TCLSTUBLIB) $(TCLIMPLIB)
- $(link32) $(conlflags) -stack:2300000 -out:$@ $(baselibs) $**
- $(_VC_MANIFEST_EMBED_EXE)
-
-!if $(STATIC_BUILD)
-$(TCLDDELIB): $(TMP_DIR)\tclWinDde.obj
- $(lib32) -nologo $(LINKERFLAGS) -out:$@ $**
-!else
-$(TCLDDELIB): $(TMP_DIR)\tclWinDde.obj $(TCLSTUBLIB)
- $(link32) $(dlllflags) -base:@$(WINDIR)\coffbase.txt,tcldde -out:$@ \
- $** $(baselibs)
- $(_VC_MANIFEST_EMBED_DLL)
-!endif
-
-!if $(STATIC_BUILD)
-$(TCLREGLIB): $(TMP_DIR)\tclWinReg.obj
- $(lib32) -nologo $(LINKERFLAGS) -out:$@ $**
-!else
-$(TCLREGLIB): $(TMP_DIR)\tclWinReg.obj $(TCLSTUBLIB)
- $(link32) $(dlllflags) -base:@$(WINDIR)\coffbase.txt,tclreg -out:$@ \
- $** $(baselibs)
- $(_VC_MANIFEST_EMBED_DLL)
-!endif
-
-pkgs:
- @for /d %d in ($(PKGSDIR)\*) do \
- @if exist "%~fd\win\makefile.vc" ( \
- pushd "%~fd\win" & \
- $(MAKE) -$(MAKEFLAGS) -f makefile.vc TCLDIR=$(ROOT) &\
- popd \
- )
-
-test-pkgs:
- @for /d %d in ($(PKGSDIR)\*) do \
- @if exist "%~fd\win\makefile.vc" ( \
- pushd "%~fd\win" & \
- $(MAKE) -$(MAKEFLAGS) -f makefile.vc TCLDIR=$(ROOT) test &\
- popd \
- )
-
-install-pkgs:
- @for /d %d in ($(PKGSDIR)\*) do \
- @if exist "%~fd\win\makefile.vc" ( \
- pushd "%~fd\win" & \
- $(MAKE) -$(MAKEFLAGS) -f makefile.vc TCLDIR=$(ROOT) install &\
- popd \
- )
-
-clean-pkgs:
- @for /d %d in ($(PKGSDIR)\*) do \
- @if exist "%~fd\win\makefile.vc" ( \
- pushd "%~fd\win" & \
- $(MAKE) -$(MAKEFLAGS) -f makefile.vc TCLDIR=$(ROOT) clean &\
- popd \
- )
-
-$(CAT32): $(WINDIR)\cat.c
- $(cc32) $(CON_CFLAGS) -Fo$(TMP_DIR)\ $?
- $(link32) $(conlflags) -out:$@ -stack:16384 $(TMP_DIR)\cat.obj \
- $(baselibs)
- $(_VC_MANIFEST_EMBED_EXE)
-
-#---------------------------------------------------------------------
-# Regenerate the stubs files. [Development use only]
-#---------------------------------------------------------------------
-
-genstubs:
-!if !exist($(TCLSH))
- @echo Build tclsh first!
-!else
- $(TCLSH) $(TOOLSDIR:\=/)/genStubs.tcl $(GENERICDIR:\=/) \
- $(GENERICDIR:\=/)/tcl.decls $(GENERICDIR:\=/)/tclInt.decls \
- $(GENERICDIR:\=/)/tclTomMath.decls
- $(TCLSH) $(TOOLSDIR:\=/)/genStubs.tcl $(GENERICDIR:\=/) \
- $(GENERICDIR:\=/)/tclOO.decls
-!endif
-
-
-#----------------------------------------------------------------------
-# The following target generates the file generic/tclTomMath.h.
-# It needs to be run (and the results checked) after updating
-# to a new release of libtommath.
-#----------------------------------------------------------------------
-
-gentommath_h:
-!if !exist($(TCLSH))
- @echo Build tclsh first!
-!else
- $(TCLSH) "$(TOOLSDIR:\=/)/fix_tommath_h.tcl" \
- "$(TOMMATHDIR:\=/)/tommath.h" \
- > "$(GENERICDIR)\tclTomMath.h"
-!endif
-
-#---------------------------------------------------------------------
-# Build the Windows HTML help file.
-#---------------------------------------------------------------------
-
-# NOTE: you can define HHC on the command-line to override this
-!ifndef HHC
-HHC=""%ProgramFiles%\HTML Help Workshop\hhc.exe""
-!endif
-HTMLDIR=$(OUT_DIR)\html
-HTMLBASE=TclTk$(VERSION)
-HHPFILE=$(HTMLDIR)\$(HTMLBASE).hhp
-CHMFILE=$(HTMLDIR)\$(HTMLBASE).chm
-
-htmlhelp: chmsetup $(CHMFILE)
-
-$(CHMFILE): $(DOCDIR)\*
- @$(TCLSH) $(TOOLSDIR)\tcltk-man2html.tcl "--htmldir=$(HTMLDIR)"
- @echo Compiling HTML help project
- -$(HHC) <<$(HHPFILE) >NUL
-[OPTIONS]
-Compatibility=1.1 or later
-Compiled file=$(HTMLBASE).chm
-Default topic=contents.htm
-Display compile progress=no
-Error log file=$(HTMLBASE).log
-Full-text search=Yes
-Language=0x409 English (United States)
-Title=Tcl/Tk $(DOT_VERSION) Help
-[FILES]
-contents.htm
-docs.css
-Keywords\*.htm
-TclCmd\*.htm
-TclLib\*.htm
-TkCmd\*.htm
-TkLib\*.htm
-UserCmd\*.htm
-<<
-
-chmsetup:
- @if not exist $(HTMLDIR)\nul mkdir $(HTMLDIR)
-
-#-------------------------------------------------------------------------
-# Build the old-style Windows .hlp file
-#-------------------------------------------------------------------------
-
-TCLHLPBASE = $(PROJECT)$(VERSION)
-HELPFILE = $(OUT_DIR)\$(TCLHLPBASE).hlp
-HELPCNT = $(OUT_DIR)\$(TCLHLPBASE).cnt
-DOCTMP_DIR = $(OUT_DIR)\$(PROJECT)_docs
-HELPRTF = $(DOCTMP_DIR)\$(PROJECT).rtf
-MAN2HELP = $(DOCTMP_DIR)\man2help.tcl
-MAN2HELP2 = $(DOCTMP_DIR)\man2help2.tcl
-INDEX = $(DOCTMP_DIR)\index.tcl
-BMP = $(DOCTMP_DIR)\feather.bmp
-BMP_NOPATH = feather.bmp
-MAN2TCL = $(DOCTMP_DIR)\man2tcl.exe
-
-winhelp: docsetup $(HELPFILE)
-
-docsetup:
- @if not exist $(DOCTMP_DIR)\nul mkdir $(DOCTMP_DIR)
-
-$(MAN2HELP) $(MAN2HELP2) $(INDEX) $(BMP): $(TOOLSDIR)\$$(@F)
- @$(CPY) $(TOOLSDIR)\$(@F) $(@D)
-
-$(HELPFILE): $(HELPRTF) $(BMP)
- cd $(DOCTMP_DIR)
- start /wait hcrtf.exe -x <<$(PROJECT).hpj
-[OPTIONS]
-COMPRESS=12 Hall Zeck
-LCID=0x409 0x0 0x0 ; English (United States)
-TITLE=Tcl/Tk Reference Manual
-BMROOT=.
-CNT=$(@B).cnt
-HLP=$(@B).hlp
-
-[FILES]
-$(PROJECT).rtf
-
-[WINDOWS]
-main="Tcl/Tk Reference Manual",,27648,(r15263976),(r65535)
-
-[CONFIG]
-BrowseButtons()
-CreateButton(1, "Web", ExecFile("http://www.tcl.tk"))
-CreateButton(2, "SF", ExecFile("http://sf.net/projects/tcl"))
-CreateButton(3, "Wiki", ExecFile("http://wiki.tcl.tk"))
-CreateButton(4, "FAQ", ExecFile("http://www.purl.org/NET/Tcl-FAQ/"))
-<<
- cd $(MAKEDIR)
- @$(CPY) "$(DOCTMP_DIR)\$(@B).hlp" "$(OUT_DIR)"
- @$(CPY) "$(DOCTMP_DIR)\$(@B).cnt" "$(OUT_DIR)"
-
-$(MAN2TCL): $(TOOLSDIR)\$$(@B).c
- $(cc32) $(TCL_CFLAGS) -Fo$(@D)\ $(TOOLSDIR)\$(@B).c
- $(link32) $(conlflags) -out:$@ -stack:16384 $(@D)\man2tcl.obj
- $(_VC_MANIFEST_EMBED_EXE)
-
-$(HELPRTF): $(MAN2TCL) $(MAN2HELP) $(MAN2HELP2) $(INDEX) $(DOCDIR)\*
- $(TCLSH) $(MAN2HELP) -bitmap $(BMP_NOPATH) $(PROJECT) $(VERSION) $(DOCDIR:\=/)
-
-install-docs:
-!if exist("$(CHMFILE)")
- @echo Installing compiled HTML help
- @$(CPY) "$(CHMFILE)" "$(DOC_INSTALL_DIR)\"
-!endif
-!if exist("$(HELPFILE)")
- @echo Installing Windows help
- @$(CPY) "$(HELPFILE)" "$(DOC_INSTALL_DIR)\"
- @$(CPY) "$(HELPCNT)" "$(DOC_INSTALL_DIR)\"
-!endif
-
-#---------------------------------------------------------------------
-# Build tclConfig.sh for the TEA build system.
-#---------------------------------------------------------------------
-
-tclConfig: $(OUT_DIR)\tclConfig.sh
-
-$(OUT_DIR)\tclConfig.sh: $(WINDIR)\tclConfig.sh.in
- @echo Creating tclConfig.sh
- @nmakehlp -s << $** >$@
-@TCL_DLL_FILE@ $(TCLLIBNAME)
-@TCL_VERSION@ $(DOTVERSION)
-@TCL_MAJOR_VERSION@ $(TCL_MAJOR_VERSION)
-@TCL_MINOR_VERSION@ $(TCL_MINOR_VERSION)
-@TCL_PATCH_LEVEL@ $(TCL_PATCH_LEVEL)
-@CC@ $(CC)
-@DEFS@ $(TCL_CFLAGS)
-@CFLAGS_DEBUG@ -nologo -c -W3 -YX -Fp$(TMP_DIR)\ -MDd
-@CFLAGS_OPTIMIZE@ -nologo -c -W3 -YX -Fp$(TMP_DIR)\ -MD
-@LDFLAGS_DEBUG@ -nologo -machine:$(MACHINE) -debug -debugtype:cv
-@LDFLAGS_OPTIMIZE@ -nologo -machine:$(MACHINE) -release -opt:ref -opt:icf,3
-@TCL_DBGX@ $(SUFX)
-@TCL_LIB_FILE@ $(PROJECT)$(VERSION)$(SUFX).lib
-@TCL_NEEDS_EXP_FILE@
-@LIBS@ $(baselibs)
-@prefix@ $(_INSTALLDIR)
-@exec_prefix@ $(BIN_INSTALL_DIR)
-@SHLIB_CFLAGS@
-@STLIB_CFLAGS@
-@CFLAGS_WARNING@ -W3
-@EXTRA_CFLAGS@ -YX
-@SHLIB_LD@ $(link32) $(dlllflags)
-@STLIB_LD@ $(lib32) -nologo
-@SHLIB_LD_LIBS@ $(baselibs)
-@SHLIB_SUFFIX@ .dll
-@DL_LIBS@
-@LDFLAGS@
-@TCL_CC_SEARCH_FLAGS@
-@TCL_LD_SEARCH_FLAGS@
-@LIBOBJS@
-@RANLIB@
-@TCL_LIB_FLAG@
-@TCL_BUILD_LIB_SPEC@
-@TCL_LIB_SPEC@ $(LIB_INSTALL_DIR)\$(PROJECT)$(VERSION)$(SUFX).lib
-@TCL_INCLUDE_SPEC@ -I$(INCLUDE_INSTALL_DIR)
-@TCL_LIB_VERSIONS_OK@
-@TCL_SRC_DIR@ $(ROOT)
-@TCL_PACKAGE_PATH@
-@TCL_STUB_LIB_FILE@ $(TCLSTUBLIBNAME)
-@TCL_STUB_LIB_FLAG@ $(TCLSTUBLIBNAME)
-@TCL_STUB_LIB_SPEC@ -L$(LIB_INSTALL_DIR) $(TCLSTUBLIBNAME)
-@TCL_THREADS@ $(TCL_THREADS)
-@TCL_BUILD_STUB_LIB_SPEC@ -L$(OUT_DIR) $(TCLSTUBLIBNAME)
-@TCL_BUILD_STUB_LIB_PATH@ $(TCLSTUBLIB)
-@TCL_STUB_LIB_PATH@ $(LIB_INSTALL_DIR)\$(TCLSTUBLIBNAME)
-@CFG_TCL_EXPORT_FILE_SUFFIX@ $(VERSION)$(SUFX).lib
-@CFG_TCL_SHARED_LIB_SUFFIX@ $(VERSION)$(SUFX).dll
-@CFG_TCL_UNSHARED_LIB_SUFFIX@ $(VERSION)$(SUFX).lib
-!if $(STATIC_BUILD)
-@TCL_SHARED_BUILD@ 0
-!else
-@TCL_SHARED_BUILD@ 1
-!endif
-<<
-
-
-#---------------------------------------------------------------------
-# The following target generates the file generic/tclDate.c
-# from the yacc grammar found in generic/tclGetDate.y. This is
-# only run by hand as yacc is not available in all environments.
-# The name of the .c file is different than the name of the .y file
-# so that make doesn't try to automatically regenerate the .c file.
-#---------------------------------------------------------------------
-
-gendate:
- bison --output-file=$(GENERICDIR)/tclDate.c \
- --name-prefix=TclDate \
- $(GENERICDIR)/tclGetDate.y
-
-#---------------------------------------------------------------------
-# Special case object file targets
-#---------------------------------------------------------------------
-
-$(TMP_DIR)\testMain.obj: $(WINDIR)\tclAppInit.c
- $(cc32) $(TCL_CFLAGS) -DTCL_TEST \
- -DTCL_USE_STATIC_PACKAGES=$(TCL_USE_STATIC_PACKAGES) \
- -Fo$@ $?
-
-$(TMP_DIR)\tclMain2.obj: $(GENERICDIR)\tclMain.c
- $(cc32) $(TCL_CFLAGS) -DBUILD_tcl -DTCL_ASCII_MAIN \
- -Fo$@ $?
-
-$(TMP_DIR)\tclTest.obj: $(GENERICDIR)\tclTest.c
- $(cc32) $(TCL_CFLAGS) -Fo$@ $?
-
-$(TMP_DIR)\tclTestObj.obj: $(GENERICDIR)\tclTestObj.c
- $(cc32) $(TCL_CFLAGS) -Fo$@ $?
-
-$(TMP_DIR)\tclWinTest.obj: $(WINDIR)\tclWinTest.c
- $(cc32) $(TCL_CFLAGS) -Fo$@ $?
-
-$(TMP_DIR)\tclZlib.obj: $(GENERICDIR)\tclZlib.c
- $(cc32) $(TCL_CFLAGS) -I$(COMPATDIR)\zlib -DBUILD_tcl -Fo$@ $?
-
-$(TMP_DIR)\tclPkgConfig.obj: $(GENERICDIR)\tclPkgConfig.c
- $(cc32) -DBUILD_tcl $(TCL_CFLAGS) \
- -DCFG_INSTALL_LIBDIR="\"$(LIB_INSTALL_DIR:\=\\)\"" \
- -DCFG_INSTALL_BINDIR="\"$(BIN_INSTALL_DIR:\=\\)\"" \
- -DCFG_INSTALL_SCRDIR="\"$(SCRIPT_INSTALL_DIR:\=\\)\"" \
- -DCFG_INSTALL_INCDIR="\"$(INCLUDE_INSTALL_DIR:\=\\)\"" \
- -DCFG_INSTALL_DOCDIR="\"$(DOC_INSTALL_DIR:\=\\)\"" \
- -DCFG_RUNTIME_LIBDIR="\"$(LIB_INSTALL_DIR:\=\\)\"" \
- -DCFG_RUNTIME_BINDIR="\"$(BIN_INSTALL_DIR:\=\\)\"" \
- -DCFG_RUNTIME_SCRDIR="\"$(SCRIPT_INSTALL_DIR:\=\\)\"" \
- -DCFG_RUNTIME_INCDIR="\"$(INCLUDE_INSTALL_DIR:\=\\)\"" \
- -DCFG_RUNTIME_DOCDIR="\"$(DOC_INSTALL_DIR:\=\\)\"" \
- -Fo$@ $?
-
-$(TMP_DIR)\tclAppInit.obj: $(WINDIR)\tclAppInit.c
- $(cc32) $(TCL_CFLAGS) \
- -DTCL_USE_STATIC_PACKAGES=$(TCL_USE_STATIC_PACKAGES) \
- -Fo$@ $?
-
-### The following objects should be built using the stub interfaces
-### *ALL* extensions need to built with -DTCL_THREADS=1
-
-$(TMP_DIR)\tclWinReg.obj: $(WINDIR)\tclWinReg.c
-!if $(STATIC_BUILD)
- $(cc32) $(TCL_CFLAGS) -DTCL_THREADS=1 -DSTATIC_BUILD -Fo$@ $?
-!else
- $(cc32) $(TCL_CFLAGS) -DTCL_THREADS=1 -DUSE_TCL_STUBS -Fo$@ $?
-!endif
-
-
-$(TMP_DIR)\tclWinDde.obj: $(WINDIR)\tclWinDde.c
-!if $(STATIC_BUILD)
- $(cc32) $(TCL_CFLAGS) -DTCL_THREADS=1 -DSTATIC_BUILD -Fo$@ $?
-!else
- $(cc32) $(TCL_CFLAGS) -DTCL_THREADS=1 -DUSE_TCL_STUBS -Fo$@ $?
-!endif
-
-
-### The following objects are part of the stub library and should not
-### be built as DLL objects. -Zl is used to avoid a dependency on any
-### specific C run-time.
-
-$(TMP_DIR)\tclStubLib.obj: $(GENERICDIR)\tclStubLib.c
- $(cc32) $(STUB_CFLAGS) -Zl -DSTATIC_BUILD $(TCL_INCLUDES) -Fo$@ $?
-
-$(TMP_DIR)\tclTomMathStubLib.obj: $(GENERICDIR)\tclTomMathStubLib.c
- $(cc32) $(STUB_CFLAGS) -Zl -DSTATIC_BUILD $(TCL_INCLUDES) -Fo$@ $?
-
-$(TMP_DIR)\tclOOStubLib.obj: $(GENERICDIR)\tclOOStubLib.c
- $(cc32) $(STUB_CFLAGS) -Zl -DSTATIC_BUILD $(TCL_INCLUDES) -Fo$@ $?
-
-$(TMP_DIR)\tclsh.exe.manifest: $(WINDIR)\tclsh.exe.manifest.in
- @nmakehlp -s << $** >$@
-@MACHINE@ $(MACHINE:IX86=X86)
-@TCL_WIN_VERSION@ $(DOTVERSION).0.0
-<<
-
-#---------------------------------------------------------------------
-# Generate the source dependencies. Having dependency rules will
-# improve incremental build accuracy without having to resort to a
-# full rebuild just because some non-global header file like
-# tclCompile.h was changed. These rules aren't needed when building
-# from scratch.
-#---------------------------------------------------------------------
-
-depend:
-!if !exist($(TCLSH))
- @echo Build tclsh first!
-!else
- $(TCLSH) $(TOOLSDIR:\=/)/mkdepend.tcl -vc32 -out:"$(OUT_DIR)\depend.mk" \
- -passthru:"-DBUILD_tcl $(TCL_INCLUDES)" $(GENERICDIR),$$(GENERICDIR) \
- $(COMPATDIR),$$(COMPATDIR) $(TOMMATHDIR),$$(TOMMATHDIR) $(WINDIR),$$(WINDIR) @<<
-$(TCLOBJS)
-<<
-!endif
-
-#---------------------------------------------------------------------
-# Dependency rules
-#---------------------------------------------------------------------
-
-!if exist("$(OUT_DIR)\depend.mk")
-!include "$(OUT_DIR)\depend.mk"
-!message *** Dependency rules in use.
-!else
-!message *** Dependency rules are not being used.
-!endif
-
-### add a spacer in the output
-!message
-
-
-#---------------------------------------------------------------------
-# Implicit rules. A limitation exists with nmake that requires that
-# source directory can not contain spaces in the path. This an
-# absolute.
-#---------------------------------------------------------------------
-
-{$(WINDIR)}.c{$(TMP_DIR)}.obj::
- $(cc32) $(TCL_CFLAGS) -DBUILD_tcl -Fo$(TMP_DIR)\ @<<
-$<
-<<
-
-{$(TOMMATHDIR)}.c{$(TMP_DIR)}.obj::
- $(cc32) $(TCL_CFLAGS) -DBUILD_tcl -Fo$(TMP_DIR)\ @<<
-$<
-<<
-
-{$(GENERICDIR)}.c{$(TMP_DIR)}.obj::
- $(cc32) $(TCL_CFLAGS) -DBUILD_tcl -Fo$(TMP_DIR)\ @<<
-$<
-<<
-
-{$(COMPATDIR)}.c{$(TMP_DIR)}.obj::
- $(cc32) $(TCL_CFLAGS) -DBUILD_tcl -Fo$(TMP_DIR)\ @<<
-$<
-<<
-
-{$(COMPATDIR)\zlib}.c{$(TMP_DIR)}.obj::
- $(cc32) $(TCL_CFLAGS) -DBUILD_tcl -Fo$(TMP_DIR)\ @<<
-$<
-<<
-
-{$(WINDIR)}.rc{$(TMP_DIR)}.res:
- $(rc32) -fo $@ -r -i "$(GENERICDIR)" -i "$(TMP_DIR)" \
- -d DEBUG=$(DEBUG) -d UNCHECKED=$(UNCHECKED) \
- -d TCL_THREADS=$(TCL_THREADS) \
- -d STATIC_BUILD=$(STATIC_BUILD) \
- $<
-
-$(TMP_DIR)\tclsh.res: $(TMP_DIR)\tclsh.exe.manifest
-
-.SUFFIXES:
-.SUFFIXES:.c .rc
-
-
-#---------------------------------------------------------------------
-# Installation.
-#---------------------------------------------------------------------
-
-install-binaries:
- @echo Installing to '$(_INSTALLDIR)'
- @echo Installing $(TCLLIBNAME)
-!if "$(TCLLIB)" != "$(TCLIMPLIB)"
- @$(CPY) "$(TCLLIB)" "$(BIN_INSTALL_DIR)\"
-!endif
- @$(CPY) "$(TCLIMPLIB)" "$(LIB_INSTALL_DIR)\"
-!if exist($(TCLSH))
- @echo Installing $(TCLSHNAME)
- @$(CPY) "$(TCLSH)" "$(BIN_INSTALL_DIR)\"
-!endif
- @echo Installing $(TCLSTUBLIBNAME)
- @$(CPY) "$(TCLSTUBLIB)" "$(LIB_INSTALL_DIR)\"
-
-#" emacs fix
-
-install-libraries: tclConfig install-msgs install-tzdata
- @if not exist "$(SCRIPT_INSTALL_DIR)$(NULL)" \
- $(MKDIR) "$(SCRIPT_INSTALL_DIR)"
- @if not exist "$(SCRIPT_INSTALL_DIR)\..\tcl8$(NULL)" \
- $(MKDIR) "$(SCRIPT_INSTALL_DIR)\..\tcl8"
- @if not exist "$(SCRIPT_INSTALL_DIR)\..\tcl8\8.4$(NULL)" \
- $(MKDIR) "$(SCRIPT_INSTALL_DIR)\..\tcl8\8.4"
- @if not exist "$(SCRIPT_INSTALL_DIR)\..\tcl8\8.4\platform$(NULL)" \
- $(MKDIR) "$(SCRIPT_INSTALL_DIR)\..\tcl8\8.4\platform"
- @if not exist "$(SCRIPT_INSTALL_DIR)\..\tcl8\8.5$(NULL)" \
- $(MKDIR) "$(SCRIPT_INSTALL_DIR)\..\tcl8\8.5"
- @if not exist "$(SCRIPT_INSTALL_DIR)\..\tcl8\8.6$(NULL)" \
- $(MKDIR) "$(SCRIPT_INSTALL_DIR)\..\tcl8\8.6"
- @echo Installing header files
- @$(CPY) "$(GENERICDIR)\tcl.h" "$(INCLUDE_INSTALL_DIR)\"
- @$(CPY) "$(GENERICDIR)\tclDecls.h" "$(INCLUDE_INSTALL_DIR)\"
- @$(CPY) "$(GENERICDIR)\tclOO.h" "$(INCLUDE_INSTALL_DIR)\"
- @$(CPY) "$(GENERICDIR)\tclOODecls.h" "$(INCLUDE_INSTALL_DIR)\"
- @$(CPY) "$(GENERICDIR)\tclPlatDecls.h" "$(INCLUDE_INSTALL_DIR)\"
- @$(CPY) "$(GENERICDIR)\tclTomMath.h" "$(INCLUDE_INSTALL_DIR)\"
- @$(CPY) "$(GENERICDIR)\tclTomMathDecls.h" "$(INCLUDE_INSTALL_DIR)\"
- @$(CPY) "$(TOMMATHDIR)\tommath_class.h" "$(INCLUDE_INSTALL_DIR)\"
- @$(CPY) "$(TOMMATHDIR)\tommath_superclass.h" "$(INCLUDE_INSTALL_DIR)\"
- @echo Installing library files to $(SCRIPT_INSTALL_DIR)
- @$(CPY) "$(ROOT)\library\history.tcl" "$(SCRIPT_INSTALL_DIR)\"
- @$(CPY) "$(ROOT)\library\init.tcl" "$(SCRIPT_INSTALL_DIR)\"
- @$(CPY) "$(ROOT)\library\clock.tcl" "$(SCRIPT_INSTALL_DIR)\"
- @$(CPY) "$(ROOT)\library\tm.tcl" "$(SCRIPT_INSTALL_DIR)\"
- @$(CPY) "$(ROOT)\library\parray.tcl" "$(SCRIPT_INSTALL_DIR)\"
- @$(CPY) "$(ROOT)\library\safe.tcl" "$(SCRIPT_INSTALL_DIR)\"
- @$(CPY) "$(ROOT)\library\tclIndex" "$(SCRIPT_INSTALL_DIR)\"
- @$(CPY) "$(ROOT)\library\package.tcl" "$(SCRIPT_INSTALL_DIR)\"
- @$(CPY) "$(ROOT)\library\word.tcl" "$(SCRIPT_INSTALL_DIR)\"
- @$(CPY) "$(ROOT)\library\auto.tcl" "$(SCRIPT_INSTALL_DIR)\"
- @$(CPY) "$(OUT_DIR)\tclConfig.sh" "$(LIB_INSTALL_DIR)\"
- @$(CPY) "$(WINDIR)\tclooConfig.sh" "$(LIB_INSTALL_DIR)\"
- @echo Installing library http1.0 directory
- @$(CPY) "$(ROOT)\library\http1.0\*.tcl" \
- "$(SCRIPT_INSTALL_DIR)\http1.0\"
- @echo Installing library opt0.4 directory
- @$(CPY) "$(ROOT)\library\opt\*.tcl" \
- "$(SCRIPT_INSTALL_DIR)\opt0.4\"
- @echo Installing package http $(PKG_HTTP_VER) as a Tcl Module
- @$(COPY) "$(ROOT)\library\http\http.tcl" \
- "$(SCRIPT_INSTALL_DIR)\..\tcl8\8.6\http-$(PKG_HTTP_VER).tm"
- @echo Installing package msgcat $(PKG_MSGCAT_VER) as a Tcl Module
- @$(COPY) "$(ROOT)\library\msgcat\msgcat.tcl" \
- "$(SCRIPT_INSTALL_DIR)\..\tcl8\8.5\msgcat-$(PKG_MSGCAT_VER).tm"
- @echo Installing package tcltest $(PKG_TCLTEST_VER) as a Tcl Module
- @$(COPY) "$(ROOT)\library\tcltest\tcltest.tcl" \
- "$(SCRIPT_INSTALL_DIR)\..\tcl8\8.5\tcltest-$(PKG_TCLTEST_VER).tm"
- @echo Installing package platform $(PKG_PLATFORM_VER) as a Tcl Module
- @$(COPY) "$(ROOT)\library\platform\platform.tcl" \
- "$(SCRIPT_INSTALL_DIR)\..\tcl8\8.4\platform-$(PKG_PLATFORM_VER).tm"
- @echo Installing package platform::shell $(PKG_SHELL_VER) as a Tcl Module
- @$(COPY) "$(ROOT)\library\platform\shell.tcl" \
- "$(SCRIPT_INSTALL_DIR)\..\tcl8\8.4\platform\shell-$(PKG_SHELL_VER).tm"
- @echo Installing $(TCLDDELIBNAME)
-!if $(STATIC_BUILD)
-!if !$(TCL_USE_STATIC_PACKAGES)
- @$(CPY) "$(TCLDDELIB)" "$(LIB_INSTALL_DIR)\"
-!endif
-!else
- @$(CPY) "$(TCLDDELIB)" "$(LIB_INSTALL_DIR)\dde$(DDEDOTVERSION)\"
- @$(CPY) "$(ROOT)\library\dde\pkgIndex.tcl" \
- "$(LIB_INSTALL_DIR)\dde$(DDEDOTVERSION)\"
-!endif
- @echo Installing $(TCLREGLIBNAME)
-!if $(STATIC_BUILD)
-!if !$(TCL_USE_STATIC_PACKAGES)
- @$(CPY) "$(TCLREGLIB)" "$(LIB_INSTALL_DIR)\"
-!endif
-!else
- @$(CPY) "$(TCLREGLIB)" "$(LIB_INSTALL_DIR)\reg$(REGDOTVERSION)\"
- @$(CPY) "$(ROOT)\library\reg\pkgIndex.tcl" \
- "$(LIB_INSTALL_DIR)\reg$(REGDOTVERSION)\"
-!endif
- @echo Installing encodings
- @$(CPY) "$(ROOT)\library\encoding\*.enc" \
- "$(SCRIPT_INSTALL_DIR)\encoding\"
-
-#" emacs fix
-
-install-tzdata:
- @echo Installing time zone data
- @set TCL_LIBRARY=$(ROOT:\=/)/library
- @$(TCLSH_NATIVE) "$(ROOT:\=/)/tools/installData.tcl" \
- "$(ROOT:\=/)/library/tzdata" "$(SCRIPT_INSTALL_DIR)/tzdata"
-
-install-msgs:
- @echo Installing message catalogs
- @set TCL_LIBRARY=$(ROOT:\=/)/library
- @$(TCLSH_NATIVE) "$(ROOT:\=/)/tools/installData.tcl" \
- "$(ROOT:\=/)/library/msgs" "$(SCRIPT_INSTALL_DIR)/msgs"
-
-#---------------------------------------------------------------------
-# Clean up
-#---------------------------------------------------------------------
-
-tidy:
-!if "$(TCLLIB)" != "$(TCLIMPLIB)"
- @echo Removing $(TCLLIB) ...
- @if exist $(TCLLIB) del $(TCLLIB)
-!endif
- @echo Removing $(TCLIMPLIB) ...
- @if exist $(TCLIMPLIB) del $(TCLIMPLIB)
- @echo Removing $(TCLSH) ...
- @if exist $(TCLSH) del $(TCLSH)
- @echo Removing $(TCLTEST) ...
- @if exist $(TCLTEST) del $(TCLTEST)
- @echo Removing $(TCLDDELIB) ...
- @if exist $(TCLDDELIB) del $(TCLDDELIB)
- @echo Removing $(TCLREGLIB) ...
- @if exist $(TCLREGLIB) del $(TCLREGLIB)
-
-clean: clean-pkgs
- @echo Cleaning $(TMP_DIR)\* ...
- @if exist $(TMP_DIR)\nul $(RMDIR) $(TMP_DIR)
- @echo Cleaning $(WINDIR)\nmakehlp.obj ...
- @if exist $(WINDIR)\nmakehlp.obj del $(WINDIR)\nmakehlp.obj
- @echo Cleaning $(WINDIR)\nmakehlp.exe ...
- @if exist $(WINDIR)\nmakehlp.exe del $(WINDIR)\nmakehlp.exe
- @echo Cleaning $(WINDIR)\_junk.pch ...
- @if exist $(WINDIR)\_junk.pch del $(WINDIR)\_junk.pch
- @echo Cleaning $(WINDIR)\vercl.x ...
- @if exist $(WINDIR)\vercl.x del $(WINDIR)\vercl.x
- @echo Cleaning $(WINDIR)\vercl.i ...
- @if exist $(WINDIR)\vercl.i del $(WINDIR)\vercl.i
- @echo Cleaning $(WINDIR)\versions.vc ...
- @if exist $(WINDIR)\versions.vc del $(WINDIR)\versions.vc
-
-realclean: hose
-
-hose:
- @echo Hosing $(OUT_DIR)\* ...
- @if exist $(OUT_DIR)\nul $(RMDIR) $(OUT_DIR)
-
-# Local Variables:
-# mode: makefile
-# End:
+#-------------------------------------------------------------
+# makefile.vc --
+#
+# Microsoft Visual C++ makefile for use with nmake.exe v1.62+ (VC++ 5.0+)
+#
+# See the file "license.terms" for information on usage and redistribution
+# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+#
+# Copyright (c) 1995-1996 Sun Microsystems, Inc.
+# Copyright (c) 1998-2000 Ajuba Solutions.
+# Copyright (c) 2001-2005 ActiveState Corporation.
+# Copyright (c) 2001-2004 David Gravereaux.
+# Copyright (c) 2003-2008 Pat Thoyts.
+#------------------------------------------------------------------------------
+
+# Check to see we are configured to build with MSVC (MSDEVDIR, MSVCDIR or
+# VCINSTALLDIR) or with the MS Platform SDK (MSSDK or WindowsSDKDir)
+!if !defined(MSDEVDIR) && !defined(MSVCDIR) && !defined(VCINSTALLDIR) && !defined(MSSDK) && !defined(WINDOWSSDKDIR)
+MSG = ^
+You need to run vcvars32.bat from Developer Studio or setenv.bat from the^
+Platform SDK first to setup the environment. Jump to this line to read^
+the build instructions.
+!error $(MSG)
+!endif
+
+#------------------------------------------------------------------------------
+# HOW TO USE this makefile:
+#
+# 1) It is now necessary to have MSVCDir, MSDevDir or MSSDK set in the
+# environment. This is used as a check to see if vcvars32.bat had been
+# run prior to running nmake or during the installation of Microsoft
+# Visual C++, MSVCDir had been set globally and the PATH adjusted.
+# Either way is valid.
+#
+# You'll need to run vcvars32.bat contained in the MsDev's vc(98)/bin
+# directory to setup the proper environment, if needed, for your
+# current setup. This is a needed bootstrap requirement and allows the
+# swapping of different environments to be easier.
+#
+# 2) To use the Platform SDK (not expressly needed), run setenv.bat after
+# vcvars32.bat according to the instructions for it. This can also
+# turn on the 64-bit compiler, if your SDK has it.
+#
+# 3) Targets are:
+# release -- Builds the core, the shell and the dlls. (default)
+# dlls -- Just builds the windows extensions
+# shell -- Just builds the shell and the core.
+# core -- Only builds the core [tclXX.(dll|lib)].
+# all -- Builds everything.
+# test -- Builds and runs the test suite.
+# tcltest -- Just builds the test shell.
+# install -- Installs the built binaries and libraries to $(INSTALLDIR)
+# as the root of the install tree.
+# tidy/clean/hose -- varying levels of cleaning.
+# genstubs -- Rebuilds the Stubs table and support files (dev only).
+# depend -- Generates an accurate set of source dependancies for this
+# makefile. Helpful to avoid problems when the sources are
+# refreshed and you rebuild, but can "overbuild" when common
+# headers like tclInt.h just get small changes.
+# htmlhelp -- Builds a Windows .chm help file for Tcl and Tk from the
+# troff manual pages found in $(ROOT)\doc. You need to
+# have installed the HTML Help Compiler package from Microsoft
+# to produce the .chm file.
+# winhelp -- (deprecated) Builds the windows .hlp file for Tcl from
+# the troff man files found in $(ROOT)\doc. This type of
+# help file is deprecated by Microsoft in favour of html
+# help files (.chm)
+#
+# 4) Macros usable on the commandline:
+# INSTALLDIR=<path>
+# Sets where to install Tcl from the built binaries.
+# C:\Progra~1\Tcl is assumed when not specified.
+#
+# OPTS=loimpact,msvcrt,nothreads,pdbs,profile,static,staticpkg,symbols,thrdalloc,tclalloc,unchecked,none
+# Sets special options for the core. The default is for none.
+# Any combination of the above may be used (comma separated).
+# 'none' will over-ride everything to nothing.
+#
+# loimpact = Adds a flag for how NT treats the heap to keep memory
+# in use, low. This is said to impact alloc performance.
+# msvcrt = Affects the static option only to switch it from
+# using libcmt(d) as the C runtime [by default] to
+# msvcrt(d). This is useful for static embedding
+# support.
+# nothreads= Turns off full multithreading support.
+# pdbs = Build detached symbols for release builds.
+# profile = Adds profiling hooks. Map file is assumed.
+# static = Builds a static library of the core instead of a
+# dll. The static library will contain the dde and reg
+# extensions. External applications who want to use
+# this, need to link with the stub library as well as
+# the static Tcl library.The shell will be static (and
+# large), as well.
+# staticpkg = Affects the static option only to switch
+# tclshXX.exe to have the dde and reg extension linked
+# inside it.
+# symbols = Debug build. Links to the debug C runtime, disables
+# optimizations and creates pdb symbols files.
+# thrdalloc = Use the thread allocator (shared global free pool)
+# This is the default on threaded builds.
+# tclalloc = Use the old non-thread allocator
+# unchecked= Allows a symbols build to not use the debug
+# enabled runtime (msvcrt.dll not msvcrtd.dll
+# or libcmt.lib not libcmtd.lib).
+#
+# STATS=compdbg,memdbg,none
+# Sets optional memory and bytecode compiler debugging code added
+# to the core. The default is for none. Any combination of the
+# above may be used (comma separated). 'none' will over-ride
+# everything to nothing.
+#
+# compdbg = Enables byte compilation logging.
+# memdbg = Enables the debugging memory allocator.
+#
+# CHECKS=64bit,fullwarn,nodep,none
+# Sets special macros for checking compatibility.
+#
+# 64bit = Enable 64bit portability warnings (if available)
+# fullwarn = Builds with full compiler and link warnings enabled.
+# Very verbose.
+# nodep = Turns off compatibility macros to ensure the core
+# isn't being built with deprecated functions.
+#
+# MACHINE=(ALPHA|AMD64|IA64|IX86)
+# Set the machine type used for the compiler, linker, and
+# resource compiler. This hook is needed to tell the tools
+# when alternate platforms are requested. IX86 is the default
+# when not specified. If the CPU environment variable has been
+# set (ie: recent Platform SDK) then MACHINE is set from CPU.
+#
+# TMP_DIR=<path>
+# OUT_DIR=<path>
+# Hooks to allow the intermediate and output directories to be
+# changed. $(OUT_DIR) is assumed to be
+# $(BINROOT)\(Release|Debug) based on if symbols are requested.
+# $(TMP_DIR) will de $(OUT_DIR)\<buildtype> by default.
+#
+# TESTPAT=<file>
+# Reads the tests requested to be run from this file.
+#
+# CFG_ENCODING=encoding
+# name of encoding for configuration information. Defaults
+# to cp1252
+#
+# 5) Examples:
+#
+# Basic syntax of calling nmake looks like this:
+# nmake [-nologo] -f makefile.vc [target|macrodef [target|macrodef] [...]]
+#
+# Standard (no frills)
+# c:\tcl_src\win\>c:\progra~1\micros~1\vc98\bin\vcvars32.bat
+# Setting environment for using Microsoft Visual C++ tools.
+# c:\tcl_src\win\>nmake -f makefile.vc release
+# c:\tcl_src\win\>nmake -f makefile.vc install INSTALLDIR=c:\progra~1\tcl
+#
+# Building for Win64
+# c:\tcl_src\win\>c:\progra~1\micros~1\vc98\bin\vcvars32.bat
+# Setting environment for using Microsoft Visual C++ tools.
+# c:\tcl_src\win\>c:\progra~1\platfo~1\setenv.bat /pre64 /RETAIL
+# Targeting Windows pre64 RETAIL
+# c:\tcl_src\win\>nmake -f makefile.vc MACHINE=IA64
+#
+#------------------------------------------------------------------------------
+#==============================================================================
+###############################################################################
+
+
+# //==================================================================\\
+# >>[ -> Do not modify below this line. <- ]<<
+# >>[ Please, use the commandline macros to modify how Tcl is built. ]<<
+# >>[ If you need more features, send us a patch for more macros. ]<<
+# \\==================================================================//
+
+
+###############################################################################
+#==============================================================================
+#------------------------------------------------------------------------------
+
+!if !exist("makefile.vc")
+MSG = ^
+You must run this makefile only from the directory it is in.^
+Please `cd` to its location first.
+!error $(MSG)
+!endif
+
+PROJECT = tcl
+!include "rules.vc"
+
+STUBPREFIX = $(PROJECT)stub
+DOTVERSION = $(TCL_MAJOR_VERSION).$(TCL_MINOR_VERSION)
+VERSION = $(TCL_MAJOR_VERSION)$(TCL_MINOR_VERSION)
+
+DDEDOTVERSION = 1.4
+DDEVERSION = $(DDEDOTVERSION:.=)
+
+REGDOTVERSION = 1.3
+REGVERSION = $(REGDOTVERSION:.=)
+
+BINROOT = $(MAKEDIR) # originally .
+ROOT = $(MAKEDIR)\.. # originally ..
+
+TCLIMPLIB = $(OUT_DIR)\$(PROJECT)$(VERSION)$(SUFX).lib
+TCLLIBNAME = $(PROJECT)$(VERSION)$(SUFX).$(EXT)
+TCLLIB = $(OUT_DIR)\$(TCLLIBNAME)
+
+TCLSTUBLIBNAME = $(STUBPREFIX)$(VERSION).lib
+TCLSTUBLIB = $(OUT_DIR)\$(TCLSTUBLIBNAME)
+
+TCLSHNAME = $(PROJECT)sh$(VERSION)$(SUFX).exe
+TCLSH = $(OUT_DIR)\$(TCLSHNAME)
+
+TCLREGLIBNAME = $(PROJECT)reg$(REGVERSION)$(SUFX:t=).$(EXT)
+TCLREGLIB = $(OUT_DIR)\$(TCLREGLIBNAME)
+
+TCLDDELIBNAME = $(PROJECT)dde$(DDEVERSION)$(SUFX:t=).$(EXT)
+TCLDDELIB = $(OUT_DIR)\$(TCLDDELIBNAME)
+
+TCLTEST = $(OUT_DIR)\$(PROJECT)test.exe
+CAT32 = $(OUT_DIR)\cat32.exe
+
+# Can we run what we build? IX86 runs on all architectures.
+!ifndef TCLSH_NATIVE
+!if "$(MACHINE)" == "IX86" || "$(MACHINE)" == "$(NATIVE_ARCH)"
+TCLSH_NATIVE = $(TCLSH)
+!else
+!error You must explicitly set TCLSH_NATIVE for cross-compilation
+!endif
+!endif
+
+### Make sure we use backslash only.
+LIB_INSTALL_DIR = $(_INSTALLDIR)\lib
+BIN_INSTALL_DIR = $(_INSTALLDIR)\bin
+DOC_INSTALL_DIR = $(_INSTALLDIR)\doc
+SCRIPT_INSTALL_DIR = $(_INSTALLDIR)\lib\tcl$(DOTVERSION)
+INCLUDE_INSTALL_DIR = $(_INSTALLDIR)\include
+
+TCLSHOBJS = \
+ $(TMP_DIR)\tclAppInit.obj \
+!if !$(STATIC_BUILD)
+!if $(TCL_USE_STATIC_PACKAGES)
+ $(TMP_DIR)\tclWinReg.obj \
+ $(TMP_DIR)\tclWinDde.obj \
+!endif
+!endif
+ $(TMP_DIR)\tclsh.res
+
+TCLTESTOBJS = \
+ $(TMP_DIR)\tclTest.obj \
+ $(TMP_DIR)\tclTestObj.obj \
+ $(TMP_DIR)\tclTestProcBodyObj.obj \
+ $(TMP_DIR)\tclThreadTest.obj \
+ $(TMP_DIR)\tclWinTest.obj \
+!if !$(STATIC_BUILD)
+!if $(TCL_USE_STATIC_PACKAGES)
+ $(TMP_DIR)\tclWinReg.obj \
+ $(TMP_DIR)\tclWinDde.obj \
+!endif
+!endif
+ $(TMP_DIR)\testMain.obj
+
+COREOBJS = \
+ $(TMP_DIR)\regcomp.obj \
+ $(TMP_DIR)\regerror.obj \
+ $(TMP_DIR)\regexec.obj \
+ $(TMP_DIR)\regfree.obj \
+ $(TMP_DIR)\tclAlloc.obj \
+ $(TMP_DIR)\tclAssembly.obj \
+ $(TMP_DIR)\tclAsync.obj \
+ $(TMP_DIR)\tclBasic.obj \
+ $(TMP_DIR)\tclBinary.obj \
+ $(TMP_DIR)\tclCkalloc.obj \
+ $(TMP_DIR)\tclClock.obj \
+ $(TMP_DIR)\tclClockFmt.obj \
+ $(TMP_DIR)\tclCmdAH.obj \
+ $(TMP_DIR)\tclCmdIL.obj \
+ $(TMP_DIR)\tclCmdMZ.obj \
+ $(TMP_DIR)\tclCompCmds.obj \
+ $(TMP_DIR)\tclCompCmdsGR.obj \
+ $(TMP_DIR)\tclCompCmdsSZ.obj \
+ $(TMP_DIR)\tclCompExpr.obj \
+ $(TMP_DIR)\tclCompile.obj \
+ $(TMP_DIR)\tclConfig.obj \
+ $(TMP_DIR)\tclDate.obj \
+ $(TMP_DIR)\tclDictObj.obj \
+ $(TMP_DIR)\tclDisassemble.obj \
+ $(TMP_DIR)\tclEncoding.obj \
+ $(TMP_DIR)\tclEnsemble.obj \
+ $(TMP_DIR)\tclEnv.obj \
+ $(TMP_DIR)\tclEvent.obj \
+ $(TMP_DIR)\tclExecute.obj \
+ $(TMP_DIR)\tclFCmd.obj \
+ $(TMP_DIR)\tclFileName.obj \
+ $(TMP_DIR)\tclGet.obj \
+ $(TMP_DIR)\tclHash.obj \
+ $(TMP_DIR)\tclHistory.obj \
+ $(TMP_DIR)\tclIndexObj.obj \
+ $(TMP_DIR)\tclInterp.obj \
+ $(TMP_DIR)\tclIO.obj \
+ $(TMP_DIR)\tclIOCmd.obj \
+ $(TMP_DIR)\tclIOGT.obj \
+ $(TMP_DIR)\tclIOSock.obj \
+ $(TMP_DIR)\tclIOUtil.obj \
+ $(TMP_DIR)\tclIORChan.obj \
+ $(TMP_DIR)\tclIORTrans.obj \
+ $(TMP_DIR)\tclLink.obj \
+ $(TMP_DIR)\tclListObj.obj \
+ $(TMP_DIR)\tclLiteral.obj \
+ $(TMP_DIR)\tclLoad.obj \
+ $(TMP_DIR)\tclMain.obj \
+ $(TMP_DIR)\tclMain2.obj \
+ $(TMP_DIR)\tclNamesp.obj \
+ $(TMP_DIR)\tclNotify.obj \
+ $(TMP_DIR)\tclOO.obj \
+ $(TMP_DIR)\tclOOBasic.obj \
+ $(TMP_DIR)\tclOOCall.obj \
+ $(TMP_DIR)\tclOODefineCmds.obj \
+ $(TMP_DIR)\tclOOInfo.obj \
+ $(TMP_DIR)\tclOOMethod.obj \
+ $(TMP_DIR)\tclOOStubInit.obj \
+ $(TMP_DIR)\tclObj.obj \
+ $(TMP_DIR)\tclOptimize.obj \
+ $(TMP_DIR)\tclPanic.obj \
+ $(TMP_DIR)\tclParse.obj \
+ $(TMP_DIR)\tclPathObj.obj \
+ $(TMP_DIR)\tclPipe.obj \
+ $(TMP_DIR)\tclPkg.obj \
+ $(TMP_DIR)\tclPkgConfig.obj \
+ $(TMP_DIR)\tclPosixStr.obj \
+ $(TMP_DIR)\tclPreserve.obj \
+ $(TMP_DIR)\tclProc.obj \
+ $(TMP_DIR)\tclRegexp.obj \
+ $(TMP_DIR)\tclResolve.obj \
+ $(TMP_DIR)\tclResult.obj \
+ $(TMP_DIR)\tclScan.obj \
+ $(TMP_DIR)\tclStringObj.obj \
+ $(TMP_DIR)\tclStrIdxTree.obj \
+ $(TMP_DIR)\tclStrToD.obj \
+ $(TMP_DIR)\tclStubInit.obj \
+ $(TMP_DIR)\tclThread.obj \
+ $(TMP_DIR)\tclThreadAlloc.obj \
+ $(TMP_DIR)\tclThreadJoin.obj \
+ $(TMP_DIR)\tclThreadStorage.obj \
+ $(TMP_DIR)\tclTimer.obj \
+ $(TMP_DIR)\tclTomMathInterface.obj \
+ $(TMP_DIR)\tclTrace.obj \
+ $(TMP_DIR)\tclUtf.obj \
+ $(TMP_DIR)\tclUtil.obj \
+ $(TMP_DIR)\tclVar.obj \
+ $(TMP_DIR)\tclZlib.obj
+
+ZLIBOBJS = \
+ $(TMP_DIR)\adler32.obj \
+ $(TMP_DIR)\compress.obj \
+ $(TMP_DIR)\crc32.obj \
+ $(TMP_DIR)\deflate.obj \
+ $(TMP_DIR)\infback.obj \
+ $(TMP_DIR)\inffast.obj \
+ $(TMP_DIR)\inflate.obj \
+ $(TMP_DIR)\inftrees.obj \
+ $(TMP_DIR)\trees.obj \
+ $(TMP_DIR)\uncompr.obj \
+ $(TMP_DIR)\zutil.obj
+
+TOMMATHOBJS = \
+ $(TMP_DIR)\bncore.obj \
+ $(TMP_DIR)\bn_reverse.obj \
+ $(TMP_DIR)\bn_fast_s_mp_mul_digs.obj \
+ $(TMP_DIR)\bn_fast_s_mp_sqr.obj \
+ $(TMP_DIR)\bn_mp_add.obj \
+ $(TMP_DIR)\bn_mp_add_d.obj \
+ $(TMP_DIR)\bn_mp_and.obj \
+ $(TMP_DIR)\bn_mp_clamp.obj \
+ $(TMP_DIR)\bn_mp_clear.obj \
+ $(TMP_DIR)\bn_mp_clear_multi.obj \
+ $(TMP_DIR)\bn_mp_cmp.obj \
+ $(TMP_DIR)\bn_mp_cmp_d.obj \
+ $(TMP_DIR)\bn_mp_cmp_mag.obj \
+ $(TMP_DIR)\bn_mp_cnt_lsb.obj \
+ $(TMP_DIR)\bn_mp_copy.obj \
+ $(TMP_DIR)\bn_mp_count_bits.obj \
+ $(TMP_DIR)\bn_mp_div.obj \
+ $(TMP_DIR)\bn_mp_div_d.obj \
+ $(TMP_DIR)\bn_mp_div_2.obj \
+ $(TMP_DIR)\bn_mp_div_2d.obj \
+ $(TMP_DIR)\bn_mp_div_3.obj \
+ $(TMP_DIR)\bn_mp_exch.obj \
+ $(TMP_DIR)\bn_mp_expt_d.obj \
+ $(TMP_DIR)\bn_mp_grow.obj \
+ $(TMP_DIR)\bn_mp_init.obj \
+ $(TMP_DIR)\bn_mp_init_copy.obj \
+ $(TMP_DIR)\bn_mp_init_multi.obj \
+ $(TMP_DIR)\bn_mp_init_set.obj \
+ $(TMP_DIR)\bn_mp_init_set_int.obj \
+ $(TMP_DIR)\bn_mp_init_size.obj \
+ $(TMP_DIR)\bn_mp_karatsuba_mul.obj \
+ $(TMP_DIR)\bn_mp_karatsuba_sqr.obj \
+ $(TMP_DIR)\bn_mp_lshd.obj \
+ $(TMP_DIR)\bn_mp_mod.obj \
+ $(TMP_DIR)\bn_mp_mod_2d.obj \
+ $(TMP_DIR)\bn_mp_mul.obj \
+ $(TMP_DIR)\bn_mp_mul_2.obj \
+ $(TMP_DIR)\bn_mp_mul_2d.obj \
+ $(TMP_DIR)\bn_mp_mul_d.obj \
+ $(TMP_DIR)\bn_mp_neg.obj \
+ $(TMP_DIR)\bn_mp_or.obj \
+ $(TMP_DIR)\bn_mp_radix_size.obj \
+ $(TMP_DIR)\bn_mp_radix_smap.obj \
+ $(TMP_DIR)\bn_mp_read_radix.obj \
+ $(TMP_DIR)\bn_mp_rshd.obj \
+ $(TMP_DIR)\bn_mp_set.obj \
+ $(TMP_DIR)\bn_mp_set_int.obj \
+ $(TMP_DIR)\bn_mp_shrink.obj \
+ $(TMP_DIR)\bn_mp_sqr.obj \
+ $(TMP_DIR)\bn_mp_sqrt.obj \
+ $(TMP_DIR)\bn_mp_sub.obj \
+ $(TMP_DIR)\bn_mp_sub_d.obj \
+ $(TMP_DIR)\bn_mp_to_unsigned_bin.obj \
+ $(TMP_DIR)\bn_mp_to_unsigned_bin_n.obj \
+ $(TMP_DIR)\bn_mp_toom_mul.obj \
+ $(TMP_DIR)\bn_mp_toom_sqr.obj \
+ $(TMP_DIR)\bn_mp_toradix_n.obj \
+ $(TMP_DIR)\bn_mp_unsigned_bin_size.obj \
+ $(TMP_DIR)\bn_mp_xor.obj \
+ $(TMP_DIR)\bn_mp_zero.obj \
+ $(TMP_DIR)\bn_s_mp_add.obj \
+ $(TMP_DIR)\bn_s_mp_mul_digs.obj \
+ $(TMP_DIR)\bn_s_mp_sqr.obj \
+ $(TMP_DIR)\bn_s_mp_sub.obj
+
+PLATFORMOBJS = \
+ $(TMP_DIR)\tclWin32Dll.obj \
+ $(TMP_DIR)\tclWinChan.obj \
+ $(TMP_DIR)\tclWinConsole.obj \
+ $(TMP_DIR)\tclWinError.obj \
+ $(TMP_DIR)\tclWinFCmd.obj \
+ $(TMP_DIR)\tclWinFile.obj \
+ $(TMP_DIR)\tclWinInit.obj \
+ $(TMP_DIR)\tclWinLoad.obj \
+ $(TMP_DIR)\tclWinNotify.obj \
+ $(TMP_DIR)\tclWinPipe.obj \
+ $(TMP_DIR)\tclWinSerial.obj \
+ $(TMP_DIR)\tclWinSock.obj \
+ $(TMP_DIR)\tclWinThrd.obj \
+ $(TMP_DIR)\tclWinTime.obj \
+!if $(STATIC_BUILD)
+ $(TMP_DIR)\tclWinReg.obj \
+ $(TMP_DIR)\tclWinDde.obj \
+!else
+ $(TMP_DIR)\tcl.res
+!endif
+
+TCLOBJS = $(COREOBJS) $(ZLIBOBJS) $(TOMMATHOBJS) $(PLATFORMOBJS)
+
+TCLSTUBOBJS = \
+ $(TMP_DIR)\tclStubLib.obj \
+ $(TMP_DIR)\tclTomMathStubLib.obj \
+ $(TMP_DIR)\tclOOStubLib.obj
+
+### The following paths CANNOT have spaces in them.
+COMPATDIR = $(ROOT)\compat
+DOCDIR = $(ROOT)\doc
+GENERICDIR = $(ROOT)\generic
+TOMMATHDIR = $(ROOT)\libtommath
+TOOLSDIR = $(ROOT)\tools
+WINDIR = $(ROOT)\win
+PKGSDIR = $(ROOT)\pkgs
+
+#---------------------------------------------------------------------
+# Compile flags
+#---------------------------------------------------------------------
+
+!if !$(DEBUG)
+!if $(OPTIMIZING)
+### This cranks the optimization level to maximize speed
+cdebug = -O2 $(OPTIMIZATIONS)
+!else
+cdebug =
+!endif
+!if $(SYMBOLS)
+cdebug = $(cdebug) -Zi
+!endif
+!else if "$(MACHINE)" == "IA64" || "$(MACHINE)" == "AMD64"
+### Warnings are too many, can't support warnings into errors.
+cdebug = -Zi -Od $(DEBUGFLAGS)
+!else
+cdebug = -Zi -WX $(DEBUGFLAGS)
+!endif
+
+### Declarations common to all compiler options
+cwarn = $(WARNINGS) -D _CRT_SECURE_NO_DEPRECATE -D _CRT_NONSTDC_NO_DEPRECATE
+cflags = -nologo -c $(COMPILERFLAGS) $(cwarn) -Fp$(TMP_DIR)^\
+
+!if $(MSVCRT)
+!if $(DEBUG) && !$(UNCHECKED)
+crt = -MDd
+!else
+crt = -MD
+!endif
+!else
+!if $(DEBUG) && !$(UNCHECKED)
+crt = -MTd
+!else
+crt = -MT
+!endif
+!endif
+
+TCL_INCLUDES = -I"$(WINDIR)" -I"$(GENERICDIR)" -I"$(TOMMATHDIR)"
+TCL_DEFINES = -DTCL_TOMMATH -DMP_PREC=4 -Dinline=__inline -DHAVE_ZLIB=1
+BASE_CFLAGS = $(cflags) $(cdebug) $(crt) $(TCL_INCLUDES) $(TCL_DEFINES)
+CON_CFLAGS = $(cflags) $(cdebug) $(crt) -DCONSOLE
+TCL_CFLAGS = $(BASE_CFLAGS) $(OPTDEFINES)
+STUB_CFLAGS = $(cflags) $(cdebug) $(OPTDEFINES)
+
+
+#---------------------------------------------------------------------
+# Link flags
+#---------------------------------------------------------------------
+
+!if $(DEBUG)
+ldebug = -debug -debugtype:cv
+!else
+ldebug = -release -opt:ref -opt:icf,3
+!if $(SYMBOLS)
+ldebug = $(ldebug) -debug -debugtype:cv
+!endif
+!endif
+
+### Declarations common to all linker options
+lflags = -nologo -machine:$(MACHINE) $(LINKERFLAGS) $(ldebug)
+
+!if $(PROFILE)
+lflags = $(lflags) -profile
+!endif
+
+!if $(MSVCRT) && !($(DEBUG) && !$(UNCHECKED)) && $(VCVERSION) >= 1900
+lflags = $(lflags) -nodefaultlib:libucrt.lib
+!endif
+
+!if $(ALIGN98_HACK) && !$(STATIC_BUILD)
+### Align sections for PE size savings.
+lflags = $(lflags) -opt:nowin98
+!else if !$(ALIGN98_HACK) && $(STATIC_BUILD)
+### Align sections for speed in loading by choosing the virtual page size.
+lflags = $(lflags) -align:4096
+!endif
+
+!if $(LOIMPACT)
+lflags = $(lflags) -ws:aggressive
+!endif
+
+dlllflags = $(lflags) -dll
+conlflags = $(lflags) -subsystem:console
+guilflags = $(lflags) -subsystem:windows
+
+baselibs = netapi32.lib kernel32.lib user32.lib advapi32.lib userenv.lib ws2_32.lib
+# Avoid 'unresolved external symbol __security_cookie' errors.
+# c.f. http://support.microsoft.com/?id=894573
+!if "$(MACHINE)" == "IA64" || "$(MACHINE)" == "AMD64"
+!if $(VCVERSION) > 1399 && $(VCVERSION) < 1500
+baselibs = $(baselibs) bufferoverflowU.lib
+!endif
+!endif
+!if $(MSVCRT) && !($(DEBUG) && !$(UNCHECKED)) && $(VCVERSION) >= 1900
+baselibs = $(baselibs) ucrt.lib
+!endif
+
+#---------------------------------------------------------------------
+# TclTest flags
+#---------------------------------------------------------------------
+
+!if "$(TESTPAT)" != ""
+TESTFLAGS = $(TESTFLAGS) -file $(TESTPAT)
+!endif
+
+
+#---------------------------------------------------------------------
+# Project specific targets
+#---------------------------------------------------------------------
+
+release: setup $(TCLSH) $(TCLSTUBLIB) dlls pkgs
+core: setup $(TCLLIB) $(TCLSTUBLIB)
+shell: setup $(TCLSH)
+dlls: setup $(TCLREGLIB) $(TCLDDELIB)
+all: setup $(TCLSH) $(TCLSTUBLIB) dlls $(CAT32) pkgs
+tcltest: setup $(TCLTEST) dlls $(CAT32)
+install: install-binaries install-libraries install-docs install-pkgs
+
+test: test-core test-pkgs
+test-core: setup $(TCLTEST) dlls $(CAT32)
+ set TCL_LIBRARY=$(ROOT:\=/)/library
+!if "$(OS)" == "Windows_NT" || "$(MSVCDIR)" == "IDE"
+ $(DEBUGGER) $(TCLTEST) "$(ROOT:\=/)/tests/all.tcl" $(TESTFLAGS) -loadfile <<
+ package ifneeded dde 1.4.0 [list load "$(TCLDDELIB:\=/)" dde]
+ package ifneeded registry 1.3.2 [list load "$(TCLREGLIB:\=/)" registry]
+<<
+!else
+ @echo Please wait while the tests are collected...
+ $(TCLTEST) "$(ROOT:\=/)/tests/all.tcl" $(TESTFLAGS) -loadfile << > tests.log
+ package ifneeded dde 1.4.0 "$(TCLDDELIB:\=/)" dde]
+ package ifneeded registry 1.3.2 "$(TCLREGLIB:\=/)" registry]
+<<
+ type tests.log | more
+!endif
+
+runtest: setup $(TCLTEST) dlls $(CAT32)
+ set TCL_LIBRARY=$(ROOT:\=/)/library
+ $(DEBUGGER) $(TCLTEST) $(SCRIPT)
+
+runshell: setup $(TCLSH) dlls
+ set TCL_LIBRARY=$(ROOT:\=/)/library
+ $(DEBUGGER) $(TCLSH) $(SCRIPT)
+
+setup:
+ @if not exist $(OUT_DIR)\nul mkdir $(OUT_DIR)
+ @if not exist $(TMP_DIR)\nul mkdir $(TMP_DIR)
+
+!if !$(STATIC_BUILD)
+$(TCLIMPLIB): $(TCLLIB)
+!endif
+
+$(TCLLIB): $(TCLOBJS)
+!if $(STATIC_BUILD)
+ $(lib32) -nologo $(LINKERFLAGS) -out:$@ @<<
+$**
+<<
+!else
+ $(link32) $(dlllflags) -base:@$(WINDIR)\coffbase.txt,tcl -out:$@ \
+ $(baselibs) @<<
+$**
+<<
+ $(_VC_MANIFEST_EMBED_DLL)
+!endif
+
+$(TCLSTUBLIB): $(TCLSTUBOBJS)
+ $(lib32) -nologo $(LINKERFLAGS) -nodefaultlib -out:$@ $(TCLSTUBOBJS)
+
+$(TCLSH): $(TCLSHOBJS) $(TCLSTUBLIB) $(TCLIMPLIB)
+ $(link32) $(conlflags) -stack:2300000 -out:$@ $(baselibs) $**
+ $(_VC_MANIFEST_EMBED_EXE)
+
+$(TCLTEST): $(TCLTESTOBJS) $(TCLSTUBLIB) $(TCLIMPLIB)
+ $(link32) $(conlflags) -stack:2300000 -out:$@ $(baselibs) $**
+ $(_VC_MANIFEST_EMBED_EXE)
+
+!if $(STATIC_BUILD)
+$(TCLDDELIB): $(TMP_DIR)\tclWinDde.obj
+ $(lib32) -nologo $(LINKERFLAGS) -out:$@ $**
+!else
+$(TCLDDELIB): $(TMP_DIR)\tclWinDde.obj $(TCLSTUBLIB)
+ $(link32) $(dlllflags) -base:@$(WINDIR)\coffbase.txt,tcldde -out:$@ \
+ $** $(baselibs)
+ $(_VC_MANIFEST_EMBED_DLL)
+!endif
+
+!if $(STATIC_BUILD)
+$(TCLREGLIB): $(TMP_DIR)\tclWinReg.obj
+ $(lib32) -nologo $(LINKERFLAGS) -out:$@ $**
+!else
+$(TCLREGLIB): $(TMP_DIR)\tclWinReg.obj $(TCLSTUBLIB)
+ $(link32) $(dlllflags) -base:@$(WINDIR)\coffbase.txt,tclreg -out:$@ \
+ $** $(baselibs)
+ $(_VC_MANIFEST_EMBED_DLL)
+!endif
+
+pkgs:
+ @for /d %d in ($(PKGSDIR)\*) do \
+ @if exist "%~fd\win\makefile.vc" ( \
+ pushd "%~fd\win" & \
+ $(MAKE) -$(MAKEFLAGS) -f makefile.vc TCLDIR=$(ROOT) &\
+ popd \
+ )
+
+test-pkgs:
+ @for /d %d in ($(PKGSDIR)\*) do \
+ @if exist "%~fd\win\makefile.vc" ( \
+ pushd "%~fd\win" & \
+ $(MAKE) -$(MAKEFLAGS) -f makefile.vc TCLDIR=$(ROOT) test &\
+ popd \
+ )
+
+install-pkgs:
+ @for /d %d in ($(PKGSDIR)\*) do \
+ @if exist "%~fd\win\makefile.vc" ( \
+ pushd "%~fd\win" & \
+ $(MAKE) -$(MAKEFLAGS) -f makefile.vc TCLDIR=$(ROOT) install &\
+ popd \
+ )
+
+clean-pkgs:
+ @for /d %d in ($(PKGSDIR)\*) do \
+ @if exist "%~fd\win\makefile.vc" ( \
+ pushd "%~fd\win" & \
+ $(MAKE) -$(MAKEFLAGS) -f makefile.vc TCLDIR=$(ROOT) clean &\
+ popd \
+ )
+
+$(CAT32): $(WINDIR)\cat.c
+ $(cc32) $(CON_CFLAGS) -Fo$(TMP_DIR)\ $?
+ $(link32) $(conlflags) -out:$@ -stack:16384 $(TMP_DIR)\cat.obj \
+ $(baselibs)
+ $(_VC_MANIFEST_EMBED_EXE)
+
+#---------------------------------------------------------------------
+# Regenerate the stubs files. [Development use only]
+#---------------------------------------------------------------------
+
+genstubs:
+!if !exist($(TCLSH))
+ @echo Build tclsh first!
+!else
+ $(TCLSH) $(TOOLSDIR:\=/)/genStubs.tcl $(GENERICDIR:\=/) \
+ $(GENERICDIR:\=/)/tcl.decls $(GENERICDIR:\=/)/tclInt.decls \
+ $(GENERICDIR:\=/)/tclTomMath.decls
+ $(TCLSH) $(TOOLSDIR:\=/)/genStubs.tcl $(GENERICDIR:\=/) \
+ $(GENERICDIR:\=/)/tclOO.decls
+!endif
+
+
+#----------------------------------------------------------------------
+# The following target generates the file generic/tclTomMath.h.
+# It needs to be run (and the results checked) after updating
+# to a new release of libtommath.
+#----------------------------------------------------------------------
+
+gentommath_h:
+!if !exist($(TCLSH))
+ @echo Build tclsh first!
+!else
+ $(TCLSH) "$(TOOLSDIR:\=/)/fix_tommath_h.tcl" \
+ "$(TOMMATHDIR:\=/)/tommath.h" \
+ > "$(GENERICDIR)\tclTomMath.h"
+!endif
+
+#---------------------------------------------------------------------
+# Build the Windows HTML help file.
+#---------------------------------------------------------------------
+
+# NOTE: you can define HHC on the command-line to override this
+!ifndef HHC
+HHC=""%ProgramFiles%\HTML Help Workshop\hhc.exe""
+!endif
+HTMLDIR=$(OUT_DIR)\html
+HTMLBASE=TclTk$(VERSION)
+HHPFILE=$(HTMLDIR)\$(HTMLBASE).hhp
+CHMFILE=$(HTMLDIR)\$(HTMLBASE).chm
+
+htmlhelp: chmsetup $(CHMFILE)
+
+$(CHMFILE): $(DOCDIR)\*
+ @$(TCLSH) $(TOOLSDIR)\tcltk-man2html.tcl "--htmldir=$(HTMLDIR)"
+ @echo Compiling HTML help project
+ -$(HHC) <<$(HHPFILE) >NUL
+[OPTIONS]
+Compatibility=1.1 or later
+Compiled file=$(HTMLBASE).chm
+Default topic=contents.htm
+Display compile progress=no
+Error log file=$(HTMLBASE).log
+Full-text search=Yes
+Language=0x409 English (United States)
+Title=Tcl/Tk $(DOT_VERSION) Help
+[FILES]
+contents.htm
+docs.css
+Keywords\*.htm
+TclCmd\*.htm
+TclLib\*.htm
+TkCmd\*.htm
+TkLib\*.htm
+UserCmd\*.htm
+<<
+
+chmsetup:
+ @if not exist $(HTMLDIR)\nul mkdir $(HTMLDIR)
+
+#-------------------------------------------------------------------------
+# Build the old-style Windows .hlp file
+#-------------------------------------------------------------------------
+
+TCLHLPBASE = $(PROJECT)$(VERSION)
+HELPFILE = $(OUT_DIR)\$(TCLHLPBASE).hlp
+HELPCNT = $(OUT_DIR)\$(TCLHLPBASE).cnt
+DOCTMP_DIR = $(OUT_DIR)\$(PROJECT)_docs
+HELPRTF = $(DOCTMP_DIR)\$(PROJECT).rtf
+MAN2HELP = $(DOCTMP_DIR)\man2help.tcl
+MAN2HELP2 = $(DOCTMP_DIR)\man2help2.tcl
+INDEX = $(DOCTMP_DIR)\index.tcl
+BMP = $(DOCTMP_DIR)\feather.bmp
+BMP_NOPATH = feather.bmp
+MAN2TCL = $(DOCTMP_DIR)\man2tcl.exe
+
+winhelp: docsetup $(HELPFILE)
+
+docsetup:
+ @if not exist $(DOCTMP_DIR)\nul mkdir $(DOCTMP_DIR)
+
+$(MAN2HELP) $(MAN2HELP2) $(INDEX) $(BMP): $(TOOLSDIR)\$$(@F)
+ @$(CPY) $(TOOLSDIR)\$(@F) $(@D)
+
+$(HELPFILE): $(HELPRTF) $(BMP)
+ cd $(DOCTMP_DIR)
+ start /wait hcrtf.exe -x <<$(PROJECT).hpj
+[OPTIONS]
+COMPRESS=12 Hall Zeck
+LCID=0x409 0x0 0x0 ; English (United States)
+TITLE=Tcl/Tk Reference Manual
+BMROOT=.
+CNT=$(@B).cnt
+HLP=$(@B).hlp
+
+[FILES]
+$(PROJECT).rtf
+
+[WINDOWS]
+main="Tcl/Tk Reference Manual",,27648,(r15263976),(r65535)
+
+[CONFIG]
+BrowseButtons()
+CreateButton(1, "Web", ExecFile("http://www.tcl.tk"))
+CreateButton(2, "SF", ExecFile("http://sf.net/projects/tcl"))
+CreateButton(3, "Wiki", ExecFile("http://wiki.tcl.tk"))
+CreateButton(4, "FAQ", ExecFile("http://www.purl.org/NET/Tcl-FAQ/"))
+<<
+ cd $(MAKEDIR)
+ @$(CPY) "$(DOCTMP_DIR)\$(@B).hlp" "$(OUT_DIR)"
+ @$(CPY) "$(DOCTMP_DIR)\$(@B).cnt" "$(OUT_DIR)"
+
+$(MAN2TCL): $(TOOLSDIR)\$$(@B).c
+ $(cc32) $(TCL_CFLAGS) -Fo$(@D)\ $(TOOLSDIR)\$(@B).c
+ $(link32) $(conlflags) -out:$@ -stack:16384 $(@D)\man2tcl.obj
+ $(_VC_MANIFEST_EMBED_EXE)
+
+$(HELPRTF): $(MAN2TCL) $(MAN2HELP) $(MAN2HELP2) $(INDEX) $(DOCDIR)\*
+ $(TCLSH) $(MAN2HELP) -bitmap $(BMP_NOPATH) $(PROJECT) $(VERSION) $(DOCDIR:\=/)
+
+install-docs:
+!if exist("$(CHMFILE)")
+ @echo Installing compiled HTML help
+ @$(CPY) "$(CHMFILE)" "$(DOC_INSTALL_DIR)\"
+!endif
+!if exist("$(HELPFILE)")
+ @echo Installing Windows help
+ @$(CPY) "$(HELPFILE)" "$(DOC_INSTALL_DIR)\"
+ @$(CPY) "$(HELPCNT)" "$(DOC_INSTALL_DIR)\"
+!endif
+
+#---------------------------------------------------------------------
+# Build tclConfig.sh for the TEA build system.
+#---------------------------------------------------------------------
+
+tclConfig: $(OUT_DIR)\tclConfig.sh
+
+$(OUT_DIR)\tclConfig.sh: $(WINDIR)\tclConfig.sh.in
+ @echo Creating tclConfig.sh
+ @nmakehlp -s << $** >$@
+@TCL_DLL_FILE@ $(TCLLIBNAME)
+@TCL_VERSION@ $(DOTVERSION)
+@TCL_MAJOR_VERSION@ $(TCL_MAJOR_VERSION)
+@TCL_MINOR_VERSION@ $(TCL_MINOR_VERSION)
+@TCL_PATCH_LEVEL@ $(TCL_PATCH_LEVEL)
+@CC@ $(CC)
+@DEFS@ $(TCL_CFLAGS)
+@CFLAGS_DEBUG@ -nologo -c -W3 -YX -Fp$(TMP_DIR)\ -MDd
+@CFLAGS_OPTIMIZE@ -nologo -c -W3 -YX -Fp$(TMP_DIR)\ -MD
+@LDFLAGS_DEBUG@ -nologo -machine:$(MACHINE) -debug -debugtype:cv
+@LDFLAGS_OPTIMIZE@ -nologo -machine:$(MACHINE) -release -opt:ref -opt:icf,3
+@TCL_DBGX@ $(SUFX)
+@TCL_LIB_FILE@ $(PROJECT)$(VERSION)$(SUFX).lib
+@TCL_NEEDS_EXP_FILE@
+@LIBS@ $(baselibs)
+@prefix@ $(_INSTALLDIR)
+@exec_prefix@ $(BIN_INSTALL_DIR)
+@SHLIB_CFLAGS@
+@STLIB_CFLAGS@
+@CFLAGS_WARNING@ -W3
+@EXTRA_CFLAGS@ -YX
+@SHLIB_LD@ $(link32) $(dlllflags)
+@STLIB_LD@ $(lib32) -nologo
+@SHLIB_LD_LIBS@ $(baselibs)
+@SHLIB_SUFFIX@ .dll
+@DL_LIBS@
+@LDFLAGS@
+@TCL_CC_SEARCH_FLAGS@
+@TCL_LD_SEARCH_FLAGS@
+@LIBOBJS@
+@RANLIB@
+@TCL_LIB_FLAG@
+@TCL_BUILD_LIB_SPEC@
+@TCL_LIB_SPEC@ $(LIB_INSTALL_DIR)\$(PROJECT)$(VERSION)$(SUFX).lib
+@TCL_INCLUDE_SPEC@ -I$(INCLUDE_INSTALL_DIR)
+@TCL_LIB_VERSIONS_OK@
+@TCL_SRC_DIR@ $(ROOT)
+@TCL_PACKAGE_PATH@
+@TCL_STUB_LIB_FILE@ $(TCLSTUBLIBNAME)
+@TCL_STUB_LIB_FLAG@ $(TCLSTUBLIBNAME)
+@TCL_STUB_LIB_SPEC@ -L$(LIB_INSTALL_DIR) $(TCLSTUBLIBNAME)
+@TCL_THREADS@ $(TCL_THREADS)
+@TCL_BUILD_STUB_LIB_SPEC@ -L$(OUT_DIR) $(TCLSTUBLIBNAME)
+@TCL_BUILD_STUB_LIB_PATH@ $(TCLSTUBLIB)
+@TCL_STUB_LIB_PATH@ $(LIB_INSTALL_DIR)\$(TCLSTUBLIBNAME)
+@CFG_TCL_EXPORT_FILE_SUFFIX@ $(VERSION)$(SUFX).lib
+@CFG_TCL_SHARED_LIB_SUFFIX@ $(VERSION)$(SUFX).dll
+@CFG_TCL_UNSHARED_LIB_SUFFIX@ $(VERSION)$(SUFX).lib
+!if $(STATIC_BUILD)
+@TCL_SHARED_BUILD@ 0
+!else
+@TCL_SHARED_BUILD@ 1
+!endif
+<<
+
+
+#---------------------------------------------------------------------
+# The following target generates the file generic/tclDate.c
+# from the yacc grammar found in generic/tclGetDate.y. This is
+# only run by hand as yacc is not available in all environments.
+# The name of the .c file is different than the name of the .y file
+# so that make doesn't try to automatically regenerate the .c file.
+#---------------------------------------------------------------------
+
+gendate:
+ bison --output-file=$(GENERICDIR)/tclDate.c \
+ --name-prefix=TclDate \
+ $(GENERICDIR)/tclGetDate.y
+
+#---------------------------------------------------------------------
+# Special case object file targets
+#---------------------------------------------------------------------
+
+$(TMP_DIR)\testMain.obj: $(WINDIR)\tclAppInit.c
+ $(cc32) $(TCL_CFLAGS) -DTCL_TEST \
+ -DTCL_USE_STATIC_PACKAGES=$(TCL_USE_STATIC_PACKAGES) \
+ -Fo$@ $?
+
+$(TMP_DIR)\tclMain2.obj: $(GENERICDIR)\tclMain.c
+ $(cc32) $(TCL_CFLAGS) -DBUILD_tcl -DTCL_ASCII_MAIN \
+ -Fo$@ $?
+
+$(TMP_DIR)\tclTest.obj: $(GENERICDIR)\tclTest.c
+ $(cc32) $(TCL_CFLAGS) -Fo$@ $?
+
+$(TMP_DIR)\tclTestObj.obj: $(GENERICDIR)\tclTestObj.c
+ $(cc32) $(TCL_CFLAGS) -Fo$@ $?
+
+$(TMP_DIR)\tclWinTest.obj: $(WINDIR)\tclWinTest.c
+ $(cc32) $(TCL_CFLAGS) -Fo$@ $?
+
+$(TMP_DIR)\tclZlib.obj: $(GENERICDIR)\tclZlib.c
+ $(cc32) $(TCL_CFLAGS) -I$(COMPATDIR)\zlib -DBUILD_tcl -Fo$@ $?
+
+$(TMP_DIR)\tclPkgConfig.obj: $(GENERICDIR)\tclPkgConfig.c
+ $(cc32) -DBUILD_tcl $(TCL_CFLAGS) \
+ -DCFG_INSTALL_LIBDIR="\"$(LIB_INSTALL_DIR:\=\\)\"" \
+ -DCFG_INSTALL_BINDIR="\"$(BIN_INSTALL_DIR:\=\\)\"" \
+ -DCFG_INSTALL_SCRDIR="\"$(SCRIPT_INSTALL_DIR:\=\\)\"" \
+ -DCFG_INSTALL_INCDIR="\"$(INCLUDE_INSTALL_DIR:\=\\)\"" \
+ -DCFG_INSTALL_DOCDIR="\"$(DOC_INSTALL_DIR:\=\\)\"" \
+ -DCFG_RUNTIME_LIBDIR="\"$(LIB_INSTALL_DIR:\=\\)\"" \
+ -DCFG_RUNTIME_BINDIR="\"$(BIN_INSTALL_DIR:\=\\)\"" \
+ -DCFG_RUNTIME_SCRDIR="\"$(SCRIPT_INSTALL_DIR:\=\\)\"" \
+ -DCFG_RUNTIME_INCDIR="\"$(INCLUDE_INSTALL_DIR:\=\\)\"" \
+ -DCFG_RUNTIME_DOCDIR="\"$(DOC_INSTALL_DIR:\=\\)\"" \
+ -Fo$@ $?
+
+$(TMP_DIR)\tclAppInit.obj: $(WINDIR)\tclAppInit.c
+ $(cc32) $(TCL_CFLAGS) \
+ -DTCL_USE_STATIC_PACKAGES=$(TCL_USE_STATIC_PACKAGES) \
+ -Fo$@ $?
+
+### The following objects should be built using the stub interfaces
+### *ALL* extensions need to built with -DTCL_THREADS=1
+
+$(TMP_DIR)\tclWinReg.obj: $(WINDIR)\tclWinReg.c
+!if $(STATIC_BUILD)
+ $(cc32) $(TCL_CFLAGS) -DTCL_THREADS=1 -DSTATIC_BUILD -Fo$@ $?
+!else
+ $(cc32) $(TCL_CFLAGS) -DTCL_THREADS=1 -DUSE_TCL_STUBS -Fo$@ $?
+!endif
+
+
+$(TMP_DIR)\tclWinDde.obj: $(WINDIR)\tclWinDde.c
+!if $(STATIC_BUILD)
+ $(cc32) $(TCL_CFLAGS) -DTCL_THREADS=1 -DSTATIC_BUILD -Fo$@ $?
+!else
+ $(cc32) $(TCL_CFLAGS) -DTCL_THREADS=1 -DUSE_TCL_STUBS -Fo$@ $?
+!endif
+
+
+### The following objects are part of the stub library and should not
+### be built as DLL objects. -Zl is used to avoid a dependency on any
+### specific C run-time.
+
+$(TMP_DIR)\tclStubLib.obj: $(GENERICDIR)\tclStubLib.c
+ $(cc32) $(STUB_CFLAGS) -Zl -DSTATIC_BUILD $(TCL_INCLUDES) -Fo$@ $?
+
+$(TMP_DIR)\tclTomMathStubLib.obj: $(GENERICDIR)\tclTomMathStubLib.c
+ $(cc32) $(STUB_CFLAGS) -Zl -DSTATIC_BUILD $(TCL_INCLUDES) -Fo$@ $?
+
+$(TMP_DIR)\tclOOStubLib.obj: $(GENERICDIR)\tclOOStubLib.c
+ $(cc32) $(STUB_CFLAGS) -Zl -DSTATIC_BUILD $(TCL_INCLUDES) -Fo$@ $?
+
+$(TMP_DIR)\tclsh.exe.manifest: $(WINDIR)\tclsh.exe.manifest.in
+ @nmakehlp -s << $** >$@
+@MACHINE@ $(MACHINE:IX86=X86)
+@TCL_WIN_VERSION@ $(DOTVERSION).0.0
+<<
+
+#---------------------------------------------------------------------
+# Generate the source dependencies. Having dependency rules will
+# improve incremental build accuracy without having to resort to a
+# full rebuild just because some non-global header file like
+# tclCompile.h was changed. These rules aren't needed when building
+# from scratch.
+#---------------------------------------------------------------------
+
+depend:
+!if !exist($(TCLSH))
+ @echo Build tclsh first!
+!else
+ $(TCLSH) $(TOOLSDIR:\=/)/mkdepend.tcl -vc32 -out:"$(OUT_DIR)\depend.mk" \
+ -passthru:"-DBUILD_tcl $(TCL_INCLUDES)" $(GENERICDIR),$$(GENERICDIR) \
+ $(COMPATDIR),$$(COMPATDIR) $(TOMMATHDIR),$$(TOMMATHDIR) $(WINDIR),$$(WINDIR) @<<
+$(TCLOBJS)
+<<
+!endif
+
+#---------------------------------------------------------------------
+# Dependency rules
+#---------------------------------------------------------------------
+
+!if exist("$(OUT_DIR)\depend.mk")
+!include "$(OUT_DIR)\depend.mk"
+!message *** Dependency rules in use.
+!else
+!message *** Dependency rules are not being used.
+!endif
+
+### add a spacer in the output
+!message
+
+
+#---------------------------------------------------------------------
+# Implicit rules. A limitation exists with nmake that requires that
+# source directory can not contain spaces in the path. This an
+# absolute.
+#---------------------------------------------------------------------
+
+{$(WINDIR)}.c{$(TMP_DIR)}.obj::
+ $(cc32) $(TCL_CFLAGS) -DBUILD_tcl -Fo$(TMP_DIR)\ @<<
+$<
+<<
+
+{$(TOMMATHDIR)}.c{$(TMP_DIR)}.obj::
+ $(cc32) $(TCL_CFLAGS) -DBUILD_tcl -Fo$(TMP_DIR)\ @<<
+$<
+<<
+
+{$(GENERICDIR)}.c{$(TMP_DIR)}.obj::
+ $(cc32) $(TCL_CFLAGS) -DBUILD_tcl -Fo$(TMP_DIR)\ @<<
+$<
+<<
+
+{$(COMPATDIR)}.c{$(TMP_DIR)}.obj::
+ $(cc32) $(TCL_CFLAGS) -DBUILD_tcl -Fo$(TMP_DIR)\ @<<
+$<
+<<
+
+{$(COMPATDIR)\zlib}.c{$(TMP_DIR)}.obj::
+ $(cc32) $(TCL_CFLAGS) -DBUILD_tcl -Fo$(TMP_DIR)\ @<<
+$<
+<<
+
+{$(WINDIR)}.rc{$(TMP_DIR)}.res:
+ $(rc32) -fo $@ -r -i "$(GENERICDIR)" -i "$(TMP_DIR)" \
+ -d DEBUG=$(DEBUG) -d UNCHECKED=$(UNCHECKED) \
+ -d TCL_THREADS=$(TCL_THREADS) \
+ -d STATIC_BUILD=$(STATIC_BUILD) \
+ $<
+
+$(TMP_DIR)\tclsh.res: $(TMP_DIR)\tclsh.exe.manifest
+
+.SUFFIXES:
+.SUFFIXES:.c .rc
+
+
+#---------------------------------------------------------------------
+# Installation.
+#---------------------------------------------------------------------
+
+install-binaries:
+ @echo Installing to '$(_INSTALLDIR)'
+ @echo Installing $(TCLLIBNAME)
+!if "$(TCLLIB)" != "$(TCLIMPLIB)"
+ @$(CPY) "$(TCLLIB)" "$(BIN_INSTALL_DIR)\"
+!endif
+ @$(CPY) "$(TCLIMPLIB)" "$(LIB_INSTALL_DIR)\"
+!if exist($(TCLSH))
+ @echo Installing $(TCLSHNAME)
+ @$(CPY) "$(TCLSH)" "$(BIN_INSTALL_DIR)\"
+!endif
+ @echo Installing $(TCLSTUBLIBNAME)
+ @$(CPY) "$(TCLSTUBLIB)" "$(LIB_INSTALL_DIR)\"
+
+#" emacs fix
+
+install-libraries: tclConfig install-msgs install-tzdata
+ @if not exist "$(SCRIPT_INSTALL_DIR)$(NULL)" \
+ $(MKDIR) "$(SCRIPT_INSTALL_DIR)"
+ @if not exist "$(SCRIPT_INSTALL_DIR)\..\tcl8$(NULL)" \
+ $(MKDIR) "$(SCRIPT_INSTALL_DIR)\..\tcl8"
+ @if not exist "$(SCRIPT_INSTALL_DIR)\..\tcl8\8.4$(NULL)" \
+ $(MKDIR) "$(SCRIPT_INSTALL_DIR)\..\tcl8\8.4"
+ @if not exist "$(SCRIPT_INSTALL_DIR)\..\tcl8\8.4\platform$(NULL)" \
+ $(MKDIR) "$(SCRIPT_INSTALL_DIR)\..\tcl8\8.4\platform"
+ @if not exist "$(SCRIPT_INSTALL_DIR)\..\tcl8\8.5$(NULL)" \
+ $(MKDIR) "$(SCRIPT_INSTALL_DIR)\..\tcl8\8.5"
+ @if not exist "$(SCRIPT_INSTALL_DIR)\..\tcl8\8.6$(NULL)" \
+ $(MKDIR) "$(SCRIPT_INSTALL_DIR)\..\tcl8\8.6"
+ @echo Installing header files
+ @$(CPY) "$(GENERICDIR)\tcl.h" "$(INCLUDE_INSTALL_DIR)\"
+ @$(CPY) "$(GENERICDIR)\tclDecls.h" "$(INCLUDE_INSTALL_DIR)\"
+ @$(CPY) "$(GENERICDIR)\tclOO.h" "$(INCLUDE_INSTALL_DIR)\"
+ @$(CPY) "$(GENERICDIR)\tclOODecls.h" "$(INCLUDE_INSTALL_DIR)\"
+ @$(CPY) "$(GENERICDIR)\tclPlatDecls.h" "$(INCLUDE_INSTALL_DIR)\"
+ @$(CPY) "$(GENERICDIR)\tclTomMath.h" "$(INCLUDE_INSTALL_DIR)\"
+ @$(CPY) "$(GENERICDIR)\tclTomMathDecls.h" "$(INCLUDE_INSTALL_DIR)\"
+ @$(CPY) "$(TOMMATHDIR)\tommath_class.h" "$(INCLUDE_INSTALL_DIR)\"
+ @$(CPY) "$(TOMMATHDIR)\tommath_superclass.h" "$(INCLUDE_INSTALL_DIR)\"
+ @echo Installing library files to $(SCRIPT_INSTALL_DIR)
+ @$(CPY) "$(ROOT)\library\history.tcl" "$(SCRIPT_INSTALL_DIR)\"
+ @$(CPY) "$(ROOT)\library\init.tcl" "$(SCRIPT_INSTALL_DIR)\"
+ @$(CPY) "$(ROOT)\library\clock.tcl" "$(SCRIPT_INSTALL_DIR)\"
+ @$(CPY) "$(ROOT)\library\tm.tcl" "$(SCRIPT_INSTALL_DIR)\"
+ @$(CPY) "$(ROOT)\library\parray.tcl" "$(SCRIPT_INSTALL_DIR)\"
+ @$(CPY) "$(ROOT)\library\safe.tcl" "$(SCRIPT_INSTALL_DIR)\"
+ @$(CPY) "$(ROOT)\library\tclIndex" "$(SCRIPT_INSTALL_DIR)\"
+ @$(CPY) "$(ROOT)\library\package.tcl" "$(SCRIPT_INSTALL_DIR)\"
+ @$(CPY) "$(ROOT)\library\word.tcl" "$(SCRIPT_INSTALL_DIR)\"
+ @$(CPY) "$(ROOT)\library\auto.tcl" "$(SCRIPT_INSTALL_DIR)\"
+ @$(CPY) "$(OUT_DIR)\tclConfig.sh" "$(LIB_INSTALL_DIR)\"
+ @$(CPY) "$(WINDIR)\tclooConfig.sh" "$(LIB_INSTALL_DIR)\"
+ @echo Installing library http1.0 directory
+ @$(CPY) "$(ROOT)\library\http1.0\*.tcl" \
+ "$(SCRIPT_INSTALL_DIR)\http1.0\"
+ @echo Installing library opt0.4 directory
+ @$(CPY) "$(ROOT)\library\opt\*.tcl" \
+ "$(SCRIPT_INSTALL_DIR)\opt0.4\"
+ @echo Installing package http $(PKG_HTTP_VER) as a Tcl Module
+ @$(COPY) "$(ROOT)\library\http\http.tcl" \
+ "$(SCRIPT_INSTALL_DIR)\..\tcl8\8.6\http-$(PKG_HTTP_VER).tm"
+ @echo Installing package msgcat $(PKG_MSGCAT_VER) as a Tcl Module
+ @$(COPY) "$(ROOT)\library\msgcat\msgcat.tcl" \
+ "$(SCRIPT_INSTALL_DIR)\..\tcl8\8.5\msgcat-$(PKG_MSGCAT_VER).tm"
+ @echo Installing package tcltest $(PKG_TCLTEST_VER) as a Tcl Module
+ @$(COPY) "$(ROOT)\library\tcltest\tcltest.tcl" \
+ "$(SCRIPT_INSTALL_DIR)\..\tcl8\8.5\tcltest-$(PKG_TCLTEST_VER).tm"
+ @echo Installing package platform $(PKG_PLATFORM_VER) as a Tcl Module
+ @$(COPY) "$(ROOT)\library\platform\platform.tcl" \
+ "$(SCRIPT_INSTALL_DIR)\..\tcl8\8.4\platform-$(PKG_PLATFORM_VER).tm"
+ @echo Installing package platform::shell $(PKG_SHELL_VER) as a Tcl Module
+ @$(COPY) "$(ROOT)\library\platform\shell.tcl" \
+ "$(SCRIPT_INSTALL_DIR)\..\tcl8\8.4\platform\shell-$(PKG_SHELL_VER).tm"
+ @echo Installing $(TCLDDELIBNAME)
+!if $(STATIC_BUILD)
+!if !$(TCL_USE_STATIC_PACKAGES)
+ @$(CPY) "$(TCLDDELIB)" "$(LIB_INSTALL_DIR)\"
+!endif
+!else
+ @$(CPY) "$(TCLDDELIB)" "$(LIB_INSTALL_DIR)\dde$(DDEDOTVERSION)\"
+ @$(CPY) "$(ROOT)\library\dde\pkgIndex.tcl" \
+ "$(LIB_INSTALL_DIR)\dde$(DDEDOTVERSION)\"
+!endif
+ @echo Installing $(TCLREGLIBNAME)
+!if $(STATIC_BUILD)
+!if !$(TCL_USE_STATIC_PACKAGES)
+ @$(CPY) "$(TCLREGLIB)" "$(LIB_INSTALL_DIR)\"
+!endif
+!else
+ @$(CPY) "$(TCLREGLIB)" "$(LIB_INSTALL_DIR)\reg$(REGDOTVERSION)\"
+ @$(CPY) "$(ROOT)\library\reg\pkgIndex.tcl" \
+ "$(LIB_INSTALL_DIR)\reg$(REGDOTVERSION)\"
+!endif
+ @echo Installing encodings
+ @$(CPY) "$(ROOT)\library\encoding\*.enc" \
+ "$(SCRIPT_INSTALL_DIR)\encoding\"
+
+#" emacs fix
+
+install-tzdata:
+ @echo Installing time zone data
+ @set TCL_LIBRARY=$(ROOT:\=/)/library
+ @$(TCLSH_NATIVE) "$(ROOT:\=/)/tools/installData.tcl" \
+ "$(ROOT:\=/)/library/tzdata" "$(SCRIPT_INSTALL_DIR)/tzdata"
+
+install-msgs:
+ @echo Installing message catalogs
+ @set TCL_LIBRARY=$(ROOT:\=/)/library
+ @$(TCLSH_NATIVE) "$(ROOT:\=/)/tools/installData.tcl" \
+ "$(ROOT:\=/)/library/msgs" "$(SCRIPT_INSTALL_DIR)/msgs"
+
+#---------------------------------------------------------------------
+# Clean up
+#---------------------------------------------------------------------
+
+tidy:
+!if "$(TCLLIB)" != "$(TCLIMPLIB)"
+ @echo Removing $(TCLLIB) ...
+ @if exist $(TCLLIB) del $(TCLLIB)
+!endif
+ @echo Removing $(TCLIMPLIB) ...
+ @if exist $(TCLIMPLIB) del $(TCLIMPLIB)
+ @echo Removing $(TCLSH) ...
+ @if exist $(TCLSH) del $(TCLSH)
+ @echo Removing $(TCLTEST) ...
+ @if exist $(TCLTEST) del $(TCLTEST)
+ @echo Removing $(TCLDDELIB) ...
+ @if exist $(TCLDDELIB) del $(TCLDDELIB)
+ @echo Removing $(TCLREGLIB) ...
+ @if exist $(TCLREGLIB) del $(TCLREGLIB)
+
+clean: clean-pkgs
+ @echo Cleaning $(TMP_DIR)\* ...
+ @if exist $(TMP_DIR)\nul $(RMDIR) $(TMP_DIR)
+ @echo Cleaning $(WINDIR)\nmakehlp.obj ...
+ @if exist $(WINDIR)\nmakehlp.obj del $(WINDIR)\nmakehlp.obj
+ @echo Cleaning $(WINDIR)\nmakehlp.exe ...
+ @if exist $(WINDIR)\nmakehlp.exe del $(WINDIR)\nmakehlp.exe
+ @echo Cleaning $(WINDIR)\_junk.pch ...
+ @if exist $(WINDIR)\_junk.pch del $(WINDIR)\_junk.pch
+ @echo Cleaning $(WINDIR)\vercl.x ...
+ @if exist $(WINDIR)\vercl.x del $(WINDIR)\vercl.x
+ @echo Cleaning $(WINDIR)\vercl.i ...
+ @if exist $(WINDIR)\vercl.i del $(WINDIR)\vercl.i
+ @echo Cleaning $(WINDIR)\versions.vc ...
+ @if exist $(WINDIR)\versions.vc del $(WINDIR)\versions.vc
+
+realclean: hose
+
+hose:
+ @echo Hosing $(OUT_DIR)\* ...
+ @if exist $(OUT_DIR)\nul $(RMDIR) $(OUT_DIR)
+
+# Local Variables:
+# mode: makefile
+# End: