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/*---------------------------------------------------------------------------*/