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;
A Queue represents a context for button clicks. It contains a list of pending events.
If pushModel, then notifierRunning is a BOOL that indicates whether or not a process
is currently processing an event. (notifierRunning is ignored if NOT pushModel).
If NOT pushModel, then newEvent is a CONDITION on which a client process may
wait for the next event to occur. (newEvent is ignored if pushModel).
MyClickInfo is stored in the clientData field maintained by Viewers. Since we assign
an MBQueue ClickProc and clientData with the button, we need this record to save the
real clientData and ClickProc. We also save the queue, so we know the context of the click.
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];
};
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;
};
END.