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 [Abort, Detach, EnableAborts, MsecToTicks, SetTimeout], 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; Create: PUBLIC PROC [pushModel: BOOL] RETURNS [queue: Queue] = TRUSTED { queue ¬ NEW[QueueObj ¬ [pushModel: pushModel]]; Process.EnableAborts[@queue.newEvent]; IF pushModel THEN Process.SetTimeout[@queue.newEvent, Process.MsecToTicks[100]]; RETURN [queue]; }; CreateMenuEntry: PUBLIC PROC [q: Queue, name: Rope.ROPE, proc: Menus.ClickProc, clientData: REF, documentation: REF, guarded: BOOL, immediate: BOOL] RETURNS [Menus.MenuEntry] = { new: MyClickInfo ¬ NEW[MyClickInfoObj ¬ [ proc: proc, immediate: immediate, clientData: clientData, q: q]]; RETURN [Menus.CreateEntry[ name: name, proc: UserClick, clientData: new, documentation: documentation, fork: FALSE, guarded: guarded]] }; CreateButton: PUBLIC PROC [q: Queue, info: ViewerClasses.ViewerRec, proc: Buttons.ButtonProc, clientData: REF, font: Imager.Font, documentation: REF, guarded: BOOL, paint: BOOL, immediate: BOOL] RETURNS [Buttons.Button] = { new: MyClickInfo ¬ NEW[MyClickInfoObj ¬ [ proc: proc, immediate: immediate, clientData: clientData, q: q]]; RETURN [Buttons.Create[ info: info, proc: UserClick, clientData: new, fork: FALSE, font: font, documentation: documentation, guarded: guarded, paint: paint]] }; QueueClientAction: PUBLIC PROC [q: Queue, proc: PROC [REF], data: REF, immediate: BOOL] = { newEvent: Event ¬ CONS[first: [client[proc, data]], rest: NIL]; Enqueue[q, newEvent, immediate]; }; DequeueAction: PUBLIC ENTRY PROC [q: Queue] RETURNS [Action] = { ENABLE UNWIND => NULL; event: Event ¬ q.firstEvent; IF q.pushModel THEN RETURN WITH ERROR ClientProgrammingError; WHILE event = NIL DO WAIT q.newEvent; event ¬ q.firstEvent; ENDLOOP; q.firstEvent ¬ event.rest; RETURN [event.first]; }; FlushWithCallback: PUBLIC ENTRY PROC [q: Queue, proc: PROC[Action], abort: BOOL] = { ENABLE UNWIND => NULL; IF proc # NIL THEN UNTIL q.firstEvent = NIL DO event: Event ¬ q.firstEvent; q.firstEvent ¬ q.firstEvent.rest; proc[event.first]; ENDLOOP; q.firstEvent ¬ NIL; IF abort THEN RequestAbort[q]; }; Flush: PUBLIC ENTRY PROC [q: Queue, abort: BOOL] = { ENABLE UNWIND => NULL; q.firstEvent ¬ NIL; IF abort THEN RequestAbort[q]; }; Enqueue: PUBLIC ENTRY PROC [q: Queue, e: Event, immediate: BOOL] = { ENABLE UNWIND => NULL; qFirst: Event ¬ q.firstEvent; IF e # NIL THEN { SELECT TRUE FROM immediate => { lag: Event ¬ e; WHILE lag.rest # NIL DO lag ¬ lag.rest; ENDLOOP; lag.rest ¬ qFirst; q.firstEvent ¬ e; }; qFirst = NIL => q.firstEvent ¬ e; ENDCASE => { lag: Event ¬ qFirst; WHILE lag.rest # NIL DO lag ¬ lag.rest; ENDLOOP; lag.rest ¬ e; }; IF q.pushModel THEN TRUSTED { IF q.notifier # NIL THEN RETURN; q.notifier ¬ FORK Notifier[q]; Process.Detach[q.notifier]; } ELSE NOTIFY q.newEvent; }; }; Notifier: PROC [q: Queue] = { DO ENABLE UNWIND => AcknowledgeAbort[q]; event: Event ¬ Dequeue[q]; IF event = NIL THEN EXIT; WITH event.first SELECT FROM e1: Action.user => { viewer: ViewerClasses.Viewer ¬ NIL; parent: ViewerClasses.Viewer ¬ 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; }; RequestAbort: INTERNAL PROC [q: Queue] = { IF q.notifier # NIL THEN { aborts: CARD ¬ q.aborts; IF NOT q.abortPending THEN TRUSTED { q.abortPending ¬ TRUE; Process.Abort[q.notifier]; BROADCAST q.stateChange; }; WHILE q.aborts = aborts DO WAIT q.stateChange; ENDLOOP; }; }; AcknowledgeAbort: ENTRY PROC [q: Queue] = { IF q.abortPending THEN {q.aborts ¬ q.aborts + 1; q.abortPending ¬ FALSE}; q.notifier ¬ NIL; BROADCAST q.stateChange; }; Dequeue: ENTRY PROC [q: Queue] RETURNS [event: Event] = { IF q.firstEvent = NIL THEN WAIT q.newEvent; IF q.firstEvent = NIL THEN {q.notifier ¬ NIL; RETURN[NIL]}; event ¬ q.firstEvent; q.firstEvent ¬ event.rest; }; UserClick: PUBLIC Menus.ClickProc = { WITH clientData SELECT FROM mci: MyClickInfo => { newEvent: Event ¬ LIST[[user[ mci.proc, parent, mci.clientData, mouseButton, shift, control]]]; Enqueue[mci.q, newEvent, mci.immediate]; }; ENDCASE; }; END. Ό MBQueueImpl.mesa Copyright Σ 1985, 1986, 1991 by Xerox Corporation. All rights reserved. Created by Cattell and Willie-Sue October 20, 1982 4:20 pm Willie-Sue on October 25, 1982 4:04 pm Doug Wyatt, May 9, 1985 10:26:55 am PDT Russ Atkinson (RRA) January 20, 1987 3:08:56 am PST 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. Put the event on the front of the queue for immediate processing 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 ONLY from Notifier. This allows the notifier to pause a little bit before being recycled. Adds another event to the end of q's event list Κε•NewlineDelimiter –(cedarcode) style™codešœ™Kšœ Οeœ=™HKšœ:™:Kšœ&™&K™'K™3—˜šΟk ˜ Kšœžœ/˜