[occt.git] / src / Draw / Draw_Interpretor.cxx

// File:	Draw_Interpretor.cxx
// Created:	Thu Feb 23 17:53:09 1995
// Author:	Remi LEQUETTE
//		<rle@bravox>


#include <Draw_Interpretor.ixx>
#include <Draw_Appli.hxx>
#include <Standard_SStream.hxx>
#include <Standard_RangeError.hxx>
#include <Standard_ErrorHandler.hxx>
#include <Standard_Macro.hxx>

#include <TCollection_AsciiString.hxx>
#include <TCollection_ExtendedString.hxx>

#include <string.h>

#include <tcl.h>

#if ((TCL_MAJOR_VERSION > 8) || ((TCL_MAJOR_VERSION == 8) && (TCL_MINOR_VERSION >= 1)))
#define TCL_USES_UTF8
#endif

//
// Auxiliary tool to convert strings in command arguments from UTF-8 
// (Tcl internal encoding since Tcl 8.1) to system local encoding, 
// normally extended Ascii as expected by OCC commands
//
class TclUTFToLocalStringSentry {
 public:

#ifdef TCL_USES_UTF8
  TclUTFToLocalStringSentry (int argc, const char **argv) :
    nb(0),
    TclArgv(new Tcl_DString[argc]),
    Argv(new char*[argc])
  {
    for (; nb < argc; nb++ ) {
      Tcl_UtfToExternalDString ( NULL, argv[nb], -1, &TclArgv[nb] );
      Argv[nb] = Tcl_DStringValue ( &TclArgv[nb] );
    }
  }
  
  ~TclUTFToLocalStringSentry () 
  {
    delete[] Argv;
    while ( nb-- >0 ) Tcl_DStringFree ( &TclArgv[nb] );
    delete[] TclArgv;
  }
#else
  TclUTFToLocalStringSentry (int, const char **argv) : Argv((char**)argv) {}
#endif

  const char **GetArgv () const { return (const char **)Argv; }
  
 private:
  int nb;
  Tcl_DString *TclArgv;
  char **Argv;
};


//
// Call backs for TCL
//

struct CData {
  CData(Draw_CommandFunction ff, Draw_Interpretor* ii) : f(ff), i(ii) {}
  Draw_CommandFunction f;
  Draw_Interpretor*    i;
};

// MKV 29.03.05
#if ((TCL_MAJOR_VERSION > 8) || ((TCL_MAJOR_VERSION == 8) && (TCL_MINOR_VERSION >= 4))) && !defined(USE_NON_CONST)
static Standard_Integer CommandCmd 
(ClientData clientData, Tcl_Interp *interp,
 Standard_Integer argc, const char* argv[])
#else
static Standard_Integer CommandCmd 
(ClientData clientData, Tcl_Interp *interp,
 Standard_Integer argc, char* argv[])
#endif
{
  static Standard_Integer code;
  code = TCL_OK;
  CData* C = (CData*) clientData;

  try {
    OCC_CATCH_SIGNALS

    // OCC63: Convert strings from UTF-8 to local encoding, normally expected by OCC commands
    TclUTFToLocalStringSentry anArgs ( argc, (const char**)argv );
      
    Draw_Interpretor& di = *(C->i);
    Standard_Integer fres = C->f ( di, argc, anArgs.GetArgv() );
    if (fres != 0) 
      code = TCL_ERROR;
  }
  catch (Standard_Failure) {

    Handle(Standard_Failure) E = Standard_Failure::Caught();

    // fail if Draw_ExitOnCatch is set
    // MKV 29.03.05
#if ((TCL_MAJOR_VERSION > 8) || ((TCL_MAJOR_VERSION == 8) && (TCL_MINOR_VERSION >= 4))) && !defined(USE_NON_CONST)
    const char*  cc = Tcl_GetVar(interp,
			  "Draw_ExitOnCatch",TCL_GLOBAL_ONLY);
#else
    char* const cc = Tcl_GetVar(interp,
			  "Draw_ExitOnCatch",TCL_GLOBAL_ONLY);
#endif

    cout << "An exception was caught " << E << endl;

    if (cc && atoi(cc)) {
#ifdef WNT
      Tcl_Exit(0);
#else      
      Tcl_Eval(interp,"exit");
#endif
    }

    // get the error message
    Standard_SStream ss;
    ss << "** Exception ** " << E << ends ;
#ifdef USE_STL_STREAM
    Tcl_SetResult(interp,(char*)(ss.str().c_str()),TCL_VOLATILE);
#else
    Tcl_SetResult(interp,(char*)(ss.str()),TCL_VOLATILE);
#endif    
    code = TCL_ERROR;
  }
  
  return code;
}


static void CommandDelete (ClientData clientData)
{
  CData *C = (CData*) clientData;
  delete C;
}

//=======================================================================
//function : Draw_Interpretor
//purpose  : 
//=======================================================================

Draw_Interpretor::Draw_Interpretor() :
  isAllocated(Standard_False)
{
// The tcl interpreter is not created immediately as it is kept 
// by a global variable and created and deleted before the main().
  myInterp  = NULL;
}

//=======================================================================
//function : Init
//purpose  : It is necessary to call this function
//=======================================================================

void Draw_Interpretor::Init()
{
  if (isAllocated) 
    Tcl_DeleteInterp(myInterp);
  isAllocated=Standard_True;
  myInterp=Tcl_CreateInterp();
}

//=======================================================================
//function : Draw_Interpretor
//purpose  : 
//=======================================================================

Draw_Interpretor::Draw_Interpretor(const Draw_PInterp& p) :
  isAllocated(Standard_False),
  myInterp(p)
{
}

//=======================================================================
//function : Add
//purpose  : 
//=======================================================================
//#ifdef WNT
void Draw_Interpretor::Add(const Standard_CString n,
			   const Standard_CString help,
			   const Draw_CommandFunction f,
			   const Standard_CString group)
//#else
//void Draw_Interpretor::Add(const Standard_CString n,
//			   const Standard_CString help,
//			   const Draw_CommandFunction& f,
//			   const Standard_CString group)
//#endif
{
  Standard_PCharacter pN, pHelp, pGroup;
  //
  pN=(Standard_PCharacter)n;
  pHelp=(Standard_PCharacter)help;
  pGroup=(Standard_PCharacter)group;
  //
  if (myInterp==NULL) Init();

  CData* C = new CData(f,this);
  
  Tcl_CreateCommand(myInterp, pN ,CommandCmd, (ClientData) C, CommandDelete);

  // add the help
  Tcl_SetVar2(myInterp,"Draw_Helps", pN, pHelp, TCL_GLOBAL_ONLY);
  Tcl_SetVar2(myInterp,"Draw_Groups",pGroup,pN,
	      TCL_GLOBAL_ONLY|TCL_APPEND_VALUE|TCL_LIST_ELEMENT);
}
//=======================================================================
//function : Add
//purpose  : 
//=======================================================================
void Draw_Interpretor::Add(const Standard_CString n,
			   const Standard_CString help,
			   const Standard_CString file_name,
			   const Draw_CommandFunction f,
			   const Standard_CString group)
{
  Standard_PCharacter pN, pHelp, pGroup, pFileName;
  //
  pN=(Standard_PCharacter)n;
  pHelp=(Standard_PCharacter)help;
  pGroup=(Standard_PCharacter)group;
  pFileName=(Standard_PCharacter)file_name;
  //
  if (myInterp==NULL) Init();

  CData* C = new CData(f,this);
  Standard_Integer length, num_slashes,  ii,  jj,  kk;
  Tcl_CreateCommand(myInterp,pN,CommandCmd, (ClientData) C, CommandDelete);

  // add the help
  Tcl_SetVar2(myInterp,"Draw_Helps",pN,pHelp,TCL_GLOBAL_ONLY);
  Tcl_SetVar2(myInterp,"Draw_Groups",pGroup,pN,
	      TCL_GLOBAL_ONLY|TCL_APPEND_VALUE|TCL_LIST_ELEMENT);
  length = strlen(pFileName) ;
  char * a_string = 
    new char[length + 1] ;
  jj = 0 ;
  num_slashes = 0 ;
  ii = length ;
  while (num_slashes < 3 && ii >= 0) {
    if (file_name[ii] == '/') {
      num_slashes += 1 ;
    }
    ii -= 1 ; 
  } 
  jj = 0 ;
  for (kk = ii+2 , jj =0 ; kk < length ; kk++) {
     a_string[jj] = file_name[kk] ;
     jj += 1 ;
   }
  a_string[jj] = '\0' ;
 
  Tcl_SetVar2(myInterp,"Draw_Files",pN,a_string,TCL_GLOBAL_ONLY);

  delete [] a_string;

}


//=======================================================================
//function : Remove
//purpose  : 
//=======================================================================

Standard_Boolean Draw_Interpretor::Remove(Standard_CString const n)
{
  Standard_PCharacter pN;
  //
  pN=(Standard_PCharacter)n;
 
  Standard_Integer result = Tcl_DeleteCommand(myInterp,pN);
  return result == 0;
}

//=======================================================================
//function : Result
//purpose  : 
//=======================================================================

Standard_CString Draw_Interpretor::Result() const
{
#if ((TCL_MAJOR_VERSION > 8) || ((TCL_MAJOR_VERSION == 8) && (TCL_MINOR_VERSION >= 5)))
  return Tcl_GetStringResult(myInterp);
#else
  return myInterp->result;
#endif
}

//=======================================================================
//function : Reset
//purpose  : 
//=======================================================================

void Draw_Interpretor::Reset()
{
  Tcl_ResetResult(myInterp);
}

//=======================================================================
//function : Append
//purpose  : 
//=======================================================================

Draw_Interpretor& Draw_Interpretor::Append(const Standard_CString s)
{
#ifdef TCL_USES_UTF8
  // Convert string to UTF-8 format for Tcl
  Tcl_DString TclString;
  Tcl_ExternalToUtfDString ( NULL, s, -1, &TclString );
  Tcl_AppendResult ( myInterp, Tcl_DStringValue ( &TclString ), (Standard_CString)0 );
  Tcl_DStringFree ( &TclString );
#else
  Tcl_AppendResult(myInterp,s,(Standard_CString)0);
#endif
  return *this;
}

//=======================================================================
//function : Append
//purpose  : 
//=======================================================================

Draw_Interpretor& Draw_Interpretor::Append(const TCollection_AsciiString& s)
{
  return Append (s.ToCString());
}

//=======================================================================
//function : Append
//purpose  : 
//=======================================================================

Draw_Interpretor& Draw_Interpretor::Append(const TCollection_ExtendedString& theString)
{
#ifdef TCL_USES_UTF8
  // Convert string to UTF-8 format for Tcl
  char *str = new char[theString.LengthOfCString()+1];
  theString.ToUTF8CString (str);
  Tcl_AppendResult ( myInterp, str, (Standard_CString)0 );
  delete[] str;
#else
  // put as ascii string, replacing non-ascii characters by '?'
  TCollection_AsciiString str (theString, '?');
  Tcl_AppendResult(myInterp,str.ToCString(),(Standard_CString)0);
#endif
  return *this;
}

//=======================================================================
//function : Append
//purpose  : 
//=======================================================================

Draw_Interpretor& Draw_Interpretor::Append(const Standard_Integer i)
{
  char c[100];
  sprintf(c,"%d",i);
  Tcl_AppendResult(myInterp,c,(Standard_CString)0);
  return *this;
}

//=======================================================================
//function : Append
//purpose  : 
//=======================================================================

Draw_Interpretor& Draw_Interpretor::Append(const Standard_Real r)
{
  char s[100];
  sprintf(s,"%.17g",r);
  Tcl_AppendResult(myInterp,s,(Standard_CString)0);
  return *this;
}

//=======================================================================
//function : Append
//purpose  : 
//=======================================================================

Draw_Interpretor& Draw_Interpretor::Append(const Standard_SStream& s)
{
#ifdef USE_STL_STREAM
  return Append (s.str().c_str());
#else
  // Note: use dirty tricks -- unavoidable with old streams 
  TCollection_AsciiString aStr (((Standard_SStream&)AReason).str(), AReason.pcount());
  ((Standard_SStream&)AReason).freeze (false);
  return Append (aStr.ToCString());
#endif
}

//=======================================================================
//function : AppendElement
//purpose  : 
//=======================================================================

void Draw_Interpretor::AppendElement(const Standard_CString s)
{
#ifdef TCL_USES_UTF8
  // Convert string to UTF-8 format for Tcl
  Tcl_DString TclString;
  Tcl_ExternalToUtfDString ( NULL, s, -1, &TclString );
  Tcl_AppendElement ( myInterp, Tcl_DStringValue ( &TclString ) );
  Tcl_DStringFree ( &TclString );
#else
#ifdef IRIX
  //AppendElement is declared as (Tcl_Interp *interp, char *string)
  //on SGI 32
  Tcl_AppendElement(myInterp,(char*) s);
#else
  Tcl_AppendElement(myInterp, s);
#endif
#endif
}

//=======================================================================
//function : Eval
//purpose  : 
//=======================================================================

Standard_Integer Draw_Interpretor::Eval(const Standard_CString line)
{
  Standard_PCharacter pLine;
  //
  pLine=(Standard_PCharacter)line;
  //
  return Tcl_Eval(myInterp,pLine);
}


//=======================================================================
//function : Eval
//purpose  : 
//=======================================================================

Standard_Integer Draw_Interpretor::RecordAndEval(const Standard_CString line,
						 const Standard_Integer flags)
{
  Standard_PCharacter pLine;
  //
  pLine=(Standard_PCharacter)line;
  return Tcl_RecordAndEval(myInterp,pLine,flags);
}

//=======================================================================
//function : EvalFile
//purpose  : 
//=======================================================================

Standard_Integer Draw_Interpretor::EvalFile(const Standard_CString fname)
{
  Standard_PCharacter pfname;
  //
  pfname=(Standard_PCharacter)fname;
  return Tcl_EvalFile(myInterp,pfname);
}

//=======================================================================
//function :Complete
//purpose  : 
//=======================================================================

Standard_Boolean Draw_Interpretor::Complete(const Standard_CString line)
{
  Standard_PCharacter pLine;
  //
  pLine=(Standard_PCharacter)line;
  return Tcl_CommandComplete(pLine);
}

//=======================================================================
//function : Destroy
//purpose  : 
//=======================================================================

void Draw_Interpretor::Destroy()
{
  // MKV 01.02.05
#if ((TCL_MAJOR_VERSION > 8) || ((TCL_MAJOR_VERSION == 8) && (TCL_MINOR_VERSION >= 4)))
  try {
    OCC_CATCH_SIGNALS
    Tcl_Exit(0);
  }
  catch (Standard_Failure) {
#ifdef DEB
    cout <<"Tcl_Exit have an exeption" << endl;
#endif
  }
#else
#ifdef WNT
  Tcl_Exit(0);
#endif  
#endif
}

//=======================================================================
//function : Interp
//purpose  : 
//=======================================================================

Draw_PInterp Draw_Interpretor::Interp() const
{
  Standard_DomainError_Raise_if (myInterp==NULL , "No call for  Draw_Interpretor::Init()");
  return myInterp;
}

void Draw_Interpretor::Set(const Draw_PInterp& PIntrp)
{
  if (isAllocated)
    Tcl_DeleteInterp(myInterp);
  isAllocated = Standard_False;
  myInterp = PIntrp;
}
Commit	Line	Data
7fd59977	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	{
0d969553 Y	153	// The tcl interpreter is not created immediately as it is kept
0d969553 Y	154	// by a global variable and created and deleted before the main().
7fd59977	155	myInterp = NULL;
	156	}
	157
	158	//=======================================================================
	159	//function : Init
0d969553	160	//purpose : It is necessary to call this function
7fd59977	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
938a360f	263	delete [] a_string;
938a360f	264
7fd59977	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	}