Tcl Source Code

    iPtr->allocCache = (AllocCache *)TclpGetAllocCache();
#else
    iPtr->allocCache = NULL;
#endif
    iPtr->pendingObjDataPtr = NULL;
    iPtr->asyncReadyPtr = TclGetAsyncReadyPtr();
    iPtr->deferredCallbacks = NULL;
    iPtr->objectFoundation = NULL;

    /*
     * Create the core commands. Do it here, rather than calling Tcl_CreateObjCommand,
     * because it's faster (there's no need to check for a preexisting command
     * by the same name). Set the Tcl_CmdProc to NULL.
     */

 */

#ifdef HAVE_CONFIG_H
#include "config.h"
#endif
#include "tclInt.h"
#include "tclOOInt.h"
#include <assert.h>

/*
 * Commands in oo::define and oo::objdefine.
 */

static const struct {
    const char *name;

static const Tcl_MethodType classConstructor = {
    TCL_OO_METHOD_VERSION_CURRENT,
    "oo::class constructor",
    TclOO_Class_Constructor, NULL, NULL
};
















/*
 * The scripted part of the definitions of TclOO.
 */

#include "tclOOScript.h"

/*

    }
    list[idx] = NULL;
}

/*
 * ----------------------------------------------------------------------
 *
 * TclOOInitModuleObjCmd --
 *
 *	This is stub command that is mapped to the public commands of
 *	oo::class, oo::define, oo::objdefine and oo::object. When called
 *	it will initialize the OO system which will define the real tcl::oo
 *	commands and then call the command that was invoked. Will be called
 *	only once per interpreter since any call will define all of the
 *	real tcl::oo commands, overwriting the stubs.
 *
 * Result:
 *	TCL_OK if the setup succeeded.
 *
 * Side effects:
 *	Creates namespaces, commands, several classes and a number of
 *	callbacks. Upon return, the OO system is ready for use.
 *
 * ----------------------------------------------------------------------
 */

static int
TclOOInitModuleObjCmd(
    TCL_UNUSED(void *),
    Tcl_Interp *interp,
    int objc,
    Tcl_Obj *const objv[])
{
    Interp *iPtr = (Interp *)interp;
    if (iPtr->objectFoundation == NULL) {
	/*
	 * Build the core of the OO system.
	 */

	if (InitFoundation(interp) != TCL_OK) {
	    return TCL_ERROR;
	}

    }
    return Tcl_EvalObjv(interp, objc, objv, 0);
}

/*
 * ----------------------------------------------------------------------
 *
 * TclOOInit --
 *
 *	Called to initialise the OO system within an interpreter. Does
 *	not do the actual initialization but rather sets up stub commands
 *	that will do the initialization when called.
 *
 * Result:
 *	TCL_OK if the setup succeeded.
 *
 * Side effects:
 *	Creates stub commands for the public oo commands like oo::class etc.,
 *	subcommands for the info command and version variables. Also registers
 *	the tcl::oo package.
 *
 * ----------------------------------------------------------------------
 */
int
TclOOInit(
    Tcl_Interp *interp)		/* The interpreter to install into. */
{
    Tcl_CreateObjCommand(interp, "::oo::class",
	    TclOOInitModuleObjCmd, INT2PTR(0), NULL);
    Tcl_CreateObjCommand(interp, "::oo::define",
	    TclOOInitModuleObjCmd, INT2PTR(0), NULL);
    Tcl_CreateObjCommand(interp, "::oo::objdefine",
	    TclOOInitModuleObjCmd, INT2PTR(0), NULL);
    Tcl_CreateObjCommand(interp, "::oo::object",
	    TclOOInitModuleObjCmd, INT2PTR(0), NULL);


    Tcl_Command infoCmd;
    Tcl_Obj *mapDict;

    /*
     * Install into the [info] ensemble.
     */

    infoCmd = Tcl_FindCommand(interp, "info", NULL, TCL_GLOBAL_ONLY);
    if (infoCmd) {
	Tcl_CreateObjCommand(interp, "::oo::InfoObject",
	    TclOOInitModuleObjCmd, INT2PTR(0), NULL);
	Tcl_CreateObjCommand(interp, "::oo::InfoClass",
	    TclOOInitModuleObjCmd, INT2PTR(0), NULL);
	Tcl_GetEnsembleMappingDict(NULL, infoCmd, &mapDict);
	TclDictPutString(NULL, mapDict, "object", "::oo::InfoObject");
	TclDictPutString(NULL, mapDict, "class", "::oo::InfoClass");
	Tcl_SetEnsembleMappingDict(interp, infoCmd, mapDict);
    }

    /*
     * Set up the version and patchlevel variables. This used to be done by
     * the init script which is no longer used.
     */
    Tcl_SetVar2(interp, "::oo::patchlevel", NULL, TCLOO_PATCHLEVEL, 0);
    Tcl_SetVar2(interp, "::oo::version", NULL, TCLOO_VERSION, 0);



#ifndef TCL_NO_DEPRECATED
    Tcl_PkgProvideEx(interp, "TclOO", TCLOO_PATCHLEVEL,
	    &tclOOStubs);
#endif
    Tcl_PkgProvideEx(interp, "tcl::oo", TCLOO_PATCHLEVEL,
	    &tclOOStubs);

    if (Tcl_EvalEx(interp,
	"package ifneeded tcl::oo " TCLOO_PATCHLEVEL " {};"
	"package ifneeded TclOO " TCLOO_PATCHLEVEL " {};",
	TCL_INDEX_NONE, 0) != TCL_OK) {
	return TCL_ERROR;
    }
    return TCL_OK;
}

/*
 * ----------------------------------------------------------------------
 *
 * TclOOGetFoundation --
 *
 *	Get a reference to the OO core class system.
 *

 * ----------------------------------------------------------------------
 */

static int
InitFoundation(
    Tcl_Interp *interp)
{
    if (((Interp *) interp)->objectFoundation) {
	return TCL_OK;
    }

    static Tcl_ThreadDataKey tsdKey;
    ThreadLocalData *tsdPtr = (ThreadLocalData *)
	    Tcl_GetThreadData(&tsdKey, sizeof(ThreadLocalData));
    Foundation *fPtr = (Foundation *) Tcl_Alloc(sizeof(Foundation));
    Tcl_Namespace *define, *objdef;
    Tcl_Obj *namePtr;
    size_t i;

    /*
     * Initialize the structure that holds the OO system core. This is
     * attached to the interpreter via an assocData entry; not very efficient,
     * but the best we can do without hacking the core more.
     */

    memset(fPtr, 0, sizeof(Foundation));
    ((Interp *) interp)->objectFoundation = fPtr;
    fPtr->interp = interp;
    fPtr->ooNs = Tcl_FindNamespace(interp, "::oo", NULL, 0);
    assert(fPtr->ooNs != NULL);
    Tcl_Export(interp, fPtr->ooNs, "[a-z]*", 1);
    define = Tcl_CreateNamespace(interp, "::oo::define", fPtr, NULL);
    objdef = Tcl_CreateNamespace(interp, "::oo::objdefine", fPtr, NULL);
    fPtr->helpersNs = Tcl_CreateNamespace(interp, "::oo::Helpers", fPtr,
	    DeletedHelpersNamespace);
    Tcl_CreateNamespace(interp, "::oo::configuresupport", NULL, NULL);
    fPtr->epoch = 1;