#include <string.h>
#include <assert.h>

#include "../shared/TclUtil.h"

#include "TclNamedReference.h"


/////////////////////////////////////////////////////////////////////
// Build the TCL value type
/////////////////////////////////////////////////////////////////////

static Tcl_ObjType tclNamedReferenceObjectType;

inline bool isOurType(Tcl_Obj *objPtr)
{
  return objPtr->typePtr == &tclNamedReferenceObjectType;
}
 
// This points to the NamedReference or where the NamedReference should go.
// The caller must verify that this object is of the right type.  Use
// extractNamedReference() is you are not certain what's in the objPtr.
inline NamedReference *&getNamedReference(Tcl_Obj *objPtr)
{
  assert(isOurType(objPtr));
  return (NamedReference *&)objPtr->internalRep.otherValuePtr;
}

static int setFromAnyProc(Tcl_Interp *interp, Tcl_Obj *objPtr)
{
  const std::string name = getString(objPtr);
  NamedReference ref = NamedReference::find(name);
  if (!ref)
  { // Not found.
    if (interp)
    // Record error message.
      Tcl_SetObjResult(interp, makeTclString("Can't find object:  " + name));
    return TCL_ERROR;    
  }
  // Found the C++ object.
  if (Tcl_ObjType const *oldType = objPtr->typePtr)
  { // There is a previous object representation.
    if (!objPtr->bytes)
      // There is no string representation.  Create one from the previous
      // object representation.
      oldType->updateStringProc(objPtr);
    // Remove the old object representation.
    oldType->freeIntRepProc(objPtr);
  }
  // Add the new object representation.
  objPtr->typePtr = &tclNamedReferenceObjectType;
  getNamedReference(objPtr) = new NamedReference(ref);
  return TCL_OK;
}

static void updateStringProc(Tcl_Obj *objPtr)
{
  assert(!objPtr->bytes);
  assert(isOurType(objPtr));
  const std::string name = getNamedReference(objPtr)->getName();
  // Be sure to copy the terminating null.  Hence the +1.
  objPtr->bytes = Tcl_Alloc(name.length() + 1);
  memcpy(objPtr->bytes, name.c_str(), name.length() + 1);
  objPtr->length = name.length();
}

static void dupInternalRepProc(Tcl_Obj *srcPtr, Tcl_Obj *dupPtr)
{
  //std::cout<<"Calling dupInternalRepProc in TclNamedReference.C";
  //if (srcPtr->bytes)
  //  std::cout<<" on "<<srcPtr->bytes;
  //std::cout<<std::endl;

  // Interesting.  TCL never actually called dupInternalRepProc() until I added
  // ti::template to common.tcl  The following code will cause TCL to call
  // dupInternalRepProc():
  //   set channel [ti::get_current_channel]
  //   ti::template {ti::reply_to_client <<<$channel>>> }
  // I'm not exactly sure why this happens.  It seems to be a combination of
  // list, expr, and uplevel.  Removing any one of those was enough to stop
  // calling dupInternalRepProc().
  
  assert(isOurType(srcPtr));
  assert(!dupPtr->typePtr);
  dupPtr->typePtr = &tclNamedReferenceObjectType;
  getNamedReference(dupPtr) = new NamedReference(*getNamedReference(srcPtr));
}

static void freeInternalRepProc(Tcl_Obj *objPtr)
{
  assert(isOurType(objPtr));
  delete getNamedReference(objPtr);
}

class InitTclNamedReference
{
public:
  InitTclNamedReference()
  {
    tclNamedReferenceObjectType.name = "TclNamedReference";
    tclNamedReferenceObjectType.freeIntRepProc = freeInternalRepProc;
    tclNamedReferenceObjectType.dupIntRepProc = dupInternalRepProc;
    tclNamedReferenceObjectType.updateStringProc = updateStringProc;
    tclNamedReferenceObjectType.setFromAnyProc = setFromAnyProc;
  }
};

static InitTclNamedReference init;


/////////////////////////////////////////////////////////////////////
// debug commands
/////////////////////////////////////////////////////////////////////

static int getAllNamesCmd(ClientData clientData,
			  Tcl_Interp *interp,
			  int objc,
			  Tcl_Obj *const objv[])
{
  if (objc != 1)
  {
    Tcl_WrongNumArgs(interp, 1, objv, "");
    return TCL_ERROR;
  }
  Tcl_SetObjResult(interp, convertToTcl(NamedReference::getAllNames()));
  return TCL_OK;
}

static int getCountCmd(ClientData clientData,
		       Tcl_Interp *interp,
		       int objc,
		       Tcl_Obj *const objv[])
{
  if (objc != 1)
  {
    Tcl_WrongNumArgs(interp, 1, objv, "");
    return TCL_ERROR;
  }
  Tcl_SetObjResult(interp, convertToTcl(NamedReference::getObjectCount()));
  return TCL_OK;
}


/////////////////////////////////////////////////////////////////////
// Functions exported to the main program.
/////////////////////////////////////////////////////////////////////

Tcl_Obj *createTclObject(NamedReference const &ref)
{
  Tcl_Obj *result = Tcl_NewObj();
  assert(!result->typePtr);
  result->typePtr = &tclNamedReferenceObjectType;
  getNamedReference(result) = new NamedReference(ref);
  Tcl_InvalidateStringRep(result);
  return result;
}

NamedReference extractNamedReference(Tcl_Obj* obj, Tcl_Interp *interp)
{
  if (!isOurType(obj))
    // Convert to the correct type.  I.e. look up the name to find a pointer to
    // the actual.
    setFromAnyProc(interp, obj);
  if (isOurType(obj))
    return *getNamedReference(obj);
  else
    // Conversion / lookup failed.
    return NamedReference();
}

void reportNotApplicableError(Tcl_Interp *interp,
			      NamedReference const &namedReference,
			      std::string const &expecting)
{
  std::string msg = "Not applicable to objects of this type:  "
    + namedReference.as< HasNamedReference >()->getTypeName()
    + ".  Expecting:  " + expecting + '.';
  Tcl_SetObjResult(interp, makeTclString(msg));
}

void installNamedReferenceDebugCommands(Tcl_Interp *interp)
{
  Tcl_CreateObjCommand(interp, "ti::get_all_named_references", getAllNamesCmd,
                       NULL, NULL);
  Tcl_CreateObjCommand(interp, "ti::get_named_reference_count", getCountCmd,
                       NULL, NULL);
}