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