diff options
Diffstat (limited to 'win/tclWinDde.c')
| -rw-r--r-- | win/tclWinDde.c | 438 |
1 files changed, 301 insertions, 137 deletions
diff --git a/win/tclWinDde.c b/win/tclWinDde.c index 5543732..d0600e6 100644 --- a/win/tclWinDde.c +++ b/win/tclWinDde.c @@ -10,10 +10,28 @@ * this file, and for a DISCLAIMER OF ALL WARRANTIES. */ +#undef STATIC_BUILD +#undef USE_TCL_STUBS +#define USE_TCL_STUBS #include "tclInt.h" #include <dde.h> #include <ddeml.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 * declaration is in the source file itself, which is only accessed when we @@ -33,7 +51,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; @@ -78,10 +96,10 @@ static DWORD ddeInstance; /* The application instance handle given to us * by DdeInitialize. */ static int ddeIsServer = 0; -#define TCL_DDE_VERSION "1.3.3" +#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 @@ -100,7 +118,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); @@ -110,7 +128,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, @@ -143,6 +161,13 @@ Dde_Init( 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); @@ -229,7 +254,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; @@ -263,10 +288,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 flags, /* DDE_FLAG_FORCE or 0 */ @@ -276,7 +301,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); @@ -314,7 +339,7 @@ DdeSetServerName( * current interp, but it doesn't have a name. */ - return ""; + return TEXT(""); } /* @@ -335,7 +360,9 @@ DdeSetServerName( &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; } @@ -352,13 +379,13 @@ DdeSetServerName( 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); + _stprintf((TCHAR *) (Tcl_DStringValue(&dString) + offset), TEXT("%d"), suffix); } /* @@ -367,39 +394,41 @@ DdeSetServerName( 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); } } - Tcl_DStringSetLength(&dString, - offset + (int)strlen(Tcl_DStringValue(&dString)+offset)); } /* * 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"); } @@ -528,6 +557,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; } @@ -607,7 +637,7 @@ DdeServerProc( Tcl_DString dString; int len; DWORD dlen; - char *utilString; + TCHAR *utilString; Tcl_Obj *ddeObjectPtr; HDDEDATA ddeReturn = NULL; RegisteredInterp *riPtr; @@ -621,16 +651,16 @@ DdeServerProc( * 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; } @@ -646,16 +676,16 @@ DdeServerProc( * 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; @@ -685,7 +715,7 @@ DdeServerProc( if (convPtr->returnPackagePtr != NULL) { Tcl_DecrRefCount(convPtr->returnPackagePtr); } - ckfree((char *) convPtr); + ckfree(convPtr); break; } } @@ -713,20 +743,20 @@ 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); } else { returnString = (char *) Tcl_GetUnicodeFromObj(convPtr->returnPackagePtr, &len); - len = 2 * len + 1; + len = sizeof(TCHAR) * len + 1; } ddeReturn = DdeCreateDataHandle(ddeInstance, (BYTE *)returnString, (DWORD) len+1, 0, ddeItem, uFmt, 0); @@ -734,8 +764,11 @@ DdeServerProc( 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) { if (uFmt == CF_TEXT) { @@ -744,7 +777,7 @@ DdeServerProc( } else { returnString = (char *) Tcl_GetUnicodeFromObj( variableObjPtr, &len); - len = 2 * len + 1; + len = sizeof(TCHAR) * len + 1; } ddeReturn = DdeCreateDataHandle(ddeInstance, (BYTE *)returnString, (DWORD) len+1, 0, ddeItem, @@ -752,12 +785,60 @@ DdeServerProc( } 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 @@ -765,7 +846,7 @@ DdeServerProc( */ Tcl_Obj *returnPackagePtr; - Tcl_UniChar *uniStr; + char *string; for (convPtr = tsdPtr->currentConversations; (convPtr != NULL) && (convPtr->hConv != hConv); convPtr = convPtr->nextPtr) { @@ -778,21 +859,21 @@ DdeServerProc( return (HDDEDATA) DDE_FNOTPROCESSED; } - utilString = (char *) DdeAccessData(hData, &dlen); - uniStr = (Tcl_UniChar *) utilString; + utilString = (TCHAR *) DdeAccessData(hData, &dlen); + string = (char *) utilString; if (!dlen) { /* Empty binary array. */ ddeObjectPtr = Tcl_NewObj(); - } else if ((dlen & 1) || uniStr[(dlen>>1)-1]) { + } else if ((dlen & 1) || utilString[(dlen>>1)-1]) { /* Cannot be unicode, so assume utf-8 */ - if (!utilString[dlen-1]) { + if (!string[dlen-1]) { dlen--; } - ddeObjectPtr = Tcl_NewStringObj(utilString, dlen); + ddeObjectPtr = Tcl_NewStringObj(string, dlen); } else { /* unicode */ dlen >>= 1; - ddeObjectPtr = Tcl_NewUnicodeObj(uniStr, dlen - 1); + ddeObjectPtr = Tcl_NewUnicodeObj((Tcl_UniChar *)utilString, dlen - 1); } Tcl_IncrRefCount(ddeObjectPtr); DdeUnaccessData(hData); @@ -845,9 +926,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; @@ -905,14 +986,14 @@ 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; 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); @@ -920,8 +1001,13 @@ MakeDdeConnection( if (ddeConv == (HCONV) NULL) { if (interp != NULL) { - Tcl_AppendResult(interp, "no registered server named \"", - name, "\"", 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; } @@ -955,8 +1041,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); @@ -1011,7 +1097,8 @@ DdeServicesOnAck( ATOM service = (ATOM)LOWORD(lParam); ATOM topic = (ATOM)HIWORD(lParam); struct DdeEnumServices *es; - char sz[255]; + TCHAR sz[255]; + Tcl_DString dString; #ifdef _WIN64 es = (struct DdeEnumServices *) GetWindowLongPtr(hwnd, GWLP_USERDATA); @@ -1025,9 +1112,13 @@ DdeServicesOnAck( Tcl_Obj *resultPtr = Tcl_GetObjResult(es->interp); GlobalGetAtomName(service, 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); 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 @@ -1074,8 +1165,8 @@ DdeEnumWindowsCallback( static int DdeGetServicesList( Tcl_Interp *interp, - const char *serviceName, - const char *topicName) + const TCHAR *serviceName, + const TCHAR *topicName) { struct DdeEnumServices es; @@ -1122,25 +1213,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); } /* @@ -1167,23 +1263,29 @@ 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", "-binary", NULL + }; + enum DdeExecOptions { + DDE_EXEC_ASYNC, DDE_EXEC_BINARY + }; + static const char *const ddeEvalOptions[] = { "-async", NULL }; - static const char *ddeReqOptions[] = { + static const char *const ddeReqOptions[] = { "-binary", NULL }; @@ -1192,7 +1294,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; @@ -1259,38 +1362,53 @@ DdeObjCmd( if (objc == 5) { firstArg = 2; break; - } else if (objc == 6) { - if (Tcl_GetIndexFromObj(NULL, objv[2], ddeExecOptions, "option", 0, - &argIndex) == TCL_OK) { - flags |= DDE_FLAG_ASYNC; - 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) { - flags |= DDE_FLAG_BINARY; - 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; } /* @@ -1314,7 +1432,7 @@ DdeObjCmd( return TCL_ERROR; } else { firstArg = 2; - if (Tcl_GetIndexFromObj(NULL, objv[2], ddeExecOptions, "option", + if (Tcl_GetIndexFromObj(NULL, objv[2], ddeEvalOptions, "option", 0, &argIndex) == TCL_OK) { if (objc < 5) { goto wrongDdeEvalArgs; @@ -1329,7 +1447,11 @@ DdeObjCmd( Initialize(); if (firstArg != 1) { +#ifdef UNICODE + serviceName = Tcl_GetUnicodeFromObj(objv[firstArg], &length); +#else serviceName = Tcl_GetStringFromObj(objv[firstArg], &length); +#endif } else { length = 0; } @@ -1338,16 +1460,20 @@ 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)) { +#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, (void *) topicName, - CP_WINANSI); + CP_WINUNICODE); } } @@ -1356,7 +1482,11 @@ DdeObjCmd( 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); } @@ -1364,12 +1494,21 @@ DdeObjCmd( case DDE_EXECUTE: { int dataLength; - BYTE *dataString = (BYTE *) 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; } @@ -1383,16 +1522,16 @@ DdeObjCmd( 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 (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; @@ -1406,12 +1545,18 @@ DdeObjCmd( break; } case DDE_REQUEST: { - const char *itemString = Tcl_GetStringFromObj(objv[firstArg + 2], +#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; } @@ -1424,26 +1569,27 @@ 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); + (flags & DDE_FLAG_BINARY) ? CF_TEXT : CF_UNICODETEXT, XTYP_REQUEST, 5000, NULL); if (ddeData == NULL) { SetDdeError(interp); result = TCL_ERROR; } else { DWORD tmp; - const char *dataString = (const char *) DdeAccessData(ddeData, &tmp); + const Tcl_UniChar *dataString = (const Tcl_UniChar *) DdeAccessData(ddeData, &tmp); if (flags & DDE_FLAG_BINARY) { returnObjPtr = Tcl_NewByteArrayObj((BYTE *) dataString, (int) tmp); } else { - if (tmp && !dataString[tmp-1]) { + tmp >>= 1; + if (tmp && !dataString[(tmp-1)]) { --tmp; } - returnObjPtr = Tcl_NewStringObj(dataString, + returnObjPtr = Tcl_NewUnicodeObj(dataString, (int) tmp); } DdeUnaccessData(ddeData); @@ -1459,18 +1605,30 @@ DdeObjCmd( break; } case DDE_POKE: { - const char *itemString = Tcl_GetStringFromObj(objv[firstArg + 2], +#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 = (BYTE *) 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); @@ -1481,10 +1639,10 @@ 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); + 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; @@ -1508,6 +1666,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; } @@ -1526,7 +1685,7 @@ DdeObjCmd( for (riPtr = tsdPtr->interpListPtr; riPtr != NULL; riPtr = riPtr->nextPtr) { - if (stricmp(serviceName, riPtr->name) == 0) { + if (_tcsicmp(serviceName, riPtr->name) == 0) { break; } } @@ -1539,9 +1698,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 @@ -1552,9 +1711,11 @@ DdeObjCmd( */ 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; } @@ -1606,8 +1767,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 @@ -1617,31 +1778,31 @@ 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; } objPtr = Tcl_ConcatObj(objc, objv); - string = Tcl_GetStringFromObj(objPtr, &length); + string = (const char *) Tcl_GetUnicodeFromObj(objPtr, &length); ddeItemData = DdeCreateDataHandle(ddeInstance, - (BYTE *) string, (DWORD) length+1, 0, 0, CF_TEXT, 0); + (BYTE *) string, (DWORD) 2*length+2, 0, 0, CF_UNICODETEXT, 0); 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); } } @@ -1650,10 +1811,12 @@ DdeObjCmd( if (ddeData == 0) { SetDdeError(interp); result = TCL_ERROR; + goto cleanup; } if (!(flags & DDE_FLAG_ASYNC)) { Tcl_Obj *resultPtr; + Tcl_UniChar *ddeDataString; /* * The return handle has a two or four element list in it. The @@ -1666,10 +1829,11 @@ DdeObjCmd( resultPtr = Tcl_NewObj(); length = DdeGetData(ddeData, NULL, 0, 0); - Tcl_SetObjLength(resultPtr, length); - string = Tcl_GetString(resultPtr); - DdeGetData(ddeData, (BYTE *) 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); |