1 // Created on: 1995-02-23
2 // Created by: Remi LEQUETTE
3 // Copyright (c) 1995-1999 Matra Datavision
4 // Copyright (c) 1999-2014 OPEN CASCADE SAS
6 // This file is part of Open CASCADE Technology software library.
8 // This library is free software; you can redistribute it and/or modify it under
9 // the terms of the GNU Lesser General Public License version 2.1 as published
10 // by the Free Software Foundation, with special exception defined in the file
11 // OCCT_LGPL_EXCEPTION.txt. Consult the file LICENSE_LGPL_21.txt included in OCCT
12 // distribution for complete text of the license and disclaimer of any warranty.
14 // Alternatively, this file may be used under the terms of Open CASCADE
15 // commercial license or contractual agreement.
17 #include <Draw_Interpretor.hxx>
18 #include <Draw_Appli.hxx>
19 #include <Standard_SStream.hxx>
20 #include <Standard_RangeError.hxx>
21 #include <Standard_ErrorHandler.hxx>
22 #include <Standard_Macro.hxx>
24 #include <TCollection_AsciiString.hxx>
25 #include <TCollection_ExtendedString.hxx>
26 #include <OSD_Process.hxx>
27 #include <OSD_Path.hxx>
33 // for capturing of cout and cerr (dup(), dup2())
41 #if ! defined(STDOUT_FILENO)
42 #define STDOUT_FILENO fileno(stdout)
44 #if ! defined(STDERR_FILENO)
45 #define STDERR_FILENO fileno(stderr)
48 #if ((TCL_MAJOR_VERSION > 8) || ((TCL_MAJOR_VERSION == 8) && (TCL_MINOR_VERSION >= 1)))
53 // Auxiliary tool to convert strings in command arguments from UTF-8
54 // (Tcl internal encoding since Tcl 8.1) to system local encoding,
55 // normally extended Ascii as expected by OCC commands
57 class TclUTFToLocalStringSentry {
61 TclUTFToLocalStringSentry (int argc, const char **argv) :
63 TclArgv(new Tcl_DString[argc]),
66 for (; nb < argc; nb++ ) {
67 Tcl_UtfToExternalDString ( NULL, argv[nb], -1, &TclArgv[nb] );
68 Argv[nb] = Tcl_DStringValue ( &TclArgv[nb] );
72 ~TclUTFToLocalStringSentry ()
75 while ( nb-- >0 ) Tcl_DStringFree ( &TclArgv[nb] );
79 TclUTFToLocalStringSentry (int, const char **argv) :
86 const char **GetArgv () const { return (const char **)Argv; }
96 void dumpArgs (Standard_OStream& os, int argc, const char *argv[])
98 for (int i=0; i < argc; i++)
103 void flush_standard_streams ()
111 FILE* capture_start (int std_fd, int *save_fd, char*& tmp_name)
115 // open temporary files
117 // use _tempnam() to decrease chances of failure (tmpfile() creates
118 // file in root folder and will fail if it is write protected), see #24132
119 static const char* tmpdir = getenv("TEMP");
120 static char prefix[256] = ""; // prefix for temporary files, initialize once per process using pid
121 if (prefix[0] == '\0')
122 sprintf (prefix, "drawtmp%d_", (int)OSD_Process().ProcessId());
123 tmp_name = _tempnam (tmpdir, prefix);
124 FILE* aTmpFile = (tmp_name != NULL ? fopen (tmp_name, "w+b") : tmpfile());
127 FILE* aTmpFile = tmpfile();
129 int fd_tmp = (aTmpFile != NULL ? fileno (aTmpFile) : -1);
132 cerr << "Error: cannot create temporary file for capturing console output" << endl;
137 // remember current file descriptors of standard stream, and replace it by temporary
138 (*save_fd) = dup(std_fd);
139 dup2(fd_tmp, std_fd);
143 void capture_end (FILE* tmp_file, int std_fd, int save_fd, char* tmp_name, Standard_OStream &log, Standard_Boolean doEcho)
148 // restore normal descriptors of console stream
149 dup2 (save_fd, std_fd);
152 // extract all output and copy it to log and optionally to cout
153 const int BUFSIZE = 2048;
156 while (fgets (buf, BUFSIZE, tmp_file) != NULL)
163 // close temporary file
166 // remove temporary file if this is not done by the system
173 #if ((TCL_MAJOR_VERSION > 8) || ((TCL_MAJOR_VERSION == 8) && (TCL_MINOR_VERSION >= 4))) && !defined(USE_NON_CONST)
174 static Standard_Integer CommandCmd
175 (ClientData theClientData, Tcl_Interp *interp,
176 Standard_Integer argc, const char* argv[])
178 static Standard_Integer CommandCmd
179 (ClientData theClientData, Tcl_Interp *interp,
180 Standard_Integer argc, char* argv[])
183 static Standard_Integer code;
185 Draw_Interpretor::CallBackData* aCallback = (Draw_Interpretor::CallBackData* )theClientData;
186 Draw_Interpretor& di = *(aCallback->myDI);
188 // log command execution, except commands manipulating log itself and echo
189 Standard_Boolean isLogManipulation = (strcmp (argv[0], "dlog") == 0 ||
190 strcmp (argv[0], "decho") == 0);
191 Standard_Boolean doLog = (di.GetDoLog() && ! isLogManipulation);
192 Standard_Boolean doEcho = (di.GetDoEcho() && ! isLogManipulation);
194 dumpArgs (di.Log(), argc, argv);
196 dumpArgs (cout, argc, argv);
198 // flush cerr and cout
199 flush_standard_streams();
201 // capture cout and cerr to log
202 char *err_name = NULL, *out_name = NULL;
203 FILE * aFile_err = NULL;
204 FILE * aFile_out = NULL;
209 aFile_out = capture_start (STDOUT_FILENO, &fd_out_save, out_name);
210 aFile_err = capture_start (STDERR_FILENO, &fd_err_save, err_name);
217 // get exception if control-break has been pressed
220 // OCC63: Convert strings from UTF-8 to local encoding, normally expected by OCC commands
221 TclUTFToLocalStringSentry anArgs ( argc, (const char**)argv );
223 Standard_Integer fres = aCallback->Invoke ( di, argc, anArgs.GetArgv() );
227 catch (Standard_Failure) {
229 Handle(Standard_Failure) E = Standard_Failure::Caught();
231 // fail if Draw_ExitOnCatch is set
233 #if ((TCL_MAJOR_VERSION > 8) || ((TCL_MAJOR_VERSION == 8) && (TCL_MINOR_VERSION >= 4))) && !defined(USE_NON_CONST)
234 const char* cc = Tcl_GetVar(interp,
235 "Draw_ExitOnCatch",TCL_GLOBAL_ONLY);
237 char* const cc = Tcl_GetVar(interp,
238 "Draw_ExitOnCatch",TCL_GLOBAL_ONLY);
241 cout << "An exception was caught " << E << endl;
243 if (cc && Draw::Atoi(cc)) {
247 Tcl_Eval(interp,"exit");
251 // get the error message
253 ss << "** Exception ** " << E << ends ;
254 #ifdef USE_STL_STREAM
255 Tcl_SetResult(interp,(char*)(ss.str().c_str()),TCL_VOLATILE);
257 Tcl_SetResult(interp,(char*)(ss.str()),TCL_VOLATILE);
263 flush_standard_streams();
265 // end capturing cout and cerr
268 capture_end (aFile_err, STDERR_FILENO, fd_err_save, err_name, di.Log(), doEcho);
269 capture_end (aFile_out, STDOUT_FILENO, fd_out_save, out_name, di.Log(), doEcho);
272 // log command result
273 const char* aResultStr = NULL;
276 aResultStr = Tcl_GetStringResult (interp);
277 if (aResultStr != 0 && aResultStr[0] != '\0' )
278 di.Log() << Tcl_GetStringResult (interp) << endl;
282 if (aResultStr == NULL)
283 aResultStr = Tcl_GetStringResult (interp);
284 if (aResultStr != 0 && aResultStr[0] != '\0' )
285 cout << Tcl_GetStringResult (interp) << endl;
291 static void CommandDelete (ClientData theClientData)
293 Draw_Interpretor::CallBackData* aCallback = (Draw_Interpretor::CallBackData* )theClientData;
297 //=======================================================================
298 //function : Draw_Interpretor
300 //=======================================================================
302 Draw_Interpretor::Draw_Interpretor() :
303 isAllocated(Standard_False), myDoLog(Standard_False), myDoEcho(Standard_False)
305 // The tcl interpreter is not created immediately as it is kept
306 // by a global variable and created and deleted before the main().
310 //=======================================================================
312 //purpose : It is necessary to call this function
313 //=======================================================================
315 void Draw_Interpretor::Init()
318 Tcl_DeleteInterp(myInterp);
319 isAllocated=Standard_True;
320 myInterp=Tcl_CreateInterp();
323 //=======================================================================
324 //function : Draw_Interpretor
326 //=======================================================================
328 Draw_Interpretor::Draw_Interpretor(const Draw_PInterp& p) :
329 isAllocated(Standard_False),
331 myDoLog(Standard_False),
332 myDoEcho(Standard_False)
336 //=======================================================================
339 //=======================================================================
340 void Draw_Interpretor::add (const Standard_CString theCommandName,
341 const Standard_CString theHelp,
342 const Standard_CString theFileName,
343 Draw_Interpretor::CallBackData* theCallback,
344 const Standard_CString theGroup)
346 if (myInterp == NULL)
351 Standard_PCharacter aName = (Standard_PCharacter )theCommandName;
352 Standard_PCharacter aHelp = (Standard_PCharacter )theHelp;
353 Standard_PCharacter aGroup = (Standard_PCharacter )theGroup;
354 Tcl_CreateCommand (myInterp, aName, CommandCmd, (ClientData )theCallback, CommandDelete);
357 Tcl_SetVar2 (myInterp, "Draw_Helps", aName, aHelp, TCL_GLOBAL_ONLY);
358 Tcl_SetVar2 (myInterp, "Draw_Groups", aGroup, aName,
359 TCL_GLOBAL_ONLY | TCL_APPEND_VALUE | TCL_LIST_ELEMENT);
361 // add path to source file (keep not more than two last subdirectories)
362 if (theFileName == NULL
363 || *theFileName == '\0')
368 OSD_Path aPath (theFileName);
369 Standard_Integer nbTrek = aPath.TrekLength();
370 for (Standard_Integer i = 2; i < nbTrek; ++i)
372 aPath.RemoveATrek (1);
376 TCollection_AsciiString aSrcPath;
377 aPath.SystemName (aSrcPath);
378 Tcl_SetVar2 (myInterp, "Draw_Files", aName, aSrcPath.ToCString(), TCL_GLOBAL_ONLY);
381 //=======================================================================
384 //=======================================================================
386 Standard_Boolean Draw_Interpretor::Remove(Standard_CString const n)
388 Standard_PCharacter pN;
390 pN=(Standard_PCharacter)n;
392 Standard_Integer result = Tcl_DeleteCommand(myInterp,pN);
396 //=======================================================================
399 //=======================================================================
401 Standard_CString Draw_Interpretor::Result() const
403 #if ((TCL_MAJOR_VERSION > 8) || ((TCL_MAJOR_VERSION == 8) && (TCL_MINOR_VERSION >= 5)))
404 return Tcl_GetStringResult(myInterp);
406 return myInterp->result;
410 //=======================================================================
413 //=======================================================================
415 void Draw_Interpretor::Reset()
417 Tcl_ResetResult(myInterp);
420 //=======================================================================
423 //=======================================================================
425 Draw_Interpretor& Draw_Interpretor::Append(const Standard_CString s)
428 // Convert string to UTF-8 format for Tcl
429 Tcl_DString TclString;
430 Tcl_ExternalToUtfDString ( NULL, s, -1, &TclString );
431 Tcl_AppendResult ( myInterp, Tcl_DStringValue ( &TclString ), (Standard_CString)0 );
432 Tcl_DStringFree ( &TclString );
434 Tcl_AppendResult(myInterp,s,(Standard_CString)0);
439 //=======================================================================
442 //=======================================================================
444 Draw_Interpretor& Draw_Interpretor::Append(const TCollection_AsciiString& s)
446 return Append (s.ToCString());
449 //=======================================================================
452 //=======================================================================
454 Draw_Interpretor& Draw_Interpretor::Append(const TCollection_ExtendedString& theString)
457 // Convert string to UTF-8 format for Tcl
458 char *str = new char[theString.LengthOfCString()+1];
459 theString.ToUTF8CString (str);
460 Tcl_AppendResult ( myInterp, str, (Standard_CString)0 );
463 // put as ascii string, replacing non-ascii characters by '?'
464 TCollection_AsciiString str (theString, '?');
465 Tcl_AppendResult(myInterp,str.ToCString(),(Standard_CString)0);
470 //=======================================================================
473 //=======================================================================
475 Draw_Interpretor& Draw_Interpretor::Append(const Standard_Integer i)
479 Tcl_AppendResult(myInterp,c,(Standard_CString)0);
483 //=======================================================================
486 //=======================================================================
488 Draw_Interpretor& Draw_Interpretor::Append(const Standard_Real r)
491 Sprintf(s,"%.17g",r);
492 Tcl_AppendResult(myInterp,s,(Standard_CString)0);
496 //=======================================================================
499 //=======================================================================
501 Draw_Interpretor& Draw_Interpretor::Append(const Standard_SStream& s)
503 #ifdef USE_STL_STREAM
504 return Append (s.str().c_str());
506 // Note: use dirty tricks -- unavoidable with old streams
507 TCollection_AsciiString aStr (((Standard_SStream&)AReason).str(), AReason.pcount());
508 ((Standard_SStream&)AReason).freeze (false);
509 return Append (aStr.ToCString());
513 //=======================================================================
514 //function : AppendElement
516 //=======================================================================
518 void Draw_Interpretor::AppendElement(const Standard_CString s)
521 // Convert string to UTF-8 format for Tcl
522 Tcl_DString TclString;
523 Tcl_ExternalToUtfDString ( NULL, s, -1, &TclString );
524 Tcl_AppendElement ( myInterp, Tcl_DStringValue ( &TclString ) );
525 Tcl_DStringFree ( &TclString );
528 //AppendElement is declared as (Tcl_Interp *interp, char *string)
530 Tcl_AppendElement(myInterp,(char*) s);
532 Tcl_AppendElement(myInterp, s);
537 //=======================================================================
540 //=======================================================================
542 Standard_Integer Draw_Interpretor::Eval(const Standard_CString line)
544 Standard_PCharacter pLine;
546 pLine=(Standard_PCharacter)line;
548 return Tcl_Eval(myInterp,pLine);
552 //=======================================================================
555 //=======================================================================
557 Standard_Integer Draw_Interpretor::RecordAndEval(const Standard_CString line,
558 const Standard_Integer flags)
560 Standard_PCharacter pLine;
562 pLine=(Standard_PCharacter)line;
563 return Tcl_RecordAndEval(myInterp,pLine,flags);
566 //=======================================================================
567 //function : EvalFile
569 //=======================================================================
571 Standard_Integer Draw_Interpretor::EvalFile(const Standard_CString fname)
573 Standard_PCharacter pfname;
575 pfname=(Standard_PCharacter)fname;
576 return Tcl_EvalFile(myInterp,pfname);
579 //=======================================================================
582 //=======================================================================
584 Standard_Boolean Draw_Interpretor::Complete(const Standard_CString line)
586 Standard_PCharacter pLine;
588 pLine=(Standard_PCharacter)line;
589 return Tcl_CommandComplete(pLine);
592 //=======================================================================
595 //=======================================================================
597 Draw_Interpretor::~Draw_Interpretor()
600 #if ((TCL_MAJOR_VERSION > 8) || ((TCL_MAJOR_VERSION == 8) && (TCL_MINOR_VERSION >= 4)))
605 catch (Standard_Failure) {
607 cout <<"Tcl_Exit have an exeption" << endl;
617 //=======================================================================
620 //=======================================================================
622 Draw_PInterp Draw_Interpretor::Interp() const
624 Standard_DomainError_Raise_if (myInterp==NULL , "No call for Draw_Interpretor::Init()");
628 void Draw_Interpretor::Set(const Draw_PInterp& PIntrp)
631 Tcl_DeleteInterp(myInterp);
632 isAllocated = Standard_False;
636 //=======================================================================
639 //=======================================================================
641 void Draw_Interpretor::SetDoLog (Standard_Boolean doLog)
646 void Draw_Interpretor::SetDoEcho (Standard_Boolean doEcho)
651 Standard_Boolean Draw_Interpretor::GetDoLog () const
656 Standard_Boolean Draw_Interpretor::GetDoEcho () const
661 Standard_SStream& Draw_Interpretor::Log ()