1/* 2 * Wrapper for Tcl hash tables. From Adrian Zimmer's book Tcl/Tk for Programmers. 3 */ 4 5#include "Tfp_Arrays.h" 6 7Tfp_ArrayType 8*Tfp_ArrayInit( Tfp_ArrayDeleteProc *cleanProc ) 9{ 10 Tfp_ArrayType *arr; 11 12 arr = (Tfp_ArrayType *) Tcl_Alloc( sizeof(Tfp_ArrayType) ); 13 arr->table = (Tcl_HashTable *) Tcl_Alloc( sizeof(Tcl_HashTable) ); 14 Tcl_InitHashTable( arr->table, TCL_STRING_KEYS ); 15 arr->cleanProc = cleanProc; 16 return arr; 17} 18 19void 20Tfp_ArrayDestroy( Tfp_ArrayType *arr ) 21{ 22 Tcl_HashEntry *p; 23 Tcl_HashSearch s; 24 25 if (arr->cleanProc != (Tfp_ArrayDeleteProc *) NULL) { 26 for (p = Tcl_FirstHashEntry( arr->table, &s ); p != (Tcl_HashEntry *) NULL; 27 p = Tcl_NextHashEntry( &s )) { 28 (*arr->cleanProc) ( Tcl_GetHashValue( p ) ); 29 } 30 } 31 Tcl_DeleteHashTable( arr->table ); 32 Tcl_Free( (char *) arr->table ); 33 Tcl_Free( (char *) arr ); 34} 35 36int 37Tfp_ArrayGet( Tfp_ArrayType *arr, char *key, ClientData *returnValue ) 38{ 39 Tcl_HashEntry *p; 40 41 p = Tcl_FindHashEntry( arr->table, key ); 42 if (p == (Tcl_HashEntry *) NULL) { 43 return 0; 44 } 45 *returnValue = Tcl_GetHashValue( p ); 46 return 1; 47} 48 49void 50Tfp_ArraySet( Tfp_ArrayType *arr, char *key, ClientData value ) 51{ 52 int junk; 53 Tcl_HashEntry *p; 54 55 p = Tcl_CreateHashEntry( arr->table, key, &junk ); 56 Tcl_SetHashValue( p, value ); 57} 58 59void 60Tfp_ArrayDelete( Tfp_ArrayType *arr, char *key ) 61{ 62 Tcl_HashEntry *p; 63 64 p = Tcl_FindHashEntry( arr->table, key ); 65 if (p == (Tcl_HashEntry *) NULL) { 66 return; 67 } 68 (*arr->cleanProc) ( Tcl_GetHashValue( p ) ); 69 Tcl_DeleteHashEntry( p ); 70} 71 72/*---------------------------------------------------------------------------*/