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, August 1, 1983 4:04 pm
-- Widom, June 15, 1984 1:35:04 pm PDT
-- Butler, June 26, 1984 5:07:05 pm PDT

DIRECTORY
Atom,
FS USING [Error],
DB,
DBEnvironment,
DBIcons USING [GetIcon, IsRegistered, Failed, RegisterIcon],
Icons USING [IconFlavor, NewIconFromFile],
IO,
Labels USING [Create],
MessageWindow,
NutOps USING [IsSystemDomain, SafeNameOf, SafeSegmentOf,
SafeDomainOf, EntityToName, DecomposeName],
NutViewer,
Rope USING [Cat, Concat, Equal, Length, ROPE, SkipTo],
ViewerClasses,
ViewerLocks,
ViewerOps,
VirtualDesktops;

NutViewerImpl: CEDAR MONITOR
IMPORTS
Atom, FS, DB, DBEnvironment, DBIcons, Icons, IO, NutOps, NutViewer, 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;


-- ****************** converting from viewer to entity ****************

ToolViewer: PUBLIC Rope.ROPE ← "ToolViewer";

TextViewer: PUBLIC Rope.ROPE ← "TextViewer";
ToolInfo: TYPE = RECORD[ tool: ATOM, icon: ATOM ← NIL, commandLine: ROPE ];

squirrel: PUBLIC Viewer;
squirrelOut: PUBLIC IO.STREAM ← IO.noWhereStream;
stopped: PUBLIC BOOLEAN;


GetNutInfo: PUBLIC PROC[v: Viewer]
RETURNS[segment: Segment, domain: Domain, entity: ROPE] = {
-- Returns segment, domain, and entity name (if any) using the $Segment, $DomainName,
 -- and $EntityName properties set up by CreateNut.
 entity← NARROW[ViewerOps.FetchProp[v, $EntityName]];
segment← NARROW[ViewerOps.FetchProp[v, $Segment]];
domain← DB.DeclareDomain[V2S[ ViewerOps.FetchProp[v, $DomainName]], segment, OldOnly !
DBEnvironment.Error => CHECKED { domain ← NIL; CONTINUE } ];
};
Create: PROCEDURE[ d: Domain, eName: ROPE, seg: DB.Segment ← NIL, column: ViewerClasses.Column ← left ]
RETURNS [v: Viewer] =
--Creates a viewer to operate on the entity whose name is eName
BEGIN
segment: DB.Segment = IF NutOps.IsSystemDomain[d] THEN seg ELSE NutOps.SafeSegmentOf[d];
defaultLabel: ROPE = Rope.Cat[ NutOps.SafeNameOf[d], ": ", eName, NIL];
-- following line WAS part of function call
--  IF Nut.debug THEN Rope.Cat[ " (", Atom.GetPName[segment], " segment)" ] ELSE NIL ];
info: ViewerClasses.ViewerRec = [name: defaultLabel, iconic: FALSE, column: column];
RETURN[ViewerOps.CreateViewer[flavor: $Container, info: info, paint: FALSE]]
END;

CheckViewer: PROCEDURE[newV: Viewer, oldV: Viewer, eName: ROPE, e: Entity, d: Domain, seg: Segment]
RETURNS[Viewer] =
--Determines the iconicness of a viewer. Sets properties for a new
-- viewer and returns the viewer
BEGIN
SetUpNewViewer: PROC[] =
BEGIN
-- Add $Entity, used by whiteboards when AddSelected, and $EntityHandle (not used?)
-- used to only be done if viewer was a displayer
IF e # NIL THEN BEGIN
ViewerOps.AddProp[newV, $Entity, NutOps.EntityToName[e, seg]];
ViewerOps.AddProp[ newV, $EntityHandle, e ];
ViewerOps.AddProp[ newV, $DomainName, NutOps.SafeNameOf[d] ];
END;
ViewerOps.AddProp[ newV, $Segment, seg ];
ViewerOps.AddProp[ newV, $EntityName, eName ];
-- ViewerOps.AddProp[ newV, $NutType, NEW[NutType← type] ];
IF newV.icon = tool THEN
-- Set the icon if the create proc left it as default (tool) icon
newV.icon ←
IF e#NIL THEN GetIcon[e, seg] -- use icon for specific entity
ELSE GetIcon[d, seg]
END; -- use icon for domain
{ ENABLE UNWIND => ViewerLocks.ReleaseWriteLock[newV];
ViewerLocks.CallUnderWriteLock[SetUpNewViewer, newV] };
IF newV = oldV THEN RETURN[newV]; -- just replacing existing viewer
IF oldV=NIL OR newV.column # oldV.column THEN
{ IF NOT newV.iconic THEN ViewerOps.ComputeColumn[newV.column];
RETURN[newV]};
IF newV.iconic # oldV.iconic THEN
ViewerOps.OpenIcon[icon: IF newV.iconic THEN newV ELSE oldV, paint: FALSE];
IF NOT newV.iconic THEN ViewerOps.ReplaceViewer[new: newV, old: oldV]
ELSE { -- ViewerOps.ReplaceViewer doesn't work well with a pair of icons
 ViewerOps.DestroyViewer[oldV] };
RETURN[newV]
END;
SpawnViewer: PUBLIC ENTRY PROCEDURE[
eName: ROPE ← NIL, e: Entity, d: Domain ← NIL, seg: Segment ← NIL, parent: Viewer ← NIL]
RETURNS[newV: Viewer] =
--Creates and returns a new viewer that is spawned from parent
BEGIN
oldV: Viewer ← FindSpawned[parent];
IF oldV # NIL AND oldV.newVersion THEN oldV ← NIL;
IF d = NIL THEN d ← DB.DomainOf[e];
IF seg = NIL THEN seg ← NutOps.SafeSegmentOf[d];
IF eName = NIL THEN eName ← NutOps.SafeNameOf[e];
newV ← Create[d, eName, seg, IF oldV = NIL THEN left ELSE oldV.column];
IF newV = NIL THEN RETURN[NIL]
ELSE BEGIN
SetSpawned[parent, newV];
RETURN[CheckViewer[newV, oldV, eName, e, d, seg]];
END;
END;
OneViewer: PUBLIC ENTRY PROCEDURE[
eName: ROPE ← NIL, e: Entity, d: Domain ← NIL, seg: Segment ← NIL, parent: Viewer ← NIL]
RETURNS[newV: Viewer] =
--Creates and returns a new viewer and ensures only one exists
BEGIN
oldV: Viewer ← FindSpawned[parent];
IF d = NIL THEN d ← DB.DomainOf[e];
IF (oldV # NIL AND oldV.newVersion) OR (oldV = NIL)
THEN oldV ← FindViewer[d, eName, seg];
IF oldV # NIL AND oldV.newVersion THEN oldV ← NIL;
IF seg = NIL THEN seg ← NutOps.SafeSegmentOf[d];
IF eName = NIL THEN eName ← NutOps.SafeNameOf[e];
newV ← Create[d, eName, seg, IF oldV = NIL THEN left ELSE oldV.column];
IF newV = NIL THEN RETURN[NIL]
ELSE RETURN[ CheckViewer[newV, oldV, eName, e, d, seg] ];
END;
ReplaceViewer: PUBLIC ENTRY PROCEDURE[
eName: ROPE ← NIL, e: Entity, d: Domain ← NIL, seg: Segment ← NIL, 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 THEN oldV ← NIL;
IF d = NIL THEN d ← DB.DomainOf[e];
IF seg = NIL THEN seg ← NutOps.SafeSegmentOf[d];
IF eName = NIL THEN eName ← NutOps.SafeNameOf[e];
newV ← Create[d, eName, seg, IF oldV = NIL THEN left ELSE oldV.column];
IF newV = NIL THEN RETURN[NIL]
ELSE RETURN[ CheckViewer[newV, oldV, eName, e, d, seg] ];
END;
-- * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
-- locally used procedures

FindViewer: INTERNAL PROCEDURE
 [ domain: DB.Domain, eName: Rope.ROPE, seg: DB.Segment]
 RETURNS[Viewer] =
BEGIN
entity: Rope.ROPE = Rope.Cat[Atom.GetPName[seg], "!", NutOps.SafeNameOf[domain], "!", eName];
FOR nL: LIST OF Viewer ← GetNutList[], nL.rest UNTIL nL=NIL DO
typeProp: REF ANY = ViewerOps.FetchProp[ nL.first, $NutType ];
--nutType: NutType = IF typeProp = NIL THEN displayer
       --ELSE NARROW[typeProp, REF NutType]^;
 --IF nutType # type THEN LOOP;
 IF NOT Rope.Equal[entity, NARROW[ ViewerOps.FetchProp[nL.first, $Entity]]] THEN LOOP;
IF nL.first.destroyed THEN LOOP;
RETURN[nL.first];
ENDLOOP;
RETURN[NIL];
END;

FindSpawned: PROC[v: Viewer] RETURNS[Viewer] =
BEGIN
IF v = NIL THEN RETURN[NIL];
{ spawn: Viewer = NARROW[ ViewerOps.FetchProp[ v, $LastSpawned ], Viewer ];
IF spawn = NIL OR spawn.destroyed THEN RETURN[ NIL ];
IF ViewerOps.FetchProp[spawn, $Frozen] = NIL THEN RETURN[ spawn ];
RETURN[ NIL ] }
END;

SetSpawned: PROC[parent, spawned: Viewer] =
BEGIN
IF parent = NIL THEN RETURN;
ViewerOps.AddProp[ parent, $LastSpawned, spawned ];
IF spawned # NIL THEN ViewerOps.AddProp[ spawned, $WhoSpawnedMe, parent ];
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;

-- ****************** setting/getting icons for entities ****************

-- works for Entities or Domains

acorn: Icons.IconFlavor← NewIcon["Nut.icons", 3];

SetIcon: PUBLIC PROCEDURE[e: Entity, iconFile: ROPE, fileIndex: CARDINAL] =
BEGIN
name: ROPE = IF DB.Eq[NutOps.SafeDomainOf[e], DomainDomain] THEN NutOps.SafeNameOf[e]
     ELSE NutOps.EntityToName[e, NutOps.SafeSegmentOf[e]];
  IF DBIcons.IsRegistered[name].file = NIL THEN
  DBIcons.RegisterIcon[ name, iconFile, fileIndex ]
END;

GetIcon: PUBLIC PROC[e: Entity, seg: Segment ← NIL] RETURNS[icon: Icons.IconFlavor] =
BEGIN
IF e = NIL THEN RETURN[acorn];
{ d: Domain = NutOps.SafeDomainOf[e];
segment: DB.Segment = IF NutOps.IsSystemDomain[d] THEN seg ELSE NutOps.SafeSegmentOf[e];
dName: ROPE ← NutOps.SafeNameOf[d];
isTool: BOOL = Rope.Equal[dName, ToolViewer];
eName: ROPE = IF isTool THEN NutOps.SafeNameOf[e]
ELSE NutOps.EntityToName[e, segment];
IF dName.Equal["TextViewer"] THEN RETURN[document];
icon ← unInit;
icon ← DBIcons.GetIcon[eName, IF isTool THEN tool ELSE unInit
   ! DBIcons.Failed => CONTINUE];
IF icon # unInit THEN RETURN;
IF dName.Equal["Domain"] THEN dName← NutOps.SafeNameOf[e]; -- Use domain icon for domain entity
 icon ← DBIcons.GetIcon[dName, acorn] }
END;

GetIconFromName: PUBLIC PROC[ name: ROPE ] RETURNS[icon: Icons.IconFlavor] = {
domain, entity: ROPE;
isTool: BOOLEAN;
[, domain, entity] ← NutOps.DecomposeName[name];
IF Rope.Equal[domain, "TextViewer"] THEN RETURN[document];
isTool ← Rope.Equal[domain, ToolViewer];
IF isTool THEN name ← entity;
icon ← DBIcons.GetIcon[name, IF isTool THEN tool ELSE unInit
   ! DBIcons.Failed => { icon ← unInit; CONTINUE } ];
IF icon # unInit THEN RETURN;
icon ← DBIcons.GetIcon[domain, acorn] };

icons: IconList;
IconList: TYPE = LIST OF RECORD[file: ROPE, index: INTEGER, icon: Icons.IconFlavor];

NewIcon: PUBLIC PROC[file: ROPE, index: INTEGER] RETURNS[icon: Icons.IconFlavor ← acorn] =
BEGIN
ENABLE FS.Error =>
TRUSTED {IF error.group = bug OR error.group = environment THEN REJECT
     ELSE GOTO notFound};
FOR list: IconList ← icons, list.rest WHILE list # NIL DO
IF list.first.index # index THEN LOOP;
IF ~Rope.Equal[list.first.file, file] THEN LOOP;
RETURN[list.first.icon];
ENDLOOP;
icon ← Icons.NewIconFromFile[file, index];
icons ← CONS[[file, index, icon], icons];
EXITS
notFound => -- if not given full path name, then try [Indigo]<Squirrel>Icons>file
 BEGIN ENABLE FS.Error =>
TRUSTED {IF error.group = bug OR error.group = environment THEN REJECT
     ELSE CONTINUE};
IF file.SkipTo[pos: 0, skip: "[/"] # file.Length[] THEN RETURN; --given full path, give up
 icon ← Icons.NewIconFromFile[Rope.Cat["[Indigo]<Squirrel>Icons>", file], index];
icons ← CONS[[file, index, icon], icons];
END;
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
NutViewer.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;
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];
NutViewer.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;


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]};
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]]};
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.STREAM] = {
IF v=NIL THEN
IF (v← NutViewer.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};


END.