summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
Diffstat
-rw-r--r--generic/tcl.decls18
-rw-r--r--generic/tcl.h9
-rw-r--r--generic/tclDecls.h22
-rw-r--r--generic/tclPkg.c44
-rw-r--r--generic/tclStubInit.c4
-rw-r--r--generic/tclTest.c2
-rw-r--r--generic/tclTestProcBodyObj.c2
-rw-r--r--generic/tclZlib.c2
-rw-r--r--unix/dltest/pkga.c4
-rw-r--r--unix/dltest/pkgb.c4
-rw-r--r--unix/dltest/pkgc.c8
-rw-r--r--unix/dltest/pkgd.c8
-rw-r--r--unix/dltest/pkge.c2
-rw-r--r--unix/dltest/pkgua.c4
-rw-r--r--win/tclWinDde.c51
-rw-r--r--win/tclWinReg.c39
16 files changed, 100 insertions, 123 deletions
diff --git a/generic/tcl.decls b/generic/tcl.decls
index fe1d763..6f46e61 100644
--- a/generic/tcl.decls
+++ b/generic/tcl.decls
@@ -962,10 +962,11 @@ declare 270 {
const char *Tcl_ParseVar(Tcl_Interp *interp, const char *start,
const char **termPtr)
}
-declare 271 {
- const char *Tcl_PkgPresent(Tcl_Interp *interp, const char *name,
- const char *version, int exact)
-}
+# Removed in 9.0, converted to macro
+#declare 271 {
+# const char *Tcl_PkgPresent(Tcl_Interp *interp, const char *name,
+# const char *version, int exact)
+#}
declare 272 {
const char *Tcl_PkgPresentEx(Tcl_Interp *interp,
const char *name, const char *version, int exact,
@@ -977,10 +978,11 @@ declare 273 {
const char *version)
}
# TIP #268: The internally used new Require function is in slot 573.
-declare 274 {
- const char *Tcl_PkgRequire(Tcl_Interp *interp, const char *name,
- const char *version, int exact)
-}
+# Removed in 9.0, converted to macro
+#declare 274 {
+# const char *Tcl_PkgRequire(Tcl_Interp *interp, const char *name,
+# const char *version, int exact)
+#}
declare 275 {
void Tcl_SetErrorCodeVA(Tcl_Interp *interp, va_list argList)
}
diff --git a/generic/tcl.h b/generic/tcl.h
index cc3efaf..11c77d8 100644
--- a/generic/tcl.h
+++ b/generic/tcl.h
@@ -2207,8 +2207,13 @@ const char * TclTomMathInitializeStubs(Tcl_Interp *interp,
*/
#ifdef USE_TCL_STUBS
-#define Tcl_InitStubs(interp, version, exact) \
- TclInitStubs(interp, version, exact, TCL_VERSION, TCL_STUB_MAGIC)
+#if TCL_RELEASE_LEVEL == TCL_FINAL_RELEASE
+# define Tcl_InitStubs(interp, version, exact) \
+ TclInitStubs(interp, version, exact, TCL_VERSION, TCL_STUB_MAGIC)
+#else
+# define Tcl_InitStubs(interp, version, exact) \
+ TclInitStubs(interp, TCL_PATCH_LEVEL, 1, TCL_VERSION, TCL_STUB_MAGIC)
+#endif
#else
#define Tcl_InitStubs(interp, version, exact) \
Tcl_PkgInitStubsCheck(interp, version, exact)
diff --git a/generic/tclDecls.h b/generic/tclDecls.h
index 0770e98..cfabbd4 100644
--- a/generic/tclDecls.h
+++ b/generic/tclDecls.h
@@ -778,9 +778,7 @@ TCLAPI char * Tcl_HashStats(Tcl_HashTable *tablePtr);
/* 270 */
TCLAPI const char * Tcl_ParseVar(Tcl_Interp *interp, const char *start,
const char **termPtr);
-/* 271 */
-TCLAPI const char * Tcl_PkgPresent(Tcl_Interp *interp, const char *name,
- const char *version, int exact);
+/* Slot 271 is reserved */
/* 272 */
TCLAPI const char * Tcl_PkgPresentEx(Tcl_Interp *interp,
const char *name, const char *version,
@@ -788,9 +786,7 @@ TCLAPI const char * Tcl_PkgPresentEx(Tcl_Interp *interp,
/* 273 */
TCLAPI int TclPkgProvide(Tcl_Interp *interp, const char *name,
const char *version);
-/* 274 */
-TCLAPI const char * Tcl_PkgRequire(Tcl_Interp *interp, const char *name,
- const char *version, int exact);
+/* Slot 274 is reserved */
/* 275 */
TCLAPI void Tcl_SetErrorCodeVA(Tcl_Interp *interp,
va_list argList);
@@ -2072,10 +2068,10 @@ typedef struct TclStubs {
void (*tcl_AppendStringsToObjVA) (Tcl_Obj *objPtr, va_list argList); /* 268 */
char * (*tcl_HashStats) (Tcl_HashTable *tablePtr); /* 269 */
const char * (*tcl_ParseVar) (Tcl_Interp *interp, const char *start, const char **termPtr); /* 270 */
- const char * (*tcl_PkgPresent) (Tcl_Interp *interp, const char *name, const char *version, int exact); /* 271 */
+ void (*reserved271)(void);
const char * (*tcl_PkgPresentEx) (Tcl_Interp *interp, const char *name, const char *version, int exact, void *clientDataPtr); /* 272 */
int (*tclPkgProvide) (Tcl_Interp *interp, const char *name, const char *version); /* 273 */
- const char * (*tcl_PkgRequire) (Tcl_Interp *interp, const char *name, const char *version, int exact); /* 274 */
+ void (*reserved274)(void);
void (*tcl_SetErrorCodeVA) (Tcl_Interp *interp, va_list argList); /* 275 */
void (*reserved276)(void);
Tcl_Pid (*tcl_WaitPid) (Tcl_Pid pid, int *statPtr, int options); /* 277 */
@@ -2998,14 +2994,12 @@ extern const TclStubs *tclStubsPtr;
(tclStubsPtr->tcl_HashStats) /* 269 */
#define Tcl_ParseVar \
(tclStubsPtr->tcl_ParseVar) /* 270 */
-#define Tcl_PkgPresent \
- (tclStubsPtr->tcl_PkgPresent) /* 271 */
+/* Slot 271 is reserved */
#define Tcl_PkgPresentEx \
(tclStubsPtr->tcl_PkgPresentEx) /* 272 */
#define TclPkgProvide \
(tclStubsPtr->tclPkgProvide) /* 273 */
-#define Tcl_PkgRequire \
- (tclStubsPtr->tcl_PkgRequire) /* 274 */
+/* Slot 274 is reserved */
#define Tcl_SetErrorCodeVA \
(tclStubsPtr->tcl_SetErrorCodeVA) /* 275 */
/* Slot 276 is reserved */
@@ -3740,7 +3734,11 @@ TCLAPI void Tcl_MainExW(int argc, wchar_t **argv,
Tcl_AppInitProc *appInitProc, Tcl_Interp *interp);
#endif
+#define Tcl_PkgPresent(interp, name, version, exact) \
+ Tcl_PkgPresentEx(interp, name, version, exact, NULL)
#define Tcl_PkgProvide(interp, name, version) \
Tcl_PkgProvideEx(interp, name, version, NULL)
+#define Tcl_PkgRequire(interp, name, version, exact) \
+ Tcl_PkgRequireEx(interp, name, version, exact, NULL)
#endif /* _TCLDECLS */
diff --git a/generic/tclPkg.c b/generic/tclPkg.c
index f67135d..ec5d0e6 100644
--- a/generic/tclPkg.c
+++ b/generic/tclPkg.c
@@ -88,7 +88,7 @@ static const char * PkgRequireCore(Tcl_Interp *interp, const char *name,
/*
*----------------------------------------------------------------------
*
- * Tcl_PkgProvide / Tcl_PkgProvideEx --
+ * Tcl_PkgProvideEx --
*
* This function is invoked to declare that a particular version of a
* particular package is now present in an interpreter. There must not be
@@ -154,7 +154,7 @@ Tcl_PkgProvideEx(
/*
*----------------------------------------------------------------------
*
- * Tcl_PkgRequire / Tcl_PkgRequireEx / Tcl_PkgRequireProc --
+ * Tcl_PkgRequireEx / Tcl_PkgRequireProc --
*
* This function is called by code that depends on a particular version
* of a particular package. If the package is not already provided in the
@@ -179,20 +179,6 @@ Tcl_PkgProvideEx(
*/
const char *
-Tcl_PkgRequire(
- Tcl_Interp *interp, /* Interpreter in which package is now
- * available. */
- const char *name, /* Name of desired package. */
- const char *version, /* Version string for desired version; NULL
- * means use the latest version available. */
- int exact) /* Non-zero means that only the particular
- * version given is acceptable. Zero means use
- * the latest compatible version. */
-{
- return Tcl_PkgRequireEx(interp, name, version, exact, NULL);
-}
-
-const char *
Tcl_PkgRequireEx(
Tcl_Interp *interp, /* Interpreter in which package is now
* available. */
@@ -642,7 +628,7 @@ PkgRequireCore(
/*
*----------------------------------------------------------------------
*
- * Tcl_PkgPresent / Tcl_PkgPresentEx --
+ * Tcl_PkgPresentEx --
*
* Checks to see whether the specified package is present. If it is not
* then no additional action is taken.
@@ -661,20 +647,6 @@ PkgRequireCore(
*/
const char *
-Tcl_PkgPresent(
- Tcl_Interp *interp, /* Interpreter in which package is now
- * available. */
- const char *name, /* Name of desired package. */
- const char *version, /* Version string for desired version; NULL
- * means use the latest version available. */
- int exact) /* Non-zero means that only the particular
- * version given is acceptable. Zero means use
- * the latest compatible version. */
-{
- return Tcl_PkgPresentEx(interp, name, version, exact, NULL);
-}
-
-const char *
Tcl_PkgPresentEx(
Tcl_Interp *interp, /* Interpreter in which package is now
* available. */
@@ -936,7 +908,7 @@ Tcl_PackageObjCmd(
version = TclGetString(objv[3]);
}
}
- Tcl_PkgPresent(interp, name, version, exact);
+ Tcl_PkgPresentEx(interp, name, version, exact, NULL);
return TCL_ERROR;
break;
}
@@ -961,7 +933,7 @@ Tcl_PackageObjCmd(
if (CheckVersionAndConvert(interp, argv3, NULL, NULL) != TCL_OK) {
return TCL_ERROR;
}
- return Tcl_PkgProvide(interp, argv2, argv3);
+ return Tcl_PkgProvideEx(interp, argv2, argv3, NULL);
case PKG_REQUIRE:
require:
if (objc < 3) {
@@ -1880,7 +1852,7 @@ Tcl_PkgInitStubsCheck(
const char * version,
int exact)
{
- const char *actualVersion = Tcl_PkgPresent(interp, "Tcl", version, 0);
+ const char *actualVersion = Tcl_PkgPresentEx(interp, "Tcl", version, 0, NULL);
if (exact && actualVersion) {
const char *p = version;
@@ -1892,11 +1864,11 @@ Tcl_PkgInitStubsCheck(
if (count == 1) {
if (0 != strncmp(version, actualVersion, strlen(version))) {
/* Construct error message */
- Tcl_PkgPresent(interp, "Tcl", version, 1);
+ Tcl_PkgPresentEx(interp, "Tcl", version, 1, NULL);
return NULL;
}
} else {
- return Tcl_PkgPresent(interp, "Tcl", version, 1);
+ return Tcl_PkgPresentEx(interp, "Tcl", version, 1, NULL);
}
}
return actualVersion;
diff --git a/generic/tclStubInit.c b/generic/tclStubInit.c
index 50fc6de..9a5dee2 100644
--- a/generic/tclStubInit.c
+++ b/generic/tclStubInit.c
@@ -941,10 +941,10 @@ const TclStubs tclStubs = {
Tcl_AppendStringsToObjVA, /* 268 */
Tcl_HashStats, /* 269 */
Tcl_ParseVar, /* 270 */
- Tcl_PkgPresent, /* 271 */
+ 0, /* 271 */
Tcl_PkgPresentEx, /* 272 */
TclPkgProvide, /* 273 */
- Tcl_PkgRequire, /* 274 */
+ 0, /* 274 */
Tcl_SetErrorCodeVA, /* 275 */
0, /* 276 */
Tcl_WaitPid, /* 277 */
diff --git a/generic/tclTest.c b/generic/tclTest.c
index dcfe8b0..80a845a 100644
--- a/generic/tclTest.c
+++ b/generic/tclTest.c
@@ -521,7 +521,7 @@ Tcltest_Init(
}
/* TIP #268: Full patchlevel instead of just major.minor */
- if (Tcl_PkgProvide(interp, "Tcltest", TCL_PATCH_LEVEL) == TCL_ERROR) {
+ if (Tcl_PkgProvideEx(interp, "Tcltest", TCL_PATCH_LEVEL, NULL) == TCL_ERROR) {
return TCL_ERROR;
}
diff --git a/generic/tclTestProcBodyObj.c b/generic/tclTestProcBodyObj.c
index 3324b98..234b270 100644
--- a/generic/tclTestProcBodyObj.c
+++ b/generic/tclTestProcBodyObj.c
@@ -185,7 +185,7 @@ ProcBodyTestInitInternal(
}
}
- return Tcl_PkgProvide(interp, packageName, packageVersion);
+ return Tcl_PkgProvideEx(interp, packageName, packageVersion, NULL);
}
/*
diff --git a/generic/tclZlib.c b/generic/tclZlib.c
index 9c1176e..5a693fc 100644
--- a/generic/tclZlib.c
+++ b/generic/tclZlib.c
@@ -3871,7 +3871,7 @@ TclZlibInit(
* Formally provide the package as a Tcl built-in.
*/
- return Tcl_PkgProvide(interp, "zlib", TCL_ZLIB_VERSION);
+ return Tcl_PkgProvideEx(interp, "zlib", TCL_ZLIB_VERSION, NULL);
}
/*
diff --git a/unix/dltest/pkga.c b/unix/dltest/pkga.c
index 7e5d7d3..afa346a 100644
--- a/unix/dltest/pkga.c
+++ b/unix/dltest/pkga.c
@@ -122,10 +122,10 @@ Pkga_Init(
{
int code;
- if (Tcl_InitStubs(interp, TCL_VERSION, 0) == NULL) {
+ if (Tcl_InitStubs(interp, "9.0", 0) == NULL) {
return TCL_ERROR;
}
- code = Tcl_PkgProvide(interp, "Pkga", "1.0");
+ code = Tcl_PkgProvideEx(interp, "Pkga", "1.0", NULL);
if (code != TCL_OK) {
return code;
}
diff --git a/unix/dltest/pkgb.c b/unix/dltest/pkgb.c
index 35f691a..b32092c 100644
--- a/unix/dltest/pkgb.c
+++ b/unix/dltest/pkgb.c
@@ -41,6 +41,10 @@ static int Pkgb_DemoObjCmd(ClientData clientData,
*----------------------------------------------------------------------
*/
+#ifndef Tcl_GetErrorLine
+# define Tcl_GetErrorLine(interp) ((interp)->errorLine)
+#endif
+
static int
Pkgb_SubObjCmd(
ClientData dummy, /* Not used. */
diff --git a/unix/dltest/pkgc.c b/unix/dltest/pkgc.c
index 4e3e174..c76c2d2 100644
--- a/unix/dltest/pkgc.c
+++ b/unix/dltest/pkgc.c
@@ -112,10 +112,10 @@ Pkgc_Init(
{
int code;
- if (Tcl_InitStubs(interp, TCL_VERSION, 0) == NULL) {
+ if (Tcl_InitStubs(interp, "9.0", 0) == NULL) {
return TCL_ERROR;
}
- code = Tcl_PkgProvide(interp, "Pkgc", "1.7.2");
+ code = Tcl_PkgProvideEx(interp, "Pkgc", "1.7.2", NULL);
if (code != TCL_OK) {
return code;
}
@@ -149,10 +149,10 @@ Pkgc_SafeInit(
{
int code;
- if (Tcl_InitStubs(interp, TCL_VERSION, 0) == NULL) {
+ if (Tcl_InitStubs(interp, "9.0", 0) == NULL) {
return TCL_ERROR;
}
- code = Tcl_PkgProvide(interp, "Pkgc", "1.7.2");
+ code = Tcl_PkgProvideEx(interp, "Pkgc", "1.7.2", NULL);
if (code != TCL_OK) {
return code;
}
diff --git a/unix/dltest/pkgd.c b/unix/dltest/pkgd.c
index 4a1defa..ae9ff93 100644
--- a/unix/dltest/pkgd.c
+++ b/unix/dltest/pkgd.c
@@ -112,10 +112,10 @@ Pkgd_Init(
{
int code;
- if (Tcl_InitStubs(interp, TCL_VERSION, 0) == NULL) {
+ if (Tcl_InitStubs(interp, "9.0", 0) == NULL) {
return TCL_ERROR;
}
- code = Tcl_PkgProvide(interp, "Pkgd", "7.3");
+ code = Tcl_PkgProvideEx(interp, "Pkgd", "7.3", NULL);
if (code != TCL_OK) {
return code;
}
@@ -149,10 +149,10 @@ Pkgd_SafeInit(
{
int code;
- if (Tcl_InitStubs(interp, TCL_VERSION, 0) == NULL) {
+ if (Tcl_InitStubs(interp, "9.0", 0) == NULL) {
return TCL_ERROR;
}
- code = Tcl_PkgProvide(interp, "Pkgd", "7.3");
+ code = Tcl_PkgProvideEx(interp, "Pkgd", "7.3", NULL);
if (code != TCL_OK) {
return code;
}
diff --git a/unix/dltest/pkge.c b/unix/dltest/pkge.c
index 36c8c1a..a36ac30 100644
--- a/unix/dltest/pkge.c
+++ b/unix/dltest/pkge.c
@@ -38,7 +38,7 @@ Pkge_Init(
{
static const char script[] = "if 44 {open non_existent}";
- if (Tcl_InitStubs(interp, TCL_VERSION, 0) == NULL) {
+ if (Tcl_InitStubs(interp, "9.0", 0) == NULL) {
return TCL_ERROR;
}
return Tcl_Eval(interp, script);
diff --git a/unix/dltest/pkgua.c b/unix/dltest/pkgua.c
index 2a38525..b92b320 100644
--- a/unix/dltest/pkgua.c
+++ b/unix/dltest/pkgua.c
@@ -199,7 +199,7 @@ Pkgua_Init(
int code, cmdIndex = 0;
Tcl_Command *cmdTokens;
- if (Tcl_InitStubs(interp, TCL_VERSION, 0) == NULL) {
+ if (Tcl_InitStubs(interp, "9.0", 0) == NULL) {
return TCL_ERROR;
}
@@ -210,7 +210,7 @@ Pkgua_Init(
PkguaInitTokensHashTable();
- code = Tcl_PkgProvide(interp, "Pkgua", "1.0");
+ code = Tcl_PkgProvideEx(interp, "Pkgua", "1.0", NULL);
if (code != TCL_OK) {
return code;
}
diff --git a/win/tclWinDde.c b/win/tclWinDde.c
index b4a4fde..013b320 100644
--- a/win/tclWinDde.c
+++ b/win/tclWinDde.c
@@ -147,20 +147,13 @@ int
Dde_Init(
Tcl_Interp *interp)
{
- if (!Tcl_InitStubs(interp, TCL_VERSION, 0)) {
+ if (Tcl_InitStubs(interp, "8.5", 0) == NULL) {
return TCL_ERROR;
}
-#ifdef UNICODE
- if (TclWinGetPlatformId() < VER_PLATFORM_WIN32_NT) {
- Tcl_SetObjResult(interp, Tcl_NewStringObj(
- "Win32s and Windows 9x are not supported platforms", -1));
- return TCL_ERROR;
- }
-#endif
Tcl_CreateObjCommand(interp, "dde", DdeObjCmd, NULL, NULL);
Tcl_CreateExitHandler(DdeExitProc, NULL);
- return Tcl_PkgProvide(interp, TCL_DDE_PACKAGE_NAME, TCL_DDE_VERSION);
+ return Tcl_PkgProvideEx(interp, TCL_DDE_PACKAGE_NAME, TCL_DDE_VERSION, NULL);
}
/*
@@ -385,9 +378,12 @@ DdeSetServerName(
for (n = 0; n < srvCount; ++n) {
Tcl_Obj* namePtr;
Tcl_DString ds;
+ const char *nameStr;
+ int len;
Tcl_ListObjIndex(interp, srvPtrPtr[n], 1, &namePtr);
- Tcl_WinUtfToTChar(Tcl_GetString(namePtr), -1, &ds);
+ nameStr = Tcl_GetStringFromObj(namePtr, &len);
+ Tcl_WinUtfToTChar(nameStr, len, &ds);
if (_tcscmp(actualName, (TCHAR *)Tcl_DStringValue(&ds)) == 0) {
suffix++;
Tcl_DStringFree(&ds);
@@ -746,7 +742,7 @@ DdeServerProc(
} else {
returnString = (char *)
Tcl_GetUnicodeFromObj(convPtr->returnPackagePtr, &len);
- len = sizeof(TCHAR) * len + 1;
+ len = 2 * len + 1;
}
ddeReturn = DdeCreateDataHandle(ddeInstance, (BYTE *)returnString,
(DWORD) len+1, 0, ddeItem, uFmt, 0);
@@ -767,7 +763,7 @@ DdeServerProc(
} else {
returnString = (char *) Tcl_GetUnicodeFromObj(
variableObjPtr, &len);
- len = sizeof(TCHAR) * len + 1;
+ len = 2 * len + 1;
}
ddeReturn = DdeCreateDataHandle(ddeInstance,
(BYTE *)returnString, (DWORD) len+1, 0, ddeItem,
@@ -1298,16 +1294,16 @@ DdeObjCmd(
return TCL_ERROR;
}
- if (Tcl_GetIndexFromObj(interp, objv[1], ddeCommands, "command", 0,
- &index) != TCL_OK) {
+ if (Tcl_GetIndexFromObjStruct(interp, objv[1], ddeCommands,
+ sizeof(char *), "command", 0, &index) != TCL_OK) {
return TCL_ERROR;
}
switch ((enum DdeSubcommands) index) {
case DDE_SERVERNAME:
for (i = 2; i < objc; i++) {
- if (Tcl_GetIndexFromObj(interp, objv[i], ddeSrvOptions,
- "option", 0, &argIndex) != TCL_OK) {
+ if (Tcl_GetIndexFromObjStruct(interp, objv[i], ddeSrvOptions,
+ sizeof(char *), "option", 0, &argIndex) != TCL_OK) {
/*
* If it is the last argument, it might be a server name
* instead of a bad argument.
@@ -1355,8 +1351,8 @@ DdeObjCmd(
} else if (objc >= 6 && objc <= 7) {
firstArg = objc - 3;
for (i = 2; i < firstArg; i++) {
- if (Tcl_GetIndexFromObj(interp, objv[i], ddeExecOptions,
- "option", 0, &argIndex) != TCL_OK) {
+ if (Tcl_GetIndexFromObjStruct(interp, objv[i], ddeExecOptions,
+ sizeof(char *), "option", 0, &argIndex) != TCL_OK) {
goto wrongDdeExecuteArgs;
}
if (argIndex == DDE_EXEC_ASYNC) {
@@ -1376,8 +1372,8 @@ DdeObjCmd(
if (objc == 6) {
firstArg = 2;
break;
- } else if ((objc == 7) && (Tcl_GetIndexFromObj(NULL, objv[2],
- ddeReqOptions, "option", 0, &argIndex) == TCL_OK)) {
+ } else if ((objc == 7) && (Tcl_GetIndexFromObjStruct(NULL, objv[2],
+ ddeReqOptions, sizeof(char *), "option", 0, &argIndex) == TCL_OK)) {
flags |= DDE_FLAG_BINARY;
firstArg = 3;
break;
@@ -1394,8 +1390,8 @@ DdeObjCmd(
if (objc == 5) {
firstArg = 2;
break;
- } else if ((objc == 6) && (Tcl_GetIndexFromObj(NULL, objv[2],
- ddeReqOptions, "option", 0, &argIndex) == TCL_OK)) {
+ } else if ((objc == 6) && (Tcl_GetIndexFromObjStruct(NULL, objv[2],
+ ddeReqOptions, sizeof(char *), "option", 0, &argIndex) == TCL_OK)) {
flags |= DDE_FLAG_BINARY;
firstArg = 3;
break;
@@ -1422,8 +1418,8 @@ DdeObjCmd(
return TCL_ERROR;
} else {
firstArg = 2;
- if (Tcl_GetIndexFromObj(NULL, objv[2], ddeEvalOptions, "option",
- 0, &argIndex) == TCL_OK) {
+ if (Tcl_GetIndexFromObjStruct(NULL, objv[2], ddeEvalOptions,
+ sizeof(char *), "option", 0, &argIndex) == TCL_OK) {
if (objc < 5) {
goto wrongDdeEvalArgs;
}
@@ -1745,8 +1741,7 @@ DdeObjCmd(
objPtr = Tcl_GetVar2Ex(sendInterp, "errorInfo", NULL,
TCL_GLOBAL_ONLY);
if (objPtr) {
- string = Tcl_GetStringFromObj(objPtr, &length);
- Tcl_AddObjErrorInfo(interp, string, length);
+ Tcl_AppendObjToErrorInfo(interp, objPtr);
}
objPtr = Tcl_GetVar2Ex(sendInterp, "errorCode", NULL,
@@ -1841,9 +1836,7 @@ DdeObjCmd(
Tcl_DecrRefCount(resultPtr);
goto invalidServerResponse;
}
- length = -1;
- string = Tcl_GetStringFromObj(objPtr, &length);
- Tcl_AddObjErrorInfo(interp, string, length);
+ Tcl_AppendObjToErrorInfo(interp, objPtr);
Tcl_ListObjIndex(NULL, resultPtr, 2, &objPtr);
Tcl_SetObjErrorCode(interp, objPtr);
diff --git a/win/tclWinReg.c b/win/tclWinReg.c
index 619d9df..643bd06 100644
--- a/win/tclWinReg.c
+++ b/win/tclWinReg.c
@@ -156,14 +156,14 @@ Registry_Init(
{
Tcl_Command cmd;
- if (Tcl_InitStubs(interp, TCL_VERSION, 0) == NULL) {
+ if (Tcl_InitStubs(interp, "8.5", 0) == NULL) {
return TCL_ERROR;
}
cmd = Tcl_CreateObjCommand(interp, "registry", RegistryObjCmd,
interp, DeleteCmd);
Tcl_SetAssocData(interp, REGISTRY_ASSOC_KEY, NULL, cmd);
- return Tcl_PkgProvide(interp, "registry", "1.3.0");
+ return Tcl_PkgProvideEx(interp, "registry", "1.3.0", NULL);
}
/*
@@ -281,9 +281,9 @@ RegistryObjCmd(
return TCL_ERROR;
}
- if (Tcl_GetString(objv[n])[0] == '-') {
- if (Tcl_GetIndexFromObj(interp, objv[n++], modes, "mode", 0,
- &index) != TCL_OK) {
+ if (Tcl_GetStringFromObj(objv[n], NULL)[0] == '-') {
+ if (Tcl_GetIndexFromObjStruct(interp, objv[n++], modes,
+ sizeof(char *), "mode", 0, &index) != TCL_OK) {
return TCL_ERROR;
}
switch (index) {
@@ -299,8 +299,8 @@ RegistryObjCmd(
}
}
- if (Tcl_GetIndexFromObj(interp, objv[n++], subcommands, "option", 0,
- &index) != TCL_OK) {
+ if (Tcl_GetIndexFromObjStruct(interp, objv[n++], subcommands,
+ sizeof(char *), "option", 0, &index) != TCL_OK) {
return TCL_ERROR;
}
@@ -520,7 +520,8 @@ DeleteValue(
if (result != ERROR_SUCCESS) {
Tcl_SetObjResult(interp, Tcl_ObjPrintf(
"unable to delete value \"%s\" from key \"%s\": ",
- Tcl_GetString(valueNameObj), Tcl_GetString(keyNameObj)));
+ Tcl_GetStringFromObj(valueNameObj, NULL),
+ Tcl_GetStringFromObj(keyNameObj, NULL)));
AppendSystemError(interp, result);
result = TCL_ERROR;
} else {
@@ -568,7 +569,7 @@ GetKeyNames(
Tcl_DString ds; /* Buffer to translate subkey name to UTF-8 */
if (patternObj) {
- pattern = Tcl_GetString(patternObj);
+ pattern = Tcl_GetStringFromObj(patternObj, NULL);
} else {
pattern = NULL;
}
@@ -597,7 +598,7 @@ GetKeyNames(
} else {
Tcl_SetObjResult(interp, Tcl_ObjPrintf(
"unable to enumerate subkeys of \"%s\": ",
- Tcl_GetString(keyNameObj)));
+ Tcl_GetStringFromObj(keyNameObj, NULL)));
AppendSystemError(interp, result);
result = TCL_ERROR;
}
@@ -680,7 +681,8 @@ GetType(
if (result != ERROR_SUCCESS) {
Tcl_SetObjResult(interp, Tcl_ObjPrintf(
"unable to get type of value \"%s\" from key \"%s\": ",
- Tcl_GetString(valueNameObj), Tcl_GetString(keyNameObj)));
+ Tcl_GetStringFromObj(valueNameObj, NULL),
+ Tcl_GetStringFromObj(keyNameObj, NULL)));
AppendSystemError(interp, result);
return TCL_ERROR;
}
@@ -774,7 +776,8 @@ GetValue(
if (result != ERROR_SUCCESS) {
Tcl_SetObjResult(interp, Tcl_ObjPrintf(
"unable to get value \"%s\" from key \"%s\": ",
- Tcl_GetString(valueNameObj), Tcl_GetString(keyNameObj)));
+ Tcl_GetStringFromObj(valueNameObj, NULL),
+ Tcl_GetStringFromObj(keyNameObj, NULL)));
AppendSystemError(interp, result);
Tcl_DStringFree(&data);
return TCL_ERROR;
@@ -878,7 +881,7 @@ GetValueNames(
result = TCL_OK;
if (patternObj) {
- pattern = Tcl_GetString(patternObj);
+ pattern = Tcl_GetStringFromObj(patternObj, NULL);
} else {
pattern = NULL;
}
@@ -1118,8 +1121,8 @@ ParseKeyName(
*/
rootObj = Tcl_NewStringObj(rootName, -1);
- result = Tcl_GetIndexFromObj(interp, rootObj, rootKeyNames, "root name",
- TCL_EXACT, &index);
+ result = Tcl_GetIndexFromObjStruct(interp, rootObj, rootKeyNames,
+ sizeof(char *), "root name", TCL_EXACT, &index);
Tcl_DecrRefCount(rootObj);
if (result != TCL_OK) {
return TCL_ERROR;
@@ -1254,8 +1257,8 @@ SetValue(
if (typeObj == NULL) {
type = REG_SZ;
- } else if (Tcl_GetIndexFromObj(interp, typeObj, typeNames, "type",
- 0, (int *) &type) != TCL_OK) {
+ } else if (Tcl_GetIndexFromObjStruct(interp, typeObj, typeNames,
+ sizeof(char *), "type", 0, (int *) &type) != TCL_OK) {
if (Tcl_GetIntFromObj(NULL, typeObj, (int *) &type) != TCL_OK) {
return TCL_ERROR;
}
@@ -1408,7 +1411,7 @@ BroadcastValue(
* Use the ignore the result.
*/
- result = SendMessageTimeoutA(HWND_BROADCAST, WM_SETTINGCHANGE,
+ result = SendMessageTimeout(HWND_BROADCAST, WM_SETTINGCHANGE,
(WPARAM) 0, (LPARAM) str, SMTO_ABORTIFHUNG, timeout, &sendResult);
objPtr = Tcl_NewObj();
generated by cgit v0.12 at 2024-11-17 15:50:02 (GMT)