/*
 * hv3see.c --
 *
 *     This file contains C-code that contributes to the Javascript based
 *     scripting environment in the Hv3 web browser. It assumes the
 *     availability of SEE (Simple EcmaScript Interpreter) and the Boehm
 *     C/C++ garbage collecting memory allocator.
 *
 *     SEE:      http://www.adaptive-enterprises.com.au/~d/software/see/
 *     Boehm GC: http://www.hpl.hp.com/personal/Hans_Boehm/gc/
 *
 *     Although it may be still be used for other purposes, the design
 *     of this extension is heavily influenced by the requirements of Hv3.
 *     It is not a generic javascript interpreter interface for Tcl.
 *
 * TODO: Copyright.
 */

/*-------------------------------------------------------------------------- 
 *                         Interpreter Interface
 *
 * ::see::interp
 *     Create a new SEE interpreter and return it's name (which may
 *     then be used as a Tcl command). Interpreter command names are
 *     always generated by this code, they can be renamed if required. 
 *
 *
 * $interp destroy
 *     Delete an interpreter and all associated resources. The command
 *     $interp is deleted by this command.
 *
 * $interp global TCL-OBJECT
 *     Install the javascript wrapper of TCL-OBJECT as the global
 *     interpreter object. In web-browsers this is the Window object.
 *
 * $interp eval ?-file FILENAME? JAVASCRIPT
 *     Evaluate the supplied javascript using SEE_Global_eval().
 *
 * $interp tostring OBJ
 *     Return the string form of a javascript object.
 *
 * $interp debug objects
 *     Return a list of Tcl commands this interpreter is holding
 *     as persistent-state objects.
 */

/*------------------------------------------------------------------------
 *                         Javascript values:
 *
 *     undefined
 *     null
 *     boolean    BOOL
 *     number     NUMBER
 *     string     STRING
 *     object     COMMAND
 *     transient  COMMAND
 *
 */

/*-------------------------------------------------------------------------- 
 *                      Tcl-based Javascript Objects
 *
 * As well as running javascript code, the Tcl application must provide
 * implementations of DOM objects to the javascript interpreter. Objects
 * are provided by one of two methods:
 *
 *     1) Explicitly, by calling the [$interp global] command.
 *
 *     2) By returning a value of the form {object OBJ} or {transient OBJ}
 *        from a [Call], [Construct] or [Get] invocation on another object
 *        (see below).
 *
 * In either case, the Tcl application provides the interpreter with a
 * command that supports the following interface:
 *
 *         $obj Call         THIS ?ARG-VALUE...?
 *         $obj CanPut       PROPERTY
 *         $obj Construct    ?ARG-VALUE...?
 *         $obj DefaultValue
 *         $obj Delete       PROPERTY
 *         $obj Enumerator
 *         $obj Get          PROPERTY
 *         $obj HasProperty  PROPERTY
 *         $obj Put          PROPERTY ARG-VALUE
 *         $obj Finalize
 *
 * Argument PROPERTY is a simple property name (i.e. "className"). 
 * VALUE is a typed javascript value. 
 *
 * Object resource management:
 *
 *     There are no resource management issues on the global object.
 *     The script must ensure that the specified command exists for the
 *     lifetime of the interpreter. The [Finalize] method is never
 *     called by the extension on the global object (not even when the
 *     interpreter is destroyed).
 *
 *     For all other objects, once the object is passed to javascript,
 *     javascript is in charge of deleting the object. The Tcl script
 *     must ensure that the command is valid until the javascript side
 *     calls the [Finalize] method. Of course, the command may become
 *     a no-op - that's a DOM detail....
 *
 *     An object is created by returning a value of one of the following 
 *     two forms from a [Call], [Construct] or [Get] method.
 *
 *         {object    COMMAND}
 *         {transient COMMAND}
 *
 *     Both forms create the same kinds of javascript object, but 
 *     the first initialises the object in "persistent" state
 *     the second in "transient" state. Objects in "transient" state
 *     are eligible for garbage collection once the SEE interpreter
 *     state contains no more references to it. Objects in "persistent"
 *     state are not garbage collected until the interpreter is deleted.
 *
 *     When an object in "transient" state is garbage collected,
 *     the [Finalize] method is invoked. After the interpreter is 
 *     deleted, [Finalize] will be (eventually) called for all 
 *     objects in "persistent" state.
 *
 *     The Tcl script may move an object from "persistent" to 
 *     "transient" state using the following command:
 *
 *         $interp make_transient COMMAND
 *
 *     And back again with
 *
 *         $interp make_peristent COMMAND
 *
 *     Command [set_state transient] may be called on any object in
 *     persistent state. But [set_state persistent] may be called only
 *     on objects passed from javascript to Tcl as command arguments.
 *     Calling [set_state persistent] on any other object throws
 *     a Tcl exception.
 */


#include <tcl.h>
#include <see/see.h>

#ifdef NO_HAVE_GC
    /* If the symbol NO_HAVE_GC is defined, have SEE use regular malloc() 
     * instead of a garbage-collecting version. Of course, it leaks a
     * lot of memory when compiled this way.
     */
    #define GC_MALLOC_UNCOLLECTABLE(x) ckalloc(x)
    #define GC_FREE(x) ckfree((char *)x)
    #define GC_register_finalizer(a,b,c,d,e)
    #define GC_register_finalizer_no_order(a,b,c,d,e)
#else
    #include <gc.h>
#endif

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

/* Just plain handy, these guys. */
#define MAX(x,y) ((x) > (y) ? (x) : (y))
#define MIN(x,y) ((x) < (y) ? (x) : (y))

/* File hv3format.c contains the code to uniformly indent javascript
 * text. This is used to make stuff in the debugger more readable, it
 * is not essential (and adds a fair overhead too).
 */
#include "hv3format.c"

#include "hv3bridge.c"

typedef struct SeeTclObject SeeTclObject;
typedef struct SeeTclClass SeeTclClass;

typedef struct SeeInterp SeeInterp;
typedef struct SeeJsObject SeeJsObject;
typedef struct SeeTimeout SeeTimeout;

typedef struct NodeHack NodeHack;
struct NodeHack {
  SeeTclObject *pObj;
  NodeHack *pParent;             /* Parent of this node */
  int iNode;                     /* Node index */
};

/* Size of hash-table. This should be replaced with a dynamic hash 
 * table structure. 
 */
#define OBJECT_HASH_SIZE 257

typedef struct EventType EventType;

/* Each javascript object created by the Tcl-side is represented by
 * an instance of the following struct.
 */
struct SeeTclObject {
    struct SEE_object object;     /* C Base class - Object */
    struct SEE_native *pNative;   /* Store native properties here */
    Tcl_Obj *pObj;                /* Tcl script for object */

    /* Used by the events sub-system (hv3events.c) */
    EventType *pTypeList;
    NodeHack *nodehandle;        /* Non-zero if this is a "node" object */

    /* Used by the timer sub-system (hv3timeout.c). This pointer is only
     * ever used for objects of type Window, but space is allocated for
     * every single object. This seems a bit wasteful, but it's not our
     * biggest problem right now.
     */
    SeeTimeout *pTimeout;

    SeeTclClass *pClass;

    /* The data stored in these variables is based on the data in pObj. 
     * See the allocWordArray() function for details. The idea is that
     * we break the list in pObj into an array of words (apWord). But
     * the allocated size of apWord is larger than the number of
     * words in pObj.
     * 
     * So when we need to append some arguments and execute the object
     * command, the code just looks like this:
     *
     *     int N = pSeeTclObject->nWord;
     *     pSeeTclObject->apWord[N]   = Tcl_NewStringObj(.....);
     *     pSeeTclObject->apWord[N+1] = Tcl_NewStringObj(.....);
     *     rc = Tcl_EvalObjv(interp, N+2, pSeeTclObject->apWord, flags);
     *     # ... cleanup the two allocated string objects....
     */
    Tcl_Obj **apWord;
    int nWord;
    int nAllocWord;

    /* This is used by objects while they reside in the 
     * SeeInterp.aTclObject[] hash table. 
     */
    SeeTclObject *pNext;
};

struct SeeTclClass  {
  /* Hash table containing fixed list of properties for this class. Hash
   * table keys are intern'd SEE_string pointers. Because they are intern'd
   * in the global string table, this can be used with any SEE interpreter.
   */
  Tcl_HashTable aProperty;
};


struct SeeInterp {
    /* The two interpreters - SEE and Tcl. The interp member must be
     * first, so that we can cast between (struct SEE_interpreter *)
     * and (SeeInterp *).
     */
    struct SEE_interpreter interp;

    /* The Tcl interpreter that created this object. */
    Tcl_Interp *pTclInterp;

    /* The global object used by this interpreter. */
    SeeTclObject global;

    ClientData pInstrumentData;

    Tcl_Obj *pTclError;

    /* Hash table containing the objects created by the Tcl interpreter
     * that are currently in "persistent" state.
     *
     * This maps from the Tcl command to the SeeTclObject structure.
     * This structure (and the aTclObject[] array along with it) is
     * allocated using GC_MALLOC_UNCOLLECTABLE(), so anything in the
     * following hash-table is not eligible for garbage collection.
     */
    SeeTclObject *aTclObject[OBJECT_HASH_SIZE];

    /* Debugger related stuff. If not NULL, pTrace is the tcl script 
     * to invoke from within the SEE trace-callback. While the pTrace
     * script is executing, pTraceContext is set to a copy of the
     * SEE_context passed to the trace-callback.
     */
    Tcl_Obj *pTrace;
    struct SEE_context *pTraceContext;

    struct SEE_scope *pScope;

    Tcl_Obj *pLog;

    /* Start of a linked list of SeeTimeout structures. See 
    ** included file hv3timeout.c for details.
    */
    int iNextTimeout;

    /* Objects used by the events subsystem. See hv3events.c for details */
    struct SEE_object *pEventPrototype;

    /* Linked list of SeeJsObject structures that will be removed from
     * the aJsObject[] table next time removeTransientRefs() is called.
     *
     * Variable iNextJsObject is used to assign unique integer ids
     * (SeeJsObject.iKey) to SeeJsObject instances as they are created.
     * I am not worried about it wrapping around, as the odds of Hv3
     * running for that long in javascript mode without crashing are
     * vanishingly small.
     */
    int iNextJsObject;
    SeeJsObject *pJsObject;
};
static int iSeeInterp = 0;


/* This variable, used for debugging, stores the total number of 
 * SeeTclObject structures currently allocated.
 */
static int iNumSeeTclObject = 0;

/* Entries in the SeeInterp.pJsObject[] linked list are instances of
 * the following structure. 
 */
struct SeeJsObject {
    int iKey;
    struct SEE_object *pObject;

    /* Next entry in the SeeInterp.pJsObject list */
    SeeJsObject *pNext;
};

static Tcl_ObjCmdProc eventDispatchCmd;
static Tcl_ObjCmdProc eventDumpCmd;
static void eventTargetInit(SeeInterp *, SeeTclObject *);

/* Return a pointer to the V-Table for Tcl based javascript objects. 
 */
static struct SEE_objectclass *getVtbl();

/* Source file hv3timeout.c contains the implementation of the 
** following methods of the Window (global) object:
**
**     setTimeout()
**     setInterval()
**     clearTimeout()
**     clearInterval()
**
** The hv3timeout.c module uses the SeeInterp.pTimeout pointer. The
** external interface (called from this file) is:
*/ 
static void interpTimeoutInit(SeeInterp *, SeeTclObject *);
static void interpTimeoutCleanup(SeeInterp *, SeeTclObject *);
#include "hv3timeout.c"


/*
 *---------------------------------------------------------------------------
 *
 * allocWordArray --
 *
 * Results: 
 *     See above.
 *
 * Side effects:
 *     None.
 *
 *---------------------------------------------------------------------------
 */
static int
allocWordArray(p, pSeeTclObject, nExtra)
    SeeInterp *p;
    SeeTclObject *pSeeTclObject;
    int nExtra;
{
    if ( 
        (pSeeTclObject->nWord == 0) || 
        ((pSeeTclObject->nAllocWord - pSeeTclObject->nWord) < nExtra)
    ) {
        int n;
        int nByte;
        int rc;
        Tcl_Obj **apWord;
        Tcl_Interp *interp = p->pTclInterp;

        rc = Tcl_ListObjGetElements(interp, pSeeTclObject->pObj, &n, &apWord);
        if (rc != TCL_OK) {
            return rc;
        }

        pSeeTclObject->nWord = n;
        pSeeTclObject->nAllocWord = n + nExtra;
        nByte = (sizeof(Tcl_Obj* ) * (n+nExtra));
        pSeeTclObject->apWord = SEE_malloc_string(&p->interp, nByte);
        memcpy(pSeeTclObject->apWord, apWord, n * sizeof(Tcl_Obj *));
    }

    return TCL_OK;
}

/*
 *---------------------------------------------------------------------------
 *
 * getSeeTclObject --
 *     If the javascript object passed as the first argument was created
 *     by Tcl, cast it to a (SeeTclObject*) and return it. Otherwise
 *     return NULL.
 *
 * Results: 
 *     See above.
 *
 * Side effects:
 *     None.
 *
 *---------------------------------------------------------------------------
 */
static SeeTclObject *
getSeeTclObject(pSeeObject)
    struct SEE_object *pSeeObject;
{
    SeeTclObject *pRet = 0;
    if (pSeeObject && pSeeObject->objectclass == getVtbl()) {
        pRet = (SeeTclObject *)pSeeObject;
    }
    return pRet;
}


/*
 *---------------------------------------------------------------------------
 *
 * hashCommand --
 *     Return a hash value between 0 and (OBJECT_HASH_SIZE-1) for the
 *     nul-terminated string passed as an argument.
 *
 * Results: 
 *     Integer between 0 and (OBJECT_HASH_SIZE-1), inclusive.
 *
 * Side effects:
 *     None.
 *
 *---------------------------------------------------------------------------
 */
static int
hashCommand(zCommand)
    char const *zCommand;
{
    unsigned int iSlot = 0;
    char const *z;
    for (z = zCommand ; *z; z++) {
        iSlot = (iSlot << 3) + (int)(*z);
    }
    return (iSlot % OBJECT_HASH_SIZE);
}

/*
 *---------------------------------------------------------------------------
 *
 * createObjectRef --
 *     Insert an entry in the SeeInterp.aJsObject[] table for pObject.
 *     return the integer key associated with the table entry.
 *
 * Results: 
 *     Integer.
 *
 * Side effects:
 *     None.
 *
 *---------------------------------------------------------------------------
 */
static int
createObjectRef(pTclSeeInterp, pObject)
    SeeInterp *pTclSeeInterp;
    struct SEE_object *pObject;
{
    SeeJsObject *pJsObject;

    /* Create the new SeeJsObject structure. */
    pJsObject = SEE_NEW(&pTclSeeInterp->interp, SeeJsObject);
    pJsObject->iKey = pTclSeeInterp->iNextJsObject++;
    pJsObject->pObject = pObject;

    pJsObject->pNext = pTclSeeInterp->pJsObject;
    pTclSeeInterp->pJsObject = pJsObject;

    return pJsObject->iKey;
}

/*
 *---------------------------------------------------------------------------
 *
 * removeTransientRefs --
 *
 * Results: 
 *     None.
 *
 * Side effects:
 *
 *---------------------------------------------------------------------------
 */
static void
removeTransientRefs(pTclSeeInterp, n)
    SeeInterp *pTclSeeInterp;
    int n;
{
    int ii;
    for(ii = 0; ii < n; ii++) {
        pTclSeeInterp->pJsObject = pTclSeeInterp->pJsObject->pNext;
    }
}

/*
 *---------------------------------------------------------------------------
 *
 * lookupObjectRef --
 *     Lookup the entry associated with parameter iKey in the 
 *     SeeInterp.pJsObject list. Return a pointer to the SEE object
 *     stored as part of the entry.
 *
 *     If there is no such entry in the SeeInterp.pJsObject list,
 *     return NULL and leave an error in the Tcl interpreter.
 *
 * Results: 
 *     Pointer to SEE_object, or NULL.
 *
 * Side effects:
 *     May write an error to SeeInterp.pTclInterp.
 *
 *---------------------------------------------------------------------------
 */
static struct SEE_object *
lookupObjectRef(pTclSeeInterp, iKey)
    SeeInterp *pTclSeeInterp;
    int iKey;
{
    SeeJsObject *pJsObject;

    for (
        pJsObject = pTclSeeInterp->pJsObject;
        pJsObject && pJsObject->iKey != iKey;
        pJsObject = pJsObject->pNext
    );

    if (!pJsObject) {
        char zBuf[64];
        sprintf(zBuf, "No such object: %d", iKey);
        Tcl_SetResult(pTclSeeInterp->pTclInterp, zBuf, TCL_VOLATILE);
        return 0;
    }

    return pJsObject->pObject;
}

/*
 *---------------------------------------------------------------------------
 *
 * stringToObj --
 *
 *     Create a Tcl object containing a copy of the string pString. The
 *     returned object has a ref-count of 0.
 *
 * Results:
 *
 * Side effects:
 *
 *---------------------------------------------------------------------------
 */
static Tcl_Obj *
stringToObj(pString)
    struct SEE_string *pString;
{
    Tcl_Obj *pObj;
    if( pString ){
        pObj = Tcl_NewUnicodeObj(pString->data, pString->length);
    } else {
        pObj = Tcl_NewObj();
    }
    return pObj;
}

/*
 *---------------------------------------------------------------------------
 *
 * primitiveValueToTcl --
 *
 *     Convert the SEE value *pValue to it's Tcl representation, assuming
 *     that *pValue holds a primitive value, not a javascript object. 
 *     Return a pointer to a new Tcl object (ref-count 0) containing
 *     the Tcl representation.
 *
 *     If *pValue does contain a javascript object, use SEE_ToPrimitive()
 *     to convert it to a primitive. The conversion is done on a copy
 *     to *pValue, so *pValue is never modified.
 *
 * Results:
 *     Tcl object with ref-count set to 0.
 *
 * Side effects:
 *     None.
 *
 *---------------------------------------------------------------------------
 */
static Tcl_Obj *
primitiveValueToTcl(pTclSeeInterp, pValue)
    SeeInterp *pTclSeeInterp;
    struct SEE_value *pValue;
{
    Tcl_Obj *aTclValues[2] = {0, 0};
    int nTclValues = 2;
    struct SEE_value copy;
    struct SEE_value *p = pValue;

    int eType = SEE_VALUE_GET_TYPE(pValue);
    if (
        eType != SEE_UNDEFINED && eType != SEE_NULL &&
        eType != SEE_BOOLEAN   && eType != SEE_NUMBER && 
        eType != SEE_STRING    && eType != SEE_OBJECT
    ) {
        SEE_ToPrimitive(&pTclSeeInterp->interp, pValue, 0, &copy);
        p = &copy;
    }

    switch (SEE_VALUE_GET_TYPE(p)) {

        case SEE_UNDEFINED:
            aTclValues[0] = Tcl_NewStringObj("undefined", -1);
            break;

        case SEE_NULL:
            aTclValues[0] = Tcl_NewStringObj("null", -1);
            break;

        case SEE_BOOLEAN:
            aTclValues[0] = Tcl_NewStringObj("boolean", -1);
            aTclValues[1] = Tcl_NewBooleanObj(p->u.boolean);
            break;

        case SEE_NUMBER:
            aTclValues[0] = Tcl_NewStringObj("number", -1);
            aTclValues[1] = Tcl_NewDoubleObj(p->u.number);
            break;

        case SEE_STRING:
            aTclValues[0] = Tcl_NewStringObj("string", -1);
            aTclValues[1] = stringToObj(p->u.string);
            break;

        case SEE_OBJECT: {
            if (p->u.object->objectclass != getVtbl()) {
                aTclValues[0] = Tcl_NewStringObj("OBJECT", -1);
            } else {
                SeeTclObject *pObj = (SeeTclObject *)(p->u.object);
                aTclValues[0] = Tcl_NewStringObj("object", -1);
                aTclValues[1] = pObj->pObj;
            }
            break;
        }

        case SEE_REFERENCE: 
            aTclValues[0] = Tcl_NewStringObj("REFERENCE", -1);
            break;

        case SEE_COMPLETION: 
            aTclValues[0] = Tcl_NewStringObj("COMPLETION", -1);
            break;

        default:
            assert(!"Bad value type");

    }

    assert(aTclValues[0]);
    if (!aTclValues[1]) {
        nTclValues = 1;
    }

    return Tcl_NewListObj(nTclValues, aTclValues);
}

/*
 *---------------------------------------------------------------------------
 *
 * argValueToTcl --
 *
 *     Convert the SEE value *pValue to it's Tcl form. If *pValue contains
 *     a primitive (non javascript-object) value, use primitiveValueToTcl()
 *     to convert it. 
 *
 *     If *pValue contains an object reference, then add an entry for the
 *     object to the SeeInterp.aJsObject[] array and return an object
 *     reference of the form:
 *
 *         {object {INTERP Get ID}}
 *
 *     The ID for the new object reference is added to the
 *     SeeInterp.pTransient list (so that it is removed by
 *     removeTransientRefs()).
 *
 * Results:
 *     Tcl object with ref-count set to 0.
 *
 * Side effects:
 *     May add an entry to SeeInterp.aJsObject[].
 *
 *---------------------------------------------------------------------------
 */
static Tcl_Obj *
argValueToTcl(pTclSeeInterp, pValue, piObject)
    SeeInterp *pTclSeeInterp;
    struct SEE_value *pValue;
    int *piObject;
{
    if (SEE_VALUE_GET_TYPE(pValue) == SEE_OBJECT) {
        int iKey;
        Tcl_Obj *aTclValues[2];
        struct SEE_object *pObject = pValue->u.object;
        SeeTclObject *pSeeTclObject;

        aTclValues[0] = Tcl_NewStringObj("object", -1);
        pSeeTclObject = getSeeTclObject(pObject);
        if (pSeeTclObject) {
          aTclValues[1] = pSeeTclObject->pObj;
        } else {
          iKey = createObjectRef(pTclSeeInterp, pObject, 1);
          aTclValues[1] = Tcl_NewIntObj(iKey);
          (*piObject)++;
        }
        return Tcl_NewListObj(2, aTclValues);
    } else {
        return primitiveValueToTcl(pTclSeeInterp, pValue);
    }
}


static int evalObjv(pTcl, nWord, apWord)
    Tcl_Interp *pTcl;
    int nWord;
    Tcl_Obj **apWord;
{
#if 0
    int ii;
    for (ii = 0; ii < nWord; ii++){
         printf("%s ", Tcl_GetString(apWord[ii]));
    }
    printf("\n");
#endif
    return Tcl_EvalObjv(pTcl, nWord, apWord, TCL_EVAL_GLOBAL);
} 

/*
 *---------------------------------------------------------------------------
 *
 * callSeeTclMethod --
 *
 *     This is a helper function used to call the following methods of
 *     the supplied SeeTclObject (argument p):
 *
 *         Get Put CanPut HasProperty Delete DefaultValue Enumerator
 *
 *     The other methods (Call and Construct) are invoked via
 *     tclCallOrConstruct().
 *
 * Results: 
 *     See above.
 *
 * Side effects:
 *     None.
 *
 *---------------------------------------------------------------------------
 */
static int 
callSeeTclMethod(pTcl, pLog, p, zMethod, pProperty, pVal)
    Tcl_Interp *pTcl;                      /* Tcl Interpreter context */
    Tcl_Obj *pLog;                         /* Log command */
    SeeTclObject *p;                       /* Object to call method of */
    const char *zMethod;                   /* Method name */
    struct SEE_string *pProperty;          /* First argument (or null) */
    Tcl_Obj *pVal;                         /* Second argument (or null) */
{
    Tcl_Obj *pMethod;
    Tcl_Obj *pProp = 0;
    int nArg = 1;
    int rc;

    assert(p->nAllocWord - p->nWord >= 3);

    pMethod = Tcl_NewStringObj(zMethod, -1);
    Tcl_IncrRefCount(pMethod);
    p->apWord[p->nWord] = pMethod;

    if (pProperty) {
        pProp = stringToObj(pProperty);
        Tcl_IncrRefCount(pProp);
        p->apWord[p->nWord + nArg] = pProp;
        nArg++;
    }

    if (pVal) {
        p->apWord[p->nWord + nArg] = pVal;
        nArg++;
    }

    rc = evalObjv(pTcl, p->nWord + nArg, p->apWord);

    if (pLog && rc==TCL_OK) {
        Tcl_Obj *pEval;
        Tcl_Obj *pSubject;
        Tcl_Obj *pRes = Tcl_GetObjResult(pTcl);
        Tcl_IncrRefCount(pRes);

        pSubject = Tcl_NewStringObj("ECMASCRIPT ", -1);
        Tcl_AppendToObj(pSubject, zMethod, -1);

        pEval = Tcl_DuplicateObj(pLog);
        Tcl_IncrRefCount(pEval);
        Tcl_ListObjAppendElement(0, pEval, pSubject);
        Tcl_ListObjAppendElement(0, pEval, p->pObj);
        if (pMethod) Tcl_ListObjAppendElement(0, pEval, pMethod);
        if (pProp) Tcl_ListObjAppendElement(0, pEval, pProp);
        if (pVal) Tcl_ListObjAppendElement(0, pEval, pVal);
        Tcl_ListObjAppendElement(0, pEval, pRes);
        Tcl_EvalObjEx(pTcl, pEval, TCL_EVAL_DIRECT|TCL_EVAL_GLOBAL);
        Tcl_DecrRefCount(pEval);

        Tcl_SetObjResult(pTcl, pRes);
        Tcl_DecrRefCount(pRes);
    }

    if (pMethod) Tcl_DecrRefCount(pMethod);
    if (pProp) Tcl_DecrRefCount(pProp);

    return rc;
}

static void
initSeeTclObject(pTclSeeInterp, p, pTclCommand)
    SeeInterp *pTclSeeInterp;
    SeeTclObject *p;
    Tcl_Obj *pTclCommand;
{
    Tcl_CmdInfo info;
    char zBuf[256];

    memset(p, 0, sizeof(SeeTclObject));
    p->pObj = pTclCommand;
    p->object.objectclass = getVtbl();
    p->object.Prototype = pTclSeeInterp->interp.Object_prototype;

    Tcl_IncrRefCount(p->pObj);
    allocWordArray(pTclSeeInterp, p, 5);

    /* Initialise the native object (used to store native properties) */
    p->pNative = (struct SEE_native *)SEE_native_new(&pTclSeeInterp->interp);

    /* Initialise the class, if any */
    sprintf(zBuf, "%s.class", Tcl_GetString(p->apWord[0]));
    if (Tcl_GetCommandInfo(pTclSeeInterp->pTclInterp, zBuf, &info)){
        p->pClass = (SeeTclClass *)info.objClientData;
    }

    iNumSeeTclObject++;
}

/*
 *---------------------------------------------------------------------------
 *
 * newSeeTclObject --
 *
 *     Allocate and return a pointer to a new SeeTclObject structure 
 *     based on the Tcl command passed as the second argument.
 *
 * Results:
 *     Pointer to new SeeTclObject structure.
 *
 * Side effects:
 *     None.
 *
 *---------------------------------------------------------------------------
 */
static SeeTclObject *
newSeeTclObject(pTclSeeInterp, pTclCommand)
    SeeInterp *pTclSeeInterp;
    Tcl_Obj *pTclCommand;
{
    SeeTclObject *p = SEE_NEW(&pTclSeeInterp->interp, SeeTclObject);
    initSeeTclObject(pTclSeeInterp, p, pTclCommand);
    return p;
}

/*
 *---------------------------------------------------------------------------
 *
 * finalizeObject --
 *
 *     Finalize a SeeTclObject structure. Because this finalizer
 *     is attached using _no_order(), we have to be careful what
 *     is done here. The safest approach is to access no gc'd
 *     memory except for the SeeTclObject itself.
 *
 *     The context argument, pContext, may point to a Tcl interpreter.
 *     If so, evaluate the objects Tcl [Finalize] method.
 *
 *     TODO: This is going to be a problem if Hv3 ever uses multiple
 *     interpreters. But it doesn't right now...
 *
 * Results:
 *     None.
 *
 * Side effects:
 *     Drops the reference to SeeTclObject.pObj.
 *
 *---------------------------------------------------------------------------
 */
static void
finalizeObject(pPtr, pContext)
    void *pPtr;                 /* Object to finalize */
    void *pContext;             /* If non-zero, Tcl interpreter */
{
    SeeTclObject *p = (SeeTclObject *)pPtr;

    if (pContext) {
        /* Execute the Tcl Finalize hook. Do nothing with the result thereof. */
        Tcl_Interp *pTclInterp = (Tcl_Interp *)pContext;
        int rc = callSeeTclMethod(pTclInterp, 0, p, "Finalize", 0, 0);
        if (rc != TCL_OK) {
            printf("WARNING Seetcl: Finalize script failed for %s: %s\n", 
                Tcl_GetString(p->pObj), Tcl_GetStringResult(pTclInterp)
            );
        }
    }

    assert(p->pObj->refCount >= 1);
    Tcl_DecrRefCount(p->pObj);
    p->pObj = 0;
    iNumSeeTclObject--;
}

/*
 *---------------------------------------------------------------------------
 *
 * createTransient --
 *
 * Results:
 *     Pointer to SEE_object structure.
 *
 * Side effects:
 *
 *---------------------------------------------------------------------------
 */
static struct SEE_object *
createTransient(pTclSeeInterp, pTclCommand)
    SeeInterp *pTclSeeInterp;
    Tcl_Obj *pTclCommand;
{
    Tcl_Interp *pTcl = pTclSeeInterp->pTclInterp;
    SeeTclObject *p = newSeeTclObject(pTclSeeInterp, pTclCommand);
    GC_register_finalizer_no_order(p, finalizeObject, pTcl, 0, 0);
    return (struct SEE_object *)p;
}

/*
 *---------------------------------------------------------------------------
 *
 * createNative --
 *
 * Results:
 *     Pointer to SEE_object structure.
 *
 * Side effects:
 *
 *---------------------------------------------------------------------------
 */
static int objToValue(SeeInterp *, Tcl_Obj *, struct SEE_value *, int *);
static struct SEE_object *
createNative(pTclSeeInterp, pTclList)
    SeeInterp *pTclSeeInterp;
    Tcl_Obj *pTclList;
{
    Tcl_Interp *pTcl = pTclSeeInterp->pTclInterp;
    struct SEE_interpreter *pSee = (struct SEE_interpreter *)pTclSeeInterp;
    int nElem = 0;
    Tcl_Obj **apElem = 0;
    int rc;
    int ii;
    struct SEE_object *pRet;

    rc = Tcl_ListObjGetElements(pTcl, pTclList, &nElem, &apElem);
    if (rc != TCL_OK) return 0;

    pRet = (struct SEE_object *)SEE_native_new(pSee);
    for (ii = 0; ii < (nElem-1); ii += 2){
      struct SEE_value value;
      rc = objToValue(pTclSeeInterp, apElem[ii+1], &value, 0);
      if (rc != TCL_OK) return 0;
      SEE_OBJECT_PUTA(pSee, pRet, Tcl_GetString(apElem[ii]), &value, 0);
    }

    return pRet;
}

static struct SEE_object *
createBridge(pTclSeeInterp, pCommand)
    SeeInterp *pTclSeeInterp;
    Tcl_Obj *pCommand;
{
    Tcl_Command t;
    Tcl_CmdInfo info;

    SeeInterp *pForiegnInterp;

    t = Tcl_GetCommandFromObj(pTclSeeInterp->pTclInterp, pCommand);
    if( !t ) return 0;
    assert(t);
    Tcl_GetCommandInfoFromToken(t, &info);
    pForiegnInterp = info.objClientData;
    assert( pForiegnInterp->global.object.objectclass==getVtbl() );
    return createBridgeObject(&pTclSeeInterp->interp, 
        &pForiegnInterp->interp, &pForiegnInterp->global.object
    );
}

/*
 *---------------------------------------------------------------------------
 *
 * findOrCreateObject --
 *
 * Results:
 *     Pointer to SEE_object structure.
 *
 * Side effects:
 *     May create a new SeeTclObject structure and add it to the
 *     SeeInterp.aObject hash table.
 *
 *---------------------------------------------------------------------------
 */
static struct SEE_object *
findOrCreateObject(pTclSeeInterp, pTclCommand, isGlobal)
    SeeInterp *pTclSeeInterp;
    Tcl_Obj *pTclCommand;
    int isGlobal;               /* True when creating the global object */
{
    Tcl_Interp *pTclInterp = pTclSeeInterp->pTclInterp;
    char const *zCommand = Tcl_GetString(pTclCommand);
    int iSlot = hashCommand(zCommand);
    SeeTclObject *pObject;

    /* See if this is a javascript object reference. It is assumed to
     * be a javascript reference if the first character is a digit.
     */
    if ( isdigit((unsigned char)zCommand[0]) ){
        int iKey;
        if (TCL_OK != Tcl_GetIntFromObj(pTclInterp, pTclCommand, &iKey)) {
            return 0;
        }
        return lookupObjectRef(pTclSeeInterp, iKey);
    }

    /* Search for an existing Tcl object */
    for (
        pObject = pTclSeeInterp->aTclObject[iSlot];
        pObject && strcmp(zCommand, Tcl_GetString(pObject->pObj));
        pObject = pObject->pNext
    );

    /* If pObject is still NULL, there is no existing object, create a 
     * new SeeTclObject.
     */
    if (!pObject) {
        Tcl_Interp *pTcl = pTclSeeInterp->pTclInterp;
        if (isGlobal) {
            pObject = &pTclSeeInterp->global;
        }else{
            pObject = newSeeTclObject(pTclSeeInterp, pTclCommand);
        }

        /* Insert the new object into the hash table */
        pObject->pNext = pTclSeeInterp->aTclObject[iSlot];
        pTclSeeInterp->aTclObject[iSlot] = pObject;

        /* Initialise the objects events subsystem. */
        eventTargetInit(pTclSeeInterp, pObject);

        /* Have to be careful using the _no_order() variant to
         * attach a finalizer. See comments above finalizeObject().
         */
        if (!isGlobal) {
            GC_register_finalizer_no_order(pObject, finalizeObject, pTcl, 0, 0);
        } 
    }

    return (struct SEE_object *)pObject;
}

static struct SEE_object *
createNode(pTclSeeInterp, pTclCommand)
    SeeInterp *pTclSeeInterp;
    Tcl_Obj *pTclCommand;
{
    Tcl_Interp *pTcl = pTclSeeInterp->pTclInterp;
    SeeTclObject * p;

    p = (SeeTclObject *)findOrCreateObject(pTclSeeInterp, pTclCommand, 0);
    if (p->nodehandle == 0) {
        Tcl_Command t;
        Tcl_CmdInfo info;
        t = Tcl_GetCommandFromObj(pTcl, p->apWord[2]);
        assert(t);
        Tcl_GetCommandInfoFromToken(t, &info);
        p->nodehandle = info.objClientData;
        ((NodeHack *)p->nodehandle)->pObj = p;
    }
    return (struct SEE_object *)p;
}


/*
 *---------------------------------------------------------------------------
 *
 * makeObjectTransient --
 *
 * Results:
 *
 * Side effects:
 *
 *---------------------------------------------------------------------------
 */
static int
makeObjectTransient(pTclSeeInterp, pCommand)
    SeeInterp *pTclSeeInterp;
    Tcl_Obj *pCommand;
{
    const char *zCommand = Tcl_GetString(pCommand);
    SeeTclObject **pp;

    for (
        pp = &pTclSeeInterp->aTclObject[hashCommand(zCommand)];
        *pp && strcmp(zCommand, Tcl_GetString((*pp)->pObj));
        pp = &(*pp)->pNext
    );
    if (*pp) {
        SeeTclObject *p = *pp;
        interpTimeoutCleanup(pTclSeeInterp, p);
        *pp = p->pNext;
        p->pNext = 0;
    } else {
        Tcl_AppendResult(pTclSeeInterp->pTclInterp, 
            "No such object: \"", zCommand, "\"", 0
        );
        return TCL_ERROR;
    }
    return TCL_OK;
}

/*
 *---------------------------------------------------------------------------
 *
 * makeObjectPersistent --
 *
 * Results:
 *
 * Side effects:
 *
 *---------------------------------------------------------------------------
 */
static int
makeObjectPersistent(pTclSeeInterp, pCommand)
    SeeInterp *pTclSeeInterp;
    Tcl_Obj *pCommand;
{
    SeeJsObject **pp;
    const char *zCommand = Tcl_GetString(pCommand);

    pp = &pTclSeeInterp->pJsObject;
    while (*pp) {
        SeeTclObject *pSeeTclObject = getSeeTclObject((*pp)->pObject);
        if (0 == strcmp(Tcl_GetString(pSeeTclObject->pObj), zCommand)) {
            /* Found the item we're looking for. Unless it is already there, 
             * add this object to the persistent objects hash table. The
             * object stays in the args list too. This way, it is safe
             * to call [make_persistent] twice on the same argument in
             * a callback. Also, you can call [make_persistent] followed
             * by [make_transient] and the object will not be eligible
             * for GC until the callback returns and it is removed from the arg
             * list.
             */
            int iSlot = hashCommand(zCommand);
            SeeTclObject *p;
            for (
                 p = pTclSeeInterp->aTclObject[iSlot];
                 p && p != pSeeTclObject;
                 p = p->pNext
            );
            if( !p ){
                assert(!pSeeTclObject->pNext);
                pSeeTclObject->pNext = pTclSeeInterp->aTclObject[iSlot];
                pTclSeeInterp->aTclObject[iSlot] = pSeeTclObject;
            }
            return TCL_OK;
        }
        pp = &(*pp)->pNext;
    }

    Tcl_AppendResult(pTclSeeInterp->pTclInterp,
        "Cannot call [make_persistent] on ", zCommand, 0
    );
    return TCL_ERROR;
}

static int
objToValue(pInterp, pObj, pValue, pIsCacheable)
    SeeInterp *pInterp;
    Tcl_Obj *pObj;                  /* IN: Tcl js value */
    struct SEE_value *pValue;       /* OUT: Parsed value */
    int *pIsCacheable;              /* OUT: Cacheable? */
{
    int rc;
    int nElem = 0;
    Tcl_Obj **apElem = 0;

    Tcl_Interp *pTclInterp = pInterp->pTclInterp;

    rc = Tcl_ListObjGetElements(pTclInterp, pObj, &nElem, &apElem);
    if (rc == TCL_OK) {
        assert(nElem == 0 || 0 != strcmp("", Tcl_GetString(pObj)));

        /* Check if the first word is "cache" */
        if (pIsCacheable) {
            *pIsCacheable = 0;
            if (nElem > 0 && 0 == strcmp("cache", Tcl_GetString(apElem[0]))) {
                *pIsCacheable = 1;
                nElem--;
                apElem++;
            }
        }

        if (nElem == 0) {
            SEE_SET_UNDEFINED(pValue);
        } else {
            int iChoice;
            #define TRANSIENT -124
            #define NATIVE    -123
            #define NODE      -122
            #define BRIDGE    -121
            struct ValueType {
                char const *zType;
                int eType;
                int nArg;
            } aType[] = {
                {"undefined", SEE_UNDEFINED, 0}, 
                {"null",      SEE_NULL, 0}, 
                {"number",    SEE_NUMBER, 1}, 
                {"string",    SEE_STRING, 1}, 
                {"boolean",   SEE_BOOLEAN, 1},

                {"object",    SEE_OBJECT, 1},
                {"transient", TRANSIENT, 1},
                {"native",    NATIVE, 1},
                {"node",      NODE, 1},
                {"bridge",    BRIDGE, 1},
                {0, 0, 0}
            };

            if (Tcl_GetIndexFromObjStruct(pTclInterp, apElem[0], aType,
                sizeof(struct ValueType), "type", 0, &iChoice) 
            ){
                Tcl_AppendResult(pTclInterp, 
                    " value was \"", Tcl_GetString(pObj), "\"", 0
                );
                return TCL_ERROR;
            }
            if (nElem != (aType[iChoice].nArg + 1)) {
                Tcl_AppendResult(pTclInterp, 
                    "Bad javascript value spec: \"", Tcl_GetString(pObj),
                    "\"", 0
                );
                return TCL_ERROR;
            }
            switch (aType[iChoice].eType) {
                case SEE_UNDEFINED:
                    SEE_SET_UNDEFINED(pValue);
                    break;
                case SEE_NULL:
                    SEE_SET_NULL(pValue);
                    break;
                case SEE_BOOLEAN: {
                    int val;
                    if (Tcl_GetBooleanFromObj(pTclInterp, apElem[1], &val)) {
                        return TCL_ERROR;
                    }
                    SEE_SET_BOOLEAN(pValue, val);
                    break;
                }
                case SEE_NUMBER: {
                    double val;
                    const char *zElem = Tcl_GetString(apElem[1]);
                    if (0==strcmp(zElem, "-NaN") || 0==strcmp(zElem, "NaN")) {
                        struct SEE_value v;
                        struct SEE_string *pNaN = SEE_intern_ascii(
                            &pInterp->interp, "NaN"
                        );
                        SEE_SET_STRING(&v, pNaN);
                        SEE_ToNumber(&pInterp->interp, &v, pValue);
                    } else 
                    if (Tcl_GetDoubleFromObj(pTclInterp, apElem[1], &val)) {
                        return TCL_ERROR;
                    } else {
                        SEE_SET_NUMBER(pValue, val);
                    }
                    break;
                }
                case SEE_STRING: {
                    int nChar;
                    Tcl_UniChar *zChar;
                    struct SEE_string *pString;
                    struct SEE_string str;

                    zChar = Tcl_GetUnicodeFromObj(apElem[1], &nChar);;

                    pString = SEE_string_new(&pInterp->interp, nChar);
                    str.length = nChar;
                    str.data = zChar;
                    SEE_string_append(pString, &str);

                    SEE_SET_STRING(pValue, pString);
                    break;
                }

                case SEE_OBJECT: {
                    struct SEE_object *pObject = 
                        findOrCreateObject(pInterp, apElem[1], 0);
                    SEE_SET_OBJECT(pValue, pObject);
                    break;
                }

                case NODE: {
                    struct SEE_object *p = createNode(pInterp, apElem[1]);
                    SEE_SET_OBJECT(pValue, (struct SEE_object *)p);
                    break;
                }

                case TRANSIENT: {
                    struct SEE_object *pObject = 
                        createTransient(pInterp, apElem[1]);
                    SEE_SET_OBJECT(pValue, pObject);
                    break;
                }

                case NATIVE: {
                    struct SEE_object *pObject;
                    pObject = createNative(pInterp, apElem[1]);
                    SEE_SET_OBJECT(pValue, pObject);
                    break;
                }

                case BRIDGE: {
                    struct SEE_object *pObject;
                    pObject = createBridge(pInterp, apElem[1]);
                    if (pObject) {
                        SEE_SET_OBJECT(pValue, pObject);
                    }else{
                        rc = TCL_ERROR;
                    }
                    break;
                }
            }
        }
    }
    return rc;
}

struct SEE_string *
SEE_function_getname(struct SEE_interpreter * i, struct SEE_object *o);

/*
 *---------------------------------------------------------------------------
 *
 * handleJavascriptError --
 *
 *     This function is designed to be called when a javascript error
 *     occurs (i.e. a SEE exception is thrown by either SEE_Global_eval()
 *     or SEE_OBJECT_CALL()).
 *
 *     Information is retrieved from the try-catch context passed as 
 *     argument pTry and loaded into the result of the Tcl-interpreter
 *     component of argument pTclSeeInterp. 
 *
 * Results:
 *     Always returns TCL_ERROR.
 *
 * Side effects:
 *     Sets the result of Tcl interpreter pTclSeeInterp->pTclInterp.
 *
 *---------------------------------------------------------------------------
 */
static int 
handleJavascriptError(pTclSeeInterp, pTry)
    SeeInterp *pTclSeeInterp;
    SEE_try_context_t *pTry;
{
    Tcl_Interp *pTclInterp = pTclSeeInterp->pTclInterp;
    struct SEE_interpreter *pSeeInterp = &pTclSeeInterp->interp;
    struct SEE_traceback *pTrace;
    struct SEE_value error;
    Tcl_Obj *pError;
    
    /* The Tcl error message is a well formed Tcl list. The elements
     * of which are as follows:
     *
     *   * The literal string "JS_ERROR"
     *   * The string form of the javascript object thrown.
     *   * The value of $errorInfo (if this is a Tcl error, otherwise 
     *     an empty string).
     *   * Followed by an even number of elements - alternating filenames
     *     and line numbers that make up the stack trace (first pair
     *     is at the bottom of the stack - where the exception was thrown
     *     from).
     */

    pError = Tcl_NewObj();
    Tcl_ListObjAppendElement(0, pError, Tcl_NewStringObj("JS_ERROR", -1));

    /* String form of exception object thrown */
    SEE_ToString(pSeeInterp, SEE_CAUGHT(*pTry), &error);
    if (SEE_VALUE_GET_TYPE(&error) == SEE_STRING) {
        struct SEE_string *pS = error.u.string;
        Tcl_Obj *pErrorString = stringToObj(pS);
        Tcl_ListObjAppendElement(0, pError, pErrorString);
    } else {
        Tcl_ListObjAppendElement(0, pError, Tcl_NewStringObj("N/A", -1));
    }

    /* If there is a Tcl error, append it. Otherwise append an empty string. */
    if (pTclSeeInterp->pTclError) {
        Tcl_ListObjAppendElement(0, pError, pTclSeeInterp->pTclError);
        Tcl_DecrRefCount(pTclSeeInterp->pTclError);
        pTclSeeInterp->pTclError = 0;
    } else {
        Tcl_ListObjAppendElement(0, pError, Tcl_NewStringObj("", -1));
    }

    if (pSeeInterp->try_location) {
        struct SEE_throw_location *pLoc = pSeeInterp->try_location;
        Tcl_ListObjAppendElement(0, pError, stringToObj(pLoc->filename));
        Tcl_ListObjAppendElement(0, pError, Tcl_NewIntObj(pLoc->lineno));
        Tcl_ListObjAppendElement(0, pError, Tcl_NewObj());
        Tcl_ListObjAppendElement(0, pError, Tcl_NewObj());
    }

    for (pTrace = pTry->traceback; pTrace; pTrace = pTrace->prev) {
        struct SEE_string *pFile = pTrace->call_location->filename;
        if (!pFile) {
            Tcl_ListObjAppendElement(0, pError, Tcl_NewStringObj("N/A", -1));
        } else {
            Tcl_ListObjAppendElement(0, pError, stringToObj(pFile));
        }
        Tcl_ListObjAppendElement(0, pError, 
            Tcl_NewIntObj(pTrace->call_location->lineno)
        );

        switch (pTrace->call_type) {
            case SEE_CALLTYPE_CONSTRUCT: {
                char const *zClass =  pTrace->callee->objectclass->Class;
                if (!zClass) zClass = "?";
                Tcl_ListObjAppendElement(0,pError,Tcl_NewStringObj("new",-1));
                Tcl_ListObjAppendElement(0,pError,Tcl_NewStringObj(zClass,-1));
                break;
            }
            case SEE_CALLTYPE_CALL: {
                struct SEE_string *pName;
                Tcl_ListObjAppendElement(0,pError,Tcl_NewStringObj("call",-1));
                pName = SEE_function_getname(pSeeInterp, pTrace->callee);
                if (pName) {
                    Tcl_ListObjAppendElement(0, pError, stringToObj(pName));
                } else {
                    Tcl_ListObjAppendElement(0,pError,Tcl_NewStringObj("?",-1));
                }
                break;
            }
            default:
                assert(0);
        }
    }

    Tcl_SetObjResult(pTclInterp, pError);
    return TCL_ERROR;
}

/*
 *---------------------------------------------------------------------------
 *
 * delInterpCmd --
 *
 *     This function is called when a SeeInterp is deleted.
 *
 * Results:
 *     None.
 *
 * Side effects:
 *
 *---------------------------------------------------------------------------
 */
static void 
delInterpCmd(clientData)
    ClientData clientData;             /* The SeeInterp data structure */
{
    SeeInterp *pTclSeeInterp = (SeeInterp *)clientData;
    if (pTclSeeInterp->pTrace) {
        Tcl_DecrRefCount(pTclSeeInterp->pTrace);
        pTclSeeInterp->pTrace = 0;
    }

    if (pTclSeeInterp->pLog) {
        Tcl_DecrRefCount(pTclSeeInterp->pLog);
        pTclSeeInterp->pLog = 0;
    }
  
    /* Try to make garbage collection happen now. This could be taken
     * out and (according to the garbage-collection folk) things might
     * run more smoothly. But leaving it in makes the system a bit more
     * debuggable, which is a much bigger concern.
     */
    memset(pTclSeeInterp->aTclObject, 0, 
        sizeof(SeeTclObject *) * OBJECT_HASH_SIZE
    );
    SEE_gcollect(&pTclSeeInterp->interp);

    GC_FREE(pTclSeeInterp);
}

typedef struct TclCmdArg TclCmdArg;
struct TclCmdArg {
  const char *zName;
  int isBoolean;
  Tcl_Obj *pVal;
};

static int
processArgs(pTcl, aOpt, nArg, apArg)
    Tcl_Interp *pTcl;
    TclCmdArg *aOpt;
    int nArg;
    Tcl_Obj **apArg;
{
    int ii;
    for (ii = 0; ii < nArg; ii++){
        Tcl_Obj *p = apArg[ii];
        size_t s = sizeof(TclCmdArg);
        int iIdx;
        if (Tcl_GetIndexFromObjStruct(pTcl, p, aOpt, s, "option", 0, &iIdx)) {
            return TCL_ERROR;
        }
        if (0 == aOpt[iIdx].isBoolean) {
            ii++;
            if (ii >= nArg) {
                Tcl_AppendResult(pTcl, 
                    "option ", aOpt[iIdx].zName, " requires an argument", 0
                );
                return TCL_ERROR;
            }
        }
        aOpt[iIdx].pVal = apArg[ii];
    }
    return TCL_OK;
}

/*
 *---------------------------------------------------------------------------
 *
 * interpEval --
 *
 *     This function does the work of the [$see_interp eval JAVASCRIPT]
 *     Tcl command. Syntax:
 *
 *         $interp eval ?OPTIONS? JAVASCRIPT
 *
 *     where OPTIONS are:
 *
 *         -file  FILENAME
 *         -scope JAVASCRIPT-OBJECT
 *
 * Results:
 *     Tcl result - TCL_OK or TCL_ERROR.
 *
 * Side effects:
 *     Executes the block of javascript passed as parameter pCode in
 *     the global context.
 *
 *---------------------------------------------------------------------------
 */
static int
interpEval(pTclSeeInterp, nArg, apArg)
    SeeInterp *pTclSeeInterp;     /* Interpreter */
    int nArg;
    Tcl_Obj **apArg;
{
    struct SEE_interpreter *pSee = &(pTclSeeInterp->interp);
    Tcl_Interp *pTclInterp = pTclSeeInterp->pTclInterp;
    int rc = TCL_OK;
    SEE_try_context_t try_ctxt;

    TclCmdArg aOptions[] = {
      {"-file",      0, 0},              /* 0 */
      {"-noresult",  1, 0},              /* 1 */
      {0,            0, 0}
    };

    Tcl_Obj *pFile;                     /* Value passed to -file option */
    Tcl_Obj *pCode;                     /* Javascript to evaluate */
    int isNoResult;                     /* True if -noresult */

    struct SEE_value res;               /* Result of script evaluation */

    if (nArg < 3) {
        Tcl_WrongNumArgs(pTclInterp, 1, apArg, "SUBCOMMAND ...");
        return TCL_ERROR;
    }
    if (processArgs(pTclInterp, aOptions, nArg - 3, &apArg[2])) {
        return TCL_ERROR;
    }
    pCode = apArg[nArg - 1];
    pFile = aOptions[0].pVal;
    isNoResult = (aOptions[1].pVal!=0);

    memset(&res, 0, sizeof(struct SEE_value));
    Tcl_ResetResult(pTclInterp);

    if (pTclSeeInterp->pTraceContext) {
        /* If there is a trace-context, then this method is being called
         * from within a trace callback. In this case use SEE_context_eval()
         */
        struct SEE_string input;
        memset(&input, 0, sizeof(struct SEE_string));
        input.data = Tcl_GetUnicodeFromObj(pCode, (int *)&input.length);
        SEE_TRY(pSee, try_ctxt) {
            SEE_context_eval(pTclSeeInterp->pTraceContext, &input, &res);
        }
    } else {
        struct SEE_input *pInput = SEE_input_utf8(pSee, Tcl_GetString(pCode));

        if( pFile ){
            pInput->filename = SEE_string_sprintf(
                pSee, "%s", Tcl_GetString(pFile)
            );
        }
        SEE_TRY(pSee, try_ctxt) {
            SEE_Global_eval(pSee, pInput, &res);
        }
        SEE_INPUT_CLOSE(pInput);
    }

    if (SEE_CAUGHT(try_ctxt)) {
        rc = handleJavascriptError(pTclSeeInterp, &try_ctxt);
    } else if (!isNoResult) {
        Tcl_SetObjResult(pTclInterp, primitiveValueToTcl(pTclSeeInterp, &res));
    }

    return rc;
}

static int
interpGlobalSet(pTclSeeInterp, pProp, pValue)
    SeeInterp *pTclSeeInterp;          /* Interpreter */
    Tcl_Obj *pProp;
    Tcl_Obj *pValue;
{
    struct SEE_value value;
    int rc;
    rc = objToValue(pTclSeeInterp, pValue, &value, 0);
    if (rc == TCL_OK) {
        SEE_OBJECT_PUTA(&pTclSeeInterp->interp, 
            (struct SEE_object *)(pTclSeeInterp->global.pNative), 
            Tcl_GetString(pProp), &value, 0
        );
    }
    return rc;
}

/*
 *---------------------------------------------------------------------------
 *
 * interpDebug --
 *
 *    Implementation of the [$interp debug] command. This command is
 *    not required for normal operation, but provides some sub-commands
 *    useful while debugging the system.
 *    
 *       $interp debug objects
 *       $interp debug alloc
 *
 *    (Probably there are more sub-commands, peers of "objects", to come)
 *
 * Results:
 *
 * Side effects:
 *
 *---------------------------------------------------------------------------
 */
static int
interpDebug(pTclSeeInterp, objc, objv)
    SeeInterp *pTclSeeInterp;          /* Interpreter */
    int objc;                          /* Number of arguments. */
    Tcl_Obj *CONST objv[];             /* Argument strings. */
{
    int iSlot;
    Tcl_Obj *pRet = Tcl_NewObj();
    Tcl_IncrRefCount(pRet);

    if (0 == strcmp("alloc", Tcl_GetString(objv[2]))){
        Tcl_Obj *pRet = Tcl_NewObj();
        int ii;

        const char *azString[6] = {
          "SeeTclObject structures allocated",
          "GC_get_heap_size",
          "GC_get_free_bytes",
          "GC_get_bytes_since_gc",
          "GC_get_total_bytes",
        };
        int aVal[5];

        memset(aVal, 0, sizeof(aVal));
        aVal[0] = iNumSeeTclObject;
#ifndef NO_HAVE_GC
        aVal[1] = (int)GC_get_heap_size();
        aVal[2] = (int)GC_get_free_bytes();
        aVal[3] = (int)GC_get_bytes_since_gc();
        aVal[4] = (int)GC_get_total_bytes();
#endif

        for (ii = 0; ii < 5; ii++){
          Tcl_ListObjAppendElement(0, pRet, Tcl_NewStringObj(azString[ii], -1));
          Tcl_ListObjAppendElement(0, pRet, Tcl_NewIntObj(aVal[ii]));
        }

        Tcl_SetObjResult(pTclSeeInterp->pTclInterp, pRet);
    } 
    else {
        for (iSlot = 0; iSlot < OBJECT_HASH_SIZE; iSlot++){
            SeeTclObject *pObject = pTclSeeInterp->aTclObject[iSlot];
            for ( ; pObject; pObject = pObject->pNext) {
                Tcl_ListObjAppendElement(0, pRet, pObject->pObj);
            }
        }
    
        Tcl_SetObjResult(pTclSeeInterp->pTclInterp, pRet);
        Tcl_DecrRefCount(pRet);
    }

    return TCL_OK;
}



/*
 *---------------------------------------------------------------------------
 *
 * interpCmd --
 *
 * Results:
 *
 * Side effects:
 *
 *---------------------------------------------------------------------------
 */
static int 
interpCmd(clientData, pTclInterp, objc, objv)
    ClientData clientData;             /* The SeeInterp data structure */
    Tcl_Interp *pTclInterp;            /* Current interpreter. */
    int objc;                          /* Number of arguments. */
    Tcl_Obj *CONST objv[];             /* Argument strings. */
{
    int rc = TCL_OK;
    int iChoice;
    SeeInterp *pTclSeeInterp = (SeeInterp *)clientData;
    struct SEE_interpreter *pSeeInterp = &pTclSeeInterp->interp;

    int nMin;
    int nMax;

    enum INTERP_enum {
        INTERP_DESTROY,               /* Destroy the interpreter */
        INTERP_EVAL,                  /* Evaluate some javascript */
        INTERP_TOSTRING,              /* Convert js value to a string */

        INTERP_NODE,
        INTERP_GLOBAL,

        /* Object management */
        INTERP_MAKE_TRANSIENT,        /* Declare an object eligible for GC */
        INTERP_MAKE_PERSISTENT,       /* Cancel a previous [make_transient] */

        /* Debugging API - not essential for normal operation. */
        INTERP_DEBUG,
        INTERP_EVENTS,
        INTERP_LOG,
        INTERP_TRACE,

        /* Dispatch a DOM event */
        INTERP_DISPATCH,
    };

    static const struct InterpSubCommand {
        const char *zCommand;
        enum INTERP_enum eSymbol;
        int nMinArgs;
        int nMaxArgs;
        char *zArgs;
    } aSubCommand[] = {
        {"destroy",     INTERP_DESTROY,     0, 0, ""},
        {"eval",        INTERP_EVAL,        0, -1, 0},
        {"tostring",    INTERP_TOSTRING,    1, 1, "JAVASCRIPT-VALUE"},

        {"node",        INTERP_NODE,        1, 1, "TCL-COMMAND"},

        /* Set properties on persistent objects */
        {"global",      INTERP_GLOBAL,      2, 2, "PROPERTY JAVASCRIPT-VALUE"},

        /* Events */
        {"dispatch",    INTERP_DISPATCH, 2, 2, "TARGET-COMMAND EVENT-COMMAND"},

        /* Object management */
        {"make_transient",  INTERP_MAKE_TRANSIENT,  1, 1, "TCL-COMMAND"},
        {"make_persistent", INTERP_MAKE_PERSISTENT, 1, 1, "TCL-COMMAND"},

        /* Debugging API */
        {"debug",       INTERP_DEBUG,       1, 1, "SUB-COMMAND"},
        {"trace",       INTERP_TRACE,       1, 1, "TCL-COMMAND"},
        {"log",         INTERP_LOG,         1, 1, "TCL-COMMAND"},
        {"events",      INTERP_EVENTS,      1, 1, "TCL-COMMAND"},
        {0, 0, 0, 0}
    };

    if (objc<2) {
        Tcl_WrongNumArgs(pTclInterp, 1, objv, "SUBCOMMAND ...");
        return TCL_ERROR;
    }
    if (Tcl_GetIndexFromObjStruct(pTclInterp, objv[1], aSubCommand, 
            sizeof(struct InterpSubCommand), "option", 0, &iChoice) 
    ){
        return TCL_ERROR;
    }

    nMin = aSubCommand[iChoice].nMinArgs;
    nMax = aSubCommand[iChoice].nMaxArgs;
    if ((nMin >= 0 && objc < (nMin + 2)) || (nMax >= 0 && objc < (nMax + 2))) {
        Tcl_WrongNumArgs(pTclInterp, 2, objv, aSubCommand[iChoice].zArgs);
        return TCL_ERROR;
    }

    switch (aSubCommand[iChoice].eSymbol) {

        /*
         * seeInterp eval ?OPTIONS? PROGRAM-TEXT
         * 
         *     Evaluate a javascript script.
         */
        case INTERP_EVAL: {
            rc = interpEval(pTclSeeInterp, objc, objv);
            break;
        }

        /*
         * seeInterp debug SUB-COMMAND
         */
        case INTERP_DEBUG: {
            rc = interpDebug(pTclSeeInterp, objc, objv);
            break;
        }

        /*
         * seeInterp node JAVASCRIPT-OBJECT
         */
        case INTERP_NODE: {
            createNode(pTclSeeInterp, objv[2]);
            break;
        }

        /*
         * seeInterp global PROPERTY JAVASCRIPT-VALUE
         */
        case INTERP_GLOBAL: {
            rc = interpGlobalSet(pTclSeeInterp, objv[2], objv[3]);
            break;
        }

        /*
         * seeInterp destroy
         *
         */
        case INTERP_DESTROY: {
            /* Deleting the command automatically calls delInterpCmd() */
            Tcl_DeleteCommand(pTclInterp, Tcl_GetString(objv[0]));
            break;
        }

        /*
         * $interp tostring VALUE
         */
        case INTERP_TOSTRING: {
            struct SEE_value val;
            struct SEE_value res;
            objToValue(pTclSeeInterp, objv[2], &val, 0);
            SEE_ToString(pSeeInterp, &val, &res);
            Tcl_SetObjResult(pTclInterp, stringToObj(res.u.string));
            break;
        }

        /*
         * $interp eventtarget
         */
        case INTERP_DISPATCH: {
            return eventDispatchCmd(clientData, pTclInterp, objc, objv);
        }

        /*
         * $interp trace TCL-COMMAND
         *
	 *   Set or clear the javascript-trace callback. See the 
         *   implementation of function seeTraceHook() for details.
         */
        case INTERP_TRACE: {
            assert(objc == 3);
            if (pTclSeeInterp->pTrace) {
                Tcl_DecrRefCount(pTclSeeInterp->pTrace);
                pTclSeeInterp->pTrace = 0;
            }
            if (strlen(Tcl_GetString(objv[2])) > 0) {
                pTclSeeInterp->pTrace = objv[2];
                Tcl_IncrRefCount(pTclSeeInterp->pTrace);
            }
            break;
        }

        /*
         * $interp make_transient TCL-COMMAND
         * $interp make_persistent TCL-COMMAND
         *
         *   Move an object from persistent to transient state, or the
         *   reverse. 
         */
        case INTERP_MAKE_TRANSIENT: {
            rc = makeObjectTransient(pTclSeeInterp, objv[2]);
            break;
        }

        case INTERP_MAKE_PERSISTENT: {
            rc = makeObjectPersistent(pTclSeeInterp, objv[2]);
            break;
        }

        case INTERP_EVENTS: {
            return eventDumpCmd(clientData, pTclInterp, objc, objv);
        }

        case INTERP_LOG: {
            Tcl_Obj *pLog = objv[2];
            if (pTclSeeInterp->pLog) {
                Tcl_DecrRefCount(pTclSeeInterp->pLog);
                pTclSeeInterp->pLog = 0;
            }
            if (strlen(Tcl_GetString(pLog))>0) {
                Tcl_IncrRefCount(pLog);
                pTclSeeInterp->pLog = pLog;
            }
            break;
        }
    }

    return rc;
}

static void
seeTraceHook(pSeeInterp, pThrowLoc, pContext, event)
    struct SEE_interpreter *pSeeInterp;
    struct SEE_throw_location *pThrowLoc;
    struct SEE_context *pContext;
    enum SEE_trace_event event;
{
    SeeInterp *pTclSee = (SeeInterp *)pSeeInterp;
    if (pTclSee->pTrace) {
        const int evalflags = (TCL_EVAL_DIRECT|TCL_EVAL_GLOBAL);
        const char *zEvent = "N/A";
        struct SEE_context *pSavedContext;
        int rc;

        Tcl_Obj *pEval = Tcl_DuplicateObj(pTclSee->pTrace);
        Tcl_IncrRefCount(pEval);

        switch (event) {
            case SEE_TRACE_CALL:      zEvent = "call";      break;
            case SEE_TRACE_RETURN:    zEvent = "return";    break;
            case SEE_TRACE_STATEMENT: zEvent = "statement"; break;
            case SEE_TRACE_THROW:     zEvent = "throw";     break;
        }
        Tcl_ListObjAppendElement(0, pEval, Tcl_NewStringObj(zEvent, -1));

        if (pThrowLoc->filename) {
            Tcl_Obj *pFilename = stringToObj(pThrowLoc->filename);
            Tcl_ListObjAppendElement(0, pEval, pFilename);
        } else {
            Tcl_ListObjAppendElement(0, pEval, Tcl_NewObj());
        }

        Tcl_ListObjAppendElement(0, pEval, Tcl_NewIntObj(pThrowLoc->lineno));

        pSavedContext = pTclSee->pTraceContext;
        pTclSee->pTraceContext = pContext;
        rc = Tcl_EvalObjEx(pTclSee->pTclInterp, pEval, evalflags);
        if (rc != TCL_OK) {
            Tcl_BackgroundError(pTclSee->pTclInterp);
        }
        pTclSee->pTraceContext = pSavedContext;

        Tcl_DecrRefCount(pEval);
    }
}

/*
 *---------------------------------------------------------------------------
 *
 * tclSeeInterp --
 *
 *     Implementation of [::see::interp].
 *
 *     Creates a new javascript interpreter object-command.
 *
 * Results:
 *     TCL_OK or TCL_ERROR.
 *
 * Side effects:
 *     See above.
 *
 *---------------------------------------------------------------------------
 */
static int 
tclSeeInterp(clientData, interp, objc, objv)
    ClientData clientData;             /* Unused */
    Tcl_Interp *interp;                /* Current interpreter. */
    int objc;                          /* Number of arguments. */
    Tcl_Obj *CONST objv[];             /* Argument strings. */
{
    char zCmd[64];
    SeeInterp *pInterp;
    if (objc != 2) {
        Tcl_WrongNumArgs(interp, 1, objv, "GLOBAL-OBJCOMMAND");
        return TCL_ERROR;
    }

    /* Allocate the interpreter structure and initialize the global object. */
    pInterp = (SeeInterp *)GC_MALLOC_UNCOLLECTABLE(sizeof(SeeInterp));
    memset(pInterp, 0, sizeof(SeeInterp));
    pInterp->pTclInterp = interp;
    initSeeTclObject(pInterp, &pInterp->global, objv[1]);
 
    /* Initialize the SEE interpreter. */
    SEE_interpreter_init_hostglobal(&pInterp->interp, 
        SEE_COMPAT_JS15|SEE_COMPAT_SGMLCOM|SEE_COMPAT_262_3B,
	(struct SEE_object *)&pInterp->global
    );
    pInterp->interp.trace = seeTraceHook;

    /* This call puts the global object in the hash table with the other
     * Tcl based objects. This is required so that references to 'window'
     * actually return a pointer to SEE_interpreter.Global.
     */
    findOrCreateObject(pInterp, objv[1], 1);
    interpTimeoutInit(pInterp, &pInterp->global);

    /* Create the tcl command used to access this javascript interpreter. */
    sprintf(zCmd, "::see::interp_%d", iSeeInterp++);
    Tcl_CreateObjCommand(interp, zCmd, interpCmd, pInterp, delInterpCmd);
    Tcl_SetResult(interp, zCmd, TCL_VOLATILE);

#ifndef NDEBUG
    if (1) {
        Tcl_CmdInfo cmdinfo;
        if (Tcl_GetCommandInfo(interp, "::tkhtml::instrument", &cmdinfo)) {
            pInterp->pInstrumentData = cmdinfo.objClientData;
        }
    }
#endif

    return TCL_OK;
}

static void throwTclError(p, rc)
    struct SEE_interpreter *p;
    int rc;
{
    if (rc!=TCL_OK) {
        SeeInterp *pTclSeeInterp = (SeeInterp *)p;

        Tcl_Interp *interp = pTclSeeInterp->pTclInterp;
        Tcl_Obj *pErrorInfo;
        Tcl_Obj *pErr;

        Tcl_Obj *pSaved = Tcl_GetObjResult(interp);

        pErrorInfo = Tcl_NewStringObj("errorInfo", -1);
        Tcl_IncrRefCount(pErrorInfo);
        pErr = Tcl_ObjGetVar2(interp, pErrorInfo, 0, TCL_GLOBAL_ONLY);
        pErr = Tcl_DuplicateObj(pErr);
        Tcl_IncrRefCount(pErr);
        if (pTclSeeInterp->pTclError) {
            Tcl_DecrRefCount(pTclSeeInterp->pTclError);
        }
        pTclSeeInterp->pTclError = pErr;
        Tcl_DecrRefCount(pErrorInfo);

        Tcl_SetObjResult(interp, pSaved);
        SEE_error_throw(p, p->Error, "%s", Tcl_GetStringResult(interp));
    }
}



/*
 *---------------------------------------------------------------------------
 *
 * callSeeTclFunction --
 *
 *     This is a helper function used to call the following methods of
 *     the supplied SeeTclObject (argument p):
 *
 *         Call Construct
 *
 *     TODO: Fix the "$this" argument. 
 *
 * Results: 
 *     See above.
 *
 * Side effects:
 *     None.
 *
 *---------------------------------------------------------------------------
 */
static void 
tclCallOrConstruct(zMethod, pInterp, pObj, pThis, argc, argv, pRes)
    const char *zMethod;
    struct SEE_interpreter *pInterp;
    struct SEE_object *pObj;
    struct SEE_object *pThis;
    int argc;
    struct SEE_value **argv;
    struct SEE_value *pRes;
{
    SeeTclObject *p = (SeeTclObject *)pObj;
    SeeInterp *pTclSeeInterp = (SeeInterp *)pInterp;
    Tcl_Interp *pTclInterp = pTclSeeInterp->pTclInterp;
    int rc;
    int ii;
    int nObj = 0;

    /* Make sure there is enough space to marshall the arguments */
    allocWordArray(pTclSeeInterp, p, argc + 2);

    p->apWord[p->nWord]     = Tcl_NewStringObj(zMethod, -1);
    p->apWord[p->nWord + 1] = Tcl_NewStringObj("THIS", 4);
    for (ii = 0; ii < argc; ii++) {
        Tcl_Obj *pArg = argValueToTcl(pTclSeeInterp, argv[ii], &nObj);
        p->apWord[p->nWord+2+ii] = pArg;
    }

    for (ii = 0; ii < (argc + 2); ii++) {
        Tcl_IncrRefCount(p->apWord[p->nWord + ii]);
    }
    rc = evalObjv(pTclInterp, p->nWord + argc + 2, p->apWord);
    for (ii = 0; ii < (argc + 2); ii++) {
        Tcl_DecrRefCount(p->apWord[p->nWord + ii]);
    }
    removeTransientRefs(pTclSeeInterp, nObj);
    throwTclError(pInterp, rc);

    rc = objToValue(pTclSeeInterp, Tcl_GetObjResult(pTclInterp), pRes, 0);
    throwTclError(pInterp, rc);
}

static void 
SeeTcl_Get(pInterp, pObj, pProp, pRes)
    struct SEE_interpreter *pInterp;
    struct SEE_object *pObj;
    struct SEE_string *pProp;
    struct SEE_value *pRes;
{
    SeeTclObject *p = (SeeTclObject *)pObj;
    SeeInterp *pTclSeeInterp = (SeeInterp *)pInterp;
    Tcl_Interp *pTclInterp = pTclSeeInterp->pTclInterp;
    struct SEE_object *pNative = (struct SEE_object *)p->pNative;

    Tcl_Obj *pScriptRes;
    int rc;
    int isCacheable = 0;

    /* Test if the requested property is stored in the pNative object.
     * If so, return this value instead of evaluating a Tcl script.
     *
     * The assumption is that the hash-lookup on the native object is
     * much faster than evaluating the Tcl command.
     */
    pProp = SEE_intern(pInterp, pProp);
    if (SEE_native_hasproperty(pInterp, pNative, pProp)) {
        SEE_native_get(pInterp, pNative, pProp, pRes);
        return;
    }

    /* Execute the Tcl script:
     *
     *     eval $obj Get $property
     */
    if (!p->pClass || Tcl_FindHashEntry(&p->pClass->aProperty, (char *)pProp)) {
        rc = callSeeTclMethod(pTclInterp, pTclSeeInterp->pLog, p,"Get",pProp,0);
        throwTclError(pInterp, rc);
        pScriptRes = Tcl_GetObjResult(pTclInterp);
        Tcl_IncrRefCount(pScriptRes);
        rc = objToValue(pTclSeeInterp, pScriptRes, pRes, &isCacheable);
        Tcl_DecrRefCount(pScriptRes);
        throwTclError(pInterp, rc);
    
        if (isCacheable) {
            SEE_native_put(pInterp, pNative, pProp, pRes, SEE_ATTR_INTERNAL);
        }
    } else {
        SEE_SET_UNDEFINED(pRes);
    }
}

static void 
SeeTcl_Put(pInterp, pObj, pProp, pValue, flags)
    struct SEE_interpreter *pInterp;
    struct SEE_object *pObj;
    struct SEE_string *pProp;
    struct SEE_value *pValue;
    int flags;
{
    SeeTclObject *pObject = (SeeTclObject *)pObj;
    SeeInterp *p = (SeeInterp *)pInterp;
    Tcl_Interp *pTclInterp = p->pTclInterp;
    struct SEE_object *pNative = (struct SEE_object *)pObject->pNative;

    int rc;
    int isNative;

    Tcl_Obj *pVal;
    int nObj = 0;

    pProp = SEE_intern(pInterp, pProp);
    isNative = SEE_OBJECT_HASPROPERTY(pInterp, pNative, pProp);

    if (!isNative) {
        pVal = argValueToTcl(p, pValue, &nObj);
        Tcl_IncrRefCount(pVal);
        rc = callSeeTclMethod(pTclInterp, p->pLog, pObject, "Put", pProp, pVal);
        Tcl_DecrRefCount(pVal);
        removeTransientRefs(p, nObj);
        throwTclError(pInterp, rc);
    }

    /* If the result of the [$obj Put] script was the literal string 
     * "native", then store this property in the pObject->native hash 
     * table.
     */
    if (isNative || 0 == strcmp(Tcl_GetStringResult(pTclInterp), "native")) {
        flags |= SEE_ATTR_INTERNAL;
        SEE_native_put(&p->interp, pNative, pProp, pValue, flags);
    }
}

static int 
SeeTcl_CanPut(pInterp, pObj, pProp)
    struct SEE_interpreter *pInterp;
    struct SEE_object *pObj;
    struct SEE_string *pProp;
{
    SeeTclObject *pObject = (SeeTclObject *)pObj;
    SeeInterp *pTclSeeInterp = (SeeInterp *)pInterp;
    Tcl_Interp *pTclInterp = pTclSeeInterp->pTclInterp;
    int rc;
    int ret;

    rc = callSeeTclMethod(pTclInterp, 0, pObject, "CanPut", pProp, 0);
    throwTclError(pInterp, rc);

    Tcl_Obj *pRes = Tcl_GetObjResult(pTclInterp);
    rc = Tcl_GetBooleanFromObj(pTclInterp, pRes, &ret);
    throwTclError(pInterp, rc);
    return ret;
}

static int 
SeeTcl_HasProperty(pInterp, pObj, pProp)
    struct SEE_interpreter *pInterp;
    struct SEE_object *pObj;
    struct SEE_string *pProp;
{
    SeeTclObject *p = (SeeTclObject *)pObj;
    SeeInterp *pTclSeeInterp = (SeeInterp *)pInterp;
    int rc;
    int ret = 0;
    struct SEE_object *pNative = (struct SEE_object *)p->pNative;

    if (p == &pTclSeeInterp->global) return 1;

    /* First check if the property is stored in the native hash table. */
    pProp = SEE_intern(pInterp, pProp);
    ret = SEE_OBJECT_HASPROPERTY(pInterp, pNative, pProp);

    if (!ret && (
        !p->pClass || Tcl_FindHashEntry(&p->pClass->aProperty, (char *)pProp)
    )) {
        Tcl_Interp *pTcl = pTclSeeInterp->pTclInterp;
        rc = callSeeTclMethod(pTcl, 0, p, "HasProperty", pProp, 0);
        throwTclError(pInterp, rc);
        rc = Tcl_GetBooleanFromObj(pTcl, Tcl_GetObjResult(pTcl), &ret);
        throwTclError(pInterp, rc);
    }

    return ret;
}
static int 
SeeTcl_Delete(pInterp, pObj, pProp)
    struct SEE_interpreter *pInterp;
    struct SEE_object *pObj;
    struct SEE_string *pProp;
{
    SeeTclObject *pObject = (SeeTclObject *)pObj;
    SeeInterp *pTclSeeInterp = (SeeInterp *)pInterp;
    Tcl_Interp *pTclInterp = pTclSeeInterp->pTclInterp;
    int rc;

    rc = callSeeTclMethod(pTclInterp, 0, pObject, "Delete", pProp, 0);
    throwTclError(pInterp, rc);

    return 0;
}

static void 
SeeTcl_DefaultValue(pInterp, pObj, pHint, pRes)
    struct SEE_interpreter *pInterp;
    struct SEE_object *pObj;
    struct SEE_value *pHint;
    struct SEE_value *pRes;
{
    SeeTclObject *pObject = (SeeTclObject *)pObj;
    SeeInterp *pTclSeeInterp = (SeeInterp *)pInterp;
    Tcl_Interp *pTclInterp = pTclSeeInterp->pTclInterp;
    int rc;

    rc = callSeeTclMethod(pTclInterp, 0, pObject, "DefaultValue", 0, 0);
    if (rc == TCL_OK) {
        objToValue(pTclSeeInterp, Tcl_GetObjResult(pTclInterp), pRes, 0);
    } else {
        struct SEE_string *pString;
        pString = SEE_string_sprintf(
            &pTclSeeInterp->interp, "%s", Tcl_GetString(pObject->pObj)
        );
        SEE_SET_STRING(pRes, pString);
    }
}
static struct SEE_enum * 
tclEnumerator(struct SEE_interpreter *, struct SEE_object *);
static struct SEE_enum *
SeeTcl_Enumerator(pInterp, pObj)
    struct SEE_interpreter *pInterp;
    struct SEE_object *pObj;
{
    return tclEnumerator(pInterp, pObj);
}
static void 
SeeTcl_Construct(pInterp, pObj, pThis, argc, argv, pRes)
    struct SEE_interpreter *pInterp;
    struct SEE_object *pObj;
    struct SEE_object *pThis;
    int argc;
    struct SEE_value **argv;
    struct SEE_value *pRes;
{
    tclCallOrConstruct("Construct", pInterp, pObj, pThis, argc, argv, pRes);
}
static void 
SeeTcl_Call(pInterp, pObj, pThis, argc, argv, pRes)
    struct SEE_interpreter *pInterp;
    struct SEE_object *pObj;
    struct SEE_object *pThis;
    int argc;
    struct SEE_value **argv;
    struct SEE_value *pRes;
{
    tclCallOrConstruct("Call", pInterp, pObj, pThis, argc, argv, pRes);
}
static int 
SeeTcl_HasInstance(pInterp, pObj, pInstance)
    struct SEE_interpreter *pInterp;
    struct SEE_object *pObj;
    struct SEE_value *pInstance;
{
    printf("HasInstance!!!\n");
    return 0;
}
static void *
SeeTcl_GetSecDomain(pInterp, pObj)
    struct SEE_interpreter *pInterp;
    struct SEE_object *pObj;
{
    printf("GetSecDomain!!!\n");
    return 0;
}

static struct SEE_objectclass SeeTclObjectVtbl = {
    "Object",
    SeeTcl_Get,
    SeeTcl_Put,
    SeeTcl_CanPut,
    SeeTcl_HasProperty,
    SeeTcl_Delete,
    SeeTcl_DefaultValue,
    SeeTcl_Enumerator,
    SeeTcl_Construct,
    SeeTcl_Call,
    SeeTcl_HasInstance,
    SeeTcl_GetSecDomain
};
static struct SEE_objectclass *getVtbl() {
    return &SeeTclObjectVtbl;
}


/* Sub-class of SEE_enum (v-table SeeTclEnumVtbl, see below) for iterating
 * through the properties of a Tcl-based object.
 */
typedef struct SeeTclEnum SeeTclEnum;
struct SeeTclEnum {
  struct SEE_enum base;

  /* Variables for iterating through Tcl properties */
  int iCurrent;
  int nString;
  struct SEE_string **aString;

  /* Enumerator for iterating through native properties */
  struct SEE_enum *pNativeEnum;
};

static struct SEE_string *
SeeTclEnum_Next(pSeeInterp, pEnum, pFlags)
    struct SEE_interpreter *pSeeInterp;
    struct SEE_enum *pEnum;
    int *pFlags;                          /* OUT: true for "do not enumerate" */
{
    SeeTclEnum *pSeeTclEnum = (SeeTclEnum *)pEnum;
    if (pSeeTclEnum->iCurrent < pSeeTclEnum->nString) {
        if (pFlags) *pFlags = 0;
        return pSeeTclEnum->aString[pSeeTclEnum->iCurrent++];
    }
    return SEE_ENUM_NEXT(pSeeInterp, pSeeTclEnum->pNativeEnum, pFlags);
}

static struct SEE_enumclass SeeTclEnumVtbl = {
  0,  /* Unused */
  SeeTclEnum_Next
};


static struct SEE_enum *
tclEnumerator(pInterp, pObj)
    struct SEE_interpreter *pInterp;
    struct SEE_object *pObj;
{
    SeeTclObject *pObject = (SeeTclObject *)pObj;
    SeeInterp *pTclSeeInterp = (SeeInterp *)pInterp;

    Tcl_Interp *pTclInterp = pTclSeeInterp->pTclInterp;

    Tcl_Obj *pRet = 0;       /* Return value of script */
    Tcl_Obj **apRet = 0;     /* List elements of pRet */
    int nRet = 0;            /* size of apString */

    SeeTclEnum *pEnum;
    int ii;

    int rc;

    rc = callSeeTclMethod(pTclInterp, 0, pObject, "Enumerator", 0, 0);
    throwTclError(pInterp, rc);

    pRet = Tcl_GetObjResult(pTclInterp);
    rc = Tcl_ListObjGetElements(pTclInterp, pRet, &nRet, &apRet);
    throwTclError(pInterp, rc);

    pEnum = SEE_malloc(&pTclSeeInterp->interp,
        sizeof(SeeTclEnum) + sizeof(struct SEE_String *) * nRet
    );
    pEnum->base.enumclass = &SeeTclEnumVtbl;
    pEnum->iCurrent = 0;
    pEnum->nString = nRet;
    pEnum->aString = (struct SEE_string **)(&pEnum[1]);
    
    for (ii = 0; ii < nRet; ii++) {
        pEnum->aString[ii] = SEE_string_sprintf(
             &pTclSeeInterp->interp, "%s", Tcl_GetString(apRet[ii])
        );
    }

    pEnum->pNativeEnum = SEE_native_enumerator(
        &pTclSeeInterp->interp, (struct SEE_object *)pObject->pNative
    );

    return (struct SEE_enum *)pEnum;
}

static int 
tclSeeAlloc(clientData, interp, objc, objv)
    ClientData clientData;             /* Unused */
    Tcl_Interp *interp;                /* Current interpreter. */
    int objc;                          /* Number of arguments. */
    Tcl_Obj *CONST objv[];             /* Argument strings. */
{
    Tcl_Obj *pRet = Tcl_NewObj();
    int ii;

    const char *azString[6] = {
          "SeeTclObject",
          "GC_get_heap_size",
          "GC_get_free_bytes",
          "GC_get_bytes_since_gc",
          "GC_get_total_bytes",
    };
    int aVal[5];

    memset(aVal, 0, sizeof(aVal));
    aVal[0] = iNumSeeTclObject;
#ifndef NO_HAVE_GC
    aVal[1] = (int)GC_get_heap_size();
    aVal[2] = (int)GC_get_free_bytes();
    aVal[3] = (int)GC_get_bytes_since_gc();
    aVal[4] = (int)GC_get_total_bytes();
#endif

    for (ii = 0; ii < 5; ii++){
        Tcl_ListObjAppendElement(0, pRet, Tcl_NewStringObj(azString[ii], -1));
        Tcl_ListObjAppendElement(0, pRet, Tcl_NewIntObj(aVal[ii]));
    }

    Tcl_SetObjResult(interp, pRet);
    return TCL_OK;
}

static int 
tclSeeCollect(clientData, interp, objc, objv)
    ClientData clientData;             /* Unused */
    Tcl_Interp *interp;                /* Current interpreter. */
    int objc;                          /* Number of arguments. */
    Tcl_Obj *CONST objv[];             /* Argument strings. */
{
#ifndef NO_HAVE_GC
    GC_gcollect();
#endif
    return TCL_OK;
}

static int
classCall(clientData, interp, objc, objv)
    ClientData clientData;             /* Pointer to class object */
    Tcl_Interp *interp;                /* Current interpreter. */
    int objc;                          /* Number of arguments. */
    Tcl_Obj *CONST objv[];             /* Argument strings. */
{
    return TCL_OK;
}
static void
classDelete(clientData)
    ClientData clientData;             /* Pointer to class object */
{
    SeeTclClass *p = (SeeTclClass *)clientData;
    Tcl_DeleteHashTable(&p->aProperty);
    ckfree((char *)p);
}

/*
 *---------------------------------------------------------------------------
 *
 * tclSeeClass --
 *
 *   Implementation of [::see::class].
 *
 *     ::see::class CLASS-NAME PROPERTY-LIST
 *
 * Results:
 *   TCL_OK or TCL_ERROR.
 *
 * Side effects:
 *   See above.
 *
 *---------------------------------------------------------------------------
 */
static int 
tclSeeClass(clientData, interp, objc, objv)
    ClientData clientData;             /* Unused */
    Tcl_Interp *interp;                /* Current interpreter. */
    int objc;                          /* Number of arguments. */
    Tcl_Obj *CONST objv[];             /* Argument strings. */
{
    SeeTclClass *p;
    Tcl_Obj **apObj;
    int nObj;

    int ii;
    char zBuf[256];

    if (objc != 3) {
        Tcl_WrongNumArgs(interp, 1, objv, "CLASS-NAME PROPERTY-LIST");
        return TCL_ERROR;
    }

    if (iSeeInterp > 0) {
        Tcl_AppendResult(
            interp, "::see::class cannot be called after ::see::interp", 0);
        return TCL_ERROR;
    }

    p = (SeeTclClass *)ckalloc(sizeof(SeeTclClass));
    memset(p, 0, sizeof(SeeTclClass));
    Tcl_InitHashTable(&p->aProperty, TCL_ONE_WORD_KEYS);

    if (Tcl_ListObjGetElements(interp, objv[2], &nObj, &apObj)) {
        return TCL_ERROR;
    }
    for (ii = 0; ii < nObj; ii++) {
        int isNew;
        struct SEE_string *str = SEE_intern_global(Tcl_GetString(apObj[ii]));
        Tcl_CreateHashEntry(&p->aProperty, (char *)str, &isNew);
    }
    sprintf(zBuf, "%s.class", Tcl_GetString(objv[1]));

    Tcl_CreateObjCommand(interp, zBuf, classCall, (char *)p, classDelete);
    return TCL_OK;
}

int 
Tclsee_Init(interp)
    Tcl_Interp *interp;
{
    /* Require stubs libraries version 8.4 or greater. */
#ifdef USE_TCL_STUBS
    if (Tcl_InitStubs(interp, "8.4", 0) == 0) {
        return TCL_ERROR;
    }
#endif

#ifndef NO_HAVE_GC
    GC_init();
#endif

    Tcl_PkgProvide(interp, "Tclsee", "0.1");
    Tcl_CreateObjCommand(interp, "::see::interp", tclSeeInterp, 0, 0);
    Tcl_CreateObjCommand(interp, "::see::alloc",  tclSeeAlloc, 0, 0);
    Tcl_CreateObjCommand(interp, "::see::format", tclSeeFormat, 0, 0);
    Tcl_CreateObjCommand(interp, "::see::gc",     tclSeeCollect, 0, 0);
    Tcl_CreateObjCommand(interp, "::see::class",  tclSeeClass, 0, 0);
    return TCL_OK;
}

#include "hv3events.c"
