Tcl Source Code

2012-05-??  Jan Nijtmans  <[email protected]>

	* win/tclWinDde.c:    [Bug 473946]: special characters not correctly sent
	* library/dde/pkgIndex.tcl  Increase version to 1.2.5

2012-05-02  Jan Nijtmans  <[email protected]>

	* generic/configure.in:    Better detection and implementation for cpuid
	* generic/configure:       instruction on Intel-derived processors, both
	* generic/tclUnixCompat.c: 32-bit and 64-bit.
	* generic/tclTest.c:       Move cpuid testcase from win-specific to generic
	* win/tclWinTest.c:        tests, as it should work on all Intel-related

if {![package vsatisfies [package provide Tcl] 8]} return
if {[string compare [info sharedlibextension] .dll]} return
if {[info exists ::tcl_platform(debug)]} {
    package ifneeded dde 1.2.4 [list load [file join $dir tcldde12g.dll] dde]
    package ifneeded dde 1.2.5 [list load [file join $dir tcldde12g.dll] dde]
} else {
    package ifneeded dde 1.2.4 [list load [file join $dir tcldde12.dll] dde]
    package ifneeded dde 1.2.5 [list load [file join $dir tcldde12.dll] dde]
}

/* 
/*
 * tclWinDde.c --
 *
 *	This file provides procedures that implement the "send"
 *	command, allowing commands to be passed from interpreter
 *	to interpreter.
 *
 * Copyright (c) 1997 by Sun Microsystems, Inc.

 * Registry_Init declaration is in the source file itself, which is only
 * accessed when we are building a library.
 */

#undef TCL_STORAGE_CLASS
#define TCL_STORAGE_CLASS DLLEXPORT

/* 
/*
 * The following structure is used to keep track of the interpreters
 * registered by this process.
 */

typedef struct RegisteredInterp {
    struct RegisteredInterp *nextPtr;
				/* The next interp this application knows

 * The Mutex ddeMutex guards access to the ddeInstance.
 */
static HSZ ddeServiceGlobal = 0;
static DWORD ddeInstance;       /* The application instance handle given
				 * to us by DdeInitialize. */
static int ddeIsServer = 0;

#define TCL_DDE_VERSION "1.2.4"
#define TCL_DDE_PACKAGE_NAME "dde"
#define TCL_DDE_SERVICE_NAME "TclEval"
#define TCL_DDE_VERSION		"1.2.5"
#define TCL_DDE_PACKAGE_NAME	"dde"
#define TCL_DDE_SERVICE_NAME	"TclEval"
#define TCL_DDE_EXECUTE_RESULT	"$TCLEVAL$EXECUTE$RESULT"

TCL_DECLARE_MUTEX(ddeMutex)

/*
 * Forward declarations for procedures defined later in this file.
 */

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,
static void		    DdeExitProc(ClientData clientData);
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);
static HDDEDATA CALLBACK    DdeServerProc(UINT uType,
				UINT uFmt, HCONV hConv, HSZ ddeTopic,
				HSZ ddeItem, HDDEDATA hData, DWORD dwData1, 
				DWORD dwData2));
static void		    SetDdeError _ANSI_ARGS_((Tcl_Interp *interp));
static int                  DdeGetServicesList _ANSI_ARGS_((
				HSZ ddeItem, HDDEDATA hData, DWORD dwData1,
				DWORD dwData2);
static void		    SetDdeError(Tcl_Interp *interp);
static int                  DdeGetServicesList(
				Tcl_Interp *interp,
				char *serviceName,
				char *topicName));
int Tcl_DdeObjCmd(ClientData clientData,	/* Used only for deletion */
	Tcl_Interp *interp,		/* The interp we are sending from */
				const char *serviceName,
				const char *topicName);
static int		DdeObjCmd(ClientData clientData,
			    Tcl_Interp *interp, int objc,
	int objc,			/* Number of arguments */
	Tcl_Obj *CONST objv[]);	/* The arguments */
			    Tcl_Obj *const objv[]);

EXTERN int Dde_Init(Tcl_Interp *interp);
EXTERN int		Dde_Init(Tcl_Interp *interp);

/*
 *----------------------------------------------------------------------
 *
 * Dde_Init --
 *
 *	This procedure initializes the dde command.

 *----------------------------------------------------------------------
 */

int
Dde_Init(
    Tcl_Interp *interp)
{
    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);
    Tcl_CreateObjCommand(interp, "dde", DdeObjCmd, NULL, NULL);

    Tcl_CreateExitHandler(DdeExitProc, NULL);

    return Tcl_PkgProvide(interp, TCL_DDE_PACKAGE_NAME, TCL_DDE_VERSION);
}

/*
 *----------------------------------------------------------------------
 *
 * Initialize --

 */

static void
Initialize(void)
{
    int nameFound = 0;
    ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
    

    /*
     * See if the application is already registered; if so, remove its
     * current name from the registry. The deletion of the command
     * will take care of disposing of this entry.
     */

    if (tsdPtr->interpListPtr != NULL) {

    if (ddeInstance == 0) {
	Tcl_MutexLock(&ddeMutex);
	if (ddeInstance == 0) {
	    if (DdeInitialize(&ddeInstance, (PFNCALLBACK) DdeServerProc,
		    CBF_SKIP_REGISTRATIONS
		    | CBF_SKIP_UNREGISTRATIONS
		    | CBF_FAIL_POKES, 0) 
		    | 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);
    }
}    
}

/*
 *--------------------------------------------------------------
 *
 * DdeSetServerName --
 *
 *	This procedure is called to associate an ASCII name with a Dde

 *
 *--------------------------------------------------------------
 */

static char *
DdeSetServerName(
    Tcl_Interp *interp,
    char *name			/* The name that will be used to
    const char *name		/* The name that will be used to
				 * refer to the interpreter in later
				 * "send" commands.  Must be globally
				 * unique. */
    )
{
    RegisteredInterp *riPtr, *prevPtr;
    Tcl_DString dString;
    ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);

    /*
     * See if the application is already registered; if so, remove its
     * current name from the registry. The deletion of the command
     * will take care of disposing of this entry.
     */

    for (riPtr = tsdPtr->interpListPtr, prevPtr = NULL; riPtr != NULL; 
    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;

	 * the name was NULL, so the caller is asking for
	 * the name of the current interp, but it doesn't
	 * have a name.
	 */

	return "";
    }
    

    /*
     * Pick a name to use for the application.  Use "name" if it's not
     * already in use.  Otherwise add a suffix such as " #2", trying
     * larger and larger numbers until we eventually find one that is
     * unique.
     */

    Tcl_DStringInit(&dString);

    /*
     * We have found a unique name. Now add it to the registry.
     */

    riPtr = (RegisteredInterp *) ckalloc(sizeof(RegisteredInterp));
    riPtr->interp = interp;
    riPtr->name = ckalloc((unsigned int) strlen(name) + 1);
    riPtr->nextPtr = tsdPtr->interpListPtr;
    tsdPtr->interpListPtr = riPtr;
    strcpy(riPtr->name, name);

    Tcl_CreateObjCommand(interp, "dde", Tcl_DdeObjCmd,
    Tcl_CreateObjCommand(interp, "dde", DdeObjCmd,
	    (ClientData) riPtr, DeleteProc);
    if (Tcl_IsSafe(interp)) {
	Tcl_HideCommand(interp, "dde", "dde");
    }
    Tcl_DStringFree(&dString);

    /*
     * re-initialize with the new name
     */
    Initialize();
    

    return riPtr->name;
}

/*
 *--------------------------------------------------------------
 *
 * DeleteProc

static HDDEDATA CALLBACK
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 
    HCONV hConv,		/* The conversation associated with the
				 * current transaction. */
    HSZ ddeTopic,		/* A string handle. Transaction-type 
    HSZ ddeTopic,		/* A string handle. Transaction-type
				 * dependent. */
    HSZ ddeItem,		/* A string handle. Transaction-type 
    HSZ ddeItem,		/* A string handle. Transaction-type
				 * dependent. */
    HDDEDATA hData,		/* DDE data. Transaction-type dependent. */
    DWORD dwData1,		/* Transaction-dependent data. */
    DWORD dwData2)		/* Transaction-dependent data. */
{
    Tcl_DString dString;
    int len;

	    Tcl_DStringFree(&dString);
	    return (HDDEDATA) FALSE;

	case XTYP_CONNECT_CONFIRM:

	    /*
	     * Dde has decided that we can connect, so it gives us a 
	     * Dde has decided that we can connect, so it gives us a
	     * conversation handle. We need to keep track of it
	     * so we know which execution result to return in an
	     * XTYP_REQUEST.
	     */

	    len = DdeQueryString(ddeInstance, ddeTopic, NULL, 0, 0);
	    Tcl_DStringInit(&dString);
	    Tcl_DStringSetLength(&dString, len);
	    utilString = Tcl_DStringValue(&dString);
	    DdeQueryString(ddeInstance, ddeTopic, utilString, (DWORD) len + 1, 
	    DdeQueryString(ddeInstance, ddeTopic, utilString, (DWORD) len + 1,
		    CP_WINANSI);
	    for (riPtr = tsdPtr->interpListPtr; riPtr != NULL; 
	    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;

	    /*
	     * The client has disconnected from our server. Forget this
	     * conversation.
	     */

	    for (convPtr = tsdPtr->currentConversations, prevConvPtr = NULL;
		    convPtr != NULL; 
		    convPtr != NULL;
		    prevConvPtr = convPtr, convPtr = convPtr->nextPtr) {
		if (hConv == convPtr->hConv) {
		    if (prevConvPtr == NULL) {
			tsdPtr->currentConversations = convPtr->nextPtr;
		    } else {
			prevConvPtr->nextPtr = convPtr->nextPtr;
		    }

	    /*
	     * This could be either a request for a value of a Tcl variable,
	     * or it could be the send command requesting the results of the
	     * last execute.
	     */

	    if (uFmt != CF_TEXT) {
	    if ((uFmt != CF_TEXT) && (uFmt != CF_UNICODETEXT)) {
		return (HDDEDATA) FALSE;
	    }

	    ddeReturn = (HDDEDATA) FALSE;
	    for (convPtr = tsdPtr->currentConversations; (convPtr != NULL)
		    && (convPtr->hConv != hConv); convPtr = convPtr->nextPtr) {
		/*
		 * Empty loop body.
		 */
	    }

	    if (convPtr != NULL) {
		BYTE *returnString;
		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, 
		DdeQueryString(ddeInstance, ddeItem, utilString,
                        (DWORD) len + 1, CP_WINANSI);
		if (stricmp(utilString, "$TCLEVAL$EXECUTE$RESULT") == 0) {
		    returnString =
		        (BYTE *)Tcl_GetStringFromObj(convPtr->returnPackagePtr, &len);
		if (stricmp(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;
		    }
		    ddeReturn = DdeCreateDataHandle(ddeInstance,
			    returnString, (DWORD) len+1, 0, ddeItem, CF_TEXT,
		    		(BYTE *)returnString, (DWORD) len+1, 0, ddeItem, uFmt, 0);
			    0);
		} else {
		    Tcl_Obj *variableObjPtr = Tcl_GetVar2Ex(
			    convPtr->riPtr->interp, utilString, NULL, 
			    convPtr->riPtr->interp, utilString, NULL,
			    TCL_GLOBAL_ONLY);
		    if (variableObjPtr != NULL) {
			if (uFmt == CF_TEXT) {
			    returnString =
			returnString = (BYTE *)Tcl_GetStringFromObj(variableObjPtr,
				&len);
				    Tcl_GetStringFromObj(variableObjPtr, &len);
			} else {
			    returnString =  (char *)
				    Tcl_GetUnicodeFromObj(variableObjPtr, &len);
			    len = 2 * len + 1;
			}
			ddeReturn = DdeCreateDataHandle(ddeInstance,
				returnString, (DWORD) len+1, 0, ddeItem,
				(BYTE *)returnString, (DWORD) len+1, 0, ddeItem, uFmt, 0);
				CF_TEXT, 0);
		    } else {
			ddeReturn = NULL;
		    }
		}
		Tcl_DStringFree(&dString);
	    }
	    return ddeReturn;

	    ddeObjectPtr = Tcl_NewStringObj(utilString, -1);
	    Tcl_IncrRefCount(ddeObjectPtr);
	    DdeUnaccessData(hData);
	    if (convPtr->returnPackagePtr != NULL) {
		Tcl_DecrRefCount(convPtr->returnPackagePtr);
	    }
	    convPtr->returnPackagePtr = NULL;
	    returnPackagePtr = 
	    returnPackagePtr =
		    ExecuteRemoteObject(convPtr->riPtr, ddeObjectPtr);
	    Tcl_IncrRefCount(returnPackagePtr);
	    for (convPtr = tsdPtr->currentConversations; (convPtr != NULL)
 		    && (convPtr->hConv != hConv); convPtr = convPtr->nextPtr) {
		/*
		 * Empty loop body.
		 */

	    Tcl_DecrRefCount(ddeObjectPtr);
	    if (returnPackagePtr == NULL) {
		return (HDDEDATA) DDE_FNOTPROCESSED;
	    } else {
		return (HDDEDATA) DDE_FACK;
	    }
	}
	    

	case XTYP_WILDCONNECT: {

	    /*
	     * Dde wants a list of services and topics that we support.
	     */

	    HSZPAIR *returnPtr;

	    }

	    numItems = i;
	    ddeReturn = DdeCreateDataHandle(ddeInstance, NULL,
		    (numItems + 1) * sizeof(HSZPAIR), 0, 0, 0, 0);
	    returnPtr = (HSZPAIR *) DdeAccessData(ddeReturn, &dlen);
	    len = dlen;
	    for (i = 0, riPtr = tsdPtr->interpListPtr; i < numItems; 
	    for (i = 0, riPtr = tsdPtr->interpListPtr; i < numItems;
		    i++, riPtr = riPtr->nextPtr) {
		returnPtr[i].hszSvc = DdeCreateStringHandle(
                        ddeInstance, "TclEval", CP_WINANSI);
                        ddeInstance, TCL_DDE_SERVICE_NAME, CP_WINANSI);
		returnPtr[i].hszTopic = DdeCreateStringHandle(
                        ddeInstance, riPtr->name, CP_WINANSI);
	    }
	    returnPtr[i].hszSvc = NULL;
	    returnPtr[i].hszTopic = NULL;
	    DdeUnaccessData(ddeReturn);
	    return ddeReturn;

 * MakeDdeConnection --
 *
 *	This procedure is a utility used to connect to a DDE
 *	server when given a server name and a topic name.
 *
 * Results:
 *	A standard Tcl result.
 *	
 *
 *
 * Side effects:
 *	Passes back a conversation through ddeConvPtr
 *
 *--------------------------------------------------------------
 */

static int
MakeDdeConnection(
    Tcl_Interp *interp,		/* Used to report errors. */
    char *name,			/* The connection to use. */
    const char *name,		/* The connection to use. */
    HCONV *ddeConvPtr)
{
    HSZ ddeTopic, ddeService;
    HCONV ddeConv;
    
    ddeService = DdeCreateStringHandle(ddeInstance, "TclEval", 0);

    ddeService = DdeCreateStringHandle(ddeInstance, TCL_DDE_SERVICE_NAME, 0);
    ddeTopic = DdeCreateStringHandle(ddeInstance, name, 0);

    ddeConv = DdeConnect(ddeInstance, ddeService, ddeTopic, NULL);
    DdeFreeStringHandle(ddeInstance, ddeService);
    DdeFreeStringHandle(ddeInstance, ddeTopic);

    if (ddeConv == (HCONV) NULL) {

    Tcl_Interp *interp;
    int         result;
    ATOM        service;
    ATOM        topic;
    HWND        hwnd;
} ddeEnumServices;

LRESULT CALLBACK
static LRESULT CALLBACK
DdeClientWindowProc(HWND hwnd, UINT uMsg, WPARAM wParam, LPARAM lParam);
static LRESULT
DdeServicesOnAck(HWND hwnd, WPARAM wParam, LPARAM lParam);

static int
DdeCreateClient(ddeEnumServices *es)
{

    es->hwnd = CreateWindowEx(0, szDdeClientClassName,
			      szDdeClientWindowName,
			      WS_POPUP, 0, 0, 0, 0, NULL, NULL, NULL,
			      (LPVOID)es);
    return TCL_OK;
}

LRESULT CALLBACK
static LRESULT CALLBACK
DdeClientWindowProc(HWND hwnd, UINT uMsg, WPARAM wParam, LPARAM lParam)
{
    LRESULT lr = 0L;

    switch (uMsg) {
	case WM_CREATE: {
	    LPCREATESTRUCT lpcs = (LPCREATESTRUCT)lParam;

		       (WPARAM)es->hwnd,
		       MAKELONG(es->service, es->topic),
		       SMTO_ABORTIFHUNG, 1000, &dwResult);
    return TRUE;
}

static int
DdeGetServicesList(Tcl_Interp *interp, char *serviceName, char *topicName)
DdeGetServicesList(Tcl_Interp *interp, const char *serviceName, const char *topicName)
{
    ddeEnumServices es;
    es.interp = interp;
    es.result = TCL_OK;
    es.service = (serviceName == NULL)
	? (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);
    EnumWindows(DdeEnumWindowsCallback, (LPARAM)&es);
    

    if (IsWindow(es.hwnd))
        DestroyWindow(es.hwnd);
    if (es.service != (ATOM)0)
	GlobalDeleteAtom(es.service);
    if (es.topic != (ATOM)0)
	GlobalDeleteAtom(es.topic);
    return es.result;
}

/*
 *--------------------------------------------------------------
 *
 * SetDdeError --
 *
 *	Sets the interp result to a cogent error message
 *	describing the last DDE error.
 *
 * Results:
 *	None.
 *	
 *
 *
 * Side effects:
 *	The interp's result object is changed.
 *
 *--------------------------------------------------------------
 */

	    break;

	case DMLERR_BUSY:
	    Tcl_SetStringObj(resultPtr, "remote server is busy", -1);
	    break;

	case DMLERR_NOTPROCESSED:
	    Tcl_SetStringObj(resultPtr, 
	    Tcl_SetStringObj(resultPtr,
		    "remote server cannot handle this command", -1);
	    break;

	default:
	    Tcl_SetStringObj(resultPtr, "dde command failed", -1);
    }
}

/*
 *--------------------------------------------------------------
 *
 * Tcl_DdeObjCmd --
 * DdeObjCmd --
 *
 *	This procedure is invoked to process the "dde" Tcl command.
 *	See the user documentation for details on what it does.
 *
 * Results:
 *	A standard Tcl result.
 *
 * Side effects:
 *	See the user documentation.
 *
 *--------------------------------------------------------------
 */

int
Tcl_DdeObjCmd(
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 */
    Tcl_Obj *const *objv)	/* The arguments */
{
    enum {
	DDE_SERVERNAME,
	DDE_EXECUTE,
	DDE_POKE,
	DDE_REQUEST,
	DDE_SERVICES,
	DDE_EVAL
    };

    static CONST char *ddeCommands[] = {"servername", "execute", "poke",
          "request", "services", "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};
    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 = NULL, *itemString;
    const char *serviceName, *topicName = NULL, *itemString;
    char *string;
    int firstArg = 0, length, dataLength;
    DWORD ddeResult;
    HDDEDATA ddeReturn;
    RegisteredInterp *riPtr;
    Tcl_Interp *sendInterp;
    Tcl_Obj *objPtr;
    ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);

    /*
     * Initialize DDE server/client
     */
    

    if (objc < 2) {
	Tcl_WrongNumArgs(interp, 1, objv, 
	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, 
		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,

			"poke serviceName topicName item value");
		return TCL_ERROR;
	    }
	    firstArg = 2;
	    break;
	case DDE_REQUEST:
	    if ((objc < 5) || (objc > 6)) {
		Tcl_WrongNumArgs(interp, 1, objv, 
		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,

			"services serviceName topicName");
		return TCL_ERROR;
	    }
	    firstArg = 2;
	    break;
	case DDE_EVAL:
	    if (objc < 4) {
		Tcl_WrongNumArgs(interp, 1, objv, 
		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,

    }

    if ((index != DDE_SERVERNAME) &&(index != DDE_EVAL)) {
	topicName = Tcl_GetStringFromObj(objv[firstArg + 1], &length);
	if (length == 0) {
	    topicName = NULL;
	} else {
	    ddeTopic = DdeCreateStringHandle(ddeInstance, 
	    ddeTopic = DdeCreateStringHandle(ddeInstance,
		    topicName, CP_WINANSI);
	}
    }

    switch (index) {
	case DDE_SERVERNAME: {
	    serviceName = DdeSetServerName(interp, serviceName);

		break;
	    }

	    ddeData = DdeCreateDataHandle(ddeInstance, dataString,
		    (DWORD) dataLength+1, 0, 0, CF_TEXT, 0);
	    if (ddeData != NULL) {
		if (async) {
		    DdeClientTransaction((LPBYTE) ddeData, 0xFFFFFFFF, hConv, 0, 
		    DdeClientTransaction((LPBYTE) ddeData, 0xFFFFFFFF, hConv, 0,
			    CF_TEXT, XTYP_EXECUTE, TIMEOUT_ASYNC, &ddeResult);
		    DdeAbandonTransaction(ddeInstance, hConv, 
		    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;

		Tcl_SetStringObj(Tcl_GetObjResult(interp),
			"cannot request value of null data", -1);
		goto errorNoResult;
	    }
	    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, 
		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;

	    itemString = Tcl_GetStringFromObj(objv[firstArg + 2], &length);
	    if (length == 0) {
		Tcl_SetStringObj(Tcl_GetObjResult(interp),
			"cannot have a null item", -1);
		goto errorNoResult;
	    }
	    dataString = (BYTE *) 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;

	    objc -= (async + 3);
	    objv += (async + 3);

            /*
	     * See if the target interpreter is local.  If so, execute
	     * the command directly without going through the DDE server.
	     * Don't exchange objects between interps.  The target interp could
	     * compile an object, producing a bytecode structure that refers to 
	     * other objects owned by the target interp.  If the target interp 
	     * is then deleted, the bytecode structure would be referring to 
	     * compile an object, producing a bytecode structure that refers to
	     * other objects owned by the target interp.  If the target interp
	     * is then deleted, the bytecode structure would be referring to
	     * deallocated objects.
	     */
	    

	    for (riPtr = tsdPtr->interpListPtr; riPtr != NULL;
		 riPtr = riPtr->nextPtr) {
		if (stricmp(serviceName, riPtr->name) == 0) {
		    break;
		}
	    }

	    if (riPtr != NULL) {
		/*
		 * This command is to a local interp. No need to go through
		 * the server.
		 */
		

		Tcl_Preserve((ClientData) riPtr);
		sendInterp = riPtr->interp;
		Tcl_Preserve((ClientData) sendInterp);
		

		/*
		 * Don't exchange objects between interps.  The target interp
		 * would compile an object, producing a bytecode structure that
		 * refers to other objects owned by the target interp.  If the
		 * target interp is then deleted, the bytecode structure would
		 * be referring to deallocated objects.
		 */

		if (interp != sendInterp) {
		    if (result == TCL_ERROR) {
			/*
			 * An error occurred, so transfer error information
			 * from the destination interpreter back to our
			 * interpreter.
			 */
			

			Tcl_ResetResult(interp);
			objPtr = Tcl_GetVar2Ex(sendInterp, "errorInfo", NULL, 
			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 {
		/*
		 * This is a non-local request. Send the script to the server
		 * and poll it for a result.
		 */
		

		if (MakeDdeConnection(interp, serviceName, &hConv) != TCL_OK) {
		    goto error;
		}
		

		objPtr = Tcl_ConcatObj(objc, objv);
		string = Tcl_GetStringFromObj(objPtr, &length);
		ddeItemData = DdeCreateDataHandle(ddeInstance, (BYTE *) string,
			(DWORD) 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);

			ddeCookie = DdeCreateStringHandle(ddeInstance,
				TCL_DDE_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;
		    

		    /*
		     * The return handle has a two or four element list in
		     * it. The first element is the return code (TCL_OK,
		     * TCL_ERROR, etc.). The second is the result of the
		     * script. If the return code is TCL_ERROR, then the third
		     * element is the value of the variable "errorCode", and
		     * the fourth is the value of the variable "errorInfo".
		     */
		    

		    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));
		    

		    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;