File: NutButtonQImpl.mesa
-- Contents: impl'n of NutButtonQImpl
-- 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 October 25, 1982 4:04 pm

-- Last Edited by: Maxwell, January 18, 1984 9:11 am

-- Last Edited by: Paul Rovner, June 15, 1983 5:26 pm
-- Last Edited by: Butler, July 15, 1984 4:19:30 pm PDT

DIRECTORY
Buttons USING [ButtonProc, SetDisplayStyle],
MBQueue,
Menus USING [ClickProc, CreateEntry, MenuEntry],
NutButtons,
NutViewer,
Process USING [Detach, DisableTimeout, EnableAborts],
Rope USING [ROPE],
ViewerClasses USING [Viewer, ViewerRec];

NutButtonQImpl: CEDAR MONITOR LOCKS q USING q: Queue
IMPORTS
Buttons, Menus, NutButtons,
Process
EXPORTS
NutButtons
= BEGIN

Viewer: TYPE = NutViewer.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 = MBQueue.Action;
Event: TYPE = LIST OF Action;

-- NutClickInfo 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.

NutClickInfo: TYPE = REF NutClickInfoObj;

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

-- Public procedures

CreateQueue: PUBLIC PROC [pushModel: BOOL] RETURNS [queue: Queue] = TRUSTED {
queue ← NEW[QueueObj← [pushModel: pushModel]];
Process.DisableTimeout[@queue.newEvent];
Process.EnableAborts[@queue.newEvent];
RETURN[queue];
};

CreateQMenuEntry: 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[NutClickInfoObj← [proc, clientData, q]],
documentation, FALSE, guarded]]
};


QueueButton: PUBLIC PROC [
q: Queue, info: ViewerClasses.ViewerRec ← [], proc: Buttons.ButtonProc,
clientData: REF ANY ← NIL, fork: BOOL ← TRUE,
font: NutButtons.ButtonFontInfo ← NIL,
documentation: REF ANY ← NIL, guarded: BOOL ← FALSE, paint: BOOL ← TRUE]

RETURNS [NutButtons.NutButton] = {
RETURN[NutButtons.Create[
info, UserClick,
NEW[NutClickInfoObj← [proc, clientData, q]],
FALSE, documentation, font, 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] = {
q.firstEvent← NIL
};


-- 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: Viewer;
 IF ISTYPE[e1.parent, Viewer] THEN viewer ← NARROW[e1.parent];
 IF viewer # NIL AND viewer.class.flavor = $NutButton THEN
  Buttons.SetDisplayStyle[viewer, $BlackOnGrey];
 e1.proc[e1.parent, e1.clientData, e1.mouseButton, e1.shift, e1.control];
 IF viewer # NIL AND viewer.class.flavor = $NutButton 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: NutClickInfo ← NARROW[clientData];
newEvent: Event← CONS[
first: [user[mci.proc, parent, mci.clientData, mouseButton, shift, control]], rest: NIL];
Enqueue[mci.q, newEvent];
};


END.