1 |
578 |
markom |
/*
|
2 |
|
|
* ------------------------------------------------------------------------
|
3 |
|
|
* PACKAGE: [incr Tcl]
|
4 |
|
|
* DESCRIPTION: Object-Oriented Extensions to Tcl
|
5 |
|
|
*
|
6 |
|
|
* [incr Tcl] provides object-oriented extensions to Tcl, much as
|
7 |
|
|
* C++ provides object-oriented extensions to C. It provides a means
|
8 |
|
|
* of encapsulating related procedures together with their shared data
|
9 |
|
|
* in a local namespace that is hidden from the outside world. It
|
10 |
|
|
* promotes code re-use through inheritance. More than anything else,
|
11 |
|
|
* it encourages better organization of Tcl applications through the
|
12 |
|
|
* object-oriented paradigm, leading to code that is easier to
|
13 |
|
|
* understand and maintain.
|
14 |
|
|
*
|
15 |
|
|
* This part handles ensembles, which support compound commands in Tcl.
|
16 |
|
|
* The usual "info" command is an ensemble with parts like "info body"
|
17 |
|
|
* and "info globals". Extension developers can extend commands like
|
18 |
|
|
* "info" by adding their own parts to the ensemble.
|
19 |
|
|
*
|
20 |
|
|
* ========================================================================
|
21 |
|
|
* AUTHOR: Michael J. McLennan
|
22 |
|
|
* Bell Labs Innovations for Lucent Technologies
|
23 |
|
|
* mmclennan@lucent.com
|
24 |
|
|
* http://www.tcltk.com/itcl
|
25 |
|
|
*
|
26 |
|
|
* RCS: $Id: itcl_ensemble.c,v 1.1.1.1 2002-01-16 10:24:46 markom Exp $
|
27 |
|
|
* ========================================================================
|
28 |
|
|
* Copyright (c) 1993-1998 Lucent Technologies, Inc.
|
29 |
|
|
* ------------------------------------------------------------------------
|
30 |
|
|
* See the file "license.terms" for information on usage and redistribution
|
31 |
|
|
* of this file, and for a DISCLAIMER OF ALL WARRANTIES.
|
32 |
|
|
*/
|
33 |
|
|
#include "itclInt.h"
|
34 |
|
|
|
35 |
|
|
/*
|
36 |
|
|
* Data used to represent an ensemble:
|
37 |
|
|
*/
|
38 |
|
|
struct Ensemble;
|
39 |
|
|
typedef struct EnsemblePart {
|
40 |
|
|
char *name; /* name of this part */
|
41 |
|
|
int minChars; /* chars needed to uniquely identify part */
|
42 |
|
|
Command *cmdPtr; /* command handling this part */
|
43 |
|
|
char *usage; /* usage string describing syntax */
|
44 |
|
|
struct Ensemble* ensemble; /* ensemble containing this part */
|
45 |
|
|
} EnsemblePart;
|
46 |
|
|
|
47 |
|
|
/*
|
48 |
|
|
* Data used to represent an ensemble:
|
49 |
|
|
*/
|
50 |
|
|
typedef struct Ensemble {
|
51 |
|
|
Tcl_Interp *interp; /* interpreter containing this ensemble */
|
52 |
|
|
EnsemblePart **parts; /* list of parts in this ensemble */
|
53 |
|
|
int numParts; /* number of parts in part list */
|
54 |
|
|
int maxParts; /* current size of parts list */
|
55 |
|
|
Tcl_Command cmd; /* command representing this ensemble */
|
56 |
|
|
EnsemblePart* parent; /* parent part for sub-ensembles
|
57 |
|
|
* NULL => toplevel ensemble */
|
58 |
|
|
} Ensemble;
|
59 |
|
|
|
60 |
|
|
/*
|
61 |
|
|
* Data shared by ensemble access commands and ensemble parser:
|
62 |
|
|
*/
|
63 |
|
|
typedef struct EnsembleParser {
|
64 |
|
|
Tcl_Interp* master; /* master interp containing ensembles */
|
65 |
|
|
Tcl_Interp* parser; /* slave interp for parsing */
|
66 |
|
|
Ensemble* ensData; /* add parts to this ensemble */
|
67 |
|
|
} EnsembleParser;
|
68 |
|
|
|
69 |
|
|
/*
|
70 |
|
|
* Declarations for local procedures to this file:
|
71 |
|
|
*/
|
72 |
|
|
static void FreeEnsInvocInternalRep _ANSI_ARGS_((Tcl_Obj *objPtr));
|
73 |
|
|
static void DupEnsInvocInternalRep _ANSI_ARGS_((Tcl_Obj *objPtr,
|
74 |
|
|
Tcl_Obj *copyPtr));
|
75 |
|
|
static void UpdateStringOfEnsInvoc _ANSI_ARGS_((Tcl_Obj *objPtr));
|
76 |
|
|
static int SetEnsInvocFromAny _ANSI_ARGS_((Tcl_Interp *interp,
|
77 |
|
|
Tcl_Obj *objPtr));
|
78 |
|
|
|
79 |
|
|
/*
|
80 |
|
|
* This structure defines a Tcl object type that takes the
|
81 |
|
|
* place of a part name during ensemble invocations. When an
|
82 |
|
|
* error occurs and the caller tries to print objv[0], it will
|
83 |
|
|
* get a string that contains a complete path to the ensemble
|
84 |
|
|
* part.
|
85 |
|
|
*/
|
86 |
|
|
Tcl_ObjType itclEnsInvocType = {
|
87 |
|
|
"ensembleInvoc", /* name */
|
88 |
|
|
FreeEnsInvocInternalRep, /* freeIntRepProc */
|
89 |
|
|
DupEnsInvocInternalRep, /* dupIntRepProc */
|
90 |
|
|
UpdateStringOfEnsInvoc, /* updateStringProc */
|
91 |
|
|
SetEnsInvocFromAny /* setFromAnyProc */
|
92 |
|
|
};
|
93 |
|
|
|
94 |
|
|
/*
|
95 |
|
|
* Boolean flag indicating whether or not the "ensemble" object
|
96 |
|
|
* type has been registered with the Tcl compiler.
|
97 |
|
|
*/
|
98 |
|
|
static int ensInitialized = 0;
|
99 |
|
|
|
100 |
|
|
/*
|
101 |
|
|
* Forward declarations for the procedures used in this file.
|
102 |
|
|
*/
|
103 |
|
|
static void GetEnsembleUsage _ANSI_ARGS_((Ensemble *ensData,
|
104 |
|
|
Tcl_Obj *objPtr));
|
105 |
|
|
|
106 |
|
|
static void GetEnsemblePartUsage _ANSI_ARGS_((EnsemblePart *ensPart,
|
107 |
|
|
Tcl_Obj *objPtr));
|
108 |
|
|
|
109 |
|
|
static int CreateEnsemble _ANSI_ARGS_((Tcl_Interp *interp,
|
110 |
|
|
Ensemble *parentEnsData, char *ensName));
|
111 |
|
|
|
112 |
|
|
static int AddEnsemblePart _ANSI_ARGS_((Tcl_Interp *interp,
|
113 |
|
|
Ensemble* ensData, char* partName, char* usageInfo,
|
114 |
|
|
Tcl_ObjCmdProc *objProc, ClientData clientData,
|
115 |
|
|
Tcl_CmdDeleteProc *deleteProc, EnsemblePart **rVal));
|
116 |
|
|
|
117 |
|
|
static void DeleteEnsemble _ANSI_ARGS_((ClientData clientData));
|
118 |
|
|
|
119 |
|
|
static int FindEnsemble _ANSI_ARGS_((Tcl_Interp *interp, char **nameArgv,
|
120 |
|
|
int nameArgc, Ensemble** ensDataPtr));
|
121 |
|
|
|
122 |
|
|
static int CreateEnsemblePart _ANSI_ARGS_((Tcl_Interp *interp,
|
123 |
|
|
Ensemble *ensData, char* partName, EnsemblePart **ensPartPtr));
|
124 |
|
|
|
125 |
|
|
static void DeleteEnsemblePart _ANSI_ARGS_((EnsemblePart *ensPart));
|
126 |
|
|
|
127 |
|
|
static int FindEnsemblePart _ANSI_ARGS_((Tcl_Interp *interp,
|
128 |
|
|
Ensemble *ensData, char* partName, EnsemblePart **rensPart));
|
129 |
|
|
|
130 |
|
|
static int FindEnsemblePartIndex _ANSI_ARGS_((Ensemble *ensData,
|
131 |
|
|
char *partName, int *posPtr));
|
132 |
|
|
|
133 |
|
|
static void ComputeMinChars _ANSI_ARGS_((Ensemble *ensData, int pos));
|
134 |
|
|
|
135 |
|
|
static int HandleEnsemble _ANSI_ARGS_((ClientData clientData,
|
136 |
|
|
Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]));
|
137 |
|
|
|
138 |
|
|
static EnsembleParser* GetEnsembleParser _ANSI_ARGS_((Tcl_Interp *interp));
|
139 |
|
|
|
140 |
|
|
static void DeleteEnsParser _ANSI_ARGS_((ClientData clientData,
|
141 |
|
|
Tcl_Interp* interp));
|
142 |
|
|
|
143 |
|
|
|
144 |
|
|
|
145 |
|
|
/*
|
146 |
|
|
*----------------------------------------------------------------------
|
147 |
|
|
*
|
148 |
|
|
* Itcl_EnsembleInit --
|
149 |
|
|
*
|
150 |
|
|
* Called when any interpreter is created to make sure that
|
151 |
|
|
* things are properly set up for ensembles.
|
152 |
|
|
*
|
153 |
|
|
* Results:
|
154 |
|
|
* Returns TCL_OK if successful, and TCL_ERROR if anything goes
|
155 |
|
|
* wrong.
|
156 |
|
|
*
|
157 |
|
|
* Side effects:
|
158 |
|
|
* On the first call, the "ensemble" object type is registered
|
159 |
|
|
* with the Tcl compiler. If an error is encountered, an error
|
160 |
|
|
* is left as the result in the interpreter.
|
161 |
|
|
*
|
162 |
|
|
*----------------------------------------------------------------------
|
163 |
|
|
*/
|
164 |
|
|
/* ARGSUSED */
|
165 |
|
|
int
|
166 |
|
|
Itcl_EnsembleInit(interp)
|
167 |
|
|
Tcl_Interp *interp; /* interpreter being initialized */
|
168 |
|
|
{
|
169 |
|
|
if (!ensInitialized) {
|
170 |
|
|
Tcl_RegisterObjType(&itclEnsInvocType);
|
171 |
|
|
ensInitialized = 1;
|
172 |
|
|
}
|
173 |
|
|
|
174 |
|
|
Tcl_CreateObjCommand(interp, "::itcl::ensemble",
|
175 |
|
|
Itcl_EnsembleCmd, (ClientData)NULL, (Tcl_CmdDeleteProc*)NULL);
|
176 |
|
|
|
177 |
|
|
return TCL_OK;
|
178 |
|
|
}
|
179 |
|
|
|
180 |
|
|
|
181 |
|
|
/*
|
182 |
|
|
*----------------------------------------------------------------------
|
183 |
|
|
*
|
184 |
|
|
* Itcl_CreateEnsemble --
|
185 |
|
|
*
|
186 |
|
|
* Creates an ensemble command, or adds a sub-ensemble to an
|
187 |
|
|
* existing ensemble command. The ensemble name is a space-
|
188 |
|
|
* separated list. The first word in the list is the command
|
189 |
|
|
* name for the top-level ensemble. Other names do not have
|
190 |
|
|
* commands associated with them; they are merely sub-ensembles
|
191 |
|
|
* within the ensemble. So a name like "a::b::foo bar baz"
|
192 |
|
|
* represents an ensemble command called "foo" in the namespace
|
193 |
|
|
* "a::b" that has a sub-ensemble "bar", that has a sub-ensemble
|
194 |
|
|
* "baz".
|
195 |
|
|
*
|
196 |
|
|
* If the name is a single word, then this procedure creates
|
197 |
|
|
* a top-level ensemble and installs an access command for it.
|
198 |
|
|
* If a command already exists with that name, it is deleted.
|
199 |
|
|
*
|
200 |
|
|
* If the name has more than one word, then the leading words
|
201 |
|
|
* are treated as a path name for an existing ensemble. The
|
202 |
|
|
* last word is treated as the name for a new sub-ensemble.
|
203 |
|
|
* If an part already exists with that name, it is an error.
|
204 |
|
|
*
|
205 |
|
|
* Results:
|
206 |
|
|
* Returns TCL_OK if successful, and TCL_ERROR if anything goes
|
207 |
|
|
* wrong.
|
208 |
|
|
*
|
209 |
|
|
* Side effects:
|
210 |
|
|
* If an error is encountered, an error is left as the result
|
211 |
|
|
* in the interpreter.
|
212 |
|
|
*
|
213 |
|
|
*----------------------------------------------------------------------
|
214 |
|
|
*/
|
215 |
|
|
int
|
216 |
|
|
Itcl_CreateEnsemble(interp, ensName)
|
217 |
|
|
Tcl_Interp *interp; /* interpreter to be updated */
|
218 |
|
|
char* ensName; /* name of the new ensemble */
|
219 |
|
|
{
|
220 |
|
|
char **nameArgv = NULL;
|
221 |
|
|
int nameArgc;
|
222 |
|
|
Ensemble *parentEnsData;
|
223 |
|
|
Tcl_DString buffer;
|
224 |
|
|
|
225 |
|
|
/*
|
226 |
|
|
* Split the ensemble name into its path components.
|
227 |
|
|
*/
|
228 |
|
|
if (Tcl_SplitList(interp, ensName, &nameArgc, &nameArgv) != TCL_OK) {
|
229 |
|
|
goto ensCreateFail;
|
230 |
|
|
}
|
231 |
|
|
if (nameArgc < 1) {
|
232 |
|
|
Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
|
233 |
|
|
"invalid ensemble name \"", ensName, "\"",
|
234 |
|
|
(char*)NULL);
|
235 |
|
|
goto ensCreateFail;
|
236 |
|
|
}
|
237 |
|
|
|
238 |
|
|
/*
|
239 |
|
|
* If there is more than one path component, then follow
|
240 |
|
|
* the path down to the last component, to find the containing
|
241 |
|
|
* ensemble.
|
242 |
|
|
*/
|
243 |
|
|
parentEnsData = NULL;
|
244 |
|
|
if (nameArgc > 1) {
|
245 |
|
|
if (FindEnsemble(interp, nameArgv, nameArgc-1, &parentEnsData)
|
246 |
|
|
!= TCL_OK) {
|
247 |
|
|
goto ensCreateFail;
|
248 |
|
|
}
|
249 |
|
|
|
250 |
|
|
if (parentEnsData == NULL) {
|
251 |
|
|
char *pname = Tcl_Merge(nameArgc-1, nameArgv);
|
252 |
|
|
Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
|
253 |
|
|
"invalid ensemble name \"", pname, "\"",
|
254 |
|
|
(char*)NULL);
|
255 |
|
|
ckfree(pname);
|
256 |
|
|
goto ensCreateFail;
|
257 |
|
|
}
|
258 |
|
|
}
|
259 |
|
|
|
260 |
|
|
/*
|
261 |
|
|
* Create the ensemble.
|
262 |
|
|
*/
|
263 |
|
|
if (CreateEnsemble(interp, parentEnsData, nameArgv[nameArgc-1])
|
264 |
|
|
!= TCL_OK) {
|
265 |
|
|
goto ensCreateFail;
|
266 |
|
|
}
|
267 |
|
|
|
268 |
|
|
ckfree((char*)nameArgv);
|
269 |
|
|
return TCL_OK;
|
270 |
|
|
|
271 |
|
|
ensCreateFail:
|
272 |
|
|
if (nameArgv) {
|
273 |
|
|
ckfree((char*)nameArgv);
|
274 |
|
|
}
|
275 |
|
|
Tcl_DStringInit(&buffer);
|
276 |
|
|
Tcl_DStringAppend(&buffer, "\n (while creating ensemble \"", -1);
|
277 |
|
|
Tcl_DStringAppend(&buffer, ensName, -1);
|
278 |
|
|
Tcl_DStringAppend(&buffer, "\")", -1);
|
279 |
|
|
Tcl_AddObjErrorInfo(interp, Tcl_DStringValue(&buffer), -1);
|
280 |
|
|
Tcl_DStringFree(&buffer);
|
281 |
|
|
|
282 |
|
|
return TCL_ERROR;
|
283 |
|
|
}
|
284 |
|
|
|
285 |
|
|
|
286 |
|
|
/*
|
287 |
|
|
*----------------------------------------------------------------------
|
288 |
|
|
*
|
289 |
|
|
* Itcl_AddEnsemblePart --
|
290 |
|
|
*
|
291 |
|
|
* Adds a part to an ensemble which has been created by
|
292 |
|
|
* Itcl_CreateEnsemble. Ensembles are addressed by name, as
|
293 |
|
|
* described in Itcl_CreateEnsemble.
|
294 |
|
|
*
|
295 |
|
|
* If the ensemble already has a part with the specified name,
|
296 |
|
|
* this procedure returns an error. Otherwise, it adds a new
|
297 |
|
|
* part to the ensemble.
|
298 |
|
|
*
|
299 |
|
|
* Any client data specified is automatically passed to the
|
300 |
|
|
* handling procedure whenever the part is invoked. It is
|
301 |
|
|
* automatically destroyed by the deleteProc when the part is
|
302 |
|
|
* deleted.
|
303 |
|
|
*
|
304 |
|
|
* Results:
|
305 |
|
|
* Returns TCL_OK if successful, and TCL_ERROR if anything goes
|
306 |
|
|
* wrong.
|
307 |
|
|
*
|
308 |
|
|
* Side effects:
|
309 |
|
|
* If an error is encountered, an error is left as the result
|
310 |
|
|
* in the interpreter.
|
311 |
|
|
*
|
312 |
|
|
*----------------------------------------------------------------------
|
313 |
|
|
*/
|
314 |
|
|
int
|
315 |
|
|
Itcl_AddEnsemblePart(interp, ensName, partName, usageInfo,
|
316 |
|
|
objProc, clientData, deleteProc)
|
317 |
|
|
|
318 |
|
|
Tcl_Interp *interp; /* interpreter to be updated */
|
319 |
|
|
char* ensName; /* ensemble containing this part */
|
320 |
|
|
char* partName; /* name of the new part */
|
321 |
|
|
char* usageInfo; /* usage info for argument list */
|
322 |
|
|
Tcl_ObjCmdProc *objProc; /* handling procedure for part */
|
323 |
|
|
ClientData clientData; /* client data associated with part */
|
324 |
|
|
Tcl_CmdDeleteProc *deleteProc; /* procedure used to destroy client data */
|
325 |
|
|
{
|
326 |
|
|
char **nameArgv = NULL;
|
327 |
|
|
int nameArgc;
|
328 |
|
|
Ensemble *ensData;
|
329 |
|
|
EnsemblePart *ensPart;
|
330 |
|
|
Tcl_DString buffer;
|
331 |
|
|
|
332 |
|
|
/*
|
333 |
|
|
* Parse the ensemble name and look for a containing ensemble.
|
334 |
|
|
*/
|
335 |
|
|
if (Tcl_SplitList(interp, ensName, &nameArgc, &nameArgv) != TCL_OK) {
|
336 |
|
|
goto ensPartFail;
|
337 |
|
|
}
|
338 |
|
|
if (FindEnsemble(interp, nameArgv, nameArgc, &ensData) != TCL_OK) {
|
339 |
|
|
goto ensPartFail;
|
340 |
|
|
}
|
341 |
|
|
|
342 |
|
|
if (ensData == NULL) {
|
343 |
|
|
char *pname = Tcl_Merge(nameArgc, nameArgv);
|
344 |
|
|
Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
|
345 |
|
|
"invalid ensemble name \"", pname, "\"",
|
346 |
|
|
(char*)NULL);
|
347 |
|
|
ckfree(pname);
|
348 |
|
|
goto ensPartFail;
|
349 |
|
|
}
|
350 |
|
|
|
351 |
|
|
/*
|
352 |
|
|
* Install the new part into the part list.
|
353 |
|
|
*/
|
354 |
|
|
if (AddEnsemblePart(interp, ensData, partName, usageInfo,
|
355 |
|
|
objProc, clientData, deleteProc, &ensPart) != TCL_OK) {
|
356 |
|
|
goto ensPartFail;
|
357 |
|
|
}
|
358 |
|
|
|
359 |
|
|
ckfree((char*)nameArgv);
|
360 |
|
|
return TCL_OK;
|
361 |
|
|
|
362 |
|
|
ensPartFail:
|
363 |
|
|
if (nameArgv) {
|
364 |
|
|
ckfree((char*)nameArgv);
|
365 |
|
|
}
|
366 |
|
|
Tcl_DStringInit(&buffer);
|
367 |
|
|
Tcl_DStringAppend(&buffer, "\n (while adding to ensemble \"", -1);
|
368 |
|
|
Tcl_DStringAppend(&buffer, ensName, -1);
|
369 |
|
|
Tcl_DStringAppend(&buffer, "\")", -1);
|
370 |
|
|
Tcl_AddObjErrorInfo(interp, Tcl_DStringValue(&buffer), -1);
|
371 |
|
|
Tcl_DStringFree(&buffer);
|
372 |
|
|
|
373 |
|
|
return TCL_ERROR;
|
374 |
|
|
}
|
375 |
|
|
|
376 |
|
|
|
377 |
|
|
/*
|
378 |
|
|
*----------------------------------------------------------------------
|
379 |
|
|
*
|
380 |
|
|
* Itcl_GetEnsemblePart --
|
381 |
|
|
*
|
382 |
|
|
* Looks for a part within an ensemble, and returns information
|
383 |
|
|
* about it.
|
384 |
|
|
*
|
385 |
|
|
* Results:
|
386 |
|
|
* If the ensemble and its part are found, this procedure
|
387 |
|
|
* loads information about the part into the "infoPtr" structure
|
388 |
|
|
* and returns 1. Otherwise, it returns 0.
|
389 |
|
|
*
|
390 |
|
|
* Side effects:
|
391 |
|
|
* None.
|
392 |
|
|
*
|
393 |
|
|
*----------------------------------------------------------------------
|
394 |
|
|
*/
|
395 |
|
|
int
|
396 |
|
|
Itcl_GetEnsemblePart(interp, ensName, partName, infoPtr)
|
397 |
|
|
Tcl_Interp *interp; /* interpreter to be updated */
|
398 |
|
|
char *ensName; /* ensemble containing the part */
|
399 |
|
|
char *partName; /* name of the desired part */
|
400 |
|
|
Tcl_CmdInfo *infoPtr; /* returns: info associated with part */
|
401 |
|
|
{
|
402 |
|
|
char **nameArgv = NULL;
|
403 |
|
|
int nameArgc;
|
404 |
|
|
Ensemble *ensData;
|
405 |
|
|
EnsemblePart *ensPart;
|
406 |
|
|
Command *cmdPtr;
|
407 |
|
|
Itcl_InterpState state;
|
408 |
|
|
|
409 |
|
|
/*
|
410 |
|
|
* Parse the ensemble name and look for a containing ensemble.
|
411 |
|
|
* Save the interpreter state before we do this. If we get any
|
412 |
|
|
* errors, we don't want them to affect the interpreter.
|
413 |
|
|
*/
|
414 |
|
|
state = Itcl_SaveInterpState(interp, TCL_OK);
|
415 |
|
|
|
416 |
|
|
if (Tcl_SplitList(interp, ensName, &nameArgc, &nameArgv) != TCL_OK) {
|
417 |
|
|
goto ensGetFail;
|
418 |
|
|
}
|
419 |
|
|
if (FindEnsemble(interp, nameArgv, nameArgc, &ensData) != TCL_OK) {
|
420 |
|
|
goto ensGetFail;
|
421 |
|
|
}
|
422 |
|
|
if (ensData == NULL) {
|
423 |
|
|
goto ensGetFail;
|
424 |
|
|
}
|
425 |
|
|
|
426 |
|
|
/*
|
427 |
|
|
* Look for a part with the desired name. If found, load
|
428 |
|
|
* its data into the "infoPtr" structure.
|
429 |
|
|
*/
|
430 |
|
|
if (FindEnsemblePart(interp, ensData, partName, &ensPart)
|
431 |
|
|
!= TCL_OK || ensPart == NULL) {
|
432 |
|
|
goto ensGetFail;
|
433 |
|
|
}
|
434 |
|
|
|
435 |
|
|
cmdPtr = ensPart->cmdPtr;
|
436 |
|
|
infoPtr->isNativeObjectProc = (cmdPtr->objProc != TclInvokeStringCommand);
|
437 |
|
|
infoPtr->objProc = cmdPtr->objProc;
|
438 |
|
|
infoPtr->objClientData = cmdPtr->objClientData;
|
439 |
|
|
infoPtr->proc = cmdPtr->proc;
|
440 |
|
|
infoPtr->clientData = cmdPtr->clientData;
|
441 |
|
|
infoPtr->deleteProc = cmdPtr->deleteProc;
|
442 |
|
|
infoPtr->deleteData = cmdPtr->deleteData;
|
443 |
|
|
infoPtr->namespacePtr = (Tcl_Namespace*)cmdPtr->nsPtr;
|
444 |
|
|
|
445 |
|
|
Itcl_DiscardInterpState(state);
|
446 |
|
|
return 1;
|
447 |
|
|
|
448 |
|
|
ensGetFail:
|
449 |
|
|
Itcl_RestoreInterpState(interp, state);
|
450 |
|
|
return 0;
|
451 |
|
|
}
|
452 |
|
|
|
453 |
|
|
|
454 |
|
|
/*
|
455 |
|
|
*----------------------------------------------------------------------
|
456 |
|
|
*
|
457 |
|
|
* Itcl_IsEnsemble --
|
458 |
|
|
*
|
459 |
|
|
* Determines whether or not an existing command is an ensemble.
|
460 |
|
|
*
|
461 |
|
|
* Results:
|
462 |
|
|
* Returns non-zero if the command is an ensemble, and zero
|
463 |
|
|
* otherwise.
|
464 |
|
|
*
|
465 |
|
|
* Side effects:
|
466 |
|
|
* None.
|
467 |
|
|
*
|
468 |
|
|
*----------------------------------------------------------------------
|
469 |
|
|
*/
|
470 |
|
|
int
|
471 |
|
|
Itcl_IsEnsemble(infoPtr)
|
472 |
|
|
Tcl_CmdInfo* infoPtr; /* command info from Tcl_GetCommandInfo() */
|
473 |
|
|
{
|
474 |
|
|
if (infoPtr) {
|
475 |
|
|
return (infoPtr->deleteProc == DeleteEnsemble);
|
476 |
|
|
}
|
477 |
|
|
return 0;
|
478 |
|
|
}
|
479 |
|
|
|
480 |
|
|
|
481 |
|
|
/*
|
482 |
|
|
*----------------------------------------------------------------------
|
483 |
|
|
*
|
484 |
|
|
* Itcl_GetEnsembleUsage --
|
485 |
|
|
*
|
486 |
|
|
* Returns a summary of all of the parts of an ensemble and
|
487 |
|
|
* the meaning of their arguments. Each part is listed on
|
488 |
|
|
* a separate line. Having this summary is sometimes useful
|
489 |
|
|
* when building error messages for the "@error" handler in
|
490 |
|
|
* an ensemble.
|
491 |
|
|
*
|
492 |
|
|
* Ensembles are accessed by name, as described in
|
493 |
|
|
* Itcl_CreateEnsemble.
|
494 |
|
|
*
|
495 |
|
|
* Results:
|
496 |
|
|
* If the ensemble is found, its usage information is appended
|
497 |
|
|
* onto the object "objPtr", and this procedure returns
|
498 |
|
|
* non-zero. It is the responsibility of the caller to
|
499 |
|
|
* initialize and free the object. If anything goes wrong,
|
500 |
|
|
* this procedure returns 0.
|
501 |
|
|
*
|
502 |
|
|
* Side effects:
|
503 |
|
|
* Object passed in is modified.
|
504 |
|
|
*
|
505 |
|
|
*----------------------------------------------------------------------
|
506 |
|
|
*/
|
507 |
|
|
int
|
508 |
|
|
Itcl_GetEnsembleUsage(interp, ensName, objPtr)
|
509 |
|
|
Tcl_Interp *interp; /* interpreter containing the ensemble */
|
510 |
|
|
char *ensName; /* name of the ensemble */
|
511 |
|
|
Tcl_Obj *objPtr; /* returns: summary of usage info */
|
512 |
|
|
{
|
513 |
|
|
char **nameArgv = NULL;
|
514 |
|
|
int nameArgc;
|
515 |
|
|
Ensemble *ensData;
|
516 |
|
|
Itcl_InterpState state;
|
517 |
|
|
|
518 |
|
|
/*
|
519 |
|
|
* Parse the ensemble name and look for the ensemble.
|
520 |
|
|
* Save the interpreter state before we do this. If we get
|
521 |
|
|
* any errors, we don't want them to affect the interpreter.
|
522 |
|
|
*/
|
523 |
|
|
state = Itcl_SaveInterpState(interp, TCL_OK);
|
524 |
|
|
|
525 |
|
|
if (Tcl_SplitList(interp, ensName, &nameArgc, &nameArgv) != TCL_OK) {
|
526 |
|
|
goto ensUsageFail;
|
527 |
|
|
}
|
528 |
|
|
if (FindEnsemble(interp, nameArgv, nameArgc, &ensData) != TCL_OK) {
|
529 |
|
|
goto ensUsageFail;
|
530 |
|
|
}
|
531 |
|
|
if (ensData == NULL) {
|
532 |
|
|
goto ensUsageFail;
|
533 |
|
|
}
|
534 |
|
|
|
535 |
|
|
/*
|
536 |
|
|
* Add a summary of usage information to the return buffer.
|
537 |
|
|
*/
|
538 |
|
|
GetEnsembleUsage(ensData, objPtr);
|
539 |
|
|
|
540 |
|
|
Itcl_DiscardInterpState(state);
|
541 |
|
|
return 1;
|
542 |
|
|
|
543 |
|
|
ensUsageFail:
|
544 |
|
|
Itcl_RestoreInterpState(interp, state);
|
545 |
|
|
return 0;
|
546 |
|
|
}
|
547 |
|
|
|
548 |
|
|
|
549 |
|
|
/*
|
550 |
|
|
*----------------------------------------------------------------------
|
551 |
|
|
*
|
552 |
|
|
* Itcl_GetEnsembleUsageForObj --
|
553 |
|
|
*
|
554 |
|
|
* Returns a summary of all of the parts of an ensemble and
|
555 |
|
|
* the meaning of their arguments. This procedure is just
|
556 |
|
|
* like Itcl_GetEnsembleUsage, but it determines the desired
|
557 |
|
|
* ensemble from a command line argument. The argument should
|
558 |
|
|
* be the first argument on the command line--the ensemble
|
559 |
|
|
* command or one of its parts.
|
560 |
|
|
*
|
561 |
|
|
* Results:
|
562 |
|
|
* If the ensemble is found, its usage information is appended
|
563 |
|
|
* onto the object "objPtr", and this procedure returns
|
564 |
|
|
* non-zero. It is the responsibility of the caller to
|
565 |
|
|
* initialize and free the object. If anything goes wrong,
|
566 |
|
|
* this procedure returns 0.
|
567 |
|
|
*
|
568 |
|
|
* Side effects:
|
569 |
|
|
* Object passed in is modified.
|
570 |
|
|
*
|
571 |
|
|
*----------------------------------------------------------------------
|
572 |
|
|
*/
|
573 |
|
|
int
|
574 |
|
|
Itcl_GetEnsembleUsageForObj(interp, ensObjPtr, objPtr)
|
575 |
|
|
Tcl_Interp *interp; /* interpreter containing the ensemble */
|
576 |
|
|
Tcl_Obj *ensObjPtr; /* argument representing ensemble */
|
577 |
|
|
Tcl_Obj *objPtr; /* returns: summary of usage info */
|
578 |
|
|
{
|
579 |
|
|
Ensemble *ensData;
|
580 |
|
|
Tcl_Obj *chainObj;
|
581 |
|
|
Tcl_Command cmd;
|
582 |
|
|
Command *cmdPtr;
|
583 |
|
|
|
584 |
|
|
/*
|
585 |
|
|
* If the argument is an ensemble part, then follow the chain
|
586 |
|
|
* back to the command word for the entire ensemble.
|
587 |
|
|
*/
|
588 |
|
|
chainObj = ensObjPtr;
|
589 |
|
|
while (chainObj && chainObj->typePtr == &itclEnsInvocType) {
|
590 |
|
|
chainObj = (Tcl_Obj*)chainObj->internalRep.twoPtrValue.ptr2;
|
591 |
|
|
}
|
592 |
|
|
|
593 |
|
|
if (chainObj) {
|
594 |
|
|
cmd = Tcl_GetCommandFromObj(interp, chainObj);
|
595 |
|
|
cmdPtr = (Command*)cmd;
|
596 |
|
|
if (cmdPtr->deleteProc == DeleteEnsemble) {
|
597 |
|
|
ensData = (Ensemble*)cmdPtr->objClientData;
|
598 |
|
|
GetEnsembleUsage(ensData, objPtr);
|
599 |
|
|
return 1;
|
600 |
|
|
}
|
601 |
|
|
}
|
602 |
|
|
return 0;
|
603 |
|
|
}
|
604 |
|
|
|
605 |
|
|
|
606 |
|
|
/*
|
607 |
|
|
*----------------------------------------------------------------------
|
608 |
|
|
*
|
609 |
|
|
* GetEnsembleUsage --
|
610 |
|
|
*
|
611 |
|
|
*
|
612 |
|
|
* Returns a summary of all of the parts of an ensemble and
|
613 |
|
|
* the meaning of their arguments. Each part is listed on
|
614 |
|
|
* a separate line. This procedure is used internally to
|
615 |
|
|
* generate usage information for error messages.
|
616 |
|
|
*
|
617 |
|
|
* Results:
|
618 |
|
|
* Appends usage information onto the object in "objPtr".
|
619 |
|
|
*
|
620 |
|
|
* Side effects:
|
621 |
|
|
* None.
|
622 |
|
|
*
|
623 |
|
|
*----------------------------------------------------------------------
|
624 |
|
|
*/
|
625 |
|
|
static void
|
626 |
|
|
GetEnsembleUsage(ensData, objPtr)
|
627 |
|
|
Ensemble *ensData; /* ensemble data */
|
628 |
|
|
Tcl_Obj *objPtr; /* returns: summary of usage info */
|
629 |
|
|
{
|
630 |
|
|
char *spaces = " ";
|
631 |
|
|
int isOpenEnded = 0;
|
632 |
|
|
|
633 |
|
|
int i;
|
634 |
|
|
EnsemblePart *ensPart;
|
635 |
|
|
|
636 |
|
|
for (i=0; i < ensData->numParts; i++) {
|
637 |
|
|
ensPart = ensData->parts[i];
|
638 |
|
|
|
639 |
|
|
if (*ensPart->name == '@' && strcmp(ensPart->name,"@error") == 0) {
|
640 |
|
|
isOpenEnded = 1;
|
641 |
|
|
}
|
642 |
|
|
else {
|
643 |
|
|
Tcl_AppendToObj(objPtr, spaces, -1);
|
644 |
|
|
GetEnsemblePartUsage(ensPart, objPtr);
|
645 |
|
|
spaces = "\n ";
|
646 |
|
|
}
|
647 |
|
|
}
|
648 |
|
|
if (isOpenEnded) {
|
649 |
|
|
Tcl_AppendToObj(objPtr,
|
650 |
|
|
"\n...and others described on the man page", -1);
|
651 |
|
|
}
|
652 |
|
|
}
|
653 |
|
|
|
654 |
|
|
|
655 |
|
|
/*
|
656 |
|
|
*----------------------------------------------------------------------
|
657 |
|
|
*
|
658 |
|
|
* GetEnsemblePartUsage --
|
659 |
|
|
*
|
660 |
|
|
* Determines the usage for a single part within an ensemble,
|
661 |
|
|
* and appends a summary onto a dynamic string. The usage
|
662 |
|
|
* is a combination of the part name and the argument summary.
|
663 |
|
|
* It is the caller's responsibility to initialize and free
|
664 |
|
|
* the dynamic string.
|
665 |
|
|
*
|
666 |
|
|
* Results:
|
667 |
|
|
* Returns usage information in the object "objPtr".
|
668 |
|
|
*
|
669 |
|
|
* Side effects:
|
670 |
|
|
* None.
|
671 |
|
|
*
|
672 |
|
|
*----------------------------------------------------------------------
|
673 |
|
|
*/
|
674 |
|
|
static void
|
675 |
|
|
GetEnsemblePartUsage(ensPart, objPtr)
|
676 |
|
|
EnsemblePart *ensPart; /* ensemble part for usage info */
|
677 |
|
|
Tcl_Obj *objPtr; /* returns: usage information */
|
678 |
|
|
{
|
679 |
|
|
EnsemblePart *part;
|
680 |
|
|
Command *cmdPtr;
|
681 |
|
|
char *name;
|
682 |
|
|
Itcl_List trail;
|
683 |
|
|
Itcl_ListElem *elem;
|
684 |
|
|
Tcl_DString buffer;
|
685 |
|
|
|
686 |
|
|
/*
|
687 |
|
|
* Build the trail of ensemble names leading to this part.
|
688 |
|
|
*/
|
689 |
|
|
Tcl_DStringInit(&buffer);
|
690 |
|
|
Itcl_InitList(&trail);
|
691 |
|
|
for (part=ensPart; part; part=part->ensemble->parent) {
|
692 |
|
|
Itcl_InsertList(&trail, (ClientData)part);
|
693 |
|
|
}
|
694 |
|
|
|
695 |
|
|
cmdPtr = (Command*)ensPart->ensemble->cmd;
|
696 |
|
|
name = Tcl_GetHashKey(cmdPtr->hPtr->tablePtr, cmdPtr->hPtr);
|
697 |
|
|
Tcl_DStringAppendElement(&buffer, name);
|
698 |
|
|
|
699 |
|
|
for (elem=Itcl_FirstListElem(&trail); elem; elem=Itcl_NextListElem(elem)) {
|
700 |
|
|
part = (EnsemblePart*)Itcl_GetListValue(elem);
|
701 |
|
|
Tcl_DStringAppendElement(&buffer, part->name);
|
702 |
|
|
}
|
703 |
|
|
Itcl_DeleteList(&trail);
|
704 |
|
|
|
705 |
|
|
/*
|
706 |
|
|
* If the part has usage info, use it directly.
|
707 |
|
|
*/
|
708 |
|
|
if (ensPart->usage && *ensPart->usage != '\0') {
|
709 |
|
|
Tcl_DStringAppend(&buffer, " ", 1);
|
710 |
|
|
Tcl_DStringAppend(&buffer, ensPart->usage, -1);
|
711 |
|
|
}
|
712 |
|
|
|
713 |
|
|
/*
|
714 |
|
|
* If the part is itself an ensemble, summarize its usage.
|
715 |
|
|
*/
|
716 |
|
|
else if (ensPart->cmdPtr &&
|
717 |
|
|
ensPart->cmdPtr->deleteProc == DeleteEnsemble) {
|
718 |
|
|
Tcl_DStringAppend(&buffer, " option ?arg arg ...?", 21);
|
719 |
|
|
}
|
720 |
|
|
|
721 |
|
|
Tcl_AppendToObj(objPtr, Tcl_DStringValue(&buffer),
|
722 |
|
|
Tcl_DStringLength(&buffer));
|
723 |
|
|
|
724 |
|
|
Tcl_DStringFree(&buffer);
|
725 |
|
|
}
|
726 |
|
|
|
727 |
|
|
|
728 |
|
|
/*
|
729 |
|
|
*----------------------------------------------------------------------
|
730 |
|
|
*
|
731 |
|
|
* CreateEnsemble --
|
732 |
|
|
*
|
733 |
|
|
* Creates an ensemble command, or adds a sub-ensemble to an
|
734 |
|
|
* existing ensemble command. Works like Itcl_CreateEnsemble,
|
735 |
|
|
* except that the ensemble name is a single name, not a path.
|
736 |
|
|
* If a parent ensemble is specified, then a new ensemble is
|
737 |
|
|
* added to that parent. If a part already exists with the
|
738 |
|
|
* same name, it is an error. If a parent ensemble is not
|
739 |
|
|
* specified, then a top-level ensemble is created. If a
|
740 |
|
|
* command already exists with the same name, it is deleted.
|
741 |
|
|
*
|
742 |
|
|
* Results:
|
743 |
|
|
* Returns TCL_OK if successful, and TCL_ERROR if anything goes
|
744 |
|
|
* wrong.
|
745 |
|
|
*
|
746 |
|
|
* Side effects:
|
747 |
|
|
* If an error is encountered, an error is left as the result
|
748 |
|
|
* in the interpreter.
|
749 |
|
|
*
|
750 |
|
|
*----------------------------------------------------------------------
|
751 |
|
|
*/
|
752 |
|
|
static int
|
753 |
|
|
CreateEnsemble(interp, parentEnsData, ensName)
|
754 |
|
|
Tcl_Interp *interp; /* interpreter to be updated */
|
755 |
|
|
Ensemble *parentEnsData; /* parent ensemble or NULL */
|
756 |
|
|
char *ensName; /* name of the new ensemble */
|
757 |
|
|
{
|
758 |
|
|
Ensemble *ensData;
|
759 |
|
|
EnsemblePart *ensPart;
|
760 |
|
|
Command *cmdPtr;
|
761 |
|
|
Tcl_CmdInfo cmdInfo;
|
762 |
|
|
|
763 |
|
|
/*
|
764 |
|
|
* Create the data associated with the ensemble.
|
765 |
|
|
*/
|
766 |
|
|
ensData = (Ensemble*)ckalloc(sizeof(Ensemble));
|
767 |
|
|
ensData->interp = interp;
|
768 |
|
|
ensData->numParts = 0;
|
769 |
|
|
ensData->maxParts = 10;
|
770 |
|
|
ensData->parts = (EnsemblePart**)ckalloc(
|
771 |
|
|
(unsigned)(ensData->maxParts*sizeof(EnsemblePart*))
|
772 |
|
|
);
|
773 |
|
|
ensData->cmd = NULL;
|
774 |
|
|
ensData->parent = NULL;
|
775 |
|
|
|
776 |
|
|
/*
|
777 |
|
|
* If there is no parent data, then this is a top-level
|
778 |
|
|
* ensemble. Create the ensemble by installing its access
|
779 |
|
|
* command.
|
780 |
|
|
*
|
781 |
|
|
* BE CAREFUL: Set the string-based proc to the wrapper
|
782 |
|
|
* procedure TclInvokeObjectCommand. Otherwise, the
|
783 |
|
|
* ensemble command may fail. For example, it will fail
|
784 |
|
|
* when invoked as a hidden command.
|
785 |
|
|
*/
|
786 |
|
|
if (parentEnsData == NULL) {
|
787 |
|
|
ensData->cmd = Tcl_CreateObjCommand(interp, ensName,
|
788 |
|
|
HandleEnsemble, (ClientData)ensData, DeleteEnsemble);
|
789 |
|
|
|
790 |
|
|
if (Tcl_GetCommandInfo(interp, ensName, &cmdInfo)) {
|
791 |
|
|
cmdInfo.proc = TclInvokeObjectCommand;
|
792 |
|
|
Tcl_SetCommandInfo(interp, ensName, &cmdInfo);
|
793 |
|
|
}
|
794 |
|
|
return TCL_OK;
|
795 |
|
|
}
|
796 |
|
|
|
797 |
|
|
/*
|
798 |
|
|
* Otherwise, this ensemble is contained within another parent.
|
799 |
|
|
* Install the new ensemble as a part within its parent.
|
800 |
|
|
*/
|
801 |
|
|
if (CreateEnsemblePart(interp, parentEnsData, ensName, &ensPart)
|
802 |
|
|
!= TCL_OK) {
|
803 |
|
|
DeleteEnsemble((ClientData)ensData);
|
804 |
|
|
return TCL_ERROR;
|
805 |
|
|
}
|
806 |
|
|
|
807 |
|
|
ensData->cmd = parentEnsData->cmd;
|
808 |
|
|
ensData->parent = ensPart;
|
809 |
|
|
|
810 |
|
|
cmdPtr = (Command*)ckalloc(sizeof(Command));
|
811 |
|
|
cmdPtr->hPtr = NULL;
|
812 |
|
|
cmdPtr->nsPtr = ((Command*)ensData->cmd)->nsPtr;
|
813 |
|
|
cmdPtr->refCount = 0;
|
814 |
|
|
cmdPtr->cmdEpoch = 0;
|
815 |
|
|
cmdPtr->compileProc = NULL;
|
816 |
|
|
cmdPtr->objProc = HandleEnsemble;
|
817 |
|
|
cmdPtr->objClientData = (ClientData)ensData;
|
818 |
|
|
cmdPtr->proc = NULL;
|
819 |
|
|
cmdPtr->clientData = NULL;
|
820 |
|
|
cmdPtr->deleteProc = DeleteEnsemble;
|
821 |
|
|
cmdPtr->deleteData = cmdPtr->objClientData;
|
822 |
|
|
cmdPtr->deleted = 0;
|
823 |
|
|
cmdPtr->importRefPtr = NULL;
|
824 |
|
|
|
825 |
|
|
ensPart->cmdPtr = cmdPtr;
|
826 |
|
|
|
827 |
|
|
return TCL_OK;
|
828 |
|
|
}
|
829 |
|
|
|
830 |
|
|
|
831 |
|
|
/*
|
832 |
|
|
*----------------------------------------------------------------------
|
833 |
|
|
*
|
834 |
|
|
* AddEnsemblePart --
|
835 |
|
|
*
|
836 |
|
|
* Adds a part to an existing ensemble. Works like
|
837 |
|
|
* Itcl_AddEnsemblePart, but the part name is a single word,
|
838 |
|
|
* not a path.
|
839 |
|
|
*
|
840 |
|
|
* If the ensemble already has a part with the specified name,
|
841 |
|
|
* this procedure returns an error. Otherwise, it adds a new
|
842 |
|
|
* part to the ensemble.
|
843 |
|
|
*
|
844 |
|
|
* Any client data specified is automatically passed to the
|
845 |
|
|
* handling procedure whenever the part is invoked. It is
|
846 |
|
|
* automatically destroyed by the deleteProc when the part is
|
847 |
|
|
* deleted.
|
848 |
|
|
*
|
849 |
|
|
* Results:
|
850 |
|
|
* Returns TCL_OK if successful, along with a pointer to the
|
851 |
|
|
* new part. Returns TCL_ERROR if anything goes wrong.
|
852 |
|
|
*
|
853 |
|
|
* Side effects:
|
854 |
|
|
* If an error is encountered, an error is left as the result
|
855 |
|
|
* in the interpreter.
|
856 |
|
|
*
|
857 |
|
|
*----------------------------------------------------------------------
|
858 |
|
|
*/
|
859 |
|
|
static int
|
860 |
|
|
AddEnsemblePart(interp, ensData, partName, usageInfo,
|
861 |
|
|
objProc, clientData, deleteProc, rVal)
|
862 |
|
|
|
863 |
|
|
Tcl_Interp *interp; /* interpreter to be updated */
|
864 |
|
|
Ensemble* ensData; /* ensemble that will contain this part */
|
865 |
|
|
char* partName; /* name of the new part */
|
866 |
|
|
char* usageInfo; /* usage info for argument list */
|
867 |
|
|
Tcl_ObjCmdProc *objProc; /* handling procedure for part */
|
868 |
|
|
ClientData clientData; /* client data associated with part */
|
869 |
|
|
Tcl_CmdDeleteProc *deleteProc; /* procedure used to destroy client data */
|
870 |
|
|
EnsemblePart **rVal; /* returns: new ensemble part */
|
871 |
|
|
{
|
872 |
|
|
EnsemblePart *ensPart;
|
873 |
|
|
Command *cmdPtr;
|
874 |
|
|
|
875 |
|
|
/*
|
876 |
|
|
* Install the new part into the part list.
|
877 |
|
|
*/
|
878 |
|
|
if (CreateEnsemblePart(interp, ensData, partName, &ensPart) != TCL_OK) {
|
879 |
|
|
return TCL_ERROR;
|
880 |
|
|
}
|
881 |
|
|
|
882 |
|
|
if (usageInfo) {
|
883 |
|
|
ensPart->usage = ckalloc((unsigned)(strlen(usageInfo)+1));
|
884 |
|
|
strcpy(ensPart->usage, usageInfo);
|
885 |
|
|
}
|
886 |
|
|
|
887 |
|
|
cmdPtr = (Command*)ckalloc(sizeof(Command));
|
888 |
|
|
cmdPtr->hPtr = NULL;
|
889 |
|
|
cmdPtr->nsPtr = ((Command*)ensData->cmd)->nsPtr;
|
890 |
|
|
cmdPtr->refCount = 0;
|
891 |
|
|
cmdPtr->cmdEpoch = 0;
|
892 |
|
|
cmdPtr->compileProc = NULL;
|
893 |
|
|
cmdPtr->objProc = objProc;
|
894 |
|
|
cmdPtr->objClientData = (ClientData)clientData;
|
895 |
|
|
cmdPtr->proc = NULL;
|
896 |
|
|
cmdPtr->clientData = NULL;
|
897 |
|
|
cmdPtr->deleteProc = deleteProc;
|
898 |
|
|
cmdPtr->deleteData = (ClientData)clientData;
|
899 |
|
|
cmdPtr->deleted = 0;
|
900 |
|
|
cmdPtr->importRefPtr = NULL;
|
901 |
|
|
|
902 |
|
|
ensPart->cmdPtr = cmdPtr;
|
903 |
|
|
*rVal = ensPart;
|
904 |
|
|
|
905 |
|
|
return TCL_OK;
|
906 |
|
|
}
|
907 |
|
|
|
908 |
|
|
|
909 |
|
|
/*
|
910 |
|
|
*----------------------------------------------------------------------
|
911 |
|
|
*
|
912 |
|
|
* DeleteEnsemble --
|
913 |
|
|
*
|
914 |
|
|
* Invoked when the command associated with an ensemble is
|
915 |
|
|
* destroyed, to delete the ensemble. Destroys all parts
|
916 |
|
|
* included in the ensemble, and frees all memory associated
|
917 |
|
|
* with it.
|
918 |
|
|
*
|
919 |
|
|
* Results:
|
920 |
|
|
* None.
|
921 |
|
|
*
|
922 |
|
|
* Side effects:
|
923 |
|
|
* None.
|
924 |
|
|
*
|
925 |
|
|
*----------------------------------------------------------------------
|
926 |
|
|
*/
|
927 |
|
|
static void
|
928 |
|
|
DeleteEnsemble(clientData)
|
929 |
|
|
ClientData clientData; /* ensemble data */
|
930 |
|
|
{
|
931 |
|
|
Ensemble* ensData = (Ensemble*)clientData;
|
932 |
|
|
|
933 |
|
|
/*
|
934 |
|
|
* BE CAREFUL: Each ensemble part removes itself from the list.
|
935 |
|
|
* So keep deleting the first part until all parts are gone.
|
936 |
|
|
*/
|
937 |
|
|
while (ensData->numParts > 0) {
|
938 |
|
|
DeleteEnsemblePart(ensData->parts[0]);
|
939 |
|
|
}
|
940 |
|
|
ckfree((char*)ensData->parts);
|
941 |
|
|
ckfree((char*)ensData);
|
942 |
|
|
}
|
943 |
|
|
|
944 |
|
|
|
945 |
|
|
/*
|
946 |
|
|
*----------------------------------------------------------------------
|
947 |
|
|
*
|
948 |
|
|
* FindEnsemble --
|
949 |
|
|
*
|
950 |
|
|
* Searches for an ensemble command and follows a path to
|
951 |
|
|
* sub-ensembles.
|
952 |
|
|
*
|
953 |
|
|
* Results:
|
954 |
|
|
* Returns TCL_OK if the ensemble was found, along with a
|
955 |
|
|
* pointer to the ensemble data in "ensDataPtr". Returns
|
956 |
|
|
* TCL_ERROR if anything goes wrong.
|
957 |
|
|
*
|
958 |
|
|
* Side effects:
|
959 |
|
|
* If anything goes wrong, this procedure returns an error
|
960 |
|
|
* message as the result in the interpreter.
|
961 |
|
|
*
|
962 |
|
|
*----------------------------------------------------------------------
|
963 |
|
|
*/
|
964 |
|
|
static int
|
965 |
|
|
FindEnsemble(interp, nameArgv, nameArgc, ensDataPtr)
|
966 |
|
|
Tcl_Interp *interp; /* interpreter containing the ensemble */
|
967 |
|
|
char **nameArgv; /* path of names leading to ensemble */
|
968 |
|
|
int nameArgc; /* number of strings in nameArgv */
|
969 |
|
|
Ensemble** ensDataPtr; /* returns: ensemble data */
|
970 |
|
|
{
|
971 |
|
|
int i;
|
972 |
|
|
Command* cmdPtr;
|
973 |
|
|
Ensemble *ensData;
|
974 |
|
|
EnsemblePart *ensPart;
|
975 |
|
|
|
976 |
|
|
*ensDataPtr = NULL; /* assume that no data will be found */
|
977 |
|
|
|
978 |
|
|
/*
|
979 |
|
|
* If there are no names in the path, then return an error.
|
980 |
|
|
*/
|
981 |
|
|
if (nameArgc < 1) {
|
982 |
|
|
Tcl_AppendToObj(Tcl_GetObjResult(interp),
|
983 |
|
|
"invalid ensemble name \"\"", -1);
|
984 |
|
|
return TCL_ERROR;
|
985 |
|
|
}
|
986 |
|
|
|
987 |
|
|
/*
|
988 |
|
|
* Use the first name to find the command for the top-level
|
989 |
|
|
* ensemble.
|
990 |
|
|
*/
|
991 |
|
|
cmdPtr = (Command*) Tcl_FindCommand(interp, nameArgv[0],
|
992 |
|
|
(Tcl_Namespace*)NULL, TCL_LEAVE_ERR_MSG);
|
993 |
|
|
|
994 |
|
|
if (cmdPtr == NULL || cmdPtr->deleteProc != DeleteEnsemble) {
|
995 |
|
|
Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
|
996 |
|
|
"command \"", nameArgv[0], "\" is not an ensemble",
|
997 |
|
|
(char*)NULL);
|
998 |
|
|
return TCL_ERROR;
|
999 |
|
|
}
|
1000 |
|
|
ensData = (Ensemble*)cmdPtr->objClientData;
|
1001 |
|
|
|
1002 |
|
|
/*
|
1003 |
|
|
* Follow the trail of sub-ensemble names.
|
1004 |
|
|
*/
|
1005 |
|
|
for (i=1; i < nameArgc; i++) {
|
1006 |
|
|
if (FindEnsemblePart(interp, ensData, nameArgv[i], &ensPart)
|
1007 |
|
|
!= TCL_OK) {
|
1008 |
|
|
return TCL_ERROR;
|
1009 |
|
|
}
|
1010 |
|
|
if (ensPart == NULL) {
|
1011 |
|
|
char *pname = Tcl_Merge(i, nameArgv);
|
1012 |
|
|
Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
|
1013 |
|
|
"invalid ensemble name \"", pname, "\"",
|
1014 |
|
|
(char*)NULL);
|
1015 |
|
|
ckfree(pname);
|
1016 |
|
|
return TCL_ERROR;
|
1017 |
|
|
}
|
1018 |
|
|
|
1019 |
|
|
cmdPtr = ensPart->cmdPtr;
|
1020 |
|
|
if (cmdPtr == NULL || cmdPtr->deleteProc != DeleteEnsemble) {
|
1021 |
|
|
Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
|
1022 |
|
|
"part \"", nameArgv[i], "\" is not an ensemble",
|
1023 |
|
|
(char*)NULL);
|
1024 |
|
|
return TCL_ERROR;
|
1025 |
|
|
}
|
1026 |
|
|
ensData = (Ensemble*)cmdPtr->objClientData;
|
1027 |
|
|
}
|
1028 |
|
|
*ensDataPtr = ensData;
|
1029 |
|
|
|
1030 |
|
|
return TCL_OK;
|
1031 |
|
|
}
|
1032 |
|
|
|
1033 |
|
|
|
1034 |
|
|
/*
|
1035 |
|
|
*----------------------------------------------------------------------
|
1036 |
|
|
*
|
1037 |
|
|
* CreateEnsemblePart --
|
1038 |
|
|
*
|
1039 |
|
|
* Creates a new part within an ensemble.
|
1040 |
|
|
*
|
1041 |
|
|
* Results:
|
1042 |
|
|
* If successful, this procedure returns TCL_OK, along with a
|
1043 |
|
|
* pointer to the new part in "ensPartPtr". If a part with the
|
1044 |
|
|
* same name already exists, this procedure returns TCL_ERROR.
|
1045 |
|
|
*
|
1046 |
|
|
* Side effects:
|
1047 |
|
|
* If anything goes wrong, this procedure returns an error
|
1048 |
|
|
* message as the result in the interpreter.
|
1049 |
|
|
*
|
1050 |
|
|
*----------------------------------------------------------------------
|
1051 |
|
|
*/
|
1052 |
|
|
static int
|
1053 |
|
|
CreateEnsemblePart(interp, ensData, partName, ensPartPtr)
|
1054 |
|
|
Tcl_Interp *interp; /* interpreter containing the ensemble */
|
1055 |
|
|
Ensemble *ensData; /* ensemble being modified */
|
1056 |
|
|
char* partName; /* name of the new part */
|
1057 |
|
|
EnsemblePart **ensPartPtr; /* returns: new ensemble part */
|
1058 |
|
|
{
|
1059 |
|
|
int i, pos, size;
|
1060 |
|
|
EnsemblePart** partList;
|
1061 |
|
|
EnsemblePart* part;
|
1062 |
|
|
|
1063 |
|
|
/*
|
1064 |
|
|
* If a matching entry was found, then return an error.
|
1065 |
|
|
*/
|
1066 |
|
|
if (FindEnsemblePartIndex(ensData, partName, &pos)) {
|
1067 |
|
|
Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
|
1068 |
|
|
"part \"", partName, "\" already exists in ensemble",
|
1069 |
|
|
(char*)NULL);
|
1070 |
|
|
return TCL_ERROR;
|
1071 |
|
|
}
|
1072 |
|
|
|
1073 |
|
|
/*
|
1074 |
|
|
* Otherwise, make room for a new entry. Keep the parts in
|
1075 |
|
|
* lexicographical order, so we can search them quickly
|
1076 |
|
|
* later.
|
1077 |
|
|
*/
|
1078 |
|
|
if (ensData->numParts >= ensData->maxParts) {
|
1079 |
|
|
size = ensData->maxParts*sizeof(EnsemblePart*);
|
1080 |
|
|
partList = (EnsemblePart**)ckalloc((unsigned)2*size);
|
1081 |
|
|
memcpy((VOID*)partList, (VOID*)ensData->parts, (size_t)size);
|
1082 |
|
|
ckfree((char*)ensData->parts);
|
1083 |
|
|
|
1084 |
|
|
ensData->parts = partList;
|
1085 |
|
|
ensData->maxParts *= 2;
|
1086 |
|
|
}
|
1087 |
|
|
|
1088 |
|
|
for (i=ensData->numParts; i > pos; i--) {
|
1089 |
|
|
ensData->parts[i] = ensData->parts[i-1];
|
1090 |
|
|
}
|
1091 |
|
|
ensData->numParts++;
|
1092 |
|
|
|
1093 |
|
|
part = (EnsemblePart*)ckalloc(sizeof(EnsemblePart));
|
1094 |
|
|
part->name = (char*)ckalloc((unsigned)(strlen(partName)+1));
|
1095 |
|
|
strcpy(part->name, partName);
|
1096 |
|
|
part->cmdPtr = NULL;
|
1097 |
|
|
part->usage = NULL;
|
1098 |
|
|
part->ensemble = ensData;
|
1099 |
|
|
|
1100 |
|
|
ensData->parts[pos] = part;
|
1101 |
|
|
|
1102 |
|
|
/*
|
1103 |
|
|
* Compare the new part against the one on either side of
|
1104 |
|
|
* it. Determine how many letters are needed in each part
|
1105 |
|
|
* to guarantee that an abbreviated form is unique. Update
|
1106 |
|
|
* the parts on either side as well, since they are influenced
|
1107 |
|
|
* by the new part.
|
1108 |
|
|
*/
|
1109 |
|
|
ComputeMinChars(ensData, pos);
|
1110 |
|
|
ComputeMinChars(ensData, pos-1);
|
1111 |
|
|
ComputeMinChars(ensData, pos+1);
|
1112 |
|
|
|
1113 |
|
|
*ensPartPtr = part;
|
1114 |
|
|
return TCL_OK;
|
1115 |
|
|
}
|
1116 |
|
|
|
1117 |
|
|
|
1118 |
|
|
/*
|
1119 |
|
|
*----------------------------------------------------------------------
|
1120 |
|
|
*
|
1121 |
|
|
* DeleteEnsemblePart --
|
1122 |
|
|
*
|
1123 |
|
|
* Deletes a single part from an ensemble. The part must have
|
1124 |
|
|
* been created previously by CreateEnsemblePart.
|
1125 |
|
|
*
|
1126 |
|
|
* If the part has a delete proc, then it is called to free the
|
1127 |
|
|
* associated client data.
|
1128 |
|
|
*
|
1129 |
|
|
* Results:
|
1130 |
|
|
* None.
|
1131 |
|
|
*
|
1132 |
|
|
* Side effects:
|
1133 |
|
|
* Delete proc is called.
|
1134 |
|
|
*
|
1135 |
|
|
*----------------------------------------------------------------------
|
1136 |
|
|
*/
|
1137 |
|
|
static void
|
1138 |
|
|
DeleteEnsemblePart(ensPart)
|
1139 |
|
|
EnsemblePart *ensPart; /* part being destroyed */
|
1140 |
|
|
{
|
1141 |
|
|
int i, pos;
|
1142 |
|
|
Command *cmdPtr;
|
1143 |
|
|
Ensemble *ensData;
|
1144 |
|
|
cmdPtr = ensPart->cmdPtr;
|
1145 |
|
|
|
1146 |
|
|
/*
|
1147 |
|
|
* If this part has a delete proc, then call it to free
|
1148 |
|
|
* up the client data.
|
1149 |
|
|
*/
|
1150 |
|
|
if (cmdPtr->deleteData && cmdPtr->deleteProc) {
|
1151 |
|
|
(*cmdPtr->deleteProc)(cmdPtr->deleteData);
|
1152 |
|
|
}
|
1153 |
|
|
ckfree((char*)cmdPtr);
|
1154 |
|
|
|
1155 |
|
|
/*
|
1156 |
|
|
* Find this part within its ensemble, and remove it from
|
1157 |
|
|
* the list of parts.
|
1158 |
|
|
*/
|
1159 |
|
|
if (FindEnsemblePartIndex(ensPart->ensemble, ensPart->name, &pos)) {
|
1160 |
|
|
ensData = ensPart->ensemble;
|
1161 |
|
|
for (i=pos; i < ensData->numParts-1; i++) {
|
1162 |
|
|
ensData->parts[i] = ensData->parts[i+1];
|
1163 |
|
|
}
|
1164 |
|
|
ensData->numParts--;
|
1165 |
|
|
}
|
1166 |
|
|
|
1167 |
|
|
/*
|
1168 |
|
|
* Free the memory associated with the part.
|
1169 |
|
|
*/
|
1170 |
|
|
if (ensPart->usage) {
|
1171 |
|
|
ckfree(ensPart->usage);
|
1172 |
|
|
}
|
1173 |
|
|
ckfree(ensPart->name);
|
1174 |
|
|
ckfree((char*)ensPart);
|
1175 |
|
|
}
|
1176 |
|
|
|
1177 |
|
|
|
1178 |
|
|
/*
|
1179 |
|
|
*----------------------------------------------------------------------
|
1180 |
|
|
*
|
1181 |
|
|
* FindEnsemblePart --
|
1182 |
|
|
*
|
1183 |
|
|
* Searches for a part name within an ensemble. Recognizes
|
1184 |
|
|
* unique abbreviations for part names.
|
1185 |
|
|
*
|
1186 |
|
|
* Results:
|
1187 |
|
|
* If the part name is not a unique abbreviation, this procedure
|
1188 |
|
|
* returns TCL_ERROR. Otherwise, it returns TCL_OK. If the
|
1189 |
|
|
* part can be found, "rensPart" returns a pointer to the part.
|
1190 |
|
|
* Otherwise, it returns NULL.
|
1191 |
|
|
*
|
1192 |
|
|
* Side effects:
|
1193 |
|
|
* If anything goes wrong, this procedure returns an error
|
1194 |
|
|
* message as the result in the interpreter.
|
1195 |
|
|
*
|
1196 |
|
|
*----------------------------------------------------------------------
|
1197 |
|
|
*/
|
1198 |
|
|
static int
|
1199 |
|
|
FindEnsemblePart(interp, ensData, partName, rensPart)
|
1200 |
|
|
Tcl_Interp *interp; /* interpreter containing the ensemble */
|
1201 |
|
|
Ensemble *ensData; /* ensemble being searched */
|
1202 |
|
|
char* partName; /* name of the desired part */
|
1203 |
|
|
EnsemblePart **rensPart; /* returns: pointer to the desired part */
|
1204 |
|
|
{
|
1205 |
|
|
int pos = 0;
|
1206 |
|
|
int first, last, nlen;
|
1207 |
|
|
int i, cmp;
|
1208 |
|
|
|
1209 |
|
|
*rensPart = NULL;
|
1210 |
|
|
|
1211 |
|
|
/*
|
1212 |
|
|
* Search for the desired part name.
|
1213 |
|
|
* All parts are in lexicographical order, so use a
|
1214 |
|
|
* binary search to find the part quickly. Match only
|
1215 |
|
|
* as many characters as are included in the specified
|
1216 |
|
|
* part name.
|
1217 |
|
|
*/
|
1218 |
|
|
first = 0;
|
1219 |
|
|
last = ensData->numParts-1;
|
1220 |
|
|
nlen = strlen(partName);
|
1221 |
|
|
|
1222 |
|
|
while (last >= first) {
|
1223 |
|
|
pos = (first+last)/2;
|
1224 |
|
|
if (*partName == *ensData->parts[pos]->name) {
|
1225 |
|
|
cmp = strncmp(partName, ensData->parts[pos]->name, nlen);
|
1226 |
|
|
if (cmp == 0) {
|
1227 |
|
|
break; /* found it! */
|
1228 |
|
|
}
|
1229 |
|
|
}
|
1230 |
|
|
else if (*partName < *ensData->parts[pos]->name) {
|
1231 |
|
|
cmp = -1;
|
1232 |
|
|
}
|
1233 |
|
|
else {
|
1234 |
|
|
cmp = 1;
|
1235 |
|
|
}
|
1236 |
|
|
|
1237 |
|
|
if (cmp > 0) {
|
1238 |
|
|
first = pos+1;
|
1239 |
|
|
} else {
|
1240 |
|
|
last = pos-1;
|
1241 |
|
|
}
|
1242 |
|
|
}
|
1243 |
|
|
|
1244 |
|
|
/*
|
1245 |
|
|
* If a matching entry could not be found, then quit.
|
1246 |
|
|
*/
|
1247 |
|
|
if (last < first) {
|
1248 |
|
|
return TCL_OK;
|
1249 |
|
|
}
|
1250 |
|
|
|
1251 |
|
|
/*
|
1252 |
|
|
* If a matching entry was found, there may be some ambiguity
|
1253 |
|
|
* if the user did not specify enough characters. Find the
|
1254 |
|
|
* top-most match in the list, and see if the part name has
|
1255 |
|
|
* enough characters. If there are two parts like "foo"
|
1256 |
|
|
* and "food", this allows us to match "foo" exactly.
|
1257 |
|
|
*/
|
1258 |
|
|
if (nlen < ensData->parts[pos]->minChars) {
|
1259 |
|
|
while (pos > 0) {
|
1260 |
|
|
pos--;
|
1261 |
|
|
if (strncmp(partName, ensData->parts[pos]->name, nlen) != 0) {
|
1262 |
|
|
pos++;
|
1263 |
|
|
break;
|
1264 |
|
|
}
|
1265 |
|
|
}
|
1266 |
|
|
}
|
1267 |
|
|
if (nlen < ensData->parts[pos]->minChars) {
|
1268 |
|
|
Tcl_Obj *resultPtr = Tcl_NewStringObj((char*)NULL, 0);
|
1269 |
|
|
|
1270 |
|
|
Tcl_AppendStringsToObj(resultPtr,
|
1271 |
|
|
"ambiguous option \"", partName, "\": should be one of...",
|
1272 |
|
|
(char*)NULL);
|
1273 |
|
|
|
1274 |
|
|
for (i=pos; i < ensData->numParts; i++) {
|
1275 |
|
|
if (strncmp(partName, ensData->parts[i]->name, nlen) != 0) {
|
1276 |
|
|
break;
|
1277 |
|
|
}
|
1278 |
|
|
Tcl_AppendToObj(resultPtr, "\n ", 3);
|
1279 |
|
|
GetEnsemblePartUsage(ensData->parts[i], resultPtr);
|
1280 |
|
|
}
|
1281 |
|
|
Tcl_SetObjResult(interp, resultPtr);
|
1282 |
|
|
return TCL_ERROR;
|
1283 |
|
|
}
|
1284 |
|
|
|
1285 |
|
|
/*
|
1286 |
|
|
* Found a match. Return the desired part.
|
1287 |
|
|
*/
|
1288 |
|
|
*rensPart = ensData->parts[pos];
|
1289 |
|
|
return TCL_OK;
|
1290 |
|
|
}
|
1291 |
|
|
|
1292 |
|
|
|
1293 |
|
|
/*
|
1294 |
|
|
*----------------------------------------------------------------------
|
1295 |
|
|
*
|
1296 |
|
|
* FindEnsemblePartIndex --
|
1297 |
|
|
*
|
1298 |
|
|
* Searches for a part name within an ensemble. The part name
|
1299 |
|
|
* must be an exact match for an existing part name in the
|
1300 |
|
|
* ensemble. This procedure is useful for managing (i.e.,
|
1301 |
|
|
* creating and deleting) parts in an ensemble.
|
1302 |
|
|
*
|
1303 |
|
|
* Results:
|
1304 |
|
|
* If an exact match is found, this procedure returns
|
1305 |
|
|
* non-zero, along with the index of the part in posPtr.
|
1306 |
|
|
* Otherwise, it returns zero, along with an index in posPtr
|
1307 |
|
|
* indicating where the part should be.
|
1308 |
|
|
*
|
1309 |
|
|
* Side effects:
|
1310 |
|
|
* None.
|
1311 |
|
|
*
|
1312 |
|
|
*----------------------------------------------------------------------
|
1313 |
|
|
*/
|
1314 |
|
|
static int
|
1315 |
|
|
FindEnsemblePartIndex(ensData, partName, posPtr)
|
1316 |
|
|
Ensemble *ensData; /* ensemble being searched */
|
1317 |
|
|
char *partName; /* name of desired part */
|
1318 |
|
|
int *posPtr; /* returns: index for part */
|
1319 |
|
|
{
|
1320 |
|
|
int pos = 0;
|
1321 |
|
|
int first, last;
|
1322 |
|
|
int cmp;
|
1323 |
|
|
|
1324 |
|
|
/*
|
1325 |
|
|
* Search for the desired part name.
|
1326 |
|
|
* All parts are in lexicographical order, so use a
|
1327 |
|
|
* binary search to find the part quickly.
|
1328 |
|
|
*/
|
1329 |
|
|
first = 0;
|
1330 |
|
|
last = ensData->numParts-1;
|
1331 |
|
|
|
1332 |
|
|
while (last >= first) {
|
1333 |
|
|
pos = (first+last)/2;
|
1334 |
|
|
if (*partName == *ensData->parts[pos]->name) {
|
1335 |
|
|
cmp = strcmp(partName, ensData->parts[pos]->name);
|
1336 |
|
|
if (cmp == 0) {
|
1337 |
|
|
break; /* found it! */
|
1338 |
|
|
}
|
1339 |
|
|
}
|
1340 |
|
|
else if (*partName < *ensData->parts[pos]->name) {
|
1341 |
|
|
cmp = -1;
|
1342 |
|
|
}
|
1343 |
|
|
else {
|
1344 |
|
|
cmp = 1;
|
1345 |
|
|
}
|
1346 |
|
|
|
1347 |
|
|
if (cmp > 0) {
|
1348 |
|
|
first = pos+1;
|
1349 |
|
|
} else {
|
1350 |
|
|
last = pos-1;
|
1351 |
|
|
}
|
1352 |
|
|
}
|
1353 |
|
|
|
1354 |
|
|
if (last >= first) {
|
1355 |
|
|
*posPtr = pos;
|
1356 |
|
|
return 1;
|
1357 |
|
|
}
|
1358 |
|
|
*posPtr = first;
|
1359 |
|
|
return 0;
|
1360 |
|
|
}
|
1361 |
|
|
|
1362 |
|
|
|
1363 |
|
|
/*
|
1364 |
|
|
*----------------------------------------------------------------------
|
1365 |
|
|
*
|
1366 |
|
|
* ComputeMinChars --
|
1367 |
|
|
*
|
1368 |
|
|
* Compares part names on an ensemble's part list and
|
1369 |
|
|
* determines the minimum number of characters needed for a
|
1370 |
|
|
* unique abbreviation. The parts on either side of a
|
1371 |
|
|
* particular part index are compared. As long as there is
|
1372 |
|
|
* a part on one side or the other, this procedure updates
|
1373 |
|
|
* the parts to have the proper minimum abbreviations.
|
1374 |
|
|
*
|
1375 |
|
|
* Results:
|
1376 |
|
|
* None.
|
1377 |
|
|
*
|
1378 |
|
|
* Side effects:
|
1379 |
|
|
* Updates three parts within the ensemble to remember
|
1380 |
|
|
* the minimum abbreviations.
|
1381 |
|
|
*
|
1382 |
|
|
*----------------------------------------------------------------------
|
1383 |
|
|
*/
|
1384 |
|
|
static void
|
1385 |
|
|
ComputeMinChars(ensData, pos)
|
1386 |
|
|
Ensemble *ensData; /* ensemble being modified */
|
1387 |
|
|
int pos; /* index of part being updated */
|
1388 |
|
|
{
|
1389 |
|
|
int min, max;
|
1390 |
|
|
char *p, *q;
|
1391 |
|
|
|
1392 |
|
|
/*
|
1393 |
|
|
* If the position is invalid, do nothing.
|
1394 |
|
|
*/
|
1395 |
|
|
if (pos < 0 || pos >= ensData->numParts) {
|
1396 |
|
|
return;
|
1397 |
|
|
}
|
1398 |
|
|
|
1399 |
|
|
/*
|
1400 |
|
|
* Start by assuming that only the first letter is required
|
1401 |
|
|
* to uniquely identify this part. Then compare the name
|
1402 |
|
|
* against each neighboring part to determine the real minimum.
|
1403 |
|
|
*/
|
1404 |
|
|
ensData->parts[pos]->minChars = 1;
|
1405 |
|
|
|
1406 |
|
|
if (pos-1 >= 0) {
|
1407 |
|
|
p = ensData->parts[pos]->name;
|
1408 |
|
|
q = ensData->parts[pos-1]->name;
|
1409 |
|
|
for (min=1; *p == *q && *p != '\0' && *q != '\0'; min++) {
|
1410 |
|
|
p++;
|
1411 |
|
|
q++;
|
1412 |
|
|
}
|
1413 |
|
|
if (min > ensData->parts[pos]->minChars) {
|
1414 |
|
|
ensData->parts[pos]->minChars = min;
|
1415 |
|
|
}
|
1416 |
|
|
}
|
1417 |
|
|
|
1418 |
|
|
if (pos+1 < ensData->numParts) {
|
1419 |
|
|
p = ensData->parts[pos]->name;
|
1420 |
|
|
q = ensData->parts[pos+1]->name;
|
1421 |
|
|
for (min=1; *p == *q && *p != '\0' && *q != '\0'; min++) {
|
1422 |
|
|
p++;
|
1423 |
|
|
q++;
|
1424 |
|
|
}
|
1425 |
|
|
if (min > ensData->parts[pos]->minChars) {
|
1426 |
|
|
ensData->parts[pos]->minChars = min;
|
1427 |
|
|
}
|
1428 |
|
|
}
|
1429 |
|
|
|
1430 |
|
|
max = strlen(ensData->parts[pos]->name);
|
1431 |
|
|
if (ensData->parts[pos]->minChars > max) {
|
1432 |
|
|
ensData->parts[pos]->minChars = max;
|
1433 |
|
|
}
|
1434 |
|
|
}
|
1435 |
|
|
|
1436 |
|
|
|
1437 |
|
|
/*
|
1438 |
|
|
*----------------------------------------------------------------------
|
1439 |
|
|
*
|
1440 |
|
|
* HandleEnsemble --
|
1441 |
|
|
*
|
1442 |
|
|
* Invoked by Tcl whenever the user issues an ensemble-style
|
1443 |
|
|
* command. Handles commands of the form:
|
1444 |
|
|
*
|
1445 |
|
|
* <ensembleName> <partName> ?<arg> <arg>...?
|
1446 |
|
|
*
|
1447 |
|
|
* Looks for the <partName> within the ensemble, and if it
|
1448 |
|
|
* exists, the procedure transfers control to it.
|
1449 |
|
|
*
|
1450 |
|
|
* Results:
|
1451 |
|
|
* Returns TCL_OK if successful, and TCL_ERROR if anything
|
1452 |
|
|
* goes wrong.
|
1453 |
|
|
*
|
1454 |
|
|
* Side effects:
|
1455 |
|
|
* If anything goes wrong, this procedure returns an error
|
1456 |
|
|
* message as the result in the interpreter.
|
1457 |
|
|
*
|
1458 |
|
|
*----------------------------------------------------------------------
|
1459 |
|
|
*/
|
1460 |
|
|
static int
|
1461 |
|
|
HandleEnsemble(clientData, interp, objc, objv)
|
1462 |
|
|
ClientData clientData; /* ensemble data */
|
1463 |
|
|
Tcl_Interp *interp; /* current interpreter */
|
1464 |
|
|
int objc; /* number of arguments */
|
1465 |
|
|
Tcl_Obj *CONST objv[]; /* argument objects */
|
1466 |
|
|
{
|
1467 |
|
|
Ensemble *ensData = (Ensemble*)clientData;
|
1468 |
|
|
|
1469 |
|
|
int i, result;
|
1470 |
|
|
Command *cmdPtr;
|
1471 |
|
|
EnsemblePart *ensPart;
|
1472 |
|
|
char *partName;
|
1473 |
|
|
int partNameLen;
|
1474 |
|
|
Tcl_Obj *cmdlinePtr, *chainObj;
|
1475 |
|
|
int cmdlinec;
|
1476 |
|
|
Tcl_Obj **cmdlinev;
|
1477 |
|
|
|
1478 |
|
|
/*
|
1479 |
|
|
* If a part name is not specified, return an error that
|
1480 |
|
|
* summarizes the usage for this ensemble.
|
1481 |
|
|
*/
|
1482 |
|
|
if (objc < 2) {
|
1483 |
|
|
Tcl_Obj *resultPtr = Tcl_NewStringObj(
|
1484 |
|
|
"wrong # args: should be one of...\n", -1);
|
1485 |
|
|
|
1486 |
|
|
GetEnsembleUsage(ensData, resultPtr);
|
1487 |
|
|
Tcl_SetObjResult(interp, resultPtr);
|
1488 |
|
|
return TCL_ERROR;
|
1489 |
|
|
}
|
1490 |
|
|
|
1491 |
|
|
/*
|
1492 |
|
|
* Lookup the desired part. If an ambiguous abbrevition is
|
1493 |
|
|
* found, return an error immediately.
|
1494 |
|
|
*/
|
1495 |
|
|
partName = Tcl_GetStringFromObj(objv[1], &partNameLen);
|
1496 |
|
|
if (FindEnsemblePart(interp, ensData, partName, &ensPart) != TCL_OK) {
|
1497 |
|
|
return TCL_ERROR;
|
1498 |
|
|
}
|
1499 |
|
|
|
1500 |
|
|
/*
|
1501 |
|
|
* If the part was not found, then look for an "@error" part
|
1502 |
|
|
* to handle the error.
|
1503 |
|
|
*/
|
1504 |
|
|
if (ensPart == NULL) {
|
1505 |
|
|
if (FindEnsemblePart(interp, ensData, "@error", &ensPart) != TCL_OK) {
|
1506 |
|
|
return TCL_ERROR;
|
1507 |
|
|
}
|
1508 |
|
|
if (ensPart != NULL) {
|
1509 |
|
|
cmdPtr = (Command*)ensPart->cmdPtr;
|
1510 |
|
|
result = (*cmdPtr->objProc)(cmdPtr->objClientData,
|
1511 |
|
|
interp, objc, objv);
|
1512 |
|
|
return result;
|
1513 |
|
|
}
|
1514 |
|
|
}
|
1515 |
|
|
if (ensPart == NULL) {
|
1516 |
|
|
return Itcl_EnsembleErrorCmd((ClientData)ensData,
|
1517 |
|
|
interp, objc-1, objv+1);
|
1518 |
|
|
}
|
1519 |
|
|
|
1520 |
|
|
/*
|
1521 |
|
|
* Pass control to the part, and return the result.
|
1522 |
|
|
*/
|
1523 |
|
|
chainObj = Tcl_NewObj();
|
1524 |
|
|
chainObj->bytes = NULL;
|
1525 |
|
|
chainObj->typePtr = &itclEnsInvocType;
|
1526 |
|
|
chainObj->internalRep.twoPtrValue.ptr1 = (VOID *) ensPart;
|
1527 |
|
|
Tcl_IncrRefCount(objv[1]);
|
1528 |
|
|
chainObj->internalRep.twoPtrValue.ptr2 = (VOID *) objv[0];
|
1529 |
|
|
Tcl_IncrRefCount(objv[0]);
|
1530 |
|
|
|
1531 |
|
|
cmdlinePtr = Tcl_NewListObj(0, (Tcl_Obj**)NULL);
|
1532 |
|
|
Tcl_ListObjAppendElement((Tcl_Interp*)NULL, cmdlinePtr, chainObj);
|
1533 |
|
|
for (i=2; i < objc; i++) {
|
1534 |
|
|
Tcl_ListObjAppendElement((Tcl_Interp*)NULL, cmdlinePtr, objv[i]);
|
1535 |
|
|
}
|
1536 |
|
|
Tcl_IncrRefCount(cmdlinePtr);
|
1537 |
|
|
|
1538 |
|
|
result = Tcl_ListObjGetElements((Tcl_Interp*)NULL, cmdlinePtr,
|
1539 |
|
|
&cmdlinec, &cmdlinev);
|
1540 |
|
|
|
1541 |
|
|
if (result == TCL_OK) {
|
1542 |
|
|
cmdPtr = (Command*)ensPart->cmdPtr;
|
1543 |
|
|
result = (*cmdPtr->objProc)(cmdPtr->objClientData, interp,
|
1544 |
|
|
cmdlinec, cmdlinev);
|
1545 |
|
|
}
|
1546 |
|
|
Tcl_DecrRefCount(cmdlinePtr);
|
1547 |
|
|
|
1548 |
|
|
return result;
|
1549 |
|
|
}
|
1550 |
|
|
|
1551 |
|
|
|
1552 |
|
|
/*
|
1553 |
|
|
*----------------------------------------------------------------------
|
1554 |
|
|
*
|
1555 |
|
|
* Itcl_EnsembleCmd --
|
1556 |
|
|
*
|
1557 |
|
|
* Invoked by Tcl whenever the user issues the "ensemble"
|
1558 |
|
|
* command to manipulate an ensemble. Handles the following
|
1559 |
|
|
* syntax:
|
1560 |
|
|
*
|
1561 |
|
|
* ensemble <ensName> ?<command> <arg> <arg>...?
|
1562 |
|
|
* ensemble <ensName> {
|
1563 |
|
|
* part <partName> <args> <body>
|
1564 |
|
|
* ensemble <ensName> {
|
1565 |
|
|
* ...
|
1566 |
|
|
* }
|
1567 |
|
|
* }
|
1568 |
|
|
*
|
1569 |
|
|
* Finds or creates the ensemble <ensName>, and then executes
|
1570 |
|
|
* the commands to add parts.
|
1571 |
|
|
*
|
1572 |
|
|
* Results:
|
1573 |
|
|
* Returns TCL_OK if successful, and TCL_ERROR if anything
|
1574 |
|
|
* goes wrong.
|
1575 |
|
|
*
|
1576 |
|
|
* Side effects:
|
1577 |
|
|
* If anything goes wrong, this procedure returns an error
|
1578 |
|
|
* message as the result in the interpreter.
|
1579 |
|
|
*
|
1580 |
|
|
*----------------------------------------------------------------------
|
1581 |
|
|
*/
|
1582 |
|
|
int
|
1583 |
|
|
Itcl_EnsembleCmd(clientData, interp, objc, objv)
|
1584 |
|
|
ClientData clientData; /* ensemble data */
|
1585 |
|
|
Tcl_Interp *interp; /* current interpreter */
|
1586 |
|
|
int objc; /* number of arguments */
|
1587 |
|
|
Tcl_Obj *CONST objv[]; /* argument objects */
|
1588 |
|
|
{
|
1589 |
|
|
int status;
|
1590 |
|
|
char *ensName;
|
1591 |
|
|
EnsembleParser *ensInfo;
|
1592 |
|
|
Ensemble *ensData, *savedEnsData;
|
1593 |
|
|
EnsemblePart *ensPart;
|
1594 |
|
|
Tcl_Command cmd;
|
1595 |
|
|
Command *cmdPtr;
|
1596 |
|
|
Tcl_Obj *objPtr;
|
1597 |
|
|
|
1598 |
|
|
/*
|
1599 |
|
|
* Make sure that an ensemble name was specified.
|
1600 |
|
|
*/
|
1601 |
|
|
if (objc < 2) {
|
1602 |
|
|
Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
|
1603 |
|
|
"wrong # args: should be \"",
|
1604 |
|
|
Tcl_GetStringFromObj(objv[0], (int*)NULL),
|
1605 |
|
|
" name ?command arg arg...?\"",
|
1606 |
|
|
(char*)NULL);
|
1607 |
|
|
return TCL_ERROR;
|
1608 |
|
|
}
|
1609 |
|
|
|
1610 |
|
|
/*
|
1611 |
|
|
* If this is the "ensemble" command in the main interpreter,
|
1612 |
|
|
* then the client data will be null. Otherwise, it is
|
1613 |
|
|
* the "ensemble" command in the ensemble body parser, and
|
1614 |
|
|
* the client data indicates which ensemble we are modifying.
|
1615 |
|
|
*/
|
1616 |
|
|
if (clientData) {
|
1617 |
|
|
ensInfo = (EnsembleParser*)clientData;
|
1618 |
|
|
} else {
|
1619 |
|
|
ensInfo = GetEnsembleParser(interp);
|
1620 |
|
|
}
|
1621 |
|
|
ensData = ensInfo->ensData;
|
1622 |
|
|
|
1623 |
|
|
/*
|
1624 |
|
|
* Find or create the desired ensemble. If an ensemble is
|
1625 |
|
|
* being built, then this "ensemble" command is enclosed in
|
1626 |
|
|
* another "ensemble" command. Use the current ensemble as
|
1627 |
|
|
* the parent, and find or create an ensemble part within it.
|
1628 |
|
|
*/
|
1629 |
|
|
ensName = Tcl_GetStringFromObj(objv[1], (int*)NULL);
|
1630 |
|
|
|
1631 |
|
|
if (ensData) {
|
1632 |
|
|
if (FindEnsemblePart(interp, ensData, ensName, &ensPart) != TCL_OK) {
|
1633 |
|
|
ensPart = NULL;
|
1634 |
|
|
}
|
1635 |
|
|
if (ensPart == NULL) {
|
1636 |
|
|
if (CreateEnsemble(interp, ensData, ensName) != TCL_OK) {
|
1637 |
|
|
return TCL_ERROR;
|
1638 |
|
|
}
|
1639 |
|
|
if (FindEnsemblePart(interp, ensData, ensName, &ensPart)
|
1640 |
|
|
!= TCL_OK) {
|
1641 |
|
|
panic("Itcl_EnsembleCmd: can't create ensemble");
|
1642 |
|
|
}
|
1643 |
|
|
}
|
1644 |
|
|
|
1645 |
|
|
cmdPtr = (Command*)ensPart->cmdPtr;
|
1646 |
|
|
if (cmdPtr->deleteProc != DeleteEnsemble) {
|
1647 |
|
|
Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
|
1648 |
|
|
"part \"", Tcl_GetStringFromObj(objv[1], (int*)NULL),
|
1649 |
|
|
"\" is not an ensemble",
|
1650 |
|
|
(char*)NULL);
|
1651 |
|
|
return TCL_ERROR;
|
1652 |
|
|
}
|
1653 |
|
|
ensData = (Ensemble*)cmdPtr->objClientData;
|
1654 |
|
|
}
|
1655 |
|
|
|
1656 |
|
|
/*
|
1657 |
|
|
* Otherwise, the desired ensemble is a top-level ensemble.
|
1658 |
|
|
* Find or create the access command for the ensemble, and
|
1659 |
|
|
* then get its data.
|
1660 |
|
|
*/
|
1661 |
|
|
else {
|
1662 |
|
|
cmd = Tcl_FindCommand(interp, ensName, (Tcl_Namespace*)NULL, 0);
|
1663 |
|
|
if (cmd == NULL) {
|
1664 |
|
|
if (CreateEnsemble(interp, (Ensemble*)NULL, ensName)
|
1665 |
|
|
!= TCL_OK) {
|
1666 |
|
|
return TCL_ERROR;
|
1667 |
|
|
}
|
1668 |
|
|
cmd = Tcl_FindCommand(interp, ensName, (Tcl_Namespace*)NULL, 0);
|
1669 |
|
|
}
|
1670 |
|
|
cmdPtr = (Command*)cmd;
|
1671 |
|
|
|
1672 |
|
|
if (cmdPtr == NULL || cmdPtr->deleteProc != DeleteEnsemble) {
|
1673 |
|
|
Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
|
1674 |
|
|
"command \"", Tcl_GetStringFromObj(objv[1], (int*)NULL),
|
1675 |
|
|
"\" is not an ensemble",
|
1676 |
|
|
(char*)NULL);
|
1677 |
|
|
return TCL_ERROR;
|
1678 |
|
|
}
|
1679 |
|
|
ensData = (Ensemble*)cmdPtr->objClientData;
|
1680 |
|
|
}
|
1681 |
|
|
|
1682 |
|
|
/*
|
1683 |
|
|
* At this point, we have the data for the ensemble that is
|
1684 |
|
|
* being manipulated. Plug this into the parser, and then
|
1685 |
|
|
* interpret the rest of the arguments in the ensemble parser.
|
1686 |
|
|
*/
|
1687 |
|
|
status = TCL_OK;
|
1688 |
|
|
savedEnsData = ensInfo->ensData;
|
1689 |
|
|
ensInfo->ensData = ensData;
|
1690 |
|
|
|
1691 |
|
|
if (objc == 3) {
|
1692 |
|
|
/* CYGNUS LOCAL - fix for Tcl8.1 */
|
1693 |
|
|
#if TCL_MAJOR_VERSION == 8 && TCL_MINOR_VERSION == 0
|
1694 |
|
|
status = Tcl_EvalObj(ensInfo->parser, objv[2]);
|
1695 |
|
|
#else
|
1696 |
|
|
status = Tcl_EvalObj(ensInfo->parser, objv[2], 0);
|
1697 |
|
|
#endif
|
1698 |
|
|
}
|
1699 |
|
|
else if (objc > 3) {
|
1700 |
|
|
objPtr = Tcl_NewListObj(objc-2, objv+2);
|
1701 |
|
|
#if TCL_MAJOR_VERSION == 8 && TCL_MINOR_VERSION == 0
|
1702 |
|
|
status = Tcl_EvalObj(ensInfo->parser, objPtr);
|
1703 |
|
|
#else
|
1704 |
|
|
Tcl_IncrRefCount(objPtr);
|
1705 |
|
|
status = Tcl_EvalObj(ensInfo->parser, objPtr, 0);
|
1706 |
|
|
#endif
|
1707 |
|
|
/* END CYGNUS LOCAL */
|
1708 |
|
|
Tcl_DecrRefCount(objPtr); /* we're done with the object */
|
1709 |
|
|
}
|
1710 |
|
|
|
1711 |
|
|
/*
|
1712 |
|
|
* Copy the result from the parser interpreter to the
|
1713 |
|
|
* master interpreter. If an error was encountered,
|
1714 |
|
|
* copy the error info first, and then set the result.
|
1715 |
|
|
* Otherwise, the offending command is reported twice.
|
1716 |
|
|
*/
|
1717 |
|
|
if (status == TCL_ERROR) {
|
1718 |
|
|
char *errInfo = Tcl_GetVar2(ensInfo->parser, "::errorInfo",
|
1719 |
|
|
(char*)NULL, TCL_GLOBAL_ONLY);
|
1720 |
|
|
|
1721 |
|
|
if (errInfo) {
|
1722 |
|
|
Tcl_AddObjErrorInfo(interp, errInfo, -1);
|
1723 |
|
|
}
|
1724 |
|
|
|
1725 |
|
|
if (objc == 3) {
|
1726 |
|
|
char msg[128];
|
1727 |
|
|
sprintf(msg, "\n (\"ensemble\" body line %d)",
|
1728 |
|
|
ensInfo->parser->errorLine);
|
1729 |
|
|
Tcl_AddObjErrorInfo(interp, msg, -1);
|
1730 |
|
|
}
|
1731 |
|
|
}
|
1732 |
|
|
Tcl_SetObjResult(interp, Tcl_GetObjResult(ensInfo->parser));
|
1733 |
|
|
|
1734 |
|
|
ensInfo->ensData = savedEnsData;
|
1735 |
|
|
return status;
|
1736 |
|
|
}
|
1737 |
|
|
|
1738 |
|
|
|
1739 |
|
|
/*
|
1740 |
|
|
*----------------------------------------------------------------------
|
1741 |
|
|
*
|
1742 |
|
|
* GetEnsembleParser --
|
1743 |
|
|
*
|
1744 |
|
|
* Returns the slave interpreter that acts as a parser for
|
1745 |
|
|
* the body of an "ensemble" definition. The first time that
|
1746 |
|
|
* this is called for an interpreter, the parser is created
|
1747 |
|
|
* and registered as associated data. After that, it is
|
1748 |
|
|
* simply returned.
|
1749 |
|
|
*
|
1750 |
|
|
* Results:
|
1751 |
|
|
* Returns a pointer to the ensemble parser data structure.
|
1752 |
|
|
*
|
1753 |
|
|
* Side effects:
|
1754 |
|
|
* On the first call, the ensemble parser is created and
|
1755 |
|
|
* registered as "itcl_ensembleParser" with the interpreter.
|
1756 |
|
|
*
|
1757 |
|
|
*----------------------------------------------------------------------
|
1758 |
|
|
*/
|
1759 |
|
|
static EnsembleParser*
|
1760 |
|
|
GetEnsembleParser(interp)
|
1761 |
|
|
Tcl_Interp *interp; /* interpreter handling the ensemble */
|
1762 |
|
|
{
|
1763 |
|
|
Namespace *nsPtr;
|
1764 |
|
|
Tcl_Namespace *childNs;
|
1765 |
|
|
EnsembleParser *ensInfo;
|
1766 |
|
|
Tcl_HashEntry *hPtr;
|
1767 |
|
|
Tcl_HashSearch search;
|
1768 |
|
|
Tcl_Command cmd;
|
1769 |
|
|
|
1770 |
|
|
/*
|
1771 |
|
|
* Look for an existing ensemble parser. If it is found,
|
1772 |
|
|
* return it immediately.
|
1773 |
|
|
*/
|
1774 |
|
|
ensInfo = (EnsembleParser*) Tcl_GetAssocData(interp,
|
1775 |
|
|
"itcl_ensembleParser", NULL);
|
1776 |
|
|
|
1777 |
|
|
if (ensInfo) {
|
1778 |
|
|
return ensInfo;
|
1779 |
|
|
}
|
1780 |
|
|
|
1781 |
|
|
/*
|
1782 |
|
|
* Create a slave interpreter that can be used to parse
|
1783 |
|
|
* the body of an ensemble definition.
|
1784 |
|
|
*/
|
1785 |
|
|
ensInfo = (EnsembleParser*)ckalloc(sizeof(EnsembleParser));
|
1786 |
|
|
ensInfo->master = interp;
|
1787 |
|
|
ensInfo->parser = Tcl_CreateInterp();
|
1788 |
|
|
ensInfo->ensData = NULL;
|
1789 |
|
|
|
1790 |
|
|
/*
|
1791 |
|
|
* Remove all namespaces and all normal commands from the
|
1792 |
|
|
* parser interpreter.
|
1793 |
|
|
*/
|
1794 |
|
|
nsPtr = (Namespace*)Tcl_GetGlobalNamespace(ensInfo->parser);
|
1795 |
|
|
|
1796 |
|
|
for (hPtr = Tcl_FirstHashEntry(&nsPtr->childTable, &search);
|
1797 |
|
|
hPtr != NULL;
|
1798 |
|
|
hPtr = Tcl_FirstHashEntry(&nsPtr->childTable, &search)) {
|
1799 |
|
|
|
1800 |
|
|
childNs = (Tcl_Namespace*)Tcl_GetHashValue(hPtr);
|
1801 |
|
|
Tcl_DeleteNamespace(childNs);
|
1802 |
|
|
}
|
1803 |
|
|
|
1804 |
|
|
for (hPtr = Tcl_FirstHashEntry(&nsPtr->cmdTable, &search);
|
1805 |
|
|
hPtr != NULL;
|
1806 |
|
|
hPtr = Tcl_FirstHashEntry(&nsPtr->cmdTable, &search)) {
|
1807 |
|
|
|
1808 |
|
|
cmd = (Tcl_Command)Tcl_GetHashValue(hPtr);
|
1809 |
|
|
Tcl_DeleteCommandFromToken(ensInfo->parser, cmd);
|
1810 |
|
|
}
|
1811 |
|
|
|
1812 |
|
|
/*
|
1813 |
|
|
* Add the allowed commands to the parser interpreter:
|
1814 |
|
|
* part, delete, ensemble
|
1815 |
|
|
*/
|
1816 |
|
|
Tcl_CreateObjCommand(ensInfo->parser, "part", Itcl_EnsPartCmd,
|
1817 |
|
|
(ClientData)ensInfo, (Tcl_CmdDeleteProc*)NULL);
|
1818 |
|
|
|
1819 |
|
|
Tcl_CreateObjCommand(ensInfo->parser, "option", Itcl_EnsPartCmd,
|
1820 |
|
|
(ClientData)ensInfo, (Tcl_CmdDeleteProc*)NULL);
|
1821 |
|
|
|
1822 |
|
|
Tcl_CreateObjCommand(ensInfo->parser, "ensemble", Itcl_EnsembleCmd,
|
1823 |
|
|
(ClientData)ensInfo, (Tcl_CmdDeleteProc*)NULL);
|
1824 |
|
|
|
1825 |
|
|
/*
|
1826 |
|
|
* Install the parser data, so we'll have it the next time
|
1827 |
|
|
* we call this procedure.
|
1828 |
|
|
*/
|
1829 |
|
|
(void) Tcl_SetAssocData(interp, "itcl_ensembleParser",
|
1830 |
|
|
DeleteEnsParser, (ClientData)ensInfo);
|
1831 |
|
|
|
1832 |
|
|
return ensInfo;
|
1833 |
|
|
}
|
1834 |
|
|
|
1835 |
|
|
|
1836 |
|
|
/*
|
1837 |
|
|
*----------------------------------------------------------------------
|
1838 |
|
|
*
|
1839 |
|
|
* DeleteEnsParser --
|
1840 |
|
|
*
|
1841 |
|
|
* Called when an interpreter is destroyed to clean up the
|
1842 |
|
|
* ensemble parser within it. Destroys the slave interpreter
|
1843 |
|
|
* and frees up the data associated with it.
|
1844 |
|
|
*
|
1845 |
|
|
* Results:
|
1846 |
|
|
* None.
|
1847 |
|
|
*
|
1848 |
|
|
* Side effects:
|
1849 |
|
|
* None.
|
1850 |
|
|
*
|
1851 |
|
|
*----------------------------------------------------------------------
|
1852 |
|
|
*/
|
1853 |
|
|
/* ARGSUSED */
|
1854 |
|
|
static void
|
1855 |
|
|
DeleteEnsParser(clientData, interp)
|
1856 |
|
|
ClientData clientData; /* client data for ensemble-related commands */
|
1857 |
|
|
Tcl_Interp *interp; /* interpreter containing the data */
|
1858 |
|
|
{
|
1859 |
|
|
EnsembleParser* ensInfo = (EnsembleParser*)clientData;
|
1860 |
|
|
Tcl_DeleteInterp(ensInfo->parser);
|
1861 |
|
|
ckfree((char*)ensInfo);
|
1862 |
|
|
}
|
1863 |
|
|
|
1864 |
|
|
|
1865 |
|
|
/*
|
1866 |
|
|
*----------------------------------------------------------------------
|
1867 |
|
|
*
|
1868 |
|
|
* Itcl_EnsPartCmd --
|
1869 |
|
|
*
|
1870 |
|
|
* Invoked by Tcl whenever the user issues the "part" command
|
1871 |
|
|
* to manipulate an ensemble. This command can only be used
|
1872 |
|
|
* inside the "ensemble" command, which handles ensembles.
|
1873 |
|
|
* Handles the following syntax:
|
1874 |
|
|
*
|
1875 |
|
|
* ensemble <ensName> {
|
1876 |
|
|
* part <partName> <args> <body>
|
1877 |
|
|
* }
|
1878 |
|
|
*
|
1879 |
|
|
* Adds a new part called <partName> to the ensemble. If a
|
1880 |
|
|
* part already exists with that name, it is an error. The
|
1881 |
|
|
* new part is handled just like an ordinary Tcl proc, with
|
1882 |
|
|
* a list of <args> and a <body> of code to execute.
|
1883 |
|
|
*
|
1884 |
|
|
* Results:
|
1885 |
|
|
* Returns TCL_OK if successful, and TCL_ERROR if anything
|
1886 |
|
|
* goes wrong.
|
1887 |
|
|
*
|
1888 |
|
|
* Side effects:
|
1889 |
|
|
* If anything goes wrong, this procedure returns an error
|
1890 |
|
|
* message as the result in the interpreter.
|
1891 |
|
|
*
|
1892 |
|
|
*----------------------------------------------------------------------
|
1893 |
|
|
*/
|
1894 |
|
|
int
|
1895 |
|
|
Itcl_EnsPartCmd(clientData, interp, objc, objv)
|
1896 |
|
|
ClientData clientData; /* ensemble data */
|
1897 |
|
|
Tcl_Interp *interp; /* current interpreter */
|
1898 |
|
|
int objc; /* number of arguments */
|
1899 |
|
|
Tcl_Obj *CONST objv[]; /* argument objects */
|
1900 |
|
|
{
|
1901 |
|
|
EnsembleParser *ensInfo = (EnsembleParser*)clientData;
|
1902 |
|
|
Ensemble *ensData = (Ensemble*)ensInfo->ensData;
|
1903 |
|
|
|
1904 |
|
|
int status, varArgs, space;
|
1905 |
|
|
char *partName, *usage;
|
1906 |
|
|
Proc *procPtr;
|
1907 |
|
|
Command *cmdPtr;
|
1908 |
|
|
CompiledLocal *localPtr;
|
1909 |
|
|
EnsemblePart *ensPart;
|
1910 |
|
|
Tcl_DString buffer;
|
1911 |
|
|
|
1912 |
|
|
if (objc != 4) {
|
1913 |
|
|
Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
|
1914 |
|
|
"wrong # args: should be \"",
|
1915 |
|
|
Tcl_GetStringFromObj(objv[0], (int*)NULL),
|
1916 |
|
|
" name args body\"",
|
1917 |
|
|
(char*)NULL);
|
1918 |
|
|
return TCL_ERROR;
|
1919 |
|
|
}
|
1920 |
|
|
|
1921 |
|
|
/*
|
1922 |
|
|
* Create a Tcl-style proc definition using the specified args
|
1923 |
|
|
* and body. This is not a proc in the usual sense. It belongs
|
1924 |
|
|
* to the namespace that contains the ensemble, but it is
|
1925 |
|
|
* accessed through the ensemble, not through a Tcl command.
|
1926 |
|
|
*/
|
1927 |
|
|
partName = Tcl_GetStringFromObj(objv[1], (int*)NULL);
|
1928 |
|
|
cmdPtr = (Command*)ensData->cmd;
|
1929 |
|
|
|
1930 |
|
|
if (TclCreateProc(interp, cmdPtr->nsPtr, partName, objv[2], objv[3],
|
1931 |
|
|
&procPtr) != TCL_OK) {
|
1932 |
|
|
return TCL_ERROR;
|
1933 |
|
|
}
|
1934 |
|
|
|
1935 |
|
|
/*
|
1936 |
|
|
* Deduce the usage information from the argument list.
|
1937 |
|
|
* We'll register this when we create the part, in a moment.
|
1938 |
|
|
*/
|
1939 |
|
|
Tcl_DStringInit(&buffer);
|
1940 |
|
|
varArgs = 0;
|
1941 |
|
|
space = 0;
|
1942 |
|
|
|
1943 |
|
|
for (localPtr=procPtr->firstLocalPtr;
|
1944 |
|
|
localPtr != NULL;
|
1945 |
|
|
localPtr=localPtr->nextPtr) {
|
1946 |
|
|
|
1947 |
|
|
if (TclIsVarArgument(localPtr)) {
|
1948 |
|
|
varArgs = 0;
|
1949 |
|
|
if (strcmp(localPtr->name, "args") == 0) {
|
1950 |
|
|
varArgs = 1;
|
1951 |
|
|
}
|
1952 |
|
|
else if (localPtr->defValuePtr) {
|
1953 |
|
|
if (space) {
|
1954 |
|
|
Tcl_DStringAppend(&buffer, " ", 1);
|
1955 |
|
|
}
|
1956 |
|
|
Tcl_DStringAppend(&buffer, "?", 1);
|
1957 |
|
|
Tcl_DStringAppend(&buffer, localPtr->name, -1);
|
1958 |
|
|
Tcl_DStringAppend(&buffer, "?", 1);
|
1959 |
|
|
space = 1;
|
1960 |
|
|
}
|
1961 |
|
|
else {
|
1962 |
|
|
if (space) {
|
1963 |
|
|
Tcl_DStringAppend(&buffer, " ", 1);
|
1964 |
|
|
}
|
1965 |
|
|
Tcl_DStringAppend(&buffer, localPtr->name, -1);
|
1966 |
|
|
space = 1;
|
1967 |
|
|
}
|
1968 |
|
|
}
|
1969 |
|
|
}
|
1970 |
|
|
if (varArgs) {
|
1971 |
|
|
if (space) {
|
1972 |
|
|
Tcl_DStringAppend(&buffer, " ", 1);
|
1973 |
|
|
}
|
1974 |
|
|
Tcl_DStringAppend(&buffer, "?arg arg ...?", 13);
|
1975 |
|
|
}
|
1976 |
|
|
|
1977 |
|
|
usage = Tcl_DStringValue(&buffer);
|
1978 |
|
|
|
1979 |
|
|
/*
|
1980 |
|
|
* Create a new part within the ensemble. If successful,
|
1981 |
|
|
* plug the command token into the proc; we'll need it later
|
1982 |
|
|
* if we try to compile the Tcl code for the part. If
|
1983 |
|
|
* anything goes wrong, clean up before bailing out.
|
1984 |
|
|
*/
|
1985 |
|
|
status = AddEnsemblePart(interp, ensData, partName, usage,
|
1986 |
|
|
TclObjInterpProc, (ClientData)procPtr, TclProcDeleteProc,
|
1987 |
|
|
&ensPart);
|
1988 |
|
|
|
1989 |
|
|
if (status == TCL_OK) {
|
1990 |
|
|
procPtr->cmdPtr = ensPart->cmdPtr;
|
1991 |
|
|
} else {
|
1992 |
|
|
TclProcDeleteProc((ClientData)procPtr);
|
1993 |
|
|
}
|
1994 |
|
|
Tcl_DStringFree(&buffer);
|
1995 |
|
|
|
1996 |
|
|
return status;
|
1997 |
|
|
}
|
1998 |
|
|
|
1999 |
|
|
|
2000 |
|
|
/*
|
2001 |
|
|
*----------------------------------------------------------------------
|
2002 |
|
|
*
|
2003 |
|
|
* Itcl_EnsembleErrorCmd --
|
2004 |
|
|
*
|
2005 |
|
|
* Invoked when the user tries to access an unknown part for
|
2006 |
|
|
* an ensemble. Acts as the default handler for the "@error"
|
2007 |
|
|
* part. Generates an error message like:
|
2008 |
|
|
*
|
2009 |
|
|
* bad option "foo": should be one of...
|
2010 |
|
|
* info args procname
|
2011 |
|
|
* info body procname
|
2012 |
|
|
* info cmdcount
|
2013 |
|
|
* ...
|
2014 |
|
|
*
|
2015 |
|
|
* Results:
|
2016 |
|
|
* Always returns TCL_OK.
|
2017 |
|
|
*
|
2018 |
|
|
* Side effects:
|
2019 |
|
|
* Returns the error message as the result in the interpreter.
|
2020 |
|
|
*
|
2021 |
|
|
*----------------------------------------------------------------------
|
2022 |
|
|
*/
|
2023 |
|
|
/* ARGSUSED */
|
2024 |
|
|
int
|
2025 |
|
|
Itcl_EnsembleErrorCmd(clientData, interp, objc, objv)
|
2026 |
|
|
ClientData clientData; /* ensemble info */
|
2027 |
|
|
Tcl_Interp *interp; /* current interpreter */
|
2028 |
|
|
int objc; /* number of arguments */
|
2029 |
|
|
Tcl_Obj *CONST objv[]; /* argument objects */
|
2030 |
|
|
{
|
2031 |
|
|
Ensemble *ensData = (Ensemble*)clientData;
|
2032 |
|
|
|
2033 |
|
|
char *cmdName;
|
2034 |
|
|
Tcl_Obj *objPtr;
|
2035 |
|
|
|
2036 |
|
|
cmdName = Tcl_GetStringFromObj(objv[0], (int*)NULL);
|
2037 |
|
|
|
2038 |
|
|
objPtr = Tcl_NewStringObj((char*)NULL, 0);
|
2039 |
|
|
Tcl_AppendStringsToObj(objPtr,
|
2040 |
|
|
"bad option \"", cmdName, "\": should be one of...\n",
|
2041 |
|
|
(char*)NULL);
|
2042 |
|
|
GetEnsembleUsage(ensData, objPtr);
|
2043 |
|
|
|
2044 |
|
|
Tcl_SetObjResult(interp, objPtr);
|
2045 |
|
|
return TCL_ERROR;
|
2046 |
|
|
}
|
2047 |
|
|
|
2048 |
|
|
|
2049 |
|
|
/*
|
2050 |
|
|
*----------------------------------------------------------------------
|
2051 |
|
|
*
|
2052 |
|
|
* FreeEnsInvocInternalRep --
|
2053 |
|
|
*
|
2054 |
|
|
* Frees the resources associated with an ensembleInvoc object's
|
2055 |
|
|
* internal representation.
|
2056 |
|
|
*
|
2057 |
|
|
* Results:
|
2058 |
|
|
* None.
|
2059 |
|
|
*
|
2060 |
|
|
* Side effects:
|
2061 |
|
|
* Decrements the ref count of the two objects referenced by
|
2062 |
|
|
* this object. If there are no more uses, this will free
|
2063 |
|
|
* the other objects.
|
2064 |
|
|
*
|
2065 |
|
|
*----------------------------------------------------------------------
|
2066 |
|
|
*/
|
2067 |
|
|
static void
|
2068 |
|
|
FreeEnsInvocInternalRep(objPtr)
|
2069 |
|
|
register Tcl_Obj *objPtr; /* namespName object with internal
|
2070 |
|
|
* representation to free */
|
2071 |
|
|
{
|
2072 |
|
|
Tcl_Obj *prevArgObj = (Tcl_Obj*)objPtr->internalRep.twoPtrValue.ptr2;
|
2073 |
|
|
|
2074 |
|
|
if (prevArgObj) {
|
2075 |
|
|
Tcl_DecrRefCount(prevArgObj);
|
2076 |
|
|
}
|
2077 |
|
|
}
|
2078 |
|
|
|
2079 |
|
|
|
2080 |
|
|
/*
|
2081 |
|
|
*----------------------------------------------------------------------
|
2082 |
|
|
*
|
2083 |
|
|
* DupEnsInvocInternalRep --
|
2084 |
|
|
*
|
2085 |
|
|
* Initializes the internal representation of an ensembleInvoc
|
2086 |
|
|
* object to a copy of the internal representation of
|
2087 |
|
|
* another ensembleInvoc object.
|
2088 |
|
|
*
|
2089 |
|
|
* This shouldn't be called. Normally, a temporary ensembleInvoc
|
2090 |
|
|
* object is created while an ensemble call is in progress.
|
2091 |
|
|
* This object may be converted to string form if an error occurs.
|
2092 |
|
|
* It does not stay around long, and there is no reason for it
|
2093 |
|
|
* to be duplicated.
|
2094 |
|
|
*
|
2095 |
|
|
* Results:
|
2096 |
|
|
* None.
|
2097 |
|
|
*
|
2098 |
|
|
* Side effects:
|
2099 |
|
|
* copyPtr's internal rep is set to duplicates of the objects
|
2100 |
|
|
* pointed to by srcPtr's internal rep.
|
2101 |
|
|
*
|
2102 |
|
|
*----------------------------------------------------------------------
|
2103 |
|
|
*/
|
2104 |
|
|
static void
|
2105 |
|
|
DupEnsInvocInternalRep(srcPtr, copyPtr)
|
2106 |
|
|
Tcl_Obj *srcPtr; /* Object with internal rep to copy. */
|
2107 |
|
|
register Tcl_Obj *copyPtr; /* Object with internal rep to set. */
|
2108 |
|
|
{
|
2109 |
|
|
EnsemblePart *ensPart = (EnsemblePart*)srcPtr->internalRep.twoPtrValue.ptr1;
|
2110 |
|
|
Tcl_Obj *prevArgObj = (Tcl_Obj*)srcPtr->internalRep.twoPtrValue.ptr2;
|
2111 |
|
|
Tcl_Obj *objPtr;
|
2112 |
|
|
|
2113 |
|
|
copyPtr->internalRep.twoPtrValue.ptr1 = (VOID *) ensPart;
|
2114 |
|
|
|
2115 |
|
|
if (prevArgObj) {
|
2116 |
|
|
objPtr = Tcl_DuplicateObj(prevArgObj);
|
2117 |
|
|
copyPtr->internalRep.twoPtrValue.ptr2 = (VOID *) objPtr;
|
2118 |
|
|
}
|
2119 |
|
|
}
|
2120 |
|
|
|
2121 |
|
|
|
2122 |
|
|
/*
|
2123 |
|
|
*----------------------------------------------------------------------
|
2124 |
|
|
*
|
2125 |
|
|
* SetEnsInvocFromAny --
|
2126 |
|
|
*
|
2127 |
|
|
* Generates the internal representation for an ensembleInvoc
|
2128 |
|
|
* object. This conversion really shouldn't take place.
|
2129 |
|
|
* Normally, a temporary ensembleInvoc object is created while
|
2130 |
|
|
* an ensemble call is in progress. This object may be converted
|
2131 |
|
|
* to string form if an error occurs. But there is no reason
|
2132 |
|
|
* for any other object to be converted to ensembleInvoc form.
|
2133 |
|
|
*
|
2134 |
|
|
* Results:
|
2135 |
|
|
* Always returns TCL_OK.
|
2136 |
|
|
*
|
2137 |
|
|
* Side effects:
|
2138 |
|
|
* The string representation is saved as if it were the
|
2139 |
|
|
* command line argument for the ensemble invocation. The
|
2140 |
|
|
* reference to the ensemble part is set to NULL.
|
2141 |
|
|
*
|
2142 |
|
|
*----------------------------------------------------------------------
|
2143 |
|
|
*/
|
2144 |
|
|
static int
|
2145 |
|
|
SetEnsInvocFromAny(interp, objPtr)
|
2146 |
|
|
Tcl_Interp *interp; /* Determines the context for
|
2147 |
|
|
name resolution */
|
2148 |
|
|
register Tcl_Obj *objPtr; /* The object to convert */
|
2149 |
|
|
{
|
2150 |
|
|
int length;
|
2151 |
|
|
char *name;
|
2152 |
|
|
Tcl_Obj *argObj;
|
2153 |
|
|
|
2154 |
|
|
/*
|
2155 |
|
|
* Get objPtr's string representation.
|
2156 |
|
|
* Make it up-to-date if necessary.
|
2157 |
|
|
* THIS FAILS IF THE OBJECT'S STRING REP CONTAINS NULLS.
|
2158 |
|
|
*/
|
2159 |
|
|
name = Tcl_GetStringFromObj(objPtr, &length);
|
2160 |
|
|
|
2161 |
|
|
/*
|
2162 |
|
|
* Make an argument object to contain the string, and
|
2163 |
|
|
* set the ensemble part definition to NULL. At this point,
|
2164 |
|
|
* we don't know anything about an ensemble, so we'll just
|
2165 |
|
|
* keep the string around as if it were the command line
|
2166 |
|
|
* invocation.
|
2167 |
|
|
*/
|
2168 |
|
|
argObj = Tcl_NewStringObj(name, -1);
|
2169 |
|
|
|
2170 |
|
|
/*
|
2171 |
|
|
* Free the old representation and install a new one.
|
2172 |
|
|
*/
|
2173 |
|
|
if (objPtr->typePtr && objPtr->typePtr->freeIntRepProc != NULL) {
|
2174 |
|
|
(*objPtr->typePtr->freeIntRepProc)(objPtr);
|
2175 |
|
|
}
|
2176 |
|
|
objPtr->internalRep.twoPtrValue.ptr1 = (VOID *) NULL;
|
2177 |
|
|
objPtr->internalRep.twoPtrValue.ptr2 = (VOID *) argObj;
|
2178 |
|
|
objPtr->typePtr = &itclEnsInvocType;
|
2179 |
|
|
|
2180 |
|
|
return TCL_OK;
|
2181 |
|
|
}
|
2182 |
|
|
|
2183 |
|
|
|
2184 |
|
|
/*
|
2185 |
|
|
*----------------------------------------------------------------------
|
2186 |
|
|
*
|
2187 |
|
|
* UpdateStringOfEnsInvoc --
|
2188 |
|
|
*
|
2189 |
|
|
* Updates the string representation for an ensembleInvoc object.
|
2190 |
|
|
* This is called when an error occurs in an ensemble part, when
|
2191 |
|
|
* the code tries to print objv[0] as the command name. This
|
2192 |
|
|
* code automatically chains together all of the names leading
|
2193 |
|
|
* to the ensemble part, so the error message references the
|
2194 |
|
|
* entire command, not just the part name.
|
2195 |
|
|
*
|
2196 |
|
|
* Note: This procedure does not free an existing old string rep
|
2197 |
|
|
* so storage will be lost if this has not already been done.
|
2198 |
|
|
*
|
2199 |
|
|
* Results:
|
2200 |
|
|
* None.
|
2201 |
|
|
*
|
2202 |
|
|
* Side effects:
|
2203 |
|
|
* The object's string is set to the full command name for
|
2204 |
|
|
* the ensemble part.
|
2205 |
|
|
*
|
2206 |
|
|
*----------------------------------------------------------------------
|
2207 |
|
|
*/
|
2208 |
|
|
static void
|
2209 |
|
|
UpdateStringOfEnsInvoc(objPtr)
|
2210 |
|
|
register Tcl_Obj *objPtr; /* NamespName obj to update string rep. */
|
2211 |
|
|
{
|
2212 |
|
|
EnsemblePart *ensPart = (EnsemblePart*)objPtr->internalRep.twoPtrValue.ptr1;
|
2213 |
|
|
Tcl_Obj *prevArgObj = (Tcl_Obj*)objPtr->internalRep.twoPtrValue.ptr2;
|
2214 |
|
|
|
2215 |
|
|
Tcl_DString buffer;
|
2216 |
|
|
int length;
|
2217 |
|
|
char *name;
|
2218 |
|
|
|
2219 |
|
|
Tcl_DStringInit(&buffer);
|
2220 |
|
|
|
2221 |
|
|
/*
|
2222 |
|
|
* Get the string representation for the previous argument.
|
2223 |
|
|
* This will force each ensembleInvoc argument up the line
|
2224 |
|
|
* to get its string representation. So we will get the
|
2225 |
|
|
* original command name, followed by the sub-ensemble, and
|
2226 |
|
|
* the next sub-ensemble, and so on. Then add the part
|
2227 |
|
|
* name from the ensPart argument.
|
2228 |
|
|
*/
|
2229 |
|
|
if (prevArgObj) {
|
2230 |
|
|
name = Tcl_GetStringFromObj(prevArgObj, &length);
|
2231 |
|
|
Tcl_DStringAppend(&buffer, name, length);
|
2232 |
|
|
}
|
2233 |
|
|
|
2234 |
|
|
if (ensPart) {
|
2235 |
|
|
Tcl_DStringAppendElement(&buffer, ensPart->name);
|
2236 |
|
|
}
|
2237 |
|
|
|
2238 |
|
|
/*
|
2239 |
|
|
* The following allocates an empty string on the heap if name is ""
|
2240 |
|
|
* (e.g., if the internal rep is NULL).
|
2241 |
|
|
*/
|
2242 |
|
|
name = Tcl_DStringValue(&buffer);
|
2243 |
|
|
length = strlen(name);
|
2244 |
|
|
objPtr->bytes = (char *) ckalloc((unsigned) (length + 1));
|
2245 |
|
|
memcpy((VOID *) objPtr->bytes, (VOID *) name, (unsigned) length);
|
2246 |
|
|
objPtr->bytes[length] = '\0';
|
2247 |
|
|
objPtr->length = length;
|
2248 |
|
|
}
|