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 5 Aug 2010 04:22 Robert I did try this and got the same result. I will keep digging. sam On Aug 5, 1:04 am, sam appleton <sam.s.apple...(a)gmail.com> wrote: > 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 > > > > ... > > read more »
From: Harald Oehlmann on 5 Aug 2010 05:50 On 5 Aug., 10:06, sam appleton <sam.s.apple...(a)gmail.com> wrote: > 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. So the string "callabck_test" was set in the interpreter result ? You have read this text by calling "Tcl_GetObjResult(interp)" after Tcl_Eval ? If you take a routine, say: proc callback_test args { puts <$args> return "ok" } does it put "<xxxx>" on the console ? Or "<>" ?
From: Ralf Fassel on 5 Aug 2010 10:20 * sam appleton <sam.s.appleton(a)gmail.com> | Robert | I did try this and got the same result. I will keep digging. I guess it would be good if you show the exact C code you're running (probably snipped to the interesting context), together with the TCL code you're calling (the 'callback_test' proc code)... R'
From: Robert Heller on 5 Aug 2010 11:21 At Thu, 5 Aug 2010 01:04:26 -0700 (PDT) sam appleton <sam.s.appleton(a)gmail.com> wrote: > > > 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. Yes. Basically what I am doing is something like this: namespace mycontainer { variable savedfunction {} proc savefunction {f} { variable savedfunction set savedfunction $f } proc callback {someargument} { variable savedfunction if {[catch [list $savedfunction $someargument] theerror]} { berror $theerror } } } But coded in C++. > > sam > > > On Aug 4, 7:14=A0pm, Robert Heller <hel...(a)deepsoft.com> wrote: > > At Wed, 4 Aug 2010 18:47:13 -0700 (PDT) sam appleton <sam.s.apple...(a)gmai= > l.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 =3D (argument to C function from TCL call, let's > > > say "callback_test") > > > > > Tcl_Obj* funcArg =3D xxxx; > > > Tcl_Obj& cmd[2]; > > > > > cmd[0] =3D callbackObj; > > > cmd[1] =3D 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. =A0You want to look at the code for the > > Tcl8WorkInProgressCallback member functions. =A0(This code uses the C++ > > STL, including basic_strings.) > > > > /** @brief =A0Various callback classes. > > =A0 * =A0 =A0 These classes are used to provide a means for various class= > members > > =A0 * =A0 =A0 to access code in the outer application to handle message p= > assing and > > =A0 * =A0 =A0 related activies. For the most part, the base classes don't= > do anything > > =A0 * =A0 =A0 at all, but provide a set of virtual methods that implement= > the various > > =A0 * =A0 =A0 sorts of callback functionallity. > > =A0 * > > =A0 * =A0 =A0 @author Robert Heller \<heller\@deepsoft.com\> > > =A0 */ > > > > /** @addtogroup FCFSupport > > =A0 * @{ > > =A0 */ > > > > namespace FCFSupport { > > > > /** =A0 @brief Work In Progress Callback. > > =A0 * > > =A0 * =A0 =A0 Provides a callback to manage a work in > > =A0 * =A0 =A0 progress display. =A0This class is a dummy base class. =A0A= > pplications > > =A0 * =A0 =A0 can define member functions that manage an application spec= > ific > > =A0 * =A0 =A0 work in progress display. > > =A0 * > > =A0 * =A0 =A0 @author Robert Heller \<heller\@deepsoft.com\> > > =A0 */ > > class WorkInProgressCallback { > > public: > > =A0 =A0 =A0 =A0 /** @brief Constructor. > > =A0 =A0 =A0 =A0 =A0 * The base constructor does nothing. =A0It is presume= > d that > > =A0 =A0 =A0 =A0 =A0 * a derived class might do something useful. > > =A0 =A0 =A0 =A0 =A0 */ > > =A0 =A0 =A0 =A0 WorkInProgressCallback() {} > > =A0 =A0 =A0 =A0 /** @brief Destructor. > > =A0 =A0 =A0 =A0 =A0 * The base destructor does nothing. =A0It is presumed= > that a > > =A0 =A0 =A0 =A0 =A0 * derived class might do something useful. > > =A0 =A0 =A0 =A0 =A0 */ > > =A0 =A0 =A0 =A0 virtual ~WorkInProgressCallback() {} > > #ifndef SWIG > > =A0 =A0 =A0 =A0 /** =A0Start up the work in progress display. =A0An initi= > al message > > =A0 =A0 =A0 =A0 =A0 * is passed to be displayed. > > =A0 =A0 =A0 =A0 =A0 * @param Message An initial message string. > > =A0 =A0 =A0 =A0 =A0 */ > > =A0 =A0 =A0 =A0 virtual void ProgressStart(const string Message) const {} > > =A0 =A0 =A0 =A0 /** =A0Update the progress meter. Advance the progress me= > ter to the > > =A0 =A0 =A0 =A0 =A0 * percent completed and display an updated message de= > scribing the > > =A0 =A0 =A0 =A0 =A0 * progress. > > =A0 =A0 =A0 =A0 =A0 * @param Percent The completion percentage, between 0= > and 100. > > =A0 =A0 =A0 =A0 =A0 * =A0 =A0 =A0 A value of 100 indicates that the job i= > s done. > > =A0 =A0 =A0 =A0 =A0 * @param Message A message to display, typically some= > thing > > =A0 =A0 =A0 =A0 =A0 * =A0 =A0 =A0 identifing what tasks have been complet= > ed. > > =A0 =A0 =A0 =A0 =A0 */ > > =A0 =A0 =A0 =A0 virtual void ProgressUpdate(int Percent,const string Mess= > age) const {} > > =A0 =A0 =A0 =A0 /** =A0Mark the process meter as done. =A0Forces the mete= > r to 100 percent > > =A0 =A0 =A0 =A0 =A0 * and display a work completion message. > > =A0 =A0 =A0 =A0 =A0 * @param Message A message to display. > > =A0 =A0 =A0 =A0 =A0 */ > > =A0 =A0 =A0 =A0 virtual void ProgressDone(const string Message) const {} > > #endif > > > > }; > > > > #ifdef SWIG > > class Tcl8WorkInProgressCallback : public FCFSupport::WorkInProgressCallb= > ack { > > public: > > =A0 =A0 =A0 =A0 Tcl8WorkInProgressCallback(Tcl_Interp *interp,const char = > *start_, > > =A0 =A0 =A0 =A0 =A0 =A0 =A0 =A0 =A0 =A0 =A0 =A0 =A0 =A0 =A0 =A0 =A0 =A0co= > nst char *update_, const char *done_) {} > > =A0 =A0 =A0 =A0 virtual ~Tcl8WorkInProgressCallback() {} > > > > }; > > > > %{ > > namespace FCFSupport { > > > > /** =A0(a)brief A Swig Tcl 8.x derived class for work in progress handling. > > =A0 * =A0Provides a Tcl interface to the work in progress callback > > =A0 * =A0handling code. > > =A0 */ > > class Tcl8WorkInProgressCallback : public WorkInProgressCallback { > > public: > > =A0 =A0 =A0 =A0 /** @args startScript updateScript doneScript > > =A0 =A0 =A0 =A0 =A0 * Constructor. =A0Creates a work in progress callback= > structure to > > =A0 =A0 =A0 =A0 =A0 * call back Tcl code. =A0Stores the three commands th= > at implement > > =A0 =A0 =A0 =A0 =A0 * the Tcl code for the callback. > > =A0 =A0 =A0 =A0 =A0 * @param startScript Start prodedure. This command ge= > ts one argument, > > =A0 =A0 =A0 =A0 =A0 * =A0 =A0 =A0 the message string for the work in prog= > ress startup. > > =A0 =A0 =A0 =A0 =A0 * @param updateScript Update prodedure. This command = > gets two > > =A0 =A0 =A0 =A0 =A0 * =A0 =A0 =A0 arguments, the percent done (as an inte= > ger between 0 and > > =A0 =A0 =A0 =A0 =A0 * =A0 =A0 =A0 100), and an update message string. > > =A0 =A0 =A0 =A0 =A0 * @param doneScript Done procedure. =A0This command g= > ets one argument, > > =A0 =A0 =A0 =A0 =A0 * =A0 =A0 =A0 the done message string. > > =A0 =A0 =A0 =A0 =A0 */ > > =A0 =A0 =A0 =A0 Tcl8WorkInProgressCallback(Tcl_Interp *interp_,const char= > *start_, > > =A0 =A0 =A0 =A0 =A0 =A0 =A0 =A0 const char *update_,const char *done_) { > > =A0 =A0 =A0 =A0 =A0 =A0 =A0 =A0 interp =3D interp_; > > =A0 =A0 =A0 =A0 =A0 =A0 =A0 =A0 start =A0=3D start_; > > =A0 =A0 =A0 =A0 =A0 =A0 =A0 =A0 update =3D update_; > > =A0 =A0 =A0 =A0 =A0 =A0 =A0 =A0 done =A0 =3D done_; > > =A0 =A0 =A0 =A0 } > > =A0 =A0 =A0 =A0 /*+ =A0Destructor. > > =A0 =A0 =A0 =A0 =A0 */ > > =A0 =A0 =A0 =A0 virtual ~Tcl8WorkInProgressCallback() {} > > =A0 =A0 =A0 =A0 /*+ =A0Startup member function. > > =A0 =A0 =A0 =A0 =A0 * @param Message Startup message. > > =A0 =A0 =A0 =A0 =A0 */ > > =A0 =A0 =A0 =A0 virtual void ProgressStart(const string Message) const; > > =A0 =A0 =A0 =A0 /*+ =A0Update member function. > > =A0 =A0 =A0 =A0 =A0 * @param Percent Percent done, 0 to 100. > > =A0 =A0 =A0 =A0 =A0 * @param Message Update message. > > =A0 =A0 =A0 =A0 =A0 */ > > =A0 =A0 =A0 =A0 virtual void ProgressUpdate(int Percent,const string Mess= > age) const; > > =A0 =A0 =A0 =A0 /*+ =A0Done member function. > > =A0 =A0 =A0 =A0 =A0 * @param Message Completion message. > > =A0 =A0 =A0 =A0 =A0 */ > > =A0 =A0 =A0 =A0 virtual void ProgressDone(const string Message) const; > > private: > > =A0 =A0 =A0 =A0 /*+ =A0Interpreter to use for Tcl callbacks. > > =A0 =A0 =A0 =A0 =A0 */ > > =A0 =A0 =A0 =A0 Tcl_Interp *interp; > > =A0 =A0 =A0 =A0 /*+ =A0Start procedure or command. > > =A0 =A0 =A0 =A0 =A0 */ > > =A0 =A0 =A0 =A0 string start; > > =A0 =A0 =A0 =A0 /*+ =A0Update procedure or command. > > =A0 =A0 =A0 =A0 =A0 */ > > =A0 =A0 =A0 =A0 string update; > > =A0 =A0 =A0 =A0 /*+ =A0Done procedure or command. > > =A0 =A0 =A0 =A0 =A0 */ > > =A0 =A0 =A0 =A0 string done; =A0 =A0 > > > > }; > > > > void Tcl8WorkInProgressCallback::ProgressStart(const string Message) cons= > t { > > #ifdef DEBUG > > =A0 =A0 =A0 =A0 cerr << "*** Tcl8WorkInProgressCallback::ProgressStart(" = > << Message << ")" << endl; > > #endif > > =A0 =A0 =A0 =A0 Tcl_Obj *striptObj =3D Tcl_NewListObj(0,NULL); > > =A0 =A0 =A0 =A0 if (Tcl_ListObjAppendElement(interp,striptObj,Tcl_NewStri= > ngObj((char *)start.c_str(),-1)) !=3D TCL_OK) { > > =A0 =A0 =A0 =A0 =A0 =A0 =A0 =A0 Tcl_BackgroundError(interp); > > =A0 =A0 =A0 =A0 } > > =A0 =A0 =A0 =A0 if (Tcl_ListObjAppendElement(interp,striptObj,Tcl_NewStri= > ngObj((char *)Message.c_str(),-1)) !=3D TCL_OK) { > > =A0 =A0 =A0 =A0 =A0 =A0 =A0 =A0 Tcl_BackgroundError(interp); > > =A0 =A0 =A0 =A0 } > > #ifdef DEBUG > > =A0 =A0 =A0 =A0 cerr << "*** Tcl8WorkInProgressCallback::ProgressStart: s= > triptObj is " << Tcl_GetStringFromObj(striptObj,NULL) << endl; > > #endif > > =A0 =A0 =A0 =A0 int result =3D Tcl_EvalObjEx(interp,striptObj,TCL_EVAL_GL= > OBAL); > > #ifdef DEBUG > > =A0 =A0 =A0 =A0 cerr << "*** Tcl8WorkInProgressCallback::ProgressStart: r= > esult =3D " << result << endl; > > #endif > > =A0 =A0 =A0 =A0 if (result !=3D TCL_OK) Tcl_BackgroundError(interp); > > > > } > > > > void Tcl8WorkInProgressCallback::ProgressUpdate(int Percent,const string = > Message) const { > > #ifdef DEBUG > > =A0 =A0 =A0 =A0 cerr << "*** Tcl8WorkInProgressCallback::ProgressUpdate("= > << Percent << "," << Message << ")" << endl; > > #endif > > =A0 =A0 =A0 =A0 Tcl_Obj *striptObj =3D Tcl_NewListObj(0,NULL); > > =A0 =A0 =A0 =A0 if (Tcl_ListObjAppendElement(interp,striptObj,Tcl_NewStri= > ngObj((char *)update.c_str(),-1)) !=3D TCL_OK) { > > =A0 =A0 =A0 =A0 =A0 =A0 =A0 =A0 Tcl_BackgroundError(interp); > > =A0 =A0 =A0 =A0 } > > =A0 =A0 =A0 =A0 if (Tcl_ListObjAppendElement(interp,striptObj,Tcl_NewIntO= > bj(Percent)) !=3D TCL_OK) { > > =A0 =A0 =A0 =A0 =A0 =A0 =A0 =A0 Tcl_BackgroundError(interp); > > =A0 =A0 =A0 =A0 } > > =A0 =A0 =A0 =A0 if (Tcl_ListObjAppendElement(interp,striptObj,Tcl_NewStri= > ngObj((char *)Message.c_str(),-1)) !=3D TCL_OK) { > > =A0 =A0 =A0 =A0 =A0 =A0 =A0 =A0 Tcl_BackgroundError(interp); > > =A0 =A0 =A0 =A0 } > > #ifdef DEBUG > > =A0 =A0 =A0 =A0 cerr << "*** Tcl8WorkInProgressCallback::ProgressUpdate: = > striptObj is " << Tcl_GetStringFromObj(striptObj,NULL) << endl; > > #endif > > =A0 =A0 =A0 =A0 int result =3D Tcl_EvalObjEx(interp,striptObj,TCL_EVAL_GL= > OBAL); > > #ifdef DEBUG > > =A0 =A0 =A0 =A0 cerr << "*** Tcl8WorkInProgressCallback::ProgressUpdate: = > result =3D " << result << endl; > > #endif > > =A0 =A0 =A0 =A0 if (result !=3D TCL_OK) Tcl_BackgroundError(interp); > > > > } > > > > void Tcl8WorkInProgressCallback::ProgressDone(const string Message) const= > { > > #ifdef DEBUG > > =A0 =A0 =A0 =A0 cerr << "*** Tcl8WorkInProgressCallback::ProgressDone(" <= > < Message << ")" << endl; > > #endif > > =A0 =A0 =A0 =A0 Tcl_Obj *striptObj =3D Tcl_NewListObj(0,NULL); > > =A0 =A0 =A0 =A0 if (Tcl_ListObjAppendElement(interp,striptObj,Tcl_NewStri= > ngObj((char *)done.c_str(),-1)) !=3D TCL_OK) { > > =A0 =A0 =A0 =A0 =A0 =A0 =A0 =A0 Tcl_BackgroundError(interp); > > =A0 =A0 =A0 =A0 } > > =A0 =A0 =A0 =A0 if (Tcl_ListObjAppendElement(interp,striptObj,Tcl_NewStri= > ngObj((char *)Message.c_str(),-1)) !=3D TCL_OK) { > > =A0 =A0 =A0 =A0 =A0 =A0 =A0 =A0 Tcl_BackgroundError(interp); > > =A0 =A0 =A0 =A0 } > > #ifdef DEBUG > > =A0 =A0 =A0 =A0 cerr << "*** Tcl8WorkInProgressCallback::ProgressDone: st= > riptObj is " << Tcl_GetStringFromObj(striptObj,NULL) << endl; > > #endif > > =A0 =A0 =A0 =A0 int result =3D Tcl_EvalObjEx(interp,striptObj,TCL_EVAL_GL= > OBAL); > > #ifdef DEBUG > > =A0 =A0 =A0 =A0 cerr << "*** Tcl8WorkInProgressCallback::ProgressDone: re= > sult =3D " << result << endl; > > #endif > > =A0 =A0 =A0 =A0 if (result !=3D TCL_OK) Tcl_BackgroundError(interp);} > > } > > > > %} > > > > > > > > > Sam > > > > -- > > Robert Heller =A0 =A0 =A0 =A0 =A0 =A0 -- 978-544-6933 > > Deepwoods Software =A0 =A0 =A0 =A0-- Download the Model Railroad Systemht= > tp://www.deepsoft.com/=A0-- Binaries for Linux and MS-Windows > > hel...(a)deepsoft.com =A0 =A0 =A0 --http://www.deepsoft.com/ModelRailroadSy= > stem/ > > -- 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 9 Aug 2010 07:57
On 5 Aug., 17:21, Robert Heller <hel...(a)deepsoft.com> wrote: > Yes. Basically what I am doing is something like this: > > namespace mycontainer { > variable savedfunction {} > > proc savefunction {f} { > variable savedfunction > set savedfunction $f > } > > proc callback {someargument} { > variable savedfunction > if {[catch [list $savedfunction $someargument] theerror]} { > berror $theerror > } > } > } Well, that should work. May http://wiki.tcl.tk/17195 be helpful as an example ? The lower program does register a callback function and execute it later. The stuff around the notifier must be removed for your application. |