-- File: NutViewerMiscImpl.mesa
-- Contents: Implementation of most of Squirrel Viewers interface (NutViewer).
-- Last edited by:
-- Cattell on June 7, 1983 3:01 pm
-- Willie-Sue on January 21, 1983 8:48 am
-- Donahue, April 5, 1983 11:18 am

DIRECTORY
Buttons,
Containers USING [ChildXBound, ChildYBound],
DB,
IO,
Labels USING [Create],
MessageWindow,
Menus,
MBQueue,
Nut,
NutOps,
NutViewer,
Process USING [Detach],
Rope,
Rules USING [Create],
SquirrelTool USING [squirrel],
ViewerOps,
ViewerClasses,
ViewerTools USING [MakeNewTextViewer, SetContents],
ViewerSpecs USING [openLeftTopY],
VFonts USING[defaultFont, Font];

NutViewerMiscImpl: CEDAR PROGRAM
IMPORTS
Buttons, DB, IO, Nut, NutOps, MessageWindow,
  Containers, Labels, MBQueue, Menus, Process,
  Rope, Rules, SquirrelTool, NutViewer, ViewerOps, ViewerTools, VFonts
EXPORTS NutViewer =

BEGIN OPEN NutViewer, DB;

-- Types and global variables

Queue: TYPE = MBQueue.Queue;

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]};

Initialize: PUBLIC PROC[parent: Viewer] RETURNS [nV: Viewer] =
-- Makes a label which is the first one in a viewer, at standard Y value
BEGIN
CheckAborted[parent];
nV← ViewerOps.CreateViewer[
flavor: $Label, info: [parent: parent, ww: 0, wh: 0, wy: 1,
  wx: IF parent.scrollable THEN 0 ELSE xFudge, border: FALSE]]
END;

MakeTextViewer: PUBLIC PROC[
sib: Viewer, w: INTEGER, fullLine: BOOL] RETURNS [nV: Viewer] =
BEGIN
IF fullLine THEN RETURN[NextTextViewer[sib]]
ELSE RETURN[NextRightTextViewer[sib, w]];
END;

NextTextViewer: PUBLIC PROC[sib: Viewer] RETURNS [nV: Viewer] =
-- Creates text viewer on line after sib, full width of parent
BEGIN
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;

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;

MakeLabel: PUBLIC PROC[
name: ROPE, sib: Viewer← NIL, newLine: BOOL← FALSE] RETURNS [nV: Viewer] =
BEGIN
-- ly: INTEGER← sib.wy;
-- IF sib.class.flavor = $Text THEN ly← ly - yTextFudge;
info: ViewerRec← [name: name, parent: sib.parent, wy: sib.wy, wh: entryHeight,
  border: FALSE];
CheckAborted[sib];
IF newLine THEN
{ info.wx← IF sib.parent.scrollable THEN 0 ELSE xFudge;
  info.wy← info.wy + sib.wh;
}
ELSE info.wx← sib.wx+sib.ww;
nV← Labels.Create[info: info];
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 in a viewer
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+xFudge;
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]]
};

MakeTypescript: PUBLIC PROC[sib: Viewer] RETURNS [ts: Viewer] =
BEGIN
y: INTEGER← sib.wy+sib.wh+xFudge;
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;

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

MakeRuler: PUBLIC PROC[sib: Viewer, h: INTEGER← 1] RETURNS [nV: Viewer] =
-- Make a one-bit wide line after sib
BEGIN
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;

CheckAborted: 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;

ProcessSelection: PUBLIC Buttons.ButtonProc =
-- A standard ButtonProc that assumes the button's REF ANY data is the FieldHandle above.
-- Insures attribute of tuple is entity-valued and non-NIL, then calls Nut.Display on it.
BEGIN OPEN DB;
otherEntity: Entity;
fd: FieldHandle← NARROW[clientData];
viewer: Viewer← NARROW[parent];
IF fd.attribute=NIL THEN -- it was the relation itself
{ otherEntity ← RelationOf[fd.tuple];
[]← Nut.Display[e: otherEntity, parent: viewer.parent, seg: SegmentOf[otherEntity]] }
ELSE IF NutOps.EntityValued[fd.attribute] THEN -- attribute refs another entity
IF Null[fd.tuple] THEN
Message[viewer, "That relationship has been deleted!"]
ELSE IF Null[otherEntity←V2E[GetF[fd.tuple, fd.attribute]]] THEN
Message[viewer, "That entity has been deleted!"]
ELSE
{ otherEntity ← V2E[GetF[fd.tuple, fd.attribute]];
[]← Nut.Display[e: otherEntity, parent: viewer.parent, seg: SegmentOf[otherEntity]] }
ELSE -- attribute is a string or number
Message[viewer, "Not an entity-valued field"];
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: PUBLIC PROC [q: MBQueue.Queue] = {
-- Just like Notifier provided by MBQueue, except catches generic database errors
v: REF ANY; -- the viewer in which the action occurred, or NIL if client-defined action
DO -- forever
ENABLE BEGIN
ABORTED =>
{MBQueue.Flush[q]; LOOP};
DB.Aborted =>
TRUSTED {MBQueue.Flush[q]; Process.Detach[FORK NutOps.TryRestart[trans]]; LOOP};
DB.Failure =>
{MBQueue.Flush[q]; NutViewer.Error[NARROW[v], "Alpine problem."]; LOOP};
DB.Error =>
IF code=NullifiedArgument THEN
{NutViewer.Message[NARROW[v], "Sorry, that entity has been nullified!"]; LOOP}
ELSE IF code=TransactionNotOpen THEN
{NutViewer.Message[NARROW[v], "There is no transaction open!"]; LOOP}
END;
event: MBQueue.Action← MBQueue.DequeueAction[q];
WITH event SELECT FROM
e1: MBQueue.Action.user =>
{v← e1.parent; e1.proc[e1.parent, e1.clientData, e1.mouseButton, e1.shift, e1.control]};
e2: MBQueue.Action.client =>
{v← NIL; e2.proc[e2.data]};
ENDCASE => ERROR;
ENDLOOP;
};

Message: PUBLIC PROC[v: Viewer, msg1, msg2, msg3, msg4: ROPE← NIL] =
-- Print msgs in v's typescript if there is one, else in Squirrel window if there is one,
-- else in message window.
BEGIN out: IO.Handle ← GetTypescript[v];
IF out=NIL THEN
{MessageWindow.Clear[]; MessageWindow.Append[Rope.Cat[msg1, msg2, msg3, msg4]]}
ELSE {
out.Put[IO.rope[msg1], IO.rope[msg2], IO.rope[Rope.Concat[msg3,msg4]]]; out.PutChar[IO.CR]};
END;

MessageRope: PUBLIC PROC[v: Viewer, msg: ROPE← NIL] =
BEGIN out: IO.Handle← GetTypescript[v];
IF out=NIL THEN {MessageWindow.Append[msg]}
ELSE {out.Put[IO.rope[msg]]};
END;

Error: PUBLIC PROC[v: Viewer, msg1, msg2, msg3, msg4: ROPE← NIL] =
-- Same as Message, but blinks to get user's attention.
{MessageWindow.Blink[]; Message[v, msg1, msg2, msg3, msg4]};

GetTypescript: PROC [v: Viewer] RETURNS [out: IO.Handle] = {
IF v=NIL THEN
IF (v← SquirrelTool.squirrel)=NIL THEN RETURN[NIL]
ELSE IF v.iconic THEN ViewerOps.BlinkIcon[v]
ELSE v← GetTopLevel[v];
RETURN[NARROW[ViewerOps.FetchProp[GetTopLevel[v], $Typescript]]];
};

GetTopLevel: PROC [v: Viewer] RETURNS [top: Viewer] =
{FOR top← v, top.parent UNTIL top.parent=NIL DO ENDLOOP};

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


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.