fef27edd738397d0dd67dafb4c4badeb8270f430
[occt.git] / src / Draw / Draw_Interpretor.cxx
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
5 //
6 // This file is part of Open CASCADE Technology software library.
7 //
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.
13 //
14 // Alternatively, this file may be used under the terms of Open CASCADE
15 // commercial license or contractual agreement.
16
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>
23
24 #include <TCollection_AsciiString.hxx>
25 #include <TCollection_ExtendedString.hxx>
26 #include <OSD_Process.hxx>
27 #include <OSD_Path.hxx>
28 #include <OSD.hxx>
29
30 #include <string.h>
31 #include <tcl.h>
32 #ifndef _WIN32
33 #include <unistd.h>
34 #endif
35
36 // for capturing of cout and cerr (dup(), dup2())
37 #ifdef _MSC_VER
38 #include <io.h>
39 #endif
40
41 #if ! defined(STDOUT_FILENO)
42 #define STDOUT_FILENO fileno(stdout)
43 #endif
44 #if ! defined(STDERR_FILENO)
45 #define STDERR_FILENO fileno(stderr)
46 #endif
47
48 #if ((TCL_MAJOR_VERSION > 8) || ((TCL_MAJOR_VERSION == 8) && (TCL_MINOR_VERSION >= 1)))
49 #define TCL_USES_UTF8
50 #endif
51
52 // logging helpers
53 namespace {
54   void dumpArgs (Standard_OStream& os, int argc, const char *argv[])
55   {
56     for (int i=0; i < argc; i++)
57       os << argv[i] << " ";
58     os << endl;
59   }
60
61   void flush_standard_streams ()
62   {
63     fflush (stderr);
64     fflush (stdout);
65     cerr << flush;
66     cout << flush;
67   }
68
69   FILE* capture_start (int std_fd, int *save_fd, char*& tmp_name)
70   {
71     *save_fd = 0;
72
73     // open temporary files
74   #if defined(_WIN32)
75     // use _tempnam() to decrease chances of failure (tmpfile() creates 
76     // file in root folder and will fail if it is write protected), see #24132
77     static const char* tmpdir = getenv("TEMP");
78     static char prefix[256] = ""; // prefix for temporary files, initialize once per process using pid
79     if (prefix[0] == '\0')
80       sprintf (prefix, "drawtmp%d_", (int)OSD_Process().ProcessId());
81     tmp_name = _tempnam (tmpdir, prefix);
82     FILE* aTmpFile = (tmp_name != NULL ? fopen (tmp_name, "w+b") : tmpfile());
83   #else
84     tmp_name = NULL;
85     FILE* aTmpFile = tmpfile();
86   #endif
87     int fd_tmp = (aTmpFile != NULL ? fileno (aTmpFile) : -1);
88     if (fd_tmp < 0)
89     {
90       cerr << "Error: cannot create temporary file for capturing console output" << endl;
91       fclose (aTmpFile);
92       return NULL;
93     }
94
95     // remember current file descriptors of standard stream, and replace it by temporary
96     (*save_fd) = dup(std_fd);
97     dup2(fd_tmp, std_fd);
98     return aTmpFile;
99   }
100
101   void capture_end (FILE* tmp_file, int std_fd, int save_fd, char* tmp_name, Standard_OStream &log, Standard_Boolean doEcho)
102   {
103     if (! tmp_file)
104       return;
105
106     // restore normal descriptors of console stream
107     dup2 (save_fd, std_fd);
108     close(save_fd);
109
110     // extract all output and copy it to log and optionally to cout
111     const int BUFSIZE = 2048;
112     char buf[BUFSIZE];
113     rewind(tmp_file);
114     while (fgets (buf, BUFSIZE, tmp_file) != NULL)
115     {
116       log << buf;
117       if (doEcho) 
118         cout << buf;
119     }
120
121     // close temporary file
122     fclose (tmp_file);
123
124     // remove temporary file if this is not done by the system
125     if (tmp_name)
126       remove (tmp_name);
127   }
128 };
129
130 // MKV 29.03.05
131 #if ((TCL_MAJOR_VERSION > 8) || ((TCL_MAJOR_VERSION == 8) && (TCL_MINOR_VERSION >= 4))) && !defined(USE_NON_CONST)
132 static Standard_Integer CommandCmd 
133 (ClientData theClientData, Tcl_Interp *interp,
134  Standard_Integer argc, const char* argv[])
135 #else
136 static Standard_Integer CommandCmd 
137 (ClientData theClientData, Tcl_Interp *interp,
138  Standard_Integer argc, char* argv[])
139 #endif
140 {
141   static Standard_Integer code;
142   code = TCL_OK;
143   Draw_Interpretor::CallBackData* aCallback = (Draw_Interpretor::CallBackData* )theClientData;
144   Draw_Interpretor& di = *(aCallback->myDI);
145
146   // log command execution, except commands manipulating log itself and echo
147   Standard_Boolean isLogManipulation = (strcmp (argv[0], "dlog") == 0 || 
148                                         strcmp (argv[0], "decho") == 0);
149   Standard_Boolean doLog  = (di.GetDoLog() && ! isLogManipulation);
150   Standard_Boolean doEcho = (di.GetDoEcho() && ! isLogManipulation);
151   if (doLog)
152     dumpArgs (di.Log(), argc, argv);
153   if (doEcho)
154     dumpArgs (cout, argc, argv);
155
156   // flush cerr and cout
157   flush_standard_streams();
158
159   // capture cout and cerr to log
160   char *err_name = NULL, *out_name = NULL;
161   FILE * aFile_err = NULL;
162   FILE * aFile_out = NULL;
163   int fd_err_save = 0;
164   int fd_out_save = 0;
165   if (doLog)
166   {
167     aFile_out = capture_start (STDOUT_FILENO, &fd_out_save, out_name);
168     aFile_err = capture_start (STDERR_FILENO, &fd_err_save, err_name);
169   }
170
171   // run command
172   try {
173     OCC_CATCH_SIGNALS
174
175     // get exception if control-break has been pressed 
176     OSD::ControlBreak();
177
178     // OCC680: Transfer UTF-8 directly to OCC commands without locale usage
179       
180     Standard_Integer fres = aCallback->Invoke ( di, argc, argv /*anArgs.GetArgv()*/ );
181     if (fres != 0) 
182       code = TCL_ERROR;
183   }
184   catch (Standard_Failure) {
185
186     Handle(Standard_Failure) E = Standard_Failure::Caught();
187
188     // fail if Draw_ExitOnCatch is set
189     // MKV 29.03.05
190 #if ((TCL_MAJOR_VERSION > 8) || ((TCL_MAJOR_VERSION == 8) && (TCL_MINOR_VERSION >= 4))) && !defined(USE_NON_CONST)
191     const char*  cc = Tcl_GetVar(interp,
192                           "Draw_ExitOnCatch",TCL_GLOBAL_ONLY);
193 #else
194     char* const cc = Tcl_GetVar(interp,
195                           "Draw_ExitOnCatch",TCL_GLOBAL_ONLY);
196 #endif
197
198     cout << "An exception was caught " << E << endl;
199
200     if (cc && Draw::Atoi(cc)) {
201 #ifdef _WIN32
202       Tcl_Exit(0);
203 #else      
204       Tcl_Eval(interp,"exit");
205 #endif
206     }
207
208     // get the error message
209     Standard_SStream ss;
210     ss << "** Exception ** " << E << ends;
211     Tcl_SetResult(interp,(char*)(ss.str().c_str()),TCL_VOLATILE);
212     code = TCL_ERROR;
213   }
214
215   // flush streams
216   flush_standard_streams();
217
218   // end capturing cout and cerr 
219   if (doLog) 
220   {
221     capture_end (aFile_err, STDERR_FILENO, fd_err_save, err_name, di.Log(), doEcho);
222     capture_end (aFile_out, STDOUT_FILENO, fd_out_save, out_name, di.Log(), doEcho);
223   }
224
225   // log command result
226   const char* aResultStr = NULL;
227   if (doLog)
228   {
229     aResultStr = Tcl_GetStringResult (interp);
230     if (aResultStr != 0 && aResultStr[0] != '\0' )
231       di.Log() << Tcl_GetStringResult (interp) << endl;
232   }
233   if (doEcho)
234   {
235     if (aResultStr == NULL)
236       aResultStr = Tcl_GetStringResult (interp);
237     if (aResultStr != 0 && aResultStr[0] != '\0' )
238       cout << Tcl_GetStringResult (interp) << endl;
239   }
240
241   return code;
242 }
243
244 static void CommandDelete (ClientData theClientData)
245 {
246   Draw_Interpretor::CallBackData* aCallback = (Draw_Interpretor::CallBackData* )theClientData;
247   delete aCallback;
248 }
249
250 //=======================================================================
251 //function : Draw_Interpretor
252 //purpose  : 
253 //=======================================================================
254
255 Draw_Interpretor::Draw_Interpretor() :
256   isAllocated(Standard_False), myDoLog(Standard_False), myDoEcho(Standard_False)
257 {
258 // The tcl interpreter is not created immediately as it is kept 
259 // by a global variable and created and deleted before the main().
260   myInterp  = NULL;
261 }
262
263 //=======================================================================
264 //function : Init
265 //purpose  : It is necessary to call this function
266 //=======================================================================
267
268 void Draw_Interpretor::Init()
269 {
270   if (isAllocated) 
271     Tcl_DeleteInterp(myInterp);
272   isAllocated=Standard_True;
273   myInterp=Tcl_CreateInterp();
274 }
275
276 //=======================================================================
277 //function : Draw_Interpretor
278 //purpose  : 
279 //=======================================================================
280
281 Draw_Interpretor::Draw_Interpretor(const Draw_PInterp& p) :
282   isAllocated(Standard_False),
283   myInterp(p),
284   myDoLog(Standard_False),
285   myDoEcho(Standard_False)
286 {
287 }
288
289 //=======================================================================
290 //function : add
291 //purpose  :
292 //=======================================================================
293 void Draw_Interpretor::add (const Standard_CString          theCommandName,
294                             const Standard_CString          theHelp,
295                             const Standard_CString          theFileName,
296                             Draw_Interpretor::CallBackData* theCallback,
297                             const Standard_CString          theGroup)
298 {
299   if (myInterp == NULL)
300   {
301     Init();
302   }
303
304   Standard_PCharacter aName  = (Standard_PCharacter )theCommandName;
305   Standard_PCharacter aHelp  = (Standard_PCharacter )theHelp;
306   Standard_PCharacter aGroup = (Standard_PCharacter )theGroup;
307   Tcl_CreateCommand (myInterp, aName, CommandCmd, (ClientData )theCallback, CommandDelete);
308
309   // add the help
310   Tcl_SetVar2 (myInterp, "Draw_Helps",  aName,  aHelp, TCL_GLOBAL_ONLY);
311   Tcl_SetVar2 (myInterp, "Draw_Groups", aGroup, aName,
312                      TCL_GLOBAL_ONLY | TCL_APPEND_VALUE | TCL_LIST_ELEMENT);
313
314   // add path to source file (keep not more than two last subdirectories)
315   if (theFileName  == NULL
316    || *theFileName == '\0')
317   {
318     return;
319   }
320
321   OSD_Path aPath (theFileName);
322   Standard_Integer nbTrek = aPath.TrekLength();
323   for (Standard_Integer i = 2; i < nbTrek; ++i)
324   {
325     aPath.RemoveATrek (1);
326   }
327   aPath.SetDisk ("");
328   aPath.SetNode ("");
329   TCollection_AsciiString aSrcPath;
330   aPath.SystemName (aSrcPath);
331   Tcl_SetVar2 (myInterp, "Draw_Files", aName, aSrcPath.ToCString(), TCL_GLOBAL_ONLY);
332 }
333
334 //=======================================================================
335 //function : Remove
336 //purpose  : 
337 //=======================================================================
338
339 Standard_Boolean Draw_Interpretor::Remove(Standard_CString const n)
340 {
341   Standard_PCharacter pN;
342   //
343   pN=(Standard_PCharacter)n;
344  
345   Standard_Integer result = Tcl_DeleteCommand(myInterp,pN);
346   return result == 0;
347 }
348
349 //=======================================================================
350 //function : Result
351 //purpose  : 
352 //=======================================================================
353
354 Standard_CString Draw_Interpretor::Result() const
355 {
356 #if ((TCL_MAJOR_VERSION > 8) || ((TCL_MAJOR_VERSION == 8) && (TCL_MINOR_VERSION >= 5)))
357   return Tcl_GetStringResult(myInterp);
358 #else
359   return myInterp->result;
360 #endif
361 }
362
363 //=======================================================================
364 //function : Reset
365 //purpose  : 
366 //=======================================================================
367
368 void Draw_Interpretor::Reset()
369 {
370   Tcl_ResetResult(myInterp);
371 }
372
373 //=======================================================================
374 //function : Append
375 //purpose  : 
376 //=======================================================================
377
378 Draw_Interpretor& Draw_Interpretor::Append(const Standard_CString s)
379 {
380 #ifdef TCL_USES_UTF8
381   // Convert string to UTF-8 format for Tcl
382   Tcl_DString TclString;
383   Tcl_ExternalToUtfDString ( NULL, s, -1, &TclString );
384   Tcl_AppendResult ( myInterp, Tcl_DStringValue ( &TclString ), (Standard_CString)0 );
385   Tcl_DStringFree ( &TclString );
386 #else
387   Tcl_AppendResult(myInterp,s,(Standard_CString)0);
388 #endif
389   return *this;
390 }
391
392 //=======================================================================
393 //function : Append
394 //purpose  : 
395 //=======================================================================
396
397 Draw_Interpretor& Draw_Interpretor::Append(const TCollection_AsciiString& s)
398 {
399   return Append (s.ToCString());
400 }
401
402 //=======================================================================
403 //function : Append
404 //purpose  : 
405 //=======================================================================
406
407 Draw_Interpretor& Draw_Interpretor::Append(const TCollection_ExtendedString& theString)
408 {
409 #ifdef TCL_USES_UTF8
410   // Convert string to UTF-8 format for Tcl
411   char *str = new char[theString.LengthOfCString()+1];
412   theString.ToUTF8CString (str);
413   Tcl_AppendResult ( myInterp, str, (Standard_CString)0 );
414   delete[] str;
415 #else
416   // put as ascii string, replacing non-ascii characters by '?'
417   TCollection_AsciiString str (theString, '?');
418   Tcl_AppendResult(myInterp,str.ToCString(),(Standard_CString)0);
419 #endif
420   return *this;
421 }
422
423 //=======================================================================
424 //function : Append
425 //purpose  : 
426 //=======================================================================
427
428 Draw_Interpretor& Draw_Interpretor::Append(const Standard_Integer i)
429 {
430   char c[100];
431   Sprintf(c,"%d",i);
432   Tcl_AppendResult(myInterp,c,(Standard_CString)0);
433   return *this;
434 }
435
436 //=======================================================================
437 //function : Append
438 //purpose  : 
439 //=======================================================================
440
441 Draw_Interpretor& Draw_Interpretor::Append(const Standard_Real r)
442 {
443   char s[100];
444   Sprintf(s,"%.17g",r);
445   Tcl_AppendResult(myInterp,s,(Standard_CString)0);
446   return *this;
447 }
448
449 //=======================================================================
450 //function : Append
451 //purpose  : 
452 //=======================================================================
453
454 Draw_Interpretor& Draw_Interpretor::Append(const Standard_SStream& s)
455 {
456   return Append (s.str().c_str());
457 }
458
459 //=======================================================================
460 //function : AppendElement
461 //purpose  : 
462 //=======================================================================
463
464 void Draw_Interpretor::AppendElement(const Standard_CString s)
465 {
466 #ifdef TCL_USES_UTF8
467   // Convert string to UTF-8 format for Tcl
468   Tcl_DString TclString;
469   Tcl_ExternalToUtfDString ( NULL, s, -1, &TclString );
470   Tcl_AppendElement ( myInterp, Tcl_DStringValue ( &TclString ) );
471   Tcl_DStringFree ( &TclString );
472 #else
473 #ifdef IRIX
474   //AppendElement is declared as (Tcl_Interp *interp, char *string)
475   //on SGI 32
476   Tcl_AppendElement(myInterp,(char*) s);
477 #else
478   Tcl_AppendElement(myInterp, s);
479 #endif
480 #endif
481 }
482
483 //=======================================================================
484 //function : Eval
485 //purpose  : 
486 //=======================================================================
487
488 Standard_Integer Draw_Interpretor::Eval(const Standard_CString line)
489 {
490   Standard_PCharacter pLine;
491   //
492   pLine=(Standard_PCharacter)line;
493   //
494   return Tcl_Eval(myInterp,pLine);
495 }
496
497
498 //=======================================================================
499 //function : Eval
500 //purpose  : 
501 //=======================================================================
502
503 Standard_Integer Draw_Interpretor::RecordAndEval(const Standard_CString line,
504                                                  const Standard_Integer flags)
505 {
506   Standard_PCharacter pLine;
507   //
508   pLine=(Standard_PCharacter)line;
509   return Tcl_RecordAndEval(myInterp,pLine,flags);
510 }
511
512 //=======================================================================
513 //function : EvalFile
514 //purpose  : 
515 //=======================================================================
516
517 Standard_Integer Draw_Interpretor::EvalFile(const Standard_CString fname)
518 {
519   Standard_PCharacter pfname;
520   //
521   pfname=(Standard_PCharacter)fname;
522   return Tcl_EvalFile(myInterp,pfname);
523 }
524
525 //=======================================================================
526 //function : PrintHelp
527 //purpose  :
528 //=======================================================================
529
530 Standard_Integer Draw_Interpretor::PrintHelp (const Standard_CString theCommandName)
531 {
532   TCollection_AsciiString aCmd     = TCollection_AsciiString ("help ") + theCommandName;
533   Standard_PCharacter     aLinePtr = (Standard_PCharacter )aCmd.ToCString();
534   return Tcl_Eval (myInterp, aLinePtr);
535 }
536
537 //=======================================================================
538 //function :Complete
539 //purpose  : 
540 //=======================================================================
541
542 Standard_Boolean Draw_Interpretor::Complete(const Standard_CString line)
543 {
544   Standard_PCharacter pLine;
545   //
546   pLine=(Standard_PCharacter)line;
547   return Tcl_CommandComplete(pLine);
548 }
549
550 //=======================================================================
551 //function : Destroy
552 //purpose  : 
553 //=======================================================================
554
555 Draw_Interpretor::~Draw_Interpretor()
556 {
557   // MKV 01.02.05
558 #if ((TCL_MAJOR_VERSION > 8) || ((TCL_MAJOR_VERSION == 8) && (TCL_MINOR_VERSION >= 4)))
559   try {
560     OCC_CATCH_SIGNALS
561     Tcl_Exit(0);
562   }
563   catch (Standard_Failure) {
564 #ifdef OCCT_DEBUG
565     cout <<"Tcl_Exit have an exeption" << endl;
566 #endif
567   }
568 #else
569 #ifdef _WIN32
570   Tcl_Exit(0);
571 #endif  
572 #endif
573 }
574
575 //=======================================================================
576 //function : Interp
577 //purpose  : 
578 //=======================================================================
579
580 Draw_PInterp Draw_Interpretor::Interp() const
581 {
582   Standard_DomainError_Raise_if (myInterp==NULL , "No call for  Draw_Interpretor::Init()");
583   return myInterp;
584 }
585
586 void Draw_Interpretor::Set(const Draw_PInterp& PIntrp)
587 {
588   if (isAllocated)
589     Tcl_DeleteInterp(myInterp);
590   isAllocated = Standard_False;
591   myInterp = PIntrp;
592 }
593
594 //=======================================================================
595 //function : Logging
596 //purpose  : 
597 //=======================================================================
598
599 void Draw_Interpretor::SetDoLog (Standard_Boolean doLog)
600 {
601   myDoLog = doLog;
602 }
603
604 void Draw_Interpretor::SetDoEcho (Standard_Boolean doEcho)
605 {
606   myDoEcho = doEcho;
607 }
608
609 Standard_Boolean Draw_Interpretor::GetDoLog () const
610 {
611   return myDoLog;
612 }
613
614 Standard_Boolean Draw_Interpretor::GetDoEcho () const
615 {
616   return myDoEcho;
617 }
618
619 Standard_SStream& Draw_Interpretor::Log ()
620 {
621   return myLog;
622 }