summaryrefslogtreecommitdiffstats
path: root/xpa/tclloop.c
diff options
context:
space:
mode:
Diffstat (limited to 'xpa/tclloop.c')
-rw-r--r--xpa/tclloop.c391
1 files changed, 391 insertions, 0 deletions
diff --git a/xpa/tclloop.c b/xpa/tclloop.c
new file mode 100644
index 0000000..a8b4ac5
--- /dev/null
+++ b/xpa/tclloop.c
@@ -0,0 +1,391 @@
+/*
+ * Copyright (c) 1999-2003 Smithsonian Astrophysical Observatory
+ */
+
+#include <xpap.h>
+
+#if HAVE_TCL
+
+#include <tcl.h>
+
+/* We build XPA on Windows using Cygwin and, for convenience, we sense the
+ presence of Windows by the presence of Cygwin. This is important for Tcl
+ because Windows does not support Tcl_CreateFileHandler */
+#ifndef HAVE_TCLFILEHANDLER
+#if HAVE_CYGWIN|HAVE_MINGW32
+#define HAVE_TCLFILEHANDLER 0
+#else
+#define HAVE_TCLFILEHANDLER 1
+#endif
+#endif
+
+/*
+ *----------------------------------------------------------------------------
+ *
+ *
+ * Private Routines and Data
+ *
+ *
+ *----------------------------------------------------------------------------
+ */
+
+#define TCL_SOCKET TCL_UNIX_FD
+
+/*
+ *
+ * record struct for maintining Tcl info in Tcl select loop
+ *
+ */
+typedef struct xpatclrec{
+ Tcl_Event header;
+ int fd;
+ void *client_data;
+} *XPATcl, XPATclRec;
+
+
+#if HAVE_TCLFILEHANDLER
+/*
+ *----------------------------------------------------------------------------
+ *
+ * Routine: XPATclHandler
+ *
+ * Purpose: handle one request for an xpaset or xpaget
+ *
+ * Return: none
+ *
+ *----------------------------------------------------------------------------
+ */
+#ifdef ANSI_FUNC
+static void
+XPATclHandler (ClientData client_data, int mask)
+#else
+static void XPATclHandler(client_data, mask)
+ ClientData client_data;
+ int mask;
+#endif
+{
+ XPATcl xptr = (XPATcl)client_data;
+ if( (xptr == NULL) || (xptr->client_data == NULL) )
+ return;
+ XPAHandler((XPA)xptr->client_data, xptr->fd);
+}
+
+#else
+
+#define TCL_BLOCKTIME_SEC 0
+#define TCL_BLOCKTIME_USEC 1000
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * XPAEventProc --
+ *
+ * This procedure is called by Tcl_ServiceEvent when an XPA event
+ * reaches the front of the event queue. This procedure is
+ * responsible for notifying the generic channel code.
+ *
+ * Results:
+ * Returns 1 if the event was handled, meaning it should be removed
+ * from the queue. Returns 0 if the event was not handled, meaning
+ * it should stay on the queue. The only time the event isn't
+ * handled is if the TCL_FILE_EVENTS flag bit isn't set.
+ *
+ * Side effects:
+ * Whatever the channel callback procedures do.
+ *
+ *----------------------------------------------------------------------
+ */
+#ifdef ANSI_FUNC
+static int
+XPAEventProc(Tcl_Event *evPtr, int flags)
+#else
+static int
+XPAEventProc(evPtr, flags)
+ Tcl_Event *evPtr; /* Event to service. */
+ int flags; /* Flags that indicate what events to
+ * handle, such as TCL_FILE_EVENTS. */
+#endif
+{
+ XPATcl xptr = (XPATcl)evPtr;
+ if( xptr && xptr->client_data )
+ XPAHandler((XPA)xptr->client_data, xptr->fd);
+ return 1;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * XPASetupProc --
+ *
+ * This procedure is invoked before Tcl_DoOneEvent blocks waiting
+ * for an event.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Adjusts the block time if needed.
+ *
+ *----------------------------------------------------------------------
+ */
+#ifdef ANSI_FUNC
+static void
+XPASetupProc(ClientData data, int flags)
+#else
+static void
+XPASetupProc(data, flags)
+ ClientData data;
+ int flags;
+#endif
+{
+ Tcl_Time blockTime = { TCL_BLOCKTIME_SEC, TCL_BLOCKTIME_USEC };
+
+ Tcl_SetMaxBlockTime(&blockTime);
+ return;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * XPACheckProc --
+ *
+ * This procedure is called by Tcl_DoOneEvent to check the XPA
+ * event source for events.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * May queue an event.
+ *
+ *----------------------------------------------------------------------
+ */
+#ifdef ANSI_FUNC
+static void
+XPACheckProc(ClientData data, int flags)
+#else
+static void
+XPACheckProc(data, flags)
+ ClientData data;
+ int flags;
+#endif
+{
+ XPATcl xptr = (XPATcl)data;
+ XPATcl evPtr;
+ fd_set readfds;
+ struct timeval tv;
+ int got;
+
+again:
+ FD_ZERO(&readfds);
+ if( XPAActiveFd(xptr->fd) ){
+ FD_SET(xptr->fd, &readfds);
+ tv.tv_sec = 0;
+ tv.tv_usec = 0;
+ got = xselect(xptr->fd+1, &readfds, NULL, NULL, &tv);
+ if( got < 0 ){
+ if( errno == EINTR )
+ goto again;
+ perror("xpa select event");
+ Tcl_DeleteEventSource(XPASetupProc, XPACheckProc, xptr);
+ }
+ else if( got ){
+ evPtr = (XPATcl)Tcl_Alloc(sizeof(XPATclRec));
+ memcpy(evPtr, xptr, sizeof(XPATclRec));
+ evPtr->header.proc = XPAEventProc;
+ Tcl_QueueEvent((Tcl_Event *) evPtr, TCL_QUEUE_TAIL);
+ }
+ }
+}
+#endif
+
+/*
+ *----------------------------------------------------------------------------
+ *
+ * Routine: XPATclEnableOneInput
+ *
+ * Purpose: Enable 1 XPA entry from the Tcl event loop
+ *
+ * Results: none
+ *
+ *----------------------------------------------------------------------------
+ */
+#ifdef ANSI_FUNC
+static void
+XPATclEnableOneInput (void *client_data)
+#else
+static void XPATclEnableOneInput(client_data)
+ void *client_data;
+#endif
+{
+ XPATcl xptr = (XPATcl)client_data;
+ if( xptr == NULL )
+ return;
+#if HAVE_TCLFILEHANDLER
+ Tcl_CreateFileHandler(xptr->fd, TCL_READABLE, XPATclHandler, xptr);
+#else
+ Tcl_CreateEventSource(XPASetupProc, XPACheckProc, xptr);
+#endif
+}
+
+/*
+ *----------------------------------------------------------------------------
+ *
+ * Routine: XPATclDisableOneInput
+ *
+ * Purpose: Disable 1 XPA entry from the Tcl event loop
+ *
+ * Results: none
+ *
+ *----------------------------------------------------------------------------
+ */
+#ifdef ANSI_FUNC
+static void
+XPATclDisableOneInput (void *client_data)
+#else
+static void XPATclDisableOneInput(client_data)
+ void *client_data;
+#endif
+{
+ XPATcl xptr = (XPATcl)client_data;
+ if( xptr == NULL )
+ return;
+#if HAVE_TCLFILEHANDLER
+ Tcl_CreateFileHandler(xptr->fd, 0, XPATclHandler, xptr->client_data);
+#else
+ Tcl_DeleteEventSource(XPASetupProc, XPACheckProc, xptr);
+#endif
+}
+
+/*
+ *----------------------------------------------------------------------------
+ *
+ * Routine: XPATclAddOneInput
+ *
+ * Purpose: Add 1 XPA entry to the Tcl event loop
+ *
+ * Results: none
+ *
+ *----------------------------------------------------------------------------
+ */
+#ifdef ANSI_FUNC
+static void *
+XPATclAddOneInput (void *client_data, int fd)
+#else
+static void *XPATclAddOneInput(client_data, fd)
+ void *client_data;
+ int fd;
+#endif
+{
+ XPATcl xptr;
+ if( fd < 0 )
+ return(NULL);
+ xptr = (XPATcl)xcalloc(1, sizeof(XPATclRec));
+ xptr->fd = fd;
+ xptr->client_data = (XPA)client_data;
+ XPATclEnableOneInput(xptr);
+ return(xptr);
+}
+
+/*
+ *----------------------------------------------------------------------------
+ *
+ * Routine: XPATclDelOneInput
+ *
+ * Purpose: Delete 1 XPA entry from the Tcl event loop (called by XPAFree)
+ *
+ * Results: none
+ *
+ *----------------------------------------------------------------------------
+ */
+#ifdef ANSI_FUNC
+static void
+XPATclDelOneInput (void *client_data)
+#else
+static void XPATclDelOneInput(client_data)
+ void *client_data;
+#endif
+{
+ XPATcl xptr = (XPATcl)client_data;
+ if( xptr == NULL )
+ return;
+ XPATclDisableOneInput(xptr);
+ xfree(xptr);
+}
+
+/*
+ *----------------------------------------------------------------------------
+ *
+ *
+ * Public Routines and Data
+ *
+ *
+ *----------------------------------------------------------------------------
+ */
+
+/*
+ *----------------------------------------------------------------------------
+ *
+ * Routine: XPATclAddInput
+ *
+ * Purpose: Add XPA entries to the Tcl event loop
+ *
+ * Results: number of xpa entried added
+ *
+ *----------------------------------------------------------------------------
+ */
+#ifdef ANSI_FUNC
+int
+XPATclAddInput (XPA xpa)
+#else
+int XPATclAddInput(xpa)
+ XPA xpa;
+#endif
+{
+ XPA cur;
+ int got=0;
+
+ /* if a specific xpa was specified, just add it */
+ if( xpa != NULL ){
+ /* remove old one */
+ if( xpa->seldel && xpa->selptr ){
+ (xpa->seldel)(xpa->selptr);
+ }
+ /* add new one */
+ xpa->seladd = XPATclAddOneInput;
+ xpa->seldel = XPATclDelOneInput;
+#if HAVE_TCLFILEHANDLER
+ xpa->selon = XPATclEnableOneInput;
+ xpa->seloff = XPATclDisableOneInput;
+#endif
+ xpa->selptr = XPATclAddOneInput((void *)xpa, xpa->fd);
+ got = 1;
+ }
+ /* otherwise set up all xpa's */
+ else{
+ for(cur=(XPA)XPAListHead(); cur!=NULL; cur=cur->next){
+ /* remove old one */
+ if( cur->seldel && cur->selptr ){
+ (cur->seldel)(cur->selptr);
+ }
+ /* add new one */
+ cur->seladd = XPATclAddOneInput;
+ cur->seldel = XPATclDelOneInput;
+#if HAVE_TCLFILEHANDLER
+ cur->selon = XPATclEnableOneInput;
+ cur->seloff = XPATclDisableOneInput;
+#endif
+ cur->selptr = XPATclAddOneInput((void *)cur, cur->fd);
+ got++;
+ }
+ }
+ return(got);
+}
+
+int xpa_tcl = 1;
+
+#else
+
+int xpa_tcl = 0;
+
+#endif
generated by cgit v0.12 at 2024-07-18 06:50:05 (GMT)