-- File: WQueueImpl.mesa

-- Contents: impl'n of WQueue
-- Created by Cattell and Haugeland October 20, 1982 4:20 pm
-- Last edit by:
-- Cattell on October 25, 1982 1:54 pm
-- MBrown on October 22, 1982 1:09 pm
-- Willie-Sue on August 8, 1983 9:18 am

-- Last Edited by: Maxwell, May 23, 1983 9:33 am

DIRECTORY
Buttons USING [Button, ButtonProc, Create, SetDisplayStyle],
WQueue,
Menus USING [ClickProc, CreateEntry, MenuEntry],
Process USING [Detach, DisableTimeout, EnableAborts],
Rope USING [ROPE],
ViewerClasses USING [Viewer, ViewerRec],
VFonts USING [Font];

WQueueImpl: CEDAR MONITOR LOCKS q USING q: Queue
IMPORTS
Buttons,
Menus,
Process,
VFonts
EXPORTS
WQueue
= BEGIN

Viewer: TYPE = ViewerClasses.Viewer;
ROPE: TYPE = Rope.ROPE;
ClientProgrammingError: ERROR = CODE;
InternalProgrammingError: 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).

Queue: TYPE = REF QueueObj;
QueueObj: PUBLIC TYPE = MONITORED RECORD [
firstEvent: Event ← NIL,
pushModel: BOOL,
newEvent: CONDITION,
notifierRunning: BOOL ← FALSE];

-- An Action represents a single click or client-defined action.
-- It contains the information needed to process the click when the notifier gets around
--to it, including all the arguments to a button proc.

Action: TYPE = WQueue.Action;
Event: TYPE = LIST OF Action;

-- MyClickInfo is stored in the clientData field maintained by Viewers. Since we assign
-- an WQueue 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.

MyClickInfo: TYPE = REF MyClickInfoObj;
MyClickInfoObj: TYPE = RECORD[
proc: Menus.ClickProc,
clientData: REF ANY,
q: Queue ];


-- 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: VFonts.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];
};

Flush: 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;
};

-- Private procedures

Enqueue: 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.
qEnd: Event;
IF q.firstEvent=NIL THEN
q.firstEvent← e
ELSE {
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.
event: Event;
UNTIL (event← Dequeue[q])=NIL DO
ENABLE ABORTED => {Flush[q]; LOOP};
WITH event.first SELECT FROM
e1: Action.user => {
 viewer: ViewerClasses.Viewer;
 IF ISTYPE[e1.parent, ViewerClasses.Viewer] THEN viewer ← NARROW[e1.parent];
 IF viewer # NIL AND viewer.class.flavor = $Button THEN
  Buttons.SetDisplayStyle[viewer, $BlackOnGrey];
 e1.proc[e1.parent, e1.clientData, e1.mouseButton, e1.shift, e1.control];
 IF viewer # NIL AND viewer.class.flavor = $Button 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.
BEGIN
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;
END;

UserClick: 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.