calling back TCL from C
in [TCL]
|
Prev: Event-driven way of getting file updates?
Next: 100% without investment online part time jobs..(adsense,datawork,neobux..more jobs)
From: sam appleton on 4 Aug 2010 21:47 Hi I am trying to callback a TCL function from C. TCL calls my C function with a Tcl_Obj* that represents the function to be called back with certain arguments. When I'm ready to call the TCL function back, I do Tcl_Obj* callbackObj = (argument to C function from TCL call, let's say "callback_test") Tcl_Obj* funcArg = xxxx; Tcl_Obj& cmd[2]; cmd[0] = callbackObj; cmd[1] = funcArg; Tcl_EvalObjv(interp,2,cmd,0) when I do this, all I get is expected integer but got "callback_test" can anyone enlighten me on how to callback TCL from C with functions & arguments? Sam
From: Robert Heller on 4 Aug 2010 22:14 At Wed, 4 Aug 2010 18:47:13 -0700 (PDT) sam appleton <sam.s.appleton(a)gmail.com> wrote: > > Hi > > I am trying to callback a TCL function from C. TCL calls my C function > with a Tcl_Obj* that represents the function to be called back with > certain arguments. When I'm ready to call the TCL function back, > I do > > Tcl_Obj* callbackObj = (argument to C function from TCL call, let's > say "callback_test") > > > Tcl_Obj* funcArg = xxxx; > Tcl_Obj& cmd[2]; > > cmd[0] = callbackObj; > cmd[1] = funcArg; > > Tcl_EvalObjv(interp,2,cmd,0) > > when I do this, all I get is > > expected integer but got "callback_test" > > > can anyone enlighten me on how to callback TCL from C with functions & > arguments? Download my Model Railroad System (see my signature for the URL) for some C++ code that does exactly that (look in both the FCFSupport and TTSupport C++ directories of the sources. Here is a code fragment. You want to look at the code for the Tcl8WorkInProgressCallback member functions. (This code uses the C++ STL, including basic_strings.) /** @brief Various callback classes. * These classes are used to provide a means for various class members * to access code in the outer application to handle message passing and * related activies. For the most part, the base classes don't do anything * at all, but provide a set of virtual methods that implement the various * sorts of callback functionallity. * * @author Robert Heller \<heller\@deepsoft.com\> */ /** @addtogroup FCFSupport * @{ */ namespace FCFSupport { /** @brief Work In Progress Callback. * * Provides a callback to manage a work in * progress display. This class is a dummy base class. Applications * can define member functions that manage an application specific * work in progress display. * * @author Robert Heller \<heller\@deepsoft.com\> */ class WorkInProgressCallback { public: /** @brief Constructor. * The base constructor does nothing. It is presumed that * a derived class might do something useful. */ WorkInProgressCallback() {} /** @brief Destructor. * The base destructor does nothing. It is presumed that a * derived class might do something useful. */ virtual ~WorkInProgressCallback() {} #ifndef SWIG /** Start up the work in progress display. An initial message * is passed to be displayed. * @param Message An initial message string. */ virtual void ProgressStart(const string Message) const {} /** Update the progress meter. Advance the progress meter to the * percent completed and display an updated message describing the * progress. * @param Percent The completion percentage, between 0 and 100. * A value of 100 indicates that the job is done. * @param Message A message to display, typically something * identifing what tasks have been completed. */ virtual void ProgressUpdate(int Percent,const string Message) const {} /** Mark the process meter as done. Forces the meter to 100 percent * and display a work completion message. * @param Message A message to display. */ virtual void ProgressDone(const string Message) const {} #endif }; #ifdef SWIG class Tcl8WorkInProgressCallback : public FCFSupport::WorkInProgressCallback { public: Tcl8WorkInProgressCallback(Tcl_Interp *interp,const char *start_, const char *update_, const char *done_) {} virtual ~Tcl8WorkInProgressCallback() {} }; %{ namespace FCFSupport { /** @brief A Swig Tcl 8.x derived class for work in progress handling. * Provides a Tcl interface to the work in progress callback * handling code. */ class Tcl8WorkInProgressCallback : public WorkInProgressCallback { public: /** @args startScript updateScript doneScript * Constructor. Creates a work in progress callback structure to * call back Tcl code. Stores the three commands that implement * the Tcl code for the callback. * @param startScript Start prodedure. This command gets one argument, * the message string for the work in progress startup. * @param updateScript Update prodedure. This command gets two * arguments, the percent done (as an integer between 0 and * 100), and an update message string. * @param doneScript Done procedure. This command gets one argument, * the done message string. */ Tcl8WorkInProgressCallback(Tcl_Interp *interp_,const char *start_, const char *update_,const char *done_) { interp = interp_; start = start_; update = update_; done = done_; } /*+ Destructor. */ virtual ~Tcl8WorkInProgressCallback() {} /*+ Startup member function. * @param Message Startup message. */ virtual void ProgressStart(const string Message) const; /*+ Update member function. * @param Percent Percent done, 0 to 100. * @param Message Update message. */ virtual void ProgressUpdate(int Percent,const string Message) const; /*+ Done member function. * @param Message Completion message. */ virtual void ProgressDone(const string Message) const; private: /*+ Interpreter to use for Tcl callbacks. */ Tcl_Interp *interp; /*+ Start procedure or command. */ string start; /*+ Update procedure or command. */ string update; /*+ Done procedure or command. */ string done; }; void Tcl8WorkInProgressCallback::ProgressStart(const string Message) const { #ifdef DEBUG cerr << "*** Tcl8WorkInProgressCallback::ProgressStart(" << Message << ")" << endl; #endif Tcl_Obj *striptObj = Tcl_NewListObj(0,NULL); if (Tcl_ListObjAppendElement(interp,striptObj,Tcl_NewStringObj((char *)start.c_str(),-1)) != TCL_OK) { Tcl_BackgroundError(interp); } if (Tcl_ListObjAppendElement(interp,striptObj,Tcl_NewStringObj((char *)Message.c_str(),-1)) != TCL_OK) { Tcl_BackgroundError(interp); } #ifdef DEBUG cerr << "*** Tcl8WorkInProgressCallback::ProgressStart: striptObj is " << Tcl_GetStringFromObj(striptObj,NULL) << endl; #endif int result = Tcl_EvalObjEx(interp,striptObj,TCL_EVAL_GLOBAL); #ifdef DEBUG cerr << "*** Tcl8WorkInProgressCallback::ProgressStart: result = " << result << endl; #endif if (result != TCL_OK) Tcl_BackgroundError(interp); } void Tcl8WorkInProgressCallback::ProgressUpdate(int Percent,const string Message) const { #ifdef DEBUG cerr << "*** Tcl8WorkInProgressCallback::ProgressUpdate(" << Percent << "," << Message << ")" << endl; #endif Tcl_Obj *striptObj = Tcl_NewListObj(0,NULL); if (Tcl_ListObjAppendElement(interp,striptObj,Tcl_NewStringObj((char *)update.c_str(),-1)) != TCL_OK) { Tcl_BackgroundError(interp); } if (Tcl_ListObjAppendElement(interp,striptObj,Tcl_NewIntObj(Percent)) != TCL_OK) { Tcl_BackgroundError(interp); } if (Tcl_ListObjAppendElement(interp,striptObj,Tcl_NewStringObj((char *)Message.c_str(),-1)) != TCL_OK) { Tcl_BackgroundError(interp); } #ifdef DEBUG cerr << "*** Tcl8WorkInProgressCallback::ProgressUpdate: striptObj is " << Tcl_GetStringFromObj(striptObj,NULL) << endl; #endif int result = Tcl_EvalObjEx(interp,striptObj,TCL_EVAL_GLOBAL); #ifdef DEBUG cerr << "*** Tcl8WorkInProgressCallback::ProgressUpdate: result = " << result << endl; #endif if (result != TCL_OK) Tcl_BackgroundError(interp); } void Tcl8WorkInProgressCallback::ProgressDone(const string Message) const { #ifdef DEBUG cerr << "*** Tcl8WorkInProgressCallback::ProgressDone(" << Message << ")" << endl; #endif Tcl_Obj *striptObj = Tcl_NewListObj(0,NULL); if (Tcl_ListObjAppendElement(interp,striptObj,Tcl_NewStringObj((char *)done.c_str(),-1)) != TCL_OK) { Tcl_BackgroundError(interp); } if (Tcl_ListObjAppendElement(interp,striptObj,Tcl_NewStringObj((char *)Message.c_str(),-1)) != TCL_OK) { Tcl_BackgroundError(interp); } #ifdef DEBUG cerr << "*** Tcl8WorkInProgressCallback::ProgressDone: striptObj is " << Tcl_GetStringFromObj(striptObj,NULL) << endl; #endif int result = Tcl_EvalObjEx(interp,striptObj,TCL_EVAL_GLOBAL); #ifdef DEBUG cerr << "*** Tcl8WorkInProgressCallback::ProgressDone: result = " << result << endl; #endif if (result != TCL_OK) Tcl_BackgroundError(interp); } } %} > > Sam > -- Robert Heller -- 978-544-6933 Deepwoods Software -- Download the Model Railroad System http://www.deepsoft.com/ -- Binaries for Linux and MS-Windows heller(a)deepsoft.com -- http://www.deepsoft.com/ModelRailroadSystem/
From: Harald Oehlmann on 5 Aug 2010 02:49 On 5 Aug., 03:47, sam appleton <sam.s.apple...(a)gmail.com> wrote: > Tcl_Obj* callbackObj = (argument to C function from TCL call, let's > say "callback_test") > Tcl_Obj* funcArg = xxxx; > Tcl_Obj& cmd[2]; > cmd[0] = callbackObj; > cmd[1] = funcArg; > Tcl_EvalObjv(interp,2,cmd,0) Hi Sam, for me, your approach and code sketch is correct. > when I do this, all I get is > expected integer but got "callback_test" I did not get the issue. What is not working ? Maybee you may post more code and more results ?
From: sam appleton on 5 Aug 2010 04:04 Thanks for your reply Robert. Are you saying the correct way to do this is to construct a ListObject and pass that to Tcl_EvalObjEx? That's what your code looks to be doing. sam On Aug 4, 7:14 pm, Robert Heller <hel...(a)deepsoft.com> wrote: > At Wed, 4 Aug 2010 18:47:13 -0700 (PDT) sam appleton <sam.s.apple...(a)gmail.com> wrote: > > > > > > > Hi > > > I am trying to callback a TCL function from C. TCL calls my C function > > with a Tcl_Obj* that represents the function to be called back with > > certain arguments. When I'm ready to call the TCL function back, > > I do > > > Tcl_Obj* callbackObj = (argument to C function from TCL call, let's > > say "callback_test") > > > Tcl_Obj* funcArg = xxxx; > > Tcl_Obj& cmd[2]; > > > cmd[0] = callbackObj; > > cmd[1] = funcArg; > > > Tcl_EvalObjv(interp,2,cmd,0) > > > when I do this, all I get is > > > expected integer but got "callback_test" > > > can anyone enlighten me on how to callback TCL from C with functions & > > arguments? > > Download my Model Railroad System (see my signature for the URL) for > some C++ code that does exactly that (look in both the FCFSupport and > TTSupport C++ directories of the sources. > > Here is a code fragment. You want to look at the code for the > Tcl8WorkInProgressCallback member functions. (This code uses the C++ > STL, including basic_strings.) > > /** @brief Various callback classes. > * These classes are used to provide a means for various class members > * to access code in the outer application to handle message passing and > * related activies. For the most part, the base classes don't do anything > * at all, but provide a set of virtual methods that implement the various > * sorts of callback functionallity. > * > * @author Robert Heller \<heller\@deepsoft.com\> > */ > > /** @addtogroup FCFSupport > * @{ > */ > > namespace FCFSupport { > > /** @brief Work In Progress Callback. > * > * Provides a callback to manage a work in > * progress display. This class is a dummy base class. Applications > * can define member functions that manage an application specific > * work in progress display. > * > * @author Robert Heller \<heller\@deepsoft.com\> > */ > class WorkInProgressCallback { > public: > /** @brief Constructor. > * The base constructor does nothing. It is presumed that > * a derived class might do something useful. > */ > WorkInProgressCallback() {} > /** @brief Destructor. > * The base destructor does nothing. It is presumed that a > * derived class might do something useful. > */ > virtual ~WorkInProgressCallback() {} > #ifndef SWIG > /** Start up the work in progress display. An initial message > * is passed to be displayed. > * @param Message An initial message string. > */ > virtual void ProgressStart(const string Message) const {} > /** Update the progress meter. Advance the progress meter to the > * percent completed and display an updated message describing the > * progress. > * @param Percent The completion percentage, between 0 and 100. > * A value of 100 indicates that the job is done. > * @param Message A message to display, typically something > * identifing what tasks have been completed. > */ > virtual void ProgressUpdate(int Percent,const string Message) const {} > /** Mark the process meter as done. Forces the meter to 100 percent > * and display a work completion message. > * @param Message A message to display. > */ > virtual void ProgressDone(const string Message) const {} > #endif > > }; > > #ifdef SWIG > class Tcl8WorkInProgressCallback : public FCFSupport::WorkInProgressCallback { > public: > Tcl8WorkInProgressCallback(Tcl_Interp *interp,const char *start_, > const char *update_, const char *done_) {} > virtual ~Tcl8WorkInProgressCallback() {} > > }; > > %{ > namespace FCFSupport { > > /** @brief A Swig Tcl 8.x derived class for work in progress handling. > * Provides a Tcl interface to the work in progress callback > * handling code. > */ > class Tcl8WorkInProgressCallback : public WorkInProgressCallback { > public: > /** @args startScript updateScript doneScript > * Constructor. Creates a work in progress callback structure to > * call back Tcl code. Stores the three commands that implement > * the Tcl code for the callback. > * @param startScript Start prodedure. This command gets one argument, > * the message string for the work in progress startup. > * @param updateScript Update prodedure. This command gets two > * arguments, the percent done (as an integer between 0 and > * 100), and an update message string. > * @param doneScript Done procedure. This command gets one argument, > * the done message string. > */ > Tcl8WorkInProgressCallback(Tcl_Interp *interp_,const char *start_, > const char *update_,const char *done_) { > interp = interp_; > start = start_; > update = update_; > done = done_; > } > /*+ Destructor. > */ > virtual ~Tcl8WorkInProgressCallback() {} > /*+ Startup member function. > * @param Message Startup message. > */ > virtual void ProgressStart(const string Message) const; > /*+ Update member function. > * @param Percent Percent done, 0 to 100. > * @param Message Update message. > */ > virtual void ProgressUpdate(int Percent,const string Message) const; > /*+ Done member function. > * @param Message Completion message. > */ > virtual void ProgressDone(const string Message) const; > private: > /*+ Interpreter to use for Tcl callbacks. > */ > Tcl_Interp *interp; > /*+ Start procedure or command. > */ > string start; > /*+ Update procedure or command. > */ > string update; > /*+ Done procedure or command. > */ > string done; > > }; > > void Tcl8WorkInProgressCallback::ProgressStart(const string Message) const { > #ifdef DEBUG > cerr << "*** Tcl8WorkInProgressCallback::ProgressStart(" << Message << ")" << endl; > #endif > Tcl_Obj *striptObj = Tcl_NewListObj(0,NULL); > if (Tcl_ListObjAppendElement(interp,striptObj,Tcl_NewStringObj((char *)start.c_str(),-1)) != TCL_OK) { > Tcl_BackgroundError(interp); > } > if (Tcl_ListObjAppendElement(interp,striptObj,Tcl_NewStringObj((char *)Message.c_str(),-1)) != TCL_OK) { > Tcl_BackgroundError(interp); > } > #ifdef DEBUG > cerr << "*** Tcl8WorkInProgressCallback::ProgressStart: striptObj is " << Tcl_GetStringFromObj(striptObj,NULL) << endl; > #endif > int result = Tcl_EvalObjEx(interp,striptObj,TCL_EVAL_GLOBAL); > #ifdef DEBUG > cerr << "*** Tcl8WorkInProgressCallback::ProgressStart: result = " << result << endl; > #endif > if (result != TCL_OK) Tcl_BackgroundError(interp); > > } > > void Tcl8WorkInProgressCallback::ProgressUpdate(int Percent,const string Message) const { > #ifdef DEBUG > cerr << "*** Tcl8WorkInProgressCallback::ProgressUpdate(" << Percent << "," << Message << ")" << endl; > #endif > Tcl_Obj *striptObj = Tcl_NewListObj(0,NULL); > if (Tcl_ListObjAppendElement(interp,striptObj,Tcl_NewStringObj((char *)update.c_str(),-1)) != TCL_OK) { > Tcl_BackgroundError(interp); > } > if (Tcl_ListObjAppendElement(interp,striptObj,Tcl_NewIntObj(Percent)) != TCL_OK) { > Tcl_BackgroundError(interp); > } > if (Tcl_ListObjAppendElement(interp,striptObj,Tcl_NewStringObj((char *)Message.c_str(),-1)) != TCL_OK) { > Tcl_BackgroundError(interp); > } > #ifdef DEBUG > cerr << "*** Tcl8WorkInProgressCallback::ProgressUpdate: striptObj is " << Tcl_GetStringFromObj(striptObj,NULL) << endl; > #endif > int result = Tcl_EvalObjEx(interp,striptObj,TCL_EVAL_GLOBAL); > #ifdef DEBUG > cerr << "*** Tcl8WorkInProgressCallback::ProgressUpdate: result = " << result << endl; > #endif > if (result != TCL_OK) Tcl_BackgroundError(interp); > > } > > void Tcl8WorkInProgressCallback::ProgressDone(const string Message) const { > #ifdef DEBUG > cerr << "*** Tcl8WorkInProgressCallback::ProgressDone(" << Message << ")" << endl; > #endif > Tcl_Obj *striptObj = Tcl_NewListObj(0,NULL); > if (Tcl_ListObjAppendElement(interp,striptObj,Tcl_NewStringObj((char *)done.c_str(),-1)) != TCL_OK) { > Tcl_BackgroundError(interp); > } > if (Tcl_ListObjAppendElement(interp,striptObj,Tcl_NewStringObj((char *)Message.c_str(),-1)) != TCL_OK) { > Tcl_BackgroundError(interp); > } > #ifdef DEBUG > cerr << "*** Tcl8WorkInProgressCallback::ProgressDone: striptObj is " << Tcl_GetStringFromObj(striptObj,NULL) << endl; > #endif > int result = Tcl_EvalObjEx(interp,striptObj,TCL_EVAL_GLOBAL); > #ifdef DEBUG > cerr << "*** Tcl8WorkInProgressCallback::ProgressDone: result = " << result << endl; > #endif > if (result != TCL_OK) Tcl_BackgroundError(interp);} > } > > %} > > > > > Sam > > -- > Robert Heller -- 978-544-6933 > Deepwoods Software -- Download the Model Railroad Systemhttp://www.deepsoft.com/ -- Binaries for Linux and MS-Windows > hel...(a)deepsoft.com --http://www.deepsoft.com/ModelRailroadSystem/
From: sam appleton on 5 Aug 2010 04:06
Hi Harald - thanks for your reply. The frustrating thing is the string that I quoted _was_ the result when the callback from C to TCL occured via Tcl_EvalObjv, so it's hard to figure out exactly what happened. Sam On Aug 4, 11:49 pm, Harald Oehlmann <wortka...(a)yahoo.de> wrote: > On 5 Aug., 03:47, sam appleton <sam.s.apple...(a)gmail.com> wrote: > > > Tcl_Obj* callbackObj = (argument to C function from TCL call, let's > > say "callback_test") > > Tcl_Obj* funcArg = xxxx; > > Tcl_Obj& cmd[2]; > > cmd[0] = callbackObj; > > cmd[1] = funcArg; > > Tcl_EvalObjv(interp,2,cmd,0) > > Hi Sam, > for me, your approach and code sketch is correct. > > > when I do this, all I get is > > expected integer but got "callback_test" > > I did not get the issue. What is not working ? > > Maybee you may post more code and more results ? |