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); }
virtual void SetParameters (Tcl_Interp * interp) { occparam.resthcloseedgefac = atof (Tcl_GetVar (interp, "::stloptions.resthcloseedgefac", 0)); occparam.resthcloseedgeenable = atoi (Tcl_GetVar (interp, "::stloptions.resthcloseedgeenable", 0)); }
int NpInitInterp(Tcl_Interp *interp, int install_tk) { Tcl_Preserve((ClientData) interp); /* * Set sharedlib in interp while we are here. This will be used to * base the location of the default pluginX.Y package in the stardll * usage scenario. */ if (Tcl_SetVar2(interp, "plugin", "sharedlib", dllName, TCL_GLOBAL_ONLY) == NULL) { NpPlatformMsg("Failed to set plugin(sharedlib)!", "NpInitInterp"); return TCL_ERROR; } /* * The plugin doesn't directly call Tk C APIs - it's all managed at * the Tcl level, so we can just pkg req Tk here instead of calling * Tk_InitStubs. */ if (TCL_OK != Tcl_Init(interp)) { CONST char *msg = Tcl_GetVar(interp, "errorInfo", TCL_GLOBAL_ONLY); fprintf(stderr, "GTKWAVE | Tcl_Init error: %s\n", msg) ; exit(EXIT_FAILURE); } if (install_tk) { NpLog("Tcl_PkgRequire(\"Tk\", \"%s\", 0)\n", TK_VERSION); if (1 && Tcl_PkgRequire(interp, "Tk", TK_VERSION, 0) == NULL) { CONST char *msg = Tcl_GetVar(interp, "errorInfo", TCL_GLOBAL_ONLY); NpPlatformMsg(msg, "NpInitInterp Tcl_PkgRequire(Tk)"); NpPlatformMsg("Failed to create initialize Tk", "NpInitInterp"); return TCL_ERROR; } } return TCL_OK; }
static int ThreadEventProc( Tcl_Event *evPtr, /* Really ThreadEvent */ int mask) { ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey); ThreadEvent *threadEventPtr = (ThreadEvent *)evPtr; ThreadEventResult *resultPtr = threadEventPtr->resultPtr; Tcl_Interp *interp = tsdPtr->interp; int code; const char *result, *errorCode, *errorInfo; if (interp == NULL) { code = TCL_ERROR; result = "no target interp!"; errorCode = "THREAD"; errorInfo = ""; } else { Tcl_Preserve((ClientData) interp); Tcl_ResetResult(interp); Tcl_CreateThreadExitHandler(ThreadFreeProc, (ClientData) threadEventPtr->script); code = Tcl_GlobalEval(interp, threadEventPtr->script); Tcl_DeleteThreadExitHandler(ThreadFreeProc, (ClientData) threadEventPtr->script); if (code != TCL_OK) { errorCode = Tcl_GetVar(interp, "errorCode", TCL_GLOBAL_ONLY); errorInfo = Tcl_GetVar(interp, "errorInfo", TCL_GLOBAL_ONLY); } else { errorCode = errorInfo = NULL; } result = Tcl_GetStringResult(interp); } ckfree(threadEventPtr->script); if (resultPtr) { Tcl_MutexLock(&threadMutex); resultPtr->code = code; resultPtr->result = ckalloc(strlen(result) + 1); strcpy(resultPtr->result, result); if (errorCode != NULL) { resultPtr->errorCode = ckalloc(strlen(errorCode) + 1); strcpy(resultPtr->errorCode, errorCode); } if (errorInfo != NULL) { resultPtr->errorInfo = ckalloc(strlen(errorInfo) + 1); strcpy(resultPtr->errorInfo, errorInfo); } Tcl_ConditionNotify(&resultPtr->done); Tcl_MutexUnlock(&threadMutex); } if (interp != NULL) { Tcl_Release((ClientData) interp); } return 1; }
void handle_error(Tcl_Interp *interp, char *msg) { char *info = Tcl_GetVar(interp, "errorInfo", TCL_GLOBAL_ONLY); #ifdef USE_TIDE char *code = Tcl_GetVar(interp, "errorCode", TCL_GLOBAL_ONLY); if(handle_tide_error(interp, code, msg, info)) return; #endif fprintf(stderr, "error in Tcl script: %s\n%s\n", msg, info); }
/* * cat命令处理 */ int PacketDefCmd::cat_proc(ClientData clientData, Tcl_Interp *interp, int argc,char *argv[]) { if(argc < 2) { //DataLog::insertERROR("cat command wrong, usage: cat 00 11 ..."); return TCL_ERROR; } char result[512] = {0} ; memset(result,0,argc); int pos = 0; for(int i=1;i<argc;i++) { if(argv[i][0] != '$') { strcpy(result+pos,argv[i]); pos += strlen(argv[i]); } else //进行值替换 { const char* value = Tcl_GetVar(interp,argv[i]+1,TCL_GLOBAL_ONLY); strcpy(result+pos,value); pos += strlen(value); } } //interp->result的缺省大小为200字节 strcpy(interp->result,result); //output data log // DataLog::insertDEBUG("[cat ...] command success!"); return TCL_OK; }
/* * header命令处理 */ int PacketDefCmd::header_proc(ClientData clientData, Tcl_Interp *interp, int argc, char *argv[]) { //Check the StopTcl flag const char* stoptcl = Tcl_GetVar(interp,"StopTcl",TCL_GLOBAL_ONLY); if(stoptcl != NULL && (bcmp(stoptcl,"yes",3) == 0)) //TclIntepreter thread stop return TCL_BREAK; if(argc != 3) { //DataLog::insertERROR("header command wrong, usage: header name body"); return TCL_ERROR; } memset(headerName,0,sizeof(headerName)); strcpy(headerName,argv[1]); //save the header name; int len = strlen(argv[2]); getLine(argv[2],len,interp,0); //output data log snprintf(logdata,LOGLEN,"header %s {...} command success!",argv[1]); // DataLog::insertDEBUG(logdata); return TCL_OK; }
static int echoBegin(sqlite3_vtab *tab){ int rc; echo_vtab *pVtab = (echo_vtab *)tab; Tcl_Interp *interp = pVtab->interp; const char *zVal; assert( !pVtab->inTransaction ); if( simulateVtabError(pVtab, "xBegin") ){ return SQLITE_ERROR; } rc = echoTransactionCall(tab, "xBegin"); if( rc==SQLITE_OK ){ zVal = Tcl_GetVar(interp, "echo_module_begin_fail", TCL_GLOBAL_ONLY); if( zVal && 0==strcmp(zVal, pVtab->zTableName) ){ rc = SQLITE_ERROR; } } if( rc==SQLITE_OK ){ pVtab->inTransaction = 1; } return rc; }
int TCLSH_MAIN(int argc, char **argv){ #ifndef TCL_THREADS Tcl_Interp *interp; Tcl_FindExecutable(argv[0]); interp = Tcl_CreateInterp(); Libsqlite_Init(interp); if( argc>=2 ){ int i; Tcl_SetVar(interp,"argv0",argv[1],TCL_GLOBAL_ONLY); Tcl_SetVar(interp,"argv", "", TCL_GLOBAL_ONLY); for(i=2; i<argc; i++){ Tcl_SetVar(interp, "argv", argv[i], TCL_GLOBAL_ONLY | TCL_LIST_ELEMENT | TCL_APPEND_VALUE); } if( Tcl_EvalFile(interp, argv[1])!=TCL_OK ){ const char *zInfo = Tcl_GetVar(interp, "errorInfo", TCL_GLOBAL_ONLY); if( zInfo==0 ) zInfo = interp->result; fprintf(stderr,"%s: %s\n", *argv, zInfo); return TCL_ERROR; } }else{ Tcl_GlobalEval(interp, zMainloop); } return 0; #else Tcl_Main(argc, argv, Libsqlite_Init); #endif /* TCL_THREADS */ return 0; }
static int echoSync(sqlite3_vtab *tab){ int rc; echo_vtab *pVtab = (echo_vtab *)tab; Tcl_Interp *interp = pVtab->interp; const char *zVal; /* Ticket #3083 - Only call xSync if we have previously started a ** transaction */ assert( pVtab->inTransaction ); if( simulateVtabError(pVtab, "xSync") ){ return SQLITE_ERROR; } rc = echoTransactionCall(tab, "xSync"); if( rc==SQLITE_OK ){ /* Check if the $::echo_module_sync_fail variable is defined. If it is, ** and it is set to the name of the real table underlying this virtual ** echo module table, then cause this xSync operation to fail. */ zVal = Tcl_GetVar(interp, "echo_module_sync_fail", TCL_GLOBAL_ONLY); if( zVal && 0==strcmp(zVal, pVtab->zTableName) ){ rc = -1; } } return rc; }
void fetch_param_bool( struct param *p ) { const char *str_val; int val; bool_t no_val = False; check_assertion( p->type == PARAM_BOOL, "configuration parameter type mismatch" ); str_val = Tcl_GetVar( g_game.tcl_interp, p->name, TCL_GLOBAL_ONLY ); if ( str_val == NULL ) { no_val = True; } else if ( string_cmp_no_case( str_val, "false" ) == 0 ) { p->val.bool_val = False; } else if ( string_cmp_no_case( str_val, "true" ) == 0 ) { p->val.bool_val = True; } else if ( Tcl_GetInt( g_game.tcl_interp, str_val, &val) == TCL_ERROR ) { no_val = True; } else { p->val.bool_val = (val == 0) ? False : True ; } if ( no_val ) { p->val.bool_val = p->deflt.bool_val; } p->loaded = True; }
static void ThreadErrorProc( Tcl_Interp *interp) /* Interp that failed */ { Tcl_Channel errChannel; const char *errorInfo, *argv[3]; char *script; char buf[TCL_DOUBLE_SPACE+1]; sprintf(buf, "%ld", (long) Tcl_GetCurrentThread()); errorInfo = Tcl_GetVar(interp, "errorInfo", TCL_GLOBAL_ONLY); if (errorProcString == NULL) { errChannel = Tcl_GetStdChannel(TCL_STDERR); Tcl_WriteChars(errChannel, "Error from thread ", -1); Tcl_WriteChars(errChannel, buf, -1); Tcl_WriteChars(errChannel, "\n", 1); Tcl_WriteChars(errChannel, errorInfo, -1); Tcl_WriteChars(errChannel, "\n", 1); } else { argv[0] = errorProcString; argv[1] = buf; argv[2] = errorInfo; script = Tcl_Merge(3, argv); TclThreadSend(interp, errorThreadId, script, 0); ckfree(script); } }
static int SetupMainInterp( Tcl_Interp *interp) { /* * Initialize the console only if we are running as an interactive * application. */ TkMacInitAppleEvents(interp); TkMacInitMenus(interp); if (strcmp(Tcl_GetVar(interp, "tcl_interactive", TCL_GLOBAL_ONLY), "1") == 0) { if (Tk_CreateConsoleWindow(interp) == TCL_ERROR) { goto error; } SetupSIOUX(); TclMacInstallExitToShellPatch(NoMoreOutput); } /* * Attach the global interpreter to tk's expected global console */ gStdoutInterp = interp; return TCL_OK; error: panic(Tcl_GetStringResult(interp)); return TCL_ERROR; }
static int echoBegin(sqlite3_vtab *tab){ int rc; echo_vtab *pVtab = (echo_vtab *)tab; Tcl_Interp *interp = pVtab->interp; const char *zVal; /* Ticket #3083 - do not start a transaction if we are already in ** a transaction */ assert( !pVtab->inTransaction ); if( simulateVtabError(pVtab, "xBegin") ){ return SQLITE_ERROR; } rc = echoTransactionCall(tab, "xBegin"); if( rc==SQLITE_OK ){ /* Check if the $::echo_module_begin_fail variable is defined. If it is, ** and it is set to the name of the real table underlying this virtual ** echo module table, then cause this xSync operation to fail. */ zVal = Tcl_GetVar(interp, "echo_module_begin_fail", TCL_GLOBAL_ONLY); if( zVal && 0==strcmp(zVal, pVtab->zTableName) ){ rc = SQLITE_ERROR; } } if( rc==SQLITE_OK ){ pVtab->inTransaction = 1; } return rc; }
static void ThreadErrorProc(Tcl_Interp *interpreter) { #ifdef WIN32 /* George Petasis, 21 Feb 2006: * Unfortunatelly, I cannot find a way to measure the LONG_MAX characters * with Visual C++ preprocessor. char buffer[strlen("")] does nto seem to work * with static functions under Visual C++ .NET.*/ char buffer[15]; #else char buffer[strlen(XSTRING(LONG_MAX))]; #endif CONST char *errorInformation; Tcl_Channel errorChannel; errorInformation = Tcl_GetVar(interpreter, "errorInfo", TCL_GLOBAL_ONLY); if (errorInformation == 0) { errorInformation = ""; } errorChannel = Tcl_GetStdChannel(TCL_STDERR); if (errorChannel == NULL) return; sprintf(buffer, "%ld", (long)CURRENTTHREAD); Tcl_WriteChars(errorChannel, "Error from thread ", -1); Tcl_WriteChars(errorChannel, buffer, -1); Tcl_WriteChars(errorChannel, "\n", 1); Tcl_WriteChars(errorChannel, errorInformation, -1); Tcl_WriteChars(errorChannel, "\n", 1); }
void gdbtk_interp::pre_command_loop () { /* We no longer want to use stdin as the command input stream: disable events from stdin. */ main_ui->input_fd = -1; if (Tcl_Eval (gdbtk_tcl_interp, "gdbtk_tcl_preloop") != TCL_OK) { const char *msg; /* Force errorInfo to be set up propertly. */ Tcl_AddErrorInfo (gdbtk_tcl_interp, ""); msg = Tcl_GetVar (gdbtk_tcl_interp, "errorInfo", TCL_GLOBAL_ONLY); #ifdef _WIN32 MessageBox (NULL, msg, NULL, MB_OK | MB_ICONERROR | MB_TASKMODAL); #else fputs_unfiltered (msg, gdb_stderr); #endif } #ifdef _WIN32 close_bfds (); #endif }
/*--------------------------------------------------------------------------*/ BOOL TCL_ArrayExist(Tcl_Interp *TCLinterpreter,char *VarName) { BOOL bExist = FALSE; if (strcmp(VarName,TCL_VAR_NAME_TMP)) { char MyTclCommand[2048]; char *StrArrayExist=NULL; sprintf(MyTclCommand, "set TclScilabTmpVar [array exists %s];",VarName); if ( Tcl_Eval(TCLinterpreter,MyTclCommand) == TCL_ERROR ) { Scierror(999,_("Tcl Error : %s\n"),Tcl_GetStringResult(TCLinterpreter)); return FALSE; } StrArrayExist = (char *) Tcl_GetVar(TCLinterpreter, TCL_VAR_NAME_TMP,TCL_GLOBAL_ONLY); if (StrArrayExist) { int r = (int)atoi(StrArrayExist); if (r) bExist = TRUE; Tcl_UnsetVar(TCLinterpreter,TCL_VAR_NAME_TMP, TCL_GLOBAL_ONLY); } } return bExist; }
enum MqErrorE NS(ProcError) ( struct TclContextS * const tclctx, MQ_CST proc ) { SETUP_interp enum MqErrorE ret = MQ_OK; Tcl_Obj *item; Tcl_Obj *errorCode = Tcl_GetVar2Ex (interp, "errorCode", NULL, TCL_GLOBAL_ONLY); if ( Tcl_ListObjIndex (NULL, errorCode, 0, &item) == TCL_ERROR || // index "0" is not in the list "code" strncmp (Tcl_GetString (item), "TCLMSGQUE", 9) // error is not from "TCLMSGQUE" ) { // tcl error ret = MqErrorC (MQCTX,proc,-1,Tcl_GetVar (interp, "errorInfo", TCL_GLOBAL_ONLY)); } else { // tclmsgque error int errnum = -1; int errcode = -1; Tcl_ListObjIndex (NULL, errorCode, 1, &item); Tcl_GetIntFromObj(NULL, item, &errnum); Tcl_ListObjIndex (NULL, errorCode, 2, &item); Tcl_GetIntFromObj(NULL, item, &errcode); Tcl_ListObjIndex (NULL, errorCode, 3, &item); ret = MqErrorSet (MQCTX, errnum, (enum MqErrorE) errcode, Tcl_GetString(item), NULL); } Tcl_ResetResult(interp); return ret; }
static void gdbtk_command_loop (void) { extern FILE *instream; /* We no longer want to use stdin as the command input stream */ instream = NULL; if (Tcl_Eval (gdbtk_interp, "gdbtk_tcl_preloop") != TCL_OK) { const char *msg; /* Force errorInfo to be set up propertly. */ Tcl_AddErrorInfo (gdbtk_interp, ""); msg = Tcl_GetVar (gdbtk_interp, "errorInfo", TCL_GLOBAL_ONLY); #ifdef _WIN32 MessageBox (NULL, msg, NULL, MB_OK | MB_ICONERROR | MB_TASKMODAL); #else fputs_unfiltered (msg, gdb_stderr); #endif } #ifdef _WIN32 close_bfds (); #endif Tk_MainLoop (); }
/*--------------------------------------------------------------------------*/ int TCL_ArraySize(Tcl_Interp *TCLinterpreter, char *VarName) { int ArraySize = 0; if (strcmp(VarName, "TclScilabTmpVar")) { char MyTclCommand[2048]; char *StrArraySize = NULL; sprintf(MyTclCommand, "set TclScilabTmpVar [array size %s];", VarName); if ( Tcl_Eval(TCLinterpreter, MyTclCommand) == TCL_ERROR ) { Scierror(999, _("Tcl Error: %s\n"), Tcl_GetStringResult(TCLinterpreter)); return 0; } StrArraySize = (char *) Tcl_GetVar(TCLinterpreter, "TclScilabTmpVar", TCL_GLOBAL_ONLY); if (StrArraySize) { ArraySize = (int)atoi(StrArraySize); Tcl_UnsetVar(TCLinterpreter, "TclScilabTmpVar", TCL_GLOBAL_ONLY); } } return ArraySize; }
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); }
char *fset_rem_str(ClientData *cd, Tcl_Interp *intp, char *name1, char *name2, int flags) { char *s; IrcVariable *n; n = (IrcVariable *)cd; if ((s = Tcl_GetVar(intp, name1, TCL_GLOBAL_ONLY))) { malloc_strcpy(&n->string, s); } return NULL; }
/******************************************************************************* * * Name: cam_display_list( camera_t *, object_t * ) * * Purpose: Display list of given objecst is given list of cameras * * Parameters: * * Input: (camera_t *) input list of cameras * (object_t *) input list of objecst * * Output: graphics * * Return value: if mouse interaction is going on and too slow FALSE, * otherwise TRUE * *******************************************************************************/ int cam_display_list( camera_t *camera, object_t *object ) { double t = RealTime(), ct = CPUTime(); int FitToPage = 0, nofcameras; camera_t *cam; if ( GlobalOptions.OutputPS ) { initglp( Tcl_GetVar( TCLInterp, "PSFileName", TCL_GLOBAL_ONLY ), GlobalOptions.FitToPagePS ); } if ( user_hook_before_all ) (*user_hook_before_all)( camera,object ); nofcameras = 0; for( cam=camera; cam != NULL; cam = cam->Next, nofcameras++ ); for( GlobalPass=0; GlobalPass < 2; GlobalPass++ ) { for( cam=camera; cam != NULL; cam = cam->Next ) { if ( !cam->OnOff ) continue; gra_set_projection( cam->ProjectionType, cam->FieldAngle, cam->ViewportLowX, cam->ViewportHighX, cam->ViewportLowY, cam->ViewportHighY, cam->ClipNear, cam->ClipFar, nofcameras>1 ); gra_push_matrix(); gra_look_at( cam->LookFromX, cam->LookFromY, cam->LookFromZ, cam->LookAtX, cam->LookAtY, cam->LookAtZ, cam->UpX, cam->UpY, cam->UpZ ); if ( user_hook_camera_before ) (*user_hook_camera_before)( GlobalPass,cam,object,t ); if ( !obj_display_list( object, t ) ) return FALSE; if ( user_hook_camera_after ) (*user_hook_camera_after)( GlobalPass,cam,object,t ); gra_pop_matrix(); if ( BreakLoop ) break; } if ( BreakLoop ) break; } if ( user_hook_after_all ) (*user_hook_after_all)( camera,object ); if ( GlobalOptions.OutputPS ) stopglp(); return TRUE; }
static int simulateVtabError(echo_vtab *p, const char *zMethod){ const char *zErr; char zVarname[128]; zVarname[127] = '\0'; sqlite3_snprintf(127, zVarname, "echo_module_fail(%s,%s)", zMethod, p->zTableName); zErr = Tcl_GetVar(p->interp, zVarname, TCL_GLOBAL_ONLY); if( zErr ){ p->base.zErrMsg = sqlite3_mprintf("echo-vtab-error: %s", zErr); } return (zErr!=0); }
pure_expr *tk_get(const char *s) { char *result = NULL; if (tk_start(&result)) { const char *res = Tcl_GetVar(interp, s, TCL_GLOBAL_ONLY); if (res) return pure_string_dup(res); else return NULL; } else return tk_error(result); }
void ScriptTcl::doCallback(const char *labels, const char *data) { if ( ! callbackname ) return; int len = strlen(callbackname) + strlen(labels) + strlen(data) + 7; char *cmd = new char[len]; sprintf(cmd, "%s {%s} {%s}", callbackname, labels, data); int rval = Tcl_Eval(interp,cmd); delete [] cmd; if (rval != TCL_OK) { const char *errorInfo = Tcl_GetVar(interp,"errorInfo",0); NAMD_die(errorInfo); } }
int PacketDefCmd::delay_proc(ClientData clientData, Tcl_Interp *interp, int argc, char *argv[]) { //Check the StopTcl flag const char* stoptcl = Tcl_GetVar(interp,"StopTcl",TCL_GLOBAL_ONLY); if(stoptcl != NULL && (bcmp(stoptcl,"yes",3) == 0)) //TclIntepreter thread stop return TCL_BREAK; if(argc != 2 ) { //DataLog::insertERROR("delay command wrong, usage: delay value"); return TCL_ERROR; } int timecount; timecount = atoi(argv[1]); sprintf(logdata,"delay %d milliseconds",timecount*100); //DataLog::insertINFO(logdata); int time=0; while(time < timecount) { //sleep(1); usleep(100000); //100ms time++; //Check the StopTcl flag const char* stoptcl = Tcl_GetVar(interp,"StopTcl",TCL_GLOBAL_ONLY); if(stoptcl != NULL && (bcmp(stoptcl,"yes",3) == 0)) //TclIntepreter thread stop return TCL_BREAK; } //DataLog::insertINFO("delay timeout"); return TCL_OK; }
/* *---------------------------------------------------------------------- * * TcpHostPortList -- * * This function is called by the -gethostname and -getpeername * switches of TcpGetOptionProc() to add three list elements * with the textual representation of the given address to the * given DString. * * Results: * None. * * Side effects: * Adds three elements do dsPtr * *---------------------------------------------------------------------- */ static void TcpHostPortList( Tcl_Interp *interp, Tcl_DString *dsPtr, address addr, socklen_t salen) { #define SUPPRESS_RDNS_VAR "::tcl::unsupported::noReverseDNS" char host[NI_MAXHOST], nhost[NI_MAXHOST], nport[NI_MAXSERV]; int flags = 0; getnameinfo(&addr.sa, salen, nhost, sizeof(nhost), nport, sizeof(nport), NI_NUMERICHOST | NI_NUMERICSERV); Tcl_DStringAppendElement(dsPtr, nhost); /* * We don't want to resolve INADDR_ANY and sin6addr_any; they * can sometimes cause problems (and never have a name). */ if (addr.sa.sa_family == AF_INET) { if (addr.sa4.sin_addr.s_addr == INADDR_ANY) { flags |= NI_NUMERICHOST; } #ifndef NEED_FAKE_RFC2553 } else if (addr.sa.sa_family == AF_INET6) { if ((IN6_ARE_ADDR_EQUAL(&addr.sa6.sin6_addr, &in6addr_any)) || (IN6_IS_ADDR_V4MAPPED(&addr.sa6.sin6_addr) && addr.sa6.sin6_addr.s6_addr[12] == 0 && addr.sa6.sin6_addr.s6_addr[13] == 0 && addr.sa6.sin6_addr.s6_addr[14] == 0 && addr.sa6.sin6_addr.s6_addr[15] == 0)) { flags |= NI_NUMERICHOST; } #endif /* NEED_FAKE_RFC2553 */ } /* Check if reverse DNS has been switched off globally */ if (interp != NULL && Tcl_GetVar(interp, SUPPRESS_RDNS_VAR, 0) != NULL) { flags |= NI_NUMERICHOST; } if (getnameinfo(&addr.sa, salen, host, sizeof(host), NULL, 0, flags) == 0) { /* Reverse mapping worked */ Tcl_DStringAppendElement(dsPtr, host); } else { /* Reverse mappong failed - use the numeric rep once more */ Tcl_DStringAppendElement(dsPtr, nhost); } Tcl_DStringAppendElement(dsPtr, nport); }
void ScriptTcl::load(char *scriptFile) { #ifdef NAMD_TCL int code = Tcl_EvalFile(interp,scriptFile); const char *result = Tcl_GetStringResult(interp); if (*result != 0) CkPrintf("TCL: %s\n",result); if (code != TCL_OK) { const char *errorInfo = Tcl_GetVar(interp,"errorInfo",0); NAMD_die(errorInfo); } #else NAMD_bug("ScriptTcl::load called without Tcl."); #endif }
static char * setFullButtons(ClientData data, Tcl_Interp * interp, char * name1, char * name2, int flags) { char * val = Tcl_GetVar(interp, "whiptcl_fullbuttons", TCL_GLOBAL_ONLY); int rc; int state; if ((rc = Tcl_ExprBoolean(interp, val, &state))) { Tcl_FreeResult(interp); return "whiptcl_fullbuttons may only contain a boolean value"; } useFullButtons(state); return NULL; }