ViewerEventsImpl.mesa
Copyright Ó 1985, 1986, 1987, 1991 by Xerox Corporation. All rights reserved.
Russ Atkinson (RRA) March 2, 1987 8:29:47 pm PST
Michael Plass, January 26, 1987 8:56:01 pm PST
Doug Wyatt, June 10, 1987 4:34:04 pm PDT
Bier, November 30, 1988 1:02:00 pm PST
Christian Jacobi, October 25, 1991 3:58 pm PDT
DIRECTORY
Rope USING [ROPE],
ViewerClasses USING [Viewer],
ViewerEvents USING [EventProc, EventRegistration, ViewerEvent],
ViewerPrivate USING [Severity],
UserProfile USING [Boolean];
ViewerEventsImpl: CEDAR MONITOR
IMPORTS UserProfile
EXPORTS ViewerEvents, ViewerPrivate
= BEGIN
ROPE: TYPE = Rope.ROPE;
EventProcs: TYPE = LIST OF RECORD[proc: ViewerEvents.EventProc, filter: REF, before: BOOL];
ArrayEventProcs: TYPE = ARRAY ViewerEvents.ViewerEvent OF EventProcs;
eventProcs: REF ArrayEventProcs ¬ NEW[ArrayEventProcs ¬ ALL[NIL]];
Exports to ViewerPrivate
Error: PUBLIC SIGNAL [severity: ViewerPrivate.Severity ¬ fatal, msg: Rope.ROPE ¬ NIL] = CODE;
UserErrorQuery: PUBLIC ENTRY PROC RETURNS [continue: BOOL ¬ FALSE] = TRUSTED {
RRA: formerly used to query user as to whether or not to continue when an uncaught error occurs in a paint or TIP notification procedure (not currently used, perhaps this entire module should go away).
ENABLE UNWIND => NULL;
IF UserProfile.Boolean["Viewers.WorldSwapDebug", FALSE] THEN RETURN [FALSE];
};
Exports to ViewerEvents
RegisterEventProc: PUBLIC PROC [proc: ViewerEvents.EventProc,
event: ViewerEvents.ViewerEvent, filter: REF ¬ NIL, before: BOOL ¬ TRUE]
RETURNS [ViewerEvents.EventRegistration ¬ NIL] = {
Monitorized CONS onto the head of the list. We don't check for duplicates. The key returned is a copy to avoid smashing the list in UnRegisterEventProc.
IF proc # NIL THEN {
key: EventProcs ¬ LIST[[proc, filter, before]];
If the proc is unsafe to assign this will get the fault before we grab the monitor lock.
innerRegister: ENTRY PROC = {
eventProcs[event] ¬ CONS[[proc, filter, before], eventProcs[event]];
};
innerRegister[];
RETURN [key];
};
};
UnRegisterEventProc: PUBLIC ENTRY PROC
[proc: ViewerEvents.EventRegistration, event: ViewerEvents.ViewerEvent] = {
Copy the previous list without the given entry. We copy this to avoid needing to monitorize ProcessEvent (who needs the hassle, after all).
newHead: EventProcs ¬ NIL;
newTail: EventProcs ¬ NIL;
who: EventProcs ¬ NIL;
WITH proc SELECT FROM
ep: EventProcs => {
IF ep.first.proc = NIL THEN RETURN;
who ¬ ep;
};
ENDCASE => RETURN;
FOR each: EventProcs ¬ eventProcs[event], each.rest WHILE each # NIL DO
IF who.first = each.first
THEN {
We have found the registration (or its equivalent), so just splice out the entry and exit. There is no need to copy any more, since the list is immutable.
IF newTail # NIL THEN newTail.rest ¬ each.rest ELSE newHead ¬ each.rest;
who.first.proc ¬ NIL; -- don't let this key be used again!
EXIT;
}
ELSE {
We have not found the registration yet, so copy the list.
new: EventProcs ¬ LIST[each.first];
IF newTail # NIL THEN newTail.rest ¬ new ELSE newHead ¬ new;
newTail ¬ new;
};
ENDLOOP;
eventProcs[event] ¬ newHead;
};
GetHead: ENTRY PROC [event: ViewerEvents.ViewerEvent] RETURNS [EventProcs] = INLINE {
This guarantees that the sampling is atomic.
RETURN [eventProcs[event]];
};
ProcessEvent: PUBLIC PROC [event: ViewerEvents.ViewerEvent, viewer: ViewerClasses.Viewer, before: BOOL] RETURNS [abort: BOOL ¬ FALSE] = {
Notice that we do not have to monitorize this processing since the sampling of GetHead[event] is atomic and the list is never changed by smashing elements.
FOR l: EventProcs ¬ GetHead[event], l.rest UNTIL l=NIL DO
IF l.first.before = before THEN {
filter: REF ¬ l.first.filter;
IF filter = NIL OR filter = viewer OR (viewer # NIL AND filter = viewer.class.flavor) THEN {
proc: ViewerEvents.EventProc ¬ l.first.proc;
IF proc # NIL THEN
abort ¬ proc[viewer, event, before ! ABORTED => {abort ¬ TRUE; EXIT}].abort;
IF abort THEN RETURN;
};
};
ENDLOOP;
};
END.