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
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;
Public procedures
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] = {
Like UserClick defined later, but queues a client-defined .action
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];
};
Private procedures
Enqueue:
PUBLIC
ENTRY
PROC [q: Queue, e: Event, immediate:
BOOL] = {
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.
ENABLE UNWIND => NULL;
qFirst: Event ¬ q.firstEvent;
IF e #
NIL
THEN {
SELECT
TRUE
FROM
immediate => {
Put the event on the front of the queue for immediate processing
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] = {
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 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
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;
};
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] = {
Removes the first event on q's event list, returning NIL if list empty.
Called ONLY from Notifier.
IF q.firstEvent =
NIL
THEN
WAIT q.newEvent;
This allows the notifier to pause a little bit before being recycled.
IF q.firstEvent = NIL THEN {q.notifier ¬ NIL; RETURN[NIL]};
event ¬ q.firstEvent;
q.firstEvent ¬ event.rest;
};
UserClick:
PUBLIC Menus.ClickProc = {
Adds another event to the end of q's event list
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.