C++ Tcl_InitHashTable函数代码示例

static void
AtomInit(
    TkDisplay *dispPtr)/* Display to initialize. */
{
    Tcl_HashEntry *hPtr;
    Atom atom;

    dispPtr->atomInit = 1;
    Tcl_InitHashTable(&dispPtr->nameTable, TCL_STRING_KEYS);
    Tcl_InitHashTable(&dispPtr->atomTable, TCL_ONE_WORD_KEYS);

    for (atom = 1; atom <= XA_LAST_PREDEFINED; atom++) {
	const char *name;
	int isNew;

	hPtr = Tcl_FindHashEntry(&dispPtr->atomTable, (char *) atom);
	if (hPtr != NULL) {
	    continue;
	}

	name = atomNameArray[atom - 1];
	hPtr = Tcl_CreateHashEntry(&dispPtr->nameTable, name, &isNew);
	Tcl_SetHashValue(hPtr, atom);
	name = Tcl_GetHashKey(&dispPtr->nameTable, hPtr);
	hPtr = Tcl_CreateHashEntry(&dispPtr->atomTable, (char *) atom, &isNew);
	Tcl_SetHashValue(hPtr, name);
    }
}

static void
InitKeyMaps()
{
    Tcl_HashEntry *hPtr;
    KeyInfo *kPtr;
    int dummy;
		
    Tcl_InitHashTable(&keycodeTable, TCL_ONE_WORD_KEYS);
    for (kPtr = keyArray; kPtr->keycode != 0; kPtr++) {
	hPtr = Tcl_CreateHashEntry(&keycodeTable, (char *) kPtr->keycode,
		&dummy);
	Tcl_SetHashValue(hPtr, kPtr->keysym);
    }
    Tcl_InitHashTable(&vkeyTable, TCL_ONE_WORD_KEYS);
    for (kPtr = vituralkeyArray; kPtr->keycode != 0; kPtr++) {
	hPtr = Tcl_CreateHashEntry(&vkeyTable, (char *) kPtr->keycode,
		&dummy);
	Tcl_SetHashValue(hPtr, kPtr->keysym);
    }
    KCHRPtr = (Ptr) GetScriptManagerVariable(smKCHRCache);
    if (!KCHRPtr){
        fprintf(stderr,"GetScriptManagerVariable failed\n");
    }
    initialized = 1;
}

static void
CursorInit(
    TkDisplay *dispPtr)		/* Display used to store thread-specific
				 * data. */
{
    Tcl_InitHashTable(&dispPtr->cursorNameTable, TCL_STRING_KEYS);
    Tcl_InitHashTable(&dispPtr->cursorDataTable, sizeof(DataKey)/sizeof(int));

    /*
     * The call below is tricky: can't use sizeof(IdKey) because it gets
     * padded with extra unpredictable bytes on some 64-bit machines.
     */

    /*
     * Old code....
     *     Tcl_InitHashTable(&dispPtr->cursorIdTable, sizeof(Display *)
     *                       /sizeof(int));
     *
     * The comment above doesn't make sense. However, XIDs should only be 32
     * bits, by the definition of X, so the code above causes Tk to crash.
     * Here is the real code:
     */

    Tcl_InitHashTable(&dispPtr->cursorIdTable, TCL_ONE_WORD_KEYS);

    dispPtr->cursorInit = 1;
}

int
ItclVarsAndCommandResolveInit(
    Tcl_Interp *interp)
{
#ifdef NEW_PROTO_RESOLVER
    ItclResolvingInfo *iriPtr;

    /*
     *  Create the top-level data structure for tracking objects.
     *  Store this as "associated data" for easy access, but link
     *  it to the itcl namespace for ownership.
     */
    iriPtr = (ItclResolvingInfo*)ckalloc(sizeof(ItclResolvingInfo));
    memset(iriPtr, 0, sizeof(ItclResolvingInfo));
    iriPtr->interp = interp;
    Tcl_InitHashTable(&iriPtr->resolveVars, TCL_ONE_WORD_KEYS);
    Tcl_InitHashTable(&iriPtr->resolveCmds, TCL_ONE_WORD_KEYS);
    Tcl_InitHashTable(&iriPtr->objectVarsTables, TCL_ONE_WORD_KEYS);
    Tcl_InitHashTable(&iriPtr->objectCmdsTables, TCL_ONE_WORD_KEYS);

    Tcl_SetAssocData(interp, ITCL_RESOLVE_DATA,
        (Tcl_InterpDeleteProc*)ItclDeleteResolveInfo, (ClientData)iriPtr);
    Tcl_Preserve((ClientData)iriPtr);

    Itcl_SetClassCommandProtectionCallback(interp, NULL,
            Itcl_CheckClassCommandProtection);
    Itcl_SetClassVariableProtectionCallback(interp, NULL,
            Itcl_CheckClassVariableProtection);
#endif
    return TCL_OK;
}

int mpsa_Init(
    Tcl_Interp *interp
)
{
    ClientData dummy;
    int argc = 0;
    char **argv = NULL;
    char *InitScript;

    Tcl_InitHashTable(&mpsa_SimHashTable, TCL_STRING_KEYS);
    Tcl_InitHashTable(&mpsa_ListHashTable, TCL_STRING_KEYS);
    Tcl_InitHashTable(&mpsa_PairListHashTable, TCL_STRING_KEYS);
    Tcl_InitHashTable(&mpsa_ParticletypeHashTable, TCL_STRING_KEYS);
    Tcl_InitHashTable(&mpsa_PiptypeHashTable, TCL_STRING_KEYS);

    /*
     * register external 'mpsa' commands. necessary since these are in a
     * 'loadable module' format.
     */

    Tcl_SetVar2(interp, "Mpsa", "etc", MPSA_ETC_DIR, TCL_GLOBAL_ONLY);
    InitScript = "catch {source $Mpsa(etc)/Init.tcl}";
    Tcl_Eval(interp, InitScript);

    mpsa_InitCmd(dummy, interp, argc, argv);
    Tree_Init(interp);
    Cloud_Init(interp);
    Sf_Init(interp);
    Sn_Init(interp);
    Tpp_Init(interp);
    Pairlist_Init(interp);

    return TCL_OK;
}

void 
XOTclProfileInit(Tcl_Interp *interp) {
  RUNTIME_STATE(interp)->profile.overallTime = 0;
  Tcl_InitHashTable(&RUNTIME_STATE(interp)->profile.objectData,
		    TCL_STRING_KEYS);
  Tcl_InitHashTable(&RUNTIME_STATE(interp)->profile.methodData,
		    TCL_STRING_KEYS);
}

static void
ColorInit(
    TkDisplay *dispPtr)
{
    if (!dispPtr->colorInit) {
        dispPtr->colorInit = 1;
        Tcl_InitHashTable(&dispPtr->colorNameTable, TCL_STRING_KEYS);
        Tcl_InitHashTable(&dispPtr->colorValueTable,
                          sizeof(ValueKey)/sizeof(int));
    }
}

static void
GCInit(
    TkDisplay *dispPtr)
{
    if (dispPtr->gcInit < 0) {
	Tcl_Panic("called GCInit after GCCleanup");
    }
    dispPtr->gcInit = 1;
    Tcl_InitHashTable(&dispPtr->gcValueTable, sizeof(ValueKey)/sizeof(int));
    Tcl_InitHashTable(&dispPtr->gcIdTable, TCL_ONE_WORD_KEYS);
}

/*
 * Ttk_CreateResourceCache --
 * 	Initialize a new resource cache.
 */
Ttk_ResourceCache Ttk_CreateResourceCache(Tcl_Interp *interp)
{
    Ttk_ResourceCache cache = ckalloc(sizeof(*cache));

    cache->tkwin = NULL;	/* initialized later */
    cache->interp = interp;
    Tcl_InitHashTable(&cache->fontTable, TCL_STRING_KEYS);
    Tcl_InitHashTable(&cache->colorTable, TCL_STRING_KEYS);
    Tcl_InitHashTable(&cache->borderTable, TCL_STRING_KEYS);
    Tcl_InitHashTable(&cache->imageTable, TCL_STRING_KEYS);
    Tcl_InitHashTable(&cache->namedColors, TCL_STRING_KEYS);

    return cache;
}

ClientData
Itcl_RegisterClassCommand(
    Tcl_Interp *interp,
    Tcl_Namespace *nsPtr,
    const char *cmdName,
    ClientData clientData)
{
    Tcl_HashEntry *hPtr;
    Tcl_HashTable *tablePtr;
    ItclResolvingInfo *iriPtr;
    int isNew;

    iriPtr = Tcl_GetAssocData(interp, ITCL_RESOLVE_DATA, NULL);
    hPtr = Tcl_CreateHashEntry(&iriPtr->resolveCmds, nsPtr->fullName, &isNew);
    if (isNew) {
	tablePtr = (Tcl_HashTable *)ckalloc(sizeof(Tcl_HashTable));
	Tcl_InitHashTable(tablePtr, TCL_STRING_KEYS);
        Tcl_SetHashValue(hPtr, tablePtr);

    } else {
        tablePtr = Tcl_GetHashValue(hPtr);
    }
    hPtr = Tcl_CreateHashEntry(tablePtr, cmdName, &isNew);
    if (isNew) {
        Tcl_SetHashValue(hPtr, clientData);
    }
    return Tcl_GetHashValue(hPtr);
}

TNPtr
tn_dup (TPtr dst, TNPtr src)
{
    TNPtr dstn;

    dstn = tn_new (dst, Tcl_GetString (src->name));

    if (src->attr) {
	int i, new;
	Tcl_HashSearch hs;
	Tcl_HashEntry* he;
	Tcl_HashEntry* dhe;
	CONST char*    key;
	Tcl_Obj*       val;

	dstn->attr = ALLOC (Tcl_HashTable);
	Tcl_InitHashTable(dstn->attr, TCL_STRING_KEYS);

	for(i = 0, he = Tcl_FirstHashEntry(src->attr, &hs);
	    he != NULL;
	    he = Tcl_NextHashEntry(&hs), i++) {

	    key = Tcl_GetHashKey (src->attr, he);
	    val = (Tcl_Obj*) Tcl_GetHashValue(he);

	    dhe = Tcl_CreateHashEntry(dstn->attr, key, &new);

	    Tcl_IncrRefCount (val);
	    Tcl_SetHashValue (dhe, (ClientData) val);
	}
    }

/*
 * Tclduktape_Init -- Called when Tcl loads the extension.
 */
int DLLEXPORT
Tclduktape_Init(Tcl_Interp *interp)
{
    Tcl_Namespace *nsPtr;
    struct DuktapeData *duktape_data;

#ifdef USE_TCL_STUBS
    if (Tcl_InitStubs(interp, TCL_VERSION, 0) == NULL) {
        return TCL_ERROR;
    }
#endif

    duktape_data = (struct DuktapeData *) ckalloc(sizeof(struct DuktapeData));

    /* Create the namespace. */
    if (Tcl_FindNamespace(interp, NS, NULL, 0) == NULL) {
        nsPtr = Tcl_CreateNamespace(interp, NS, NULL, NULL);
        if (nsPtr == NULL) {
            return TCL_ERROR;
        }
    }

    duktape_data->counter = 0;
    Tcl_InitHashTable(&duktape_data->table, TCL_STRING_KEYS);

    Tcl_CreateObjCommand(interp, NS INIT, Init_Cmd, duktape_data, NULL);
    Tcl_CreateObjCommand(interp, NS CLOSE, Close_Cmd, duktape_data, NULL);
    Tcl_CreateObjCommand(interp, NS EVAL, Eval_Cmd, duktape_data, NULL);
    Tcl_CreateObjCommand(interp, NS CALL_METHOD,
            CallMethod_Cmd, duktape_data, NULL);
    Tcl_CallWhenDeleted(interp, cleanup_interp, duktape_data);
    Tcl_PkgProvide(interp, PACKAGE, VERSION);

    return TCL_OK;
}

static void
RegisterTcpServerInterpCleanup(
    Tcl_Interp *interp,		/* Interpreter for which we want to be
				 * informed of deletion. */
    AcceptCallback *acceptCallbackPtr)
				/* The accept callback record whose interp
				 * field we want set to NULL when the
				 * interpreter is deleted. */
{
    Tcl_HashTable *hTblPtr;	/* Hash table for accept callback records to
				 * smash when the interpreter will be
				 * deleted. */
    Tcl_HashEntry *hPtr;	/* Entry for this record. */
    int isNew;			/* Is the entry new? */

    hTblPtr = (Tcl_HashTable *)
	    Tcl_GetAssocData(interp, "tclTCPAcceptCallbacks", NULL);

    if (hTblPtr == NULL) {
	hTblPtr = (Tcl_HashTable *) ckalloc((unsigned) sizeof(Tcl_HashTable));
	Tcl_InitHashTable(hTblPtr, TCL_ONE_WORD_KEYS);
	(void) Tcl_SetAssocData(interp, "tclTCPAcceptCallbacks",
		TcpAcceptCallbacksDeleteProc, hTblPtr);
    }

    hPtr = Tcl_CreateHashEntry(hTblPtr, (char *) acceptCallbackPtr, &isNew);
    if (!isNew) {
	Tcl_Panic("RegisterTcpServerCleanup: damaged accept record table");
    }
    Tcl_SetHashValue(hPtr, acceptCallbackPtr);
}

void
create_name_hash( FILE *fd )
{
    char line[MAX_LINE_SIZE];
    Tcl_HashEntry *hash_entry=NULL;
    int new_entry=0;

    Tcl_InitHashTable( &htbl, TCL_STRING_KEYS );

    while ( bu_fgets( line, MAX_LINE_SIZE, fd ) ) {
	char *part_no, *desc, *ptr;

	ptr = strtok( line, " \t\n" );
	if ( !ptr )
	    bu_exit( 1, "%s: *****Error processing part name file at line:\n\t%s\n", progname,line );
	part_no = bu_strdup( ptr );
	lower_case( part_no );
	ptr = strtok( (char *)NULL, " \t\n" );
	if ( !ptr )
	    bu_exit( 1, "%s: *****Error processing part name file at line:\n\t%s\n", progname,line );
	desc = bu_strdup( ptr );
	lower_case( desc );

	hash_entry = Tcl_CreateHashEntry( &htbl, part_no, &new_entry );
	if ( new_entry ) {
	    Tcl_SetHashValue( hash_entry, desc );
	} else {
	    bu_free( (char *)part_no, "part_no" );
	    bu_free( (char *)desc, "desc" );
	}
    }
}

static void
BorderInit(
     TkDisplay *dispPtr)	/* Used to access thread-specific data. */
{
    dispPtr->borderInit = 1;
    Tcl_InitHashTable(&dispPtr->borderTable, TCL_STRING_KEYS);
}