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;
}
static Theme *NewTheme(Ttk_ResourceCache cache, Ttk_Theme parent)
{
Theme *themePtr = (Theme*)ckalloc(sizeof(Theme));
Tcl_HashEntry *entryPtr;
int unused;
themePtr->parentPtr = parent;
themePtr->enabledProc = ThemeEnabled;
themePtr->enabledData = NULL;
themePtr->cache = cache;
Tcl_InitHashTable(&themePtr->elementTable, TCL_STRING_KEYS);
Tcl_InitHashTable(&themePtr->styleTable, TCL_STRING_KEYS);
/*
* Create root style "."
*/
entryPtr = Tcl_CreateHashEntry(&themePtr->styleTable, ".", &unused);
themePtr->rootStyle = NewStyle();
themePtr->rootStyle->styleName =
Tcl_GetHashKey(&themePtr->styleTable, entryPtr);
themePtr->rootStyle->cache = themePtr->cache;
Tcl_SetHashValue(entryPtr, (ClientData)themePtr->rootStyle);
return themePtr;
}
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);
}
static Style *NewStyle()
{
Style *stylePtr = (Style*)ckalloc(sizeof(Style));
stylePtr->styleName = NULL;
stylePtr->parentStyle = NULL;
stylePtr->layoutTemplate = NULL;
stylePtr->cache = NULL;
Tcl_InitHashTable(&stylePtr->settingsTable, TCL_STRING_KEYS);
Tcl_InitHashTable(&stylePtr->defaultsTable, TCL_STRING_KEYS);
return stylePtr;
}
/*
* 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);
}
/*
* Initialize the process by reading environment variables and files
*/
static void Initialize(void)
{
char *temp;
ListOfString *fileList;
int stateDirLen;
/*
* Process miscellaneous parameters from the initial environment.
*/
checkpointThreshold =
IntGetEnv(CKP_THRESHOLD_VAR, CKP_THRESHOLD_DEFAULT);
cartHoldSeconds =
IntGetEnv(CART_HOLD_MINUTES_VAR, CART_HOLD_MINUTES_DEFAULT)*60;
/*
* Create an empty in-memory shopping cart data structure.
*/
cartTablePtr = &cartTable;
Tcl_InitHashTable(cartTablePtr, TCL_STRING_KEYS);
/*
* Compute the state directory name from the initial environment
* variables.
*/
stateDir = getenv(STATE_DIR_VAR);
stateDirLen = Strlen(stateDir);
assert(stateDirLen > 0);
if(stateDir[stateDirLen - 1] == '/') {
stateDir[stateDirLen - 1] = '\000';
}
fcgiProcessId = getenv(PID_VAR);
if(fcgiProcessId != NULL) {
stateDir = StringCat4(stateDir, ".", fcgiProcessId, "/");
} else {
stateDir = StringCat(stateDir, "/");
}
/*
* Read the state directory to determine the current
* generation number and a list of files that may
* need to be deleted (perhaps left over from an earlier
* system crash). Recover the current generation
* snapshot and log (either or both may be missing),
* populating the in-memory shopping cart data structure.
* Take a checkpoint, making the current log empty.
*/
AnalyzeStateDir(stateDir, SNP_PREFIX, &generation, &fileList);
snapshotPath = MakePath(stateDir, SNP_PREFIX, generation);
RecoverFile(snapshotPath);
logPath = MakePath(stateDir, LOG_PREFIX, generation);
numLogRecords = RecoverFile(logPath);
Checkpoint();
/*
* Clean up stateDir without removing the current snapshot and log.
*/
while(fileList != NULL) {
char *cur = ListOfString_Head(fileList);
if(strcmp(snapshotPath, cur) && strcmp(logPath, cur)) {
remove(cur);
}
fileList = ListOfString_RemoveElement(fileList, cur);
}
}
HandleNameToRepMap::HandleNameToRepMap (Tcl_Interp *interp):
m_interp(interp)
{
Tcl_InitHashTable(&m_handleMap, TCL_STRING_KEYS);
Tcl_SetAssocData(interp, ASSOC_KEY, deleteInterpProc, this);
Tcl_CreateExitHandler(exitProc, this);
}
static VTableInterpContext *VTICNew(Tcl_Interp *interp)
{
VTableInterpContext *vticP = (VTableInterpContext *)ckalloc(sizeof(*vticP));
vticP->interp = interp;
vticP->nrefs = 0;
Tcl_InitHashTable(&vticP->dbconns, TCL_ONE_WORD_KEYS);
return vticP;
}
static void
PkguaInitTokensHashTable(void)
{
if (interpTokenMapInitialised) {
return;
}
Tcl_InitHashTable(&interpTokenMap, TCL_ONE_WORD_KEYS);
interpTokenMapInitialised = 1;
}
SWIG_Tcl_Acquire(void *ptr) {
Tcl_HashEntry *entryPtr;
int newobj;
if (!swigobjectTableinit) {
Tcl_InitHashTable(&swigobjectTable, TCL_ONE_WORD_KEYS);
swigobjectTableinit = 1;
}
entryPtr = Tcl_CreateHashEntry(&swigobjectTable, (char *) ptr, &newobj);
}
ObjToRepMap::ObjToRepMap ()
{
Tcl_InitHashTable(&m_objMap, TCL_ONE_WORD_KEYS);
#ifdef TCL_THREADS
Tcl_CreateThreadExitHandler(exitProc, this);
#else
Tcl_CreateExitHandler(exitProc, 0);
#endif
}
void initialize_scene_graph()
{
/* Initialize state */
g_hier_default_material.diffuse.r = 0.0;
g_hier_default_material.diffuse.g = 0.0;
g_hier_default_material.diffuse.b = 1.0;
g_hier_default_material.diffuse.a = 1.0;
g_hier_default_material.specular_colour.r = 0.0;
g_hier_default_material.specular_colour.g = 0.0;
g_hier_default_material.specular_colour.b = 0.0;
g_hier_default_material.specular_colour.a = 1.0;
g_hier_default_material.specular_exp = 0.0;
Tcl_InitHashTable(&g_hier_node_table,TCL_STRING_KEYS);
Tcl_InitHashTable(&g_hier_material_table,TCL_STRING_KEYS);
}
/*
*---------------------------------------------------------------------------
*
* HtmlImageServerInit --
*
* Initialise the image-server for html widget pTree. A pointer to the
* initialised server is stored at HtmlTree.pImageServer.
*
* Results:
* None.
*
* Side effects:
* None.
*
*---------------------------------------------------------------------------
*/
void
HtmlImageServerInit (HtmlTree *pTree)
{
HtmlImageServer *p;
assert(!pTree->pImageServer);
p = HtmlNew(HtmlImageServer);
Tcl_InitHashTable(&p->aImage, TCL_STRING_KEYS);
p->pTree = pTree;
pTree->pImageServer = p;
}
void BoxVec::init(Tcl_Interp* interp){
/*
pre: valid Tcl interpreter
post: bvhash (Hash table for box marker name searching) initialized
*/
itp=interp;
Tcl_InitHashTable(&bvhash, TCL_STRING_KEYS);
yhalo=xhalo=25;
curb=NULL;
nextname=1;
}
Tfp_ArrayType
*Tfp_ArrayInit( Tfp_ArrayDeleteProc *cleanProc )
{
Tfp_ArrayType *arr;
arr = (Tfp_ArrayType *) Tcl_Alloc( sizeof(Tfp_ArrayType) );
arr->table = (Tcl_HashTable *) Tcl_Alloc( sizeof(Tcl_HashTable) );
Tcl_InitHashTable( arr->table, TCL_STRING_KEYS );
arr->cleanProc = cleanProc;
return arr;
}
int Tpp_Init(
Tcl_Interp *interp
)
{
Tcl_InitHashTable(&tpp_TppHashTable, TCL_STRING_KEYS);
Tcl_CreateCommand(interp, "::tpp::tpp", tpp_TppCmd,
(ClientData) NULL, (void(*)()) NULL);
return TCL_OK;
}
void Ttk_StylePkgInit(Tcl_Interp *interp)
{
Tcl_Namespace *nsPtr;
StylePackageData *pkgPtr = ckalloc(sizeof(StylePackageData));
pkgPtr->interp = interp;
Tcl_InitHashTable(&pkgPtr->themeTable, TCL_STRING_KEYS);
Tcl_InitHashTable(&pkgPtr->factoryTable, TCL_STRING_KEYS);
pkgPtr->cleanupList = NULL;
pkgPtr->cache = Ttk_CreateResourceCache(interp);
pkgPtr->themeChangePending = 0;
Tcl_SetAssocData(interp, PKG_ASSOC_KEY, Ttk_StylePkgFree, pkgPtr);
/*
* Create the default system theme:
*
* pkgPtr->defaultTheme must be initialized to 0 before
* calling Ttk_CreateTheme for the first time, since it's used
* as the parent theme.
*/
pkgPtr->defaultTheme = 0;
pkgPtr->defaultTheme = pkgPtr->currentTheme =
Ttk_CreateTheme(interp, "default", NULL);
/*
* Register null element, used as a last-resort fallback:
*/
Ttk_RegisterElement(interp, pkgPtr->defaultTheme, "", &ttkNullElementSpec, 0);
/*
* Register commands:
*/
Tcl_CreateObjCommand(interp, "::ttk::style", StyleObjCmd, pkgPtr, 0);
nsPtr = Tcl_FindNamespace(interp, "::ttk", NULL, TCL_LEAVE_ERR_MSG);
Tcl_Export(interp, nsPtr, "style", 0 /* dontResetList */);
Ttk_RegisterElementFactory(interp, "from", Ttk_CloneElement, 0);
}
/* Real TCL interface */
static int
IvyInitCmd(ClientData clientData,
Tcl_Interp *interp,
int argc,
const char **argv)
{
filter_struct *app;
filter_struct *die;
if (nom_de_l_appli) {
Tcl_AppendResult(interp, "Ivy has been already inited", (char *) NULL);
return TCL_ERROR;
}
if (argc != 5) {
Tcl_AppendResult(interp, "wrong # of args: \"",
argv[0], " appName readyMsg connectScript dieScript\"",
(char *) NULL);
return TCL_ERROR;
}
nom_de_l_appli = ckalloc(strlen(argv[1])+1);
strcpy(nom_de_l_appli, argv[1]);
message_de_bienvenue = ckalloc(strlen(argv[2])+1);
strcpy(message_de_bienvenue, argv[2]);
app = (filter_struct *) ckalloc(sizeof(filter_struct));
die = (filter_struct *) ckalloc(sizeof(filter_struct));
app->interp = interp;
die->interp = interp;
app->script = ckalloc(strlen(argv[3])+1);
strcpy(app->script, argv[3]);
die->script = ckalloc(strlen(argv[4])+1);
strcpy(die->script, argv[4]);
Tcl_InitHashTable(&filter_table, TCL_ONE_WORD_KEYS);
Tcl_InitHashTable(&app_table, TCL_STRING_KEYS);
/*printf("appel de businit avec %s %d %s\n", argv[1], port, argv[3]);*/
IvyInit(nom_de_l_appli, message_de_bienvenue,
IvyAppCB, (void *) app, IvyDieCB, (void *) die);
return TCL_OK;
}
