tclwindde.c

这是leon3处理器的交叉编译链

    switch(uType) {
	case XTYP_CONNECT:

	    /*
	     * Dde is trying to initialize a conversation with us. Check
	     * and make sure we have a valid topic.
	     */

	    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:

	    /*
	     * 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, 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:

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

	    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:

	    /*
	     * 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) {
		return (HDDEDATA) FALSE;
	    }

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

	    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: {

	    /*
	     * Execute this script. The results will be saved into
	     * a list object which will be retreived later. See
	     * ExecuteRemoteObject.
	     */

	    Tcl_Obj *returnPackagePtr;

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

	    }

	    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) {
		/*
		 * Empty loop body.
		 */

	    }
	    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: {

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

	    HSZPAIR *returnPtr;
	    int i;
	    int numItems;

	    for (i = 0, riPtr = tsdPtr->interpListPtr; riPtr != NULL;
		    i++, riPtr = riPtr->nextPtr) {
		/*
		 * Empty loop body.
		 */

	    }

	    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;
}

/*
 *--------------------------------------------------------------
 *
 * DdeExitProc --
 *
 *	Gets rid of our DDE server when we go away.
 *
 * Results:
 *	None.
 *
 * Side effects:
 *	The DDE server is deleted.
 *
 *--------------------------------------------------------------
 */

static void
DdeExitProc(
    ClientData clientData)	    /* Not used in this handler. */
{
    DdeNameService(ddeInstance, NULL, 0, DNS_UNREGISTER);
    DdeUninitialize(ddeInstance);
    ddeInstance = 0;
}

/*
 *--------------------------------------------------------------
 *
 * 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. */
    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;
}

/*
 *--------------------------------------------------------------
 *
 * 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.
 *
 *--------------------------------------------------------------
 */

static void
SetDdeError(
    Tcl_Interp *interp)	    /* The interp to put the message in.*/
{
    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);
    }
}

/*
 *--------------------------------------------------------------
 *
 * Tcl_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(
    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 */
{
    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);

    /*
     * Initialize DDE server/client
     */
    
    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,