1 #include <stdlib.h>
2 #include <stdarg.h>
3 #include <string.h>
4 #include <sys/types.h>
5
6 #ifdef DMALLOC
7 #include <dmalloc.h>
8 #endif
9
10 #include "config.h"
11
12 #include <string>
13 #ifdef USING_STD_STRING
14 using std::string;
15 #endif
16
17 #include "tcltk.h"
18 #include "support.h"
19 #include "messages.h"
20
21 #include <sys/time.h>
22 #include <unistd.h>
23
24 char *TT_Temp;
25
26 Tcl_Interp* TT_Interp;
27
TT_Init(int * argc,char ** argv)28 int TT_Init(int *argc,char **argv) {
29 Tcl_FindExecutable(argv[0]);
30 TT_Interp = Tcl_CreateInterp();
31
32 #ifdef TCL_MEM_DEBUG
33 Tcl_InitMemory(TT_Interp);
34 #endif
35
36 if (Tcl_Init(TT_Interp) == TCL_ERROR) {
37 fprintf(stderr,"Error initializing Tcl:\n%s\n",Tcl_GetStringResult(TT_Interp));
38 return TCL_ERROR;
39 }
40
41 // If there is a variable argv in interp, Tk_Init treats the contents of this
42 // variable as a list of options for the new Tk application. The options may
43 // have any of the forms documented for the wish application (in fact, wish
44 // uses Tk_Init to process its command-line arguments).
45
46 if (Tk_Init(TT_Interp) == TCL_ERROR) {
47 fprintf(stderr,"Error initializing Tk:\n%s\n",Tcl_GetStringResult(TT_Interp));
48 return TCL_ERROR;
49 }
50
51 /*
52 Tcl_GlobalEval(TT_Interp,"checkmem tclmem.log");
53 Tcl_DeleteInterp(TT_Interp);
54 Tcl_Exit(0);
55 */
56
57 Tcl_StaticPackage(TT_Interp, "Tk", Tk_Init, Tk_SafeInit);
58 return TCL_OK;
59 }
60
TT_Fix_Name(char * name)61 char *TT_Fix_Name(char *name) {
62 char *p;
63 TT_Temp=strdup(name);
64 while((p=strstr(TT_Temp,"__"))) {
65 *p=':';
66 *(p+1)=':';
67 }
68 return TT_Temp;
69 }
70
TT_Eval(Tcl_Interp * interp,char * filename,int line,char * command)71 void TT_Eval(Tcl_Interp *interp,char *filename,int line,char *command) {
72 Tcl_Obj *objptr;
73 objptr=Tcl_NewStringObj(command,strlen(command));
74 Tcl_IncrRefCount(objptr);
75 //if(TCL_ERROR==Tcl_EvalObjEx(interp,objptr,TCL_EVAL_GLOBAL)) {
76 if(TCL_ERROR==Tcl_GlobalEvalObj(interp,objptr)) {
77 Tcl_VarEval(interp,"bgerror \"File: ",filename," Line: ",strnum(line),"\"",0);
78 }
79 Tcl_DecrRefCount(objptr);
80 }
81
TT_EvalF(Tcl_Interp * interp,char * filename,int line,char * command,...)82 void TT_EvalF(Tcl_Interp *interp,char *filename,int line,char *command, ...) {
83 va_list ap;
84 char *charp;
85 char *p;
86 int num;
87 char *dst;
88 int flags;
89 Tcl_Obj *objptr;
90
91 /*
92 struct timeval tv;
93 struct timezone tz;
94 tz.tz_minuteswest=0;
95 tz.tz_dsttime=0;
96 if(gettimeofday(&tv,&tz)) {
97 printf("gettimeofday()\n");
98 exit(1);
99 }
100 printf("Entering: %ld %ld\n",tv.tv_sec,tv.tv_usec);
101 */
102 //printf("1\n");
103 //printf("%s\n",command);
104 objptr=Tcl_NewStringObj("",0);
105 Tcl_IncrRefCount(objptr);
106 va_start(ap,command);
107 for(p=command;*p;p++) {
108 switch(*p) {
109 case '%':
110 p++;
111 switch(*p) {
112 case '%':
113 Tcl_AppendToObj(objptr,"%",1);
114 break;
115 case 's':
116 charp=va_arg(ap,char*);
117 Tcl_AppendStringsToObj(objptr,charp,NULL);
118 break;
119 case 'd':
120 num=va_arg(ap,int);
121 Tcl_AppendStringsToObj(objptr,strnum(num),NULL);
122 break;
123 case 'q':
124 charp=va_arg(ap,char*);
125 dst=(char *)malloc(Tcl_ScanElement(charp,&flags));
126 flags|=TCL_DONT_USE_BRACES;
127 Tcl_ConvertElement(charp, dst, flags);
128 Tcl_AppendStringsToObj(objptr,dst,NULL);
129 free(dst);
130 break;
131 default:
132 Tcl_AppendToObj(objptr,"%",1);
133 Tcl_AppendToObj(objptr,p,1);
134 }
135 break;
136 default:
137 Tcl_AppendToObj(objptr,p,1);
138 }
139 }
140 va_end(ap);
141
142 //if(TCL_ERROR==Tcl_EvalObjEx(interp,objptr,TCL_EVAL_GLOBAL|TCL_EVAL_DIRECT)) {
143 if(TCL_ERROR==Tcl_GlobalEvalObj(interp,objptr)) {
144 Tcl_VarEval(interp,"bgerror \"File: ",filename," Line: ",strnum(line),"\"",0);
145 }
146 //Record time and command name, show time elapsed and command name when complete. Maybe even rip string out of object before decreasing reference count.
147 Tcl_DecrRefCount(objptr);
148 /*
149 if(gettimeofday(&tv,&tz)) {
150 printf("gettimeofday()\n");
151 exit(1);
152 }
153 printf("Exiting: %ld %ld\n",tv.tv_sec,tv.tv_usec);
154 */
155 //printf("2\n");
156 //printf("Finished Command\n");
157 }
158
TT_Int(Tcl_Interp * interp,char * filename,int line,char * command)159 int TT_Int(Tcl_Interp *interp,char *filename,int line,char *command) {
160 Tcl_Obj *objptr;
161 objptr=Tcl_NewStringObj(command,strlen(command));
162 Tcl_IncrRefCount(objptr);
163 //if(TCL_ERROR==Tcl_EvalObjEx(interp,objptr,TCL_EVAL_GLOBAL)) {
164 if(TCL_ERROR==Tcl_GlobalEvalObj(interp,objptr)) {
165 Tcl_VarEval(interp,"bgerror \"File: ",filename," Line: ",strnum(line),"\"",0);
166 }
167 Tcl_DecrRefCount(objptr);
168 return(atoi(Tcl_GetStringResult(interp)));
169 }
170
TT_IntF(Tcl_Interp * interp,char * filename,int line,char * command,...)171 int TT_IntF(Tcl_Interp *interp,char *filename,int line,char *command, ...) {
172 va_list ap;
173 char *charp;
174 char *p;
175 int num;
176 char *dst;
177 int flags;
178 Tcl_Obj *objptr;
179
180 objptr=Tcl_NewStringObj("",0);
181 Tcl_IncrRefCount(objptr);
182 va_start(ap,command);
183 for(p=command;*p;p++) {
184 switch(*p) {
185 case '%':
186 p++;
187 switch(*p) {
188 case '%':
189 Tcl_AppendToObj(objptr,"%",1);
190 break;
191 case 's':
192 charp=va_arg(ap,char*);
193 Tcl_AppendStringsToObj(objptr,charp,NULL);
194 break;
195 case 'd':
196 num=va_arg(ap,int);
197 Tcl_AppendStringsToObj(objptr,strnum(num),NULL);
198 break;
199 case 'q':
200 charp=va_arg(ap,char*);
201 dst=(char *)malloc(Tcl_ScanElement(charp,&flags));
202 flags|=TCL_DONT_USE_BRACES;
203 Tcl_ConvertElement(charp, dst, flags);
204 Tcl_AppendStringsToObj(objptr,dst,NULL);
205 free(dst);
206 break;
207 default:
208 Tcl_AppendToObj(objptr,"%",1);
209 Tcl_AppendToObj(objptr,p,1);
210 }
211 break;
212 default:
213 Tcl_AppendToObj(objptr,p,1);
214 }
215 }
216 va_end(ap);
217
218 //if(TCL_ERROR==Tcl_EvalObjEx(interp,objptr,TCL_EVAL_GLOBAL)) {
219 if(TCL_ERROR==Tcl_GlobalEvalObj(interp,objptr)) {
220 Tcl_VarEval(interp,"bgerror \"File: ",filename," Line: ",strnum(line),"\"",0);
221 }
222 Tcl_DecrRefCount(objptr);
223 return(atoi(Tcl_GetStringResult(interp)));
224 }
225
TT_Str(Tcl_Interp * interp,char * filename,int line,char * command)226 const char *TT_Str(Tcl_Interp *interp,
227 char *filename,
228 int line,
229 char *command) {
230 Tcl_Obj *objptr;
231 objptr=Tcl_NewStringObj(command,strlen(command));
232 Tcl_IncrRefCount(objptr);
233 //if(TCL_ERROR==Tcl_EvalObjEx(interp,objptr,TCL_EVAL_GLOBAL)) {
234 if(TCL_ERROR==Tcl_GlobalEvalObj(interp,objptr)) {
235 Tcl_VarEval(interp,"bgerror \"File: ",filename," Line: ",strnum(line),"\"",0);
236 }
237 Tcl_DecrRefCount(objptr);
238 return(Tcl_GetStringResult(interp));
239 }
240
TT_StrF(Tcl_Interp * interp,char * filename,int line,char * command,...)241 const char *TT_StrF(Tcl_Interp *interp,
242 char *filename,
243 int line,
244 char *command,
245 ...) {
246 va_list ap;
247 char *charp;
248 char *p;
249 int num;
250 char *dst;
251 int flags;
252 Tcl_Obj *objptr;
253
254 objptr=Tcl_NewStringObj("",0);
255 Tcl_IncrRefCount(objptr);
256 va_start(ap,command);
257 for(p=command;*p;p++) {
258 switch(*p) {
259 case '%':
260 p++;
261 switch(*p) {
262 case '%':
263 Tcl_AppendToObj(objptr,"%",1);
264 break;
265 case 's':
266 charp=va_arg(ap,char*);
267 Tcl_AppendStringsToObj(objptr,charp,NULL);
268 break;
269 case 'd':
270 num=va_arg(ap,int);
271 Tcl_AppendStringsToObj(objptr,strnum(num),NULL);
272 break;
273 case 'q':
274 charp=va_arg(ap,char*);
275 dst=(char *)malloc(Tcl_ScanElement(charp,&flags));
276 flags|=TCL_DONT_USE_BRACES;
277 Tcl_ConvertElement(charp, dst, flags);
278 Tcl_AppendStringsToObj(objptr,dst,NULL);
279 free(dst);
280 break;
281 default:
282 Tcl_AppendToObj(objptr,"%",1);
283 Tcl_AppendToObj(objptr,p,1);
284 }
285 break;
286 default:
287 Tcl_AppendToObj(objptr,p,1);
288 }
289 }
290 va_end(ap);
291
292 //if(TCL_ERROR==Tcl_EvalObjEx(interp,objptr,TCL_EVAL_GLOBAL)) {
293 if(TCL_ERROR==Tcl_GlobalEvalObj(interp,objptr)) {
294 Tcl_VarEval(interp,"bgerror \"File: ",filename," Line: ",strnum(line),"\"",0);
295 }
296 Tcl_DecrRefCount(objptr);
297 /*
298 static Tcl_DString dstr;
299 #if TCL_VERSION == "8.0"
300 Tcl_DStringGetResult(interp, &dstr);
301 #else
302 Tcl_UtfToExternalDString(NULL,
303 Tcl_GetStringResult(interp),
304 strlen(Tcl_GetStringResult(interp)),
305 &dstr);
306 #endif
307 return &dstr;
308 */
309 return Tcl_GetStringResult(interp);
310 }
311
Tcl_ScanCountedElementFixed(const char * str,int length,int * flagPtr)312 int Tcl_ScanCountedElementFixed(const char *str, int length, int *flagPtr) {
313 string copy;
314 copy.assign(str,length);
315 copy+=" ";
316 return Tcl_ScanCountedElement(copy.data(),copy.length(),flagPtr);
317 }
318
319 /*
320 char *TT_dstrdup(Tcl_DString *dstr) {
321 char *result = strdup(Tcl_DStringGetValue(dstr));
322 if(!result) {
323 fprintf(stderr,"%s",M_OUT_OF_MEMORY);
324 exit(1);
325 }
326 // Free the dstr here.
327 return result;
328 }
329 */
330