/*
 * ------------------------------------------------------------------------
 *      PACKAGE:  [incr Tcl]
 *  DESCRIPTION:  Object-Oriented Extensions to Tcl
 *
 *  These procedures handle built-in class methods, including the
 *  "installhull" method for package ItclWidget
 *
 * This implementation is based mostly on the ideas of snit
 * whose author is William Duquette.
 *
 * ========================================================================
 *  Author: Arnulf Wiedemann
 *
 * ========================================================================
 *           Copyright (c) 2007 Arnulf Wiedemann
 * ------------------------------------------------------------------------
 * See the file "license.terms" for information on usage and redistribution
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 */
#include "itclWidgetInt.h"
#include <tk.h>

/*
 *  Standard list of built-in methods for all objects.
 */
typedef struct BiMethod {
    char* name;              /* method name */
    char* usage;             /* string describing usage */
    char* registration;      /* registration name for C proc */
    Tcl_ObjCmdProc *proc;    /* implementation C proc */
} BiMethod;

static BiMethod BiMethodList[] = {
    { "installhull", "using widgetType ?arg ...?",
                   "@itcl-builtin-installhull",  Itcl_BiInstallHullCmd },
};
static int BiMethodListLen = sizeof(BiMethodList)/sizeof(BiMethod);

Tcl_CommandTraceProc ItclHullContentsDeleted;



/*
 * ------------------------------------------------------------------------
 *  Itcl_WidgetBiInit()
 *
 *  Creates a namespace full of built-in methods/procs for [incr Tcl]
 *  classes.  This includes things like the "isa" method and "info"
 *  for querying class info.  Usually invoked by Itcl_Init() when
 *  [incr Tcl] is first installed into an interpreter.
 *
 *  Returns TCL_OK/TCL_ERROR to indicate success/failure.
 * ------------------------------------------------------------------------
 */
void ItclHullContentsDeleted(
    void *clientData,
    Tcl_Interp *interp,
    const char *oldName,
    const char *newName,
    int flags)
{
    Tcl_HashEntry *hPtr;
    ItclObjectInfo *infoPtr;
    ItclObject *ioPtr;

    ioPtr = (ItclObject *)clientData;
    infoPtr = Tcl_GetAssocData(interp, ITCL_INTERP_DATA, NULL);
    hPtr = Tcl_FindHashEntry(&infoPtr->objects, (char *)ioPtr);
    if (hPtr == NULL) {
       /* object has already been deleted */
       return;
    }
    if (newName == NULL) {
        /* delete the object which has this as an itcl_hull contents */
        Itcl_RenameCommand(ioPtr->interp,
	        Tcl_GetString(ioPtr->origNamePtr), NULL);
/*
fprintf(stderr, "RES!%d!%s!\n", result, Tcl_GetStringResult(ioPtr->iclsPtr->interp));
*/
    }
}

/*
 * ------------------------------------------------------------------------
 *  Itcl_WidgetBiInit()
 *
 *  Creates a namespace full of built-in methods/procs for [incr Tcl]
 *  classes.  This includes things like the "isa" method and "info"
 *  for querying class info.  Usually invoked by Itcl_Init() when
 *  [incr Tcl] is first installed into an interpreter.
 *
 *  Returns TCL_OK/TCL_ERROR to indicate success/failure.
 * ------------------------------------------------------------------------
 */
int
Itcl_WidgetBiInit(
    Tcl_Interp *interp,      /* current interpreter */
    ItclObjectInfo *infoPtr)
{
    Tcl_DString buffer;
    int i;

    /*
     *  "::itcl::builtin" commands.
     *  These commands are imported into each class
     *  just before the class definition is parsed.
     */
    Tcl_DStringInit(&buffer);
    for (i=0; i < BiMethodListLen; i++) {
	Tcl_DStringSetLength(&buffer, 0);
	Tcl_DStringAppend(&buffer, "::itcl::builtin::", TCL_INDEX_NONE);
	Tcl_DStringAppend(&buffer, BiMethodList[i].name, TCL_INDEX_NONE);
        Tcl_CreateObjCommand(interp, Tcl_DStringValue(&buffer),
	        BiMethodList[i].proc, (void *)infoPtr, NULL);
    }
    Tcl_DStringFree(&buffer);
    return TCL_OK;
}


/*
 * ------------------------------------------------------------------------
 *  Itcl_InstallWidgetBiMethods()
 *
 *  Invoked when a class is first created, just after the class
 *  definition has been parsed, to add definitions for built-in
 *  methods to the class.  If a method already exists in the class
 *  with the same name as the built-in, then the built-in is skipped.
 *  Otherwise, a method definition for the built-in method is added.
 *
 *  Returns TCL_OK if successful, or TCL_ERROR (along with an error
 *  message in the interpreter) if anything goes wrong.
 * ------------------------------------------------------------------------
 */
int
Itcl_InstallWidgetBiMethods(
    Tcl_Interp *interp,      /* current interpreter */
    ItclClass *iclsPtr)      /* class definition to be updated */
{
    int result = TCL_OK;
    Tcl_HashEntry *hPtr = NULL;

    int i;
    ItclHierIter hier;
    ItclClass *superPtr;

    /*
     *  Scan through all of the built-in methods and see if
     *  that method already exists in the class.  If not, add
     *  it in.
     *
     *  TRICKY NOTE:  The virtual tables haven't been built yet,
     *    so look for existing methods the hard way--by scanning
     *    through all classes.
     */
    Tcl_Obj *objPtr = Tcl_NewStringObj("", 0);
    for (i=0; i < BiMethodListLen; i++) {
        Itcl_InitHierIter(&hier, iclsPtr);
	Tcl_SetStringObj(objPtr, BiMethodList[i].name, TCL_INDEX_NONE);
        superPtr = Itcl_AdvanceHierIter(&hier);
        while (superPtr) {
            hPtr = Tcl_FindHashEntry(&superPtr->functions, (char *)objPtr);
            if (hPtr) {
                break;
            }
            superPtr = Itcl_AdvanceHierIter(&hier);
        }
        Itcl_DeleteHierIter(&hier);

        if (!hPtr) {
            result = Itcl_CreateMethod(interp, iclsPtr,
	        Tcl_NewStringObj(BiMethodList[i].name, TCL_INDEX_NONE),
                BiMethodList[i].usage, BiMethodList[i].registration);

            if (result != TCL_OK) {
                break;
            }
        }
    }
    return result;
}

/*
 * ------------------------------------------------------------------------
 *  Itcl_BiInstallHullCmd()
 *
 *  Invoked whenever the user issues the "installhull" method for an object.
 *  Handles the following syntax:
 *
 *    installhull using <widgetType> ?arg ...?
 *    installhull name
 *
 * ------------------------------------------------------------------------
 */

int
Itcl_BiInstallHullCmd(
    void *clientData,        /* ItclObjectInfo *Ptr */
    Tcl_Interp *interp,      /* current interpreter */
    int objc,                /* number of arguments */
    Tcl_Obj *const objv[])   /* argument objects */
{
    FOREACH_HASH_DECLS;
    Tcl_Obj *namePtr;
    Tcl_Obj *classNamePtr;
    Tcl_DString buffer;
    Tcl_Obj **newObjv;
    Tk_Window tkMainWin;
    Tk_Window tkWin;
    ItclClass *contextIclsPtr;
    ItclObject *contextIoPtr;
    ItclObjectInfo *infoPtr;
    ItclVariable *ivPtr;
    ItclOption *ioptPtr;
    ItclDelegatedOption *idoPtr;
    const char *val;
    const char *itclHull;
    const char *component;
    const char *widgetType;
    const char *className;
    const char *widgetName;
    const char *origWidgetName;
    char *token;
    int newObjc;
    int lgth;
    int i;
    int iOpts;
    int noOptionSet;
    int shortForm;
    int numOptArgs;
    int optsStartIdx;
    int result;

    result = TCL_OK;
    tkWin = NULL;
    component = NULL;
    ItclShowArgs(1, "Itcl_BiInstallHullCmd", objc, objv);
    infoPtr = (ItclObjectInfo *)clientData;
    if (infoPtr->buildingWidget) {
	contextIoPtr = infoPtr->currIoPtr;
        contextIclsPtr = contextIoPtr->iclsPtr;
    } else {
        /*
         *  Make sure that this command is being invoked in the proper
         *  context.
         */
        contextIclsPtr = NULL;
        if (Itcl_GetContext(interp, &contextIclsPtr, &contextIoPtr) != TCL_OK) {
            return TCL_ERROR;
        }
    }

    if (contextIoPtr == NULL) {
        Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
            "cannot installhull without an object context", NULL);
        return TCL_ERROR;
    }
    if (objc < 3) {
	if (objc != 2) {
            token = Tcl_GetString(objv[0]);
            Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
                "wrong # args: should be \"", token,
	        "\" name|using <widgetType> ?arg ...?\"", NULL);
            return TCL_ERROR;
	}
    }
    shortForm = 0;
    widgetName = Tcl_GetString(contextIoPtr->namePtr);
    origWidgetName = widgetName;
    if (objc == 2) {
        shortForm = 1;
        widgetName = Tcl_GetString(objv[1]);
    }
    const char *wName;
    wName = strstr(widgetName, "::");
    if (wName != NULL) {
        widgetName = wName + 2;
    }

    optsStartIdx = 3;
    if (!shortForm) {
        widgetType = Tcl_GetString(objv[2]);
	classNamePtr = NULL;
	className = NULL;
	if (objc > 3) {
            if (strcmp(Tcl_GetString(objv[3]), "-class") == 0) {
                className = Tcl_GetString(objv[4]);
	        optsStartIdx += 2;
	    }
	}
	if (className == NULL) {
	    classNamePtr = ItclCapitalize(widgetType);
	    className = Tcl_GetString(classNamePtr);
        }
	numOptArgs = objc - optsStartIdx;
	newObjc = 4;
	newObjv = (Tcl_Obj **)ckalloc(sizeof(Tcl_Obj *) *
	        (newObjc + numOptArgs));
	newObjv[0] = Tcl_NewStringObj(widgetType, TCL_INDEX_NONE);
	newObjv[1] = Tcl_NewStringObj(widgetName, TCL_INDEX_NONE);
	newObjv[2] = Tcl_NewStringObj("-class", TCL_INDEX_NONE);
	newObjv[3] = Tcl_NewStringObj(className, TCL_INDEX_NONE);
	i = 4;
	iOpts = optsStartIdx;
	for (; iOpts < objc; iOpts++, i++) {
	    newObjv[i] = objv[iOpts];
	    Tcl_IncrRefCount(newObjv[i]);
	}
	ItclShowArgs(1, "HullCreate", newObjc + numOptArgs, newObjv);
        result = Tcl_EvalObjv(interp, newObjc + numOptArgs, newObjv, 0);
	for (i = newObjc + numOptArgs - 1; i > 3; i--) {
	    Tcl_DecrRefCount(newObjv[i]);
	}
	ckfree((char *)newObjv);
	if (classNamePtr != NULL) {
	    Tcl_DecrRefCount(classNamePtr);
	}

	/* now initialize the itcl_options array */
        tkMainWin = Tk_MainWindow(interp);
        tkWin = Tk_NameToWindow(interp, origWidgetName, tkMainWin);
        if (tkWin != NULL) {
            FOREACH_HASH_VALUE(ioptPtr, &contextIclsPtr->options) {
                val = Tk_GetOption(tkWin, Tcl_GetString(
		        ioptPtr->resourceNamePtr),
	                Tcl_GetString(ioptPtr->classNamePtr));
	        if (val != NULL) {
                    val = ItclSetInstanceVar(interp, "itcl_options",
	                    Tcl_GetString(ioptPtr->namePtr), val,
                            contextIoPtr, contextIoPtr->iclsPtr);
	        } else {
	            if (ioptPtr->defaultValuePtr != NULL) {
                        val = ItclSetInstanceVar(interp, "itcl_options",
	                        Tcl_GetString(ioptPtr->namePtr),
		                Tcl_GetString(ioptPtr->defaultValuePtr),
                                contextIoPtr, contextIoPtr->iclsPtr);
	            }
		}
	    }
        }
    }

    /* initialize the itcl_hull variable */
    i = 0;
    Tcl_DStringInit(&buffer);
    Tcl_DStringAppend(&buffer, ITCL_WIDGETS_NAMESPACE"::hull", TCL_INDEX_NONE);
    lgth = strlen(Tcl_DStringValue(&buffer));
    while (1) {
	Tcl_DStringSetLength(&buffer, lgth);
	i++;
	char buf[10];
	sprintf(buf, "%d", i);
	Tcl_DStringAppend(&buffer, buf, TCL_INDEX_NONE);
        Tcl_DStringAppend(&buffer, Tcl_GetString(contextIoPtr->namePtr), TCL_INDEX_NONE);
	if (Tcl_FindCommand(interp, Tcl_DStringValue(&buffer), NULL, 0)
	        == NULL) {
            break;
	}
    }
    contextIoPtr->hullWindowNamePtr = Tcl_NewStringObj(widgetName, TCL_INDEX_NONE);
/*
fprintf(stderr, "REN!%s!%s!\n", widgetName, Tcl_DStringValue(&buffer));
*/
    Itcl_RenameCommand(interp, widgetName,
            Tcl_DStringValue(&buffer));
    result = Tcl_TraceCommand(interp, Tcl_DStringValue(&buffer),
            TCL_TRACE_RENAME|TCL_TRACE_DELETE,
            ItclHullContentsDeleted, contextIoPtr);

    namePtr = Tcl_NewStringObj("itcl_hull", TCL_INDEX_NONE);
    Tcl_IncrRefCount(namePtr);
    hPtr = Tcl_FindHashEntry(&contextIoPtr->iclsPtr->variables,
            (char *)namePtr);
    Tcl_DecrRefCount(namePtr);
    if (hPtr == NULL) {
	Tcl_AppendResult(interp, "cannot find class variable itcl_hull", NULL);
        return TCL_ERROR;
    }
    ivPtr =Tcl_GetHashValue(hPtr);
    if (ivPtr->initted <= 1) {
        ivPtr->initted = 0;
        hPtr = Tcl_FindHashEntry(&contextIoPtr->objectVariables, (char *)ivPtr);
        val = ItclSetInstanceVar(interp, "itcl_hull", NULL,
                Tcl_DStringValue(&buffer), contextIoPtr, contextIoPtr->iclsPtr);
        ivPtr->initted = 2;
        if (val == NULL) {
            Tcl_AppendResult(interp, "cannot set itcl_hull for object \"",
                Tcl_GetString(contextIoPtr->namePtr), "\"", NULL);
            Tcl_DStringFree(&buffer);
            return TCL_ERROR;
        }
    }
    itclHull = Itcl_GetInstanceVar(interp, "itcl_hull",
            contextIoPtr, contextIoPtr->iclsPtr);
    /* now initialize the delegated options from the option database */
    if (itclHull != NULL) {
        tkMainWin = Tk_MainWindow(interp);
        tkWin = Tk_NameToWindow(interp, origWidgetName, tkMainWin);
        if (tkWin != NULL) {
            FOREACH_HASH_VALUE(idoPtr, &contextIclsPtr->delegatedOptions) {
		val = NULL;
		if (idoPtr->resourceNamePtr == NULL) {
		    /* that is the case when delegating "*" */
		    continue;
		}
		/* check if not in the command line options */
		/* these have higher priority */
		const char *optionName;
		optionName = Tcl_GetString(idoPtr->namePtr);
		if (idoPtr->asPtr != NULL) {
		    optionName = Tcl_GetString(idoPtr->asPtr);
		}
		noOptionSet = 0;
		for (i = optsStartIdx; i < objc; i += 2) {
		    if (strcmp(optionName, Tcl_GetString(objv[i])) == 0) {
		        noOptionSet = 1;
		        break;
		    }
		}
		if (noOptionSet) {
		    break;
		}
                val = Tk_GetOption(tkWin,
		        Tcl_GetString(idoPtr->resourceNamePtr),
		        idoPtr->classNamePtr == NULL ? NULL :
		        Tcl_GetString(idoPtr->classNamePtr));
	        if (val != NULL) {
	            newObjv = (Tcl_Obj **)ckalloc(sizeof(Tcl_Obj *) * 4);
                    component = Itcl_GetInstanceVar(interp,
		            Tcl_GetString(idoPtr->icPtr->namePtr),
                            contextIoPtr, contextIoPtr->iclsPtr);
		    if ((component != NULL) && (strlen(component) > 0)) {
		        newObjv[0] = Tcl_NewStringObj(component, TCL_INDEX_NONE);
		        Tcl_IncrRefCount(newObjv[0]);
		        newObjv[1] = Tcl_NewStringObj("configure", TCL_INDEX_NONE);
		        Tcl_IncrRefCount(newObjv[1]);
		        if (idoPtr->asPtr == NULL) {
		            newObjv[2] = idoPtr->namePtr;
		        } else {
		            newObjv[2] = idoPtr->asPtr;
		        }
		        Tcl_IncrRefCount(newObjv[2]);
		        newObjv[3] = Tcl_NewStringObj(val, TCL_INDEX_NONE);
		        Tcl_IncrRefCount(newObjv[3]);
                        ItclShowArgs(1, "SET OPTION", 4, newObjv);
                        result = Tcl_EvalObjv(interp, 4, newObjv, 0);
		        Tcl_DecrRefCount(newObjv[3]);
		        Tcl_DecrRefCount(newObjv[2]);
		        Tcl_DecrRefCount(newObjv[1]);
		        Tcl_DecrRefCount(newObjv[0]);
	            }
	        }
	    }
        }
    }
    return result;
}
