This function is called to create a new source of events that will be checked by the Tcl event loop. It registers two functions that will be called when Tcl_DoOneEvent is called to process events. The SetupProc is called to check for the maximum amount of time to block if there are no events. CheckProc is called to test for a signaled state. The manual page has a good deal to say about the Tcl notifier in general so here is a sample that gets Tcl to process Glib or Gtk+ events. #include <gtk/gtk.h>
/* When there are Gtk+ events to process we raise a Tcl event */
/* When this event is processed here it flushes the Gtk queue */
static int EventProc(Tcl_Event *evPtr, int flags)
{
if (!(flags & TCL_WINDOW_EVENTS)) {
return 0;
}
while (gtk_events_pending()) {
gtk_main_iteration();
}
return 1;
}
/* If there are gtk events in the queue, set the block time to zero */
/* otherwise make it short - 10ms */
static void SetupProc(ClientData clientData, int flags) {
Tcl_Time block_time = {0, 0};
if (!(flags & TCL_WINDOW_EVENTS)) {
return;
}
if (!gtk_events_pending()) {
block_time.usec = 10000;
}
Tcl_SetMaxBlockTime(&block_time);
return;
}
/* If there are events to process, raise a Tk event to indicate this */
static void CheckProc(ClientData clientData, int flags) {
if (!(flags & TCL_WINDOW_EVENTS)) {
return;
}
if (gtk_events_pending()) {
Tcl_Event *event = (Tcl_Event *)ckalloc(sizeof(Tcl_Event));
event->proc = EventProc;
Tcl_QueueEvent(event, TCL_QUEUE_TAIL);
}
return;
}Given the above functions we just have to register the new event source when we initialize our package or our interpreter:Tcl_CreateEventSource(SetupProc, CheckProc, NULL);
HaO: Implement a tcl callback function with an event source similar to the fileevent command:
set h [open com1 rw] fileevent $h readable $Cmd ... close $hIn this example, the commands analogous to open, fileevent and close are implemented by:
mycmd open mycmd event ?script? mycmd closeThe properties are similar to fileevent:
- When no script given, the current is returned.
- When script is the empty string, the event is removed.
- When script is given, the event is installed.
- On close, the event is removed.
Tcl_Obj * fg_p_command_obj == NULL;
Tcl_Interp * fg_p_command_interp;
int myCmd(ClientData unused, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]) {
int Index;
char *subCmds[] = { "open", "close", "event", "version", "help", NULL};
enum iCommand { iOpen, iClose, iEvent, iVersion, iHelp,};
if (objc <= 1) {
Tcl_WrongNumArgs(interp, 1, objv, "option");
return TCL_ERROR;
}
if (TCL_ERROR == Tcl_GetIndexFromObj(interp, objv[1], subCmds, "mycmd", 0, &Index) )
return TCL_ERROR;
switch (Index) {
iOpen:
// Insert code to "Open" the "Device" here
break;
iEvent:
if (objc == 2) {
if ( NULL == fg_p_command_obj )
Tcl_ResetResult( interp );
else
Tcl_SetObjResult( interp, fg_p_command_obj );
} else {
int CmdLength;
// Remove eventual old registration
if ( fg_p_command_obj != NULL )
RemoveEvent();
// Check passed argument for empty string
Tcl_GetStringFromObj( objv[2], & CmdLength);
if ( CmdLength != 0 ) {
// Save command and interpreter pointer
fg_p_command_obj = objv[2];
Tcl_IncrRefCount( fg_p_command_obj );
Tcl_Preserve((ClientData)interp);
fg_p_command_interp = interp;
// Activate new event
Tcl_CreateEventSource( SetupProc, CheckProc, NULL);
}
}
break;
iClose:
// Insert code to "close" the "device" here
RemoveEvent();
// ??? I am not sure, if the event queue must be cleared to prohibit the execution of any pending
// ??? event from here on
break;
}
return TCL_OK;
}Now the EventProc may call the saved command. If the command fails, bgerror is called and the event is disabled (analogous to fileevent):int EventProc(Tcl_Event *evPtr, int flags) {
// Check if it is my event type
if (!(flags & TCL_FILE_EVENTS))
return 0;
// Check for deleted interpreter
if ( Tcl_InterpDeleted(fg_p_command_interp) ) {
// Interpreter marked for deletion -> remove event and release interpreter pointer
RemoveEvent();
return 1;
}
// Evaluate registered command
if ( TCL_ERROR == Tcl_EvalObjEx(fg_p_command_interp, fg_p_command_obj, TCL_EVAL_DIRECT|TCL_EVAL_GLOBAL) ) {
// Command failed -> call bgerror
Tcl_EvalEx(fg_p_command_interp, "bgerror {myCmd event callback failed}", -1,
TCL_EVAL_DIRECT|TCL_EVAL_GLOBAL);
// Unregister event
RemoveEvent();
}
// Return as processed
return 1;
}
void RemoveEvent() {
if ( fg_p_command_obj != NULL ) {
// > Remove event
Tcl_DeleteEventSource( SetupProc, CheckProc, NULL);
// > Remove old command
Tcl_DecrRefCount( fg_p_command_obj );
fg_p_command_obj = NULL;
Tcl_Release((ClientData)fg_p_command_interp);
}
}The event setup and event check procedures are not shown here. They depend on the event source. The gtk implementation at the top of this page may be used as an example.Andrew Mangogna pointed out, that the implementation of a channel driver is another possibility. See http://tcl-cm3.cvs.sourceforge.net/tcl-cm3/ftd2chan/generic/ for an example.APN If you are stashing the interp away in a data structure or global for later use, I believe it would also be advisable to use Tcl_Preserve/Tcl_Release/Tcl_InterpDeleted as described in the Tcl_CreateInterp documentation.Callback and NRE
HaO2014-01-29: I asked on clt if it is senseful to NRE enable the callback function 'EventProc' above. The answer by Donal Fellows was:An event handling layer is better off not fussing around with NRE. Tcl's built-in one most certainly does not! If you look at the function TclChannelEventScriptInvoker() in generic/tclIO.c, which is what is called to process a fileevent-triggered callback, you'll see that it has nothing to do with the NRE-style functions; it's classic code that calls Tcl_EvalObjEx().The only NRE-enabled IO-related command is source, and that isn't done because it is IO but rather because it evaluates a script (and yielding inside that script is reasonable; it allows having things like templates for web servers that yield…)
