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 | ||
938a360f | 263 | delete [] a_string; |
264 | ||
7fd59977 | 265 | } |
266 | ||
267 | ||
268 | //======================================================================= | |
269 | //function : Remove | |
270 | //purpose : | |
271 | //======================================================================= | |
272 | ||
273 | Standard_Boolean Draw_Interpretor::Remove(Standard_CString const n) | |
274 | { | |
275 | Standard_PCharacter pN; | |
276 | // | |
277 | pN=(Standard_PCharacter)n; | |
278 | ||
279 | Standard_Integer result = Tcl_DeleteCommand(myInterp,pN); | |
280 | return result == 0; | |
281 | } | |
282 | ||
283 | //======================================================================= | |
284 | //function : Result | |
285 | //purpose : | |
286 | //======================================================================= | |
287 | ||
288 | Standard_CString Draw_Interpretor::Result() const | |
289 | { | |
290 | #if ((TCL_MAJOR_VERSION > 8) || ((TCL_MAJOR_VERSION == 8) && (TCL_MINOR_VERSION >= 5))) | |
291 | return Tcl_GetStringResult(myInterp); | |
292 | #else | |
293 | return myInterp->result; | |
294 | #endif | |
295 | } | |
296 | ||
297 | //======================================================================= | |
298 | //function : Reset | |
299 | //purpose : | |
300 | //======================================================================= | |
301 | ||
302 | void Draw_Interpretor::Reset() | |
303 | { | |
304 | Tcl_ResetResult(myInterp); | |
305 | } | |
306 | ||
307 | //======================================================================= | |
308 | //function : Append | |
309 | //purpose : | |
310 | //======================================================================= | |
311 | ||
312 | Draw_Interpretor& Draw_Interpretor::Append(const Standard_CString s) | |
313 | { | |
314 | #ifdef TCL_USES_UTF8 | |
315 | // Convert string to UTF-8 format for Tcl | |
316 | Tcl_DString TclString; | |
317 | Tcl_ExternalToUtfDString ( NULL, s, -1, &TclString ); | |
318 | Tcl_AppendResult ( myInterp, Tcl_DStringValue ( &TclString ), (Standard_CString)0 ); | |
319 | Tcl_DStringFree ( &TclString ); | |
320 | #else | |
321 | Tcl_AppendResult(myInterp,s,(Standard_CString)0); | |
322 | #endif | |
323 | return *this; | |
324 | } | |
325 | ||
326 | //======================================================================= | |
327 | //function : Append | |
328 | //purpose : | |
329 | //======================================================================= | |
330 | ||
331 | Draw_Interpretor& Draw_Interpretor::Append(const TCollection_AsciiString& s) | |
332 | { | |
333 | return Append (s.ToCString()); | |
334 | } | |
335 | ||
336 | //======================================================================= | |
337 | //function : Append | |
338 | //purpose : | |
339 | //======================================================================= | |
340 | ||
341 | Draw_Interpretor& Draw_Interpretor::Append(const TCollection_ExtendedString& theString) | |
342 | { | |
343 | #ifdef TCL_USES_UTF8 | |
344 | // Convert string to UTF-8 format for Tcl | |
345 | char *str = new char[theString.LengthOfCString()+1]; | |
346 | theString.ToUTF8CString (str); | |
347 | Tcl_AppendResult ( myInterp, str, (Standard_CString)0 ); | |
348 | delete[] str; | |
349 | #else | |
350 | // put as ascii string, replacing non-ascii characters by '?' | |
351 | TCollection_AsciiString str (theString, '?'); | |
352 | Tcl_AppendResult(myInterp,str.ToCString(),(Standard_CString)0); | |
353 | #endif | |
354 | return *this; | |
355 | } | |
356 | ||
357 | //======================================================================= | |
358 | //function : Append | |
359 | //purpose : | |
360 | //======================================================================= | |
361 | ||
362 | Draw_Interpretor& Draw_Interpretor::Append(const Standard_Integer i) | |
363 | { | |
364 | char c[100]; | |
365 | sprintf(c,"%d",i); | |
366 | Tcl_AppendResult(myInterp,c,(Standard_CString)0); | |
367 | return *this; | |
368 | } | |
369 | ||
370 | //======================================================================= | |
371 | //function : Append | |
372 | //purpose : | |
373 | //======================================================================= | |
374 | ||
375 | Draw_Interpretor& Draw_Interpretor::Append(const Standard_Real r) | |
376 | { | |
377 | char s[100]; | |
378 | sprintf(s,"%.17g",r); | |
379 | Tcl_AppendResult(myInterp,s,(Standard_CString)0); | |
380 | return *this; | |
381 | } | |
382 | ||
383 | //======================================================================= | |
384 | //function : Append | |
385 | //purpose : | |
386 | //======================================================================= | |
387 | ||
388 | Draw_Interpretor& Draw_Interpretor::Append(const Standard_SStream& s) | |
389 | { | |
390 | #ifdef USE_STL_STREAM | |
391 | return Append (s.str().c_str()); | |
392 | #else | |
393 | // Note: use dirty tricks -- unavoidable with old streams | |
394 | TCollection_AsciiString aStr (((Standard_SStream&)AReason).str(), AReason.pcount()); | |
395 | ((Standard_SStream&)AReason).freeze (false); | |
396 | return Append (aStr.ToCString()); | |
397 | #endif | |
398 | } | |
399 | ||
400 | //======================================================================= | |
401 | //function : AppendElement | |
402 | //purpose : | |
403 | //======================================================================= | |
404 | ||
405 | void Draw_Interpretor::AppendElement(const Standard_CString s) | |
406 | { | |
407 | #ifdef TCL_USES_UTF8 | |
408 | // Convert string to UTF-8 format for Tcl | |
409 | Tcl_DString TclString; | |
410 | Tcl_ExternalToUtfDString ( NULL, s, -1, &TclString ); | |
411 | Tcl_AppendElement ( myInterp, Tcl_DStringValue ( &TclString ) ); | |
412 | Tcl_DStringFree ( &TclString ); | |
413 | #else | |
414 | #ifdef IRIX | |
415 | //AppendElement is declared as (Tcl_Interp *interp, char *string) | |
416 | //on SGI 32 | |
417 | Tcl_AppendElement(myInterp,(char*) s); | |
418 | #else | |
419 | Tcl_AppendElement(myInterp, s); | |
420 | #endif | |
421 | #endif | |
422 | } | |
423 | ||
424 | //======================================================================= | |
425 | //function : Eval | |
426 | //purpose : | |
427 | //======================================================================= | |
428 | ||
429 | Standard_Integer Draw_Interpretor::Eval(const Standard_CString line) | |
430 | { | |
431 | Standard_PCharacter pLine; | |
432 | // | |
433 | pLine=(Standard_PCharacter)line; | |
434 | // | |
435 | return Tcl_Eval(myInterp,pLine); | |
436 | } | |
437 | ||
438 | ||
439 | //======================================================================= | |
440 | //function : Eval | |
441 | //purpose : | |
442 | //======================================================================= | |
443 | ||
444 | Standard_Integer Draw_Interpretor::RecordAndEval(const Standard_CString line, | |
445 | const Standard_Integer flags) | |
446 | { | |
447 | Standard_PCharacter pLine; | |
448 | // | |
449 | pLine=(Standard_PCharacter)line; | |
450 | return Tcl_RecordAndEval(myInterp,pLine,flags); | |
451 | } | |
452 | ||
453 | //======================================================================= | |
454 | //function : EvalFile | |
455 | //purpose : | |
456 | //======================================================================= | |
457 | ||
458 | Standard_Integer Draw_Interpretor::EvalFile(const Standard_CString fname) | |
459 | { | |
460 | Standard_PCharacter pfname; | |
461 | // | |
462 | pfname=(Standard_PCharacter)fname; | |
463 | return Tcl_EvalFile(myInterp,pfname); | |
464 | } | |
465 | ||
466 | //======================================================================= | |
467 | //function :Complete | |
468 | //purpose : | |
469 | //======================================================================= | |
470 | ||
471 | Standard_Boolean Draw_Interpretor::Complete(const Standard_CString line) | |
472 | { | |
473 | Standard_PCharacter pLine; | |
474 | // | |
475 | pLine=(Standard_PCharacter)line; | |
476 | return Tcl_CommandComplete(pLine); | |
477 | } | |
478 | ||
479 | //======================================================================= | |
480 | //function : Destroy | |
481 | //purpose : | |
482 | //======================================================================= | |
483 | ||
484 | void Draw_Interpretor::Destroy() | |
485 | { | |
486 | // MKV 01.02.05 | |
487 | #if ((TCL_MAJOR_VERSION > 8) || ((TCL_MAJOR_VERSION == 8) && (TCL_MINOR_VERSION >= 4))) | |
488 | try { | |
489 | OCC_CATCH_SIGNALS | |
490 | Tcl_Exit(0); | |
491 | } | |
492 | catch (Standard_Failure) { | |
493 | #ifdef DEB | |
494 | cout <<"Tcl_Exit have an exeption" << endl; | |
495 | #endif | |
496 | } | |
497 | #else | |
498 | #ifdef WNT | |
499 | Tcl_Exit(0); | |
500 | #endif | |
501 | #endif | |
502 | } | |
503 | ||
504 | //======================================================================= | |
505 | //function : Interp | |
506 | //purpose : | |
507 | //======================================================================= | |
508 | ||
509 | Draw_PInterp Draw_Interpretor::Interp() const | |
510 | { | |
511 | Standard_DomainError_Raise_if (myInterp==NULL , "No call for Draw_Interpretor::Init()"); | |
512 | return myInterp; | |
513 | } | |
514 | ||
515 | void Draw_Interpretor::Set(const Draw_PInterp& PIntrp) | |
516 | { | |
517 | if (isAllocated) | |
518 | Tcl_DeleteInterp(myInterp); | |
519 | isAllocated = Standard_False; | |
520 | myInterp = PIntrp; | |
521 | } |