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