#include #include #include #include #ifdef DMALLOC #include #endif #include "config.h" #include #ifdef USING_STD_STRING using std::string; #endif #include "tcltk.h" #include "support.h" #include "messages.h" #include #include char *TT_Temp; Tcl_Interp* TT_Interp; int TT_Init(int *argc,char **argv) { Tcl_FindExecutable(argv[0]); TT_Interp = Tcl_CreateInterp(); #ifdef TCL_MEM_DEBUG Tcl_InitMemory(TT_Interp); #endif if (Tcl_Init(TT_Interp) == TCL_ERROR) { fprintf(stderr,"Error initializing Tcl:\n%s\n",TT_Interp->result); return TCL_ERROR; } // If there is a variable argv in interp, Tk_Init treats the contents of this // variable as a list of options for the new Tk application. The options may // have any of the forms documented for the wish application (in fact, wish // uses Tk_Init to process its command-line arguments). if (Tk_Init(TT_Interp) == TCL_ERROR) { fprintf(stderr,"Error initializing Tk:\n%s\n",TT_Interp->result); return TCL_ERROR; } /* Tcl_GlobalEval(TT_Interp,"checkmem tclmem.log"); Tcl_DeleteInterp(TT_Interp); Tcl_Exit(0); */ Tcl_StaticPackage(TT_Interp, "Tk", Tk_Init, Tk_SafeInit); return TCL_OK; } char *TT_Fix_Name(char *name) { char *p; TT_Temp=strdup(name); while((p=strstr(TT_Temp,"__"))) { *p=':'; *(p+1)=':'; } return TT_Temp; } void TT_Eval(Tcl_Interp *interp,char *filename,int line,char *command) { Tcl_Obj *objptr; objptr=Tcl_NewStringObj(command,strlen(command)); Tcl_IncrRefCount(objptr); //if(TCL_ERROR==Tcl_EvalObjEx(interp,objptr,TCL_EVAL_GLOBAL)) { if(TCL_ERROR==Tcl_GlobalEvalObj(interp,objptr)) { Tcl_VarEval(interp,"bgerror \"File: ",filename," Line: ",strnum(line),"\"",0); } Tcl_DecrRefCount(objptr); } void TT_EvalF(Tcl_Interp *interp,char *filename,int line,char *command, ...) { va_list ap; char *charp; char *p; int num; char *dst; int flags; Tcl_Obj *objptr; /* struct timeval tv; struct timezone tz; tz.tz_minuteswest=0; tz.tz_dsttime=0; if(gettimeofday(&tv,&tz)) { printf("gettimeofday()\n"); exit(1); } printf("Entering: %ld %ld\n",tv.tv_sec,tv.tv_usec); */ //printf("1\n"); //printf("%s\n",command); objptr=Tcl_NewStringObj("",0); Tcl_IncrRefCount(objptr); va_start(ap,command); for(p=command;*p;p++) { switch(*p) { case '%': p++; switch(*p) { case '%': Tcl_AppendToObj(objptr,"%",1); break; case 's': charp=va_arg(ap,char*); Tcl_AppendStringsToObj(objptr,charp,NULL); break; case 'd': num=va_arg(ap,int); Tcl_AppendStringsToObj(objptr,strnum(num),NULL); break; case 'q': charp=va_arg(ap,char*); dst=(char *)malloc(Tcl_ScanElement(charp,&flags)); flags|=TCL_DONT_USE_BRACES; Tcl_ConvertElement(charp, dst, flags); Tcl_AppendStringsToObj(objptr,dst,NULL); free(dst); break; default: Tcl_AppendToObj(objptr,"%",1); Tcl_AppendToObj(objptr,p,1); } break; default: Tcl_AppendToObj(objptr,p,1); } } va_end(ap); //if(TCL_ERROR==Tcl_EvalObjEx(interp,objptr,TCL_EVAL_GLOBAL|TCL_EVAL_DIRECT)) { if(TCL_ERROR==Tcl_GlobalEvalObj(interp,objptr)) { Tcl_VarEval(interp,"bgerror \"File: ",filename," Line: ",strnum(line),"\"",0); } //Record time and command name, show time elapsed and command name when complete. Maybe even rip string out of object before decreasing reference count. Tcl_DecrRefCount(objptr); /* if(gettimeofday(&tv,&tz)) { printf("gettimeofday()\n"); exit(1); } printf("Exiting: %ld %ld\n",tv.tv_sec,tv.tv_usec); */ //printf("2\n"); //printf("Finished Command\n"); } int TT_Int(Tcl_Interp *interp,char *filename,int line,char *command) { Tcl_Obj *objptr; objptr=Tcl_NewStringObj(command,strlen(command)); Tcl_IncrRefCount(objptr); //if(TCL_ERROR==Tcl_EvalObjEx(interp,objptr,TCL_EVAL_GLOBAL)) { if(TCL_ERROR==Tcl_GlobalEvalObj(interp,objptr)) { Tcl_VarEval(interp,"bgerror \"File: ",filename," Line: ",strnum(line),"\"",0); } Tcl_DecrRefCount(objptr); return(atoi(Tcl_GetStringResult(interp))); } int TT_IntF(Tcl_Interp *interp,char *filename,int line,char *command, ...) { va_list ap; char *charp; char *p; int num; char *dst; int flags; Tcl_Obj *objptr; objptr=Tcl_NewStringObj("",0); Tcl_IncrRefCount(objptr); va_start(ap,command); for(p=command;*p;p++) { switch(*p) { case '%': p++; switch(*p) { case '%': Tcl_AppendToObj(objptr,"%",1); break; case 's': charp=va_arg(ap,char*); Tcl_AppendStringsToObj(objptr,charp,NULL); break; case 'd': num=va_arg(ap,int); Tcl_AppendStringsToObj(objptr,strnum(num),NULL); break; case 'q': charp=va_arg(ap,char*); dst=(char *)malloc(Tcl_ScanElement(charp,&flags)); flags|=TCL_DONT_USE_BRACES; Tcl_ConvertElement(charp, dst, flags); Tcl_AppendStringsToObj(objptr,dst,NULL); free(dst); break; default: Tcl_AppendToObj(objptr,"%",1); Tcl_AppendToObj(objptr,p,1); } break; default: Tcl_AppendToObj(objptr,p,1); } } va_end(ap); //if(TCL_ERROR==Tcl_EvalObjEx(interp,objptr,TCL_EVAL_GLOBAL)) { if(TCL_ERROR==Tcl_GlobalEvalObj(interp,objptr)) { Tcl_VarEval(interp,"bgerror \"File: ",filename," Line: ",strnum(line),"\"",0); } Tcl_DecrRefCount(objptr); return(atoi(Tcl_GetStringResult(interp))); } const char *TT_Str(Tcl_Interp *interp, char *filename, int line, char *command) { Tcl_Obj *objptr; objptr=Tcl_NewStringObj(command,strlen(command)); Tcl_IncrRefCount(objptr); //if(TCL_ERROR==Tcl_EvalObjEx(interp,objptr,TCL_EVAL_GLOBAL)) { if(TCL_ERROR==Tcl_GlobalEvalObj(interp,objptr)) { Tcl_VarEval(interp,"bgerror \"File: ",filename," Line: ",strnum(line),"\"",0); } Tcl_DecrRefCount(objptr); return(Tcl_GetStringResult(interp)); } const char *TT_StrF(Tcl_Interp *interp, char *filename, int line, char *command, ...) { va_list ap; char *charp; char *p; int num; char *dst; int flags; Tcl_Obj *objptr; objptr=Tcl_NewStringObj("",0); Tcl_IncrRefCount(objptr); va_start(ap,command); for(p=command;*p;p++) { switch(*p) { case '%': p++; switch(*p) { case '%': Tcl_AppendToObj(objptr,"%",1); break; case 's': charp=va_arg(ap,char*); Tcl_AppendStringsToObj(objptr,charp,NULL); break; case 'd': num=va_arg(ap,int); Tcl_AppendStringsToObj(objptr,strnum(num),NULL); break; case 'q': charp=va_arg(ap,char*); dst=(char *)malloc(Tcl_ScanElement(charp,&flags)); flags|=TCL_DONT_USE_BRACES; Tcl_ConvertElement(charp, dst, flags); Tcl_AppendStringsToObj(objptr,dst,NULL); free(dst); break; default: Tcl_AppendToObj(objptr,"%",1); Tcl_AppendToObj(objptr,p,1); } break; default: Tcl_AppendToObj(objptr,p,1); } } va_end(ap); //if(TCL_ERROR==Tcl_EvalObjEx(interp,objptr,TCL_EVAL_GLOBAL)) { if(TCL_ERROR==Tcl_GlobalEvalObj(interp,objptr)) { Tcl_VarEval(interp,"bgerror \"File: ",filename," Line: ",strnum(line),"\"",0); } Tcl_DecrRefCount(objptr); /* static Tcl_DString dstr; #if TCL_VERSION == "8.0" Tcl_DStringGetResult(interp, &dstr); #else Tcl_UtfToExternalDString(NULL, Tcl_GetStringResult(interp), strlen(Tcl_GetStringResult(interp)), &dstr); #endif return &dstr; */ return Tcl_GetStringResult(interp); } int Tcl_ScanCountedElementFixed(const char *str, int length, int *flagPtr) { string copy; copy.assign(str,length); copy+=" "; return Tcl_ScanCountedElement(copy.data(),copy.length(),flagPtr); } /* char *TT_dstrdup(Tcl_DString *dstr) { char *result = strdup(Tcl_DStringGetValue(dstr)); if(!result) { fprintf(stderr,"%s",M_OUT_OF_MEMORY); exit(1); } // Free the dstr here. return result; } */