<> <> <> <> <> <> <> <> 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; <> Enqueue: PUBLIC ENTRY PROC [qPart: REF QueueObj, e: Event] = { <> <> <> 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] = { <> <> <> DO ENABLE ABORTED => {q.firstEvent _ NIL; LOOP}; -- flush queue on abort event: Event _ Dequeue[q]; IF event = NIL THEN EXIT; <> 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 <> 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 <> 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] = { <> <> 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 = { <> 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.