TBQueueImpl.mesa
Copyright Ó 1985, 1992 by Xerox Corporation. All rights reserved.
Swinehar, February 3, 1991 0:59 am PST
Willie-sue, April 23, 1992 2:28 pm PDT
Contents: impl'n of TBQueue - modeled after MBQueueImpl
DIRECTORY
Buttons USING [Button, ButtonProc, Create, SetDisplayStyle],
EditSpan USING [ Place ],
Imager USING [Font],
Menus USING [ClickProc, CreateEntry, MenuEntry],
Process USING [Abort, Detach, EnableAborts, MsecToTicks, SetTimeout],
Rope USING [ROPE],
TBQueue,
TBQueuePrivate,
TiogaButtons
USING [TiogaButtonProc, TiogaButton,
AppendToButton, CreateButton, CreateButtonAtNode, CreateButtonFromNode],
TiogaOps USING [Ref],
ViewerClasses USING [Viewer, ViewerRec],
ViewerOps USING [FetchProp];
TBQueueImpl:
CEDAR
MONITOR
LOCKS q USING q: Queue
IMPORTS
Buttons, Menus, Process, TiogaButtons, ViewerOps
EXPORTS
TBQueue, TBQueuePrivate
= BEGIN OPEN TBQueue, TBQueuePrivate;
QueueObj: PUBLIC TYPE ~ TBQueuePrivate.QueueObj; -- export concrete type to TBQueue
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];
};
CreateTiogaButtonAtNode:
PUBLIC PROC [
q: TBQueue.Queue,
viewer: ViewerClasses.Viewer,
oldButton: TiogaButtons.TiogaButton¬
NIL,
where: EditSpan.Place¬before,
rope: Rope.
ROPE ¬
NIL,
format: Rope.
ROPE ¬
NIL,
looks: Rope.
ROPE ¬
NIL,
proc: TiogaButtons.TiogaButtonProc,
clientData:
REF
ANY ¬
NIL,
fork:
BOOL ¬
TRUE,
paint:
BOOL ¬
TRUE,
immediate:
BOOL ¬
FALSE
]
RETURNS [TiogaButtons.TiogaButton] ~ {
RETURN[TiogaButtons.CreateButtonAtNode[
viewer, oldButton, where, rope, format, looks, TBUserClick,
NEW[ MyClickInfoObj ¬ [
tbProc: proc, mbProc: NIL,
immediate: immediate,
clientData: clientData,
q: q]],
fork]]
};
CreateTiogaButton:
PUBLIC
PROC [
q: Queue, viewer: ViewerClasses.Viewer, rope: ROPE ¬ NIL, format: ROPE ¬ NIL,
looks: ROPE ¬ NIL, proc: TiogaButtons.TiogaButtonProc, clientData: REF ANY ¬ NIL,
fork:
BOOL ¬
TRUE, paint:
BOOL ¬
TRUE, immediate:
BOOL ¬
FALSE]
RETURNS [TiogaButtons.TiogaButton] = {
RETURN[TiogaButtons.CreateButton[
viewer, rope, format, looks, TBUserClick,
NEW[ MyClickInfoObj ¬ [
tbProc: proc, mbProc: NIL,
immediate: immediate,
clientData: clientData,
q: q]],
fork]]
};
CreateTiogaButtonFromNode:
PUBLIC
PROC [
q: Queue, node: TiogaOps.Ref, start: INT ¬ 0, end: INT ¬ INT.LAST,
proc: TiogaButtons.TiogaButtonProc ¬ NIL, clientData: REF ANY ¬ NIL,
fork:
BOOL ¬
TRUE, immediate:
BOOL ¬
FALSE]
RETURNS [TiogaButtons.TiogaButton] = {
RETURN[TiogaButtons.CreateButtonFromNode[
node, start, end, TBUserClick,
NEW[ MyClickInfoObj ¬ [
tbProc: proc, mbProc: NIL,
immediate: immediate,
clientData: clientData,
q: q]],
fork]];
};
AppendToTiogaButton:
PUBLIC
PROC [
q: Queue, button: TiogaButtons.TiogaButton, rope: ROPE ¬ NIL, looks: ROPE ¬ NIL,
proc: TiogaButtons.TiogaButtonProc ¬ NIL, clientData: REF ANY ¬ NIL,
fork:
BOOL ¬
TRUE, immediate:
BOOL ¬
FALSE]
RETURNS [TiogaButtons.TiogaButton] = {
RETURN[TiogaButtons.AppendToButton[
button, rope, looks, TBUserClick,
NEW[ MyClickInfoObj ¬ [
tbProc: proc, mbProc: NIL,
immediate: immediate,
clientData: clientData,
q: q]],
fork]];
};
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 ¬ [
tbProc: NIL, mbProc: proc,
immediate: immediate, clientData: clientData, q: q]];
RETURN [Menus.CreateEntry[
name: name, proc: MBUserClick, 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 ¬ [
tbProc: NIL, mbProc: proc,
immediate: immediate, clientData: clientData, q: q]];
RETURN [Buttons.Create[
info: info, proc: MBUserClick, 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 TB/MBUserClick 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.tbUser => {
e1.proc[e1.button, e1.clientData, e1.mouseButton, e1.shift, e1.control];
};
e2: Action.mbUser => {
viewer: ViewerClasses.Viewer ¬ NIL;
parent: ViewerClasses.Viewer ¬ e2.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];
e2.proc[parent, e2.clientData, e2.mouseButton, e2.shift, e2.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]
};
e3: Action.client => e3.proc[e3.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;
};
TBUserClick:
PUBLIC TiogaButtons.TiogaButtonProc = {
Adds another event to the end of q's event list
WITH clientData
SELECT
FROM
mci: MyClickInfo => {
newEvent: Event ¬ LIST[[tbUser[
mci.tbProc, button, mci.clientData, mouseButton, shift, control]]];
Enqueue[mci.q, newEvent, mci.immediate];
};
ENDCASE;
};
MBUserClick:
PUBLIC Menus.ClickProc = {
Adds another event to the end of q's event list
WITH clientData
SELECT
FROM
mci: MyClickInfo => {
newEvent: Event ¬ LIST[[mbUser[
mci.mbProc, parent, mci.clientData, mouseButton, shift, control]]];
Enqueue[mci.q, newEvent, mci.immediate];
};
ENDCASE;
};