<> <> <> <> <> <> <> DIRECTORY Buttons USING [Button, ButtonProc, Create, SetDisplayStyle], Imager USING [Font], MBQueue USING [], MBQueuePrivate USING [Action, Event, MyClickInfo, MyClickInfoObj, Queue, QueueObj], Menus USING [ClickProc, CreateEntry, MenuEntry], Process USING [Detach, DisableTimeout, EnableAborts], Rope USING [ROPE], ViewerClasses USING [Viewer, ViewerRec], ViewerOps USING [FetchProp]; MBQueueImpl: CEDAR MONITOR LOCKS q USING q: Queue IMPORTS Buttons, Menus, Process, ViewerOps EXPORTS MBQueue, MBQueuePrivate ~ BEGIN OPEN MBQueuePrivate; QueueObj: PUBLIC TYPE ~ MBQueuePrivate.QueueObj; -- export concrete type to MBQueue Viewer: TYPE = ViewerClasses.Viewer; ROPE: TYPE = Rope.ROPE; ClientProgrammingError: ERROR = CODE; InternalProgrammingError: ERROR = CODE; <> Create: PUBLIC PROC [pushModel: BOOL] RETURNS [queue: Queue] = TRUSTED { queue _ NEW[QueueObj_ [pushModel: pushModel]]; Process.DisableTimeout[@queue.newEvent]; Process.EnableAborts[@queue.newEvent]; RETURN[queue]; }; CreateMenuEntry: PUBLIC PROC [q: Queue, name: Rope.ROPE, proc: Menus.ClickProc, clientData: REF ANY _ NIL, documentation: REF ANY _ NIL, fork: BOOL _ TRUE, guarded: BOOL _ FALSE] RETURNS [Menus.MenuEntry] = { RETURN[Menus.CreateEntry[ name, UserClick, NEW[MyClickInfoObj_ [proc, clientData, q]], documentation, FALSE, guarded]] }; CreateButton: PUBLIC PROC [q: Queue, info: ViewerClasses.ViewerRec, proc: Buttons.ButtonProc, clientData: REF ANY, fork: BOOL, font: Imager.Font, documentation: REF ANY, guarded: BOOL, paint: BOOL ] RETURNS [Buttons.Button] = { RETURN[Buttons.Create[ info, UserClick, NEW[MyClickInfoObj_ [proc, clientData, q]], FALSE, font, documentation, guarded, paint]] }; QueueClientAction: PUBLIC PROC [q: Queue, proc: PROC [REF ANY], data: REF ANY] = { <> newEvent: Event _ CONS[first: [client[proc, data]], rest: NIL]; Enqueue[q, newEvent]; }; DequeueAction: PUBLIC ENTRY PROC [q: Queue] RETURNS [Action] = { event: Event; IF q.pushModel THEN RETURN WITH ERROR ClientProgrammingError; WHILE q.firstEvent=NIL DO WAIT q.newEvent ENDLOOP; event _ q.firstEvent; q.firstEvent_ q.firstEvent.rest; RETURN [event.first]; }; FlushWithCallback: PUBLIC ENTRY PROC [q: Queue, proc: PROC[Action]_ NIL] = { event: Event; IF proc = NIL THEN q.firstEvent_ NIL ELSE UNTIL q.firstEvent = NIL DO event_ q.firstEvent; q.firstEvent_ q.firstEvent.rest; proc[event.first]; ENDLOOP; }; Flush: PUBLIC ENTRY PROC [q: Queue] = { q.firstEvent_ NIL }; <> Enqueue: PUBLIC ENTRY PROC [q: Queue, e: Event] = { <> <> <> IF q.firstEvent=NIL THEN q.firstEvent_ e ELSE { qEnd: Event; FOR qEnd_ q.firstEvent, qEnd.rest UNTIL qEnd.rest=NIL DO ENDLOOP; qEnd.rest_ e }; IF q.pushModel THEN { IF q.notifierRunning THEN RETURN; q.notifierRunning_ TRUE; TRUSTED {Process.Detach[FORK Notifier[q]]}; } ELSE NOTIFY q.newEvent }; Notifier: PROC [q: Queue] = { <> <> <> DO ENABLE ABORTED => {Flush[q]; LOOP}; event: Event _ Dequeue[q]; IF event = NIL THEN EXIT; 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 [q: Queue] RETURNS [event: Event] = { <> <> IF NOT q.pushModel THEN RETURN WITH ERROR InternalProgrammingError; IF q.firstEvent=NIL THEN {q.notifierRunning_ FALSE; RETURN[NIL]}; event_ q.firstEvent; q.firstEvent_ q.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]; Enqueue[mci.q, newEvent]; }; END.