1 /*=========================================================================
2 *
3 * Copyright Insight Software Consortium
4 *
5 * Licensed under the Apache License, Version 2.0 (the "License");
6 * you may not use this file except in compliance with the License.
7 * You may obtain a copy of the License at
8 *
9 * http://www.apache.org/licenses/LICENSE-2.0.txt
10 *
11 * Unless required by applicable law or agreed to in writing, software
12 * distributed under the License is distributed on an "AS IS" BASIS,
13 * WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
14 * See the License for the specific language governing permissions and
15 * limitations under the License.
16 *
17 *=========================================================================*/
18
19 #include "itkTclCommand.h"
20
21 namespace itk
22 {
23
TclCommand()24 TclCommand::TclCommand()
25 {
26 m_Interpreter = 0;
27 }
28
29
30 ///! Set the interpreter in which the command is to be invoked.
SetInterpreter(Tcl_Interp * interp)31 void TclCommand::SetInterpreter(Tcl_Interp* interp)
32 {
33 m_Interpreter = interp;
34 }
35
36
37 ///! Get the interpreter in which the command will be invoked.
GetInterpreter() const38 Tcl_Interp* TclCommand::GetInterpreter() const
39 {
40 return m_Interpreter;
41 }
42
43
44 ///! Set the command to invoke in the interpreter.
SetCommandString(const char * commandString)45 void TclCommand::SetCommandString(const char* commandString)
46 {
47 m_CommandString = commandString;
48 }
49
50
51 ///! Get the command that will be invoked in the interpreter.
GetCommandString() const52 const char* TclCommand::GetCommandString() const
53 {
54 return m_CommandString.c_str();
55 }
56
57
58 ///! Execute the callback to the Tcl interpreter.
Execute(Object *,const EventObject &)59 void TclCommand::Execute(Object*, const EventObject &)
60 {
61 this->TclExecute();
62 }
63
64
65 ///! Execute the callback to the Tcl interpreter with a const LightObject
Execute(const Object *,const EventObject &)66 void TclCommand::Execute(const Object*, const EventObject & )
67 {
68 this->TclExecute();
69 }
70
71
72 /**
73 * Invokes the registered command in the Tcl interpreter. Reports
74 * command errors as ITK warnings.
75 */
TclExecute() const76 void TclCommand::TclExecute() const
77 {
78 // Make sure an interpreter has been assigned.
79 if(!m_Interpreter)
80 {
81 itkWarningMacro("Error in itk/tcl callback:\n" <<
82 m_CommandString.c_str() << std::endl <<
83 "invoked with no interpreter!");
84 return;
85 }
86
87 // Try to evaluate the command in the interpreter.
88 if(Tcl_GlobalEval(m_Interpreter,
89 const_cast<char*>(m_CommandString.c_str())) == TCL_ERROR)
90 {
91 const char* errorInfo = Tcl_GetVar(m_Interpreter, "errorInfo", 0);
92 if(!errorInfo) { errorInfo = ""; }
93 itkWarningMacro("Error returned from itk/tcl callback:\n" <<
94 m_CommandString.c_str() << std::endl << errorInfo <<
95 " at line number " << m_Interpreter->errorLine);
96 }
97 }
98
99 } // namespace itk
100