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