HierarchicalDisplaysImpl.Mesa
Last Edited by: Spreitzer, July 8, 1985 8:03:50 pm PDT
DIRECTORY Buttons, HierarchicalDisplays, MJSContainers, UserProfile, ViewerClasses, ViewerOps;
HierarchicalDisplaysImpl:
CEDAR
MONITOR
IMPORTS Buttons, MJSContainers, UserProfile, VO:ViewerOps
EXPORTS HierarchicalDisplays =
BEGIN OPEN HierarchicalDisplays;
ParentList: TYPE = LIST OF Parent;
Root: TYPE = REF RootRep;
RootRep:
TYPE =
RECORD [
parent: Parent,
cw: INTEGER];
nvSep: INTEGER = 2;
cSep: INTEGER = 5;
vSep: INTEGER = 2;
indent: INTEGER ← 10;
nvDiffLines: BOOLEAN ← TRUE;
SampleHierarchicalDisplaysProfile: UserProfile.ProfileChangedProc
--PROC [reason: ProfileChangeReason]-- =
BEGIN
indent ← UserProfile.Number[key: "HierarchicalDisplays.indent", default: 10];
nvDiffLines ← UserProfile.Boolean[key: "HierarchicalDisplays.nvDiffLines", default: TRUE];
END;
debug: BOOLEAN ← FALSE;
roots: ParentList ← NIL;
CreateRoot:
PUBLIC
PROC [viewerInit: ViewerRec, paint:
BOOLEAN ←
TRUE]
RETURNS [p: Parent] =
BEGIN
r: Root;
IF viewerInit.parent # NIL THEN viewerInit.wh ← MAX[viewerInit.wh, minH];
p ← NEW [ParentRep ← [container: NIL]];
viewerInit.data ← r ← NEW [RootRep ← [p, 0]];
[] ← MJSContainers.Create[viewerFlavor: $HierarchicalDisplayRoot, info: viewerInit, paint: paint];
roots ← CONS[p, roots];
END;
InitRoot: ViewerClasses.InitProc
--PROC [self: Viewer]-- =
BEGIN
r: Root ← NARROW[MJSContainers.GetClientData[self]];
r.parent.container ← self;
r.cw ← self.cw;
END;
HandleSizeChange:
PROC [self: Viewer]
RETURNS [adjusted:
BOOL ←
FALSE]
--ViewerClasses.AdjustProc-- =
BEGIN
root: Root ← NARROW[MJSContainers.GetClientData[self]];
News:
ENTRY
PROC
RETURNS [news:
BOOLEAN] =
{
IF news ← root.parent.container.cw # root.cw
THEN root.cw ← root.parent.container.cw};
IF adjusted ← (root # NIL AND News[]) THEN Pack[parent: root.parent, paint: FALSE];
END;
Pack:
PUBLIC
PROC [parent: Parent, paint:
BOOLEAN ←
TRUE] =
BEGIN
parent.rx ← parent.ty ← parent.by ← 0;
FOR c: Child ← parent.firstChild, c.next
WHILE c #
NIL
DO
WITH c
SELECT
FROM
in: InternalNode =>
BEGIN
FlushRight[parent.container, in.container];
FlushRight[in.container, in.asParent.container];
Pack[in.asParent, FALSE];
in.container.wh ← MAX[in.nameButton.wy + in.nameButton.wh, in.asParent.container.wy + in.asParent.container.wh] + in.container.wh - in.container.ch;
END;
x: Leaf => SetLeafSize[x];
ENDCASE => ERROR;
Place[c, FALSE];
ENDLOOP;
IF parent.container.parent # NIL THEN VO.MoveViewer[viewer: parent.container, x: parent.container.wx, y: parent.container.wy, w: parent.container.ww, h: parent.by + parent.container.wh - parent.container.ch, paint: paint]
ELSE IF paint THEN VO.PaintViewer[viewer: parent.container, hint: client];
END;
FlushRight:
PROC [parent, child: Viewer] =
BEGIN
temp: INTEGER ← MAX[parent.cw - child.wx, 5];
IF temp # child.ww
THEN
VO.MoveViewer[viewer: child, x: child.wx, y: child.wy, w: temp, h: child.wh, paint: FALSE];
END;
Place:
PROC [child: Child, paint:
BOOLEAN] =
BEGIN
parent: Parent ← child.parent;
IF child.forceNewline
OR parent.rx + child.container.ww + (
IF parent.rx > 0
THEN cSep
ELSE 0) > parent.container.cw
AND parent.rx > 0
THEN
BEGIN
parent.rx ← 0;
parent.ty ← parent.by + vSep;
parent.by ← parent.ty;
END
ELSE IF parent.rx > 0 THEN parent.rx ← parent.rx + cSep;
VO.MoveViewer[viewer: child.container, x: parent.rx, y: parent.ty, w: child.container.ww, h: child.container.wh, paint: paint];
parent.by ← MAX[parent.by, child.container.wy + child.container.wh];
parent.rx ← child.container.wx + child.container.ww;
END;
AddLeaf:
PUBLIC
PROC [parent: Parent, before: Child, name:
ROPE, class: ChildClass, classData, instanceData:
REF
ANY ←
NIL, CreateValue: ValueCreater]
RETURNS [leaf: Leaf] =
BEGIN
paint: BOOLEAN = FALSE;
leaf ←
NEW [ChildRep[TypeLeaf] ← [
container: MJSContainers.Create[
viewerFlavor: $VanillaMJSContainer,
info: [parent: parent.container,
wh: minH,
ww: parent.container.cw,
scrollable: debug,
border: debug],
paint: FALSE],
parent: parent,
class: class,
classData: classData,
instanceData: instanceData,
variant: TypeLeaf[value: NIL] ]];
leaf.nameButton ← Buttons.Create[info: [parent: leaf.container, name: name, border: debug], proc: class.buttonProc, clientData: leaf, paint: FALSE];
IF before # NIL THEN {leaf.next ← before; leaf.prev ← before.prev; IF before.parent # parent THEN ERROR}
ELSE
IF parent.lastChild #
NIL
THEN
{leaf.prev ← parent.lastChild; leaf.next ← NIL}
ELSE leaf.next ← leaf.prev ← NIL;
IF leaf.next = NIL THEN parent.lastChild ← leaf ELSE leaf.next.prev ← leaf;
IF leaf.prev = NIL THEN parent.firstChild ← leaf ELSE leaf.prev.next ← leaf;
leaf.value ← CreateValue[leaf];
SetLeafSize[leaf];
IF leaf.next = NIL THEN Place[leaf, paint] ELSE Pack[parent, paint];
END;
SetLeafSize:
PROC [leaf: Leaf] = {
VO.MoveViewer[viewer: leaf.container,
x: leaf.container.wx,
y: leaf.container.wy,
w:
MAX[
leaf.nameButton.wx + leaf.nameButton.ww,
leaf.value.wx + leaf.value.ww]
+ leaf.container.ww - leaf.container.cw,
h:
MAX[
leaf.nameButton.wy + leaf.nameButton.wh,
leaf.value.wy + leaf.value.wh]
+ leaf.container.wh - leaf.container.ch,
paint: FALSE];
};
AddInternalNode:
PUBLIC
PROC [parent: Parent, before: Child, name:
ROPE, class: ChildClass, classData, instanceData:
REF
ANY ←
NIL]
RETURNS [internal: InternalNode] =
BEGIN
paint: BOOLEAN = FALSE;
lx, ty: INTEGER;
internal ←
NEW [ChildRep[TypeParent] ← [
container: MJSContainers.Create[viewerFlavor: $VanillaMJSContainer, info: [parent: parent.container, wh: minH, ww: parent.container.cw, scrollable: debug, border: debug], paint: FALSE],
parent: parent,
class: class,
classData: classData,
instanceData: instanceData,
variant: TypeParent[NIL] ]];
internal.nameButton ← Buttons.Create[info: [parent: internal.container, name: name, border: debug], proc: class.buttonProc, clientData: internal, paint: FALSE];
IF before # NIL THEN {internal.next ← before; internal.prev ← before.prev; IF before.parent # parent THEN ERROR}
ELSE
IF parent.lastChild #
NIL
THEN
{internal.prev ← parent.lastChild; internal.next ← NIL}
ELSE internal.next ← internal.prev ← NIL;
IF internal.next = NIL THEN parent.lastChild ← internal ELSE internal.next.prev ← internal;
IF internal.prev = NIL THEN parent.firstChild ← internal ELSE internal.prev.next ← internal;
IF nvDiffLines
THEN
BEGIN
lx ← indent;
ty ← internal.nameButton.wy + internal.nameButton.wh + vSep;
END
ELSE
BEGIN
lx ← internal.nameButton.wx + internal.nameButton.ww + nvSep;
ty ← 0;
END;
internal.asParent ←
NEW [ParentRep ← [
container: MJSContainers.Create[
viewerFlavor: $VanillaMJSContainer,
info: [parent: internal.container, scrollable: debug,
wx: lx,
wy: ty,
ww: MAX[20, internal.container.cw - lx],
wh: minH],
paint: FALSE],
asChild: internal ]];
VO.MoveViewer[
viewer: internal.container,
x: internal.container.wx,
y: internal.container.wy,
w: internal.container.ww,
h:
MAX[
internal.nameButton.wy + internal.nameButton.wh,
internal.asParent.container.wy + internal.asParent.container.wh]
+ internal.container.wh - internal.container.ch,
paint: FALSE];
internal.forceNewline ← TRUE;
IF internal.next = NIL THEN Place[internal, paint] ELSE Pack[parent, paint];
END;
Remove:
PUBLIC
PROC [child: Child] =
BEGIN
paint: BOOLEAN = FALSE;
IF child.next = NIL THEN child.parent.lastChild ← child.prev ELSE child.next.prev ← child.prev;
IF child.prev = NIL THEN child.parent.firstChild ← child.next ELSE child.prev.next ← child.next;
child.class.NotifyOnRemove[child];
WITH child
SELECT
FROM
in: InternalNode => RemoveChildren[in.asParent];
leaf: Leaf => NULL;
ENDCASE => ERROR;
VO.DestroyViewer[viewer: child.container, paint: paint];
END;
RemoveChildren:
PROC [parent: Parent] =
{FOR c: Child ← parent.firstChild, c.next WHILE c # NIL DO Remove[c] ENDLOOP};
EnumerateChildren:
PUBLIC
PROC [to: ChildNotifyProc, from: Parent ←
NIL, changedOnly:
BOOLEAN ←
FALSE, leaves, internals:
BOOLEAN ←
TRUE] =
BEGIN
Survey:
PROC [p: Parent] =
BEGIN
FOR c: Child ← p.firstChild, c.next
WHILE c #
NIL
DO
WITH c
SELECT
FROM
in: InternalNode =>
BEGIN
IF internals THEN to[c];
Survey[in.asParent];
END;
leaf: Leaf => IF leaves AND (IF changedOnly THEN leaf.value.newVersion ELSE TRUE) THEN to[leaf];
ENDCASE => ERROR;
ENDLOOP;
END;
IF from # NIL THEN Survey[from]
ELSE
FOR ps: ParentList ← roots, ps.rest
WHILE ps #
NIL
DO
Survey[ps.first];
ENDLOOP;
END;
Setup:
PROC =
BEGIN
UserProfile.CallWhenProfileChanges[SampleHierarchicalDisplaysProfile];
MJSContainers.RegisterClass[viewerFlavor: $HierarchicalDisplayRoot, class: NEW [MJSContainers.MJSContainerClassRep ← [init: InitRoot, adjust: HandleSizeChange]]];
END;
Setup[];
END.