ActionQueuePrivateImpl.mesa
Copyright © 1985 by Xerox Corporation. All rights reserved.
Created by Cattell and Haugeland October 20, 1982 4:20 pm
Cattell on October 25, 1982 1:54 pm
Willie-Sue on October 25, 1982 4:04 pm
Doug Wyatt, May 9, 1985 10:26:55 am PDT
Russ Atkinson (RRA) June 18, 1985 6:07:16 pm PDT
Crow, September 16, 1986 7:20:10 pm PDT
DIRECTORY
Buttons USING [Button, SetDisplayStyle],
ActionQueue USING [],
ActionQueuePrivate USING [Action, Event, MyClickInfo, Queue, QueueObj],
Menus USING [ClickProc],
Process USING [Detach, GetPriority, SetPriority],
Rope USING [ROPE],
ViewerClasses USING [Viewer, ViewerRec],
ViewerOps USING [FetchProp];
ActionQueuePrivateImpl:
CEDAR
MONITOR
LOCKS qPart USING qPart: REF QueueObj
IMPORTS Buttons, Process, ViewerOps
EXPORTS ActionQueuePrivate
~ BEGIN OPEN ActionQueuePrivate;
QueueObj: PUBLIC TYPE ~ ActionQueuePrivate.QueueObj; -- export concrete type to ActionQueue
Viewer: TYPE = ViewerClasses.Viewer;
ROPE: TYPE = Rope.ROPE;
ClientProgrammingError: ERROR = CODE;
InternalProgrammingError: ERROR = CODE;
Private procedures
Enqueue:
PUBLIC
ENTRY
PROC [qPart:
REF QueueObj, e: Event] = {
Adds another event e to the end of q's event list, and set a notifier running again
if there wasn't one. Note that the caller of this procedure does the NEW of the Event,
outside the monitor, but leaves the rest field NIL to be assigned by this procedure.
IF qPart.firstEvent=
NIL
THEN qPart.firstEvent← e
ELSE {
qEnd: Event;
FOR qEnd← qPart.firstEvent, qEnd.rest UNTIL qEnd.rest=NIL DO ENDLOOP;
qEnd.rest← e
};
IF qPart.pushModel
THEN {
IF qPart.notifierRunning THEN RETURN;
qPart.notifierRunning← TRUE;
TRUSTED {Process.Detach[FORK Notifier[qPart]]};
}
ELSE NOTIFY qPart.newEvent
};
Notifier:
PROC [q:
REF QueueObj] = {
This process is not under the queue monitor. There are exactly one or zero notifiers per
queue, so that no more than one event happens at a time.
FORKed from Enqueue.
DO
ENABLE ABORTED => {q.firstEvent ← NIL; LOOP}; -- flush queue on abort
event: Event ← Dequeue[q];
IF event =
NIL
THEN
EXIT;
Setting action to normal priority gets buttons enqueued before action starts
IF Process.GetPriority[] >= 2 THEN Process.SetPriority[2];
WITH event.first
SELECT
FROM
e1: Action.user => {
viewer: ViewerClasses.Viewer ← NIL;
parent: REF ← e1.parent;
WITH parent
SELECT
FROM
v: ViewerClasses.Viewer => viewer ← v;
ENDCASE;
IF viewer #
NIL
AND viewer.class.flavor = $Button
THEN
RRA sez: we need some better way to keep from doing this
IF ViewerOps.FetchProp[viewer, $DisableMBFeedback] =
NIL
THEN
Buttons.SetDisplayStyle[viewer, $BlackOnGrey];
e1.proc[parent, e1.clientData, e1.mouseButton, e1.shift, e1.control];
IF viewer #
NIL
AND viewer.class.flavor = $Button
THEN
RRA sez: we need some better way to keep from doing this
IF ViewerOps.FetchProp[viewer, $DisableMBFeedback] =
NIL
THEN
Buttons.SetDisplayStyle[viewer, $BlackOnWhite]};
e2: Action.client => e2.proc[e2.data];
ENDCASE => ERROR;
ENDLOOP;
};
Dequeue:
ENTRY
PROC [qPart:
REF QueueObj]
RETURNS [event: Event] = {
Removes the first event on q's event list, returning NIL if list empty.
Called from Notifier.
IF NOT qPart.pushModel THEN RETURN WITH ERROR InternalProgrammingError;
IF qPart.firstEvent=NIL THEN {qPart.notifierRunning← FALSE; RETURN[NIL]};
event← qPart.firstEvent;
qPart.firstEvent← qPart.firstEvent.rest;
};
UserClick:
PUBLIC Menus.ClickProc = {
Adds another event to the end of q's event list
mci: MyClickInfo ← NARROW[clientData];
newEvent: Event ←
CONS[
first: [user[mci.proc, parent, mci.clientData, mouseButton, shift, control]], rest: NIL];
IF mci.immediate
THEN {
mci.q.std.firstEvent ← NIL; -- flush standard queue, if immediate
Enqueue[mci.q.panic, newEvent]; -- action on panic queue for immediate attention
}
ELSE Enqueue[mci.q.std, newEvent];
};
END.