itk_archetype.c

这是一个Linux下的集成开发环境

        (void) Tcl_Eval(interp, Tcl_DStringValue(&buffer));
        Tcl_ResetResult(interp);
        Tcl_DStringFree(&buffer);

        Tcl_UnsetVar2(interp, "itk_component", token, 0);
        Tcl_DeleteHashEntry(entry);

        /*
         *  Clean up the options that belong to the component.  Do this
         *  by scanning through all available options and looking for
         *  those that belong to the component.  If we remove them as
         *  we go, we'll mess up Tcl_NextHashEntry.  So instead, we
         *  build up a list of options to remove, and then remove the
         *  options below.
         */
        Itcl_InitList(&delOptList);
        entry = Tcl_FirstHashEntry(&info->options, &place);
        while (entry) {
            archOpt = (ArchOption*)Tcl_GetHashValue(entry);
            elem = Itcl_FirstListElem(&archOpt->parts);
            while (elem) {
                optPart = (ArchOptionPart*)Itcl_GetListValue(elem);
                if (optPart->from == (ClientData)archComp) {
                    Itcl_AppendList(&delOptList, (ClientData)entry);
                }
                elem = Itcl_NextListElem(elem);
            }
            entry = Tcl_NextHashEntry(&place);
        }

        /*
         *  Now that we've figured out which options to delete,
         *  go through the list and remove them.
         */
        elem = Itcl_FirstListElem(&delOptList);
        while (elem) {
            entry = (Tcl_HashEntry*)Itcl_GetListValue(elem);
            token = Tcl_GetHashKey(&info->options, entry);

            Itk_RemoveArchOptionPart(info, token, (ClientData)archComp);

            elem = Itcl_NextListElem(elem);
        }
        Itcl_DeleteList(&delOptList);

        Itk_DelArchComponent(archComp);
    }
    return TCL_OK;
}


/*
 * ------------------------------------------------------------------------
 *  Itk_ArchOptKeepCmd()
 *
 *  Invoked by [incr Tcl] to handle the "keep" command in the itk
 *  option parser.  Integrates a list of component configuration options
 *  into a mega-widget, so that whenever the mega-widget is updated,
 *  the component will be updated as well.
 *
 *  Handles the following syntax:
 *
 *      keep <option> ?<option>...?
 *
 *  Returns TCL_OK/TCL_ERROR to indicate success/failure.
 * ------------------------------------------------------------------------
 */
/* ARGSUSED */
static int
Itk_ArchOptKeepCmd(clientData, interp, objc, objv)
    ClientData clientData;   /* option merging info record */
    Tcl_Interp *interp;      /* current interpreter */
    int objc;                /* number of arguments */
    Tcl_Obj *CONST objv[];   /* argument objects */
{
    ArchMergeInfo *mergeInfo = (ArchMergeInfo*)clientData;
    int result = TCL_OK;

    int i;
    char *token;
    Tcl_HashEntry *entry;
    GenericConfigOpt *opt;
    ArchOption *archOpt;
    ArchOptionPart *optPart;
    ConfigCmdline *cmdlinePtr;

    if (objc < 2) {
        Tcl_WrongNumArgs(interp, 1, objv, "option ?option...?");
        return TCL_ERROR;
    }

    /*
     *  Make sure that this command is being accessed in the
     *  proper context.  The merge info record should be set up
     *  properly.
     */
    if (!mergeInfo->archInfo || !mergeInfo->optionTable) {
        token = Tcl_GetStringFromObj(objv[0], (int*)NULL);
        Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
            "improper usage: \"", token,
            "\" should only be accessed via itk_component",
            (char*)NULL);
        return TCL_ERROR;
    }

    /*
     *  Scan through all of the options on the list, and make
     *  sure that they are valid options for this component.
     *  Integrate them into the option info for the mega-widget.
     */
    for (i=1; i < objc; i++) {
        token = Tcl_GetStringFromObj(objv[i], (int*)NULL);
        entry = Tcl_FindHashEntry(mergeInfo->optionTable, token);
        if (!entry) {
            Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
                "option not recognized: ", token,
                (char*)NULL);
            result = TCL_ERROR;
            break;
        }
        opt = (GenericConfigOpt*)Tcl_GetHashValue(entry);

        /*
         *  If this option has already been integrated, then
         *  remove it and start again.
         */
        Itk_IgnoreArchOptionPart(mergeInfo->archInfo, opt);

        /*
         *  Build a command prefix that can be used to apply changes
         *  to this option for this component.
         */
        cmdlinePtr = Itk_CreateConfigCmdline(interp,
            mergeInfo->archComp->accessCmd, token);

        optPart = Itk_CreateOptionPart(interp, (ClientData)cmdlinePtr,
            Itk_PropagateOption, Itk_DeleteConfigCmdline,
            (ClientData)mergeInfo->archComp);

        result = Itk_AddOptionPart(interp, mergeInfo->archInfo,
            opt->switchName, opt->resName, opt->resClass,
            opt->init, opt->value, optPart, &archOpt);

        if (result == TCL_OK) {
            opt->integrated = archOpt;
            opt->optPart    = optPart;
        } else {
            Itk_DelOptionPart(optPart);
            result = TCL_ERROR;
            break;
        }
    }
    return result;
}


/*
 * ------------------------------------------------------------------------
 *  Itk_ArchOptIgnoreCmd()
 *
 *  Invoked by [incr Tcl] to handle the "ignore" command in the itk
 *  option parser.  Removes a list of component configuration options
 *  from a mega-widget.  This negates the action of previous "keep"
 *  and "rename" commands.
 *
 *  Handles the following syntax:
 *
 *      ignore <option> ?<option>...?
 *
 *  Returns TCL_OK/TCL_ERROR to indicate success/failure.
 * ------------------------------------------------------------------------
 */
/* ARGSUSED */
static int
Itk_ArchOptIgnoreCmd(clientData, interp, objc, objv)
    ClientData clientData;   /* option merging info record */
    Tcl_Interp *interp;      /* current interpreter */
    int objc;                /* number of arguments */
    Tcl_Obj *CONST objv[];   /* argument objects */
{
    ArchMergeInfo *mergeInfo = (ArchMergeInfo*)clientData;

    int i;
    char *token;
    Tcl_HashEntry *entry;
    GenericConfigOpt *opt;

    if (objc < 2) {
        Tcl_WrongNumArgs(interp, 1, objv, "option ?option...?");
        return TCL_ERROR;
    }

    /*
     *  Make sure that this command is being accessed in the
     *  proper context.  The merge info record should be set up
     *  properly.
     */
    if (!mergeInfo->archInfo || !mergeInfo->optionTable) {
        token = Tcl_GetStringFromObj(objv[0], (int*)NULL);
        Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
            "improper usage: \"", token,
            "\" should only be accessed via itk_component",
            (char*)NULL);
        return TCL_ERROR;
    }

    /*
     *  Scan through all of the options on the list, and make
     *  sure that they are valid options for this component.
     *  Remove them from the mega-widget.
     */
    for (i=1; i < objc; i++) {
        token = Tcl_GetStringFromObj(objv[i], (int*)NULL);
        entry = Tcl_FindHashEntry(mergeInfo->optionTable, token);
        if (!entry) {
            Tcl_AppendResult(interp, "option not recognized: ", token,
                (char*)NULL);
            return TCL_ERROR;
        }
        opt = (GenericConfigOpt*)Tcl_GetHashValue(entry);

        /*
         *  If this option has already been integrated, then
         *  remove it.  Otherwise, ignore it.
         */
        Itk_IgnoreArchOptionPart(mergeInfo->archInfo, opt);
    }
    return TCL_OK;
}


/*
 * ------------------------------------------------------------------------
 *  Itk_ArchOptRenameCmd()
 *
 *  Invoked by [incr Tcl] to handle the "rename" command in the itk
 *  option parser.  Integrates one configuration option into a
 *  mega-widget, using a different name for the option.  Whenever the
 *  mega-widget option is updated, the renamed option will be updated
 *  as well.  Handles the following syntax:
 *
 *      rename <oldSwitch> <newSwitch> <resName> <resClass>
 *
 *  Returns TCL_OK/TCL_ERROR to indicate success/failure.
 * ------------------------------------------------------------------------
 */
/* ARGSUSED */
static int
Itk_ArchOptRenameCmd(clientData, interp, objc, objv)
    ClientData clientData;   /* option merging info record */
    Tcl_Interp *interp;      /* current interpreter */
    int objc;                /* number of arguments */
    Tcl_Obj *CONST objv[];   /* argument objects */
{
    ArchMergeInfo *mergeInfo = (ArchMergeInfo*)clientData;

    int result;
    char *oldSwitch, *newSwitch, *resName, *resClass;
    Tcl_HashEntry *entry;
    GenericConfigOpt *opt;
    ArchOption *archOpt;
    ArchOptionPart *optPart;
    ConfigCmdline *cmdlinePtr;

    if (objc != 5) {
        Tcl_WrongNumArgs(interp, 1, objv,
            "oldSwitch newSwitch resourceName resourceClass");
        return TCL_ERROR;
    }

    /*
     *  Make sure that this command is being accessed in the
     *  proper context.  The merge info record should be set up
     *  properly.
     */
    if (!mergeInfo->archInfo || !mergeInfo->optionTable) {
        char *token = Tcl_GetStringFromObj(objv[0], (int*)NULL);
        Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
            "improper usage: \"", token,
            "\" should only be accessed via itk_component",
            (char*)NULL);
        return TCL_ERROR;
    }

    oldSwitch = Tcl_GetStringFromObj(objv[1], (int*)NULL);
    newSwitch = Tcl_GetStringFromObj(objv[2], (int*)NULL);
    resName   = Tcl_GetStringFromObj(objv[3], (int*)NULL);
    resClass  = Tcl_GetStringFromObj(objv[4], (int*)NULL);

    /*
     *  Make sure that the resource name and resource class look good.
     */
    if (!islower((int)*resName)) {
        Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
            "bad resource name \"", resName,
            "\": should start with a lower case letter",
            (char*)NULL);
        return TCL_ERROR;
    }
    if (!isupper((int)*resClass)) {
        Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
            "bad resource class \"", resClass,
            "\": should start with an upper case letter",
            (char*)NULL);
        return TCL_ERROR;
    }

    /*
     *  Make sure that the specified switch exists in the widget.
     */
    entry = Tcl_FindHashEntry(mergeInfo->optionTable, oldSwitch);
    if (!entry) {
        Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
            "option not recognized: ", oldSwitch,
            (char*)NULL);
        return TCL_ERROR;
    }
    opt = (GenericConfigOpt*)Tcl_GetHashValue(entry);

    /*
     *  If this option has already been integrated, then
     *  remove it and start again.
     */
    Itk_IgnoreArchOptionPart(mergeInfo->archInfo, opt);

    /*
     *  Build a command prefix that can be used to apply changes
     *  to this option for this component.
     */
    cmdlinePtr = Itk_CreateConfigCmdline(interp,
        mergeInfo->archComp->accessCmd, oldSwitch);

    optPart = Itk_CreateOptionPart(interp, (ClientData)cmdlinePtr,
        Itk_PropagateOption, Itk_DeleteConfigCmdline,
        (ClientData)mergeInfo->archComp);

    /*
     *  Merge this option into the mega-widget with a new name.
     */
    result = Itk_AddOptionPart(interp, mergeInfo->archInfo, newSwitch,
        resName, resClass, opt->init, opt->value, optPart,
        &archOpt);

    if (result == TCL_OK) {
        opt->integrated = archOpt;
        opt->optPart    = optPart;
    } else {
        Itk_DelOptionPart(optPart);
        result = TCL_ERROR;
    }
    return result;
}


/*
 * ------------------------------------------------------------------------
 *  Itk_ArchOptUsualCmd()
 *
 *  Invoked by [incr Tcl] to handle the "usual" command in the itk
 *  option parser.  Looks for a set of "usual" option-handling commands
 *  associated with the given tag or component class and then evaluates
 *  the commands in the option parser namespace.  This keeps the user
 *  from having to type a bunch of "keep" and "rename" commands for
 *  each component widget.
 *
 *  Handles the following syntax:
 *
 *      usual ?<tag>?
 *
 *  If the <tag> is not specified, then the class name for the
 *  component is used as the tag name.
 *
 *  Returns TCL_OK/TCL_ERROR to indicate success/failure.
 * ------------------------------------------------------------------------
 */
/* ARGSUSED */
static int
Itk_ArchOptUsualCmd(clientData, interp, objc, objv)
    ClientData clientData;   /* option merging info record */
    Tcl_Interp *interp;      /* current interpreter */
    int objc;                /* number of arguments */
    Tcl_Obj *CONST objv[];   /* argument objects */
{
    ArchMergeInfo *mergeInfo = (ArchMergeInfo*)clientData;

    char *tag;
    Tcl_HashEntry *entry;