
    <<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_0, 
        cell: CD.Object_NIL,
        cellFound: BOOL_FALSE,
        cellPos: CD.Position_[0, 0],
        cellOrient: CD.Orientation_0
        ];

    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_0] =
        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.