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
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;
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: 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;
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];
e1.proc[parent, e1.clientData, e1.mouseButton, e1.shift, e1.control];
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 => 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.
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.