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. BMBQueueImpl.mesa Copyright c 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 Public procedures Like UserClick defined later, but queues a client-defined .action Private procedures 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. 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. RRA sez: we need some better way to keep from doing this RRA sez: we need some better way to keep from doing this Removes the first event on q's event list, returning NIL if list empty. Called from Notifier. Adds another event to the end of q's event list Κ>˜codešœ™Kšœ Οmœ1™