4510
4511
4512
4513
4514
4515
4516
4517
4518
4519
4520
4521
4522
4523
4524
4525
4526
4527
4528
4529
4530
4531
4532
4533
4534
4535
4536
4537
4538
4539
4540
4541
4542
4543
4544
4545
4546
4547
4548
4549
4550
4551
4552
4553
4554
4555
4556
4557
4558
4559
4560
4561
4562
4563
4564
4565
4566
4567
4568
4569
4570
4571
4572
4573
4574
4575
4576
4577
4578
4579
4580
4581
4582
4583
4584
4585
4586
4587
4588
4589
4590
4591
4592
4593
4594
4595
4596
4597
4598
4599
4600
4601
4602
4603
4604
4605
4606
4607
4608
4609
4610
4611
4612
4613
4614
4615
4616
4617
4618
4619
4620
4621
4622
4623
4624
4625
4626
4627
4628
4629
4630
4631
4632
4633
4634
4635
4636
4637
4638
4639
4640
4641
4642
4643
4644
4645
4646
4647
4648
4649
4650
4651
4652
4653
4654
4655
4656
4657
4658
4659
4660
4661
4662
4663
4664
4665
4666
4667
4668
|
4509
4510
4511
4512
4513
4514
4515
4516
4517
4518
4519
4520
4521
4522
4523
4524
4525
4526
4527
4528
4529
4530
4531
4532
4533
4534
4535
4536
4537
4538
4539
4540
4541
4542
4543
4544
4545
4546
4547
4548
4549
4550
4551
4552
4553
4554
4555
4556
4557
4558
4559
4560
4561
4562
4563
4564
4565
4566
4567
4568
4569
4570
4571
4572
4573
4574
4575
4576
4577
4578
4579
4580
4581
4582
4583
4584
4585
4586
4587
4588
4589
4590
4591
4592
4593
4594
4595
4596
4597
4598
4599
4600
4601
4602
4603
4604
4605
4606
4607
4608
4609
4610
4611
4612
4613
4614
4615
4616
4617
4618
4619
4620
4621
4622
4623
4624
4625
4626
4627
4628
4629
4630
4631
4632
4633
4634
4635
4636
4637
4638
4639
4640
4641
4642
4643
4644
4645
4646
4647
4648
4649
4650
4651
4652
4653
4654
4655
4656
4657
4658
4659
4660
4661
4662
4663
4664
4665
4666
4667
|
-
-
-
-
-
+
+
+
+
+
-
+
-
+
-
+
-
+
-
+
-
+
-
+
-
+
-
+
-
+
-
+
-
+
-
+
-
+
-
-
-
-
-
+
+
+
+
+
|
* Create the ensemble. Note that this might delete another
* ensemble linked to the same namespace, so we must be
* careful. However, we should be OK because we only link the
* namespace into the list once we've created it (and after
* any deletions have occurred.)
*/
token = TclMakeEnsembleCmd(interp, name, NULL,
(permitPrefix ? ENS_PREFIX : 0));
TclSetEnsembleSubcommandList(interp, token, subcmdObj);
TclSetEnsembleMappingDict(interp, token, mapObj);
TclSetEnsembleUnknownHandler(interp, token, unknownObj);
token = Tcl_CreateEnsemble(interp, name, NULL,
(permitPrefix ? TCL_ENSEMBLE_PREFIX : 0));
Tcl_SetEnsembleSubcommandList(interp, token, subcmdObj);
Tcl_SetEnsembleMappingDict(interp, token, mapObj);
Tcl_SetEnsembleUnknownHandler(interp, token, unknownObj);
/*
* Tricky! Rely on the object result not being shared!
*/
Tcl_GetCommandFullName(interp, token, Tcl_GetObjResult(interp));
return TCL_OK;
}
case ENS_EXISTS:
if (objc != 4) {
Tcl_WrongNumArgs(interp, 3, objv, "cmdname");
return TCL_ERROR;
}
Tcl_SetObjResult(interp, Tcl_NewBooleanObj(
TclFindEnsemble(interp, objv[3], 0) != NULL));
Tcl_FindEnsemble(interp, objv[3], 0) != NULL));
return TCL_OK;
case ENS_CONFIG:
if (objc < 4 || (objc != 5 && objc & 1)) {
Tcl_WrongNumArgs(interp, 3, objv, "cmdname ?opt? ?value? ...");
return TCL_ERROR;
}
token = TclFindEnsemble(interp, objv[3], TCL_LEAVE_ERR_MSG);
token = Tcl_FindEnsemble(interp, objv[3], TCL_LEAVE_ERR_MSG);
if (token == NULL) {
return TCL_ERROR;
}
if (objc == 5) {
Tcl_Obj *resultObj;
if (Tcl_GetIndexFromObj(interp, objv[4], configOptions, "option",
0, &index) != TCL_OK) {
return TCL_ERROR;
}
switch ((enum EnsConfigOpts) index) {
case CONF_SUBCMDS:
TclGetEnsembleSubcommandList(NULL, token, &resultObj);
Tcl_GetEnsembleSubcommandList(NULL, token, &resultObj);
if (resultObj != NULL) {
Tcl_SetObjResult(interp, resultObj);
}
break;
case CONF_MAP:
TclGetEnsembleMappingDict(NULL, token, &resultObj);
Tcl_GetEnsembleMappingDict(NULL, token, &resultObj);
if (resultObj != NULL) {
Tcl_SetObjResult(interp, resultObj);
}
break;
case CONF_NAMESPACE: {
Tcl_Namespace *namespacePtr;
TclGetEnsembleNamespace(NULL, token, &namespacePtr);
Tcl_GetEnsembleNamespace(NULL, token, &namespacePtr);
Tcl_SetResult(interp, ((Namespace *)namespacePtr)->fullName,
TCL_VOLATILE);
break;
}
case CONF_PREFIX: {
int flags;
TclGetEnsembleFlags(NULL, token, &flags);
Tcl_GetEnsembleFlags(NULL, token, &flags);
Tcl_SetObjResult(interp,
Tcl_NewBooleanObj(flags & ENS_PREFIX));
Tcl_NewBooleanObj(flags & TCL_ENSEMBLE_PREFIX));
break;
}
case CONF_UNKNOWN:
TclGetEnsembleUnknownHandler(NULL, token, &resultObj);
Tcl_GetEnsembleUnknownHandler(NULL, token, &resultObj);
if (resultObj != NULL) {
Tcl_SetObjResult(interp, resultObj);
}
break;
}
return TCL_OK;
} else if (objc == 4) {
/*
* Produce list of all information.
*/
Tcl_Obj *resultObj, *tmpObj;
Tcl_Namespace *namespacePtr;
int flags;
TclNewObj(resultObj);
/* -map option */
Tcl_ListObjAppendElement(NULL, resultObj,
Tcl_NewStringObj(configOptions[CONF_MAP], -1));
TclGetEnsembleMappingDict(NULL, token, &tmpObj);
Tcl_GetEnsembleMappingDict(NULL, token, &tmpObj);
if (tmpObj != NULL) {
Tcl_ListObjAppendElement(NULL, resultObj, tmpObj);
} else {
Tcl_ListObjAppendElement(NULL, resultObj, Tcl_NewObj());
}
/* -namespace option */
Tcl_ListObjAppendElement(NULL, resultObj,
Tcl_NewStringObj(configOptions[CONF_NAMESPACE], -1));
TclGetEnsembleNamespace(NULL, token, &namespacePtr);
Tcl_GetEnsembleNamespace(NULL, token, &namespacePtr);
Tcl_ListObjAppendElement(NULL, resultObj,
Tcl_NewStringObj(((Namespace *)namespacePtr)->fullName,
-1));
/* -prefix option */
Tcl_ListObjAppendElement(NULL, resultObj,
Tcl_NewStringObj(configOptions[CONF_PREFIX], -1));
TclGetEnsembleFlags(NULL, token, &flags);
Tcl_GetEnsembleFlags(NULL, token, &flags);
Tcl_ListObjAppendElement(NULL, resultObj,
Tcl_NewBooleanObj(flags & ENS_PREFIX));
Tcl_NewBooleanObj(flags & TCL_ENSEMBLE_PREFIX));
/* -subcommands option */
Tcl_ListObjAppendElement(NULL, resultObj,
Tcl_NewStringObj(configOptions[CONF_SUBCMDS], -1));
TclGetEnsembleSubcommandList(NULL, token, &tmpObj);
Tcl_GetEnsembleSubcommandList(NULL, token, &tmpObj);
if (tmpObj != NULL) {
Tcl_ListObjAppendElement(NULL, resultObj, tmpObj);
} else {
Tcl_ListObjAppendElement(NULL, resultObj, Tcl_NewObj());
}
/* -unknown option */
Tcl_ListObjAppendElement(NULL, resultObj,
Tcl_NewStringObj(configOptions[CONF_UNKNOWN], -1));
TclGetEnsembleUnknownHandler(NULL, token, &tmpObj);
Tcl_GetEnsembleUnknownHandler(NULL, token, &tmpObj);
if (tmpObj != NULL) {
Tcl_ListObjAppendElement(NULL, resultObj, tmpObj);
} else {
Tcl_ListObjAppendElement(NULL, resultObj, Tcl_NewObj());
}
Tcl_SetObjResult(interp, resultObj);
return TCL_OK;
} else {
Tcl_DictSearch search;
Tcl_Obj *listObj;
int done, len, allocatedMapFlag = 0;
/*
* Defaults
*/
Tcl_Obj *subcmdObj, *mapObj, *unknownObj;
int permitPrefix, flags;
TclGetEnsembleSubcommandList(NULL, token, &subcmdObj);
TclGetEnsembleMappingDict(NULL, token, &mapObj);
TclGetEnsembleUnknownHandler(NULL, token, &unknownObj);
TclGetEnsembleFlags(NULL, token, &flags);
permitPrefix = (flags & ENS_PREFIX) != 0;
Tcl_GetEnsembleSubcommandList(NULL, token, &subcmdObj);
Tcl_GetEnsembleMappingDict(NULL, token, &mapObj);
Tcl_GetEnsembleUnknownHandler(NULL, token, &unknownObj);
Tcl_GetEnsembleFlags(NULL, token, &flags);
permitPrefix = (flags & TCL_ENSEMBLE_PREFIX) != 0;
objv += 4;
objc -= 4;
/*
* Parse the option list, applying type checks as we go.
* Note that we are not incrementing any reference counts
|
4788
4789
4790
4791
4792
4793
4794
4795
4796
4797
4798
4799
4800
4801
4802
4803
4804
4805
4806
4807
4808
4809
4810
4811
4812
4813
4814
4815
4816
4817
4818
4819
4820
4821
4822
4823
4824
4825
4826
4827
4828
4829
4830
4831
4832
4833
|
4787
4788
4789
4790
4791
4792
4793
4794
4795
4796
4797
4798
4799
4800
4801
4802
4803
4804
4805
4806
4807
4808
4809
4810
4811
4812
4813
4814
4815
4816
4817
4818
4819
4820
4821
4822
4823
4824
4825
4826
4827
4828
4829
4830
4831
4832
4833
|
-
-
-
-
-
+
+
+
+
+
+
-
+
-
+
|
}
/*
* Update the namespace now that we've finished the
* parsing stage.
*/
flags = (permitPrefix ? flags|ENS_PREFIX : flags&~ENS_PREFIX);
TclSetEnsembleSubcommandList(NULL, token, subcmdObj);
TclSetEnsembleMappingDict(NULL, token, mapObj);
TclSetEnsembleUnknownHandler(NULL, token, unknownObj);
TclSetEnsembleFlags(NULL, token, flags);
flags = (permitPrefix ? flags|TCL_ENSEMBLE_PREFIX
: flags&~TCL_ENSEMBLE_PREFIX);
Tcl_SetEnsembleSubcommandList(NULL, token, subcmdObj);
Tcl_SetEnsembleMappingDict(NULL, token, mapObj);
Tcl_SetEnsembleUnknownHandler(NULL, token, unknownObj);
Tcl_SetEnsembleFlags(NULL, token, flags);
return TCL_OK;
}
default:
Tcl_Panic("unexpected ensemble command");
}
return TCL_OK;
}
/*
*----------------------------------------------------------------------
*
* TclMakeEnsembleCmd --
* Tcl_CreateEnsemble --
*
* Create a simple ensemble attached to the given namespace.
*
* Results:
* The token for the command created.
*
* Side effects:
* The ensemble is created and marked for compilation.
*
*----------------------------------------------------------------------
*/
Tcl_Command
TclMakeEnsembleCmd(interp, name, namespacePtr, flags)
Tcl_CreateEnsemble(interp, name, namespacePtr, flags)
Tcl_Interp *interp;
CONST char *name;
Tcl_Namespace *namespacePtr;
int flags;
{
Namespace *nsPtr = (Namespace *) namespacePtr;
EnsembleConfig *ensemblePtr =
|