Subversion Repositories or1k

/*
 * tixWidget.c --
 *
 *	Constructs Tix-based compound widgets
 *
 * 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.
 *
 */
 
#include <tclInt.h>
#include <tixInt.h>
#include <tixItcl.h>
 
static int			ParseOptions _ANSI_ARGS_((
				    Tcl_Interp * interp,TixClassRecord * cPtr,
				    char *widRec, int argc, char** argv));
 
TIX_DECLARE_CMD(Tix_InstanceCmd);
 
/*----------------------------------------------------------------------
 * Tix_CreateWidgetCmd
 *
 * 	Create an instance object of a Tix widget class.
 *
 * argv[0]  = object name.
 * argv[1+] = args
 *----------------------------------------------------------------------
 */
TIX_DEFINE_CMD(Tix_CreateWidgetCmd)
{
    TixClassRecord * cPtr =(TixClassRecord *)clientData;
    TixConfigSpec * spec;
    char * widRec = NULL;
    char * rootCmd = NULL;
    char * tmpArgv[3];
    char * value;
    int i;
    int code = TCL_OK;
    Tk_Window mainWin = Tk_MainWindow(interp);
    Tcl_DString ds;
 
    DECLARE_ITCL_NAMESP(nameSp, interp);
 
    if (argc <= 1) {
	return Tix_ArgcError(interp, argc, argv, 1, "pathname ?arg? ...");
    } else {
	widRec = argv[1];
    }
 
    if (Tk_NameToWindow(interp, widRec, mainWin) != NULL) {
	Tcl_ResetResult(interp);
	Tcl_AppendResult(interp, "window name \"", widRec,
	    "\" already exists", NULL);
	return TCL_ERROR;
    } else {
	Tcl_ResetResult(interp);
    }
 
    if (!TixItclSetGlobalNameSp(&nameSp, interp)) {
        code = TCL_ERROR;
	goto done;
    }
 
    /*
     * Before doing anything, let's reset the TCL result, errorInfo,
     * errorCode, etc.
     */
    Tcl_SetVar2(interp, "errorInfo", NULL, "", TCL_GLOBAL_ONLY);
    Tcl_SetVar2(interp, "errorCode", NULL, "", TCL_GLOBAL_ONLY);
    Tcl_ResetResult(interp);
 
    /* Set up the widget record */
    rootCmd = ckalloc(strlen(widRec)+10);
    sprintf(rootCmd, "%s:root", widRec);
    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);
    Tcl_SetVar2(interp, widRec, "w:root",    widRec,  	      TCL_GLOBAL_ONLY);
    Tcl_SetVar2(interp, widRec, "rootCmd",   rootCmd,         TCL_GLOBAL_ONLY);
 
    /* We need to create the root widget in order to parse the options
     * database
     */
    if (Tix_CallMethod(interp, cPtr->className, widRec, "CreateRootWidget",
	    argc-2, argv+2) != TCL_OK) {
	code = TCL_ERROR;
	goto done;
    }
 
    /* Parse the options specified in the option database and supplied
     * in the command line.
     */
    Tcl_ResetResult(interp);
    if (ParseOptions(interp, cPtr, widRec, argc-2, argv+2) != TCL_OK) {
	code = TCL_ERROR;
	goto done;
    }
 
    /* Rename the root widget command and create a new TCL command for
     * this widget
     */
 
#ifndef TK_8_0_OR_LATER
    tmpArgv[0] = "rename";
    tmpArgv[1] = widRec;
    tmpArgv[2] = rootCmd;
 
    if (Tcl_RenameCmd((ClientData)0, interp, 3, tmpArgv) != TCL_OK) {
	code = TCL_ERROR;
	goto done;
    }
#else
    Tcl_DStringInit(&ds);
    Tcl_DStringAppendElement(&ds, "rename");
    Tcl_DStringAppendElement(&ds, widRec);
    Tcl_DStringAppendElement(&ds, rootCmd);
 
    if (Tcl_Eval(interp, ds.string) != TCL_OK) {
	Tcl_DStringFree(&ds);
	code = TCL_ERROR;
	goto done;
    } else {
	Tcl_DStringFree(&ds);
    }
#endif
 
    Tcl_CreateCommand(interp, widRec, Tix_InstanceCmd,
	(ClientData)cPtr, NULL);
 
    /* Now call the initialization methods defined by the Tix Intrinsics
     */
    if (Tix_CallMethod(interp, cPtr->className, widRec, "InitWidgetRec",
	    0, 0) != TCL_OK) {
	code = TCL_ERROR;
	goto done;
    }
 
    if (Tix_CallMethod(interp, cPtr->className, widRec, "ConstructWidget",
	    0, 0) != TCL_OK) {
	code = TCL_ERROR;
	goto done;
    }
 
    if (Tix_CallMethod(interp, cPtr->className, widRec, "SetBindings",
		0, 0) != TCL_OK) {
	code = TCL_ERROR;
	goto done;
    }
 
    /* The widget has been successfully initialized. Now call the config
     * method for all -forceCall options
     */
    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:
 
    if (code != TCL_OK) {
	/* %% TCL CORE USED !! %% */
	Interp *iPtr = (Interp *) interp;
	char * oldResult, * oldErrorInfo, * oldErrorCode;
	Tk_Window topLevel, tkwin;
 
	/* We need to save the old error message because
	 * interp->result may be changed by some of the following function
	 * calls.
	 */
	if (interp->result) {
	    oldResult = (char*)tixStrDup(interp->result);
#if 0
	    printf("%s -->\n%s\n", widRec, oldResult);
#endif
	} else {
	    oldResult = NULL;
	}
	oldErrorInfo = Tcl_GetVar2(interp, "errorInfo", NULL, TCL_GLOBAL_ONLY);
	oldErrorCode = Tcl_GetVar2(interp, "errorCode", NULL, TCL_GLOBAL_ONLY);
 
	Tcl_ResetResult(interp);
 
	/* (1) window */
	topLevel = cPtr->mainWindow;
 
	if (widRec != NULL) {
	    Display *display = NULL;
 
	    tkwin = Tk_NameToWindow(interp, widRec, topLevel);
	    if (tkwin != NULL) {
		display = Tk_Display(tkwin);
		Tk_DestroyWindow(tkwin);
	    }
 
	    /* (2) widget command + root command */
	    Tcl_DeleteCommand(interp, widRec);
	    Tcl_DeleteCommand(interp, rootCmd);
 
	    /* (3) widget record */
	    Tcl_UnsetVar(interp, widRec, TCL_GLOBAL_ONLY);
 
	    if (display) {
#ifndef _WINDOWS
		XSync(display, False);
#endif
		while (1) {
		    if (Tk_DoOneEvent(TK_X_EVENTS|TK_DONT_WAIT) == 0) {
			break;
		    }
		}
	    }
	}
	if (oldResult) {
	    Tcl_SetResult(interp, oldResult, TCL_DYNAMIC);
	}
	if (oldErrorInfo && *oldErrorInfo) {
	    Tcl_SetVar2(interp, "errorInfo", NULL, oldErrorInfo,
		TCL_GLOBAL_ONLY);
	} else {
	    Tcl_SetVar2(interp, "errorInfo", NULL, oldResult,
		TCL_GLOBAL_ONLY);
	}
	if (oldErrorCode) {
	    Tcl_SetVar2(interp, "errorCode", NULL, oldErrorCode,
		TCL_GLOBAL_ONLY);
	}
	iPtr->flags |= ERR_IN_PROGRESS;
    }
    if (rootCmd) {
	ckfree(rootCmd);
    }
 
    TixItclRestoreGlobalNameSp(&nameSp, interp);
 
    return code;
}
 
/*----------------------------------------------------------------------
 * Subroutines for object instantiation.
 *
 *
 *----------------------------------------------------------------------
 */
static int ParseOptions(interp, cPtr, widRec, argc, argv)
    Tcl_Interp * interp;
    TixClassRecord * cPtr;
    char *widRec;
    int argc;
    char** argv;
{
    int i;
    TixConfigSpec *spec;
    Tk_Window tkwin;
    char * value;
 
    if ((argc %2) != 0) {
	Tcl_AppendResult(interp, "missing argument for \"", argv[argc-1],
	    "\"", NULL);
	return TCL_ERROR;
    }
 
    if ((tkwin = Tk_NameToWindow(interp, widRec, cPtr->mainWindow)) == 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 ((value=Tk_GetOption(tkwin,spec->dbName,spec->dbClass))==NULL) {
		value = spec->defValue;
	    }
	    if (Tix_ChangeOneOption(interp, cPtr, widRec, spec,
		value, 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;
}