NutViewerImpl.mesa
Last edit by
Maxwell on September 30, 1982 10:35 am
Willie-Sue, January 21, 1983 8:50 am
Cattell, August 9, 1983 10:41 am
Donahue, July 12, 1984 2:51:20 pm PDT
Widom, June 15, 1984 1:35:04 pm PDT
Butler, August 16, 1984 9:51:22 am PDT
DIRECTORY
Atom,
Containers USING[Create],
DB,
DBEnvironment,
DBIcons USING[GetIconForEntity],
DBNames USING[MakeName],
Icons USING [IconFlavor],
IO,
Labels USING [Create],
MessageWindow,
Nut,
NutViewer,
Rope USING [Cat, Concat, Equal, ROPE],
ViewerClasses,
ViewerLocks,
ViewerOps,
VirtualDesktops;
NutViewerImpl: CEDAR MONITOR
IMPORTS
Atom, Containers, DBNames, DBIcons, IO, Nut, Rope, ViewerLocks, ViewerOps, VirtualDesktops, MessageWindow, Labels
EXPORTS NutViewer
SHARES ViewerLocks =
BEGIN OPEN IO, DB;
ViewerRec: TYPE = ViewerClasses.ViewerRec;
Viewer: TYPE = ViewerClasses.Viewer;
ROPE: TYPE = Rope.ROPE;
SpawnViewer: PUBLIC ENTRY PROCEDURE[eName, domain: ROPE, seg: Segment, parent: Viewer ← NIL] RETURNS[newV: Viewer] =
Creates and returns a new viewer that is spawned from parent
BEGIN
oldV: Viewer ← Nut.GetSpawnedProperty[parent];
IF oldV # NIL AND (oldV.newVersion OR oldV.destroyed) THEN oldV ← NIL;
newV ← CreateDefaultViewer[eName, domain, seg, oldV];
IF newV # NIL THEN [] ← Nut.SetSpawnedProperty[parent, newV];
END;
OneViewer: PUBLIC ENTRY PROCEDURE[eName, domain: ROPE, seg: Segment, parent: Viewer ← NIL] RETURNS[newV: Viewer] =
Creates and returns a new viewer and ensures only one exists
BEGIN
oldV: Viewer ← Nut.GetSpawnedProperty[parent];
IF oldV # NIL AND (oldV.newVersion OR oldV.destroyed)
THEN oldV ← FindViewer[eName, domain, seg];
IF oldV # NIL AND oldV.newVersion THEN oldV ← NIL;
newV ← CreateDefaultViewer[eName, domain, seg, oldV]
END;
ReplaceViewer: PUBLIC ENTRY PROCEDURE[eName, domain: ROPE, seg: Segment, parent: Viewer ← NIL] RETURNS[newV: Viewer] =
Creates and returns a new viewer that replaces parent
BEGIN
oldV: Viewer ← parent;
IF oldV # NIL AND (oldV.newVersion OR oldV.destroyed) THEN oldV ← NIL;
newV ← CreateDefaultViewer[eName, domain, seg, oldV]
END;
CreateDefaultViewer: PUBLIC PROC [eName, domain: ROPE, segment: DB.Segment, replace: Viewer ← NIL] RETURNS [newV: Viewer] ~ {
name: ROPE = Rope.Cat[domain, ": ", eName, "(", Atom.GetPName[segment], ")"];
iconLabel: ROPE = eName;
viewerRec: ViewerClasses.ViewerRec =
[name: name,
column: IF replace # NIL AND NOT replace.iconic THEN replace.column ELSE left,
iconic: FALSE,
icon: DBIcons.GetIconForEntity[eName, domain, segment] ];
FixUpTheOld: PROC[] = {
IF newV.column # replace.column THEN
{ IF NOT newV.iconic THEN ViewerOps.ComputeColumn[newV.column]; RETURN};
IF NOT newV.iconic THEN ViewerOps.ReplaceViewer[new: newV, old: replace]
ELSE ViewerOps.DestroyViewer[replace]
};
IF replace # NIL AND (IsDefaultViewer[replace] AND NOT replace.destroyed) THEN
{child: Viewer = replace.child;
replace.name ← name;
IF child # NIL THEN ViewerOps.DestroyViewer[viewer: child]
ELSE ViewerOps.PaintViewer[replace, caption];
ViewerOps.AddProp[replace, $IconLabel, iconLabel];
Nut.SetNutInfo[replace, segment, domain, eName];
RETURN[replace] };
newV ← Containers.Create[info: viewerRec, paint: FALSE];
ViewerOps.AddProp[newV, $IconLabel, iconLabel];
Nut.SetNutInfo[newV, segment, domain, eName];
ViewerOps.AddProp[newV, $Squirrel, $Squirrel];
IF replace = NIL THEN RETURN;
{ ENABLE UNWIND => ViewerLocks.ReleaseWriteLock[replace];
ViewerLocks.CallUnderWriteLock[FixUpTheOld, replace] }
};
IsDefaultViewer: PUBLIC PROCEDURE[v: Viewer] RETURNS[BOOL] =
checks the $Squirrel property to see if this is one of ours
BEGIN
RETURN[ NARROW[ViewerOps.FetchProp[v, $Squirrel], ATOM] = $Squirrel]
END;
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
locally used procedures
FindViewer: INTERNAL PROCEDURE[ eName, domain: ROPE, seg: DB.Segment]
RETURNS[Viewer] =
BEGIN
entity: Rope.ROPE = DBNames.MakeName[seg, domain, eName];
FOR nL: LIST OF Viewer ← GetNutList[], nL.rest UNTIL nL=NIL DO
IF NOT Rope.Equal[entity, Nut.EntityNameForViewer[nL.first]] THEN LOOP;
IF nL.first.destroyed THEN LOOP;
RETURN[nL.first];
ENDLOOP;
RETURN[NIL];
END;
GetNutList: INTERNAL PROC RETURNS[nL: LIST OF Viewer] =
BEGIN
enum: ViewerOps.EnumProc =
{ name: Rope.ROPE = NARROW[ViewerOps.FetchProp[v, $Entity]];
IF name # NIL THEN nL← CONS[v, nL];
RETURN[TRUE] };
VirtualDesktops.EnumerateViewers[enum];
END;
xFudge: INTEGER = 4;
entryHeight: INTEGER = 14;
Initialize: PUBLIC PROC[parent: Viewer] RETURNS [nV: Viewer] =
Makes a label which is the first one in a viewer, at standard Y value
BEGIN
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;
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];
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;
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.STREAM = 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];
IF v.iconic THEN ViewerOps.BlinkIcon[v] };
END;
MessageRope: PUBLIC PROC[v: Viewer, msg: ROPE← NIL] =
BEGIN out: IO.STREAM = GetTypescript[v];
IF out=NIL THEN {MessageWindow.Append[msg]}
ELSE {out.Put[IO.rope[msg]]; IF v.iconic THEN ViewerOps.BlinkIcon[v]};
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: PUBLIC PROC [v: Viewer] RETURNS [out: IO.STREAM] = {
IF v=NIL OR v.destroyed THEN RETURN[NIL] ELSE v← GetTopLevel[v];
out ← NARROW[ViewerOps.FetchProp[GetTopLevel[v], $Typescript]];
RETURN[out];
};
GetTopLevel: PROC [v: Viewer] RETURNS [top: Viewer] =
{FOR top← v, top.parent UNTIL top.parent=NIL DO ENDLOOP};
END.