Commit | Line | Data |
---|---|---|
7fd59977 | 1 | // File: Draw_Interpretor.cxx |
2 | // Created: Thu Feb 23 17:53:09 1995 | |
3 | // Author: Remi LEQUETTE | |
4 | // <rle@bravox> | |
5 | ||
6 | ||
7 | #include <Draw_Interpretor.ixx> | |
8 | #include <Draw_Appli.hxx> | |
9 | #include <Standard_SStream.hxx> | |
10 | #include <Standard_RangeError.hxx> | |
11 | #include <Standard_ErrorHandler.hxx> | |
12 | #include <Standard_Macro.hxx> | |
13 | ||
14 | #include <TCollection_AsciiString.hxx> | |
15 | #include <TCollection_ExtendedString.hxx> | |
16 | ||
17 | #include <string.h> | |
18 | ||
19 | #include <tcl.h> | |
20 | ||
21 | #if ((TCL_MAJOR_VERSION > 8) || ((TCL_MAJOR_VERSION == 8) && (TCL_MINOR_VERSION >= 1))) | |
22 | #define TCL_USES_UTF8 | |
23 | #endif | |
24 | ||
25 | // | |
26 | // Auxiliary tool to convert strings in command arguments from UTF-8 | |
27 | // (Tcl internal encoding since Tcl 8.1) to system local encoding, | |
28 | // normally extended Ascii as expected by OCC commands | |
29 | // | |
30 | class TclUTFToLocalStringSentry { | |
31 | public: | |
32 | ||
33 | #ifdef TCL_USES_UTF8 | |
34 | TclUTFToLocalStringSentry (int argc, const char **argv) : | |
35 | nb(0), | |
36 | TclArgv(new Tcl_DString[argc]), | |
37 | Argv(new char*[argc]) | |
38 | { | |
39 | for (; nb < argc; nb++ ) { | |
40 | Tcl_UtfToExternalDString ( NULL, argv[nb], -1, &TclArgv[nb] ); | |
41 | Argv[nb] = Tcl_DStringValue ( &TclArgv[nb] ); | |
42 | } | |
43 | } | |
44 | ||
45 | ~TclUTFToLocalStringSentry () | |
46 | { | |
47 | delete[] Argv; | |
48 | while ( nb-- >0 ) Tcl_DStringFree ( &TclArgv[nb] ); | |
49 | delete[] TclArgv; | |
50 | } | |
51 | #else | |
52 | TclUTFToLocalStringSentry (int, const char **argv) : Argv((char**)argv) {} | |
53 | #endif | |
54 | ||
55 | const char **GetArgv () const { return (const char **)Argv; } | |
56 | ||
57 | private: | |
58 | int nb; | |
59 | Tcl_DString *TclArgv; | |
60 | char **Argv; | |
61 | }; | |
62 | ||
63 | ||
64 | // | |
65 | // Call backs for TCL | |
66 | // | |
67 | ||
68 | struct CData { | |
69 | CData(Draw_CommandFunction ff, Draw_Interpretor* ii) : f(ff), i(ii) {} | |
70 | Draw_CommandFunction f; | |
71 | Draw_Interpretor* i; | |
72 | }; | |
73 | ||
74 | // MKV 29.03.05 | |
75 | #if ((TCL_MAJOR_VERSION > 8) || ((TCL_MAJOR_VERSION == 8) && (TCL_MINOR_VERSION >= 4))) && !defined(USE_NON_CONST) | |
76 | static Standard_Integer CommandCmd | |
77 | (ClientData clientData, Tcl_Interp *interp, | |
78 | Standard_Integer argc, const char* argv[]) | |
79 | #else | |
80 | static Standard_Integer CommandCmd | |
81 | (ClientData clientData, Tcl_Interp *interp, | |
82 | Standard_Integer argc, char* argv[]) | |
83 | #endif | |
84 | { | |
85 | static Standard_Integer code; | |
86 | code = TCL_OK; | |
87 | CData* C = (CData*) clientData; | |
88 | ||
89 | try { | |
90 | OCC_CATCH_SIGNALS | |
91 | ||
92 | // OCC63: Convert strings from UTF-8 to local encoding, normally expected by OCC commands | |
93 | TclUTFToLocalStringSentry anArgs ( argc, (const char**)argv ); | |
94 | ||
95 | Draw_Interpretor& di = *(C->i); | |
96 | Standard_Integer fres = C->f ( di, argc, anArgs.GetArgv() ); | |
97 | if (fres != 0) | |
98 | code = TCL_ERROR; | |
99 | } | |
100 | catch (Standard_Failure) { | |
101 | ||
102 | Handle(Standard_Failure) E = Standard_Failure::Caught(); | |
103 | ||
104 | // fail if Draw_ExitOnCatch is set | |
105 | // MKV 29.03.05 | |
106 | #if ((TCL_MAJOR_VERSION > 8) || ((TCL_MAJOR_VERSION == 8) && (TCL_MINOR_VERSION >= 4))) && !defined(USE_NON_CONST) | |
107 | const char* cc = Tcl_GetVar(interp, | |
108 | "Draw_ExitOnCatch",TCL_GLOBAL_ONLY); | |
109 | #else | |
110 | char* const cc = Tcl_GetVar(interp, | |
111 | "Draw_ExitOnCatch",TCL_GLOBAL_ONLY); | |
112 | #endif | |
113 | ||
114 | cout << "An exception was caught " << E << endl; | |
115 | ||
116 | if (cc && atoi(cc)) { | |
117 | #ifdef WNT | |
118 | Tcl_Exit(0); | |
119 | #else | |
120 | Tcl_Eval(interp,"exit"); | |
121 | #endif | |
122 | } | |
123 | ||
124 | // get the error message | |
125 | Standard_SStream ss; | |
126 | ss << "** Exception ** " << E << ends ; | |
127 | #ifdef USE_STL_STREAM | |
128 | Tcl_SetResult(interp,(char*)(ss.str().c_str()),TCL_VOLATILE); | |
129 | #else | |
130 | Tcl_SetResult(interp,(char*)(ss.str()),TCL_VOLATILE); | |
131 | #endif | |
132 | code = TCL_ERROR; | |
133 | } | |
134 | ||
135 | return code; | |
136 | } | |
137 | ||
138 | ||
139 | static void CommandDelete (ClientData clientData) | |
140 | { | |
141 | CData *C = (CData*) clientData; | |
142 | delete C; | |
143 | } | |
144 | ||
145 | //======================================================================= | |
146 | //function : Draw_Interpretor | |
147 | //purpose : | |
148 | //======================================================================= | |
149 | ||
150 | Draw_Interpretor::Draw_Interpretor() : | |
151 | isAllocated(Standard_False) | |
152 | { | |
0d969553 Y |
153 | // The tcl interpreter is not created immediately as it is kept |
154 | // by a global variable and created and deleted before the main(). | |
7fd59977 | 155 | myInterp = NULL; |
156 | } | |
157 | ||
158 | //======================================================================= | |
159 | //function : Init | |
0d969553 | 160 | //purpose : It is necessary to call this function |
7fd59977 | 161 | //======================================================================= |
162 | ||
163 | void Draw_Interpretor::Init() | |
164 | { | |
165 | if (isAllocated) | |
166 | Tcl_DeleteInterp(myInterp); | |
167 | isAllocated=Standard_True; | |
168 | myInterp=Tcl_CreateInterp(); | |
169 | } | |
170 | ||
171 | //======================================================================= | |
172 | //function : Draw_Interpretor | |
173 | //purpose : | |
174 | //======================================================================= | |
175 | ||
176 | Draw_Interpretor::Draw_Interpretor(const Draw_PInterp& p) : | |
177 | isAllocated(Standard_False), | |
178 | myInterp(p) | |
179 | { | |
180 | } | |
181 | ||
182 | //======================================================================= | |
183 | //function : Add | |
184 | //purpose : | |
185 | //======================================================================= | |
186 | //#ifdef WNT | |
187 | void Draw_Interpretor::Add(const Standard_CString n, | |
188 | const Standard_CString help, | |
189 | const Draw_CommandFunction f, | |
190 | const Standard_CString group) | |
191 | //#else | |
192 | //void Draw_Interpretor::Add(const Standard_CString n, | |
193 | // const Standard_CString help, | |
194 | // const Draw_CommandFunction& f, | |
195 | // const Standard_CString group) | |
196 | //#endif | |
197 | { | |
198 | Standard_PCharacter pN, pHelp, pGroup; | |
199 | // | |
200 | pN=(Standard_PCharacter)n; | |
201 | pHelp=(Standard_PCharacter)help; | |
202 | pGroup=(Standard_PCharacter)group; | |
203 | // | |
204 | if (myInterp==NULL) Init(); | |
205 | ||
206 | CData* C = new CData(f,this); | |
207 | ||
208 | Tcl_CreateCommand(myInterp, pN ,CommandCmd, (ClientData) C, CommandDelete); | |
209 | ||
210 | // add the help | |
211 | Tcl_SetVar2(myInterp,"Draw_Helps", pN, pHelp, TCL_GLOBAL_ONLY); | |
212 | Tcl_SetVar2(myInterp,"Draw_Groups",pGroup,pN, | |
213 | TCL_GLOBAL_ONLY|TCL_APPEND_VALUE|TCL_LIST_ELEMENT); | |
214 | } | |
215 | //======================================================================= | |
216 | //function : Add | |
217 | //purpose : | |
218 | //======================================================================= | |
219 | void Draw_Interpretor::Add(const Standard_CString n, | |
220 | const Standard_CString help, | |
221 | const Standard_CString file_name, | |
222 | const Draw_CommandFunction f, | |
223 | const Standard_CString group) | |
224 | { | |
225 | Standard_PCharacter pN, pHelp, pGroup, pFileName; | |
226 | // | |
227 | pN=(Standard_PCharacter)n; | |
228 | pHelp=(Standard_PCharacter)help; | |
229 | pGroup=(Standard_PCharacter)group; | |
230 | pFileName=(Standard_PCharacter)file_name; | |
231 | // | |
232 | if (myInterp==NULL) Init(); | |
233 | ||
234 | CData* C = new CData(f,this); | |
235 | Standard_Integer length, num_slashes, ii, jj, kk; | |
236 | Tcl_CreateCommand(myInterp,pN,CommandCmd, (ClientData) C, CommandDelete); | |
237 | ||
238 | // add the help | |
239 | Tcl_SetVar2(myInterp,"Draw_Helps",pN,pHelp,TCL_GLOBAL_ONLY); | |
240 | Tcl_SetVar2(myInterp,"Draw_Groups",pGroup,pN, | |
241 | TCL_GLOBAL_ONLY|TCL_APPEND_VALUE|TCL_LIST_ELEMENT); | |
242 | length = strlen(pFileName) ; | |
243 | char * a_string = | |
244 | new char[length + 1] ; | |
245 | jj = 0 ; | |
246 | num_slashes = 0 ; | |
247 | ii = length ; | |
248 | while (num_slashes < 3 && ii >= 0) { | |
249 | if (file_name[ii] == '/') { | |
250 | num_slashes += 1 ; | |
251 | } | |
252 | ii -= 1 ; | |
253 | } | |
254 | jj = 0 ; | |
255 | for (kk = ii+2 , jj =0 ; kk < length ; kk++) { | |
256 | a_string[jj] = file_name[kk] ; | |
257 | jj += 1 ; | |
258 | } | |
259 | a_string[jj] = '\0' ; | |
260 | ||
261 | Tcl_SetVar2(myInterp,"Draw_Files",pN,a_string,TCL_GLOBAL_ONLY); | |
262 | ||
263 | } | |
264 | ||
265 | ||
266 | //======================================================================= | |
267 | //function : Remove | |
268 | //purpose : | |
269 | //======================================================================= | |
270 | ||
271 | Standard_Boolean Draw_Interpretor::Remove(Standard_CString const n) | |
272 | { | |
273 | Standard_PCharacter pN; | |
274 | // | |
275 | pN=(Standard_PCharacter)n; | |
276 | ||
277 | Standard_Integer result = Tcl_DeleteCommand(myInterp,pN); | |
278 | return result == 0; | |
279 | } | |
280 | ||
281 | //======================================================================= | |
282 | //function : Result | |
283 | //purpose : | |
284 | //======================================================================= | |
285 | ||
286 | Standard_CString Draw_Interpretor::Result() const | |
287 | { | |
288 | #if ((TCL_MAJOR_VERSION > 8) || ((TCL_MAJOR_VERSION == 8) && (TCL_MINOR_VERSION >= 5))) | |
289 | return Tcl_GetStringResult(myInterp); | |
290 | #else | |
291 | return myInterp->result; | |
292 | #endif | |
293 | } | |
294 | ||
295 | //======================================================================= | |
296 | //function : Reset | |
297 | //purpose : | |
298 | //======================================================================= | |
299 | ||
300 | void Draw_Interpretor::Reset() | |
301 | { | |
302 | Tcl_ResetResult(myInterp); | |
303 | } | |
304 | ||
305 | //======================================================================= | |
306 | //function : Append | |
307 | //purpose : | |
308 | //======================================================================= | |
309 | ||
310 | Draw_Interpretor& Draw_Interpretor::Append(const Standard_CString s) | |
311 | { | |
312 | #ifdef TCL_USES_UTF8 | |
313 | // Convert string to UTF-8 format for Tcl | |
314 | Tcl_DString TclString; | |
315 | Tcl_ExternalToUtfDString ( NULL, s, -1, &TclString ); | |
316 | Tcl_AppendResult ( myInterp, Tcl_DStringValue ( &TclString ), (Standard_CString)0 ); | |
317 | Tcl_DStringFree ( &TclString ); | |
318 | #else | |
319 | Tcl_AppendResult(myInterp,s,(Standard_CString)0); | |
320 | #endif | |
321 | return *this; | |
322 | } | |
323 | ||
324 | //======================================================================= | |
325 | //function : Append | |
326 | //purpose : | |
327 | //======================================================================= | |
328 | ||
329 | Draw_Interpretor& Draw_Interpretor::Append(const TCollection_AsciiString& s) | |
330 | { | |
331 | return Append (s.ToCString()); | |
332 | } | |
333 | ||
334 | //======================================================================= | |
335 | //function : Append | |
336 | //purpose : | |
337 | //======================================================================= | |
338 | ||
339 | Draw_Interpretor& Draw_Interpretor::Append(const TCollection_ExtendedString& theString) | |
340 | { | |
341 | #ifdef TCL_USES_UTF8 | |
342 | // Convert string to UTF-8 format for Tcl | |
343 | char *str = new char[theString.LengthOfCString()+1]; | |
344 | theString.ToUTF8CString (str); | |
345 | Tcl_AppendResult ( myInterp, str, (Standard_CString)0 ); | |
346 | delete[] str; | |
347 | #else | |
348 | // put as ascii string, replacing non-ascii characters by '?' | |
349 | TCollection_AsciiString str (theString, '?'); | |
350 | Tcl_AppendResult(myInterp,str.ToCString(),(Standard_CString)0); | |
351 | #endif | |
352 | return *this; | |
353 | } | |
354 | ||
355 | //======================================================================= | |
356 | //function : Append | |
357 | //purpose : | |
358 | //======================================================================= | |
359 | ||
360 | Draw_Interpretor& Draw_Interpretor::Append(const Standard_Integer i) | |
361 | { | |
362 | char c[100]; | |
363 | sprintf(c,"%d",i); | |
364 | Tcl_AppendResult(myInterp,c,(Standard_CString)0); | |
365 | return *this; | |
366 | } | |
367 | ||
368 | //======================================================================= | |
369 | //function : Append | |
370 | //purpose : | |
371 | //======================================================================= | |
372 | ||
373 | Draw_Interpretor& Draw_Interpretor::Append(const Standard_Real r) | |
374 | { | |
375 | char s[100]; | |
376 | sprintf(s,"%.17g",r); | |
377 | Tcl_AppendResult(myInterp,s,(Standard_CString)0); | |
378 | return *this; | |
379 | } | |
380 | ||
381 | //======================================================================= | |
382 | //function : Append | |
383 | //purpose : | |
384 | //======================================================================= | |
385 | ||
386 | Draw_Interpretor& Draw_Interpretor::Append(const Standard_SStream& s) | |
387 | { | |
388 | #ifdef USE_STL_STREAM | |
389 | return Append (s.str().c_str()); | |
390 | #else | |
391 | // Note: use dirty tricks -- unavoidable with old streams | |
392 | TCollection_AsciiString aStr (((Standard_SStream&)AReason).str(), AReason.pcount()); | |
393 | ((Standard_SStream&)AReason).freeze (false); | |
394 | return Append (aStr.ToCString()); | |
395 | #endif | |
396 | } | |
397 | ||
398 | //======================================================================= | |
399 | //function : AppendElement | |
400 | //purpose : | |
401 | //======================================================================= | |
402 | ||
403 | void Draw_Interpretor::AppendElement(const Standard_CString s) | |
404 | { | |
405 | #ifdef TCL_USES_UTF8 | |
406 | // Convert string to UTF-8 format for Tcl | |
407 | Tcl_DString TclString; | |
408 | Tcl_ExternalToUtfDString ( NULL, s, -1, &TclString ); | |
409 | Tcl_AppendElement ( myInterp, Tcl_DStringValue ( &TclString ) ); | |
410 | Tcl_DStringFree ( &TclString ); | |
411 | #else | |
412 | #ifdef IRIX | |
413 | //AppendElement is declared as (Tcl_Interp *interp, char *string) | |
414 | //on SGI 32 | |
415 | Tcl_AppendElement(myInterp,(char*) s); | |
416 | #else | |
417 | Tcl_AppendElement(myInterp, s); | |
418 | #endif | |
419 | #endif | |
420 | } | |
421 | ||
422 | //======================================================================= | |
423 | //function : Eval | |
424 | //purpose : | |
425 | //======================================================================= | |
426 | ||
427 | Standard_Integer Draw_Interpretor::Eval(const Standard_CString line) | |
428 | { | |
429 | Standard_PCharacter pLine; | |
430 | // | |
431 | pLine=(Standard_PCharacter)line; | |
432 | // | |
433 | return Tcl_Eval(myInterp,pLine); | |
434 | } | |
435 | ||
436 | ||
437 | //======================================================================= | |
438 | //function : Eval | |
439 | //purpose : | |
440 | //======================================================================= | |
441 | ||
442 | Standard_Integer Draw_Interpretor::RecordAndEval(const Standard_CString line, | |
443 | const Standard_Integer flags) | |
444 | { | |
445 | Standard_PCharacter pLine; | |
446 | // | |
447 | pLine=(Standard_PCharacter)line; | |
448 | return Tcl_RecordAndEval(myInterp,pLine,flags); | |
449 | } | |
450 | ||
451 | //======================================================================= | |
452 | //function : EvalFile | |
453 | //purpose : | |
454 | //======================================================================= | |
455 | ||
456 | Standard_Integer Draw_Interpretor::EvalFile(const Standard_CString fname) | |
457 | { | |
458 | Standard_PCharacter pfname; | |
459 | // | |
460 | pfname=(Standard_PCharacter)fname; | |
461 | return Tcl_EvalFile(myInterp,pfname); | |
462 | } | |
463 | ||
464 | //======================================================================= | |
465 | //function :Complete | |
466 | //purpose : | |
467 | //======================================================================= | |
468 | ||
469 | Standard_Boolean Draw_Interpretor::Complete(const Standard_CString line) | |
470 | { | |
471 | Standard_PCharacter pLine; | |
472 | // | |
473 | pLine=(Standard_PCharacter)line; | |
474 | return Tcl_CommandComplete(pLine); | |
475 | } | |
476 | ||
477 | //======================================================================= | |
478 | //function : Destroy | |
479 | //purpose : | |
480 | //======================================================================= | |
481 | ||
482 | void Draw_Interpretor::Destroy() | |
483 | { | |
484 | // MKV 01.02.05 | |
485 | #if ((TCL_MAJOR_VERSION > 8) || ((TCL_MAJOR_VERSION == 8) && (TCL_MINOR_VERSION >= 4))) | |
486 | try { | |
487 | OCC_CATCH_SIGNALS | |
488 | Tcl_Exit(0); | |
489 | } | |
490 | catch (Standard_Failure) { | |
491 | #ifdef DEB | |
492 | cout <<"Tcl_Exit have an exeption" << endl; | |
493 | #endif | |
494 | } | |
495 | #else | |
496 | #ifdef WNT | |
497 | Tcl_Exit(0); | |
498 | #endif | |
499 | #endif | |
500 | } | |
501 | ||
502 | //======================================================================= | |
503 | //function : Interp | |
504 | //purpose : | |
505 | //======================================================================= | |
506 | ||
507 | Draw_PInterp Draw_Interpretor::Interp() const | |
508 | { | |
509 | Standard_DomainError_Raise_if (myInterp==NULL , "No call for Draw_Interpretor::Init()"); | |
510 | return myInterp; | |
511 | } | |
512 | ||
513 | void Draw_Interpretor::Set(const Draw_PInterp& PIntrp) | |
514 | { | |
515 | if (isAllocated) | |
516 | Tcl_DeleteInterp(myInterp); | |
517 | isAllocated = Standard_False; | |
518 | myInterp = PIntrp; | |
519 | } |