CDErrorsImpl.mesa (part of ChipNDale)
Copyright © 1985, 1986, 1987 by Xerox Corporation. All rights reserved.
Created by Christian Jacobi, March 1, 1985 9:40:12 am PST
Last edited by: Christian Jacobi, October 16, 1987 11:54:20 am PDT
Needs some redesign to be able to deal with immutable objects
DIRECTORY
CD,
CDBasics,
CDCells,
CDDefaultProcs,
CDDirectory,
CDErrors,
CDOps,
CDProperties,
CDRects,
RefTab,
Rope,
TerminalIO;
CDErrorsImpl:
CEDAR
PROGRAM
IMPORTS CD, CDBasics, CDCells, CDDefaultProcs, CDDirectory, CDProperties, CDOps, CDRects, RefTab, Rope, TerminalIO
EXPORTS CDErrors =
BEGIN
IgnoreContext: CD.DrawContextProc = {};
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 [
seen: RefTab.Ref,
searchOb: CD.Object,
found: BOOL←FALSE,
trans: CD.Transformation←[[0, 0], original],
cell: CD.Object←NIL, --is not a cell but any object able to display errors
cellFound: BOOL←FALSE,
cellTrans: CD.Transformation←[[0, 0], original]
];
MyDrawChild:
CD.DrawProc = {
device: REF MyDevice = NARROW[pr.devicePrivate];
IF RefTab.Insert[device.seen, ob, $x]
THEN {
IF ob=device.searchOb
THEN {
device.trans ← trans;
device.found ← TRUE;
SIGNAL foundInFirstPlace;
RETURN
};
ob.class.drawMe[pr: pr, ob: ob, trans: trans, readOnlyInstProps: readOnlyInstProps!
foundInFirstPlace => {
IF ob.class.showsErrors
THEN {
device.cell ← ob;
device.cellTrans ← trans;
device.cellFound ← TRUE;
ERROR foundAndStop; --this signal is not an error, but we will not resume it
};
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←original] = {
--cell is not a cell but any object able to display errors
failed: BOOL ← FALSE;
myDrawRef: REF CD.DrawInformation;
myDevice: REF MyDevice ← NEW[MyDevice ← [searchOb: ob, seen: RefTab.Create[]]];
IF ob=NIL THEN RETURN [where ← design];
IF ob.class.showsErrors THEN RETURN [where ← itself, cell ← ob];
myDrawRef ←
CD.CreateDrawRef[[
design: design,
interestClip: CDBasics.universe,
drawChild: MyDrawChild,
drawRect: CDDefaultProcs.IgnoreRect,
drawContext: IgnoreContext,
devicePrivate: myDevice
]];
CDOps.DrawDesign[design, myDrawRef
! foundAndStop, foundInFirstPlace => CONTINUE;
];
IF myDevice.found
THEN {
IF myDevice.cellFound
AND ~CDCells.IsDummyCell[myDevice.cell]
THEN {
r: CD.Rect;
cell ← myDevice.cell;
where ← WhereFound[cell];
r ← CDBasics.DeMapRect[myDevice.searchOb.bbox, myDevice.trans];
pos ← CDBasics.BaseOfRect[r];
orientation ← CDBasics.DecomposeOrient[itemInWorld: myDevice.trans.orient, cellInWorld: myDevice.cellTrans.orient].itemInCell;
}
ELSE {
where ← WhereFound[design];
pos ← myDevice.trans.off;
orientation ← myDevice.trans.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.specific
SELECT
FROM
cp: CD.CellSpecific => RETURN [ob.bbox]
ENDCASE => NULL;
RETURN [ob.bbox]
};
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.
ROPE←
NIL, owner:
ATOM←
NIL]
RETURNS [done:
BOOL←
TRUE, into:
CD.Object
←NIL, inst:
CD.Instance
←NIL] = {
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 ← CDBasics.MapRect[rect, [pos, orientation]];
cellRep ← CDDirectory.Name[cell, design];
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.composed
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, design]]
THEN
CDProperties.PutObjectProp[ob, hasErrorsInOtherCellsKey, $many]
}
};
IF ob#
NIL
THEN {
from ← CDDirectory.Name[ob, design];
IF from=NIL THEN from ← CD.Describe[ob, NIL, design];
message ← Rope.Cat[message, " [local to ", from, "]"];
}
};
IF where#design THEN [mappedRect, message] ← FancyClip[mappedRect, cell, message];
--include the error rectangle
IF cell=
NIL
OR (~cell.immutable
AND CDCells.IsCell[cell])
THEN {
inst ← CDCells.IncludeOb[design: design,
cell: cell,
ob: CDRects.CreateRect[CDBasics.SizeOfRect[mappedRect], CD.errorLayer],
trans: [CDBasics.BaseOfRect[mappedRect], original],
mode: dontResize
].newInst;
CDOps.Redraw[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];
}
ELSE TerminalIO.PutRope["can't display error message in immutable object\n"];
};
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.
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
removeList: CD.InstanceList ← NIL;
countAll, countRemove: INT ← 0;
EachInst: CDCells.InstEnumerator = {
IF ~IsError[inst.ob] THEN RETURN;
countAll ← countAll+1;
IF owner=
NIL
OR owner=CDProperties.GetInstanceProp[inst, ownerKey]
THEN {
IF all
OR EqualXR[CDProperties.GetInstanceProp[inst, showErrorsForOtherKey], restricted]
THEN {
IF cell#
NIL
OR ~inst.selected
THEN {
--dont remove selected messages
IF removeIt=
NIL
OR removeIt[inst]
THEN {
countRemove ← countRemove+1;
removeList ← CONS[inst, removeList]
}
}
}
}
};
IF cell=NIL THEN cell ← CDOps.PushedTopCell[design];
--to improve, handle innerrect crap, removing and repositioning inside
IF CDCells.IsCell[cell]
THEN {
[] ← CDCells.EnumerateInstances[cell, EachInst];
IF removeList#
NIL
AND cell.immutable
THEN {
TerminalIO.PutRope["can't remove error message from immutable object\n"];
};
FOR list:
CD.InstanceList ← removeList, list.rest
WHILE list#
NIL
DO
[] ← CDCells.RemoveInstance[design, cell, list.first, doit]
ENDLOOP;
};
IF countRemove>0 AND ~CDCells.IsDummyCell[cell] THEN CDOps.Redraw[design];
others ← countAll#countRemove;
};
RemoveMessages:
PUBLIC
PROC [design:
CD.Design, ob:
CD.Object, owner:
ATOM, alsoOthers:
BOOL, removeIt: InstancePredicate] = {
RemoveMessFromEveryWhere:
PROC [restricted: Rope.
ROPE←
NIL]
RETURNS [others:
BOOL←
FALSE] = {
EachOb: CDDirectory.EachObjectProc = {
IF CDCells.IsCell[me]
THEN
others ← others OR RemFromCellOrTopLevel[design, owner, me, removeIt, restricted];
};
[] ← CDDirectory.EnumerateDesign[design, EachOb];
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.composed
THEN {
others: BOOL ← TRUE; -- found error messages of other owners
x: REF = CDProperties.GetObjectProp[ob, hasErrorsInOtherCellsKey];
IF x#
NIL
THEN {
obName: Rope.ROPE = CDDirectory.Name[ob, design];
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[CD.Describe[ob]];
};
RemoveAllMessages:
PUBLIC
PROC [design:
CD.Design, owner:
ATOM, removeIt: InstancePredicate] = {
EachOb: CDDirectory.EachObjectProc = {
IF CDCells.IsCell[me]
THEN
[] ← RemFromCellOrTopLevel[design, owner, me, removeIt, NIL, TRUE]
};
[] ← CDDirectory.EnumerateDesign[design, EachOb];
[] ← 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.