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