diff options
author | William Joye <wjoye@cfa.harvard.edu> | 2017-10-26 16:45:12 (GMT) |
---|---|---|
committer | William Joye <wjoye@cfa.harvard.edu> | 2017-10-26 16:45:12 (GMT) |
commit | 6054f36bb658916bd231b9002efb94444e2871c8 (patch) | |
tree | a815500ec9bf0e100f4075a825213605c382def0 /tclloop.c | |
download | blt-6054f36bb658916bd231b9002efb94444e2871c8.zip blt-6054f36bb658916bd231b9002efb94444e2871c8.tar.gz blt-6054f36bb658916bd231b9002efb94444e2871c8.tar.bz2 |
Squashed 'xpa/' content from commit d6a54301
git-subtree-dir: xpa
git-subtree-split: d6a543018b46c5a6c47b5ff91e0e131549595ca6
Diffstat (limited to 'tclloop.c')
-rw-r--r-- | tclloop.c | 391 |
1 files changed, 391 insertions, 0 deletions
diff --git a/tclloop.c b/tclloop.c new file mode 100644 index 0000000..a8b4ac5 --- /dev/null +++ b/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 |