src/Draw/Draw_Interpretor.cxx

   1 // File:        Draw_Interpretor.cxx
   2 // Created:     Thu Feb 23 17:53:09 1995
   3 // Author:      Remi LEQUETTE
   4 //              <rle@bravox>
   5
   6
   7 #include <Draw_Interpretor.ixx>
   8 #include <Draw_Appli.hxx>
   9 #include <Standard_SStream.hxx>
  10 #include <Standard_RangeError.hxx>
  11 #include <Standard_ErrorHandler.hxx>
  12 #include <Standard_Macro.hxx>
  13
  14 #include <TCollection_AsciiString.hxx>
  15 #include <TCollection_ExtendedString.hxx>
  16
  17 #include <string.h>
  18
  19 #include <tcl.h>
  20
  21 #if ((TCL_MAJOR_VERSION > 8) || ((TCL_MAJOR_VERSION == 8) && (TCL_MINOR_VERSION >= 1)))
  22 #define TCL_USES_UTF8
  23 #endif
  24
  25 //
  26 // Auxiliary tool to convert strings in command arguments from UTF-8
  27 // (Tcl internal encoding since Tcl 8.1) to system local encoding,
  28 // normally extended Ascii as expected by OCC commands
  29 //
  30 class TclUTFToLocalStringSentry {
  31  public:
  32
  33 #ifdef TCL_USES_UTF8
  34   TclUTFToLocalStringSentry (int argc, const char **argv) :
  35     nb(0),
  36     TclArgv(new Tcl_DString[argc]),
  37     Argv(new char*[argc])
  38   {
  39     for (; nb < argc; nb++ ) {
  40       Tcl_UtfToExternalDString ( NULL, argv[nb], -1, &TclArgv[nb] );
  41       Argv[nb] = Tcl_DStringValue ( &TclArgv[nb] );
  42     }
  43   }
  44
  45   ~TclUTFToLocalStringSentry ()
  46   {
  47     delete[] Argv;
  48     while ( nb-- >0 ) Tcl_DStringFree ( &TclArgv[nb] );
  49     delete[] TclArgv;
  50   }
  51 #else
  52   TclUTFToLocalStringSentry (int, const char **argv) : Argv((char**)argv) {}
  53 #endif
  54
  55   const char **GetArgv () const { return (const char **)Argv; }
  56
  57  private:
  58   int nb;
  59   Tcl_DString *TclArgv;
  60   char **Argv;
  61 };
  62
  63
  64 //
  65 // Call backs for TCL
  66 //
  67
  68 struct CData {
  69   CData(Draw_CommandFunction ff, Draw_Interpretor* ii) : f(ff), i(ii) {}
  70   Draw_CommandFunction f;
  71   Draw_Interpretor*    i;
  72 };
  73
  74 // MKV 29.03.05
  75 #if ((TCL_MAJOR_VERSION > 8) || ((TCL_MAJOR_VERSION == 8) && (TCL_MINOR_VERSION >= 4))) && !defined(USE_NON_CONST)
  76 static Standard_Integer CommandCmd
  77 (ClientData clientData, Tcl_Interp *interp,
  78  Standard_Integer argc, const char* argv[])
  79 #else
  80 static Standard_Integer CommandCmd
  81 (ClientData clientData, Tcl_Interp *interp,
  82  Standard_Integer argc, char* argv[])
  83 #endif
  84 {
  85   static Standard_Integer code;
  86   code = TCL_OK;
  87   CData* C = (CData*) clientData;
  88
  89   try {
  90     OCC_CATCH_SIGNALS
  91
  92     // OCC63: Convert strings from UTF-8 to local encoding, normally expected by OCC commands
  93     TclUTFToLocalStringSentry anArgs ( argc, (const char**)argv );
  94
  95     Draw_Interpretor& di = *(C->i);
  96     Standard_Integer fres = C->f ( di, argc, anArgs.GetArgv() );
  97     if (fres != 0)
  98       code = TCL_ERROR;
  99   }
 100   catch (Standard_Failure) {
 101
 102     Handle(Standard_Failure) E = Standard_Failure::Caught();
 103
 104     // fail if Draw_ExitOnCatch is set
 105     // MKV 29.03.05
 106 #if ((TCL_MAJOR_VERSION > 8) || ((TCL_MAJOR_VERSION == 8) && (TCL_MINOR_VERSION >= 4))) && !defined(USE_NON_CONST)
 107     const char*  cc = Tcl_GetVar(interp,
 108                           "Draw_ExitOnCatch",TCL_GLOBAL_ONLY);
 109 #else
 110     char* const cc = Tcl_GetVar(interp,
 111                           "Draw_ExitOnCatch",TCL_GLOBAL_ONLY);
 112 #endif
 113
 114     cout << "An exception was caught " << E << endl;
 115
 116     if (cc && atoi(cc)) {
 117 #ifdef WNT
 118       Tcl_Exit(0);
 119 #else
 120       Tcl_Eval(interp,"exit");
 121 #endif
 122     }
 123
 124     // get the error message
 125     Standard_SStream ss;
 126     ss << "** Exception ** " << E << ends ;
 127 #ifdef USE_STL_STREAM
 128     Tcl_SetResult(interp,(char*)(ss.str().c_str()),TCL_VOLATILE);
 129 #else
 130     Tcl_SetResult(interp,(char*)(ss.str()),TCL_VOLATILE);
 131 #endif
 132     code = TCL_ERROR;
 133   }
 134
 135   return code;
 136 }
 137
 138
 139 static void CommandDelete (ClientData clientData)
 140 {
 141   CData *C = (CData*) clientData;
 142   delete C;
 143 }
 144
 145 //=======================================================================
 146 //function : Draw_Interpretor
 147 //purpose  :
 148 //=======================================================================
 149
 150 Draw_Interpretor::Draw_Interpretor() :
 151   isAllocated(Standard_False)
 152 {
 153 // The tcl interpreter is not created immediately as it is kept
 154 // by a global variable and created and deleted before the main().
 155   myInterp  = NULL;
 156 }
 157
 158 //=======================================================================
 159 //function : Init
 160 //purpose  : It is necessary to call this function
 161 //=======================================================================
 162
 163 void Draw_Interpretor::Init()
 164 {
 165   if (isAllocated)
 166     Tcl_DeleteInterp(myInterp);
 167   isAllocated=Standard_True;
 168   myInterp=Tcl_CreateInterp();
 169 }
 170
 171 //=======================================================================
 172 //function : Draw_Interpretor
 173 //purpose  :
 174 //=======================================================================
 175
 176 Draw_Interpretor::Draw_Interpretor(const Draw_PInterp& p) :
 177   isAllocated(Standard_False),
 178   myInterp(p)
 179 {
 180 }
 181
 182 //=======================================================================
 183 //function : Add
 184 //purpose  :
 185 //=======================================================================
 186 //#ifdef WNT
 187 void Draw_Interpretor::Add(const Standard_CString n,
 188                            const Standard_CString help,
 189                            const Draw_CommandFunction f,
 190                            const Standard_CString group)
 191 //#else
 192 //void Draw_Interpretor::Add(const Standard_CString n,
 193 //                         const Standard_CString help,
 194 //                         const Draw_CommandFunction& f,
 195 //                         const Standard_CString group)
 196 //#endif
 197 {
 198   Standard_PCharacter pN, pHelp, pGroup;
 199   //
 200   pN=(Standard_PCharacter)n;
 201   pHelp=(Standard_PCharacter)help;
 202   pGroup=(Standard_PCharacter)group;
 203   //
 204   if (myInterp==NULL) Init();
 205
 206   CData* C = new CData(f,this);
 207
 208   Tcl_CreateCommand(myInterp, pN ,CommandCmd, (ClientData) C, CommandDelete);
 209
 210   // add the help
 211   Tcl_SetVar2(myInterp,"Draw_Helps", pN, pHelp, TCL_GLOBAL_ONLY);
 212   Tcl_SetVar2(myInterp,"Draw_Groups",pGroup,pN,
 213               TCL_GLOBAL_ONLY|TCL_APPEND_VALUE|TCL_LIST_ELEMENT);
 214 }
 215 //=======================================================================
 216 //function : Add
 217 //purpose  :
 218 //=======================================================================
 219 void Draw_Interpretor::Add(const Standard_CString n,
 220                            const Standard_CString help,
 221                            const Standard_CString file_name,
 222                            const Draw_CommandFunction f,
 223                            const Standard_CString group)
 224 {
 225   Standard_PCharacter pN, pHelp, pGroup, pFileName;
 226   //
 227   pN=(Standard_PCharacter)n;
 228   pHelp=(Standard_PCharacter)help;
 229   pGroup=(Standard_PCharacter)group;
 230   pFileName=(Standard_PCharacter)file_name;
 231   //
 232   if (myInterp==NULL) Init();
 233
 234   CData* C = new CData(f,this);
 235   Standard_Integer length, num_slashes,  ii,  jj,  kk;
 236   Tcl_CreateCommand(myInterp,pN,CommandCmd, (ClientData) C, CommandDelete);
 237
 238   // add the help
 239   Tcl_SetVar2(myInterp,"Draw_Helps",pN,pHelp,TCL_GLOBAL_ONLY);
 240   Tcl_SetVar2(myInterp,"Draw_Groups",pGroup,pN,
 241               TCL_GLOBAL_ONLY|TCL_APPEND_VALUE|TCL_LIST_ELEMENT);
 242   length = strlen(pFileName) ;
 243   char * a_string =
 244     new char[length + 1] ;
 245   jj = 0 ;
 246   num_slashes = 0 ;
 247   ii = length ;
 248   while (num_slashes < 3 && ii >= 0) {
 249     if (file_name[ii] == '/') {
 250       num_slashes += 1 ;
 251     }
 252     ii -= 1 ;
 253   }
 254   jj = 0 ;
 255   for (kk = ii+2 , jj =0 ; kk < length ; kk++) {
 256      a_string[jj] = file_name[kk] ;
 257      jj += 1 ;
 258    }
 259   a_string[jj] = '\0' ;
 260
 261   Tcl_SetVar2(myInterp,"Draw_Files",pN,a_string,TCL_GLOBAL_ONLY);
 262
 263   delete [] a_string;
 264
 265 }
 266
 267
 268 //=======================================================================
 269 //function : Remove
 270 //purpose  :
 271 //=======================================================================
 272
 273 Standard_Boolean Draw_Interpretor::Remove(Standard_CString const n)
 274 {
 275   Standard_PCharacter pN;
 276   //
 277   pN=(Standard_PCharacter)n;
 278
 279   Standard_Integer result = Tcl_DeleteCommand(myInterp,pN);
 280   return result == 0;
 281 }
 282
 283 //=======================================================================
 284 //function : Result
 285 //purpose  :
 286 //=======================================================================
 287
 288 Standard_CString Draw_Interpretor::Result() const
 289 {
 290 #if ((TCL_MAJOR_VERSION > 8) || ((TCL_MAJOR_VERSION == 8) && (TCL_MINOR_VERSION >= 5)))
 291   return Tcl_GetStringResult(myInterp);
 292 #else
 293   return myInterp->result;
 294 #endif
 295 }
 296
 297 //=======================================================================
 298 //function : Reset
 299 //purpose  :
 300 //=======================================================================
 301
 302 void Draw_Interpretor::Reset()
 303 {
 304   Tcl_ResetResult(myInterp);
 305 }
 306
 307 //=======================================================================
 308 //function : Append
 309 //purpose  :
 310 //=======================================================================
 311
 312 Draw_Interpretor& Draw_Interpretor::Append(const Standard_CString s)
 313 {
 314 #ifdef TCL_USES_UTF8
 315   // Convert string to UTF-8 format for Tcl
 316   Tcl_DString TclString;
 317   Tcl_ExternalToUtfDString ( NULL, s, -1, &TclString );
 318   Tcl_AppendResult ( myInterp, Tcl_DStringValue ( &TclString ), (Standard_CString)0 );
 319   Tcl_DStringFree ( &TclString );
 320 #else
 321   Tcl_AppendResult(myInterp,s,(Standard_CString)0);
 322 #endif
 323   return *this;
 324 }
 325
 326 //=======================================================================
 327 //function : Append
 328 //purpose  :
 329 //=======================================================================
 330
 331 Draw_Interpretor& Draw_Interpretor::Append(const TCollection_AsciiString& s)
 332 {
 333   return Append (s.ToCString());
 334 }
 335
 336 //=======================================================================
 337 //function : Append
 338 //purpose  :
 339 //=======================================================================
 340
 341 Draw_Interpretor& Draw_Interpretor::Append(const TCollection_ExtendedString& theString)
 342 {
 343 #ifdef TCL_USES_UTF8
 344   // Convert string to UTF-8 format for Tcl
 345   char *str = new char[theString.LengthOfCString()+1];
 346   theString.ToUTF8CString (str);
 347   Tcl_AppendResult ( myInterp, str, (Standard_CString)0 );
 348   delete[] str;
 349 #else
 350   // put as ascii string, replacing non-ascii characters by '?'
 351   TCollection_AsciiString str (theString, '?');
 352   Tcl_AppendResult(myInterp,str.ToCString(),(Standard_CString)0);
 353 #endif
 354   return *this;
 355 }
 356
 357 //=======================================================================
 358 //function : Append
 359 //purpose  :
 360 //=======================================================================
 361
 362 Draw_Interpretor& Draw_Interpretor::Append(const Standard_Integer i)
 363 {
 364   char c[100];
 365   sprintf(c,"%d",i);
 366   Tcl_AppendResult(myInterp,c,(Standard_CString)0);
 367   return *this;
 368 }
 369
 370 //=======================================================================
 371 //function : Append
 372 //purpose  :
 373 //=======================================================================
 374
 375 Draw_Interpretor& Draw_Interpretor::Append(const Standard_Real r)
 376 {
 377   char s[100];
 378   sprintf(s,"%.17g",r);
 379   Tcl_AppendResult(myInterp,s,(Standard_CString)0);
 380   return *this;
 381 }
 382
 383 //=======================================================================
 384 //function : Append
 385 //purpose  :
 386 //=======================================================================
 387
 388 Draw_Interpretor& Draw_Interpretor::Append(const Standard_SStream& s)
 389 {
 390 #ifdef USE_STL_STREAM
 391   return Append (s.str().c_str());
 392 #else
 393   // Note: use dirty tricks -- unavoidable with old streams
 394   TCollection_AsciiString aStr (((Standard_SStream&)AReason).str(), AReason.pcount());
 395   ((Standard_SStream&)AReason).freeze (false);
 396   return Append (aStr.ToCString());
 397 #endif
 398 }
 399
 400 //=======================================================================
 401 //function : AppendElement
 402 //purpose  :
 403 //=======================================================================
 404
 405 void Draw_Interpretor::AppendElement(const Standard_CString s)
 406 {
 407 #ifdef TCL_USES_UTF8
 408   // Convert string to UTF-8 format for Tcl
 409   Tcl_DString TclString;
 410   Tcl_ExternalToUtfDString ( NULL, s, -1, &TclString );
 411   Tcl_AppendElement ( myInterp, Tcl_DStringValue ( &TclString ) );
 412   Tcl_DStringFree ( &TclString );
 413 #else
 414 #ifdef IRIX
 415   //AppendElement is declared as (Tcl_Interp *interp, char *string)
 416   //on SGI 32
 417   Tcl_AppendElement(myInterp,(char*) s);
 418 #else
 419   Tcl_AppendElement(myInterp, s);
 420 #endif
 421 #endif
 422 }
 423
 424 //=======================================================================
 425 //function : Eval
 426 //purpose  :
 427 //=======================================================================
 428
 429 Standard_Integer Draw_Interpretor::Eval(const Standard_CString line)
 430 {
 431   Standard_PCharacter pLine;
 432   //
 433   pLine=(Standard_PCharacter)line;
 434   //
 435   return Tcl_Eval(myInterp,pLine);
 436 }
 437
 438
 439 //=======================================================================
 440 //function : Eval
 441 //purpose  :
 442 //=======================================================================
 443
 444 Standard_Integer Draw_Interpretor::RecordAndEval(const Standard_CString line,
 445                                                  const Standard_Integer flags)
 446 {
 447   Standard_PCharacter pLine;
 448   //
 449   pLine=(Standard_PCharacter)line;
 450   return Tcl_RecordAndEval(myInterp,pLine,flags);
 451 }
 452
 453 //=======================================================================
 454 //function : EvalFile
 455 //purpose  :
 456 //=======================================================================
 457
 458 Standard_Integer Draw_Interpretor::EvalFile(const Standard_CString fname)
 459 {
 460   Standard_PCharacter pfname;
 461   //
 462   pfname=(Standard_PCharacter)fname;
 463   return Tcl_EvalFile(myInterp,pfname);
 464 }
 465
 466 //=======================================================================
 467 //function :Complete
 468 //purpose  :
 469 //=======================================================================
 470
 471 Standard_Boolean Draw_Interpretor::Complete(const Standard_CString line)
 472 {
 473   Standard_PCharacter pLine;
 474   //
 475   pLine=(Standard_PCharacter)line;
 476   return Tcl_CommandComplete(pLine);
 477 }
 478
 479 //=======================================================================
 480 //function : Destroy
 481 //purpose  :
 482 //=======================================================================
 483
 484 void Draw_Interpretor::Destroy()
 485 {
 486   // MKV 01.02.05
 487 #if ((TCL_MAJOR_VERSION > 8) || ((TCL_MAJOR_VERSION == 8) && (TCL_MINOR_VERSION >= 4)))
 488   try {
 489     OCC_CATCH_SIGNALS
 490     Tcl_Exit(0);
 491   }
 492   catch (Standard_Failure) {
 493 #ifdef DEB
 494     cout <<"Tcl_Exit have an exeption" << endl;
 495 #endif
 496   }
 497 #else
 498 #ifdef WNT
 499   Tcl_Exit(0);
 500 #endif
 501 #endif
 502 }
 503
 504 //=======================================================================
 505 //function : Interp
 506 //purpose  :
 507 //=======================================================================
 508
 509 Draw_PInterp Draw_Interpretor::Interp() const
 510 {
 511   Standard_DomainError_Raise_if (myInterp==NULL , "No call for  Draw_Interpretor::Init()");
 512   return myInterp;
 513 }
 514
 515 void Draw_Interpretor::Set(const Draw_PInterp& PIntrp)
 516 {
 517   if (isAllocated)
 518     Tcl_DeleteInterp(myInterp);
 519   isAllocated = Standard_False;
 520   myInterp = PIntrp;
 521 }