Diff
Not logged in

Differences From Artifact [e4468c9455]:

To Artifact [6b88d6e267]:


162
163
164
165
166
167
168
169
170


171
172
173
174
175
176
177
162
163
164
165
166
167
168


169
170
171
172
173
174
175
176
177







-
-
+
+







{
    Object *oPtr = (Object *) Tcl_GetObjectFromObj(interp, objPtr);

    if (oPtr == NULL) {
	return NULL;
    }
    if (oPtr->classPtr == NULL) {
	Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		"\"%s\" is not a class", TclGetString(objPtr)));
	TclPrintfResult(interp,
		"\"%s\" is not a class", TclGetString(objPtr));
	TclSetErrorCode(interp, "TCL", "LOOKUP", "CLASS",
		TclGetString(objPtr));
	return NULL;
    }
    return oPtr->classPtr;
}

300
301
302
303
304
305
306
307
308

309
310
311
312
313
314


315
316
317
318
319
320
321
322
300
301
302
303
304
305
306


307
308
309
310
311


312
313

314
315
316
317
318
319
320







-
-
+




-
-
+
+
-







    return TCL_OK;

    /*
     * Errors...
     */

  unknownMethod:
    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
	    "unknown method \"%s\"", TclGetString(objv[2])));
    TclPrintfResult(interp, "unknown method \"%s\"", TclGetString(objv[2]));
    TclSetErrorCode(interp, "TCL", "LOOKUP", "METHOD", TclGetString(objv[2]));
    return TCL_ERROR;

  wrongType:
    Tcl_SetObjResult(interp, Tcl_NewStringObj(
	    "definition not available for this kind of method",
    TclPrintfResult(interp,
	    "definition not available for this kind of method");
	    TCL_AUTO_LENGTH));
    TclSetErrorCode(interp, "TCL", "LOOKUP", "METHOD", TclGetString(objv[2]));
    return TCL_ERROR;
}

/*
 * ----------------------------------------------------------------------
 *
407
408
409
410
411
412
413
414
415


416
417
418
419
420
421


422
423
424
425
426
427
428
429
405
406
407
408
409
410
411


412
413
414
415
416
417


418
419

420
421
422
423
424
425
426







-
-
+
+




-
-
+
+
-







    return TCL_OK;

    /*
     * Errors...
     */

  unknownMethod:
    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
	    "unknown method \"%s\"", TclGetString(objv[2])));
    TclPrintfResult(interp,
	    "unknown method \"%s\"", TclGetString(objv[2]));
    TclSetErrorCode(interp, "TCL", "LOOKUP", "METHOD", TclGetString(objv[2]));
    return TCL_ERROR;

  wrongType:
    Tcl_SetObjResult(interp, Tcl_NewStringObj(
	    "prefix argument list not available for this kind of method",
    TclPrintfResult(interp,
	    "prefix argument list not available for this kind of method");
	    TCL_AUTO_LENGTH));
    TclSetErrorCode(interp, "TCL", "LOOKUP", "METHOD", TclGetString(objv[2]));
    return TCL_ERROR;
}

/*
 * ----------------------------------------------------------------------
 *
609
610
611
612
613
614
615
616
617

618
619
620
621
622
623
624
606
607
608
609
610
611
612


613
614
615
616
617
618
619
620







-
-
+







		flag = PRIVATE_METHOD;
		break;
	    case OPT_PRIVATE:
		flag = 0;
		break;
	    case OPT_SCOPE:
		if (++i >= objc) {
		    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
			    "missing option for -scope"));
		    TclPrintfResult(interp, "missing option for -scope");
		    TclSetErrorCode(interp, "TCL", "ARGUMENT", "MISSING");
		    return TCL_ERROR;
		}
		if (Tcl_GetIndexFromObj(interp, objv[i], scopes, "scope", 0,
			&scope) != TCL_OK) {
		    return TCL_ERROR;
		}
734
735
736
737
738
739
740
741
742

743
744
745
746
747
748
749
730
731
732
733
734
735
736


737
738
739
740
741
742
743
744







-
-
+







    }

    Tcl_SetObjResult(interp,
	    Tcl_NewStringObj(mPtr->typePtr->name, TCL_AUTO_LENGTH));
    return TCL_OK;

  unknownMethod:
    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
	    "unknown method \"%s\"", TclGetString(objv[2])));
    TclPrintfResult(interp, "unknown method \"%s\"", TclGetString(objv[2]));
    TclSetErrorCode(interp, "TCL", "LOOKUP", "METHOD", TclGetString(objv[2]));
    return TCL_ERROR;
}

/*
 * ----------------------------------------------------------------------
 *
875
876
877
878
879
880
881
882

883
884

885
886
887
888
889
890
891
870
871
872
873
874
875
876

877
878

879
880
881
882
883
884
885
886







-
+

-
+








    if (objc != 2 && objc != 3) {
	Tcl_WrongNumArgs(interp, 1, objv, "objName ?-private?");
	return TCL_ERROR;
    }
    if (objc == 3) {
	if (strcmp("-private", TclGetString(objv[2])) != 0) {
	    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
	    TclPrintfResult(interp,
		    "option \"%s\" is not exactly \"-private\"",
		    TclGetString(objv[2])));
		    TclGetString(objv[2]));
	    OO_ERROR(interp, BAD_ARG);
	    return TCL_ERROR;
	}
	isPrivate = 1;
    }
    oPtr = (Object *) Tcl_GetObjectFromObj(interp, objv[1]);
    if (oPtr == NULL) {
1002
1003
1004
1005
1006
1007
1008
1009
1010


1011
1012
1013
1014
1015
1016
1017
1018
997
998
999
1000
1001
1002
1003


1004
1005

1006
1007
1008
1009
1010
1011
1012







-
-
+
+
-







	return TCL_ERROR;
    }
    if (clsPtr->constructorPtr == NULL) {
	return TCL_OK;
    }
    procPtr = TclOOGetProcFromMethod(clsPtr->constructorPtr);
    if (procPtr == NULL) {
	Tcl_SetObjResult(interp, Tcl_NewStringObj(
		"definition not available for this kind of method",
	TclPrintfResult(interp,
		"definition not available for this kind of method");
		TCL_AUTO_LENGTH));
	OO_ERROR(interp, METHOD_TYPE);
	return TCL_ERROR;
    }

    TclNewObj(resultObjs[0]);
    for (localPtr=procPtr->firstLocalPtr; localPtr!=NULL;
	    localPtr=localPtr->nextPtr) {
1061
1062
1063
1064
1065
1066
1067
1068
1069


1070
1071
1072
1073
1074
1075
1076


1077
1078
1079
1080
1081
1082
1083
1084
1055
1056
1057
1058
1059
1060
1061


1062
1063
1064
1065
1066
1067
1068


1069
1070

1071
1072
1073
1074
1075
1076
1077







-
-
+
+





-
-
+
+
-







    }
    clsPtr = TclOOGetClassFromObj(interp, objv[1]);
    if (clsPtr == NULL) {
	return TCL_ERROR;
    }
    hPtr = Tcl_FindHashEntry(&clsPtr->classMethods, objv[2]);
    if (hPtr == NULL) {
	Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		"unknown method \"%s\"", TclGetString(objv[2])));
	TclPrintfResult(interp,
		"unknown method \"%s\"", TclGetString(objv[2]));
	TclSetErrorCode(interp, "TCL", "LOOKUP", "METHOD", TclGetString(objv[2]));
	return TCL_ERROR;
    }
    procPtr = TclOOGetProcFromMethod((Method *) Tcl_GetHashValue(hPtr));
    if (procPtr == NULL) {
	Tcl_SetObjResult(interp, Tcl_NewStringObj(
		"definition not available for this kind of method",
	TclPrintfResult(interp,
		"definition not available for this kind of method");
		TCL_AUTO_LENGTH));
	TclSetErrorCode(interp, "TCL", "LOOKUP", "METHOD", TclGetString(objv[2]));
	return TCL_ERROR;
    }

    TclNewObj(resultObjs[0]);
    for (localPtr=procPtr->firstLocalPtr; localPtr!=NULL;
	    localPtr=localPtr->nextPtr) {
1178
1179
1180
1181
1182
1183
1184
1185
1186


1187
1188
1189
1190
1191
1192
1193
1194
1171
1172
1173
1174
1175
1176
1177


1178
1179

1180
1181
1182
1183
1184
1185
1186







-
-
+
+
-







    }

    if (clsPtr->destructorPtr == NULL) {
	return TCL_OK;
    }
    procPtr = TclOOGetProcFromMethod(clsPtr->destructorPtr);
    if (procPtr == NULL) {
	Tcl_SetObjResult(interp, Tcl_NewStringObj(
		"definition not available for this kind of method",
	TclPrintfResult(interp,
		"definition not available for this kind of method");
		TCL_AUTO_LENGTH));
	OO_ERROR(interp, METHOD_TYPE);
	return TCL_ERROR;
    }

    Tcl_SetObjResult(interp, TclOOGetMethodBody(clsPtr->destructorPtr));
    return TCL_OK;
}
1258
1259
1260
1261
1262
1263
1264
1265
1266


1267
1268
1269
1270
1271
1272
1273


1274
1275
1276
1277
1278
1279
1280
1281
1250
1251
1252
1253
1254
1255
1256


1257
1258
1259
1260
1261
1262
1263


1264
1265

1266
1267
1268
1269
1270
1271
1272







-
-
+
+





-
-
+
+
-







    }
    clsPtr = TclOOGetClassFromObj(interp, objv[1]);
    if (clsPtr == NULL) {
	return TCL_ERROR;
    }
    hPtr = Tcl_FindHashEntry(&clsPtr->classMethods, objv[2]);
    if (hPtr == NULL) {
	Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		"unknown method \"%s\"", TclGetString(objv[2])));
	TclPrintfResult(interp,
		"unknown method \"%s\"", TclGetString(objv[2]));
	TclSetErrorCode(interp, "TCL", "LOOKUP", "METHOD", TclGetString(objv[2]));
	return TCL_ERROR;
    }
    prefixObj = TclOOGetFwdFromMethod((Method *) Tcl_GetHashValue(hPtr));
    if (prefixObj == NULL) {
	Tcl_SetObjResult(interp, Tcl_NewStringObj(
		"prefix argument list not available for this kind of method",
	TclPrintfResult(interp,
		"prefix argument list not available for this kind of method");
		TCL_AUTO_LENGTH));
	TclSetErrorCode(interp, "TCL", "LOOKUP", "METHOD", TclGetString(objv[2]));
	return TCL_ERROR;
    }

    Tcl_SetObjResult(interp, prefixObj);
    return TCL_OK;
}
1387
1388
1389
1390
1391
1392
1393
1394
1395

1396
1397
1398
1399
1400
1401
1402
1378
1379
1380
1381
1382
1383
1384


1385
1386
1387
1388
1389
1390
1391
1392







-
-
+







		flag = PRIVATE_METHOD;
		break;
	    case OPT_PRIVATE:
		flag = 0;
		break;
	    case OPT_SCOPE:
		if (++i >= objc) {
		    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
			    "missing option for -scope"));
		    TclPrintfResult(interp, "missing option for -scope");
		    TclSetErrorCode(interp, "TCL", "ARGUMENT", "MISSING");
		    return TCL_ERROR;
		}
		if (Tcl_GetIndexFromObj(interp, objv[i], scopes, "scope", 0,
			&scope) != TCL_OK) {
		    return TCL_ERROR;
		}
1501
1502
1503
1504
1505
1506
1507
1508
1509

1510
1511
1512
1513
1514
1515
1516
1491
1492
1493
1494
1495
1496
1497


1498
1499
1500
1501
1502
1503
1504
1505







-
-
+







	goto unknownMethod;
    }
    Tcl_SetObjResult(interp,
	    Tcl_NewStringObj(mPtr->typePtr->name, TCL_AUTO_LENGTH));
    return TCL_OK;

  unknownMethod:
    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
	    "unknown method \"%s\"", TclGetString(objv[2])));
    TclPrintfResult(interp, "unknown method \"%s\"", TclGetString(objv[2]));
    TclSetErrorCode(interp, "TCL", "LOOKUP", "METHOD", TclGetString(objv[2]));
    return TCL_ERROR;
}

/*
 * ----------------------------------------------------------------------
 *
1671
1672
1673
1674
1675
1676
1677
1678

1679
1680

1681
1682
1683
1684
1685
1686
1687
1660
1661
1662
1663
1664
1665
1666

1667
1668

1669
1670
1671
1672
1673
1674
1675
1676







-
+

-
+








    if (objc != 2 && objc != 3) {
	Tcl_WrongNumArgs(interp, 1, objv, "className ?-private?");
	return TCL_ERROR;
    }
    if (objc == 3) {
	if (strcmp("-private", TclGetString(objv[2])) != 0) {
	    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
	    TclPrintfResult(interp,
		    "option \"%s\" is not exactly \"-private\"",
		    TclGetString(objv[2])));
		    TclGetString(objv[2]));
	    OO_ERROR(interp, BAD_ARG);
	    return TCL_ERROR;
	}
	isPrivate = 1;
    }
    clsPtr = TclOOGetClassFromObj(interp, objv[1]);
    if (clsPtr == NULL) {
1738
1739
1740
1741
1742
1743
1744
1745
1746

1747
1748
1749
1750
1751
1752
1753
1727
1728
1729
1730
1731
1732
1733


1734
1735
1736
1737
1738
1739
1740
1741







-
-
+







    /*
     * Get the call context and render its call chain.
     */

    contextPtr = TclOOGetCallContext(oPtr, objv[2], PUBLIC_METHOD, NULL, NULL,
	    NULL);
    if (contextPtr == NULL) {
	Tcl_SetObjResult(interp, Tcl_NewStringObj(
		"cannot construct any call chain", TCL_AUTO_LENGTH));
	TclPrintfResult(interp, "cannot construct any call chain");
	OO_ERROR(interp, BAD_CALL_CHAIN);
	return TCL_ERROR;
    }
    Tcl_SetObjResult(interp,
	    TclOORenderCallChain(interp, contextPtr->callPtr));
    TclOODeleteContext(contextPtr);
    return TCL_OK;
1784
1785
1786
1787
1788
1789
1790
1791
1792

1793
1794
1795
1796
1797
1798
1799
1772
1773
1774
1775
1776
1777
1778


1779
1780
1781
1782
1783
1784
1785
1786







-
-
+








    /*
     * Get an render the stereotypical call chain.
     */

    callPtr = TclOOGetStereotypeCallChain(clsPtr, objv[2], PUBLIC_METHOD);
    if (callPtr == NULL) {
	Tcl_SetObjResult(interp, Tcl_NewStringObj(
		"cannot construct any call chain", TCL_AUTO_LENGTH));
	TclPrintfResult(interp, "cannot construct any call chain");
	OO_ERROR(interp, BAD_CALL_CHAIN);
	return TCL_ERROR;
    }
    Tcl_SetObjResult(interp, TclOORenderCallChain(interp, callPtr));
    TclOODeleteChain(callPtr);
    return TCL_OK;
}