DIRECTORY CD, CDBottomUp, CDCells, CDCommandOps, CDDirectory, CDImports, CDOps, CDProperties, CDSequencer, IO, RefTab, Rope, TerminalIO; CDFeatureCheckImpl: CEDAR PROGRAM IMPORTS CD, CDBottomUp, CDCells, CDCommandOps, CDDirectory, CDImports, CDOps, CDProperties, CDSequencer, RefTab, Rope, TerminalIO = BEGIN MsgProc: TYPE = PROC [ob: CD.Object] RETURNS [msg: Rope.ROPE_NIL]; State: TYPE = RefTab.Ref; FeatureTab: PROC [state: State] RETURNS [featureTab: RefTab.Ref] = INLINE { featureTab _ NARROW[state]; }; ReadOnlyCell: PROC [ob: CD.Object] RETURNS [readOnlyCell: CD.Object_NIL] = BEGIN readOnlyCell _ ob; WHILE ob#NIL AND ob.class.inDirectory AND ~CDCells.IsCell[ob] DO readOnlyCell _ CDDirectory.Expand[ob, NIL, NIL, FALSE].new; IF readOnlyCell=ob OR readOnlyCell=NIL THEN readOnlyCell _ CDDirectory.ExpandByDraw[ob]; ob _ readOnlyCell; ENDLOOP; END; CheckClass: PROC [ob: CD.Object] RETURNS [msg: Rope.ROPE_NIL] = BEGIN WITH CDProperties.GetObjectProp[ob, $CDFeatureCheck] SELECT FROM mp: REF MsgProc => RETURN [mp[ob]]; r: Rope.ROPE => RETURN [r]; ENDCASE => WITH CDProperties.GetProp[ob.class, $CDFeatureCheck] SELECT FROM mp: REF MsgProc => RETURN [mp[ob]]; ENDCASE => RETURN [NIL] END; BadLayer: PROC [ob: CD.Object] RETURNS [msg: Rope.ROPE] = { msg _ Rope.Cat["layer ", CDOps.LayerRope[ob.layer], " used in ", CDOps.ObjectRope[ob]] }; CheckContainer: PROC [state: State, ob: CD.Object] RETURNS [msg: Rope.ROPE _ NIL] = BEGIN recurse: BOOL_FALSE; mustCheckLayer: BOOL_FALSE; layerFound: BOOL_FALSE; CheckRef: PROC [val: REF] = BEGIN IF val=NIL THEN { IF ~ob.class.inDirectory AND ~ob.class.symbolic THEN { IF recurse OR (val_RefTab.Fetch[FeatureTab[state], $CDFeatureCheckOthers].val)#NIL THEN msg _ Rope.Cat["class not enabled: ", CDOps.ObjectRope[ob]] ELSE {recurse _ TRUE; CheckRef[val]} }; } ELSE WITH val SELECT FROM a: ATOM => { IF a=$T THEN layerFound _ TRUE ELSE IF a=CD.LayerKey[ob.layer] THEN layerFound _ TRUE ELSE mustCheckLayer _ TRUE }; lora: LIST OF REF ANY => FOR l: LIST OF REF ANY _ lora, l.rest WHILE (l#NIL AND msg=NIL) DO CheckRef[l.first]; ENDLOOP; loa: LIST OF ATOM => {layerKey: ATOM ~ CD.LayerKey[ob.layer]; FOR ll: LIST OF ATOM _ loa, ll.rest WHILE ll#NIL DO IF layerKey=ll.first OR ll.first=$T THEN {layerFound _ TRUE; EXIT}; ENDLOOP; mustCheckLayer _ TRUE; }; mp: REF MsgProc => msg _ mp[ob]; rp: REF CD.Rect => { sz: CD.Position _ CD.InterestSize[ob]; IF sz.xrp.x2 OR sz.y>rp.y2 THEN msg _ Rope.Cat[CDOps.ObjectRope[ob], " too large"]; }; r: Rope.ROPE => IF ~Rope.IsEmpty[r] THEN msg _ Rope.Cat[CDOps.ObjectRope[ob], " ", r]; ENDCASE => msg _ Rope.Cat["class forbidden: ", CDOps.ObjectRope[ob]]; END; CheckRef[RefTab.Fetch[FeatureTab[state], ob.class.objectType].val]; IF Rope.IsEmpty[msg] AND mustCheckLayer AND ~layerFound THEN msg _ BadLayer[ob]; IF Rope.IsEmpty[msg] THEN msg _ CheckClass[ob]; IF Rope.IsEmpty[msg] THEN msg _ NIL; END; CheckTopChilds: PROC [state: State, ob: CD.Object] RETURNS [msg: Rope.ROPE _ NIL] = BEGIN cnt: INT _ 0; ob1: CD.Object _ ReadOnlyCell[ob]; IF ob1=NIL THEN msg _ "failed to expand" ELSE { EachInst: CDCells.InstEnumerator = { IF ~inst.ob.class.inDirectory THEN { msg1: Rope.ROPE _ CheckContainer[state, inst.ob]; IF msg1#NIL THEN { cnt _ cnt+1; IF cnt<4 THEN msg _ Rope.Cat[msg, "\n | ", msg1] ELSE IF cnt=4 THEN msg _ Rope.Cat[msg, "\n |"] ELSE msg _ Rope.Cat[msg, "|"] }; } }; [] _ CDCells.EnumerateInstances[ob1, EachInst]; }; END; CheckOneLevel: PROC [state: State, ob: CD.Object] RETURNS [msg: Rope.ROPE _ NIL] = BEGIN msg _ CheckContainer[state, ob]; IF Rope.IsEmpty[msg] THEN msg _ CheckTopChilds[state, ob]; END; DoExt: CDBottomUp.DoProc = BEGIN msg: Rope.ROPE _ NIL; IF CDImports.IsImport[ob] THEN { ip: CDImports.ImportSpecific _ NARROW[ob.specific]; IF ip.boundInstance#NIL THEN [] _ handle.DoRecurse[ip.boundInstance.ob] ELSE msg _ "not bound"; }; TerminalIO.PutRopes["checking ", CDOps.ObjectRope[ob]]; IF msg=NIL THEN msg _ CheckOneLevel[NARROW[handle.data], ob]; IF msg=NIL THEN TerminalIO.PutRope[" ok\n"] ELSE { handle.cnt _ handle.cnt+1; TerminalIO.PutRopes["\n ** ", msg, "\n"] }; val _ msg; IF handle.design#NIL THEN CDSequencer.CheckAborted[handle.design]; END; ReUseExt: CDBottomUp.ReUseProc = BEGIN TerminalIO.PutRopes["previously checked ", CDOps.ObjectRope[ob]]; WITH previousVal SELECT FROM r: Rope.ROPE => { handle.cnt _ handle.cnt+1; TerminalIO.PutRopes["\n ** ", r, "\n"] }; ENDCASE => TerminalIO.PutRope[" ok\n"]; IF handle.design#NIL THEN CDSequencer.CheckAborted[handle.design]; END; HierarchicalFeatureCheckComm: PROC [comm: CDSequencer.Command] = BEGIN HierarchicalFeatureCheck: PROC [featureChecker: CDBottomUp.Class, design: CD.Design, state: RefTab.Ref, ob: CD.Object] = BEGIN h: CDBottomUp.Handle _ CDBottomUp.StartRecurse[featureChecker, design, ob, state].handle; IF h.cnt=0 THEN TerminalIO.PutRope["no errors found\n"] ELSE TerminalIO.PutF1["error(s) found in %g object(s)\n", [integer[h.cnt]]] END; inst: CD.Instance _ CDOps.TheInstance[comm.design, "hierarchical feature checking"]; IF inst#NIL THEN { IF ~inst.ob.class.inDirectory THEN { TerminalIO.PutRopes[" object not composed\n"]; RETURN }; WITH CDProperties.GetAtomProp[$CDFeatureCheck, $CDFeatureCheck] SELECT FROM rt: RefTab.Ref => { featureChecker: CDBottomUp.Class; key: REF _ rt.Fetch[$CDFeatureCheckKey].val; text: Rope.ROPE _ CDOps.ToRope[rt.Fetch[$CDFeatureCheckName].val]; IF key=NIL THEN key_NEW[INT]; TerminalIO.PutRopes["feature set used: [", text, "]\n"]; IF ISTYPE[key, ATOM] THEN TerminalIO.PutRopes[" [ key = ", CDOps.ToRope[key], " ]\n"]; featureChecker _ CDBottomUp.Register[DoExt, ReUseExt, key, $CDFeatureCheck ! CD.Error => GOTO oops]; HierarchicalFeatureCheck[featureChecker, comm.design, rt, inst.ob]; }; ENDCASE => TerminalIO.PutRope[" no feature table is assigned\n"] } EXITS oops => TerminalIO.PutRope[" failed to read parameters from atom\n"] END; CDCommandOps.RegisterWithMenu[menu: $ProgramMenu, entry: "Feature checking", doc: "needs commandfile be previously set up", proc: HierarchicalFeatureCheckComm, key: $HFCheck]; END. ”CDFeatureCheckImpl.mesa Copyright c 1986 by Xerox Corporation. All rights reserved. Created by Christian Jacobi, December 12, 1985 2:19:57 pm PST Last edited by: Christian Jacobi, October 30, 1986 1:55:06 pm PST This tool allows the user to check whether certain features are used or not. It can be used as a mean for subclassing technologies. --this is independent of particular design rules ΚΟ˜codešœ™Kšœ Οmœ1™˜E—Kšžœ˜—K˜KšœC˜CKšžœžœžœ žœ˜PKšžœžœ˜/Kšžœžœžœ˜$Kšžœ˜—K˜š  œžœžœ žœ žœžœ˜SKšž˜Kšœžœ˜ Kšœžœ˜"Kšžœžœžœ˜(šžœ˜š œ˜$šžœžœ˜$Kšœ žœ"˜1šžœžœžœ˜Kšœ ˜ Kšžœžœ%˜2Kšžœžœžœ˜0Kšžœ˜K˜—K˜—Kšœ˜—Kšœ/˜/K˜—Kšžœ˜—K˜š   œžœžœ žœ žœžœ˜RKšž˜Kšœ ˜ Kšžœžœ!˜:Kšžœ˜—K˜šŸœ˜Kšž˜Kšœ ž œ˜šžœžœ˜ Kšœžœ˜3Kšžœžœžœ+˜GKšžœ˜K˜—Kšœ7˜7Kšžœžœžœžœ˜=Kšžœžœžœ˜,šžœ˜Kšœ˜Kšœ*˜*K˜—Kšœ ˜ Kšžœžœžœ)˜BKšžœ˜—K˜šŸœ˜ Kšž˜KšœA˜Ašžœ žœž˜šœžœ˜Kšœ˜Kšœ(˜(K˜—Kšžœ!˜(—Kšžœžœžœ)˜BKšžœ˜—K˜šΠbnœžœ˜@Kšž˜K˜š œžœ,žœ žœ ˜xKšž˜KšœY˜YKšžœ žœ(˜7KšžœG˜KKšžœ˜—K˜KšœžœL˜Tšžœžœžœ˜šžœžœ˜$Kšœ/˜/Kšž˜K˜—šžœ<žœž˜K˜Kšœ!˜!Kšœžœ$˜,Kšœ žœ3˜BKš žœžœžœžœžœ˜Kšœ8˜8šžœžœžœžœ˜Kšœ@˜@—šœK˜KKšœžœ žœ˜—KšœC˜CK˜—Kšžœ:˜A—K˜—KšžœF˜KKšžœ˜—K˜K˜Kšœ―˜―Kšžœ˜K˜—…—"{