MBQueueImpl.mesa
Copyright © 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, August 5, 1985 12:01:16 pm PDT
DIRECTORY
Buttons USING [Button, ButtonProc, Create, SetDisplayStyle],
Imager USING [Font],
List USING [ AList ],
MBQueue USING [],
MBQueuePrivate USING [Action, Event, MyClickInfo, MyClickInfoObj, Queue, QueueObj],
Menus USING [ClickProc, CreateEntry, MenuEntry],
Process USING [Detach, DisableTimeout, EnableAborts],
ProcessProps USING [AddPropList],
Rope USING [ROPE],
ViewerClasses USING [Viewer, ViewerRec],
ViewerOps USING [FetchProp];
MBQueueImpl: CEDAR MONITOR
LOCKS q USING q: Queue
IMPORTS Buttons, Menus, Process, ProcessProps, 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;
Public procedures
Create: PUBLIC PROC [pushModel: BOOL, propList: List.AList ← NIL] RETURNS [queue: Queue] =
TRUSTED {
queue ← NEW[QueueObj← [pushModel: pushModel, propList: propList]];
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] = {
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];
};
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
};
Private procedures
Enqueue: PUBLIC 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.
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] = {
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.
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;
e1Inner: PROC = { e1.proc[parent, e1.clientData, e1.mouseButton, e1.shift, e1.control]; };
WITH parent SELECT FROM
v: ViewerClasses.Viewer => viewer ← v;
ENDCASE;
IF viewer # NIL AND viewer.class.flavor = $Button THEN
RRA sez: we need some better way to keep from doing this
IF ViewerOps.FetchProp[viewer, $DisableMBFeedback] = NIL THEN
Buttons.SetDisplayStyle[viewer, $BlackOnGrey];
ProcessProps.AddPropList[q.propList, e1Inner];
IF viewer # NIL AND viewer.class.flavor = $Button THEN
RRA sez: we need some better way to keep from doing this
IF ViewerOps.FetchProp[viewer, $DisableMBFeedback] = NIL THEN
Buttons.SetDisplayStyle[viewer, $BlackOnWhite]};
e2: Action.client => {
e2Inner: PROC = { e2.proc[e2.data]; };
ProcessProps.AddPropList[q.propList, e2Inner];
};
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.
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 = {
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.