/* 
 * tkSendMS.c --
 *
 *	This file provides procedures that implement the "send"
 *	command, allowing commands to be passed from interpreter
 *	to interpreter and to DDE servers under Windows NT.
 *
 * Copyright (c) 1989-1993 The Regents of the University of California.
 * All rights reserved.
 *
 * Permission is hereby granted, without written agreement and without
 * license or royalty fees, to use, copy, modify, and distribute this
 * software and its documentation for any purpose, provided that the
 * above copyright notice and the following two paragraphs appear in
 * all copies of this software.
 * 
 * IN NO EVENT SHALL THE UNIVERSITY OF CALIFORNIA BE LIABLE TO ANY PARTY FOR
 * DIRECT, INDIRECT, SPECIAL, INCIDENTAL, OR CONSEQUENTIAL DAMAGES ARISING OUT
 * OF THE USE OF THIS SOFTWARE AND ITS DOCUMENTATION, EVEN IF THE UNIVERSITY OF
 * CALIFORNIA HAS BEEN ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
 *
 * THE UNIVERSITY OF CALIFORNIA SPECIFICALLY DISCLAIMS ANY WARRANTIES,
 * INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY
 * AND FITNESS FOR A PARTICULAR PURPOSE.  THE SOFTWARE PROVIDED HEREUNDER IS
 * ON AN "AS IS" BASIS, AND THE UNIVERSITY OF CALIFORNIA HAS NO OBLIGATION TO
 * PROVIDE MAINTENANCE, SUPPORT, UPDATES, ENHANCEMENTS, OR MODIFICATIONS.
 */
/*
 * Copyright (c) 1994 Software Research Associates, Inc.
 *
 * Permission to use, copy, modify, and distribute this software and its
 * documentation for any purpose and without fee is hereby granted, provided
 * that the above copyright notice appear in all copies and that both that
 * copyright notice and this permission notice appear in supporting
 * documentation, and that the name of Software Research Associates not be
 * used in advertising or publicity pertaining to distribution of the
 * software without specific, written prior permission.  Software Research
 * Associates makes no representations about the suitability of this software
 * for any purpose.  It is provided "as is" without express or implied
 * warranty.
 */

#ifndef lint
static char rcsid[] = "$Header: /user6/ouster/wish/RCS/tkSend.c,v 1.34 93/10/13 17:17:26 ouster Exp $ SPRITE (Berkeley)";
#endif

#include <windows.h>
#include <ddeml.h>
#include "tkConfig.h"
#include "tkInt.h"


#define TK_SEND_EXECUTE 1
#define TK_SEND_POKE    2
#define TK_SEND_REQUEST 4

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

typedef struct RegisteredInterp {
    char *name;			/* Interpreter's name (malloc-ed). */
    Tcl_Interp *interp;		/* Interpreter associated with
				 * name. */
    TkDisplay *dispPtr;		/* Display associated with name. */

    DWORD ddeServInst;
    HSZ ddeService;
    unsigned char ddePair;

    int commandCount;		/* # of commands associated with this struct */


    struct RegisteredInterp *nextPtr;
				/* Next in list of names associated
				 * with interps in this process.
				 * NULL means end of list. */
} RegisteredInterp;

static RegisteredInterp *registry = NULL;
				/* List of all interpreters
				 * registered by this process. */

/*
 * The information below is used for communication between
 * processes during "send" commands.
 *
 * Response:
 *	'RTk' code space result '\0'
 * The 'RTk' string indicates that this is a response.
 * The code field is a decimal integer giving 
 * the Tcl return code from the command, and result is the string
 * result.  The result is terminated by a NULL character.  If the 
 * 'RTk' string is not in the response, we assume it comes from a
 * non-Tk DDE server.
 *
 * There should be a nice register of interpreters, but I haven't
 * done this yet.  To do it, use CreateSemaphore() on a named semaphore
 * that only Tk processes can use.  This gets us exclusive rights.
 * Then modify the atom that has the names.
 *
 * The register of interpreters is kept in a property
 * "InterpRegistry" on the root window of the display.  It is
 * organized as a series of zero or more concatenated strings
 * (in no particular order), each of the form
 * 	window space name '\0'
 * where "window" is the hex id of the comm. window to use to talk
 * to an interpreter named "name".
 */

/*
 * Maximum size property that can be read at one time by
 * this module:
 */

#define MAX_PROP_WORDS 100000

/*
 * Forward declarations for procedures defined later in this file:
 */
static void	DeleteProc _ANSI_ARGS_((ClientData clientData));

HDDEDATA DdeServer(UINT iType, UINT iFmt, HCONV hConv, HSZ ddeTopic,
		   HSZ ddeItem, HDDEDATA hData, DWORD dwData1, DWORD dwData2,
		   int ddePair);
HDDEDATA DdeClient(UINT iType, UINT iFmt, HCONV hConv, HSZ ddeTopic,
		   HSZ ddeItem, HDDEDATA hData, DWORD dwData1, DWORD dwData2,
		   int ddePair);

/* Provide support for up to 10 different DDE Servers.  Some of the DDE
 * callbacks give us no way to identify diffent Servers, so we need to
 * resort to this clunky method.  Ideally, we would like to instantiate
 * a new procedure (a lambda function) in C for each Interp, but this is
 * not possible.  Stick with a kludge for now
 */
HDDEDATA CALLBACK
DdeServerCB0(UINT iType, UINT iFmt, HCONV hConv, HSZ ddeTopic, HSZ ddeItem,
	     HDDEDATA hData, DWORD dwData1, DWORD dwData2)
{
    int pair = 0;
    return DdeServer(iType, iFmt, hConv, ddeTopic, ddeItem,
		       hData, dwData1, dwData2, pair);
}
    
HDDEDATA CALLBACK
DdeServerCB1(UINT iType, UINT iFmt, HCONV hConv, HSZ ddeTopic, HSZ ddeItem,
	     HDDEDATA hData, DWORD dwData1, DWORD dwData2)
{
    int pair = 1;
    return DdeServer(iType, iFmt, hConv, ddeTopic, ddeItem,
		       hData, dwData1, dwData2, pair);
}

HDDEDATA CALLBACK
DdeServerCB2(UINT iType, UINT iFmt, HCONV hConv, HSZ ddeTopic, HSZ ddeItem,
	     HDDEDATA hData, DWORD dwData1, DWORD dwData2)
{
    int pair = 2;
    return DdeServer(iType, iFmt, hConv, ddeTopic, ddeItem,
		       hData, dwData1, dwData2, pair);
}

HDDEDATA CALLBACK
DdeServerCB3(UINT iType, UINT iFmt, HCONV hConv, HSZ ddeTopic, HSZ ddeItem,
	     HDDEDATA hData, DWORD dwData1, DWORD dwData2)
{
    int pair = 3;
    return DdeServer(iType, iFmt, hConv, ddeTopic, ddeItem,
		       hData, dwData1, dwData2, pair);
}

HDDEDATA CALLBACK
DdeServerCB4(UINT iType, UINT iFmt, HCONV hConv, HSZ ddeTopic, HSZ ddeItem,
	     HDDEDATA hData, DWORD dwData1, DWORD dwData2)
{
    int pair = 4;
    return DdeServer(iType, iFmt, hConv, ddeTopic, ddeItem,
		       hData, dwData1, dwData2, pair);
}

HDDEDATA CALLBACK
DdeServerCB5(UINT iType, UINT iFmt, HCONV hConv, HSZ ddeTopic, HSZ ddeItem,
	     HDDEDATA hData, DWORD dwData1, DWORD dwData2)
{
    int pair = 5;
    return DdeServer(iType, iFmt, hConv, ddeTopic, ddeItem,
		       hData, dwData1, dwData2, pair);
}

HDDEDATA CALLBACK
DdeServerCB6(UINT iType, UINT iFmt, HCONV hConv, HSZ ddeTopic, HSZ ddeItem,
	     HDDEDATA hData, DWORD dwData1, DWORD dwData2)
{
    int pair = 6;
    return DdeServer(iType, iFmt, hConv, ddeTopic, ddeItem,
		       hData, dwData1, dwData2, pair);
}

HDDEDATA CALLBACK
DdeServerCB7(UINT iType, UINT iFmt, HCONV hConv, HSZ ddeTopic, HSZ ddeItem,
	     HDDEDATA hData, DWORD dwData1, DWORD dwData2)
{
    int pair = 7;
    return DdeServer(iType, iFmt, hConv, ddeTopic, ddeItem,
		       hData, dwData1, dwData2, pair);
}

HDDEDATA CALLBACK
DdeServerCB8(UINT iType, UINT iFmt, HCONV hConv, HSZ ddeTopic, HSZ ddeItem,
	     HDDEDATA hData, DWORD dwData1, DWORD dwData2)
{
    int pair = 8;
    return DdeServer(iType, iFmt, hConv, ddeTopic, ddeItem,
		       hData, dwData1, dwData2, pair);
}

HDDEDATA CALLBACK
DdeServerCB9(UINT iType, UINT iFmt, HCONV hConv, HSZ ddeTopic, HSZ ddeItem,
	     HDDEDATA hData, DWORD dwData1, DWORD dwData2)
{
    int pair = 9;
    return DdeServer(iType, iFmt, hConv, ddeTopic, ddeItem,
		       hData, dwData1, dwData2, pair);
}

/* These have to be globals or else the initialize function barfs */
DWORD tkDDEServInst[10], tkDDEClientInst[10];

static int tkDDEPair[10];
static PFNCALLBACK tkDDEServer[10] =
{
    DdeServerCB0, DdeServerCB1, DdeServerCB2, DdeServerCB3, DdeServerCB4,
    DdeServerCB5, DdeServerCB6, DdeServerCB7, DdeServerCB8, DdeServerCB9
};

static char *buffer = NULL;
static int bufsize = 0;

#define BUFALLOC(len, bufsize, buffer) \
	if (len >= bufsize) { \
	    if (buffer != NULL) { \
		ckfree(buffer); \
	    } \
	    buffer = ckalloc(len); \
	    if (buffer == NULL) { \
		bufsize = 0; \
		return FALSE; \
	    } \
	    bufsize = len; \
	}

HDDEDATA
DdeServer(UINT iType, UINT iFmt, HCONV hConv, HSZ ddeTopic, HSZ ddeItem,
	    HDDEDATA hData, DWORD dwData1, DWORD dwData2, int ddePair)
{
    int len;
    RegisteredInterp *riPtr;
    int result;
    char *resultString;

    for (riPtr = registry; riPtr != NULL; riPtr = riPtr->nextPtr) {
	if (riPtr->ddePair == ddePair) {
	    break;
	}
    }
    if (riPtr == NULL) {
	return FALSE;
    }

    switch (iType)
    {
    case XTYP_CONNECT:		/* ddeItem = service */
	len = DdeQueryString(riPtr->ddeServInst, ddeItem, NULL, 0, 0) + 1;
	BUFALLOC(len, bufsize, buffer);
	DdeQueryString(riPtr->ddeServInst, ddeItem, buffer, len, 0);
	if (strcmp(riPtr->name, buffer) != 0) {
	    return FALSE;
	}

	len = DdeQueryString(riPtr->ddeServInst, ddeTopic, NULL, 0, 0) + 1;
	BUFALLOC(len, bufsize, buffer);
	DdeQueryString(riPtr->ddeServInst, ddeTopic, buffer, len, 0);
	if (strcmp(buffer, "tk_comm") != 0) {
	    return FALSE;
	}
	return TRUE;

    case XTYP_REQUEST:
	/* Check for matching format and data item */
	if (iFmt != CF_TEXT) {
	    return FALSE;
	}

	len = DdeQueryString(riPtr->ddeServInst, ddeItem, NULL, 0, 0) + 1;
	BUFALLOC(len, bufsize, buffer);
	DdeQueryString(riPtr->ddeServInst, ddeItem, buffer, len, 0);

	/* buffer should hold the string to execute */
	result = Tcl_GlobalEval(riPtr->interp, buffer);
	resultString = riPtr->interp->result;

	/*
	 * Return the result to the sender.
	 */

	len = strlen(resultString) + 30;
	BUFALLOC(len, bufsize, buffer);
	sprintf(buffer, "RTk1 %x %d %s", 0, result, resultString);
	
	return DdeCreateDataHandle (riPtr->ddeServInst, buffer,
				    strlen(buffer) + 1,
				    0, ddeItem, CF_TEXT, 0) ;
    }

    return FALSE;
}

/* Provide support for up to 10 different DDE Clients.  Some of the DDE
 * callbacks give us no way to identify diffent Clients, so we need to
 * resort to this clunky method.  Ideally, we would like to instantiate
 * a new procedure (a lambda function) in C for each Interp, but this is
 * not possible.  Stick with a kludge for now
 */
HDDEDATA CALLBACK
DdeClientCB0(UINT iType, UINT iFmt, HCONV hConv, HSZ ddeTopic, HSZ ddeItem,
	     HDDEDATA hData, DWORD dwData1, DWORD dwData2)
{
    int pair = 0;
    return DdeClient(iType, iFmt, hConv, ddeTopic, ddeItem,
		       hData, dwData1, dwData2, pair);
}
    
HDDEDATA CALLBACK
DdeClientCB1(UINT iType, UINT iFmt, HCONV hConv, HSZ ddeTopic, HSZ ddeItem,
	     HDDEDATA hData, DWORD dwData1, DWORD dwData2)
{
    int pair = 1;
    return DdeClient(iType, iFmt, hConv, ddeTopic, ddeItem,
		       hData, dwData1, dwData2, pair);
}

HDDEDATA CALLBACK
DdeClientCB2(UINT iType, UINT iFmt, HCONV hConv, HSZ ddeTopic, HSZ ddeItem,
	     HDDEDATA hData, DWORD dwData1, DWORD dwData2)
{
    int pair = 2;
    return DdeClient(iType, iFmt, hConv, ddeTopic, ddeItem,
		       hData, dwData1, dwData2, pair);
}

HDDEDATA CALLBACK
DdeClientCB3(UINT iType, UINT iFmt, HCONV hConv, HSZ ddeTopic, HSZ ddeItem,
	     HDDEDATA hData, DWORD dwData1, DWORD dwData2)
{
    int pair = 3;
    return DdeClient(iType, iFmt, hConv, ddeTopic, ddeItem,
		       hData, dwData1, dwData2, pair);
}

HDDEDATA CALLBACK
DdeClientCB4(UINT iType, UINT iFmt, HCONV hConv, HSZ ddeTopic, HSZ ddeItem,
	     HDDEDATA hData, DWORD dwData1, DWORD dwData2)
{
    int pair = 4;
    return DdeClient(iType, iFmt, hConv, ddeTopic, ddeItem,
		       hData, dwData1, dwData2, pair);
}

HDDEDATA CALLBACK
DdeClientCB5(UINT iType, UINT iFmt, HCONV hConv, HSZ ddeTopic, HSZ ddeItem,
	     HDDEDATA hData, DWORD dwData1, DWORD dwData2)
{
    int pair = 5;
    return DdeClient(iType, iFmt, hConv, ddeTopic, ddeItem,
		       hData, dwData1, dwData2, pair);
}

HDDEDATA CALLBACK
DdeClientCB6(UINT iType, UINT iFmt, HCONV hConv, HSZ ddeTopic, HSZ ddeItem,
	     HDDEDATA hData, DWORD dwData1, DWORD dwData2)
{
    int pair = 6;
    return DdeClient(iType, iFmt, hConv, ddeTopic, ddeItem,
		       hData, dwData1, dwData2, pair);
}

HDDEDATA CALLBACK
DdeClientCB7(UINT iType, UINT iFmt, HCONV hConv, HSZ ddeTopic, HSZ ddeItem,
	     HDDEDATA hData, DWORD dwData1, DWORD dwData2)
{
    int pair = 7;
    return DdeClient(iType, iFmt, hConv, ddeTopic, ddeItem,
		       hData, dwData1, dwData2, pair);
}

HDDEDATA CALLBACK
DdeClientCB8(UINT iType, UINT iFmt, HCONV hConv, HSZ ddeTopic, HSZ ddeItem,
	     HDDEDATA hData, DWORD dwData1, DWORD dwData2)
{
    int pair = 8;
    return DdeClient(iType, iFmt, hConv, ddeTopic, ddeItem,
		       hData, dwData1, dwData2, pair);
}

HDDEDATA CALLBACK
DdeClientCB9(UINT iType, UINT iFmt, HCONV hConv, HSZ ddeTopic, HSZ ddeItem,
	     HDDEDATA hData, DWORD dwData1, DWORD dwData2)
{
    int pair = 9;
    return DdeClient(iType, iFmt, hConv, ddeTopic, ddeItem,
		       hData, dwData1, dwData2, pair);
}

static PFNCALLBACK tkDDEClient[10] =
{
    DdeClientCB0, DdeClientCB1, DdeClientCB2, DdeClientCB3, DdeClientCB4,
    DdeClientCB5, DdeClientCB6, DdeClientCB7, DdeClientCB8, DdeClientCB9
};

HDDEDATA
DdeClient(UINT iType, UINT iFmt, HCONV hConv, HSZ ddeTopic, HSZ ddeItem,
	    HDDEDATA hData, DWORD dwData1, DWORD dwData2, int ddePair)
{
#if 1
    return (HDDEDATA) NULL;
#else
    int i, len;
    RegisteredInterp *riPtr;
    int result;
    int resultString;

    for (riPtr = registry; riPtr != NULL; riPtr = riPtr->nextPtr) {
	if (riPtr->ddePair == ddePair) {
	    break;
	}
    }
    if (riPtr == NULL) {
	return FALSE;
    }
#endif
}

/*
 *--------------------------------------------------------------
 *
 * SendDdeConnect --
 *
 *	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
SendDdeConnect(Tcl_Interp *interp, DWORD ddeServInst,
	     char *server, char *topic, HCONV *ddeConvPtr)
{
    HSZ ddeTopic, ddeService;
    HCONV ddeConv;
    
    ddeService = DdeCreateStringHandle(ddeServInst, server, 0);
    ddeTopic   = DdeCreateStringHandle(ddeServInst, topic, 0);

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

    if (ddeConv == (HCONV) NULL) {
	Tcl_AppendResult(interp, "no registered DDE server named \"",
		server, "\" for topic \"", topic, "\"", (char *) NULL);
	return TCL_ERROR;
    }

    *ddeConvPtr = ddeConv;
    return TCL_OK;
}

/*
 *--------------------------------------------------------------
 *
 * SendLocalCheck --
 *
 *	This procedure is a utility used to check if a DDE server
 *	is a local interp.  If it is, execute the command.
 *
 * Results:
 *	0 if server is not a local interp, 1 if it is
 *	
 * Side effects:
 *	Returns the result through resultPtr if this was a local interp.
 *
 *--------------------------------------------------------------
 */
static int
SendLocalCheck(Tcl_Interp *interp, char *server, char *cmd, int *resultPtr)
{
    RegisteredInterp *riPtr;

    for (riPtr = registry; riPtr != NULL; riPtr = riPtr->nextPtr) {
	if (strcmp(riPtr->name, server) != 0) {
	    continue;
	}
	if (interp == riPtr->interp) {
	    *resultPtr = Tcl_GlobalEval(interp, cmd);
	} else {
	    *resultPtr = Tcl_GlobalEval(riPtr->interp, cmd);
	    interp->result = riPtr->interp->result;
	    interp->freeProc = riPtr->interp->freeProc;
	    riPtr->interp->freeProc = 0;
	    Tcl_ResetResult(riPtr->interp);
	}
	return 1;
    }
    return 0;
}

/*
 *--------------------------------------------------------------
 *
 * Tk_SendCmd --
 *
 *	This procedure is invoked to process the "send" Tcl command.
 *	See the user documentation for details on what it does.
 *
 * Results:
 *	A standard Tcl result.
 *
 * Side effects:
 *	See the user documentation.
 *
 *--------------------------------------------------------------
 */

int
Tk_SendCmd(clientData, interp, argc, argv)
    ClientData clientData;		/* Information about sender (only
					 * dispPtr field is used). */
    Tcl_Interp *interp;			/* Current interpreter. */
    int argc;				/* Number of arguments. */
    char **argv;			/* Argument strings. */
{
    RegisteredInterp *senderRiPtr = (RegisteredInterp *) clientData;
    register RegisteredInterp *riPtr;
    int len, code, result, serial;
    char *end, *cmd, *p;
    HSZ ddeItem;
    HCONV ddeConv;
    DWORD ddeResult;
    HDDEDATA ddeData;

    if (argc < 3) {
	Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
		" interpName arg ?arg ...?\"",
		(char *) NULL);
	return TCL_ERROR;
    }

    if (argc == 3) {
	cmd = argv[2];
    } else {
	cmd = Tcl_Concat(argc-2, argv+2);
    }

    /*
     * See if the target interpreter is local.  If so, execute
     * the command directly without going through the DDE mechanism.
     * The only tricky thing is passing the result from the target
     * interpreter to the invoking interpreter.  Watch out:  they
     * could be the same!
     */

    if (SendLocalCheck(interp, argv[1], cmd, &result) == 1) {
	if (cmd != argv[2]) {
	    ckfree(cmd);
	}
	return result;
    }

    riPtr = senderRiPtr;
    result = SendDdeConnect(interp, riPtr->ddeServInst, argv[1], "tk_comm",
			    &ddeConv);
    if (result != TCL_OK) {
	if (cmd != argv[2]) {
	    ckfree(cmd);
	}
	return TCL_ERROR;
    }

    ddeItem = DdeCreateStringHandle(riPtr->ddeServInst, cmd, 0);
    ddeData = DdeClientTransaction(NULL, 0, ddeConv, ddeItem, CF_TEXT,
				   XTYP_REQUEST, 5000, &ddeResult);

    DdeFreeStringHandle(riPtr->ddeServInst, ddeItem);
    if (cmd != argv[2]) {
	ckfree(cmd);
    }

    if (ddeData == 0) {
	int err;

	err = DdeGetLastError(riPtr->ddeServInst);
	if (err == DMLERR_DATAACKTIMEOUT || err == DMLERR_EXECACKTIMEOUT ||
	    err == DMLERR_POKEACKTIMEOUT) {
	    Tcl_AppendResult(interp, "remote interpreter did not respond",
			     (char *) NULL);
	} else if (err == DMLERR_BUSY) {
	    Tcl_AppendResult(interp, "remote server is busy",
			     (char *) NULL);
	} else if (err == DMLERR_NOTPROCESSED) {
	    Tcl_AppendResult(interp, "remote server cannot handle this command",
			     (char *) NULL);
	} else {
	    Tcl_AppendResult(interp, "send failed",
			     (char *) NULL);
	}
	return TCL_ERROR;
    }

    len = DdeGetData(ddeData, NULL, 0, 0) + 1;
    BUFALLOC(len, bufsize, buffer);
    buffer[0] = '\0';
    DdeGetData(ddeData, buffer, bufsize, 0);
    DdeFreeDataHandle(ddeData);

    DdeDisconnect(ddeConv);

    if (!(buffer[0] == 'R' && buffer[1] == 'T' &&
	  buffer[2] == 'k' && buffer[3] == '1' && buffer[4] == ' '))
    {
    error:
	Tcl_AppendResult(interp, "bad return value from remote interp",
			 (char *) NULL);
	return TCL_ERROR;
    }

    p = &buffer[5];
    serial = (int) strtol(p, &end, 16);
    if (end == p) {
	goto error;
    }

    p = end;
    if (*p != ' ') {
	goto error;
    }
    p++;

    code = (int) strtol(p, &end, 10);
    if (end == p) {
	goto error;
    }

    end++;

    Tcl_SetResult(interp, end, TCL_VOLATILE);
    return code;
}

/*
 *--------------------------------------------------------------
 *
 * Tk_DdeRequestCmd --
 *
 *	This procedure is invoked to process the "dde_request" Tcl command.
 *	See the user documentation for details on what it does.
 *
 * Results:
 *	A standard Tcl result.
 *
 * Side effects:
 *	See the user documentation.
 *
 *--------------------------------------------------------------
 */

int
Tk_DdeRequestCmd(clientData, interp, argc, argv)
    ClientData clientData;		/* Information about sender (only
					 * dispPtr field is used). */
    Tcl_Interp *interp;			/* Current interpreter. */
    int argc;				/* Number of arguments. */
    char **argv;			/* Argument strings. */
{
    RegisteredInterp *senderRiPtr = (RegisteredInterp *) clientData;
    register RegisteredInterp *riPtr;
    int len, result;
    char *cmd;
    HSZ ddeItem;
    HCONV ddeConv;
    DWORD ddeResult;
    HDDEDATA ddeData;
    int i;
    char *buf;
    int timeout, length;

    if (argc < 4) {
    Usage:
	Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
		" serverName topicName ?-timeout milliseconds? arg ?arg ...?\"",
		(char *) NULL);
	return TCL_ERROR;
    }

    timeout = 5000;
    i = 3;
    if (argv[3][0] == '-') {
	length = strlen(argv[3]);
	if (strncmp(argv[3], "-timeout", length) == 0) {
	    if (argc < 6) {
		goto Usage;
	    }
	    if (Tcl_GetInt(interp, argv[4], &timeout) != TCL_OK) {
	    	Tcl_AppendResult(interp, "bad milliseconds value \"",
				 argv[4], "\"", (char *) NULL);
		return TCL_ERROR;
	    }
	} else {
	    Tcl_AppendResult(interp, "unknown flag \"", argv[3],
			     "\": should be -timeout", (char *) NULL);
	    return TCL_ERROR;
	}
	i += 2;
    }

    if (argc - i == 1) {
	cmd = argv[i];
    } else {
	cmd = Tcl_Concat(argc-i, argv+i);
    }

    /*
     * See if the target interpreter is local.  If so, execute
     * the command directly without going through the DDE mechanism.
     * The only tricky thing is passing the result from the target
     * interpreter to the invoking interpreter.  Watch out:  they
     * could be the same!
     */

    if (SendLocalCheck(interp, argv[1], cmd, &result) == 1) {
	if (cmd != argv[i]) {
	    ckfree(cmd);
	}
	return result;
    }

    riPtr = senderRiPtr;
    result = SendDdeConnect(interp, riPtr->ddeServInst, argv[1], argv[2],
			    &ddeConv);
    if (result != TCL_OK) {
	if (cmd != argv[i]) {
	    ckfree(cmd);
	}
	return TCL_ERROR;
    }

    ddeItem = DdeCreateStringHandle(riPtr->ddeServInst, cmd, 0);
    ddeData = DdeClientTransaction(NULL, 0, ddeConv, ddeItem, CF_TEXT,
				   XTYP_REQUEST, 5000, &ddeResult);

    DdeFreeStringHandle(riPtr->ddeServInst, ddeItem);
    if (cmd != argv[i]) {
	ckfree(cmd);
    }

    if (ddeData == 0) {
	int err;

	err = DdeGetLastError(riPtr->ddeServInst);
	if (err == DMLERR_DATAACKTIMEOUT || err == DMLERR_EXECACKTIMEOUT ||
	    err == DMLERR_POKEACKTIMEOUT) {
	    Tcl_AppendResult(interp, "remote server did not respond",
			     (char *) NULL);
	} else if (err == DMLERR_BUSY) {
	    Tcl_AppendResult(interp, "remote server is busy",
			     (char *) NULL);
	} else if (err == DMLERR_NOTPROCESSED) {
	    Tcl_AppendResult(interp, "remote server cannot handle this command",
			     (char *) NULL);
	} else {
	    Tcl_AppendResult(interp, "send failed",
			     (char *) NULL);
	}
	return TCL_ERROR;
    }

    len = DdeGetData(ddeData, NULL, 0, 0) + 1;
    if (len < TCL_RESULT_SIZE) {
	buf = interp->result;
    } else {
	buf = (char *) ckalloc(len + 1);
    }

    buf[0] = '\0';
    DdeGetData(ddeData, buf, len, 0);
    DdeFreeDataHandle(ddeData);
    DdeDisconnect(ddeConv);
    buf[len] = '\0';

    if (buf != interp->result) {
	Tcl_SetResult(interp, buf, TCL_VOLATILE);
	ckfree((char *) buf);
    }
    return TCL_OK;
}

/*
 *--------------------------------------------------------------
 *
 * Tk_DdeExecuteCmd --
 *
 *	This procedure is invoked to process the "dde_execute" Tcl command.
 *	See the user documentation for details on what it does.
 *
 * Results:
 *	A standard Tcl result.
 *
 * Side effects:
 *	See the user documentation.
 *
 *--------------------------------------------------------------
 */

int
Tk_DdeExecuteCmd(clientData, interp, argc, argv)
    ClientData clientData;		/* Information about sender (only
					 * dispPtr field is used). */
    Tcl_Interp *interp;			/* Current interpreter. */
    int argc;				/* Number of arguments. */
    char **argv;			/* Argument strings. */
{
    RegisteredInterp *senderRiPtr = (RegisteredInterp *) clientData;
    register RegisteredInterp *riPtr;
    int result, length;
    HCONV ddeConv;
    HDDEDATA ddeData;
    DWORD ddeResult;
    char *cmd;
    int i;
    int timeout;

    if (argc < 4) {
    Usage:
	Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
		" serverName topicName ?-timeout milliseconds? arg ?arg ...?\"",
		(char *) NULL);
	return TCL_ERROR;
    }

    timeout = 5000;
    i = 3;
    if (argv[3][0] == '-') {
	length = strlen(argv[3]);
	if (strncmp(argv[3], "-timeout", length) == 0) {
	    if (argc < 6) {
		goto Usage;
	    }
	    if (Tcl_GetInt(interp, argv[4], &timeout) != TCL_OK) {
	    	Tcl_AppendResult(interp, "bad milliseconds value \"",
				 argv[4], "\"", (char *) NULL);
		return TCL_ERROR;
	    }
	} else {
	    Tcl_AppendResult(interp, "unknown flag \"", argv[3],
			     "\": should be -timeout", (char *) NULL);
	    return TCL_ERROR;
	}
	i += 2;
    }

    if (argc - i == 1) {
	cmd = argv[i];
    } else {
	cmd = Tcl_Concat(argc-i, argv+i);
    }

    /*
     * See if the target server is local.  If so, execute
     * the command directly without going through the DDE mechanism.
     * The only tricky thing is passing the result from the target
     * interpreter to the invoking interpreter.  Watch out:  they
     * could be the same!
     */

    if (SendLocalCheck(interp, argv[1], cmd, &result) == 1) {
	if (cmd != argv[i]) {
	    ckfree(cmd);
	}
	return result;
    }

    riPtr = senderRiPtr;
    result = SendDdeConnect(interp, riPtr->ddeServInst, argv[1], argv[2],
			    &ddeConv);
    if (result != TCL_OK) {
	if (cmd != argv[i]) {
	    ckfree(cmd);
	}
	return TCL_ERROR;
    }

    ddeData = DdeClientTransaction(cmd, strlen(cmd) + 1, ddeConv, 0L, CF_TEXT,
				   XTYP_EXECUTE, timeout, &ddeResult);

    if (cmd != argv[i]) {
	ckfree(cmd);
    }

    if (ddeData == 0) {
	int err;

	err = DdeGetLastError(riPtr->ddeServInst);
	if (err == DMLERR_DATAACKTIMEOUT || err == DMLERR_EXECACKTIMEOUT ||
	    err == DMLERR_POKEACKTIMEOUT) {
	    Tcl_AppendResult(interp, "remote server timed out",
			     (char *) NULL);
	} else if (err == DMLERR_BUSY) {
	    Tcl_AppendResult(interp, "remote server is busy",
			     (char *) NULL);
	} else if (err == DMLERR_NOTPROCESSED) {
	    Tcl_AppendResult(interp, "remote server cannot handle this command",
			     (char *) NULL);
	} else {
	    Tcl_AppendResult(interp, "dde execute attempt failed",
			     (char *) NULL);
	}
	return TCL_ERROR;
    }

    return TCL_OK;
}

/*
 *--------------------------------------------------------------
 *
 * Tk_RegisterInterp --
 *
 *	This procedure is called to associate an ASCII name
 *	with an interpreter.  Tk_InitSend must previously
 *	have been called to set up communication channels
 *	and specify a display.
 *
 * Results:
 *	Zero is returned if the name was registered successfully.
 *	Non-zero means the name was already in use.
 *
 * Side effects:
 *	Registration info is saved, thereby allowing the
 *	"send" command to be used later to invoke commands
 *	in the interpreter.  The registration will be removed
 *	automatically when the interpreter is deleted.
 *
 *--------------------------------------------------------------
 */
int
Tk_RegisterInterp(interp, name, tkwin)
    Tcl_Interp *interp;		/* Interpreter associated with name. */
    char *name;			/* The name that will be used to
				 * refer to the interpreter in later
				 * "send" commands.  Must be globally
				 * unique. */
    Tk_Window tkwin;		/* Token for window associated with
				 * interp;  used to identify display
				 * for communication.  */
{
    HWND hwnd;
    HANDLE handle;
    HSZ ddeService;
    int ddePair;
    int ret;
    register RegisteredInterp *riPtr;
    TkWindow *winPtr = (TkWindow *) tkwin;
    TkDisplay *dispPtr;

    dispPtr = winPtr->dispPtr;

    for (ddePair = 0; ddePair < 10; ddePair++) {
	if (tkDDEPair[ddePair] == 0) {
	    break;
	}
    }
    if (ddePair == 10) {
        Tcl_AppendResult(interp, "no free DDE servers",
			 (char *) NULL);
	return TCL_ERROR;
    }
	
    hwnd = GetDesktopWindow();
    handle = GetProp(hwnd, name);
    if (handle) {
        Tcl_AppendResult(interp, "interpreter name \"", name,
			 "\" is already in use", (char *) NULL);
	return TCL_ERROR;
    }

    if (SetProp(hwnd, name, (void *) 1) == FALSE) {
        Tcl_AppendResult(interp, "unable to register interpreter name \"", name,
			 (char *) NULL);
	return TCL_ERROR;
    }

    /* Here, we need to setup a DDE string server to field queries. This will
     * be the mechanism used to handle the 'send' command
     */
    ret = DdeInitialize(&tkDDEServInst[ddePair], tkDDEServer[ddePair],
			CBF_FAIL_EXECUTES|CBF_FAIL_POKES|
			CBF_SKIP_REGISTRATIONS|CBF_SKIP_UNREGISTRATIONS, 0);
    if (ret != DMLERR_NO_ERROR) {
	RemoveProp(hwnd, name);
        Tcl_AppendResult(interp, "unable to initialize DDE server",
			 (char *) NULL);
	return TCL_ERROR;
    }

    ret = DdeInitialize(&tkDDEClientInst[ddePair], tkDDEClient[ddePair],
			APPCLASS_STANDARD|APPCMD_CLIENTONLY, 0L);
    if (ret != DMLERR_NO_ERROR) {
	DdeUninitialize(tkDDEServInst[ddePair]);
	RemoveProp(hwnd, name);
        Tcl_AppendResult(interp, "unable to initialize DDE client",
			 (char *) NULL);
	return TCL_ERROR;
    }

    ddeService = DdeCreateStringHandle(tkDDEServInst[ddePair], name, 0);
    DdeNameService(tkDDEServInst[ddePair], ddeService, 0L, DNS_REGISTER) ;
    tkDDEPair[ddePair] = 1;

    riPtr = (RegisteredInterp *) ckalloc(sizeof(RegisteredInterp));
    riPtr->name = (char *) ckalloc((unsigned) (strlen(name) + 1));
    strcpy(riPtr->name, name);
    riPtr->interp = interp;
    riPtr->dispPtr = dispPtr;
    riPtr->ddeServInst = tkDDEServInst[ddePair];
    riPtr->ddeService = ddeService;
    riPtr->ddePair = ddePair;
    riPtr->nextPtr = registry;
    riPtr->commandCount = 0;
    registry = riPtr;

    /*
     * Add the "send" command to this interpreter, and arrange for
     * us to be notified when the interpreter is deleted (actually,
     * when the "send" command is deleted).
     */

    Tcl_CreateCommand(interp, "send", Tk_SendCmd, (ClientData) riPtr,
	    DeleteProc);
    riPtr->commandCount++;

    Tcl_CreateCommand(interp, "dde_request", Tk_DdeRequestCmd,
		      (ClientData) riPtr, DeleteProc);
    riPtr->commandCount++;

    Tcl_CreateCommand(interp, "dde_execute", Tk_DdeExecuteCmd,
		      (ClientData) riPtr, DeleteProc);
    riPtr->commandCount++;

#if 0
    Tcl_CreateCommand(interp, "dde_poke", Tk_DdePokeCmd,
		      (ClientData) riPtr, DeleteProc);
    riPtr->commandCount++;
#endif

    return TCL_OK;
}

/*
 *--------------------------------------------------------------
 *
 * DeleteProc --
 *
 *	This procedure is invoked by Tcl when a registered
 *	interpreter is about to be deleted.  It unregisters
 *	the interpreter.
 *
 * Results:
 *	None.
 *
 * Side effects:
 *	The interpreter given by riPtr is unregistered.
 *
 *--------------------------------------------------------------
 */

static void
DeleteProc(clientData)
    ClientData clientData;	/* Info about registration, passed
				 * as ClientData. */
{
    RegisteredInterp *riPtr = (RegisteredInterp *) clientData;
    register RegisteredInterp *riPtr2;
    HWND hwnd;

    if (registry == riPtr) {
	registry = riPtr->nextPtr;
    } else {
	for (riPtr2 = registry; riPtr2 != NULL;
		riPtr2 = riPtr2->nextPtr) {
	    if (riPtr2->nextPtr == riPtr) {
		riPtr2->nextPtr = riPtr->nextPtr;
		break;
	    }
	}
    }

    riPtr->commandCount--;
    if (riPtr->commandCount != 0) {
	return;
    }
    DdeFreeStringHandle(riPtr->ddeServInst, riPtr->ddeService);
    DdeUninitialize(riPtr->ddeServInst);
    hwnd = GetDesktopWindow();
    RemoveProp(hwnd, riPtr->name);

    ckfree((char *) riPtr->name);
    ckfree((char *) riPtr);
}

/*
 *----------------------------------------------------------------------
 *
 * TkGetInterpNames --
 *
 *	This procedure is invoked to fetch a list of all the
 *	interpreter names currently registered for the display
 *	of a particular window.
 *
 * Results:
 *	A standard Tcl return value.  Interp->result will be set
 *	to hold a list of all the interpreter names defined for
 *	tkwin's display.  If an error occurs, then TCL_ERROR
 *	is returned and interp->result will hold an error message.
 *
 * Side effects:
 *	None.
 *
 *----------------------------------------------------------------------
 */

int
TkGetInterpNames(interp, tkwin)
    Tcl_Interp *interp;		/* Interpreter for returning a result. */
    Tk_Window tkwin;		/* Window whose display is to be used
				 * for the lookup. */
{
    TkDisplay *dispPtr = ((TkWindow *) tkwin)->dispPtr;

    Tcl_AppendResult(interp, "option not yet implemented", (char *) NULL);
    return TCL_ERROR;
}
