int
TkWinSend_QueueCommand(
Tcl_Interp *interp,
Tcl_Obj *cmdPtr)
{
SendEvent *evPtr;
TRACE("SendQueueCommand()\n");
evPtr = ckalloc(sizeof(SendEvent));
evPtr->header.proc = SendEventProc;
evPtr->header.nextPtr = NULL;
evPtr->interp = interp;
Tcl_Preserve(evPtr->interp);
if (Tcl_IsShared(cmdPtr)) {
evPtr->cmdPtr = Tcl_DuplicateObj(cmdPtr);
} else {
evPtr->cmdPtr = cmdPtr;
Tcl_IncrRefCount(evPtr->cmdPtr);
}
Tcl_QueueEvent((Tcl_Event *)evPtr, TCL_QUEUE_TAIL);
return 0;
}
void
PgNotifyTransferEvents(Pg_ConnectionId * connid)
{
PGnotify *notify;
while ((notify = PQnotifies(connid->conn)) != NULL)
{
NotifyEvent *event = (NotifyEvent *) ckalloc(sizeof(NotifyEvent));
event->header.proc = Pg_Notify_EventProc;
event->notify = notify;
event->connid = connid;
Tcl_QueueEvent((Tcl_Event *) event, TCL_QUEUE_TAIL);
}
/*
* This is also a good place to check for unexpected closure of the
* connection (ie, backend crash), in which case we must shut down the
* notify event source to keep Tcl from trying to select() on the now-
* closed socket descriptor. But don't kill on-connection-loss
* events; in fact, register one.
*/
if (PQsocket(connid->conn) < 0)
PgConnLossTransferEvents(connid);
}
static OSErr
QuitHandler(
const AppleEvent *event,
AppleEvent *reply,
long handlerRefcon)
{
Tcl_Interp *interp = (Tcl_Interp *) handlerRefcon;
KillEvent *eventPtr;
if (interp) {
/*
* Call the exit command from the event loop, since you are not
* supposed to call ExitToShell in an Apple Event Handler. We put this
* at the head of Tcl's event queue because this message usually comes
* when the Mac is shutting down, and we want to kill the shell as
* quickly as possible.
*/
eventPtr = (KillEvent *) ckalloc(sizeof(KillEvent));
eventPtr->header.proc = ReallyKillMe;
eventPtr->interp = interp;
Tcl_QueueEvent((Tcl_Event *) eventPtr, TCL_QUEUE_HEAD);
}
return noErr;
}
static gboolean tcl_file_callback(GIOChannel *source, GIOCondition condition, gpointer data)
{
struct tcl_file_handler *tfh = data;
struct tcl_file_event *fev;
int mask = 0;
if (condition & G_IO_IN)
mask |= TCL_READABLE;
if (condition & G_IO_OUT)
mask |= TCL_WRITABLE;
if (condition & (G_IO_ERR|G_IO_HUP|G_IO_NVAL))
mask |= TCL_EXCEPTION;
if (!(tfh->mask & (mask & ~tfh->pending)))
return TRUE;
tfh->pending |= mask;
fev = (struct tcl_file_event *)ckalloc(sizeof(struct tcl_file_event));
memset(fev, 0, sizeof(struct tcl_file_event));
fev->header.proc = tcl_file_event_callback;
fev->fd = tfh->fd;
Tcl_QueueEvent((Tcl_Event *)fev, TCL_QUEUE_TAIL);
Tcl_ServiceAll();
return TRUE;
}
static void
ConsoleCheckProc(
ClientData data, /* Not used. */
int flags) /* Event flags as passed to Tcl_DoOneEvent. */
{
ConsoleInfo *infoPtr;
int needEvent;
ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
if (!(flags & TCL_FILE_EVENTS)) {
return;
}
/*
* Queue events for any ready consoles that don't already have events
* queued.
*/
for (infoPtr = tsdPtr->firstConsolePtr; infoPtr != NULL;
infoPtr = infoPtr->nextPtr) {
if (infoPtr->flags & CONSOLE_PENDING) {
continue;
}
/*
* Queue an event if the console is signaled for reading or writing.
*/
needEvent = 0;
if (infoPtr->watchMask & TCL_WRITABLE) {
if (WaitForSingleObject(infoPtr->writer.readyEvent,
0) != WAIT_TIMEOUT) {
needEvent = 1;
}
}
if (infoPtr->watchMask & TCL_READABLE) {
if (WaitForRead(infoPtr, 0) >= 0) {
needEvent = 1;
}
}
if (needEvent) {
ConsoleEvent *evPtr = ckalloc(sizeof(ConsoleEvent));
infoPtr->flags |= CONSOLE_PENDING;
evPtr->header.proc = ConsoleEventProc;
evPtr->infoPtr = infoPtr;
Tcl_QueueEvent((Tcl_Event *) evPtr, TCL_QUEUE_TAIL);
}
}
}
static void
FileProc(
ClientData clientData,
int *fd,
XtInputId *id)
{
FileHandler *filePtr = (FileHandler *)clientData;
FileHandlerEvent *fileEvPtr;
int mask = 0;
/*
* Determine which event happened.
*/
if (*id == filePtr->read) {
mask = TCL_READABLE;
} else if (*id == filePtr->write) {
mask = TCL_WRITABLE;
} else if (*id == filePtr->except) {
mask = TCL_EXCEPTION;
}
/*
* Ignore unwanted or duplicate events.
*/
if (!(filePtr->mask & mask) || (filePtr->readyMask & mask)) {
return;
}
/*
* This is an interesting event, so put it onto the event queue.
*/
filePtr->readyMask |= mask;
fileEvPtr = ckalloc(sizeof(FileHandlerEvent));
fileEvPtr->header.proc = FileHandlerEventProc;
fileEvPtr->fd = filePtr->fd;
Tcl_QueueEvent((Tcl_Event *) fileEvPtr, TCL_QUEUE_TAIL);
/*
* Process events on the Tcl event queue before returning to Xt.
*/
Tcl_ServiceAll();
}
static void
QueueGrabWindowChange(
TkDisplay *dispPtr, /* Display on which to change the grab
* window. */
TkWindow *grabWinPtr) /* Window that is to become the new grab
* window (may be NULL). */
{
NewGrabWinEvent *grabEvPtr;
grabEvPtr = (NewGrabWinEvent *) ckalloc(sizeof(NewGrabWinEvent));
grabEvPtr->header.proc = GrabWinEventProc;
grabEvPtr->dispPtr = dispPtr;
if (grabWinPtr == NULL) {
grabEvPtr->grabWindow = None;
} else {
grabEvPtr->grabWindow = grabWinPtr->window;
}
Tcl_QueueEvent(&grabEvPtr->header, TCL_QUEUE_MARK);
dispPtr->eventualGrabWinPtr = grabWinPtr;
}
static void
TimerCheckProc(
ClientData data, /* Not used. */
int flags) /* Event flags as passed to Tcl_DoOneEvent. */
{
Tcl_Event *timerEvPtr;
Tcl_Time blockTime;
ThreadSpecificData *tsdPtr = InitTimer();
if ((flags & TCL_TIMER_EVENTS) && tsdPtr->firstTimerHandlerPtr) {
/*
* Compute the timeout for the next timer on the list.
*/
Tcl_GetTime(&blockTime);
blockTime.sec = tsdPtr->firstTimerHandlerPtr->time.sec - blockTime.sec;
blockTime.usec = tsdPtr->firstTimerHandlerPtr->time.usec -
blockTime.usec;
if (blockTime.usec < 0) {
blockTime.sec -= 1;
blockTime.usec += 1000000;
}
if (blockTime.sec < 0) {
blockTime.sec = 0;
blockTime.usec = 0;
}
/*
* If the first timer has expired, stick an event on the queue.
*/
if (blockTime.sec == 0 && blockTime.usec == 0 &&
!tsdPtr->timerPending) {
tsdPtr->timerPending = 1;
timerEvPtr = ckalloc(sizeof(Tcl_Event));
timerEvPtr->proc = TimerHandlerEventProc;
Tcl_QueueEvent(timerEvPtr, TCL_QUEUE_TAIL);
}
}
}
/*
* Handle a connection-loss event
*/
void
PgConnLossTransferEvents(Pg_ConnectionId * connid)
{
if (connid->notifier_running)
{
/* Put the on-connection-loss event in the Tcl queue */
NotifyEvent *event = (NotifyEvent *) ckalloc(sizeof(NotifyEvent));
event->header.proc = Pg_Notify_EventProc;
event->notify = NULL;
event->connid = connid;
Tcl_QueueEvent((Tcl_Event *) event, TCL_QUEUE_TAIL);
}
/*
* Shut down the notify event source to keep Tcl from trying to
* select() on the now-closed socket descriptor. And zap any
* unprocessed notify events ... but not, of course, the
* connection-loss event.
*/
PgStopNotifyEventSource(connid, false);
}
void DBus_CallResult(DBusPendingCall *pending, void *data)
{
DBusMessage *msg;
Tcl_CallData *dataPtr = data;
Tcl_DBusEvent *evPtr;
msg = dbus_pending_call_steal_reply(pending);
/* free the pending message handle */
dbus_pending_call_unref(pending);
/* Allocate a DBus event structure and copy in some basic data */
evPtr = (Tcl_DBusEvent *) ckalloc(sizeof(Tcl_DBusEvent));
evPtr->interp = dataPtr->interp;
evPtr->script = dataPtr->script;
evPtr->conn = dataPtr->conn;
/* Fill in the rest of the DBus event structure */
evPtr->event.proc = DBus_EventHandler;
evPtr->msg = msg;
/* Don't send a reply on the reply */
evPtr->flags = dataPtr->flags | DBUSFLAG_NOREPLY;
Tcl_QueueEvent((Tcl_Event *) evPtr, TCL_QUEUE_TAIL);
/* Free the DBus handler data structure */
ckfree(data);
}
DBusHandlerResult DBus_Monitor(DBusConnection *conn,
DBusMessage *msg, void *data)
{
Tcl_DBusEvent *evPtr;
Tcl_DBusMonitorData* dataPtr = data;
if (dataPtr->script != NULL) {
evPtr = (Tcl_DBusEvent *) ckalloc(sizeof(Tcl_DBusEvent));
/* Storage at *evPtr will be freed by Tcl_ServiceEvent */
evPtr->event.proc = DBus_EventHandler;
evPtr->interp = dataPtr->interp;
evPtr->script = dataPtr->script;
Tcl_IncrRefCount(evPtr->script);
evPtr->conn = conn;
evPtr->msg = msg;
/* Never report the result of a snoop handler */
evPtr->flags = dataPtr->flags | DBUSFLAG_NOREPLY;
dbus_message_ref(msg);
Tcl_QueueEvent((Tcl_Event *) evPtr, TCL_QUEUE_TAIL);
}
/* Allow messages to proceed to invoke methods and signal events */
return DBUS_HANDLER_RESULT_NOT_YET_HANDLED;
}
int
Tcl_WaitForEvent(
Tcl_Time *timePtr) /* Maximum block time, or NULL. */
{
FileHandler *filePtr;
FileHandlerEvent *fileEvPtr;
int mask;
int waitForFiles;
ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
if (tclStubs.tcl_WaitForEvent != tclOriginalNotifier.waitForEventProc) {
return tclStubs.tcl_WaitForEvent(timePtr);
}
/*
* Start notifier thread if necessary.
*/
LOCK_NOTIFIER_INIT;
if (!notifierCount) {
Tcl_Panic("Tcl_WaitForEvent: notifier not initialized");
}
if (!notifierThread) {
int result;
pthread_attr_t attr;
pthread_attr_init(&attr);
pthread_attr_setscope(&attr, PTHREAD_SCOPE_SYSTEM);
pthread_attr_setdetachstate(&attr, PTHREAD_CREATE_JOINABLE);
pthread_attr_setstacksize(&attr, 60 * 1024);
result = pthread_create(¬ifierThread, &attr,
(void * (*)(void *))NotifierThreadProc, NULL);
pthread_attr_destroy(&attr);
if (result || !notifierThread) {
Tcl_Panic("Tcl_WaitForEvent: unable to start notifier thread");
}
}
UNLOCK_NOTIFIER_INIT;
/*
* Place this thread on the list of interested threads, signal the
* notifier thread, and wait for a response or a timeout.
*/
LOCK_NOTIFIER;
if (!tsdPtr->runLoop) {
Tcl_Panic("Tcl_WaitForEvent: CFRunLoop not initialized");
}
waitForFiles = (tsdPtr->numFdBits > 0);
if (timePtr != NULL && timePtr->sec == 0 && timePtr->usec == 0) {
/*
* Cannot emulate a polling select with a polling condition variable.
* Instead, pretend to wait for files and tell the notifier thread
* what we are doing. The notifier thread makes sure it goes through
* select with its select mask in the same state as ours currently is.
* We block until that happens.
*/
waitForFiles = 1;
tsdPtr->pollState = POLL_WANT;
timePtr = NULL;
} else {
tsdPtr->pollState = 0;
}
if (waitForFiles) {
/*
* Add the ThreadSpecificData structure of this thread to the list of
* ThreadSpecificData structures of all threads that are waiting on
* file events.
*/
tsdPtr->nextPtr = waitingListPtr;
if (waitingListPtr) {
waitingListPtr->prevPtr = tsdPtr;
}
tsdPtr->prevPtr = 0;
waitingListPtr = tsdPtr;
tsdPtr->onList = 1;
write(triggerPipe, "", 1);
}
FD_ZERO(&(tsdPtr->readyMasks.readable));
FD_ZERO(&(tsdPtr->readyMasks.writable));
FD_ZERO(&(tsdPtr->readyMasks.exceptional));
if (!tsdPtr->eventReady) {
CFTimeInterval waitTime;
CFStringRef runLoopMode;
if (timePtr == NULL) {
waitTime = 1.0e10; /* Wait forever, as per CFRunLoop.c */
} else {
waitTime = timePtr->sec + 1.0e-6 * timePtr->usec;
}
/*
* If the run loop is already running (e.g. if Tcl_WaitForEvent was
* called recursively), re-run it in a custom run loop mode containing
* only the source for the notifier thread, otherwise wakeups from other
* sources added to the common run loop modes might get lost.
*/
if ((runLoopMode = CFRunLoopCopyCurrentMode(tsdPtr->runLoop))) {
CFRelease(runLoopMode);
runLoopMode = tclEventsOnlyRunLoopMode;
} else {
runLoopMode = kCFRunLoopDefaultMode;
}
UNLOCK_NOTIFIER;
CFRunLoopRunInMode(runLoopMode, waitTime, TRUE);
LOCK_NOTIFIER;
}
tsdPtr->eventReady = 0;
if (waitForFiles && tsdPtr->onList) {
/*
* Remove the ThreadSpecificData structure of this thread from the
* waiting list. Alert the notifier thread to recompute its select
* masks - skipping this caused a hang when trying to close a pipe
* which the notifier thread was still doing a select on.
*/
if (tsdPtr->prevPtr) {
tsdPtr->prevPtr->nextPtr = tsdPtr->nextPtr;
} else {
waitingListPtr = tsdPtr->nextPtr;
}
if (tsdPtr->nextPtr) {
tsdPtr->nextPtr->prevPtr = tsdPtr->prevPtr;
}
tsdPtr->nextPtr = tsdPtr->prevPtr = NULL;
tsdPtr->onList = 0;
write(triggerPipe, "", 1);
}
/*
* Queue all detected file events before returning.
*/
for (filePtr = tsdPtr->firstFileHandlerPtr; (filePtr != NULL);
filePtr = filePtr->nextPtr) {
mask = 0;
if (FD_ISSET(filePtr->fd, &(tsdPtr->readyMasks.readable))) {
mask |= TCL_READABLE;
}
if (FD_ISSET(filePtr->fd, &(tsdPtr->readyMasks.writable))) {
mask |= TCL_WRITABLE;
}
if (FD_ISSET(filePtr->fd, &(tsdPtr->readyMasks.exceptional))) {
mask |= TCL_EXCEPTION;
}
if (!mask) {
continue;
}
/*
* Don't bother to queue an event if the mask was previously non-zero
* since an event must still be on the queue.
*/
if (filePtr->readyMask == 0) {
fileEvPtr = (FileHandlerEvent *) ckalloc(sizeof(FileHandlerEvent));
fileEvPtr->header.proc = FileHandlerEventProc;
fileEvPtr->fd = filePtr->fd;
Tcl_QueueEvent((Tcl_Event *) fileEvPtr, TCL_QUEUE_TAIL);
}
filePtr->readyMask = mask;
}
UNLOCK_NOTIFIER;
return 0;
}
DBusHandlerResult DBus_Message(DBusConnection *conn,
DBusMessage *msg, void *data)
{
Tcl_HashTable *members;
Tcl_HashEntry *memberPtr;
Tcl_HashSearch search;
Tcl_DBusEvent *evPtr;
Tcl_DBusMethodData *mPtr = NULL;
Tcl_DBusSignalData *sPtr;
DBusMessage *err;
int i, len;
char buffer[DBUS_MAXIMUM_NAME_LENGTH + 1], *errbuf;
const char *path, *name, *intf, *str[2];
Tcl_DBusHandlerData* dataPtr = data;
path = dbus_message_get_path(msg);
intf = dbus_message_get_interface(msg);
name = dbus_message_get_member(msg);
if (intf != NULL) {
intf = strncpy(buffer, intf, DBUS_MAXIMUM_NAME_LENGTH);
buffer[DBUS_MAXIMUM_NAME_LENGTH] = '\0';
len = strlen(intf);
buffer[len++] = '.';
name = strncpy(buffer + len, name, DBUS_MAXIMUM_NAME_LENGTH - len);
}
switch (dbus_message_get_type(msg)) {
case DBUS_MESSAGE_TYPE_METHOD_CALL:
if (intf != NULL) {
mPtr = DBus_FindListeners(dataPtr->dbus, path, intf, TRUE);
if (mPtr == NULL) {
/* Check if a method was defined without a path */
mPtr = DBus_FindListeners(dataPtr->dbus, "", intf, TRUE);
}
}
if (intf == NULL || mPtr == NULL) {
/* TODO: Method calls are not required to specify an interface */
/* So should really also check for *.name if intf == NULL */
/* Check if a method was defined without an interface */
mPtr = DBus_FindListeners(dataPtr->dbus, path, name, TRUE);
if (mPtr == NULL) {
/* Check if a method was defined with no path and no interface */
mPtr = DBus_FindListeners(dataPtr->dbus, "", name, TRUE);
}
}
if (mPtr == NULL) {
/* Check if an unknown handler was defined for the path */
mPtr = DBus_FindListeners(dataPtr->dbus, path, "", TRUE);
if (mPtr == NULL) {
/* Check if a global unknown handler was defined */
mPtr = DBus_FindListeners(dataPtr->dbus, "", "", TRUE);
}
}
if (mPtr == NULL) {
/* There is no script-level handler for this method call */
if (dbus_message_get_no_reply(msg))
/* The caller is not interested in succes or failure */
break;
/* Allocate space and construct the error message */
/* Each of name, interface, and signature can only be 255 chars */
/* long, but path is unlimited. So base the amount of space */
/* to request on the length of the path string */
if ((errbuf = attemptckalloc(strlen(path) + 1024)) != NULL) {
sprintf(errbuf, "No such method '%s' in interface '%s' "
"at object path '%s' (signature '%s')",
name, dbus_message_get_interface(msg),
path, dbus_message_get_signature(msg));
}
/* Send the error back to the caller */
err = dbus_message_new_error(msg, DBUS_ERROR_UNKNOWN_METHOD, errbuf);
if (dbus_connection_send(conn, err, NULL)) {
dbus_connection_flush(conn);
}
/* Free up the used resources */
dbus_message_unref(err);
if (errbuf != NULL) ckfree(errbuf);
break;
}
evPtr = (Tcl_DBusEvent *) ckalloc(sizeof(Tcl_DBusEvent));
evPtr->event.proc = DBus_EventHandler;
evPtr->interp = mPtr->interp;
evPtr->script = mPtr->script;
Tcl_IncrRefCount(evPtr->script);
evPtr->conn = mPtr->conn;
evPtr->msg = msg;
evPtr->flags = mPtr->flags;
dbus_message_ref(msg);
if (dbus_message_get_no_reply(msg))
/* Don't report the result of the event handler */
evPtr->flags |= DBUSFLAG_NOREPLY;
Tcl_QueueEvent((Tcl_Event *) evPtr, TCL_QUEUE_TAIL);
break;
case DBUS_MESSAGE_TYPE_METHOD_RETURN:
break;
case DBUS_MESSAGE_TYPE_ERROR:
break;
case DBUS_MESSAGE_TYPE_SIGNAL:
str[0] = intf; str[1] = name;
for (i = 0; i < 2; i++) {
if (str[i] == NULL) continue;
members = DBus_FindListeners(dataPtr->dbus, path, str[i], FALSE);
if (members == NULL) {
members = DBus_FindListeners(dataPtr->dbus, "", str[i], FALSE);
if (members == NULL) continue;
}
/* Queue execution of listeners for this signal in all interpreters */
for (memberPtr = Tcl_FirstHashEntry(members, &search);
memberPtr != NULL; memberPtr = Tcl_NextHashEntry(&search)) {
evPtr = (Tcl_DBusEvent *) ckalloc(sizeof(Tcl_DBusEvent));
sPtr = (Tcl_DBusSignalData *) Tcl_GetHashValue(memberPtr);
evPtr->event.proc = DBus_EventHandler;
evPtr->interp = (Tcl_Interp *) Tcl_GetHashKey(members, memberPtr);
evPtr->script = sPtr->script;
Tcl_IncrRefCount(evPtr->script);
evPtr->conn = conn;
evPtr->msg = msg;
/* Never report the result of a signal handler */
evPtr->flags = sPtr->flags | DBUSFLAG_NOREPLY;
dbus_message_ref(msg);
Tcl_QueueEvent((Tcl_Event *) evPtr, TCL_QUEUE_TAIL);
}
}
break;
}
return DBUS_HANDLER_RESULT_HANDLED;
}