1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
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
|
/*
* tclOODefineCmds.c --
*
* This file contains the implementation of the ::oo-related [info]
* subcommands.
*
* Copyright (c) 2006-2008 by Donal K. Fellows
*
* See the file "license.terms" for information on usage and redistribution of
* this file, and for a DISCLAIMER OF ALL WARRANTIES.
*
* RCS: @(#) $Id: tclOOInfo.c,v 1.6 2008/08/12 23:19:15 hobbs Exp $
*/
#ifdef HAVE_CONFIG_H
#include "config.h"
#endif
#include "tclInt.h"
#include "tclOOInt.h"
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 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;
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::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},
{NULL, NULL}
};
/*
* ----------------------------------------------------------------------
*
* TclOOInitInfo --
|
|
>
>
>
>
|
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
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
|
/*
* tclOODefineCmds.c --
*
* This file contains the implementation of the ::oo-related [info]
* subcommands.
*
* Copyright (c) 2006-2008 by Donal K. Fellows
*
* See the file "license.terms" for information on usage and redistribution of
* this file, and for a DISCLAIMER OF ALL WARRANTIES.
*
* RCS: @(#) $Id: tclOOInfo.c,v 1.7 2008/09/23 05:05:54 dkf Exp $
*/
#ifdef HAVE_CONFIG_H
#include "config.h"
#endif
#include "tclInt.h"
#include "tclOOInt.h"
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 --
|
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
|
if (localPtr->defValuePtr != NULL) {
Tcl_ListObjAppendElement(NULL, argObj, localPtr->defValuePtr);
}
Tcl_ListObjAppendElement(NULL, argsObj, argObj);
}
}
Tcl_ListObjAppendElement(NULL, Tcl_GetObjResult(interp), argsObj);
/*
* This is copied from the [info body] implementation. See the comments
* there for why this copy has to be done here.
*/
if (procPtr->bodyPtr->bytes == NULL) {
(void) Tcl_GetString(procPtr->bodyPtr);
}
Tcl_NewStringObj(procPtr->bodyPtr->bytes,
procPtr->bodyPtr->length));
return TCL_OK;
}
/*
* ----------------------------------------------------------------------
*
* InfoObjectFiltersCmd --
|
<
<
<
<
<
<
<
<
<
|
<
|
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
|
if (localPtr->defValuePtr != NULL) {
Tcl_ListObjAppendElement(NULL, argObj, localPtr->defValuePtr);
}
Tcl_ListObjAppendElement(NULL, argsObj, argObj);
}
}
Tcl_ListObjAppendElement(NULL, Tcl_GetObjResult(interp), argsObj);
Tcl_ListObjAppendElement(NULL, Tcl_GetObjResult(interp),
TclOOGetMethodBody(Tcl_GetHashValue(hPtr)));
return TCL_OK;
}
/*
* ----------------------------------------------------------------------
*
* InfoObjectFiltersCmd --
|
613
614
615
616
617
618
619
620
621
622
623
624
625
626
|
}
return TCL_OK;
}
/*
* ----------------------------------------------------------------------
*
* InfoObjectVarsCmd --
*
* Implements [info object vars $objName ?$pattern?]
*
* ----------------------------------------------------------------------
*/
|
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
|
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
|
}
return TCL_OK;
}
/*
* ----------------------------------------------------------------------
*
* InfoObjectVariablesCmd --
*
* Implements [info object variables $objName]
*
* ----------------------------------------------------------------------
*/
static int
InfoObjectVariablesCmd(
ClientData clientData,
Tcl_Interp *interp,
int objc,
Tcl_Obj *const objv[])
{
Object *oPtr;
Tcl_Obj *variableObj;
int i;
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;
}
FOREACH(variableObj, oPtr->variables) {
Tcl_ListObjAppendElement(NULL, Tcl_GetObjResult(interp), variableObj);
}
return TCL_OK;
}
/*
* ----------------------------------------------------------------------
*
* InfoObjectVarsCmd --
*
* Implements [info object vars $objName ?$pattern?]
*
* ----------------------------------------------------------------------
*/
|
735
736
737
738
739
740
741
742
743
744
745
746
747
748
749
750
751
752
753
754
|
if (localPtr->defValuePtr != NULL) {
Tcl_ListObjAppendElement(NULL, argObj, localPtr->defValuePtr);
}
Tcl_ListObjAppendElement(NULL, argsObj, argObj);
}
}
Tcl_ListObjAppendElement(NULL, Tcl_GetObjResult(interp), argsObj);
if (procPtr->bodyPtr->bytes == NULL) {
(void) Tcl_GetString(procPtr->bodyPtr);
}
Tcl_NewStringObj(procPtr->bodyPtr->bytes,
procPtr->bodyPtr->length));
|
<
<
<
<
|
|
765
766
767
768
769
770
771
772
773
774
775
776
777
778
779
780
|
if (localPtr->defValuePtr != NULL) {
Tcl_ListObjAppendElement(NULL, argObj, localPtr->defValuePtr);
}
Tcl_ListObjAppendElement(NULL, argsObj, argObj);
}
}
Tcl_ListObjAppendElement(NULL, Tcl_GetObjResult(interp), argsObj);
Tcl_ListObjAppendElement(NULL, Tcl_GetObjResult(interp),
TclOOGetMethodBody(clsPtr->constructorPtr));
return TCL_OK;
}
/*
* ----------------------------------------------------------------------
*
* InfoClassDefnCmd --
|
812
813
814
815
816
817
818
819
820
821
822
823
824
825
826
827
828
829
830
831
|
if (localPtr->defValuePtr != NULL) {
Tcl_ListObjAppendElement(NULL, argObj, localPtr->defValuePtr);
}
Tcl_ListObjAppendElement(NULL, argsObj, argObj);
}
}
Tcl_ListObjAppendElement(NULL, Tcl_GetObjResult(interp), argsObj);
if (procPtr->bodyPtr->bytes == NULL) {
(void) Tcl_GetString(procPtr->bodyPtr);
}
Tcl_NewStringObj(procPtr->bodyPtr->bytes,
procPtr->bodyPtr->length));
return TCL_OK;
}
/*
* ----------------------------------------------------------------------
*
* InfoClassDestrCmd --
|
<
<
<
|
<
|
838
839
840
841
842
843
844
845
846
847
848
849
850
851
852
853
|
if (localPtr->defValuePtr != NULL) {
Tcl_ListObjAppendElement(NULL, argObj, localPtr->defValuePtr);
}
Tcl_ListObjAppendElement(NULL, argsObj, argObj);
}
}
Tcl_ListObjAppendElement(NULL, Tcl_GetObjResult(interp), argsObj);
Tcl_ListObjAppendElement(NULL, Tcl_GetObjResult(interp),
TclOOGetMethodBody(Tcl_GetHashValue(hPtr)));
return TCL_OK;
}
/*
* ----------------------------------------------------------------------
*
* InfoClassDestrCmd --
|
867
868
869
870
871
872
873
874
875
876
877
878
879
880
881
882
883
884
885
886
|
procPtr = TclOOGetProcFromMethod(clsPtr->destructorPtr);
if (procPtr == NULL) {
Tcl_AppendResult(interp,
"definition not available for this kind of method", NULL);
return TCL_ERROR;
}
if (procPtr->bodyPtr->bytes == NULL) {
(void) Tcl_GetString(procPtr->bodyPtr);
}
Tcl_ListObjAppendElement(NULL, Tcl_GetObjResult(interp),
Tcl_NewStringObj(procPtr->bodyPtr->bytes,
procPtr->bodyPtr->length));
|
<
<
<
|
<
<
|
889
890
891
892
893
894
895
896
897
898
899
900
901
902
903
|
procPtr = TclOOGetProcFromMethod(clsPtr->destructorPtr);
if (procPtr == NULL) {
Tcl_AppendResult(interp,
"definition not available for this kind of method", NULL);
return TCL_ERROR;
}
Tcl_SetObjResult(interp, TclOOGetMethodBody(clsPtr->destructorPtr));
return TCL_OK;
}
/*
* ----------------------------------------------------------------------
*
* InfoClassFiltersCmd --
|
1257
1258
1259
1260
1261
1262
1263
1264
1265
1266
1267
1268
1269
1270
1271
|
FOREACH(superPtr, clsPtr->superclasses) {
Tcl_ListObjAppendElement(NULL, Tcl_GetObjResult(interp),
TclOOObjectName(interp, superPtr->thisPtr));
}
return TCL_OK;
}
/*
* Local Variables:
* mode: c
* c-basic-offset: 4
* fill-column: 78
* End:
*/
|
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
|
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
1299
1300
1301
1302
1303
1304
1305
1306
1307
1308
1309
1310
1311
1312
1313
1314
1315
1316
1317
1318
1319
1320
1321
1322
1323
1324
1325
1326
1327
1328
1329
1330
1331
|
FOREACH(superPtr, clsPtr->superclasses) {
Tcl_ListObjAppendElement(NULL, Tcl_GetObjResult(interp),
TclOOObjectName(interp, superPtr->thisPtr));
}
return TCL_OK;
}
/*
* ----------------------------------------------------------------------
*
* InfoClassVariablesCmd --
*
* Implements [info class variables $clsName]
*
* ----------------------------------------------------------------------
*/
static int
InfoClassVariablesCmd(
ClientData clientData,
Tcl_Interp *interp,
int objc,
Tcl_Obj *const objv[])
{
Object *oPtr;
Class *clsPtr;
Tcl_Obj *variableObj;
int i;
if (objc != 2) {
Tcl_WrongNumArgs(interp, 1, objv, "className");
return TCL_ERROR;
}
oPtr = (Object *) Tcl_GetObjectFromObj(interp, objv[1]);
if (oPtr == NULL) {
return TCL_ERROR;
}
if (oPtr->classPtr == NULL) {
Tcl_AppendResult(interp, "\"", TclGetString(objv[1]),
"\" is not a class", NULL);
return TCL_ERROR;
}
clsPtr = oPtr->classPtr;
FOREACH(variableObj, clsPtr->variables) {
Tcl_ListObjAppendElement(NULL, Tcl_GetObjResult(interp), variableObj);
}
return TCL_OK;
}
/*
* Local Variables:
* mode: c
* c-basic-offset: 4
* fill-column: 78
* End:
*/
|