CDErrorsImpl.mesa (part of ChipNDale)
Copyright © 1985 by Xerox Corporation. All rights reserved.
by Christian Jacobi, March 1, 1985 9:40:12 am PST
last edited by Christian Jacobi, December 13, 1985 12:43:34 pm PST
DIRECTORY
CD,
CDBasics,
CDDirectory,
CDErrors,
CDMarks,
CDOps,
CDOrient,
CDProperties,
CDRects,
CDCells,
Rope;
CDErrorsImpl:
CEDAR
PROGRAM
IMPORTS CD, CDBasics, 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: BOOL←FALSE,
pos: CD.Position←[0, 0],
orient: CD.Orientation𡤀,
cell: CD.Object←NIL,
cellFound: BOOL←FALSE,
cellPos: CD.Position←[0, 0],
cellOrient: CD.Orientation𡤀
];
MyDrawChild:
CD.DrawProc =
--PROC [inst: CD.Instance, pos: CD.Position, orient: CD.Orientation, pr: REF CD.DrawInformation]
BEGIN
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
}
];
END;
IsPushedInto:
PROC [design:
CD.Design, ob:
CD.Object]
RETURNS [yes:
BOOL←
FALSE] =
BEGIN
FOR list:
LIST
OF CD.PushRec ← design.actual, list.rest
WHILE list#
NIL
DO
IF list.first.dummyCell.ob=ob THEN RETURN [TRUE];
--not needed in this application of procedure
--IF list.first.mightReplace#NIL AND list.first.mightReplace.ob=ob THEN RETURN [TRUE]
ENDLOOP
END;
FindAnInstance:
PROC [design:
CD.Design, ob:
CD.Object]
RETURNS [where: WhereFound ← none, cell:
CD.Object←
NIL, pos:
CD.Position←[0, 0], orientation:
CD.Orientation𡤀] =
BEGIN
ProtectedDrawDesign:
PROC [mark: CDMarks.MarkRange] =
BEGIN
myDrawRef.devicePrivate ← myDevice ← NEW[MyDevice ← [searchOb: ob, mark: mark]];
CDOps.DrawDesign[design, myDrawRef !
foundAndStop, foundInFirstPlace => CONTINUE;
];
END;
failed: BOOL ← FALSE;
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];
myDrawRef.interestClip ← CDBasics.universe;
myDrawRef.drawChild ← MyDrawChild;
CDMarks.DoWithMark[design, ProtectedDrawDesign];
IF myDevice.found
THEN {
IF myDevice.cellFound
AND ~IsPushedInto[design, 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;
}
}
END;
FancyClip:
PROC [r:
CD.Rect, into:
CD.Object, msg: Rope.
ROPE]
RETURNS [cr:
CD.Rect, text: Rope.
ROPE] =
BEGIN
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;
};
};
END;
IncludeMessage:
PUBLIC
PROC [
design: CD.Design,
ob: CD.Object,
rect: CD.Rect,
message: Rope.ROPE←NIL,
owner:
ATOM←
NIL]
RETURNS [done: BOOL←TRUE, into: CD.Object←NIL, inst: CD.Instance←NIL] =
BEGIN
mappedRect: CD.Rect;
where: WhereFound;
cell: CD.Object;
pos: CD.Position;
orientation: CD.Orientation;
from: Rope.ROPE ← NIL;
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.GetPropFromObject[ob, hasErrorsInOtherCellsKey];
IF x=NIL THEN CDProperties.PutPropOnObject[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.PutPropOnObject[ob, hasErrorsInOtherCellsKey, $many]
}
};
IF ob#
NIL
THEN {
from ← CDDirectory.Name[ob];
IF from=NIL THEN from ← CDOps.Info[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.highLightError],
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.PutPropOnInstance[inst, ownerKey, owner];
IF message#NIL THEN CDProperties.PutPropOnInstance[inst, messageKey, message];
IF from#NIL THEN CDProperties.PutPropOnInstance[inst, showErrorsForOtherKey, from];
END;
EqualXR:
PROC [x:
REF, r: Rope.
ROPE]
RETURNS [
BOOL] =
INLINE BEGIN
WITH x
SELECT
FROM
xr: Rope.ROPE => RETURN [Rope.Equal[xr, r]];
ENDCASE => RETURN [x=r] --both NIL
END;
RemFromCellOrTopLevel:
PROC [design:
CD.Design, owner:
ATOM, cell:
CD.Object, removeIt: InstancePredicate, restricted: Rope.
ROPE←
NIL, all:
BOOL←
FALSE]
RETURNS [others:
BOOL] =
--all: whether we want restricted to be applied
--restricted: whether only messages with Name(origin)=restricted will be removed
BEGIN
redraw: BOOL←FALSE;
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.GetPropFromInstance[list.first, ownerKey]
THEN {
IF all
OR EqualXR[
CDProperties.GetPropFromInstance[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;
END;
RemoveMessages:
PUBLIC
PROC [design:
CD.Design, ob:
CD.Object, owner:
ATOM, alsoOthers:
BOOL, removeIt: InstancePredicate] =
BEGIN
RemoveMessFromEveryWhere:
PROC [restricted: Rope.
ROPE←
NIL]
RETURNS [others:
BOOL←
FALSE] =
BEGIN
EachEntry:
PROC [name: Rope.
ROPE, ob:
CD.Object]
RETURNS [quit:
BOOL←
FALSE] = {
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];
END;
IF ob=NIL OR CDCells.IsCell[ob] THEN [] ← RemFromCellOrTopLevel[design, owner, ob, removeIt, NIL, alsoOthers]
ELSE
IF ob.class.inDirectory
THEN {
others: BOOL ← TRUE; -- found error messages of other owners
x: REF = CDProperties.GetPropFromObject[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.PutPropOnObject[ob, hasErrorsInOtherCellsKey, NIL];
};
}
ELSE [] ← RemoveMessFromEveryWhere[CDOps.Info[ob]];
END;
RemoveAllMessages:
PUBLIC
PROC [design:
CD.Design, owner:
ATOM, removeIt: InstancePredicate] =
BEGIN
EachEntry:
PROC [name: Rope.
ROPE, ob:
CD.Object]
RETURNS [quit:
BOOL←
FALSE] = {
IF CDCells.IsCell[ob]
THEN
[] ← RemFromCellOrTopLevel[design, owner, ob, removeIt, NIL, TRUE]
};
[] ← CDDirectory.Enumerate[design, EachEntry];
[] ← RemFromCellOrTopLevel[design, owner, NIL, removeIt, NIL, TRUE];
END;
IsError:
PROC [ob:
CD.Object]
RETURNS [
BOOL] =
INLINE BEGIN
RETURN [ob.layer=CD.highLightError AND ob.class.wireTyped]
END;
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.