DIRECTORY Buttons USING [Button, ButtonProc, Create, SetDisplayStyle], Imager USING [Font], MBQueue USING [], MBQueuePrivate USING [Action, Event, MyClickInfo, MyClickInfoObj, Queue, QueueObj], MBQueueExtras USING [ Model ], 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, MBQueueExtras ~ 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]; }; InsertClientAction: PUBLIC ENTRY PROC [q: Queue, proc: PROC [REF ANY], data: REF ANY] = { q.firstEvent _ CONS[first: [client[proc, data]], rest: q.firstEvent]; IF q.pushModel THEN { IF q.notifierRunning THEN RETURN; q.notifierRunning_ TRUE; TRUSTED {Process.Detach[FORK Notifier[q]]}; } ELSE NOTIFY 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, TRUE]; 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, remove: BOOL_FALSE] RETURNS [event: Event] = { IF NOT q.pushModel OR q.firstEvent=NIL THEN {q.notifierRunning_ FALSE; RETURN[NIL]; }; event_ q.firstEvent; IF remove THEN q.firstEvent_ q.firstEvent.rest; }; IsEmpty: PUBLIC ENTRY PROC [q: Queue] RETURNS [empty: BOOL] = { RETURN[q.firstEvent=NIL]; }; ChangeModel: PUBLIC ENTRY PROC[q: Queue, model: MBQueueExtras.Model] = { SELECT model FROM $pushModel => NULL; -- handle below $pullModel => { q.pushModel _ FALSE; IF q.firstEvent#NIL THEN NOTIFY q.newEvent; }; ENDCASE=>ERROR; q.pushModel _ TRUE; IF q.firstEvent=NIL OR ~q.notifierRunning THEN RETURN; q.notifierRunning_ TRUE; TRUSTED {Process.Detach[FORK Notifier[q]]}; }; 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. ΌMBQueueImpl.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 Swinehart, November 12, 1985 8:53:38 am PST Public procedures Like UserClick defined later, but queues a client-defined .action Like QueueClientAction, but inserts the 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 or not pushing. Called from Notifier. Adds another event to the end of q's event list Κͺ˜codešœ™Kšœ Οmœ1™™>Kšœžœ2˜Ešžœ ˜šžœ˜Kšžœžœžœ˜!Kšœžœ˜Kšžœžœ˜+K˜—Kšžœžœ ˜—K˜K˜—š   œžœžœžœ žœ ˜@K˜ Kš žœ žœžœžœžœ˜=Kš žœžœžœžœ žœ˜2K˜K˜ Kšžœ˜K˜K˜—š  œžœžœžœžœ žœ˜LK˜ šžœžœžœž˜$Kšž˜šžœžœž˜K˜K˜ K˜—Kšžœ˜—K˜K˜—š œžœžœžœ˜'Kšœž˜K˜K˜—Kšœ™K˜š œžœžœžœ˜3KšœS™SKšœW™WKšœT™Tšžœž˜Kšžœ˜šžœ˜K˜ Kš žœžœ žœžœžœ˜AK˜ K˜——šžœ ˜šžœ˜Kšžœžœžœ˜!Kšœžœ˜Kšžœžœ˜+K˜—Kšžœžœ ˜—K˜K˜—š œžœ˜KšœY™YKšœ8™8Kšœ™šž˜Kšžœžœžœ˜#Kšœžœ˜ Kšžœ žœžœžœ˜šžœ žœž˜˜Kšœžœ˜#Kšœžœ ˜šžœžœž˜Kšœ&˜&Kšžœ˜—šžœ žœžœž˜6Kšžœ5™8šžœ3žœž˜=K˜.——KšœE˜Ešžœ žœžœž˜6Kšžœ5™8šžœ3žœž˜=K˜0———K˜&Kšžœžœ˜—Kšžœ˜—K˜K˜—š  œžœžœžœžœžœ˜MKšœV™VKšœ™Kšžœžœ žœžœžœžœžœžœ˜VK˜Kšžœžœ!˜/Kšœ˜K˜—š  œžœžœžœ žœ žœ˜?Kšžœžœ˜Kšœ˜K˜—š  œžœžœžœ*˜Hšžœž˜KšœžœŸ˜$Kš œžœžœžœžœžœ˜SKšžœžœ˜—Kšœžœ˜Kš žœžœžœžœžœ˜6Kšœžœ˜Kšžœžœ˜+K˜K˜—š  œžœ˜%Kšœ/™/Kšœžœ ˜&šœžœ˜KšœTžœ˜Y—K˜K˜K˜—Kšžœ˜K˜—…—h