Updated 2014-01-29 13:57:17 by oehhar

Tcl_CreateEventSource(Tcl_EventSetupProc , Tcl_EventCheckProc, ClientData)

http://www.tcl.tk/man/tcl8.5/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.
        #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 $h

In this example, the commands analogous to open, fileevent and close are implemented by:
mycmd open
mycmd event ?script?
mycmd close

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. APNs suggestion was included: protect the interpreter used by the saved pointer from deletion by Tcl_Preserve().
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…)