/*
 * tkoWidget.c --
 *
 *    This file contains the tko widget class.
 *
 * Copyright (c) 2019 Rene Zaumseil
 *
 */

#include "tkoWidget.h"

#if (TCL_MAJOR_VERSION < 9)
#if (TCL_MINOR_VERSION < 7) || (TCL_RELEASE_LEVEL == TCL_ALPHA_RELEASE)
#include "tclOOInt.h" /*TODO needed for Widget_GetClassName() in tkoWidget.c */
/*
 * Widget_GetClassName --
 *    Return class name of object.
 *    Should be OO core function.
 *
 * Results:
 *    Name of class or NULL on error.
 *
 * Side effects:
 *    Use internal OO structures!!!
 */
Tcl_Obj *
Tcl_GetObjectClassName(
    Tcl_Interp * interp,
    Tcl_Object object)
{
    Tcl_Object classPtr;
    classPtr = (Tcl_Object)(((Object *)object)->selfCls->thisPtr);
    if (classPtr == NULL) return NULL;

    return Tcl_GetObjectName(interp, classPtr);
}
#endif /*TCL_MINOR_VERSION*/
#endif /*TCL_MAJOR_VERSION*/

/*
* Clientdata of option methods.
*/
typedef struct WidgetClientdata {
	Tcl_MethodType2 method;
	Tcl_Obj *option;
	int offset;
	int type;
	int flags;
} WidgetClientdata;

/*
 * Commonly used data and strings.
 */
typedef struct TkoThreadData {
    /* Static string objects. */
    Tcl_Obj *Obj_0; /* 0 */
    Tcl_Obj *Obj_1; /* 1 */
    Tcl_Obj *Obj_2; /* 2 */
    Tcl_Obj *Obj_dict; /* "dict" */
    Tcl_Obj *Obj_set; /* "set" */
    Tcl_Obj *Obj_init; /* "init" */
    Tcl_Obj *Obj_error_readonly; /* "error readonly" */
    Tcl_Obj *Obj_empty; /* "" */
    Tcl_Obj *Obj_s; /* "s" */
    Tcl_Obj *Obj_oo_objdefine; /* "::oo::objdefine" */
    Tcl_Obj *Obj_oo_define; /* "::oo::define" */
    Tcl_Obj* Obj_Tko; /* "Tko" */
    Tcl_Obj* Obj_tko_init; /* "_tko_init" */
    Tcl_Obj *Obj_tko_option; /* "::tko_option" */
    Tcl_Obj *Obj_create; /* "create" */
    Tcl_Obj *Obj_method; /* "method" */
    Tcl_Obj *Obj_point; /* "." */
    Tcl_Obj *Obj_point2; /* ".." */
    Tcl_Obj *Obj__screen; /* "-screen" */
    Tcl_Obj *Obj__class; /* "-class" */
} TkoThreadData;
static Tcl_ThreadDataKey tkoKey;

/*
 * Methods
 */

/*
 * Functions
 */
static char* WidgetOptionTrace(
    ClientData clientData,
    Tcl_Interp* interp,
    const char* name1,
    const char* name2,
    int flags);
static void WidgetEventProc(
    ClientData clientData,
    XEvent * eventPtr);
static void WidgetMetaDestroy(
    Tko_Widget * widget);
static void WidgetMetaDelete(
    ClientData clientData);
static int WidgetMethod_Empty(
	ClientData clientdata,
	Tcl_Interp * interp,
	Tcl_ObjectContext context,
	Tcl_Size objc,
	Tcl_Obj * const objv[]);
static int WidgetMethod_(
    ClientData clientData,
    Tcl_Interp * interp,
    Tcl_ObjectContext context,
    Tcl_Size objc,
    Tcl_Obj * const objv[]);
static void WidgetClientdataDelete(
    ClientData clientdata);
static int WidgetClientdataClone(
    Tcl_Interp *interp,
    ClientData clientdata,
    ClientData *newPtr);
static void WidgetDeleteTkwin(
    Tko_Widget *widget);

/*
 * tkoWidgetMeta --
 *    Identifier for attached tko widget data.
 */
Tcl_ObjectMetadataType tkoWidgetMeta = {
    TCL_OO_METADATA_VERSION_CURRENT,
    "tkoWidgetMeta",
    WidgetMetaDelete,
    NULL
};

/*
 * Tko_Init --
 *    Initialize tko widgets.
 *
 * Results:
 *    A standard Tcl result.
 *
 * Side effects:
 *    Create available oo::class tko widgets.
 */
#ifdef __cplusplus
extern "C" {
#endif  /* __cplusplus */
DLLEXPORT int
Tko_Init(
    Tcl_Interp * interp /* Tcl interpreter. */)
{
    if (Tcl_InitStubs(interp, "8.6-", 0) == NULL) {
    	return TCL_ERROR;
    }
    if (Tk_InitStubs(interp, "8.6-", 0) == NULL) {
    	return TCL_ERROR;
    }
    /* Needed oo extension */
    if (Tcl_OOInitStubs(interp) == NULL) {
        return TCL_ERROR;
    }
    /*
     * Constants
     */
    TkoThreadData *tkoPtr = Tcl_GetThreadData(&tkoKey, sizeof(TkoThreadData));
    Tcl_IncrRefCount((tkoPtr->Obj_0 = Tcl_NewIntObj(0)));
    Tcl_IncrRefCount((tkoPtr->Obj_1 = Tcl_NewIntObj(1)));
    Tcl_IncrRefCount((tkoPtr->Obj_2 = Tcl_NewIntObj(2)));
    Tcl_IncrRefCount((tkoPtr->Obj_dict = Tcl_NewStringObj("dict", -1)));
    Tcl_IncrRefCount((tkoPtr->Obj_set = Tcl_NewStringObj("set", -1)));
    Tcl_IncrRefCount((tkoPtr->Obj_init = Tcl_NewStringObj("init", -1)));
    Tcl_IncrRefCount((tkoPtr->Obj_error_readonly = Tcl_NewStringObj("error readonly", -1)));
    Tcl_IncrRefCount((tkoPtr->Obj_empty = Tcl_NewStringObj("", -1)));
    Tcl_IncrRefCount((tkoPtr->Obj_s = Tcl_NewStringObj("s", -1)));
    /* Internally visible */
    Tcl_IncrRefCount((tkoPtr->Obj_oo_objdefine = Tcl_NewStringObj("::oo::objdefine", -1)));
    Tcl_IncrRefCount((tkoPtr->Obj_oo_define = Tcl_NewStringObj("::oo::define", -1)));
    Tcl_IncrRefCount((tkoPtr->Obj_Tko = Tcl_NewStringObj("Tko", -1)));
    Tcl_IncrRefCount((tkoPtr->Obj_tko_init = Tcl_NewStringObj("_tko_init", -1)));
    Tcl_IncrRefCount((tkoPtr->Obj_tko_option = Tcl_NewStringObj("::tko_option", -1)));
    Tcl_IncrRefCount((tkoPtr->Obj_create = Tcl_NewStringObj("create", -1)));
    Tcl_IncrRefCount((tkoPtr->Obj_method = Tcl_NewStringObj("method", -1)));
    Tcl_IncrRefCount((tkoPtr->Obj_point = Tcl_NewStringObj(".", -1)));
    Tcl_IncrRefCount((tkoPtr->Obj_point2 = Tcl_NewStringObj("..", -1)));
    Tcl_IncrRefCount((tkoPtr->Obj__screen = Tcl_NewStringObj("-screen", -1)));
    Tcl_IncrRefCount((tkoPtr->Obj__class = Tcl_NewStringObj("-class", -1)));
	/*
	 * Commands and Widgets
	 */
    if (Tko_FrameInit(interp) != TCL_OK) {
        return TCL_ERROR;
    }
#ifdef TKO_USE_GRAPH
    Tcl_CreateObjCommand2(interp, "::tko::snap", Rbc_SnapObjCmd, NULL, NULL);
    if (Tko_GraphInit(interp) != TCL_OK) {
        return TCL_ERROR;
    }
    if (Tko_VectorInit(interp) != TCL_OK) {
        return TCL_ERROR;
    }
#endif
#ifdef TKO_USE_PATH
    if (Tko_PathInit(interp) != TCL_OK) {
        return TCL_ERROR;
    }
#endif
    return TCL_OK;
}
#ifdef __cplusplus
}
#endif  /* __cplusplus */

/*
 * Tko_WidgetClassDefine --
 *    Create a new tko widget class.
 *
 * Results:
 *    A standard Tcl result.
 *
 * Side effects:
 *    Create new class with methods and option defines.
 */
int
Tko_WidgetClassDefine(
	Tcl_Interp * interp,
	Tcl_Obj * classname,
	const Tcl_MethodType2 * methods,
	Tko_WidgetOptionDefine * options)
{
	Tcl_Class clazz;
	Tcl_Object object;
	Tcl_Obj *tmpObj;
	WidgetClientdata *clientdata;
	Tcl_Obj *myObjv[5];
    Tcl_Obj* objTko;
	int i;
	TkoThreadData *tkoPtr = Tcl_GetThreadData(&tkoKey, sizeof(TkoThreadData));

	if (classname == NULL) {
		Tcl_SetObjResult(interp, Tcl_ObjPrintf("missing class name"));
		return TCL_ERROR;
	}
	/*
	 * Create or define widget class with initialization script.
	 */
	myObjv[0] = Tcl_ObjPrintf("::oo::class create %s ::tko_createwidget", Tcl_GetString(classname));
	Tcl_IncrRefCount(myObjv[0]);
	if (Tcl_Eval(interp, Tcl_GetString(myObjv[0])) != TCL_OK) {
	    Tcl_DecrRefCount(myObjv[0]);
	    return TCL_ERROR;
	}
	Tcl_DecrRefCount(myObjv[0]);

	/* Get class object */
	if ((object = Tcl_GetObjectFromObj(interp, classname)) == NULL
		|| (clazz = Tcl_GetObjectAsClass(object)) == NULL) {
		return TCL_ERROR;
	}

	/*
	 * Add methods
	 */
	if (methods) {
		/* constructor */
		if (methods[0].name == NULL && methods[0].callProc) {
			Tcl_ClassSetConstructor(interp, clazz,
				Tcl_NewMethod2(interp, clazz, NULL, 1, &methods[0], NULL));
		}
		/* destructor */
		if (methods[1].name == NULL && methods[1].callProc) {
			Tcl_ClassSetDestructor(interp, clazz,
				Tcl_NewMethod2(interp, clazz, NULL, 1, &methods[1], NULL));
		}
        /* public */
		for (i = 2; methods[i].name != NULL; i++) {
			tmpObj = Tcl_NewStringObj(methods[i].name, -1);
			Tcl_IncrRefCount(tmpObj);
			Tcl_NewMethod2(interp, clazz, tmpObj, 1, &methods[i], NULL);
			Tcl_DecrRefCount(tmpObj);
		}
		i++;
		/* private */
        for (; methods[i].name != NULL; i++) {
			tmpObj = Tcl_NewStringObj(methods[i].name, -1);
			Tcl_IncrRefCount(tmpObj);
			Tcl_NewMethod2(interp, clazz, tmpObj, 0, &methods[i], NULL);
			Tcl_DecrRefCount(tmpObj);
		}
    }
	/*
	 * Add options
	 */
    objTko = Tcl_NewStringObj(Tcl_GetObjectNamespace(object)->fullName, -1);
    Tcl_AppendToObj(objTko, "::Tko", -1);
    Tcl_IncrRefCount(objTko);
	if (options) {
		/* Loop over all option definitions */
		for (i = 0;; i++) {
			/* test on end of options */
			if (options[i].option == NULL) {
				break;
			}
			/* test option name starting with "-" */
			if (options[i].option[0] != '-') {
				Tcl_SetObjResult(interp, Tcl_ObjPrintf("wrong option name: %s",
					options[i].option));
                Tcl_DecrRefCount(objTko);
				return TCL_ERROR;
			}
			/* we need at least an synonym name here */
			if (options[i].dbname == NULL) {
				Tcl_SetObjResult(interp,
					Tcl_ObjPrintf("wrong option definition: %d", i));
                Tcl_DecrRefCount(objTko);
				return TCL_ERROR;
			}
			/* no dbclass means synonym option definition */
			if (options[i].dbclass == NULL) {
				/* test synonym option starting with "-" */
				if (options[i].dbname[0] != '-') {
					Tcl_SetObjResult(interp, Tcl_ObjPrintf("wrong synonym name: %s",
						options[i].dbname));
                    Tcl_DecrRefCount(objTko);
					return TCL_ERROR;
				}
                myObjv[0] = tkoPtr->Obj_dict;
                myObjv[1] = tkoPtr->Obj_set;
                myObjv[2] = objTko;
				myObjv[3] = Tcl_NewStringObj(options[i].option, -1);
				myObjv[4] = Tcl_NewStringObj(options[i].dbname, -1);
                Tcl_IncrRefCount(myObjv[3]);
                Tcl_IncrRefCount(myObjv[4]);
                /* dict set Tko -option -synonym */
                if (Tcl_EvalObjv(interp, 5, myObjv, TCL_EVAL_GLOBAL) != TCL_OK) {
				    Tcl_DecrRefCount(myObjv[2]);
				    Tcl_DecrRefCount(myObjv[3]);
                    Tcl_DecrRefCount(myObjv[4]);
                    Tcl_DecrRefCount(objTko);
					return TCL_ERROR;
				}
				Tcl_DecrRefCount(myObjv[3]);
                Tcl_DecrRefCount(myObjv[4]);
                continue;
			}
			/* normal option */
            myObjv[0] = tkoPtr->Obj_dict;
            myObjv[1] = tkoPtr->Obj_set;
            myObjv[2] = objTko;
            myObjv[3] = Tcl_NewStringObj(options[i].option, -1);
            myObjv[4] = Tcl_NewObj();
            Tcl_ListObjAppendElement(interp,myObjv[4],Tcl_NewStringObj(options[i].dbname, -1));
            Tcl_ListObjAppendElement(interp,myObjv[4],Tcl_NewStringObj(options[i].dbclass, -1));
            if (options[i].defvalue == NULL) {
                Tcl_ListObjAppendElement(interp,myObjv[4],tkoPtr->Obj_empty);
			}
			else {
                Tcl_ListObjAppendElement(interp,myObjv[4],Tcl_NewStringObj(options[i].defvalue, -1));
			}
			if (options[i].flags & TKO_OPTION_READONLY) {
                Tcl_ListObjAppendElement(interp,myObjv[4],tkoPtr->Obj_error_readonly);
			}
            Tcl_IncrRefCount(myObjv[3]);
            Tcl_IncrRefCount(myObjv[4]);
            /* dict set Tko -option {dbname dbclass default ?body?} */
			if (Tcl_EvalObjv(interp, 5, myObjv, TCL_EVAL_GLOBAL) != TCL_OK) {
				Tcl_DecrRefCount(myObjv[3]);
				Tcl_DecrRefCount(myObjv[4]);
                Tcl_DecrRefCount(objTko);
				return TCL_ERROR;
			}
			/*
			 * Now we create the necessary -option method.
			 * If given we create the -option method with the given method.
			 * Or we use the internal implementation of a given type.
			 * If none of the above are provided the option body is empty.
			 */
			clientdata = (WidgetClientdata *)ckalloc(sizeof(WidgetClientdata));
			assert(clientdata);
			clientdata->method.version = TCL_OO_METHOD_VERSION_2;
			clientdata->method.name = options[i].option;
			if (options[i].method != NULL) {
				clientdata->method.callProc = options[i].method;
			}
			else if (options[i].type > 0) {
				clientdata->method.callProc = WidgetMethod_;
			}
			else {
                clientdata->method.callProc = WidgetMethod_Empty;
			}
			clientdata->method.deleteProc = WidgetClientdataDelete;
			clientdata->method.cloneProc = WidgetClientdataClone;
			clientdata->option = myObjv[3];/* we do not decrement here */
			clientdata->offset = options[i].offset;
			clientdata->type = options[i].type;
			clientdata->flags = options[i].flags;
			Tcl_NewMethod2(interp, clazz, myObjv[3], 0, &clientdata->method,
				(ClientData)clientdata);
            /* all ok */
			Tcl_DecrRefCount(myObjv[3]);
			Tcl_DecrRefCount(myObjv[4]);
		}
	}
    Tcl_DecrRefCount(objTko);
    return TCL_OK;
}

/*
 * WidgetOptionInit --
 *
 * Results:
 *    A standard Tcl result.
 *
 * Side effects:
 *  Set object tko(-option) variable.
 */
int WidgetOption_Init(
	Tcl_Interp *interp,
	Tko_Widget *widget,
	TkoThreadData *tkoPtr,
	Tcl_Obj *option,/* option from Tko dictionary */
    Tcl_Obj *value,/* value from Tko dictionary */
    Tcl_Obj *arglist,/* argument list from creation command */
    Tcl_Obj *tkolist,/* list {option ..} for later call in _tko_init() */
	Tcl_Obj *mylist,/* list {option body} for readonly options */
    char **system)/* return value and usage of Tk_GetSystemDefault(), NULL=not, address=yes */
{
    Tcl_Obj **argObjv;
    Tcl_Size argObjc;
	Tcl_Obj *optionPtr=NULL;

	/* we only check argument number flag */
	if (Tcl_ListObjGetElements(interp, value, &argObjc, &argObjv) != TCL_OK
		|| (argObjc != 4 && argObjc != 3 && argObjc != 1)) {
		Tcl_SetObjResult(interp, Tcl_ObjPrintf("wrong '%s' option", Tcl_GetString(option)));
		return TCL_ERROR;
	}
    /* synonym option */
	if (argObjc == 1) {
		/* Try to get value from command line or use default one. */
		Tcl_DictObjGet(interp, arglist, option, &optionPtr);
		if (optionPtr != NULL) {
            /* Set command line value in the tko() array synonym variable */
            if (Tcl_ObjSetVar2(interp, widget->optionsArray, value,
                optionPtr, TCL_GLOBAL_ONLY) == NULL) {
                return TCL_ERROR;
            }
            Tcl_DictObjRemove(interp, arglist, option);
        }
		return TCL_OK;
	}
    /* normal option {dbname dbclass default ?body?} */
	/* Try to get value from command line or use default one. */
	Tcl_DictObjGet(interp, arglist, option, &optionPtr);
	if (optionPtr != NULL) {
		Tcl_DictObjRemove(interp, arglist, option);
	}
	else {
        /* Try to get value from option db */
		Tk_Uid dbnameUid = Tk_GetUid(Tcl_GetString(argObjv[0]));
		Tk_Uid dbclassUid = Tk_GetUid(Tcl_GetString(argObjv[1]));
		Tk_Uid valueUid;
		if ((dbnameUid[0] != '\0') && (widget->tkWin != NULL)) {
			valueUid = Tk_GetOption(widget->tkWin, dbnameUid, dbclassUid);
			if (valueUid != NULL) {
				optionPtr = Tcl_NewStringObj(valueUid, -1);
			}
		}
		/* Check for a system-specific default value. */
		if (optionPtr == NULL && (system==NULL)) {
			optionPtr = Tk_GetSystemDefault(widget->tkWin, dbnameUid, dbclassUid);
		}
	}
    /* Use default value */
	if (optionPtr == NULL) {
		optionPtr = argObjv[2];
	}
    /* Finally set the found value in the tko() array variable */
    if (Tcl_ObjSetVar2(interp, widget->optionsArray, option,
	    optionPtr, TCL_GLOBAL_ONLY) == NULL) {
	    return TCL_ERROR;
    }
    /* shortcut used for -screen and -class options */
    if (system != NULL) {
        *system = Tcl_GetString(optionPtr);
        return TCL_OK;
    }
    if (argObjc == 3) {
        Tcl_ListObjAppendElement(interp, tkolist, option);
    }
    else {
        Tcl_ListObjAppendElement(interp, mylist, option);
        Tcl_ListObjAppendElement(interp, mylist, argObjv[3]);
    }
    return TCL_OK;
}

/*
 * Tko_WidgetCreate --
 *    Create new tko object.
 *
 * Results:
 *    A standard Tcl result.
 *
 * Side effects:
 *    Can create new widget.
 */
int
Tko_WidgetCreate(
    ClientData clientdata, /* pointer to Tko_Widget structure */
    Tcl_Interp * interp,
    Tcl_Object object,
    Tcl_Obj *classname,
    int isToplevel, /* */
    Tcl_Obj *arglist) /* -value option .. list, used options will be removed */
{
    Tko_Widget *widget;
    const char *nsPtr;
    Tcl_Size argSize;
    Tcl_Obj *classObj;
    Tcl_Object classobject;
    Tcl_Obj **argObjv;
    Tcl_Size argObjc;
    char *textPtr;
    Tcl_DictSearch search;
    Tcl_Obj *key, *value;
    int done;
    char *ch;
    Tcl_Size length;
    Tcl_Obj *tmpPtr;
    Tcl_Obj *varPtr;
    Tcl_Obj *valuePtr;
    TkoThreadData *tkoPtr = Tcl_GetThreadData(&tkoKey, sizeof(TkoThreadData));
	Tcl_Obj *myObjv[6];
    Tcl_Obj *dictPtr=NULL;
	Tcl_Obj *tkoList=NULL;
	Tcl_Obj *myList=NULL;
	int i;

    /* This would be an internal programming error */
    if (clientdata == NULL) {
        Tcl_SetObjResult(interp, Tcl_ObjPrintf("no widget data"));
        return TCL_ERROR;
    }
    /* Check name starting with "::." */
    if ((tmpPtr = Tcl_GetObjectName(interp, object)) == NULL
        || (ch = Tcl_GetStringFromObj(tmpPtr, &length)) == NULL
        || length < 3 || ch[0] != ':' || ch[1] != ':') {
        Tcl_SetObjResult(interp, Tcl_ObjPrintf("no object"));
        return TCL_ERROR;
    }
	if (ch[2] != '.') {
		Tcl_SetObjResult(interp, Tcl_ObjPrintf("wrong pathName1: %s", ch));
		return TCL_ERROR;
	}
	/* Convert argument list in dictionary */
	if (Tcl_DictObjSize(interp, arglist, &argSize) != TCL_OK) {
		Tcl_SetObjResult(interp, Tcl_ObjPrintf("could not get arglist"));
		return TCL_ERROR;
	}

    /*
     * Get options from outermost class dictionary.
     */
    classObj = Tcl_GetObjectClassName(interp, object);
    if (classObj == NULL) {
        Tcl_SetObjResult(interp, Tcl_ObjPrintf("no class name"));
        return TCL_ERROR;
    }
    /* Get option list from class object */
	if ((classobject = Tcl_GetObjectFromObj(interp, classObj)) == NULL
		|| (Tcl_GetObjectAsClass(classobject) == NULL)
		|| (nsPtr = Tcl_GetObjectNamespace(classobject)->fullName) == NULL) {
		Tcl_SetObjResult(interp, Tcl_ObjPrintf("class '%s' not found", nsPtr));
		return TCL_ERROR;
	}
	varPtr = Tcl_ObjPrintf("%s::Tko", nsPtr);
	Tcl_IncrRefCount(varPtr);/* will be used later */
	dictPtr = Tcl_ObjGetVar2(interp, varPtr, NULL, TCL_GLOBAL_ONLY);
	dictPtr = Tcl_DuplicateObj(dictPtr);
	Tcl_IncrRefCount(dictPtr);

    /* Add widget to metadata so it can be released  */
    Tcl_ObjectSetMetadata(object, &tkoWidgetMeta, clientdata);

    /*
    * Initialize internal widget strucure.
    */
    widget = (Tko_Widget *)clientdata;
    Tcl_Preserve(widget);
    widget->interp = interp;
    widget->object = object;
    widget->widgetCmd = Tcl_GetObjectCommand(object);
    /* Create internal my command and option array varname */
    nsPtr = Tcl_GetObjectNamespace(object)->fullName;
    widget->myCmd = Tcl_ObjPrintf("%s::my", nsPtr);
    Tcl_IncrRefCount(widget->myCmd);
    widget->optionsArray = Tcl_ObjPrintf("%s::tko", nsPtr);
    Tcl_IncrRefCount(widget->optionsArray);
    /* Set class options dict name, already incremented */
	widget->optionsDict = varPtr;

	tkoList = Tcl_NewObj();
	Tcl_IncrRefCount(tkoList);
	myList = Tcl_NewObj();
	Tcl_IncrRefCount(myList);
	/* -screen option for toplevels */
	if (isToplevel) {
        if (Tcl_DictObjGet(interp, dictPtr, tkoPtr->Obj__screen, &valuePtr) != TCL_OK || valuePtr == NULL) {
            Tcl_SetObjResult(interp, Tcl_ObjPrintf("no '-screen' option"));
            goto error;
        }
        Tcl_DictObjRemove(interp, dictPtr, tkoPtr->Obj__screen);
        if (WidgetOption_Init(interp, widget, tkoPtr, tkoPtr->Obj__screen, valuePtr, arglist,
            tkoList, myList ,&textPtr) != TCL_OK) {
			goto error;
		}
        myObjv[0] = tkoPtr->Obj_oo_objdefine;
        myObjv[1] = Tcl_GetObjectName(interp, object);
        myObjv[2] = tkoPtr->Obj_method;
        myObjv[3] = tkoPtr->Obj__screen;
        myObjv[4] = tkoPtr->Obj_empty;
        myObjv[5] = tkoPtr->Obj_error_readonly;
        if (Tcl_EvalObjv(interp, 6, myObjv, TCL_EVAL_GLOBAL) != TCL_OK) {
            goto error;
        }
	} else {
	    textPtr = NULL;
    }
    /* create internal window */
	widget->tkWin = Tk_CreateWindowFromPath(interp,
		Tk_MainWindow(interp), &ch[2], textPtr);
	if (widget->tkWin == NULL) {
		goto error;
	}
	if ((widget->display = Tk_Display(widget->tkWin)) == NULL) {
		Tcl_SetObjResult(interp, Tcl_ObjPrintf("could not get display"));
		goto error;
	}
    /* Set tko(.) to name of widget or class */
    if (Tcl_ObjSetVar2(interp, widget->optionsArray, tkoPtr->Obj_point,
        Tcl_NewStringObj(&ch[2], length - 2), TCL_GLOBAL_ONLY) == NULL) {
        goto error;
    }
    /* Set tko(Tko) to outermost class variable */
    if (Tcl_ObjSetVar2(interp, widget->optionsArray, tkoPtr->Obj_Tko,
        varPtr, TCL_GLOBAL_ONLY) == NULL) {
        goto error;
    }
    /*
     * When creating widgets then "-class" option should be first option now.
     * It's value is needed to get option informations from option database.
     */
    if (Tcl_DictObjGet(interp, dictPtr, tkoPtr->Obj__class, &valuePtr) != TCL_OK || valuePtr == NULL) {
        Tcl_SetObjResult(interp, Tcl_ObjPrintf("no '-class' option"));
        goto error;
    }
    Tcl_DictObjRemove(interp, dictPtr, tkoPtr->Obj__class);
    if (WidgetOption_Init(interp, widget, tkoPtr, tkoPtr->Obj__class, valuePtr, arglist,
        tkoList, myList, &textPtr) != TCL_OK) {
        goto error;
    }
    myObjv[0] = tkoPtr->Obj_oo_objdefine;
    myObjv[1] = Tcl_GetObjectName(interp, object);
    myObjv[2] = tkoPtr->Obj_method;
    myObjv[3] = tkoPtr->Obj__class;
    myObjv[4] = tkoPtr->Obj_empty;
    myObjv[5] = tkoPtr->Obj_error_readonly;
    if (Tcl_EvalObjv(interp, 6, myObjv, TCL_EVAL_GLOBAL) != TCL_OK) {
        goto error;
    }
 	Tk_SetClass(widget->tkWin, textPtr);
    /*
     * Add all options and configure readonly options.
     */
	if (Tcl_DictObjFirst(interp, dictPtr, &search, &key, &value, &done) != TCL_OK) {
		goto error;
	}
	for (; !done; Tcl_DictObjNext(&search, &key, &value, &done)) {
	    if (WidgetOption_Init(interp, widget, tkoPtr, key, value, arglist,
            tkoList, myList, NULL) != TCL_OK) {
		    goto error;
	    }
	}
    /* check on unknown options on command line args */
    if(Tcl_GetString(arglist)[0] != '\0') {
        Tcl_SetObjResult(interp, Tcl_ObjPrintf("unknown options: %s",
                Tcl_GetString(arglist)));
        goto error;
    }
    /* call "my -option" commands and set new body */
    if (Tcl_ListObjGetElements(interp, myList, &argObjc, &argObjv) != TCL_OK || argObjc%2) {
	    goto error;
    }
	for (i = 0; i < argObjc; i++) {
		myObjv[0] = widget->myCmd;
		myObjv[1] = argObjv[i];
	    if (Tcl_EvalObjv(interp, 2, myObjv, TCL_EVAL_GLOBAL) != TCL_OK) {
		    goto error;
	    }
		myObjv[0] = tkoPtr->Obj_oo_objdefine;
		myObjv[1] = Tcl_GetObjectName(interp,object);
		myObjv[2] = tkoPtr->Obj_method;
		myObjv[3] = argObjv[i];
        myObjv[4] = tkoPtr->Obj_empty;
		myObjv[5] = argObjv[i+1];
	    if (Tcl_EvalObjv(interp, 6, myObjv, TCL_EVAL_GLOBAL) != TCL_OK) {
	        goto error;
	    }
        i++;
    }
    /* save options for later call of "my -option" */
	if (Tcl_ObjSetVar2(interp, widget->optionsArray, tkoPtr->Obj_init,
		tkoList, TCL_GLOBAL_ONLY) == NULL) {
		goto error;
	}
    /* Now activate option array tracing */
    Tcl_TraceVar2(interp, Tcl_GetString(widget->optionsArray), NULL,
        TCL_TRACE_WRITES | TCL_TRACE_RESULT_OBJECT, WidgetOptionTrace, widget);

    /* If we are a widget add our own event funtion */
    Tk_CreateEventHandler(widget->tkWin, StructureNotifyMask | VirtualEventMask,
            WidgetEventProc, (ClientData)widget);

    if (dictPtr) Tcl_DecrRefCount(dictPtr);
	if (tkoList) Tcl_DecrRefCount(tkoList);
	if (myList) Tcl_DecrRefCount(myList);
    Tcl_Release(widget);
    return TCL_OK;

error:
 	if (dictPtr) Tcl_DecrRefCount(dictPtr);
	if (tkoList) Tcl_DecrRefCount(tkoList);
	if (myList) Tcl_DecrRefCount(myList);
    Tcl_Release(widget);
    Tcl_DeleteCommandFromToken(interp, widget->widgetCmd);
    return TCL_ERROR;
}

/*
 * Tko_WidgetDestroy --
 *    Delete widget window and command.
 *
 * Results:
 *    A standard Tcl result.
 *
 * Side effects:
 *    Delete widget ressources and remove widget window.
 */
void
Tko_WidgetDestroy(
    Tcl_ObjectContext context)
{
    Tko_Widget *widget;

    if ((widget = (Tko_Widget *)Tko_WidgetClientData(context)) == NULL) {
        return;
    }
    Tcl_Preserve(widget);
    if (widget->tkWin) {
        WidgetDeleteTkwin(widget);
    }
    if (widget->myCmd) {
        Tcl_DecrRefCount(widget->myCmd);
        widget->myCmd = NULL;
    }
    Tcl_ObjectSetMetadata(widget->object, &tkoWidgetMeta, NULL);
    Tcl_Release(widget);
    return;
}

/*
 * Tko_WidgetClientData --
 *    Return pointer to widget client data.
 *
 * Results:
 *    None.
 *
 * Side effects:
 *    None.
 */
ClientData Tko_WidgetClientData(
    Tcl_ObjectContext context)
{
    Tcl_Object object;
    if ((object = Tcl_ObjectContextObject(context)) == NULL) {
        return NULL;
    }
    return Tcl_ObjectGetMetadata(object, &tkoWidgetMeta);
}

/*
 * WidgetMetaDestroy --
 *    Free ressources.
 *
 * Results:
 *    None.
 *
 * Side effects:
 *    Delete or give back all used internal ressources
 */
static void
WidgetMetaDestroy(
    Tko_Widget * widget)
{
    if (widget->optionsDict != NULL) {
        Tcl_DecrRefCount((widget->optionsDict));
        widget->optionsDict = NULL;
    }
    if (widget->optionsArray != NULL) {
        Tcl_DecrRefCount((widget->optionsArray));
        widget->optionsArray = NULL;
    }
    ckfree(widget);
}

/*
 * WidgetDeleteTkwin --
 *    Resets internal Tk_Window in widget structure.
 *
 * Results:
 *    None.
 *
 * Side effects:
 *    Delete event handler of widget.
 *    When the widget is wrappen then delete wrap widget command.
 */
static void WidgetDeleteTkwin(
    Tko_Widget *widget)
{
    Tcl_Obj *tmpObj;

    TkoThreadData *tkoPtr = Tcl_GetThreadData(&tkoKey, sizeof(TkoThreadData));
    Tk_DeleteEventHandler(widget->tkWin, StructureNotifyMask | VirtualEventMask,
        WidgetEventProc, widget);
    tmpObj = Tcl_ObjGetVar2(widget->interp, widget->optionsArray, tkoPtr->Obj_point2, TCL_GLOBAL_ONLY);
    if (tmpObj) {
        tmpObj = Tcl_ObjPrintf("rename %s {}", Tcl_GetString(tmpObj));
        Tcl_IncrRefCount(tmpObj);
        Tcl_EvalObjEx(widget->interp, tmpObj,TCL_GLOBAL_ONLY);
        Tcl_DecrRefCount(tmpObj);
    }
    else {
        Tk_DestroyWindow(widget->tkWin);
    }
    widget->tkWin = NULL;
}

/*
 * WidgetOptionTrace --
 * Write trace on option array variable
 *
 * Results:
 *    Return NULL if successfull and leave error message otherwise.
 *
 * Side effects:
 *    Check on existence of option and call "-option" method with new value.
 */
static char*
WidgetOptionTrace(
    ClientData clientData,
    Tcl_Interp* interp,
    const char* name1,
    const char* name2,
    int flags)
{
    Tko_Widget* widget = (Tko_Widget*)clientData;
    Tcl_Obj* myObjv[2];
    Tcl_Obj* myRet;

    if (name2[0] != '-') {
        return NULL;
    }

    myObjv[0] = widget->myCmd;
    myObjv[1] = Tcl_NewStringObj(name2,-1);
    Tcl_IncrRefCount(myObjv[1]);
    if (Tcl_EvalObjv(interp, 2, myObjv, TCL_EVAL_GLOBAL) != TCL_OK) {
        Tcl_DecrRefCount(myObjv[1]);
        myRet = Tcl_GetObjResult(interp);
        Tcl_IncrRefCount(myRet);
        return (char*)myRet;
    }
    Tcl_DecrRefCount(myObjv[1]);
    return NULL;
}

/*
 * WidgetEventProc --
 *    This function is invoked by the Tk dispatcher for various events on
 *    canvases.
 *
 * Results:
 *    None.
 *
 * Side effects:
 *    When the window gets deleted, internal structures get cleaned up.
 */
static void
WidgetEventProc(
    ClientData clientData,     /* Information about window. */
    XEvent* eventPtr)
{              /* Information about event. */
    Tko_Widget* widget = (Tko_Widget*)clientData;

    if (eventPtr->type == DestroyNotify) {
        if (widget->tkWin) {
            WidgetDeleteTkwin(widget);
            Tcl_DeleteCommandFromToken(widget->interp, widget->widgetCmd);
        }
        if (widget->myCmd) {
            Tcl_DecrRefCount(widget->myCmd);
            widget->myCmd = NULL;
        }
    }
}


/*
 * Tko_WidgetOptionGet --
 *
 * Results:
 *    Return TclObj value of option or NULL if widget is destroyed.
 *
 * Side effects:
 */
Tcl_Obj *
Tko_WidgetOptionGet(
    Tko_Widget *widget,
    Tcl_Obj *option)
{
    if (widget->optionsArray == NULL || option ==NULL) return NULL;
    return Tcl_ObjGetVar2(widget->interp, widget->optionsArray, option,
        TCL_GLOBAL_ONLY);
}

/*
 * Tko_WidgetOptionSet --
 *    Set option value.
 *
 * Results:
 *    A standard Tcl result.
 *
 * Side effects:
 *    Create necessary C-values.
 */
Tcl_Obj *
Tko_WidgetOptionSet(
    Tko_Widget *widget,
    Tcl_Obj * option,
    Tcl_Obj * value)
{
    if (widget->optionsArray == NULL || option==NULL || value == NULL) return NULL;
    return Tcl_ObjSetVar2(widget->interp, widget->optionsArray, option, value,
        TCL_GLOBAL_ONLY);
}

/* Tko_WidgetOptionInit --
 *  Call "my _tko_init <classname>"
 *
 * Results:
 *    A standard Tcl result.
 */
int
Tko_WidgetOptionInit(
    Tcl_Interp *interp,
    Tko_Widget *widget,
    Tcl_Obj *classname)
{
    Tcl_Obj* myObjv[3];
    TkoThreadData* tkoPtr = Tcl_GetThreadData(&tkoKey, sizeof(TkoThreadData));
    /* call "my _tko_init <classname>" */
    myObjv[0] = widget->myCmd;
    myObjv[1] = tkoPtr->Obj_tko_init;
    myObjv[2] = classname;
    return Tcl_EvalObjv(interp, 3, myObjv, TCL_EVAL_GLOBAL);
}
/*
 * WidgetMetaDelete --
 *    Delete widget meta data when all preserve calls done.
 *
 * Results:
 *    None.
 *
 * Side effects:
 */
static void
WidgetMetaDelete(
    ClientData clientData)
{
    Tcl_EventuallyFree(clientData, (Tcl_FreeProc *)WidgetMetaDestroy);
}

static int
WidgetMethod_Empty(
	ClientData clientdata,
	Tcl_Interp * interp,
	Tcl_ObjectContext context,
	Tcl_Size objc,
	Tcl_Obj * const objv[])
{
    return TCL_OK;
}


static int
WidgetMethod_(
    ClientData clientdata,
    Tcl_Interp * interp,
    Tcl_ObjectContext context,
    Tcl_Size objc,
    Tcl_Obj * const objv[])
{
    WidgetClientdata *define;
    Tcl_Object object;
    Tko_Widget *widget;
    Tcl_Obj *value;
    char *address = NULL;
    int intVal;
    double dblVal;
    Colormap colormap;
    int *intPtr;
    const char *str;
    Tcl_Size length;
    int pixels[4] = { 0, 0, 0, 0 };
    Tcl_Size myObjc;
    Tcl_Obj **myObjv;
    Visual * visual;
    XColor * color;
    Tk_3DBorder border;
    Tk_Anchor anchor;
    Tk_Cursor cursor;
    Tk_Window newWin;
    Tk_Font newFont;
    Tk_Justify justify;

    if ((define = (WidgetClientdata *)clientdata) == NULL
        || (object = Tcl_ObjectContextObject(context)) == NULL
        || (widget = (Tko_Widget *)Tcl_ObjectGetMetadata(object, &tkoWidgetMeta))
            == NULL
        || (value = Tcl_ObjGetVar2(interp, widget->optionsArray, define->option,
            TCL_GLOBAL_ONLY)) == NULL
        || widget->myCmd == NULL) {
        return TCL_ERROR;
    }
    if (define->offset > 0) {
        address = ((char *)widget) + define->offset;
    }

    switch (define->type) {
    case TKO_SET_CLASS:        /* (Tcl_Obj **)address */
        Tk_SetClass(widget->tkWin, Tcl_GetString(value));
        if (address) {
            if (*((Tcl_Obj **)address) != NULL)
                Tcl_DecrRefCount(*((Tcl_Obj **)address));
            *((Tcl_Obj **)address) = value;
            Tcl_IncrRefCount(value);
        }
        return TCL_OK;
    case TKO_SET_VISUAL:       /* (Tcl_Obj **)address */
        visual =
            Tk_GetVisual(interp, widget->tkWin, Tcl_GetString(value), &intVal,
                &colormap);
        if (visual == NULL)
            return TCL_ERROR;
        Tk_SetWindowVisual(widget->tkWin, visual, intVal, colormap);
        if (address) {
            if (*((Tcl_Obj **)address) != NULL)
                Tcl_DecrRefCount(*((Tcl_Obj **)address));
            *((Tcl_Obj **)address) = value;
            Tcl_IncrRefCount(value);
        }
        return TCL_OK;
    case TKO_SET_COLORMAP:     /* (Tcl_Obj **)address */
        str = Tcl_GetStringFromObj(value, &length);
        if (str && length) {
            colormap = Tk_GetColormap(interp, widget->tkWin, str);
            if (colormap == None)
                return TCL_ERROR;
            Tk_SetWindowColormap(widget->tkWin, colormap);
        }
        if (address) {
            if (*((Tcl_Obj **)address) != NULL)
                Tcl_DecrRefCount(*((Tcl_Obj **)address));
            *((Tcl_Obj **)address) = value;
            Tcl_IncrRefCount(value);
        }
        return TCL_OK;
    case TKO_SET_USE:      /* (Tcl_Obj **)address */
        str = Tcl_GetStringFromObj(value, &length);
        if (str && length) {
            if (Tk_UseWindow(interp, widget->tkWin, str) != TCL_OK) {
                return TCL_ERROR;
            }
        }
        else if (!(define->flags & TKO_OPTION_NULL)) {
            return TCL_ERROR;

        }
        if (address) {
            if (*((Tcl_Obj **)address) != NULL)
                Tcl_DecrRefCount(*((Tcl_Obj **)address));
            if (length) {
                *((Tcl_Obj **)address) = value;
                Tcl_IncrRefCount(value);
            }
            else {
                *((Tcl_Obj **)address) = NULL;
            }
        }
        return TCL_OK;
    case TKO_SET_CONTAINER:    /* (int *)address */
        if (Tcl_GetBooleanFromObj(interp, value, &intVal) != TCL_OK)
            return TCL_ERROR;
        if (intVal) {
            Tk_MakeContainer(widget->tkWin);
            Tcl_ObjSetVar2(interp, widget->optionsArray, objv[1], Tcl_NewIntObj(1),
                TCL_GLOBAL_ONLY);
        }
        else {
            Tcl_ObjSetVar2(interp, widget->optionsArray, objv[1], Tcl_NewIntObj(0),
                TCL_GLOBAL_ONLY);
        }
        if (address) {
            *(int *)address = intVal;
        }
        return TCL_OK;
    case TKO_SET_TCLOBJ:       /* (Tcl_Obj **)address */
        if (address) {
            if (*((Tcl_Obj **)address) != NULL)
                Tcl_DecrRefCount(*((Tcl_Obj **)address));
            *((Tcl_Obj **)address) = value;
            Tcl_IncrRefCount(value);
        }
        return TCL_OK;
    case TKO_SET_XCOLOR:       /* (Xcolor **)address */
        color = Tk_AllocColorFromObj(interp, widget->tkWin, value);
        if (color == NULL)
            return TCL_ERROR;
        if (address) {
            if (*((XColor **)address) != NULL) {
                Tk_FreeColor(*((XColor **)address));
            }
            *((XColor **)address) = color;
        }
        else {
            Tk_FreeColor(color);
        }
        return TCL_OK;
    case TKO_SET_3DBORDER:     /* (Tk_3DBorder *)address */
        str = Tcl_GetStringFromObj(value, &length);
        if (str && length) {
            border = Tk_Alloc3DBorderFromObj(interp, widget->tkWin, value);
            if (border == NULL)
                return TCL_ERROR;
        }
        else if (define->flags & TKO_OPTION_NULL) {
            border = NULL;
        } else {
            return TCL_ERROR;
        }
        if (address) {
            if (*(Tk_3DBorder *)address != NULL) {
                Tk_Free3DBorder(*(Tk_3DBorder *)address);
            }
            *(Tk_3DBorder *)address = border;
        }
        else {
            Tk_Free3DBorder(border);
        }
        return TCL_OK;
    case TKO_SET_PIXEL:        /* (int *)address */
        if (Tk_GetPixelsFromObj(interp, widget->tkWin, value, &intVal) != TCL_OK) {
            return TCL_ERROR;
        }
        if (address) {
            *(int *)address = intVal;
        }
        Tcl_ObjSetVar2(interp, widget->optionsArray, objv[1],
            Tcl_NewIntObj(intVal), TCL_GLOBAL_ONLY);
        return TCL_OK;
    case TKO_SET_PIXELNONEGATIV:       /* (int *)address */
        if (Tk_GetPixelsFromObj(interp, widget->tkWin, value, &intVal) != TCL_OK) {
            return TCL_ERROR;
        }
        if (intVal >= SHRT_MAX) {
            Tcl_AppendResult(interp, "bad distance \"", Tcl_GetString(value),
                "\": ", "too big to represent", (char *)NULL);
            return TCL_ERROR;
        }
        if (intVal < 0) {
            Tcl_AppendResult(interp, "bad distance \"", Tcl_GetString(value),
                "\": ", "can't be negative", (char *)NULL);
            return TCL_ERROR;
        }
        if (address) {
            *(int *)address = intVal;
        }
        Tcl_ObjSetVar2(interp, widget->optionsArray, objv[1],
            Tcl_NewIntObj(intVal), TCL_GLOBAL_ONLY);
        return TCL_OK;
    case TKO_SET_PIXELPOSITIV: /* (int *)address */
        if (Tk_GetPixelsFromObj(interp, widget->tkWin, value, &intVal) != TCL_OK) {
            return TCL_ERROR;
        }
        if (intVal >= SHRT_MAX) {
            Tcl_AppendResult(interp, "bad distance \"", Tcl_GetString(value),
                "\": ", "too big to represent", (char *)NULL);
            return TCL_ERROR;
        }
        if (intVal <= 0) {
            Tcl_AppendResult(interp, "bad distance \"", Tcl_GetString(value),
                "\": ", "must be positive", (char *)NULL);
            return TCL_ERROR;
        }
        if (address) {
            *(int *)address = intVal;
        }
        Tcl_ObjSetVar2(interp, widget->optionsArray, objv[1],
            Tcl_NewIntObj(intVal), TCL_GLOBAL_ONLY);
        return TCL_OK;
    case TKO_SET_DOUBLE:       /* (double *)address */
        if (Tcl_GetDoubleFromObj(interp, value, &dblVal) != TCL_OK) {
            return TCL_ERROR;
        }
        if (address) {
            *(double *)address = dblVal;
        }
        Tcl_ObjSetVar2(interp, widget->optionsArray, objv[1],
            Tcl_NewDoubleObj(dblVal), TCL_GLOBAL_ONLY);
        return TCL_OK;
    case TKO_SET_BOOLEAN:      /* (int *)address */
        if (Tcl_GetBooleanFromObj(interp, value, &intVal) != TCL_OK) {
            return TCL_ERROR;
        }
        if (intVal) {
            Tcl_ObjSetVar2(interp, widget->optionsArray, objv[1], Tcl_NewIntObj(1),
                TCL_GLOBAL_ONLY);
        }
        else {
            Tcl_ObjSetVar2(interp, widget->optionsArray, objv[1], Tcl_NewIntObj(0),
                TCL_GLOBAL_ONLY);
        }
        if (address) {
            *(int *)address = intVal;
        }
        Tcl_ObjSetVar2(interp, widget->optionsArray, objv[1],
            Tcl_NewIntObj(intVal), TCL_GLOBAL_ONLY);
        return TCL_OK;
    case TKO_SET_CURSOR:       /* (Tk_Cursor *)address */
        cursor = NULL;
        if (Tcl_GetString(value)[0] != '\0') {
            cursor = Tk_AllocCursorFromObj(interp, widget->tkWin, value);
            if (cursor == NULL) {
                return TCL_ERROR;
            }
            Tk_DefineCursor(widget->tkWin, cursor);
        }
        if (address) {
            if (*(Tk_Cursor *)address != NULL) {
                Tk_FreeCursor(Tk_Display(widget->tkWin),
                    *(Tk_Cursor *)address);
            }
            *(Tk_Cursor *)address = cursor;
        }
        else {
            if (cursor != NULL) {
                Tk_FreeCursor(Tk_Display(widget->tkWin), cursor);/*TODO necessary? */
            }
        }
        return TCL_OK;
    case TKO_SET_INT:  /* (int *)address */
        if (Tcl_GetIntFromObj(interp, value, &intVal) != TCL_OK) {
            return TCL_ERROR;
        }
        if (address) {
            *(int *)address = intVal;
        }
        Tcl_ObjSetVar2(interp, widget->optionsArray, objv[1],
            Tcl_NewIntObj(intVal), TCL_GLOBAL_ONLY);
        return TCL_OK;
    case TKO_SET_RELIEF:       /* (int *)address */
        if (Tk_GetReliefFromObj(interp, value, &intVal) != TCL_OK) {
            return TCL_ERROR;
        }
        if (address) {
            *(int *)address = intVal;
        }
        return TCL_OK;
    case TKO_SET_ANCHOR:       /* (Tk_Anchor *)address */
        if (Tk_GetAnchorFromObj(interp, value, &anchor) != TCL_OK) {
            return TCL_ERROR;
        }
        if (address) {
            *(Tk_Anchor *)address = anchor;
        }
        return TCL_OK;
    case TKO_SET_WINDOW:       /* (Tk_Window *)address */
        if (value == NULL || Tcl_GetCharLength(value) == 0) {
            newWin = NULL;
        }
        else {
            if (TkGetWindowFromObj(interp, widget->tkWin, value,
                &newWin) != TCL_OK) {
                return TCL_ERROR;
            }
        }
        if (address) {
            *(Tk_Window *)address = newWin;
        }
        return TCL_OK;
    case TKO_SET_FONT: /* (Tk_Font *)address */
        newFont = Tk_AllocFontFromObj(interp, widget->tkWin, value);
        if (newFont == NULL) {
            return TCL_ERROR;
        }
        if (address) {
            if (*(Tk_Font *)address != NULL) {
                Tk_FreeFont(*(Tk_Font *)address);
            }
            *(Tk_Font *)address = newFont;
        }
        else {
            Tk_FreeFont(newFont);
        }
        return TCL_OK;
    case TKO_SET_STRING:   /* (char **)address */
        if (address) {
            str = Tcl_GetStringFromObj(value, &length);
            if (*(char **)address != NULL) {
                ckfree(*(char **)address);
            }
            if (length == 0 && define->flags&TKO_OPTION_NULL) {
                *(char **)address = NULL;
            }
            else {
                *(char **)address=ckalloc(length + 1);
                assert(*(char **)address);
                memcpy(*(char **)address, str, length + 1);
            }
        }
        return TCL_OK;
    case TKO_SET_SCROLLREGION: /* (int *[4])address */
        if (Tcl_ListObjGetElements(interp, value, &myObjc, &myObjv) != TCL_OK) {
            return TCL_ERROR;
        }
        if (myObjc == 4) {
            if (Tk_GetPixelsFromObj(interp, widget->tkWin, myObjv[0],
                &pixels[0]) != TCL_OK
                || Tk_GetPixelsFromObj(interp, widget->tkWin, myObjv[1],
                    &pixels[1]) != TCL_OK
                || Tk_GetPixelsFromObj(interp, widget->tkWin, myObjv[2],
                    &pixels[2]) != TCL_OK
                || Tk_GetPixelsFromObj(interp, widget->tkWin, myObjv[3],
                    &pixels[3]) != TCL_OK) {
                return TCL_ERROR;
            }
        }
        else if (myObjc != 0) {
            Tcl_SetObjResult(interp,
                Tcl_ObjPrintf("found %d instead of 4 values", myObjc));
            return TCL_ERROR;
        }
        if (address) {
            intPtr = (int *)address;
            intPtr[0] = pixels[0];
            intPtr[1] = pixels[1];
            intPtr[2] = pixels[2];
            intPtr[3] = pixels[3];
        }
        return TCL_OK;
    case TKO_SET_JUSTIFY:      /* (Tk_Justify *)address */
        if (Tk_GetJustify(interp, Tk_GetUid(Tcl_GetString(value)),
            &justify) != TCL_OK) {
            return TCL_ERROR;
        }
        if (address) {
            *(Tk_Justify *)address = justify;
        }
        return TCL_OK;
    }

    Tcl_SetObjResult(interp, Tcl_ObjPrintf("unknown type \"%d\"", define->type));
    return TCL_ERROR;
}

/*
 * WidgetClientdataDelete --
 *    Delete widget internal method clientdata.
 *
 * Results:
 *    None.
 *
 * Side effects:
 *    Free memory.
 */
static void WidgetClientdataDelete(
    ClientData clientdata)
{
    WidgetClientdata *cd = (WidgetClientdata *)clientdata;
    Tcl_DecrRefCount(cd->option);
    ckfree(cd);
}

/*
 * WidgetClientdataClone --
 *    Copy widget internal method clientdata.
 *
 * Results:
 *    Return copied clientdata in newPtr.
 *
 * Side effects:
 */
static int WidgetClientdataClone(
    Tcl_Interp *interp,
    ClientData clientdata,
    ClientData *newPtr)
{
    WidgetClientdata *cd = (WidgetClientdata *)clientdata;
    if (cd) {
        *newPtr = ckalloc(sizeof(WidgetClientdata));
        assert(*newPtr);
        memcpy(*newPtr, cd, sizeof(WidgetClientdata));
        Tcl_IncrRefCount(cd->option);
    }
    return TCL_OK;
}

/* vim: set ts=4 sw=4 sts=4 ff=unix et : */

