/*
|
/*
|
* ------------------------------------------------------------------------
|
* ------------------------------------------------------------------------
|
* PACKAGE: [incr Tcl]
|
* PACKAGE: [incr Tcl]
|
* DESCRIPTION: Object-Oriented Extensions to Tcl
|
* DESCRIPTION: Object-Oriented Extensions to Tcl
|
*
|
*
|
* [incr Tcl] provides object-oriented extensions to Tcl, much as
|
* [incr Tcl] provides object-oriented extensions to Tcl, much as
|
* C++ provides object-oriented extensions to C. It provides a means
|
* C++ provides object-oriented extensions to C. It provides a means
|
* of encapsulating related procedures together with their shared data
|
* of encapsulating related procedures together with their shared data
|
* in a local namespace that is hidden from the outside world. It
|
* in a local namespace that is hidden from the outside world. It
|
* promotes code re-use through inheritance. More than anything else,
|
* promotes code re-use through inheritance. More than anything else,
|
* it encourages better organization of Tcl applications through the
|
* it encourages better organization of Tcl applications through the
|
* object-oriented paradigm, leading to code that is easier to
|
* object-oriented paradigm, leading to code that is easier to
|
* understand and maintain.
|
* understand and maintain.
|
*
|
*
|
* This part adds a mechanism for integrating C procedures into
|
* This part adds a mechanism for integrating C procedures into
|
* [incr Tcl] classes as methods and procs. Each C procedure must
|
* [incr Tcl] classes as methods and procs. Each C procedure must
|
* either be declared via Itcl_RegisterC() or dynamically loaded.
|
* either be declared via Itcl_RegisterC() or dynamically loaded.
|
*
|
*
|
* ========================================================================
|
* ========================================================================
|
* AUTHOR: Michael J. McLennan
|
* AUTHOR: Michael J. McLennan
|
* Bell Labs Innovations for Lucent Technologies
|
* Bell Labs Innovations for Lucent Technologies
|
* mmclennan@lucent.com
|
* mmclennan@lucent.com
|
* http://www.tcltk.com/itcl
|
* http://www.tcltk.com/itcl
|
*
|
*
|
* RCS: $Id: itcl_linkage.c,v 1.1.1.1 2002-01-16 10:24:46 markom Exp $
|
* RCS: $Id: itcl_linkage.c,v 1.1.1.1 2002-01-16 10:24:46 markom Exp $
|
* ========================================================================
|
* ========================================================================
|
* Copyright (c) 1993-1998 Lucent Technologies, Inc.
|
* Copyright (c) 1993-1998 Lucent Technologies, Inc.
|
* ------------------------------------------------------------------------
|
* ------------------------------------------------------------------------
|
* See the file "license.terms" for information on usage and redistribution
|
* See the file "license.terms" for information on usage and redistribution
|
* of this file, and for a DISCLAIMER OF ALL WARRANTIES.
|
* of this file, and for a DISCLAIMER OF ALL WARRANTIES.
|
*/
|
*/
|
#include "itclInt.h"
|
#include "itclInt.h"
|
|
|
/*
|
/*
|
* These records store the pointers for all "RegisterC" functions.
|
* These records store the pointers for all "RegisterC" functions.
|
*/
|
*/
|
typedef struct ItclCfunc {
|
typedef struct ItclCfunc {
|
Tcl_CmdProc *argCmdProc; /* old-style (argc,argv) command handler */
|
Tcl_CmdProc *argCmdProc; /* old-style (argc,argv) command handler */
|
Tcl_ObjCmdProc *objCmdProc; /* new (objc,objv) command handler */
|
Tcl_ObjCmdProc *objCmdProc; /* new (objc,objv) command handler */
|
ClientData clientData; /* client data passed into this function */
|
ClientData clientData; /* client data passed into this function */
|
Tcl_CmdDeleteProc *deleteProc; /* proc called to free clientData */
|
Tcl_CmdDeleteProc *deleteProc; /* proc called to free clientData */
|
} ItclCfunc;
|
} ItclCfunc;
|
|
|
static Tcl_HashTable* ItclGetRegisteredProcs _ANSI_ARGS_((Tcl_Interp *interp));
|
static Tcl_HashTable* ItclGetRegisteredProcs _ANSI_ARGS_((Tcl_Interp *interp));
|
static void ItclFreeC _ANSI_ARGS_((ClientData clientData, Tcl_Interp *interp));
|
static void ItclFreeC _ANSI_ARGS_((ClientData clientData, Tcl_Interp *interp));
|
|
|
|
|
/*
|
/*
|
* ------------------------------------------------------------------------
|
* ------------------------------------------------------------------------
|
* Itcl_RegisterC()
|
* Itcl_RegisterC()
|
*
|
*
|
* Used to associate a symbolic name with an (argc,argv) C procedure
|
* Used to associate a symbolic name with an (argc,argv) C procedure
|
* that handles a Tcl command. Procedures that are registered in this
|
* that handles a Tcl command. Procedures that are registered in this
|
* manner can be referenced in the body of an [incr Tcl] class
|
* manner can be referenced in the body of an [incr Tcl] class
|
* definition to specify C procedures to acting as methods/procs.
|
* definition to specify C procedures to acting as methods/procs.
|
* Usually invoked in an initialization routine for an extension,
|
* Usually invoked in an initialization routine for an extension,
|
* called out in Tcl_AppInit() at the start of an application.
|
* called out in Tcl_AppInit() at the start of an application.
|
*
|
*
|
* Each symbolic procedure can have an arbitrary client data value
|
* Each symbolic procedure can have an arbitrary client data value
|
* associated with it. This value is passed into the command
|
* associated with it. This value is passed into the command
|
* handler whenever it is invoked.
|
* handler whenever it is invoked.
|
*
|
*
|
* A symbolic procedure name can be used only once for a given style
|
* A symbolic procedure name can be used only once for a given style
|
* (arg/obj) handler. If the name is defined with an arg-style
|
* (arg/obj) handler. If the name is defined with an arg-style
|
* handler, it can be redefined with an obj-style handler; or if
|
* handler, it can be redefined with an obj-style handler; or if
|
* the name is defined with an obj-style handler, it can be redefined
|
* the name is defined with an obj-style handler, it can be redefined
|
* with an arg-style handler. In either case, any previous client
|
* with an arg-style handler. In either case, any previous client
|
* data is discarded and the new client data is remembered. However,
|
* data is discarded and the new client data is remembered. However,
|
* if a name is redefined to a different handler of the same style,
|
* if a name is redefined to a different handler of the same style,
|
* this procedure returns an error.
|
* this procedure returns an error.
|
*
|
*
|
* Returns TCL_OK on success, or TCL_ERROR (along with an error message
|
* Returns TCL_OK on success, or TCL_ERROR (along with an error message
|
* in interp->result) if anything goes wrong.
|
* in interp->result) if anything goes wrong.
|
* ------------------------------------------------------------------------
|
* ------------------------------------------------------------------------
|
*/
|
*/
|
int
|
int
|
Itcl_RegisterC(interp, name, proc, clientData, deleteProc)
|
Itcl_RegisterC(interp, name, proc, clientData, deleteProc)
|
Tcl_Interp *interp; /* interpreter handling this registration */
|
Tcl_Interp *interp; /* interpreter handling this registration */
|
char *name; /* symbolic name for procedure */
|
char *name; /* symbolic name for procedure */
|
Tcl_CmdProc *proc; /* procedure handling Tcl command */
|
Tcl_CmdProc *proc; /* procedure handling Tcl command */
|
ClientData clientData; /* client data associated with proc */
|
ClientData clientData; /* client data associated with proc */
|
Tcl_CmdDeleteProc *deleteProc; /* proc called to free up client data */
|
Tcl_CmdDeleteProc *deleteProc; /* proc called to free up client data */
|
{
|
{
|
int newEntry;
|
int newEntry;
|
Tcl_HashEntry *entry;
|
Tcl_HashEntry *entry;
|
Tcl_HashTable *procTable;
|
Tcl_HashTable *procTable;
|
ItclCfunc *cfunc;
|
ItclCfunc *cfunc;
|
|
|
/*
|
/*
|
* Make sure that a proc was specified.
|
* Make sure that a proc was specified.
|
*/
|
*/
|
if (!proc) {
|
if (!proc) {
|
Tcl_AppendResult(interp, "initialization error: null pointer for ",
|
Tcl_AppendResult(interp, "initialization error: null pointer for ",
|
"C procedure \"", name, "\"",
|
"C procedure \"", name, "\"",
|
(char*)NULL);
|
(char*)NULL);
|
return TCL_ERROR;
|
return TCL_ERROR;
|
}
|
}
|
|
|
/*
|
/*
|
* Add a new entry for the given procedure. If an entry with
|
* Add a new entry for the given procedure. If an entry with
|
* this name already exists, then make sure that it was defined
|
* this name already exists, then make sure that it was defined
|
* with the same proc.
|
* with the same proc.
|
*/
|
*/
|
procTable = ItclGetRegisteredProcs(interp);
|
procTable = ItclGetRegisteredProcs(interp);
|
entry = Tcl_CreateHashEntry(procTable, name, &newEntry);
|
entry = Tcl_CreateHashEntry(procTable, name, &newEntry);
|
if (!newEntry) {
|
if (!newEntry) {
|
cfunc = (ItclCfunc*)Tcl_GetHashValue(entry);
|
cfunc = (ItclCfunc*)Tcl_GetHashValue(entry);
|
if (cfunc->argCmdProc != NULL && cfunc->argCmdProc != proc) {
|
if (cfunc->argCmdProc != NULL && cfunc->argCmdProc != proc) {
|
Tcl_AppendResult(interp, "initialization error: C procedure ",
|
Tcl_AppendResult(interp, "initialization error: C procedure ",
|
"with name \"", name, "\" already defined",
|
"with name \"", name, "\" already defined",
|
(char*)NULL);
|
(char*)NULL);
|
return TCL_ERROR;
|
return TCL_ERROR;
|
}
|
}
|
|
|
if (cfunc->deleteProc != NULL) {
|
if (cfunc->deleteProc != NULL) {
|
(*cfunc->deleteProc)(cfunc->clientData);
|
(*cfunc->deleteProc)(cfunc->clientData);
|
}
|
}
|
}
|
}
|
else {
|
else {
|
cfunc = (ItclCfunc*)ckalloc(sizeof(ItclCfunc));
|
cfunc = (ItclCfunc*)ckalloc(sizeof(ItclCfunc));
|
cfunc->objCmdProc = NULL;
|
cfunc->objCmdProc = NULL;
|
}
|
}
|
|
|
cfunc->argCmdProc = proc;
|
cfunc->argCmdProc = proc;
|
cfunc->clientData = clientData;
|
cfunc->clientData = clientData;
|
cfunc->deleteProc = deleteProc;
|
cfunc->deleteProc = deleteProc;
|
|
|
Tcl_SetHashValue(entry, (ClientData)cfunc);
|
Tcl_SetHashValue(entry, (ClientData)cfunc);
|
return TCL_OK;
|
return TCL_OK;
|
}
|
}
|
|
|
|
|
/*
|
/*
|
* ------------------------------------------------------------------------
|
* ------------------------------------------------------------------------
|
* Itcl_RegisterObjC()
|
* Itcl_RegisterObjC()
|
*
|
*
|
* Used to associate a symbolic name with an (objc,objv) C procedure
|
* Used to associate a symbolic name with an (objc,objv) C procedure
|
* that handles a Tcl command. Procedures that are registered in this
|
* that handles a Tcl command. Procedures that are registered in this
|
* manner can be referenced in the body of an [incr Tcl] class
|
* manner can be referenced in the body of an [incr Tcl] class
|
* definition to specify C procedures to acting as methods/procs.
|
* definition to specify C procedures to acting as methods/procs.
|
* Usually invoked in an initialization routine for an extension,
|
* Usually invoked in an initialization routine for an extension,
|
* called out in Tcl_AppInit() at the start of an application.
|
* called out in Tcl_AppInit() at the start of an application.
|
*
|
*
|
* Each symbolic procedure can have an arbitrary client data value
|
* Each symbolic procedure can have an arbitrary client data value
|
* associated with it. This value is passed into the command
|
* associated with it. This value is passed into the command
|
* handler whenever it is invoked.
|
* handler whenever it is invoked.
|
*
|
*
|
* A symbolic procedure name can be used only once for a given style
|
* A symbolic procedure name can be used only once for a given style
|
* (arg/obj) handler. If the name is defined with an arg-style
|
* (arg/obj) handler. If the name is defined with an arg-style
|
* handler, it can be redefined with an obj-style handler; or if
|
* handler, it can be redefined with an obj-style handler; or if
|
* the name is defined with an obj-style handler, it can be redefined
|
* the name is defined with an obj-style handler, it can be redefined
|
* with an arg-style handler. In either case, any previous client
|
* with an arg-style handler. In either case, any previous client
|
* data is discarded and the new client data is remembered. However,
|
* data is discarded and the new client data is remembered. However,
|
* if a name is redefined to a different handler of the same style,
|
* if a name is redefined to a different handler of the same style,
|
* this procedure returns an error.
|
* this procedure returns an error.
|
*
|
*
|
* Returns TCL_OK on success, or TCL_ERROR (along with an error message
|
* Returns TCL_OK on success, or TCL_ERROR (along with an error message
|
* in interp->result) if anything goes wrong.
|
* in interp->result) if anything goes wrong.
|
* ------------------------------------------------------------------------
|
* ------------------------------------------------------------------------
|
*/
|
*/
|
int
|
int
|
Itcl_RegisterObjC(interp, name, proc, clientData, deleteProc)
|
Itcl_RegisterObjC(interp, name, proc, clientData, deleteProc)
|
Tcl_Interp *interp; /* interpreter handling this registration */
|
Tcl_Interp *interp; /* interpreter handling this registration */
|
char *name; /* symbolic name for procedure */
|
char *name; /* symbolic name for procedure */
|
Tcl_ObjCmdProc *proc; /* procedure handling Tcl command */
|
Tcl_ObjCmdProc *proc; /* procedure handling Tcl command */
|
ClientData clientData; /* client data associated with proc */
|
ClientData clientData; /* client data associated with proc */
|
Tcl_CmdDeleteProc *deleteProc; /* proc called to free up client data */
|
Tcl_CmdDeleteProc *deleteProc; /* proc called to free up client data */
|
{
|
{
|
int newEntry;
|
int newEntry;
|
Tcl_HashEntry *entry;
|
Tcl_HashEntry *entry;
|
Tcl_HashTable *procTable;
|
Tcl_HashTable *procTable;
|
ItclCfunc *cfunc;
|
ItclCfunc *cfunc;
|
|
|
/*
|
/*
|
* Make sure that a proc was specified.
|
* Make sure that a proc was specified.
|
*/
|
*/
|
if (!proc) {
|
if (!proc) {
|
Tcl_AppendResult(interp, "initialization error: null pointer for ",
|
Tcl_AppendResult(interp, "initialization error: null pointer for ",
|
"C procedure \"", name, "\"",
|
"C procedure \"", name, "\"",
|
(char*)NULL);
|
(char*)NULL);
|
return TCL_ERROR;
|
return TCL_ERROR;
|
}
|
}
|
|
|
/*
|
/*
|
* Add a new entry for the given procedure. If an entry with
|
* Add a new entry for the given procedure. If an entry with
|
* this name already exists, then make sure that it was defined
|
* this name already exists, then make sure that it was defined
|
* with the same proc.
|
* with the same proc.
|
*/
|
*/
|
procTable = ItclGetRegisteredProcs(interp);
|
procTable = ItclGetRegisteredProcs(interp);
|
entry = Tcl_CreateHashEntry(procTable, name, &newEntry);
|
entry = Tcl_CreateHashEntry(procTable, name, &newEntry);
|
if (!newEntry) {
|
if (!newEntry) {
|
cfunc = (ItclCfunc*)Tcl_GetHashValue(entry);
|
cfunc = (ItclCfunc*)Tcl_GetHashValue(entry);
|
if (cfunc->objCmdProc != NULL && cfunc->objCmdProc != proc) {
|
if (cfunc->objCmdProc != NULL && cfunc->objCmdProc != proc) {
|
Tcl_AppendResult(interp, "initialization error: C procedure ",
|
Tcl_AppendResult(interp, "initialization error: C procedure ",
|
"with name \"", name, "\" already defined",
|
"with name \"", name, "\" already defined",
|
(char*)NULL);
|
(char*)NULL);
|
return TCL_ERROR;
|
return TCL_ERROR;
|
}
|
}
|
|
|
if (cfunc->deleteProc != NULL) {
|
if (cfunc->deleteProc != NULL) {
|
(*cfunc->deleteProc)(cfunc->clientData);
|
(*cfunc->deleteProc)(cfunc->clientData);
|
}
|
}
|
}
|
}
|
else {
|
else {
|
cfunc = (ItclCfunc*)ckalloc(sizeof(ItclCfunc));
|
cfunc = (ItclCfunc*)ckalloc(sizeof(ItclCfunc));
|
cfunc->argCmdProc = NULL;
|
cfunc->argCmdProc = NULL;
|
}
|
}
|
|
|
cfunc->objCmdProc = proc;
|
cfunc->objCmdProc = proc;
|
cfunc->clientData = clientData;
|
cfunc->clientData = clientData;
|
cfunc->deleteProc = deleteProc;
|
cfunc->deleteProc = deleteProc;
|
|
|
Tcl_SetHashValue(entry, (ClientData)cfunc);
|
Tcl_SetHashValue(entry, (ClientData)cfunc);
|
return TCL_OK;
|
return TCL_OK;
|
}
|
}
|
|
|
|
|
/*
|
/*
|
* ------------------------------------------------------------------------
|
* ------------------------------------------------------------------------
|
* Itcl_FindC()
|
* Itcl_FindC()
|
*
|
*
|
* Used to query a C procedure via its symbolic name. Looks at the
|
* Used to query a C procedure via its symbolic name. Looks at the
|
* list of procedures registered previously by either Itcl_RegisterC
|
* list of procedures registered previously by either Itcl_RegisterC
|
* or Itcl_RegisterObjC and returns pointers to the appropriate
|
* or Itcl_RegisterObjC and returns pointers to the appropriate
|
* (argc,argv) or (objc,objv) handlers. Returns non-zero if the
|
* (argc,argv) or (objc,objv) handlers. Returns non-zero if the
|
* name is recognized and pointers are returned; returns zero
|
* name is recognized and pointers are returned; returns zero
|
* otherwise.
|
* otherwise.
|
* ------------------------------------------------------------------------
|
* ------------------------------------------------------------------------
|
*/
|
*/
|
int
|
int
|
Itcl_FindC(interp, name, argProcPtr, objProcPtr, cDataPtr)
|
Itcl_FindC(interp, name, argProcPtr, objProcPtr, cDataPtr)
|
Tcl_Interp *interp; /* interpreter handling this registration */
|
Tcl_Interp *interp; /* interpreter handling this registration */
|
char *name; /* symbolic name for procedure */
|
char *name; /* symbolic name for procedure */
|
Tcl_CmdProc **argProcPtr; /* returns (argc,argv) command handler */
|
Tcl_CmdProc **argProcPtr; /* returns (argc,argv) command handler */
|
Tcl_ObjCmdProc **objProcPtr; /* returns (objc,objv) command handler */
|
Tcl_ObjCmdProc **objProcPtr; /* returns (objc,objv) command handler */
|
ClientData *cDataPtr; /* returns client data */
|
ClientData *cDataPtr; /* returns client data */
|
{
|
{
|
Tcl_HashEntry *entry;
|
Tcl_HashEntry *entry;
|
Tcl_HashTable *procTable;
|
Tcl_HashTable *procTable;
|
ItclCfunc *cfunc;
|
ItclCfunc *cfunc;
|
|
|
*argProcPtr = NULL; /* assume info won't be found */
|
*argProcPtr = NULL; /* assume info won't be found */
|
*objProcPtr = NULL;
|
*objProcPtr = NULL;
|
*cDataPtr = NULL;
|
*cDataPtr = NULL;
|
|
|
if (interp) {
|
if (interp) {
|
procTable = (Tcl_HashTable*)Tcl_GetAssocData(interp,
|
procTable = (Tcl_HashTable*)Tcl_GetAssocData(interp,
|
"itcl_RegC", (Tcl_InterpDeleteProc**)NULL);
|
"itcl_RegC", (Tcl_InterpDeleteProc**)NULL);
|
|
|
if (procTable) {
|
if (procTable) {
|
entry = Tcl_FindHashEntry(procTable, name);
|
entry = Tcl_FindHashEntry(procTable, name);
|
if (entry) {
|
if (entry) {
|
cfunc = (ItclCfunc*)Tcl_GetHashValue(entry);
|
cfunc = (ItclCfunc*)Tcl_GetHashValue(entry);
|
*argProcPtr = cfunc->argCmdProc;
|
*argProcPtr = cfunc->argCmdProc;
|
*objProcPtr = cfunc->objCmdProc;
|
*objProcPtr = cfunc->objCmdProc;
|
*cDataPtr = cfunc->clientData;
|
*cDataPtr = cfunc->clientData;
|
}
|
}
|
}
|
}
|
}
|
}
|
return (*argProcPtr != NULL || *objProcPtr != NULL);
|
return (*argProcPtr != NULL || *objProcPtr != NULL);
|
}
|
}
|
|
|
|
|
/*
|
/*
|
* ------------------------------------------------------------------------
|
* ------------------------------------------------------------------------
|
* ItclGetRegisteredProcs()
|
* ItclGetRegisteredProcs()
|
*
|
*
|
* Returns a pointer to a hash table containing the list of registered
|
* Returns a pointer to a hash table containing the list of registered
|
* procs in the specified interpreter. If the hash table does not
|
* procs in the specified interpreter. If the hash table does not
|
* already exist, it is created.
|
* already exist, it is created.
|
* ------------------------------------------------------------------------
|
* ------------------------------------------------------------------------
|
*/
|
*/
|
static Tcl_HashTable*
|
static Tcl_HashTable*
|
ItclGetRegisteredProcs(interp)
|
ItclGetRegisteredProcs(interp)
|
Tcl_Interp *interp; /* interpreter handling this registration */
|
Tcl_Interp *interp; /* interpreter handling this registration */
|
{
|
{
|
Tcl_HashTable* procTable;
|
Tcl_HashTable* procTable;
|
|
|
/*
|
/*
|
* If the registration table does not yet exist, then create it.
|
* If the registration table does not yet exist, then create it.
|
*/
|
*/
|
procTable = (Tcl_HashTable*)Tcl_GetAssocData(interp, "itcl_RegC",
|
procTable = (Tcl_HashTable*)Tcl_GetAssocData(interp, "itcl_RegC",
|
(Tcl_InterpDeleteProc**)NULL);
|
(Tcl_InterpDeleteProc**)NULL);
|
|
|
if (!procTable) {
|
if (!procTable) {
|
procTable = (Tcl_HashTable*)ckalloc(sizeof(Tcl_HashTable));
|
procTable = (Tcl_HashTable*)ckalloc(sizeof(Tcl_HashTable));
|
Tcl_InitHashTable(procTable, TCL_STRING_KEYS);
|
Tcl_InitHashTable(procTable, TCL_STRING_KEYS);
|
Tcl_SetAssocData(interp, "itcl_RegC", ItclFreeC,
|
Tcl_SetAssocData(interp, "itcl_RegC", ItclFreeC,
|
(ClientData)procTable);
|
(ClientData)procTable);
|
}
|
}
|
return procTable;
|
return procTable;
|
}
|
}
|
|
|
|
|
/*
|
/*
|
* ------------------------------------------------------------------------
|
* ------------------------------------------------------------------------
|
* ItclFreeC()
|
* ItclFreeC()
|
*
|
*
|
* When an interpreter is deleted, this procedure is called to
|
* When an interpreter is deleted, this procedure is called to
|
* free up the associated data created by Itcl_RegisterC and
|
* free up the associated data created by Itcl_RegisterC and
|
* Itcl_RegisterObjC.
|
* Itcl_RegisterObjC.
|
* ------------------------------------------------------------------------
|
* ------------------------------------------------------------------------
|
*/
|
*/
|
static void
|
static void
|
ItclFreeC(clientData, interp)
|
ItclFreeC(clientData, interp)
|
ClientData clientData; /* associated data */
|
ClientData clientData; /* associated data */
|
Tcl_Interp *interp; /* intepreter being deleted */
|
Tcl_Interp *interp; /* intepreter being deleted */
|
{
|
{
|
Tcl_HashTable *tablePtr = (Tcl_HashTable*)clientData;
|
Tcl_HashTable *tablePtr = (Tcl_HashTable*)clientData;
|
Tcl_HashSearch place;
|
Tcl_HashSearch place;
|
Tcl_HashEntry *entry;
|
Tcl_HashEntry *entry;
|
ItclCfunc *cfunc;
|
ItclCfunc *cfunc;
|
|
|
entry = Tcl_FirstHashEntry(tablePtr, &place);
|
entry = Tcl_FirstHashEntry(tablePtr, &place);
|
while (entry) {
|
while (entry) {
|
cfunc = (ItclCfunc*)Tcl_GetHashValue(entry);
|
cfunc = (ItclCfunc*)Tcl_GetHashValue(entry);
|
|
|
if (cfunc->deleteProc != NULL) {
|
if (cfunc->deleteProc != NULL) {
|
(*cfunc->deleteProc)(cfunc->clientData);
|
(*cfunc->deleteProc)(cfunc->clientData);
|
}
|
}
|
ckfree ( (char*)cfunc );
|
ckfree ( (char*)cfunc );
|
entry = Tcl_NextHashEntry(&place);
|
entry = Tcl_NextHashEntry(&place);
|
}
|
}
|
|
|
Tcl_DeleteHashTable(tablePtr);
|
Tcl_DeleteHashTable(tablePtr);
|
ckfree((char*)tablePtr);
|
ckfree((char*)tablePtr);
|
}
|
}
|
|
|