| ︙ | | | ︙ | |
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
|
static inline Class * GetClassFromObj(Tcl_Interp *interp, Tcl_Obj *objPtr);
static Tcl_ObjCmdProc InfoObjectClassCmd;
static Tcl_ObjCmdProc InfoObjectDefnCmd;
static Tcl_ObjCmdProc InfoObjectFiltersCmd;
static Tcl_ObjCmdProc InfoObjectForwardCmd;
static Tcl_ObjCmdProc InfoObjectIsACmd;
static Tcl_ObjCmdProc InfoObjectMethodsCmd;
static Tcl_ObjCmdProc InfoObjectMixinsCmd;
static Tcl_ObjCmdProc InfoObjectVarsCmd;
static Tcl_ObjCmdProc InfoObjectVariablesCmd;
static Tcl_ObjCmdProc InfoClassConstrCmd;
static Tcl_ObjCmdProc InfoClassDefnCmd;
static Tcl_ObjCmdProc InfoClassDestrCmd;
static Tcl_ObjCmdProc InfoClassFiltersCmd;
static Tcl_ObjCmdProc InfoClassForwardCmd;
static Tcl_ObjCmdProc InfoClassInstancesCmd;
static Tcl_ObjCmdProc InfoClassMethodsCmd;
static Tcl_ObjCmdProc InfoClassMixinsCmd;
static Tcl_ObjCmdProc InfoClassSubsCmd;
static Tcl_ObjCmdProc InfoClassSupersCmd;
static Tcl_ObjCmdProc InfoClassVariablesCmd;
struct NameProcMap { const char *name; Tcl_ObjCmdProc *proc; };
/*
* List of commands that are used to implement the [info object] subcommands.
*/
static const struct NameProcMap infoObjectCmds[] = {
{"::oo::InfoObject::class", InfoObjectClassCmd},
{"::oo::InfoObject::definition", InfoObjectDefnCmd},
{"::oo::InfoObject::filters", InfoObjectFiltersCmd},
{"::oo::InfoObject::forward", InfoObjectForwardCmd},
{"::oo::InfoObject::isa", InfoObjectIsACmd},
{"::oo::InfoObject::methods", InfoObjectMethodsCmd},
{"::oo::InfoObject::mixins", InfoObjectMixinsCmd},
{"::oo::InfoObject::variables", InfoObjectVariablesCmd},
{"::oo::InfoObject::vars", InfoObjectVarsCmd},
{NULL, NULL}
};
/*
* List of commands that are used to implement the [info class] subcommands.
*/
static const struct NameProcMap infoClassCmds[] = {
{"::oo::InfoClass::constructor", InfoClassConstrCmd},
{"::oo::InfoClass::definition", InfoClassDefnCmd},
{"::oo::InfoClass::destructor", InfoClassDestrCmd},
{"::oo::InfoClass::filters", InfoClassFiltersCmd},
{"::oo::InfoClass::forward", InfoClassForwardCmd},
{"::oo::InfoClass::instances", InfoClassInstancesCmd},
{"::oo::InfoClass::methods", InfoClassMethodsCmd},
{"::oo::InfoClass::mixins", InfoClassMixinsCmd},
{"::oo::InfoClass::subclasses", InfoClassSubsCmd},
{"::oo::InfoClass::superclasses", InfoClassSupersCmd},
{"::oo::InfoClass::variables", InfoClassVariablesCmd},
{NULL, NULL}
};
/*
* ----------------------------------------------------------------------
*
* TclOOInitInfo --
|
>
>
>
|
|
|
|
|
|
>
|
>
|
|
|
|
|
|
|
|
|
>
|
|
|
|
|
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
|
static inline Class * GetClassFromObj(Tcl_Interp *interp, Tcl_Obj *objPtr);
static Tcl_ObjCmdProc InfoObjectClassCmd;
static Tcl_ObjCmdProc InfoObjectDefnCmd;
static Tcl_ObjCmdProc InfoObjectFiltersCmd;
static Tcl_ObjCmdProc InfoObjectForwardCmd;
static Tcl_ObjCmdProc InfoObjectIsACmd;
static Tcl_ObjCmdProc InfoObjectMethodsCmd;
static Tcl_ObjCmdProc InfoObjectMethodTypeCmd;
static Tcl_ObjCmdProc InfoObjectMixinsCmd;
static Tcl_ObjCmdProc InfoObjectNsCmd;
static Tcl_ObjCmdProc InfoObjectVarsCmd;
static Tcl_ObjCmdProc InfoObjectVariablesCmd;
static Tcl_ObjCmdProc InfoClassConstrCmd;
static Tcl_ObjCmdProc InfoClassDefnCmd;
static Tcl_ObjCmdProc InfoClassDestrCmd;
static Tcl_ObjCmdProc InfoClassFiltersCmd;
static Tcl_ObjCmdProc InfoClassForwardCmd;
static Tcl_ObjCmdProc InfoClassInstancesCmd;
static Tcl_ObjCmdProc InfoClassMethodsCmd;
static Tcl_ObjCmdProc InfoClassMethodTypeCmd;
static Tcl_ObjCmdProc InfoClassMixinsCmd;
static Tcl_ObjCmdProc InfoClassSubsCmd;
static Tcl_ObjCmdProc InfoClassSupersCmd;
static Tcl_ObjCmdProc InfoClassVariablesCmd;
struct NameProcMap { const char *name; Tcl_ObjCmdProc *proc; };
/*
* List of commands that are used to implement the [info object] subcommands.
*/
static const struct NameProcMap infoObjectCmds[] = {
{"::oo::InfoObject::class", InfoObjectClassCmd},
{"::oo::InfoObject::definition", InfoObjectDefnCmd},
{"::oo::InfoObject::filters", InfoObjectFiltersCmd},
{"::oo::InfoObject::forward", InfoObjectForwardCmd},
{"::oo::InfoObject::isa", InfoObjectIsACmd},
{"::oo::InfoObject::methods", InfoObjectMethodsCmd},
{"::oo::InfoObject::methodtype", InfoObjectMethodTypeCmd},
{"::oo::InfoObject::mixins", InfoObjectMixinsCmd},
{"::oo::InfoObject::namespace", InfoObjectNsCmd},
{"::oo::InfoObject::variables", InfoObjectVariablesCmd},
{"::oo::InfoObject::vars", InfoObjectVarsCmd},
{NULL, NULL}
};
/*
* List of commands that are used to implement the [info class] subcommands.
*/
static const struct NameProcMap infoClassCmds[] = {
{"::oo::InfoClass::constructor", InfoClassConstrCmd},
{"::oo::InfoClass::definition", InfoClassDefnCmd},
{"::oo::InfoClass::destructor", InfoClassDestrCmd},
{"::oo::InfoClass::filters", InfoClassFiltersCmd},
{"::oo::InfoClass::forward", InfoClassForwardCmd},
{"::oo::InfoClass::instances", InfoClassInstancesCmd},
{"::oo::InfoClass::methods", InfoClassMethodsCmd},
{"::oo::InfoClass::methodtype", InfoClassMethodTypeCmd},
{"::oo::InfoClass::mixins", InfoClassMixinsCmd},
{"::oo::InfoClass::subclasses", InfoClassSubsCmd},
{"::oo::InfoClass::superclasses", InfoClassSupersCmd},
{"::oo::InfoClass::variables", InfoClassVariablesCmd},
{NULL, NULL}
};
/*
* ----------------------------------------------------------------------
*
* TclOOInitInfo --
|
| ︙ | | | ︙ | |
167
168
169
170
171
172
173
174
175
176
177
178
179
180
|
if (oPtr == NULL) {
return NULL;
}
if (oPtr->classPtr == NULL) {
Tcl_AppendResult(interp, "\"", TclGetString(objPtr),
"\" is not a class", NULL);
return NULL;
}
return oPtr->classPtr;
}
/*
* ----------------------------------------------------------------------
|
>
>
|
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
|
if (oPtr == NULL) {
return NULL;
}
if (oPtr->classPtr == NULL) {
Tcl_AppendResult(interp, "\"", TclGetString(objPtr),
"\" is not a class", NULL);
Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "CLASS",
TclGetString(objPtr), NULL);
return NULL;
}
return oPtr->classPtr;
}
/*
* ----------------------------------------------------------------------
|
| ︙ | | | ︙ | |
217
218
219
220
221
222
223
224
225
226
227
228
229
230
|
o2Ptr = (Object *) Tcl_GetObjectFromObj(interp, objv[2]);
if (o2Ptr == NULL) {
return TCL_ERROR;
}
if (o2Ptr->classPtr == NULL) {
Tcl_AppendResult(interp, "object \"", TclGetString(objv[2]),
"\" is not a class", NULL);
return TCL_ERROR;
}
FOREACH(mixinPtr, oPtr->mixins) {
if (TclOOIsReachable(o2Ptr->classPtr, mixinPtr)) {
Tcl_SetObjResult(interp, Tcl_NewIntObj(1));
return TCL_OK;
|
>
>
|
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
|
o2Ptr = (Object *) Tcl_GetObjectFromObj(interp, objv[2]);
if (o2Ptr == NULL) {
return TCL_ERROR;
}
if (o2Ptr->classPtr == NULL) {
Tcl_AppendResult(interp, "object \"", TclGetString(objv[2]),
"\" is not a class", NULL);
Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "CLASS",
TclGetString(objv[2]), NULL);
return TCL_ERROR;
}
FOREACH(mixinPtr, oPtr->mixins) {
if (TclOOIsReachable(o2Ptr->classPtr, mixinPtr)) {
Tcl_SetObjResult(interp, Tcl_NewIntObj(1));
return TCL_OK;
|
| ︙ | | | ︙ | |
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
|
goto unknownMethod;
}
hPtr = Tcl_FindHashEntry(oPtr->methodsPtr, (char *) objv[2]);
if (hPtr == NULL) {
unknownMethod:
Tcl_AppendResult(interp, "unknown method \"", TclGetString(objv[2]),
"\"", NULL);
return TCL_ERROR;
}
procPtr = TclOOGetProcFromMethod(Tcl_GetHashValue(hPtr));
if (procPtr == NULL) {
Tcl_AppendResult(interp,
"definition not available for this kind of method", NULL);
return TCL_ERROR;
}
resultObjs[0] = Tcl_NewObj();
for (localPtr=procPtr->firstLocalPtr; localPtr!=NULL;
localPtr=localPtr->nextPtr) {
if (TclIsVarArgument(localPtr)) {
|
>
>
>
>
|
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
|
goto unknownMethod;
}
hPtr = Tcl_FindHashEntry(oPtr->methodsPtr, (char *) objv[2]);
if (hPtr == NULL) {
unknownMethod:
Tcl_AppendResult(interp, "unknown method \"", TclGetString(objv[2]),
"\"", NULL);
Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "METHOD",
TclGetString(objv[2]), NULL);
return TCL_ERROR;
}
procPtr = TclOOGetProcFromMethod(Tcl_GetHashValue(hPtr));
if (procPtr == NULL) {
Tcl_AppendResult(interp,
"definition not available for this kind of method", NULL);
Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "METHOD",
TclGetString(objv[2]), NULL);
return TCL_ERROR;
}
resultObjs[0] = Tcl_NewObj();
for (localPtr=procPtr->firstLocalPtr; localPtr!=NULL;
localPtr=localPtr->nextPtr) {
if (TclIsVarArgument(localPtr)) {
|
| ︙ | | | ︙ | |
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
|
goto unknownMethod;
}
hPtr = Tcl_FindHashEntry(oPtr->methodsPtr, (char *) objv[2]);
if (hPtr == NULL) {
unknownMethod:
Tcl_AppendResult(interp, "unknown method \"", TclGetString(objv[2]),
"\"", NULL);
return TCL_ERROR;
}
prefixObj = TclOOGetFwdFromMethod(Tcl_GetHashValue(hPtr));
if (prefixObj == NULL) {
Tcl_AppendResult(interp,
"prefix argument list not available for this kind of method",
NULL);
return TCL_ERROR;
}
Tcl_SetObjResult(interp, prefixObj);
return TCL_OK;
}
|
>
>
>
>
|
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
|
goto unknownMethod;
}
hPtr = Tcl_FindHashEntry(oPtr->methodsPtr, (char *) objv[2]);
if (hPtr == NULL) {
unknownMethod:
Tcl_AppendResult(interp, "unknown method \"", TclGetString(objv[2]),
"\"", NULL);
Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "METHOD",
TclGetString(objv[2]), NULL);
return TCL_ERROR;
}
prefixObj = TclOOGetFwdFromMethod(Tcl_GetHashValue(hPtr));
if (prefixObj == NULL) {
Tcl_AppendResult(interp,
"prefix argument list not available for this kind of method",
NULL);
Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "METHOD",
TclGetString(objv[2]), NULL);
return TCL_ERROR;
}
Tcl_SetObjResult(interp, prefixObj);
return TCL_OK;
}
|
| ︙ | | | ︙ | |
582
583
584
585
586
587
588
589
590
591
592
593
594
595
596
597
598
599
600
601
602
603
604
605
606
|
const char **names;
int i, numNames = TclOOGetSortedMethodList(oPtr, flag, &names);
for (i=0 ; i<numNames ; i++) {
Tcl_ListObjAppendElement(NULL, resultObj,
Tcl_NewStringObj(names[i], -1));
}
ckfree((char *) names);
} else if (oPtr->methodsPtr) {
FOREACH_HASH(namePtr, mPtr, oPtr->methodsPtr) {
if (mPtr->typePtr != NULL && (mPtr->flags & flag) == flag) {
Tcl_ListObjAppendElement(NULL, resultObj, namePtr);
}
}
}
Tcl_SetObjResult(interp, resultObj);
return TCL_OK;
}
/*
* ----------------------------------------------------------------------
*
* InfoObjectMixinsCmd --
*
* Implements [info object mixins $objName]
|
>
|
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
|
600
601
602
603
604
605
606
607
608
609
610
611
612
613
614
615
616
617
618
619
620
621
622
623
624
625
626
627
628
629
630
631
632
633
634
635
636
637
638
639
640
641
642
643
644
645
646
647
648
649
650
651
652
653
654
655
656
657
658
659
660
661
662
663
664
665
666
667
668
669
670
671
672
673
674
675
676
677
678
679
680
681
682
683
|
const char **names;
int i, numNames = TclOOGetSortedMethodList(oPtr, flag, &names);
for (i=0 ; i<numNames ; i++) {
Tcl_ListObjAppendElement(NULL, resultObj,
Tcl_NewStringObj(names[i], -1));
}
if (numNames > 0) {
ckfree((char *) names);
}
} else if (oPtr->methodsPtr) {
FOREACH_HASH(namePtr, mPtr, oPtr->methodsPtr) {
if (mPtr->typePtr != NULL && (mPtr->flags & flag) == flag) {
Tcl_ListObjAppendElement(NULL, resultObj, namePtr);
}
}
}
Tcl_SetObjResult(interp, resultObj);
return TCL_OK;
}
/*
* ----------------------------------------------------------------------
*
* InfoObjectMethodTypeCmd --
*
* Implements [info object methodtype $objName $methodName]
*
* ----------------------------------------------------------------------
*/
static int
InfoObjectMethodTypeCmd(
ClientData clientData,
Tcl_Interp *interp,
int objc,
Tcl_Obj *const objv[])
{
Object *oPtr;
Tcl_HashEntry *hPtr;
Method *mPtr;
if (objc != 3) {
Tcl_WrongNumArgs(interp, 1, objv, "objName methodName");
return TCL_ERROR;
}
oPtr = (Object *) Tcl_GetObjectFromObj(interp, objv[1]);
if (oPtr == NULL) {
return TCL_ERROR;
}
if (!oPtr->methodsPtr) {
goto unknownMethod;
}
hPtr = Tcl_FindHashEntry(oPtr->methodsPtr, (char *) objv[2]);
if (hPtr == NULL) {
unknownMethod:
Tcl_AppendResult(interp, "unknown method \"", TclGetString(objv[2]),
"\"", NULL);
Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "METHOD",
TclGetString(objv[2]), NULL);
return TCL_ERROR;
}
mPtr = Tcl_GetHashValue(hPtr);
if (mPtr->typePtr == NULL) {
/*
* Special entry for visibility control: pretend the method doesnt
* exist.
*/
goto unknownMethod;
}
Tcl_SetObjResult(interp, Tcl_NewStringObj(mPtr->typePtr->name, -1));
return TCL_OK;
}
/*
* ----------------------------------------------------------------------
*
* InfoObjectMixinsCmd --
*
* Implements [info object mixins $objName]
|
| ︙ | | | ︙ | |
633
634
635
636
637
638
639
640
641
642
643
644
645
646
|
FOREACH(mixinPtr, oPtr->mixins) {
Tcl_ListObjAppendElement(NULL, resultObj,
TclOOObjectName(interp, mixinPtr->thisPtr));
}
Tcl_SetObjResult(interp, resultObj);
return TCL_OK;
}
/*
* ----------------------------------------------------------------------
*
* InfoObjectVariablesCmd --
*
* Implements [info object variables $objName]
|
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
|
710
711
712
713
714
715
716
717
718
719
720
721
722
723
724
725
726
727
728
729
730
731
732
733
734
735
736
737
738
739
740
741
742
743
744
745
746
747
748
749
750
751
752
753
754
755
756
|
FOREACH(mixinPtr, oPtr->mixins) {
Tcl_ListObjAppendElement(NULL, resultObj,
TclOOObjectName(interp, mixinPtr->thisPtr));
}
Tcl_SetObjResult(interp, resultObj);
return TCL_OK;
}
/*
* ----------------------------------------------------------------------
*
* InfoObjectNsCmd --
*
* Implements [info object namespace $objName]
*
* ----------------------------------------------------------------------
*/
static int
InfoObjectNsCmd(
ClientData clientData,
Tcl_Interp *interp,
int objc,
Tcl_Obj *const objv[])
{
Object *oPtr;
if (objc != 2) {
Tcl_WrongNumArgs(interp, 1, objv, "objName");
return TCL_ERROR;
}
oPtr = (Object *) Tcl_GetObjectFromObj(interp, objv[1]);
if (oPtr == NULL) {
return TCL_ERROR;
}
Tcl_SetObjResult(interp,
Tcl_NewStringObj(oPtr->namespacePtr->fullName, -1));
return TCL_OK;
}
/*
* ----------------------------------------------------------------------
*
* InfoObjectVariablesCmd --
*
* Implements [info object variables $objName]
|
| ︙ | | | ︙ | |
828
829
830
831
832
833
834
835
836
837
838
839
840
841
842
843
844
845
846
847
|
if (clsPtr == NULL) {
return TCL_ERROR;
}
hPtr = Tcl_FindHashEntry(&clsPtr->classMethods, (char *) objv[2]);
if (hPtr == NULL) {
Tcl_AppendResult(interp, "unknown method \"", TclGetString(objv[2]),
"\"", NULL);
return TCL_ERROR;
}
procPtr = TclOOGetProcFromMethod(Tcl_GetHashValue(hPtr));
if (procPtr == NULL) {
Tcl_AppendResult(interp,
"definition not available for this kind of method", NULL);
return TCL_ERROR;
}
resultObjs[0] = Tcl_NewObj();
for (localPtr=procPtr->firstLocalPtr; localPtr!=NULL;
localPtr=localPtr->nextPtr) {
if (TclIsVarArgument(localPtr)) {
|
>
>
>
>
|
938
939
940
941
942
943
944
945
946
947
948
949
950
951
952
953
954
955
956
957
958
959
960
961
|
if (clsPtr == NULL) {
return TCL_ERROR;
}
hPtr = Tcl_FindHashEntry(&clsPtr->classMethods, (char *) objv[2]);
if (hPtr == NULL) {
Tcl_AppendResult(interp, "unknown method \"", TclGetString(objv[2]),
"\"", NULL);
Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "METHOD",
TclGetString(objv[2]), NULL);
return TCL_ERROR;
}
procPtr = TclOOGetProcFromMethod(Tcl_GetHashValue(hPtr));
if (procPtr == NULL) {
Tcl_AppendResult(interp,
"definition not available for this kind of method", NULL);
Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "METHOD",
TclGetString(objv[2]), NULL);
return TCL_ERROR;
}
resultObjs[0] = Tcl_NewObj();
for (localPtr=procPtr->firstLocalPtr; localPtr!=NULL;
localPtr=localPtr->nextPtr) {
if (TclIsVarArgument(localPtr)) {
|
| ︙ | | | ︙ | |
971
972
973
974
975
976
977
978
979
980
981
982
983
984
985
986
987
988
989
990
991
|
if (clsPtr == NULL) {
return TCL_ERROR;
}
hPtr = Tcl_FindHashEntry(&clsPtr->classMethods, (char *) objv[2]);
if (hPtr == NULL) {
Tcl_AppendResult(interp, "unknown method \"", TclGetString(objv[2]),
"\"", NULL);
return TCL_ERROR;
}
prefixObj = TclOOGetFwdFromMethod(Tcl_GetHashValue(hPtr));
if (prefixObj == NULL) {
Tcl_AppendResult(interp,
"prefix argument list not available for this kind of method",
NULL);
return TCL_ERROR;
}
Tcl_SetObjResult(interp, prefixObj);
return TCL_OK;
}
|
>
>
>
>
|
1085
1086
1087
1088
1089
1090
1091
1092
1093
1094
1095
1096
1097
1098
1099
1100
1101
1102
1103
1104
1105
1106
1107
1108
1109
|
if (clsPtr == NULL) {
return TCL_ERROR;
}
hPtr = Tcl_FindHashEntry(&clsPtr->classMethods, (char *) objv[2]);
if (hPtr == NULL) {
Tcl_AppendResult(interp, "unknown method \"", TclGetString(objv[2]),
"\"", NULL);
Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "METHOD",
TclGetString(objv[2]), NULL);
return TCL_ERROR;
}
prefixObj = TclOOGetFwdFromMethod(Tcl_GetHashValue(hPtr));
if (prefixObj == NULL) {
Tcl_AppendResult(interp,
"prefix argument list not available for this kind of method",
NULL);
Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "METHOD",
TclGetString(objv[2]), NULL);
return TCL_ERROR;
}
Tcl_SetObjResult(interp, prefixObj);
return TCL_OK;
}
|
| ︙ | | | ︙ | |
1100
1101
1102
1103
1104
1105
1106
1107
1108
1109
1110
1111
1112
1113
1114
1115
1116
1117
1118
1119
1120
1121
1122
1123
1124
1125
1126
|
const char **names;
int i, numNames = TclOOGetSortedClassMethodList(clsPtr, flag, &names);
for (i=0 ; i<numNames ; i++) {
Tcl_ListObjAppendElement(NULL, resultObj,
Tcl_NewStringObj(names[i], -1));
}
ckfree((char *) names);
} else {
FOREACH_HASH_DECLS;
FOREACH_HASH(namePtr, mPtr, &clsPtr->classMethods) {
if (mPtr->typePtr != NULL && (mPtr->flags & flag) == flag) {
Tcl_ListObjAppendElement(NULL, resultObj, namePtr);
}
}
}
Tcl_SetObjResult(interp, resultObj);
return TCL_OK;
}
/*
* ----------------------------------------------------------------------
*
* InfoClassMixinsCmd --
*
* Implements [info class mixins $clsName]
|
>
|
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
|
1218
1219
1220
1221
1222
1223
1224
1225
1226
1227
1228
1229
1230
1231
1232
1233
1234
1235
1236
1237
1238
1239
1240
1241
1242
1243
1244
1245
1246
1247
1248
1249
1250
1251
1252
1253
1254
1255
1256
1257
1258
1259
1260
1261
1262
1263
1264
1265
1266
1267
1268
1269
1270
1271
1272
1273
1274
1275
1276
1277
1278
1279
1280
1281
1282
1283
1284
1285
1286
1287
1288
1289
1290
1291
1292
1293
1294
1295
1296
1297
1298
|
const char **names;
int i, numNames = TclOOGetSortedClassMethodList(clsPtr, flag, &names);
for (i=0 ; i<numNames ; i++) {
Tcl_ListObjAppendElement(NULL, resultObj,
Tcl_NewStringObj(names[i], -1));
}
if (numNames > 0) {
ckfree((char *) names);
}
} else {
FOREACH_HASH_DECLS;
FOREACH_HASH(namePtr, mPtr, &clsPtr->classMethods) {
if (mPtr->typePtr != NULL && (mPtr->flags & flag) == flag) {
Tcl_ListObjAppendElement(NULL, resultObj, namePtr);
}
}
}
Tcl_SetObjResult(interp, resultObj);
return TCL_OK;
}
/*
* ----------------------------------------------------------------------
*
* InfoClassMethodTypeCmd --
*
* Implements [info class methodtype $clsName $methodName]
*
* ----------------------------------------------------------------------
*/
static int
InfoClassMethodTypeCmd(
ClientData clientData,
Tcl_Interp *interp,
int objc,
Tcl_Obj *const objv[])
{
Tcl_HashEntry *hPtr;
Method *mPtr;
Class *clsPtr;
if (objc != 3) {
Tcl_WrongNumArgs(interp, 1, objv, "className methodName");
return TCL_ERROR;
}
clsPtr = GetClassFromObj(interp, objv[1]);
if (clsPtr == NULL) {
return TCL_ERROR;
}
hPtr = Tcl_FindHashEntry(&clsPtr->classMethods, (char *) objv[2]);
if (hPtr == NULL) {
unknownMethod:
Tcl_AppendResult(interp, "unknown method \"", TclGetString(objv[2]),
"\"", NULL);
Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "METHOD",
TclGetString(objv[2]), NULL);
return TCL_ERROR;
}
mPtr = Tcl_GetHashValue(hPtr);
if (mPtr->typePtr == NULL) {
/*
* Special entry for visibility control: pretend the method doesnt
* exist.
*/
goto unknownMethod;
}
Tcl_SetObjResult(interp, Tcl_NewStringObj(mPtr->typePtr->name, -1));
return TCL_OK;
}
/*
* ----------------------------------------------------------------------
*
* InfoClassMixinsCmd --
*
* Implements [info class mixins $clsName]
|
| ︙ | | | ︙ | |