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, April 11, 1985 9:16:48 am PST
Last Edited by: Beretta, July 1, 1985 4:12:31 pm PDT
DIRECTORY
CD,
CDBasics,
CDDirectory,
CDErrors,
CDMarks,
CDOps,
CDOrient,
CDProperties,
CDRects,
CDX,
Rope,
TerminalIO;
CDErrorsImpl:
CEDAR
PROGRAM
IMPORTS CD, CDBasics, CDDirectory, CDMarks, CDOrient, CDProperties, CDOps, CDRects, CDX, Rope, TerminalIO
EXPORTS CDErrors =
BEGIN
AppPredicate:
TYPE = CDErrors.AppPredicate;
--PROC [aptr: CD.ApplicationPtr] RETURNS [yes: BOOL←TRUE];
WhereFound: TYPE = {itself, cell, design, none};
foundAndStop: SIGNAL = CODE;
foundInFirstPlace: SIGNAL = CODE;
MyDevice:
TYPE =
RECORD [
mark: CDMarks.MarkRange,
searchOb: CD.ObPtr,
found: BOOL←FALSE,
pos: CD.DesignPosition←[0, 0],
orient: CD.Orientation𡤀,
cell: CD.ObPtr←NIL,
cellFound: BOOL←FALSE,
cellPos: CD.DesignPosition←[0, 0],
cellOrient: CD.Orientation𡤀
];
MyDrawChild:
CD.DrawProc =
--PROC [aptr: CD.ApplicationPtr, pos: CD.DesignPosition, orient: CD.Orientation, pr: REF CD.DrawInformation]
BEGIN
device: REF MyDevice = NARROW[pr.devicePrivate];
IF aptr.ob.marked = device.mark THEN RETURN;
aptr.ob.marked ← device.mark;
IF aptr.ob=device.searchOb
THEN {
device.pos ← pos;
device.orient ← orient;
device.found ← TRUE;
SIGNAL foundInFirstPlace;
RETURN
};
aptr.ob.p.drawMe[aptr: aptr, pos: pos, orient: orient, pr: pr !
foundInFirstPlace => {
IF IsCell[aptr.ob]
THEN {
device.cell ← aptr.ob;
device.cellPos ← pos;
device.cellOrient ← orient;
device.cellFound ← TRUE;
SIGNAL foundAndStop;
ERROR
};
REJECT
}
];
END;
IsPushedInto:
PROC [design:
CD.Design, ob:
CD.ObPtr]
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.ObPtr]
RETURNS [where: WhereFound ← none, cell:
CD.ObPtr←
NIL, pos:
CD.DesignPosition←[0, 0], orientation:
CD.Orientation𡤀] =
BEGIN
ProtectedDrawDesign:
PROC [] =
BEGIN
ENABLE UNWIND => CDMarks.ReleaseMark[design, myMark];
CDOps.DrawDesign[design, myDrawRef !
foundAndStop, foundInFirstPlace => CONTINUE;
];
CDMarks.ReleaseMark[design, myMark ! CD.Error => GOTO exit];
EXITS
exit => TerminalIO.WriteRope["** release problem in CDErrorsImpl\n"];
END;
myDrawRef: REF CD.DrawInformation;
myDevice: REF MyDevice;
myMark: CDMarks.MarkRange;
IF IsCell[ob] THEN RETURN [where ← itself, cell ← ob];
myDrawRef ← CD.CreateDrawRef[design];
myDrawRef.interestClip ← CDBasics.universe;
myDrawRef.drawChild ← MyDrawChild;
myMark ← CDMarks.GetNewMark[design];
myDrawRef.devicePrivate ← myDevice ← NEW[MyDevice ← [searchOb: ob, mark: myMark]];
ProtectedDrawDesign[];
IF myDevice.found
THEN {
IF myDevice.cellFound
AND ~IsPushedInto[design, cell]
THEN {
r: CD.DesignRect;
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;
IncludeMessage:
PUBLIC
PROC [
design: CD.Design,
ob: CD.ObPtr,
rect: CD.DesignRect,
message: Rope.ROPE←NIL,
owner:
ATOM←
NIL]
RETURNS [done: BOOL←TRUE, into: CD.ObPtr←NIL, app: CD.ApplicationPtr←NIL] =
BEGIN
mappedRect: CD.DesignRect;
where: WhereFound;
cell: CD.ObPtr;
pos: CD.DesignPosition;
orientation: CD.Orientation;
from: Rope.ROPE ← NIL;
IF design=NIL OR ob=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;
from ← CDDirectory.Name[ob];
IF from=NIL THEN from ← CDOps.Info[ob];
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.p.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]
}
};
message ← Rope.Cat[message, " [local to ", from, "]"];
};
IF where#design
THEN {
ir: CD.DesignRect ← CD.InterestRect[cell];
clipped: CD.Rect ← CDBasics.Intersection[ir, mappedRect];
IF ~CDBasics.NonEmpty[clipped]
AND
ISTYPE[cell.specificRef,
CD.CellPtr]
THEN {
cellPtr: CD.CellPtr ← NARROW[cell.specificRef];
IF ~cellPtr.useDIr
THEN {
clipped ← CDBasics.Intersection[CDBasics.RectAt[[0, 0], cell.size], mappedRect]
}
};
IF CDBasics.NonEmpty[clipped] THEN mappedRect ← clipped ELSE mappedRect ← ir;
};
--include the error rectangle
app ←
CDX.IncludeOb[design: design,
cell: cell,
ob: CDRects.CreateRect[CDBasics.SizeOfRect[mappedRect], CD.highLightError],
position: CDBasics.BaseOfRect[mappedRect],
cellCSystem: cdCoords,
obCSystem: cdCoords,
mode: dontPropagate
].newApp;
CDOps.DelayedRedraw[design, (IF cell=NIL THEN mappedRect ELSE CDBasics.universe)];
--properties
IF owner#NIL THEN CDProperties.PutPropOnApplication[app, ownerKey, owner];
IF message#NIL THEN CDProperties.PutPropOnApplication[app, messageKey, message];
IF from#NIL THEN CDProperties.PutPropOnApplication[app, 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;
RemoveMessFromCell:
PROC [design:
CD.Design, owner:
ATOM, cell:
CD.ObPtr, removeIt: AppPredicate, 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.ApplicationList ← NIL;
countAll: INT ← 0;
countRemove: INT ← 0;
cp: CD.CellPtr ← NARROW[cell.specificRef];
--to improve, handle innerrect crap, removing and repositioning inside
FOR list:
CD.ApplicationList ← cp.contents, list.rest
WHILE list#
NIL
DO
IF IsError[list.first.ob]
THEN {
countAll ← countAll+1;
IF owner=
NIL
OR owner=CDProperties.GetPropFromApplication[list.first, ownerKey]
THEN {
IF all
OR EqualXR[
CDProperties.GetPropFromApplication[list.first, showErrorsForOtherKey],
restricted]
THEN
IF removeIt=
NIL
OR removeIt[list.first]
THEN {
countRemove ← countRemove+1;
removeList ← CONS[list.first, removeList]
}
}
}
ENDLOOP;
FOR list:
CD.ApplicationList ← removeList, list.rest
WHILE list#
NIL
DO
[] ← CDX.RemoveApp[design, cell, list.first, doit]
ENDLOOP;
IF countRemove>0 THEN CDOps.DelayedRedraw[design];
others ← countAll#countRemove;
END;
RemoveMessFromWorld:
PROC [design:
CD.Design, owner:
ATOM, removeIt: AppPredicate, restricted: Rope.
ROPE, 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
countAll: INT ← 0;
countRemove: INT ← 0;
removeList: CD.ApplicationList ← NIL;
FOR list:
CD.ApplicationList ← CDOps.AppList[design], list.rest
WHILE list#
NIL
DO
IF IsError[list.first.ob]
THEN {
countAll ← countAll+1;
IF owner=
NIL
OR owner=CDProperties.GetPropFromApplication[list.first, ownerKey]
THEN {
IF all
OR EqualXR[
CDProperties.GetPropFromApplication[list.first, showErrorsForOtherKey],
restricted]
THEN
IF removeIt=
NIL
OR removeIt[list.first]
THEN {
countRemove ← countRemove+1;
removeList ← CONS[list.first, removeList]
}
}
}
ENDLOOP;
FOR list:
CD.ApplicationList ← removeList, list.rest
WHILE list#
NIL
DO
CDOps.RemoveApplication[design, list.first]
ENDLOOP;
others ← countAll#countRemove
END;
RemoveMessages:
PUBLIC
PROC [design:
CD.Design, ob:
CD.ObPtr, owner:
ATOM, alsoOthers:
BOOL, removeIt: AppPredicate] =
BEGIN
RemoveMessFromEveryWhere:
PROC [restricted: Rope.
ROPE←
NIL]
RETURNS [others:
BOOL←
FALSE] =
BEGIN
EachEntry:
PROC [name: Rope.
ROPE, ob:
CD.ObPtr]
RETURNS [quit:
BOOL←
FALSE] =
BEGIN
IF IsCell[ob]
THEN
others ← others OR RemoveMessFromCell[design, owner, ob, removeIt, restricted];
END;
[] ← CDDirectory.Enumerate[design, EachEntry];
others ← others OR RemoveMessFromWorld[design, owner, removeIt, restricted];
END;
IF IsCell[ob] THEN [] ← RemoveMessFromCell[design, owner, ob, removeIt, NIL, alsoOthers]
ELSE
IF ob.p.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 ← RemoveMessFromWorld[design, owner, removeIt, obName]
ELSE
WITH x
SELECT
FROM
r: Rope.
ROPE => {
other: CD.ObPtr ← CDDirectory.Fetch[design, r].object;
IF other#
NIL
AND IsCell[other]
THEN
others ← RemoveMessFromCell[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: AppPredicate] =
BEGIN
EachEntry:
PROC [name: Rope.
ROPE, ob:
CD.ObPtr]
RETURNS [quit:
BOOL←
FALSE] =
BEGIN
IF IsCell[ob] THEN [] ← RemoveMessFromCell[design, owner, ob, removeIt, NIL, TRUE]
END;
[] ← CDDirectory.Enumerate[design, EachEntry];
[] ← RemoveMessFromWorld[design, owner, removeIt, NIL, TRUE];
END;
IsError:
PROC [ob:
CD.ObPtr]
RETURNS [
BOOL] =
INLINE BEGIN
RETURN [ob.layer=CD.highLightError AND ob.p.objectType=$Rect]
END;
IsCell:
PROC [ob:
CD.ObPtr]
RETURNS [
BOOL] =
INLINE BEGIN
RETURN [ob.p.objectType=$Cell]
END;
messageKey: PUBLIC ATOM ← $SignalName;
ownerKey: ATOM = $ErrorOwner;
hasErrorsInOtherCellsKey: ATOM = $showErrorsElseWhere;
showErrorsForOtherKey: ATOM = $showErrorsForOthers;
[] ← CDProperties.RegisterProperty[hasErrorsInOtherCellsKey, $many];
[] ← CDProperties.RegisterProperty[showErrorsForOtherKey, $Rope];
[] ← CDProperties.RegisterProperty[ownerKey, $ATOM];
END.