test() { int code; int i=123; double d=3.14; // Link C/C++ variable and Tcl variable Tcl_LinkVar(interp,"i",(char*)(&i),TCL_LINK_INT); Tcl_LinkVar(interp,"d",(char*)(&d),TCL_LINK_DOUBLE); printf("i=%s\n",Tcl_GetVar(interp,"i",0)); printf("d=%s\n",Tcl_GetVar(interp,"d",0)); Tcl_SetVar(interp,"i","456",0); Tcl_SetVar(interp,"d","1.41421356",0); printf("i=%d\n",i); printf("d=%g\n",d); i=3229; d=1.6e-19; code=Tcl_Eval(interp,"expr $i"); if(*interp->result!=0) printf("%s\n",interp->result); code=Tcl_Eval(interp,"expr $d"); if(*interp->result!=0) printf("%s\n",interp->result); if(code!=TCL_OK) exit(1); }
// LinkUserVariables: // Links user variables void animTcl::LinkUserVariables(Tcl_Interp *interp) { int count = 0; for(int i = 0 ; setlist[i].ptr ; i++ ) { SETVAR *v = &setlist[i] ; if ( Tcl_LinkVar(interp,v->name, v->ptr,v->type) == TCL_ERROR) { animTcl::OutputMessage("ERROR: Cannot link variables %s", v->name); } else count++; } count = 0 ; for(int i = 0 ; setlist[i].ptr ; i++ ) { SETVAR *v = &myScriptVariables[i]; if ( Tcl_LinkVar(interp,v->name, v->ptr,v->type) == TCL_ERROR) { animTcl::OutputMessage("ERROR: Cannot link variables %s", v->name); } else count++; } animTcl::OutputMessage("Linked %d user Tcl variables.\n",count); }
int geo_group_id( element_model_t *model, char *name,int open ) { group_t *group,*prevgroup; int groupid = 0; static char str[128]; prevgroup = model->Groups; for( group = model->Groups; group!=NULL; group=group->Next ) { if ( strcmp(group->Name, name) == 0 ) break; groupid++; prevgroup = group; } if ( !group ) { if ( !prevgroup ) group = model->Groups = (group_t *)malloc(sizeof(group_t)); else group = prevgroup->Next = (group_t *)malloc(sizeof(group_t)); sprintf( str, "GroupStatus(%d)", groupid ); Tcl_LinkVar( TCLInterp,str,(char *)&group->status,TCL_LINK_INT ); group->status = 1; group->Next = NULL; group->Name = (char *)malloc(strlen(name)+1); strcpy(group->Name,name); } group->Open = open; return groupid; }
int Dm_Init(void *interpreter) { Tcl_Interp *interp = (Tcl_Interp *)interpreter; static struct bu_cmdtab cmdtab[] = { {"dm_validXType", dm_validXType_tcl}, {"dm_bestXType", dm_bestXType_tcl}, {(const char *)NULL, BU_CMD_NULL} }; struct bu_vls vls = BU_VLS_INIT_ZERO; /* register commands */ register_cmds(interp, cmdtab); bu_vls_strcpy(&vls, "vectorThreshold"); Tcl_LinkVar(interp, bu_vls_addr(&vls), (char *)&vectorThreshold, TCL_LINK_INT); bu_vls_free(&vls); /* initialize display manager object code */ Dmo_Init(interp); Tcl_PkgProvide(interp, "Dm", brlcad_version()); return TCL_OK; }
test() { Tcl_Interp *interp; int code; int i=123; double d=3.14; interp = Tcl_CreateInterp(); Tcl_AppInit(interp); // cinttk_init(); // Link C/C++ variable and Tcl variable Tcl_LinkVar(interp,"i",(char*)(&i),TCL_LINK_INT); Tcl_LinkVar(interp,"d",(char*)(&d),TCL_LINK_DOUBLE); printf("i=%s\n",Tcl_GetVar(interp,"i",0)); printf("d=%s\n",Tcl_GetVar(interp,"d",0)); Tcl_SetVar(interp,"i","456",0); Tcl_SetVar(interp,"d","1.41421356",0); printf("i=%d\n",i); printf("d=%g\n",d); code=Tcl_Eval(interp,"set i 789"); code=Tcl_Eval(interp,"set d 0.71"); printf("i=%d\n",i); printf("d=%g\n",d); i=3229; d=1.6e-19; code=Tcl_Eval(interp,"expr $i"); if(*interp->result!=0) printf("%s\n",interp->result); code=Tcl_Eval(interp,"expr $d"); if(*interp->result!=0) printf("%s\n",interp->result); printf("tcl source code insertion test\n"); #pragma tcl interp set i 512 set d 299.793 #pragma endtcl printf("i=%d\n",i); printf("d=%g\n",d); if(code!=TCL_OK) exit(1); exit(0); }
/** * Register all MGED commands. */ HIDDEN void cmd_setup(void) { struct cmdtab *ctp; struct bu_vls temp = BU_VLS_INIT_ZERO; const char *pathname; char buffer[1024]; /* from cmd.c */ extern int glob_compat_mode; extern int output_as_return; for (ctp = mged_cmdtab; ctp->name != NULL; ctp++) { bu_vls_strcpy(&temp, "_mged_"); bu_vls_strcat(&temp, ctp->name); (void)Tcl_CreateCommand(INTERP, ctp->name, ctp->tcl_func, (ClientData)ctp, (Tcl_CmdDeleteProc *)NULL); (void)Tcl_CreateCommand(INTERP, bu_vls_addr(&temp), ctp->tcl_func, (ClientData)ctp, (Tcl_CmdDeleteProc *)NULL); } /* overrides/wraps the built-in tree command */ /* Locate the BRL-CAD-specific Tcl scripts */ pathname = bu_brlcad_data("tclscripts", 1); snprintf(buffer, sizeof(buffer), "%s", pathname); /* link some tcl variables to these corresponding globals */ Tcl_LinkVar(INTERP, "glob_compat_mode", (char *)&glob_compat_mode, TCL_LINK_BOOLEAN); Tcl_LinkVar(INTERP, "output_as_return", (char *)&output_as_return, TCL_LINK_BOOLEAN); /* Provide Tcl interfaces to the fundamental BRL-CAD libraries */ if (Bu_Init(INTERP) == TCL_ERROR) { bu_log("Bu_Init ERROR:\n%s\n", Tcl_GetStringResult(INTERP)); } Bn_Init(INTERP); Rt_Init(INTERP); Go_Init(INTERP); Wdb_Init(INTERP); tkwin = NULL; bu_vls_free(&temp); }
/* ** Register commands with the TCL interpreter. */ int Sqlitetest2_Init(Tcl_Interp *interp){ extern int sqlite3_io_error_persist; extern int sqlite3_io_error_pending; extern int sqlite3_io_error_hit; extern int sqlite3_io_error_hardhit; extern int sqlite3_diskfull_pending; extern int sqlite3_diskfull; extern int sqlite3_pager_n_sort_bucket; static struct { char *zName; Tcl_CmdProc *xProc; } aCmd[] = { { "pager_open", (Tcl_CmdProc*)pager_open }, { "pager_close", (Tcl_CmdProc*)pager_close }, { "pager_commit", (Tcl_CmdProc*)pager_commit }, { "pager_rollback", (Tcl_CmdProc*)pager_rollback }, { "pager_stmt_begin", (Tcl_CmdProc*)pager_stmt_begin }, { "pager_stmt_commit", (Tcl_CmdProc*)pager_stmt_commit }, { "pager_stmt_rollback", (Tcl_CmdProc*)pager_stmt_rollback }, { "pager_stats", (Tcl_CmdProc*)pager_stats }, { "pager_pagecount", (Tcl_CmdProc*)pager_pagecount }, { "page_get", (Tcl_CmdProc*)page_get }, { "page_lookup", (Tcl_CmdProc*)page_lookup }, { "page_unref", (Tcl_CmdProc*)page_unref }, { "page_read", (Tcl_CmdProc*)page_read }, { "page_write", (Tcl_CmdProc*)page_write }, { "page_number", (Tcl_CmdProc*)page_number }, { "pager_truncate", (Tcl_CmdProc*)pager_truncate }, #ifndef SQLITE_OMIT_DISKIO { "fake_big_file", (Tcl_CmdProc*)fake_big_file }, #endif { "sqlite3BitvecBuiltinTest",(Tcl_CmdProc*)testBitvecBuiltinTest}, }; int i; for(i=0; i<sizeof(aCmd)/sizeof(aCmd[0]); i++){ Tcl_CreateCommand(interp, aCmd[i].zName, aCmd[i].xProc, 0, 0); } Tcl_LinkVar(interp, "sqlite_io_error_pending", (char*)&sqlite3_io_error_pending, TCL_LINK_INT); Tcl_LinkVar(interp, "sqlite_io_error_persist", (char*)&sqlite3_io_error_persist, TCL_LINK_INT); Tcl_LinkVar(interp, "sqlite_io_error_hit", (char*)&sqlite3_io_error_hit, TCL_LINK_INT); Tcl_LinkVar(interp, "sqlite_io_error_hardhit", (char*)&sqlite3_io_error_hardhit, TCL_LINK_INT); Tcl_LinkVar(interp, "sqlite_diskfull_pending", (char*)&sqlite3_diskfull_pending, TCL_LINK_INT); Tcl_LinkVar(interp, "sqlite_diskfull", (char*)&sqlite3_diskfull, TCL_LINK_INT); Tcl_LinkVar(interp, "sqlite_pending_byte", (char*)&sqlite3_pending_byte, TCL_LINK_INT); Tcl_LinkVar(interp, "sqlite_pager_n_sort_bucket", (char*)&sqlite3_pager_n_sort_bucket, TCL_LINK_INT); return TCL_OK; }
/* Sets up a Tcl interpreter for the game. Adds commands to implement our scripting interface. */ void InitScripting(void) { /* First, create an interpreter and make sure it's valid. */ interp = Tcl_CreateInterp(); if (interp == NULL) { fprintf(stderr, "Unable to initialize Tcl.\n"); exit(1); } /* Add the "fireWeapon" command. */ if (Tcl_CreateObjCommand(interp, "fireWeapon", HandleFireWeaponCmd, (ClientData) 0, NULL) == NULL) { fprintf(stderr, "Error creating Tcl command.\n"); exit(1); } /* Link the important parts of our player data structures to global variables in Tcl. (Ignore the char * typecast; Tcl will treat the data as the requested type, in this case double.) */ Tcl_LinkVar(interp, "player_x", (char *) &player.world_x, TCL_LINK_DOUBLE); Tcl_LinkVar(interp, "player_y", (char *) &player.world_y, TCL_LINK_DOUBLE); Tcl_LinkVar(interp, "player_angle", (char *) &player.angle, TCL_LINK_DOUBLE); Tcl_LinkVar(interp, "player_accel", (char *) &player.accel, TCL_LINK_DOUBLE); Tcl_LinkVar(interp, "computer_x", (char *) &opponent.world_x, TCL_LINK_DOUBLE); Tcl_LinkVar(interp, "computer_y", (char *) &opponent.world_y, TCL_LINK_DOUBLE); Tcl_LinkVar(interp, "computer_angle", (char *) &opponent.angle, TCL_LINK_DOUBLE); Tcl_LinkVar(interp, "computer_accel", (char *) &opponent.accel, TCL_LINK_DOUBLE); /* Make the constants in gamedefs.h available to the script. The script should play by the game's rules, just like the human player. Tcl_SetVar2Ex is part of the Tcl_SetVar family of functions, which you can read about in the manpage. It simply sets a variable to a new value given by a Tcl_Obj structure. */ Tcl_SetVar2Ex(interp, "world_width", NULL, Tcl_NewIntObj(WORLD_WIDTH), 0); Tcl_SetVar2Ex(interp, "world_height", NULL, Tcl_NewIntObj(WORLD_HEIGHT), 0); Tcl_SetVar2Ex(interp, "player_forward_thrust", NULL, Tcl_NewIntObj(PLAYER_FORWARD_THRUST), 0); Tcl_SetVar2Ex(interp, "player_reverse_thrust", NULL, Tcl_NewIntObj(PLAYER_REVERSE_THRUST), 0); }
/* ** Register commands with the TCL interpreter. */ int Sqlitetest2_Init(Tcl_Interp *interp){ extern int sqlite_io_error_pending; char zBuf[100]; static struct { char *zName; Tcl_CmdProc *xProc; } aCmd[] = { { "pager_open", (Tcl_CmdProc*)pager_open }, { "pager_close", (Tcl_CmdProc*)pager_close }, { "pager_commit", (Tcl_CmdProc*)pager_commit }, { "pager_rollback", (Tcl_CmdProc*)pager_rollback }, { "pager_ckpt_begin", (Tcl_CmdProc*)pager_ckpt_begin }, { "pager_ckpt_commit", (Tcl_CmdProc*)pager_ckpt_commit }, { "pager_ckpt_rollback", (Tcl_CmdProc*)pager_ckpt_rollback }, { "pager_stats", (Tcl_CmdProc*)pager_stats }, { "pager_pagecount", (Tcl_CmdProc*)pager_pagecount }, { "page_get", (Tcl_CmdProc*)page_get }, { "page_lookup", (Tcl_CmdProc*)page_lookup }, { "page_unref", (Tcl_CmdProc*)page_unref }, { "page_read", (Tcl_CmdProc*)page_read }, { "page_write", (Tcl_CmdProc*)page_write }, { "page_number", (Tcl_CmdProc*)page_number }, { "fake_big_file", (Tcl_CmdProc*)fake_big_file }, }; int i; for(i=0; i<sizeof(aCmd)/sizeof(aCmd[0]); i++){ Tcl_CreateCommand(interp, aCmd[i].zName, aCmd[i].xProc, 0, 0); } Tcl_LinkVar(interp, "sqlite_io_error_pending", (char*)&sqlite_io_error_pending, TCL_LINK_INT); #ifdef SQLITE_TEST Tcl_LinkVar(interp, "journal_format", (char*)&journal_format, TCL_LINK_INT); #endif sprintf(zBuf, "%d", SQLITE_PAGE_SIZE); Tcl_SetVar(interp, "SQLITE_PAGE_SIZE", zBuf, TCL_GLOBAL_ONLY); sprintf(zBuf, "%d", SQLITE_PAGE_RESERVE); Tcl_SetVar(interp, "SQLITE_PAGE_RESERVE", zBuf, TCL_GLOBAL_ONLY); sprintf(zBuf, "%d", SQLITE_USABLE_SIZE); Tcl_SetVar(interp, "SQLITE_USABLE_SIZE", zBuf, TCL_GLOBAL_ONLY); return TCL_OK; }
flag showGraph(Graph G) { char var[32]; if (!G->hidden || Batch) return TCL_OK; G->hidden = FALSE; G->needsRedraw = FALSE; G->needsPropRefresh = FALSE; eval(".drawGraph %d", G->num); sprintf(var, ".graphPropUp_%d", G->num); Tcl_LinkVar(Interp, var, (char *) &(G->propertiesUp), TCL_LINK_INT); drawLater(G); return TCL_OK; }
/* ** Register commands with the TCL interpreter. */ int Sqlitetest1_Init(Tcl_Interp *interp){ extern int sqlite_search_count; extern int sqlite_interrupt_count; extern int sqlite_open_file_count; extern int sqlite_current_time; extern int sqlite_temp_directory; static struct { char *zName; Tcl_CmdProc *xProc; } aCmd[] = { { "sqlite_mprintf_int", (Tcl_CmdProc*)sqlite_mprintf_int }, { "sqlite_mprintf_str", (Tcl_CmdProc*)sqlite_mprintf_str }, { "sqlite_mprintf_double", (Tcl_CmdProc*)sqlite_mprintf_double }, { "sqlite_mprintf_scaled", (Tcl_CmdProc*)sqlite_mprintf_scaled }, { "sqlite_mprintf_z_test", (Tcl_CmdProc*)test_mprintf_z }, { "sqlite_open", (Tcl_CmdProc*)sqlite_test_open }, { "sqlite_last_insert_rowid", (Tcl_CmdProc*)test_last_rowid }, { "sqlite_exec_printf", (Tcl_CmdProc*)test_exec_printf }, { "sqlite_get_table_printf", (Tcl_CmdProc*)test_get_table_printf }, { "sqlite_close", (Tcl_CmdProc*)sqlite_test_close }, { "sqlite_create_function", (Tcl_CmdProc*)test_create_function }, { "sqlite_create_aggregate", (Tcl_CmdProc*)test_create_aggregate }, { "sqlite_register_test_function", (Tcl_CmdProc*)test_register_func }, { "sqlite_abort", (Tcl_CmdProc*)sqlite_abort }, { "sqlite_datatypes", (Tcl_CmdProc*)sqlite_datatypes }, #ifdef MEMORY_DEBUG { "sqlite_malloc_fail", (Tcl_CmdProc*)sqlite_malloc_fail }, { "sqlite_malloc_stat", (Tcl_CmdProc*)sqlite_malloc_stat }, #endif { "sqlite_compile", (Tcl_CmdProc*)test_compile }, { "sqlite_step", (Tcl_CmdProc*)test_step }, { "sqlite_finalize", (Tcl_CmdProc*)test_finalize }, { "sqlite_bind", (Tcl_CmdProc*)test_bind }, { "sqlite_reset", (Tcl_CmdProc*)test_reset }, { "breakpoint", (Tcl_CmdProc*)test_breakpoint }, }; int i; for(i=0; i<sizeof(aCmd)/sizeof(aCmd[0]); i++){ Tcl_CreateCommand(interp, aCmd[i].zName, aCmd[i].xProc, 0, 0); } Tcl_LinkVar(interp, "sqlite_search_count", (char*)&sqlite_search_count, TCL_LINK_INT); Tcl_LinkVar(interp, "sqlite_interrupt_count", (char*)&sqlite_interrupt_count, TCL_LINK_INT); Tcl_LinkVar(interp, "sqlite_open_file_count", (char*)&sqlite_open_file_count, TCL_LINK_INT); Tcl_LinkVar(interp, "sqlite_current_time", (char*)&sqlite_current_time, TCL_LINK_INT); Tcl_LinkVar(interp, "sqlite_static_bind_value", (char*)&sqlite_static_bind_value, TCL_LINK_STRING); Tcl_LinkVar(interp, "sqlite_temp_directory", (char*)&sqlite_temp_directory, TCL_LINK_STRING); return TCL_OK; }
void InitScripting(void) { interp = Tcl_CreateInterp(); if ( interp == NULL ) { fprintf( stderr, "Unable to initialize Tcl.\n" ); exit( 1 ); } if ( Tcl_CreateObjCommand( interp, "fireWeapon", HandleFireWeaponCmd, ( ClientData ) 0, NULL ) == NULL) { fprintf( stderr, "Error creating Tcl command.\n" ); exit(1); } Tcl_LinkVar( interp, "player_x", ( char * ) &player.world_x, TCL_LINK_DOUBLE ); Tcl_LinkVar( interp, "player_y", ( char * ) &player.world_y, TCL_LINK_DOUBLE ); Tcl_LinkVar( interp, "player_angle", ( char * ) &player.angle, TCL_LINK_DOUBLE ); Tcl_LinkVar( interp, "player_accel", ( char * ) &player.accel, TCL_LINK_DOUBLE ); Tcl_LinkVar( interp, "computer_x", ( char * ) &opponent.world_x, TCL_LINK_DOUBLE ); Tcl_LinkVar( interp, "computer_y", ( char * ) &opponent.world_y, TCL_LINK_DOUBLE ); Tcl_LinkVar( interp, "computer_angle", ( char * ) &opponent.angle, TCL_LINK_DOUBLE ); Tcl_LinkVar( interp, "computer_accel", ( char * ) &opponent.accel, TCL_LINK_DOUBLE ); Tcl_SetVar2Ex( interp, "world_width", NULL, Tcl_NewIntObj( WORLD_WIDTH ), 0); Tcl_SetVar2Ex( interp, "world_height", NULL, Tcl_NewIntObj( WORLD_HEIGHT ), 0); Tcl_SetVar2Ex( interp, "player_forward_thrust", NULL, Tcl_NewIntObj( PLAYER_FORWARD_THRUST ), 0); Tcl_SetVar2Ex( interp, "player_reverse_thrust", NULL, Tcl_NewIntObj( PLAYER_REVERSE_THRUST ), 0); }
/* * Public entry point for ::tcl::kitpath. * Creates both link variable name and Tcl command ::tcl::kitpath. */ static int TclKitPath_Init(Tcl_Interp *interp) { Tcl_CreateObjCommand(interp, "::tcl::kitpath", TclKitPathObjCmd, 0, 0); if (Tcl_LinkVar(interp, "::tcl::kitpath", (char *) &tclKitPath, TCL_LINK_STRING | TCL_LINK_READ_ONLY) != TCL_OK) { Tcl_ResetResult(interp); } if (tclKitPath == NULL) { /* * XXX: We may want to avoid doing this to allow tcl::kitpath calls * XXX: to obtain changes in nameofexe, if they occur. */ TclKit_SetKitPath(Tcl_GetNameOfExecutable()); } return Tcl_PkgProvide(interp, "tclkitpath", "1.0"); }
int TextOutput_Init(Tcl_Interp *interp) { _interp = interp; Tcl_CreateCommand(interp, "tout_init", tcl_tout_init, (ClientData) NULL, NULL); Tcl_CreateCommand(interp, "tout_set_scroll", tcl_tout_set_scroll, (ClientData) NULL, NULL); Tcl_CreateCommand(interp, "tout_set_redir", tcl_tout_set_redir, (ClientData) NULL, NULL); #ifndef NOPIPE Tcl_CreateCommand(interp, "tout_pipe", tcl_tout_pipe, (ClientData) NULL, NULL); #endif Tcl_CreateCommand(interp, "vmessage", tcl_vmessage, (ClientData) NULL, NULL); Tcl_CreateCommand(interp, "vmessage_tagged", tcl_vmessage_tagged, (ClientData) NULL, NULL); Tcl_CreateCommand(interp, "verror", tcl_verror, (ClientData) NULL, NULL); Tcl_CreateCommand(interp, "vfuncheader", tcl_vfuncheader, (ClientData) NULL, NULL); Tcl_CreateCommand(interp, "vfuncgroup", tcl_vfuncgroup, (ClientData) NULL, NULL); Tcl_CreateCommand(interp, "error_bell", tcl_error_bell, (ClientData) NULL, NULL); Tcl_CreateObjCommand(interp, "log_str", tcl_log_str, NULL, NULL); Tcl_CreateObjCommand(interp, "log_call", tcl_log_call, NULL, NULL); Tcl_CreateObjCommand(interp, "log_vmessage", tcl_log_vmessage, NULL, NULL); Tcl_LinkVar(interp, "logging", (char *)&logging, TCL_LINK_INT); return TCL_OK; }
void add_tcl_fset(Tcl_Interp *irp) { char varname[180]; int i = 0; for(i = 0; fset_array[i].name; i++) { int type_of = -1; switch(fset_array[i].type) { case INT_TYPE_VAR: type_of = TCL_LINK_INT; break; case STR_TYPE_VAR: type_of = TCL_LINK_STRING; break; case BOOL_TYPE_VAR: type_of = TCL_LINK_BOOLEAN; break; default: continue; } strncpy(varname, fset_array[i].name, 80); lower(varname); type_of |= TCL_LINK_READ_ONLY; Tcl_LinkVar(irp, varname, (fset_array[i].type == STR_TYPE_VAR) ? (char *)&fset_array[i].string : (char *)&fset_array[i].integer, type_of); #if 0 if (fset_array[i].type == STR_TYPE_VAR) { Tcl_TraceVar(irp, varname, TCL_TRACE_WRITES, (Tcl_VarTraceProc *)fset_rem_str, (ClientData)&fset_array[i]); } #endif } }
/* ** Register commands with the TCL interpreter. */ int Sqlitetest2_Init(Tcl_Interp *interp){ static struct { char *zName; Tcl_CmdProc *xProc; } aCmd[] = { { "pager_open", (Tcl_CmdProc*)t2_tcl_function_stub }, { "pager_close", (Tcl_CmdProc*)t2_tcl_function_stub }, { "pager_commit", (Tcl_CmdProc*)t2_tcl_function_stub }, { "pager_rollback", (Tcl_CmdProc*)t2_tcl_function_stub }, { "pager_stmt_begin", (Tcl_CmdProc*)t2_tcl_function_stub }, { "pager_stmt_commit", (Tcl_CmdProc*)t2_tcl_function_stub }, { "pager_stmt_rollback", (Tcl_CmdProc*)t2_tcl_function_stub }, { "pager_stats", (Tcl_CmdProc*)t2_tcl_function_stub }, { "pager_pagecount", (Tcl_CmdProc*)t2_tcl_function_stub }, { "page_get", (Tcl_CmdProc*)t2_tcl_function_stub }, { "page_lookup", (Tcl_CmdProc*)t2_tcl_function_stub }, { "page_unref", (Tcl_CmdProc*)t2_tcl_function_stub }, { "page_read", (Tcl_CmdProc*)t2_tcl_function_stub }, { "page_write", (Tcl_CmdProc*)t2_tcl_function_stub }, { "page_number", (Tcl_CmdProc*)t2_tcl_function_stub }, { "pager_truncate", (Tcl_CmdProc*)t2_tcl_function_stub }, #ifndef SQLITE_OMIT_DISKIO { "fake_big_file", (Tcl_CmdProc*)fake_big_file }, #endif { "sqlite3BitvecBuiltinTest",(Tcl_CmdProc*)testBitvecBuiltinTest }, { "sqlite3_test_control_pending_byte", (Tcl_CmdProc*)t2_tcl_function_stub }, }; int i; for(i=0; i<sizeof(aCmd)/sizeof(aCmd[0]); i++){ Tcl_CreateCommand(interp, aCmd[i].zName, aCmd[i].xProc, 0, 0); } #ifndef SQLITE_OMIT_WSD Tcl_LinkVar(interp, "sqlite_pending_byte", (char*)&sqlite3PendingByte, TCL_LINK_INT | TCL_LINK_READ_ONLY); #endif return TCL_OK; }
int Tkpath_Init(Tcl_Interp *interp) /* Tcl interpreter. */ { #if defined(USE_TCL_STUBS) if (Tcl_InitStubs(interp, TKPATH_REQUIRE, 0) == NULL) { return TCL_ERROR; } #endif if (Tcl_PkgRequire(interp, "Tcl", TKPATH_REQUIRE, 0) == NULL) { return TCL_ERROR; } #if defined(USE_TK_STUBS) if (Tk_InitStubs(interp, TKPATH_REQUIRE, 0) == NULL) { return TCL_ERROR; } #endif if (Tcl_PkgRequire(interp, "Tk", TKPATH_REQUIRE, 0) == NULL) { return TCL_ERROR; } if (Tcl_CreateNamespace(interp, "::tkp", NULL, NULL) == NULL) { Tcl_ResetResult(interp); } Tcl_CreateObjCommand(interp, "::tkp::canvas", Tk_PathCanvasObjCmd, (ClientData) Tk_MainWindow(interp), NULL); gInterp = interp; /* * Link the ::tkp::antialias variable to control antialiasing. */ if (Tcl_LinkVar(interp, "::tkp::antialias", (char *) &gAntiAlias, TCL_LINK_BOOLEAN) != TCL_OK) { Tcl_ResetResult(interp); } /* * With gSurfaceCopyPremultiplyAlpha true we ignore the "premultiply alpha" * and use RGB as is. Else we need to divide each RGB with alpha * to get "true" values. */ if (Tcl_LinkVar(interp, "::tkp::premultiplyalpha", (char *) &gSurfaceCopyPremultiplyAlpha, TCL_LINK_BOOLEAN) != TCL_OK) { Tcl_ResetResult(interp); } if (Tcl_LinkVar(interp, "::tkp::depixelize", (char *) &gDepixelize, TCL_LINK_BOOLEAN) != TCL_OK) { Tcl_ResetResult(interp); } Tcl_CreateObjCommand(interp, "::tkp::pixelalign", PixelAlignObjCmd, (ClientData) NULL, (Tcl_CmdDeleteProc *) NULL); /* * Make separate gradient objects, similar to SVG. */ PathGradientInit(interp); SurfaceInit(interp); /* * Style object. */ PathStyleInit(interp); return Tcl_PkgProvide(interp, "tkpath", TKPATH_PATCHLEVEL); }
void Tcl_MainEx( int argc, /* Number of arguments. */ TCHAR **argv, /* Array of argument strings. */ Tcl_AppInitProc *appInitProc, /* Application-specific initialization * function to call after most initialization * but before starting to execute commands. */ Tcl_Interp *interp) { Tcl_Obj *path, *resultPtr, *argvPtr, *appName; const char *encodingName = NULL; int code, exitCode = 0; Tcl_MainLoopProc *mainLoopProc; Tcl_Channel chan; InteractiveState is; TclpSetInitialEncodings(); TclpFindExecutable((const char *)argv[0]); Tcl_InitMemory(interp); is.interp = interp; is.prompt = PROMPT_START; is.commandPtr = Tcl_NewObj(); /* * If the application has not already set a startup script, parse the * first few command line arguments to determine the script path and * encoding. */ if (NULL == Tcl_GetStartupScript(NULL)) { /* * Check whether first 3 args (argv[1] - argv[3]) look like * -encoding ENCODING FILENAME * or like * FILENAME */ if ((argc > 3) && (0 == _tcscmp(TEXT("-encoding"), argv[1])) && ('-' != argv[3][0])) { Tcl_Obj *value = NewNativeObj(argv[2], -1); Tcl_SetStartupScript(NewNativeObj(argv[3], -1), Tcl_GetString(value)); Tcl_DecrRefCount(value); argc -= 3; argv += 3; } else if ((argc > 1) && ('-' != argv[1][0])) { Tcl_SetStartupScript(NewNativeObj(argv[1], -1), NULL); argc--; argv++; } } path = Tcl_GetStartupScript(&encodingName); if (path == NULL) { appName = NewNativeObj(argv[0], -1); } else { appName = path; } Tcl_SetVar2Ex(interp, "argv0", NULL, appName, TCL_GLOBAL_ONLY); argc--; argv++; Tcl_SetVar2Ex(interp, "argc", NULL, Tcl_NewIntObj(argc), TCL_GLOBAL_ONLY); argvPtr = Tcl_NewListObj(0, NULL); while (argc--) { Tcl_ListObjAppendElement(NULL, argvPtr, NewNativeObj(*argv++, -1)); } Tcl_SetVar2Ex(interp, "argv", NULL, argvPtr, TCL_GLOBAL_ONLY); /* * Set the "tcl_interactive" variable. */ is.tty = isatty(0); Tcl_SetVar2Ex(interp, "tcl_interactive", NULL, Tcl_NewIntObj(!path && is.tty), TCL_GLOBAL_ONLY); /* * Invoke application-specific initialization. */ Tcl_Preserve(interp); if (appInitProc(interp) != TCL_OK) { chan = Tcl_GetStdChannel(TCL_STDERR); if (chan) { Tcl_WriteChars(chan, "application-specific initialization failed: ", -1); Tcl_WriteObj(chan, Tcl_GetObjResult(interp)); Tcl_WriteChars(chan, "\n", 1); } } if (Tcl_InterpDeleted(interp)) { goto done; } if (Tcl_LimitExceeded(interp)) { goto done; } if (TclFullFinalizationRequested()) { /* * Arrange for final deletion of the main interp */ /* ARGH Munchhausen effect */ Tcl_CreateExitHandler(FreeMainInterp, interp); } /* * Invoke the script specified on the command line, if any. Must fetch it * again, as the appInitProc might have reset it. */ path = Tcl_GetStartupScript(&encodingName); if (path != NULL) { Tcl_ResetResult(interp); code = Tcl_FSEvalFileEx(interp, path, encodingName); if (code != TCL_OK) { chan = Tcl_GetStdChannel(TCL_STDERR); if (chan) { Tcl_Obj *options = Tcl_GetReturnOptions(interp, code); Tcl_Obj *keyPtr, *valuePtr; TclNewLiteralStringObj(keyPtr, "-errorinfo"); Tcl_IncrRefCount(keyPtr); Tcl_DictObjGet(NULL, options, keyPtr, &valuePtr); Tcl_DecrRefCount(keyPtr); if (valuePtr) { Tcl_WriteObj(chan, valuePtr); } Tcl_WriteChars(chan, "\n", 1); Tcl_DecrRefCount(options); } exitCode = 1; } goto done; } /* * We're running interactively. Source a user-specific startup file if the * application specified one and if the file exists. */ Tcl_SourceRCFile(interp); if (Tcl_LimitExceeded(interp)) { goto done; } /* * Process commands from stdin until there's an end-of-file. Note that we * need to fetch the standard channels again after every eval, since they * may have been changed. */ Tcl_IncrRefCount(is.commandPtr); /* * Get a new value for tty if anyone writes to ::tcl_interactive */ Tcl_LinkVar(interp, "tcl_interactive", (char *) &is.tty, TCL_LINK_BOOLEAN); is.input = Tcl_GetStdChannel(TCL_STDIN); while ((is.input != NULL) && !Tcl_InterpDeleted(interp)) { mainLoopProc = TclGetMainLoop(); if (mainLoopProc == NULL) { int length; if (is.tty) { Prompt(interp, &is); if (Tcl_InterpDeleted(interp)) { break; } if (Tcl_LimitExceeded(interp)) { break; } is.input = Tcl_GetStdChannel(TCL_STDIN); if (is.input == NULL) { break; } } if (Tcl_IsShared(is.commandPtr)) { Tcl_DecrRefCount(is.commandPtr); is.commandPtr = Tcl_DuplicateObj(is.commandPtr); Tcl_IncrRefCount(is.commandPtr); } length = Tcl_GetsObj(is.input, is.commandPtr); if (length < 0) { if (Tcl_InputBlocked(is.input)) { /* * This can only happen if stdin has been set to * non-blocking. In that case cycle back and try again. * This sets up a tight polling loop (since we have no * event loop running). If this causes bad CPU hogging, we * might try toggling the blocking on stdin instead. */ continue; } /* * Either EOF, or an error on stdin; we're done */ break; } /* * Add the newline removed by Tcl_GetsObj back to the string. Have * to add it back before testing completeness, because it can make * a difference. [Bug 1775878] */ if (Tcl_IsShared(is.commandPtr)) { Tcl_DecrRefCount(is.commandPtr); is.commandPtr = Tcl_DuplicateObj(is.commandPtr); Tcl_IncrRefCount(is.commandPtr); } Tcl_AppendToObj(is.commandPtr, "\n", 1); if (!TclObjCommandComplete(is.commandPtr)) { is.prompt = PROMPT_CONTINUE; continue; } is.prompt = PROMPT_START; /* * The final newline is syntactically redundant, and causes some * error messages troubles deeper in, so lop it back off. */ Tcl_GetStringFromObj(is.commandPtr, &length); Tcl_SetObjLength(is.commandPtr, --length); code = Tcl_RecordAndEvalObj(interp, is.commandPtr, TCL_EVAL_GLOBAL); is.input = Tcl_GetStdChannel(TCL_STDIN); Tcl_DecrRefCount(is.commandPtr); is.commandPtr = Tcl_NewObj(); Tcl_IncrRefCount(is.commandPtr); if (code != TCL_OK) { chan = Tcl_GetStdChannel(TCL_STDERR); if (chan) { Tcl_WriteObj(chan, Tcl_GetObjResult(interp)); Tcl_WriteChars(chan, "\n", 1); } } else if (is.tty) { resultPtr = Tcl_GetObjResult(interp); Tcl_IncrRefCount(resultPtr); Tcl_GetStringFromObj(resultPtr, &length); chan = Tcl_GetStdChannel(TCL_STDOUT); if ((length > 0) && chan) { Tcl_WriteObj(chan, resultPtr); Tcl_WriteChars(chan, "\n", 1); } Tcl_DecrRefCount(resultPtr); } } else { /* (mainLoopProc != NULL) */ /* * If a main loop has been defined while running interactively, we * want to start a fileevent based prompt by establishing a * channel handler for stdin. */ if (is.input) { if (is.tty) { Prompt(interp, &is); } Tcl_CreateChannelHandler(is.input, TCL_READABLE, StdinProc, &is); } mainLoopProc(); Tcl_SetMainLoop(NULL); if (is.input) { Tcl_DeleteChannelHandler(is.input, StdinProc, &is); } is.input = Tcl_GetStdChannel(TCL_STDIN); } /* * This code here only for the (unsupported and deprecated) [checkmem] * command. */ #ifdef TCL_MEM_DEBUG if (tclMemDumpFileName != NULL) { Tcl_SetMainLoop(NULL); Tcl_DeleteInterp(interp); } #endif /* TCL_MEM_DEBUG */ } done: mainLoopProc = TclGetMainLoop(); if ((exitCode == 0) && mainLoopProc && !Tcl_LimitExceeded(interp)) { /* * If everything has gone OK so far, call the main loop proc, if it * exists. Packages (like Tk) can set it to start processing events at * this point. */ mainLoopProc(); Tcl_SetMainLoop(NULL); } if (is.commandPtr != NULL) { Tcl_DecrRefCount(is.commandPtr); } /* * Rather than calling exit, invoke the "exit" command so that users can * replace "exit" with some other command to do additional cleanup on * exit. The Tcl_EvalObjEx call should never return. */ if (!Tcl_InterpDeleted(interp) && !Tcl_LimitExceeded(interp)) { Tcl_Obj *cmd = Tcl_ObjPrintf("exit %d", exitCode); Tcl_IncrRefCount(cmd); Tcl_EvalObjEx(interp, cmd, TCL_EVAL_GLOBAL); Tcl_DecrRefCount(cmd); } /* * If Tcl_EvalObjEx returns, trying to eval [exit], something unusual is * happening. Maybe interp has been deleted; maybe [exit] was redefined, * maybe we've blown up because of an exceeded limit. We still want to * cleanup and exit. */ Tcl_Exit(exitCode); }
struct sfilterp_st *open_sfilter(char *script){ struct sfilterp_st *sfilterp; int status = 0; sfilterp = malloc(sizeof(struct sfilterp_st)); if(sfilterp == NULL) return(NULL); /* * The variables output_xxxx are set by the filter and read by the server. * The other ones are set by the server and read by the filter. */ sfilterp->script = NULL; sfilterp->tcl_scriptpath = NULL; sfilterp->input = NULL; sfilterp->fdata = NULL; sfilterp->input_size = 0; sfilterp->fdata_size = 0; sfilterp->cmd = SFILTER_CMD_INIT; sfilterp->output_status = 0; /* set by the filter */ sfilterp->output_fpathout = NULL; /* set by the filter */ sfilterp->output_emwinfname = NULL; /* set by the filter */ if(set_sfilter_script(sfilterp, script) != 0){ free(sfilterp); return(NULL); } sfilterp->interp = tcl_create_interp(); if(sfilterp->interp == NULL) status = -1; if(status == 0){ sfilterp->input = ckalloc(INIT_INPUT_SIZE); if(sfilterp->input == NULL) status = -1; else{ sfilterp->input[0] = '\0'; sfilterp->input_size = INIT_INPUT_SIZE; } } if(status == 0){ Tcl_LinkVar(sfilterp->interp, "input", (void*)&sfilterp->input, TCL_LINK_STRING); Tcl_LinkVar(sfilterp->interp, "fdata", (void*)&sfilterp->fdata, TCL_LINK_STRING); Tcl_LinkVar(sfilterp->interp, "fdata_size", (void*)&sfilterp->fdata_size, TCL_LINK_INT); Tcl_LinkVar(sfilterp->interp, "command", (void*)&sfilterp->cmd, TCL_LINK_INT); Tcl_LinkVar(sfilterp->interp, "output_status", (void*)&sfilterp->output_status, TCL_LINK_INT); Tcl_LinkVar(sfilterp->interp, "output_fpathout", (void*)&sfilterp->output_fpathout, TCL_LINK_STRING); Tcl_LinkVar(sfilterp->interp, "output_emwinfname", (void*)&sfilterp->output_emwinfname, TCL_LINK_STRING); } if(status == 0){ status = pthread_mutex_init(&sfilterp->mutex, NULL); if(status == 0){ status = pthread_cond_init(&sfilterp->cond, NULL); if(status != 0) pthread_mutex_destroy(&sfilterp->mutex); } if(status != 0){ errno = status; status = -1; }else sfilterp->thread_status = 0; } if(status != 0){ close_sfilter(sfilterp); sfilterp = NULL; } return(sfilterp); }
/* Main global setup function */ int init_globals(Tcl_Interp *interp) { static int done_init = 0; extern int gap_fatal_errors; char *env; if (done_init) return 0; else done_init++; /* lookup tables */ set_char_set(1); /* 1 == DNA */ set_dna_lookup(); /* general lookup and complementing */ set_iubc_lookup(); /* iubc codes for restriction enzymes */ #if 0 set_mask_lookup(); /* used to mask/mark consensus */ #endif init_genetic_code(); #if 0 inits_(); /* fortran stuff */ initlu_(&idm); /* fortran stuff */ #endif /* Init Tcl note database */ init_tcl_notes(interp); if (NULL == (env = getenv("STADTABL"))) verror(ERR_FATAL, "init_globals", "STADTABL environment variable is not set."); else { char buf[1024]; sprintf(buf, "%s/align_lib_nuc_matrix", env); nt_matrix = create_matrix(buf, nt_order); if (nt_matrix) init_W128(nt_matrix, nt_order, 0); else verror(ERR_FATAL, "init_globals", "%s: file not found", buf); } /* * gap5_defs (a Tcl_Obj pointer) * * We keep this up to date by creating a write trace on the object and * doing an ObjGetVar2 when it changes. This way the object is always * valid. * Firstly we have to create gap5_defs though as initially it doesn't * exist. */ { Tcl_Obj *val; defs_name = Tcl_NewStringObj("gap5_defs", -1); /* global */ val = Tcl_ObjGetVar2(interp, defs_name, NULL, TCL_GLOBAL_ONLY); if (NULL == val) val = Tcl_NewStringObj("", -1); gap5_defs = Tcl_ObjSetVar2(interp, defs_name, NULL, val, TCL_GLOBAL_ONLY); Tcl_TraceVar(interp, "gap5_defs", TCL_TRACE_WRITES | TCL_GLOBAL_ONLY, gap5_defs_trace, NULL); } /* consensus_cutoff */ Tcl_TraceVar(interp, "consensus_cutoff", TCL_TRACE_WRITES|TCL_GLOBAL_ONLY, change_consensus_cutoff, (ClientData)NULL); /* quality_cutoff */ Tcl_LinkVar(interp, "quality_cutoff", (char *)&quality_cutoff, TCL_LINK_INT); /* chem_as_double */ Tcl_LinkVar(interp, "chem_as_double", (char *)&chem_as_double, TCL_LINK_INT); /* gap_fatal_errors */ Tcl_LinkVar(interp, "gap_fatal_errors", (char *)&gap_fatal_errors, TCL_LINK_BOOLEAN); #if 0 /* maxseq */ Tcl_LinkVar(interp, "maxseq", (char *)&maxseq, TCL_LINK_INT); /* maxdb */ Tcl_LinkVar(interp, "maxdb", (char *)&maxdb, TCL_LINK_INT); #endif /* ignore_checkdb */ Tcl_LinkVar(interp, "ignore_checkdb", (char *)&ignore_checkdb, TCL_LINK_INT); /* consensus_mode */ Tcl_LinkVar(interp, "consensus_mode", (char *)&consensus_mode, TCL_LINK_INT); /* consensus_iub */ Tcl_LinkVar(interp, "consensus_iub", (char *)&consensus_iub, TCL_LINK_INT); /* exec_notes */ Tcl_LinkVar(interp, "exec_notes", (char *)&exec_notes, TCL_LINK_INT); /* rawdata_note */ Tcl_LinkVar(interp, "rawdata_note", (char *)&rawdata_note, TCL_LINK_INT); /* align_open_cost */ Tcl_LinkVar(interp, "align_open_cost", (char *)&gopenval, TCL_LINK_INT); /* align_extend_cost */ Tcl_LinkVar(interp, "align_extend_cost", (char *)&gextendval, TCL_LINK_INT); /* template_size_tolerance */ Tcl_LinkVar(interp, "template_size_tolerance", (char *)&template_size_tolerance, TCL_LINK_DOUBLE); /* min_vector_len */ Tcl_LinkVar(interp, "min_vector_len", (char *)&min_vector_len, TCL_LINK_INT); /* template_check_flags */ Tcl_LinkVar(interp, "template_check_flags", (char *)&template_check_flags, TCL_LINK_INT); return TCL_OK; }
/******************************************************************************************** * InitTcl * purpose : Initialize the TCL part of the test application * input : executable - Program executable * versionString - Stack version string * output : reason - Reason of failure on failure * return : Tcl_Interp interpreter for tcl commands * NULL on failure ********************************************************************************************/ Tcl_Interp* InitTcl(const char* executable, char* versionString, char** reason) { static char strBuf[1024]; int retCode; /* Find TCL executable and create an interpreter */ Tcl_FindExecutable(executable); interp = Tcl_CreateInterp(); if (interp == NULL) { *reason = (char*)"Failed to create Tcl interpreter"; return NULL; } /* Overload file and source commands */ TclExecute("rename file fileOverloaded"); CREATE_COMMAND("file", test_File); CREATE_COMMAND("source", test_Source); /* Reroute tcl libraries - we'll need this one later */ /*TclSetVariable("tcl_library", TCL_LIBPATH); TclSetVariable("env(TCL_LIBRARY)", TCL_LIBPATH); TclSetVariable("tk_library", TK_LIBPATH); TclSetVariable("env(TK_LIBRARY)", TK_LIBPATH);*/ /* Initialize TCL */ retCode = Tcl_Init(interp); if (retCode != TCL_OK) { sprintf(strBuf, "Error in Tcl_Init: %s", Tcl_GetStringResult(interp)); *reason = strBuf; Tcl_DeleteInterp(interp); return NULL; } /* Initialize TK */ retCode = Tk_Init(interp); if (retCode != TCL_OK) { sprintf(strBuf, "Error in Tk_Init: %s", Tcl_GetStringResult(interp)); *reason = strBuf; Tcl_DeleteInterp(interp); return NULL; } /* Set argc and argv parameters for the script. This allows us to work with C in the scripts. */ retCode = TclExecute("set tmp(version) {Test Application: %s }", versionString); if (retCode != TCL_OK) { *reason = (char*)"Error setting stack's version for test application"; return interp; } /* Create new commands that are used in the tcl script */ CreateTclCommands(interp); Tcl_LinkVar(interp, (char *)"scriptLogs", (char *)&LogWrappers, TCL_LINK_BOOLEAN); /* Evaluate the Tcl script of the test application */ retCode = Tcl_Eval(interp, (char*)"source " TCL_FILENAME); if (retCode != TCL_OK) { sprintf(strBuf, "Error reading testapp script (line %d): %s\n", interp->errorLine, Tcl_GetStringResult(interp)); *reason = strBuf; return NULL; } /* Return the created interpreter */ *reason = NULL; return interp; }
/**************************************************** LINK_DATA ****************************************************/ void link_data( object *root, char *lab ) { int i, j; char previous[ MAX_ELEM_LENGTH + 20 ], ch1[ MAX_ELEM_LENGTH ]; object *cur, *cur1; variable *cv, *cv1; cur1 = root->search( lab ); strcpy( previous, "" ); for ( cv1 = cur1->v, j = 0; cv1 != NULL; ) { if ( cv1->param == 1 ) { strncpy( ch1, cv1->label, MAX_ELEM_LENGTH - 1 ); ch1[ MAX_ELEM_LENGTH - 1 ] = '\0'; cmd( "label $w.tit_t%s -anchor w -width 25 -text \"Par: %-25s\" -borderwidth 4", cv1->label, ch1 ); cmd( "$w window create end -window $w.tit_t%s", cv1->label ); cmd( "bind $w.tit_t%s <Enter> {set msg \"Parameter '%s'\"}", cv1->label, cv1->label ); cmd( "bind $w.tit_t%s <Leave> {set msg \" \"}", cv1->label ); cmd( "button $w.b%s_%d -text \"Set All\" -pady 0m -padx 1m -command {set choice 2; set var-S-A %s; set lag %d; set position $w.tit_t%s}", cv1->label, j, cv1->label, j, cv1->label ); cmd( "$w window create end -window $w.b%s_%d", cv1->label, j ); } else { if ( j < cv1->num_lag ) { strncpy( ch1, cv1->label, MAX_ELEM_LENGTH - 1 ); ch1[ MAX_ELEM_LENGTH - 1 ] = '\0'; cmd( "label $w.tit_t%s_%d -anchor w -width 25 -text \"Var: %-20s (-%d)\" -borderwidth 4", cv1->label, j, ch1, j + 1 ); cmd( "$w window create end -window $w.tit_t%s_%d", cv1->label, j ); cmd( "bind $w.tit_t%s_%d <Enter> {set msg \"Variable '%s' with lag %d\" }", cv1->label, j, cv1->label, j + 1 ); cmd( "bind $w.tit_t%s_%d <Leave> {set msg \" \" }", cv1->label, j ); cmd( "button $w.b%s_%d -text \"Set All\" -pady 0m -padx 1m -command {set choice 2; set var-S-A %s; set lag %d; set position $w.tit_t%s_%d}", cv1->label, j, cv1->label, j, cv1->label, j ); cmd( "$w window create end -window $w.b%s_%d", cv1->label, j ); } } for ( cur = cur1, i = 1; i <= MAX_COLS && cur != NULL; cur = cur->hyper_next( lab ) , ++i ) { cv = cur->search_var( cur, cv1->label ); cv->data_loaded = '+'; if ( cv->param == 1 ) { sprintf( ch1, "p%s_%d", cv->label, i ); Tcl_LinkVar( inter, ch1, ( char * ) &( cv->val[ 0 ] ), TCL_LINK_DOUBLE ); cmd( "entry $w.c%d_v%sp -width $cwidth -bd $cbd -validate focusout -vcmd {if [string is double -strict %%P] {set p%s_%d %%P; return 1} {%%W delete 0 end; %%W insert 0 $p%s_%d; return 0}} -invcmd {bell} -justify center", i, cv->label, cv->label, i, cv->label, i ); cmd( "$w.c%d_v%sp insert 0 $p%s_%d", i, cv->label, cv->label, i ); if ( set_focus == 0 ) { cmd( "set initial_focus $w.c%d_v%sp", i, cv->label ); set_focus = 1; } cmd( "$w window create end -window $w.c%d_v%sp", i, cv->label ); if ( strlen( previous ) != 0 ) { cmd( "bind %s <KeyPress-Return> {focus $w.c%d_v%sp; $w.c%d_v%sp selection range 0 end; $w see $w.c%d_v%sp}", previous, i, cv->label, i, cv->label, i, cv->label ); cmd( "bind %s <KeyPress-Down> {focus $w.c%d_v%sp; $w.c%d_v%sp selection range 0 end; $w see $w.c%d_v%sp}", previous, i, cv->label, i, cv->label, i, cv->label ); cmd( "bind $w.c%d_v%sp <KeyPress-Up> {focus %s; %s selection range 0 end; $w see %s}", i, cv->label, previous, previous, previous ); } cmd( "bind $w.c%d_v%sp <FocusIn> {set msg \"Inserting parameter '%s' in '%s' $tag_%d\"}", i,cv->label,cv->label,cur1->label,i ); cmd( "bind $w.c%d_v%sp <FocusOut> {set msg \" \"}", i, cv->label ); sprintf( previous, "$w.c%d_v%sp", i, cv->label ); } else { if ( j < cv->num_lag ) { sprintf( ch1, "v%s_%d_%d", cv->label, i, j ); Tcl_LinkVar( inter, ch1, ( char * ) &( cv->val[ j ] ), TCL_LINK_DOUBLE ); cmd( "entry $w.c%d_v%s_%d -width $cwidth -bd $cbd -validate focusout -vcmd {if [string is double -strict %%P] {set v%s_%d_%d %%P; return 1} {%%W delete 0 end; %%W insert 0 $v%s_%d_%d; return 0}} -invcmd {bell} -justify center", i, cv->label, j, cv->label, i, j, cv->label, i, j ); cmd( "$w.c%d_v%s_%d insert 0 $v%s_%d_%d", i, cv->label, j, cv->label, i, j ); if ( set_focus == 0 ) { cmd( "set initial_focus $w.c%d_v%s_%d", i, cv->label, j ); set_focus = 1; } cmd( "$w window create end -window $w.c%d_v%s_%d", i, cv->label, j ); if ( strlen( previous ) != 0 ) { cmd( "bind %s <KeyPress-Return> {focus $w.c%d_v%s_%d; $w.c%d_v%s_%d selection range 0 end; $w see $w.c%d_v%s_%d}", previous, i, cv->label, j, i, cv->label, j, i, cv->label, j ); cmd( "bind %s <KeyPress-Down> {focus $w.c%d_v%s_%d; $w.c%d_v%s_%d selection range 0 end; $w see $w.c%d_v%s_%d}", previous, i, cv->label, j, i, cv->label, j, i, cv->label, j ); cmd( "bind $w.c%d_v%s_%d <KeyPress-Up> {focus %s; %s selection range 0 end; $w see %s}", i, cv->label, j, previous, previous, previous ); } cmd( "bind $w.c%d_v%s_%d <FocusIn> {set msg \"Inserting variable '%s' (lag %d) in '%s' $tag_%d\"}", i, cv->label, j, cv->label, j + 1, cur1->label, i ); cmd( "bind $w.c%d_v%s_%d <FocusOut> {set msg \" \"}", i, cv->label, j ); sprintf( previous, "$w.c%d_v%s_%d", i, cv->label, j ); } } } // indicate columns overflow (>MAX_COLS) if ( ! colOvflw && cur != NULL ) colOvflw = true; // set flag of data loaded also to not shown pars. for ( ; cur != NULL; cur = cur->hyper_next( lab ) ) { cv = cur->search_var( cur, cv1->label ); cv->data_loaded = '+'; } if ( cv1->param == 1 || cv1->num_lag > 0 ) cmd( "$w insert end \\n" ); if ( cv1->param == 0 && j + 1 < cv1->num_lag ) ++j; else { cv1 = cv1->next; j = 0; } } }
void Tcl_Main( int argc, /* Number of arguments. */ char **argv, /* Array of argument strings. */ Tcl_AppInitProc *appInitProc) /* Application-specific initialization * function to call after most initialization * but before starting to execute commands. */ { Tcl_Obj *path, *resultPtr, *argvPtr, *commandPtr = NULL; const char *encodingName = NULL; PromptType prompt = PROMPT_START; int code, length, tty, exitCode = 0; Tcl_Channel inChannel, outChannel, errChannel; Tcl_Interp *interp; Tcl_DString appName; Tcl_FindExecutable(argv[0]); interp = Tcl_CreateInterp(); Tcl_InitMemory(interp); /* * If the application has not already set a startup script, parse the * first few command line arguments to determine the script path and * encoding. */ if (NULL == Tcl_GetStartupScript(NULL)) { /* * Check whether first 3 args (argv[1] - argv[3]) look like * -encoding ENCODING FILENAME * or like * FILENAME */ if ((argc > 3) && (0 == strcmp("-encoding", argv[1])) && ('-' != argv[3][0])) { Tcl_SetStartupScript(Tcl_NewStringObj(argv[3], -1), argv[2]); argc -= 3; argv += 3; } else if ((argc > 1) && ('-' != argv[1][0])) { Tcl_SetStartupScript(Tcl_NewStringObj(argv[1], -1), NULL); argc--; argv++; } } path = Tcl_GetStartupScript(&encodingName); if (path == NULL) { Tcl_ExternalToUtfDString(NULL, argv[0], -1, &appName); } else { const char *pathName = Tcl_GetStringFromObj(path, &length); Tcl_ExternalToUtfDString(NULL, pathName, length, &appName); path = Tcl_NewStringObj(Tcl_DStringValue(&appName), -1); Tcl_SetStartupScript(path, encodingName); } Tcl_SetVar(interp, "argv0", Tcl_DStringValue(&appName), TCL_GLOBAL_ONLY); Tcl_DStringFree(&appName); argc--; argv++; Tcl_SetVar2Ex(interp, "argc", NULL, Tcl_NewIntObj(argc), TCL_GLOBAL_ONLY); argvPtr = Tcl_NewListObj(0, NULL); while (argc--) { Tcl_DString ds; Tcl_ExternalToUtfDString(NULL, *argv++, -1, &ds); Tcl_ListObjAppendElement(NULL, argvPtr, Tcl_NewStringObj( Tcl_DStringValue(&ds), Tcl_DStringLength(&ds))); Tcl_DStringFree(&ds); } Tcl_SetVar2Ex(interp, "argv", NULL, argvPtr, TCL_GLOBAL_ONLY); /* * Set the "tcl_interactive" variable. */ tty = isatty(0); Tcl_SetVar(interp, "tcl_interactive", ((path == NULL) && tty) ? "1" : "0", TCL_GLOBAL_ONLY); /* * Invoke application-specific initialization. */ Tcl_Preserve(interp); if (appInitProc(interp) != TCL_OK) { errChannel = Tcl_GetStdChannel(TCL_STDERR); if (errChannel) { Tcl_WriteChars(errChannel, "application-specific initialization failed: ", -1); Tcl_WriteObj(errChannel, Tcl_GetObjResult(interp)); Tcl_WriteChars(errChannel, "\n", 1); } } if (Tcl_InterpDeleted(interp)) { goto done; } if (Tcl_LimitExceeded(interp)) { goto done; } /* * If a script file was specified then just source that file and quit. * Must fetch it again, as the appInitProc might have reset it. */ path = Tcl_GetStartupScript(&encodingName); if (path != NULL) { code = Tcl_FSEvalFileEx(interp, path, encodingName); if (code != TCL_OK) { errChannel = Tcl_GetStdChannel(TCL_STDERR); if (errChannel) { Tcl_Obj *options = Tcl_GetReturnOptions(interp, code); Tcl_Obj *keyPtr, *valuePtr; TclNewLiteralStringObj(keyPtr, "-errorinfo"); Tcl_IncrRefCount(keyPtr); Tcl_DictObjGet(NULL, options, keyPtr, &valuePtr); Tcl_DecrRefCount(keyPtr); if (valuePtr) { Tcl_WriteObj(errChannel, valuePtr); } Tcl_WriteChars(errChannel, "\n", 1); } exitCode = 1; } goto done; } /* * We're running interactively. Source a user-specific startup file if the * application specified one and if the file exists. */ Tcl_SourceRCFile(interp); if (Tcl_LimitExceeded(interp)) { goto done; } /* * Process commands from stdin until there's an end-of-file. Note that we * need to fetch the standard channels again after every eval, since they * may have been changed. */ commandPtr = Tcl_NewObj(); Tcl_IncrRefCount(commandPtr); /* * Get a new value for tty if anyone writes to ::tcl_interactive */ Tcl_LinkVar(interp, "tcl_interactive", (char *) &tty, TCL_LINK_BOOLEAN); inChannel = Tcl_GetStdChannel(TCL_STDIN); outChannel = Tcl_GetStdChannel(TCL_STDOUT); while ((inChannel != NULL) && !Tcl_InterpDeleted(interp)) { if (mainLoopProc == NULL) { if (tty) { Prompt(interp, &prompt); if (Tcl_InterpDeleted(interp)) { break; } if (Tcl_LimitExceeded(interp)) { break; } inChannel = Tcl_GetStdChannel(TCL_STDIN); if (inChannel == NULL) { break; } } if (Tcl_IsShared(commandPtr)) { Tcl_DecrRefCount(commandPtr); commandPtr = Tcl_DuplicateObj(commandPtr); Tcl_IncrRefCount(commandPtr); } length = Tcl_GetsObj(inChannel, commandPtr); if (length < 0) { if (Tcl_InputBlocked(inChannel)) { /* * This can only happen if stdin has been set to * non-blocking. In that case cycle back and try again. * This sets up a tight polling loop (since we have no * event loop running). If this causes bad CPU hogging, we * might try toggling the blocking on stdin instead. */ continue; } /* * Either EOF, or an error on stdin; we're done */ break; } /* * Add the newline removed by Tcl_GetsObj back to the string. Have * to add it back before testing completeness, because it can make * a difference. [Bug 1775878] */ if (Tcl_IsShared(commandPtr)) { Tcl_DecrRefCount(commandPtr); commandPtr = Tcl_DuplicateObj(commandPtr); Tcl_IncrRefCount(commandPtr); } Tcl_AppendToObj(commandPtr, "\n", 1); if (!TclObjCommandComplete(commandPtr)) { prompt = PROMPT_CONTINUE; continue; } prompt = PROMPT_START; /* * The final newline is syntactically redundant, and causes some * error messages troubles deeper in, so lop it back off. */ Tcl_GetStringFromObj(commandPtr, &length); Tcl_SetObjLength(commandPtr, --length); code = Tcl_RecordAndEvalObj(interp, commandPtr, TCL_EVAL_GLOBAL); inChannel = Tcl_GetStdChannel(TCL_STDIN); outChannel = Tcl_GetStdChannel(TCL_STDOUT); errChannel = Tcl_GetStdChannel(TCL_STDERR); Tcl_DecrRefCount(commandPtr); commandPtr = Tcl_NewObj(); Tcl_IncrRefCount(commandPtr); if (code != TCL_OK) { if (errChannel) { Tcl_WriteObj(errChannel, Tcl_GetObjResult(interp)); Tcl_WriteChars(errChannel, "\n", 1); } } else if (tty) { resultPtr = Tcl_GetObjResult(interp); Tcl_IncrRefCount(resultPtr); Tcl_GetStringFromObj(resultPtr, &length); if ((length > 0) && outChannel) { Tcl_WriteObj(outChannel, resultPtr); Tcl_WriteChars(outChannel, "\n", 1); } Tcl_DecrRefCount(resultPtr); } } else { /* (mainLoopProc != NULL) */ /* * If a main loop has been defined while running interactively, we * want to start a fileevent based prompt by establishing a * channel handler for stdin. */ InteractiveState *isPtr = NULL; if (inChannel) { if (tty) { Prompt(interp, &prompt); } isPtr = (InteractiveState *) ckalloc(sizeof(InteractiveState)); isPtr->input = inChannel; isPtr->tty = tty; isPtr->commandPtr = commandPtr; isPtr->prompt = prompt; isPtr->interp = interp; Tcl_UnlinkVar(interp, "tcl_interactive"); Tcl_LinkVar(interp, "tcl_interactive", (char *) &(isPtr->tty), TCL_LINK_BOOLEAN); Tcl_CreateChannelHandler(inChannel, TCL_READABLE, StdinProc, isPtr); } mainLoopProc(); mainLoopProc = NULL; if (inChannel) { tty = isPtr->tty; Tcl_UnlinkVar(interp, "tcl_interactive"); Tcl_LinkVar(interp, "tcl_interactive", (char *) &tty, TCL_LINK_BOOLEAN); prompt = isPtr->prompt; commandPtr = isPtr->commandPtr; if (isPtr->input != NULL) { Tcl_DeleteChannelHandler(isPtr->input, StdinProc, isPtr); } ckfree((char *) isPtr); } inChannel = Tcl_GetStdChannel(TCL_STDIN); outChannel = Tcl_GetStdChannel(TCL_STDOUT); errChannel = Tcl_GetStdChannel(TCL_STDERR); } #ifdef TCL_MEM_DEBUG /* * This code here only for the (unsupported and deprecated) [checkmem] * command. */ if (tclMemDumpFileName != NULL) { mainLoopProc = NULL; Tcl_DeleteInterp(interp); } #endif } done: if ((exitCode == 0) && (mainLoopProc != NULL) && !Tcl_LimitExceeded(interp)) { /* * If everything has gone OK so far, call the main loop proc, if it * exists. Packages (like Tk) can set it to start processing events at * this point. */ mainLoopProc(); mainLoopProc = NULL; } if (commandPtr != NULL) { Tcl_DecrRefCount(commandPtr); } /* * Rather than calling exit, invoke the "exit" command so that users can * replace "exit" with some other command to do additional cleanup on * exit. The Tcl_EvalObjEx call should never return. */ if (!Tcl_InterpDeleted(interp)) { if (!Tcl_LimitExceeded(interp)) { Tcl_Obj *cmd = Tcl_ObjPrintf("exit %d", exitCode); Tcl_IncrRefCount(cmd); Tcl_EvalObjEx(interp, cmd, TCL_EVAL_GLOBAL); Tcl_DecrRefCount(cmd); } /* * If Tcl_EvalObjEx returns, trying to eval [exit], something unusual * is happening. Maybe interp has been deleted; maybe [exit] was * redefined, maybe we've blown up because of an exceeded limit. We * still want to cleanup and exit. */ if (!Tcl_InterpDeleted(interp)) { Tcl_DeleteInterp(interp); } } Tcl_SetStartupScript(NULL, NULL); /* * If we get here, the master interp has been deleted. Allow its * destruction with the last matching Tcl_Release. */ Tcl_Release(interp); Tcl_Exit(exitCode); }
void commandsManager::registerVariable(char *varName, char* &Var, char *helpMsg) { varsHelp[varName] = helpMsg; Tcl_LinkVar(interp, varName, (char *)&Var, TCL_LINK_STRING); }
/**************************************************** EDIT_DATA ****************************************************/ void edit_data( object *root, int *choice, char *obj_name ) { char *l , ch[ 2 * MAX_ELEM_LENGTH ], ch1[ MAX_ELEM_LENGTH ]; int i, counter, lag; object *first; cmd( "if {$tcl_platform(os) == \"Darwin\"} {set cwidth 9; set cbd 2 } {set cwidth 8; set cbd 2}" ); Tcl_LinkVar( inter, "lag", ( char * ) &lag, TCL_LINK_INT ); cmd( "if { ! [ info exists autoWidth ] } { set autoWidth 1 }" ); cmd( "if { ! [ winfo exists .ini ] } { newtop .ini; showtop .ini topleftW 1 1 1 $hsizeI $vsizeI } { if { ! $autoWidth } { resizetop $hsizeI $vsizeI } }" ); cmd( "set position 1.0" ); in_edit_data = true; *choice = 0; while ( *choice == 0 ) { // reset title and destroy command because may be coming from set_obj_number cmd( "settop .ini \"%s%s - LSD Initial Values Editor\" { set choice 1 }", unsaved_change() ? "*" : " ", simul_name ); first = root->search( obj_name ); cmd( "frame .ini.b" ); cmd( "set w .ini.b.tx" ); cmd( "scrollbar .ini.b.ys -command \".ini.b.tx yview\"" ); cmd( "scrollbar .ini.b.xs -command \".ini.b.tx xview\" -orient horizontal" ); cmd( "text $w -yscrollcommand \".ini.b.ys set\" -xscrollcommand \".ini.b.xs set\" -wrap none" ); cmd( ".ini.b.tx conf -cursor arrow" ); strncpy( ch1, obj_name, MAX_ELEM_LENGTH - 1 ); ch1[ MAX_ELEM_LENGTH - 1 ] = '\0'; cmd( "label $w.tit_empty -width 32 -relief raised -text \"Object: %-17s \" -borderwidth 4", ch1 ); cmd( "bind $w.tit_empty <Button-1> {set choice 4}" ); if ( ! in_set_obj ) // show only if not already recursing cmd( "bind $w.tit_empty <Enter> {set msg \"Click to edit number of instances\"}" ); cmd( "bind $w.tit_empty <Leave> {set msg \"\"}" ); cmd( "$w window create end -window $w.tit_empty" ); strcpy( ch, "" ); i = 0; counter = 1; colOvflw = false; search_title( root, ch, &i, obj_name, &counter ); cmd( "$w insert end \\n" ); // explore the tree searching for each instance of such object and create: // - titles // - entry cells linked to the values set_focus = 0; link_data( root, obj_name ); cmd( "pack .ini.b.ys -side right -fill y" ); cmd( "pack .ini.b.xs -side bottom -fill x" ); cmd( "pack .ini.b.tx -expand yes -fill both" ); cmd( "pack .ini.b -expand yes -fill both" ); cmd( "label .ini.msg -textvariable msg" ); cmd( "pack .ini.msg -pady 5" ); cmd( "frame .ini.st" ); cmd( "label .ini.st.err -text \"\"" ); cmd( "label .ini.st.pad -text \" \"" ); cmd( "checkbutton .ini.st.aw -text \"Automatic width\" -variable autoWidth -command { set choice 5 }" ); cmd( "pack .ini.st.err .ini.st.pad .ini.st.aw -side left" ); cmd( "pack .ini.st -anchor e -padx 10 -pady 5" ); cmd( "donehelp .ini boh { set choice 1 } { LsdHelp menudata_init.html }" ); cmd( "$w configure -state disabled" ); if ( set_focus == 1 ) cmd( "focus $initial_focus; $initial_focus selection range 0 end" ); cmd( "bind .ini <KeyPress-Escape> {set choice 1}" ); cmd( "bind .ini <F1> { LsdHelp menudata_init.html }" ); // show overflow warning just once per configuration but always indicate if ( colOvflw ) { cmd( ".ini.st.err conf -text \"OBJECTS NOT SHOWN! (> %d)\" -fg red", MAX_COLS ); if ( ! iniShowOnce ) { cmd( "update; tk_messageBox -parent .ini -type ok -title Warning -icon warning -message \"Too many objects to edit\" -detail \"LSD Initial Values editor can show only the first %d objects' values. Please use the 'Set All' button to define values for objects beyond those.\" ", MAX_COLS ); iniShowOnce = true; } } noredraw: cmd( "if $autoWidth { resizetop .ini [ expr ( 40 + %d * ( $cwidth + 1 ) ) * [ font measure TkTextFont -displayof .ini 0 ] ] }", counter ); // editor main command loop while ( ! *choice ) { try { Tcl_DoOneEvent( 0 ); } catch ( bad_alloc& ) // raise memory problems { throw; } catch ( ... ) // ignore the rest { goto noredraw; } } // handle both resizing event and block object # setting while editing initial values if ( *choice == 5 || ( *choice == 4 && in_set_obj ) ) // avoid recursion { *choice = 0; goto noredraw; } // clean up strcpy( ch, "" ); i = 0; clean_cell( root, ch, obj_name ); cmd( "destroy .ini.b .ini.boh .ini.msg .ini.st" ); if ( *choice == 2 ) { l = ( char * ) Tcl_GetVar( inter, "var-S-A", 0 ); strcpy( ch, l ); *choice = 2; // set data editor window parent set_all( choice, first, ch, lag ); cmd( "bind .ini <KeyPress-Return> {}" ); *choice = 0; } if ( *choice ==4 ) { *choice = 0; set_obj_number( root, choice ); *choice = 0; } } in_edit_data = false; Tcl_UnlinkVar( inter, "lag"); }
/* ** This routine sets entries in the global ::sqlite_options() array variable ** according to the compile-time configuration of the database. Test ** procedures use this to determine when tests should be omitted. */ static void set_options(Tcl_Interp *interp){ #ifdef SQLITE_32BIT_ROWID Tcl_SetVar2(interp, "sqlite_options", "rowid32", "1", TCL_GLOBAL_ONLY); #else Tcl_SetVar2(interp, "sqlite_options", "rowid32", "0", TCL_GLOBAL_ONLY); #endif #ifdef SQLITE_CASE_SENSITIVE_LIKE Tcl_SetVar2(interp, "sqlite_options","casesensitivelike","1",TCL_GLOBAL_ONLY); #else Tcl_SetVar2(interp, "sqlite_options","casesensitivelike","0",TCL_GLOBAL_ONLY); #endif #ifdef SQLITE_DEBUG Tcl_SetVar2(interp, "sqlite_options", "debug", "1", TCL_GLOBAL_ONLY); #else Tcl_SetVar2(interp, "sqlite_options", "debug", "0", TCL_GLOBAL_ONLY); #endif #ifdef SQLITE_DIRECT_OVERFLOW_READ Tcl_SetVar2(interp, "sqlite_options", "direct_read", "1", TCL_GLOBAL_ONLY); #else Tcl_SetVar2(interp, "sqlite_options", "direct_read", "0", TCL_GLOBAL_ONLY); #endif #ifdef SQLITE_DISABLE_DIRSYNC Tcl_SetVar2(interp, "sqlite_options", "dirsync", "0", TCL_GLOBAL_ONLY); #else Tcl_SetVar2(interp, "sqlite_options", "dirsync", "1", TCL_GLOBAL_ONLY); #endif #ifdef SQLITE_DISABLE_LFS Tcl_SetVar2(interp, "sqlite_options", "lfs", "0", TCL_GLOBAL_ONLY); #else Tcl_SetVar2(interp, "sqlite_options", "lfs", "1", TCL_GLOBAL_ONLY); #endif #if 1 /* def SQLITE_MEMDEBUG */ Tcl_SetVar2(interp, "sqlite_options", "memdebug", "1", TCL_GLOBAL_ONLY); #else Tcl_SetVar2(interp, "sqlite_options", "memdebug", "0", TCL_GLOBAL_ONLY); #endif #ifdef SQLITE_ENABLE_8_3_NAMES Tcl_SetVar2(interp, "sqlite_options", "8_3_names", "1", TCL_GLOBAL_ONLY); #else Tcl_SetVar2(interp, "sqlite_options", "8_3_names", "0", TCL_GLOBAL_ONLY); #endif #ifdef SQLITE_ENABLE_MEMSYS3 Tcl_SetVar2(interp, "sqlite_options", "mem3", "1", TCL_GLOBAL_ONLY); #else Tcl_SetVar2(interp, "sqlite_options", "mem3", "0", TCL_GLOBAL_ONLY); #endif #ifdef SQLITE_ENABLE_MEMSYS5 Tcl_SetVar2(interp, "sqlite_options", "mem5", "1", TCL_GLOBAL_ONLY); #else Tcl_SetVar2(interp, "sqlite_options", "mem5", "0", TCL_GLOBAL_ONLY); #endif #ifdef SQLITE_MUTEX_OMIT Tcl_SetVar2(interp, "sqlite_options", "mutex", "0", TCL_GLOBAL_ONLY); #else Tcl_SetVar2(interp, "sqlite_options", "mutex", "1", TCL_GLOBAL_ONLY); #endif #ifdef SQLITE_MUTEX_NOOP Tcl_SetVar2(interp, "sqlite_options", "mutex_noop", "1", TCL_GLOBAL_ONLY); #else Tcl_SetVar2(interp, "sqlite_options", "mutex_noop", "0", TCL_GLOBAL_ONLY); #endif #ifdef SQLITE_OMIT_ALTERTABLE Tcl_SetVar2(interp, "sqlite_options", "altertable", "0", TCL_GLOBAL_ONLY); #else Tcl_SetVar2(interp, "sqlite_options", "altertable", "1", TCL_GLOBAL_ONLY); #endif #ifdef SQLITE_OMIT_ANALYZE Tcl_SetVar2(interp, "sqlite_options", "analyze", "0", TCL_GLOBAL_ONLY); #else Tcl_SetVar2(interp, "sqlite_options", "analyze", "1", TCL_GLOBAL_ONLY); #endif #ifdef SQLITE_ENABLE_ATOMIC_WRITE Tcl_SetVar2(interp, "sqlite_options", "atomicwrite", "1", TCL_GLOBAL_ONLY); #else Tcl_SetVar2(interp, "sqlite_options", "atomicwrite", "0", TCL_GLOBAL_ONLY); #endif #ifdef SQLITE_OMIT_ATTACH Tcl_SetVar2(interp, "sqlite_options", "attach", "0", TCL_GLOBAL_ONLY); #else Tcl_SetVar2(interp, "sqlite_options", "attach", "1", TCL_GLOBAL_ONLY); #endif #ifdef SQLITE_OMIT_AUTHORIZATION Tcl_SetVar2(interp, "sqlite_options", "auth", "0", TCL_GLOBAL_ONLY); #else Tcl_SetVar2(interp, "sqlite_options", "auth", "1", TCL_GLOBAL_ONLY); #endif #ifdef SQLITE_OMIT_AUTOINCREMENT Tcl_SetVar2(interp, "sqlite_options", "autoinc", "0", TCL_GLOBAL_ONLY); #else Tcl_SetVar2(interp, "sqlite_options", "autoinc", "1", TCL_GLOBAL_ONLY); #endif #ifdef SQLITE_OMIT_AUTOMATIC_INDEX Tcl_SetVar2(interp, "sqlite_options", "autoindex", "0", TCL_GLOBAL_ONLY); #else Tcl_SetVar2(interp, "sqlite_options", "autoindex", "1", TCL_GLOBAL_ONLY); #endif #ifdef SQLITE_OMIT_AUTORESET Tcl_SetVar2(interp, "sqlite_options", "autoreset", "0", TCL_GLOBAL_ONLY); #else Tcl_SetVar2(interp, "sqlite_options", "autoreset", "1", TCL_GLOBAL_ONLY); #endif #ifdef SQLITE_OMIT_AUTOVACUUM Tcl_SetVar2(interp, "sqlite_options", "autovacuum", "0", TCL_GLOBAL_ONLY); #else Tcl_SetVar2(interp, "sqlite_options", "autovacuum", "1", TCL_GLOBAL_ONLY); #endif /* SQLITE_OMIT_AUTOVACUUM */ #if !defined(SQLITE_DEFAULT_AUTOVACUUM) Tcl_SetVar2(interp,"sqlite_options","default_autovacuum","0",TCL_GLOBAL_ONLY); #else Tcl_SetVar2(interp, "sqlite_options", "default_autovacuum", STRINGVALUE(SQLITE_DEFAULT_AUTOVACUUM), TCL_GLOBAL_ONLY); #endif #ifdef SQLITE_OMIT_BETWEEN_OPTIMIZATION Tcl_SetVar2(interp, "sqlite_options", "between_opt", "0", TCL_GLOBAL_ONLY); #else Tcl_SetVar2(interp, "sqlite_options", "between_opt", "1", TCL_GLOBAL_ONLY); #endif #ifdef SQLITE_OMIT_BUILTIN_TEST Tcl_SetVar2(interp, "sqlite_options", "builtin_test", "0", TCL_GLOBAL_ONLY); #else Tcl_SetVar2(interp, "sqlite_options", "builtin_test", "1", TCL_GLOBAL_ONLY); #endif #ifdef SQLITE_OMIT_BLOB_LITERAL Tcl_SetVar2(interp, "sqlite_options", "bloblit", "0", TCL_GLOBAL_ONLY); #else Tcl_SetVar2(interp, "sqlite_options", "bloblit", "1", TCL_GLOBAL_ONLY); #endif #ifdef SQLITE_OMIT_CAST Tcl_SetVar2(interp, "sqlite_options", "cast", "0", TCL_GLOBAL_ONLY); #else Tcl_SetVar2(interp, "sqlite_options", "cast", "1", TCL_GLOBAL_ONLY); #endif #ifdef SQLITE_OMIT_CHECK Tcl_SetVar2(interp, "sqlite_options", "check", "0", TCL_GLOBAL_ONLY); #else Tcl_SetVar2(interp, "sqlite_options", "check", "1", TCL_GLOBAL_ONLY); #endif #ifdef SQLITE_ENABLE_COLUMN_METADATA Tcl_SetVar2(interp, "sqlite_options", "columnmetadata", "1", TCL_GLOBAL_ONLY); #else Tcl_SetVar2(interp, "sqlite_options", "columnmetadata", "0", TCL_GLOBAL_ONLY); #endif #ifdef SQLITE_ENABLE_OVERSIZE_CELL_CHECK Tcl_SetVar2(interp, "sqlite_options", "oversize_cell_check", "1", TCL_GLOBAL_ONLY); #else Tcl_SetVar2(interp, "sqlite_options", "oversize_cell_check", "0", TCL_GLOBAL_ONLY); #endif #ifdef SQLITE_OMIT_COMPILEOPTION_DIAGS Tcl_SetVar2(interp, "sqlite_options", "compileoption_diags", "0", TCL_GLOBAL_ONLY); #else Tcl_SetVar2(interp, "sqlite_options", "compileoption_diags", "1", TCL_GLOBAL_ONLY); #endif #ifdef SQLITE_OMIT_COMPLETE Tcl_SetVar2(interp, "sqlite_options", "complete", "0", TCL_GLOBAL_ONLY); #else Tcl_SetVar2(interp, "sqlite_options", "complete", "1", TCL_GLOBAL_ONLY); #endif #ifdef SQLITE_OMIT_COMPOUND_SELECT Tcl_SetVar2(interp, "sqlite_options", "compound", "0", TCL_GLOBAL_ONLY); #else Tcl_SetVar2(interp, "sqlite_options", "compound", "1", TCL_GLOBAL_ONLY); #endif Tcl_SetVar2(interp, "sqlite_options", "conflict", "1", TCL_GLOBAL_ONLY); #if SQLITE_OS_UNIX Tcl_SetVar2(interp, "sqlite_options", "crashtest", "1", TCL_GLOBAL_ONLY); #else Tcl_SetVar2(interp, "sqlite_options", "crashtest", "0", TCL_GLOBAL_ONLY); #endif #ifdef SQLITE_OMIT_DATETIME_FUNCS Tcl_SetVar2(interp, "sqlite_options", "datetime", "0", TCL_GLOBAL_ONLY); #else Tcl_SetVar2(interp, "sqlite_options", "datetime", "1", TCL_GLOBAL_ONLY); #endif #ifdef SQLITE_OMIT_DECLTYPE Tcl_SetVar2(interp, "sqlite_options", "decltype", "0", TCL_GLOBAL_ONLY); #else Tcl_SetVar2(interp, "sqlite_options", "decltype", "1", TCL_GLOBAL_ONLY); #endif #ifdef SQLITE_OMIT_DEPRECATED Tcl_SetVar2(interp, "sqlite_options", "deprecated", "0", TCL_GLOBAL_ONLY); #else Tcl_SetVar2(interp, "sqlite_options", "deprecated", "1", TCL_GLOBAL_ONLY); #endif #ifdef SQLITE_OMIT_DISKIO Tcl_SetVar2(interp, "sqlite_options", "diskio", "0", TCL_GLOBAL_ONLY); #else Tcl_SetVar2(interp, "sqlite_options", "diskio", "1", TCL_GLOBAL_ONLY); #endif #ifdef SQLITE_OMIT_EXPLAIN Tcl_SetVar2(interp, "sqlite_options", "explain", "0", TCL_GLOBAL_ONLY); #else Tcl_SetVar2(interp, "sqlite_options", "explain", "1", TCL_GLOBAL_ONLY); #endif #ifdef SQLITE_OMIT_FLOATING_POINT Tcl_SetVar2(interp, "sqlite_options", "floatingpoint", "0", TCL_GLOBAL_ONLY); #else Tcl_SetVar2(interp, "sqlite_options", "floatingpoint", "1", TCL_GLOBAL_ONLY); #endif #ifdef SQLITE_OMIT_FOREIGN_KEY Tcl_SetVar2(interp, "sqlite_options", "foreignkey", "0", TCL_GLOBAL_ONLY); #else Tcl_SetVar2(interp, "sqlite_options", "foreignkey", "1", TCL_GLOBAL_ONLY); #endif #ifdef SQLITE_ENABLE_FTS1 Tcl_SetVar2(interp, "sqlite_options", "fts1", "1", TCL_GLOBAL_ONLY); #else Tcl_SetVar2(interp, "sqlite_options", "fts1", "0", TCL_GLOBAL_ONLY); #endif #ifdef SQLITE_ENABLE_FTS2 Tcl_SetVar2(interp, "sqlite_options", "fts2", "1", TCL_GLOBAL_ONLY); #else Tcl_SetVar2(interp, "sqlite_options", "fts2", "0", TCL_GLOBAL_ONLY); #endif #ifdef SQLITE_ENABLE_FTS3 Tcl_SetVar2(interp, "sqlite_options", "fts3", "1", TCL_GLOBAL_ONLY); #else Tcl_SetVar2(interp, "sqlite_options", "fts3", "0", TCL_GLOBAL_ONLY); #endif #ifdef SQLITE_OMIT_GET_TABLE Tcl_SetVar2(interp, "sqlite_options", "gettable", "0", TCL_GLOBAL_ONLY); #else Tcl_SetVar2(interp, "sqlite_options", "gettable", "1", TCL_GLOBAL_ONLY); #endif #ifdef SQLITE_ENABLE_ICU Tcl_SetVar2(interp, "sqlite_options", "icu", "1", TCL_GLOBAL_ONLY); #else Tcl_SetVar2(interp, "sqlite_options", "icu", "0", TCL_GLOBAL_ONLY); #endif #ifdef SQLITE_OMIT_INCRBLOB Tcl_SetVar2(interp, "sqlite_options", "incrblob", "0", TCL_GLOBAL_ONLY); #else Tcl_SetVar2(interp, "sqlite_options", "incrblob", "1", TCL_GLOBAL_ONLY); #endif /* SQLITE_OMIT_AUTOVACUUM */ #ifdef SQLITE_OMIT_INTEGRITY_CHECK Tcl_SetVar2(interp, "sqlite_options", "integrityck", "0", TCL_GLOBAL_ONLY); #else Tcl_SetVar2(interp, "sqlite_options", "integrityck", "1", TCL_GLOBAL_ONLY); #endif #if defined(SQLITE_DEFAULT_FILE_FORMAT) && SQLITE_DEFAULT_FILE_FORMAT==1 Tcl_SetVar2(interp, "sqlite_options", "legacyformat", "1", TCL_GLOBAL_ONLY); #else Tcl_SetVar2(interp, "sqlite_options", "legacyformat", "0", TCL_GLOBAL_ONLY); #endif #ifdef SQLITE_OMIT_LIKE_OPTIMIZATION Tcl_SetVar2(interp, "sqlite_options", "like_opt", "0", TCL_GLOBAL_ONLY); #else Tcl_SetVar2(interp, "sqlite_options", "like_opt", "1", TCL_GLOBAL_ONLY); #endif #ifdef SQLITE_OMIT_LOAD_EXTENSION Tcl_SetVar2(interp, "sqlite_options", "load_ext", "0", TCL_GLOBAL_ONLY); #else Tcl_SetVar2(interp, "sqlite_options", "load_ext", "1", TCL_GLOBAL_ONLY); #endif #ifdef SQLITE_OMIT_LOCALTIME Tcl_SetVar2(interp, "sqlite_options", "localtime", "0", TCL_GLOBAL_ONLY); #else Tcl_SetVar2(interp, "sqlite_options", "localtime", "1", TCL_GLOBAL_ONLY); #endif #ifdef SQLITE_OMIT_LOOKASIDE Tcl_SetVar2(interp, "sqlite_options", "lookaside", "0", TCL_GLOBAL_ONLY); #else Tcl_SetVar2(interp, "sqlite_options", "lookaside", "1", TCL_GLOBAL_ONLY); #endif Tcl_SetVar2(interp, "sqlite_options", "long_double", sizeof(LONGDOUBLE_TYPE)>sizeof(double) ? "1" : "0", TCL_GLOBAL_ONLY); #ifdef SQLITE_OMIT_MEMORYDB Tcl_SetVar2(interp, "sqlite_options", "memorydb", "0", TCL_GLOBAL_ONLY); #else Tcl_SetVar2(interp, "sqlite_options", "memorydb", "1", TCL_GLOBAL_ONLY); #endif #ifdef SQLITE_ENABLE_MEMORY_MANAGEMENT Tcl_SetVar2(interp, "sqlite_options", "memorymanage", "1", TCL_GLOBAL_ONLY); #else Tcl_SetVar2(interp, "sqlite_options", "memorymanage", "0", TCL_GLOBAL_ONLY); #endif #ifdef SQLITE_OMIT_MERGE_SORT Tcl_SetVar2(interp, "sqlite_options", "mergesort", "0", TCL_GLOBAL_ONLY); #else Tcl_SetVar2(interp, "sqlite_options", "mergesort", "1", TCL_GLOBAL_ONLY); #endif #ifdef SQLITE_OMIT_OR_OPTIMIZATION Tcl_SetVar2(interp, "sqlite_options", "or_opt", "0", TCL_GLOBAL_ONLY); #else Tcl_SetVar2(interp, "sqlite_options", "or_opt", "1", TCL_GLOBAL_ONLY); #endif #ifdef SQLITE_OMIT_PAGER_PRAGMAS Tcl_SetVar2(interp, "sqlite_options", "pager_pragmas", "0", TCL_GLOBAL_ONLY); #else Tcl_SetVar2(interp, "sqlite_options", "pager_pragmas", "1", TCL_GLOBAL_ONLY); #endif #if defined(SQLITE_OMIT_PRAGMA) || defined(SQLITE_OMIT_FLAG_PRAGMAS) Tcl_SetVar2(interp, "sqlite_options", "pragma", "0", TCL_GLOBAL_ONLY); Tcl_SetVar2(interp, "sqlite_options", "integrityck", "0", TCL_GLOBAL_ONLY); #else Tcl_SetVar2(interp, "sqlite_options", "pragma", "1", TCL_GLOBAL_ONLY); #endif #ifdef SQLITE_OMIT_PROGRESS_CALLBACK Tcl_SetVar2(interp, "sqlite_options", "progress", "0", TCL_GLOBAL_ONLY); #else Tcl_SetVar2(interp, "sqlite_options", "progress", "1", TCL_GLOBAL_ONLY); #endif #ifdef SQLITE_OMIT_REINDEX Tcl_SetVar2(interp, "sqlite_options", "reindex", "0", TCL_GLOBAL_ONLY); #else Tcl_SetVar2(interp, "sqlite_options", "reindex", "1", TCL_GLOBAL_ONLY); #endif #ifdef SQLITE_ENABLE_RTREE Tcl_SetVar2(interp, "sqlite_options", "rtree", "1", TCL_GLOBAL_ONLY); #else Tcl_SetVar2(interp, "sqlite_options", "rtree", "0", TCL_GLOBAL_ONLY); #endif #ifdef SQLITE_OMIT_SCHEMA_PRAGMAS Tcl_SetVar2(interp, "sqlite_options", "schema_pragmas", "0", TCL_GLOBAL_ONLY); #else Tcl_SetVar2(interp, "sqlite_options", "schema_pragmas", "1", TCL_GLOBAL_ONLY); #endif #ifdef SQLITE_OMIT_SCHEMA_VERSION_PRAGMAS Tcl_SetVar2(interp, "sqlite_options", "schema_version", "0", TCL_GLOBAL_ONLY); #else Tcl_SetVar2(interp, "sqlite_options", "schema_version", "1", TCL_GLOBAL_ONLY); #endif #ifdef SQLITE_ENABLE_STAT3 Tcl_SetVar2(interp, "sqlite_options", "stat3", "1", TCL_GLOBAL_ONLY); #else Tcl_SetVar2(interp, "sqlite_options", "stat3", "0", TCL_GLOBAL_ONLY); #endif #if !defined(SQLITE_ENABLE_LOCKING_STYLE) # if defined(__APPLE__) # define SQLITE_ENABLE_LOCKING_STYLE 1 # else # define SQLITE_ENABLE_LOCKING_STYLE 0 # endif #endif #if SQLITE_ENABLE_LOCKING_STYLE && defined(__APPLE__) Tcl_SetVar2(interp,"sqlite_options","lock_proxy_pragmas","1",TCL_GLOBAL_ONLY); #else Tcl_SetVar2(interp,"sqlite_options","lock_proxy_pragmas","0",TCL_GLOBAL_ONLY); #endif #if defined(SQLITE_PREFER_PROXY_LOCKING) && defined(__APPLE__) Tcl_SetVar2(interp,"sqlite_options","prefer_proxy_locking","1",TCL_GLOBAL_ONLY); #else Tcl_SetVar2(interp,"sqlite_options","prefer_proxy_locking","0",TCL_GLOBAL_ONLY); #endif #ifdef SQLITE_OMIT_SHARED_CACHE Tcl_SetVar2(interp, "sqlite_options", "shared_cache", "0", TCL_GLOBAL_ONLY); #else Tcl_SetVar2(interp, "sqlite_options", "shared_cache", "1", TCL_GLOBAL_ONLY); #endif #ifdef SQLITE_OMIT_SUBQUERY Tcl_SetVar2(interp, "sqlite_options", "subquery", "0", TCL_GLOBAL_ONLY); #else Tcl_SetVar2(interp, "sqlite_options", "subquery", "1", TCL_GLOBAL_ONLY); #endif #ifdef SQLITE_OMIT_TCL_VARIABLE Tcl_SetVar2(interp, "sqlite_options", "tclvar", "0", TCL_GLOBAL_ONLY); #else Tcl_SetVar2(interp, "sqlite_options", "tclvar", "1", TCL_GLOBAL_ONLY); #endif Tcl_SetVar2(interp, "sqlite_options", "threadsafe", STRINGVALUE(SQLITE_THREADSAFE), TCL_GLOBAL_ONLY); assert( sqlite3_threadsafe()==SQLITE_THREADSAFE ); #ifdef SQLITE_OMIT_TEMPDB Tcl_SetVar2(interp, "sqlite_options", "tempdb", "0", TCL_GLOBAL_ONLY); #else Tcl_SetVar2(interp, "sqlite_options", "tempdb", "1", TCL_GLOBAL_ONLY); #endif #ifdef SQLITE_OMIT_TRACE Tcl_SetVar2(interp, "sqlite_options", "trace", "0", TCL_GLOBAL_ONLY); #else Tcl_SetVar2(interp, "sqlite_options", "trace", "1", TCL_GLOBAL_ONLY); #endif #ifdef SQLITE_OMIT_TRIGGER Tcl_SetVar2(interp, "sqlite_options", "trigger", "0", TCL_GLOBAL_ONLY); #else Tcl_SetVar2(interp, "sqlite_options", "trigger", "1", TCL_GLOBAL_ONLY); #endif #ifdef SQLITE_OMIT_TRUNCATE_OPTIMIZATION Tcl_SetVar2(interp, "sqlite_options", "truncate_opt", "0", TCL_GLOBAL_ONLY); #else Tcl_SetVar2(interp, "sqlite_options", "truncate_opt", "1", TCL_GLOBAL_ONLY); #endif #ifdef SQLITE_OMIT_UTF16 Tcl_SetVar2(interp, "sqlite_options", "utf16", "0", TCL_GLOBAL_ONLY); #else Tcl_SetVar2(interp, "sqlite_options", "utf16", "1", TCL_GLOBAL_ONLY); #endif #if defined(SQLITE_OMIT_VACUUM) || defined(SQLITE_OMIT_ATTACH) Tcl_SetVar2(interp, "sqlite_options", "vacuum", "0", TCL_GLOBAL_ONLY); #else Tcl_SetVar2(interp, "sqlite_options", "vacuum", "1", TCL_GLOBAL_ONLY); #endif #ifdef SQLITE_OMIT_VIEW Tcl_SetVar2(interp, "sqlite_options", "view", "0", TCL_GLOBAL_ONLY); #else Tcl_SetVar2(interp, "sqlite_options", "view", "1", TCL_GLOBAL_ONLY); #endif #ifdef SQLITE_OMIT_VIRTUALTABLE Tcl_SetVar2(interp, "sqlite_options", "vtab", "0", TCL_GLOBAL_ONLY); #else Tcl_SetVar2(interp, "sqlite_options", "vtab", "1", TCL_GLOBAL_ONLY); #endif #ifdef SQLITE_OMIT_WAL Tcl_SetVar2(interp, "sqlite_options", "wal", "0", TCL_GLOBAL_ONLY); #else Tcl_SetVar2(interp, "sqlite_options", "wal", "1", TCL_GLOBAL_ONLY); #endif #ifdef SQLITE_OMIT_WSD Tcl_SetVar2(interp, "sqlite_options", "wsd", "0", TCL_GLOBAL_ONLY); #else Tcl_SetVar2(interp, "sqlite_options", "wsd", "1", TCL_GLOBAL_ONLY); #endif #if defined(SQLITE_ENABLE_UPDATE_DELETE_LIMIT) && !defined(SQLITE_OMIT_SUBQUERY) Tcl_SetVar2(interp, "sqlite_options", "update_delete_limit", "1", TCL_GLOBAL_ONLY); #else Tcl_SetVar2(interp, "sqlite_options", "update_delete_limit", "0", TCL_GLOBAL_ONLY); #endif #if defined(SQLITE_ENABLE_UNLOCK_NOTIFY) Tcl_SetVar2(interp, "sqlite_options", "unlock_notify", "1", TCL_GLOBAL_ONLY); #else Tcl_SetVar2(interp, "sqlite_options", "unlock_notify", "0", TCL_GLOBAL_ONLY); #endif #ifdef SQLITE_SECURE_DELETE Tcl_SetVar2(interp, "sqlite_options", "secure_delete", "1", TCL_GLOBAL_ONLY); #else Tcl_SetVar2(interp, "sqlite_options", "secure_delete", "0", TCL_GLOBAL_ONLY); #endif #ifdef SQLITE_MULTIPLEX_EXT_OVWR Tcl_SetVar2(interp, "sqlite_options", "multiplex_ext_overwrite", "1", TCL_GLOBAL_ONLY); #else Tcl_SetVar2(interp, "sqlite_options", "multiplex_ext_overwrite", "0", TCL_GLOBAL_ONLY); #endif #ifdef YYTRACKMAXSTACKDEPTH Tcl_SetVar2(interp, "sqlite_options", "yytrackmaxstackdepth", "1", TCL_GLOBAL_ONLY); #else Tcl_SetVar2(interp, "sqlite_options", "yytrackmaxstackdepth", "0", TCL_GLOBAL_ONLY); #endif #define LINKVAR(x) { \ static const int cv_ ## x = SQLITE_ ## x; \ Tcl_LinkVar(interp, "SQLITE_" #x, (char *)&(cv_ ## x), \ TCL_LINK_INT | TCL_LINK_READ_ONLY); } LINKVAR( MAX_LENGTH ); LINKVAR( MAX_COLUMN ); LINKVAR( MAX_SQL_LENGTH ); LINKVAR( MAX_EXPR_DEPTH ); LINKVAR( MAX_COMPOUND_SELECT ); LINKVAR( MAX_VDBE_OP ); LINKVAR( MAX_FUNCTION_ARG ); LINKVAR( MAX_VARIABLE_NUMBER ); LINKVAR( MAX_PAGE_SIZE ); LINKVAR( MAX_PAGE_COUNT ); LINKVAR( MAX_LIKE_PATTERN_LENGTH ); LINKVAR( MAX_TRIGGER_DEPTH ); LINKVAR( DEFAULT_TEMP_CACHE_SIZE ); LINKVAR( DEFAULT_CACHE_SIZE ); LINKVAR( DEFAULT_PAGE_SIZE ); LINKVAR( DEFAULT_FILE_FORMAT ); LINKVAR( MAX_ATTACHED ); LINKVAR( MAX_DEFAULT_PAGE_SIZE ); { static const int cv_TEMP_STORE = SQLITE_TEMP_STORE; Tcl_LinkVar(interp, "TEMP_STORE", (char *)&(cv_TEMP_STORE), TCL_LINK_INT | TCL_LINK_READ_ONLY); } }
int Twapi_base_Init(Tcl_Interp *interp) { TwapiInterpContext *ticP; HRESULT hr; /* IMPORTANT */ /* MUST BE FIRST CALL as it initializes Tcl stubs - should this be the done for EVERY interp creation or move into one-time above ? TBD */ /* TBD dgp says this #ifdef USE_TCL_STUBS is not needed and indeed that seems to be the case for Tcl_InitStubs. But Tcl_TomMath_InitStubs crashes on a static build not using stubs */ #ifdef USE_TCL_STUBS if (Tcl_InitStubs(interp, TCL_VERSION, 0) == NULL) { return TCL_ERROR; } if (Tcl_TomMath_InitStubs(interp, 0) == NULL) { return TCL_ERROR; } #endif /* Init unless already done. */ if (! TwapiDoOneTimeInit(&gTwapiInitialized, TwapiOneTimeInit, interp)) return TCL_ERROR; /* NOTE: no point setting Tcl_SetResult for errors as they are not looked at when DLL is being loaded */ /* * Per interp initialization */ if (TwapiTlsInit() != TCL_OK) return TCL_ERROR; /* * Single-threaded COM model - note some Shell extensions * require this if functions such as ShellExecute are * invoked. TBD - should we do this lazily in com and mstask modules ? * * TBD - recent MSDN docs states: * "Avoid the COM single-threaded apartment model, as it is incompatible * with the thread pool. STA creates thread state which can affect the * next work item for the thread. STA is generally long-lived and has * thread affinity, which is the opposite of the thread pool." * Since we use thread pools, does this mean we should not be * using STA? Or does that only apply when making COM calls from * a thread pool thread in which case it would not apply to us? */ hr = CoInitializeEx( NULL, COINIT_APARTMENTTHREADED | COINIT_DISABLE_OLE1DDE); if (hr != S_OK && hr != S_FALSE) return TCL_ERROR; /* Create the name space and some variables. Not sure if this is explicitly needed */ Tcl_CreateNamespace(interp, "::twapi", NULL, NULL); Tcl_SetVar2(interp, "::twapi::version", MODULENAME, MODULEVERSION, 0); Tcl_SetVar2(interp, "::twapi::settings", "log_limit", "100", 0); Tcl_LinkVar(interp, "::twapi::settings(use_unicode_obj)", (char *)&gBaseSettings.use_unicode_obj, TCL_LINK_ULONG); /* Allocate a context that will be passed around in all interpreters */ ticP = TwapiRegisterModule(interp, gTwapiModuleHandle, &gBaseModule, NEW_TIC); if (ticP == NULL) return TCL_ERROR; ticP->module.data.pval = TwapiAlloc(sizeof(TwapiBaseSpecificContext)); /* Cache of commonly used objects */ Tcl_InitHashTable(&BASE_CONTEXT(ticP)->atoms, TCL_STRING_KEYS); /* Pointer registration table */ Tcl_InitHashTable(&BASE_CONTEXT(ticP)->pointers, TCL_ONE_WORD_KEYS); /* Trap stack */ BASE_CONTEXT(ticP)->trapstack = ObjNewList(0, NULL); ObjIncrRefs(BASE_CONTEXT(ticP)->trapstack); Tcl_CallWhenDeleted(interp, Twapi_InterpCleanup, NULL); return TwapiLoadStaticModules(interp); }
/* ** This routine sets entries in the global ::sqlite_options() array variable ** according to the compile-time configuration of the database. Test ** procedures use this to determine when tests should be omitted. */ static void set_options(Tcl_Interp *interp){ #ifdef SQLITE_32BIT_ROWID Tcl_SetVar2(interp, "sqlite_options", "rowid32", "1", TCL_GLOBAL_ONLY); #else Tcl_SetVar2(interp, "sqlite_options", "rowid32", "0", TCL_GLOBAL_ONLY); #endif #ifdef SQLITE_CASE_SENSITIVE_LIKE Tcl_SetVar2(interp, "sqlite_options","casesensitivelike","1",TCL_GLOBAL_ONLY); #else Tcl_SetVar2(interp, "sqlite_options","casesensitivelike","0",TCL_GLOBAL_ONLY); #endif #ifdef SQLITE_DEBUG Tcl_SetVar2(interp, "sqlite_options", "debug", "1", TCL_GLOBAL_ONLY); #else Tcl_SetVar2(interp, "sqlite_options", "debug", "0", TCL_GLOBAL_ONLY); #endif #ifdef SQLITE_DISABLE_DIRSYNC Tcl_SetVar2(interp, "sqlite_options", "dirsync", "0", TCL_GLOBAL_ONLY); #else Tcl_SetVar2(interp, "sqlite_options", "dirsync", "1", TCL_GLOBAL_ONLY); #endif #ifdef SQLITE_DISABLE_LFS Tcl_SetVar2(interp, "sqlite_options", "lfs", "0", TCL_GLOBAL_ONLY); #else Tcl_SetVar2(interp, "sqlite_options", "lfs", "1", TCL_GLOBAL_ONLY); #endif #ifdef SQLITE_OMIT_ALTERTABLE Tcl_SetVar2(interp, "sqlite_options", "altertable", "0", TCL_GLOBAL_ONLY); #else Tcl_SetVar2(interp, "sqlite_options", "altertable", "1", TCL_GLOBAL_ONLY); #endif #ifdef SQLITE_OMIT_ANALYZE Tcl_SetVar2(interp, "sqlite_options", "analyze", "0", TCL_GLOBAL_ONLY); #else Tcl_SetVar2(interp, "sqlite_options", "analyze", "1", TCL_GLOBAL_ONLY); #endif #ifdef SQLITE_OMIT_ATTACH Tcl_SetVar2(interp, "sqlite_options", "attach", "0", TCL_GLOBAL_ONLY); #else Tcl_SetVar2(interp, "sqlite_options", "attach", "1", TCL_GLOBAL_ONLY); #endif #ifdef SQLITE_OMIT_AUTHORIZATION Tcl_SetVar2(interp, "sqlite_options", "auth", "0", TCL_GLOBAL_ONLY); #else Tcl_SetVar2(interp, "sqlite_options", "auth", "1", TCL_GLOBAL_ONLY); #endif #ifdef SQLITE_OMIT_AUTOINCREMENT Tcl_SetVar2(interp, "sqlite_options", "autoinc", "0", TCL_GLOBAL_ONLY); #else Tcl_SetVar2(interp, "sqlite_options", "autoinc", "1", TCL_GLOBAL_ONLY); #endif #ifdef SQLITE_OMIT_AUTOVACUUM Tcl_SetVar2(interp, "sqlite_options", "autovacuum", "0", TCL_GLOBAL_ONLY); #else Tcl_SetVar2(interp, "sqlite_options", "autovacuum", "1", TCL_GLOBAL_ONLY); #endif /* SQLITE_OMIT_AUTOVACUUM */ #if !defined(SQLITE_DEFAULT_AUTOVACUUM) || SQLITE_DEFAULT_AUTOVACUUM==0 Tcl_SetVar2(interp,"sqlite_options","default_autovacuum","0",TCL_GLOBAL_ONLY); #else Tcl_SetVar2(interp,"sqlite_options","default_autovacuum","1",TCL_GLOBAL_ONLY); #endif #ifdef SQLITE_OMIT_BETWEEN_OPTIMIZATION Tcl_SetVar2(interp, "sqlite_options", "between_opt", "0", TCL_GLOBAL_ONLY); #else Tcl_SetVar2(interp, "sqlite_options", "between_opt", "1", TCL_GLOBAL_ONLY); #endif #ifdef SQLITE_OMIT_BLOB_LITERAL Tcl_SetVar2(interp, "sqlite_options", "bloblit", "0", TCL_GLOBAL_ONLY); #else Tcl_SetVar2(interp, "sqlite_options", "bloblit", "1", TCL_GLOBAL_ONLY); #endif #ifdef SQLITE_OMIT_CAST Tcl_SetVar2(interp, "sqlite_options", "cast", "0", TCL_GLOBAL_ONLY); #else Tcl_SetVar2(interp, "sqlite_options", "cast", "1", TCL_GLOBAL_ONLY); #endif #ifdef SQLITE_OMIT_CHECK Tcl_SetVar2(interp, "sqlite_options", "check", "0", TCL_GLOBAL_ONLY); #else Tcl_SetVar2(interp, "sqlite_options", "check", "1", TCL_GLOBAL_ONLY); #endif #ifdef SQLITE_ENABLE_COLUMN_METADATA Tcl_SetVar2(interp, "sqlite_options", "columnmetadata", "1", TCL_GLOBAL_ONLY); #else Tcl_SetVar2(interp, "sqlite_options", "columnmetadata", "0", TCL_GLOBAL_ONLY); #endif #ifdef SQLITE_OMIT_COMPLETE Tcl_SetVar2(interp, "sqlite_options", "complete", "0", TCL_GLOBAL_ONLY); #else Tcl_SetVar2(interp, "sqlite_options", "complete", "1", TCL_GLOBAL_ONLY); #endif #ifdef SQLITE_OMIT_COMPOUND_SELECT Tcl_SetVar2(interp, "sqlite_options", "compound", "0", TCL_GLOBAL_ONLY); #else Tcl_SetVar2(interp, "sqlite_options", "compound", "1", TCL_GLOBAL_ONLY); #endif #ifdef SQLITE_OMIT_CONFLICT_CLAUSE Tcl_SetVar2(interp, "sqlite_options", "conflict", "0", TCL_GLOBAL_ONLY); #else Tcl_SetVar2(interp, "sqlite_options", "conflict", "1", TCL_GLOBAL_ONLY); #endif #if OS_UNIX Tcl_SetVar2(interp, "sqlite_options", "crashtest", "1", TCL_GLOBAL_ONLY); #else Tcl_SetVar2(interp, "sqlite_options", "crashtest", "0", TCL_GLOBAL_ONLY); #endif #ifdef SQLITE_OMIT_DATETIME_FUNCS Tcl_SetVar2(interp, "sqlite_options", "datetime", "0", TCL_GLOBAL_ONLY); #else Tcl_SetVar2(interp, "sqlite_options", "datetime", "1", TCL_GLOBAL_ONLY); #endif #ifdef SQLITE_OMIT_DISKIO Tcl_SetVar2(interp, "sqlite_options", "diskio", "0", TCL_GLOBAL_ONLY); #else Tcl_SetVar2(interp, "sqlite_options", "diskio", "1", TCL_GLOBAL_ONLY); #endif #ifdef SQLITE_OMIT_EXPLAIN Tcl_SetVar2(interp, "sqlite_options", "explain", "0", TCL_GLOBAL_ONLY); #else Tcl_SetVar2(interp, "sqlite_options", "explain", "1", TCL_GLOBAL_ONLY); #endif #ifdef SQLITE_OMIT_FLOATING_POINT Tcl_SetVar2(interp, "sqlite_options", "floatingpoint", "0", TCL_GLOBAL_ONLY); #else Tcl_SetVar2(interp, "sqlite_options", "floatingpoint", "1", TCL_GLOBAL_ONLY); #endif #ifdef SQLITE_OMIT_FOREIGN_KEY Tcl_SetVar2(interp, "sqlite_options", "foreignkey", "0", TCL_GLOBAL_ONLY); #else Tcl_SetVar2(interp, "sqlite_options", "foreignkey", "1", TCL_GLOBAL_ONLY); #endif #ifdef SQLITE_ENABLE_FTS1 Tcl_SetVar2(interp, "sqlite_options", "fts1", "1", TCL_GLOBAL_ONLY); #else Tcl_SetVar2(interp, "sqlite_options", "fts1", "0", TCL_GLOBAL_ONLY); #endif #ifdef SQLITE_ENABLE_FTS2 Tcl_SetVar2(interp, "sqlite_options", "fts2", "1", TCL_GLOBAL_ONLY); #else Tcl_SetVar2(interp, "sqlite_options", "fts2", "0", TCL_GLOBAL_ONLY); #endif #ifdef SQLITE_OMIT_GLOBALRECOVER Tcl_SetVar2(interp, "sqlite_options", "globalrecover", "0", TCL_GLOBAL_ONLY); #else Tcl_SetVar2(interp, "sqlite_options", "globalrecover", "1", TCL_GLOBAL_ONLY); #endif #ifdef SQLITE_ENABLE_ICU Tcl_SetVar2(interp, "sqlite_options", "icu", "1", TCL_GLOBAL_ONLY); #else Tcl_SetVar2(interp, "sqlite_options", "icu", "0", TCL_GLOBAL_ONLY); #endif #ifdef SQLITE_OMIT_INCRBLOB Tcl_SetVar2(interp, "sqlite_options", "incrblob", "0", TCL_GLOBAL_ONLY); #else Tcl_SetVar2(interp, "sqlite_options", "incrblob", "1", TCL_GLOBAL_ONLY); #endif /* SQLITE_OMIT_AUTOVACUUM */ #ifdef SQLITE_OMIT_INTEGRITY_CHECK Tcl_SetVar2(interp, "sqlite_options", "integrityck", "0", TCL_GLOBAL_ONLY); #else Tcl_SetVar2(interp, "sqlite_options", "integrityck", "1", TCL_GLOBAL_ONLY); #endif #if defined(SQLITE_DEFAULT_FILE_FORMAT) && SQLITE_DEFAULT_FILE_FORMAT==1 Tcl_SetVar2(interp, "sqlite_options", "legacyformat", "1", TCL_GLOBAL_ONLY); #else Tcl_SetVar2(interp, "sqlite_options", "legacyformat", "0", TCL_GLOBAL_ONLY); #endif #ifdef SQLITE_OMIT_LIKE_OPTIMIZATION Tcl_SetVar2(interp, "sqlite_options", "like_opt", "0", TCL_GLOBAL_ONLY); #else Tcl_SetVar2(interp, "sqlite_options", "like_opt", "1", TCL_GLOBAL_ONLY); #endif #ifdef SQLITE_OMIT_LOAD_EXTENSION Tcl_SetVar2(interp, "sqlite_options", "load_ext", "0", TCL_GLOBAL_ONLY); #else Tcl_SetVar2(interp, "sqlite_options", "load_ext", "1", TCL_GLOBAL_ONLY); #endif #ifdef SQLITE_OMIT_MEMORYDB Tcl_SetVar2(interp, "sqlite_options", "memorydb", "0", TCL_GLOBAL_ONLY); #else Tcl_SetVar2(interp, "sqlite_options", "memorydb", "1", TCL_GLOBAL_ONLY); #endif #ifdef SQLITE_ENABLE_MEMORY_MANAGEMENT Tcl_SetVar2(interp, "sqlite_options", "memorymanage", "1", TCL_GLOBAL_ONLY); #else Tcl_SetVar2(interp, "sqlite_options", "memorymanage", "0", TCL_GLOBAL_ONLY); #endif #ifdef SQLITE_OMIT_OR_OPTIMIZATION Tcl_SetVar2(interp, "sqlite_options", "or_opt", "0", TCL_GLOBAL_ONLY); #else Tcl_SetVar2(interp, "sqlite_options", "or_opt", "1", TCL_GLOBAL_ONLY); #endif #ifdef SQLITE_OMIT_PAGER_PRAGMAS Tcl_SetVar2(interp, "sqlite_options", "pager_pragmas", "0", TCL_GLOBAL_ONLY); #else Tcl_SetVar2(interp, "sqlite_options", "pager_pragmas", "1", TCL_GLOBAL_ONLY); #endif #ifdef SQLITE_OMIT_PARSER Tcl_SetVar2(interp, "sqlite_options", "parser", "0", TCL_GLOBAL_ONLY); #else Tcl_SetVar2(interp, "sqlite_options", "parser", "1", TCL_GLOBAL_ONLY); #endif #if defined(SQLITE_OMIT_PRAGMA) || defined(SQLITE_OMIT_FLAG_PRAGMAS) Tcl_SetVar2(interp, "sqlite_options", "pragma", "0", TCL_GLOBAL_ONLY); Tcl_SetVar2(interp, "sqlite_options", "integrityck", "0", TCL_GLOBAL_ONLY); #else Tcl_SetVar2(interp, "sqlite_options", "pragma", "1", TCL_GLOBAL_ONLY); #endif #ifdef SQLITE_OMIT_PROGRESS_CALLBACK Tcl_SetVar2(interp, "sqlite_options", "progress", "0", TCL_GLOBAL_ONLY); #else Tcl_SetVar2(interp, "sqlite_options", "progress", "1", TCL_GLOBAL_ONLY); #endif #ifdef SQLITE_ENABLE_REDEF_IO Tcl_SetVar2(interp, "sqlite_options", "redefio", "1", TCL_GLOBAL_ONLY); #else Tcl_SetVar2(interp, "sqlite_options", "redefio", "0", TCL_GLOBAL_ONLY); #endif #ifdef SQLITE_OMIT_REINDEX Tcl_SetVar2(interp, "sqlite_options", "reindex", "0", TCL_GLOBAL_ONLY); #else Tcl_SetVar2(interp, "sqlite_options", "reindex", "1", TCL_GLOBAL_ONLY); #endif #ifdef SQLITE_OMIT_SCHEMA_PRAGMAS Tcl_SetVar2(interp, "sqlite_options", "schema_pragmas", "0", TCL_GLOBAL_ONLY); #else Tcl_SetVar2(interp, "sqlite_options", "schema_pragmas", "1", TCL_GLOBAL_ONLY); #endif #ifdef SQLITE_OMIT_SCHEMA_VERSION_PRAGMAS Tcl_SetVar2(interp, "sqlite_options", "schema_version", "0", TCL_GLOBAL_ONLY); #else Tcl_SetVar2(interp, "sqlite_options", "schema_version", "1", TCL_GLOBAL_ONLY); #endif #ifdef SQLITE_OMIT_SHARED_CACHE Tcl_SetVar2(interp, "sqlite_options", "shared_cache", "0", TCL_GLOBAL_ONLY); #else Tcl_SetVar2(interp, "sqlite_options", "shared_cache", "1", TCL_GLOBAL_ONLY); #endif #ifdef SQLITE_OMIT_SUBQUERY Tcl_SetVar2(interp, "sqlite_options", "subquery", "0", TCL_GLOBAL_ONLY); #else Tcl_SetVar2(interp, "sqlite_options", "subquery", "1", TCL_GLOBAL_ONLY); #endif #ifdef SQLITE_OMIT_TCL_VARIABLE Tcl_SetVar2(interp, "sqlite_options", "tclvar", "0", TCL_GLOBAL_ONLY); #else Tcl_SetVar2(interp, "sqlite_options", "tclvar", "1", TCL_GLOBAL_ONLY); #endif #if defined(THREADSAFE) && THREADSAFE Tcl_SetVar2(interp, "sqlite_options", "threadsafe", "1", TCL_GLOBAL_ONLY); #else Tcl_SetVar2(interp, "sqlite_options", "threadsafe", "0", TCL_GLOBAL_ONLY); #endif #ifdef SQLITE_OMIT_TRACE Tcl_SetVar2(interp, "sqlite_options", "trace", "0", TCL_GLOBAL_ONLY); #else Tcl_SetVar2(interp, "sqlite_options", "trace", "1", TCL_GLOBAL_ONLY); #endif #ifdef SQLITE_OMIT_TRIGGER Tcl_SetVar2(interp, "sqlite_options", "trigger", "0", TCL_GLOBAL_ONLY); #else Tcl_SetVar2(interp, "sqlite_options", "trigger", "1", TCL_GLOBAL_ONLY); #endif #ifdef SQLITE_OMIT_TEMPDB Tcl_SetVar2(interp, "sqlite_options", "tempdb", "0", TCL_GLOBAL_ONLY); #else Tcl_SetVar2(interp, "sqlite_options", "tempdb", "1", TCL_GLOBAL_ONLY); #endif #ifdef SQLITE_OMIT_UTF16 Tcl_SetVar2(interp, "sqlite_options", "utf16", "0", TCL_GLOBAL_ONLY); #else Tcl_SetVar2(interp, "sqlite_options", "utf16", "1", TCL_GLOBAL_ONLY); #endif #if defined(SQLITE_OMIT_VACUUM) || defined(SQLITE_OMIT_ATTACH) Tcl_SetVar2(interp, "sqlite_options", "vacuum", "0", TCL_GLOBAL_ONLY); #else Tcl_SetVar2(interp, "sqlite_options", "vacuum", "1", TCL_GLOBAL_ONLY); #endif #ifdef SQLITE_OMIT_VIEW Tcl_SetVar2(interp, "sqlite_options", "view", "0", TCL_GLOBAL_ONLY); #else Tcl_SetVar2(interp, "sqlite_options", "view", "1", TCL_GLOBAL_ONLY); #endif #ifdef SQLITE_OMIT_VIRTUALTABLE Tcl_SetVar2(interp, "sqlite_options", "vtab", "0", TCL_GLOBAL_ONLY); #else Tcl_SetVar2(interp, "sqlite_options", "vtab", "1", TCL_GLOBAL_ONLY); #endif { static int sqlite_max_length = SQLITE_MAX_LENGTH; Tcl_LinkVar(interp, "SQLITE_MAX_LENGTH", (char*)&sqlite_max_length, TCL_LINK_INT|TCL_LINK_READ_ONLY); } { static int sqlite_max_column = SQLITE_MAX_COLUMN; Tcl_LinkVar(interp, "SQLITE_MAX_COLUMN", (char*)&sqlite_max_column, TCL_LINK_INT|TCL_LINK_READ_ONLY); } { static int sqlite_max_sql_length = SQLITE_MAX_SQL_LENGTH; Tcl_LinkVar(interp, "SQLITE_MAX_SQL_LENGTH", (char*)&sqlite_max_sql_length, TCL_LINK_INT|TCL_LINK_READ_ONLY); } { static int sqlite_max_expr_depth = SQLITE_MAX_EXPR_DEPTH; Tcl_LinkVar(interp, "SQLITE_MAX_EXPR_DEPTH", (char*)&sqlite_max_expr_depth, TCL_LINK_INT|TCL_LINK_READ_ONLY); } { static int sqlite_max_compound_select = SQLITE_MAX_COMPOUND_SELECT; Tcl_LinkVar(interp, "SQLITE_MAX_COMPOUND_SELECT", (char*)&sqlite_max_compound_select, TCL_LINK_INT|TCL_LINK_READ_ONLY); } { static int sqlite_max_vdbe_op = SQLITE_MAX_VDBE_OP; Tcl_LinkVar(interp, "SQLITE_MAX_VDBE_OP", (char*)&sqlite_max_vdbe_op, TCL_LINK_INT|TCL_LINK_READ_ONLY); } { static int sqlite_max_function_arg = SQLITE_MAX_FUNCTION_ARG; Tcl_LinkVar(interp, "SQLITE_MAX_FUNCTION_ARG", (char*)&sqlite_max_function_arg, TCL_LINK_INT|TCL_LINK_READ_ONLY); } { static int sqlite_default_temp_cache_size = SQLITE_DEFAULT_TEMP_CACHE_SIZE; Tcl_LinkVar(interp, "SQLITE_DEFAULT_TEMP_CACHE_SIZE", (char*)&sqlite_default_temp_cache_size, TCL_LINK_INT|TCL_LINK_READ_ONLY); } { static int sqlite_default_cache_size = SQLITE_DEFAULT_CACHE_SIZE; Tcl_LinkVar(interp, "SQLITE_DEFAULT_CACHE_SIZE", (char*)&sqlite_default_cache_size, TCL_LINK_INT|TCL_LINK_READ_ONLY); } { static int sqlite_max_variable_number = SQLITE_MAX_VARIABLE_NUMBER; Tcl_LinkVar(interp, "SQLITE_MAX_VARIABLE_NUMBER", (char*)&sqlite_max_variable_number, TCL_LINK_INT|TCL_LINK_READ_ONLY); } { static int sqlite_default_page_size = SQLITE_DEFAULT_PAGE_SIZE; Tcl_LinkVar(interp, "SQLITE_DEFAULT_PAGE_SIZE", (char*)&sqlite_default_page_size, TCL_LINK_INT|TCL_LINK_READ_ONLY); } { static int sqlite_max_page_size = SQLITE_MAX_PAGE_SIZE; Tcl_LinkVar(interp, "SQLITE_MAX_PAGE_SIZE", (char*)&sqlite_max_page_size, TCL_LINK_INT|TCL_LINK_READ_ONLY); } { static int sqlite_max_page_count = SQLITE_MAX_PAGE_COUNT; Tcl_LinkVar(interp, "SQLITE_MAX_PAGE_COUNT", (char*)&sqlite_max_page_count, TCL_LINK_INT|TCL_LINK_READ_ONLY); } { static int temp_store = TEMP_STORE; Tcl_LinkVar(interp, "TEMP_STORE", (char*)&temp_store, TCL_LINK_INT|TCL_LINK_READ_ONLY); } { static int sqlite_default_file_format = SQLITE_DEFAULT_FILE_FORMAT; Tcl_LinkVar(interp, "SQLITE_DEFAULT_FILE_FORMAT", (char*)&sqlite_default_file_format, TCL_LINK_INT|TCL_LINK_READ_ONLY); } { static int sqlite_max_like_pattern = SQLITE_MAX_LIKE_PATTERN_LENGTH; Tcl_LinkVar(interp, "SQLITE_MAX_LIKE_PATTERN_LENGTH", (char*)&sqlite_max_like_pattern, TCL_LINK_INT|TCL_LINK_READ_ONLY); } { static int sqlite_max_attached = SQLITE_MAX_ATTACHED; Tcl_LinkVar(interp, "SQLITE_MAX_ATTACHED", (char*)&sqlite_max_attached, TCL_LINK_INT|TCL_LINK_READ_ONLY); } }
/* ** This routine sets entries in the global ::sqlite_options() array variable ** according to the compile-time configuration of the database. Test ** procedures use this to determine when tests should be omitted. */ static void set_options(Tcl_Interp *interp){ #if HAVE_MALLOC_USABLE_SIZE Tcl_SetVar2(interp, "sqlite_options", "malloc_usable_size", "1", TCL_GLOBAL_ONLY); #else Tcl_SetVar2(interp, "sqlite_options", "malloc_usable_size", "0", TCL_GLOBAL_ONLY); #endif #ifdef SQLITE_32BIT_ROWID Tcl_SetVar2(interp, "sqlite_options", "rowid32", "1", TCL_GLOBAL_ONLY); #else Tcl_SetVar2(interp, "sqlite_options", "rowid32", "0", TCL_GLOBAL_ONLY); #endif #ifdef SQLITE_CASE_SENSITIVE_LIKE Tcl_SetVar2(interp, "sqlite_options","casesensitivelike","1",TCL_GLOBAL_ONLY); #else Tcl_SetVar2(interp, "sqlite_options","casesensitivelike","0",TCL_GLOBAL_ONLY); #endif #if !SQLITE_OS_WINCE && !SQLITE_OS_WINRT Tcl_SetVar2(interp, "sqlite_options", "curdir", "1", TCL_GLOBAL_ONLY); #else Tcl_SetVar2(interp, "sqlite_options", "curdir", "0", TCL_GLOBAL_ONLY); #endif #ifdef SQLITE_WIN32_MALLOC Tcl_SetVar2(interp, "sqlite_options", "win32malloc", "1", TCL_GLOBAL_ONLY); #else Tcl_SetVar2(interp, "sqlite_options", "win32malloc", "0", TCL_GLOBAL_ONLY); #endif #ifdef SQLITE_DEBUG Tcl_SetVar2(interp, "sqlite_options", "debug", "1", TCL_GLOBAL_ONLY); #else Tcl_SetVar2(interp, "sqlite_options", "debug", "0", TCL_GLOBAL_ONLY); #endif #ifdef SQLITE_DEFAULT_CKPTFULLFSYNC Tcl_SetVar2(interp, "sqlite_options", "default_ckptfullfsync", SQLITE_DEFAULT_CKPTFULLFSYNC ? "1" : "0", TCL_GLOBAL_ONLY); #else Tcl_SetVar2(interp, "sqlite_options", "default_ckptfullfsync", "0", TCL_GLOBAL_ONLY); #endif #ifdef SQLITE_DIRECT_OVERFLOW_READ Tcl_SetVar2(interp, "sqlite_options", "direct_read", "1", TCL_GLOBAL_ONLY); #else Tcl_SetVar2(interp, "sqlite_options", "direct_read", "0", TCL_GLOBAL_ONLY); #endif #ifdef SQLITE_DISABLE_DIRSYNC Tcl_SetVar2(interp, "sqlite_options", "dirsync", "0", TCL_GLOBAL_ONLY); #else Tcl_SetVar2(interp, "sqlite_options", "dirsync", "1", TCL_GLOBAL_ONLY); #endif #ifdef SQLITE_DISABLE_LFS Tcl_SetVar2(interp, "sqlite_options", "lfs", "0", TCL_GLOBAL_ONLY); #else Tcl_SetVar2(interp, "sqlite_options", "lfs", "1", TCL_GLOBAL_ONLY); #endif #ifdef SQLITE_DISABLE_PAGECACHE_OVERFLOW_STATS Tcl_SetVar2(interp, "sqlite_options", "pagecache_overflow_stats","0",TCL_GLOBAL_ONLY); #else Tcl_SetVar2(interp, "sqlite_options", "pagecache_overflow_stats","1",TCL_GLOBAL_ONLY); #endif #if SQLITE_MAX_MMAP_SIZE>0 Tcl_SetVar2(interp, "sqlite_options", "mmap", "1", TCL_GLOBAL_ONLY); #else Tcl_SetVar2(interp, "sqlite_options", "mmap", "0", TCL_GLOBAL_ONLY); #endif Tcl_SetVar2(interp, "sqlite_options", "worker_threads", STRINGVALUE(SQLITE_MAX_WORKER_THREADS), TCL_GLOBAL_ONLY ); #if 1 /* def SQLITE_MEMDEBUG */ Tcl_SetVar2(interp, "sqlite_options", "memdebug", "1", TCL_GLOBAL_ONLY); #else Tcl_SetVar2(interp, "sqlite_options", "memdebug", "0", TCL_GLOBAL_ONLY); #endif #ifdef SQLITE_ENABLE_8_3_NAMES Tcl_SetVar2(interp, "sqlite_options", "8_3_names", "1", TCL_GLOBAL_ONLY); #else Tcl_SetVar2(interp, "sqlite_options", "8_3_names", "0", TCL_GLOBAL_ONLY); #endif #ifdef SQLITE_ENABLE_CURSOR_HINTS Tcl_SetVar2(interp, "sqlite_options", "cursorhints", "1", TCL_GLOBAL_ONLY); #else Tcl_SetVar2(interp, "sqlite_options", "cursorhints", "0", TCL_GLOBAL_ONLY); #endif #ifdef SQLITE_ENABLE_HIDDEN_COLUMNS Tcl_SetVar2(interp, "sqlite_options", "hiddencolumns", "1", TCL_GLOBAL_ONLY); #else Tcl_SetVar2(interp, "sqlite_options", "hiddencolumns", "0", TCL_GLOBAL_ONLY); #endif #ifdef SQLITE_ENABLE_MEMSYS3 Tcl_SetVar2(interp, "sqlite_options", "mem3", "1", TCL_GLOBAL_ONLY); #else Tcl_SetVar2(interp, "sqlite_options", "mem3", "0", TCL_GLOBAL_ONLY); #endif #ifdef SQLITE_ENABLE_MEMSYS5 Tcl_SetVar2(interp, "sqlite_options", "mem5", "1", TCL_GLOBAL_ONLY); #else Tcl_SetVar2(interp, "sqlite_options", "mem5", "0", TCL_GLOBAL_ONLY); #endif #ifdef SQLITE_ENABLE_PREUPDATE_HOOK Tcl_SetVar2(interp, "sqlite_options", "preupdate", "1", TCL_GLOBAL_ONLY); #else Tcl_SetVar2(interp, "sqlite_options", "preupdate", "0", TCL_GLOBAL_ONLY); #endif #ifdef SQLITE_ENABLE_SNAPSHOT Tcl_SetVar2(interp, "sqlite_options", "snapshot", "1", TCL_GLOBAL_ONLY); #else Tcl_SetVar2(interp, "sqlite_options", "snapshot", "0", TCL_GLOBAL_ONLY); #endif #ifdef SQLITE_MUTEX_OMIT Tcl_SetVar2(interp, "sqlite_options", "mutex", "0", TCL_GLOBAL_ONLY); #else Tcl_SetVar2(interp, "sqlite_options", "mutex", "1", TCL_GLOBAL_ONLY); #endif #ifdef SQLITE_MUTEX_NOOP Tcl_SetVar2(interp, "sqlite_options", "mutex_noop", "1", TCL_GLOBAL_ONLY); #else Tcl_SetVar2(interp, "sqlite_options", "mutex_noop", "0", TCL_GLOBAL_ONLY); #endif #ifdef SQLITE_OMIT_ALTERTABLE Tcl_SetVar2(interp, "sqlite_options", "altertable", "0", TCL_GLOBAL_ONLY); #else Tcl_SetVar2(interp, "sqlite_options", "altertable", "1", TCL_GLOBAL_ONLY); #endif #ifdef SQLITE_OMIT_ANALYZE Tcl_SetVar2(interp, "sqlite_options", "analyze", "0", TCL_GLOBAL_ONLY); #else Tcl_SetVar2(interp, "sqlite_options", "analyze", "1", TCL_GLOBAL_ONLY); #endif #ifdef SQLITE_ENABLE_API_ARMOR Tcl_SetVar2(interp, "sqlite_options", "api_armor", "1", TCL_GLOBAL_ONLY); #else Tcl_SetVar2(interp, "sqlite_options", "api_armor", "0", TCL_GLOBAL_ONLY); #endif #ifdef SQLITE_ENABLE_ATOMIC_WRITE Tcl_SetVar2(interp, "sqlite_options", "atomicwrite", "1", TCL_GLOBAL_ONLY); #else Tcl_SetVar2(interp, "sqlite_options", "atomicwrite", "0", TCL_GLOBAL_ONLY); #endif #ifdef SQLITE_ENABLE_JSON1 Tcl_SetVar2(interp, "sqlite_options", "json1", "1", TCL_GLOBAL_ONLY); #else Tcl_SetVar2(interp, "sqlite_options", "json1", "0", TCL_GLOBAL_ONLY); #endif #ifdef SQLITE_HAS_CODEC Tcl_SetVar2(interp, "sqlite_options", "has_codec", "1", TCL_GLOBAL_ONLY); #else Tcl_SetVar2(interp, "sqlite_options", "has_codec", "0", TCL_GLOBAL_ONLY); #endif #ifdef SQLITE_LIKE_DOESNT_MATCH_BLOBS Tcl_SetVar2(interp, "sqlite_options", "like_match_blobs", "0", TCL_GLOBAL_ONLY); #else Tcl_SetVar2(interp, "sqlite_options", "like_match_blobs", "1", TCL_GLOBAL_ONLY); #endif #ifdef SQLITE_OMIT_ATTACH Tcl_SetVar2(interp, "sqlite_options", "attach", "0", TCL_GLOBAL_ONLY); #else Tcl_SetVar2(interp, "sqlite_options", "attach", "1", TCL_GLOBAL_ONLY); #endif #ifdef SQLITE_OMIT_AUTHORIZATION Tcl_SetVar2(interp, "sqlite_options", "auth", "0", TCL_GLOBAL_ONLY); #else Tcl_SetVar2(interp, "sqlite_options", "auth", "1", TCL_GLOBAL_ONLY); #endif #ifdef SQLITE_OMIT_AUTOINCREMENT Tcl_SetVar2(interp, "sqlite_options", "autoinc", "0", TCL_GLOBAL_ONLY); #else Tcl_SetVar2(interp, "sqlite_options", "autoinc", "1", TCL_GLOBAL_ONLY); #endif #ifdef SQLITE_OMIT_AUTOMATIC_INDEX Tcl_SetVar2(interp, "sqlite_options", "autoindex", "0", TCL_GLOBAL_ONLY); #else Tcl_SetVar2(interp, "sqlite_options", "autoindex", "1", TCL_GLOBAL_ONLY); #endif #ifdef SQLITE_OMIT_AUTORESET Tcl_SetVar2(interp, "sqlite_options", "autoreset", "0", TCL_GLOBAL_ONLY); #else Tcl_SetVar2(interp, "sqlite_options", "autoreset", "1", TCL_GLOBAL_ONLY); #endif #ifdef SQLITE_OMIT_AUTOVACUUM Tcl_SetVar2(interp, "sqlite_options", "autovacuum", "0", TCL_GLOBAL_ONLY); #else Tcl_SetVar2(interp, "sqlite_options", "autovacuum", "1", TCL_GLOBAL_ONLY); #endif /* SQLITE_OMIT_AUTOVACUUM */ #if !defined(SQLITE_DEFAULT_AUTOVACUUM) Tcl_SetVar2(interp,"sqlite_options","default_autovacuum","0",TCL_GLOBAL_ONLY); #else Tcl_SetVar2(interp, "sqlite_options", "default_autovacuum", STRINGVALUE(SQLITE_DEFAULT_AUTOVACUUM), TCL_GLOBAL_ONLY); #endif #ifdef SQLITE_OMIT_BETWEEN_OPTIMIZATION Tcl_SetVar2(interp, "sqlite_options", "between_opt", "0", TCL_GLOBAL_ONLY); #else Tcl_SetVar2(interp, "sqlite_options", "between_opt", "1", TCL_GLOBAL_ONLY); #endif #ifdef SQLITE_UNTESTABLE Tcl_SetVar2(interp, "sqlite_options", "builtin_test", "0", TCL_GLOBAL_ONLY); #else Tcl_SetVar2(interp, "sqlite_options", "builtin_test", "1", TCL_GLOBAL_ONLY); #endif #ifdef SQLITE_OMIT_BLOB_LITERAL Tcl_SetVar2(interp, "sqlite_options", "bloblit", "0", TCL_GLOBAL_ONLY); #else Tcl_SetVar2(interp, "sqlite_options", "bloblit", "1", TCL_GLOBAL_ONLY); #endif #ifdef SQLITE_OMIT_CAST Tcl_SetVar2(interp, "sqlite_options", "cast", "0", TCL_GLOBAL_ONLY); #else Tcl_SetVar2(interp, "sqlite_options", "cast", "1", TCL_GLOBAL_ONLY); #endif #ifdef SQLITE_OMIT_CHECK Tcl_SetVar2(interp, "sqlite_options", "check", "0", TCL_GLOBAL_ONLY); #else Tcl_SetVar2(interp, "sqlite_options", "check", "1", TCL_GLOBAL_ONLY); #endif #ifdef SQLITE_OMIT_CTE Tcl_SetVar2(interp, "sqlite_options", "cte", "0", TCL_GLOBAL_ONLY); #else Tcl_SetVar2(interp, "sqlite_options", "cte", "1", TCL_GLOBAL_ONLY); #endif #ifdef SQLITE_ENABLE_COLUMN_METADATA Tcl_SetVar2(interp, "sqlite_options", "columnmetadata", "1", TCL_GLOBAL_ONLY); #else Tcl_SetVar2(interp, "sqlite_options", "columnmetadata", "0", TCL_GLOBAL_ONLY); #endif #ifdef SQLITE_ENABLE_OVERSIZE_CELL_CHECK Tcl_SetVar2(interp, "sqlite_options", "oversize_cell_check", "1", TCL_GLOBAL_ONLY); #else Tcl_SetVar2(interp, "sqlite_options", "oversize_cell_check", "0", TCL_GLOBAL_ONLY); #endif #ifdef SQLITE_OMIT_COMPILEOPTION_DIAGS Tcl_SetVar2(interp, "sqlite_options", "compileoption_diags", "0", TCL_GLOBAL_ONLY); #else Tcl_SetVar2(interp, "sqlite_options", "compileoption_diags", "1", TCL_GLOBAL_ONLY); #endif #ifdef SQLITE_OMIT_COMPLETE Tcl_SetVar2(interp, "sqlite_options", "complete", "0", TCL_GLOBAL_ONLY); #else Tcl_SetVar2(interp, "sqlite_options", "complete", "1", TCL_GLOBAL_ONLY); #endif #ifdef SQLITE_OMIT_COMPOUND_SELECT Tcl_SetVar2(interp, "sqlite_options", "compound", "0", TCL_GLOBAL_ONLY); #else Tcl_SetVar2(interp, "sqlite_options", "compound", "1", TCL_GLOBAL_ONLY); #endif Tcl_SetVar2(interp, "sqlite_options", "conflict", "1", TCL_GLOBAL_ONLY); Tcl_SetVar2(interp, "sqlite_options", "crashtest", "1", TCL_GLOBAL_ONLY); #ifdef SQLITE_OMIT_DATETIME_FUNCS Tcl_SetVar2(interp, "sqlite_options", "datetime", "0", TCL_GLOBAL_ONLY); #else Tcl_SetVar2(interp, "sqlite_options", "datetime", "1", TCL_GLOBAL_ONLY); #endif #ifdef SQLITE_OMIT_DECLTYPE Tcl_SetVar2(interp, "sqlite_options", "decltype", "0", TCL_GLOBAL_ONLY); #else Tcl_SetVar2(interp, "sqlite_options", "decltype", "1", TCL_GLOBAL_ONLY); #endif #ifdef SQLITE_OMIT_DEPRECATED Tcl_SetVar2(interp, "sqlite_options", "deprecated", "0", TCL_GLOBAL_ONLY); #else Tcl_SetVar2(interp, "sqlite_options", "deprecated", "1", TCL_GLOBAL_ONLY); #endif #ifdef SQLITE_OMIT_DISKIO Tcl_SetVar2(interp, "sqlite_options", "diskio", "0", TCL_GLOBAL_ONLY); #else Tcl_SetVar2(interp, "sqlite_options", "diskio", "1", TCL_GLOBAL_ONLY); #endif #ifdef SQLITE_OMIT_EXPLAIN Tcl_SetVar2(interp, "sqlite_options", "explain", "0", TCL_GLOBAL_ONLY); #else Tcl_SetVar2(interp, "sqlite_options", "explain", "1", TCL_GLOBAL_ONLY); #endif #ifdef SQLITE_OMIT_FLOATING_POINT Tcl_SetVar2(interp, "sqlite_options", "floatingpoint", "0", TCL_GLOBAL_ONLY); #else Tcl_SetVar2(interp, "sqlite_options", "floatingpoint", "1", TCL_GLOBAL_ONLY); #endif #ifdef SQLITE_OMIT_FOREIGN_KEY Tcl_SetVar2(interp, "sqlite_options", "foreignkey", "0", TCL_GLOBAL_ONLY); #else Tcl_SetVar2(interp, "sqlite_options", "foreignkey", "1", TCL_GLOBAL_ONLY); #endif #ifdef SQLITE_ENABLE_FTS1 Tcl_SetVar2(interp, "sqlite_options", "fts1", "1", TCL_GLOBAL_ONLY); #else Tcl_SetVar2(interp, "sqlite_options", "fts1", "0", TCL_GLOBAL_ONLY); #endif #ifdef SQLITE_ENABLE_FTS2 Tcl_SetVar2(interp, "sqlite_options", "fts2", "1", TCL_GLOBAL_ONLY); #else Tcl_SetVar2(interp, "sqlite_options", "fts2", "0", TCL_GLOBAL_ONLY); #endif #ifdef SQLITE_ENABLE_FTS3 Tcl_SetVar2(interp, "sqlite_options", "fts3", "1", TCL_GLOBAL_ONLY); #else Tcl_SetVar2(interp, "sqlite_options", "fts3", "0", TCL_GLOBAL_ONLY); #endif #ifdef SQLITE_ENABLE_FTS5 Tcl_SetVar2(interp, "sqlite_options", "fts5", "1", TCL_GLOBAL_ONLY); #else Tcl_SetVar2(interp, "sqlite_options", "fts5", "0", TCL_GLOBAL_ONLY); #endif #if defined(SQLITE_ENABLE_FTS3) && !defined(SQLITE_DISABLE_FTS3_UNICODE) Tcl_SetVar2(interp, "sqlite_options", "fts3_unicode", "1", TCL_GLOBAL_ONLY); #else Tcl_SetVar2(interp, "sqlite_options", "fts3_unicode", "0", TCL_GLOBAL_ONLY); #endif #ifdef SQLITE_DISABLE_FTS4_DEFERRED Tcl_SetVar2(interp, "sqlite_options", "fts4_deferred", "0", TCL_GLOBAL_ONLY); #else Tcl_SetVar2(interp, "sqlite_options", "fts4_deferred", "1", TCL_GLOBAL_ONLY); #endif #ifdef SQLITE_OMIT_GET_TABLE Tcl_SetVar2(interp, "sqlite_options", "gettable", "0", TCL_GLOBAL_ONLY); #else Tcl_SetVar2(interp, "sqlite_options", "gettable", "1", TCL_GLOBAL_ONLY); #endif #ifdef SQLITE_ENABLE_ICU Tcl_SetVar2(interp, "sqlite_options", "icu", "1", TCL_GLOBAL_ONLY); #else Tcl_SetVar2(interp, "sqlite_options", "icu", "0", TCL_GLOBAL_ONLY); #endif #ifdef SQLITE_OMIT_INCRBLOB Tcl_SetVar2(interp, "sqlite_options", "incrblob", "0", TCL_GLOBAL_ONLY); #else Tcl_SetVar2(interp, "sqlite_options", "incrblob", "1", TCL_GLOBAL_ONLY); #endif /* SQLITE_OMIT_AUTOVACUUM */ #ifdef SQLITE_OMIT_INTEGRITY_CHECK Tcl_SetVar2(interp, "sqlite_options", "integrityck", "0", TCL_GLOBAL_ONLY); #else Tcl_SetVar2(interp, "sqlite_options", "integrityck", "1", TCL_GLOBAL_ONLY); #endif #if defined(SQLITE_DEFAULT_FILE_FORMAT) && SQLITE_DEFAULT_FILE_FORMAT==1 Tcl_SetVar2(interp, "sqlite_options", "legacyformat", "1", TCL_GLOBAL_ONLY); #else Tcl_SetVar2(interp, "sqlite_options", "legacyformat", "0", TCL_GLOBAL_ONLY); #endif #ifdef SQLITE_OMIT_LIKE_OPTIMIZATION Tcl_SetVar2(interp, "sqlite_options", "like_opt", "0", TCL_GLOBAL_ONLY); #else Tcl_SetVar2(interp, "sqlite_options", "like_opt", "1", TCL_GLOBAL_ONLY); #endif #ifdef SQLITE_OMIT_LOAD_EXTENSION Tcl_SetVar2(interp, "sqlite_options", "load_ext", "0", TCL_GLOBAL_ONLY); #else Tcl_SetVar2(interp, "sqlite_options", "load_ext", "1", TCL_GLOBAL_ONLY); #endif #ifdef SQLITE_OMIT_LOCALTIME Tcl_SetVar2(interp, "sqlite_options", "localtime", "0", TCL_GLOBAL_ONLY); #else Tcl_SetVar2(interp, "sqlite_options", "localtime", "1", TCL_GLOBAL_ONLY); #endif #ifdef SQLITE_OMIT_LOOKASIDE Tcl_SetVar2(interp, "sqlite_options", "lookaside", "0", TCL_GLOBAL_ONLY); #else Tcl_SetVar2(interp, "sqlite_options", "lookaside", "1", TCL_GLOBAL_ONLY); #endif Tcl_SetVar2(interp, "sqlite_options", "long_double", sizeof(LONGDOUBLE_TYPE)>sizeof(double) ? "1" : "0", TCL_GLOBAL_ONLY); #ifdef SQLITE_OMIT_MEMORYDB Tcl_SetVar2(interp, "sqlite_options", "memorydb", "0", TCL_GLOBAL_ONLY); #else Tcl_SetVar2(interp, "sqlite_options", "memorydb", "1", TCL_GLOBAL_ONLY); #endif #ifdef SQLITE_ENABLE_MEMORY_MANAGEMENT Tcl_SetVar2(interp, "sqlite_options", "memorymanage", "1", TCL_GLOBAL_ONLY); #else Tcl_SetVar2(interp, "sqlite_options", "memorymanage", "0", TCL_GLOBAL_ONLY); #endif Tcl_SetVar2(interp, "sqlite_options", "mergesort", "1", TCL_GLOBAL_ONLY); #ifdef SQLITE_OMIT_OR_OPTIMIZATION Tcl_SetVar2(interp, "sqlite_options", "or_opt", "0", TCL_GLOBAL_ONLY); #else Tcl_SetVar2(interp, "sqlite_options", "or_opt", "1", TCL_GLOBAL_ONLY); #endif #ifdef SQLITE_ENABLE_RBU Tcl_SetVar2(interp, "sqlite_options", "rbu", "1", TCL_GLOBAL_ONLY); #else Tcl_SetVar2(interp, "sqlite_options", "rbu", "0", TCL_GLOBAL_ONLY); #endif #ifdef SQLITE_OMIT_PAGER_PRAGMAS Tcl_SetVar2(interp, "sqlite_options", "pager_pragmas", "0", TCL_GLOBAL_ONLY); #else Tcl_SetVar2(interp, "sqlite_options", "pager_pragmas", "1", TCL_GLOBAL_ONLY); #endif #if defined(SQLITE_OMIT_PRAGMA) || defined(SQLITE_OMIT_FLAG_PRAGMAS) Tcl_SetVar2(interp, "sqlite_options", "pragma", "0", TCL_GLOBAL_ONLY); Tcl_SetVar2(interp, "sqlite_options", "integrityck", "0", TCL_GLOBAL_ONLY); #else Tcl_SetVar2(interp, "sqlite_options", "pragma", "1", TCL_GLOBAL_ONLY); #endif #ifdef SQLITE_OMIT_PROGRESS_CALLBACK Tcl_SetVar2(interp, "sqlite_options", "progress", "0", TCL_GLOBAL_ONLY); #else Tcl_SetVar2(interp, "sqlite_options", "progress", "1", TCL_GLOBAL_ONLY); #endif #ifdef SQLITE_OMIT_REINDEX Tcl_SetVar2(interp, "sqlite_options", "reindex", "0", TCL_GLOBAL_ONLY); #else Tcl_SetVar2(interp, "sqlite_options", "reindex", "1", TCL_GLOBAL_ONLY); #endif #ifdef SQLITE_ENABLE_RTREE Tcl_SetVar2(interp, "sqlite_options", "rtree", "1", TCL_GLOBAL_ONLY); #else Tcl_SetVar2(interp, "sqlite_options", "rtree", "0", TCL_GLOBAL_ONLY); #endif #ifdef SQLITE_RTREE_INT_ONLY Tcl_SetVar2(interp, "sqlite_options", "rtree_int_only", "1", TCL_GLOBAL_ONLY); #else Tcl_SetVar2(interp, "sqlite_options", "rtree_int_only", "0", TCL_GLOBAL_ONLY); #endif #ifdef SQLITE_OMIT_SCHEMA_PRAGMAS Tcl_SetVar2(interp, "sqlite_options", "schema_pragmas", "0", TCL_GLOBAL_ONLY); #else Tcl_SetVar2(interp, "sqlite_options", "schema_pragmas", "1", TCL_GLOBAL_ONLY); #endif #ifdef SQLITE_OMIT_SCHEMA_VERSION_PRAGMAS Tcl_SetVar2(interp, "sqlite_options", "schema_version", "0", TCL_GLOBAL_ONLY); #else Tcl_SetVar2(interp, "sqlite_options", "schema_version", "1", TCL_GLOBAL_ONLY); #endif #ifdef SQLITE_ENABLE_SESSION Tcl_SetVar2(interp, "sqlite_options", "session", "1", TCL_GLOBAL_ONLY); #else Tcl_SetVar2(interp, "sqlite_options", "session", "0", TCL_GLOBAL_ONLY); #endif #ifdef SQLITE_ENABLE_STAT4 Tcl_SetVar2(interp, "sqlite_options", "stat4", "1", TCL_GLOBAL_ONLY); #else Tcl_SetVar2(interp, "sqlite_options", "stat4", "0", TCL_GLOBAL_ONLY); #endif #if defined(SQLITE_ENABLE_STAT3) && !defined(SQLITE_ENABLE_STAT4) Tcl_SetVar2(interp, "sqlite_options", "stat3", "1", TCL_GLOBAL_ONLY); #else Tcl_SetVar2(interp, "sqlite_options", "stat3", "0", TCL_GLOBAL_ONLY); #endif #if defined(SQLITE_ENABLE_STMTVTAB) && !defined(SQLITE_OMIT_VIRTUALTABLE) Tcl_SetVar2(interp, "sqlite_options", "stmtvtab", "1", TCL_GLOBAL_ONLY); #else Tcl_SetVar2(interp, "sqlite_options", "stmtvtab", "0", TCL_GLOBAL_ONLY); #endif #ifdef SQLITE_ENABLE_STMT_SCANSTATUS Tcl_SetVar2(interp, "sqlite_options", "scanstatus", "1", TCL_GLOBAL_ONLY); #else Tcl_SetVar2(interp, "sqlite_options", "scanstatus", "0", TCL_GLOBAL_ONLY); #endif #if !defined(SQLITE_ENABLE_LOCKING_STYLE) # if defined(__APPLE__) # define SQLITE_ENABLE_LOCKING_STYLE 1 # else # define SQLITE_ENABLE_LOCKING_STYLE 0 # endif #endif #if SQLITE_ENABLE_LOCKING_STYLE && defined(__APPLE__) Tcl_SetVar2(interp,"sqlite_options","lock_proxy_pragmas","1",TCL_GLOBAL_ONLY); #else Tcl_SetVar2(interp,"sqlite_options","lock_proxy_pragmas","0",TCL_GLOBAL_ONLY); #endif #if defined(SQLITE_PREFER_PROXY_LOCKING) && defined(__APPLE__) Tcl_SetVar2(interp,"sqlite_options","prefer_proxy_locking","1",TCL_GLOBAL_ONLY); #else Tcl_SetVar2(interp,"sqlite_options","prefer_proxy_locking","0",TCL_GLOBAL_ONLY); #endif #ifdef SQLITE_OMIT_SHARED_CACHE Tcl_SetVar2(interp, "sqlite_options", "shared_cache", "0", TCL_GLOBAL_ONLY); #else Tcl_SetVar2(interp, "sqlite_options", "shared_cache", "1", TCL_GLOBAL_ONLY); #endif #ifdef SQLITE_OMIT_SUBQUERY Tcl_SetVar2(interp, "sqlite_options", "subquery", "0", TCL_GLOBAL_ONLY); #else Tcl_SetVar2(interp, "sqlite_options", "subquery", "1", TCL_GLOBAL_ONLY); #endif #ifdef SQLITE_OMIT_TCL_VARIABLE Tcl_SetVar2(interp, "sqlite_options", "tclvar", "0", TCL_GLOBAL_ONLY); #else Tcl_SetVar2(interp, "sqlite_options", "tclvar", "1", TCL_GLOBAL_ONLY); #endif Tcl_SetVar2(interp, "sqlite_options", "threadsafe", SQLITE_THREADSAFE ? "1" : "0", TCL_GLOBAL_ONLY); Tcl_SetVar2(interp, "sqlite_options", "threadsafe1", SQLITE_THREADSAFE==1 ? "1" : "0", TCL_GLOBAL_ONLY); Tcl_SetVar2(interp, "sqlite_options", "threadsafe2", SQLITE_THREADSAFE==2 ? "1" : "0", TCL_GLOBAL_ONLY); assert( sqlite3_threadsafe()==SQLITE_THREADSAFE ); #ifdef SQLITE_OMIT_TEMPDB Tcl_SetVar2(interp, "sqlite_options", "tempdb", "0", TCL_GLOBAL_ONLY); #else Tcl_SetVar2(interp, "sqlite_options", "tempdb", "1", TCL_GLOBAL_ONLY); #endif #ifdef SQLITE_OMIT_TRACE Tcl_SetVar2(interp, "sqlite_options", "trace", "0", TCL_GLOBAL_ONLY); #else Tcl_SetVar2(interp, "sqlite_options", "trace", "1", TCL_GLOBAL_ONLY); #endif #ifdef SQLITE_OMIT_TRIGGER Tcl_SetVar2(interp, "sqlite_options", "trigger", "0", TCL_GLOBAL_ONLY); #else Tcl_SetVar2(interp, "sqlite_options", "trigger", "1", TCL_GLOBAL_ONLY); #endif #ifdef SQLITE_OMIT_TRUNCATE_OPTIMIZATION Tcl_SetVar2(interp, "sqlite_options", "truncate_opt", "0", TCL_GLOBAL_ONLY); #else Tcl_SetVar2(interp, "sqlite_options", "truncate_opt", "1", TCL_GLOBAL_ONLY); #endif #ifdef SQLITE_OMIT_UTF16 Tcl_SetVar2(interp, "sqlite_options", "utf16", "0", TCL_GLOBAL_ONLY); #else Tcl_SetVar2(interp, "sqlite_options", "utf16", "1", TCL_GLOBAL_ONLY); #endif #if defined(SQLITE_OMIT_VACUUM) || defined(SQLITE_OMIT_ATTACH) Tcl_SetVar2(interp, "sqlite_options", "vacuum", "0", TCL_GLOBAL_ONLY); #else Tcl_SetVar2(interp, "sqlite_options", "vacuum", "1", TCL_GLOBAL_ONLY); #endif #ifdef SQLITE_OMIT_VIEW Tcl_SetVar2(interp, "sqlite_options", "view", "0", TCL_GLOBAL_ONLY); #else Tcl_SetVar2(interp, "sqlite_options", "view", "1", TCL_GLOBAL_ONLY); #endif #ifdef SQLITE_OMIT_VIRTUALTABLE Tcl_SetVar2(interp, "sqlite_options", "vtab", "0", TCL_GLOBAL_ONLY); #else Tcl_SetVar2(interp, "sqlite_options", "vtab", "1", TCL_GLOBAL_ONLY); #endif #ifdef SQLITE_OMIT_WAL Tcl_SetVar2(interp, "sqlite_options", "wal", "0", TCL_GLOBAL_ONLY); #else Tcl_SetVar2(interp, "sqlite_options", "wal", "1", TCL_GLOBAL_ONLY); #endif #ifdef SQLITE_OMIT_WSD Tcl_SetVar2(interp, "sqlite_options", "wsd", "0", TCL_GLOBAL_ONLY); #else Tcl_SetVar2(interp, "sqlite_options", "wsd", "1", TCL_GLOBAL_ONLY); #endif #if defined(SQLITE_ENABLE_UPDATE_DELETE_LIMIT) && !defined(SQLITE_OMIT_SUBQUERY) Tcl_SetVar2(interp, "sqlite_options", "update_delete_limit", "1", TCL_GLOBAL_ONLY); #else Tcl_SetVar2(interp, "sqlite_options", "update_delete_limit", "0", TCL_GLOBAL_ONLY); #endif #if defined(SQLITE_ENABLE_UNLOCK_NOTIFY) Tcl_SetVar2(interp, "sqlite_options", "unlock_notify", "1", TCL_GLOBAL_ONLY); #else Tcl_SetVar2(interp, "sqlite_options", "unlock_notify", "0", TCL_GLOBAL_ONLY); #endif #ifdef SQLITE_SECURE_DELETE Tcl_SetVar2(interp, "sqlite_options", "secure_delete", "1", TCL_GLOBAL_ONLY); #else Tcl_SetVar2(interp, "sqlite_options", "secure_delete", "0", TCL_GLOBAL_ONLY); #endif #ifdef SQLITE_USER_AUTHENTICATION Tcl_SetVar2(interp, "sqlite_options", "userauth", "1", TCL_GLOBAL_ONLY); #else Tcl_SetVar2(interp, "sqlite_options", "userauth", "0", TCL_GLOBAL_ONLY); #endif #ifdef SQLITE_MULTIPLEX_EXT_OVWR Tcl_SetVar2(interp, "sqlite_options", "multiplex_ext_overwrite", "1", TCL_GLOBAL_ONLY); #else Tcl_SetVar2(interp, "sqlite_options", "multiplex_ext_overwrite", "0", TCL_GLOBAL_ONLY); #endif #ifdef YYTRACKMAXSTACKDEPTH Tcl_SetVar2(interp, "sqlite_options", "yytrackmaxstackdepth", "1", TCL_GLOBAL_ONLY); #else Tcl_SetVar2(interp, "sqlite_options", "yytrackmaxstackdepth", "0", TCL_GLOBAL_ONLY); #endif #ifdef SQLITE_ENABLE_SQLLOG Tcl_SetVar2(interp, "sqlite_options", "sqllog", "1", TCL_GLOBAL_ONLY); #else Tcl_SetVar2(interp, "sqlite_options", "sqllog", "0", TCL_GLOBAL_ONLY); #endif #ifdef SQLITE_ENABLE_URI_00_ERROR Tcl_SetVar2(interp, "sqlite_options", "uri_00_error", "1", TCL_GLOBAL_ONLY); #else Tcl_SetVar2(interp, "sqlite_options", "uri_00_error", "0", TCL_GLOBAL_ONLY); #endif #define LINKVAR(x) { \ static const int cv_ ## x = SQLITE_ ## x; \ Tcl_LinkVar(interp, "SQLITE_" #x, (char *)&(cv_ ## x), \ TCL_LINK_INT | TCL_LINK_READ_ONLY); } LINKVAR( MAX_LENGTH ); LINKVAR( MAX_COLUMN ); LINKVAR( MAX_SQL_LENGTH ); LINKVAR( MAX_EXPR_DEPTH ); LINKVAR( MAX_COMPOUND_SELECT ); LINKVAR( MAX_VDBE_OP ); LINKVAR( MAX_FUNCTION_ARG ); LINKVAR( MAX_VARIABLE_NUMBER ); LINKVAR( MAX_PAGE_SIZE ); LINKVAR( MAX_PAGE_COUNT ); LINKVAR( MAX_LIKE_PATTERN_LENGTH ); LINKVAR( MAX_TRIGGER_DEPTH ); LINKVAR( DEFAULT_CACHE_SIZE ); LINKVAR( DEFAULT_PAGE_SIZE ); LINKVAR( DEFAULT_FILE_FORMAT ); LINKVAR( DEFAULT_SYNCHRONOUS ); LINKVAR( DEFAULT_WAL_SYNCHRONOUS ); LINKVAR( MAX_ATTACHED ); LINKVAR( MAX_DEFAULT_PAGE_SIZE ); LINKVAR( MAX_WORKER_THREADS ); { static const int cv_TEMP_STORE = SQLITE_TEMP_STORE; Tcl_LinkVar(interp, "TEMP_STORE", (char *)&(cv_TEMP_STORE), TCL_LINK_INT | TCL_LINK_READ_ONLY); } #ifdef _MSC_VER { static const int cv__MSC_VER = 1; Tcl_LinkVar(interp, "_MSC_VER", (char *)&(cv__MSC_VER), TCL_LINK_INT | TCL_LINK_READ_ONLY); } #endif #ifdef __GNUC__ { static const int cv___GNUC__ = 1; Tcl_LinkVar(interp, "__GNUC__", (char *)&(cv___GNUC__), TCL_LINK_INT | TCL_LINK_READ_ONLY); } #endif }