summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authorjan.nijtmans <nijtmans@users.sourceforge.net>2018-10-26 19:01:57 (GMT)
committerjan.nijtmans <nijtmans@users.sourceforge.net>2018-10-26 19:01:57 (GMT)
commit7ecdd17b4d021a420e4eb9996208dcdf54061703 (patch)
treed66891b394a34fbf9833282199f8008e4185f4cf
parent335774aef1d1e39ff22a1024aaa062106f99390b (diff)
parent125b29bfe3ceb7ff21f83db0e6b4dd79d28328c3 (diff)
downloadtcl-7ecdd17b4d021a420e4eb9996208dcdf54061703.zip
tcl-7ecdd17b4d021a420e4eb9996208dcdf54061703.tar.gz
tcl-7ecdd17b4d021a420e4eb9996208dcdf54061703.tar.bz2
Merge 8.6
-rw-r--r--library/dde/pkgIndex.tcl4
-rw-r--r--tests/winDde.test4
-rw-r--r--win/Makefile.in4
-rw-r--r--win/makefile.vc2
-rw-r--r--win/tclWinDde.c237
-rw-r--r--win/tclWinReg.c32
6 files changed, 171 insertions, 112 deletions
diff --git a/library/dde/pkgIndex.tcl b/library/dde/pkgIndex.tcl
index 4cf73d0..7aa67fa 100644
--- a/library/dde/pkgIndex.tcl
+++ b/library/dde/pkgIndex.tcl
@@ -1,7 +1,7 @@
if {([info commands ::tcl::pkgconfig] eq "")
|| ([info sharedlibextension] ne ".dll")} return
if {[::tcl::pkgconfig get debug]} {
- package ifneeded dde 1.4.0 [list load [file join $dir tcldde14g.dll] dde]
+ package ifneeded dde 1.4.1 [list load [file join $dir tcldde14g.dll] dde]
} else {
- package ifneeded dde 1.4.0 [list load [file join $dir tcldde14.dll] dde]
+ package ifneeded dde 1.4.1 [list load [file join $dir tcldde14.dll] dde]
}
diff --git a/tests/winDde.test b/tests/winDde.test
index f04fb45..1fa7e86 100644
--- a/tests/winDde.test
+++ b/tests/winDde.test
@@ -20,7 +20,7 @@ testConstraint dde 0
if {[testConstraint win]} {
if {![catch {
::tcltest::loadTestedCommands
- set ::ddever [package require dde 1.4.0]
+ set ::ddever [package require dde 1.4.1]
set ::ddelib [lindex [package ifneeded dde $::ddever] 1]}]} {
testConstraint dde 1
}
@@ -104,7 +104,7 @@ proc createChildProcess {ddeServerName args} {
# -------------------------------------------------------------------------
test winDde-1.0 {check if we are testing the right dll} {win dde} {
set ::ddever
-} {1.4.0}
+} {1.4.1}
test winDde-1.1 {Settings the server's topic name} -constraints dde -body {
list [dde servername foobar] [dde servername] [dde servername self]
diff --git a/win/Makefile.in b/win/Makefile.in
index 2148e3e..8199a40 100644
--- a/win/Makefile.in
+++ b/win/Makefile.in
@@ -868,7 +868,7 @@ test-tcl: binaries $(TCLSH) $(CAT32) $(TEST_DLL_FILE)
$(WINE) ./$(TCLSH) "$(ROOT_DIR_NATIVE)/tests/all.tcl" $(TESTFLAGS) \
-load "package ifneeded Tcltest ${VERSION}@TCL_PATCH_LEVEL@ [list load [file normalize ${TEST_DLL_FILE}] Tcltest]; \
package ifneeded tcltests 0.1 \"[list source [file normalize $(ROOT_DIR_NATIVE)/tests/tcltests.tcl]];package provide tcltests 0.1\"; \
- package ifneeded dde 1.4.0 [list load [file normalize ${DDE_DLL_FILE}] dde]; \
+ package ifneeded dde 1.4.1 [list load [file normalize ${DDE_DLL_FILE}] dde]; \
package ifneeded registry 1.3.3 [list load [file normalize ${REG_DLL_FILE}] registry]" | $(WINE) ./$(CAT32)
# Useful target to launch a built tclsh with the proper path,...
@@ -876,7 +876,7 @@ runtest: binaries $(TCLSH) $(TEST_DLL_FILE)
@TCL_LIBRARY="$(LIBRARY_DIR)"; export TCL_LIBRARY; \
$(WINE) ./$(TCLSH) $(TESTFLAGS) -load "package ifneeded Tcltest ${VERSION}@TCL_PATCH_LEVEL@ [list load [file normalize ${TEST_DLL_FILE}] Tcltest]; \
package ifneeded tcltests 0.1 \"[list source [file normalize $(ROOT_DIR_NATIVE)/tests/tcltests.tcl]];package provide tcltests 0.1\"; \
- package ifneeded dde 1.4.0 [list load [file normalize ${DDE_DLL_FILE}] dde]; \
+ package ifneeded dde 1.4.1 [list load [file normalize ${DDE_DLL_FILE}] dde]; \
package ifneeded registry 1.3.3 [list load [file normalize ${REG_DLL_FILE}] registry]" $(SCRIPT)
# This target can be used to run tclsh from the build directory via
diff --git a/win/makefile.vc b/win/makefile.vc
index 392e6b4..1278a41 100644
--- a/win/makefile.vc
+++ b/win/makefile.vc
@@ -392,7 +392,7 @@ test: test-core test-pkgs
test-core: setup $(TCLTEST) dlls
set TCL_LIBRARY=$(ROOT:\=/)/library
$(DEBUGGER) $(TCLTEST) "$(ROOT:\=/)/tests/all.tcl" $(TESTFLAGS) -loadfile <<
- package ifneeded dde 1.4.0 [list load "$(TCLDDELIB:\=/)" dde]
+ package ifneeded dde 1.4.1 [list load "$(TCLDDELIB:\=/)" dde]
package ifneeded registry 1.3.3 [list load "$(TCLREGLIB:\=/)" registry]
<<
diff --git a/win/tclWinDde.c b/win/tclWinDde.c
index 52bcd42..6908fdf 100644
--- a/win/tclWinDde.c
+++ b/win/tclWinDde.c
@@ -50,13 +50,13 @@ typedef struct Conversation {
Tcl_Obj *returnPackagePtr; /* The result package for this conversation. */
} Conversation;
-struct DdeEnumServices {
+typedef struct {
Tcl_Interp *interp;
int result;
ATOM service;
ATOM topic;
HWND hwnd;
-};
+} DdeEnumServices;
typedef struct {
Conversation *currentConversations;
@@ -78,7 +78,7 @@ static DWORD ddeInstance; /* The application instance handle given to us
* by DdeInitialize. */
static int ddeIsServer = 0;
-#define TCL_DDE_VERSION "1.4.0"
+#define TCL_DDE_VERSION "1.4.1"
#define TCL_DDE_PACKAGE_NAME "dde"
#define TCL_DDE_SERVICE_NAME TEXT("TclEval")
#define TCL_DDE_EXECUTE_RESULT TEXT("$TCLEVAL$EXECUTE$RESULT")
@@ -95,7 +95,7 @@ TCL_DECLARE_MUTEX(ddeMutex)
static LRESULT CALLBACK DdeClientWindowProc(HWND hwnd, UINT uMsg,
WPARAM wParam, LPARAM lParam);
-static int DdeCreateClient(struct DdeEnumServices *es);
+static int DdeCreateClient(DdeEnumServices *es);
static BOOL CALLBACK DdeEnumWindowsCallback(HWND hwndTarget,
LPARAM lParam);
static void DdeExitProc(ClientData clientData);
@@ -116,8 +116,9 @@ static int DdeObjCmd(ClientData clientData,
Tcl_Interp *interp, int objc,
Tcl_Obj *const objv[]);
-DLLEXPORT int Dde_Init(Tcl_Interp *interp);
-DLLEXPORT int Dde_SafeInit(Tcl_Interp *interp);
+
+DLLEXPORT int Dde_Init(Tcl_Interp *interp);
+DLLEXPORT int Dde_SafeInit(Tcl_Interp *interp);
/*
*----------------------------------------------------------------------
@@ -388,9 +389,9 @@ DdeSetServerName(
* We have found a unique name. Now add it to the registry.
*/
- riPtr = ckalloc(sizeof(RegisteredInterp));
+ riPtr = (RegisteredInterp *) Tcl_Alloc(sizeof(RegisteredInterp));
riPtr->interp = interp;
- riPtr->name = ckalloc((_tcslen(actualName) + 1) * sizeof(TCHAR));
+ riPtr->name = (TCHAR *) Tcl_Alloc((_tcslen(actualName) + 1) * sizeof(TCHAR));
riPtr->nextPtr = tsdPtr->interpListPtr;
riPtr->handlerPtr = handlerPtr;
if (riPtr->handlerPtr != NULL) {
@@ -491,7 +492,7 @@ DeleteProc(
prevPtr->nextPtr = searchPtr->nextPtr;
}
}
- ckfree(riPtr->name);
+ Tcl_Free((char *) riPtr->name);
if (riPtr->handlerPtr) {
Tcl_DecrRefCount(riPtr->handlerPtr);
}
@@ -529,7 +530,7 @@ ExecuteRemoteObject(
Tcl_Obj *returnPackagePtr;
int result = TCL_OK;
- if (riPtr->handlerPtr == NULL && Tcl_IsSafe(riPtr->interp)) {
+ if ((riPtr->handlerPtr == NULL) && Tcl_IsSafe(riPtr->interp)) {
Tcl_SetObjResult(riPtr->interp, Tcl_NewStringObj("permission denied: "
"a handler procedure must be defined for use in a safe "
"interp", -1));
@@ -611,7 +612,7 @@ DdeServerProc(
/* Transaction-dependent data. */
{
Tcl_DString dString;
- int len;
+ size_t len;
DWORD dlen;
TCHAR *utilString;
Tcl_Obj *ddeObjectPtr;
@@ -661,7 +662,7 @@ DdeServerProc(
for (riPtr = tsdPtr->interpListPtr; riPtr != NULL;
riPtr = riPtr->nextPtr) {
if (_tcsicmp(riPtr->name, utilString) == 0) {
- convPtr = ckalloc(sizeof(Conversation));
+ convPtr = (Conversation *) Tcl_Alloc(sizeof(Conversation));
convPtr->nextPtr = tsdPtr->currentConversations;
convPtr->returnPackagePtr = NULL;
convPtr->hConv = hConv;
@@ -691,7 +692,7 @@ DdeServerProc(
if (convPtr->returnPackagePtr != NULL) {
Tcl_DecrRefCount(convPtr->returnPackagePtr);
}
- ckfree(convPtr);
+ Tcl_Free((char *) convPtr);
break;
}
}
@@ -717,22 +718,24 @@ DdeServerProc(
}
if (convPtr != NULL) {
+ Tcl_DString dsBuf;
char *returnString;
len = DdeQueryString(ddeInstance, ddeItem, NULL, 0, CP_WINUNICODE);
Tcl_DStringInit(&dString);
+ Tcl_DStringInit(&dsBuf);
Tcl_DStringSetLength(&dString, (len + 1) * sizeof(TCHAR) - 1);
utilString = (TCHAR *) Tcl_DStringValue(&dString);
DdeQueryString(ddeInstance, ddeItem, utilString, (DWORD) len + 1,
CP_WINUNICODE);
if (_tcsicmp(utilString, TCL_DDE_EXECUTE_RESULT) == 0) {
- if (uFmt == CF_TEXT) {
- returnString =
- Tcl_GetStringFromObj(convPtr->returnPackagePtr, &len);
- } else {
- returnString = (char *)
- Tcl_GetUnicodeFromObj(convPtr->returnPackagePtr, &len);
- len = sizeof(TCHAR) * len + 1;
+ returnString =
+ Tcl_GetString(convPtr->returnPackagePtr);
+ len = convPtr->returnPackagePtr->length;
+ if (uFmt != CF_TEXT) {
+ Tcl_WinUtfToTChar(returnString, len, &dsBuf);
+ returnString = Tcl_DStringValue(&dsBuf);
+ len = Tcl_DStringLength(&dsBuf) + sizeof(TCHAR) - 1;
}
ddeReturn = DdeCreateDataHandle(ddeInstance, (BYTE *)returnString,
(DWORD) len+1, 0, ddeItem, uFmt, 0);
@@ -742,18 +745,18 @@ DdeServerProc(
} else {
Tcl_DString ds;
Tcl_Obj *variableObjPtr;
+
Tcl_WinTCharToUtf(utilString, -1, &ds);
variableObjPtr = Tcl_GetVar2Ex(
convPtr->riPtr->interp, Tcl_DStringValue(&ds), NULL,
TCL_GLOBAL_ONLY);
if (variableObjPtr != NULL) {
- if (uFmt == CF_TEXT) {
- returnString = Tcl_GetStringFromObj(
- variableObjPtr, &len);
- } else {
- returnString = (char *) Tcl_GetUnicodeFromObj(
- variableObjPtr, &len);
- len = sizeof(TCHAR) * len + 1;
+ returnString = Tcl_GetString(variableObjPtr);
+ len = variableObjPtr->length;
+ if (uFmt != CF_TEXT) {
+ Tcl_WinUtfToTChar(returnString, len, &dsBuf);
+ returnString = Tcl_DStringValue(&dsBuf);
+ len = Tcl_DStringLength(&dsBuf) + sizeof(TCHAR) - 1;
}
ddeReturn = DdeCreateDataHandle(ddeInstance,
(BYTE *)returnString, (DWORD) len+1, 0, ddeItem,
@@ -764,6 +767,7 @@ DdeServerProc(
Tcl_DStringFree(&ds);
}
}
+ Tcl_DStringFree(&dsBuf);
Tcl_DStringFree(&dString);
}
return ddeReturn;
@@ -788,26 +792,30 @@ DdeServerProc(
}
if (convPtr && !Tcl_IsSafe(convPtr->riPtr->interp)) {
- Tcl_DString ds;
+ Tcl_DString ds, ds2;
Tcl_Obj *variableObjPtr;
+ DWORD len2;
- len = DdeQueryString(ddeInstance, ddeItem, NULL, 0, CP_WINUNICODE);
Tcl_DStringInit(&dString);
+ Tcl_DStringInit(&ds2);
+ len = DdeQueryString(ddeInstance, ddeItem, NULL, 0, CP_WINUNICODE);
Tcl_DStringSetLength(&dString, (len + 1) * sizeof(TCHAR) - 1);
utilString = (TCHAR *) Tcl_DStringValue(&dString);
DdeQueryString(ddeInstance, ddeItem, utilString, (DWORD) len + 1,
CP_WINUNICODE);
Tcl_WinTCharToUtf(utilString, -1, &ds);
- utilString = (TCHAR *) DdeAccessData(hData, &dlen);
- if (uFmt == CF_TEXT) {
- variableObjPtr = Tcl_NewStringObj((char *)utilString, -1);
- } else {
- variableObjPtr = Tcl_NewUnicodeObj(utilString, -1);
+ utilString = (TCHAR *) DdeAccessData(hData, &len2);
+ len = len2;
+ if (uFmt != CF_TEXT) {
+ Tcl_WinTCharToUtf(utilString, -1, &ds2);
+ utilString = (TCHAR *) Tcl_DStringValue(&ds2);
}
+ variableObjPtr = Tcl_NewStringObj((char *)utilString, -1);
Tcl_SetVar2Ex(convPtr->riPtr->interp, Tcl_DStringValue(&ds), NULL,
variableObjPtr, TCL_GLOBAL_ONLY);
+ Tcl_DStringFree(&ds2);
Tcl_DStringFree(&ds);
Tcl_DStringFree(&dString);
ddeReturn = (HDDEDATA) DDE_FACK;
@@ -848,8 +856,12 @@ DdeServerProc(
ddeObjectPtr = Tcl_NewStringObj(string, dlen);
} else {
/* unicode */
- dlen >>= 1;
- ddeObjectPtr = Tcl_NewUnicodeObj((Tcl_UniChar *)utilString, dlen - 1);
+ Tcl_DString dsBuf;
+
+ Tcl_WinTCharToUtf(utilString, dlen - sizeof(TCHAR), &dsBuf);
+ ddeObjectPtr = Tcl_NewStringObj(Tcl_DStringValue(&dsBuf),
+ Tcl_DStringLength(&dsBuf));
+ Tcl_DStringFree(&dsBuf);
}
Tcl_IncrRefCount(ddeObjectPtr);
DdeUnaccessData(hData);
@@ -1014,7 +1026,7 @@ MakeDdeConnection(
static int
DdeCreateClient(
- struct DdeEnumServices *es)
+ DdeEnumServices *es)
{
WNDCLASSEX wc;
static const TCHAR *szDdeClientClassName = TEXT("TclEval client class");
@@ -1024,7 +1036,7 @@ DdeCreateClient(
wc.cbSize = sizeof(wc);
wc.lpfnWndProc = DdeClientWindowProc;
wc.lpszClassName = szDdeClientClassName;
- wc.cbWndExtra = sizeof(struct DdeEnumServices *);
+ wc.cbWndExtra = sizeof(DdeEnumServices *);
/*
* Register and create the callback window.
@@ -1046,8 +1058,8 @@ DdeClientWindowProc(
switch (uMsg) {
case WM_CREATE: {
LPCREATESTRUCT lpcs = (LPCREATESTRUCT) lParam;
- struct DdeEnumServices *es =
- (struct DdeEnumServices *) lpcs->lpCreateParams;
+ DdeEnumServices *es =
+ (DdeEnumServices *) lpcs->lpCreateParams;
#ifdef _WIN64
SetWindowLongPtr(hwnd, GWLP_USERDATA, (LONG_PTR) es);
@@ -1072,18 +1084,18 @@ DdeServicesOnAck(
HWND hwndRemote = (HWND)wParam;
ATOM service = (ATOM)LOWORD(lParam);
ATOM topic = (ATOM)HIWORD(lParam);
- struct DdeEnumServices *es;
+ DdeEnumServices *es;
TCHAR sz[255];
Tcl_DString dString;
#ifdef _WIN64
- es = (struct DdeEnumServices *) GetWindowLongPtr(hwnd, GWLP_USERDATA);
+ es = (DdeEnumServices *) GetWindowLongPtr(hwnd, GWLP_USERDATA);
#else
- es = (struct DdeEnumServices *) GetWindowLong(hwnd, GWL_USERDATA);
+ es = (DdeEnumServices *) GetWindowLong(hwnd, GWL_USERDATA);
#endif
- if ((es->service == (ATOM)0 || es->service == service)
- && (es->topic == (ATOM)0 || es->topic == topic)) {
+ if (((es->service == (ATOM)0) || (es->service == service))
+ && ((es->topic == (ATOM)0) || (es->topic == topic))) {
Tcl_Obj *matchPtr = Tcl_NewListObj(0, NULL);
Tcl_Obj *resultPtr = Tcl_GetObjResult(es->interp);
@@ -1130,7 +1142,7 @@ DdeEnumWindowsCallback(
LPARAM lParam)
{
DWORD_PTR dwResult = 0;
- struct DdeEnumServices *es = (struct DdeEnumServices *) lParam;
+ DdeEnumServices *es = (DdeEnumServices *) lParam;
SendMessageTimeout(hwndTarget, WM_DDE_INITIATE, (WPARAM)es->hwnd,
MAKELONG(es->service, es->topic), SMTO_ABORTIFHUNG, 1000,
@@ -1144,7 +1156,7 @@ DdeGetServicesList(
const TCHAR *serviceName,
const TCHAR *topicName)
{
- struct DdeEnumServices es;
+ DdeEnumServices es;
es.interp = interp;
es.result = TCL_OK;
@@ -1265,7 +1277,8 @@ DdeObjCmd(
"-binary", NULL
};
- int index, i, length, argIndex;
+ int index, i, argIndex;
+ int length;
int flags = 0, result = TCL_OK, firstArg = 0;
HSZ ddeService = NULL, ddeTopic = NULL, ddeItem = NULL, ddeCookie = NULL;
HDDEDATA ddeData = NULL, ddeItemData = NULL, ddeReturn;
@@ -1274,6 +1287,7 @@ DdeObjCmd(
const char *string;
DWORD ddeResult;
Tcl_Obj *objPtr, *handlerPtr = NULL;
+ Tcl_DString serviceBuf, topicBuf, itemBuf;
/*
* Initialize DDE server/client
@@ -1289,6 +1303,9 @@ DdeObjCmd(
return TCL_ERROR;
}
+ Tcl_DStringInit(&serviceBuf);
+ Tcl_DStringInit(&topicBuf);
+ Tcl_DStringInit(&itemBuf);
switch ((enum DdeSubcommands) index) {
case DDE_SERVERNAME:
for (i = 2; i < objc; i++) {
@@ -1338,7 +1355,7 @@ DdeObjCmd(
if (objc == 5) {
firstArg = 2;
break;
- } else if (objc >= 6 && objc <= 7) {
+ } else if ((objc >= 6) && (objc <= 7)) {
firstArg = objc - 3;
for (i = 2; i < firstArg; i++) {
if (Tcl_GetIndexFromObj(interp, objv[i], ddeExecOptions,
@@ -1423,7 +1440,12 @@ DdeObjCmd(
Initialize();
if (firstArg != 1) {
- serviceName = Tcl_GetUnicodeFromObj(objv[firstArg], &length);
+ const char *src = Tcl_GetString(objv[firstArg]);
+
+ length = objv[firstArg]->length;
+ Tcl_WinUtfToTChar(src, length, &serviceBuf);
+ serviceName = (TCHAR *) Tcl_DStringValue(&serviceBuf);
+ length = Tcl_DStringLength(&serviceBuf) / sizeof(TCHAR);
} else {
length = 0;
}
@@ -1436,7 +1458,11 @@ DdeObjCmd(
}
if ((index != DDE_SERVERNAME) && (index != DDE_EVAL)) {
- topicName = (TCHAR *) Tcl_GetUnicodeFromObj(objv[firstArg + 1], &length);
+ const char *src = Tcl_GetString(objv[firstArg + 1]);
+
+ length = objv[firstArg + 1]->length;
+ topicName = Tcl_WinUtfToTChar(src, length, &topicBuf);
+ length = Tcl_DStringLength(&topicBuf) / sizeof(TCHAR);
if (length == 0) {
topicName = NULL;
} else {
@@ -1450,7 +1476,12 @@ DdeObjCmd(
serviceName = DdeSetServerName(interp, serviceName, flags,
handlerPtr);
if (serviceName != NULL) {
- Tcl_SetObjResult(interp, Tcl_NewUnicodeObj((Tcl_UniChar *) serviceName, -1));
+ Tcl_DString dsBuf;
+
+ Tcl_WinTCharToUtf(serviceName, -1, &dsBuf);
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(Tcl_DStringValue(&dsBuf),
+ Tcl_DStringLength(&dsBuf)));
+ Tcl_DStringFree(&dsBuf);
} else {
Tcl_ResetResult(interp);
}
@@ -1458,20 +1489,27 @@ DdeObjCmd(
case DDE_EXECUTE: {
int dataLength;
- const Tcl_UniChar *dataString;
+ const void *dataString;
+ Tcl_DString dsBuf;
+ Tcl_DStringInit(&dsBuf);
if (flags & DDE_FLAG_BINARY) {
- dataString = (const Tcl_UniChar *)
+ dataString =
Tcl_GetByteArrayFromObj(objv[firstArg + 2], &dataLength);
} else {
- dataString =
- Tcl_GetUnicodeFromObj(objv[firstArg + 2], &dataLength);
- dataLength = (dataLength + 1) * sizeof(Tcl_UniChar);
+ const char *src;
+
+ src = Tcl_GetString(objv[firstArg + 2]);
+ dataLength = objv[firstArg + 2]->length;
+ dataString = (const TCHAR *)
+ Tcl_WinUtfToTChar(src, dataLength, &dsBuf);
+ dataLength = Tcl_DStringLength(&dsBuf) + sizeof(TCHAR);
}
- if (dataLength <= 0) {
+ if (dataLength + 1 < 2) {
Tcl_SetObjResult(interp,
Tcl_NewStringObj("cannot execute null data", -1));
+ Tcl_DStringFree(&dsBuf);
Tcl_SetErrorCode(interp, "TCL", "DDE", "NULL", NULL);
result = TCL_ERROR;
break;
@@ -1481,6 +1519,7 @@ DdeObjCmd(
DdeFreeStringHandle(ddeInstance, ddeTopic);
if (hConv == NULL) {
+ Tcl_DStringFree(&dsBuf);
SetDdeError(interp);
result = TCL_ERROR;
break;
@@ -1506,11 +1545,17 @@ DdeObjCmd(
SetDdeError(interp);
result = TCL_ERROR;
}
+ Tcl_DStringFree(&dsBuf);
break;
}
case DDE_REQUEST: {
- const TCHAR *itemString = (TCHAR *) Tcl_GetUnicodeFromObj(objv[firstArg + 2],
- &length);
+ const TCHAR *itemString;
+ const char *src;
+
+ src = Tcl_GetString(objv[firstArg + 2]);
+ length = objv[firstArg + 2]->length;
+ itemString = Tcl_WinUtfToTChar(src, length, &itemBuf);
+ length = Tcl_DStringLength(&itemBuf) / sizeof(TCHAR);
if (length == 0) {
Tcl_SetObjResult(interp,
@@ -1538,18 +1583,23 @@ DdeObjCmd(
result = TCL_ERROR;
} else {
DWORD tmp;
- const Tcl_UniChar *dataString = (const Tcl_UniChar *) DdeAccessData(ddeData, &tmp);
+ TCHAR *dataString = (TCHAR *) DdeAccessData(ddeData, &tmp);
if (flags & DDE_FLAG_BINARY) {
returnObjPtr =
- Tcl_NewByteArrayObj((BYTE *) dataString, (int) tmp);
+ Tcl_NewByteArrayObj((BYTE *) dataString, tmp);
} else {
- tmp >>= 1;
- if (tmp && !dataString[(tmp-1)]) {
- --tmp;
+ Tcl_DString dsBuf;
+
+ if ((tmp >= sizeof(TCHAR))
+ && !dataString[tmp / sizeof(TCHAR) - 1]) {
+ tmp -= sizeof(TCHAR);
}
- returnObjPtr = Tcl_NewUnicodeObj(dataString,
- (int) tmp);
+ Tcl_WinTCharToUtf(dataString, tmp, &dsBuf);
+ returnObjPtr =
+ Tcl_NewStringObj(Tcl_DStringValue(&dsBuf),
+ Tcl_DStringLength(&dsBuf));
+ Tcl_DStringFree(&dsBuf);
}
DdeUnaccessData(ddeData);
DdeFreeDataHandle(ddeData);
@@ -1560,14 +1610,18 @@ DdeObjCmd(
result = TCL_ERROR;
}
}
-
break;
}
case DDE_POKE: {
- const TCHAR *itemString = (TCHAR *) Tcl_GetUnicodeFromObj(objv[firstArg + 2],
- &length);
+ Tcl_DString dsBuf;
+ const TCHAR *itemString;
BYTE *dataString;
+ const char *src;
+ src = Tcl_GetString(objv[firstArg + 2]);
+ length = objv[firstArg + 2]->length;
+ itemString = Tcl_WinUtfToTChar(src, length, &itemBuf);
+ length = Tcl_DStringLength(&itemBuf) / sizeof(TCHAR);
if (length == 0) {
Tcl_SetObjResult(interp,
Tcl_NewStringObj("cannot have a null item", -1));
@@ -1575,13 +1629,17 @@ DdeObjCmd(
result = TCL_ERROR;
goto cleanup;
}
+ Tcl_DStringInit(&dsBuf);
if (flags & DDE_FLAG_BINARY) {
dataString = (BYTE *)
Tcl_GetByteArrayFromObj(objv[firstArg + 3], &length);
} else {
+ const char *data =
+ Tcl_GetString(objv[firstArg + 3]);
+ length = objv[firstArg + 3]->length;
dataString = (BYTE *)
- Tcl_GetUnicodeFromObj(objv[firstArg + 3], &length);
- length = 2 * length + 1;
+ Tcl_WinUtfToTChar(data, length, &dsBuf);
+ length = Tcl_DStringLength(&dsBuf) + sizeof(TCHAR);
}
hConv = DdeConnect(ddeInstance, ddeService, ddeTopic, NULL);
@@ -1606,6 +1664,7 @@ DdeObjCmd(
result = TCL_ERROR;
}
}
+ Tcl_DStringFree(&dsBuf);
break;
}
@@ -1664,7 +1723,7 @@ DdeObjCmd(
* referring to deallocated objects.
*/
- if (Tcl_IsSafe(riPtr->interp) && riPtr->handlerPtr == NULL) {
+ if (Tcl_IsSafe(riPtr->interp) && (riPtr->handlerPtr == NULL)) {
Tcl_SetObjResult(riPtr->interp, Tcl_NewStringObj(
"permission denied: a handler procedure must be"
" defined for use in a safe interp", -1));
@@ -1723,6 +1782,8 @@ DdeObjCmd(
Tcl_Release(riPtr);
Tcl_Release(sendInterp);
} else {
+ Tcl_DString dsBuf;
+
/*
* This is a non-local request. Send the script to the server and
* poll it for a result.
@@ -1738,9 +1799,14 @@ DdeObjCmd(
}
objPtr = Tcl_ConcatObj(objc, objv);
- string = (const char *) Tcl_GetUnicodeFromObj(objPtr, &length);
- ddeItemData = DdeCreateDataHandle(ddeInstance,
- (BYTE *) string, (DWORD) 2*length+2, 0, 0, CF_UNICODETEXT, 0);
+ string = Tcl_GetString(objPtr);
+ length = objPtr->length;
+ Tcl_WinUtfToTChar(string, length, &dsBuf);
+ string = Tcl_DStringValue(&dsBuf);
+ length = Tcl_DStringLength(&dsBuf) + sizeof(TCHAR);
+ ddeItemData = DdeCreateDataHandle(ddeInstance, (BYTE *) string,
+ (DWORD) length, 0, 0, CF_UNICODETEXT, 0);
+ Tcl_DStringFree(&dsBuf);
if (flags & DDE_FLAG_ASYNC) {
ddeData = DdeClientTransaction((LPBYTE) ddeItemData,
@@ -1769,7 +1835,7 @@ DdeObjCmd(
if (!(flags & DDE_FLAG_ASYNC)) {
Tcl_Obj *resultPtr;
- Tcl_UniChar *ddeDataString;
+ TCHAR *ddeDataString;
/*
* The return handle has a two or four element list in it. The
@@ -1780,13 +1846,17 @@ DdeObjCmd(
* variable "errorInfo".
*/
- resultPtr = Tcl_NewObj();
length = DdeGetData(ddeData, NULL, 0, 0);
- ddeDataString = ckalloc(length);
+ ddeDataString = (TCHAR *) Tcl_Alloc(length);
DdeGetData(ddeData, (BYTE *) ddeDataString, (DWORD) length, 0);
- length = (length >> 1) - 1;
- resultPtr = Tcl_NewUnicodeObj(ddeDataString, length);
- ckfree(ddeDataString);
+ if (length > sizeof(TCHAR)) {
+ length -= sizeof(TCHAR);
+ }
+ Tcl_WinTCharToUtf(ddeDataString, length, &dsBuf);
+ resultPtr = Tcl_NewStringObj(Tcl_DStringValue(&dsBuf),
+ Tcl_DStringLength(&dsBuf));
+ Tcl_DStringFree(&dsBuf);
+ Tcl_Free((char *) ddeDataString);
if (Tcl_ListObjIndex(NULL, resultPtr, 0, &objPtr) != TCL_OK) {
Tcl_DecrRefCount(resultPtr);
@@ -1836,6 +1906,9 @@ DdeObjCmd(
if (hConv != NULL) {
DdeDisconnect(hConv);
}
+ Tcl_DStringFree(&itemBuf);
+ Tcl_DStringFree(&topicBuf);
+ Tcl_DStringFree(&serviceBuf);
return result;
}
diff --git a/win/tclWinReg.c b/win/tclWinReg.c
index f3d7a07..0d2cd94 100644
--- a/win/tclWinReg.c
+++ b/win/tclWinReg.c
@@ -492,7 +492,6 @@ DeleteValue(
{
HKEY key;
char *valueName;
- size_t length;
DWORD result;
Tcl_DString ds;
@@ -506,8 +505,7 @@ DeleteValue(
}
valueName = Tcl_GetString(valueNameObj);
- length = valueNameObj->length;
- Tcl_WinUtfToTChar(valueName, length, &ds);
+ Tcl_WinUtfToTChar(valueName, valueNameObj->length, &ds);
result = RegDeleteValue(key, (const TCHAR *)Tcl_DStringValue(&ds));
Tcl_DStringFree(&ds);
if (result != ERROR_SUCCESS) {
@@ -647,7 +645,6 @@ GetType(
Tcl_DString ds;
const char *valueName;
const TCHAR *nativeValue;
- size_t length;
/*
* Attempt to open the key for reading.
@@ -663,8 +660,7 @@ GetType(
*/
valueName = Tcl_GetString(valueNameObj);
- length = valueNameObj->length;
- nativeValue = Tcl_WinUtfToTChar(valueName, length, &ds);
+ nativeValue = Tcl_WinUtfToTChar(valueName, valueNameObj->length, &ds);
result = RegQueryValueEx(key, nativeValue, NULL, &type,
NULL, NULL);
Tcl_DStringFree(&ds);
@@ -720,7 +716,6 @@ GetValue(
const TCHAR *nativeValue;
DWORD result, length, type;
Tcl_DString data, buf;
- size_t nameLen;
/*
* Attempt to open the key for reading.
@@ -746,8 +741,7 @@ GetValue(
length = TCL_DSTRING_STATIC_SIZE/sizeof(TCHAR) - 1;
valueName = Tcl_GetString(valueNameObj);
- nameLen = valueNameObj->length;
- nativeValue = Tcl_WinUtfToTChar(valueName, nameLen, &buf);
+ nativeValue = Tcl_WinUtfToTChar(valueName, valueNameObj->length, &buf);
result = RegQueryValueEx(key, nativeValue, NULL, &type,
(BYTE *) Tcl_DStringValue(&data), &length);
@@ -936,13 +930,11 @@ OpenKey(
HKEY *keyPtr) /* Returned HKEY. */
{
char *keyName, *buffer, *hostName;
- size_t length;
HKEY rootKey;
DWORD result;
keyName = Tcl_GetString(keyNameObj);
- length = keyNameObj->length;
- buffer = Tcl_Alloc(length + 1);
+ buffer = Tcl_Alloc(keyNameObj->length + 1);
strcpy(buffer, keyName);
result = ParseKeyName(interp, buffer, &hostName, &rootKey, &keyName);
@@ -1244,7 +1236,6 @@ SetValue(
REGSAM mode) /* Mode flags to pass. */
{
int type;
- size_t length;
DWORD result;
HKEY key;
const char *valueName;
@@ -1265,8 +1256,7 @@ SetValue(
}
valueName = Tcl_GetString(valueNameObj);
- length = valueNameObj->length;
- valueName = (char *) Tcl_WinUtfToTChar(valueName, length, &nameBuf);
+ valueName = (char *) Tcl_WinUtfToTChar(valueName, valueNameObj->length, &nameBuf);
if (type == REG_DWORD || type == REG_DWORD_BIG_ENDIAN) {
int value;
@@ -1301,8 +1291,7 @@ SetValue(
for (i = 0; i < objc; i++) {
const char *bytes = Tcl_GetString(objv[i]);
- length = objv[i]->length;
- Tcl_DStringAppend(&data, bytes, length);
+ Tcl_DStringAppend(&data, bytes, objv[i]->length);
/*
* Add a null character to separate this value from the next.
@@ -1322,18 +1311,16 @@ SetValue(
Tcl_DString buf;
const char *data = Tcl_GetString(dataObj);
- length = dataObj->length;
- data = (char *) Tcl_WinUtfToTChar(data, length, &buf);
+ data = (char *) Tcl_WinUtfToTChar(data, dataObj->length, &buf);
/*
* Include the null in the length, padding if needed for WCHAR.
*/
Tcl_DStringSetLength(&buf, Tcl_DStringLength(&buf)+1);
- length = Tcl_DStringLength(&buf) + 1;
result = RegSetValueEx(key, (TCHAR *) valueName, 0,
- (DWORD) type, (BYTE *) data, (DWORD) length);
+ (DWORD) type, (BYTE *) data, (DWORD) Tcl_DStringLength(&buf) + 1);
Tcl_DStringFree(&buf);
} else {
BYTE *data;
@@ -1404,8 +1391,7 @@ BroadcastValue(
}
str = Tcl_GetString(objv[0]);
- len = objv[0]->length;
- wstr = (WCHAR *) Tcl_WinUtfToTChar(str, len, &ds);
+ wstr = (WCHAR *) Tcl_WinUtfToTChar(str, objv[0]->length, &ds);
if (Tcl_DStringLength(&ds) == 0) {
wstr = NULL;
}