itcl_ensemble.c

linux 下的源代码分析阅读器 red hat公司新版

     *  Look for a part with the desired name.  If found, load
     *  its data into the "infoPtr" structure.
     */
    if (FindEnsemblePart(interp, ensData, partName, &ensPart)
        != TCL_OK || ensPart == NULL) {
        goto ensGetFail;
    }

    cmdPtr = ensPart->cmdPtr;
    infoPtr->isNativeObjectProc = (cmdPtr->objProc != TclInvokeStringCommand);
    infoPtr->objProc = cmdPtr->objProc;
    infoPtr->objClientData = cmdPtr->objClientData;
    infoPtr->proc = cmdPtr->proc;
    infoPtr->clientData = cmdPtr->clientData;
    infoPtr->deleteProc = cmdPtr->deleteProc;
    infoPtr->deleteData = cmdPtr->deleteData;
    infoPtr->namespacePtr = (Tcl_Namespace*)cmdPtr->nsPtr;

    Itcl_DiscardInterpState(state);
    return 1;

ensGetFail:
    Itcl_RestoreInterpState(interp, state);
    return 0;
}


/*
 *----------------------------------------------------------------------
 *
 * Itcl_IsEnsemble --
 *
 *      Determines whether or not an existing command is an ensemble.
 *
 * Results:
 *      Returns non-zero if the command is an ensemble, and zero
 *      otherwise.
 *
 * Side effects:
 *      None.
 *
 *----------------------------------------------------------------------
 */
int
Itcl_IsEnsemble(infoPtr)
    Tcl_CmdInfo* infoPtr;  /* command info from Tcl_GetCommandInfo() */
{
    if (infoPtr) {
        return (infoPtr->deleteProc == DeleteEnsemble);
    }
    return 0;
}


/*
 *----------------------------------------------------------------------
 *
 * Itcl_GetEnsembleUsage --
 *
 *      Returns a summary of all of the parts of an ensemble and
 *      the meaning of their arguments.  Each part is listed on
 *      a separate line.  Having this summary is sometimes useful
 *      when building error messages for the "@error" handler in
 *      an ensemble.
 *
 *      Ensembles are accessed by name, as described in
 *      Itcl_CreateEnsemble.
 *
 * Results:
 *      If the ensemble is found, its usage information is appended
 *      onto the object "objPtr", and this procedure returns
 *      non-zero.  It is the responsibility of the caller to
 *      initialize and free the object.  If anything goes wrong,
 *      this procedure returns 0.
 *
 * Side effects:
 *      Object passed in is modified.
 *
 *----------------------------------------------------------------------
 */
int
Itcl_GetEnsembleUsage(interp, ensName, objPtr)
    Tcl_Interp *interp;    /* interpreter containing the ensemble */
    char *ensName;         /* name of the ensemble */
    Tcl_Obj *objPtr;       /* returns: summary of usage info */
{
    char **nameArgv = NULL;
    int nameArgc;
    Ensemble *ensData;
    Itcl_InterpState state;

    /*
     *  Parse the ensemble name and look for the ensemble.
     *  Save the interpreter state before we do this.  If we get
     *  any errors, we don't want them to affect the interpreter.
     */
    state = Itcl_SaveInterpState(interp, TCL_OK);

    if (Tcl_SplitList(interp, ensName, &nameArgc, &nameArgv) != TCL_OK) {
        goto ensUsageFail;
    }
    if (FindEnsemble(interp, nameArgv, nameArgc, &ensData) != TCL_OK) {
        goto ensUsageFail;
    }
    if (ensData == NULL) {
        goto ensUsageFail;
    }

    /*
     *  Add a summary of usage information to the return buffer.
     */
    GetEnsembleUsage(ensData, objPtr);

    Itcl_DiscardInterpState(state);
    return 1;

ensUsageFail:
    Itcl_RestoreInterpState(interp, state);
    return 0;
}


/*
 *----------------------------------------------------------------------
 *
 * Itcl_GetEnsembleUsageForObj --
 *
 *      Returns a summary of all of the parts of an ensemble and
 *      the meaning of their arguments.  This procedure is just
 *      like Itcl_GetEnsembleUsage, but it determines the desired
 *      ensemble from a command line argument.  The argument should
 *      be the first argument on the command line--the ensemble
 *      command or one of its parts.
 *
 * Results:
 *      If the ensemble is found, its usage information is appended
 *      onto the object "objPtr", and this procedure returns
 *      non-zero.  It is the responsibility of the caller to
 *      initialize and free the object.  If anything goes wrong,
 *      this procedure returns 0.
 *
 * Side effects:
 *      Object passed in is modified.
 *
 *----------------------------------------------------------------------
 */
int
Itcl_GetEnsembleUsageForObj(interp, ensObjPtr, objPtr)
    Tcl_Interp *interp;    /* interpreter containing the ensemble */
    Tcl_Obj *ensObjPtr;    /* argument representing ensemble */
    Tcl_Obj *objPtr;       /* returns: summary of usage info */
{
    Ensemble *ensData;
    Tcl_Obj *chainObj;
    Tcl_Command cmd;
    Command *cmdPtr;

    /*
     *  If the argument is an ensemble part, then follow the chain
     *  back to the command word for the entire ensemble.
     */
    chainObj = ensObjPtr;
    while (chainObj && chainObj->typePtr == &itclEnsInvocType) {
         chainObj = (Tcl_Obj*)chainObj->internalRep.twoPtrValue.ptr2;
    }

    if (chainObj) {
        cmd = Tcl_GetCommandFromObj(interp, chainObj);
        cmdPtr = (Command*)cmd;
        if (cmdPtr->deleteProc == DeleteEnsemble) {
            ensData = (Ensemble*)cmdPtr->objClientData;
            GetEnsembleUsage(ensData, objPtr);
            return 1;
        }
    }
    return 0;
}


/*
 *----------------------------------------------------------------------
 *
 * GetEnsembleUsage --
 *
 *      
 *      Returns a summary of all of the parts of an ensemble and
 *      the meaning of their arguments.  Each part is listed on
 *      a separate line.  This procedure is used internally to
 *      generate usage information for error messages.
 *
 * Results:
 *      Appends usage information onto the object in "objPtr".
 *
 * Side effects:
 *      None.
 *
 *----------------------------------------------------------------------
 */
static void
GetEnsembleUsage(ensData, objPtr)
    Ensemble *ensData;     /* ensemble data */
    Tcl_Obj *objPtr;       /* returns: summary of usage info */
{
    char *spaces = "  ";
    int isOpenEnded = 0;

    int i;
    EnsemblePart *ensPart;

    for (i=0; i < ensData->numParts; i++) {
        ensPart = ensData->parts[i];

        if (*ensPart->name == '@' && strcmp(ensPart->name,"@error") == 0) {
            isOpenEnded = 1;
        }
        else {
            Tcl_AppendToObj(objPtr, spaces, -1);
            GetEnsemblePartUsage(ensPart, objPtr);
            spaces = "\n  ";
        }
    }
    if (isOpenEnded) {
        Tcl_AppendToObj(objPtr,
            "\n...and others described on the man page", -1);
    }
}


/*
 *----------------------------------------------------------------------
 *
 * GetEnsemblePartUsage --
 *
 *      Determines the usage for a single part within an ensemble,
 *      and appends a summary onto a dynamic string.  The usage
 *      is a combination of the part name and the argument summary.
 *      It is the caller's responsibility to initialize and free
 *      the dynamic string.
 *
 * Results:
 *      Returns usage information in the object "objPtr".
 *
 * Side effects:
 *      None.
 *
 *----------------------------------------------------------------------
 */
static void
GetEnsemblePartUsage(ensPart, objPtr)
    EnsemblePart *ensPart;   /* ensemble part for usage info */
    Tcl_Obj *objPtr;         /* returns: usage information */
{
    EnsemblePart *part;
    Command *cmdPtr;
    char *name;
    Itcl_List trail;
    Itcl_ListElem *elem;
    Tcl_DString buffer;

    /*
     *  Build the trail of ensemble names leading to this part.
     */
    Tcl_DStringInit(&buffer);
    Itcl_InitList(&trail);
    for (part=ensPart; part; part=part->ensemble->parent) {
        Itcl_InsertList(&trail, (ClientData)part);
    }

    cmdPtr = (Command*)ensPart->ensemble->cmd;
    name = Tcl_GetHashKey(cmdPtr->hPtr->tablePtr, cmdPtr->hPtr);
    Tcl_DStringAppendElement(&buffer, name);

    for (elem=Itcl_FirstListElem(&trail); elem; elem=Itcl_NextListElem(elem)) {
        part = (EnsemblePart*)Itcl_GetListValue(elem);
        Tcl_DStringAppendElement(&buffer, part->name);
    }
    Itcl_DeleteList(&trail);

    /*
     *  If the part has usage info, use it directly.
     */
    if (ensPart->usage && *ensPart->usage != '\0') {
        Tcl_DStringAppend(&buffer, " ", 1);
        Tcl_DStringAppend(&buffer, ensPart->usage, -1);
    }

    /*
     *  If the part is itself an ensemble, summarize its usage.
     */
    else if (ensPart->cmdPtr &&
             ensPart->cmdPtr->deleteProc == DeleteEnsemble) {
        Tcl_DStringAppend(&buffer, " option ?arg arg ...?", 21);
    }

    Tcl_AppendToObj(objPtr, Tcl_DStringValue(&buffer),
        Tcl_DStringLength(&buffer));

    Tcl_DStringFree(&buffer);
}


/*
 *----------------------------------------------------------------------
 *
 * CreateEnsemble --
 *
 *      Creates an ensemble command, or adds a sub-ensemble to an
 *      existing ensemble command.  Works like Itcl_CreateEnsemble,
 *      except that the ensemble name is a single name, not a path.
 *      If a parent ensemble is specified, then a new ensemble is
 *      added to that parent.  If a part already exists with the
 *      same name, it is an error.  If a parent ensemble is not
 *      specified, then a top-level ensemble is created.  If a
 *      command already exists with the same name, it is deleted.
 *
 * Results:
 *      Returns TCL_OK if successful, and TCL_ERROR if anything goes
 *      wrong.
 *
 * Side effects:
 *      If an error is encountered, an error is left as the result
 *      in the interpreter.
 *
 *----------------------------------------------------------------------
 */
static int
CreateEnsemble(interp, parentEnsData, ensName)
    Tcl_Interp *interp;            /* interpreter to be updated */
    Ensemble *parentEnsData;       /* parent ensemble or NULL */
    char *ensName;                 /* name of the new ensemble */
{
    Ensemble *ensData;
    EnsemblePart *ensPart;
    Command *cmdPtr;
    Tcl_CmdInfo cmdInfo;

    /*
     *  Create the data associated with the ensemble.
     */
    ensData = (Ensemble*)ckalloc(sizeof(Ensemble));
    ensData->interp = interp;
    ensData->numParts = 0;
    ensData->maxParts = 10;
    ensData->parts = (EnsemblePart**)ckalloc(
        (unsigned)(ensData->maxParts*sizeof(EnsemblePart*))
    );
    ensData->cmd = NULL;
    ensData->parent = NULL;

    /*
     *  If there is no parent data, then this is a top-level
     *  ensemble.  Create the ensemble by installing its access
     *  command.
     *
     *  BE CAREFUL:  Set the string-based proc to the wrapper
     *    procedure TclInvokeObjectCommand.  Otherwise, the
     *    ensemble command may fail.  For example, it will fail
     *    when invoked as a hidden command.
     */
    if (parentEnsData == NULL) {
        ensData->cmd = Tcl_CreateObjCommand(interp, ensName,
            HandleEnsemble, (ClientData)ensData, DeleteEnsemble);

        if (Tcl_GetCommandInfo(interp, ensName, &cmdInfo)) {
            cmdInfo.proc = TclInvokeObjectCommand;
            Tcl_SetCommandInfo(interp, ensName, &cmdInfo);
        }
        return TCL_OK;
    }

    /*
     *  Otherwise, this ensemble is contained within another parent.
     *  Install the new ensemble as a part within its parent.
     */
    if (CreateEnsemblePart(interp, parentEnsData, ensName, &ensPart)
        != TCL_OK) {
        DeleteEnsemble((ClientData)ensData);
        return TCL_ERROR;
    }

    ensData->cmd = parentEnsData->cmd;
    ensData->parent = ensPart;

    cmdPtr = (Command*)ckalloc(sizeof(Command));
    cmdPtr->hPtr = NULL;
    cmdPtr->nsPtr = ((Command*)ensData->cmd)->nsPtr;
    cmdPtr->refCount = 0;
    cmdPtr->cmdEpoch = 0;
    cmdPtr->compileProc = NULL;
    cmdPtr->objProc = HandleEnsemble;
    cmdPtr->objClientData = (ClientData)ensData;
    cmdPtr->proc = NULL;
    cmdPtr->clientData = NULL;
    cmdPtr->deleteProc = DeleteEnsemble;
    cmdPtr->deleteData = cmdPtr->objClientData;
    cmdPtr->deleted = 0;
    cmdPtr->importRefPtr = NULL;

    ensPart->cmdPtr = cmdPtr;

    return TCL_OK;
}


/*
 *----------------------------------------------------------------------
 *
 * AddEnsemblePart --
 *
 *      Adds a part to an existing ensemble.  Works like
 *      Itcl_AddEnsemblePart, but the part name is a single word,
 *      not a path.
 *
 *      If the ensemble already has a part with the specified name,
 *      this procedure returns an error.  Otherwise, it adds a new
 *      part to the ensemble.
 *
 *      Any client data specified is automatically passed to the
 *      handling procedure whenever the part is invoked.  It is
 *      automatically destroyed by the deleteProc when the part is
 *      deleted.
 *
 * Results:
 *      Returns TCL_OK if successful, along with a pointer to the
 *      new part.  Returns TCL_ERROR if anything goes wrong.
 *