The Perl Toolchain Summit needs more sponsors. If your company depends on Perl, please support this very important event.

/*	$Id: tixClass.c,v 1.1.1.1 2000/05/17 11:08:37 idiscovery Exp $	*/

/*
 * tixClass.c --
 *
 *	Implements the basic OOP class mechanism for the Tix Intrinsics.
 *
 * Copyright (c) 1996, Expert Interface Technologies
 *
 * See the file "license.terms" for information on usage and
 * redistribution of this file, and for a DISCLAIMER OF ALL
 * WARRANTIES.
 *
 */

/*
 *
 * Todo:
 *
 * (1) 	Problems: now a class shares some configspecs with the parent class.
 *    	If an option is declared as -static in the child class but not
 *	in the parent class, the parent class will still see this
 *	option as static.
 *
 */


#include <tk.h>
#include "tixPort.h"
#include "tixInt.h"
#include "tixItcl.h"

/*
 * Access control is not enabled yet.
 */
#define USE_ACCESS_CONTROL 0


static void		ClassTableDeleteProc _ANSI_ARGS_((
			    ClientData clientData, Tcl_Interp *interp));
static TixConfigSpec *	CopySpec _ANSI_ARGS_((TixConfigSpec *spec));
static TixClassRecord * CreateClassByName _ANSI_ARGS_((Tcl_Interp * interp,
			    char * classRec));
static TixClassRecord * CreateClassRecord _ANSI_ARGS_((Tcl_Interp *interp,
			    char * classRec, Tk_Window mainWindow,
			    int isWidget));
static void		FreeClassRecord _ANSI_ARGS_((
			    TixClassRecord *cPtr));
static void		FreeParseOptions _ANSI_ARGS_((
			    TixClassParseStruct * parsePtr));
static void		FreeSpec _ANSI_ARGS_((TixConfigSpec *spec));
static TixClassRecord * GetClassByName _ANSI_ARGS_((Tcl_Interp * interp,
			    char * classRec));
static TixConfigSpec *	InitAlias _ANSI_ARGS_((Tcl_Interp *interp,
			    TixClassRecord * cPtr, char *s));
static int		InitHashEntries _ANSI_ARGS_((
			    Tcl_Interp *interp,TixClassRecord * cPtr));
static int		InitClass _ANSI_ARGS_((Tcl_Interp * interp,
			    char * classRec, TixClassRecord * cPtr,
			    TixClassRecord * scPtr,
			    TixClassParseStruct * parsePtr));
static TixConfigSpec *	InitSpec _ANSI_ARGS_((Tcl_Interp * interp,
			    char * s, int isWidget));
static int 		ParseClassOptions _ANSI_ARGS_((
			    Tcl_Interp * interp, char * opts,
			    TixClassParseStruct * rec));
static int		ParseInstanceOptions _ANSI_ARGS_((
			    Tcl_Interp * interp,TixClassRecord * cPtr,
			    char *widRec, int argc, char** argv));
static int 		SetupAlias _ANSI_ARGS_((Tcl_Interp *interp,
			    TixClassRecord * cPtr, char *s));
static int		SetupAttribute _ANSI_ARGS_((Tcl_Interp *interp,
			    TixClassRecord * cPtr, char *s,
			    int which));
static int 		SetupMethod _ANSI_ARGS_((Tcl_Interp *interp,
			    TixClassRecord * cPtr, char *s));
static int 		SetupDefault _ANSI_ARGS_((Tcl_Interp *interp,
			    TixClassRecord * cPtr, char *s));
#if USE_ACCESS_CONTROL
static int 		SetupSubWidget _ANSI_ARGS_((Tcl_Interp *interp,
			    TixClassRecord * cPtr, char *s));
#endif
static int 		SetupSpec _ANSI_ARGS_((Tcl_Interp *interp,
			    TixClassRecord * cPtr, char *s,
			    int isWidget));

TIX_DECLARE_CMD(Tix_CreateWidgetCmd);
TIX_DECLARE_CMD(Tix_CreateInstanceCmd);
TIX_DECLARE_CMD(Tix_InstanceCmd);
TIX_DECLARE_CMD(Tix_UninitializedClassCmd);

/*
 * Hash tables used to store the classes and class specs.
 */

#define GetClassTable(interp) _TixGetHashTable(interp, "tixClassTab",  ClassTableDeleteProc)
#define GetSpecTable(interp)  _TixGetHashTable(interp, "tixSpecTab", NULL)

static char * TIX_EMPTY_STRING = "";


/*----------------------------------------------------------------------
 * GetClassByName --
 *
 *	Return a class struct if it has been created.
 *
 *----------------------------------------------------------------------
 */

static TixClassRecord *
GetClassByName(interp, classRec)
    Tcl_Interp * interp;
    char * classRec;
{
    Tcl_HashEntry *hashPtr;

    hashPtr = Tcl_FindHashEntry(GetClassTable(interp), classRec);
    if (hashPtr) {
	return (TixClassRecord *)Tcl_GetHashValue(hashPtr);
    } else {
	return NULL;
    }
}

static TixClassRecord *
CreateClassByName(interp, classRec)
    Tcl_Interp * interp;
    char * classRec;
{
    TixClassRecord * cPtr;
    TixInterpState state;

    TixSaveInterpState(interp, &state);
    cPtr = GetClassByName(interp, classRec);
    if (cPtr == NULL) {
	if (Tix_GlobalVarEval(interp, classRec, ":AutoLoad", (char*)NULL)
	        == TCL_ERROR){
	    cPtr = NULL;
	} else {
	    cPtr = GetClassByName(interp, classRec);
	}
    }
    TixRestoreInterpState(interp, &state);

    return cPtr;
}

/*----------------------------------------------------------------------
 * CreateClassRecord --
 *
 *	Create a class record for the definiton of a new class, or return
 *	error if the class already exists.
 *
 *----------------------------------------------------------------------
 */

static TixClassRecord *
CreateClassRecord(interp, classRec, mainWindow, isWidget)
    Tcl_Interp * interp;
    char * classRec;
    Tk_Window mainWindow;
    int isWidget;
{
    Tcl_HashEntry *hashPtr;
    int isNew;
    TixClassRecord * cPtr;

    hashPtr = Tcl_CreateHashEntry(GetClassTable(interp), classRec, &isNew);

    if (isNew) {
	cPtr = (TixClassRecord *)ckalloc(sizeof(TixClassRecord));
#if USE_ACCESS_CONTROL
	cPtr->next       = NULL;
#endif
	cPtr->superClass = NULL;
	cPtr->isWidget   = isWidget;
	cPtr->className  = tixStrDup(classRec);
	cPtr->ClassName  = NULL;
	cPtr->nSpecs     = 0;
	cPtr->specs      = 0;
	cPtr->nMethods   = 0;
	cPtr->methods    = 0;
	cPtr->mainWindow = mainWindow;
	cPtr->parsePtr	 = NULL;
	cPtr->initialized= 0;
	Tix_SimpleListInit(&cPtr->unInitSubCls);
	Tix_SimpleListInit(&cPtr->subWDefs);

#if USE_ACCESS_CONTROL
	Tix_SimpleListInit(&cPtr->subWidgets);
#endif

	Tcl_SetHashValue(hashPtr, (char*)cPtr);
	return cPtr;
    } else {

	/*
	 * We don't allow redefinition of classes
	 */

	Tcl_ResetResult(interp);
	Tcl_AppendResult(interp, "Class \"", classRec, "\" redefined", NULL);
	return NULL;
    }
}

/*----------------------------------------------------------------------
 * Tix_ClassCmd
 *
 * 	Create a class record for a Tix class.
 *
 * argv[0] = "tixClass" or "tixWidgetClass"
 * argv[1] = class
 * argv[2] = arglist
 *----------------------------------------------------------------------
 */

TIX_DEFINE_CMD(Tix_ClassCmd)
{
    int	isWidget, code = TCL_OK;
    TixClassParseStruct * parsePtr;
    TixClassRecord * cPtr, * scPtr;
    char * classRec = argv[1];
    Tk_Window mainWindow = (Tk_Window)clientData;
    DECLARE_ITCL_NAMESP(nameSp, interp);

    if (strcmp(argv[0], "tixClass")==0) {
	isWidget = 0;
    } else {
	isWidget = 1;
    }

    if (argc != 3) {
	return Tix_ArgcError(interp, argc, argv, 1, "className {...}");
    }
    if (!TixItclSetGlobalNameSp(&nameSp, interp)) {
	parsePtr = NULL;
        code = TCL_ERROR;
	goto done;
    }

    parsePtr = (TixClassParseStruct *)ckalloc(sizeof(TixClassParseStruct));
    if (ParseClassOptions(interp, argv[2], parsePtr) != TCL_OK) {
	ckfree((char*)parsePtr);
	parsePtr = NULL;
	code = TCL_ERROR;
	goto done;
    }

    cPtr = GetClassByName(interp, classRec);
    if (cPtr == NULL) {
	cPtr = CreateClassRecord(interp, classRec, mainWindow, isWidget);
	if (cPtr == NULL) {
	    code = TCL_ERROR;
	    goto done;
	}
    }
    if (cPtr->initialized) {
	Tcl_ResetResult(interp);
	Tcl_AppendResult(interp, "Class \"", classRec, "\" redefined", NULL);
	code = TCL_ERROR;
	goto done;
    }

    /*
     * (2) Set up the superclass
     */

    if (!parsePtr->superClass || strlen(parsePtr->superClass) == 0) {
	scPtr = NULL;
    }
    else {
	/*
	 * Create the superclass's record if it does not exist yet.
	 */
	scPtr = GetClassByName(interp, parsePtr->superClass);
	if (scPtr == NULL) {
	    scPtr = CreateClassByName(interp, parsePtr->superClass);
	    if (scPtr == NULL) {
		/*
		 * The superclass cannot be autoloaded. We create a
		 * empty class record. This record may later be filled
		 * by a tixClass call (which may be initiated by a
		 * "source" call by the the application, or by SAM).
		 */
		scPtr = CreateClassRecord(interp, parsePtr->superClass,
			mainWindow, isWidget);
		if (scPtr == NULL) {
		    code = TCL_ERROR;
		    goto done;
		}
	    }
	}
    }
    cPtr->superClass = scPtr;

    if (scPtr == NULL || scPtr->initialized == 1) {
	/*
	 * It is safe to initialized the class now.
	 */
	code = InitClass(interp, classRec, cPtr, scPtr, parsePtr);
	FreeParseOptions(parsePtr);
	cPtr->parsePtr = NULL;
    } else {
	/*
	 * This class has an uninitialized superclass. We wait until the
	 * superclass is initialized before we initialize this class.
	 */
	Tix_SimpleListAppend(&scPtr->unInitSubCls, (char*)cPtr, 0);
	Tcl_CreateCommand(interp, cPtr->className,
		Tix_UninitializedClassCmd, (ClientData)cPtr, NULL);
	cPtr->parsePtr = parsePtr;
    }

done:
    TixItclRestoreGlobalNameSp(&nameSp, interp);
    if (code == TCL_ERROR) {
	if (parsePtr != NULL) {
	    FreeParseOptions(parsePtr);
	}
    }
    return code;
}

static int
ParseClassOptions(interp, opts, parsePtr)
    Tcl_Interp * interp;
    char * opts;
    TixClassParseStruct * parsePtr;
{
    int	   i;
    char * buff, *s, *p;
    int code = TCL_OK;

    parsePtr->alias		= TIX_EMPTY_STRING;
    parsePtr->configSpec	= TIX_EMPTY_STRING;
    parsePtr->ClassName		= TIX_EMPTY_STRING;
    parsePtr->def		= TIX_EMPTY_STRING;
    parsePtr->flag		= TIX_EMPTY_STRING;
    parsePtr->forceCall		= TIX_EMPTY_STRING;
    parsePtr->isStatic		= TIX_EMPTY_STRING;
    parsePtr->method		= TIX_EMPTY_STRING;
    parsePtr->readOnly		= TIX_EMPTY_STRING;
    parsePtr->subWidget		= TIX_EMPTY_STRING;
    parsePtr->superClass	= TIX_EMPTY_STRING;
    parsePtr->isVirtual		= TIX_EMPTY_STRING;

    parsePtr->optArgv		= NULL;

    /*
     * Get rid of the comments
     */
    buff = (char*)ckalloc((strlen(opts)+1) * sizeof(char));
    for (s=opts,p=buff; *s;) {
	/* Skip starting spaces */
	while (isspace(*s)) {
	    s++;
	}
	if (*s == '#') {
	    while (*s && *s != '\n') {
		s++;
	    }
	    if (*s) {
		s++;
	    }
	    continue;
	}
	while (*s && *s != '\n') {
	    *p++ = *s++;
	}
	if (*s) {
	    *p++ = *s++;
	}
    }
    *p = '\0';

    if (Tcl_SplitList(interp, buff, &parsePtr->optArgc, &parsePtr->optArgv)
	    != TCL_OK) {
	code = TCL_ERROR;
	goto done;
    }

    if ((parsePtr->optArgc %2) == 1) {
	Tcl_AppendResult(interp, "value for \"",
		parsePtr->optArgv[parsePtr->optArgc-1],
	        "\" missing", (char*)NULL);
	code = TCL_ERROR;
	goto done;
    }
    for (i=0; i<parsePtr->optArgc; i+=2) {
	if (strcmp(parsePtr->optArgv[i], "-alias") == 0) {
	    parsePtr->alias = parsePtr->optArgv[i+1];
	}
	else if (strcmp(parsePtr->optArgv[i], "-configspec") == 0) {
	    parsePtr->configSpec = parsePtr->optArgv[i+1];
	}
	else if (strcmp(parsePtr->optArgv[i], "-classname") == 0) {
	    parsePtr->ClassName = parsePtr->optArgv[i+1];
	}
	else if (strcmp(parsePtr->optArgv[i], "-default") == 0) {
	    parsePtr->def = parsePtr->optArgv[i+1];
	}
	else if (strcmp(parsePtr->optArgv[i], "-flag") == 0) {
	    parsePtr->flag = parsePtr->optArgv[i+1];
	}
	else if (strcmp(parsePtr->optArgv[i], "-forcecall") == 0) {
	    parsePtr->forceCall = parsePtr->optArgv[i+1];
	}
	else if (strcmp(parsePtr->optArgv[i], "-method") == 0) {
	    parsePtr->method = parsePtr->optArgv[i+1];
	}
	else if (strcmp(parsePtr->optArgv[i], "-readonly") == 0) {
	    parsePtr->readOnly = parsePtr->optArgv[i+1];
	}
	else if (strcmp(parsePtr->optArgv[i], "-static") == 0) {
	    parsePtr->isStatic = parsePtr->optArgv[i+1];
	}
#if USE_ACCESS_CONTROL
	else if (strcmp(parsePtr->optArgv[i], "-subwidget") == 0) {
	    parsePtr->subWidget = parsePtr->optArgv[i+1];
	}
#endif
	else if (strcmp(parsePtr->optArgv[i], "-superclass") == 0) {
	    parsePtr->superClass = parsePtr->optArgv[i+1];
	}
	else if (strcmp(parsePtr->optArgv[i], "-virtual") == 0) {
	    parsePtr->isVirtual = parsePtr->optArgv[i+1];
	}
	else {
	    Tcl_AppendResult(interp, "unknown parsePtr->option \"",
		parsePtr->optArgv[i], "\"", (char*)NULL);
	    code = TCL_ERROR;
	    goto done;
	}
    }

  done:
    if (code != TCL_OK) {
	if (parsePtr->optArgv != NULL) {
	    ckfree((char*)parsePtr->optArgv);
	    parsePtr->optArgv = NULL;
	}
    }
    ckfree((char*)buff);
    return code;
}

static void
FreeParseOptions(parsePtr)
    TixClassParseStruct * parsePtr;
{
    if (parsePtr->optArgv) {
	ckfree((char*)parsePtr->optArgv);
    }
    ckfree((char*)parsePtr);
}

/*----------------------------------------------------------------------
 * InitClass --
 *
 * 	Initialize the class record using the arguments supplied by the
 *	tixClass and tixWidgetClass commands.
 *
 * Results:
 *	Standard Tcl result.
 *
 * Side effects:
 *	The given class is initialized.
 *----------------------------------------------------------------------
 */

static int
InitClass(interp, classRec, cPtr, scPtr, parsePtr)
    Tcl_Interp * interp;
    char * classRec;
    TixClassRecord * cPtr;
    TixClassRecord * scPtr;
    TixClassParseStruct * parsePtr;
{
    int code = TCL_OK;
    int i, flag;
    int isWidget = cPtr->isWidget;
    Tix_ListIterator li;
    TixClassRecord * subPtr;

    cPtr->ClassName = tixStrDup(parsePtr->ClassName);

    /*
     * (3) Set up the methods.
     */
    if (SetupMethod(interp, cPtr, parsePtr->method) != TCL_OK) {
	code = TCL_ERROR;
	goto done;
    }

    /* (4) Set up the major configspecs */
    if (SetupSpec(interp, cPtr, parsePtr->configSpec, isWidget) != TCL_OK) {
	code = TCL_ERROR;
	goto done;
    }

    /*
     * (5) Set up the aliases
     */

    /* (5.1)Create the alias configSpec's */
    if (parsePtr->alias && *parsePtr->alias) {
	if (SetupAlias(interp, cPtr, parsePtr->alias) != TCL_OK) {
	    code = TCL_ERROR;
	    goto done;
	}
    }

    /*
     * We are done with the class record. Now let's put the flags into
     * a hash table so then they can be retrived quickly whenever we call
     * the "$widget config" method
     */

    if (InitHashEntries(interp, cPtr)!=TCL_OK) {
	code = TCL_ERROR;
	goto done;
    }

    /*
     * (5.2) Initialize the alias configSpec's
     */
    for (i=0; i<cPtr->nSpecs; i++) {
	if (cPtr->specs[i]->isAlias) {
	    cPtr->specs[i]->realPtr =
	      Tix_FindConfigSpecByName(interp, cPtr, cPtr->specs[i]->dbName);
	}
    }

    /*
     * (6) Set up the attributes of the specs
     */
    if (parsePtr->isStatic  && *parsePtr->isStatic) {
	if (SetupAttribute(interp, cPtr, parsePtr->isStatic, FLAG_STATIC)
		!= TCL_OK) {
	    code = TCL_ERROR;
	    goto done;
	}
    }
    if (parsePtr->readOnly  && *parsePtr->readOnly) {
	if (SetupAttribute(interp,cPtr,parsePtr->readOnly, FLAG_READONLY)
		!=TCL_OK) {
	    code = TCL_ERROR;
	    goto done;
	}
    }
    if (parsePtr->forceCall  && *parsePtr->forceCall) {
	if (SetupAttribute(interp,cPtr,parsePtr->forceCall,FLAG_FORCECALL)
		!=TCL_OK) {
	    code = TCL_ERROR;
	    goto done;
	}
    }

    /* (7) Record the default options */
    if (SetupDefault(interp, cPtr, parsePtr->def) != TCL_OK) {
	code = TCL_ERROR;
	goto done;
    }

#if USE_ACCESS_CONTROL
    /* (8) Set up the SubWidget specs */
    if (isWidget) {
	if (SetupSubWidget(interp, cPtr, parsePtr->subWidget) != TCL_OK) {
	    code = TCL_ERROR;
	    goto done;
	}
    }
#endif

    /*
     * Set up the TCL array variable to store some information about the
     * class. This is compatible with the old Tix and it also speeds up
     * some operations because the look-up of these variables are done
     * by hash tables.
     */
    flag = TCL_GLOBAL_ONLY;
    if (parsePtr->superClass) {
	Tcl_SetVar2(interp, classRec, "superClass", parsePtr->superClass,flag);
    } else {
	Tcl_SetVar2(interp, classRec, "superClass", "", flag);
    }

    Tcl_SetVar2(interp, classRec, "className",     classRec,            flag);
    Tcl_SetVar2(interp, classRec, "ClassName",     parsePtr->ClassName, flag);
    Tcl_SetVar2(interp, classRec, "options",       parsePtr->flag,      flag);
    Tcl_SetVar2(interp, classRec, "forceCall",     parsePtr->forceCall, flag);
    Tcl_SetVar2(interp, classRec, "defaults",      parsePtr->def   ,    flag);
    Tcl_SetVar2(interp, classRec, "methods",       parsePtr->method,    flag);
    Tcl_SetVar2(interp, classRec, "staticOptions", parsePtr->isStatic,  flag);

    if (parsePtr->isVirtual) {
	Tcl_SetVar2(interp, classRec, "virtual",   "1",        flag);
    } else {
	Tcl_SetVar2(interp, classRec, "virtual",   "0",        flag);
    }

    if (isWidget) {
	Tcl_SetVar2(interp, classRec, "isWidget",  "1",        flag);
    } else {
	Tcl_SetVar2(interp, classRec, "isWidget",  "0",        flag);
    }

    /*
     * Now create the instantiation command.
     */
    if (isWidget) {
	Tcl_CreateCommand(interp, cPtr->className, Tix_CreateWidgetCmd,
		(ClientData)cPtr, NULL);
    } else {
	Tcl_CreateCommand(interp, cPtr->className, Tix_CreateInstanceCmd,
		(ClientData)cPtr, NULL);
    }

    /*
     * Create an "AutoLoad" command. This is needed so that class
     * definitions can be auto-loaded properly
     */
    if (Tix_GlobalVarEval(interp, "proc ", cPtr->className, ":AutoLoad {} {}",
	    (char *) NULL) != TCL_OK) {
	code = TCL_ERROR;
	goto done;
    }

    cPtr->initialized = 1;

    /*
     * Complete the initialization of all the partially initialized
     * sub-classes.
     */

    Tix_SimpleListIteratorInit(&li);
    for (Tix_SimpleListStart(&cPtr->unInitSubCls, &li);
	     !Tix_SimpleListDone(&li);
	     Tix_SimpleListNext(&cPtr->unInitSubCls, &li)) {

	subPtr = (TixClassRecord*)li.curr;
	code = InitClass(interp, subPtr->className, subPtr, cPtr,
		subPtr->parsePtr);

	if (code == TCL_OK) {
	    if (subPtr->parsePtr) {
		FreeParseOptions(subPtr->parsePtr);
	    }
	    subPtr->parsePtr = NULL;
	    Tix_SimpleListDelete(&cPtr->unInitSubCls, &li);
	} else {
	    /*
	     * (ToDo) Tix is not in a stable state. Some variables
	     * have not been freed.
	     */
	    goto done;
	}
    }

  done:
    return code;
}

/*
 *----------------------------------------------------------------------
 * FreeClassRecord --
 *
 *	Frees the data associated with a class.
 *
 * Results:
 *	None.
 *
 * Side effects:
 *	The Tix_InstanceCmd cannot be called afterwards.
 *----------------------------------------------------------------------
 */

static void
FreeClassRecord(cPtr)
    TixClassRecord *cPtr;
{
    int i;
    Tix_ListIterator li;

    if (cPtr->className) {
	ckfree(cPtr->className);
    }
    if (cPtr->ClassName) {
	ckfree(cPtr->ClassName);
    }
    for (i=0; i<cPtr->nSpecs; i++) {
	FreeSpec(cPtr->specs[i]);
    }
    if (cPtr->specs) {
	ckfree((char*)cPtr->specs);
    }
    for (i=0; i<cPtr->nMethods; i++) {
	ckfree(cPtr->methods[i]);
    }
    if (cPtr->methods) {
	ckfree((char*)cPtr->methods);
    }

    Tix_SimpleListIteratorInit(&li);
    for (Tix_SimpleListStart(&cPtr->unInitSubCls, &li);
	     !Tix_SimpleListDone(&li);
	     Tix_SimpleListNext(&cPtr->unInitSubCls, &li)) {
	Tix_SimpleListDelete(&cPtr->unInitSubCls, &li);
    }
    Tix_SimpleListIteratorInit(&li);
    for (Tix_SimpleListStart(&cPtr->subWDefs, &li);
	     !Tix_SimpleListDone(&li);
	     Tix_SimpleListNext(&cPtr->subWDefs, &li)) {

	Tix_SubwidgetDef * defPtr = (Tix_SubwidgetDef*)li.curr;
	Tix_SimpleListDelete(&cPtr->subWDefs, &li);

	ckfree((char*)defPtr->spec);
	ckfree((char*)defPtr->value);
	ckfree((char*)defPtr);
    }

    if (cPtr->parsePtr) {
	FreeParseOptions(cPtr->parsePtr);
    }

    ckfree((char*)cPtr);
}

TIX_DEFINE_CMD(Tix_UninitializedClassCmd)
{
    TixClassRecord * cPtr, *scPtr;

    cPtr = (TixClassRecord *)clientData;
    for (scPtr = cPtr->superClass; scPtr != NULL && scPtr->superClass != NULL;
	    scPtr = scPtr->superClass) {
	;
    }
    if (scPtr != NULL) {
	Tcl_AppendResult(interp, "Superclass \"", scPtr->className,
	        "\" not defined", NULL);
    } else {
	Tcl_AppendResult(interp, "Unknown Tix internal error", NULL);
    }

    return TCL_ERROR;
}


/*----------------------------------------------------------------------
 * Tix_CreateInstanceCmd --
 *
 * 	Create an instance object of a normal Tix class.
 *
 * argv[0]  = object name.
 * argv[1+] = args
 *----------------------------------------------------------------------
 */

TIX_DEFINE_CMD(Tix_CreateInstanceCmd)
{
    TixClassRecord * cPtr;
    char * widRec;
    int i, code = TCL_OK;
    TixConfigSpec * spec;
    char * value;
    DECLARE_ITCL_NAMESP(nameSp, interp);

    if (argc <= 1) {
	return Tix_ArgcError(interp, argc, argv, 1, "name ?arg? ...");
    }

    cPtr = (TixClassRecord *)clientData;
    widRec = argv[1];

    if (!TixItclSetGlobalNameSp(&nameSp, interp)) {
        code = TCL_ERROR;
	goto done;
    }

    Tcl_SetVar2(interp, widRec, "className", cPtr->className, TCL_GLOBAL_ONLY);
    Tcl_SetVar2(interp, widRec, "ClassName", cPtr->ClassName, TCL_GLOBAL_ONLY);
    Tcl_SetVar2(interp, widRec, "context",   cPtr->className, TCL_GLOBAL_ONLY);

    /* This is the command that access the widget */
    Tcl_CreateCommand(interp, widRec, Tix_InstanceCmd,
	(ClientData)cPtr, NULL);

    /* Set up the widget record according to defaults and arguments */
    ParseInstanceOptions(interp, cPtr, widRec, argc-2, argv+2);

    /* Call the constructor method */
    if (Tix_CallMethod(interp, cPtr->className, widRec, "Constructor",
		0, 0) != TCL_OK) {
	code = TCL_ERROR;
	goto done;
    }

    /*
     * %% warning. configuration methods for -forcecall options must
     * *not* assume that the value in the widget record has been
     * validated!
     *
     * todo: please explain the above in the programming guide.
     */
    for (i=0; i<cPtr->nSpecs; i++) {
	spec = cPtr->specs[i];
	if (spec->forceCall) {
	  value = Tcl_GetVar2(interp, widRec, spec->argvName,
	      TCL_GLOBAL_ONLY);
	  if (Tix_CallConfigMethod(interp, cPtr, widRec, spec, value)!=TCL_OK){
	      code = TCL_ERROR;
	      goto done;
	  }
	}
    }

    Tcl_SetResult(interp, widRec, TCL_VOLATILE);

  done:
    TixItclRestoreGlobalNameSp(&nameSp, interp);
    return code;
}

/*----------------------------------------------------------------------
 * Tix_InstanceCmd
 *
 * 	Redirect the method calls to the class methods
 *
 * argv[0]  = widget name
 * argv[1]  = method name
 * argv[2+] = arglist
 */
TIX_DEFINE_CMD(Tix_InstanceCmd)
{
    TixClassRecord * cPtr;
    char * widRec = argv[0];
    char * method = argv[1];
    char * classRec;
    char * methodName;		/* full name of the method -- method may be
				 * abbreviated */
    int len;
    int code;
    DECLARE_ITCL_NAMESP(nameSp, interp);

    cPtr = (TixClassRecord *)clientData;
    classRec = cPtr->className;

    if (argc <= 1) {
	return Tix_ArgcError(interp, argc, argv, 1, "option ...");
    }

    Tk_Preserve((ClientData) cPtr);
    if (!TixItclSetGlobalNameSp(&nameSp, interp)) {
        code = TCL_ERROR;
	goto done;
    }

    len = strlen(method);

    if ((methodName = Tix_FindPublicMethod(interp, cPtr, method)) == NULL) {
	code = Tix_UnknownPublicMethodError(interp, cPtr, widRec, method);
	goto done;
    }

    if (Tix_CallMethod(interp, classRec, widRec, methodName,
	    argc-2, argv+2) == TCL_OK) {
	code = TCL_OK;
	goto done;
    }
    /*
     * We will have an "unknown error" return value here, now
     * try to execute the command as a "Intrinsics" command
     *		configure, cget, subwidget or subwidgets
     */
    else if (strncmp(method, "configure", len) == 0) {
	Tcl_ResetResult(interp);

	if (argc==2) {
	    code = Tix_QueryAllOptions(interp, cPtr, widRec);
	    goto done;
	}
	else if (argc == 3) {
	    code = Tix_QueryOneOption(interp, cPtr, widRec, argv[2]);
	    goto done;
	} else {
	    code = Tix_ChangeOptions(interp, cPtr, widRec, argc-2, argv+2);
	    goto done;
	}
    }
    else if (strncmp(method, "cget", len) == 0) {
	Tcl_ResetResult(interp);

	if (argc == 3) {
	    code = Tix_GetVar(interp, cPtr, widRec, argv[2]);
	    goto done;
	} else {
	    code = Tix_ArgcError(interp, argc, argv, 2, "-flag");
	    goto done;
	}
    }
    else if (cPtr->isWidget && strncmp(method, "subwidget", len) == 0) {

#if 0
	/* Subwidget protection is not yet implemented */
	Tix_SubWidgetSpec * ssPtr;
	ssPtr = GetSubWidgetSpec(cPtr, argv[2]);
#endif
	char * swName, buff[40];

	Tcl_ResetResult(interp);
	if (argc >= 3) {
	    sprintf(buff, "w:%s", argv[2]);
	    swName = Tcl_GetVar2(interp, widRec, buff, TCL_GLOBAL_ONLY);

	    if (swName) {
		if (argc == 3) {
		    Tcl_SetResult(interp, swName, TCL_VOLATILE);
		    code = TCL_OK;
		    goto done;
		} else {
		    argv[2] = swName;
		    code = Tix_EvalArgv(interp, argc-2, argv+2);
		    goto done;
		}
	    }
	    Tcl_AppendResult(interp, "unknown subwidget \"", argv[2],
		"\"", NULL);
	    code = TCL_ERROR;
	    goto done;
	} else {
	    code = Tix_ArgcError(interp, argc, argv, 2, "name ?args ...?");
	    goto done;
	}
    }
    else if (cPtr->isWidget && strncmp(method, "subwidgets", len) == 0) {
	Tcl_ResetResult(interp);

	code = Tix_CallMethod(interp, classRec, widRec, "subwidgets",
	    argc-2, argv+2);
	goto done;
    } else {
	/*
	 * error message already append by Tix_CallMethod()
	 */
	code = TCL_ERROR;
	goto done;
    }

  done:
    TixItclRestoreGlobalNameSp(&nameSp, interp);
    Tk_Release((ClientData) cPtr);
    return code;
}

/*----------------------------------------------------------------------
 * Subroutines for Class definition
 *
 *
 *----------------------------------------------------------------------
 */
static int SetupMethod(interp, cPtr, s)
    Tcl_Interp * interp;
    TixClassRecord * cPtr;
    char * s;
{
    TixClassRecord * scPtr = cPtr->superClass;
    char ** listArgv;
    int listArgc, i;
    int nMethods;


    if (s && *s) {
	if (Tcl_SplitList(interp, s, &listArgc, &listArgv) != TCL_OK) {
	    return TCL_ERROR;
	}
    } else {
	listArgc = 0;
	listArgv = 0;
    }

    nMethods = listArgc;

    if (scPtr) {
	nMethods += scPtr->nMethods;
    }
    cPtr->nMethods = nMethods;
    cPtr->methods  = (char**)ckalloc(nMethods*sizeof(char*));
    /* Copy the methods of this class */
    for (i=0; i<listArgc; i++) {
	cPtr->methods[i] = tixStrDup(listArgv[i]);
    }
    /* Copy the methods of the super class */
    for (; i<nMethods; i++) {
	cPtr->methods[i] = tixStrDup(scPtr->methods[i-listArgc]);
    }

    if (listArgv) {
	ckfree((char*)listArgv);
    }

    return TCL_OK;
}

static int
SetupDefault(interp, cPtr, s)
    Tcl_Interp * interp;
    TixClassRecord * cPtr;
    char * s;
{
    char ** listArgv;
    int listArgc, i;
    TixClassRecord * scPtr = cPtr->superClass;
    Tix_ListIterator li;
    Tix_SubwidgetDef *defPtr;

    if (s && *s) {
	if (Tcl_SplitList(interp, s, &listArgc, &listArgv) != TCL_OK) {
	    return TCL_ERROR;
	}
    } else {
	return TCL_OK;
    }

    if (scPtr) {
	/*
	 * Copy the subwidget default specs from the super-class
	 */
	Tix_SimpleListIteratorInit(&li);
	for (Tix_SimpleListStart(&scPtr->subWDefs, &li);
	     !Tix_SimpleListDone(&li);
	     Tix_SimpleListNext (&scPtr->subWDefs, &li)) {

	    Tix_SubwidgetDef * p = (Tix_SubwidgetDef*)li.curr;

	    defPtr = (Tix_SubwidgetDef*)ckalloc(sizeof(Tix_SubwidgetDef));
	    defPtr->spec  = tixStrDup(p->spec);
	    defPtr->value = tixStrDup(p->value);

	    Tix_SimpleListAppend(&cPtr->subWDefs, (char*)defPtr, 0);
	}
    }

    /*
     * Merge with the new default specs
     */
    for (i=0; i<listArgc; i++) {
	char **list;
	int n;

	if (Tcl_SplitList(interp, listArgv[i], &n, &list) != TCL_OK) {
	    goto error;
	}
	if (n != 2) {
	    Tcl_AppendResult(interp, "bad subwidget default format \"",
		listArgv[i], "\"", NULL);
	    ckfree((char*)list);
	    goto error;
	}

	Tix_SimpleListIteratorInit(&li);
	for (Tix_SimpleListStart(&cPtr->subWDefs, &li);
	     !Tix_SimpleListDone(&li);
	     Tix_SimpleListNext (&cPtr->subWDefs, &li)) {

	    Tix_SubwidgetDef * p = (Tix_SubwidgetDef*)li.curr;

	    if (strcmp(list[0], p->spec) == 0) {
		Tix_SimpleListDelete(&cPtr->subWDefs, &li);
		ckfree((char*)p->value);
		ckfree((char*)p->spec);
		ckfree((char*)p);
		break;
	    }
	}
	/* Append this spec to the end
	 */
	defPtr = (Tix_SubwidgetDef*)ckalloc(sizeof(Tix_SubwidgetDef));
	defPtr->spec  = tixStrDup(list[0]);
	defPtr->value = tixStrDup(list[1]);

	Tix_SimpleListAppend(&cPtr->subWDefs, (char*)defPtr, 0);

	ckfree((char*)list);
    }

    /*
     * Add the defaults into the options database.
     */
    Tix_SimpleListIteratorInit(&li);
    for (Tix_SimpleListStart(&cPtr->subWDefs, &li);
	 !Tix_SimpleListDone(&li);
	 Tix_SimpleListNext (&cPtr->subWDefs, &li)) {

	Tix_SubwidgetDef * p = (Tix_SubwidgetDef*)li.curr;

	if (Tix_GlobalVarEval(interp, "option add *", cPtr->ClassName,
		p->spec, " [list ", p->value, "] widgetDefault",
		NULL) != TCL_OK) {
	    goto error;
	}
    }

    if (listArgv) {
	ckfree((char*)listArgv);
    }
    return TCL_OK;

  error:
   if (listArgv) {
	ckfree((char*)listArgv);
    }
    return TCL_ERROR;
}

static int
SetupSpec(interp, cPtr, s, isWidget)
    Tcl_Interp * interp;
    TixClassRecord * cPtr;
    char * s;
    int isWidget;
{
    TixClassRecord * scPtr = cPtr->superClass;
    char ** listArgv;
    int listArgc, i;
    TixConfigSpec * dupSpec;
    int nSpecs;
    int j;
    int nAlloc;
    int code = TCL_OK;

    if (s && *s) {
	if (Tcl_SplitList(interp, s, &listArgc, &listArgv) != TCL_OK) {
	    return TCL_ERROR;
	}
    } else {
	listArgc = 0;
	listArgv = 0;
    }

    nSpecs = listArgc;

    if (scPtr != NULL) {
	nAlloc = nSpecs+scPtr->nSpecs;
    } else {
	nAlloc = nSpecs;
    }

    cPtr->nSpecs = nSpecs;
    cPtr->specs  = (TixConfigSpec**)ckalloc(nAlloc*sizeof(TixConfigSpec*));

    /*
     * Initialize the specs of this class
     */
    for (i=0; i<listArgc; i++) {
	if ((cPtr->specs[i] = InitSpec(interp, listArgv[i], isWidget))==NULL){
	    code = TCL_ERROR;
	    goto done;
	}
    }
    /*
     * Copy the specs of the super class
     */
    if (scPtr != NULL) {
	for (i=0; i<scPtr->nSpecs; i++) {
	    /* See if we have re-defined this configspec */
	    for (dupSpec = 0, j=0; j<listArgc; j++) {
		char * pName = scPtr->specs[i]->argvName;
		if (strcmp(cPtr->specs[j]->argvName, pName)==0) {
		    dupSpec = cPtr->specs[j];
		    break;
		}
	    }

	    if (dupSpec) {
		/*
		 * If we have not redefined the dbclass or dbname of
		 * this duplicated configSpec, then simply
		 * copy the parent's attributes to the new configSpec
		 *
		 * Otherwise we don't copy the parent's attributes (do nothing)
		 */
		if ((strcmp(dupSpec->dbClass, scPtr->specs[i]->dbClass) == 0)
		    &&(strcmp(dupSpec->dbName, scPtr->specs[i]->dbName) == 0)){
		    dupSpec->readOnly  = scPtr->specs[i]->readOnly;
		    dupSpec->isStatic  = scPtr->specs[i]->isStatic;
		    dupSpec->forceCall = scPtr->specs[i]->forceCall;
		}
	    } else {
		/*
		 *Let's copy the parent's configSpec
		 */
		cPtr->specs[cPtr->nSpecs] = CopySpec(scPtr->specs[i]);
		cPtr->nSpecs ++;
	    }
	}
    }

    if (cPtr->nSpecs != nAlloc) {
	cPtr->specs = (TixConfigSpec**)
	  ckrealloc((char*)cPtr->specs, cPtr->nSpecs*sizeof(TixConfigSpec*));
    }

  done:
    if (listArgv) {
	ckfree((char*)listArgv);
    }
    return code;
}

static TixConfigSpec *
InitSpec(interp, s, isWidget)
    Tcl_Interp * interp;
    char * s;
    int isWidget;
{
    char ** listArgv = NULL;
    int listArgc;
    TixConfigSpec * sPtr = NULL;
    char * specList = NULL;
    char * cmdArgv[2];

    /* KLUDGE
     *
     * The following call will try to substitute the contents inside
     * the string s. Since s was originally in curly brackets,
     * setting s to {-bitmap bitmap Bitmap [tix getbitmap mybitmap]}
     * will cause the defValue to be "[tix" because the nested
     * expression is never evaluated.
     *
     */
    cmdArgv[0] = "subst";
    cmdArgv[1] = s;

    if (Tix_EvalArgv(interp, 2, cmdArgv)!= TCL_OK) {
	goto done;
    }

    specList = tixStrDup(interp->result);

    if (Tcl_SplitList(interp, specList, &listArgc, &listArgv)!= TCL_OK) {
	goto done;
    }
    if (( isWidget && (listArgc < 4 || listArgc > 5)) ||
	(!isWidget && (listArgc < 2 || listArgc > 3))) {
	Tcl_ResetResult(interp);
	Tcl_AppendResult(interp, "Wrong number of elements in ",
	    "config spec list \"", specList, "\"", NULL);
	goto done;
    }

    sPtr = (TixConfigSpec * )ckalloc(sizeof(TixConfigSpec));

    sPtr->isAlias   = 0;
    sPtr->readOnly  = 0;
    sPtr->isStatic  = 0;
    sPtr->forceCall = 0;
    sPtr->realPtr   = NULL;

    if (isWidget) {
	sPtr->argvName = tixStrDup(listArgv[0]);
	sPtr->dbName   = tixStrDup(listArgv[1]);
	sPtr->dbClass  = tixStrDup(listArgv[2]);
	sPtr->defValue = tixStrDup(listArgv[3]);
    }
    else {
	sPtr->argvName = tixStrDup(listArgv[0]);
	sPtr->dbClass  = TIX_EMPTY_STRING;
	sPtr->dbName   = TIX_EMPTY_STRING;
	sPtr->defValue = tixStrDup(listArgv[1]);
    }

    /* Set up the verifyCmd */
    if ((isWidget && listArgc == 5) || (!isWidget && listArgc == 3)) {
	int n;

	if (isWidget) {
	    n = 4;
	} else {
	    n = 2;
	}

	sPtr->verifyCmd = tixStrDup(listArgv[n]);
    } else {
	sPtr->verifyCmd = NULL;
    }

  done:
    if (listArgv) {
	ckfree((char *) listArgv);
    }
    if (specList) {
	ckfree(specList);
    }
    return sPtr;
}

static TixConfigSpec *
CopySpec(sPtr)
    TixConfigSpec *sPtr;	/* The spec record from the super class. */
{
    TixConfigSpec *nPtr = (TixConfigSpec *)ckalloc(sizeof(TixConfigSpec));

    nPtr->isAlias   = sPtr->isAlias;
    nPtr->readOnly  = sPtr->readOnly;
    nPtr->isStatic  = sPtr->isStatic;
    nPtr->forceCall = sPtr->forceCall;

    if (sPtr->argvName != NULL &&  sPtr->argvName != TIX_EMPTY_STRING) {
	nPtr->argvName = tixStrDup(sPtr->argvName);
    } else {
	nPtr->argvName = TIX_EMPTY_STRING;
    }
    if (sPtr->defValue != NULL &&  sPtr->defValue != TIX_EMPTY_STRING) {
	nPtr->defValue = tixStrDup(sPtr->defValue);
    } else {
	nPtr->defValue = TIX_EMPTY_STRING;
    }
    if (sPtr->dbName != NULL &&  sPtr->dbName != TIX_EMPTY_STRING) {
	nPtr->dbName = tixStrDup(sPtr->dbName);
    } else {
	nPtr->dbName = TIX_EMPTY_STRING;
    }
    if (sPtr->dbClass != NULL &&  sPtr->dbClass != TIX_EMPTY_STRING) {
	nPtr->dbClass = tixStrDup(sPtr->dbClass);
    } else {
	nPtr->dbClass = TIX_EMPTY_STRING;
    }
    if (sPtr->verifyCmd != NULL) {
	nPtr->verifyCmd = tixStrDup(sPtr->verifyCmd);
    } else {
	nPtr->verifyCmd = NULL;
    }

    nPtr->realPtr = NULL;

    return nPtr;
}

static void
FreeSpec(sPtr)
    TixConfigSpec *sPtr;	/* The spec record to free. */
{
    if (sPtr->argvName != NULL && sPtr->argvName != TIX_EMPTY_STRING) {
	ckfree(sPtr->argvName);
    }
    if (sPtr->defValue != NULL && sPtr->defValue != TIX_EMPTY_STRING) {
	ckfree(sPtr->defValue);
    }
    if (sPtr->dbName   != NULL && sPtr->dbName   != TIX_EMPTY_STRING) {
	ckfree(sPtr->dbName);
    }
    if (sPtr->dbClass  != NULL && sPtr->dbClass  != TIX_EMPTY_STRING) {
	ckfree(sPtr->dbClass);
    }
    if (sPtr->verifyCmd != NULL) {
	ckfree(sPtr->verifyCmd);
    }
    ckfree((char*)sPtr);
}

/*
 *----------------------------------------------------------------------
 * SetupAttribute --
 *
 *	Marks the spec's with the given attribute (-readonly, -forcecall,
 *	and -static).
 *
 * Results:
 *	Standard Tcl result.
 *
 * Side effects:
 *	The attributes of the specs are updated.
 *----------------------------------------------------------------------
 */

static int
SetupAttribute(interp, cPtr, s, which)
    Tcl_Interp * interp;
    TixClassRecord * cPtr;
    char * s;
    int which;
{
    char ** listArgv;
    int listArgc, i;
    TixConfigSpec  * spec;

    if (Tcl_SplitList(interp, s, &listArgc, &listArgv) != TCL_OK) {
	return TCL_ERROR;
    } else {
	for (i=0; i<listArgc; i++) {
	    spec = Tix_FindConfigSpecByName(interp, cPtr, listArgv[i]);
	    if (spec == NULL) {
		ckfree((char*)listArgv);
		return TCL_ERROR;
	    }
	    switch(which) {
	      case FLAG_READONLY:
		spec->readOnly = 1;
		break;
	      case FLAG_STATIC:
		spec->isStatic = 1;
		break;
	      case FLAG_FORCECALL:
		spec->forceCall = 1;
		break;
	    }
	}
    }

    ckfree((char*)listArgv);
    return TCL_OK;
}

static int
SetupAlias(interp, cPtr, s)
    Tcl_Interp * interp;
    TixClassRecord * cPtr;
    char * s;
{
    char ** listArgv;
    int listArgc, i;

    if (Tcl_SplitList(interp, s, &listArgc, &listArgv) != TCL_OK) {
	return TCL_ERROR;
    } else {
	int nAliases = listArgc;
	int nAlloc = cPtr->nSpecs + nAliases;

	cPtr->specs = (TixConfigSpec**)
	    ckrealloc((char*)cPtr->specs, nAlloc*sizeof(TixConfigSpec*));

	/* Initialize the aliases of this class */
	for (i=cPtr->nSpecs; i<nAlloc; i++) {
	    cPtr->specs[i] = InitAlias(interp, cPtr, listArgv[i-cPtr->nSpecs]);
	    if (cPtr->specs[i] == NULL) {
		ckfree((char*)listArgv);
		return TCL_ERROR;
	    }
	}

	cPtr->nSpecs = nAlloc;
    }
    ckfree((char*)listArgv);
    return TCL_OK;
}

static TixConfigSpec *
InitAlias(interp, cPtr, s)
    Tcl_Interp * interp;
    TixClassRecord * cPtr;
    char * s;
{
    char ** listArgv;
    int listArgc;
    TixConfigSpec  * sPtr;

    if (Tcl_SplitList(interp, s, &listArgc, &listArgv) != TCL_OK
	    || 2 != listArgc) {
	return NULL;
    } else {
	sPtr = (TixConfigSpec*) ckalloc(sizeof(TixConfigSpec));
	sPtr->isAlias    = 1;
	sPtr->isStatic   = 0;
	sPtr->forceCall  = 0;
	sPtr->readOnly   = 0;
	sPtr->argvName   = tixStrDup(listArgv[0]);
	sPtr->dbName     = tixStrDup(listArgv[1]);
	sPtr->dbClass    = TIX_EMPTY_STRING;
	sPtr->defValue   = TIX_EMPTY_STRING;
	sPtr->verifyCmd  = NULL;
	sPtr->realPtr    = NULL;

	ckfree((char*)listArgv);
	return sPtr;
    }
}

static int
InitHashEntries(interp, cPtr)
    Tcl_Interp * interp;
    TixClassRecord *cPtr;
{
    Tcl_HashEntry * hashPtr;
    int    	    isNew;
    char	  * key;
    int		    i;
    TixConfigSpec * sPtr;

    for (i=0; i<cPtr->nSpecs; i++) {
	sPtr = cPtr->specs[i];
	key = Tix_GetConfigSpecFullName(cPtr->className, sPtr->argvName);

	hashPtr = Tcl_CreateHashEntry(GetSpecTable(interp), key, &isNew);
	Tcl_SetHashValue(hashPtr, (char*)sPtr);

	ckfree(key);
    }

    return TCL_OK;
}
/*----------------------------------------------------------------------
 * Subroutines for object instantiation.
 *
 *
 *----------------------------------------------------------------------
 */
static int
ParseInstanceOptions(interp, cPtr, widRec, argc, argv)
    Tcl_Interp * interp;
    TixClassRecord * cPtr;
    char *widRec;
    int argc;
    char** argv;
{
    int i;
    TixConfigSpec *spec;

    if ((argc %2) != 0) {
	Tcl_AppendResult(interp, "missing argument for \"", argv[argc-1],
	    "\"", NULL);
	return TCL_ERROR;
    }

    /* Set all specs by their default values */
    for (i=0; i<cPtr->nSpecs; i++) {
	spec = cPtr->specs[i];
	if (!spec->isAlias) {
	    if (Tix_ChangeOneOption(interp, cPtr, widRec, spec,
		spec->defValue, 1, 0)!=TCL_OK) {
		return TCL_ERROR;
	    }
	}
    }

    /* Set specs according to argument line values */
    for (i=0; i<argc; i+=2) {
	spec = Tix_FindConfigSpecByName(interp, cPtr, argv[i]);

	if (spec == NULL) {	/* this is an invalid flag */
	    return TCL_ERROR;
	}

	if (Tix_ChangeOneOption(interp, cPtr, widRec, spec,
		argv[i+1], 0, 1)!=TCL_OK) {
	    return TCL_ERROR;
	}
    }

    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 * ClassTableDeleteProc --
 *
 *	This procedure is called when the interp is about to be
 *	deleted. It cleans up the hash entries and destroys the hash
 *	table.
 *
 * Results:
 *	None.
 *
 * Side effects:
 *	All class definitions are deleted.
 *----------------------------------------------------------------------
 */

static void
ClassTableDeleteProc(clientData, interp)
    ClientData clientData;
    Tcl_Interp *interp;
{
    Tcl_HashTable * classTablePtr = (Tcl_HashTable*)clientData;
    Tcl_HashSearch hashSearch;
    Tcl_HashEntry * hashPtr;
    TixClassRecord * cPtr;

    for (hashPtr = Tcl_FirstHashEntry(classTablePtr, &hashSearch);
	    hashPtr;
	    hashPtr = Tcl_NextHashEntry(&hashSearch)) {
	cPtr = (TixClassRecord*)Tcl_GetHashValue(hashPtr);
	FreeClassRecord(cPtr);
	Tcl_DeleteHashEntry(hashPtr);
    }
    Tcl_DeleteHashTable(classTablePtr);
    ckfree((char*)classTablePtr);
}

#if USE_ACCESS_CONTROL

/*
 * Everything after this line are not used at this moment.
 *
 */

/*----------------------------------------------------------------------
 *
 *
 *			ACCESS CONTROL
 *
 *
 *----------------------------------------------------------------------
 */
static void InitExportSpec(exPtr)
    Tix_ExportSpec * exPtr;
{
    Tix_SimpleListInit(&exPtr->exportCmds);
    Tix_SimpleListInit(&exPtr->restrictCmds);
    Tix_SimpleListInit(&exPtr->exportOpts);
    Tix_SimpleListInit(&exPtr->restrictOpts);
}

static Tix_LinkList * CopyStringList(list, newList)
    Tix_LinkList * list;
    Tix_LinkList * newList;
{
    Tix_StringLink * ptr, * newLink;

    for (ptr=(Tix_StringLink*)list->head; ptr; ptr=ptr->next) {
	newLink = (Tix_StringLink*)ckalloc(sizeof(Tix_StringLink));

	newLink->string = tixStrDup(ptr->string);
	Tix_SimpleListAppend(newList, (char*)newLink, 0);
    }
}

static void
CopyExportSpec(src, dst)
    Tix_ExportSpec * src;
    Tix_ExportSpec * dst;
{
    CopyStringList(&src->exportCmds,   &dst->exportCmds);
    CopyStringList(&src->restrictCmds, &dst->restrictCmds);

    CopyStringList(&src->exportOpts,   &dst->exportOpts);
    CopyStringList(&src->restrictOpts, &dst->restrictOpts);
}

/*
 * (1) All items that appear in list1 must not appear in list 2
 * (2) If either list have the item "all" -- an item whose string pointer is
 *     NULL -- the other list must be empty.
 */
static int CheckMutualExclusion(list1, list2)
    Tix_LinkList * list1;
    Tix_LinkList * list2;
{
    Tix_StringLink * ptr, *ptr2;

    if (list1->numItems == 0) {
	return TCL_OK;
    }
    if (list2->numItems == 0) {
	return TCL_OK;
    }

    for (ptr=(Tix_StringLink *)(list1->head); ptr; ptr=ptr->next) {
	if (ptr->string == NULL) {
	    goto error;
	}

	for (ptr2=(Tix_StringLink *)(list2->head); ptr2; ptr2=ptr2->next) {
	    if (strcmp(ptr->string, ptr2->string) == 0) {

		/* Violates requirement (1) above :
		 * Some items in list 1 also appear in list 2.
		 */
		goto error;
	    }
	}
    }

    return TCL_OK;

  error:

    return TCL_ERROR;
}

static int AppendStrings(interp, list, string)
    Tcl_Interp * interp;
    Tix_LinkList * list;
    char * string;
{
    char ** listArgv = NULL;
    int listArgc, i;
    Tix_StringLink * ptr;

    if (string && *string) {
	if (Tcl_SplitList(interp, string, &listArgc, &listArgv) != TCL_OK) {
	    return TCL_ERROR;
	}
    } else {
	/* Nothing to be done */
	return TCL_OK;
    }

    for (i=0; i<listArgc; i++) {
	ptr = (Tix_StringLink *)ckalloc(sizeof(Tix_StringLink));

	if (strcmp(listArgv[i], "all")==0) {
	    ptr->string = NULL;
	} else {
	    ptr->string = tixStrDup(listArgv[i]);
	}
	Tix_SimpleListAppend(list, (char*)ptr, 0);
    }

    if (listArgv) {
	ckfree((char*)listArgv);
    }

    return TCL_OK;
}


static int ConflictingSpec(interp, which, eList, rList)
    Tcl_Interp * interp;
    char * which;
    Tix_LinkList * eList;
    Tix_LinkList * rList;
{
    Tix_LinkList *lists[2];
    Tix_StringLink * ptr;
    int i;
    char * specs[2] = {"export :", "restrict :"};

    lists[0] = eList;
    lists[1] = rList;

    Tcl_ResetResult(interp);
    Tcl_AppendResult(interp, "conflicting export and restrictions ",
	"for ", which, "\n", NULL);

    for (i=0; i<2; i++) {
	Tcl_AppendResult(interp, specs[i], NULL);

	for (ptr=(Tix_StringLink *)(lists[i]->head); ptr; ptr=ptr->next) {
	    if (ptr->string == 0) {
		Tcl_AppendResult(interp, "all ", NULL);
	    } else {
		Tcl_AppendResult(interp, ptr->string, " ", NULL);
	    }
	}
	Tcl_AppendResult(interp, "\n", NULL);
    }

    return TCL_ERROR;
}

/*
 * Define or redefine the export control
 */
static int DefineExport(interp, exPtr, name, spec)
    Tcl_Interp * interp;
    Tix_ExportSpec * exPtr;
    char * name;
    char * spec;
{
    char ** listArgv = NULL;
    int listArgc, i;

    if (spec && *spec) {
	if (Tcl_SplitList(interp, spec, &listArgc, &listArgv) != TCL_OK) {
	    return TCL_ERROR;
	}
    } else {
	/* Nothing to be done */
	return TCL_OK;
    }

    if (listArgc %2 != 0) {
	Tcl_ResetResult(interp);
	Tcl_AppendResult(interp, "wrong # of argument in subwidget spec: \"",
	    spec, "\"", NULL);
	goto error;
    }

    for (i=0; i<listArgc; i+=2) {
	if (strcmp(listArgv[i], "-exportcmd") == 0) {
	    if (AppendStrings(interp, &exPtr->exportCmds,
		listArgv[i+1])==TCL_ERROR) {
		goto error;
	    }
	}
	else if (strcmp(listArgv[i], "-restrictcmd") == 0) {
	    if (AppendStrings(interp, &exPtr->restrictCmds,
		listArgv[i+1])==TCL_ERROR){
		goto error;
	    }
	}
	else if (strcmp(listArgv[i], "-exportopt") == 0) {
	    if (AppendStrings(interp, &exPtr->exportOpts,
		listArgv[i+1])==TCL_ERROR) {
		goto error;
	    }
	}
	else if (strcmp(listArgv[i], "-restrictopt") == 0) {
	    if (AppendStrings(interp, &exPtr->restrictOpts,
		listArgv[i+1])==TCL_ERROR){
		goto error;
	    }
	}
    }

    if (CheckMutualExclusion(&exPtr->exportCmds, &exPtr->restrictCmds)
	==TCL_ERROR) {
	ConflictingSpec(interp, "commands",
	    &exPtr->exportCmds, &exPtr->restrictCmds);
	goto error;
    }
    if (CheckMutualExclusion(&exPtr->restrictCmds, &exPtr->exportCmds)
	==TCL_ERROR) {
	ConflictingSpec(interp, "commands",
	     &exPtr->exportCmds, &exPtr->restrictCmds);
	goto error;
    }
    if (CheckMutualExclusion(&exPtr->exportOpts, &exPtr->restrictOpts)
	==TCL_ERROR) {
	ConflictingSpec(interp, "options",
	     &exPtr->exportOpts, &exPtr->restrictOpts);
	goto error;
    }
    if (CheckMutualExclusion(&exPtr->restrictOpts, &exPtr->exportOpts)
	==TCL_ERROR) {
	ConflictingSpec(interp, "options",
	     &exPtr->exportOpts, &exPtr->restrictOpts);
	goto error;
    }

  done:
    if (listArgv) {
	ckfree((char*)listArgv);
    }
    return TCL_OK;

  error:
    if (listArgv) {
	ckfree((char*)listArgv);
    }
    return TCL_ERROR;
}
/*----------------------------------------------------------------------
 *
 *
 *			SUBWIDGET SETUP
 *
 *
 *----------------------------------------------------------------------
 */
static Tix_SubWidgetSpec *
GetSubWidgetSpec(cPtr, name)
    TixClassRecord * cPtr;
    char * name;
{
    Tix_SubWidgetSpec *ptr;

    for (ptr=(Tix_SubWidgetSpec *)cPtr->subWidgets.head; ptr; ptr=ptr->next) {
	if (strcmp(ptr->name, name) == 0) {
	    return ptr;
	}
    }

    return NULL;
}

static Tix_SubWidgetSpec *
AllocSubWidgetSpec()
{
    Tix_SubWidgetSpec * newPtr =
      (Tix_SubWidgetSpec *)ckalloc(sizeof(Tix_SubWidgetSpec));

    newPtr->next 	= NULL;
    newPtr->name 	= NULL;
    InitExportSpec(&newPtr->exportSpec);
    return newPtr;
}

static void
CopySubWidgetSpecs(scPtr, cPtr)
    TixClassRecord * scPtr;
    TixClassRecord * cPtr;
{
    Tix_SubWidgetSpec *ssPtr;

    for (ssPtr=(Tix_SubWidgetSpec *)scPtr->subWidgets.head;
	ssPtr;
	ssPtr=ssPtr->next) {

	Tix_SubWidgetSpec *newPtr;
	newPtr = AllocSubWidgetSpec();

	newPtr->name = tixStrDup(ssPtr->name);
	CopyExportSpec(&ssPtr->exportSpec, & newPtr->exportSpec);

	Tix_SimpleListAppend(&cPtr->subWidgets, (char*)newPtr, 0);
    }
}

static int
SetupSubWidget(interp, cPtr, s)
    Tcl_Interp * interp;
    TixClassRecord * cPtr;
    char * s;
{
    char ** listArgv;
    TixClassRecord * scPtr = cPtr->superClass;
    int listArgc, i;

    if (s && *s) {
	if (Tcl_SplitList(interp, s, &listArgc, &listArgv) != TCL_OK) {
	    return TCL_ERROR;
	}
    } else {
	return TCL_OK;
    }

    if (listArgc %2 != 0) {
	Tcl_ResetResult(interp);
	Tcl_AppendResult(interp, "wrong # of argument in subwidget spec: \"",
	    s, "\"", NULL);
	goto error;
    }

    /* Copy all the subwidgets of the superclass to this class */
    if (scPtr) {
	CopySubWidgetSpecs(scPtr, cPtr);
    }

    /* Iterate over all the newly defined or re-defined subwidgets */
    for (i=0; i<listArgc; i+=2) {
	char * name, *spec;
	Tix_SubWidgetSpec * oldSpec;
	Tix_SubWidgetSpec * newSpec;

	name = listArgv[i];
	spec = listArgv[i+1];

	if (scPtr && ((oldSpec = GetSubWidgetSpec(cPtr, name)) != NULL)) {
	    if (DefineExport(interp, &oldSpec->exportSpec, name, spec)
		    != TCL_OK) {
		goto error;
	    }
	}
	else {
	    newSpec = AllocSubWidgetSpec();
	    newSpec->name = tixStrDup(name);

	    Tix_SimpleListAppend(&cPtr->subWidgets, (char*)newSpec, 0);

	    if (DefineExport(interp, &newSpec->exportSpec, name, spec)
		    != TCL_OK) {
		goto error;
	    }
	}
    }

    if (listArgv) {
	ckfree((char*)listArgv);
    }
    return TCL_OK;


  error:
    if (listArgv) {
	ckfree((char*)listArgv);
    }
    return TCL_ERROR;
}

#endif