OpenCores
URL https://opencores.org/ocsvn/or1k/or1k/trunk

Subversion Repositories or1k

[/] [or1k/] [trunk/] [insight/] [itcl/] [itcl/] [generic/] [itcl_ensemble.c] - Blame information for rev 1773

Go to most recent revision | Details | Compare with Previous | View Log

Line No. Rev Author Line
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
}

powered by: WebSVN 2.1.0

© copyright 1999-2024 OpenCores.org, equivalent to Oliscience, all rights reserved. OpenCores®, registered trademark.