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