diff options
Diffstat (limited to 'win/tclWinDde.c')
| -rw-r--r-- | win/tclWinDde.c | 735 |
1 files changed, 463 insertions, 272 deletions
diff --git a/win/tclWinDde.c b/win/tclWinDde.c index 57a7d62..ce0b413 100644 --- a/win/tclWinDde.c +++ b/win/tclWinDde.c @@ -8,14 +8,30 @@ * * See the file "license.terms" for information on usage and redistribution of * this file, and for a DISCLAIMER OF ALL WARRANTIES. - * - * RCS: @(#) $Id: tclWinDde.c,v 1.27 2005/07/24 22:56:47 dkf Exp $ */ +#undef STATIC_BUILD +#ifndef USE_TCL_STUBS +# define USE_TCL_STUBS +#endif #include "tclInt.h" #include <dde.h> #include <ddeml.h> -#include <tchar.h> + +#ifndef UNICODE +# undef CP_WINUNICODE +# define CP_WINUNICODE CP_WINANSI +# undef Tcl_WinTCharToUtf +# define Tcl_WinTCharToUtf(a,b,c) Tcl_ExternalToUtfDString(NULL,a,b,c) +# undef Tcl_WinUtfToTChar +# define Tcl_WinUtfToTChar(a,b,c) Tcl_UtfToExternalDString(NULL,a,b,c) +#endif + +#if !defined(NDEBUG) + /* test POKE server Implemented for debug mode only */ +# undef CBF_FAIL_POKES +# define CBF_FAIL_POKES 0 +#endif /* * TCL_STORAGE_CLASS is set unconditionally to DLLEXPORT because the Dde_Init @@ -36,7 +52,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; @@ -59,7 +75,7 @@ typedef struct DdeEnumServices { ATOM service; ATOM topic; HWND hwnd; -}; +} DdeEnumServices; typedef struct ThreadSpecificData { Conversation *currentConversations; @@ -81,10 +97,14 @@ static DWORD ddeInstance; /* The application instance handle given to us * by DdeInitialize. */ static int ddeIsServer = 0; -#define TCL_DDE_VERSION "1.3.1" +#define TCL_DDE_VERSION "1.4.0" #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") + +#define DDE_FLAG_ASYNC 1 +#define DDE_FLAG_BINARY 2 +#define DDE_FLAG_FORCE 4 TCL_DECLARE_MUTEX(ddeMutex) @@ -92,35 +112,31 @@ TCL_DECLARE_MUTEX(ddeMutex) * Forward declarations for functions defined later in this file. */ -static LRESULT CALLBACK DdeClientWindowProc _ANSI_ARGS_(( - HWND hwnd, UINT uMsg, WPARAM wParam, - LPARAM lParam)); -static int DdeCreateClient _ANSI_ARGS_(( - struct DdeEnumServices *es)); -static BOOL CALLBACK DdeEnumWindowsCallback _ANSI_ARGS_(( - HWND hwndTarget, LPARAM lParam)); -static void DdeExitProc _ANSI_ARGS_((ClientData clientData)); -static int DdeGetServicesList _ANSI_ARGS_((Tcl_Interp *interp, - char *serviceName, char *topicName)); -static HDDEDATA CALLBACK DdeServerProc _ANSI_ARGS_((UINT uType, - UINT uFmt, HCONV hConv, HSZ ddeTopic, - HSZ ddeItem, HDDEDATA hData, DWORD dwData1, - DWORD dwData2)); -static LRESULT DdeServicesOnAck _ANSI_ARGS_((HWND hwnd, - WPARAM wParam, LPARAM lParam)); -static void DeleteProc _ANSI_ARGS_((ClientData clientData)); -static Tcl_Obj * ExecuteRemoteObject _ANSI_ARGS_(( - RegisteredInterp *riPtr, - Tcl_Obj *ddeObjectPtr)); -static int MakeDdeConnection _ANSI_ARGS_((Tcl_Interp *interp, - char *name, HCONV *ddeConvPtr)); -static void SetDdeError _ANSI_ARGS_((Tcl_Interp *interp)); -int Tcl_DdeObjCmd _ANSI_ARGS_((ClientData clientData, - Tcl_Interp *interp, int objc, - Tcl_Obj *CONST objv[])); - -EXTERN int Dde_Init _ANSI_ARGS_((Tcl_Interp *interp)); -EXTERN int Dde_SafeInit _ANSI_ARGS_((Tcl_Interp *interp)); +static LRESULT CALLBACK DdeClientWindowProc(HWND hwnd, UINT uMsg, + WPARAM wParam, LPARAM lParam); +static int DdeCreateClient(struct DdeEnumServices *es); +static BOOL CALLBACK DdeEnumWindowsCallback(HWND hwndTarget, + LPARAM lParam); +static void DdeExitProc(ClientData clientData); +static int DdeGetServicesList(Tcl_Interp *interp, + 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); +static LRESULT DdeServicesOnAck(HWND hwnd, WPARAM wParam, + LPARAM lParam); +static void DeleteProc(ClientData clientData); +static Tcl_Obj * ExecuteRemoteObject(RegisteredInterp *riPtr, + Tcl_Obj *ddeObjectPtr); +static int MakeDdeConnection(Tcl_Interp *interp, + const TCHAR *name, HCONV *ddeConvPtr); +static void SetDdeError(Tcl_Interp *interp); +static int DdeObjCmd(ClientData clientData, + Tcl_Interp *interp, int objc, + Tcl_Obj *const objv[]); + +EXTERN int Dde_Init(Tcl_Interp *interp); +EXTERN int Dde_SafeInit(Tcl_Interp *interp); /* *---------------------------------------------------------------------- @@ -139,17 +155,21 @@ EXTERN int Dde_SafeInit _ANSI_ARGS_((Tcl_Interp *interp)); */ int -Dde_Init(interp) - Tcl_Interp *interp; +Dde_Init( + Tcl_Interp *interp) { - ThreadSpecificData *tsdPtr; - - if (!Tcl_InitStubs(interp, "8.0", 0)) { + if (!Tcl_InitStubs(interp, "8.1", 0)) { return TCL_ERROR; } - Tcl_CreateObjCommand(interp, "dde", Tcl_DdeObjCmd, NULL, NULL); - tsdPtr = TCL_TSD_INIT(&dataKey); +#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); } @@ -171,8 +191,8 @@ Dde_Init(interp) */ int -Dde_SafeInit(interp) - Tcl_Interp *interp; +Dde_SafeInit( + Tcl_Interp *interp) { int result = Dde_Init(interp); if (result == TCL_OK) { @@ -221,7 +241,7 @@ Initialize(void) if (ddeInstance == 0) { Tcl_MutexLock(&ddeMutex); if (ddeInstance == 0) { - if (DdeInitialize(&ddeInstance, DdeServerProc, + if (DdeInitialize(&ddeInstance, (PFNCALLBACK) DdeServerProc, CBF_SKIP_REGISTRATIONS | CBF_SKIP_UNREGISTRATIONS | CBF_FAIL_POKES, 0) != DMLERR_NO_ERROR) { ddeInstance = 0; @@ -235,7 +255,7 @@ Initialize(void) ddeIsServer = 1; Tcl_CreateExitHandler(DdeExitProc, NULL); ddeServiceGlobal = DdeCreateStringHandle(ddeInstance, - TCL_DDE_SERVICE_NAME, 0); + TCL_DDE_SERVICE_NAME, CP_WINUNICODE); DdeNameService(ddeInstance, ddeServiceGlobal, 0L, DNS_REGISTER); } else { ddeIsServer = 0; @@ -269,20 +289,20 @@ Initialize(void) *---------------------------------------------------------------------- */ -static char * -DdeSetServerName(interp, name, exactName, handlerPtr) - Tcl_Interp *interp; - char *name; /* The name that will be used to refer to the +static const TCHAR * +DdeSetServerName( + Tcl_Interp *interp, + 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 */ - Tcl_Obj *handlerPtr; /* Name of the optional proc/command to handle + int flags, /* DDE_FLAG_FORCE or 0 */ + Tcl_Obj *handlerPtr) /* Name of the optional proc/command to handle * incoming Dde eval's */ { int suffix, offset; RegisteredInterp *riPtr, *prevPtr; Tcl_DString dString; - 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); @@ -320,7 +340,7 @@ DdeSetServerName(interp, name, exactName, handlerPtr) * current interp, but it doesn't have a name. */ - return ""; + return TEXT(""); } /* @@ -331,7 +351,7 @@ DdeSetServerName(interp, name, exactName, handlerPtr) Tcl_DStringInit(&dString); actualName = name; - if (!exactName) { + if (!(flags & DDE_FLAG_FORCE)) { r = DdeGetServicesList(interp, TCL_DDE_SERVICE_NAME, NULL); if (r == TCL_OK) { srvListPtr = Tcl_GetObjResult(interp); @@ -341,7 +361,9 @@ DdeSetServerName(interp, name, exactName, handlerPtr) &srvPtrPtr); } if (r != TCL_OK) { - OutputDebugString(Tcl_GetStringResult(interp)); + Tcl_WinUtfToTChar(Tcl_GetStringResult(interp), -1, &dString); + OutputDebugString((TCHAR *) Tcl_DStringValue(&dString)); + Tcl_DStringFree(&dString); return NULL; } @@ -358,13 +380,14 @@ DdeSetServerName(interp, name, exactName, handlerPtr) lastSuffix = suffix; if (suffix > 1) { if (suffix == 2) { - Tcl_DStringAppend(&dString, name, -1); - Tcl_DStringAppend(&dString, " #", 2); + Tcl_DStringAppend(&dString, (char *)name, _tcslen(name) * sizeof(TCHAR)); + Tcl_DStringAppend(&dString, (char *)TEXT(" #"), 2 * sizeof(TCHAR)); offset = Tcl_DStringLength(&dString); - Tcl_DStringSetLength(&dString, offset + TCL_INTEGER_SPACE); - actualName = Tcl_DStringValue(&dString); + Tcl_DStringSetLength(&dString, offset + sizeof(TCHAR) * TCL_INTEGER_SPACE); + actualName = (TCHAR *) Tcl_DStringValue(&dString); } - sprintf(Tcl_DStringValue(&dString) + offset, "%d", suffix); + _sntprintf((TCHAR *) (Tcl_DStringValue(&dString) + offset), + TCL_INTEGER_SPACE, TEXT("%d"), suffix); } /* @@ -373,12 +396,16 @@ DdeSetServerName(interp, name, exactName, handlerPtr) for (n = 0; n < srvCount; ++n) { Tcl_Obj* namePtr; + Tcl_DString ds; Tcl_ListObjIndex(interp, srvPtrPtr[n], 1, &namePtr); - if (strcmp(actualName, Tcl_GetString(namePtr)) == 0) { + Tcl_WinUtfToTChar(Tcl_GetString(namePtr), -1, &ds); + if (_tcscmp(actualName, (TCHAR *)Tcl_DStringValue(&ds)) == 0) { suffix++; + Tcl_DStringFree(&ds); break; } + Tcl_DStringFree(&ds); } } } @@ -387,23 +414,23 @@ DdeSetServerName(interp, name, exactName, handlerPtr) * 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", Tcl_DdeObjCmd, - (ClientData) riPtr, DeleteProc); + Tcl_CreateObjCommand(interp, "dde", DdeObjCmd, + riPtr, DeleteProc); if (Tcl_IsSafe(interp)) { Tcl_HideCommand(interp, "dde", "dde"); } @@ -435,8 +462,8 @@ DdeSetServerName(interp, name, exactName, handlerPtr) */ static RegisteredInterp * -DdeGetRegistrationPtr(interp) - Tcl_Interp *interp; +DdeGetRegistrationPtr( + Tcl_Interp *interp) { RegisteredInterp *riPtr; ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey); @@ -467,8 +494,8 @@ DdeGetRegistrationPtr(interp) */ static void -DeleteProc(clientData) - ClientData clientData; /* The interp we are deleting passed as +DeleteProc( + ClientData clientData) /* The interp we are deleting passed as * ClientData. */ { RegisteredInterp *riPtr = (RegisteredInterp *) clientData; @@ -476,7 +503,7 @@ DeleteProc(clientData) ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey); for (searchPtr = tsdPtr->interpListPtr, prevPtr = NULL; - searchPtr != NULL && searchPtr != riPtr; + (searchPtr != NULL) && (searchPtr != riPtr); prevPtr = searchPtr, searchPtr = searchPtr->nextPtr) { /* * Empty loop body. @@ -521,9 +548,9 @@ DeleteProc(clientData) */ static Tcl_Obj * -ExecuteRemoteObject(riPtr, ddeObjectPtr) - RegisteredInterp *riPtr; /* Info about this server. */ - Tcl_Obj *ddeObjectPtr; /* The object to execute. */ +ExecuteRemoteObject( + RegisteredInterp *riPtr, /* Info about this server. */ + Tcl_Obj *ddeObjectPtr) /* The object to execute. */ { Tcl_Obj *returnPackagePtr; int result = TCL_OK; @@ -532,6 +559,7 @@ ExecuteRemoteObject(riPtr, ddeObjectPtr) 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; } @@ -542,7 +570,8 @@ ExecuteRemoteObject(riPtr, ddeObjectPtr) Tcl_Obj *cmdPtr = Tcl_DuplicateObj(riPtr->handlerPtr); - result = Tcl_ListObjAppendElement(riPtr->interp, cmdPtr, ddeObjectPtr); + result = Tcl_ListObjAppendElement(riPtr->interp, cmdPtr, + ddeObjectPtr); if (result == TCL_OK) { ddeObjectPtr = cmdPtr; } @@ -552,9 +581,10 @@ ExecuteRemoteObject(riPtr, ddeObjectPtr) result = Tcl_EvalObjEx(riPtr->interp, ddeObjectPtr, TCL_EVAL_GLOBAL); } - returnPackagePtr = Tcl_NewListObj(0, (Tcl_Obj **) NULL); + returnPackagePtr = Tcl_NewListObj(0, NULL); - Tcl_ListObjAppendElement(NULL, returnPackagePtr, Tcl_NewIntObj(result)); + Tcl_ListObjAppendElement(NULL, returnPackagePtr, + Tcl_NewIntObj(result)); Tcl_ListObjAppendElement(NULL, returnPackagePtr, Tcl_GetObjResult(riPtr->interp)); @@ -594,21 +624,22 @@ ExecuteRemoteObject(riPtr, ddeObjectPtr) */ static HDDEDATA CALLBACK -DdeServerProc(uType, uFmt, hConv, ddeTopic, ddeItem, hData, dwData1, dwData2) - UINT uType; /* The type of DDE transaction we are +DdeServerProc( + UINT uType, /* The type of DDE transaction we are * performing. */ - UINT uFmt; /* The format that data is sent or received. */ - HCONV hConv; /* The conversation associated with the + UINT uFmt, /* The format that data is sent or received */ + HCONV hConv, /* The conversation associated with the * current transaction. */ - HSZ ddeTopic, ddeItem; /* String handles. Transaction-type + HSZ ddeTopic, HSZ ddeItem, /* String handles. Transaction-type * dependent. */ - HDDEDATA hData; /* DDE data. Transaction-type dependent. */ - DWORD dwData1, dwData2; /* Transaction-dependent data. */ + HDDEDATA hData, /* DDE data. Transaction-type dependent. */ + DWORD dwData1, DWORD dwData2) + /* Transaction-dependent data. */ { Tcl_DString dString; int len; DWORD dlen; - char *utilString; + TCHAR *utilString; Tcl_Obj *ddeObjectPtr; HDDEDATA ddeReturn = NULL; RegisteredInterp *riPtr; @@ -622,16 +653,16 @@ DdeServerProc(uType, uFmt, hConv, ddeTopic, ddeItem, hData, dwData1, dwData2) * sure we have a valid topic. */ - len = DdeQueryString(ddeInstance, ddeTopic, NULL, 0, 0); + len = DdeQueryString(ddeInstance, ddeTopic, 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, 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; } @@ -647,16 +678,16 @@ DdeServerProc(uType, uFmt, hConv, ddeTopic, ddeItem, hData, dwData1, dwData2) * result to return in an XTYP_REQUEST. */ - len = DdeQueryString(ddeInstance, ddeTopic, NULL, 0, 0); + len = DdeQueryString(ddeInstance, ddeTopic, 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, 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; @@ -686,7 +717,7 @@ DdeServerProc(uType, uFmt, hConv, ddeTopic, ddeItem, hData, dwData1, dwData2) if (convPtr->returnPackagePtr != NULL) { Tcl_DecrRefCount(convPtr->returnPackagePtr); } - ckfree((char *) convPtr); + ckfree(convPtr); break; } } @@ -699,7 +730,7 @@ DdeServerProc(uType, uFmt, hConv, ddeTopic, ddeItem, hData, dwData1, dwData2) * execute. */ - if (uFmt != CF_TEXT) { + if ((uFmt != CF_TEXT) && (uFmt != CF_UNICODETEXT)) { return (HDDEDATA) FALSE; } @@ -714,39 +745,102 @@ DdeServerProc(uType, uFmt, hConv, ddeTopic, ddeItem, hData, dwData1, dwData2) 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) { - returnString = - Tcl_GetStringFromObj(convPtr->returnPackagePtr, &len); - ddeReturn = DdeCreateDataHandle(ddeInstance, returnString, - (DWORD) len+1, 0, ddeItem, CF_TEXT, 0); + 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; + } + ddeReturn = DdeCreateDataHandle(ddeInstance, (BYTE *)returnString, + (DWORD) len+1, 0, ddeItem, uFmt, 0); } else { if (Tcl_IsSafe(convPtr->riPtr->interp)) { ddeReturn = NULL; } else { - Tcl_Obj *variableObjPtr = Tcl_GetVar2Ex( - convPtr->riPtr->interp, utilString, NULL, + 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) { - returnString = Tcl_GetStringFromObj(variableObjPtr, - &len); + if (uFmt == CF_TEXT) { + returnString = Tcl_GetStringFromObj( + variableObjPtr, &len); + } else { + returnString = (char *) Tcl_GetUnicodeFromObj( + variableObjPtr, &len); + len = sizeof(TCHAR) * len + 1; + } ddeReturn = DdeCreateDataHandle(ddeInstance, - returnString, (DWORD) len+1, 0, ddeItem, - CF_TEXT, 0); + (BYTE *)returnString, (DWORD) len+1, 0, ddeItem, + uFmt, 0); } else { ddeReturn = NULL; } + Tcl_DStringFree(&ds); } } Tcl_DStringFree(&dString); } return ddeReturn; +#if !CBF_FAIL_POKES + case XTYP_POKE: + /* + * This is a poke for a Tcl variable, only implemented in + * debug/UNICODE mode. + */ + ddeReturn = DDE_FNOTPROCESSED; + + if ((uFmt != CF_TEXT) && (uFmt != CF_UNICODETEXT)) { + return ddeReturn; + } + + for (convPtr = tsdPtr->currentConversations; (convPtr != NULL) + && (convPtr->hConv != hConv); convPtr = convPtr->nextPtr) { + /* + * Empty loop body. + */ + } + + if (convPtr && !Tcl_IsSafe(convPtr->riPtr->interp)) { + Tcl_DString ds; + Tcl_Obj *variableObjPtr; + + len = DdeQueryString(ddeInstance, ddeItem, NULL, 0, CP_WINUNICODE); + Tcl_DStringInit(&dString); + 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); + } + + Tcl_SetVar2Ex(convPtr->riPtr->interp, Tcl_DStringValue(&ds), NULL, + variableObjPtr, TCL_GLOBAL_ONLY); + + Tcl_DStringFree(&ds); + Tcl_DStringFree(&dString); + ddeReturn = (HDDEDATA) DDE_FACK; + } + return ddeReturn; + +#endif case XTYP_EXECUTE: { /* * Execute this script. The results will be saved into a list object @@ -754,6 +848,7 @@ DdeServerProc(uType, uFmt, hConv, ddeTopic, ddeItem, hData, dwData1, dwData2) */ Tcl_Obj *returnPackagePtr; + char *string; for (convPtr = tsdPtr->currentConversations; (convPtr != NULL) && (convPtr->hConv != hConv); convPtr = convPtr->nextPtr) { @@ -766,9 +861,22 @@ DdeServerProc(uType, uFmt, hConv, ddeTopic, ddeItem, hData, dwData1, dwData2) return (HDDEDATA) DDE_FNOTPROCESSED; } - utilString = (char *) DdeAccessData(hData, &dlen); - len = dlen; - ddeObjectPtr = Tcl_NewStringObj(utilString, -1); + utilString = (TCHAR *) DdeAccessData(hData, &dlen); + string = (char *) utilString; + if (!dlen) { + /* Empty binary array. */ + ddeObjectPtr = Tcl_NewObj(); + } else if ((dlen & 1) || utilString[(dlen>>1)-1]) { + /* Cannot be unicode, so assume utf-8 */ + if (!string[dlen-1]) { + dlen--; + } + ddeObjectPtr = Tcl_NewStringObj(string, dlen); + } else { + /* unicode */ + dlen >>= 1; + ddeObjectPtr = Tcl_NewUnicodeObj((Tcl_UniChar *)utilString, dlen - 1); + } Tcl_IncrRefCount(ddeObjectPtr); DdeUnaccessData(hData); if (convPtr->returnPackagePtr != NULL) { @@ -820,9 +928,9 @@ DdeServerProc(uType, uFmt, hConv, ddeTopic, ddeItem, hData, dwData1, dwData2) 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; @@ -852,8 +960,8 @@ DdeServerProc(uType, uFmt, hConv, ddeTopic, ddeItem, hData, dwData1, dwData2) */ static void -DdeExitProc(clientData) - ClientData clientData; /* Not used in this handler. */ +DdeExitProc( + ClientData clientData) /* Not used in this handler. */ { DdeNameService(ddeInstance, NULL, 0, DNS_UNREGISTER); DdeUninitialize(ddeInstance); @@ -878,16 +986,16 @@ DdeExitProc(clientData) */ static int -MakeDdeConnection(interp, name, ddeConvPtr) - Tcl_Interp *interp; /* Used to report errors. */ - char *name; /* The connection to use. */ - HCONV *ddeConvPtr; +MakeDdeConnection( + Tcl_Interp *interp, /* Used to report errors. */ + const TCHAR *name, /* The connection to use. */ + HCONV *ddeConvPtr) { HSZ ddeTopic, ddeService; HCONV ddeConv; - ddeService = DdeCreateStringHandle(ddeInstance, TCL_DDE_SERVICE_NAME, 0); - ddeTopic = DdeCreateStringHandle(ddeInstance, name, 0); + ddeService = DdeCreateStringHandle(ddeInstance, TCL_DDE_SERVICE_NAME, CP_WINUNICODE); + ddeTopic = DdeCreateStringHandle(ddeInstance, name, CP_WINUNICODE); ddeConv = DdeConnect(ddeInstance, ddeService, ddeTopic, NULL); DdeFreeStringHandle(ddeInstance, ddeService); @@ -895,8 +1003,13 @@ MakeDdeConnection(interp, name, ddeConvPtr) if (ddeConv == (HCONV) NULL) { if (interp != NULL) { - Tcl_AppendResult(interp, "no registered server named \"", - name, "\"", (char *) NULL); + Tcl_DString dString; + + Tcl_WinTCharToUtf(name, -1, &dString); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "no registered server named \"%s\"", Tcl_DStringValue(&dString))); + Tcl_DStringFree(&dString); + Tcl_SetErrorCode(interp, "TCL", "DDE", "NO_SERVER", NULL); } return TCL_ERROR; } @@ -926,12 +1039,12 @@ MakeDdeConnection(interp, name, ddeConvPtr) */ static int -DdeCreateClient(es) - struct DdeEnumServices *es; +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); @@ -950,14 +1063,12 @@ DdeCreateClient(es) } static LRESULT CALLBACK -DdeClientWindowProc(hwnd, uMsg, wParam, lParam) - HWND hwnd; /* What window is the message for */ - UINT uMsg; /* The type of message received */ - WPARAM wParam; - LPARAM lParam; /* (Potentially) our local handle */ +DdeClientWindowProc( + HWND hwnd, /* What window is the message for */ + UINT uMsg, /* The type of message received */ + WPARAM wParam, + LPARAM lParam) /* (Potentially) our local handle */ { - LRESULT lr = 0L; - switch (uMsg) { case WM_CREATE: { LPCREATESTRUCT lpcs = (LPCREATESTRUCT) lParam; @@ -965,31 +1076,31 @@ DdeClientWindowProc(hwnd, uMsg, wParam, lParam) (struct DdeEnumServices *) lpcs->lpCreateParams; #ifdef _WIN64 - SetWindowLongPtr(hwnd, GWLP_USERDATA, (long)es); + SetWindowLongPtr(hwnd, GWLP_USERDATA, (LONG_PTR) es); #else - SetWindowLong(hwnd, GWL_USERDATA, (long)es); + SetWindowLong(hwnd, GWL_USERDATA, (LONG) es); #endif return (LRESULT) 0L; } case WM_DDE_ACK: return DdeServicesOnAck(hwnd, wParam, lParam); - break; default: return DefWindowProc(hwnd, uMsg, wParam, lParam); } } static LRESULT -DdeServicesOnAck(hwnd, wParam, lParam) - HWND hwnd; - WPARAM wParam; - LPARAM lParam; +DdeServicesOnAck( + HWND hwnd, + WPARAM wParam, + LPARAM lParam) { HWND hwndRemote = (HWND)wParam; ATOM service = (ATOM)LOWORD(lParam); ATOM topic = (ATOM)HIWORD(lParam); struct DdeEnumServices *es; TCHAR sz[255]; + Tcl_DString dString; #ifdef _WIN64 es = (struct DdeEnumServices *) GetWindowLongPtr(hwnd, GWLP_USERDATA); @@ -997,15 +1108,19 @@ DdeServicesOnAck(hwnd, wParam, lParam) es = (struct DdeEnumServices *) GetWindowLong(hwnd, GWL_USERDATA); #endif - if ((es->service == (ATOM)NULL || es->service == service) - && (es->topic == (ATOM)NULL || 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); - GlobalGetAtomName((ATOM)service, sz, 255); - Tcl_ListObjAppendElement(NULL, matchPtr, Tcl_NewStringObj(sz, -1)); + GlobalGetAtomName(service, sz, 255); + Tcl_WinTCharToUtf(sz, -1, &dString); + Tcl_ListObjAppendElement(NULL, matchPtr, Tcl_NewStringObj(Tcl_DStringValue(&dString), -1)); + Tcl_DStringFree(&dString); GlobalGetAtomName(topic, sz, 255); - Tcl_ListObjAppendElement(NULL, matchPtr, Tcl_NewStringObj(sz, -1)); + Tcl_WinTCharToUtf(sz, -1, &dString); + Tcl_ListObjAppendElement(NULL, matchPtr, Tcl_NewStringObj(Tcl_DStringValue(&dString), -1)); + Tcl_DStringFree(&dString); /* * Adding the hwnd as a third list element provides a unique @@ -1036,11 +1151,11 @@ DdeServicesOnAck(hwnd, wParam, lParam) } static BOOL CALLBACK -DdeEnumWindowsCallback(hwndTarget, lParam) - HWND hwndTarget; - LPARAM lParam; +DdeEnumWindowsCallback( + HWND hwndTarget, + LPARAM lParam) { - LRESULT dwResult = 0; + DWORD_PTR dwResult = 0; struct DdeEnumServices *es = (struct DdeEnumServices *) lParam; SendMessageTimeout(hwndTarget, WM_DDE_INITIATE, (WPARAM)es->hwnd, @@ -1050,17 +1165,18 @@ DdeEnumWindowsCallback(hwndTarget, lParam) } static int -DdeGetServicesList(interp, serviceName, topicName) - Tcl_Interp *interp; - char *serviceName, *topicName; +DdeGetServicesList( + Tcl_Interp *interp, + const TCHAR *serviceName, + const TCHAR *topicName) { struct DdeEnumServices es; es.interp = interp; es.result = TCL_OK; es.service = (serviceName == NULL) - ? (ATOM)NULL : GlobalAddAtom(serviceName); - es.topic = (topicName == NULL) ? (ATOM)NULL : GlobalAddAtom(topicName); + ? (ATOM)0 : GlobalAddAtom(serviceName); + es.topic = (topicName == NULL) ? (ATOM)0 : GlobalAddAtom(topicName); Tcl_ResetResult(interp); /* our list is to be appended to result. */ DdeCreateClient(&es); @@ -1069,10 +1185,10 @@ DdeGetServicesList(interp, serviceName, topicName) if (IsWindow(es.hwnd)) { DestroyWindow(es.hwnd); } - if (es.service != (ATOM)NULL) { + if (es.service != (ATOM)0) { GlobalDeleteAtom(es.service); } - if (es.topic != (ATOM)NULL) { + if (es.topic != (ATOM)0) { GlobalDeleteAtom(es.topic); } return es.result; @@ -1096,34 +1212,39 @@ DdeGetServicesList(interp, serviceName, topicName) */ static void -SetDdeError(interp) - Tcl_Interp *interp; /* The interp to put the message in. */ +SetDdeError( + Tcl_Interp *interp) /* The interp to put the message in. */ { - 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); } /* *---------------------------------------------------------------------- * - * Tcl_DdeObjCmd -- + * DdeObjCmd -- * * This function is invoked to process the "dde" Tcl command. See the * user documentation for details on what it does. @@ -1137,41 +1258,46 @@ SetDdeError(interp) *---------------------------------------------------------------------- */ -int -Tcl_DdeObjCmd(clientData, interp, objc, objv) - ClientData clientData; /* Used only for deletion */ - Tcl_Interp *interp; /* The interp we are sending from */ - int objc; /* Number of arguments */ - Tcl_Obj *CONST objv[]; /* The arguments */ +static int +DdeObjCmd( + ClientData clientData, /* Used only for deletion */ + Tcl_Interp *interp, /* The interp we are sending from */ + 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 - }; + (char *) NULL}; enum DdeSubcommands { DDE_SERVERNAME, DDE_EXECUTE, DDE_POKE, DDE_REQUEST, DDE_SERVICES, DDE_EVAL }; - static CONST char *ddeSrvOptions[] = { - "-force", "-handler", "--", (char *) NULL + static const char *const ddeSrvOptions[] = { + "-force", "-handler", "--", NULL }; enum DdeSrvOptions { DDE_SERVERNAME_EXACT, DDE_SERVERNAME_HANDLER, DDE_SERVERNAME_LAST, }; - static CONST char *ddeExecOptions[] = { - "-async", (char *) NULL + static const char *const ddeExecOptions[] = { + "-async", "-binary", NULL + }; + enum DdeExecOptions { + DDE_EXEC_ASYNC, DDE_EXEC_BINARY }; - static CONST char *ddeReqOptions[] = { - "-binary", (char *) NULL + static const char *const ddeEvalOptions[] = { + "-async", NULL + }; + static const char *const ddeReqOptions[] = { + "-binary", NULL }; - int index, i, length; - int async = 0, binary = 0, exact = 0; - int result = TCL_OK, firstArg = 0; + int index, i, length, argIndex; + int flags = 0, result = TCL_OK, firstArg = 0; HSZ ddeService = NULL, ddeTopic = NULL, ddeItem = NULL, ddeCookie = NULL; HDDEDATA ddeData = NULL, ddeItemData = NULL, ddeReturn; HCONV hConv = NULL; - char *serviceName = NULL, *topicName = NULL, *string; + const TCHAR *serviceName = NULL, *topicName = NULL; + const char *string; DWORD ddeResult; Tcl_Obj *objPtr, *handlerPtr = NULL; @@ -1192,9 +1318,8 @@ Tcl_DdeObjCmd(clientData, interp, objc, objv) switch ((enum DdeSubcommands) index) { case DDE_SERVERNAME: for (i = 2; i < objc; i++) { - enum DdeSrvOptions argIndex; if (Tcl_GetIndexFromObj(interp, objv[i], ddeSrvOptions, - "option", 0, (int *) &argIndex) != TCL_OK) { + "option", 0, &argIndex) != TCL_OK) { /* * If it is the last argument, it might be a server name * instead of a bad argument. @@ -1207,7 +1332,7 @@ Tcl_DdeObjCmd(clientData, interp, objc, objv) break; } if (argIndex == DDE_SERVERNAME_EXACT) { - exact = 1; + flags |= DDE_FLAG_FORCE; } else if (argIndex == DDE_SERVERNAME_HANDLER) { if ((objc - i) == 1) { /* return current handler */ RegisteredInterp *riPtr = DdeGetRegistrationPtr(interp); @@ -1239,39 +1364,53 @@ Tcl_DdeObjCmd(clientData, interp, objc, objv) if (objc == 5) { firstArg = 2; break; - } else if (objc == 6) { - int dummy; - if (Tcl_GetIndexFromObj(NULL, objv[2], ddeExecOptions, "option", 0, - &dummy) == TCL_OK) { - async = 1; - firstArg = 3; - break; + } 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) { + goto wrongDdeExecuteArgs; + } + if (argIndex == DDE_EXEC_ASYNC) { + flags |= DDE_FLAG_ASYNC; + } else { + flags |= DDE_FLAG_BINARY; + } } + break; } /* otherwise... */ + wrongDdeExecuteArgs: Tcl_WrongNumArgs(interp, 2, objv, - "?-async? serviceName topicName value"); + "?-async? ?-binary? serviceName topicName value"); return TCL_ERROR; case DDE_POKE: - if (objc != 6) { - Tcl_WrongNumArgs(interp, 2, objv, - "serviceName topicName item value"); - return TCL_ERROR; + if (objc == 6) { + firstArg = 2; + break; + } else if ((objc == 7) && (Tcl_GetIndexFromObj(NULL, objv[2], + ddeReqOptions, "option", 0, &argIndex) == TCL_OK)) { + flags |= DDE_FLAG_BINARY; + firstArg = 3; + break; } - firstArg = 2; - break; + + /* + * Otherwise... + */ + + Tcl_WrongNumArgs(interp, 2, objv, + "?-binary? serviceName topicName item value"); + return TCL_ERROR; case DDE_REQUEST: if (objc == 5) { firstArg = 2; break; - } else if (objc == 6) { - int dummy; - if (Tcl_GetIndexFromObj(NULL, objv[2], ddeReqOptions, "option", 0, - &dummy) == TCL_OK) { - binary = 1; - firstArg = 3; - break; - } + } else if ((objc == 6) && (Tcl_GetIndexFromObj(NULL, objv[2], + ddeReqOptions, "option", 0, &argIndex) == TCL_OK)) { + flags |= DDE_FLAG_BINARY; + firstArg = 3; + break; } /* @@ -1294,15 +1433,13 @@ Tcl_DdeObjCmd(clientData, interp, objc, objv) Tcl_WrongNumArgs(interp, 2, objv, "?-async? serviceName args"); return TCL_ERROR; } else { - int dummy; - firstArg = 2; - if (Tcl_GetIndexFromObj(NULL, objv[2], ddeExecOptions, "option", 0, - &dummy) == TCL_OK) { + if (Tcl_GetIndexFromObj(NULL, objv[2], ddeEvalOptions, "option", + 0, &argIndex) == TCL_OK) { if (objc < 5) { goto wrongDdeEvalArgs; } - async = 1; + flags |= DDE_FLAG_ASYNC; firstArg++; } break; @@ -1312,7 +1449,11 @@ Tcl_DdeObjCmd(clientData, interp, objc, objv) Initialize(); if (firstArg != 1) { +#ifdef UNICODE + serviceName = Tcl_GetUnicodeFromObj(objv[firstArg], &length); +#else serviceName = Tcl_GetStringFromObj(objv[firstArg], &length); +#endif } else { length = 0; } @@ -1320,25 +1461,34 @@ Tcl_DdeObjCmd(clientData, interp, objc, objv) if (length == 0) { serviceName = NULL; } else if ((index != DDE_SERVERNAME) && (index != DDE_EVAL)) { - ddeService = DdeCreateStringHandle(ddeInstance, serviceName, - CP_WINANSI); + ddeService = DdeCreateStringHandle(ddeInstance, (void *) serviceName, + CP_WINUNICODE); } if ((index != DDE_SERVERNAME) && (index != DDE_EVAL)) { +#ifdef UNICODE + topicName = (TCHAR *) Tcl_GetUnicodeFromObj(objv[firstArg + 1], &length); +#else topicName = Tcl_GetStringFromObj(objv[firstArg + 1], &length); +#endif if (length == 0) { topicName = NULL; } else { - ddeTopic = DdeCreateStringHandle(ddeInstance, topicName, - CP_WINANSI); + ddeTopic = DdeCreateStringHandle(ddeInstance, (void *) topicName, + CP_WINUNICODE); } } switch ((enum DdeSubcommands) index) { case DDE_SERVERNAME: - serviceName = DdeSetServerName(interp, serviceName, exact, handlerPtr); + serviceName = DdeSetServerName(interp, serviceName, flags, + handlerPtr); if (serviceName != NULL) { +#ifdef UNICODE + Tcl_SetObjResult(interp, Tcl_NewUnicodeObj((Tcl_UniChar *) serviceName, -1)); +#else Tcl_SetObjResult(interp, Tcl_NewStringObj(serviceName, -1)); +#endif } else { Tcl_ResetResult(interp); } @@ -1346,12 +1496,21 @@ Tcl_DdeObjCmd(clientData, interp, objc, objv) case DDE_EXECUTE: { int dataLength; - char *dataString = Tcl_GetStringFromObj(objv[firstArg + 2], - &dataLength); + const Tcl_UniChar *dataString; - if (dataLength == 0) { + if (flags & DDE_FLAG_BINARY) { + dataString = (const Tcl_UniChar *) + Tcl_GetByteArrayFromObj(objv[firstArg + 2], &dataLength); + } else { + dataString = + Tcl_GetUnicodeFromObj(objv[firstArg + 2], &dataLength); + dataLength = (dataLength + 1) * sizeof(Tcl_UniChar); + } + + if (dataLength <= 0) { Tcl_SetObjResult(interp, Tcl_NewStringObj("cannot execute null data", -1)); + Tcl_SetErrorCode(interp, "TCL", "DDE", "NULL", NULL); result = TCL_ERROR; break; } @@ -1365,16 +1524,16 @@ Tcl_DdeObjCmd(clientData, interp, objc, objv) break; } - ddeData = DdeCreateDataHandle(ddeInstance, dataString, - (DWORD) dataLength+1, 0, 0, CF_TEXT, 0); + ddeData = DdeCreateDataHandle(ddeInstance, (BYTE *) dataString, + (DWORD) dataLength, 0, 0, (flags & DDE_FLAG_BINARY) ? CF_TEXT : CF_UNICODETEXT, 0); if (ddeData != NULL) { - if (async) { + if (flags & DDE_FLAG_ASYNC) { DdeClientTransaction((LPBYTE) ddeData, 0xFFFFFFFF, hConv, 0, - CF_TEXT, XTYP_EXECUTE, TIMEOUT_ASYNC, &ddeResult); + (flags & DDE_FLAG_BINARY) ? CF_TEXT : CF_UNICODETEXT, XTYP_EXECUTE, TIMEOUT_ASYNC, &ddeResult); DdeAbandonTransaction(ddeInstance, hConv, ddeResult); } else { ddeReturn = DdeClientTransaction((LPBYTE) ddeData, 0xFFFFFFFF, - hConv, 0, CF_TEXT, XTYP_EXECUTE, 30000, NULL); + hConv, 0, (flags & DDE_FLAG_BINARY) ? CF_TEXT : CF_UNICODETEXT, XTYP_EXECUTE, 30000, NULL); if (ddeReturn == 0) { SetDdeError(interp); result = TCL_ERROR; @@ -1388,11 +1547,18 @@ Tcl_DdeObjCmd(clientData, interp, objc, objv) break; } case DDE_REQUEST: { - char *itemString = Tcl_GetStringFromObj(objv[firstArg + 2], &length); +#ifdef UNICODE + const TCHAR *itemString = (TCHAR *) Tcl_GetUnicodeFromObj(objv[firstArg + 2], + &length); +#else + const TCHAR *itemString = Tcl_GetStringFromObj(objv[firstArg + 2], + &length); +#endif 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; } @@ -1405,23 +1571,28 @@ Tcl_DdeObjCmd(clientData, interp, objc, objv) result = TCL_ERROR; } else { Tcl_Obj *returnObjPtr; - ddeItem = DdeCreateStringHandle(ddeInstance, 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); + (flags & DDE_FLAG_BINARY) ? CF_TEXT : CF_UNICODETEXT, XTYP_REQUEST, 5000, NULL); if (ddeData == NULL) { SetDdeError(interp); result = TCL_ERROR; } else { DWORD tmp; - char *dataString = DdeAccessData(ddeData, &tmp); + const Tcl_UniChar *dataString = (const Tcl_UniChar *) DdeAccessData(ddeData, &tmp); - if (binary) { - returnObjPtr = Tcl_NewByteArrayObj(dataString, - (int) tmp); + if (flags & DDE_FLAG_BINARY) { + returnObjPtr = + Tcl_NewByteArrayObj((BYTE *) dataString, (int) tmp); } else { - returnObjPtr = Tcl_NewStringObj(dataString, -1); + tmp >>= 1; + if (tmp && !dataString[(tmp-1)]) { + --tmp; + } + returnObjPtr = Tcl_NewUnicodeObj(dataString, + (int) tmp); } DdeUnaccessData(ddeData); DdeFreeDataHandle(ddeData); @@ -1436,16 +1607,30 @@ Tcl_DdeObjCmd(clientData, interp, objc, objv) break; } case DDE_POKE: { - char *itemString = Tcl_GetStringFromObj(objv[firstArg + 2], &length); - char *dataString; +#ifdef UNICODE + const TCHAR *itemString = (TCHAR *) Tcl_GetUnicodeFromObj(objv[firstArg + 2], + &length); +#else + const TCHAR *itemString = Tcl_GetStringFromObj(objv[firstArg + 2], + &length); +#endif + BYTE *dataString; 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; } - dataString = Tcl_GetStringFromObj(objv[firstArg + 3], &length); + if (flags & DDE_FLAG_BINARY) { + dataString = (BYTE *) + Tcl_GetByteArrayFromObj(objv[firstArg + 3], &length); + } else { + dataString = (BYTE *) + Tcl_GetUnicodeFromObj(objv[firstArg + 3], &length); + length = 2 * length + 1; + } hConv = DdeConnect(ddeInstance, ddeService, ddeTopic, NULL); DdeFreeStringHandle(ddeInstance, ddeService); @@ -1455,11 +1640,11 @@ Tcl_DdeObjCmd(clientData, interp, objc, objv) SetDdeError(interp); result = TCL_ERROR; } else { - ddeItem = DdeCreateStringHandle(ddeInstance, itemString, - CP_WINANSI); + ddeItem = DdeCreateStringHandle(ddeInstance, (void *) itemString, + CP_WINUNICODE); if (ddeItem != NULL) { - ddeData = DdeClientTransaction(dataString, (DWORD) length+1, - hConv, ddeItem, CF_TEXT, XTYP_POKE, 5000, NULL); + ddeData = DdeClientTransaction(dataString, (DWORD) length, + hConv, ddeItem, (flags & DDE_FLAG_BINARY) ? CF_TEXT : CF_UNICODETEXT, XTYP_POKE, 5000, NULL); if (ddeData == NULL) { SetDdeError(interp); result = TCL_ERROR; @@ -1483,12 +1668,13 @@ Tcl_DdeObjCmd(clientData, interp, objc, objv) 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; } - objc -= (async + 3); - ((Tcl_Obj **) objv) += (async + 3); + objc -= firstArg + 1; + objv += firstArg + 1; /* * See if the target interpreter is local. If so, execute the command @@ -1501,7 +1687,7 @@ Tcl_DdeObjCmd(clientData, interp, objc, objv) for (riPtr = tsdPtr->interpListPtr; riPtr != NULL; riPtr = riPtr->nextPtr) { - if (stricmp(serviceName, riPtr->name) == 0) { + if (_tcsicmp(serviceName, riPtr->name) == 0) { break; } } @@ -1514,9 +1700,9 @@ Tcl_DdeObjCmd(clientData, interp, objc, objv) * 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 @@ -1527,9 +1713,11 @@ Tcl_DdeObjCmd(clientData, interp, objc, objv) */ if (Tcl_IsSafe(riPtr->interp) && riPtr->handlerPtr == NULL) { - Tcl_SetResult(riPtr->interp, "permission denied: " - "a handler procedure must be defined for use in " - "a safe interp", TCL_STATIC); + Tcl_SetObjResult(riPtr->interp, Tcl_NewStringObj( + "permission denied: a handler procedure must be" + " defined for use in a safe interp", -1)); + Tcl_SetErrorCode(interp, "TCL", "DDE", "SECURITY_CHECK", + NULL); result = TCL_ERROR; } @@ -1581,8 +1769,8 @@ Tcl_DdeObjCmd(clientData, interp, objc, objv) } 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 @@ -1592,31 +1780,31 @@ Tcl_DdeObjCmd(clientData, interp, objc, objv) 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; } objPtr = Tcl_ConcatObj(objc, objv); - string = Tcl_GetStringFromObj(objPtr, &length); - ddeItemData = DdeCreateDataHandle(ddeInstance, string, - (DWORD) length+1, 0, 0, CF_TEXT, 0); + string = (const char *) Tcl_GetUnicodeFromObj(objPtr, &length); + ddeItemData = DdeCreateDataHandle(ddeInstance, + (BYTE *) string, (DWORD) 2*length+2, 0, 0, CF_UNICODETEXT, 0); - if (async) { + if (flags & DDE_FLAG_ASYNC) { ddeData = DdeClientTransaction((LPBYTE) ddeItemData, 0xFFFFFFFF, hConv, 0, - CF_TEXT, XTYP_EXECUTE, TIMEOUT_ASYNC, &ddeResult); + CF_UNICODETEXT, XTYP_EXECUTE, TIMEOUT_ASYNC, &ddeResult); DdeAbandonTransaction(ddeInstance, hConv, ddeResult); } else { ddeData = DdeClientTransaction((LPBYTE) ddeItemData, 0xFFFFFFFF, hConv, 0, - CF_TEXT, XTYP_EXECUTE, 30000, NULL); + CF_UNICODETEXT, 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); + CF_UNICODETEXT, XTYP_REQUEST, 30000, NULL); } } @@ -1625,10 +1813,12 @@ Tcl_DdeObjCmd(clientData, interp, objc, objv) if (ddeData == 0) { SetDdeError(interp); result = TCL_ERROR; + goto cleanup; } - if (async == 0) { + if (!(flags & DDE_FLAG_ASYNC)) { Tcl_Obj *resultPtr; + Tcl_UniChar *ddeDataString; /* * The return handle has a two or four element list in it. The @@ -1641,10 +1831,11 @@ Tcl_DdeObjCmd(clientData, interp, objc, objv) resultPtr = Tcl_NewObj(); length = DdeGetData(ddeData, NULL, 0, 0); - Tcl_SetObjLength(resultPtr, length); - string = Tcl_GetString(resultPtr); - DdeGetData(ddeData, string, (DWORD) length, 0); - Tcl_SetObjLength(resultPtr, (int) strlen(string)); + ddeDataString = ckalloc(length); + DdeGetData(ddeData, (BYTE *) ddeDataString, (DWORD) length, 0); + length = (length >> 1) - 1; + resultPtr = Tcl_NewUnicodeObj(ddeDataString, length); + ckfree(ddeDataString); if (Tcl_ListObjIndex(NULL, resultPtr, 0, &objPtr) != TCL_OK) { Tcl_DecrRefCount(resultPtr); |