Diff
Not logged in
Home Timeline Branches Tags Tickets Wiki Login
Annotate Patch Unified Diff

Differences From Artifact [e4468c9455]:

To Artifact [6b88d6e267]:

︙︙
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)));
	TclSetErrorCode(interp, "TCL", "LOOKUP", "CLASS",
		TclGetString(objPtr));
	return NULL;
    }
    return oPtr->classPtr;
}









|
|








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) {
	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

    return TCL_OK;

    /*
     * Errors...
     */

  unknownMethod:
    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
	    "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",
	    TCL_AUTO_LENGTH));
    TclSetErrorCode(interp, "TCL", "LOOKUP", "METHOD", TclGetString(objv[2]));
    return TCL_ERROR;
}

/*
 * ----------------------------------------------------------------------
 *








<
|




|
|
<








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:

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

  wrongType:
    TclPrintfResult(interp,
	    "definition not available for this kind of method");

    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

    return TCL_OK;

    /*
     * Errors...
     */

  unknownMethod:
    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
	    "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",
	    TCL_AUTO_LENGTH));
    TclSetErrorCode(interp, "TCL", "LOOKUP", "METHOD", TclGetString(objv[2]));
    return TCL_ERROR;
}

/*
 * ----------------------------------------------------------------------
 *








|
|




|
|
<








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:
    TclPrintfResult(interp,
	    "unknown method \"%s\"", TclGetString(objv[2]));
    TclSetErrorCode(interp, "TCL", "LOOKUP", "METHOD", TclGetString(objv[2]));
    return TCL_ERROR;

  wrongType:
    TclPrintfResult(interp,
	    "prefix argument list not available for this kind of method");

    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

		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"));
		    TclSetErrorCode(interp, "TCL", "ARGUMENT", "MISSING");
		    return TCL_ERROR;
		}
		if (Tcl_GetIndexFromObj(interp, objv[i], scopes, "scope", 0,
			&scope) != TCL_OK) {
		    return TCL_ERROR;
		}








<
|








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) {

		    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

    }

    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])));
    TclSetErrorCode(interp, "TCL", "LOOKUP", "METHOD", TclGetString(objv[2]));
    return TCL_ERROR;
}

/*
 * ----------------------------------------------------------------------
 *








<
|








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:

    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


    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(
		    "option \"%s\" is not exactly \"-private\"",
		    TclGetString(objv[2])));
	    OO_ERROR(interp, BAD_ARG);
	    return TCL_ERROR;
	}
	isPrivate = 1;
    }
    oPtr = (Object *) Tcl_GetObjectFromObj(interp, objv[1]);
    if (oPtr == NULL) {








|

|








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) {
	    TclPrintfResult(interp,
		    "option \"%s\" is not exactly \"-private\"",
		    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

	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",
		TCL_AUTO_LENGTH));
	OO_ERROR(interp, METHOD_TYPE);
	return TCL_ERROR;
    }

    TclNewObj(resultObjs[0]);
    for (localPtr=procPtr->firstLocalPtr; localPtr!=NULL;
	    localPtr=localPtr->nextPtr) {








|
|
<








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) {
	TclPrintfResult(interp,
		"definition not available for this kind of method");

	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

    }
    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])));
	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",
		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) {








|
|





|
|
<








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) {
	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) {
	TclPrintfResult(interp,
		"definition not available for this kind of method");

	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

    }

    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",
		TCL_AUTO_LENGTH));
	OO_ERROR(interp, METHOD_TYPE);
	return TCL_ERROR;
    }

    Tcl_SetObjResult(interp, TclOOGetMethodBody(clsPtr->destructorPtr));
    return TCL_OK;
}








|
|
<








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) {
	TclPrintfResult(interp,
		"definition not available for this kind of method");

	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

    }
    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])));
	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",
		TCL_AUTO_LENGTH));
	TclSetErrorCode(interp, "TCL", "LOOKUP", "METHOD", TclGetString(objv[2]));
	return TCL_ERROR;
    }

    Tcl_SetObjResult(interp, prefixObj);
    return TCL_OK;
}








|
|





|
|
<








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) {
	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) {
	TclPrintfResult(interp,
		"prefix argument list not available for this kind of method");

	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

		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"));
		    TclSetErrorCode(interp, "TCL", "ARGUMENT", "MISSING");
		    return TCL_ERROR;
		}
		if (Tcl_GetIndexFromObj(interp, objv[i], scopes, "scope", 0,
			&scope) != TCL_OK) {
		    return TCL_ERROR;
		}








<
|








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) {

		    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

	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])));
    TclSetErrorCode(interp, "TCL", "LOOKUP", "METHOD", TclGetString(objv[2]));
    return TCL_ERROR;
}

/*
 * ----------------------------------------------------------------------
 *








<
|








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:

    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


    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(
		    "option \"%s\" is not exactly \"-private\"",
		    TclGetString(objv[2])));
	    OO_ERROR(interp, BAD_ARG);
	    return TCL_ERROR;
	}
	isPrivate = 1;
    }
    clsPtr = TclOOGetClassFromObj(interp, objv[1]);
    if (clsPtr == NULL) {








|

|








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) {
	    TclPrintfResult(interp,
		    "option \"%s\" is not exactly \"-private\"",
		    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

    /*
     * 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));
	OO_ERROR(interp, BAD_CALL_CHAIN);
	return TCL_ERROR;
    }
    Tcl_SetObjResult(interp,
	    TclOORenderCallChain(interp, contextPtr->callPtr));
    TclOODeleteContext(contextPtr);
    return TCL_OK;








<
|








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) {

	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


    /*
     * 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));
	OO_ERROR(interp, BAD_CALL_CHAIN);
	return TCL_ERROR;
    }
    Tcl_SetObjResult(interp, TclOORenderCallChain(interp, callPtr));
    TclOODeleteChain(callPtr);
    return TCL_OK;
}








<
|








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) {

	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;
}
︙︙
This page was created in about 0.024s by Fossil version [1205ec86cb] 2025-04-30 16:57:32