summaryrefslogtreecommitdiffstats
path: root/win/tclWinDde.c
diff options
context:
space:
mode:
Diffstat (limited to 'win/tclWinDde.c')
-rw-r--r--win/tclWinDde.c148
1 files changed, 86 insertions, 62 deletions
diff --git a/win/tclWinDde.c b/win/tclWinDde.c
index 7e20da7..d508c02 100644
--- a/win/tclWinDde.c
+++ b/win/tclWinDde.c
@@ -10,10 +10,20 @@
* this file, and for a DISCLAIMER OF ALL WARRANTIES.
*/
+#undef STATIC_BUILD
+#undef USE_TCL_STUBS
+#define USE_TCL_STUBS
+#undef UNICODE
+#undef _UNICODE
#include "tclInt.h"
#include <dde.h>
#include <ddeml.h>
+#ifndef UNICODE
+# undef CP_WINUNICODE
+# define CP_WINUNICODE CP_WINANSI
+#endif
+
/*
* TCL_STORAGE_CLASS is set unconditionally to DLLEXPORT because the Dde_Init
* declaration is in the source file itself, which is only accessed when we
@@ -33,7 +43,7 @@ typedef struct RegisteredInterp {
struct RegisteredInterp *nextPtr;
/* The next interp this application knows
* about. */
- char *name; /* Interpreter's name (malloc-ed). */
+ TCHAR *name; /* Interpreter's name (malloc-ed). */
Tcl_Obj *handlerPtr; /* The server handler command */
Tcl_Interp *interp; /* The interpreter attached to this name. */
} RegisteredInterp;
@@ -80,8 +90,8 @@ static int ddeIsServer = 0;
#define TCL_DDE_VERSION "1.3.3"
#define TCL_DDE_PACKAGE_NAME "dde"
-#define TCL_DDE_SERVICE_NAME "TclEval"
-#define TCL_DDE_EXECUTE_RESULT "$TCLEVAL$EXECUTE$RESULT"
+#define TCL_DDE_SERVICE_NAME TEXT("TclEval")
+#define TCL_DDE_EXECUTE_RESULT TEXT("$TCLEVAL$EXECUTE$RESULT")
TCL_DECLARE_MUTEX(ddeMutex)
@@ -96,7 +106,7 @@ static BOOL CALLBACK DdeEnumWindowsCallback(HWND hwndTarget,
LPARAM lParam);
static void DdeExitProc(ClientData clientData);
static int DdeGetServicesList(Tcl_Interp *interp,
- const char *serviceName, const char *topicName);
+ const TCHAR *serviceName, const TCHAR *topicName);
static HDDEDATA CALLBACK DdeServerProc(UINT uType, UINT uFmt, HCONV hConv,
HSZ ddeTopic, HSZ ddeItem, HDDEDATA hData,
DWORD dwData1, DWORD dwData2);
@@ -106,7 +116,7 @@ static void DeleteProc(ClientData clientData);
static Tcl_Obj * ExecuteRemoteObject(RegisteredInterp *riPtr,
Tcl_Obj *ddeObjectPtr);
static int MakeDdeConnection(Tcl_Interp *interp,
- const char *name, HCONV *ddeConvPtr);
+ const TCHAR *name, HCONV *ddeConvPtr);
static void SetDdeError(Tcl_Interp *interp);
static int DdeObjCmd(ClientData clientData,
Tcl_Interp *interp, int objc,
@@ -259,10 +269,10 @@ Initialize(void)
*----------------------------------------------------------------------
*/
-static const char *
+static const TCHAR *
DdeSetServerName(
Tcl_Interp *interp,
- const char *name, /* The name that will be used to refer to the
+ const TCHAR *name, /* The name that will be used to refer to the
* interpreter in later "send" commands. Must
* be globally unique. */
int exactName, /* Should we make a unique name? 0 = unique */
@@ -272,7 +282,7 @@ DdeSetServerName(
int suffix, offset;
RegisteredInterp *riPtr, *prevPtr;
Tcl_DString dString;
- const char *actualName;
+ const TCHAR *actualName;
Tcl_Obj *srvListPtr = NULL, **srvPtrPtr = NULL;
int n, srvCount = 0, lastSuffix, r = TCL_OK;
ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
@@ -310,15 +320,16 @@ DdeSetServerName(
* current interp, but it doesn't have a name.
*/
- return "";
+ return TEXT("");
}
+ Tcl_DStringInit(&dString);
+
/*
* Get the list of currently registered Tcl interpreters by calling the
* internal implementation of the 'dde services' command.
*/
- Tcl_DStringInit(&dString);
actualName = name;
if (!exactName) {
@@ -365,7 +376,7 @@ DdeSetServerName(
Tcl_Obj* namePtr;
Tcl_ListObjIndex(interp, srvPtrPtr[n], 1, &namePtr);
- if (strcmp(actualName, Tcl_GetString(namePtr)) == 0) {
+ if (_tcscmp(actualName, Tcl_GetString(namePtr)) == 0) {
suffix++;
break;
}
@@ -379,23 +390,23 @@ DdeSetServerName(
* We have found a unique name. Now add it to the registry.
*/
- riPtr = (RegisteredInterp *) ckalloc(sizeof(RegisteredInterp));
+ riPtr = ckalloc(sizeof(RegisteredInterp));
riPtr->interp = interp;
- riPtr->name = ckalloc((unsigned int) strlen(actualName) + 1);
+ riPtr->name = ckalloc((_tcslen(actualName) + 1) * sizeof(TCHAR));
riPtr->nextPtr = tsdPtr->interpListPtr;
riPtr->handlerPtr = handlerPtr;
if (riPtr->handlerPtr != NULL) {
Tcl_IncrRefCount(riPtr->handlerPtr);
}
tsdPtr->interpListPtr = riPtr;
- strcpy(riPtr->name, actualName);
+ _tcscpy(riPtr->name, actualName);
if (Tcl_IsSafe(interp)) {
Tcl_ExposeCommand(interp, "dde", "dde");
}
Tcl_CreateObjCommand(interp, "dde", DdeObjCmd,
- (ClientData) riPtr, DeleteProc);
+ riPtr, DeleteProc);
if (Tcl_IsSafe(interp)) {
Tcl_HideCommand(interp, "dde", "dde");
}
@@ -524,6 +535,7 @@ ExecuteRemoteObject(
Tcl_SetObjResult(riPtr->interp, Tcl_NewStringObj("permission denied: "
"a handler procedure must be defined for use in a safe "
"interp", -1));
+ Tcl_SetErrorCode(riPtr->interp, "TCL", "DDE", "SECURITY_CHECK", NULL);
result = TCL_ERROR;
}
@@ -603,7 +615,7 @@ DdeServerProc(
Tcl_DString dString;
int len;
DWORD dlen;
- char *utilString;
+ TCHAR *utilString;
Tcl_Obj *ddeObjectPtr;
HDDEDATA ddeReturn = NULL;
RegisteredInterp *riPtr;
@@ -619,14 +631,14 @@ DdeServerProc(
len = DdeQueryString(ddeInstance, ddeTopic, NULL, 0, 0);
Tcl_DStringInit(&dString);
- Tcl_DStringSetLength(&dString, len);
- utilString = Tcl_DStringValue(&dString);
+ Tcl_DStringSetLength(&dString, (len + 1) * sizeof(TCHAR) - 1);
+ utilString = (TCHAR *) Tcl_DStringValue(&dString);
DdeQueryString(ddeInstance, ddeTopic, utilString, (DWORD) len + 1,
- CP_WINANSI);
+ CP_WINUNICODE);
for (riPtr = tsdPtr->interpListPtr; riPtr != NULL;
riPtr = riPtr->nextPtr) {
- if (stricmp(utilString, riPtr->name) == 0) {
+ if (_tcsicmp(utilString, riPtr->name) == 0) {
Tcl_DStringFree(&dString);
return (HDDEDATA) TRUE;
}
@@ -644,14 +656,14 @@ DdeServerProc(
len = DdeQueryString(ddeInstance, ddeTopic, NULL, 0, 0);
Tcl_DStringInit(&dString);
- Tcl_DStringSetLength(&dString, len);
- utilString = Tcl_DStringValue(&dString);
+ Tcl_DStringSetLength(&dString, (len + 1) * sizeof(TCHAR) - 1);
+ utilString = (TCHAR *) Tcl_DStringValue(&dString);
DdeQueryString(ddeInstance, ddeTopic, utilString, (DWORD) len + 1,
- CP_WINANSI);
+ CP_WINUNICODE);
for (riPtr = tsdPtr->interpListPtr; riPtr != NULL;
riPtr = riPtr->nextPtr) {
- if (stricmp(riPtr->name, utilString) == 0) {
- convPtr = (Conversation *) ckalloc(sizeof(Conversation));
+ if (_tcsicmp(riPtr->name, utilString) == 0) {
+ convPtr = ckalloc(sizeof(Conversation));
convPtr->nextPtr = tsdPtr->currentConversations;
convPtr->returnPackagePtr = NULL;
convPtr->hConv = hConv;
@@ -681,7 +693,7 @@ DdeServerProc(
if (convPtr->returnPackagePtr != NULL) {
Tcl_DecrRefCount(convPtr->returnPackagePtr);
}
- ckfree((char *) convPtr);
+ ckfree(convPtr);
break;
}
}
@@ -709,13 +721,13 @@ DdeServerProc(
if (convPtr != NULL) {
char *returnString;
- len = DdeQueryString(ddeInstance, ddeItem, NULL, 0, CP_WINANSI);
+ len = DdeQueryString(ddeInstance, ddeItem, NULL, 0, CP_WINUNICODE);
Tcl_DStringInit(&dString);
- Tcl_DStringSetLength(&dString, len);
- utilString = Tcl_DStringValue(&dString);
+ Tcl_DStringSetLength(&dString, (len + 1) * sizeof(TCHAR) - 1);
+ utilString = (TCHAR *) Tcl_DStringValue(&dString);
DdeQueryString(ddeInstance, ddeItem, utilString, (DWORD) len + 1,
- CP_WINANSI);
- if (stricmp(utilString, TCL_DDE_EXECUTE_RESULT) == 0) {
+ CP_WINUNICODE);
+ if (_tcsicmp(utilString, TCL_DDE_EXECUTE_RESULT) == 0) {
if (uFmt == CF_TEXT) {
returnString =
Tcl_GetStringFromObj(convPtr->returnPackagePtr, &len);
@@ -773,7 +785,7 @@ DdeServerProc(
return (HDDEDATA) DDE_FNOTPROCESSED;
}
- utilString = (char *) DdeAccessData(hData, &dlen);
+ utilString = (TCHAR *) DdeAccessData(hData, &dlen);
len = dlen;
if (len && !utilString[len-1]) {
len--;
@@ -830,9 +842,9 @@ DdeServerProc(
for (i = 0, riPtr = tsdPtr->interpListPtr; i < numItems;
i++, riPtr = riPtr->nextPtr) {
returnPtr[i].hszSvc = DdeCreateStringHandle(ddeInstance,
- TCL_DDE_SERVICE_NAME, CP_WINANSI);
+ TCL_DDE_SERVICE_NAME, CP_WINUNICODE);
returnPtr[i].hszTopic = DdeCreateStringHandle(ddeInstance,
- riPtr->name, CP_WINANSI);
+ riPtr->name, CP_WINUNICODE);
}
returnPtr[i].hszSvc = NULL;
returnPtr[i].hszTopic = NULL;
@@ -890,7 +902,7 @@ DdeExitProc(
static int
MakeDdeConnection(
Tcl_Interp *interp, /* Used to report errors. */
- const char *name, /* The connection to use. */
+ const TCHAR *name, /* The connection to use. */
HCONV *ddeConvPtr)
{
HSZ ddeTopic, ddeService;
@@ -907,6 +919,7 @@ MakeDdeConnection(
if (interp != NULL) {
Tcl_AppendResult(interp, "no registered server named \"",
name, "\"", NULL);
+ Tcl_SetErrorCode(interp, "TCL", "DDE", "NO_SERVER", NULL);
}
return TCL_ERROR;
}
@@ -940,8 +953,8 @@ DdeCreateClient(
struct DdeEnumServices *es)
{
WNDCLASSEX wc;
- static const char *szDdeClientClassName = "TclEval client class";
- static const char *szDdeClientWindowName = "TclEval client window";
+ static const TCHAR *szDdeClientClassName = TEXT("TclEval client class");
+ static const TCHAR *szDdeClientWindowName = TEXT("TclEval client window");
memset(&wc, 0, sizeof(wc));
wc.cbSize = sizeof(wc);
@@ -966,7 +979,6 @@ DdeClientWindowProc(
WPARAM wParam,
LPARAM lParam) /* (Potentially) our local handle */
{
-
switch (uMsg) {
case WM_CREATE: {
LPCREATESTRUCT lpcs = (LPCREATESTRUCT) lParam;
@@ -982,7 +994,6 @@ DdeClientWindowProc(
}
case WM_DDE_ACK:
return DdeServicesOnAck(hwnd, wParam, lParam);
- break;
default:
return DefWindowProc(hwnd, uMsg, wParam, lParam);
}
@@ -998,7 +1009,7 @@ DdeServicesOnAck(
ATOM service = (ATOM)LOWORD(lParam);
ATOM topic = (ATOM)HIWORD(lParam);
struct DdeEnumServices *es;
- char sz[255];
+ TCHAR sz[255];
#ifdef _WIN64
es = (struct DdeEnumServices *) GetWindowLongPtr(hwnd, GWLP_USERDATA);
@@ -1061,8 +1072,8 @@ DdeEnumWindowsCallback(
static int
DdeGetServicesList(
Tcl_Interp *interp,
- const char *serviceName,
- const char *topicName)
+ const TCHAR *serviceName,
+ const TCHAR *topicName)
{
struct DdeEnumServices es;
@@ -1109,25 +1120,30 @@ static void
SetDdeError(
Tcl_Interp *interp) /* The interp to put the message in. */
{
- const char *errorMessage;
+ const char *errorMessage, *errorCode;
switch (DdeGetLastError(ddeInstance)) {
case DMLERR_DATAACKTIMEOUT:
case DMLERR_EXECACKTIMEOUT:
case DMLERR_POKEACKTIMEOUT:
errorMessage = "remote interpreter did not respond";
+ errorCode = "TIMEOUT";
break;
case DMLERR_BUSY:
errorMessage = "remote server is busy";
+ errorCode = "BUSY";
break;
case DMLERR_NOTPROCESSED:
errorMessage = "remote server cannot handle this command";
+ errorCode = "NOCANDO";
break;
default:
errorMessage = "dde command failed";
+ errorCode = "FAILED";
}
Tcl_SetObjResult(interp, Tcl_NewStringObj(errorMessage, -1));
+ Tcl_SetErrorCode(interp, "TCL", "DDE", errorCode, NULL);
}
/*
@@ -1154,23 +1170,23 @@ DdeObjCmd(
int objc, /* Number of arguments */
Tcl_Obj *const *objv) /* The arguments */
{
- static const char *ddeCommands[] = {
+ static const char *const ddeCommands[] = {
"servername", "execute", "poke", "request", "services", "eval",
(char *) NULL};
enum DdeSubcommands {
DDE_SERVERNAME, DDE_EXECUTE, DDE_POKE, DDE_REQUEST, DDE_SERVICES,
DDE_EVAL
};
- static const char *ddeSrvOptions[] = {
+ static const char *const ddeSrvOptions[] = {
"-force", "-handler", "--", NULL
};
enum DdeSrvOptions {
DDE_SERVERNAME_EXACT, DDE_SERVERNAME_HANDLER, DDE_SERVERNAME_LAST,
};
- static const char *ddeExecOptions[] = {
+ static const char *const ddeExecOptions[] = {
"-async", NULL
};
- static const char *ddeReqOptions[] = {
+ static const char *const ddeReqOptions[] = {
"-binary", NULL
};
@@ -1180,7 +1196,8 @@ DdeObjCmd(
HSZ ddeService = NULL, ddeTopic = NULL, ddeItem = NULL, ddeCookie = NULL;
HDDEDATA ddeData = NULL, ddeItemData = NULL, ddeReturn;
HCONV hConv = NULL;
- const char *serviceName = NULL, *topicName = NULL, *string;
+ const TCHAR *serviceName = NULL, *topicName = NULL;
+ const char *string;
DWORD ddeResult;
Tcl_Obj *objPtr, *handlerPtr = NULL;
@@ -1330,7 +1347,7 @@ DdeObjCmd(
serviceName = NULL;
} else if ((index != DDE_SERVERNAME) && (index != DDE_EVAL)) {
ddeService = DdeCreateStringHandle(ddeInstance, (void *) serviceName,
- CP_WINANSI);
+ CP_WINUNICODE);
}
if ((index != DDE_SERVERNAME) && (index != DDE_EVAL)) {
@@ -1339,7 +1356,7 @@ DdeObjCmd(
topicName = NULL;
} else {
ddeTopic = DdeCreateStringHandle(ddeInstance, (void *) topicName,
- CP_WINANSI);
+ CP_WINUNICODE);
}
}
@@ -1362,6 +1379,7 @@ DdeObjCmd(
if (dataLength == 0) {
Tcl_SetObjResult(interp,
Tcl_NewStringObj("cannot execute null data", -1));
+ Tcl_SetErrorCode(interp, "TCL", "DDE", "NULL", NULL);
result = TCL_ERROR;
break;
}
@@ -1404,6 +1422,7 @@ DdeObjCmd(
if (length == 0) {
Tcl_SetObjResult(interp,
Tcl_NewStringObj("cannot request value of null data", -1));
+ Tcl_SetErrorCode(interp, "TCL", "DDE", "NULL", NULL);
result = TCL_ERROR;
goto cleanup;
}
@@ -1416,8 +1435,8 @@ DdeObjCmd(
result = TCL_ERROR;
} else {
Tcl_Obj *returnObjPtr;
- ddeItem = DdeCreateStringHandle(ddeInstance, (void *)itemString,
- CP_WINANSI);
+ ddeItem = DdeCreateStringHandle(ddeInstance, (void *) itemString,
+ CP_WINUNICODE);
if (ddeItem != NULL) {
ddeData = DdeClientTransaction(NULL, 0, hConv, ddeItem,
CF_TEXT, XTYP_REQUEST, 5000, NULL);
@@ -1458,6 +1477,7 @@ DdeObjCmd(
if (length == 0) {
Tcl_SetObjResult(interp,
Tcl_NewStringObj("cannot have a null item", -1));
+ Tcl_SetErrorCode(interp, "TCL", "DDE", "NULL", NULL);
result = TCL_ERROR;
goto cleanup;
}
@@ -1473,7 +1493,7 @@ DdeObjCmd(
result = TCL_ERROR;
} else {
ddeItem = DdeCreateStringHandle(ddeInstance, (void *) itemString,
- CP_WINANSI);
+ CP_WINUNICODE);
if (ddeItem != NULL) {
ddeData = DdeClientTransaction(dataString, (DWORD) length+1,
hConv, ddeItem, CF_TEXT, XTYP_POKE, 5000, NULL);
@@ -1500,6 +1520,7 @@ DdeObjCmd(
if (serviceName == NULL) {
Tcl_SetObjResult(interp,
Tcl_NewStringObj("invalid service name \"\"", -1));
+ Tcl_SetErrorCode(interp, "TCL", "DDE", "NO_SERVER", NULL);
result = TCL_ERROR;
goto cleanup;
}
@@ -1518,7 +1539,7 @@ DdeObjCmd(
for (riPtr = tsdPtr->interpListPtr; riPtr != NULL;
riPtr = riPtr->nextPtr) {
- if (stricmp(serviceName, riPtr->name) == 0) {
+ if (_tcsicmp(serviceName, riPtr->name) == 0) {
break;
}
}
@@ -1531,9 +1552,9 @@ DdeObjCmd(
* server.
*/
- Tcl_Preserve((ClientData) riPtr);
+ Tcl_Preserve(riPtr);
sendInterp = riPtr->interp;
- Tcl_Preserve((ClientData) sendInterp);
+ Tcl_Preserve(sendInterp);
/*
* Don't exchange objects between interps. The target interp would
@@ -1547,6 +1568,8 @@ DdeObjCmd(
Tcl_SetResult(riPtr->interp, "permission denied: "
"a handler procedure must be defined for use in "
"a safe interp", TCL_STATIC);
+ Tcl_SetErrorCode(interp, "TCL", "DDE", "SECURITY_CHECK",
+ NULL);
result = TCL_ERROR;
}
@@ -1598,8 +1621,8 @@ DdeObjCmd(
}
Tcl_SetObjResult(interp, Tcl_GetObjResult(sendInterp));
}
- Tcl_Release((ClientData) riPtr);
- Tcl_Release((ClientData) sendInterp);
+ Tcl_Release(riPtr);
+ Tcl_Release(sendInterp);
} else {
/*
* This is a non-local request. Send the script to the server and
@@ -1609,8 +1632,8 @@ DdeObjCmd(
if (MakeDdeConnection(interp, serviceName, &hConv) != TCL_OK) {
invalidServerResponse:
Tcl_SetObjResult(interp,
- Tcl_NewStringObj("invalid data returned from server",
- -1));
+ Tcl_NewStringObj("invalid data returned from server", -1));
+ Tcl_SetErrorCode(interp, "TCL", "DDE", "BAD_RESPONSE", NULL);
result = TCL_ERROR;
goto cleanup;
}
@@ -1631,7 +1654,7 @@ DdeObjCmd(
CF_TEXT, XTYP_EXECUTE, 30000, NULL);
if (ddeData != 0) {
ddeCookie = DdeCreateStringHandle(ddeInstance,
- TCL_DDE_EXECUTE_RESULT, CP_WINANSI);
+ TCL_DDE_EXECUTE_RESULT, CP_WINUNICODE);
ddeData = DdeClientTransaction(NULL, 0, hConv, ddeCookie,
CF_TEXT, XTYP_REQUEST, 30000, NULL);
}
@@ -1642,6 +1665,7 @@ DdeObjCmd(
if (ddeData == 0) {
SetDdeError(interp);
result = TCL_ERROR;
+ goto cleanup;
}
if (async == 0) {
@@ -1658,7 +1682,7 @@ DdeObjCmd(
resultPtr = Tcl_NewObj();
length = DdeGetData(ddeData, NULL, 0, 0);
- Tcl_SetObjLength(resultPtr, length);
+ Tcl_SetObjLength(resultPtr, (length + 1) * sizeof(TCHAR) - 1);
string = Tcl_GetString(resultPtr);
DdeGetData(ddeData, (BYTE *) string, (DWORD) length, 0);
Tcl_SetObjLength(resultPtr, (int) strlen(string));