-- File: MBQueueImpl.mesa -- Contents: impl'n of MBQueue -- Created by Cattell and Haugeland October 20, 1982 4:20 pm -- Last edit by: -- Cattell on October 25, 1982 1:54 pm -- MBrown on October 22, 1982 1:09 pm -- Willie-Sue on October 25, 1982 4:04 pm -- Last Edited by: Maxwell, May 23, 1983 9:33 am -- Last Edited by: Paul Rovner, June 15, 1983 5:26 pm DIRECTORY Buttons USING [Button, ButtonProc, Create, SetDisplayStyle], MBQueue, Menus USING [ClickProc, CreateEntry, MenuEntry], Process USING [Detach, DisableTimeout, EnableAborts], Rope USING [ROPE], ViewerClasses USING [Viewer, ViewerRec], VFonts USING [Font]; MBQueueImpl: CEDAR MONITOR LOCKS q USING q: Queue IMPORTS Buttons, Menus, Process, VFonts EXPORTS MBQueue = BEGIN Viewer: TYPE = ViewerClasses.Viewer; ROPE: TYPE = Rope.ROPE; ClientProgrammingError: ERROR = CODE; InternalProgrammingError: ERROR = CODE; -- A Queue represents a context for button clicks. It contains a list of pending events. -- If pushModel, then notifierRunning is a BOOL that indicates whether or not a process --is currently processing an event. (notifierRunning is ignored if NOT pushModel). -- If NOT pushModel, then newEvent is a CONDITION on which a client process may --wait for the next event to occur. (newEvent is ignored if pushModel). Queue: TYPE = REF QueueObj; QueueObj: PUBLIC TYPE = MONITORED RECORD [ firstEvent: Event _ NIL, pushModel: BOOL, newEvent: CONDITION, notifierRunning: BOOL _ FALSE]; -- An Action represents a single click or client-defined action. -- It contains the information needed to process the click when the notifier gets around --to it, including all the arguments to a button proc. Action: TYPE = MBQueue.Action; Event: TYPE = LIST OF Action; -- MyClickInfo is stored in the clientData field maintained by Viewers. Since we assign -- an MBQueue ClickProc and clientData with the button, we need this record to save the -- real clientData and ClickProc. We also save the queue, so we know the context of the click. MyClickInfo: TYPE = REF MyClickInfoObj; MyClickInfoObj: TYPE = RECORD[ proc: Menus.ClickProc, clientData: REF ANY, q: Queue ]; -- Public procedures 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: VFonts.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] = { -- Like UserClick defined later, but queues a client-defined .action 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]; }; Flush: PUBLIC ENTRY PROC [q: Queue] = { q.firstEvent_ NIL }; -- Private procedures Enqueue: ENTRY PROC [q: Queue, 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. qEnd: Event; IF q.firstEvent=NIL THEN q.firstEvent_ e ELSE { 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] = { -- 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. event: Event; UNTIL (event_ Dequeue[q])=NIL DO ENABLE ABORTED => {Flush[q]; LOOP}; WITH event.first SELECT FROM e1: Action.user => { viewer: ViewerClasses.Viewer; IF ISTYPE[e1.parent, ViewerClasses.Viewer] THEN viewer _ NARROW[e1.parent]; IF viewer # NIL AND viewer.class.flavor = $Button THEN Buttons.SetDisplayStyle[viewer, $BlackOnGrey]; e1.proc[e1.parent, e1.clientData, e1.mouseButton, e1.shift, e1.control]; IF viewer # NIL AND viewer.class.flavor = $Button THEN Buttons.SetDisplayStyle[viewer, $BlackOnWhite]}; e2: Action.client => e2.proc[e2.data]; ENDCASE => ERROR; ENDLOOP; }; Dequeue: ENTRY PROC [q: Queue] RETURNS [event: Event] = -- Removes the first event on q's event list, returning NIL if list empty. -- Called from Notifier. BEGIN 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; END; UserClick: 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]; Enqueue[mci.q, newEvent]; }; END. Ęg˜JšĪc‡œ'œQ˜ƒJš0˜0Jš”6œĪk œ žœCžœ0žœ0žœžœžœžœžœžœžœžœ žœ3žœžœ žœžœžœžœžœžœžœžœŸœžœžœžœžœž œžœžœžœž œžœžœŅœ žœžœžœžœ ‘œžœžœ!žœžœ)žœžœœĪnœžœžœ žœžœžœ žœzžœŸœžœžœžœ%žœžœžœžœžœžœžœžœ žœžœžœžœ.žœ=žœŸ œžœžœTžœžœ žœ$žœžœ žœ žœžœžœ*žœ.žœ/Ÿœžœžœžœžœžœ žœžœEœžœ$žœ!Ÿ œžœžœžœ žœ žœ žœžœžœžœžœžœžœžœ žœ?žœŸœžœžœžœ žœœŸœžœžœWœ[œXœžœžœžœžœžœžœ žœžœžœžœ žœžœžœžœžœžœžœžœžœŸœžœ]œ<œœžœžœžœžœžœžœžœ žœžœHžœžœ"žœ žœžœ žœžœžœžœ žœžœžœnžœžœžœŸœžœžœ žœKœœžœžœžœ žœžœžœžœžœžœžœžœžœžœ@žœŸ œ3œžœ!žœZžœ&žœ˜×,—…—Žû