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 // On ne cree pas tout de suite l'interpreteur tcl car s'il est detenu
 154 // par une variable globale il est cree et ecrase avant le main().
 155   myInterp  = NULL;
 156 }
 157
 158 //=======================================================================
 159 //function : Init
 160 //purpose  : Il faut appeler cette fonction
 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 }
 264
 265
 266 //=======================================================================
 267 //function : Remove
 268 //purpose  :
 269 //=======================================================================
 270
 271 Standard_Boolean Draw_Interpretor::Remove(Standard_CString const n)
 272 {
 273   Standard_PCharacter pN;
 274   //
 275   pN=(Standard_PCharacter)n;
 276
 277   Standard_Integer result = Tcl_DeleteCommand(myInterp,pN);
 278   return result == 0;
 279 }
 280
 281 //=======================================================================
 282 //function : Result
 283 //purpose  :
 284 //=======================================================================
 285
 286 Standard_CString Draw_Interpretor::Result() const
 287 {
 288 #if ((TCL_MAJOR_VERSION > 8) || ((TCL_MAJOR_VERSION == 8) && (TCL_MINOR_VERSION >= 5)))
 289   return Tcl_GetStringResult(myInterp);
 290 #else
 291   return myInterp->result;
 292 #endif
 293 }
 294
 295 //=======================================================================
 296 //function : Reset
 297 //purpose  :
 298 //=======================================================================
 299
 300 void Draw_Interpretor::Reset()
 301 {
 302   Tcl_ResetResult(myInterp);
 303 }
 304
 305 //=======================================================================
 306 //function : Append
 307 //purpose  :
 308 //=======================================================================
 309
 310 Draw_Interpretor& Draw_Interpretor::Append(const Standard_CString s)
 311 {
 312 #ifdef TCL_USES_UTF8
 313   // Convert string to UTF-8 format for Tcl
 314   Tcl_DString TclString;
 315   Tcl_ExternalToUtfDString ( NULL, s, -1, &TclString );
 316   Tcl_AppendResult ( myInterp, Tcl_DStringValue ( &TclString ), (Standard_CString)0 );
 317   Tcl_DStringFree ( &TclString );
 318 #else
 319   Tcl_AppendResult(myInterp,s,(Standard_CString)0);
 320 #endif
 321   return *this;
 322 }
 323
 324 //=======================================================================
 325 //function : Append
 326 //purpose  :
 327 //=======================================================================
 328
 329 Draw_Interpretor& Draw_Interpretor::Append(const TCollection_AsciiString& s)
 330 {
 331   return Append (s.ToCString());
 332 }
 333
 334 //=======================================================================
 335 //function : Append
 336 //purpose  :
 337 //=======================================================================
 338
 339 Draw_Interpretor& Draw_Interpretor::Append(const TCollection_ExtendedString& theString)
 340 {
 341 #ifdef TCL_USES_UTF8
 342   // Convert string to UTF-8 format for Tcl
 343   char *str = new char[theString.LengthOfCString()+1];
 344   theString.ToUTF8CString (str);
 345   Tcl_AppendResult ( myInterp, str, (Standard_CString)0 );
 346   delete[] str;
 347 #else
 348   // put as ascii string, replacing non-ascii characters by '?'
 349   TCollection_AsciiString str (theString, '?');
 350   Tcl_AppendResult(myInterp,str.ToCString(),(Standard_CString)0);
 351 #endif
 352   return *this;
 353 }
 354
 355 //=======================================================================
 356 //function : Append
 357 //purpose  :
 358 //=======================================================================
 359
 360 Draw_Interpretor& Draw_Interpretor::Append(const Standard_Integer i)
 361 {
 362   char c[100];
 363   sprintf(c,"%d",i);
 364   Tcl_AppendResult(myInterp,c,(Standard_CString)0);
 365   return *this;
 366 }
 367
 368 //=======================================================================
 369 //function : Append
 370 //purpose  :
 371 //=======================================================================
 372
 373 Draw_Interpretor& Draw_Interpretor::Append(const Standard_Real r)
 374 {
 375   char s[100];
 376   sprintf(s,"%.17g",r);
 377   Tcl_AppendResult(myInterp,s,(Standard_CString)0);
 378   return *this;
 379 }
 380
 381 //=======================================================================
 382 //function : Append
 383 //purpose  :
 384 //=======================================================================
 385
 386 Draw_Interpretor& Draw_Interpretor::Append(const Standard_SStream& s)
 387 {
 388 #ifdef USE_STL_STREAM
 389   return Append (s.str().c_str());
 390 #else
 391   // Note: use dirty tricks -- unavoidable with old streams
 392   TCollection_AsciiString aStr (((Standard_SStream&)AReason).str(), AReason.pcount());
 393   ((Standard_SStream&)AReason).freeze (false);
 394   return Append (aStr.ToCString());
 395 #endif
 396 }
 397
 398 //=======================================================================
 399 //function : AppendElement
 400 //purpose  :
 401 //=======================================================================
 402
 403 void Draw_Interpretor::AppendElement(const Standard_CString s)
 404 {
 405 #ifdef TCL_USES_UTF8
 406   // Convert string to UTF-8 format for Tcl
 407   Tcl_DString TclString;
 408   Tcl_ExternalToUtfDString ( NULL, s, -1, &TclString );
 409   Tcl_AppendElement ( myInterp, Tcl_DStringValue ( &TclString ) );
 410   Tcl_DStringFree ( &TclString );
 411 #else
 412 #ifdef IRIX
 413   //AppendElement is declared as (Tcl_Interp *interp, char *string)
 414   //on SGI 32
 415   Tcl_AppendElement(myInterp,(char*) s);
 416 #else
 417   Tcl_AppendElement(myInterp, s);
 418 #endif
 419 #endif
 420 }
 421
 422 //=======================================================================
 423 //function : Eval
 424 //purpose  :
 425 //=======================================================================
 426
 427 Standard_Integer Draw_Interpretor::Eval(const Standard_CString line)
 428 {
 429   Standard_PCharacter pLine;
 430   //
 431   pLine=(Standard_PCharacter)line;
 432   //
 433   return Tcl_Eval(myInterp,pLine);
 434 }
 435
 436
 437 //=======================================================================
 438 //function : Eval
 439 //purpose  :
 440 //=======================================================================
 441
 442 Standard_Integer Draw_Interpretor::RecordAndEval(const Standard_CString line,
 443                                                  const Standard_Integer flags)
 444 {
 445   Standard_PCharacter pLine;
 446   //
 447   pLine=(Standard_PCharacter)line;
 448   return Tcl_RecordAndEval(myInterp,pLine,flags);
 449 }
 450
 451 //=======================================================================
 452 //function : EvalFile
 453 //purpose  :
 454 //=======================================================================
 455
 456 Standard_Integer Draw_Interpretor::EvalFile(const Standard_CString fname)
 457 {
 458   Standard_PCharacter pfname;
 459   //
 460   pfname=(Standard_PCharacter)fname;
 461   return Tcl_EvalFile(myInterp,pfname);
 462 }
 463
 464 //=======================================================================
 465 //function :Complete
 466 //purpose  :
 467 //=======================================================================
 468
 469 Standard_Boolean Draw_Interpretor::Complete(const Standard_CString line)
 470 {
 471   Standard_PCharacter pLine;
 472   //
 473   pLine=(Standard_PCharacter)line;
 474   return Tcl_CommandComplete(pLine);
 475 }
 476
 477 //=======================================================================
 478 //function : Destroy
 479 //purpose  :
 480 //=======================================================================
 481
 482 void Draw_Interpretor::Destroy()
 483 {
 484   // MKV 01.02.05
 485 #if ((TCL_MAJOR_VERSION > 8) || ((TCL_MAJOR_VERSION == 8) && (TCL_MINOR_VERSION >= 4)))
 486   try {
 487     OCC_CATCH_SIGNALS
 488     Tcl_Exit(0);
 489   }
 490   catch (Standard_Failure) {
 491 #ifdef DEB
 492     cout <<"Tcl_Exit have an exeption" << endl;
 493 #endif
 494   }
 495 #else
 496 #ifdef WNT
 497   Tcl_Exit(0);
 498 #endif
 499 #endif
 500 }
 501
 502 //=======================================================================
 503 //function : Interp
 504 //purpose  :
 505 //=======================================================================
 506
 507 Draw_PInterp Draw_Interpretor::Interp() const
 508 {
 509   Standard_DomainError_Raise_if (myInterp==NULL , "No call for  Draw_Interpretor::Init()");
 510   return myInterp;
 511 }
 512
 513 void Draw_Interpretor::Set(const Draw_PInterp& PIntrp)
 514 {
 515   if (isAllocated)
 516     Tcl_DeleteInterp(myInterp);
 517   isAllocated = Standard_False;
 518   myInterp = PIntrp;
 519 }