Tcl_CreateEventSource(Tcl_EventSetupProc , Tcl_EventCheckProc, ClientData)
http://www.tcl-lang.tkorg/man/tcl8.56/TclLib/Notifier.htm
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.
======c
#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;
}
======c
Given the above functions we just have to register the new event source when we initialize our package or our interpreter:
======tcl
Tcl_CreateEventSource(SetupProc, CheckProc, NULL);
======tcl
----
[HaO]: Implement a tcl callback function with an event source similar to the fileevent command:
======tcl
set h [open com1 rw]
fileevent $h readable $Cmd
...
close $h
======tcl
In this example, the commands analogous to [open], [fileevent] and [close] are implemented by:
======tcl
mycmd open
mycmd event ?script?
mycmd close
======tcl
The 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.
The following function implements the command.
[APN]s suggestion was included: protect the interpreter used by the saved pointer from deletion by '''Tcl_Preserve()'''.
======c
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;
}
======c
Now the EventProc may call the saved command.
If the command fails, bgerror is called and the event is disabled (analogous to [fileevent]):
======c
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);
}
}
======c
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***
[HaO]2014-01-29: I asked on [https://groups.google.com/forum/#!topic/comp.lang.tcl/eu0_3dpViug%|%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…)
<<categories>> Tcl Library