/*
|
/*
|
* ------------------------------------------------------------------------
|
* ------------------------------------------------------------------------
|
* PACKAGE: [incr Tcl]
|
* PACKAGE: [incr Tcl]
|
* DESCRIPTION: Object-Oriented Extensions to Tcl
|
* DESCRIPTION: Object-Oriented Extensions to Tcl
|
*
|
*
|
* [incr Tcl] provides object-oriented extensions to Tcl, much as
|
* [incr Tcl] provides object-oriented extensions to Tcl, much as
|
* C++ provides object-oriented extensions to C. It provides a means
|
* C++ provides object-oriented extensions to C. It provides a means
|
* of encapsulating related procedures together with their shared data
|
* of encapsulating related procedures together with their shared data
|
* in a local namespace that is hidden from the outside world. It
|
* in a local namespace that is hidden from the outside world. It
|
* promotes code re-use through inheritance. More than anything else,
|
* promotes code re-use through inheritance. More than anything else,
|
* it encourages better organization of Tcl applications through the
|
* it encourages better organization of Tcl applications through the
|
* object-oriented paradigm, leading to code that is easier to
|
* object-oriented paradigm, leading to code that is easier to
|
* understand and maintain.
|
* understand and maintain.
|
*
|
*
|
* This part handles ensembles, which support compound commands in Tcl.
|
* This part handles ensembles, which support compound commands in Tcl.
|
* The usual "info" command is an ensemble with parts like "info body"
|
* The usual "info" command is an ensemble with parts like "info body"
|
* and "info globals". Extension developers can extend commands like
|
* and "info globals". Extension developers can extend commands like
|
* "info" by adding their own parts to the ensemble.
|
* "info" by adding their own parts to the ensemble.
|
*
|
*
|
* ========================================================================
|
* ========================================================================
|
* AUTHOR: Michael J. McLennan
|
* AUTHOR: Michael J. McLennan
|
* Bell Labs Innovations for Lucent Technologies
|
* Bell Labs Innovations for Lucent Technologies
|
* mmclennan@lucent.com
|
* mmclennan@lucent.com
|
* http://www.tcltk.com/itcl
|
* http://www.tcltk.com/itcl
|
*
|
*
|
* RCS: $Id: itcl_ensemble.c,v 1.1.1.1 2002-01-16 10:24:46 markom Exp $
|
* RCS: $Id: itcl_ensemble.c,v 1.1.1.1 2002-01-16 10:24:46 markom Exp $
|
* ========================================================================
|
* ========================================================================
|
* Copyright (c) 1993-1998 Lucent Technologies, Inc.
|
* Copyright (c) 1993-1998 Lucent Technologies, Inc.
|
* ------------------------------------------------------------------------
|
* ------------------------------------------------------------------------
|
* See the file "license.terms" for information on usage and redistribution
|
* See the file "license.terms" for information on usage and redistribution
|
* of this file, and for a DISCLAIMER OF ALL WARRANTIES.
|
* of this file, and for a DISCLAIMER OF ALL WARRANTIES.
|
*/
|
*/
|
#include "itclInt.h"
|
#include "itclInt.h"
|
|
|
/*
|
/*
|
* Data used to represent an ensemble:
|
* Data used to represent an ensemble:
|
*/
|
*/
|
struct Ensemble;
|
struct Ensemble;
|
typedef struct EnsemblePart {
|
typedef struct EnsemblePart {
|
char *name; /* name of this part */
|
char *name; /* name of this part */
|
int minChars; /* chars needed to uniquely identify part */
|
int minChars; /* chars needed to uniquely identify part */
|
Command *cmdPtr; /* command handling this part */
|
Command *cmdPtr; /* command handling this part */
|
char *usage; /* usage string describing syntax */
|
char *usage; /* usage string describing syntax */
|
struct Ensemble* ensemble; /* ensemble containing this part */
|
struct Ensemble* ensemble; /* ensemble containing this part */
|
} EnsemblePart;
|
} EnsemblePart;
|
|
|
/*
|
/*
|
* Data used to represent an ensemble:
|
* Data used to represent an ensemble:
|
*/
|
*/
|
typedef struct Ensemble {
|
typedef struct Ensemble {
|
Tcl_Interp *interp; /* interpreter containing this ensemble */
|
Tcl_Interp *interp; /* interpreter containing this ensemble */
|
EnsemblePart **parts; /* list of parts in this ensemble */
|
EnsemblePart **parts; /* list of parts in this ensemble */
|
int numParts; /* number of parts in part list */
|
int numParts; /* number of parts in part list */
|
int maxParts; /* current size of parts list */
|
int maxParts; /* current size of parts list */
|
Tcl_Command cmd; /* command representing this ensemble */
|
Tcl_Command cmd; /* command representing this ensemble */
|
EnsemblePart* parent; /* parent part for sub-ensembles
|
EnsemblePart* parent; /* parent part for sub-ensembles
|
* NULL => toplevel ensemble */
|
* NULL => toplevel ensemble */
|
} Ensemble;
|
} Ensemble;
|
|
|
/*
|
/*
|
* Data shared by ensemble access commands and ensemble parser:
|
* Data shared by ensemble access commands and ensemble parser:
|
*/
|
*/
|
typedef struct EnsembleParser {
|
typedef struct EnsembleParser {
|
Tcl_Interp* master; /* master interp containing ensembles */
|
Tcl_Interp* master; /* master interp containing ensembles */
|
Tcl_Interp* parser; /* slave interp for parsing */
|
Tcl_Interp* parser; /* slave interp for parsing */
|
Ensemble* ensData; /* add parts to this ensemble */
|
Ensemble* ensData; /* add parts to this ensemble */
|
} EnsembleParser;
|
} EnsembleParser;
|
|
|
/*
|
/*
|
* Declarations for local procedures to this file:
|
* Declarations for local procedures to this file:
|
*/
|
*/
|
static void FreeEnsInvocInternalRep _ANSI_ARGS_((Tcl_Obj *objPtr));
|
static void FreeEnsInvocInternalRep _ANSI_ARGS_((Tcl_Obj *objPtr));
|
static void DupEnsInvocInternalRep _ANSI_ARGS_((Tcl_Obj *objPtr,
|
static void DupEnsInvocInternalRep _ANSI_ARGS_((Tcl_Obj *objPtr,
|
Tcl_Obj *copyPtr));
|
Tcl_Obj *copyPtr));
|
static void UpdateStringOfEnsInvoc _ANSI_ARGS_((Tcl_Obj *objPtr));
|
static void UpdateStringOfEnsInvoc _ANSI_ARGS_((Tcl_Obj *objPtr));
|
static int SetEnsInvocFromAny _ANSI_ARGS_((Tcl_Interp *interp,
|
static int SetEnsInvocFromAny _ANSI_ARGS_((Tcl_Interp *interp,
|
Tcl_Obj *objPtr));
|
Tcl_Obj *objPtr));
|
|
|
/*
|
/*
|
* This structure defines a Tcl object type that takes the
|
* This structure defines a Tcl object type that takes the
|
* place of a part name during ensemble invocations. When an
|
* place of a part name during ensemble invocations. When an
|
* error occurs and the caller tries to print objv[0], it will
|
* error occurs and the caller tries to print objv[0], it will
|
* get a string that contains a complete path to the ensemble
|
* get a string that contains a complete path to the ensemble
|
* part.
|
* part.
|
*/
|
*/
|
Tcl_ObjType itclEnsInvocType = {
|
Tcl_ObjType itclEnsInvocType = {
|
"ensembleInvoc", /* name */
|
"ensembleInvoc", /* name */
|
FreeEnsInvocInternalRep, /* freeIntRepProc */
|
FreeEnsInvocInternalRep, /* freeIntRepProc */
|
DupEnsInvocInternalRep, /* dupIntRepProc */
|
DupEnsInvocInternalRep, /* dupIntRepProc */
|
UpdateStringOfEnsInvoc, /* updateStringProc */
|
UpdateStringOfEnsInvoc, /* updateStringProc */
|
SetEnsInvocFromAny /* setFromAnyProc */
|
SetEnsInvocFromAny /* setFromAnyProc */
|
};
|
};
|
|
|
/*
|
/*
|
* Boolean flag indicating whether or not the "ensemble" object
|
* Boolean flag indicating whether or not the "ensemble" object
|
* type has been registered with the Tcl compiler.
|
* type has been registered with the Tcl compiler.
|
*/
|
*/
|
static int ensInitialized = 0;
|
static int ensInitialized = 0;
|
|
|
/*
|
/*
|
* Forward declarations for the procedures used in this file.
|
* Forward declarations for the procedures used in this file.
|
*/
|
*/
|
static void GetEnsembleUsage _ANSI_ARGS_((Ensemble *ensData,
|
static void GetEnsembleUsage _ANSI_ARGS_((Ensemble *ensData,
|
Tcl_Obj *objPtr));
|
Tcl_Obj *objPtr));
|
|
|
static void GetEnsemblePartUsage _ANSI_ARGS_((EnsemblePart *ensPart,
|
static void GetEnsemblePartUsage _ANSI_ARGS_((EnsemblePart *ensPart,
|
Tcl_Obj *objPtr));
|
Tcl_Obj *objPtr));
|
|
|
static int CreateEnsemble _ANSI_ARGS_((Tcl_Interp *interp,
|
static int CreateEnsemble _ANSI_ARGS_((Tcl_Interp *interp,
|
Ensemble *parentEnsData, char *ensName));
|
Ensemble *parentEnsData, char *ensName));
|
|
|
static int AddEnsemblePart _ANSI_ARGS_((Tcl_Interp *interp,
|
static int AddEnsemblePart _ANSI_ARGS_((Tcl_Interp *interp,
|
Ensemble* ensData, char* partName, char* usageInfo,
|
Ensemble* ensData, char* partName, char* usageInfo,
|
Tcl_ObjCmdProc *objProc, ClientData clientData,
|
Tcl_ObjCmdProc *objProc, ClientData clientData,
|
Tcl_CmdDeleteProc *deleteProc, EnsemblePart **rVal));
|
Tcl_CmdDeleteProc *deleteProc, EnsemblePart **rVal));
|
|
|
static void DeleteEnsemble _ANSI_ARGS_((ClientData clientData));
|
static void DeleteEnsemble _ANSI_ARGS_((ClientData clientData));
|
|
|
static int FindEnsemble _ANSI_ARGS_((Tcl_Interp *interp, char **nameArgv,
|
static int FindEnsemble _ANSI_ARGS_((Tcl_Interp *interp, char **nameArgv,
|
int nameArgc, Ensemble** ensDataPtr));
|
int nameArgc, Ensemble** ensDataPtr));
|
|
|
static int CreateEnsemblePart _ANSI_ARGS_((Tcl_Interp *interp,
|
static int CreateEnsemblePart _ANSI_ARGS_((Tcl_Interp *interp,
|
Ensemble *ensData, char* partName, EnsemblePart **ensPartPtr));
|
Ensemble *ensData, char* partName, EnsemblePart **ensPartPtr));
|
|
|
static void DeleteEnsemblePart _ANSI_ARGS_((EnsemblePart *ensPart));
|
static void DeleteEnsemblePart _ANSI_ARGS_((EnsemblePart *ensPart));
|
|
|
static int FindEnsemblePart _ANSI_ARGS_((Tcl_Interp *interp,
|
static int FindEnsemblePart _ANSI_ARGS_((Tcl_Interp *interp,
|
Ensemble *ensData, char* partName, EnsemblePart **rensPart));
|
Ensemble *ensData, char* partName, EnsemblePart **rensPart));
|
|
|
static int FindEnsemblePartIndex _ANSI_ARGS_((Ensemble *ensData,
|
static int FindEnsemblePartIndex _ANSI_ARGS_((Ensemble *ensData,
|
char *partName, int *posPtr));
|
char *partName, int *posPtr));
|
|
|
static void ComputeMinChars _ANSI_ARGS_((Ensemble *ensData, int pos));
|
static void ComputeMinChars _ANSI_ARGS_((Ensemble *ensData, int pos));
|
|
|
static int HandleEnsemble _ANSI_ARGS_((ClientData clientData,
|
static int HandleEnsemble _ANSI_ARGS_((ClientData clientData,
|
Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]));
|
Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]));
|
|
|
static EnsembleParser* GetEnsembleParser _ANSI_ARGS_((Tcl_Interp *interp));
|
static EnsembleParser* GetEnsembleParser _ANSI_ARGS_((Tcl_Interp *interp));
|
|
|
static void DeleteEnsParser _ANSI_ARGS_((ClientData clientData,
|
static void DeleteEnsParser _ANSI_ARGS_((ClientData clientData,
|
Tcl_Interp* interp));
|
Tcl_Interp* interp));
|
|
|
|
|
|
|
/*
|
/*
|
*----------------------------------------------------------------------
|
*----------------------------------------------------------------------
|
*
|
*
|
* Itcl_EnsembleInit --
|
* Itcl_EnsembleInit --
|
*
|
*
|
* Called when any interpreter is created to make sure that
|
* Called when any interpreter is created to make sure that
|
* things are properly set up for ensembles.
|
* things are properly set up for ensembles.
|
*
|
*
|
* Results:
|
* Results:
|
* Returns TCL_OK if successful, and TCL_ERROR if anything goes
|
* Returns TCL_OK if successful, and TCL_ERROR if anything goes
|
* wrong.
|
* wrong.
|
*
|
*
|
* Side effects:
|
* Side effects:
|
* On the first call, the "ensemble" object type is registered
|
* On the first call, the "ensemble" object type is registered
|
* with the Tcl compiler. If an error is encountered, an error
|
* with the Tcl compiler. If an error is encountered, an error
|
* is left as the result in the interpreter.
|
* is left as the result in the interpreter.
|
*
|
*
|
*----------------------------------------------------------------------
|
*----------------------------------------------------------------------
|
*/
|
*/
|
/* ARGSUSED */
|
/* ARGSUSED */
|
int
|
int
|
Itcl_EnsembleInit(interp)
|
Itcl_EnsembleInit(interp)
|
Tcl_Interp *interp; /* interpreter being initialized */
|
Tcl_Interp *interp; /* interpreter being initialized */
|
{
|
{
|
if (!ensInitialized) {
|
if (!ensInitialized) {
|
Tcl_RegisterObjType(&itclEnsInvocType);
|
Tcl_RegisterObjType(&itclEnsInvocType);
|
ensInitialized = 1;
|
ensInitialized = 1;
|
}
|
}
|
|
|
Tcl_CreateObjCommand(interp, "::itcl::ensemble",
|
Tcl_CreateObjCommand(interp, "::itcl::ensemble",
|
Itcl_EnsembleCmd, (ClientData)NULL, (Tcl_CmdDeleteProc*)NULL);
|
Itcl_EnsembleCmd, (ClientData)NULL, (Tcl_CmdDeleteProc*)NULL);
|
|
|
return TCL_OK;
|
return TCL_OK;
|
}
|
}
|
|
|
|
|
/*
|
/*
|
*----------------------------------------------------------------------
|
*----------------------------------------------------------------------
|
*
|
*
|
* Itcl_CreateEnsemble --
|
* Itcl_CreateEnsemble --
|
*
|
*
|
* Creates an ensemble command, or adds a sub-ensemble to an
|
* Creates an ensemble command, or adds a sub-ensemble to an
|
* existing ensemble command. The ensemble name is a space-
|
* existing ensemble command. The ensemble name is a space-
|
* separated list. The first word in the list is the command
|
* separated list. The first word in the list is the command
|
* name for the top-level ensemble. Other names do not have
|
* name for the top-level ensemble. Other names do not have
|
* commands associated with them; they are merely sub-ensembles
|
* commands associated with them; they are merely sub-ensembles
|
* within the ensemble. So a name like "a::b::foo bar baz"
|
* within the ensemble. So a name like "a::b::foo bar baz"
|
* represents an ensemble command called "foo" in the namespace
|
* represents an ensemble command called "foo" in the namespace
|
* "a::b" that has a sub-ensemble "bar", that has a sub-ensemble
|
* "a::b" that has a sub-ensemble "bar", that has a sub-ensemble
|
* "baz".
|
* "baz".
|
*
|
*
|
* If the name is a single word, then this procedure creates
|
* If the name is a single word, then this procedure creates
|
* a top-level ensemble and installs an access command for it.
|
* a top-level ensemble and installs an access command for it.
|
* If a command already exists with that name, it is deleted.
|
* If a command already exists with that name, it is deleted.
|
*
|
*
|
* If the name has more than one word, then the leading words
|
* If the name has more than one word, then the leading words
|
* are treated as a path name for an existing ensemble. The
|
* are treated as a path name for an existing ensemble. The
|
* last word is treated as the name for a new sub-ensemble.
|
* last word is treated as the name for a new sub-ensemble.
|
* If an part already exists with that name, it is an error.
|
* If an part already exists with that name, it is an error.
|
*
|
*
|
* Results:
|
* Results:
|
* Returns TCL_OK if successful, and TCL_ERROR if anything goes
|
* Returns TCL_OK if successful, and TCL_ERROR if anything goes
|
* wrong.
|
* wrong.
|
*
|
*
|
* Side effects:
|
* Side effects:
|
* If an error is encountered, an error is left as the result
|
* If an error is encountered, an error is left as the result
|
* in the interpreter.
|
* in the interpreter.
|
*
|
*
|
*----------------------------------------------------------------------
|
*----------------------------------------------------------------------
|
*/
|
*/
|
int
|
int
|
Itcl_CreateEnsemble(interp, ensName)
|
Itcl_CreateEnsemble(interp, ensName)
|
Tcl_Interp *interp; /* interpreter to be updated */
|
Tcl_Interp *interp; /* interpreter to be updated */
|
char* ensName; /* name of the new ensemble */
|
char* ensName; /* name of the new ensemble */
|
{
|
{
|
char **nameArgv = NULL;
|
char **nameArgv = NULL;
|
int nameArgc;
|
int nameArgc;
|
Ensemble *parentEnsData;
|
Ensemble *parentEnsData;
|
Tcl_DString buffer;
|
Tcl_DString buffer;
|
|
|
/*
|
/*
|
* Split the ensemble name into its path components.
|
* Split the ensemble name into its path components.
|
*/
|
*/
|
if (Tcl_SplitList(interp, ensName, &nameArgc, &nameArgv) != TCL_OK) {
|
if (Tcl_SplitList(interp, ensName, &nameArgc, &nameArgv) != TCL_OK) {
|
goto ensCreateFail;
|
goto ensCreateFail;
|
}
|
}
|
if (nameArgc < 1) {
|
if (nameArgc < 1) {
|
Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
|
Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
|
"invalid ensemble name \"", ensName, "\"",
|
"invalid ensemble name \"", ensName, "\"",
|
(char*)NULL);
|
(char*)NULL);
|
goto ensCreateFail;
|
goto ensCreateFail;
|
}
|
}
|
|
|
/*
|
/*
|
* If there is more than one path component, then follow
|
* If there is more than one path component, then follow
|
* the path down to the last component, to find the containing
|
* the path down to the last component, to find the containing
|
* ensemble.
|
* ensemble.
|
*/
|
*/
|
parentEnsData = NULL;
|
parentEnsData = NULL;
|
if (nameArgc > 1) {
|
if (nameArgc > 1) {
|
if (FindEnsemble(interp, nameArgv, nameArgc-1, &parentEnsData)
|
if (FindEnsemble(interp, nameArgv, nameArgc-1, &parentEnsData)
|
!= TCL_OK) {
|
!= TCL_OK) {
|
goto ensCreateFail;
|
goto ensCreateFail;
|
}
|
}
|
|
|
if (parentEnsData == NULL) {
|
if (parentEnsData == NULL) {
|
char *pname = Tcl_Merge(nameArgc-1, nameArgv);
|
char *pname = Tcl_Merge(nameArgc-1, nameArgv);
|
Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
|
Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
|
"invalid ensemble name \"", pname, "\"",
|
"invalid ensemble name \"", pname, "\"",
|
(char*)NULL);
|
(char*)NULL);
|
ckfree(pname);
|
ckfree(pname);
|
goto ensCreateFail;
|
goto ensCreateFail;
|
}
|
}
|
}
|
}
|
|
|
/*
|
/*
|
* Create the ensemble.
|
* Create the ensemble.
|
*/
|
*/
|
if (CreateEnsemble(interp, parentEnsData, nameArgv[nameArgc-1])
|
if (CreateEnsemble(interp, parentEnsData, nameArgv[nameArgc-1])
|
!= TCL_OK) {
|
!= TCL_OK) {
|
goto ensCreateFail;
|
goto ensCreateFail;
|
}
|
}
|
|
|
ckfree((char*)nameArgv);
|
ckfree((char*)nameArgv);
|
return TCL_OK;
|
return TCL_OK;
|
|
|
ensCreateFail:
|
ensCreateFail:
|
if (nameArgv) {
|
if (nameArgv) {
|
ckfree((char*)nameArgv);
|
ckfree((char*)nameArgv);
|
}
|
}
|
Tcl_DStringInit(&buffer);
|
Tcl_DStringInit(&buffer);
|
Tcl_DStringAppend(&buffer, "\n (while creating ensemble \"", -1);
|
Tcl_DStringAppend(&buffer, "\n (while creating ensemble \"", -1);
|
Tcl_DStringAppend(&buffer, ensName, -1);
|
Tcl_DStringAppend(&buffer, ensName, -1);
|
Tcl_DStringAppend(&buffer, "\")", -1);
|
Tcl_DStringAppend(&buffer, "\")", -1);
|
Tcl_AddObjErrorInfo(interp, Tcl_DStringValue(&buffer), -1);
|
Tcl_AddObjErrorInfo(interp, Tcl_DStringValue(&buffer), -1);
|
Tcl_DStringFree(&buffer);
|
Tcl_DStringFree(&buffer);
|
|
|
return TCL_ERROR;
|
return TCL_ERROR;
|
}
|
}
|
|
|
|
|
/*
|
/*
|
*----------------------------------------------------------------------
|
*----------------------------------------------------------------------
|
*
|
*
|
* Itcl_AddEnsemblePart --
|
* Itcl_AddEnsemblePart --
|
*
|
*
|
* Adds a part to an ensemble which has been created by
|
* Adds a part to an ensemble which has been created by
|
* Itcl_CreateEnsemble. Ensembles are addressed by name, as
|
* Itcl_CreateEnsemble. Ensembles are addressed by name, as
|
* described in Itcl_CreateEnsemble.
|
* described in Itcl_CreateEnsemble.
|
*
|
*
|
* If the ensemble already has a part with the specified name,
|
* If the ensemble already has a part with the specified name,
|
* this procedure returns an error. Otherwise, it adds a new
|
* this procedure returns an error. Otherwise, it adds a new
|
* part to the ensemble.
|
* part to the ensemble.
|
*
|
*
|
* Any client data specified is automatically passed to the
|
* Any client data specified is automatically passed to the
|
* handling procedure whenever the part is invoked. It is
|
* handling procedure whenever the part is invoked. It is
|
* automatically destroyed by the deleteProc when the part is
|
* automatically destroyed by the deleteProc when the part is
|
* deleted.
|
* deleted.
|
*
|
*
|
* Results:
|
* Results:
|
* Returns TCL_OK if successful, and TCL_ERROR if anything goes
|
* Returns TCL_OK if successful, and TCL_ERROR if anything goes
|
* wrong.
|
* wrong.
|
*
|
*
|
* Side effects:
|
* Side effects:
|
* If an error is encountered, an error is left as the result
|
* If an error is encountered, an error is left as the result
|
* in the interpreter.
|
* in the interpreter.
|
*
|
*
|
*----------------------------------------------------------------------
|
*----------------------------------------------------------------------
|
*/
|
*/
|
int
|
int
|
Itcl_AddEnsemblePart(interp, ensName, partName, usageInfo,
|
Itcl_AddEnsemblePart(interp, ensName, partName, usageInfo,
|
objProc, clientData, deleteProc)
|
objProc, clientData, deleteProc)
|
|
|
Tcl_Interp *interp; /* interpreter to be updated */
|
Tcl_Interp *interp; /* interpreter to be updated */
|
char* ensName; /* ensemble containing this part */
|
char* ensName; /* ensemble containing this part */
|
char* partName; /* name of the new part */
|
char* partName; /* name of the new part */
|
char* usageInfo; /* usage info for argument list */
|
char* usageInfo; /* usage info for argument list */
|
Tcl_ObjCmdProc *objProc; /* handling procedure for part */
|
Tcl_ObjCmdProc *objProc; /* handling procedure for part */
|
ClientData clientData; /* client data associated with part */
|
ClientData clientData; /* client data associated with part */
|
Tcl_CmdDeleteProc *deleteProc; /* procedure used to destroy client data */
|
Tcl_CmdDeleteProc *deleteProc; /* procedure used to destroy client data */
|
{
|
{
|
char **nameArgv = NULL;
|
char **nameArgv = NULL;
|
int nameArgc;
|
int nameArgc;
|
Ensemble *ensData;
|
Ensemble *ensData;
|
EnsemblePart *ensPart;
|
EnsemblePart *ensPart;
|
Tcl_DString buffer;
|
Tcl_DString buffer;
|
|
|
/*
|
/*
|
* Parse the ensemble name and look for a containing ensemble.
|
* Parse the ensemble name and look for a containing ensemble.
|
*/
|
*/
|
if (Tcl_SplitList(interp, ensName, &nameArgc, &nameArgv) != TCL_OK) {
|
if (Tcl_SplitList(interp, ensName, &nameArgc, &nameArgv) != TCL_OK) {
|
goto ensPartFail;
|
goto ensPartFail;
|
}
|
}
|
if (FindEnsemble(interp, nameArgv, nameArgc, &ensData) != TCL_OK) {
|
if (FindEnsemble(interp, nameArgv, nameArgc, &ensData) != TCL_OK) {
|
goto ensPartFail;
|
goto ensPartFail;
|
}
|
}
|
|
|
if (ensData == NULL) {
|
if (ensData == NULL) {
|
char *pname = Tcl_Merge(nameArgc, nameArgv);
|
char *pname = Tcl_Merge(nameArgc, nameArgv);
|
Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
|
Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
|
"invalid ensemble name \"", pname, "\"",
|
"invalid ensemble name \"", pname, "\"",
|
(char*)NULL);
|
(char*)NULL);
|
ckfree(pname);
|
ckfree(pname);
|
goto ensPartFail;
|
goto ensPartFail;
|
}
|
}
|
|
|
/*
|
/*
|
* Install the new part into the part list.
|
* Install the new part into the part list.
|
*/
|
*/
|
if (AddEnsemblePart(interp, ensData, partName, usageInfo,
|
if (AddEnsemblePart(interp, ensData, partName, usageInfo,
|
objProc, clientData, deleteProc, &ensPart) != TCL_OK) {
|
objProc, clientData, deleteProc, &ensPart) != TCL_OK) {
|
goto ensPartFail;
|
goto ensPartFail;
|
}
|
}
|
|
|
ckfree((char*)nameArgv);
|
ckfree((char*)nameArgv);
|
return TCL_OK;
|
return TCL_OK;
|
|
|
ensPartFail:
|
ensPartFail:
|
if (nameArgv) {
|
if (nameArgv) {
|
ckfree((char*)nameArgv);
|
ckfree((char*)nameArgv);
|
}
|
}
|
Tcl_DStringInit(&buffer);
|
Tcl_DStringInit(&buffer);
|
Tcl_DStringAppend(&buffer, "\n (while adding to ensemble \"", -1);
|
Tcl_DStringAppend(&buffer, "\n (while adding to ensemble \"", -1);
|
Tcl_DStringAppend(&buffer, ensName, -1);
|
Tcl_DStringAppend(&buffer, ensName, -1);
|
Tcl_DStringAppend(&buffer, "\")", -1);
|
Tcl_DStringAppend(&buffer, "\")", -1);
|
Tcl_AddObjErrorInfo(interp, Tcl_DStringValue(&buffer), -1);
|
Tcl_AddObjErrorInfo(interp, Tcl_DStringValue(&buffer), -1);
|
Tcl_DStringFree(&buffer);
|
Tcl_DStringFree(&buffer);
|
|
|
return TCL_ERROR;
|
return TCL_ERROR;
|
}
|
}
|
|
|
|
|
/*
|
/*
|
*----------------------------------------------------------------------
|
*----------------------------------------------------------------------
|
*
|
*
|
* Itcl_GetEnsemblePart --
|
* Itcl_GetEnsemblePart --
|
*
|
*
|
* Looks for a part within an ensemble, and returns information
|
* Looks for a part within an ensemble, and returns information
|
* about it.
|
* about it.
|
*
|
*
|
* Results:
|
* Results:
|
* If the ensemble and its part are found, this procedure
|
* If the ensemble and its part are found, this procedure
|
* loads information about the part into the "infoPtr" structure
|
* loads information about the part into the "infoPtr" structure
|
* and returns 1. Otherwise, it returns 0.
|
* and returns 1. Otherwise, it returns 0.
|
*
|
*
|
* Side effects:
|
* Side effects:
|
* None.
|
* None.
|
*
|
*
|
*----------------------------------------------------------------------
|
*----------------------------------------------------------------------
|
*/
|
*/
|
int
|
int
|
Itcl_GetEnsemblePart(interp, ensName, partName, infoPtr)
|
Itcl_GetEnsemblePart(interp, ensName, partName, infoPtr)
|
Tcl_Interp *interp; /* interpreter to be updated */
|
Tcl_Interp *interp; /* interpreter to be updated */
|
char *ensName; /* ensemble containing the part */
|
char *ensName; /* ensemble containing the part */
|
char *partName; /* name of the desired part */
|
char *partName; /* name of the desired part */
|
Tcl_CmdInfo *infoPtr; /* returns: info associated with part */
|
Tcl_CmdInfo *infoPtr; /* returns: info associated with part */
|
{
|
{
|
char **nameArgv = NULL;
|
char **nameArgv = NULL;
|
int nameArgc;
|
int nameArgc;
|
Ensemble *ensData;
|
Ensemble *ensData;
|
EnsemblePart *ensPart;
|
EnsemblePart *ensPart;
|
Command *cmdPtr;
|
Command *cmdPtr;
|
Itcl_InterpState state;
|
Itcl_InterpState state;
|
|
|
/*
|
/*
|
* Parse the ensemble name and look for a containing ensemble.
|
* Parse the ensemble name and look for a containing ensemble.
|
* Save the interpreter state before we do this. If we get any
|
* Save the interpreter state before we do this. If we get any
|
* errors, we don't want them to affect the interpreter.
|
* errors, we don't want them to affect the interpreter.
|
*/
|
*/
|
state = Itcl_SaveInterpState(interp, TCL_OK);
|
state = Itcl_SaveInterpState(interp, TCL_OK);
|
|
|
if (Tcl_SplitList(interp, ensName, &nameArgc, &nameArgv) != TCL_OK) {
|
if (Tcl_SplitList(interp, ensName, &nameArgc, &nameArgv) != TCL_OK) {
|
goto ensGetFail;
|
goto ensGetFail;
|
}
|
}
|
if (FindEnsemble(interp, nameArgv, nameArgc, &ensData) != TCL_OK) {
|
if (FindEnsemble(interp, nameArgv, nameArgc, &ensData) != TCL_OK) {
|
goto ensGetFail;
|
goto ensGetFail;
|
}
|
}
|
if (ensData == NULL) {
|
if (ensData == NULL) {
|
goto ensGetFail;
|
goto ensGetFail;
|
}
|
}
|
|
|
/*
|
/*
|
* Look for a part with the desired name. If found, load
|
* Look for a part with the desired name. If found, load
|
* its data into the "infoPtr" structure.
|
* its data into the "infoPtr" structure.
|
*/
|
*/
|
if (FindEnsemblePart(interp, ensData, partName, &ensPart)
|
if (FindEnsemblePart(interp, ensData, partName, &ensPart)
|
!= TCL_OK || ensPart == NULL) {
|
!= TCL_OK || ensPart == NULL) {
|
goto ensGetFail;
|
goto ensGetFail;
|
}
|
}
|
|
|
cmdPtr = ensPart->cmdPtr;
|
cmdPtr = ensPart->cmdPtr;
|
infoPtr->isNativeObjectProc = (cmdPtr->objProc != TclInvokeStringCommand);
|
infoPtr->isNativeObjectProc = (cmdPtr->objProc != TclInvokeStringCommand);
|
infoPtr->objProc = cmdPtr->objProc;
|
infoPtr->objProc = cmdPtr->objProc;
|
infoPtr->objClientData = cmdPtr->objClientData;
|
infoPtr->objClientData = cmdPtr->objClientData;
|
infoPtr->proc = cmdPtr->proc;
|
infoPtr->proc = cmdPtr->proc;
|
infoPtr->clientData = cmdPtr->clientData;
|
infoPtr->clientData = cmdPtr->clientData;
|
infoPtr->deleteProc = cmdPtr->deleteProc;
|
infoPtr->deleteProc = cmdPtr->deleteProc;
|
infoPtr->deleteData = cmdPtr->deleteData;
|
infoPtr->deleteData = cmdPtr->deleteData;
|
infoPtr->namespacePtr = (Tcl_Namespace*)cmdPtr->nsPtr;
|
infoPtr->namespacePtr = (Tcl_Namespace*)cmdPtr->nsPtr;
|
|
|
Itcl_DiscardInterpState(state);
|
Itcl_DiscardInterpState(state);
|
return 1;
|
return 1;
|
|
|
ensGetFail:
|
ensGetFail:
|
Itcl_RestoreInterpState(interp, state);
|
Itcl_RestoreInterpState(interp, state);
|
return 0;
|
return 0;
|
}
|
}
|
|
|
|
|
/*
|
/*
|
*----------------------------------------------------------------------
|
*----------------------------------------------------------------------
|
*
|
*
|
* Itcl_IsEnsemble --
|
* Itcl_IsEnsemble --
|
*
|
*
|
* Determines whether or not an existing command is an ensemble.
|
* Determines whether or not an existing command is an ensemble.
|
*
|
*
|
* Results:
|
* Results:
|
* Returns non-zero if the command is an ensemble, and zero
|
* Returns non-zero if the command is an ensemble, and zero
|
* otherwise.
|
* otherwise.
|
*
|
*
|
* Side effects:
|
* Side effects:
|
* None.
|
* None.
|
*
|
*
|
*----------------------------------------------------------------------
|
*----------------------------------------------------------------------
|
*/
|
*/
|
int
|
int
|
Itcl_IsEnsemble(infoPtr)
|
Itcl_IsEnsemble(infoPtr)
|
Tcl_CmdInfo* infoPtr; /* command info from Tcl_GetCommandInfo() */
|
Tcl_CmdInfo* infoPtr; /* command info from Tcl_GetCommandInfo() */
|
{
|
{
|
if (infoPtr) {
|
if (infoPtr) {
|
return (infoPtr->deleteProc == DeleteEnsemble);
|
return (infoPtr->deleteProc == DeleteEnsemble);
|
}
|
}
|
return 0;
|
return 0;
|
}
|
}
|
|
|
|
|
/*
|
/*
|
*----------------------------------------------------------------------
|
*----------------------------------------------------------------------
|
*
|
*
|
* Itcl_GetEnsembleUsage --
|
* Itcl_GetEnsembleUsage --
|
*
|
*
|
* Returns a summary of all of the parts of an ensemble and
|
* Returns a summary of all of the parts of an ensemble and
|
* the meaning of their arguments. Each part is listed on
|
* the meaning of their arguments. Each part is listed on
|
* a separate line. Having this summary is sometimes useful
|
* a separate line. Having this summary is sometimes useful
|
* when building error messages for the "@error" handler in
|
* when building error messages for the "@error" handler in
|
* an ensemble.
|
* an ensemble.
|
*
|
*
|
* Ensembles are accessed by name, as described in
|
* Ensembles are accessed by name, as described in
|
* Itcl_CreateEnsemble.
|
* Itcl_CreateEnsemble.
|
*
|
*
|
* Results:
|
* Results:
|
* If the ensemble is found, its usage information is appended
|
* If the ensemble is found, its usage information is appended
|
* onto the object "objPtr", and this procedure returns
|
* onto the object "objPtr", and this procedure returns
|
* non-zero. It is the responsibility of the caller to
|
* non-zero. It is the responsibility of the caller to
|
* initialize and free the object. If anything goes wrong,
|
* initialize and free the object. If anything goes wrong,
|
* this procedure returns 0.
|
* this procedure returns 0.
|
*
|
*
|
* Side effects:
|
* Side effects:
|
* Object passed in is modified.
|
* Object passed in is modified.
|
*
|
*
|
*----------------------------------------------------------------------
|
*----------------------------------------------------------------------
|
*/
|
*/
|
int
|
int
|
Itcl_GetEnsembleUsage(interp, ensName, objPtr)
|
Itcl_GetEnsembleUsage(interp, ensName, objPtr)
|
Tcl_Interp *interp; /* interpreter containing the ensemble */
|
Tcl_Interp *interp; /* interpreter containing the ensemble */
|
char *ensName; /* name of the ensemble */
|
char *ensName; /* name of the ensemble */
|
Tcl_Obj *objPtr; /* returns: summary of usage info */
|
Tcl_Obj *objPtr; /* returns: summary of usage info */
|
{
|
{
|
char **nameArgv = NULL;
|
char **nameArgv = NULL;
|
int nameArgc;
|
int nameArgc;
|
Ensemble *ensData;
|
Ensemble *ensData;
|
Itcl_InterpState state;
|
Itcl_InterpState state;
|
|
|
/*
|
/*
|
* Parse the ensemble name and look for the ensemble.
|
* Parse the ensemble name and look for the ensemble.
|
* Save the interpreter state before we do this. If we get
|
* Save the interpreter state before we do this. If we get
|
* any errors, we don't want them to affect the interpreter.
|
* any errors, we don't want them to affect the interpreter.
|
*/
|
*/
|
state = Itcl_SaveInterpState(interp, TCL_OK);
|
state = Itcl_SaveInterpState(interp, TCL_OK);
|
|
|
if (Tcl_SplitList(interp, ensName, &nameArgc, &nameArgv) != TCL_OK) {
|
if (Tcl_SplitList(interp, ensName, &nameArgc, &nameArgv) != TCL_OK) {
|
goto ensUsageFail;
|
goto ensUsageFail;
|
}
|
}
|
if (FindEnsemble(interp, nameArgv, nameArgc, &ensData) != TCL_OK) {
|
if (FindEnsemble(interp, nameArgv, nameArgc, &ensData) != TCL_OK) {
|
goto ensUsageFail;
|
goto ensUsageFail;
|
}
|
}
|
if (ensData == NULL) {
|
if (ensData == NULL) {
|
goto ensUsageFail;
|
goto ensUsageFail;
|
}
|
}
|
|
|
/*
|
/*
|
* Add a summary of usage information to the return buffer.
|
* Add a summary of usage information to the return buffer.
|
*/
|
*/
|
GetEnsembleUsage(ensData, objPtr);
|
GetEnsembleUsage(ensData, objPtr);
|
|
|
Itcl_DiscardInterpState(state);
|
Itcl_DiscardInterpState(state);
|
return 1;
|
return 1;
|
|
|
ensUsageFail:
|
ensUsageFail:
|
Itcl_RestoreInterpState(interp, state);
|
Itcl_RestoreInterpState(interp, state);
|
return 0;
|
return 0;
|
}
|
}
|
|
|
|
|
/*
|
/*
|
*----------------------------------------------------------------------
|
*----------------------------------------------------------------------
|
*
|
*
|
* Itcl_GetEnsembleUsageForObj --
|
* Itcl_GetEnsembleUsageForObj --
|
*
|
*
|
* Returns a summary of all of the parts of an ensemble and
|
* Returns a summary of all of the parts of an ensemble and
|
* the meaning of their arguments. This procedure is just
|
* the meaning of their arguments. This procedure is just
|
* like Itcl_GetEnsembleUsage, but it determines the desired
|
* like Itcl_GetEnsembleUsage, but it determines the desired
|
* ensemble from a command line argument. The argument should
|
* ensemble from a command line argument. The argument should
|
* be the first argument on the command line--the ensemble
|
* be the first argument on the command line--the ensemble
|
* command or one of its parts.
|
* command or one of its parts.
|
*
|
*
|
* Results:
|
* Results:
|
* If the ensemble is found, its usage information is appended
|
* If the ensemble is found, its usage information is appended
|
* onto the object "objPtr", and this procedure returns
|
* onto the object "objPtr", and this procedure returns
|
* non-zero. It is the responsibility of the caller to
|
* non-zero. It is the responsibility of the caller to
|
* initialize and free the object. If anything goes wrong,
|
* initialize and free the object. If anything goes wrong,
|
* this procedure returns 0.
|
* this procedure returns 0.
|
*
|
*
|
* Side effects:
|
* Side effects:
|
* Object passed in is modified.
|
* Object passed in is modified.
|
*
|
*
|
*----------------------------------------------------------------------
|
*----------------------------------------------------------------------
|
*/
|
*/
|
int
|
int
|
Itcl_GetEnsembleUsageForObj(interp, ensObjPtr, objPtr)
|
Itcl_GetEnsembleUsageForObj(interp, ensObjPtr, objPtr)
|
Tcl_Interp *interp; /* interpreter containing the ensemble */
|
Tcl_Interp *interp; /* interpreter containing the ensemble */
|
Tcl_Obj *ensObjPtr; /* argument representing ensemble */
|
Tcl_Obj *ensObjPtr; /* argument representing ensemble */
|
Tcl_Obj *objPtr; /* returns: summary of usage info */
|
Tcl_Obj *objPtr; /* returns: summary of usage info */
|
{
|
{
|
Ensemble *ensData;
|
Ensemble *ensData;
|
Tcl_Obj *chainObj;
|
Tcl_Obj *chainObj;
|
Tcl_Command cmd;
|
Tcl_Command cmd;
|
Command *cmdPtr;
|
Command *cmdPtr;
|
|
|
/*
|
/*
|
* If the argument is an ensemble part, then follow the chain
|
* If the argument is an ensemble part, then follow the chain
|
* back to the command word for the entire ensemble.
|
* back to the command word for the entire ensemble.
|
*/
|
*/
|
chainObj = ensObjPtr;
|
chainObj = ensObjPtr;
|
while (chainObj && chainObj->typePtr == &itclEnsInvocType) {
|
while (chainObj && chainObj->typePtr == &itclEnsInvocType) {
|
chainObj = (Tcl_Obj*)chainObj->internalRep.twoPtrValue.ptr2;
|
chainObj = (Tcl_Obj*)chainObj->internalRep.twoPtrValue.ptr2;
|
}
|
}
|
|
|
if (chainObj) {
|
if (chainObj) {
|
cmd = Tcl_GetCommandFromObj(interp, chainObj);
|
cmd = Tcl_GetCommandFromObj(interp, chainObj);
|
cmdPtr = (Command*)cmd;
|
cmdPtr = (Command*)cmd;
|
if (cmdPtr->deleteProc == DeleteEnsemble) {
|
if (cmdPtr->deleteProc == DeleteEnsemble) {
|
ensData = (Ensemble*)cmdPtr->objClientData;
|
ensData = (Ensemble*)cmdPtr->objClientData;
|
GetEnsembleUsage(ensData, objPtr);
|
GetEnsembleUsage(ensData, objPtr);
|
return 1;
|
return 1;
|
}
|
}
|
}
|
}
|
return 0;
|
return 0;
|
}
|
}
|
|
|
|
|
/*
|
/*
|
*----------------------------------------------------------------------
|
*----------------------------------------------------------------------
|
*
|
*
|
* GetEnsembleUsage --
|
* GetEnsembleUsage --
|
*
|
*
|
*
|
*
|
* Returns a summary of all of the parts of an ensemble and
|
* Returns a summary of all of the parts of an ensemble and
|
* the meaning of their arguments. Each part is listed on
|
* the meaning of their arguments. Each part is listed on
|
* a separate line. This procedure is used internally to
|
* a separate line. This procedure is used internally to
|
* generate usage information for error messages.
|
* generate usage information for error messages.
|
*
|
*
|
* Results:
|
* Results:
|
* Appends usage information onto the object in "objPtr".
|
* Appends usage information onto the object in "objPtr".
|
*
|
*
|
* Side effects:
|
* Side effects:
|
* None.
|
* None.
|
*
|
*
|
*----------------------------------------------------------------------
|
*----------------------------------------------------------------------
|
*/
|
*/
|
static void
|
static void
|
GetEnsembleUsage(ensData, objPtr)
|
GetEnsembleUsage(ensData, objPtr)
|
Ensemble *ensData; /* ensemble data */
|
Ensemble *ensData; /* ensemble data */
|
Tcl_Obj *objPtr; /* returns: summary of usage info */
|
Tcl_Obj *objPtr; /* returns: summary of usage info */
|
{
|
{
|
char *spaces = " ";
|
char *spaces = " ";
|
int isOpenEnded = 0;
|
int isOpenEnded = 0;
|
|
|
int i;
|
int i;
|
EnsemblePart *ensPart;
|
EnsemblePart *ensPart;
|
|
|
for (i=0; i < ensData->numParts; i++) {
|
for (i=0; i < ensData->numParts; i++) {
|
ensPart = ensData->parts[i];
|
ensPart = ensData->parts[i];
|
|
|
if (*ensPart->name == '@' && strcmp(ensPart->name,"@error") == 0) {
|
if (*ensPart->name == '@' && strcmp(ensPart->name,"@error") == 0) {
|
isOpenEnded = 1;
|
isOpenEnded = 1;
|
}
|
}
|
else {
|
else {
|
Tcl_AppendToObj(objPtr, spaces, -1);
|
Tcl_AppendToObj(objPtr, spaces, -1);
|
GetEnsemblePartUsage(ensPart, objPtr);
|
GetEnsemblePartUsage(ensPart, objPtr);
|
spaces = "\n ";
|
spaces = "\n ";
|
}
|
}
|
}
|
}
|
if (isOpenEnded) {
|
if (isOpenEnded) {
|
Tcl_AppendToObj(objPtr,
|
Tcl_AppendToObj(objPtr,
|
"\n...and others described on the man page", -1);
|
"\n...and others described on the man page", -1);
|
}
|
}
|
}
|
}
|
|
|
|
|
/*
|
/*
|
*----------------------------------------------------------------------
|
*----------------------------------------------------------------------
|
*
|
*
|
* GetEnsemblePartUsage --
|
* GetEnsemblePartUsage --
|
*
|
*
|
* Determines the usage for a single part within an ensemble,
|
* Determines the usage for a single part within an ensemble,
|
* and appends a summary onto a dynamic string. The usage
|
* and appends a summary onto a dynamic string. The usage
|
* is a combination of the part name and the argument summary.
|
* is a combination of the part name and the argument summary.
|
* It is the caller's responsibility to initialize and free
|
* It is the caller's responsibility to initialize and free
|
* the dynamic string.
|
* the dynamic string.
|
*
|
*
|
* Results:
|
* Results:
|
* Returns usage information in the object "objPtr".
|
* Returns usage information in the object "objPtr".
|
*
|
*
|
* Side effects:
|
* Side effects:
|
* None.
|
* None.
|
*
|
*
|
*----------------------------------------------------------------------
|
*----------------------------------------------------------------------
|
*/
|
*/
|
static void
|
static void
|
GetEnsemblePartUsage(ensPart, objPtr)
|
GetEnsemblePartUsage(ensPart, objPtr)
|
EnsemblePart *ensPart; /* ensemble part for usage info */
|
EnsemblePart *ensPart; /* ensemble part for usage info */
|
Tcl_Obj *objPtr; /* returns: usage information */
|
Tcl_Obj *objPtr; /* returns: usage information */
|
{
|
{
|
EnsemblePart *part;
|
EnsemblePart *part;
|
Command *cmdPtr;
|
Command *cmdPtr;
|
char *name;
|
char *name;
|
Itcl_List trail;
|
Itcl_List trail;
|
Itcl_ListElem *elem;
|
Itcl_ListElem *elem;
|
Tcl_DString buffer;
|
Tcl_DString buffer;
|
|
|
/*
|
/*
|
* Build the trail of ensemble names leading to this part.
|
* Build the trail of ensemble names leading to this part.
|
*/
|
*/
|
Tcl_DStringInit(&buffer);
|
Tcl_DStringInit(&buffer);
|
Itcl_InitList(&trail);
|
Itcl_InitList(&trail);
|
for (part=ensPart; part; part=part->ensemble->parent) {
|
for (part=ensPart; part; part=part->ensemble->parent) {
|
Itcl_InsertList(&trail, (ClientData)part);
|
Itcl_InsertList(&trail, (ClientData)part);
|
}
|
}
|
|
|
cmdPtr = (Command*)ensPart->ensemble->cmd;
|
cmdPtr = (Command*)ensPart->ensemble->cmd;
|
name = Tcl_GetHashKey(cmdPtr->hPtr->tablePtr, cmdPtr->hPtr);
|
name = Tcl_GetHashKey(cmdPtr->hPtr->tablePtr, cmdPtr->hPtr);
|
Tcl_DStringAppendElement(&buffer, name);
|
Tcl_DStringAppendElement(&buffer, name);
|
|
|
for (elem=Itcl_FirstListElem(&trail); elem; elem=Itcl_NextListElem(elem)) {
|
for (elem=Itcl_FirstListElem(&trail); elem; elem=Itcl_NextListElem(elem)) {
|
part = (EnsemblePart*)Itcl_GetListValue(elem);
|
part = (EnsemblePart*)Itcl_GetListValue(elem);
|
Tcl_DStringAppendElement(&buffer, part->name);
|
Tcl_DStringAppendElement(&buffer, part->name);
|
}
|
}
|
Itcl_DeleteList(&trail);
|
Itcl_DeleteList(&trail);
|
|
|
/*
|
/*
|
* If the part has usage info, use it directly.
|
* If the part has usage info, use it directly.
|
*/
|
*/
|
if (ensPart->usage && *ensPart->usage != '\0') {
|
if (ensPart->usage && *ensPart->usage != '\0') {
|
Tcl_DStringAppend(&buffer, " ", 1);
|
Tcl_DStringAppend(&buffer, " ", 1);
|
Tcl_DStringAppend(&buffer, ensPart->usage, -1);
|
Tcl_DStringAppend(&buffer, ensPart->usage, -1);
|
}
|
}
|
|
|
/*
|
/*
|
* If the part is itself an ensemble, summarize its usage.
|
* If the part is itself an ensemble, summarize its usage.
|
*/
|
*/
|
else if (ensPart->cmdPtr &&
|
else if (ensPart->cmdPtr &&
|
ensPart->cmdPtr->deleteProc == DeleteEnsemble) {
|
ensPart->cmdPtr->deleteProc == DeleteEnsemble) {
|
Tcl_DStringAppend(&buffer, " option ?arg arg ...?", 21);
|
Tcl_DStringAppend(&buffer, " option ?arg arg ...?", 21);
|
}
|
}
|
|
|
Tcl_AppendToObj(objPtr, Tcl_DStringValue(&buffer),
|
Tcl_AppendToObj(objPtr, Tcl_DStringValue(&buffer),
|
Tcl_DStringLength(&buffer));
|
Tcl_DStringLength(&buffer));
|
|
|
Tcl_DStringFree(&buffer);
|
Tcl_DStringFree(&buffer);
|
}
|
}
|
|
|
|
|
/*
|
/*
|
*----------------------------------------------------------------------
|
*----------------------------------------------------------------------
|
*
|
*
|
* CreateEnsemble --
|
* CreateEnsemble --
|
*
|
*
|
* Creates an ensemble command, or adds a sub-ensemble to an
|
* Creates an ensemble command, or adds a sub-ensemble to an
|
* existing ensemble command. Works like Itcl_CreateEnsemble,
|
* existing ensemble command. Works like Itcl_CreateEnsemble,
|
* except that the ensemble name is a single name, not a path.
|
* except that the ensemble name is a single name, not a path.
|
* If a parent ensemble is specified, then a new ensemble is
|
* If a parent ensemble is specified, then a new ensemble is
|
* added to that parent. If a part already exists with the
|
* added to that parent. If a part already exists with the
|
* same name, it is an error. If a parent ensemble is not
|
* same name, it is an error. If a parent ensemble is not
|
* specified, then a top-level ensemble is created. If a
|
* specified, then a top-level ensemble is created. If a
|
* command already exists with the same name, it is deleted.
|
* command already exists with the same name, it is deleted.
|
*
|
*
|
* Results:
|
* Results:
|
* Returns TCL_OK if successful, and TCL_ERROR if anything goes
|
* Returns TCL_OK if successful, and TCL_ERROR if anything goes
|
* wrong.
|
* wrong.
|
*
|
*
|
* Side effects:
|
* Side effects:
|
* If an error is encountered, an error is left as the result
|
* If an error is encountered, an error is left as the result
|
* in the interpreter.
|
* in the interpreter.
|
*
|
*
|
*----------------------------------------------------------------------
|
*----------------------------------------------------------------------
|
*/
|
*/
|
static int
|
static int
|
CreateEnsemble(interp, parentEnsData, ensName)
|
CreateEnsemble(interp, parentEnsData, ensName)
|
Tcl_Interp *interp; /* interpreter to be updated */
|
Tcl_Interp *interp; /* interpreter to be updated */
|
Ensemble *parentEnsData; /* parent ensemble or NULL */
|
Ensemble *parentEnsData; /* parent ensemble or NULL */
|
char *ensName; /* name of the new ensemble */
|
char *ensName; /* name of the new ensemble */
|
{
|
{
|
Ensemble *ensData;
|
Ensemble *ensData;
|
EnsemblePart *ensPart;
|
EnsemblePart *ensPart;
|
Command *cmdPtr;
|
Command *cmdPtr;
|
Tcl_CmdInfo cmdInfo;
|
Tcl_CmdInfo cmdInfo;
|
|
|
/*
|
/*
|
* Create the data associated with the ensemble.
|
* Create the data associated with the ensemble.
|
*/
|
*/
|
ensData = (Ensemble*)ckalloc(sizeof(Ensemble));
|
ensData = (Ensemble*)ckalloc(sizeof(Ensemble));
|
ensData->interp = interp;
|
ensData->interp = interp;
|
ensData->numParts = 0;
|
ensData->numParts = 0;
|
ensData->maxParts = 10;
|
ensData->maxParts = 10;
|
ensData->parts = (EnsemblePart**)ckalloc(
|
ensData->parts = (EnsemblePart**)ckalloc(
|
(unsigned)(ensData->maxParts*sizeof(EnsemblePart*))
|
(unsigned)(ensData->maxParts*sizeof(EnsemblePart*))
|
);
|
);
|
ensData->cmd = NULL;
|
ensData->cmd = NULL;
|
ensData->parent = NULL;
|
ensData->parent = NULL;
|
|
|
/*
|
/*
|
* If there is no parent data, then this is a top-level
|
* If there is no parent data, then this is a top-level
|
* ensemble. Create the ensemble by installing its access
|
* ensemble. Create the ensemble by installing its access
|
* command.
|
* command.
|
*
|
*
|
* BE CAREFUL: Set the string-based proc to the wrapper
|
* BE CAREFUL: Set the string-based proc to the wrapper
|
* procedure TclInvokeObjectCommand. Otherwise, the
|
* procedure TclInvokeObjectCommand. Otherwise, the
|
* ensemble command may fail. For example, it will fail
|
* ensemble command may fail. For example, it will fail
|
* when invoked as a hidden command.
|
* when invoked as a hidden command.
|
*/
|
*/
|
if (parentEnsData == NULL) {
|
if (parentEnsData == NULL) {
|
ensData->cmd = Tcl_CreateObjCommand(interp, ensName,
|
ensData->cmd = Tcl_CreateObjCommand(interp, ensName,
|
HandleEnsemble, (ClientData)ensData, DeleteEnsemble);
|
HandleEnsemble, (ClientData)ensData, DeleteEnsemble);
|
|
|
if (Tcl_GetCommandInfo(interp, ensName, &cmdInfo)) {
|
if (Tcl_GetCommandInfo(interp, ensName, &cmdInfo)) {
|
cmdInfo.proc = TclInvokeObjectCommand;
|
cmdInfo.proc = TclInvokeObjectCommand;
|
Tcl_SetCommandInfo(interp, ensName, &cmdInfo);
|
Tcl_SetCommandInfo(interp, ensName, &cmdInfo);
|
}
|
}
|
return TCL_OK;
|
return TCL_OK;
|
}
|
}
|
|
|
/*
|
/*
|
* Otherwise, this ensemble is contained within another parent.
|
* Otherwise, this ensemble is contained within another parent.
|
* Install the new ensemble as a part within its parent.
|
* Install the new ensemble as a part within its parent.
|
*/
|
*/
|
if (CreateEnsemblePart(interp, parentEnsData, ensName, &ensPart)
|
if (CreateEnsemblePart(interp, parentEnsData, ensName, &ensPart)
|
!= TCL_OK) {
|
!= TCL_OK) {
|
DeleteEnsemble((ClientData)ensData);
|
DeleteEnsemble((ClientData)ensData);
|
return TCL_ERROR;
|
return TCL_ERROR;
|
}
|
}
|
|
|
ensData->cmd = parentEnsData->cmd;
|
ensData->cmd = parentEnsData->cmd;
|
ensData->parent = ensPart;
|
ensData->parent = ensPart;
|
|
|
cmdPtr = (Command*)ckalloc(sizeof(Command));
|
cmdPtr = (Command*)ckalloc(sizeof(Command));
|
cmdPtr->hPtr = NULL;
|
cmdPtr->hPtr = NULL;
|
cmdPtr->nsPtr = ((Command*)ensData->cmd)->nsPtr;
|
cmdPtr->nsPtr = ((Command*)ensData->cmd)->nsPtr;
|
cmdPtr->refCount = 0;
|
cmdPtr->refCount = 0;
|
cmdPtr->cmdEpoch = 0;
|
cmdPtr->cmdEpoch = 0;
|
cmdPtr->compileProc = NULL;
|
cmdPtr->compileProc = NULL;
|
cmdPtr->objProc = HandleEnsemble;
|
cmdPtr->objProc = HandleEnsemble;
|
cmdPtr->objClientData = (ClientData)ensData;
|
cmdPtr->objClientData = (ClientData)ensData;
|
cmdPtr->proc = NULL;
|
cmdPtr->proc = NULL;
|
cmdPtr->clientData = NULL;
|
cmdPtr->clientData = NULL;
|
cmdPtr->deleteProc = DeleteEnsemble;
|
cmdPtr->deleteProc = DeleteEnsemble;
|
cmdPtr->deleteData = cmdPtr->objClientData;
|
cmdPtr->deleteData = cmdPtr->objClientData;
|
cmdPtr->deleted = 0;
|
cmdPtr->deleted = 0;
|
cmdPtr->importRefPtr = NULL;
|
cmdPtr->importRefPtr = NULL;
|
|
|
ensPart->cmdPtr = cmdPtr;
|
ensPart->cmdPtr = cmdPtr;
|
|
|
return TCL_OK;
|
return TCL_OK;
|
}
|
}
|
|
|
|
|
/*
|
/*
|
*----------------------------------------------------------------------
|
*----------------------------------------------------------------------
|
*
|
*
|
* AddEnsemblePart --
|
* AddEnsemblePart --
|
*
|
*
|
* Adds a part to an existing ensemble. Works like
|
* Adds a part to an existing ensemble. Works like
|
* Itcl_AddEnsemblePart, but the part name is a single word,
|
* Itcl_AddEnsemblePart, but the part name is a single word,
|
* not a path.
|
* not a path.
|
*
|
*
|
* If the ensemble already has a part with the specified name,
|
* If the ensemble already has a part with the specified name,
|
* this procedure returns an error. Otherwise, it adds a new
|
* this procedure returns an error. Otherwise, it adds a new
|
* part to the ensemble.
|
* part to the ensemble.
|
*
|
*
|
* Any client data specified is automatically passed to the
|
* Any client data specified is automatically passed to the
|
* handling procedure whenever the part is invoked. It is
|
* handling procedure whenever the part is invoked. It is
|
* automatically destroyed by the deleteProc when the part is
|
* automatically destroyed by the deleteProc when the part is
|
* deleted.
|
* deleted.
|
*
|
*
|
* Results:
|
* Results:
|
* Returns TCL_OK if successful, along with a pointer to the
|
* Returns TCL_OK if successful, along with a pointer to the
|
* new part. Returns TCL_ERROR if anything goes wrong.
|
* new part. Returns TCL_ERROR if anything goes wrong.
|
*
|
*
|
* Side effects:
|
* Side effects:
|
* If an error is encountered, an error is left as the result
|
* If an error is encountered, an error is left as the result
|
* in the interpreter.
|
* in the interpreter.
|
*
|
*
|
*----------------------------------------------------------------------
|
*----------------------------------------------------------------------
|
*/
|
*/
|
static int
|
static int
|
AddEnsemblePart(interp, ensData, partName, usageInfo,
|
AddEnsemblePart(interp, ensData, partName, usageInfo,
|
objProc, clientData, deleteProc, rVal)
|
objProc, clientData, deleteProc, rVal)
|
|
|
Tcl_Interp *interp; /* interpreter to be updated */
|
Tcl_Interp *interp; /* interpreter to be updated */
|
Ensemble* ensData; /* ensemble that will contain this part */
|
Ensemble* ensData; /* ensemble that will contain this part */
|
char* partName; /* name of the new part */
|
char* partName; /* name of the new part */
|
char* usageInfo; /* usage info for argument list */
|
char* usageInfo; /* usage info for argument list */
|
Tcl_ObjCmdProc *objProc; /* handling procedure for part */
|
Tcl_ObjCmdProc *objProc; /* handling procedure for part */
|
ClientData clientData; /* client data associated with part */
|
ClientData clientData; /* client data associated with part */
|
Tcl_CmdDeleteProc *deleteProc; /* procedure used to destroy client data */
|
Tcl_CmdDeleteProc *deleteProc; /* procedure used to destroy client data */
|
EnsemblePart **rVal; /* returns: new ensemble part */
|
EnsemblePart **rVal; /* returns: new ensemble part */
|
{
|
{
|
EnsemblePart *ensPart;
|
EnsemblePart *ensPart;
|
Command *cmdPtr;
|
Command *cmdPtr;
|
|
|
/*
|
/*
|
* Install the new part into the part list.
|
* Install the new part into the part list.
|
*/
|
*/
|
if (CreateEnsemblePart(interp, ensData, partName, &ensPart) != TCL_OK) {
|
if (CreateEnsemblePart(interp, ensData, partName, &ensPart) != TCL_OK) {
|
return TCL_ERROR;
|
return TCL_ERROR;
|
}
|
}
|
|
|
if (usageInfo) {
|
if (usageInfo) {
|
ensPart->usage = ckalloc((unsigned)(strlen(usageInfo)+1));
|
ensPart->usage = ckalloc((unsigned)(strlen(usageInfo)+1));
|
strcpy(ensPart->usage, usageInfo);
|
strcpy(ensPart->usage, usageInfo);
|
}
|
}
|
|
|
cmdPtr = (Command*)ckalloc(sizeof(Command));
|
cmdPtr = (Command*)ckalloc(sizeof(Command));
|
cmdPtr->hPtr = NULL;
|
cmdPtr->hPtr = NULL;
|
cmdPtr->nsPtr = ((Command*)ensData->cmd)->nsPtr;
|
cmdPtr->nsPtr = ((Command*)ensData->cmd)->nsPtr;
|
cmdPtr->refCount = 0;
|
cmdPtr->refCount = 0;
|
cmdPtr->cmdEpoch = 0;
|
cmdPtr->cmdEpoch = 0;
|
cmdPtr->compileProc = NULL;
|
cmdPtr->compileProc = NULL;
|
cmdPtr->objProc = objProc;
|
cmdPtr->objProc = objProc;
|
cmdPtr->objClientData = (ClientData)clientData;
|
cmdPtr->objClientData = (ClientData)clientData;
|
cmdPtr->proc = NULL;
|
cmdPtr->proc = NULL;
|
cmdPtr->clientData = NULL;
|
cmdPtr->clientData = NULL;
|
cmdPtr->deleteProc = deleteProc;
|
cmdPtr->deleteProc = deleteProc;
|
cmdPtr->deleteData = (ClientData)clientData;
|
cmdPtr->deleteData = (ClientData)clientData;
|
cmdPtr->deleted = 0;
|
cmdPtr->deleted = 0;
|
cmdPtr->importRefPtr = NULL;
|
cmdPtr->importRefPtr = NULL;
|
|
|
ensPart->cmdPtr = cmdPtr;
|
ensPart->cmdPtr = cmdPtr;
|
*rVal = ensPart;
|
*rVal = ensPart;
|
|
|
return TCL_OK;
|
return TCL_OK;
|
}
|
}
|
|
|
|
|
/*
|
/*
|
*----------------------------------------------------------------------
|
*----------------------------------------------------------------------
|
*
|
*
|
* DeleteEnsemble --
|
* DeleteEnsemble --
|
*
|
*
|
* Invoked when the command associated with an ensemble is
|
* Invoked when the command associated with an ensemble is
|
* destroyed, to delete the ensemble. Destroys all parts
|
* destroyed, to delete the ensemble. Destroys all parts
|
* included in the ensemble, and frees all memory associated
|
* included in the ensemble, and frees all memory associated
|
* with it.
|
* with it.
|
*
|
*
|
* Results:
|
* Results:
|
* None.
|
* None.
|
*
|
*
|
* Side effects:
|
* Side effects:
|
* None.
|
* None.
|
*
|
*
|
*----------------------------------------------------------------------
|
*----------------------------------------------------------------------
|
*/
|
*/
|
static void
|
static void
|
DeleteEnsemble(clientData)
|
DeleteEnsemble(clientData)
|
ClientData clientData; /* ensemble data */
|
ClientData clientData; /* ensemble data */
|
{
|
{
|
Ensemble* ensData = (Ensemble*)clientData;
|
Ensemble* ensData = (Ensemble*)clientData;
|
|
|
/*
|
/*
|
* BE CAREFUL: Each ensemble part removes itself from the list.
|
* BE CAREFUL: Each ensemble part removes itself from the list.
|
* So keep deleting the first part until all parts are gone.
|
* So keep deleting the first part until all parts are gone.
|
*/
|
*/
|
while (ensData->numParts > 0) {
|
while (ensData->numParts > 0) {
|
DeleteEnsemblePart(ensData->parts[0]);
|
DeleteEnsemblePart(ensData->parts[0]);
|
}
|
}
|
ckfree((char*)ensData->parts);
|
ckfree((char*)ensData->parts);
|
ckfree((char*)ensData);
|
ckfree((char*)ensData);
|
}
|
}
|
|
|
|
|
/*
|
/*
|
*----------------------------------------------------------------------
|
*----------------------------------------------------------------------
|
*
|
*
|
* FindEnsemble --
|
* FindEnsemble --
|
*
|
*
|
* Searches for an ensemble command and follows a path to
|
* Searches for an ensemble command and follows a path to
|
* sub-ensembles.
|
* sub-ensembles.
|
*
|
*
|
* Results:
|
* Results:
|
* Returns TCL_OK if the ensemble was found, along with a
|
* Returns TCL_OK if the ensemble was found, along with a
|
* pointer to the ensemble data in "ensDataPtr". Returns
|
* pointer to the ensemble data in "ensDataPtr". Returns
|
* TCL_ERROR if anything goes wrong.
|
* TCL_ERROR if anything goes wrong.
|
*
|
*
|
* Side effects:
|
* Side effects:
|
* If anything goes wrong, this procedure returns an error
|
* If anything goes wrong, this procedure returns an error
|
* message as the result in the interpreter.
|
* message as the result in the interpreter.
|
*
|
*
|
*----------------------------------------------------------------------
|
*----------------------------------------------------------------------
|
*/
|
*/
|
static int
|
static int
|
FindEnsemble(interp, nameArgv, nameArgc, ensDataPtr)
|
FindEnsemble(interp, nameArgv, nameArgc, ensDataPtr)
|
Tcl_Interp *interp; /* interpreter containing the ensemble */
|
Tcl_Interp *interp; /* interpreter containing the ensemble */
|
char **nameArgv; /* path of names leading to ensemble */
|
char **nameArgv; /* path of names leading to ensemble */
|
int nameArgc; /* number of strings in nameArgv */
|
int nameArgc; /* number of strings in nameArgv */
|
Ensemble** ensDataPtr; /* returns: ensemble data */
|
Ensemble** ensDataPtr; /* returns: ensemble data */
|
{
|
{
|
int i;
|
int i;
|
Command* cmdPtr;
|
Command* cmdPtr;
|
Ensemble *ensData;
|
Ensemble *ensData;
|
EnsemblePart *ensPart;
|
EnsemblePart *ensPart;
|
|
|
*ensDataPtr = NULL; /* assume that no data will be found */
|
*ensDataPtr = NULL; /* assume that no data will be found */
|
|
|
/*
|
/*
|
* If there are no names in the path, then return an error.
|
* If there are no names in the path, then return an error.
|
*/
|
*/
|
if (nameArgc < 1) {
|
if (nameArgc < 1) {
|
Tcl_AppendToObj(Tcl_GetObjResult(interp),
|
Tcl_AppendToObj(Tcl_GetObjResult(interp),
|
"invalid ensemble name \"\"", -1);
|
"invalid ensemble name \"\"", -1);
|
return TCL_ERROR;
|
return TCL_ERROR;
|
}
|
}
|
|
|
/*
|
/*
|
* Use the first name to find the command for the top-level
|
* Use the first name to find the command for the top-level
|
* ensemble.
|
* ensemble.
|
*/
|
*/
|
cmdPtr = (Command*) Tcl_FindCommand(interp, nameArgv[0],
|
cmdPtr = (Command*) Tcl_FindCommand(interp, nameArgv[0],
|
(Tcl_Namespace*)NULL, TCL_LEAVE_ERR_MSG);
|
(Tcl_Namespace*)NULL, TCL_LEAVE_ERR_MSG);
|
|
|
if (cmdPtr == NULL || cmdPtr->deleteProc != DeleteEnsemble) {
|
if (cmdPtr == NULL || cmdPtr->deleteProc != DeleteEnsemble) {
|
Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
|
Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
|
"command \"", nameArgv[0], "\" is not an ensemble",
|
"command \"", nameArgv[0], "\" is not an ensemble",
|
(char*)NULL);
|
(char*)NULL);
|
return TCL_ERROR;
|
return TCL_ERROR;
|
}
|
}
|
ensData = (Ensemble*)cmdPtr->objClientData;
|
ensData = (Ensemble*)cmdPtr->objClientData;
|
|
|
/*
|
/*
|
* Follow the trail of sub-ensemble names.
|
* Follow the trail of sub-ensemble names.
|
*/
|
*/
|
for (i=1; i < nameArgc; i++) {
|
for (i=1; i < nameArgc; i++) {
|
if (FindEnsemblePart(interp, ensData, nameArgv[i], &ensPart)
|
if (FindEnsemblePart(interp, ensData, nameArgv[i], &ensPart)
|
!= TCL_OK) {
|
!= TCL_OK) {
|
return TCL_ERROR;
|
return TCL_ERROR;
|
}
|
}
|
if (ensPart == NULL) {
|
if (ensPart == NULL) {
|
char *pname = Tcl_Merge(i, nameArgv);
|
char *pname = Tcl_Merge(i, nameArgv);
|
Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
|
Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
|
"invalid ensemble name \"", pname, "\"",
|
"invalid ensemble name \"", pname, "\"",
|
(char*)NULL);
|
(char*)NULL);
|
ckfree(pname);
|
ckfree(pname);
|
return TCL_ERROR;
|
return TCL_ERROR;
|
}
|
}
|
|
|
cmdPtr = ensPart->cmdPtr;
|
cmdPtr = ensPart->cmdPtr;
|
if (cmdPtr == NULL || cmdPtr->deleteProc != DeleteEnsemble) {
|
if (cmdPtr == NULL || cmdPtr->deleteProc != DeleteEnsemble) {
|
Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
|
Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
|
"part \"", nameArgv[i], "\" is not an ensemble",
|
"part \"", nameArgv[i], "\" is not an ensemble",
|
(char*)NULL);
|
(char*)NULL);
|
return TCL_ERROR;
|
return TCL_ERROR;
|
}
|
}
|
ensData = (Ensemble*)cmdPtr->objClientData;
|
ensData = (Ensemble*)cmdPtr->objClientData;
|
}
|
}
|
*ensDataPtr = ensData;
|
*ensDataPtr = ensData;
|
|
|
return TCL_OK;
|
return TCL_OK;
|
}
|
}
|
|
|
|
|
/*
|
/*
|
*----------------------------------------------------------------------
|
*----------------------------------------------------------------------
|
*
|
*
|
* CreateEnsemblePart --
|
* CreateEnsemblePart --
|
*
|
*
|
* Creates a new part within an ensemble.
|
* Creates a new part within an ensemble.
|
*
|
*
|
* Results:
|
* Results:
|
* If successful, this procedure returns TCL_OK, along with a
|
* If successful, this procedure returns TCL_OK, along with a
|
* pointer to the new part in "ensPartPtr". If a part with the
|
* pointer to the new part in "ensPartPtr". If a part with the
|
* same name already exists, this procedure returns TCL_ERROR.
|
* same name already exists, this procedure returns TCL_ERROR.
|
*
|
*
|
* Side effects:
|
* Side effects:
|
* If anything goes wrong, this procedure returns an error
|
* If anything goes wrong, this procedure returns an error
|
* message as the result in the interpreter.
|
* message as the result in the interpreter.
|
*
|
*
|
*----------------------------------------------------------------------
|
*----------------------------------------------------------------------
|
*/
|
*/
|
static int
|
static int
|
CreateEnsemblePart(interp, ensData, partName, ensPartPtr)
|
CreateEnsemblePart(interp, ensData, partName, ensPartPtr)
|
Tcl_Interp *interp; /* interpreter containing the ensemble */
|
Tcl_Interp *interp; /* interpreter containing the ensemble */
|
Ensemble *ensData; /* ensemble being modified */
|
Ensemble *ensData; /* ensemble being modified */
|
char* partName; /* name of the new part */
|
char* partName; /* name of the new part */
|
EnsemblePart **ensPartPtr; /* returns: new ensemble part */
|
EnsemblePart **ensPartPtr; /* returns: new ensemble part */
|
{
|
{
|
int i, pos, size;
|
int i, pos, size;
|
EnsemblePart** partList;
|
EnsemblePart** partList;
|
EnsemblePart* part;
|
EnsemblePart* part;
|
|
|
/*
|
/*
|
* If a matching entry was found, then return an error.
|
* If a matching entry was found, then return an error.
|
*/
|
*/
|
if (FindEnsemblePartIndex(ensData, partName, &pos)) {
|
if (FindEnsemblePartIndex(ensData, partName, &pos)) {
|
Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
|
Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
|
"part \"", partName, "\" already exists in ensemble",
|
"part \"", partName, "\" already exists in ensemble",
|
(char*)NULL);
|
(char*)NULL);
|
return TCL_ERROR;
|
return TCL_ERROR;
|
}
|
}
|
|
|
/*
|
/*
|
* Otherwise, make room for a new entry. Keep the parts in
|
* Otherwise, make room for a new entry. Keep the parts in
|
* lexicographical order, so we can search them quickly
|
* lexicographical order, so we can search them quickly
|
* later.
|
* later.
|
*/
|
*/
|
if (ensData->numParts >= ensData->maxParts) {
|
if (ensData->numParts >= ensData->maxParts) {
|
size = ensData->maxParts*sizeof(EnsemblePart*);
|
size = ensData->maxParts*sizeof(EnsemblePart*);
|
partList = (EnsemblePart**)ckalloc((unsigned)2*size);
|
partList = (EnsemblePart**)ckalloc((unsigned)2*size);
|
memcpy((VOID*)partList, (VOID*)ensData->parts, (size_t)size);
|
memcpy((VOID*)partList, (VOID*)ensData->parts, (size_t)size);
|
ckfree((char*)ensData->parts);
|
ckfree((char*)ensData->parts);
|
|
|
ensData->parts = partList;
|
ensData->parts = partList;
|
ensData->maxParts *= 2;
|
ensData->maxParts *= 2;
|
}
|
}
|
|
|
for (i=ensData->numParts; i > pos; i--) {
|
for (i=ensData->numParts; i > pos; i--) {
|
ensData->parts[i] = ensData->parts[i-1];
|
ensData->parts[i] = ensData->parts[i-1];
|
}
|
}
|
ensData->numParts++;
|
ensData->numParts++;
|
|
|
part = (EnsemblePart*)ckalloc(sizeof(EnsemblePart));
|
part = (EnsemblePart*)ckalloc(sizeof(EnsemblePart));
|
part->name = (char*)ckalloc((unsigned)(strlen(partName)+1));
|
part->name = (char*)ckalloc((unsigned)(strlen(partName)+1));
|
strcpy(part->name, partName);
|
strcpy(part->name, partName);
|
part->cmdPtr = NULL;
|
part->cmdPtr = NULL;
|
part->usage = NULL;
|
part->usage = NULL;
|
part->ensemble = ensData;
|
part->ensemble = ensData;
|
|
|
ensData->parts[pos] = part;
|
ensData->parts[pos] = part;
|
|
|
/*
|
/*
|
* Compare the new part against the one on either side of
|
* Compare the new part against the one on either side of
|
* it. Determine how many letters are needed in each part
|
* it. Determine how many letters are needed in each part
|
* to guarantee that an abbreviated form is unique. Update
|
* to guarantee that an abbreviated form is unique. Update
|
* the parts on either side as well, since they are influenced
|
* the parts on either side as well, since they are influenced
|
* by the new part.
|
* by the new part.
|
*/
|
*/
|
ComputeMinChars(ensData, pos);
|
ComputeMinChars(ensData, pos);
|
ComputeMinChars(ensData, pos-1);
|
ComputeMinChars(ensData, pos-1);
|
ComputeMinChars(ensData, pos+1);
|
ComputeMinChars(ensData, pos+1);
|
|
|
*ensPartPtr = part;
|
*ensPartPtr = part;
|
return TCL_OK;
|
return TCL_OK;
|
}
|
}
|
|
|
|
|
/*
|
/*
|
*----------------------------------------------------------------------
|
*----------------------------------------------------------------------
|
*
|
*
|
* DeleteEnsemblePart --
|
* DeleteEnsemblePart --
|
*
|
*
|
* Deletes a single part from an ensemble. The part must have
|
* Deletes a single part from an ensemble. The part must have
|
* been created previously by CreateEnsemblePart.
|
* been created previously by CreateEnsemblePart.
|
*
|
*
|
* If the part has a delete proc, then it is called to free the
|
* If the part has a delete proc, then it is called to free the
|
* associated client data.
|
* associated client data.
|
*
|
*
|
* Results:
|
* Results:
|
* None.
|
* None.
|
*
|
*
|
* Side effects:
|
* Side effects:
|
* Delete proc is called.
|
* Delete proc is called.
|
*
|
*
|
*----------------------------------------------------------------------
|
*----------------------------------------------------------------------
|
*/
|
*/
|
static void
|
static void
|
DeleteEnsemblePart(ensPart)
|
DeleteEnsemblePart(ensPart)
|
EnsemblePart *ensPart; /* part being destroyed */
|
EnsemblePart *ensPart; /* part being destroyed */
|
{
|
{
|
int i, pos;
|
int i, pos;
|
Command *cmdPtr;
|
Command *cmdPtr;
|
Ensemble *ensData;
|
Ensemble *ensData;
|
cmdPtr = ensPart->cmdPtr;
|
cmdPtr = ensPart->cmdPtr;
|
|
|
/*
|
/*
|
* If this part has a delete proc, then call it to free
|
* If this part has a delete proc, then call it to free
|
* up the client data.
|
* up the client data.
|
*/
|
*/
|
if (cmdPtr->deleteData && cmdPtr->deleteProc) {
|
if (cmdPtr->deleteData && cmdPtr->deleteProc) {
|
(*cmdPtr->deleteProc)(cmdPtr->deleteData);
|
(*cmdPtr->deleteProc)(cmdPtr->deleteData);
|
}
|
}
|
ckfree((char*)cmdPtr);
|
ckfree((char*)cmdPtr);
|
|
|
/*
|
/*
|
* Find this part within its ensemble, and remove it from
|
* Find this part within its ensemble, and remove it from
|
* the list of parts.
|
* the list of parts.
|
*/
|
*/
|
if (FindEnsemblePartIndex(ensPart->ensemble, ensPart->name, &pos)) {
|
if (FindEnsemblePartIndex(ensPart->ensemble, ensPart->name, &pos)) {
|
ensData = ensPart->ensemble;
|
ensData = ensPart->ensemble;
|
for (i=pos; i < ensData->numParts-1; i++) {
|
for (i=pos; i < ensData->numParts-1; i++) {
|
ensData->parts[i] = ensData->parts[i+1];
|
ensData->parts[i] = ensData->parts[i+1];
|
}
|
}
|
ensData->numParts--;
|
ensData->numParts--;
|
}
|
}
|
|
|
/*
|
/*
|
* Free the memory associated with the part.
|
* Free the memory associated with the part.
|
*/
|
*/
|
if (ensPart->usage) {
|
if (ensPart->usage) {
|
ckfree(ensPart->usage);
|
ckfree(ensPart->usage);
|
}
|
}
|
ckfree(ensPart->name);
|
ckfree(ensPart->name);
|
ckfree((char*)ensPart);
|
ckfree((char*)ensPart);
|
}
|
}
|
|
|
|
|
/*
|
/*
|
*----------------------------------------------------------------------
|
*----------------------------------------------------------------------
|
*
|
*
|
* FindEnsemblePart --
|
* FindEnsemblePart --
|
*
|
*
|
* Searches for a part name within an ensemble. Recognizes
|
* Searches for a part name within an ensemble. Recognizes
|
* unique abbreviations for part names.
|
* unique abbreviations for part names.
|
*
|
*
|
* Results:
|
* Results:
|
* If the part name is not a unique abbreviation, this procedure
|
* If the part name is not a unique abbreviation, this procedure
|
* returns TCL_ERROR. Otherwise, it returns TCL_OK. If the
|
* returns TCL_ERROR. Otherwise, it returns TCL_OK. If the
|
* part can be found, "rensPart" returns a pointer to the part.
|
* part can be found, "rensPart" returns a pointer to the part.
|
* Otherwise, it returns NULL.
|
* Otherwise, it returns NULL.
|
*
|
*
|
* Side effects:
|
* Side effects:
|
* If anything goes wrong, this procedure returns an error
|
* If anything goes wrong, this procedure returns an error
|
* message as the result in the interpreter.
|
* message as the result in the interpreter.
|
*
|
*
|
*----------------------------------------------------------------------
|
*----------------------------------------------------------------------
|
*/
|
*/
|
static int
|
static int
|
FindEnsemblePart(interp, ensData, partName, rensPart)
|
FindEnsemblePart(interp, ensData, partName, rensPart)
|
Tcl_Interp *interp; /* interpreter containing the ensemble */
|
Tcl_Interp *interp; /* interpreter containing the ensemble */
|
Ensemble *ensData; /* ensemble being searched */
|
Ensemble *ensData; /* ensemble being searched */
|
char* partName; /* name of the desired part */
|
char* partName; /* name of the desired part */
|
EnsemblePart **rensPart; /* returns: pointer to the desired part */
|
EnsemblePart **rensPart; /* returns: pointer to the desired part */
|
{
|
{
|
int pos = 0;
|
int pos = 0;
|
int first, last, nlen;
|
int first, last, nlen;
|
int i, cmp;
|
int i, cmp;
|
|
|
*rensPart = NULL;
|
*rensPart = NULL;
|
|
|
/*
|
/*
|
* Search for the desired part name.
|
* Search for the desired part name.
|
* All parts are in lexicographical order, so use a
|
* All parts are in lexicographical order, so use a
|
* binary search to find the part quickly. Match only
|
* binary search to find the part quickly. Match only
|
* as many characters as are included in the specified
|
* as many characters as are included in the specified
|
* part name.
|
* part name.
|
*/
|
*/
|
first = 0;
|
first = 0;
|
last = ensData->numParts-1;
|
last = ensData->numParts-1;
|
nlen = strlen(partName);
|
nlen = strlen(partName);
|
|
|
while (last >= first) {
|
while (last >= first) {
|
pos = (first+last)/2;
|
pos = (first+last)/2;
|
if (*partName == *ensData->parts[pos]->name) {
|
if (*partName == *ensData->parts[pos]->name) {
|
cmp = strncmp(partName, ensData->parts[pos]->name, nlen);
|
cmp = strncmp(partName, ensData->parts[pos]->name, nlen);
|
if (cmp == 0) {
|
if (cmp == 0) {
|
break; /* found it! */
|
break; /* found it! */
|
}
|
}
|
}
|
}
|
else if (*partName < *ensData->parts[pos]->name) {
|
else if (*partName < *ensData->parts[pos]->name) {
|
cmp = -1;
|
cmp = -1;
|
}
|
}
|
else {
|
else {
|
cmp = 1;
|
cmp = 1;
|
}
|
}
|
|
|
if (cmp > 0) {
|
if (cmp > 0) {
|
first = pos+1;
|
first = pos+1;
|
} else {
|
} else {
|
last = pos-1;
|
last = pos-1;
|
}
|
}
|
}
|
}
|
|
|
/*
|
/*
|
* If a matching entry could not be found, then quit.
|
* If a matching entry could not be found, then quit.
|
*/
|
*/
|
if (last < first) {
|
if (last < first) {
|
return TCL_OK;
|
return TCL_OK;
|
}
|
}
|
|
|
/*
|
/*
|
* If a matching entry was found, there may be some ambiguity
|
* If a matching entry was found, there may be some ambiguity
|
* if the user did not specify enough characters. Find the
|
* if the user did not specify enough characters. Find the
|
* top-most match in the list, and see if the part name has
|
* top-most match in the list, and see if the part name has
|
* enough characters. If there are two parts like "foo"
|
* enough characters. If there are two parts like "foo"
|
* and "food", this allows us to match "foo" exactly.
|
* and "food", this allows us to match "foo" exactly.
|
*/
|
*/
|
if (nlen < ensData->parts[pos]->minChars) {
|
if (nlen < ensData->parts[pos]->minChars) {
|
while (pos > 0) {
|
while (pos > 0) {
|
pos--;
|
pos--;
|
if (strncmp(partName, ensData->parts[pos]->name, nlen) != 0) {
|
if (strncmp(partName, ensData->parts[pos]->name, nlen) != 0) {
|
pos++;
|
pos++;
|
break;
|
break;
|
}
|
}
|
}
|
}
|
}
|
}
|
if (nlen < ensData->parts[pos]->minChars) {
|
if (nlen < ensData->parts[pos]->minChars) {
|
Tcl_Obj *resultPtr = Tcl_NewStringObj((char*)NULL, 0);
|
Tcl_Obj *resultPtr = Tcl_NewStringObj((char*)NULL, 0);
|
|
|
Tcl_AppendStringsToObj(resultPtr,
|
Tcl_AppendStringsToObj(resultPtr,
|
"ambiguous option \"", partName, "\": should be one of...",
|
"ambiguous option \"", partName, "\": should be one of...",
|
(char*)NULL);
|
(char*)NULL);
|
|
|
for (i=pos; i < ensData->numParts; i++) {
|
for (i=pos; i < ensData->numParts; i++) {
|
if (strncmp(partName, ensData->parts[i]->name, nlen) != 0) {
|
if (strncmp(partName, ensData->parts[i]->name, nlen) != 0) {
|
break;
|
break;
|
}
|
}
|
Tcl_AppendToObj(resultPtr, "\n ", 3);
|
Tcl_AppendToObj(resultPtr, "\n ", 3);
|
GetEnsemblePartUsage(ensData->parts[i], resultPtr);
|
GetEnsemblePartUsage(ensData->parts[i], resultPtr);
|
}
|
}
|
Tcl_SetObjResult(interp, resultPtr);
|
Tcl_SetObjResult(interp, resultPtr);
|
return TCL_ERROR;
|
return TCL_ERROR;
|
}
|
}
|
|
|
/*
|
/*
|
* Found a match. Return the desired part.
|
* Found a match. Return the desired part.
|
*/
|
*/
|
*rensPart = ensData->parts[pos];
|
*rensPart = ensData->parts[pos];
|
return TCL_OK;
|
return TCL_OK;
|
}
|
}
|
|
|
|
|
/*
|
/*
|
*----------------------------------------------------------------------
|
*----------------------------------------------------------------------
|
*
|
*
|
* FindEnsemblePartIndex --
|
* FindEnsemblePartIndex --
|
*
|
*
|
* Searches for a part name within an ensemble. The part name
|
* Searches for a part name within an ensemble. The part name
|
* must be an exact match for an existing part name in the
|
* must be an exact match for an existing part name in the
|
* ensemble. This procedure is useful for managing (i.e.,
|
* ensemble. This procedure is useful for managing (i.e.,
|
* creating and deleting) parts in an ensemble.
|
* creating and deleting) parts in an ensemble.
|
*
|
*
|
* Results:
|
* Results:
|
* If an exact match is found, this procedure returns
|
* If an exact match is found, this procedure returns
|
* non-zero, along with the index of the part in posPtr.
|
* non-zero, along with the index of the part in posPtr.
|
* Otherwise, it returns zero, along with an index in posPtr
|
* Otherwise, it returns zero, along with an index in posPtr
|
* indicating where the part should be.
|
* indicating where the part should be.
|
*
|
*
|
* Side effects:
|
* Side effects:
|
* None.
|
* None.
|
*
|
*
|
*----------------------------------------------------------------------
|
*----------------------------------------------------------------------
|
*/
|
*/
|
static int
|
static int
|
FindEnsemblePartIndex(ensData, partName, posPtr)
|
FindEnsemblePartIndex(ensData, partName, posPtr)
|
Ensemble *ensData; /* ensemble being searched */
|
Ensemble *ensData; /* ensemble being searched */
|
char *partName; /* name of desired part */
|
char *partName; /* name of desired part */
|
int *posPtr; /* returns: index for part */
|
int *posPtr; /* returns: index for part */
|
{
|
{
|
int pos = 0;
|
int pos = 0;
|
int first, last;
|
int first, last;
|
int cmp;
|
int cmp;
|
|
|
/*
|
/*
|
* Search for the desired part name.
|
* Search for the desired part name.
|
* All parts are in lexicographical order, so use a
|
* All parts are in lexicographical order, so use a
|
* binary search to find the part quickly.
|
* binary search to find the part quickly.
|
*/
|
*/
|
first = 0;
|
first = 0;
|
last = ensData->numParts-1;
|
last = ensData->numParts-1;
|
|
|
while (last >= first) {
|
while (last >= first) {
|
pos = (first+last)/2;
|
pos = (first+last)/2;
|
if (*partName == *ensData->parts[pos]->name) {
|
if (*partName == *ensData->parts[pos]->name) {
|
cmp = strcmp(partName, ensData->parts[pos]->name);
|
cmp = strcmp(partName, ensData->parts[pos]->name);
|
if (cmp == 0) {
|
if (cmp == 0) {
|
break; /* found it! */
|
break; /* found it! */
|
}
|
}
|
}
|
}
|
else if (*partName < *ensData->parts[pos]->name) {
|
else if (*partName < *ensData->parts[pos]->name) {
|
cmp = -1;
|
cmp = -1;
|
}
|
}
|
else {
|
else {
|
cmp = 1;
|
cmp = 1;
|
}
|
}
|
|
|
if (cmp > 0) {
|
if (cmp > 0) {
|
first = pos+1;
|
first = pos+1;
|
} else {
|
} else {
|
last = pos-1;
|
last = pos-1;
|
}
|
}
|
}
|
}
|
|
|
if (last >= first) {
|
if (last >= first) {
|
*posPtr = pos;
|
*posPtr = pos;
|
return 1;
|
return 1;
|
}
|
}
|
*posPtr = first;
|
*posPtr = first;
|
return 0;
|
return 0;
|
}
|
}
|
|
|
|
|
/*
|
/*
|
*----------------------------------------------------------------------
|
*----------------------------------------------------------------------
|
*
|
*
|
* ComputeMinChars --
|
* ComputeMinChars --
|
*
|
*
|
* Compares part names on an ensemble's part list and
|
* Compares part names on an ensemble's part list and
|
* determines the minimum number of characters needed for a
|
* determines the minimum number of characters needed for a
|
* unique abbreviation. The parts on either side of a
|
* unique abbreviation. The parts on either side of a
|
* particular part index are compared. As long as there is
|
* particular part index are compared. As long as there is
|
* a part on one side or the other, this procedure updates
|
* a part on one side or the other, this procedure updates
|
* the parts to have the proper minimum abbreviations.
|
* the parts to have the proper minimum abbreviations.
|
*
|
*
|
* Results:
|
* Results:
|
* None.
|
* None.
|
*
|
*
|
* Side effects:
|
* Side effects:
|
* Updates three parts within the ensemble to remember
|
* Updates three parts within the ensemble to remember
|
* the minimum abbreviations.
|
* the minimum abbreviations.
|
*
|
*
|
*----------------------------------------------------------------------
|
*----------------------------------------------------------------------
|
*/
|
*/
|
static void
|
static void
|
ComputeMinChars(ensData, pos)
|
ComputeMinChars(ensData, pos)
|
Ensemble *ensData; /* ensemble being modified */
|
Ensemble *ensData; /* ensemble being modified */
|
int pos; /* index of part being updated */
|
int pos; /* index of part being updated */
|
{
|
{
|
int min, max;
|
int min, max;
|
char *p, *q;
|
char *p, *q;
|
|
|
/*
|
/*
|
* If the position is invalid, do nothing.
|
* If the position is invalid, do nothing.
|
*/
|
*/
|
if (pos < 0 || pos >= ensData->numParts) {
|
if (pos < 0 || pos >= ensData->numParts) {
|
return;
|
return;
|
}
|
}
|
|
|
/*
|
/*
|
* Start by assuming that only the first letter is required
|
* Start by assuming that only the first letter is required
|
* to uniquely identify this part. Then compare the name
|
* to uniquely identify this part. Then compare the name
|
* against each neighboring part to determine the real minimum.
|
* against each neighboring part to determine the real minimum.
|
*/
|
*/
|
ensData->parts[pos]->minChars = 1;
|
ensData->parts[pos]->minChars = 1;
|
|
|
if (pos-1 >= 0) {
|
if (pos-1 >= 0) {
|
p = ensData->parts[pos]->name;
|
p = ensData->parts[pos]->name;
|
q = ensData->parts[pos-1]->name;
|
q = ensData->parts[pos-1]->name;
|
for (min=1; *p == *q && *p != '\0' && *q != '\0'; min++) {
|
for (min=1; *p == *q && *p != '\0' && *q != '\0'; min++) {
|
p++;
|
p++;
|
q++;
|
q++;
|
}
|
}
|
if (min > ensData->parts[pos]->minChars) {
|
if (min > ensData->parts[pos]->minChars) {
|
ensData->parts[pos]->minChars = min;
|
ensData->parts[pos]->minChars = min;
|
}
|
}
|
}
|
}
|
|
|
if (pos+1 < ensData->numParts) {
|
if (pos+1 < ensData->numParts) {
|
p = ensData->parts[pos]->name;
|
p = ensData->parts[pos]->name;
|
q = ensData->parts[pos+1]->name;
|
q = ensData->parts[pos+1]->name;
|
for (min=1; *p == *q && *p != '\0' && *q != '\0'; min++) {
|
for (min=1; *p == *q && *p != '\0' && *q != '\0'; min++) {
|
p++;
|
p++;
|
q++;
|
q++;
|
}
|
}
|
if (min > ensData->parts[pos]->minChars) {
|
if (min > ensData->parts[pos]->minChars) {
|
ensData->parts[pos]->minChars = min;
|
ensData->parts[pos]->minChars = min;
|
}
|
}
|
}
|
}
|
|
|
max = strlen(ensData->parts[pos]->name);
|
max = strlen(ensData->parts[pos]->name);
|
if (ensData->parts[pos]->minChars > max) {
|
if (ensData->parts[pos]->minChars > max) {
|
ensData->parts[pos]->minChars = max;
|
ensData->parts[pos]->minChars = max;
|
}
|
}
|
}
|
}
|
|
|
|
|
/*
|
/*
|
*----------------------------------------------------------------------
|
*----------------------------------------------------------------------
|
*
|
*
|
* HandleEnsemble --
|
* HandleEnsemble --
|
*
|
*
|
* Invoked by Tcl whenever the user issues an ensemble-style
|
* Invoked by Tcl whenever the user issues an ensemble-style
|
* command. Handles commands of the form:
|
* command. Handles commands of the form:
|
*
|
*
|
* <ensembleName> <partName> ?<arg> <arg>...?
|
* <ensembleName> <partName> ?<arg> <arg>...?
|
*
|
*
|
* Looks for the <partName> within the ensemble, and if it
|
* Looks for the <partName> within the ensemble, and if it
|
* exists, the procedure transfers control to it.
|
* exists, the procedure transfers control to it.
|
*
|
*
|
* Results:
|
* Results:
|
* Returns TCL_OK if successful, and TCL_ERROR if anything
|
* Returns TCL_OK if successful, and TCL_ERROR if anything
|
* goes wrong.
|
* goes wrong.
|
*
|
*
|
* Side effects:
|
* Side effects:
|
* If anything goes wrong, this procedure returns an error
|
* If anything goes wrong, this procedure returns an error
|
* message as the result in the interpreter.
|
* message as the result in the interpreter.
|
*
|
*
|
*----------------------------------------------------------------------
|
*----------------------------------------------------------------------
|
*/
|
*/
|
static int
|
static int
|
HandleEnsemble(clientData, interp, objc, objv)
|
HandleEnsemble(clientData, interp, objc, objv)
|
ClientData clientData; /* ensemble data */
|
ClientData clientData; /* ensemble data */
|
Tcl_Interp *interp; /* current interpreter */
|
Tcl_Interp *interp; /* current interpreter */
|
int objc; /* number of arguments */
|
int objc; /* number of arguments */
|
Tcl_Obj *CONST objv[]; /* argument objects */
|
Tcl_Obj *CONST objv[]; /* argument objects */
|
{
|
{
|
Ensemble *ensData = (Ensemble*)clientData;
|
Ensemble *ensData = (Ensemble*)clientData;
|
|
|
int i, result;
|
int i, result;
|
Command *cmdPtr;
|
Command *cmdPtr;
|
EnsemblePart *ensPart;
|
EnsemblePart *ensPart;
|
char *partName;
|
char *partName;
|
int partNameLen;
|
int partNameLen;
|
Tcl_Obj *cmdlinePtr, *chainObj;
|
Tcl_Obj *cmdlinePtr, *chainObj;
|
int cmdlinec;
|
int cmdlinec;
|
Tcl_Obj **cmdlinev;
|
Tcl_Obj **cmdlinev;
|
|
|
/*
|
/*
|
* If a part name is not specified, return an error that
|
* If a part name is not specified, return an error that
|
* summarizes the usage for this ensemble.
|
* summarizes the usage for this ensemble.
|
*/
|
*/
|
if (objc < 2) {
|
if (objc < 2) {
|
Tcl_Obj *resultPtr = Tcl_NewStringObj(
|
Tcl_Obj *resultPtr = Tcl_NewStringObj(
|
"wrong # args: should be one of...\n", -1);
|
"wrong # args: should be one of...\n", -1);
|
|
|
GetEnsembleUsage(ensData, resultPtr);
|
GetEnsembleUsage(ensData, resultPtr);
|
Tcl_SetObjResult(interp, resultPtr);
|
Tcl_SetObjResult(interp, resultPtr);
|
return TCL_ERROR;
|
return TCL_ERROR;
|
}
|
}
|
|
|
/*
|
/*
|
* Lookup the desired part. If an ambiguous abbrevition is
|
* Lookup the desired part. If an ambiguous abbrevition is
|
* found, return an error immediately.
|
* found, return an error immediately.
|
*/
|
*/
|
partName = Tcl_GetStringFromObj(objv[1], &partNameLen);
|
partName = Tcl_GetStringFromObj(objv[1], &partNameLen);
|
if (FindEnsemblePart(interp, ensData, partName, &ensPart) != TCL_OK) {
|
if (FindEnsemblePart(interp, ensData, partName, &ensPart) != TCL_OK) {
|
return TCL_ERROR;
|
return TCL_ERROR;
|
}
|
}
|
|
|
/*
|
/*
|
* If the part was not found, then look for an "@error" part
|
* If the part was not found, then look for an "@error" part
|
* to handle the error.
|
* to handle the error.
|
*/
|
*/
|
if (ensPart == NULL) {
|
if (ensPart == NULL) {
|
if (FindEnsemblePart(interp, ensData, "@error", &ensPart) != TCL_OK) {
|
if (FindEnsemblePart(interp, ensData, "@error", &ensPart) != TCL_OK) {
|
return TCL_ERROR;
|
return TCL_ERROR;
|
}
|
}
|
if (ensPart != NULL) {
|
if (ensPart != NULL) {
|
cmdPtr = (Command*)ensPart->cmdPtr;
|
cmdPtr = (Command*)ensPart->cmdPtr;
|
result = (*cmdPtr->objProc)(cmdPtr->objClientData,
|
result = (*cmdPtr->objProc)(cmdPtr->objClientData,
|
interp, objc, objv);
|
interp, objc, objv);
|
return result;
|
return result;
|
}
|
}
|
}
|
}
|
if (ensPart == NULL) {
|
if (ensPart == NULL) {
|
return Itcl_EnsembleErrorCmd((ClientData)ensData,
|
return Itcl_EnsembleErrorCmd((ClientData)ensData,
|
interp, objc-1, objv+1);
|
interp, objc-1, objv+1);
|
}
|
}
|
|
|
/*
|
/*
|
* Pass control to the part, and return the result.
|
* Pass control to the part, and return the result.
|
*/
|
*/
|
chainObj = Tcl_NewObj();
|
chainObj = Tcl_NewObj();
|
chainObj->bytes = NULL;
|
chainObj->bytes = NULL;
|
chainObj->typePtr = &itclEnsInvocType;
|
chainObj->typePtr = &itclEnsInvocType;
|
chainObj->internalRep.twoPtrValue.ptr1 = (VOID *) ensPart;
|
chainObj->internalRep.twoPtrValue.ptr1 = (VOID *) ensPart;
|
Tcl_IncrRefCount(objv[1]);
|
Tcl_IncrRefCount(objv[1]);
|
chainObj->internalRep.twoPtrValue.ptr2 = (VOID *) objv[0];
|
chainObj->internalRep.twoPtrValue.ptr2 = (VOID *) objv[0];
|
Tcl_IncrRefCount(objv[0]);
|
Tcl_IncrRefCount(objv[0]);
|
|
|
cmdlinePtr = Tcl_NewListObj(0, (Tcl_Obj**)NULL);
|
cmdlinePtr = Tcl_NewListObj(0, (Tcl_Obj**)NULL);
|
Tcl_ListObjAppendElement((Tcl_Interp*)NULL, cmdlinePtr, chainObj);
|
Tcl_ListObjAppendElement((Tcl_Interp*)NULL, cmdlinePtr, chainObj);
|
for (i=2; i < objc; i++) {
|
for (i=2; i < objc; i++) {
|
Tcl_ListObjAppendElement((Tcl_Interp*)NULL, cmdlinePtr, objv[i]);
|
Tcl_ListObjAppendElement((Tcl_Interp*)NULL, cmdlinePtr, objv[i]);
|
}
|
}
|
Tcl_IncrRefCount(cmdlinePtr);
|
Tcl_IncrRefCount(cmdlinePtr);
|
|
|
result = Tcl_ListObjGetElements((Tcl_Interp*)NULL, cmdlinePtr,
|
result = Tcl_ListObjGetElements((Tcl_Interp*)NULL, cmdlinePtr,
|
&cmdlinec, &cmdlinev);
|
&cmdlinec, &cmdlinev);
|
|
|
if (result == TCL_OK) {
|
if (result == TCL_OK) {
|
cmdPtr = (Command*)ensPart->cmdPtr;
|
cmdPtr = (Command*)ensPart->cmdPtr;
|
result = (*cmdPtr->objProc)(cmdPtr->objClientData, interp,
|
result = (*cmdPtr->objProc)(cmdPtr->objClientData, interp,
|
cmdlinec, cmdlinev);
|
cmdlinec, cmdlinev);
|
}
|
}
|
Tcl_DecrRefCount(cmdlinePtr);
|
Tcl_DecrRefCount(cmdlinePtr);
|
|
|
return result;
|
return result;
|
}
|
}
|
|
|
|
|
/*
|
/*
|
*----------------------------------------------------------------------
|
*----------------------------------------------------------------------
|
*
|
*
|
* Itcl_EnsembleCmd --
|
* Itcl_EnsembleCmd --
|
*
|
*
|
* Invoked by Tcl whenever the user issues the "ensemble"
|
* Invoked by Tcl whenever the user issues the "ensemble"
|
* command to manipulate an ensemble. Handles the following
|
* command to manipulate an ensemble. Handles the following
|
* syntax:
|
* syntax:
|
*
|
*
|
* ensemble <ensName> ?<command> <arg> <arg>...?
|
* ensemble <ensName> ?<command> <arg> <arg>...?
|
* ensemble <ensName> {
|
* ensemble <ensName> {
|
* part <partName> <args> <body>
|
* part <partName> <args> <body>
|
* ensemble <ensName> {
|
* ensemble <ensName> {
|
* ...
|
* ...
|
* }
|
* }
|
* }
|
* }
|
*
|
*
|
* Finds or creates the ensemble <ensName>, and then executes
|
* Finds or creates the ensemble <ensName>, and then executes
|
* the commands to add parts.
|
* the commands to add parts.
|
*
|
*
|
* Results:
|
* Results:
|
* Returns TCL_OK if successful, and TCL_ERROR if anything
|
* Returns TCL_OK if successful, and TCL_ERROR if anything
|
* goes wrong.
|
* goes wrong.
|
*
|
*
|
* Side effects:
|
* Side effects:
|
* If anything goes wrong, this procedure returns an error
|
* If anything goes wrong, this procedure returns an error
|
* message as the result in the interpreter.
|
* message as the result in the interpreter.
|
*
|
*
|
*----------------------------------------------------------------------
|
*----------------------------------------------------------------------
|
*/
|
*/
|
int
|
int
|
Itcl_EnsembleCmd(clientData, interp, objc, objv)
|
Itcl_EnsembleCmd(clientData, interp, objc, objv)
|
ClientData clientData; /* ensemble data */
|
ClientData clientData; /* ensemble data */
|
Tcl_Interp *interp; /* current interpreter */
|
Tcl_Interp *interp; /* current interpreter */
|
int objc; /* number of arguments */
|
int objc; /* number of arguments */
|
Tcl_Obj *CONST objv[]; /* argument objects */
|
Tcl_Obj *CONST objv[]; /* argument objects */
|
{
|
{
|
int status;
|
int status;
|
char *ensName;
|
char *ensName;
|
EnsembleParser *ensInfo;
|
EnsembleParser *ensInfo;
|
Ensemble *ensData, *savedEnsData;
|
Ensemble *ensData, *savedEnsData;
|
EnsemblePart *ensPart;
|
EnsemblePart *ensPart;
|
Tcl_Command cmd;
|
Tcl_Command cmd;
|
Command *cmdPtr;
|
Command *cmdPtr;
|
Tcl_Obj *objPtr;
|
Tcl_Obj *objPtr;
|
|
|
/*
|
/*
|
* Make sure that an ensemble name was specified.
|
* Make sure that an ensemble name was specified.
|
*/
|
*/
|
if (objc < 2) {
|
if (objc < 2) {
|
Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
|
Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
|
"wrong # args: should be \"",
|
"wrong # args: should be \"",
|
Tcl_GetStringFromObj(objv[0], (int*)NULL),
|
Tcl_GetStringFromObj(objv[0], (int*)NULL),
|
" name ?command arg arg...?\"",
|
" name ?command arg arg...?\"",
|
(char*)NULL);
|
(char*)NULL);
|
return TCL_ERROR;
|
return TCL_ERROR;
|
}
|
}
|
|
|
/*
|
/*
|
* If this is the "ensemble" command in the main interpreter,
|
* If this is the "ensemble" command in the main interpreter,
|
* then the client data will be null. Otherwise, it is
|
* then the client data will be null. Otherwise, it is
|
* the "ensemble" command in the ensemble body parser, and
|
* the "ensemble" command in the ensemble body parser, and
|
* the client data indicates which ensemble we are modifying.
|
* the client data indicates which ensemble we are modifying.
|
*/
|
*/
|
if (clientData) {
|
if (clientData) {
|
ensInfo = (EnsembleParser*)clientData;
|
ensInfo = (EnsembleParser*)clientData;
|
} else {
|
} else {
|
ensInfo = GetEnsembleParser(interp);
|
ensInfo = GetEnsembleParser(interp);
|
}
|
}
|
ensData = ensInfo->ensData;
|
ensData = ensInfo->ensData;
|
|
|
/*
|
/*
|
* Find or create the desired ensemble. If an ensemble is
|
* Find or create the desired ensemble. If an ensemble is
|
* being built, then this "ensemble" command is enclosed in
|
* being built, then this "ensemble" command is enclosed in
|
* another "ensemble" command. Use the current ensemble as
|
* another "ensemble" command. Use the current ensemble as
|
* the parent, and find or create an ensemble part within it.
|
* the parent, and find or create an ensemble part within it.
|
*/
|
*/
|
ensName = Tcl_GetStringFromObj(objv[1], (int*)NULL);
|
ensName = Tcl_GetStringFromObj(objv[1], (int*)NULL);
|
|
|
if (ensData) {
|
if (ensData) {
|
if (FindEnsemblePart(interp, ensData, ensName, &ensPart) != TCL_OK) {
|
if (FindEnsemblePart(interp, ensData, ensName, &ensPart) != TCL_OK) {
|
ensPart = NULL;
|
ensPart = NULL;
|
}
|
}
|
if (ensPart == NULL) {
|
if (ensPart == NULL) {
|
if (CreateEnsemble(interp, ensData, ensName) != TCL_OK) {
|
if (CreateEnsemble(interp, ensData, ensName) != TCL_OK) {
|
return TCL_ERROR;
|
return TCL_ERROR;
|
}
|
}
|
if (FindEnsemblePart(interp, ensData, ensName, &ensPart)
|
if (FindEnsemblePart(interp, ensData, ensName, &ensPart)
|
!= TCL_OK) {
|
!= TCL_OK) {
|
panic("Itcl_EnsembleCmd: can't create ensemble");
|
panic("Itcl_EnsembleCmd: can't create ensemble");
|
}
|
}
|
}
|
}
|
|
|
cmdPtr = (Command*)ensPart->cmdPtr;
|
cmdPtr = (Command*)ensPart->cmdPtr;
|
if (cmdPtr->deleteProc != DeleteEnsemble) {
|
if (cmdPtr->deleteProc != DeleteEnsemble) {
|
Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
|
Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
|
"part \"", Tcl_GetStringFromObj(objv[1], (int*)NULL),
|
"part \"", Tcl_GetStringFromObj(objv[1], (int*)NULL),
|
"\" is not an ensemble",
|
"\" is not an ensemble",
|
(char*)NULL);
|
(char*)NULL);
|
return TCL_ERROR;
|
return TCL_ERROR;
|
}
|
}
|
ensData = (Ensemble*)cmdPtr->objClientData;
|
ensData = (Ensemble*)cmdPtr->objClientData;
|
}
|
}
|
|
|
/*
|
/*
|
* Otherwise, the desired ensemble is a top-level ensemble.
|
* Otherwise, the desired ensemble is a top-level ensemble.
|
* Find or create the access command for the ensemble, and
|
* Find or create the access command for the ensemble, and
|
* then get its data.
|
* then get its data.
|
*/
|
*/
|
else {
|
else {
|
cmd = Tcl_FindCommand(interp, ensName, (Tcl_Namespace*)NULL, 0);
|
cmd = Tcl_FindCommand(interp, ensName, (Tcl_Namespace*)NULL, 0);
|
if (cmd == NULL) {
|
if (cmd == NULL) {
|
if (CreateEnsemble(interp, (Ensemble*)NULL, ensName)
|
if (CreateEnsemble(interp, (Ensemble*)NULL, ensName)
|
!= TCL_OK) {
|
!= TCL_OK) {
|
return TCL_ERROR;
|
return TCL_ERROR;
|
}
|
}
|
cmd = Tcl_FindCommand(interp, ensName, (Tcl_Namespace*)NULL, 0);
|
cmd = Tcl_FindCommand(interp, ensName, (Tcl_Namespace*)NULL, 0);
|
}
|
}
|
cmdPtr = (Command*)cmd;
|
cmdPtr = (Command*)cmd;
|
|
|
if (cmdPtr == NULL || cmdPtr->deleteProc != DeleteEnsemble) {
|
if (cmdPtr == NULL || cmdPtr->deleteProc != DeleteEnsemble) {
|
Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
|
Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
|
"command \"", Tcl_GetStringFromObj(objv[1], (int*)NULL),
|
"command \"", Tcl_GetStringFromObj(objv[1], (int*)NULL),
|
"\" is not an ensemble",
|
"\" is not an ensemble",
|
(char*)NULL);
|
(char*)NULL);
|
return TCL_ERROR;
|
return TCL_ERROR;
|
}
|
}
|
ensData = (Ensemble*)cmdPtr->objClientData;
|
ensData = (Ensemble*)cmdPtr->objClientData;
|
}
|
}
|
|
|
/*
|
/*
|
* At this point, we have the data for the ensemble that is
|
* At this point, we have the data for the ensemble that is
|
* being manipulated. Plug this into the parser, and then
|
* being manipulated. Plug this into the parser, and then
|
* interpret the rest of the arguments in the ensemble parser.
|
* interpret the rest of the arguments in the ensemble parser.
|
*/
|
*/
|
status = TCL_OK;
|
status = TCL_OK;
|
savedEnsData = ensInfo->ensData;
|
savedEnsData = ensInfo->ensData;
|
ensInfo->ensData = ensData;
|
ensInfo->ensData = ensData;
|
|
|
if (objc == 3) {
|
if (objc == 3) {
|
/* CYGNUS LOCAL - fix for Tcl8.1 */
|
/* CYGNUS LOCAL - fix for Tcl8.1 */
|
#if TCL_MAJOR_VERSION == 8 && TCL_MINOR_VERSION == 0
|
#if TCL_MAJOR_VERSION == 8 && TCL_MINOR_VERSION == 0
|
status = Tcl_EvalObj(ensInfo->parser, objv[2]);
|
status = Tcl_EvalObj(ensInfo->parser, objv[2]);
|
#else
|
#else
|
status = Tcl_EvalObj(ensInfo->parser, objv[2], 0);
|
status = Tcl_EvalObj(ensInfo->parser, objv[2], 0);
|
#endif
|
#endif
|
}
|
}
|
else if (objc > 3) {
|
else if (objc > 3) {
|
objPtr = Tcl_NewListObj(objc-2, objv+2);
|
objPtr = Tcl_NewListObj(objc-2, objv+2);
|
#if TCL_MAJOR_VERSION == 8 && TCL_MINOR_VERSION == 0
|
#if TCL_MAJOR_VERSION == 8 && TCL_MINOR_VERSION == 0
|
status = Tcl_EvalObj(ensInfo->parser, objPtr);
|
status = Tcl_EvalObj(ensInfo->parser, objPtr);
|
#else
|
#else
|
Tcl_IncrRefCount(objPtr);
|
Tcl_IncrRefCount(objPtr);
|
status = Tcl_EvalObj(ensInfo->parser, objPtr, 0);
|
status = Tcl_EvalObj(ensInfo->parser, objPtr, 0);
|
#endif
|
#endif
|
/* END CYGNUS LOCAL */
|
/* END CYGNUS LOCAL */
|
Tcl_DecrRefCount(objPtr); /* we're done with the object */
|
Tcl_DecrRefCount(objPtr); /* we're done with the object */
|
}
|
}
|
|
|
/*
|
/*
|
* Copy the result from the parser interpreter to the
|
* Copy the result from the parser interpreter to the
|
* master interpreter. If an error was encountered,
|
* master interpreter. If an error was encountered,
|
* copy the error info first, and then set the result.
|
* copy the error info first, and then set the result.
|
* Otherwise, the offending command is reported twice.
|
* Otherwise, the offending command is reported twice.
|
*/
|
*/
|
if (status == TCL_ERROR) {
|
if (status == TCL_ERROR) {
|
char *errInfo = Tcl_GetVar2(ensInfo->parser, "::errorInfo",
|
char *errInfo = Tcl_GetVar2(ensInfo->parser, "::errorInfo",
|
(char*)NULL, TCL_GLOBAL_ONLY);
|
(char*)NULL, TCL_GLOBAL_ONLY);
|
|
|
if (errInfo) {
|
if (errInfo) {
|
Tcl_AddObjErrorInfo(interp, errInfo, -1);
|
Tcl_AddObjErrorInfo(interp, errInfo, -1);
|
}
|
}
|
|
|
if (objc == 3) {
|
if (objc == 3) {
|
char msg[128];
|
char msg[128];
|
sprintf(msg, "\n (\"ensemble\" body line %d)",
|
sprintf(msg, "\n (\"ensemble\" body line %d)",
|
ensInfo->parser->errorLine);
|
ensInfo->parser->errorLine);
|
Tcl_AddObjErrorInfo(interp, msg, -1);
|
Tcl_AddObjErrorInfo(interp, msg, -1);
|
}
|
}
|
}
|
}
|
Tcl_SetObjResult(interp, Tcl_GetObjResult(ensInfo->parser));
|
Tcl_SetObjResult(interp, Tcl_GetObjResult(ensInfo->parser));
|
|
|
ensInfo->ensData = savedEnsData;
|
ensInfo->ensData = savedEnsData;
|
return status;
|
return status;
|
}
|
}
|
|
|
|
|
/*
|
/*
|
*----------------------------------------------------------------------
|
*----------------------------------------------------------------------
|
*
|
*
|
* GetEnsembleParser --
|
* GetEnsembleParser --
|
*
|
*
|
* Returns the slave interpreter that acts as a parser for
|
* Returns the slave interpreter that acts as a parser for
|
* the body of an "ensemble" definition. The first time that
|
* the body of an "ensemble" definition. The first time that
|
* this is called for an interpreter, the parser is created
|
* this is called for an interpreter, the parser is created
|
* and registered as associated data. After that, it is
|
* and registered as associated data. After that, it is
|
* simply returned.
|
* simply returned.
|
*
|
*
|
* Results:
|
* Results:
|
* Returns a pointer to the ensemble parser data structure.
|
* Returns a pointer to the ensemble parser data structure.
|
*
|
*
|
* Side effects:
|
* Side effects:
|
* On the first call, the ensemble parser is created and
|
* On the first call, the ensemble parser is created and
|
* registered as "itcl_ensembleParser" with the interpreter.
|
* registered as "itcl_ensembleParser" with the interpreter.
|
*
|
*
|
*----------------------------------------------------------------------
|
*----------------------------------------------------------------------
|
*/
|
*/
|
static EnsembleParser*
|
static EnsembleParser*
|
GetEnsembleParser(interp)
|
GetEnsembleParser(interp)
|
Tcl_Interp *interp; /* interpreter handling the ensemble */
|
Tcl_Interp *interp; /* interpreter handling the ensemble */
|
{
|
{
|
Namespace *nsPtr;
|
Namespace *nsPtr;
|
Tcl_Namespace *childNs;
|
Tcl_Namespace *childNs;
|
EnsembleParser *ensInfo;
|
EnsembleParser *ensInfo;
|
Tcl_HashEntry *hPtr;
|
Tcl_HashEntry *hPtr;
|
Tcl_HashSearch search;
|
Tcl_HashSearch search;
|
Tcl_Command cmd;
|
Tcl_Command cmd;
|
|
|
/*
|
/*
|
* Look for an existing ensemble parser. If it is found,
|
* Look for an existing ensemble parser. If it is found,
|
* return it immediately.
|
* return it immediately.
|
*/
|
*/
|
ensInfo = (EnsembleParser*) Tcl_GetAssocData(interp,
|
ensInfo = (EnsembleParser*) Tcl_GetAssocData(interp,
|
"itcl_ensembleParser", NULL);
|
"itcl_ensembleParser", NULL);
|
|
|
if (ensInfo) {
|
if (ensInfo) {
|
return ensInfo;
|
return ensInfo;
|
}
|
}
|
|
|
/*
|
/*
|
* Create a slave interpreter that can be used to parse
|
* Create a slave interpreter that can be used to parse
|
* the body of an ensemble definition.
|
* the body of an ensemble definition.
|
*/
|
*/
|
ensInfo = (EnsembleParser*)ckalloc(sizeof(EnsembleParser));
|
ensInfo = (EnsembleParser*)ckalloc(sizeof(EnsembleParser));
|
ensInfo->master = interp;
|
ensInfo->master = interp;
|
ensInfo->parser = Tcl_CreateInterp();
|
ensInfo->parser = Tcl_CreateInterp();
|
ensInfo->ensData = NULL;
|
ensInfo->ensData = NULL;
|
|
|
/*
|
/*
|
* Remove all namespaces and all normal commands from the
|
* Remove all namespaces and all normal commands from the
|
* parser interpreter.
|
* parser interpreter.
|
*/
|
*/
|
nsPtr = (Namespace*)Tcl_GetGlobalNamespace(ensInfo->parser);
|
nsPtr = (Namespace*)Tcl_GetGlobalNamespace(ensInfo->parser);
|
|
|
for (hPtr = Tcl_FirstHashEntry(&nsPtr->childTable, &search);
|
for (hPtr = Tcl_FirstHashEntry(&nsPtr->childTable, &search);
|
hPtr != NULL;
|
hPtr != NULL;
|
hPtr = Tcl_FirstHashEntry(&nsPtr->childTable, &search)) {
|
hPtr = Tcl_FirstHashEntry(&nsPtr->childTable, &search)) {
|
|
|
childNs = (Tcl_Namespace*)Tcl_GetHashValue(hPtr);
|
childNs = (Tcl_Namespace*)Tcl_GetHashValue(hPtr);
|
Tcl_DeleteNamespace(childNs);
|
Tcl_DeleteNamespace(childNs);
|
}
|
}
|
|
|
for (hPtr = Tcl_FirstHashEntry(&nsPtr->cmdTable, &search);
|
for (hPtr = Tcl_FirstHashEntry(&nsPtr->cmdTable, &search);
|
hPtr != NULL;
|
hPtr != NULL;
|
hPtr = Tcl_FirstHashEntry(&nsPtr->cmdTable, &search)) {
|
hPtr = Tcl_FirstHashEntry(&nsPtr->cmdTable, &search)) {
|
|
|
cmd = (Tcl_Command)Tcl_GetHashValue(hPtr);
|
cmd = (Tcl_Command)Tcl_GetHashValue(hPtr);
|
Tcl_DeleteCommandFromToken(ensInfo->parser, cmd);
|
Tcl_DeleteCommandFromToken(ensInfo->parser, cmd);
|
}
|
}
|
|
|
/*
|
/*
|
* Add the allowed commands to the parser interpreter:
|
* Add the allowed commands to the parser interpreter:
|
* part, delete, ensemble
|
* part, delete, ensemble
|
*/
|
*/
|
Tcl_CreateObjCommand(ensInfo->parser, "part", Itcl_EnsPartCmd,
|
Tcl_CreateObjCommand(ensInfo->parser, "part", Itcl_EnsPartCmd,
|
(ClientData)ensInfo, (Tcl_CmdDeleteProc*)NULL);
|
(ClientData)ensInfo, (Tcl_CmdDeleteProc*)NULL);
|
|
|
Tcl_CreateObjCommand(ensInfo->parser, "option", Itcl_EnsPartCmd,
|
Tcl_CreateObjCommand(ensInfo->parser, "option", Itcl_EnsPartCmd,
|
(ClientData)ensInfo, (Tcl_CmdDeleteProc*)NULL);
|
(ClientData)ensInfo, (Tcl_CmdDeleteProc*)NULL);
|
|
|
Tcl_CreateObjCommand(ensInfo->parser, "ensemble", Itcl_EnsembleCmd,
|
Tcl_CreateObjCommand(ensInfo->parser, "ensemble", Itcl_EnsembleCmd,
|
(ClientData)ensInfo, (Tcl_CmdDeleteProc*)NULL);
|
(ClientData)ensInfo, (Tcl_CmdDeleteProc*)NULL);
|
|
|
/*
|
/*
|
* Install the parser data, so we'll have it the next time
|
* Install the parser data, so we'll have it the next time
|
* we call this procedure.
|
* we call this procedure.
|
*/
|
*/
|
(void) Tcl_SetAssocData(interp, "itcl_ensembleParser",
|
(void) Tcl_SetAssocData(interp, "itcl_ensembleParser",
|
DeleteEnsParser, (ClientData)ensInfo);
|
DeleteEnsParser, (ClientData)ensInfo);
|
|
|
return ensInfo;
|
return ensInfo;
|
}
|
}
|
|
|
|
|
/*
|
/*
|
*----------------------------------------------------------------------
|
*----------------------------------------------------------------------
|
*
|
*
|
* DeleteEnsParser --
|
* DeleteEnsParser --
|
*
|
*
|
* Called when an interpreter is destroyed to clean up the
|
* Called when an interpreter is destroyed to clean up the
|
* ensemble parser within it. Destroys the slave interpreter
|
* ensemble parser within it. Destroys the slave interpreter
|
* and frees up the data associated with it.
|
* and frees up the data associated with it.
|
*
|
*
|
* Results:
|
* Results:
|
* None.
|
* None.
|
*
|
*
|
* Side effects:
|
* Side effects:
|
* None.
|
* None.
|
*
|
*
|
*----------------------------------------------------------------------
|
*----------------------------------------------------------------------
|
*/
|
*/
|
/* ARGSUSED */
|
/* ARGSUSED */
|
static void
|
static void
|
DeleteEnsParser(clientData, interp)
|
DeleteEnsParser(clientData, interp)
|
ClientData clientData; /* client data for ensemble-related commands */
|
ClientData clientData; /* client data for ensemble-related commands */
|
Tcl_Interp *interp; /* interpreter containing the data */
|
Tcl_Interp *interp; /* interpreter containing the data */
|
{
|
{
|
EnsembleParser* ensInfo = (EnsembleParser*)clientData;
|
EnsembleParser* ensInfo = (EnsembleParser*)clientData;
|
Tcl_DeleteInterp(ensInfo->parser);
|
Tcl_DeleteInterp(ensInfo->parser);
|
ckfree((char*)ensInfo);
|
ckfree((char*)ensInfo);
|
}
|
}
|
|
|
|
|
/*
|
/*
|
*----------------------------------------------------------------------
|
*----------------------------------------------------------------------
|
*
|
*
|
* Itcl_EnsPartCmd --
|
* Itcl_EnsPartCmd --
|
*
|
*
|
* Invoked by Tcl whenever the user issues the "part" command
|
* Invoked by Tcl whenever the user issues the "part" command
|
* to manipulate an ensemble. This command can only be used
|
* to manipulate an ensemble. This command can only be used
|
* inside the "ensemble" command, which handles ensembles.
|
* inside the "ensemble" command, which handles ensembles.
|
* Handles the following syntax:
|
* Handles the following syntax:
|
*
|
*
|
* ensemble <ensName> {
|
* ensemble <ensName> {
|
* part <partName> <args> <body>
|
* part <partName> <args> <body>
|
* }
|
* }
|
*
|
*
|
* Adds a new part called <partName> to the ensemble. If a
|
* Adds a new part called <partName> to the ensemble. If a
|
* part already exists with that name, it is an error. The
|
* part already exists with that name, it is an error. The
|
* new part is handled just like an ordinary Tcl proc, with
|
* new part is handled just like an ordinary Tcl proc, with
|
* a list of <args> and a <body> of code to execute.
|
* a list of <args> and a <body> of code to execute.
|
*
|
*
|
* Results:
|
* Results:
|
* Returns TCL_OK if successful, and TCL_ERROR if anything
|
* Returns TCL_OK if successful, and TCL_ERROR if anything
|
* goes wrong.
|
* goes wrong.
|
*
|
*
|
* Side effects:
|
* Side effects:
|
* If anything goes wrong, this procedure returns an error
|
* If anything goes wrong, this procedure returns an error
|
* message as the result in the interpreter.
|
* message as the result in the interpreter.
|
*
|
*
|
*----------------------------------------------------------------------
|
*----------------------------------------------------------------------
|
*/
|
*/
|
int
|
int
|
Itcl_EnsPartCmd(clientData, interp, objc, objv)
|
Itcl_EnsPartCmd(clientData, interp, objc, objv)
|
ClientData clientData; /* ensemble data */
|
ClientData clientData; /* ensemble data */
|
Tcl_Interp *interp; /* current interpreter */
|
Tcl_Interp *interp; /* current interpreter */
|
int objc; /* number of arguments */
|
int objc; /* number of arguments */
|
Tcl_Obj *CONST objv[]; /* argument objects */
|
Tcl_Obj *CONST objv[]; /* argument objects */
|
{
|
{
|
EnsembleParser *ensInfo = (EnsembleParser*)clientData;
|
EnsembleParser *ensInfo = (EnsembleParser*)clientData;
|
Ensemble *ensData = (Ensemble*)ensInfo->ensData;
|
Ensemble *ensData = (Ensemble*)ensInfo->ensData;
|
|
|
int status, varArgs, space;
|
int status, varArgs, space;
|
char *partName, *usage;
|
char *partName, *usage;
|
Proc *procPtr;
|
Proc *procPtr;
|
Command *cmdPtr;
|
Command *cmdPtr;
|
CompiledLocal *localPtr;
|
CompiledLocal *localPtr;
|
EnsemblePart *ensPart;
|
EnsemblePart *ensPart;
|
Tcl_DString buffer;
|
Tcl_DString buffer;
|
|
|
if (objc != 4) {
|
if (objc != 4) {
|
Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
|
Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
|
"wrong # args: should be \"",
|
"wrong # args: should be \"",
|
Tcl_GetStringFromObj(objv[0], (int*)NULL),
|
Tcl_GetStringFromObj(objv[0], (int*)NULL),
|
" name args body\"",
|
" name args body\"",
|
(char*)NULL);
|
(char*)NULL);
|
return TCL_ERROR;
|
return TCL_ERROR;
|
}
|
}
|
|
|
/*
|
/*
|
* Create a Tcl-style proc definition using the specified args
|
* Create a Tcl-style proc definition using the specified args
|
* and body. This is not a proc in the usual sense. It belongs
|
* and body. This is not a proc in the usual sense. It belongs
|
* to the namespace that contains the ensemble, but it is
|
* to the namespace that contains the ensemble, but it is
|
* accessed through the ensemble, not through a Tcl command.
|
* accessed through the ensemble, not through a Tcl command.
|
*/
|
*/
|
partName = Tcl_GetStringFromObj(objv[1], (int*)NULL);
|
partName = Tcl_GetStringFromObj(objv[1], (int*)NULL);
|
cmdPtr = (Command*)ensData->cmd;
|
cmdPtr = (Command*)ensData->cmd;
|
|
|
if (TclCreateProc(interp, cmdPtr->nsPtr, partName, objv[2], objv[3],
|
if (TclCreateProc(interp, cmdPtr->nsPtr, partName, objv[2], objv[3],
|
&procPtr) != TCL_OK) {
|
&procPtr) != TCL_OK) {
|
return TCL_ERROR;
|
return TCL_ERROR;
|
}
|
}
|
|
|
/*
|
/*
|
* Deduce the usage information from the argument list.
|
* Deduce the usage information from the argument list.
|
* We'll register this when we create the part, in a moment.
|
* We'll register this when we create the part, in a moment.
|
*/
|
*/
|
Tcl_DStringInit(&buffer);
|
Tcl_DStringInit(&buffer);
|
varArgs = 0;
|
varArgs = 0;
|
space = 0;
|
space = 0;
|
|
|
for (localPtr=procPtr->firstLocalPtr;
|
for (localPtr=procPtr->firstLocalPtr;
|
localPtr != NULL;
|
localPtr != NULL;
|
localPtr=localPtr->nextPtr) {
|
localPtr=localPtr->nextPtr) {
|
|
|
if (TclIsVarArgument(localPtr)) {
|
if (TclIsVarArgument(localPtr)) {
|
varArgs = 0;
|
varArgs = 0;
|
if (strcmp(localPtr->name, "args") == 0) {
|
if (strcmp(localPtr->name, "args") == 0) {
|
varArgs = 1;
|
varArgs = 1;
|
}
|
}
|
else if (localPtr->defValuePtr) {
|
else if (localPtr->defValuePtr) {
|
if (space) {
|
if (space) {
|
Tcl_DStringAppend(&buffer, " ", 1);
|
Tcl_DStringAppend(&buffer, " ", 1);
|
}
|
}
|
Tcl_DStringAppend(&buffer, "?", 1);
|
Tcl_DStringAppend(&buffer, "?", 1);
|
Tcl_DStringAppend(&buffer, localPtr->name, -1);
|
Tcl_DStringAppend(&buffer, localPtr->name, -1);
|
Tcl_DStringAppend(&buffer, "?", 1);
|
Tcl_DStringAppend(&buffer, "?", 1);
|
space = 1;
|
space = 1;
|
}
|
}
|
else {
|
else {
|
if (space) {
|
if (space) {
|
Tcl_DStringAppend(&buffer, " ", 1);
|
Tcl_DStringAppend(&buffer, " ", 1);
|
}
|
}
|
Tcl_DStringAppend(&buffer, localPtr->name, -1);
|
Tcl_DStringAppend(&buffer, localPtr->name, -1);
|
space = 1;
|
space = 1;
|
}
|
}
|
}
|
}
|
}
|
}
|
if (varArgs) {
|
if (varArgs) {
|
if (space) {
|
if (space) {
|
Tcl_DStringAppend(&buffer, " ", 1);
|
Tcl_DStringAppend(&buffer, " ", 1);
|
}
|
}
|
Tcl_DStringAppend(&buffer, "?arg arg ...?", 13);
|
Tcl_DStringAppend(&buffer, "?arg arg ...?", 13);
|
}
|
}
|
|
|
usage = Tcl_DStringValue(&buffer);
|
usage = Tcl_DStringValue(&buffer);
|
|
|
/*
|
/*
|
* Create a new part within the ensemble. If successful,
|
* Create a new part within the ensemble. If successful,
|
* plug the command token into the proc; we'll need it later
|
* plug the command token into the proc; we'll need it later
|
* if we try to compile the Tcl code for the part. If
|
* if we try to compile the Tcl code for the part. If
|
* anything goes wrong, clean up before bailing out.
|
* anything goes wrong, clean up before bailing out.
|
*/
|
*/
|
status = AddEnsemblePart(interp, ensData, partName, usage,
|
status = AddEnsemblePart(interp, ensData, partName, usage,
|
TclObjInterpProc, (ClientData)procPtr, TclProcDeleteProc,
|
TclObjInterpProc, (ClientData)procPtr, TclProcDeleteProc,
|
&ensPart);
|
&ensPart);
|
|
|
if (status == TCL_OK) {
|
if (status == TCL_OK) {
|
procPtr->cmdPtr = ensPart->cmdPtr;
|
procPtr->cmdPtr = ensPart->cmdPtr;
|
} else {
|
} else {
|
TclProcDeleteProc((ClientData)procPtr);
|
TclProcDeleteProc((ClientData)procPtr);
|
}
|
}
|
Tcl_DStringFree(&buffer);
|
Tcl_DStringFree(&buffer);
|
|
|
return status;
|
return status;
|
}
|
}
|
|
|
|
|
/*
|
/*
|
*----------------------------------------------------------------------
|
*----------------------------------------------------------------------
|
*
|
*
|
* Itcl_EnsembleErrorCmd --
|
* Itcl_EnsembleErrorCmd --
|
*
|
*
|
* Invoked when the user tries to access an unknown part for
|
* Invoked when the user tries to access an unknown part for
|
* an ensemble. Acts as the default handler for the "@error"
|
* an ensemble. Acts as the default handler for the "@error"
|
* part. Generates an error message like:
|
* part. Generates an error message like:
|
*
|
*
|
* bad option "foo": should be one of...
|
* bad option "foo": should be one of...
|
* info args procname
|
* info args procname
|
* info body procname
|
* info body procname
|
* info cmdcount
|
* info cmdcount
|
* ...
|
* ...
|
*
|
*
|
* Results:
|
* Results:
|
* Always returns TCL_OK.
|
* Always returns TCL_OK.
|
*
|
*
|
* Side effects:
|
* Side effects:
|
* Returns the error message as the result in the interpreter.
|
* Returns the error message as the result in the interpreter.
|
*
|
*
|
*----------------------------------------------------------------------
|
*----------------------------------------------------------------------
|
*/
|
*/
|
/* ARGSUSED */
|
/* ARGSUSED */
|
int
|
int
|
Itcl_EnsembleErrorCmd(clientData, interp, objc, objv)
|
Itcl_EnsembleErrorCmd(clientData, interp, objc, objv)
|
ClientData clientData; /* ensemble info */
|
ClientData clientData; /* ensemble info */
|
Tcl_Interp *interp; /* current interpreter */
|
Tcl_Interp *interp; /* current interpreter */
|
int objc; /* number of arguments */
|
int objc; /* number of arguments */
|
Tcl_Obj *CONST objv[]; /* argument objects */
|
Tcl_Obj *CONST objv[]; /* argument objects */
|
{
|
{
|
Ensemble *ensData = (Ensemble*)clientData;
|
Ensemble *ensData = (Ensemble*)clientData;
|
|
|
char *cmdName;
|
char *cmdName;
|
Tcl_Obj *objPtr;
|
Tcl_Obj *objPtr;
|
|
|
cmdName = Tcl_GetStringFromObj(objv[0], (int*)NULL);
|
cmdName = Tcl_GetStringFromObj(objv[0], (int*)NULL);
|
|
|
objPtr = Tcl_NewStringObj((char*)NULL, 0);
|
objPtr = Tcl_NewStringObj((char*)NULL, 0);
|
Tcl_AppendStringsToObj(objPtr,
|
Tcl_AppendStringsToObj(objPtr,
|
"bad option \"", cmdName, "\": should be one of...\n",
|
"bad option \"", cmdName, "\": should be one of...\n",
|
(char*)NULL);
|
(char*)NULL);
|
GetEnsembleUsage(ensData, objPtr);
|
GetEnsembleUsage(ensData, objPtr);
|
|
|
Tcl_SetObjResult(interp, objPtr);
|
Tcl_SetObjResult(interp, objPtr);
|
return TCL_ERROR;
|
return TCL_ERROR;
|
}
|
}
|
|
|
|
|
/*
|
/*
|
*----------------------------------------------------------------------
|
*----------------------------------------------------------------------
|
*
|
*
|
* FreeEnsInvocInternalRep --
|
* FreeEnsInvocInternalRep --
|
*
|
*
|
* Frees the resources associated with an ensembleInvoc object's
|
* Frees the resources associated with an ensembleInvoc object's
|
* internal representation.
|
* internal representation.
|
*
|
*
|
* Results:
|
* Results:
|
* None.
|
* None.
|
*
|
*
|
* Side effects:
|
* Side effects:
|
* Decrements the ref count of the two objects referenced by
|
* Decrements the ref count of the two objects referenced by
|
* this object. If there are no more uses, this will free
|
* this object. If there are no more uses, this will free
|
* the other objects.
|
* the other objects.
|
*
|
*
|
*----------------------------------------------------------------------
|
*----------------------------------------------------------------------
|
*/
|
*/
|
static void
|
static void
|
FreeEnsInvocInternalRep(objPtr)
|
FreeEnsInvocInternalRep(objPtr)
|
register Tcl_Obj *objPtr; /* namespName object with internal
|
register Tcl_Obj *objPtr; /* namespName object with internal
|
* representation to free */
|
* representation to free */
|
{
|
{
|
Tcl_Obj *prevArgObj = (Tcl_Obj*)objPtr->internalRep.twoPtrValue.ptr2;
|
Tcl_Obj *prevArgObj = (Tcl_Obj*)objPtr->internalRep.twoPtrValue.ptr2;
|
|
|
if (prevArgObj) {
|
if (prevArgObj) {
|
Tcl_DecrRefCount(prevArgObj);
|
Tcl_DecrRefCount(prevArgObj);
|
}
|
}
|
}
|
}
|
|
|
|
|
/*
|
/*
|
*----------------------------------------------------------------------
|
*----------------------------------------------------------------------
|
*
|
*
|
* DupEnsInvocInternalRep --
|
* DupEnsInvocInternalRep --
|
*
|
*
|
* Initializes the internal representation of an ensembleInvoc
|
* Initializes the internal representation of an ensembleInvoc
|
* object to a copy of the internal representation of
|
* object to a copy of the internal representation of
|
* another ensembleInvoc object.
|
* another ensembleInvoc object.
|
*
|
*
|
* This shouldn't be called. Normally, a temporary ensembleInvoc
|
* This shouldn't be called. Normally, a temporary ensembleInvoc
|
* object is created while an ensemble call is in progress.
|
* object is created while an ensemble call is in progress.
|
* This object may be converted to string form if an error occurs.
|
* This object may be converted to string form if an error occurs.
|
* It does not stay around long, and there is no reason for it
|
* It does not stay around long, and there is no reason for it
|
* to be duplicated.
|
* to be duplicated.
|
*
|
*
|
* Results:
|
* Results:
|
* None.
|
* None.
|
*
|
*
|
* Side effects:
|
* Side effects:
|
* copyPtr's internal rep is set to duplicates of the objects
|
* copyPtr's internal rep is set to duplicates of the objects
|
* pointed to by srcPtr's internal rep.
|
* pointed to by srcPtr's internal rep.
|
*
|
*
|
*----------------------------------------------------------------------
|
*----------------------------------------------------------------------
|
*/
|
*/
|
static void
|
static void
|
DupEnsInvocInternalRep(srcPtr, copyPtr)
|
DupEnsInvocInternalRep(srcPtr, copyPtr)
|
Tcl_Obj *srcPtr; /* Object with internal rep to copy. */
|
Tcl_Obj *srcPtr; /* Object with internal rep to copy. */
|
register Tcl_Obj *copyPtr; /* Object with internal rep to set. */
|
register Tcl_Obj *copyPtr; /* Object with internal rep to set. */
|
{
|
{
|
EnsemblePart *ensPart = (EnsemblePart*)srcPtr->internalRep.twoPtrValue.ptr1;
|
EnsemblePart *ensPart = (EnsemblePart*)srcPtr->internalRep.twoPtrValue.ptr1;
|
Tcl_Obj *prevArgObj = (Tcl_Obj*)srcPtr->internalRep.twoPtrValue.ptr2;
|
Tcl_Obj *prevArgObj = (Tcl_Obj*)srcPtr->internalRep.twoPtrValue.ptr2;
|
Tcl_Obj *objPtr;
|
Tcl_Obj *objPtr;
|
|
|
copyPtr->internalRep.twoPtrValue.ptr1 = (VOID *) ensPart;
|
copyPtr->internalRep.twoPtrValue.ptr1 = (VOID *) ensPart;
|
|
|
if (prevArgObj) {
|
if (prevArgObj) {
|
objPtr = Tcl_DuplicateObj(prevArgObj);
|
objPtr = Tcl_DuplicateObj(prevArgObj);
|
copyPtr->internalRep.twoPtrValue.ptr2 = (VOID *) objPtr;
|
copyPtr->internalRep.twoPtrValue.ptr2 = (VOID *) objPtr;
|
}
|
}
|
}
|
}
|
|
|
|
|
/*
|
/*
|
*----------------------------------------------------------------------
|
*----------------------------------------------------------------------
|
*
|
*
|
* SetEnsInvocFromAny --
|
* SetEnsInvocFromAny --
|
*
|
*
|
* Generates the internal representation for an ensembleInvoc
|
* Generates the internal representation for an ensembleInvoc
|
* object. This conversion really shouldn't take place.
|
* object. This conversion really shouldn't take place.
|
* Normally, a temporary ensembleInvoc object is created while
|
* Normally, a temporary ensembleInvoc object is created while
|
* an ensemble call is in progress. This object may be converted
|
* an ensemble call is in progress. This object may be converted
|
* to string form if an error occurs. But there is no reason
|
* to string form if an error occurs. But there is no reason
|
* for any other object to be converted to ensembleInvoc form.
|
* for any other object to be converted to ensembleInvoc form.
|
*
|
*
|
* Results:
|
* Results:
|
* Always returns TCL_OK.
|
* Always returns TCL_OK.
|
*
|
*
|
* Side effects:
|
* Side effects:
|
* The string representation is saved as if it were the
|
* The string representation is saved as if it were the
|
* command line argument for the ensemble invocation. The
|
* command line argument for the ensemble invocation. The
|
* reference to the ensemble part is set to NULL.
|
* reference to the ensemble part is set to NULL.
|
*
|
*
|
*----------------------------------------------------------------------
|
*----------------------------------------------------------------------
|
*/
|
*/
|
static int
|
static int
|
SetEnsInvocFromAny(interp, objPtr)
|
SetEnsInvocFromAny(interp, objPtr)
|
Tcl_Interp *interp; /* Determines the context for
|
Tcl_Interp *interp; /* Determines the context for
|
name resolution */
|
name resolution */
|
register Tcl_Obj *objPtr; /* The object to convert */
|
register Tcl_Obj *objPtr; /* The object to convert */
|
{
|
{
|
int length;
|
int length;
|
char *name;
|
char *name;
|
Tcl_Obj *argObj;
|
Tcl_Obj *argObj;
|
|
|
/*
|
/*
|
* Get objPtr's string representation.
|
* Get objPtr's string representation.
|
* Make it up-to-date if necessary.
|
* Make it up-to-date if necessary.
|
* THIS FAILS IF THE OBJECT'S STRING REP CONTAINS NULLS.
|
* THIS FAILS IF THE OBJECT'S STRING REP CONTAINS NULLS.
|
*/
|
*/
|
name = Tcl_GetStringFromObj(objPtr, &length);
|
name = Tcl_GetStringFromObj(objPtr, &length);
|
|
|
/*
|
/*
|
* Make an argument object to contain the string, and
|
* Make an argument object to contain the string, and
|
* set the ensemble part definition to NULL. At this point,
|
* set the ensemble part definition to NULL. At this point,
|
* we don't know anything about an ensemble, so we'll just
|
* we don't know anything about an ensemble, so we'll just
|
* keep the string around as if it were the command line
|
* keep the string around as if it were the command line
|
* invocation.
|
* invocation.
|
*/
|
*/
|
argObj = Tcl_NewStringObj(name, -1);
|
argObj = Tcl_NewStringObj(name, -1);
|
|
|
/*
|
/*
|
* Free the old representation and install a new one.
|
* Free the old representation and install a new one.
|
*/
|
*/
|
if (objPtr->typePtr && objPtr->typePtr->freeIntRepProc != NULL) {
|
if (objPtr->typePtr && objPtr->typePtr->freeIntRepProc != NULL) {
|
(*objPtr->typePtr->freeIntRepProc)(objPtr);
|
(*objPtr->typePtr->freeIntRepProc)(objPtr);
|
}
|
}
|
objPtr->internalRep.twoPtrValue.ptr1 = (VOID *) NULL;
|
objPtr->internalRep.twoPtrValue.ptr1 = (VOID *) NULL;
|
objPtr->internalRep.twoPtrValue.ptr2 = (VOID *) argObj;
|
objPtr->internalRep.twoPtrValue.ptr2 = (VOID *) argObj;
|
objPtr->typePtr = &itclEnsInvocType;
|
objPtr->typePtr = &itclEnsInvocType;
|
|
|
return TCL_OK;
|
return TCL_OK;
|
}
|
}
|
|
|
|
|
/*
|
/*
|
*----------------------------------------------------------------------
|
*----------------------------------------------------------------------
|
*
|
*
|
* UpdateStringOfEnsInvoc --
|
* UpdateStringOfEnsInvoc --
|
*
|
*
|
* Updates the string representation for an ensembleInvoc object.
|
* Updates the string representation for an ensembleInvoc object.
|
* This is called when an error occurs in an ensemble part, when
|
* This is called when an error occurs in an ensemble part, when
|
* the code tries to print objv[0] as the command name. This
|
* the code tries to print objv[0] as the command name. This
|
* code automatically chains together all of the names leading
|
* code automatically chains together all of the names leading
|
* to the ensemble part, so the error message references the
|
* to the ensemble part, so the error message references the
|
* entire command, not just the part name.
|
* entire command, not just the part name.
|
*
|
*
|
* Note: This procedure does not free an existing old string rep
|
* Note: This procedure does not free an existing old string rep
|
* so storage will be lost if this has not already been done.
|
* so storage will be lost if this has not already been done.
|
*
|
*
|
* Results:
|
* Results:
|
* None.
|
* None.
|
*
|
*
|
* Side effects:
|
* Side effects:
|
* The object's string is set to the full command name for
|
* The object's string is set to the full command name for
|
* the ensemble part.
|
* the ensemble part.
|
*
|
*
|
*----------------------------------------------------------------------
|
*----------------------------------------------------------------------
|
*/
|
*/
|
static void
|
static void
|
UpdateStringOfEnsInvoc(objPtr)
|
UpdateStringOfEnsInvoc(objPtr)
|
register Tcl_Obj *objPtr; /* NamespName obj to update string rep. */
|
register Tcl_Obj *objPtr; /* NamespName obj to update string rep. */
|
{
|
{
|
EnsemblePart *ensPart = (EnsemblePart*)objPtr->internalRep.twoPtrValue.ptr1;
|
EnsemblePart *ensPart = (EnsemblePart*)objPtr->internalRep.twoPtrValue.ptr1;
|
Tcl_Obj *prevArgObj = (Tcl_Obj*)objPtr->internalRep.twoPtrValue.ptr2;
|
Tcl_Obj *prevArgObj = (Tcl_Obj*)objPtr->internalRep.twoPtrValue.ptr2;
|
|
|
Tcl_DString buffer;
|
Tcl_DString buffer;
|
int length;
|
int length;
|
char *name;
|
char *name;
|
|
|
Tcl_DStringInit(&buffer);
|
Tcl_DStringInit(&buffer);
|
|
|
/*
|
/*
|
* Get the string representation for the previous argument.
|
* Get the string representation for the previous argument.
|
* This will force each ensembleInvoc argument up the line
|
* This will force each ensembleInvoc argument up the line
|
* to get its string representation. So we will get the
|
* to get its string representation. So we will get the
|
* original command name, followed by the sub-ensemble, and
|
* original command name, followed by the sub-ensemble, and
|
* the next sub-ensemble, and so on. Then add the part
|
* the next sub-ensemble, and so on. Then add the part
|
* name from the ensPart argument.
|
* name from the ensPart argument.
|
*/
|
*/
|
if (prevArgObj) {
|
if (prevArgObj) {
|
name = Tcl_GetStringFromObj(prevArgObj, &length);
|
name = Tcl_GetStringFromObj(prevArgObj, &length);
|
Tcl_DStringAppend(&buffer, name, length);
|
Tcl_DStringAppend(&buffer, name, length);
|
}
|
}
|
|
|
if (ensPart) {
|
if (ensPart) {
|
Tcl_DStringAppendElement(&buffer, ensPart->name);
|
Tcl_DStringAppendElement(&buffer, ensPart->name);
|
}
|
}
|
|
|
/*
|
/*
|
* The following allocates an empty string on the heap if name is ""
|
* The following allocates an empty string on the heap if name is ""
|
* (e.g., if the internal rep is NULL).
|
* (e.g., if the internal rep is NULL).
|
*/
|
*/
|
name = Tcl_DStringValue(&buffer);
|
name = Tcl_DStringValue(&buffer);
|
length = strlen(name);
|
length = strlen(name);
|
objPtr->bytes = (char *) ckalloc((unsigned) (length + 1));
|
objPtr->bytes = (char *) ckalloc((unsigned) (length + 1));
|
memcpy((VOID *) objPtr->bytes, (VOID *) name, (unsigned) length);
|
memcpy((VOID *) objPtr->bytes, (VOID *) name, (unsigned) length);
|
objPtr->bytes[length] = '\0';
|
objPtr->bytes[length] = '\0';
|
objPtr->length = length;
|
objPtr->length = length;
|
}
|
}
|
|
|