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