Logo Search packages:      
Sourcecode: tcl8.4 version File versions  Download package

tclWinDde.c

/* 
 * 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.
 *
 * See the file "license.terms" for information on usage and redistribution
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 *
 * RCS: @(#) $Id: tclWinDde.c,v 1.13.2.4 2004/09/01 17:26:06 hobbs Exp $
 */

#include "tclPort.h"
#include <dde.h>
#include <ddeml.h>
#include <tchar.h>

/*
 * TCL_STORAGE_CLASS is set unconditionally to DLLEXPORT because the
 * 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
                         * about. */
    char *name;               /* Interpreter's name (malloc-ed). */
    Tcl_Interp *interp;       /* The interpreter attached to this name. */
} RegisteredInterp;

/*
 * Used to keep track of conversations.
 */

typedef struct Conversation {
    struct Conversation *nextPtr;
                        /* The next conversation in the list. */
    RegisteredInterp *riPtr;  /* The info we know about the conversation. */
    HCONV hConv;        /* The DDE handle for this conversation. */
    Tcl_Obj *returnPackagePtr;      /* The result package for this conversation. */
} Conversation;

typedef struct ThreadSpecificData {
    Conversation *currentConversations;
                                /* A list of conversations currently
                         * being processed. */
    RegisteredInterp *interpListPtr;
                                /* List of all interpreters registered
                         * in the current process. */
} ThreadSpecificData;
static Tcl_ThreadDataKey dataKey;

/*
 * The following variables cannot be placed in thread-local storage.
 * 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.3"
#define TCL_DDE_PACKAGE_NAME "dde"
#define TCL_DDE_SERVICE_NAME "TclEval"

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,
                        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_((
                        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 */
      int objc,               /* Number of arguments */
      Tcl_Obj *CONST objv[]); /* The arguments */

EXTERN int Dde_Init(Tcl_Interp *interp);

/*
 *----------------------------------------------------------------------
 *
 * Dde_Init --
 *
 *    This procedure initializes the dde command.
 *
 * Results:
 *    A standard Tcl result.
 *
 * Side effects:
 *    None.
 *
 *----------------------------------------------------------------------
 */

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 = TCL_TSD_INIT(&dataKey);

    Tcl_CreateExitHandler(DdeExitProc, NULL);

    return Tcl_PkgProvide(interp, TCL_DDE_PACKAGE_NAME, TCL_DDE_VERSION);
}

/*
 *----------------------------------------------------------------------
 *
 * Initialize --
 *
 *    Initialize the global DDE instance.
 *
 * Results:
 *    None.
 *
 * Side effects:
 *    Registers the DDE server proc.
 *
 *----------------------------------------------------------------------
 */

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) {
      nameFound = 1;
    }

    /*
     * Make sure that the DDE server is there. This is done only once,
     * add an exit handler tear it down.
     */

    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);
    }
}    

/*
 *--------------------------------------------------------------
 *
 * DdeSetServerName --
 *
 *    This procedure is called to associate an ASCII name with a Dde
 *    server.  If the interpreter has already been named, the
 *    name replaces the old one.
 *
 * Results:
 *    The return value is the name actually given to the interp.
 *    This will normally be the same as name, but if name was already
 *    in use for a Dde Server then a name of the form "name #2" will
 *    be chosen,  with a high enough number to make the name unique.
 *
 * Side effects:
 *    Registration info is saved, thereby allowing the "send" command
 *    to be used later to invoke commands in the application.  In
 *    addition, the "send" command is created in the application's
 *    interpreter.  The registration will be removed automatically
 *    if the interpreter is deleted or the "send" command is removed.
 *
 *--------------------------------------------------------------
 */

static char *
DdeSetServerName(
    Tcl_Interp *interp,
    char *name                /* The name that will be used to
                         * refer to the interpreter in later
                         * "send" commands.  Must be globally
                         * unique. */
    )
{
    int suffix, offset;
    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; 
          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 {
            /*
             * the name was NULL, so the caller is asking for
             * the name of the current interp.
             */

            return riPtr->name;
          }
      }
    }

    if (name == NULL) {
      /*
       * 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.
     */

    suffix = 1;
    offset = 0;
    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,
          (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
 *
 *    This procedure is called when the command "dde" is destroyed.
 *
 * Results:
 *    none
 *
 * Side effects:
 *    The interpreter given by riPtr is unregistered.
 *
 *--------------------------------------------------------------
 */

static void
DeleteProc(clientData)
    ClientData clientData;    /* The interp we are deleting passed
                         * as 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) {
      /*
       * Empty loop body.
       */
    }

    if (searchPtr != NULL) {
      if (prevPtr == NULL) {
          tsdPtr->interpListPtr = tsdPtr->interpListPtr->nextPtr;
      } else {
          prevPtr->nextPtr = searchPtr->nextPtr;
      }
    }
    ckfree(riPtr->name);
    Tcl_EventuallyFree(clientData, TCL_DYNAMIC);
}

/*
 *--------------------------------------------------------------
 *
 * ExecuteRemoteObject --
 *
 *    Takes the package delivered by DDE and executes it in
 *    the server's interpreter.
 *
 * Results:
 *    A list Tcl_Obj * that describes what happened. The first
 *    element is the numerical return code (TCL_ERROR, etc.).
 *    The second element is the result of the script. If the
 *    return result was TCL_ERROR, then the third element
 *    will be the value of the global "errorCode", and the
 *    fourth will be the value of the global "errorInfo".
 *    The return result will have a refCount of 0.
 *
 * Side effects:
 *    A Tcl script is run, which can cause all kinds of other
 *    things to happen.
 *
 *--------------------------------------------------------------
 */

static Tcl_Obj *
ExecuteRemoteObject(
    RegisteredInterp *riPtr,      /* Info about this server. */
    Tcl_Obj *ddeObjectPtr)        /* The object to execute. */
{
    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;
}

/*
 *--------------------------------------------------------------
 *
 * DdeServerProc --
 *
 *    Handles all transactions for this server. Can handle
 *    execute, request, and connect protocols. Dde will
 *    call this routine when a client attempts to run a dde
 *    command using this server.
 *
 * Results:
 *    A DDE Handle with the result of the dde command.
 *
 * Side effects:
 *    Depending on which command is executed, arbitrary
 *    Tcl scripts can be run.
 *
 *--------------------------------------------------------------
 */

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 
                         * current transaction. */
    HSZ ddeTopic,       /* A string handle. Transaction-type 
                         * dependent. */
    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;
    DWORD dlen;
    char *utilString;
    Tcl_Obj *ddeObjectPtr;
    HDDEDATA ddeReturn = NULL;
    RegisteredInterp *riPtr;
    Conversation *convPtr, *prevConvPtr;
    ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);

    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, (DWORD) 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, (DWORD) 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, 
                        (DWORD) len + 1, CP_WINANSI);
            if (stricmp(utilString, "$TCLEVAL$EXECUTE$RESULT") == 0) {
                returnString =
                    Tcl_GetStringFromObj(convPtr->returnPackagePtr, &len);
                ddeReturn = DdeCreateDataHandle(ddeInstance,
                      returnString, (DWORD) 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, (DWORD) 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, &dlen);
          len = dlen;
          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);
          Tcl_IncrRefCount(returnPackagePtr);
          for (convPtr = tsdPtr->currentConversations; (convPtr != NULL)
                && (convPtr->hConv != hConv); convPtr = convPtr->nextPtr) {
            /*
             * Empty loop body.
             */

          }
          if (convPtr != NULL) {
            convPtr->returnPackagePtr = returnPackagePtr;
          } else {
            Tcl_DecrRefCount(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, &dlen);
          len = dlen;
          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;
}

/*
 *--------------------------------------------------------------
 *
 * DdeGetServicesList --
 *
 *    This procedure obtains the list of DDE services.
 *
 *    The functions between here and this procedure are all
 *    involved with handling the DDE callbacks for this.
 *
 * Results:
 *    A standard Tcl result.
 *
 * Side effects:
 *    Sets the services list into the interp result.
 *
 *--------------------------------------------------------------
 */

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

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)
{
    WNDCLASSEX wc;
    static const char *szDdeClientClassName = "TclEval client class";
    static const char *szDdeClientWindowName = "TclEval client window";

    memset(&wc, 0, sizeof(wc));
    wc.cbSize = sizeof(wc);
    wc.lpfnWndProc = DdeClientWindowProc;
    wc.lpszClassName = szDdeClientClassName;
    wc.cbWndExtra = sizeof(ddeEnumServices*);

    /* register and create the callback window */
    RegisterClassEx(&wc);
    es->hwnd = CreateWindowEx(0, szDdeClientClassName,
                        szDdeClientWindowName,
                        WS_POPUP, 0, 0, 0, 0, NULL, NULL, NULL,
                        (LPVOID)es);
    return TCL_OK;
}

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

    switch (uMsg) {
      case WM_CREATE: {
          LPCREATESTRUCT lpcs = (LPCREATESTRUCT)lParam;
          ddeEnumServices *es;
          es = (ddeEnumServices*)lpcs->lpCreateParams;
#ifdef _WIN64
          SetWindowLongPtr(hwnd, GWLP_USERDATA, (long)es);
#else
          SetWindowLong(hwnd, GWL_USERDATA, (long)es);
#endif
          break;
      }
      case WM_DDE_ACK:
          lr =  DdeServicesOnAck(hwnd, wParam, lParam);
          break;
      default:
          lr = DefWindowProc(hwnd, uMsg, wParam, lParam);
    }
    return lr;
}

static LRESULT
DdeServicesOnAck(HWND hwnd, WPARAM wParam, LPARAM lParam)
{
    HWND hwndRemote = (HWND)wParam;
    ATOM service = (ATOM)LOWORD(lParam);
    ATOM topic = (ATOM)HIWORD(lParam);
    ddeEnumServices *es;
    TCHAR sz[255];

#ifdef _WIN64
    es = (ddeEnumServices *)GetWindowLongPtr(hwnd, GWLP_USERDATA);
#else
    es = (ddeEnumServices *)GetWindowLong(hwnd, GWL_USERDATA);
#endif

    if ((es->service == (ATOM)NULL || es->service == service)
      && (es->topic == (ATOM)NULL || es->topic == topic)) {
      Tcl_Obj *matchPtr = Tcl_NewListObj(0, NULL);

      GlobalGetAtomName(service, sz, 255);
      Tcl_ListObjAppendElement(es->interp, matchPtr,
            Tcl_NewStringObj(sz, -1));
      GlobalGetAtomName(topic, sz, 255);
      Tcl_ListObjAppendElement(es->interp, matchPtr,
            Tcl_NewStringObj(sz, -1));
      /* Adding the hwnd as a third list element provides a unique
       * identifier in the case of multiple servers with the name
       * application and topic names.
       */
      /* Needs a TIP though
       * Tcl_ListObjAppendElement(es->interp, matchPtr,
       *    Tcl_NewLongObj((long)hwndRemote));
       */
      Tcl_ListObjAppendElement(es->interp,
            Tcl_GetObjResult(es->interp), matchPtr);
    }

    /* tell the server we are no longer interested */
    PostMessage(hwndRemote, WM_DDE_TERMINATE, (WPARAM)hwnd, 0L);
    return 0L;
}

static BOOL CALLBACK
DdeEnumWindowsCallback(HWND hwndTarget, LPARAM lParam)
{
    LRESULT dwResult = 0;
    ddeEnumServices *es = (ddeEnumServices *)lParam;
    SendMessageTimeout(hwndTarget, WM_DDE_INITIATE,
                   (WPARAM)es->hwnd,
                   MAKELONG(es->service, es->topic),
                   SMTO_ABORTIFHUNG, 1000, &dwResult);
    return TRUE;
}

static int
DdeGetServicesList(Tcl_Interp *interp, char *serviceName, char *topicName)
{
    ddeEnumServices es;
    int r = TCL_OK;
    es.interp = interp;
    es.result = TCL_OK;
    es.service = (serviceName == NULL) 
      ? (ATOM)NULL : GlobalAddAtom(serviceName);
    es.topic = (topicName == NULL) 
      ? (ATOM)NULL : 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)NULL)
      GlobalDeleteAtom(es.service);
    if (es.topic != (ATOM)NULL)
      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.
 *
 *--------------------------------------------------------------
 */

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, 
                  "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,
                (DWORD) 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);
            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, 
                        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 {
                  DWORD tmp;
                  dataString = DdeAccessData(ddeData, &tmp);
                  dataLength = tmp;
                  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);
            goto errorNoResult;
          }
          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, (DWORD) 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: {
          result = DdeGetServicesList(interp, serviceName, topicName);
          break;
      }
      case DDE_EVAL: {
          if (serviceName == NULL) {
            Tcl_SetStringObj(Tcl_GetObjResult(interp),
                  "invalid service name \"\"", -1);
            goto errorNoResult;
          }

          objc -= (async + 3);
          ((Tcl_Obj **) 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 
           * 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 (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) {
                  /*
                   * An error occurred, so transfer error information
                   * from the destination interpreter back to our
                   * interpreter.
                   */
                  
                  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 {
            /*
             * 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, 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);
                  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, 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;
                }
                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;
}

Generated by  Doxygen 1.6.0   Back to index