<> <> <> <> <> <> <> <> 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] = <> 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] = <> 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] = <> 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] = <> BEGIN RETURN[ NARROW[ViewerOps.FetchProp[v, $Squirrel], ATOM] = $Squirrel] END; <<* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *>> <> 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] = <> 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 <> <> 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] = <> <> 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] = <> {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.