File: NutViewerMiscImpl.mesa
-- Contents: Implementation of most of Squirrel Viewers interface (NutViewer).
-- Last edited by:
-- Cattell on July 22, 1983 3:48 pm
-- Willie-Sue on January 21, 1983 8:48 am
-- Donahue, April 5, 1983 11:18 am
-- Widom, June 18, 1984 8:46:54 am PDT
-- Butler, June 26, 1984 4:51:20 pm PDT

DIRECTORY
Buttons,
DB,
IO,
Containers,
Menus,
MBQueue,
NutOps USING [Do],
NutViewer,
Process USING [Detach],
Rope,
Rules USING [Create],
ViewerOps,
ViewerClasses,
ViewerSpecs,
ViewerTools USING [MakeNewTextViewer, SetContents],
VFonts USING[defaultFont, Font];

NutViewerMiscImpl: CEDAR PROGRAM
IMPORTS
Buttons, MBQueue, Menus, NutViewer, Rules,
NutOps, Process, ViewerOps, Containers,
ViewerTools, VFonts
EXPORTS NutViewer =

BEGIN OPEN DB;

-- Types and global variables

Queue: TYPE = MBQueue.Queue;

FieldHandle: TYPE = REF FieldObject;

FieldObject: TYPE = RECORD[ tuple: Relship, attribute: Attribute ];

entryHeight: INTEGER = 14;

-- yTextFudge: INTEGER = 0;
xTextFudge: INTEGER = 8;
xFudge: INTEGER = 4;
-- yFudge: INTEGER = 0;

Viewer: TYPE = ViewerClasses.Viewer;
ViewerRec: TYPE = ViewerClasses.ViewerRec;
ROPE: TYPE = Rope.ROPE;

defaultDBQueue: Queue;

Exported procedures

DBQueue: PUBLIC PROC RETURNS[Queue] =
{RETURN[defaultDBQueue]};

NextRightTextViewer: PUBLIC PROC[sib: Viewer, w: INTEGER] RETURNS [nV: Viewer] =
-- creates a text viewer, next right on the same line as v
-- v must be a Viewer, not NIL
BEGIN
CheckAborted[sib];
nV← ViewerTools.MakeNewTextViewer[
info: [parent: sib.parent, wx: sib.wx+sib.ww+xFudge, wy: sib.wy,
ww: w, wh: entryHeight, border: FALSE]];
END;

MakeButton: PUBLIC PROC[q: Queue, name: ROPE, proc: Buttons.ButtonProc,
 sib: Viewer, data: REF ANY← NIL, border: BOOL← FALSE, width: INTEGER← 0,
 guarded: BOOL← FALSE, font: VFonts.Font ← VFonts.defaultFont, newLine: BOOL← FALSE]
 RETURNS [nV: Viewer] =
-- The sib is a viewer to the left or above the button to be made.
-- If q#NIL THEN button will be serialized with other buttons/menus on q,
-- otherwise it uses defaultDBQueue
-- Makes a button which is the first one on line if newLine=TRUE.
BEGIN
info: ViewerRec← [name: name, wy: sib.wy, ww: width, wh: entryHeight,
  parent: sib.parent, border: border];
CheckAborted[sib];
IF newLine THEN -- first button on new line
{ info.wy← sib.wy + sib.wh + (IF border THEN 1 ELSE 0); -- extra bit
info.wx← IF sib.parent.scrollable THEN 0 ELSE xFudge;
  }
ELSE -- next button right on same line as previous
info.wx← sib.wx+sib.ww;
IF q=NIL THEN
RETURN[Buttons.Create[
info: info, proc: proc, clientData: data, fork: FALSE, font: font, guarded: guarded]]
ELSE RETURN[ MBQueue.CreateButton[
q: q, info: info, proc: proc, clientData: data, font: font, guarded: guarded]]
END;

MakeMenuEntry: PUBLIC PROC[q: Queue, name: ROPE, proc: Menus.MenuProc,
clientData: REF ANY← NIL, documentation: REF ANY← NIL, fork: BOOL← TRUE,
guarded: BOOL← FALSE] RETURNS[Menus.MenuEntry] = {
IF q=NIL THEN RETURN[
Menus.CreateEntry[name, proc, clientData, documentation, fork, guarded]]
ELSE RETURN[
MBQueue.CreateMenuEntry[q, name, proc, clientData, documentation, fork, guarded]]
};

CheckAborted: PUBLIC PROCEDURE[sib: Viewer] =
BEGIN
state: ATOM;
IF sib = NIL THEN RETURN;
IF sib.parent # NIL THEN sib ← sib.parent;
state ← NARROW[ViewerOps.FetchProp[sib, $NutViewerState]];
IF state = $beingDestroyed THEN ERROR ABORTED; -- caught by NutImpl.Display
END;

DefaultFreezeProc: PUBLIC Menus.MenuProc =
BEGIN
 self: Viewer = NARROW[parent];
 frozen: Menus.MenuEntry = Menus.FindEntry[self.menu, "Freeze"];
 IF frozen = NIL THEN RETURN;
 Menus.ReplaceMenuEntry[self.menu, frozen];
 ViewerOps.PaintViewer[self, menu];
 ViewerOps.AddProp[self, $Frozen, self];
END;

DBNotifier: PROC [q: MBQueue.Queue] = {
-- Just like Notifier provided by MBQueue, except catches generic database errors
success: BOOL; -- set if operations succeeds;
x1: MBQueue.Action.user;
x2: MBQueue.Action.client;
Do1: PROC[ REF ANY ] = {x1.proc[x1.parent, x1.clientData, x1.mouseButton, x1.shift, x1.control]};
Do2: PROC[ REF ANY ] = {x2.proc[x2.data]};
DO -- forever
ENABLE ABORTED => {MBQueue.Flush[q]; LOOP};
event: MBQueue.Action← MBQueue.DequeueAction[q];
WITH event SELECT FROM
e1: MBQueue.Action.user => {
x1← e1; success← NutOps.Do[proc: Do1, msgViewer: NARROW[e1.parent]] };
e2: MBQueue.Action.client => {
x2← e2; success← NutOps.Do[proc: e2.proc]};
ENDCASE => ERROR;
IF NOT success THEN MBQueue.Flush[q];
ENDLOOP;
};

StartTrap: PROC = TRUSTED {
defaultDBQueue← MBQueue.Create[pushModel: FALSE];
Process.Detach[FORK DBNotifier[defaultDBQueue]]};

MakeTypescript: PUBLIC PROC[sib: Viewer] RETURNS [ts: Viewer] =
BEGIN
y: INTEGER← sib.wy+sib.wh+xFudge;
NutViewer.CheckAborted[sib];
ts← ViewerOps.CreateViewer[flavor: $Typescript,
info: [parent: sib.parent, ww: sib.cw, wy: y, wh: sib.parent.ch - y, border: FALSE] ];
Containers.ChildYBound[sib.parent, ts];
Containers.ChildXBound[sib.parent, ts];
END;

MakeRuler: PUBLIC PROC[sib: Viewer, h: INTEGER← 1] RETURNS [nV: Viewer] =
-- Make a one-bit wide line after sib
BEGIN
NutViewer.CheckAborted[sib];
nV← Rules.Create[
info: [parent: sib.parent, wy: sib.wy+sib.wh+1, ww: sib.parent.ww, wh: h]];
Containers.ChildXBound[sib.parent, nV];
END;

MakeBigTextBox: PUBLIC PROC[sib: Viewer, contents: ROPE] RETURNS [nV: Viewer]=
-- Makes editable text viewer taking rest of sib.parent's viewer,
-- suitable for msg body or whatever.
BEGIN
y: INTEGER← 0;
oldV: Viewer← sib.parent;
h: INTEGER;
NutViewer.CheckAborted[sib];
IF oldV = NIL THEN oldV← sib ELSE y← sib.wy+sib.wh+xFudge;
h← oldV.ch - y;
nV ← ViewerTools.MakeNewTextViewer[
  info: [parent: oldV, wy: y, border: FALSE, ww: oldV.ww, wh: h],
  paint: FALSE];
ViewerTools.SetContents[nV, contents];
Containers.ChildYBound[oldV, nV];
Containers.ChildXBound[oldV, nV];
END;

NextTextViewer: PUBLIC PROC[sib: Viewer] RETURNS [nV: Viewer] =
-- Creates text viewer on line after sib, full width of parent
BEGIN
NutViewer.CheckAborted[sib];
nV← ViewerTools.MakeNewTextViewer[
info: [parent: sib.parent, wy: sib.wy+sib.wh, ww: sib.parent.ww,
  wh: ViewerSpecs.openLeftTopY]];
Containers.ChildXBound[sib.parent, nV];
Containers.ChildYBound[sib.parent, nV];
END;

StartTrap[];

END.

-- Change log

WS 23-Feb-82 16:37:41: took out paint: FALSE on all viewer creations
   made all Buttons have border: FALSE

Rick 1—March or so: fixed bug in ProcessSelection: check that tuple is not null (deleted).

Rick March 25, 1982 4:01 pm: Moved CommitEditableTuple here since it was only proc in NutEditorImpl.

Rick August 3, 1982 4:11 pm: catch AttributeValueTypeMismatch in CommitEditableTuple & recover.

Cattell June 3, 1983 11:27 am: Added fancy Message stuff here, completely reorganized NextXViewer stuff to simplify.

Cattell June 6, 1983 3:24 pm: Attempt to recover from aborted transactions in DBNotifier.

Butler, June 26, 1984:
Many small changes to go with major rewrite/reorganization of Nut and Squirrel