Skunkware 5/Skunkware 5.iso/src/Tools/ObjectTcl-1.1/Otcl.C

C/C++ Source or Header | 1995-06-30 | 22.5 KB | 811 lines

/*  _ __ ___ _
 * | |\ /  /| |  $Id: Otcl.C,v 1.9 1995/06/16 13:03:59 deans Exp $
 * | | /  / | |  Copyright (C) 1995 IXI Limited.
 * |_|/__/_\|_|  IXI Limited, Cambridge, England.
 *
 * Component   : Otcl.C
 *
 * Author      : Dean Sheehan ([e-mail])
 *
 * Description : Contains the implementation of the Otcl class that is the
 *               actual extension package for Tcl.
 *
 * License     :
            Object Tcl License & Copyright
            ------------------------------

IXI Object Tcl software, both binary and source (hereafter, Software) is copyrighted by IXI Limited (IXI), and ownership remains with IXI.

IXI grants you (herafter, Licensee) a license to use the Software for academic, research and internal business purposes only, without a fee. Licensee may distribute the binary and source code (if required) to third parties provided that the copyright notice and this statement appears on all copies and that no charge is associated with such copies.

Licensee may make derivative works. However, if Licensee distributes any derivative work based on or derived from the Software, then Licensee will (1) notify IXI regarding its distribution of the derivative work, and (2) clearly notify users that such derivative work is a modified version and not the original IXI Object Tcl distributed by IXI. IXI strongly recommends that Licensee provide IXI the right to incorporate such modifications into future releases of the Software under these license terms.

Any Licensee wishing to make commercial use of the Software should contact IXI, to negotiate an appropriate license for such commercial use. Commercial use includes (1) integration of all or part of the source code into a product for sale or license by or on behalf of Licensee to third parties, or (2) distribution of the binary code or source code to third parties that need it to utilize a commercial product sold or licensed by or on behalf of Licensee.

IXI MAKES NO REPRESENTATIONS ABOUT THE SUITABILITY OF THIS SOFTWARE FOR ANY PURPOSE. IT IS PROVIDED "AS IS" WITHOUT EXPRESS OR IMPLIED WARRANTY. IXI SHALL NOT BE LIABLE FOR ANY DAMAGES WHATSOEVER SUFFERED BY THE USERS OF THIS SOFTWARE.

Copyright (C) 1995, IXI Limited

By using or copying this Software, Licensee agrees to abide by the copyright law and all other applicable laws of England and the U.S., including, but not limited to, export control laws, and the terms of this license. IXI shall have the right to terminate this license immediately by written notice upon Licensee's breach of, or non-compliance with, any of its terms. Licensee may be held legally responsible for any copyright infringement that is caused or encouraged by Licensee's failure to abide by the terms of this license.

Comments and questions are welcome and can be sent to
[e-mail]

For more information on copyright and licensing issues, contact:
Legal Department, IXI Limited, Vision Park, Cambridge CB4 4ZR,
ENGLAND.

 *
 */

// System Includes
#include <stdio.h>
#include <stdlib.h>

// Tcl Includes
#include <tclInt.h>

#include "Otcl.H"
#include "OtclClass.H"
#include "OtclObjMgr.H"
#include "OtclObject.H"

#ifdef OTCL_DP
#include "OtclOserver.H"

#ifdef _WINDOWS
#include <winsock.h>
#endif

#endif

// Class Attribute Definitions
Tcl_Interp *Otcl::tclInterp = NULL;
Otcl *Otcl::otclPtr = NULL;

Otcl::Otcl (Tcl_Interp *interp, int &result, OtclObjMgr *om)
{
   placeCommandsInScope(interp);
   Tcl_InitHashTable(&classes,TCL_STRING_KEYS);

#ifdef OTCL_DP
   Tcl_InitHashTable(&remoteClasses,TCL_STRING_KEYS);
#endif

   objMgr = om;

   tclInterp = interp;
   otclPtr = this;

   // Register all of the available Otcl bound C++ classes
   // with this Otcl extension.
   OtclClassCpp::registerWithOtcl(this);

   char *otclLibrary = getenv("OTCL_LIBRARY");
   if (otclLibrary == NULL)
   {
      otclLibrary = OTCL_LIBRARY;
   }
   Tcl_SetVar(interp,"otcl_library",otclLibrary,TCL_GLOBAL_ONLY);

   char initCmd[] =
      "if [file exists $otcl_library/otcl.tcl] {\n\
          source $otcl_library/otcl.tcl\n\
       } else {\n\
          set msg \"can't find $otcl_library/otcl.tcl; perhaps you \"\n\
          append msg \"need to\\ninstall Object Tcl or set your \"\n\
          append msg \" OTCL_LIBRARY environment variable?\"\n\
          error $msg\n\
      }";

   result = Tcl_Eval(interp,initCmd);

#ifdef OTCL_DP
#ifdef _WINDOWS
   if (result == TCL_OK)
   {
      WORD wVersionRequest = 0x0101;
      WSDATA wsaData;

      int err = WSAStartup(wVersionRequested,&wsaData);
      if (err != 0)
      {
         Otcl::setTclError(interp,"Winsock initialisition error %d.",err);
         result = TCL_ERROR;
      }
   }
#endif
#endif
}

Otcl::~Otcl ()
{
   // Cleanup all the classes in the Hash Table
   Tcl_HashEntry *entry;
   Tcl_HashSearch search;
   OtclClass *otclc;
   for (entry = Tcl_FirstHashEntry(&classes,&search);
        entry != NULL;
        entry = Tcl_NextHashEntry(&search))
   {
      otclc = (OtclClass*)(Tcl_GetHashValue(entry));

      // Not all OtclClass objects registered are owned by this Otcl object
      // as CPP OtclClasses are registered with all Otcl object in this
      // process.
      if (otclc->shouldDelete())
      {
         delete otclc;
      }
   }

   // Cleanup the Hash Table.
   Tcl_DeleteHashTable(&classes);

#ifdef OTCL_DP
   // clear up remoteClasses as well.
   OtclRemoteClass *otclrc;
   for (entry = Tcl_FirstHashEntry(&remoteClasses,&search);
        entry != NULL;
        entry = Tcl_NextHashEntry(&search))
   {
      otclrc = (OtclRemoteClass*)(Tcl_GetHashValue(entry));
      delete otclrc;
   }

   // Cleanup the Hash Table.
   Tcl_DeleteHashTable(&remoteClasses);
#endif

}

int Otcl::classInterfaceCmd (ClientData cd, Tcl_Interp *interp,
                             int argc, char *argv[])
{
   Otcl *otcl = (Otcl*)cd;
   return otcl->classInterface(interp,argc,argv);
}

int Otcl::classImplementationCmd (ClientData cd, Tcl_Interp *interp,
                                  int argc, char *argv[])
{
   Otcl *otcl = (Otcl*)cd;
   return otcl->classImplementation(interp,argc,argv);
}

int Otcl::instantiateCmd (ClientData cd, Tcl_Interp *interp,
                          int argc, char *argv[])
{
   Otcl *otcl = (Otcl*)cd;
   return otcl->instantiate(interp,argc,argv);
}

int Otcl::discardCmd (ClientData cd, Tcl_Interp *interp,
                      int argc, char *argv[])
{
   Otcl *otcl = (Otcl*)cd;
   return otcl->discard(interp,argc,argv);
}

int Otcl::otclCmd (ClientData cd, Tcl_Interp *interp,
                   int argc, char *argv[])
{
   Otcl *otcl = (Otcl*)cd;
   return otcl->otcl(interp,argc,argv);
}

int Otcl::otclNopCmd (ClientData, Tcl_Interp *interp, int argc, char *argv[])
{
   Tcl_SetResult(interp,Tcl_Merge(argc-1,&argv[1]),TCL_DYNAMIC);
   return TCL_OK;
}

int Otcl::classCmd (ClientData cd, Tcl_Interp *interp, int argc, char *argv[])
{
   ARGC_MIN(2)
   {
      return Otcl::setTclError(interp,ARGS_CLASS_CMD_ERR);
   }
   OtclClass *otclc = (OtclClass*)cd;
   return otclc->classMethod(interp,argc,argv);
}

int Otcl::classInterface (Tcl_Interp *interp, int argc, char *argv[])
{
   ARGC_MIN(2)
   {
      return Otcl::setTclError(interp,ARGS_CLASS_INTERFACE_ERR);
   }

   // First argument is the name of the new class (argv[0] is command name)
   int newEntry;
   Tcl_HashEntry *hashEntry = Tcl_CreateHashEntry(&classes,argv[1],&newEntry);
   if (newEntry != 1)
   {
      // Found entry already so must have already interfaced the class!
      return Otcl::setTclError(interp,CLASS_ALREADY_INTERFACED_ERR,argv[1]);
   }

   // Create a new OtclClass object to record the Class interface and later the
   // class internals.
   OtclClassOtcl *otclClass = new OtclClassOtcl(argv[1],this);
   Tcl_SetHashValue(hashEntry,(ClientData)otclClass);

   // Remove the global Otcl commands as we are now about the evaluate
   // the interface commands.
   removeCommandsFromScope(interp);

   int returnCode = otclClass->parseInterface(interp,argc,argv);

   if (returnCode != TCL_OK)
   {
      // Remove the class from the hash table
      Tcl_DeleteHashEntry(hashEntry);
      delete otclClass;
   }

   // Return from evaluating interface so place the global Otcl commands back
   // in scope.
   placeCommandsInScope(interp);

   return returnCode;
}

int Otcl::classImplementation (Tcl_Interp *interp, int argc, char *argv[])
{
   ARGC_MIN(2)
   {
      return Otcl::setTclError(interp,ARGS_CLASS_IMPLEMENTATION_ERR);
   }

   // First argument is the name of the existing class (argv[0] is command nm)
   int newEntry;
   Tcl_HashEntry *hashEntry = Tcl_CreateHashEntry(&classes,argv[1],&newEntry);
   if (newEntry == 1)
   {
      // Couldn't find the entry so couldn't have interfaced the class yet!
      Otcl::setTclResult(interp,CLASS_IMP_BEFORE_INT_ERR,argv[1]);

      // Cleanup the entry that would have been made.
      Tcl_DeleteHashEntry(hashEntry);
      return TCL_ERROR;
   }

   OtclClassOtcl *otclClass = (OtclClassOtcl*)Tcl_GetHashValue(hashEntry);

   // Remove the global Otcl commands as we are now about the evaluate
   // the implementation commands.
   removeCommandsFromScope(interp);

   int returnCode = otclClass->parseImplementation(interp,argc,argv);

   if (returnCode != TCL_OK)
   {
      Tcl_DeleteHashEntry(hashEntry);
      delete otclClass;
   }

   // Return from evaluating implem so place the gloabl Otcl commands back
   // in scope.
   placeCommandsInScope(interp);

   return returnCode;
}

int Otcl::instantiate (Tcl_Interp *interp, int argc, char *argv[])
{
   ARGC_MIN(2)
   {
      return Otcl::setTclError(interp,ARGS_INSTANTIATE_ERR);
   }

   // Look up the class named as the second argument (arg[1]).
   Tcl_HashEntry *hashEntry = Tcl_FindHashEntry(&classes,argv[1]);
   if (hashEntry == NULL)
   {

#ifdef OTCL_DP
      // look to see if it is a remote class
      hashEntry = Tcl_FindHashEntry(&remoteClasses,argv[1]);
      if (hashEntry != NULL)
      {
         OtclRemoteClass *otclrc =(OtclRemoteClass*)Tcl_GetHashValue(hashEntry);
         return otclrc->instantiate(interp,argc-2,(argc > 2 ? &argv[2] : NULL));
      }
#endif

      Otcl::setTclResult(interp,CLASS_UNDEFINED_ERR,argv[1]);
      return TCL_ERROR;
   }
   OtclClass *otclc = (OtclClass*)Tcl_GetHashValue(hashEntry);

   return otclc->instantiate(interp,argc-2,(argc > 2 ? &argv[2] : NULL),
                             objMgr);
}

int Otcl::instantiate (Tcl_Interp *interp, char *className,
                       int argc, char *argv[])
{
   // Look up the class named
   Tcl_HashEntry *hashEntry = Tcl_FindHashEntry(&classes,className);
   if (hashEntry == NULL)
   {
#ifdef OTCL_DP
      // look to see if it is a remote class
      hashEntry = Tcl_FindHashEntry(&remoteClasses,className);
      if (hashEntry != NULL)
      {
         OtclRemoteClass *otclrc =(OtclRemoteClass*)Tcl_GetHashValue(hashEntry);
         return otclrc->instantiate(interp,argc,argv);
      }
#endif
      Otcl::setTclResult(interp,CLASS_UNDEFINED_ERR,className);
      return TCL_ERROR;
   }
   OtclClass *otclc = (OtclClass*)Tcl_GetHashValue(hashEntry);

   return otclc->instantiate(interp,argc,argv,objMgr);
}

int Otcl::discard (Tcl_Interp *interp, int argc, char *argv[])
{
   ARGC_VALUE(2)
   {
      return Otcl::setTclError(interp,ARGS_DISCARD_ERR);
   }

   return discard(interp,argv[1],OTCL_FALSE);
}

int Otcl::discard (Tcl_Interp *interp, char *symRef, int fromCpp)
{
   OtclObject *otclo = objMgr->unManageObject(symRef,interp);
   if (otclo == NULL)
   {

#ifdef OTCL_DP
      // Check to see if it is a remote object
      if (strchr(symRef,'@') != 0)
      {
        // It is a remote object that hasn't been used yet and therefore
        // doesn't have a proxy
        return OtclRemoteObject::discard(interp,symRef);
      }
#endif

      Otcl::setTclResult(interp,UNKNOWN_OBJECT_ERR,symRef);
      return TCL_ERROR;
   }

   // OtclObject::discard also 'deletes' but it allows us to return
   // values...
   return otclo->discard(interp,fromCpp);
}

int Otcl::otcl (Tcl_Interp *interp, int argc, char *argv[])
{
   ARGC_MIN(2)
   {
      return Otcl::setTclError(interp,ARGS_OTCL_ERR);
   }

   if (strcmp(argv[1],"clear") == 0)
   {
      return clear(interp);
   }

#ifdef OTCL_DP
   if (strcmp(argv[1],"oserver") == 0)
   {
      return OtclOserver::oserverCmd(interp,argc,argv);
   }
   if (strcmp(argv[1],"remoteObject") == 0)
   {
      return remoteObject(interp,argc,argv);
   }
   if (strcmp(argv[1],"remoteClass") == 0)
   {
      return remoteClass(interp,argc,argv);
   }
#endif

   return Otcl::setTclError(interp,UNKNOWN_OTCL_COMMAND_ERR,argv[1]);
}

int Otcl::clear (Tcl_Interp *)
{
   // Cleanup all the classes in the Hash Table
   Tcl_HashEntry *entry;
   Tcl_HashSearch search;
   OtclClass *otclc;
   for (entry = Tcl_FirstHashEntry(&classes,&search);
        entry != NULL;
        entry = Tcl_NextHashEntry(&search))
   {
      otclc = (OtclClass*)(Tcl_GetHashValue(entry));

      // Not all OtclClass objects registered are owned by this Otcl object
      // as CPP OtclClasses are registered with all Otcl object in this
      // process.
      if (otclc->shouldDelete())
      {
         delete otclc;
      }
   }

   Tcl_DeleteHashTable(&classes);
   Tcl_InitHashTable(&classes,TCL_STRING_KEYS);

   // Register all of the available Otcl bound C++ classes
   // with this Otcl extension.
   OtclClassCpp::registerWithOtcl(this);

   return TCL_OK;
}

void Otcl::placeCommandsInScope (Tcl_Interp *interp)
{
   Tcl_CreateCommand(interp,CLASS_INTERFACE_CMD,Otcl::classInterfaceCmd,
                     (ClientData)this,(Tcl_CmdDeleteProc*)NULL);

   Tcl_CreateCommand(interp,CLASS_IMPLEMENTATION_CMD,
                     Otcl::classImplementationCmd,
                    (ClientData)this,(Tcl_CmdDeleteProc*)NULL);

   Tcl_CreateCommand(interp,INSTANTIATE_CMD,Otcl::instantiateCmd,
                     (ClientData)this,(Tcl_CmdDeleteProc*)NULL);

   Tcl_CreateCommand(interp,DISCARD_CMD,Otcl::discardCmd,
                     (ClientData)this,(Tcl_CmdDeleteProc*)NULL);

   Tcl_CreateCommand(interp,OTCL_CMD,Otcl::otclCmd,
                     (ClientData)this,(Tcl_CmdDeleteProc*)NULL);

   Tcl_CreateCommand(interp,OTCL_NOP_CMD,Otcl::otclNopCmd,
                     (ClientData)NULL,(Tcl_CmdDeleteProc*)NULL);

}

void Otcl::removeCommandsFromScope (Tcl_Interp *interp)
{
   Tcl_DeleteCommand(interp,CLASS_INTERFACE_CMD);
   Tcl_DeleteCommand(interp,CLASS_IMPLEMENTATION_CMD);
   Tcl_DeleteCommand(interp,INSTANTIATE_CMD);
   Tcl_DeleteCommand(interp,DISCARD_CMD);
   Tcl_DeleteCommand(interp,OTCL_CMD);
   Tcl_DeleteCommand(interp,OTCL_NOP_CMD);
}

void Otcl::registerOtclClassCpp (OtclClassCpp *otclClassCpp)
{
   int newEntry;
   Tcl_HashEntry *hashEntry = Tcl_CreateHashEntry(&classes,
                                               otclClassCpp->giveName(),
                                                  &newEntry);
   if (newEntry != 1)
   {
      fprintf(stderr,"Name clash while registering %s C++ class with Object Tcl.\n",otclClassCpp->giveName());
      exit(1);
   }

   Tcl_SetHashValue(hashEntry,(ClientData)otclClassCpp);

   Tcl_CreateCommand(tclInterp,otclClassCpp->giveName(),Otcl::classCmd,
                     (ClientData)otclClassCpp,(Tcl_CmdDeleteProc*)NULL);
}

// Code taken from Tcl7.3 distribution - funtcion CallTraces in tclVar.c
char *Otcl::callTraces (Interp *iPtr, Var *arrayPtr, Var *varPtr,
                        char *part1, char *part2, int flags)
{
   VarTrace *tracePtr;
   ActiveVarTrace active;
   char *result;

   /*
    * If there are already similar trace procedures active for the
    * variable, don't call them again.
    */

   if (varPtr->flags & VAR_TRACE_ACTIVE)
   {
      return NULL;
   }
   varPtr->flags |= VAR_TRACE_ACTIVE;
   varPtr->refCount++;

   /*
    * Invoke traces on the array containing the variable, if relevant.
    */

   result = NULL;
   active.nextPtr = iPtr->activeTracePtr;
   iPtr->activeTracePtr = &active;
   if (arrayPtr != NULL)
   {
      arrayPtr->refCount++;
      active.varPtr = arrayPtr;
      for (tracePtr = arrayPtr->tracePtr;  tracePtr != NULL;
           tracePtr = active.nextTracePtr)
      {
         active.nextTracePtr = tracePtr->nextPtr;
         if (!(tracePtr->flags & flags))
         {
            continue;
         }
         result = (*tracePtr->traceProc)(tracePtr->clientData,
                    (Tcl_Interp *) iPtr, part1, part2, flags);
         if (result != NULL)
         {
            if (flags & TCL_TRACE_UNSETS)
            {
               result = NULL;
            }
            else
            {
               goto done;
            }
         }
      }
   }

   /*
    * Invoke traces on the variable itself.
    */

   if (flags & TCL_TRACE_UNSETS)
   {
      flags |= TCL_TRACE_DESTROYED;
   }
   active.varPtr = varPtr;
   for (tracePtr = varPtr->tracePtr; tracePtr != NULL;
        tracePtr = active.nextTracePtr)
   {
      active.nextTracePtr = tracePtr->nextPtr;
      if (!(tracePtr->flags & flags))
      {
         continue;
      }
      result = (*tracePtr->traceProc)(tracePtr->clientData,
                (Tcl_Interp *) iPtr, part1, part2, flags);
      if (result != NULL)
      {
         if (flags & TCL_TRACE_UNSETS) {
            result = NULL;
         }
         else
         {
            goto done;
         }
      }
   }

   /*
    * Restore the variable's flags, remove the record of our active
    * traces, and then return.
    */

done:
   if (arrayPtr != NULL)
   {
      arrayPtr->refCount--;
   }
   varPtr->flags &= ~VAR_TRACE_ACTIVE;
   varPtr->refCount--;
   iPtr->activeTracePtr = active.nextPtr;
   return result;
}

// Code Taken from Tcl7.3 distribution DeleteArray function from tclVar.c
void Otcl::deleteArray (Interp *iPtr, char *arrayName, Var *varPtr, int flags)
{
   Tcl_HashSearch search;
   Tcl_HashEntry *hPtr;
   Var *elPtr;
   ActiveVarTrace *activePtr;

   ArraySearch *searchPtr;
   while (varPtr->searchPtr != NULL)
   {
      searchPtr = varPtr->searchPtr;
      varPtr->searchPtr = searchPtr->nextPtr;
      ckfree((char *) searchPtr);
   }

   for (hPtr = Tcl_FirstHashEntry(varPtr->value.tablePtr, &search);
        hPtr != NULL; hPtr = Tcl_NextHashEntry(&search))
   {
      elPtr = (Var *) Tcl_GetHashValue(hPtr);
      if (elPtr->valueSpace != 0)
      {
         /*
          * SPECIAL TRICK:  it's possible that the interpreter's result
          * currently points to this element (for example, a "set" or
          * "lappend" command was the last command in a procedure that's
          * being returned from).  If this is the case, then just pass
          * ownership of the value string to the Tcl interpreter.
          */

         if (iPtr->result == elPtr->value.string)
         {
            iPtr->freeProc = (Tcl_FreeProc *) free;
         }
         else
         {
            ckfree(elPtr->value.string);
         }
         elPtr->valueSpace = 0;
      }
      elPtr->hPtr = NULL;
      if (elPtr->tracePtr != NULL)
      {
         elPtr->flags &= ~VAR_TRACE_ACTIVE;
         (void) Otcl::callTraces(iPtr,(Var *) NULL, elPtr, arrayName,
                    Tcl_GetHashKey(varPtr->value.tablePtr, hPtr), flags);
         while (elPtr->tracePtr != NULL)
         {
            VarTrace *tracePtr = elPtr->tracePtr;
            elPtr->tracePtr = tracePtr->nextPtr;
            ckfree((char *) tracePtr);
         }
         for (activePtr = iPtr->activeTracePtr; activePtr != NULL;
              activePtr = activePtr->nextPtr)
         {
            if (activePtr->varPtr == elPtr)
            {
               activePtr->nextTracePtr = NULL;
            }
         }
      }
      elPtr->flags = VAR_UNDEFINED;
      if (elPtr->refCount == 0)
      {
         ckfree((char *) elPtr);
      }
   }
   Tcl_DeleteHashTable(varPtr->value.tablePtr);
   ckfree((char *) varPtr->value.tablePtr);
}

OtclClass *Otcl::giveOtclClass (char *name)
{
   Tcl_HashEntry *hashEntry = Tcl_FindHashEntry(&classes,name);
   if (hashEntry != NULL)
   {
      return (OtclClass*)Tcl_GetHashValue(hashEntry);
   }
   return NULL;
}

void *Otcl::obrefToCpp (char *obref, char *cppClassName)
{
   int returnCode;
   OtclObject *otclObject = objMgr->dereference(obref,tclInterp,returnCode);
   if (otclObject)
   {
      return otclObject->toCpp(cppClassName);
   }
   else if (returnCode == TCL_OK)
   {
      return NULL;
   }
   else
   {
      return this;
   }
}

#if 0
static void
InterpDelete (ClientData clientData,
              Tcl_Interp *interp)
{
    Otcl *obj = (Otcl *) clientData;
    delete obj;
}
#endif

int
Otcl_Init (Tcl_Interp *interp)
{
    int result;
    Otcl *obj = new Otcl(interp, result, new OtclObjMgrCmd);
#if 0
    Tcl_CallWhenDeleted (interp, InterpDelete, (ClientData) obj);
#endif
    return result;
}

OtclObject *Otcl::createObjectWrapper (OtclPart *part)
{
   OtclObject *otclo = new OtclObject();
   char *symbolicRef = otclPtr->objMgr->manageObject(otclo,tclInterp);
   if (symbolicRef == NULL)
   {
      delete otclo;
      return NULL;
   }

   otclo->setSelf(symbolicRef);

   otclo->setPart(part);

   return otclo;
}

void Otcl::setObjectReferenceSuffix (char *suffix)
{
   objMgr->setObjectReferenceSuffix(suffix);
}

OtclObject *Otcl::giveOtclObject (char *symRef, Tcl_Interp *interp,
                                  int &returnCode)
{
   return objMgr->dereference(symRef,interp,returnCode);
}

#ifdef OTCL_DP

int Otcl::remoteObject (Tcl_Interp *interp, int argc, char *argv[])
{
   ARGC_VALUE(3)
   {
      return Otcl::setTclError(interp,ARGS_REMOTE_OBJECT_ERR);
   }

   int result;
   OtclRemoteObject *otclo = new OtclRemoteObject(argv[2],result,interp);
   if (result != TCL_OK)
   {
      delete otclo;
      return TCL_ERROR;
   }
   if (!objMgr->manageObject(otclo,argv[2],interp))
   {
      Otcl::setTclResult(interp,COULDNT_MANAGE_OBJECT_ERR,"remote object");
      delete otclo;
      return TCL_ERROR;
   }
   return TCL_OK;
}

int Otcl::remoteClass (Tcl_Interp *interp, int argc, char *argv[])
{
   ARGC_RANGE(4,5)
   {
      return Otcl::setTclError(interp,ARGS_REMOTE_CLASS_ERR);
   }

   char *realName = argv[2];
   if (argc == 5)
   {
      realName = argv[4];
   }

   // Check we don't have it as an internal class
   Tcl_HashEntry *hashEntry = Tcl_FindHashEntry(&classes,argv[2]);
   if (hashEntry != NULL)
   {
      return Otcl::setTclError(interp,REMOTE_CLASS_INTERNAL_CLASS_CLASH_ERR,
                               argv[2]);
   }

   // Check to see if we have it as a remote class
   int newEntry;
   hashEntry = Tcl_CreateHashEntry(&remoteClasses,argv[2],&newEntry);
   if (newEntry == 1)
   {
      Tcl_SetHashValue(hashEntry,new OtclRemoteClass(interp,realName,argv[3]));
   }
   else
   {
      // Change the server for this remote class
      OtclRemoteClass *otclrc = (OtclRemoteClass*)Tcl_GetHashValue(hashEntry);
      otclrc->setAddress(argv[3],realName);
   }

   return TCL_OK;
}

#endif