/*
 * genobject.c --
 *
 *	This file implements the routines that maintain the
 *	GenObject Tcl object type.
 *
 * Copyright (c) 2000-2003 JYL Software, Inc.
 *
 * Permission is hereby granted, free of charge, to any person obtaining
 * a copy of this software and associated documentation files (the
 * "Software"), to deal in the Software without restriction, including
 * without limitation the rights to use, copy, modify, merge, publish,
 * distribute, sublicense, and/or sell copies of the Software, and to
 * permit persons to whom the Software is furnished to do so, subject to
 * the following conditions:
 * 
 * The above copyright notice and this permission notice shall be
 * included in all copies or substantial portions of the Software.
 * 
 * THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,
 * EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF
 * MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND
 * NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE
 * LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION
 * OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION
 * WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE, EVEN IF
 * JYL SOFTWARE INC. IS MADE AWARE OF THE POSSIBILITY OF SUCH DAMAGE.
 */

#include "genobject.h"
#include "genintrep.h"

/*
 * Functions for the GenObj Tcl object type:
 */

static void	DupGenObject	_ANSI_ARGS_((Tcl_Obj *srcPtr,
					     Tcl_Obj *destPtr));
static void	FreeGenObject	_ANSI_ARGS_((Tcl_Obj *objPtr));
static int	SetGenObject	_ANSI_ARGS_((Tcl_Interp *interp,
					     Tcl_Obj *objPtr));
static void	UpdateGenObject	_ANSI_ARGS_((Tcl_Obj *objPtr));

/*
 * Initialize the GenObject Tcl object type.
 */

static void	InitGenObjectType _ANSI_ARGS_(());

/*
 * These procedures are for the interposition on the cmdName Tcl 
 * object type:
 */

static void	DupGenCmd	_ANSI_ARGS_((Tcl_Obj *srcPtr,
					     Tcl_Obj *destPtr));
static void	FreeGenCmd	_ANSI_ARGS_((Tcl_Obj *objPtr));
static int	SetGenCmdFrmAny	_ANSI_ARGS_((Tcl_Interp *interp,
					     Tcl_Obj *objPtr));

/*
 * The GenObject Tcl object type:
 */

static Tcl_ObjType GenObjectType = {
    "GenObject",
    FreeGenObject,		/* Release a GenObject object. */
    DupGenObject,		/* Copies a GenObject objct into an
				 * existing Tcl object of arbitrary
				 * type. */
    UpdateGenObject,		/* Retrieve the string representation of
				 * a GenObject object. */
    SetGenObject		/* Change the value of an existing GenObject
				 * object. */
};

/*
 * Save the old CmdType information for the interposition.
o */

static Tcl_ObjType oldCmdType;
static Tcl_ObjType *cmdTypePtr = NULL;
static int cmdTypeInterposed = 0;

/*
 *----------------------------------------------------------------------
 *
 * Genobj_Init --
 *
 *	This procedure initializes the GenObject package in an interpreter.
 *
 * Results:
 *	A standard Tcl result.
 *
 * Side effects:
 *	None.
 *
 *----------------------------------------------------------------------
 */

GENOBJ_DLL int
Genobj_Init(Tcl_Interp *interp)
{
    InitGenObjectType();
    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *
 * Genobj_SafeInit --
 *
 *	This procedure initializes the GenObject package in a
 *	safe interpreter.
 *
 * Results:
 *	A standard Tcl result.
 *
 * Side effects:
 *	None.
 *
 *----------------------------------------------------------------------
 */

GENOBJ_DLL int
Genobj_SafeInit(Tcl_Interp *interp)
{
    InitGenObjectType();
    return TCL_OK;
}

/*
 *---------------------------------------------------------------------------
 *
 * GO_GetInternalRep --
 *
 *	Retrieves the internal representation associated with this
 *	Tcl_Obj *. Checks if the GO object is of the supplied extension
 *	and returns NULL otherwise.
 *
 * Results:
 *	The associated internal representation or NULL.
 *
 * Side effects:
 *	None.
 *
 *---------------------------------------------------------------------------
 */

void *
GO_GetInternalRep(Tcl_Obj *objPtr, GO_Extension *extPtr)
{
    GO_InternalRep *ptr2;

    if ((objPtr->typePtr != &GenObjectType) && 
	(objPtr->typePtr != cmdTypePtr)) {
	return NULL;
    }
    ptr2 = (GO_InternalRep *) objPtr->internalRep.twoPtrValue.ptr2;
    if (ptr2->extension != extPtr) {
	return NULL;
    }
    return ptr2->data;
}

/*
 *---------------------------------------------------------------------------
 *
 * GO_GetUncheckedInternalRep --
 *
 *	Retrieves the internal representation associated with this
 *	Tcl_Obj *. Does not check whether the internal representation
 *	is of any specific GO_Extension.
 *
 * Results:
 *	The associated internal representation or NULL.
 *
 * Side effects:
 *	None.
 *
 *---------------------------------------------------------------------------
 */

void *
GO_GetUncheckedInternalRep(Tcl_Obj *objPtr)
{
    GO_InternalRep *ptr2;

    if ((objPtr->typePtr != &GenObjectType) && 
	(objPtr->typePtr != cmdTypePtr)) {
	return NULL;
    }
    ptr2 = (GO_InternalRep *) objPtr->internalRep.twoPtrValue.ptr2;
    return ptr2->data;
}

/*
 *----------------------------------------------------------------------
 *
 * GO_MakeGenObject --
 *
 *	Makes a Tcl_Obj whose type is the GenObject Tcl object type and
 *	whose private data is the data passed in.
 *
 *	Extensions using GenObject should ony call this to create new
 *	instances. Extensions should not attempt to create GenObject
 *	instances themselves by manually putting them together.
 *
 * Results:
 *	A new Tcl_Obj with the right type and internal representation.
 *
 * Side effects:
 *	Creates a new Tcl_Obj instance.
 */

GENOBJ_DLL Tcl_Obj *
GO_MakeGenObject(GO_Extension *extPtr, void *data, Tcl_Interp *interp)
{
    GO_InternalRep *ptr2 = NewGenObjectInternalRep(extPtr, interp, data);
    Tcl_Obj *objPtr = Tcl_NewObj();

    /*
     * Initialize it has an invalid string representation.
     */

    objPtr->bytes = NULL;
    objPtr->length = 0;

    /*
     * Attach the type representation.
     */

    objPtr->typePtr = &GenObjectType;

    /*
     * Store the internal representation in the ptr2 field, a convention
     * that makes it possible to distinguish "our" objects when they're
     * converted to/from GenObject Tcl objects and preserve the internal
     * representation.
     */

    objPtr->internalRep.twoPtrValue.ptr2 = (VOID *) ptr2;

    /*
     * Ensure the internal representation is propertly refcounted.
     */

    GenObjectIncrRefcount(ptr2);

    /*
     * Update the string representation.
     */

    UpdateGenObject(objPtr);

    /*
     * Make the Tcl command corresponding to this GenObject instance.
     */

    GenObjectMakeTclCommand(ptr2);

    /*
     * Finally return the new Tcl_Obj object.
     */

    return objPtr;
}

/*
 *----------------------------------------------------------------------
 *
 * InitGenObjectType --
 *
 *	Initializes (registers) the GenObject Tcl object type and sets up
 *	the interposition on the CmdType Tcl object type so that GenObject
 *	objects will be preserved when an object is converted to a command.
 *
 * Results:
 *	None.
 *
 * Side effecs:
 *	Registers the GenObject Tcl object type and hijacks the CmdName
 *	Tcl object type.
 *
 *----------------------------------------------------------------------
 */

static void
InitGenObjectType()
{
    /*
     * Prevent this routine from doing the work multiple times.
     */

    if (cmdTypeInterposed) {
	return;
    }
    cmdTypeInterposed = 1;

    /*
     * Register our type.
     */

    Tcl_RegisterObjType(&GenObjectType);

    /*
     * Save the current CmdType object type and insert our own to interpose
     * on it so that GenObject objects are preserved when they're converted
     * to commands (i.e. when they're used as command names).
     *
     * The second assignment line below copies the current contents of the
     * cmdType object type into the save area.
     */

    cmdTypePtr = Tcl_GetObjType("cmdName");
    oldCmdType = *cmdTypePtr;

    /*
     * Update the cmdName object type in-place with our functionality.
     */

    cmdTypePtr->freeIntRepProc = FreeGenCmd;
    cmdTypePtr->dupIntRepProc =  DupGenCmd;
    cmdTypePtr->setFromAnyProc = SetGenCmdFrmAny;

    /*
     * At this point, the hijack is complete. Now any conversions from/to
     * cmdName objects will route through our functionality.
     */
}

/*
 *----------------------------------------------------------------------
 *
 * DupGenObject --
 *
 *	Copies a GenObject object into another object.
 *
 * Results:
 *	None.
 *
 * Side effects:
 *	Increments the refcount for the GenObject object's internal
 *	representation and smashes the other object's internal rep.
 */

static void
DupGenObject(Tcl_Obj *srcPtr, Tcl_Obj *destPtr)
{
    GO_InternalRep *ptr2 =
	(GO_InternalRep *) srcPtr->internalRep.twoPtrValue.ptr2;

    if (ptr2 == NULL) {
	Tcl_Panic("INTERNAL ERROR: Null ptr2");
    }
    GenObjectIncrRefcount(ptr2);
    destPtr->typePtr = srcPtr->typePtr;
    destPtr->internalRep.twoPtrValue.ptr2 = (VOID *) ptr2;
}

/*
 *----------------------------------------------------------------------
 *
 * FreeGenObject --
 *
 *	Frees the GenObject object and if it is the last reference for the
 *	shared internal representation, the internal representation is also
 *	freed.
 *
 * Results:
 *	None.
 *
 * Side effects:
 *	The Tcl_Obj passed in no longer is a valid reference to the
 *	internal representation.
 *
 *----------------------------------------------------------------------
 */

static void
FreeGenObject(Tcl_Obj *objPtr)
{
    GO_InternalRep *ptr2 =
	(GO_InternalRep *) objPtr->internalRep.twoPtrValue.ptr2;

    /*
     * Decrement the reference count on the internal representation.
     */

    GenObjectDecrRefcount(ptr2);
}

/*
 *----------------------------------------------------------------------
 *
 * SetGenObject --
 *
 *	No conversion of other objects to GenObject objects is possible,
 *	so this function always returns a TCL error.
 *
 * Results:
 *	Always returns TCL_ERROR.
 *
 * Side effects:
 *	None.
 *
 *----------------------------------------------------------------------
 */

static int
SetGenObject(Tcl_Interp *interp, Tcl_Obj *objPtr)
{
    /*
     * If an interpreter was given, leave an error message.
     */

    if (interp != NULL) {
	Tcl_ResetResult(interp);
	Tcl_SetStringObj(Tcl_GetObjResult(interp),
			 "cannot convert to GenObject", -1);
    }
    return TCL_ERROR;
}

/*
 *----------------------------------------------------------------------
 *
 * UpdateGenObject --
 *
 *	Update the string representation of a GenObject Tcl object.
 *
 * Results:
 *	None.
 *
 * Side effects:
 *	Updates the string representation of the given Tcl_Obj object.
 *
 *----------------------------------------------------------------------
 */

static void
UpdateGenObject(Tcl_Obj *objPtr)
{
    char *buf;
    GO_InternalRep *ptr2;

    /*
     * Get the internal representation of the GenObject object.
     */

    ptr2 = (GO_InternalRep *) objPtr->internalRep.twoPtrValue.ptr2;

    /*
     * Check that the namelen field of the extension is initialized.
     * If not, auto-initialize it to the length of the name field.
     */

    if (ptr2->extension->namelen == -1) {
	ptr2->extension->namelen = strlen(ptr2->extension->name);
    }

    /*
     * We allocate the buffer here. It will be freed when the string
     * representation changes or the object is deleted.
     */

    buf = (char *) Tcl_Alloc((unsigned) 
			     (ptr2->extension->namelen + 32) * sizeof(char));
    sprintf(buf, "%s0x%x", ptr2->extension->name, objPtr);

    /*
     * Update the string representation:
     */

    objPtr->bytes = buf;
    objPtr->length = strlen(buf);

    /*
     * Store the name of this object in the internal representation also,
     * as a convenience for debugging, etc.
     */

    ptr2->name = buf;
}

/*
 *----------------------------------------------------------------------
 *
 * DupGenCmd --
 *
 *	Initializes the internal representation of a cmdName object so
 *	that it preserves the internal representation of a GenObject
 *	object.
 *
 * Results:
 *	None.
 *
 * Side effects:
 *	The internal representation of dupPtr is set to a GenObject
 *	object corresponding to srcPtr's internal representation and
 *	the refcount on the internal representation is incremented.
 *
 *----------------------------------------------------------------------
 */

static void
DupGenCmd(Tcl_Obj *srcPtr, Tcl_Obj *destPtr)
{
    VOID *ptr2 = srcPtr->internalRep.twoPtrValue.ptr2;

    /*
     * Copy the standard parts of the dupPtr to the destPtr:
     */

    (oldCmdType.dupIntRepProc) (srcPtr, destPtr);

    /*
     * If it is a GenObject object (assumed by having a non-NULL ptr2
     * value) then duplicate it.
     */

    if (ptr2 != NULL) {
        DupGenObject(srcPtr, destPtr);
    }
}

/*
 *----------------------------------------------------------------------
 *
 * FreeGenCmd --
 *
 *	Frees the internal representation for the GenObject object.
 *
 * Results:
 *	None.
 *
 * Side effects:
 *	Decrements the refcount and frees the internal representation
 *	if this is the last reference.
 *
 *----------------------------------------------------------------------
 */

static void
FreeGenCmd(Tcl_Obj *objPtr)
{
    /*
     * If the ptr2 field is set it must be a GenObject object so we
     * can use the GenObject object API to decrement its reference count:
     */
    
    if (objPtr->internalRep.twoPtrValue.ptr2 != NULL) {
        FreeGenObject(objPtr);
    }

    /*
     * Call the old command type freeIntRepProc.
     */

    (oldCmdType.freeIntRepProc)(objPtr);
}

/*
 *----------------------------------------------------------------------
 *
 * SetGenCmdFrmAny --
 *
 *	Attempts to generate a command object from an arbitrary type.
 *	This routine wraps around the standard cmdName setFromAny
 *	procedure. If the old type was a GenObject it copies the handle
 *	into the cmdName typed object so that it can be restored later.
 *	This way the internal representation is not lost when the object
 *	is converted to a cmdName (when a GenObject is used as a command).
 *
 * Results:
 *	The return value is a standard Tcl result. If an error occurs
 *	during the conversion, an error message is left in the interpreter
 *	result if the given interpreter is non-NULL.
 *
 * Side effects:
 *	If no error occurs, a GenObject object internal representation may
 *	be stored as objPtr's internal representation and the object's
 *	reference count may be incremented.
 *
 *----------------------------------------------------------------------
 */

static int
SetGenCmdFrmAny(Tcl_Interp *interp, Tcl_Obj *objPtr)
{
    int result;
    GO_InternalRep *ptr2;

#ifdef	DEBUG
    if (interp == NULL) {
	Tcl_Panic("SetGenCmdFrmAny 0x%x called with NULL interp\n",
		  objPtr);
    }
#endif

    if (objPtr->typePtr == &GenObjectType) {

	/*
	 * This is a GenObject object. Save ptr2 while doing the conversion
	 * so that it can be restored afterwards once the object has been
	 * converted to a cmdName.
	 *
	 * This case occurs in the following code:
	 *
	 * set x [someCmdCreatingaGenObject]
	 * $x arg1 arg2
	 */

	/*
	 * First of all update the string representation.
	 */

	if (objPtr->bytes == NULL) {
	    UpdateGenObject(objPtr);
	}
		
	/*
	 * Save the GenObject internal representation.
	 */

	ptr2 = (GO_InternalRep *) objPtr->internalRep.twoPtrValue.ptr2;

	/*
	 * Check if the object migrated out of its creating interpreter.
	 * If it is from another interpreter, then we convert it to a
	 * regular cmdName and lose the internal representation (shame).
	 */

	if (ptr2->interp != interp) {
	    result = (oldCmdType.setFromAnyProc) (interp, objPtr);
	    if (result == TCL_OK) {
		objPtr->internalRep.twoPtrValue.ptr2 = NULL;
	    }
	    return result;
	}

	/*
	 * It's from this interpreter, so preserve the internal representation.
	 */

	GenObjectIncrRefcount(ptr2);
	objPtr->typePtr = NULL;
	result = (oldCmdType.setFromAnyProc)(interp, objPtr);
	if (result == TCL_OK) {
	    objPtr->internalRep.twoPtrValue.ptr2 = (VOID *) ptr2;
	    GenObjectDecrRefcount(ptr2);
	}
    } else if ((objPtr->typePtr == cmdTypePtr) &&
	       (objPtr->internalRep.twoPtrValue.ptr2 != NULL)) {

        /*
         * The object is a command and has a non-NULL ptr2 value. We assume
         * it is one of our GenObject commands. This case occurs when the
	 * command is used in a namespace where it does not yet appear in
	 * the name cache.
         *
         * We increment the refcount for the GenObject object and hold onto it
         * because the conversion is going to decrement the refcount. Then
         * after the conversion we stick the GenObject object back in ptr2 so
         * that the command can find the object to operate on.
         */

	ptr2 = (GO_InternalRep *) objPtr->internalRep.twoPtrValue.ptr2;

	/*
	 * Check if the object migrated out of its interpreter. If it is
	 * from a different interpreter, then we convert it to a regular
	 * cmdName and lose the internal representation (shame).
	 */

	if (ptr2->interp != interp) {
	    result = (oldCmdType.setFromAnyProc) (interp, objPtr);
	    if (result == TCL_OK) {
		objPtr->internalRep.twoPtrValue.ptr2 = NULL;
	    }
	    return result;
	}

	/*
	 * It's from our interpreter, so preserve the internal representation.
	 */
	
	GenObjectIncrRefcount(ptr2);
	result = (oldCmdType.setFromAnyProc) (ptr2->interp, objPtr);
	if (result == TCL_OK) {
	    objPtr->internalRep.twoPtrValue.ptr2 = (VOID *) ptr2;

	    /*
	     * NOTE:
	     * -----
	     *
	     * DO NOT call GenObjectDecrRefcount(ptr2) because the
	     * above setFromAnyProc call already did so.
	     *
	     * If the result is not TCL_OK then this object is messed up.
	     * Should we call GenObjectDecrRefcount(ptr2) in that case?
	     */
	}
    } else {

	/*
	 * It is some other type. Convert it to a cmdName and ensure that
	 * ptr2 is NULL so we do not assume it is a GenObject object.
	 */

	result = (oldCmdType.setFromAnyProc) (interp, objPtr);
	if (result == TCL_OK) {
	    objPtr->internalRep.twoPtrValue.ptr2 = NULL;
	}
    }

    return result;
}


	    
