1 // Created on: 1995-02-23
2 // Created by: Remi LEQUETTE
3 // Copyright (c) 1995-1999 Matra Datavision
4 // Copyright (c) 1999-2012 OPEN CASCADE SAS
6 // The content of this file is subject to the Open CASCADE Technology Public
7 // License Version 6.5 (the "License"). You may not use the content of this file
8 // except in compliance with the License. Please obtain a copy of the License
9 // at http://www.opencascade.org and read it completely before using this file.
11 // The Initial Developer of the Original Code is Open CASCADE S.A.S., having its
12 // main offices at: 1, place des Freres Montgolfier, 78280 Guyancourt, France.
14 // The Original Code and all software distributed under the License is
15 // distributed on an "AS IS" basis, without warranty of any kind, and the
16 // Initial Developer hereby disclaims all such warranties, including without
17 // limitation, any warranties of merchantability, fitness for a particular
18 // purpose or non-infringement. Please see the License for the specific terms
19 // and conditions governing the rights and limitations under the License.
23 #include <Draw_Interpretor.ixx>
24 #include <Draw_Appli.hxx>
25 #include <Standard_SStream.hxx>
26 #include <Standard_RangeError.hxx>
27 #include <Standard_ErrorHandler.hxx>
28 #include <Standard_Macro.hxx>
30 #include <TCollection_AsciiString.hxx>
31 #include <TCollection_ExtendedString.hxx>
37 #if ((TCL_MAJOR_VERSION > 8) || ((TCL_MAJOR_VERSION == 8) && (TCL_MINOR_VERSION >= 1)))
42 // Auxiliary tool to convert strings in command arguments from UTF-8
43 // (Tcl internal encoding since Tcl 8.1) to system local encoding,
44 // normally extended Ascii as expected by OCC commands
46 class TclUTFToLocalStringSentry {
50 TclUTFToLocalStringSentry (int argc, const char **argv) :
52 TclArgv(new Tcl_DString[argc]),
55 for (; nb < argc; nb++ ) {
56 Tcl_UtfToExternalDString ( NULL, argv[nb], -1, &TclArgv[nb] );
57 Argv[nb] = Tcl_DStringValue ( &TclArgv[nb] );
61 ~TclUTFToLocalStringSentry ()
64 while ( nb-- >0 ) Tcl_DStringFree ( &TclArgv[nb] );
68 TclUTFToLocalStringSentry (int, const char **argv) : Argv((char**)argv) {}
71 const char **GetArgv () const { return (const char **)Argv; }
85 CData(Draw_CommandFunction ff, Draw_Interpretor* ii) : f(ff), i(ii) {}
86 Draw_CommandFunction f;
91 #if ((TCL_MAJOR_VERSION > 8) || ((TCL_MAJOR_VERSION == 8) && (TCL_MINOR_VERSION >= 4))) && !defined(USE_NON_CONST)
92 static Standard_Integer CommandCmd
93 (ClientData clientData, Tcl_Interp *interp,
94 Standard_Integer argc, const char* argv[])
96 static Standard_Integer CommandCmd
97 (ClientData clientData, Tcl_Interp *interp,
98 Standard_Integer argc, char* argv[])
101 static Standard_Integer code;
103 CData* C = (CData*) clientData;
108 // OCC63: Convert strings from UTF-8 to local encoding, normally expected by OCC commands
109 TclUTFToLocalStringSentry anArgs ( argc, (const char**)argv );
111 Draw_Interpretor& di = *(C->i);
112 Standard_Integer fres = C->f ( di, argc, anArgs.GetArgv() );
116 catch (Standard_Failure) {
118 Handle(Standard_Failure) E = Standard_Failure::Caught();
120 // fail if Draw_ExitOnCatch is set
122 #if ((TCL_MAJOR_VERSION > 8) || ((TCL_MAJOR_VERSION == 8) && (TCL_MINOR_VERSION >= 4))) && !defined(USE_NON_CONST)
123 const char* cc = Tcl_GetVar(interp,
124 "Draw_ExitOnCatch",TCL_GLOBAL_ONLY);
126 char* const cc = Tcl_GetVar(interp,
127 "Draw_ExitOnCatch",TCL_GLOBAL_ONLY);
130 cout << "An exception was caught " << E << endl;
132 if (cc && atoi(cc)) {
136 Tcl_Eval(interp,"exit");
140 // get the error message
142 ss << "** Exception ** " << E << ends ;
143 #ifdef USE_STL_STREAM
144 Tcl_SetResult(interp,(char*)(ss.str().c_str()),TCL_VOLATILE);
146 Tcl_SetResult(interp,(char*)(ss.str()),TCL_VOLATILE);
155 static void CommandDelete (ClientData clientData)
157 CData *C = (CData*) clientData;
161 //=======================================================================
162 //function : Draw_Interpretor
164 //=======================================================================
166 Draw_Interpretor::Draw_Interpretor() :
167 isAllocated(Standard_False)
169 // The tcl interpreter is not created immediately as it is kept
170 // by a global variable and created and deleted before the main().
174 //=======================================================================
176 //purpose : It is necessary to call this function
177 //=======================================================================
179 void Draw_Interpretor::Init()
182 Tcl_DeleteInterp(myInterp);
183 isAllocated=Standard_True;
184 myInterp=Tcl_CreateInterp();
187 //=======================================================================
188 //function : Draw_Interpretor
190 //=======================================================================
192 Draw_Interpretor::Draw_Interpretor(const Draw_PInterp& p) :
193 isAllocated(Standard_False),
198 //=======================================================================
201 //=======================================================================
203 void Draw_Interpretor::Add(const Standard_CString n,
204 const Standard_CString help,
205 const Draw_CommandFunction f,
206 const Standard_CString group)
208 //void Draw_Interpretor::Add(const Standard_CString n,
209 // const Standard_CString help,
210 // const Draw_CommandFunction& f,
211 // const Standard_CString group)
214 Standard_PCharacter pN, pHelp, pGroup;
216 pN=(Standard_PCharacter)n;
217 pHelp=(Standard_PCharacter)help;
218 pGroup=(Standard_PCharacter)group;
220 if (myInterp==NULL) Init();
222 CData* C = new CData(f,this);
224 Tcl_CreateCommand(myInterp, pN ,CommandCmd, (ClientData) C, CommandDelete);
227 Tcl_SetVar2(myInterp,"Draw_Helps", pN, pHelp, TCL_GLOBAL_ONLY);
228 Tcl_SetVar2(myInterp,"Draw_Groups",pGroup,pN,
229 TCL_GLOBAL_ONLY|TCL_APPEND_VALUE|TCL_LIST_ELEMENT);
231 //=======================================================================
234 //=======================================================================
235 void Draw_Interpretor::Add(const Standard_CString n,
236 const Standard_CString help,
237 const Standard_CString file_name,
238 const Draw_CommandFunction f,
239 const Standard_CString group)
241 Standard_PCharacter pN, pHelp, pGroup, pFileName;
243 pN=(Standard_PCharacter)n;
244 pHelp=(Standard_PCharacter)help;
245 pGroup=(Standard_PCharacter)group;
246 pFileName=(Standard_PCharacter)file_name;
248 if (myInterp==NULL) Init();
250 CData* C = new CData(f,this);
251 Standard_Integer length, num_slashes, ii, jj, kk;
252 Tcl_CreateCommand(myInterp,pN,CommandCmd, (ClientData) C, CommandDelete);
255 Tcl_SetVar2(myInterp,"Draw_Helps",pN,pHelp,TCL_GLOBAL_ONLY);
256 Tcl_SetVar2(myInterp,"Draw_Groups",pGroup,pN,
257 TCL_GLOBAL_ONLY|TCL_APPEND_VALUE|TCL_LIST_ELEMENT);
258 length = strlen(pFileName) ;
260 new char[length + 1] ;
264 while (num_slashes < 3 && ii >= 0) {
265 if (file_name[ii] == '/') {
271 for (kk = ii+2 , jj =0 ; kk < length ; kk++) {
272 a_string[jj] = file_name[kk] ;
275 a_string[jj] = '\0' ;
277 Tcl_SetVar2(myInterp,"Draw_Files",pN,a_string,TCL_GLOBAL_ONLY);
284 //=======================================================================
287 //=======================================================================
289 Standard_Boolean Draw_Interpretor::Remove(Standard_CString const n)
291 Standard_PCharacter pN;
293 pN=(Standard_PCharacter)n;
295 Standard_Integer result = Tcl_DeleteCommand(myInterp,pN);
299 //=======================================================================
302 //=======================================================================
304 Standard_CString Draw_Interpretor::Result() const
306 #if ((TCL_MAJOR_VERSION > 8) || ((TCL_MAJOR_VERSION == 8) && (TCL_MINOR_VERSION >= 5)))
307 return Tcl_GetStringResult(myInterp);
309 return myInterp->result;
313 //=======================================================================
316 //=======================================================================
318 void Draw_Interpretor::Reset()
320 Tcl_ResetResult(myInterp);
323 //=======================================================================
326 //=======================================================================
328 Draw_Interpretor& Draw_Interpretor::Append(const Standard_CString s)
331 // Convert string to UTF-8 format for Tcl
332 Tcl_DString TclString;
333 Tcl_ExternalToUtfDString ( NULL, s, -1, &TclString );
334 Tcl_AppendResult ( myInterp, Tcl_DStringValue ( &TclString ), (Standard_CString)0 );
335 Tcl_DStringFree ( &TclString );
337 Tcl_AppendResult(myInterp,s,(Standard_CString)0);
342 //=======================================================================
345 //=======================================================================
347 Draw_Interpretor& Draw_Interpretor::Append(const TCollection_AsciiString& s)
349 return Append (s.ToCString());
352 //=======================================================================
355 //=======================================================================
357 Draw_Interpretor& Draw_Interpretor::Append(const TCollection_ExtendedString& theString)
360 // Convert string to UTF-8 format for Tcl
361 char *str = new char[theString.LengthOfCString()+1];
362 theString.ToUTF8CString (str);
363 Tcl_AppendResult ( myInterp, str, (Standard_CString)0 );
366 // put as ascii string, replacing non-ascii characters by '?'
367 TCollection_AsciiString str (theString, '?');
368 Tcl_AppendResult(myInterp,str.ToCString(),(Standard_CString)0);
373 //=======================================================================
376 //=======================================================================
378 Draw_Interpretor& Draw_Interpretor::Append(const Standard_Integer i)
382 Tcl_AppendResult(myInterp,c,(Standard_CString)0);
386 //=======================================================================
389 //=======================================================================
391 Draw_Interpretor& Draw_Interpretor::Append(const Standard_Real r)
394 sprintf(s,"%.17g",r);
395 Tcl_AppendResult(myInterp,s,(Standard_CString)0);
399 //=======================================================================
402 //=======================================================================
404 Draw_Interpretor& Draw_Interpretor::Append(const Standard_SStream& s)
406 #ifdef USE_STL_STREAM
407 return Append (s.str().c_str());
409 // Note: use dirty tricks -- unavoidable with old streams
410 TCollection_AsciiString aStr (((Standard_SStream&)AReason).str(), AReason.pcount());
411 ((Standard_SStream&)AReason).freeze (false);
412 return Append (aStr.ToCString());
416 //=======================================================================
417 //function : AppendElement
419 //=======================================================================
421 void Draw_Interpretor::AppendElement(const Standard_CString s)
424 // Convert string to UTF-8 format for Tcl
425 Tcl_DString TclString;
426 Tcl_ExternalToUtfDString ( NULL, s, -1, &TclString );
427 Tcl_AppendElement ( myInterp, Tcl_DStringValue ( &TclString ) );
428 Tcl_DStringFree ( &TclString );
431 //AppendElement is declared as (Tcl_Interp *interp, char *string)
433 Tcl_AppendElement(myInterp,(char*) s);
435 Tcl_AppendElement(myInterp, s);
440 //=======================================================================
443 //=======================================================================
445 Standard_Integer Draw_Interpretor::Eval(const Standard_CString line)
447 Standard_PCharacter pLine;
449 pLine=(Standard_PCharacter)line;
451 return Tcl_Eval(myInterp,pLine);
455 //=======================================================================
458 //=======================================================================
460 Standard_Integer Draw_Interpretor::RecordAndEval(const Standard_CString line,
461 const Standard_Integer flags)
463 Standard_PCharacter pLine;
465 pLine=(Standard_PCharacter)line;
466 return Tcl_RecordAndEval(myInterp,pLine,flags);
469 //=======================================================================
470 //function : EvalFile
472 //=======================================================================
474 Standard_Integer Draw_Interpretor::EvalFile(const Standard_CString fname)
476 Standard_PCharacter pfname;
478 pfname=(Standard_PCharacter)fname;
479 return Tcl_EvalFile(myInterp,pfname);
482 //=======================================================================
485 //=======================================================================
487 Standard_Boolean Draw_Interpretor::Complete(const Standard_CString line)
489 Standard_PCharacter pLine;
491 pLine=(Standard_PCharacter)line;
492 return Tcl_CommandComplete(pLine);
495 //=======================================================================
498 //=======================================================================
500 void Draw_Interpretor::Destroy()
503 #if ((TCL_MAJOR_VERSION > 8) || ((TCL_MAJOR_VERSION == 8) && (TCL_MINOR_VERSION >= 4)))
508 catch (Standard_Failure) {
510 cout <<"Tcl_Exit have an exeption" << endl;
520 //=======================================================================
523 //=======================================================================
525 Draw_PInterp Draw_Interpretor::Interp() const
527 Standard_DomainError_Raise_if (myInterp==NULL , "No call for Draw_Interpretor::Init()");
531 void Draw_Interpretor::Set(const Draw_PInterp& PIntrp)
534 Tcl_DeleteInterp(myInterp);
535 isAllocated = Standard_False;