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