#include "tclPort.h"
#include <ddeml.h>
#undef TCL_STORAGE_CLASS
#define TCL_STORAGE_CLASS DLLEXPORT
typedef struct RegisteredInterp {
struct RegisteredInterp *nextPtr;
char *name;
Tcl_Interp *interp;
} RegisteredInterp;
typedef struct Conversation {
struct Conversation *nextPtr;
RegisteredInterp *riPtr;
HCONV hConv;
Tcl_Obj *returnPackagePtr;
} Conversation;
typedef struct ThreadSpecificData {
Conversation *currentConversations;
RegisteredInterp *interpListPtr;
} ThreadSpecificData;
static Tcl_ThreadDataKey dataKey;
static HSZ ddeServiceGlobal = 0;
static DWORD ddeInstance;
static int ddeIsServer = 0;
#define TCL_DDE_VERSION "1.2"
#define TCL_DDE_PACKAGE_NAME "dde"
#define TCL_DDE_SERVICE_NAME "TclEval"
TCL_DECLARE_MUTEX(ddeMutex)
static void DdeExitProc _ANSI_ARGS_((ClientData clientData));
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 HDDEDATA CALLBACK DdeServerProc _ANSI_ARGS_((UINT uType,
UINT uFmt, HCONV hConv, HSZ ddeTopic,
HSZ ddeItem, HDDEDATA hData, DWORD dwData1,
DWORD dwData2));
static void SetDdeError _ANSI_ARGS_((Tcl_Interp *interp));
int Tcl_DdeObjCmd(ClientData clientData,
Tcl_Interp *interp,
int objc,
Tcl_Obj *CONST objv[]);
EXTERN int Dde_Init(Tcl_Interp *interp);
int
Dde_Init(
Tcl_Interp *interp)
{
ThreadSpecificData *tsdPtr;
if (!Tcl_InitStubs(interp, "8.0", 0)) {
return TCL_ERROR;
}
Tcl_CreateObjCommand(interp, "dde", Tcl_DdeObjCmd, NULL, NULL);
tsdPtr = (ThreadSpecificData *)
Tcl_GetThreadData((Tcl_ThreadDataKey *) &dataKey, sizeof(ThreadSpecificData));
if (tsdPtr == NULL) {
tsdPtr = TCL_TSD_INIT(&dataKey);
tsdPtr->currentConversations = NULL;
tsdPtr->interpListPtr = NULL;
}
Tcl_CreateExitHandler(DdeExitProc, NULL);
return Tcl_PkgProvide(interp, TCL_DDE_PACKAGE_NAME, TCL_DDE_VERSION);
}
static void
Initialize(void)
{
int nameFound = 0;
ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
if (tsdPtr->interpListPtr != NULL) {
nameFound = 1;
}
if (ddeInstance == 0) {
Tcl_MutexLock(&ddeMutex);
if (ddeInstance == 0) {
if (DdeInitialize(&ddeInstance, DdeServerProc,
CBF_SKIP_REGISTRATIONS
| CBF_SKIP_UNREGISTRATIONS
| CBF_FAIL_POKES, 0)
!= DMLERR_NO_ERROR) {
ddeInstance = 0;
}
}
Tcl_MutexUnlock(&ddeMutex);
}
if ((ddeServiceGlobal == 0) && (nameFound != 0)) {
Tcl_MutexLock(&ddeMutex);
if ((ddeServiceGlobal == 0) && (nameFound != 0)) {
ddeIsServer = 1;
Tcl_CreateExitHandler(DdeExitProc, NULL);
ddeServiceGlobal = DdeCreateStringHandle(ddeInstance, \
TCL_DDE_SERVICE_NAME, 0);
DdeNameService(ddeInstance, ddeServiceGlobal, 0L, DNS_REGISTER);
} else {
ddeIsServer = 0;
}
Tcl_MutexUnlock(&ddeMutex);
}
}
static char *
DdeSetServerName(
Tcl_Interp *interp,
char *name
)
{
int suffix, offset;
RegisteredInterp *riPtr, *prevPtr;
Tcl_DString dString;
ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
for (riPtr = tsdPtr->interpListPtr, prevPtr = NULL; riPtr != NULL;
prevPtr = riPtr, riPtr = riPtr->nextPtr) {
if (riPtr->interp == interp) {
if (name != NULL) {
if (prevPtr == NULL) {
tsdPtr->interpListPtr = tsdPtr->interpListPtr->nextPtr;
} else {
prevPtr->nextPtr = riPtr->nextPtr;
}
break;
} else {
return riPtr->name;
}
}
}
if (name == NULL) {
return "";
}
suffix = 1;
offset = 0;
Tcl_DStringInit(&dString);
riPtr = (RegisteredInterp *) ckalloc(sizeof(RegisteredInterp));
riPtr->interp = interp;
riPtr->name = ckalloc(strlen(name) + 1);
riPtr->nextPtr = tsdPtr->interpListPtr;
tsdPtr->interpListPtr = riPtr;
strcpy(riPtr->name, name);
Tcl_CreateObjCommand(interp, "dde", Tcl_DdeObjCmd,
(ClientData) riPtr, DeleteProc);
if (Tcl_IsSafe(interp)) {
Tcl_HideCommand(interp, "dde", "dde");
}
Tcl_DStringFree(&dString);
Initialize();
return riPtr->name;
}
static void
DeleteProc(clientData)
ClientData clientData;
{
RegisteredInterp *riPtr = (RegisteredInterp *) clientData;
RegisteredInterp *searchPtr, *prevPtr;
ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
for (searchPtr = tsdPtr->interpListPtr, prevPtr = NULL;
(searchPtr != NULL) && (searchPtr != riPtr);
prevPtr = searchPtr, searchPtr = searchPtr->nextPtr) {
}
if (searchPtr != NULL) {
if (prevPtr == NULL) {
tsdPtr->interpListPtr = tsdPtr->interpListPtr->nextPtr;
} else {
prevPtr->nextPtr = searchPtr->nextPtr;
}
}
ckfree(riPtr->name);
Tcl_EventuallyFree(clientData, TCL_DYNAMIC);
}
static Tcl_Obj *
ExecuteRemoteObject(
RegisteredInterp *riPtr,
Tcl_Obj *ddeObjectPtr)
{
Tcl_Obj *errorObjPtr;
Tcl_Obj *returnPackagePtr;
int result;
result = Tcl_EvalObjEx(riPtr->interp, ddeObjectPtr, TCL_EVAL_GLOBAL);
returnPackagePtr = Tcl_NewListObj(0, (Tcl_Obj **) NULL);
Tcl_ListObjAppendElement(NULL, returnPackagePtr,
Tcl_NewIntObj(result));
Tcl_ListObjAppendElement(NULL, returnPackagePtr,
Tcl_GetObjResult(riPtr->interp));
if (result == TCL_ERROR) {
errorObjPtr = Tcl_GetVar2Ex(riPtr->interp, "errorCode", NULL,
TCL_GLOBAL_ONLY);
Tcl_ListObjAppendElement(NULL, returnPackagePtr, errorObjPtr);
errorObjPtr = Tcl_GetVar2Ex(riPtr->interp, "errorInfo", NULL,
TCL_GLOBAL_ONLY);
Tcl_ListObjAppendElement(NULL, returnPackagePtr, errorObjPtr);
}
return returnPackagePtr;
}
static HDDEDATA CALLBACK
DdeServerProc (
UINT uType,
UINT uFmt,
HCONV hConv,
HSZ ddeTopic,
HSZ ddeItem,
HDDEDATA hData,
DWORD dwData1,
DWORD dwData2)
{
Tcl_DString dString;
int len;
char *utilString;
Tcl_Obj *ddeObjectPtr;
HDDEDATA ddeReturn = NULL;
RegisteredInterp *riPtr;
Conversation *convPtr, *prevConvPtr;
ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
switch(uType) {
case XTYP_CONNECT:
len = DdeQueryString(ddeInstance, ddeTopic, NULL, 0, 0);
Tcl_DStringInit(&dString);
Tcl_DStringSetLength(&dString, len);
utilString = Tcl_DStringValue(&dString);
DdeQueryString(ddeInstance, ddeTopic, utilString, len + 1,
CP_WINANSI);
for (riPtr = tsdPtr->interpListPtr; riPtr != NULL;
riPtr = riPtr->nextPtr) {
if (stricmp(utilString, riPtr->name) == 0) {
Tcl_DStringFree(&dString);
return (HDDEDATA) TRUE;
}
}
Tcl_DStringFree(&dString);
return (HDDEDATA) FALSE;
case XTYP_CONNECT_CONFIRM:
len = DdeQueryString(ddeInstance, ddeTopic, NULL, 0, 0);
Tcl_DStringInit(&dString);
Tcl_DStringSetLength(&dString, len);
utilString = Tcl_DStringValue(&dString);
DdeQueryString(ddeInstance, ddeTopic, utilString, len + 1,
CP_WINANSI);
for (riPtr = tsdPtr->interpListPtr; riPtr != NULL;
riPtr = riPtr->nextPtr) {
if (stricmp(riPtr->name, utilString) == 0) {
convPtr = (Conversation *) ckalloc(sizeof(Conversation));
convPtr->nextPtr = tsdPtr->currentConversations;
convPtr->returnPackagePtr = NULL;
convPtr->hConv = hConv;
convPtr->riPtr = riPtr;
tsdPtr->currentConversations = convPtr;
break;
}
}
Tcl_DStringFree(&dString);
return (HDDEDATA) TRUE;
case XTYP_DISCONNECT:
for (convPtr = tsdPtr->currentConversations, prevConvPtr = NULL;
convPtr != NULL;
prevConvPtr = convPtr, convPtr = convPtr->nextPtr) {
if (hConv == convPtr->hConv) {
if (prevConvPtr == NULL) {
tsdPtr->currentConversations = convPtr->nextPtr;
} else {
prevConvPtr->nextPtr = convPtr->nextPtr;
}
if (convPtr->returnPackagePtr != NULL) {
Tcl_DecrRefCount(convPtr->returnPackagePtr);
}
ckfree((char *) convPtr);
break;
}
}
return (HDDEDATA) TRUE;
case XTYP_REQUEST:
if (uFmt != CF_TEXT) {
return (HDDEDATA) FALSE;
}
ddeReturn = (HDDEDATA) FALSE;
for (convPtr = tsdPtr->currentConversations; (convPtr != NULL)
&& (convPtr->hConv != hConv); convPtr = convPtr->nextPtr) {
}
if (convPtr != NULL) {
char *returnString;
len = DdeQueryString(ddeInstance, ddeItem, NULL, 0,
CP_WINANSI);
Tcl_DStringInit(&dString);
Tcl_DStringSetLength(&dString, len);
utilString = Tcl_DStringValue(&dString);
DdeQueryString(ddeInstance, ddeItem, utilString,
len + 1, CP_WINANSI);
if (stricmp(utilString, "$TCLEVAL$EXECUTE$RESULT") == 0) {
returnString =
Tcl_GetStringFromObj(convPtr->returnPackagePtr, &len);
ddeReturn = DdeCreateDataHandle(ddeInstance,
returnString, len+1, 0, ddeItem, CF_TEXT,
0);
} else {
Tcl_Obj *variableObjPtr = Tcl_GetVar2Ex(
convPtr->riPtr->interp, utilString, NULL,
TCL_GLOBAL_ONLY);
if (variableObjPtr != NULL) {
returnString = Tcl_GetStringFromObj(variableObjPtr,
&len);
ddeReturn = DdeCreateDataHandle(ddeInstance,
returnString, len+1, 0, ddeItem, CF_TEXT, 0);
} else {
ddeReturn = NULL;
}
}
Tcl_DStringFree(&dString);
}
return ddeReturn;
case XTYP_EXECUTE: {
Tcl_Obj *returnPackagePtr;
for (convPtr = tsdPtr->currentConversations; (convPtr != NULL)
&& (convPtr->hConv != hConv); convPtr = convPtr->nextPtr) {
}
if (convPtr == NULL) {
return (HDDEDATA) DDE_FNOTPROCESSED;
}
utilString = (char *) DdeAccessData(hData, &len);
ddeObjectPtr = Tcl_NewStringObj(utilString, -1);
Tcl_IncrRefCount(ddeObjectPtr);
DdeUnaccessData(hData);
if (convPtr->returnPackagePtr != NULL) {
Tcl_DecrRefCount(convPtr->returnPackagePtr);
}
convPtr->returnPackagePtr = NULL;
returnPackagePtr =
ExecuteRemoteObject(convPtr->riPtr, ddeObjectPtr);
for (convPtr = tsdPtr->currentConversations; (convPtr != NULL)
&& (convPtr->hConv != hConv); convPtr = convPtr->nextPtr) {
}
if (convPtr != NULL) {
Tcl_IncrRefCount(returnPackagePtr);
convPtr->returnPackagePtr = returnPackagePtr;
}
Tcl_DecrRefCount(ddeObjectPtr);
if (returnPackagePtr == NULL) {
return (HDDEDATA) DDE_FNOTPROCESSED;
} else {
return (HDDEDATA) DDE_FACK;
}
}
case XTYP_WILDCONNECT: {
HSZPAIR *returnPtr;
int i;
int numItems;
for (i = 0, riPtr = tsdPtr->interpListPtr; riPtr != NULL;
i++, riPtr = riPtr->nextPtr) {
}
numItems = i;
ddeReturn = DdeCreateDataHandle(ddeInstance, NULL,
(numItems + 1) * sizeof(HSZPAIR), 0, 0, 0, 0);
returnPtr = (HSZPAIR *) DdeAccessData(ddeReturn, &len);
for (i = 0, riPtr = tsdPtr->interpListPtr; i < numItems;
i++, riPtr = riPtr->nextPtr) {
returnPtr[i].hszSvc = DdeCreateStringHandle(
ddeInstance, "TclEval", CP_WINANSI);
returnPtr[i].hszTopic = DdeCreateStringHandle(
ddeInstance, riPtr->name, CP_WINANSI);
}
returnPtr[i].hszSvc = NULL;
returnPtr[i].hszTopic = NULL;
DdeUnaccessData(ddeReturn);
return ddeReturn;
}
}
return NULL;
}
static void
DdeExitProc(
ClientData clientData)
{
DdeNameService(ddeInstance, NULL, 0, DNS_UNREGISTER);
DdeUninitialize(ddeInstance);
ddeInstance = 0;
}
static int
MakeDdeConnection(
Tcl_Interp *interp,
char *name,
HCONV *ddeConvPtr)
{
HSZ ddeTopic, ddeService;
HCONV ddeConv;
ddeService = DdeCreateStringHandle(ddeInstance, "TclEval", 0);
ddeTopic = DdeCreateStringHandle(ddeInstance, name, 0);
ddeConv = DdeConnect(ddeInstance, ddeService, ddeTopic, NULL);
DdeFreeStringHandle(ddeInstance, ddeService);
DdeFreeStringHandle(ddeInstance, ddeTopic);
if (ddeConv == (HCONV) NULL) {
if (interp != NULL) {
Tcl_AppendResult(interp, "no registered server named \"",
name, "\"", (char *) NULL);
}
return TCL_ERROR;
}
*ddeConvPtr = ddeConv;
return TCL_OK;
}
static void
SetDdeError(
Tcl_Interp *interp)
{
Tcl_Obj *resultPtr = Tcl_GetObjResult(interp);
int err;
err = DdeGetLastError(ddeInstance);
switch (err) {
case DMLERR_DATAACKTIMEOUT:
case DMLERR_EXECACKTIMEOUT:
case DMLERR_POKEACKTIMEOUT:
Tcl_SetStringObj(resultPtr,
"remote interpreter did not respond", -1);
break;
case DMLERR_BUSY:
Tcl_SetStringObj(resultPtr, "remote server is busy", -1);
break;
case DMLERR_NOTPROCESSED:
Tcl_SetStringObj(resultPtr,
"remote server cannot handle this command", -1);
break;
default:
Tcl_SetStringObj(resultPtr, "dde command failed", -1);
}
}
int
Tcl_DdeObjCmd(
ClientData clientData,
Tcl_Interp *interp,
int objc,
Tcl_Obj *CONST objv[])
{
enum {
DDE_SERVERNAME,
DDE_EXECUTE,
DDE_POKE,
DDE_REQUEST,
DDE_SERVICES,
DDE_EVAL
};
static CONST char *ddeCommands[] = {"servername", "execute", "poke",
"request", "services", "eval",
(char *) NULL};
static CONST char *ddeOptions[] = {"-async", (char *) NULL};
static CONST char *ddeReqOptions[] = {"-binary", (char *) NULL};
int index, argIndex;
int async = 0, binary = 0;
int result = TCL_OK;
HSZ ddeService = NULL;
HSZ ddeTopic = NULL;
HSZ ddeItem = NULL;
HDDEDATA ddeData = NULL;
HDDEDATA ddeItemData = NULL;
HCONV hConv = NULL;
HSZ ddeCookie = 0;
char *serviceName, *topicName, *itemString, *dataString;
char *string;
int firstArg, length, dataLength;
DWORD ddeResult;
HDDEDATA ddeReturn;
RegisteredInterp *riPtr;
Tcl_Interp *sendInterp;
Tcl_Obj *objPtr;
ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
if (objc < 2) {
Tcl_WrongNumArgs(interp, 1, objv,
"?-async? serviceName topicName value");
return TCL_ERROR;
}
if (Tcl_GetIndexFromObj(interp, objv[1], ddeCommands, "command", 0,
&index) != TCL_OK) {
return TCL_ERROR;
}
switch (index) {
case DDE_SERVERNAME:
if ((objc != 3) && (objc != 2)) {
Tcl_WrongNumArgs(interp, 1, objv, "servername ?serverName?");
return TCL_ERROR;
}
firstArg = (objc - 1);
break;
case DDE_EXECUTE:
if ((objc < 5) || (objc > 6)) {
Tcl_WrongNumArgs(interp, 1, objv,
"execute ?-async? serviceName topicName value");
return TCL_ERROR;
}
if (Tcl_GetIndexFromObj(NULL, objv[2], ddeOptions, "option", 0,
&argIndex) != TCL_OK) {
if (objc != 5) {
Tcl_WrongNumArgs(interp, 1, objv,
"execute ?-async? serviceName topicName value");
return TCL_ERROR;
}
async = 0;
firstArg = 2;
} else {
if (objc != 6) {
Tcl_WrongNumArgs(interp, 1, objv,
"execute ?-async? serviceName topicName value");
return TCL_ERROR;
}
async = 1;
firstArg = 3;
}
break;
case DDE_POKE:
if (objc != 6) {
Tcl_WrongNumArgs(interp, 1, objv,
"poke serviceName topicName item value");
return TCL_ERROR;
}
firstArg = 2;
break;
case DDE_REQUEST:
if ((objc < 5) || (objc > 6)) {
Tcl_WrongNumArgs(interp, 1, objv,
"request ?-binary? serviceName topicName value");
return TCL_ERROR;
}
if (Tcl_GetIndexFromObj(NULL, objv[2], ddeReqOptions, "option", 0,
&argIndex) != TCL_OK) {
if (objc != 5) {
Tcl_WrongNumArgs(interp, 1, objv,
"request ?-binary? serviceName topicName value");
return TCL_ERROR;
}
binary = 0;
firstArg = 2;
} else {
if (objc != 6) {
Tcl_WrongNumArgs(interp, 1, objv,
"request ?-binary? serviceName topicName value");
return TCL_ERROR;
}
binary = 1;
firstArg = 3;
}
break;
case DDE_SERVICES:
if (objc != 4) {
Tcl_WrongNumArgs(interp, 1, objv,
"services serviceName topicName");
return TCL_ERROR;
}
firstArg = 2;
break;
case DDE_EVAL:
if (objc < 4) {
Tcl_WrongNumArgs(interp, 1, objv,
"eval ?-async? serviceName args");
return TCL_ERROR;
}
if (Tcl_GetIndexFromObj(NULL, objv[2], ddeOptions, "option", 0,
&argIndex) != TCL_OK) {
if (objc < 4) {
Tcl_WrongNumArgs(interp, 1, objv,
"eval ?-async? serviceName args");
return TCL_ERROR;
}
async = 0;
firstArg = 2;
} else {
if (objc < 5) {
Tcl_WrongNumArgs(interp, 1, objv,
"eval ?-async? serviceName args");
return TCL_ERROR;
}
async = 1;
firstArg = 3;
}
break;
}
Initialize();
if (firstArg != 1) {
serviceName = Tcl_GetStringFromObj(objv[firstArg], &length);
} else {
length = 0;
}
if (length == 0) {
serviceName = NULL;
} else if ((index != DDE_SERVERNAME) && (index != DDE_EVAL)) {
ddeService = DdeCreateStringHandle(ddeInstance, serviceName,
CP_WINANSI);
}
if ((index != DDE_SERVERNAME) &&(index != DDE_EVAL)) {
topicName = Tcl_GetStringFromObj(objv[firstArg + 1], &length);
if (length == 0) {
topicName = NULL;
} else {
ddeTopic = DdeCreateStringHandle(ddeInstance,
topicName, CP_WINANSI);
}
}
switch (index) {
case DDE_SERVERNAME: {
serviceName = DdeSetServerName(interp, serviceName);
if (serviceName != NULL) {
Tcl_SetStringObj(Tcl_GetObjResult(interp),
serviceName, -1);
} else {
Tcl_ResetResult(interp);
}
break;
}
case DDE_EXECUTE: {
dataString = Tcl_GetStringFromObj(objv[firstArg + 2], &dataLength);
if (dataLength == 0) {
Tcl_SetStringObj(Tcl_GetObjResult(interp),
"cannot execute null data", -1);
result = TCL_ERROR;
break;
}
hConv = DdeConnect(ddeInstance, ddeService, ddeTopic, NULL);
DdeFreeStringHandle(ddeInstance, ddeService);
DdeFreeStringHandle(ddeInstance, ddeTopic);
if (hConv == NULL) {
SetDdeError(interp);
result = TCL_ERROR;
break;
}
ddeData = DdeCreateDataHandle(ddeInstance, dataString,
dataLength+1, 0, 0, CF_TEXT, 0);
if (ddeData != NULL) {
if (async) {
DdeClientTransaction((LPBYTE) ddeData, 0xFFFFFFFF, hConv, 0,
CF_TEXT, XTYP_EXECUTE, TIMEOUT_ASYNC, &ddeResult);
DdeAbandonTransaction(ddeInstance, hConv,
ddeResult);
} else {
ddeReturn = DdeClientTransaction((LPBYTE) ddeData, 0xFFFFFFFF,
hConv, 0, CF_TEXT, XTYP_EXECUTE, 30000, NULL);
if (ddeReturn == 0) {
SetDdeError(interp);
result = TCL_ERROR;
}
}
DdeFreeDataHandle(ddeData);
} else {
SetDdeError(interp);
result = TCL_ERROR;
}
break;
}
case DDE_REQUEST: {
itemString = Tcl_GetStringFromObj(objv[firstArg + 2], &length);
if (length == 0) {
Tcl_SetStringObj(Tcl_GetObjResult(interp),
"cannot request value of null data", -1);
return TCL_ERROR;
}
hConv = DdeConnect(ddeInstance, ddeService, ddeTopic, NULL);
DdeFreeStringHandle(ddeInstance, ddeService);
DdeFreeStringHandle(ddeInstance, ddeTopic);
if (hConv == NULL) {
SetDdeError(interp);
result = TCL_ERROR;
} else {
Tcl_Obj *returnObjPtr;
ddeItem = DdeCreateStringHandle(ddeInstance,
itemString, CP_WINANSI);
if (ddeItem != NULL) {
ddeData = DdeClientTransaction(NULL, 0, hConv, ddeItem,
CF_TEXT, XTYP_REQUEST, 5000, NULL);
if (ddeData == NULL) {
SetDdeError(interp);
result = TCL_ERROR;
} else {
dataString = DdeAccessData(ddeData, &dataLength);
if (binary) {
returnObjPtr = Tcl_NewByteArrayObj(dataString,
dataLength);
} else {
returnObjPtr = Tcl_NewStringObj(dataString, -1);
}
DdeUnaccessData(ddeData);
DdeFreeDataHandle(ddeData);
Tcl_SetObjResult(interp, returnObjPtr);
}
} else {
SetDdeError(interp);
result = TCL_ERROR;
}
}
break;
}
case DDE_POKE: {
itemString = Tcl_GetStringFromObj(objv[firstArg + 2], &length);
if (length == 0) {
Tcl_SetStringObj(Tcl_GetObjResult(interp),
"cannot have a null item", -1);
return TCL_ERROR;
}
dataString = Tcl_GetStringFromObj(objv[firstArg + 3], &length);
hConv = DdeConnect(ddeInstance, ddeService, ddeTopic, NULL);
DdeFreeStringHandle(ddeInstance, ddeService);
DdeFreeStringHandle(ddeInstance, ddeTopic);
if (hConv == NULL) {
SetDdeError(interp);
result = TCL_ERROR;
} else {
ddeItem = DdeCreateStringHandle(ddeInstance, itemString,
CP_WINANSI);
if (ddeItem != NULL) {
ddeData = DdeClientTransaction(dataString,length+1,
hConv, ddeItem, CF_TEXT, XTYP_POKE, 5000, NULL);
if (ddeData == NULL) {
SetDdeError(interp);
result = TCL_ERROR;
}
} else {
SetDdeError(interp);
result = TCL_ERROR;
}
}
break;
}
case DDE_SERVICES: {
HCONVLIST hConvList;
CONVINFO convInfo;
Tcl_Obj *convListObjPtr, *elementObjPtr;
Tcl_DString dString;
char *name;
convInfo.cb = sizeof(CONVINFO);
hConvList = DdeConnectList(ddeInstance, ddeService,
ddeTopic, 0, NULL);
DdeFreeStringHandle(ddeInstance,ddeService);
DdeFreeStringHandle(ddeInstance, ddeTopic);
hConv = 0;
convListObjPtr = Tcl_NewListObj(0, (Tcl_Obj **) NULL);
Tcl_DStringInit(&dString);
while (hConv = DdeQueryNextServer(hConvList, hConv), hConv != 0) {
elementObjPtr = Tcl_NewListObj(0, (Tcl_Obj **) NULL);
DdeQueryConvInfo(hConv, QID_SYNC, &convInfo);
length = DdeQueryString(ddeInstance,
convInfo.hszSvcPartner, NULL, 0, CP_WINANSI);
Tcl_DStringSetLength(&dString, length);
name = Tcl_DStringValue(&dString);
DdeQueryString(ddeInstance, convInfo.hszSvcPartner,
name, length + 1, CP_WINANSI);
Tcl_ListObjAppendElement(interp, elementObjPtr,
Tcl_NewStringObj(name, length));
length = DdeQueryString(ddeInstance, convInfo.hszTopic,
NULL, 0, CP_WINANSI);
Tcl_DStringSetLength(&dString, length);
name = Tcl_DStringValue(&dString);
DdeQueryString(ddeInstance, convInfo.hszTopic, name,
length + 1, CP_WINANSI);
Tcl_ListObjAppendElement(interp, elementObjPtr,
Tcl_NewStringObj(name, length));
Tcl_ListObjAppendElement(interp, convListObjPtr,
elementObjPtr);
}
DdeDisconnectList(hConvList);
Tcl_SetObjResult(interp, convListObjPtr);
Tcl_DStringFree(&dString);
break;
}
case DDE_EVAL: {
objc -= (async + 3);
((Tcl_Obj **) objv) += (async + 3);
for (riPtr = tsdPtr->interpListPtr; riPtr != NULL;
riPtr = riPtr->nextPtr) {
if (stricmp(serviceName, riPtr->name) == 0) {
break;
}
}
if (riPtr != NULL) {
Tcl_Preserve((ClientData) riPtr);
sendInterp = riPtr->interp;
Tcl_Preserve((ClientData) sendInterp);
if (objc == 1) {
result = Tcl_EvalObjEx(sendInterp, objv[0],
TCL_EVAL_GLOBAL);
} else {
objPtr = Tcl_ConcatObj(objc, objv);
Tcl_IncrRefCount(objPtr);
result = Tcl_EvalObjEx(sendInterp, objPtr,
TCL_EVAL_GLOBAL);
Tcl_DecrRefCount(objPtr);
}
if (interp != sendInterp) {
if (result == TCL_ERROR) {
Tcl_ResetResult(interp);
objPtr = Tcl_GetVar2Ex(sendInterp, "errorInfo", NULL,
TCL_GLOBAL_ONLY);
string = Tcl_GetStringFromObj(objPtr, &length);
Tcl_AddObjErrorInfo(interp, string, length);
objPtr = Tcl_GetVar2Ex(sendInterp, "errorCode", NULL,
TCL_GLOBAL_ONLY);
Tcl_SetObjErrorCode(interp, objPtr);
}
Tcl_SetObjResult(interp, Tcl_GetObjResult(sendInterp));
}
Tcl_Release((ClientData) riPtr);
Tcl_Release((ClientData) sendInterp);
} else {
if (MakeDdeConnection(interp, serviceName, &hConv) != TCL_OK) {
goto error;
}
objPtr = Tcl_ConcatObj(objc, objv);
string = Tcl_GetStringFromObj(objPtr, &length);
ddeItemData = DdeCreateDataHandle(ddeInstance, string,
length+1, 0, 0, CF_TEXT, 0);
if (async) {
ddeData = DdeClientTransaction((LPBYTE) ddeItemData,
0xFFFFFFFF, hConv, 0,
CF_TEXT, XTYP_EXECUTE, TIMEOUT_ASYNC, &ddeResult);
DdeAbandonTransaction(ddeInstance, hConv, ddeResult);
} else {
ddeData = DdeClientTransaction((LPBYTE) ddeItemData,
0xFFFFFFFF, hConv, 0,
CF_TEXT, XTYP_EXECUTE, 30000, NULL);
if (ddeData != 0) {
ddeCookie = DdeCreateStringHandle(ddeInstance,
"$TCLEVAL$EXECUTE$RESULT", CP_WINANSI);
ddeData = DdeClientTransaction(NULL, 0, hConv,
ddeCookie, CF_TEXT, XTYP_REQUEST, 30000, NULL);
}
}
Tcl_DecrRefCount(objPtr);
if (ddeData == 0) {
SetDdeError(interp);
goto errorNoResult;
}
if (async == 0) {
Tcl_Obj *resultPtr;
resultPtr = Tcl_NewObj();
length = DdeGetData(ddeData, NULL, 0, 0);
Tcl_SetObjLength(resultPtr, length);
string = Tcl_GetString(resultPtr);
DdeGetData(ddeData, string, length, 0);
Tcl_SetObjLength(resultPtr, strlen(string));
if (Tcl_ListObjIndex(NULL, resultPtr, 0, &objPtr)
!= TCL_OK) {
Tcl_DecrRefCount(resultPtr);
goto error;
}
if (Tcl_GetIntFromObj(NULL, objPtr, &result) != TCL_OK) {
Tcl_DecrRefCount(resultPtr);
goto error;
}
if (result == TCL_ERROR) {
Tcl_ResetResult(interp);
if (Tcl_ListObjIndex(NULL, resultPtr, 3, &objPtr)
!= TCL_OK) {
Tcl_DecrRefCount(resultPtr);
goto error;
}
length = -1;
string = Tcl_GetStringFromObj(objPtr, &length);
Tcl_AddObjErrorInfo(interp, string, length);
Tcl_ListObjIndex(NULL, resultPtr, 2, &objPtr);
Tcl_SetObjErrorCode(interp, objPtr);
}
if (Tcl_ListObjIndex(NULL, resultPtr, 1, &objPtr)
!= TCL_OK) {
Tcl_DecrRefCount(resultPtr);
goto error;
}
Tcl_SetObjResult(interp, objPtr);
Tcl_DecrRefCount(resultPtr);
}
}
}
}
if (ddeCookie != NULL) {
DdeFreeStringHandle(ddeInstance, ddeCookie);
}
if (ddeItem != NULL) {
DdeFreeStringHandle(ddeInstance, ddeItem);
}
if (ddeItemData != NULL) {
DdeFreeDataHandle(ddeItemData);
}
if (ddeData != NULL) {
DdeFreeDataHandle(ddeData);
}
if (hConv != NULL) {
DdeDisconnect(hConv);
}
return result;
error:
Tcl_SetStringObj(Tcl_GetObjResult(interp),
"invalid data returned from server", -1);
errorNoResult:
if (ddeCookie != NULL) {
DdeFreeStringHandle(ddeInstance, ddeCookie);
}
if (ddeItem != NULL) {
DdeFreeStringHandle(ddeInstance, ddeItem);
}
if (ddeItemData != NULL) {
DdeFreeDataHandle(ddeItemData);
}
if (ddeData != NULL) {
DdeFreeDataHandle(ddeData);
}
if (hConv != NULL) {
DdeDisconnect(hConv);
}
return TCL_ERROR;
}