Itcl - the [incr Tcl] extension

Check-in [cbc674f840]
Login

Many hyperlinks are disabled.
Use anonymous login to enable hyperlinks.

Overview
Comment:Getting utilities exposed needed by Itk 4.1
Downloads: Tarball | ZIP archive | SQL archive
Timelines: family | ancestors | descendants | both | experiment
Files: files | file ages | folders
SHA1: cbc674f8404f59c368b6048dcdf607dfcbb0ca17
User & Date: dgp 2017-07-25 20:33:12
Context
2017-07-27
15:25
Make Itcl(Get|Set)InstanceVariable() agree (better) with class resolvers. check-in: aafddb80ea user: dgp tags: experiment
2017-07-25
20:33
Getting utilities exposed needed by Itk 4.1 check-in: cbc674f840 user: dgp tags: experiment
2017-07-20
20:54
Revert last commit and take the better approach. Stop ItclObjectCmd from going poking into Tcl's areas of the CallFrame. Use Itcl's own mechanisms for fetching proper context information. check-in: 3e21a7bc42 user: dgp tags: trunk
Changes
Hide Diffs Unified Diffs Ignore Whitespace Patch

Changes to generic/itcl.decls.

605
606
607
608
609
610
611















    int ItclClassBaseCmd(ClientData clientData, Tcl_Interp *interp,
            int flags, int objc, Tcl_Obj *const objv[], ItclClass **iclsPtrPtr)
}
declare 181 {
    int ItclCreateComponent(Tcl_Interp *interp, ItclClass *iclsPtr,
            Tcl_Obj *componentPtr, int type, ItclComponent **icPtrPtr)
}






















>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
605
606
607
608
609
610
611
612
613
614
615
616
617
618
619
620
621
622
623
624
625
626
    int ItclClassBaseCmd(ClientData clientData, Tcl_Interp *interp,
            int flags, int objc, Tcl_Obj *const objv[], ItclClass **iclsPtrPtr)
}
declare 181 {
    int ItclCreateComponent(Tcl_Interp *interp, ItclClass *iclsPtr,
            Tcl_Obj *componentPtr, int type, ItclComponent **icPtrPtr)
}
declare 182 {
    void Itcl_SetContext(Tcl_Interp *interp, ItclObject *ioPtr)
}
declare 183 {
    void Itcl_UnsetContext(Tcl_Interp *interp)
}
declare 184 {
    const char * ItclGetInstanceVar(Tcl_Interp *interp, const char *name,
	    const char *name2, ItclObject *ioPtr, ItclClass *iclsPtr)
}
declare 185 {
    const char * ItclSetInstanceVar(Tcl_Interp *interp, const char *name,
	    const char *name2, const char *value, ItclObject *ioPtr,
	    ItclClass *iclsPtr)
}

Changes to generic/itclDecls.h.

15
16
17
18
19
20
21
22
23
24
25
26
27
28
29

#endif


/* !BEGIN!: Do not edit below this line. */

#define ITCL_STUBS_EPOCH 0
#define ITCL_STUBS_REVISION 147

#ifdef __cplusplus
extern "C" {
#endif

/*
 * Exported function declarations:







|







15
16
17
18
19
20
21
22
23
24
25
26
27
28
29

#endif


/* !BEGIN!: Do not edit below this line. */

#define ITCL_STUBS_EPOCH 0
#define ITCL_STUBS_REVISION 150

#ifdef __cplusplus
extern "C" {
#endif

/*
 * Exported function declarations:

Changes to generic/itclInt.h.

737
738
739
740
741
742
743
744
745
746
747
748
749
750
751
752
753
MODULE_SCOPE int Itcl_CreateOption (Tcl_Interp *interp, ItclClass *iclsPtr,
	ItclOption *ioptPtr);
MODULE_SCOPE int Itcl_CreateMethodVariable (Tcl_Interp *interp,
        ItclClass *iclsPtr, Tcl_Obj *name, Tcl_Obj *defaultPtr,
	Tcl_Obj *callbackPtr, ItclMethodVariable **imvPtr);
MODULE_SCOPE int DelegationInstall(Tcl_Interp *interp, ItclObject *ioPtr,
        ItclClass *iclsPtr);
MODULE_SCOPE const char* ItclGetInstanceVar(Tcl_Interp *interp,
        const char *name, const char *name2, ItclObject *contextIoPtr,
	ItclClass *contextIclsPtr);
MODULE_SCOPE const char* ItclGetCommonInstanceVar(Tcl_Interp *interp,
        const char *name, const char *name2, ItclObject *contextIoPtr,
	ItclClass *contextIclsPtr);
MODULE_SCOPE int ItclCreateMethod(Tcl_Interp* interp, ItclClass *iclsPtr,
	Tcl_Obj *namePtr, const char* arglist, const char* body,
        ItclMemberFunc **imPtrPtr);
MODULE_SCOPE int Itcl_WidgetParseInit(Tcl_Interp *interp,







<
<
<







737
738
739
740
741
742
743



744
745
746
747
748
749
750
MODULE_SCOPE int Itcl_CreateOption (Tcl_Interp *interp, ItclClass *iclsPtr,
	ItclOption *ioptPtr);
MODULE_SCOPE int Itcl_CreateMethodVariable (Tcl_Interp *interp,
        ItclClass *iclsPtr, Tcl_Obj *name, Tcl_Obj *defaultPtr,
	Tcl_Obj *callbackPtr, ItclMethodVariable **imvPtr);
MODULE_SCOPE int DelegationInstall(Tcl_Interp *interp, ItclObject *ioPtr,
        ItclClass *iclsPtr);



MODULE_SCOPE const char* ItclGetCommonInstanceVar(Tcl_Interp *interp,
        const char *name, const char *name2, ItclObject *contextIoPtr,
	ItclClass *contextIclsPtr);
MODULE_SCOPE int ItclCreateMethod(Tcl_Interp* interp, ItclClass *iclsPtr,
	Tcl_Obj *namePtr, const char* arglist, const char* body,
        ItclMemberFunc **imPtrPtr);
MODULE_SCOPE int Itcl_WidgetParseInit(Tcl_Interp *interp,

Changes to generic/itclIntDecls.h.

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
/*
 * This file is (mostly) automatically generated from itcl.decls.
 */

#ifndef _ITCLINTDECLS
#define _ITCLINTDECLS

/* !BEGIN!: Do not edit below this line. */

#define ITCLINT_STUBS_EPOCH 0
#define ITCLINT_STUBS_REVISION 147

#ifdef __cplusplus
extern "C" {
#endif

/*
 * Exported function declarations:










|







1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
/*
 * This file is (mostly) automatically generated from itcl.decls.
 */

#ifndef _ITCLINTDECLS
#define _ITCLINTDECLS

/* !BEGIN!: Do not edit below this line. */

#define ITCLINT_STUBS_EPOCH 0
#define ITCLINT_STUBS_REVISION 150

#ifdef __cplusplus
extern "C" {
#endif

/*
 * Exported function declarations:
508
509
510
511
512
513
514









515
516
517
518
519
520
521
				Tcl_Interp *interp, int flags, int objc,
				Tcl_Obj *const objv[],
				ItclClass **iclsPtrPtr);
/* 181 */
ITCLAPI int		ItclCreateComponent(Tcl_Interp *interp,
				ItclClass *iclsPtr, Tcl_Obj *componentPtr,
				int type, ItclComponent **icPtrPtr);










typedef struct ItclIntStubs {
    int magic;
    int epoch;
    int revision;
    void *hooks;








>
>
>
>
>
>
>
>
>







508
509
510
511
512
513
514
515
516
517
518
519
520
521
522
523
524
525
526
527
528
529
530
				Tcl_Interp *interp, int flags, int objc,
				Tcl_Obj *const objv[],
				ItclClass **iclsPtrPtr);
/* 181 */
ITCLAPI int		ItclCreateComponent(Tcl_Interp *interp,
				ItclClass *iclsPtr, Tcl_Obj *componentPtr,
				int type, ItclComponent **icPtrPtr);
/* 182 */
ITCLAPI void		Itcl_SetContext(Tcl_Interp *interp,
				ItclObject *ioPtr);
/* 183 */
ITCLAPI void		Itcl_UnsetContext(Tcl_Interp *interp);
/* 184 */
ITCLAPI const char *	ItclGetInstanceVar(Tcl_Interp *interp,
				const char *name, const char *name2,
				ItclObject *ioPtr, ItclClass *iclsPtr);

typedef struct ItclIntStubs {
    int magic;
    int epoch;
    int revision;
    void *hooks;

697
698
699
700
701
702
703



704
705
706
707
708
709
710
    void (*itcl_PopCallFrame) (Tcl_Interp *interp); /* 175 */
    Tcl_CallFrame * (*itcl_GetUplevelCallFrame) (Tcl_Interp *interp, int level); /* 176 */
    Tcl_CallFrame * (*itcl_ActivateCallFrame) (Tcl_Interp *interp, Tcl_CallFrame *framePtr); /* 177 */
    const char* (*itclSetInstanceVar) (Tcl_Interp *interp, const char *name, const char *name2, const char *value, ItclObject *contextIoPtr, ItclClass *contextIclsPtr); /* 178 */
    Tcl_Obj * (*itclCapitalize) (const char *str); /* 179 */
    int (*itclClassBaseCmd) (ClientData clientData, Tcl_Interp *interp, int flags, int objc, Tcl_Obj *const objv[], ItclClass **iclsPtrPtr); /* 180 */
    int (*itclCreateComponent) (Tcl_Interp *interp, ItclClass *iclsPtr, Tcl_Obj *componentPtr, int type, ItclComponent **icPtrPtr); /* 181 */



} ItclIntStubs;

extern const ItclIntStubs *itclIntStubsPtr;

#ifdef __cplusplus
}
#endif







>
>
>







706
707
708
709
710
711
712
713
714
715
716
717
718
719
720
721
722
    void (*itcl_PopCallFrame) (Tcl_Interp *interp); /* 175 */
    Tcl_CallFrame * (*itcl_GetUplevelCallFrame) (Tcl_Interp *interp, int level); /* 176 */
    Tcl_CallFrame * (*itcl_ActivateCallFrame) (Tcl_Interp *interp, Tcl_CallFrame *framePtr); /* 177 */
    const char* (*itclSetInstanceVar) (Tcl_Interp *interp, const char *name, const char *name2, const char *value, ItclObject *contextIoPtr, ItclClass *contextIclsPtr); /* 178 */
    Tcl_Obj * (*itclCapitalize) (const char *str); /* 179 */
    int (*itclClassBaseCmd) (ClientData clientData, Tcl_Interp *interp, int flags, int objc, Tcl_Obj *const objv[], ItclClass **iclsPtrPtr); /* 180 */
    int (*itclCreateComponent) (Tcl_Interp *interp, ItclClass *iclsPtr, Tcl_Obj *componentPtr, int type, ItclComponent **icPtrPtr); /* 181 */
    void (*itcl_SetContext) (Tcl_Interp *interp, ItclObject *ioPtr); /* 182 */
    void (*itcl_UnsetContext) (Tcl_Interp *interp); /* 183 */
    const char * (*itclGetInstanceVar) (Tcl_Interp *interp, const char *name, const char *name2, ItclObject *ioPtr, ItclClass *iclsPtr); /* 184 */
} ItclIntStubs;

extern const ItclIntStubs *itclIntStubsPtr;

#ifdef __cplusplus
}
#endif
1016
1017
1018
1019
1020
1021
1022






1023
1024
1025
1026
1027
1028
	(itclIntStubsPtr->itclSetInstanceVar) /* 178 */
#define ItclCapitalize \
	(itclIntStubsPtr->itclCapitalize) /* 179 */
#define ItclClassBaseCmd \
	(itclIntStubsPtr->itclClassBaseCmd) /* 180 */
#define ItclCreateComponent \
	(itclIntStubsPtr->itclCreateComponent) /* 181 */







#endif /* defined(USE_ITCL_STUBS) */

/* !END!: Do not edit above this line. */

#endif /* _ITCLINTDECLS */







>
>
>
>
>
>






1028
1029
1030
1031
1032
1033
1034
1035
1036
1037
1038
1039
1040
1041
1042
1043
1044
1045
1046
	(itclIntStubsPtr->itclSetInstanceVar) /* 178 */
#define ItclCapitalize \
	(itclIntStubsPtr->itclCapitalize) /* 179 */
#define ItclClassBaseCmd \
	(itclIntStubsPtr->itclClassBaseCmd) /* 180 */
#define ItclCreateComponent \
	(itclIntStubsPtr->itclCreateComponent) /* 181 */
#define Itcl_SetContext \
	(itclIntStubsPtr->itcl_SetContext) /* 182 */
#define Itcl_UnsetContext \
	(itclIntStubsPtr->itcl_UnsetContext) /* 183 */
#define ItclGetInstanceVar \
	(itclIntStubsPtr->itclGetInstanceVar) /* 184 */

#endif /* defined(USE_ITCL_STUBS) */

/* !END!: Do not edit above this line. */

#endif /* _ITCLINTDECLS */

Changes to generic/itclMethod.c.

1407
1408
1409
1410
1411
1412
1413
























































1414
1415
1416
1417
1418
1419
1420
 *  Returns TCL_OK if the current namespace is a class namespace.
 *  Also returns pointers to the class definition, and to object
 *  data if an object context is active.  Returns TCL_ERROR (along
 *  with an error message in the interpreter) if a class namespace
 *  is not active.
 * ------------------------------------------------------------------------
 */
























































int
Itcl_GetContext(
    Tcl_Interp *interp,           /* current interpreter */
    ItclClass **iclsPtrPtr,       /* returns:  class definition or NULL */
    ItclObject **ioPtrPtr)        /* returns:  object data or NULL */
{
    Tcl_Namespace *nsPtr;







>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>







1407
1408
1409
1410
1411
1412
1413
1414
1415
1416
1417
1418
1419
1420
1421
1422
1423
1424
1425
1426
1427
1428
1429
1430
1431
1432
1433
1434
1435
1436
1437
1438
1439
1440
1441
1442
1443
1444
1445
1446
1447
1448
1449
1450
1451
1452
1453
1454
1455
1456
1457
1458
1459
1460
1461
1462
1463
1464
1465
1466
1467
1468
1469
1470
1471
1472
1473
1474
1475
1476
 *  Returns TCL_OK if the current namespace is a class namespace.
 *  Also returns pointers to the class definition, and to object
 *  data if an object context is active.  Returns TCL_ERROR (along
 *  with an error message in the interpreter) if a class namespace
 *  is not active.
 * ------------------------------------------------------------------------
 */

void
Itcl_SetContext(
    Tcl_Interp *interp,
    ItclObject *ioPtr)
{
    int new;
    Itcl_Stack *stackPtr;
    Tcl_CallFrame *framePtr = Itcl_GetUplevelCallFrame(interp, 0);
    ItclObjectInfo *infoPtr = (ItclObjectInfo *)Tcl_GetAssocData(interp,
            ITCL_INTERP_DATA, NULL);
    Tcl_HashEntry *hPtr = Tcl_CreateHashEntry(&infoPtr->frameContext,
	    (char *)framePtr, &new);
    ItclCallContext *contextPtr
	    = (ItclCallContext *) ckalloc(sizeof(ItclCallContext));

    memset(contextPtr, 0, sizeof(ItclCallContext));
    contextPtr->ioPtr = ioPtr;
    contextPtr->refCount = 1;

    if (!new) {
	Tcl_Panic("frame already has context?!");
    }
    
    stackPtr = (Itcl_Stack *) ckalloc(sizeof(Itcl_Stack));
    Itcl_InitStack(stackPtr);
    Tcl_SetHashValue(hPtr, stackPtr);

    Itcl_PushStack(contextPtr, stackPtr);
}

void
Itcl_UnsetContext(
    Tcl_Interp *interp)
{
    Tcl_CallFrame *framePtr = Itcl_GetUplevelCallFrame(interp, 0);
    ItclObjectInfo *infoPtr = (ItclObjectInfo *)Tcl_GetAssocData(interp,
            ITCL_INTERP_DATA, NULL);
    Tcl_HashEntry *hPtr = Tcl_FindHashEntry(&infoPtr->frameContext,
	    (char *)framePtr);
    Itcl_Stack *stackPtr = (Itcl_Stack *) Tcl_GetHashValue(hPtr);
    ItclCallContext *contextPtr = Itcl_PopStack(stackPtr);

    if (Itcl_GetStackSize(stackPtr) > 0) {
	Tcl_Panic("frame context stack not empty!");
    }
    Itcl_DeleteStack(stackPtr);
    ckfree((char *) stackPtr);
    Tcl_DeleteHashEntry(hPtr);
    contextPtr->refCount--;
    if (contextPtr->refCount) {
	Tcl_Panic("frame context ref count not zero!");
    }
    ckfree((char *)contextPtr);
}

int
Itcl_GetContext(
    Tcl_Interp *interp,           /* current interpreter */
    ItclClass **iclsPtrPtr,       /* returns:  class definition or NULL */
    ItclObject **ioPtrPtr)        /* returns:  object data or NULL */
{
    Tcl_Namespace *nsPtr;
1438
1439
1440
1441
1442
1443
1444
1445

1446
1447
1448
1449
1450
1451
1452
	    ItclObject *ioPtr = contextPtr->ioPtr;

	    *iclsPtrPtr = ioPtr->iclsPtr;
	    *ioPtrPtr = ioPtr;
	    return TCL_OK;
	}

	*iclsPtrPtr = contextPtr->imPtr->iclsPtr;

	*ioPtrPtr = contextPtr->ioPtr ? contextPtr->ioPtr : infoPtr->currIoPtr;
	return TCL_OK;
    }

    /* Frame has no Itcl context data.  No way to get object context. */
    *ioPtrPtr = NULL;








|
>







1494
1495
1496
1497
1498
1499
1500
1501
1502
1503
1504
1505
1506
1507
1508
1509
	    ItclObject *ioPtr = contextPtr->ioPtr;

	    *iclsPtrPtr = ioPtr->iclsPtr;
	    *ioPtrPtr = ioPtr;
	    return TCL_OK;
	}

	*iclsPtrPtr = contextPtr->imPtr ? contextPtr->imPtr->iclsPtr
		: contextPtr->ioPtr->iclsPtr;
	*ioPtrPtr = contextPtr->ioPtr ? contextPtr->ioPtr : infoPtr->currIoPtr;
	return TCL_OK;
    }

    /* Frame has no Itcl context data.  No way to get object context. */
    *ioPtrPtr = NULL;

Changes to generic/itclStubInit.c.

191
192
193
194
195
196
197



198
199
200
201
202
203
204
    Itcl_PopCallFrame, /* 175 */
    Itcl_GetUplevelCallFrame, /* 176 */
    Itcl_ActivateCallFrame, /* 177 */
    ItclSetInstanceVar, /* 178 */
    ItclCapitalize, /* 179 */
    ItclClassBaseCmd, /* 180 */
    ItclCreateComponent, /* 181 */



};

static const ItclStubHooks itclStubHooks = {
    &itclIntStubs
};

const ItclStubs itclStubs = {







>
>
>







191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
    Itcl_PopCallFrame, /* 175 */
    Itcl_GetUplevelCallFrame, /* 176 */
    Itcl_ActivateCallFrame, /* 177 */
    ItclSetInstanceVar, /* 178 */
    ItclCapitalize, /* 179 */
    ItclClassBaseCmd, /* 180 */
    ItclCreateComponent, /* 181 */
    Itcl_SetContext, /* 182 */
    Itcl_UnsetContext, /* 183 */
    ItclGetInstanceVar, /* 184 */
};

static const ItclStubHooks itclStubHooks = {
    &itclIntStubs
};

const ItclStubs itclStubs = {