OpenCores
URL https://opencores.org/ocsvn/or1k/or1k/trunk

Subversion Repositories or1k

[/] [or1k/] [trunk/] [insight/] [tcl/] [unix/] [tclXtNotify.c] - Blame information for rev 1765

Details | Compare with Previous | View Log

Line No. Rev Author Line
1 578 markom
/*
2
 * tclXtNotify.c --
3
 *
4
 *      This file contains the notifier driver implementation for the
5
 *      Xt intrinsics.
6
 *
7
 * Copyright (c) 1997 by Sun Microsystems, Inc.
8
 *
9
 * See the file "license.terms" for information on usage and redistribution
10
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
11
 *
12
 * RCS: @(#) $Id: tclXtNotify.c,v 1.1.1.1 2002-01-16 10:25:37 markom Exp $
13
 */
14
 
15
#include <X11/Intrinsic.h>
16
#include <tclInt.h>
17
 
18
/*
19
 * This structure is used to keep track of the notifier info for a
20
 * a registered file.
21
 */
22
 
23
typedef struct FileHandler {
24
    int fd;
25
    int mask;                   /* Mask of desired events: TCL_READABLE, etc. */
26
    int readyMask;              /* Events that have been seen since the
27
                                   last time FileHandlerEventProc was called
28
                                   for this file. */
29
    XtInputId read;             /* Xt read callback handle. */
30
    XtInputId write;            /* Xt write callback handle. */
31
    XtInputId except;           /* Xt exception callback handle. */
32
    Tcl_FileProc *proc;         /* Procedure to call, in the style of
33
                                 * Tcl_CreateFileHandler. */
34
    ClientData clientData;      /* Argument to pass to proc. */
35
    struct FileHandler *nextPtr;/* Next in list of all files we care about. */
36
} FileHandler;
37
 
38
/*
39
 * The following structure is what is added to the Tcl event queue when
40
 * file handlers are ready to fire.
41
 */
42
 
43
typedef struct FileHandlerEvent {
44
    Tcl_Event header;           /* Information that is standard for
45
                                 * all events. */
46
    int fd;                     /* File descriptor that is ready.  Used
47
                                 * to find the FileHandler structure for
48
                                 * the file (can't point directly to the
49
                                 * FileHandler structure because it could
50
                                 * go away while the event is queued). */
51
} FileHandlerEvent;
52
 
53
/*
54
 * The following static structure contains the state information for the
55
 * Xt based implementation of the Tcl notifier.
56
 */
57
 
58
static struct NotifierState {
59
    XtAppContext appContext;            /* The context used by the Xt
60
                                         * notifier. Can be set with
61
                                         * TclSetAppContext. */
62
    int appContextCreated;              /* Was it created by us? */
63
    XtIntervalId currentTimeout;        /* Handle of current timer. */
64
    FileHandler *firstFileHandlerPtr;   /* Pointer to head of file handler
65
                                         * list. */
66
} notifier;
67
 
68
/*
69
 * The following static indicates whether this module has been initialized.
70
 */
71
 
72
static int initialized = 0;
73
 
74
/*
75
 * Static routines defined in this file.
76
 */
77
 
78
static int              FileHandlerEventProc _ANSI_ARGS_((Tcl_Event *evPtr,
79
                            int flags));
80
static void             FileProc _ANSI_ARGS_((caddr_t clientData,
81
                            int *source, XtInputId *id));
82
static void             InitNotifier _ANSI_ARGS_((void));
83
static void             NotifierExitHandler _ANSI_ARGS_((
84
                            ClientData clientData));
85
static void             TimerProc _ANSI_ARGS_((caddr_t clientData,
86
                            XtIntervalId *id));
87
 
88
/*
89
 * Functions defined in this file for use by users of the Xt Notifier:
90
 */
91
 
92
EXTERN XtAppContext     TclSetAppContext _ANSI_ARGS_((XtAppContext ctx));
93
 
94
/*
95
 *----------------------------------------------------------------------
96
 *
97
 * TclSetAppContext --
98
 *
99
 *      Set the notifier application context.
100
 *
101
 * Results:
102
 *      None.
103
 *
104
 * Side effects:
105
 *      Sets the application context used by the notifier. Panics if
106
 *      the context is already set when called.
107
 *
108
 *----------------------------------------------------------------------
109
 */
110
 
111
XtAppContext
112
TclSetAppContext(appContext)
113
    XtAppContext        appContext;
114
{
115
    if (!initialized) {
116
        InitNotifier();
117
    }
118
 
119
    /*
120
     * If we already have a context we check whether we were asked to set a
121
     * new context. If so, we panic because we try to prevent switching
122
     * contexts by mistake. Otherwise, we return the one we have.
123
     */
124
 
125
    if (notifier.appContext != NULL) {
126
        if (appContext != NULL) {
127
 
128
            /*
129
             * We already have a context. We do not allow switching contexts
130
             * after initialization, so we panic.
131
             */
132
 
133
            panic("TclSetAppContext:  multiple application contexts");
134
 
135
        }
136
    } else {
137
 
138
        /*
139
         * If we get here we have not yet gotten a context, so either create
140
         * one or use the one supplied by our caller.
141
         */
142
 
143
        if (appContext == NULL) {
144
 
145
            /*
146
             * We must create a new context and tell our caller what it is, so
147
             * she can use it too.
148
             */
149
 
150
            notifier.appContext = XtCreateApplicationContext();
151
            notifier.appContextCreated = 1;
152
        } else {
153
 
154
            /*
155
             * Otherwise we remember the context that our caller gave us
156
             * and use it.
157
             */
158
 
159
            notifier.appContextCreated = 0;
160
            notifier.appContext = appContext;
161
        }
162
    }
163
 
164
    return notifier.appContext;
165
}
166
 
167
/*
168
 *----------------------------------------------------------------------
169
 *
170
 * InitNotifier --
171
 *
172
 *      Initializes the notifier state.
173
 *
174
 * Results:
175
 *      None.
176
 *
177
 * Side effects:
178
 *      Creates a new exit handler.
179
 *
180
 *----------------------------------------------------------------------
181
 */
182
 
183
static void
184
InitNotifier(void)
185
{
186
    /*
187
     * Only reinitialize if we are not in exit handling. The notifier
188
     * can get reinitialized after its own exit handler has run, because
189
     * of exit handlers for the I/O and timer sub-systems (order dependency).
190
     */
191
 
192
    if (TclInExit()) {
193
        return;
194
    }
195
 
196
    /*
197
     * DO NOT create the application context yet; doing so would prevent
198
     * external applications from setting it for us to their own ones.
199
     */
200
 
201
    initialized = 1;
202
    memset(&notifier, 0, sizeof(notifier));
203
    Tcl_CreateExitHandler(NotifierExitHandler, NULL);
204
}
205
 
206
/*
207
 *----------------------------------------------------------------------
208
 *
209
 * NotifierExitHandler --
210
 *
211
 *      This function is called to cleanup the notifier state before
212
 *      Tcl is unloaded.
213
 *
214
 * Results:
215
 *      None.
216
 *
217
 * Side effects:
218
 *      Destroys the notifier window.
219
 *
220
 *----------------------------------------------------------------------
221
 */
222
 
223
static void
224
NotifierExitHandler(
225
    ClientData clientData)      /* Not used. */
226
{
227
    if (notifier.currentTimeout != 0) {
228
        XtRemoveTimeOut(notifier.currentTimeout);
229
    }
230
    for (; notifier.firstFileHandlerPtr != NULL; ) {
231
        Tcl_DeleteFileHandler(notifier.firstFileHandlerPtr->fd);
232
    }
233
    if (notifier.appContextCreated) {
234
        XtDestroyApplicationContext(notifier.appContext);
235
        notifier.appContextCreated = 0;
236
        notifier.appContext = NULL;
237
    }
238
    initialized = 0;
239
}
240
 
241
/*
242
 *----------------------------------------------------------------------
243
 *
244
 * Tcl_SetTimer --
245
 *
246
 *      This procedure sets the current notifier timeout value.
247
 *
248
 * Results:
249
 *      None.
250
 *
251
 * Side effects:
252
 *      Replaces any previous timer.
253
 *
254
 *----------------------------------------------------------------------
255
 */
256
 
257
void
258
Tcl_SetTimer(timePtr)
259
    Tcl_Time *timePtr;          /* Timeout value, may be NULL. */
260
{
261
    long timeout;
262
 
263
    if (!initialized) {
264
        InitNotifier();
265
    }
266
 
267
    TclSetAppContext(NULL);
268
    if (notifier.currentTimeout != 0) {
269
        XtRemoveTimeOut(notifier.currentTimeout);
270
    }
271
    if (timePtr) {
272
        timeout = timePtr->sec * 1000 + timePtr->usec / 1000;
273
        notifier.currentTimeout =
274
            XtAppAddTimeOut(notifier.appContext, (unsigned long) timeout,
275
                    TimerProc, NULL);
276
    } else {
277
        notifier.currentTimeout = 0;
278
    }
279
}
280
 
281
/*
282
 *----------------------------------------------------------------------
283
 *
284
 * TimerProc --
285
 *
286
 *      This procedure is the XtTimerCallbackProc used to handle
287
 *      timeouts.
288
 *
289
 * Results:
290
 *      None.
291
 *
292
 * Side effects:
293
 *      Processes all queued events.
294
 *
295
 *----------------------------------------------------------------------
296
 */
297
 
298
static void
299
TimerProc(data, id)
300
    caddr_t data;               /* Not used. */
301
    XtIntervalId *id;
302
{
303
    if (*id != notifier.currentTimeout) {
304
        return;
305
    }
306
    notifier.currentTimeout = 0;
307
 
308
    Tcl_ServiceAll();
309
}
310
 
311
/*
312
 *----------------------------------------------------------------------
313
 *
314
 * Tcl_CreateFileHandler --
315
 *
316
 *      This procedure registers a file handler with the Xt notifier.
317
 *
318
 * Results:
319
 *      None.
320
 *
321
 * Side effects:
322
 *      Creates a new file handler structure and registers one or more
323
 *      input procedures with Xt.
324
 *
325
 *----------------------------------------------------------------------
326
 */
327
 
328
void
329
Tcl_CreateFileHandler(fd, mask, proc, clientData)
330
    int fd;                     /* Handle of stream to watch. */
331
    int mask;                   /* OR'ed combination of TCL_READABLE,
332
                                 * TCL_WRITABLE, and TCL_EXCEPTION:
333
                                 * indicates conditions under which
334
                                 * proc should be called. */
335
    Tcl_FileProc *proc;         /* Procedure to call for each
336
                                 * selected event. */
337
    ClientData clientData;      /* Arbitrary data to pass to proc. */
338
{
339
    FileHandler *filePtr;
340
 
341
    if (!initialized) {
342
        InitNotifier();
343
    }
344
 
345
    TclSetAppContext(NULL);
346
 
347
    for (filePtr = notifier.firstFileHandlerPtr; filePtr != NULL;
348
            filePtr = filePtr->nextPtr) {
349
        if (filePtr->fd == fd) {
350
            break;
351
        }
352
    }
353
    if (filePtr == NULL) {
354
        filePtr = (FileHandler*) ckalloc(sizeof(FileHandler));
355
        filePtr->fd = fd;
356
        filePtr->read = 0;
357
        filePtr->write = 0;
358
        filePtr->except = 0;
359
        filePtr->readyMask = 0;
360
        filePtr->mask = 0;
361
        filePtr->nextPtr = notifier.firstFileHandlerPtr;
362
        notifier.firstFileHandlerPtr = filePtr;
363
    }
364
    filePtr->proc = proc;
365
    filePtr->clientData = clientData;
366
 
367
    /*
368
     * Register the file with the Xt notifier, if it hasn't been done yet.
369
     */
370
 
371
    if (mask & TCL_READABLE) {
372
        if (!(filePtr->mask & TCL_READABLE)) {
373
            filePtr->read =
374
                XtAppAddInput(notifier.appContext, fd, XtInputReadMask,
375
                        FileProc, filePtr);
376
        }
377
    } else {
378
        if (filePtr->mask & TCL_READABLE) {
379
            XtRemoveInput(filePtr->read);
380
        }
381
    }
382
    if (mask & TCL_WRITABLE) {
383
        if (!(filePtr->mask & TCL_WRITABLE)) {
384
            filePtr->write =
385
                XtAppAddInput(notifier.appContext, fd, XtInputWriteMask,
386
                        FileProc, filePtr);
387
        }
388
    } else {
389
        if (filePtr->mask & TCL_WRITABLE) {
390
            XtRemoveInput(filePtr->write);
391
        }
392
    }
393
    if (mask & TCL_EXCEPTION) {
394
        if (!(filePtr->mask & TCL_EXCEPTION)) {
395
            filePtr->except =
396
                XtAppAddInput(notifier.appContext, fd, XtInputExceptMask,
397
                        FileProc, filePtr);
398
        }
399
    } else {
400
        if (filePtr->mask & TCL_EXCEPTION) {
401
            XtRemoveInput(filePtr->except);
402
        }
403
    }
404
    filePtr->mask = mask;
405
}
406
 
407
/*
408
 *----------------------------------------------------------------------
409
 *
410
 * Tcl_DeleteFileHandler --
411
 *
412
 *      Cancel a previously-arranged callback arrangement for
413
 *      a file.
414
 *
415
 * Results:
416
 *      None.
417
 *
418
 * Side effects:
419
 *      If a callback was previously registered on file, remove it.
420
 *
421
 *----------------------------------------------------------------------
422
 */
423
 
424
void
425
Tcl_DeleteFileHandler(fd)
426
    int fd;                     /* Stream id for which to remove
427
                                 * callback procedure. */
428
{
429
    FileHandler *filePtr, *prevPtr;
430
 
431
    if (!initialized) {
432
        InitNotifier();
433
    }
434
 
435
    TclSetAppContext(NULL);
436
 
437
    /*
438
     * Find the entry for the given file (and return if there
439
     * isn't one).
440
     */
441
 
442
    for (prevPtr = NULL, filePtr = notifier.firstFileHandlerPtr; ;
443
            prevPtr = filePtr, filePtr = filePtr->nextPtr) {
444
        if (filePtr == NULL) {
445
            return;
446
        }
447
        if (filePtr->fd == fd) {
448
            break;
449
        }
450
    }
451
 
452
    /*
453
     * Clean up information in the callback record.
454
     */
455
 
456
    if (prevPtr == NULL) {
457
        notifier.firstFileHandlerPtr = filePtr->nextPtr;
458
    } else {
459
        prevPtr->nextPtr = filePtr->nextPtr;
460
    }
461
    if (filePtr->mask & TCL_READABLE) {
462
        XtRemoveInput(filePtr->read);
463
    }
464
    if (filePtr->mask & TCL_WRITABLE) {
465
        XtRemoveInput(filePtr->write);
466
    }
467
    if (filePtr->mask & TCL_EXCEPTION) {
468
        XtRemoveInput(filePtr->except);
469
    }
470
    ckfree((char *) filePtr);
471
}
472
 
473
/*
474
 *----------------------------------------------------------------------
475
 *
476
 * FileProc --
477
 *
478
 *      These procedures are called by Xt when a file becomes readable,
479
 *      writable, or has an exception.
480
 *
481
 * Results:
482
 *      None.
483
 *
484
 * Side effects:
485
 *      Makes an entry on the Tcl event queue if the event is
486
 *      interesting.
487
 *
488
 *----------------------------------------------------------------------
489
 */
490
 
491
static void
492
FileProc(clientData, fd, id)
493
    caddr_t clientData;
494
    int *fd;
495
    XtInputId *id;
496
{
497
    FileHandler *filePtr = (FileHandler *)clientData;
498
    FileHandlerEvent *fileEvPtr;
499
    int mask = 0;
500
 
501
    /*
502
     * Determine which event happened.
503
     */
504
 
505
    if (*id == filePtr->read) {
506
        mask = TCL_READABLE;
507
    } else if (*id == filePtr->write) {
508
        mask = TCL_WRITABLE;
509
    } else if (*id == filePtr->except) {
510
        mask = TCL_EXCEPTION;
511
    }
512
 
513
    /*
514
     * Ignore unwanted or duplicate events.
515
     */
516
 
517
    if (!(filePtr->mask & mask) || (filePtr->readyMask & mask)) {
518
        return;
519
    }
520
 
521
    /*
522
     * This is an interesting event, so put it onto the event queue.
523
     */
524
 
525
    filePtr->readyMask |= mask;
526
    fileEvPtr = (FileHandlerEvent *) ckalloc(sizeof(FileHandlerEvent));
527
    fileEvPtr->header.proc = FileHandlerEventProc;
528
    fileEvPtr->fd = filePtr->fd;
529
    Tcl_QueueEvent((Tcl_Event *) fileEvPtr, TCL_QUEUE_TAIL);
530
 
531
    /*
532
     * Process events on the Tcl event queue before returning to Xt.
533
     */
534
 
535
    Tcl_ServiceAll();
536
}
537
 
538
/*
539
 *----------------------------------------------------------------------
540
 *
541
 * FileHandlerEventProc --
542
 *
543
 *      This procedure is called by Tcl_ServiceEvent when a file event
544
 *      reaches the front of the event queue.  This procedure is
545
 *      responsible for actually handling the event by invoking the
546
 *      callback for the file handler.
547
 *
548
 * Results:
549
 *      Returns 1 if the event was handled, meaning it should be removed
550
 *      from the queue.  Returns 0 if the event was not handled, meaning
551
 *      it should stay on the queue.  The only time the event isn't
552
 *      handled is if the TCL_FILE_EVENTS flag bit isn't set.
553
 *
554
 * Side effects:
555
 *      Whatever the file handler's callback procedure does.
556
 *
557
 *----------------------------------------------------------------------
558
 */
559
 
560
static int
561
FileHandlerEventProc(evPtr, flags)
562
    Tcl_Event *evPtr;           /* Event to service. */
563
    int flags;                  /* Flags that indicate what events to
564
                                 * handle, such as TCL_FILE_EVENTS. */
565
{
566
    FileHandler *filePtr;
567
    FileHandlerEvent *fileEvPtr = (FileHandlerEvent *) evPtr;
568
    int mask;
569
 
570
    if (!(flags & TCL_FILE_EVENTS)) {
571
        return 0;
572
    }
573
 
574
    /*
575
     * Search through the file handlers to find the one whose handle matches
576
     * the event.  We do this rather than keeping a pointer to the file
577
     * handler directly in the event, so that the handler can be deleted
578
     * while the event is queued without leaving a dangling pointer.
579
     */
580
 
581
    for (filePtr = notifier.firstFileHandlerPtr; filePtr != NULL;
582
            filePtr = filePtr->nextPtr) {
583
        if (filePtr->fd != fileEvPtr->fd) {
584
            continue;
585
        }
586
 
587
        /*
588
         * The code is tricky for two reasons:
589
         * 1. The file handler's desired events could have changed
590
         *    since the time when the event was queued, so AND the
591
         *    ready mask with the desired mask.
592
         * 2. The file could have been closed and re-opened since
593
         *    the time when the event was queued.  This is why the
594
         *    ready mask is stored in the file handler rather than
595
         *    the queued event:  it will be zeroed when a new
596
         *    file handler is created for the newly opened file.
597
         */
598
 
599
        mask = filePtr->readyMask & filePtr->mask;
600
        filePtr->readyMask = 0;
601
        if (mask != 0) {
602
            (*filePtr->proc)(filePtr->clientData, mask);
603
        }
604
        break;
605
    }
606
    return 1;
607
}
608
 
609
/*
610
 *----------------------------------------------------------------------
611
 *
612
 * Tcl_WaitForEvent --
613
 *
614
 *      This function is called by Tcl_DoOneEvent to wait for new
615
 *      events on the message queue.  If the block time is 0, then
616
 *      Tcl_WaitForEvent just polls without blocking.
617
 *
618
 * Results:
619
 *      Returns 1 if an event was found, else 0.  This ensures that
620
 *      Tcl_DoOneEvent will return 1, even if the event is handled
621
 *      by non-Tcl code.
622
 *
623
 * Side effects:
624
 *      Queues file events that are detected by the select.
625
 *
626
 *----------------------------------------------------------------------
627
 */
628
 
629
int
630
Tcl_WaitForEvent(
631
    Tcl_Time *timePtr)          /* Maximum block time, or NULL. */
632
{
633
    int timeout;
634
 
635
    if (!initialized) {
636
        InitNotifier();
637
    }
638
 
639
    TclSetAppContext(NULL);
640
 
641
    if (timePtr) {
642
        timeout = timePtr->sec * 1000 + timePtr->usec / 1000;
643
        if (timeout == 0) {
644
            if (XtAppPending(notifier.appContext)) {
645
                goto process;
646
            } else {
647
                return 0;
648
            }
649
        } else {
650
            Tcl_SetTimer(timePtr);
651
        }
652
    }
653
process:
654
    XtAppProcessEvent(notifier.appContext, XtIMAll);
655
    return 1;
656
}

powered by: WebSVN 2.1.0

© copyright 1999-2024 OpenCores.org, equivalent to Oliscience, all rights reserved. OpenCores®, registered trademark.