CDErrorsImpl.mesa (part of ChipNDale)
Copyright © 1985, 1986 by Xerox Corporation. All rights reserved.
by Christian Jacobi, March 1, 1985 9:40:12 am PST
Last edited by: Christian Jacobi, September 2, 1986 5:52:57 pm PDT
DIRECTORY
CD,
CDBasics,
CDCellsExtras,
CDDirectory,
CDErrors,
CDMarks,
CDOps,
CDOrient,
CDProperties,
CDRects,
CDCells,
Rope;
CDErrorsImpl: CEDAR PROGRAM
IMPORTS CD, CDBasics, CDCellsExtras, CDDirectory, CDMarks, CDOrient, CDProperties, CDOps, CDRects, CDCells, Rope
EXPORTS CDErrors =
BEGIN
InstancePredicate: TYPE = CDErrors.InstancePredicate;
--PROC [inst: CD.Instance] RETURNS [yes: BOOL←TRUE];
WhereFound: TYPE = {itself, cell, design, none};
foundAndStop: SIGNAL = CODE;
foundInFirstPlace: SIGNAL = CODE;
MyDevice: TYPE = RECORD [
mark: CDMarks.MarkRange,
searchOb: CD.Object,
found: BOOLFALSE,
pos: CD.Position←[0, 0],
orient: CD.Orientation𡤀,
cell: CD.Object←NIL,
cellFound: BOOLFALSE,
cellPos: CD.Position←[0, 0],
cellOrient: CD.Orientation𡤀
];
MyDrawChild: CD.DrawProc = {
device: REF MyDevice = NARROW[pr.devicePrivate];
IF inst.ob.marked = device.mark THEN RETURN;
inst.ob.marked ← device.mark;
IF inst.ob=device.searchOb THEN {
device.pos ← pos;
device.orient ← orient;
device.found ← TRUE;
SIGNAL foundInFirstPlace;
RETURN
};
inst.ob.class.drawMe[inst: inst, pos: pos, orient: orient, pr: pr !
foundInFirstPlace => {
IF CDCells.IsCell[inst.ob] THEN {
device.cell ← inst.ob;
device.cellPos ← pos;
device.cellOrient ← orient;
device.cellFound ← TRUE;
SIGNAL foundAndStop;
ERROR
};
REJECT
}
];
};
FindAnInstance: PROC [design: CD.Design, ob: CD.Object] RETURNS [where: WhereFound ← none, cell: CD.Object←NIL, pos: CD.Position←[0, 0], orientation: CD.Orientation𡤀] = {
ProtectedDrawDesign: PROC [mark: CDMarks.MarkRange] = {
myDrawRef.devicePrivate ← myDevice ← NEW[MyDevice ← [searchOb: ob, mark: mark]];
CDOps.DrawDesign[design, myDrawRef !
foundAndStop, foundInFirstPlace => CONTINUE;
];
};
failed: BOOLFALSE;
myDrawRef: REF CD.DrawInformation;
myDevice: REF MyDevice;
IF ob=NIL THEN RETURN [where ← design];
IF CDCells.IsCell[ob] THEN RETURN [where ← itself, cell ← ob];
myDrawRef ← CD.CreateDrawRef[[
design: design,
interestClip: CDBasics.universe,
drawChild: MyDrawChild
]];
CDMarks.DoWithMark[design, ProtectedDrawDesign];
IF myDevice.found THEN {
IF myDevice.cellFound AND ~CDCellsExtras.IsDummyCell[cell] THEN {
r: CD.Rect;
cell ← myDevice.cell;
where ← WhereFound[cell];
r ← CDOrient.DeMapRect[
itemInWorld: CDOrient.RectAt[myDevice.pos, myDevice.searchOb.size, myDevice.orient],
cellSize: myDevice.cell.size,
cellInstOrient: myDevice.cellOrient,
cellInstPos: myDevice.cellPos
].itemInCell;
pos ← CDBasics.BaseOfRect[r];
orientation ← CDOrient.DecomposeOrient[
itemOrientInWorld: myDevice.orient,
cellOrientInWorld: myDevice.cellOrient
].itemOrientInCell;
}
ELSE {
where ← WhereFound[design];
pos ← myDevice.pos;
orientation ← myDevice.orient;
}
}
};
FancyClip: PROC [r: CD.Rect, into: CD.Object, msg: Rope.ROPE] RETURNS [cr: CD.Rect, text: Rope.ROPE] = {
EasyChangeAbleRect: PROC [ob: CD.Object] RETURNS [CD.Rect] = {
WITH ob.specificRef SELECT FROM
cp: CD.CellPtr =>
IF ~cp.useDIr THEN RETURN [CDBasics.RectAt[[0, 0], ob.size]];
ENDCASE => NULL;
RETURN [CD.InterestRect[ob]]
};
text ← msg;
cr ← r;
IF into#NIL THEN {
ir: CD.Rect ← EasyChangeAbleRect[into];
cr ← CDBasics.Intersection[cr, ir];
IF ~CDBasics.NonEmpty[cr] THEN {
text ← Rope.Concat[msg, "(outside object)"];
IF cr.x1>=cr.x2 THEN { --x dimension problem
IF cr.x1>=ir.x2 THEN {cr.x2 ← ir.x2; cr.x1 ← MAX[ir.x1, ir.x2-(ir.x2-ir.x1)/16-2]}
ELSE {cr.x1 ← ir.x1; cr.x2 ← MIN[ir.x2, ir.x1+(ir.x2-ir.x1)/8+2]}
};
IF cr.y1<=cr.y2 THEN {
IF cr.y1>ir.y2 THEN {cr.y2 ← ir.y2; cr.y1 ← MAX[ir.y1, ir.y2-(ir.y2-ir.y1)/16-2]}
ELSE {cr.y1 ← ir.y1; cr.y2 ← MIN[ir.y2, ir.y1+(ir.y2-ir.y1)/8+2]}
};
IF ~CDBasics.NonEmpty[cr] THEN cr ← ir;
};
};
};
IncludeMessage: PUBLIC PROC [design: CD.Design, ob: CD.Object, rect: CD.Rect, message: Rope.ROPENIL, owner: ATOMNIL] RETURNS [done: BOOLTRUE, into: CD.Object←NIL, inst: CD.Instance←NIL] = {
mappedRect: CD.Rect;
where: WhereFound;
cell: CD.Object;
pos: CD.Position;
orientation: CD.Orientation;
from: Rope.ROPENIL;
IF design=NIL OR ~CDBasics.NonEmpty[rect] THEN RETURN [done←FALSE];
--get an instance
[where: where, cell: cell, pos: pos, orientation: orientation] ← FindAnInstance[design, ob];
--mapp the error rectangle
IF where=none THEN RETURN [done←FALSE]
ELSE IF where=itself THEN {mappedRect ← rect; into ← ob}
ELSE {
cellRep: REF;
IF where=design THEN {mappedRect ← rect; cellRep ← $design}
ELSE IF cell#NIL THEN {
mappedRect ← CDOrient.MapRect[
itemInCell: rect,
cellSize: ob.size,
cellInstOrient: orientation,
cellInstPos: pos
];
cellRep ← CDDirectory.Name[cell];
into ← cell;
IF cellRep=NIL THEN {cellRep ← $design; into ← NIL};
}
ELSE ERROR;
--make ob pointing to errormessage places if of any value and possible
IF ob#NIL AND ob.class.inDirectory THEN {
x: REF = CDProperties.GetObjectProp[ob, hasErrorsInOtherCellsKey];
IF x=NIL THEN CDProperties.PutObjectProp[ob, hasErrorsInOtherCellsKey, cellRep]
ELSE IF x#$many AND x#cellRep THEN {
IF ~ISTYPE[x, Rope.ROPE] OR ~Rope.Equal[NARROW[x, Rope.ROPE], CDDirectory.Name[ob]] THEN
CDProperties.PutObjectProp[ob, hasErrorsInOtherCellsKey, $many]
}
};
IF ob#NIL THEN {
from ← CDDirectory.Name[ob];
IF from=NIL THEN from ← CDOps.ObjectInfo[ob];
message ← Rope.Cat[message, " [local to ", from, "]"];
}
};
IF where#design THEN [mappedRect, message] ← FancyClip[mappedRect, cell, message];
--include the error rectangle
inst ← CDCells.IncludeOb[design: design,
cell: cell,
ob: CDRects.CreateRect[CDBasics.SizeOfRect[mappedRect], CD.errorLayer],
position: CDBasics.BaseOfRect[mappedRect],
cellCSystem: cdCoords,
obCSystem: cdCoords,
mode: dontPropagate
].newInst;
CDOps.DelayedRedraw[design, (IF cell=NIL THEN mappedRect ELSE CDBasics.universe)];
--properties
IF owner#NIL THEN CDProperties.PutInstanceProp[inst, ownerKey, owner];
IF message#NIL THEN CDProperties.PutInstanceProp[inst, messageKey, message];
IF from#NIL THEN CDProperties.PutInstanceProp[inst, showErrorsForOtherKey, from];
};
EqualXR: PROC [x: REF, r: Rope.ROPE] RETURNS [BOOL] = INLINE {
WITH x SELECT FROM
xr: Rope.ROPE => RETURN [Rope.Equal[xr, r]];
ENDCASE => RETURN [x=r] --both NIL
};
RemFromCellOrTopLevel: PROC [design: CD.Design, owner: ATOM, cell: CD.Object, removeIt: InstancePredicate, restricted: Rope.ROPENIL, all: BOOLFALSE] RETURNS [others: BOOL] = {
--all: whether we want restricted to be applied
--restricted: whether only messages with Name(origin)=restricted will be removed
redraw: BOOLFALSE;
removeList: CD.InstanceList ← NIL;
countAll: INT ← 0;
countRemove: INT ← 0;
cp: CD.CellPtr;
IF cell#NIL THEN cp ← NARROW[cell.specificRef] ELSE cp ← design.actual.first.specific;
--to improve, handle innerrect crap, removing and repositioning inside
FOR list: CD.InstanceList ← cp.contents, list.rest WHILE list#NIL DO
IF IsError[list.first.ob] THEN {
countAll ← countAll+1;
IF owner=NIL OR owner=CDProperties.GetInstanceProp[list.first, ownerKey] THEN {
IF all OR EqualXR[
CDProperties.GetInstanceProp[list.first, showErrorsForOtherKey],
restricted] THEN
IF cell#NIL OR ~list.first.selected THEN --dont remove selected messages
IF removeIt=NIL OR removeIt[list.first] THEN {
countRemove ← countRemove+1;
removeList ← CONS[list.first, removeList]
}
}
}
ENDLOOP;
FOR list: CD.InstanceList ← removeList, list.rest WHILE list#NIL DO
[] ← CDCells.RemoveInstance[design, cell, list.first, doit]
ENDLOOP;
IF countRemove>0 AND cell#NIL THEN CDOps.DelayedRedraw[design];
others ← countAll#countRemove;
};
RemoveMessages: PUBLIC PROC [design: CD.Design, ob: CD.Object, owner: ATOM, alsoOthers: BOOL, removeIt: InstancePredicate] = {
RemoveMessFromEveryWhere: PROC [restricted: Rope.ROPENIL] RETURNS [others: BOOLFALSE] = {
EachEntry: PROC [name: Rope.ROPE, ob: CD.Object] RETURNS [quit: BOOLFALSE] = {
IF CDCells.IsCell[ob] THEN
others ← others OR RemFromCellOrTopLevel[design, owner, ob, removeIt, restricted];
};
[] ← CDDirectory.Enumerate[design, EachEntry];
others ← others OR RemFromCellOrTopLevel[design, owner, NIL, removeIt, restricted];
};
IF ob=NIL OR CDCells.IsCell[ob] THEN [] ← RemFromCellOrTopLevel[design, owner, ob, removeIt, NIL, alsoOthers]
ELSE IF ob.class.inDirectory THEN {
others: BOOLTRUE; -- found error messages of other owners
x: REF = CDProperties.GetObjectProp[ob, hasErrorsInOtherCellsKey];
IF x#NIL THEN {
obName: Rope.ROPE = CDDirectory.Name[ob];
IF x=$design THEN
others ← RemFromCellOrTopLevel[design, owner, NIL, removeIt, obName]
ELSE
WITH x SELECT FROM
r: Rope.ROPE => {
other: CD.Object ← CDDirectory.Fetch[design, r].object;
IF other#NIL AND CDCells.IsCell[other] THEN
others ← RemFromCellOrTopLevel[design, owner, other, removeIt, obName]
};
ENDCASE => others ← RemoveMessFromEveryWhere[obName];
IF owner=NIL OR ~others THEN
CDProperties.PutObjectProp[ob, hasErrorsInOtherCellsKey, NIL];
};
}
ELSE [] ← RemoveMessFromEveryWhere[CDOps.ObjectInfo[ob]];
};
RemoveAllMessages: PUBLIC PROC [design: CD.Design, owner: ATOM, removeIt: InstancePredicate] = {
EachEntry: PROC [name: Rope.ROPE, ob: CD.Object] RETURNS [quit: BOOLFALSE] = {
IF CDCells.IsCell[ob] THEN
[] ← RemFromCellOrTopLevel[design, owner, ob, removeIt, NIL, TRUE]
};
[] ← CDDirectory.Enumerate[design, EachEntry];
[] ← RemFromCellOrTopLevel[design, owner, NIL, removeIt, NIL, TRUE];
};
IsError: PROC [ob: CD.Object] RETURNS [BOOL] = INLINE {
RETURN [ob.layer=CD.errorLayer AND ob.class.wireTyped]
};
messageKey: PUBLIC ATOM ← $SignalName;
ownerKey: ATOM = $ErrorOwner;
hasErrorsInOtherCellsKey: ATOM = $showErrorsElseWhere;
showErrorsForOtherKey: ATOM = $showErrorsForOthers;
[] ← CDProperties.RegisterProperty[hasErrorsInOtherCellsKey, $chj];
[] ← CDProperties.RegisterProperty[showErrorsForOtherKey, $chj];
[] ← CDProperties.RegisterProperty[ownerKey, $chj];
END.