File: NutViewerMiscImpl.mesa
Last edited by
Donahue, July 24, 1984 11:15:57 am PDT
DIRECTORY
Buttons,
DB,
IO,
Containers,
Menus,
MBQueue,
Nut USING[SetFrozenProperty],
NutOps USING [Do, Outcome],
NutViewer,
Process USING [Detach],
Rope,
Rules USING [Create],
ViewerOps,
ViewerClasses,
ViewerIO USING[CreateViewerStreams],
ViewerSpecs,
ViewerTools USING [MakeNewTextViewer, SetContents],
VFonts USING[defaultFont, Font];
NutViewerMiscImpl: CEDAR PROGRAM
IMPORTS
Buttons, MBQueue, Menus, Nut, Rules, NutOps, Process, ViewerIO, ViewerOps, Containers, ViewerTools, VFonts
EXPORTS NutViewer =
BEGIN OPEN DB;
Queue: TYPE = MBQueue.Queue;
FieldHandle: TYPE = REF FieldObject;
FieldObject: TYPE = RECORD[ tuple: Relship, attribute: Attribute ];
entryHeight: INTEGER = 14;
xTextFudge: INTEGER = 8;
xFudge: INTEGER = 4;
Viewer: TYPE = ViewerClasses.Viewer;
ViewerRec: TYPE = ViewerClasses.ViewerRec;
ROPE: TYPE = Rope.ROPE;
defaultDBQueue: Queue;
DBQueue: PUBLIC PROC RETURNS[Queue] =
{RETURN[defaultDBQueue]};
NextRightTextViewer: PUBLIC PROC[sib: Viewer, w: INTEGER] RETURNS [nV: Viewer] =
BEGIN
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] =
BEGIN
info: ViewerRec← [name: name, wy: sib.wy, ww: width, wh: entryHeight,
parent: sib.parent, border: border];
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]]
};
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];
[] ← Nut.SetFrozenProperty[self, TRUE];
END;
DBNotifier: PROC [q: MBQueue.Queue] = {
outcome: NutOps.Outcome; -- 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; outcome ← NutOps.Do[proc: Do1] };
e2: MBQueue.Action.client => {
x2← e2; outcome ← NutOps.Do[proc: e2.proc]};
ENDCASE => ERROR;
IF outcome # 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;
in, out: IO.STREAM;
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];
[in, out] ← ViewerIO.CreateViewerStreams[NIL, ts];
ViewerOps.AddProp[sib.parent, $Typescript, out]
END;
MakeRuler: PUBLIC PROC[sib: Viewer, h: INTEGER← 1] RETURNS [nV: Viewer] =
BEGIN
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]=
BEGIN
y: INTEGER← 0;
oldV: Viewer← sib.parent;
h: INTEGER;
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] =
BEGIN
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.
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