DIRECTORY
Atom,
CD,
CDApplications,
CDCells,
CDCommands,
CDDirectory,
CDExtras,
CDInline,
CDMarks,
CDOps,
CDProperties,
IO,
Process,
Rope,
SymTab;

CDExtrasImpl: CEDAR MONITOR 
IMPORTS Atom, CD, CDApplications, CDCells, CDCommands, CDDirectory, CDInline, CDMarks, CDOps, CDProperties, IO, Process, Rope, SymTab 
EXPORTS CDExtras
SHARES CD = 
BEGIN

Skip: PUBLIC PROC[CD.Rect] = {};

DecomposeRect: PUBLIC PROC [r, test: CD.Rect, inside, outside: PROC[CD.Rect]_Skip] =
BEGIN
IF r.x1<test.x1 THEN
BEGIN
outside[[x1: r.x1, y1: r.y1, x2: MIN[r.x2, test.x1], y2: r.y2]];
IF r.x2<test.x1 THEN RETURN;
END;
IF r.y1<test.y1 THEN
BEGIN
outside[[x1: MAX[test.x1, r.x1], y1: r.y1, x2: r.x2, y2: MIN[r.y2, test.y1]]];
IF r.y2<test.y1 THEN RETURN;
END;
IF test.y2<r.y2 THEN
BEGIN
outside[[x1: MAX[test.x1, r.x1], y1: MAX[test.y2, r.y1], x2: r.x2,
y2: r.y2]];
IF test.y2<r.y1 THEN RETURN;
END;
IF test.x2<r.x2 THEN
BEGIN
outside[[x1: MAX[test.x2, r.x1], y1: MAX[test.y1, r.y1], x2: r.x2,
y2: MIN[r.y2, test.y2]]];
IF test.x2<r.x1 THEN RETURN;
END;
inside[[x1: MAX[test.x1, r.x1], y1: MAX[test.y1, r.y1],
x2: MIN[test.x2, r.x2], y2: MIN[test.y2, r.y2]]];
END;

CreateDummyObject: PUBLIC PROC[design: CD.Design] RETURNS [CD.ObPtr] =
BEGIN
cellOb: CD.ObPtr _ CDCells.CreateEmptyCell[];
cptr: CD.CellPtr _ NARROW[cellOb.specificRef];
FOR l: LIST OF CD.PushRec _ design.actual, l.rest WHILE l#NIL DO
cptr.contents _ CONS[CDApplications.NewApplicationI[l.first.dummyCell.ob], cptr.contents];
ENDLOOP;
RETURN [cellOb]
END;

Pair: TYPE = RECORD [p: CDDirectory.EnumerateObjectsProc, x: REF, key: REF];

EnumerationEnteredWhileInProgress: ERROR = CODE;
entered: BOOL_FALSE;


Enter: ENTRY PROC [] =
BEGIN
IF entered THEN RETURN WITH ERROR EnumerationEnteredWhileInProgress;
entered_TRUE;
END;

Leave: ENTRY PROC [] =
BEGIN
entered_FALSE;
END;


EnumerateChildrenObjects: PUBLIC PROC[me: CD.ObPtr, p: CDDirectory.EnumerateObjectsProc, x: REF] =
BEGIN ENABLE UNWIND => Leave[];
pair: REF Pair _ NEW[Pair];
pair^ _ [p, x, pair];
Enter[];
MyEnum[me, pair];
Leave[];
END;

MyEnum: PROC [me: CD.ObPtr, x: REF] =    
BEGIN
pair: REF Pair _ NARROW[x];
v: REF _ Atom.GetPropFromList[me.properties, $CDExtrasImplsTouched];
IF v=pair.key THEN RETURN; -- already visited
me.properties _ Atom.PutPropOnList[me.properties, $CDExtrasImplsTouched, pair.key];
IF me.p.hasChildren THEN CDDirectory.EnumerateChildObjects[me, MyEnum, x];
pair.p[me, pair.x]; -- call clients enumerator proc
END;

EnumerateDesignObjects: PUBLIC PROC [design: CD.Design, p: CDDirectory.EnumerateObjectsProc, x: REF] =
BEGIN ENABLE UNWIND => Leave[];
pair: REF Pair _ NEW[Pair];

EachCell: SymTab.EachPairAction --[key: Key, val: Val] RETURNS [quit: BOOLEAN] -- =
BEGIN
quit _ FALSE;
MyEnum[NARROW[val, CD.ObPtr], pair]
END;

pair^ _ [p, x, pair];
Enter[];
[] _ SymTab.Pairs[design.cellDirectory, EachCell];
FOR l: LIST OF CD.PushRec _ design.actual, l.rest WHILE l#NIL DO
MyEnum[l.first.dummyCell.ob, pair];
IF l.first.mightReplace#NIL THEN MyEnum[l.first.mightReplace.ob, pair];
ENDLOOP;
Leave[];
END;

BoundingBox: PUBLIC PROC [design: CD.Design] 
RETURNS [r: CD.DesignRect _ CDInline.empty] =
BEGIN
FOR l: LIST OF CD.PushRec _ design.actual, l.rest WHILE l#NIL DO
r _ CDInline.Surround[r, CDApplications.BoundingRect[
NARROW[l.first.dummyCell.ob.specificRef, CD.CellPtr].contents ]]
ENDLOOP;
END;

TrailingChar: PROC [base: Rope.ROPE, char: CHAR] RETURNS [INT] = {
len: INT _ Rope.Length[base];
pos: INT _ len;
WHILE pos > 0 DO
SELECT Rope.Fetch[base, pos _ pos - 1] FROM
char => RETURN [pos];
'!, '], '>, '/ => EXIT;
ENDCASE;
ENDLOOP;
RETURN [len];
};

AppendExt: PUBLIC PROC [name, defaultExt: Rope.ROPE] RETURNS [Rope.ROPE] =
BEGIN
bang: INT _ TrailingChar[name, '!];
result: Rope.ROPE _ name.Substr[len: bang];
dot: INT _ TrailingChar[result, '.];
IF ~Rope.IsEmpty[defaultExt] AND (dot >= Rope.Length[result]) THEN {
dot2: INT _ TrailingChar[defaultExt, '.];
IF dot2 >= Rope.Length[defaultExt] THEN result _ result.Cat[".", defaultExt]
ELSE result _ result.Concat[defaultExt.Substr[dot2]]
};
IF bang < Rope.Length[name] THEN {
result _ result.Concat[name.Substr[bang]]
};
RETURN [result]
END;

PushedCellName: PUBLIC PROC [design: CD.Design] RETURNS [Rope.ROPE] =
{RETURN [
IF design=NIL OR design.actual=NIL THEN "erronous" 
ELSE IF design.actual.rest=NIL THEN "top level"
ELSE IF design.actual.first.specific=NIL THEN "erronous"
ELSE IF design.actual.first.specific.name#NIL THEN design.actual.first.specific.name
ELSE "unnamed cell" ]
};   

RPEachChildren: CDDirectory.EnumerateObjectsProc --PROC [me: ObPtr, x: REF]-- =
BEGIN
IF ~me.p.hasChildren THEN
CDProperties.PutPropOnObject[onto: me, prop: x, val: NIL]
END;

RemoveProps: PROC [design: CD.Design, key: REF] =
BEGIN

RPEachDirectoryEntry: CDDirectory.EachEntryAction =
BEGIN 
CDProperties.PutPropOnObject[onto: ob, prop: key, val: NIL];
IF ob.p.hasChildren THEN 
CDDirectory.EnumerateChildObjects[me: ob, p: RPEachChildren, x: key] 
END;

TRUSTED{Process.SetPriority[Process.priorityBackground]};
[] _ CDDirectory.Enumerate[design: design, action: RPEachDirectoryEntry];
END;

RemoveProperties: PUBLIC PROC [design: CD.Design, key: REF] =
BEGIN
TRUSTED {Process.Detach[FORK RemoveProps[design, key]]}
END;

ToLambda: PUBLIC PROC [n: CD.Number] RETURNS [Rope.ROPE] =
BEGIN
r: Rope.ROPE _ IO.PutFR[format: " %g", v1: IO.int[n / CD.lambda]];
IF n MOD CD.lambda # 0 THEN 
r _ Rope.Cat[r, 
IO.PutFR[format: "+%g", v1: IO.int[n MOD CD.lambda]], 
IO.PutFR[format: "/%g", v1: IO.int[CD.lambda]]
] ;
RETURN [r];
END;

PopToTopLevel: PUBLIC PROC [design: CD.Design] =
BEGIN
WHILE design.actual.rest#NIL DO
IF NOT CDCells.PopFromCell[design, newcell] THEN EXIT
ENDLOOP;
IF design.actual.rest#NIL THEN ERROR
END;

Cellize: PUBLIC PROC [design: CD.Design, name: Rope.ROPE_NIL] RETURNS [cell: CD.ObPtr_NIL, pos: CD.DesignPosition] =
BEGIN
done: BOOL;
al: CD.ApplicationList;
PopToTopLevel[design];
CDCommands.SelectAll[design];
IF (al_CDOps.AppList[design])#NIL THEN {
IF al.rest=NIL AND ISTYPE[al.first.ob.specificRef, CD.CellPtr] AND al.first.orientation=CD.original THEN {
cell _ al.first.ob;
IF name#NIL THEN [] _ CDDirectory.Rename[design, cell, name];
done _ TRUE
}
ELSE {
IF name=NIL THEN name _ design.name;
IF name=NIL THEN name _ "no named design";
[done, cell] _ CDCells.CreateCellSelected[design, name];
};
IF done THEN {
pos _ CDOps.AppList[design].first.location;
}
ELSE cell _ NIL
};
CDOps.SetAppList[design, NIL]
END;

SkipAt: PROC [n: Rope.ROPE] RETURNS [Rope.ROPE] =
BEGIN
RETURN [Rope.Substr[base: n, len: Rope.SkipTo[s: n, skip: "@"]]]
END;

MergeIn: PUBLIC PROC [design: CD.Design, from: CD.Design, name: Rope.ROPE_NIL, fullDirectory: BOOL_TRUE] RETURNS [ob: CD.ObPtr_NIL, pos: CD.DesignPosition] =
BEGIN
m: CDMarks.MarkRange;
IncludeOneEntry: CDDirectory.EachEntryAction = {
IF fullDirectory OR ob.marked=m THEN {
IF NOT CDDirectory.Remove[design: from, name: name, expectObject: ob] THEN ERROR;
[] _ CDDirectory.Include[design: design, object: ob, alternateName: SkipAt[name]]
}
};  
IF design=from THEN RETURN;
IF design.technology#from.technology THEN 
RETURN WITH ERROR CD.Error[callingError, "MergIn design has different technology"];
[ob, pos] _ Cellize[from, name];
IF ob#NIL THEN {
IF ~fullDirectory THEN { 
m _ CDMarks.GetNewMark[from];
CDMarks.MarkUnMarkedInclusiveChildren[from, ob, m];
};
[] _ CDDirectory.Enumerate[design: from, action: IncludeOneEntry];
CDOps.ResetDesign[from];
}
ELSE ob _ NIL
END;

MergeInObjects: PUBLIC PROC [design: CD.Design, from: CD.Design, objects: LIST OF CD.ObPtr] =
BEGIN
m: CDMarks.MarkRange = CDMarks.GetNewMark[from];
IncludeOneEntry: CDDirectory.EachEntryAction = {
IF ob.marked=m THEN {
IF NOT CDDirectory.Remove[design: from, name: name, expectObject: ob] THEN ERROR;
[] _ CDDirectory.Include[design: design, object: ob, alternateName: SkipAt[name]]
}
};  
IF design=from THEN RETURN;
IF design.technology#from.technology THEN 
RETURN WITH ERROR CD.Error[callingError, "MergInObjects design has different technology"];
FOR l: LIST OF CD.ObPtr _ objects, l.rest WHILE l#NIL DO
CDMarks.MarkUnMarkedInclusiveChildren[from, l.first, m];
ENDLOOP;
[] _ CDDirectory.Enumerate[design: from, action: IncludeOneEntry];
CDOps.ResetDesign[from];
END;

END.





	ðCDExtrasImpl.mesa        (part of Chipndale)
by Christian Jacobi   September 8, 1983 9:45 am 
last edited by Christian Jacobi   December 8, 1983 3:47 pm
--create a dummy cell object which contains the whole design.
--On future changes of the design, the dummy object may or may not
--get obsolete.
--enumerate me and its children objects
--mark visited
--enumerate my children first
--position of last "char", only before '!, '], '>, '/ considered 
--defaultExt is appended to name, if name does not already has an extension
--copy extension
--put version number back
--RemoveProps
--tries to remove the propertiy "key" from all objects of "design";
--may be delayed or incomplete
--(only from objects, not applications...)
--if "design" is pushed in, it will be popped out, either by flushing, 
--replacing cells or creating new cells
--makes a single "cell" of of the "design", removes all applications; 
--pos: if "cell" is included at position "pos" in an empty design we would get "design" again
--if "design" is pushed in, it will be popped out, either by flushing, 
--replacing cells or creating new cells
--skip everything after and inclusive first "@"
--"from" is transfered to an object, and is included (transitive) to "design"'s directory
--"from" then may be resetted (preserving the rule: any object is in at most one directory)
--the caller is assumed to have the locks of both designs
--if "from" is pushed in, it's merged copy will be popped out, either by flushing, 
--replacing or creating new cells
--"name" replaces "from"'s design name for the new created object, but it is a hint only
--"pos": if "ob" is included at position "pos" in an empty design we would get "from" again
--"fullDirectory": whether all objects of "from"'s directory are merged to design,
--or only those used by "from"'s top level
--the "from"'s object's may change name to avoid conflicts with "design"'s directory
--ob gets nil if "from" is empty
--technologies must be compatible
--[name: Rope.ROPE, ob: CD.ObPtr] RETURNS [quit: BOOL_FALSE]--
IF ~fullDirectory THEN CDMarks.ReturnMark[from]; 
--"objects" which are in "from"'s directory are transferrerd (transitive) to "design"'s directory
--"from" then may be resetted (preserving the rule: any object is in at most one directory)
--the caller is assumed to have the locks of both designs
--the object's may change name to avoid conflicts with "design"'s directory
--technologies must be compatible
--[name: Rope.ROPE, ob: CD.ObPtr] RETURNS [quit: BOOL_FALSE]--
CDMarks.ReturnMark[from]
�Ê
�˜Jš
œ,™,Jš
œ0™0Jš
œ:™:J˜š
Ïk	˜	J˜Jš�œ
˜J˜J˜J˜J˜J˜	J˜	J˜J˜J˜
J˜J˜J˜J˜J˜—šÏbœ�œ
�œ
˜Jš�œe�œ˜†
Jš�œ	˜Jš�œ
�œ˜—Jš
�˜J˜JšÏnœ�œ
�œ
�œ˜ J˜šŸ
œ�œ
�œ�œ�œ
�œ˜TJš
�˜š�œ�˜Jš
�˜Jšœ!�œ˜@Jš�œ�œ
�œ
˜Jš�œ
˜—š�œ�˜Jš
�˜Jšœ
�œ)�œ˜NJš�œ�œ
�œ
˜Jš�œ
˜—š�œ�˜Jš
�˜šœ
�œ�œ˜BJ˜—Jš�œ�œ
�œ
˜Jš�œ
˜—š�œ�˜Jš
�˜šœ
�œ�œ˜BJšœ�œ˜—Jš�œ�œ
�œ
˜Jš�œ
˜—šœ�œ�œ˜7Jšœ�œ�œ˜1—Jš�œ
˜J˜—šŸœ�œ
�œ	�œ	�œ�œ	˜FJš
œ=™=Jš
œB™Bš
œ™Jš
�˜Jšœ�œ#˜-Jšœ�œ�œ˜.š
�œ�œ
�œ
�œ!�œ�œ
�˜@Jšœ�œF˜ZJš�œ
˜—Jš�œ	˜Jš�œ
˜J˜——Jš	œ�œ�œ*�œ�œ˜LJ˜Jšœ#�œ�œ
˜0Jšœ	�œ
�œ
˜J˜J˜šŸœ�œ
�œ˜Jš
�˜Jš
�œ	�œ
�œ
�œ
�œ#˜DJšœ�œ
˜
Jš�œ
˜J˜—šŸœ�œ
�œ˜Jš
�˜Jšœ�œ
˜Jš�œ
˜J˜J˜—š
Ÿœ�œ
�œ�œ0�œ˜bJš
œ'™'Jš�œ
�œ
�œ˜Jšœ�œ�œ˜J˜J˜J˜J˜Jš�œ
˜J˜—šŸœ�œ�œ�œ˜)Jš
�˜Jšœ�œ�œ˜Jšœ�œ>˜DJš�œ�œ
�œÏc˜-Jš
œ™J˜SJš
œ™Jš�œ�œ2˜JJšœ ˜3Jš�œ
˜J˜—š
Ÿœ�œ
�œ
�œ1�œ˜fJš�œ
�œ
�œ˜Jšœ�œ�œ˜J˜šžœ 1œ˜SJš
�˜Jšœ�œ
˜
Jšœ�œ�œ˜#Jš�œ
˜J˜—J˜J˜J˜2š
�œ�œ
�œ
�œ!�œ�œ
�˜@J˜#Jš�œ�œ
�œ'˜GJš�œ
˜—J˜Jš�œ
˜J˜—šŸœ�œ
�œ
�œ	˜-Jš�œ�œ˜-Jš
�˜š
�œ�œ
�œ
�œ!�œ�œ
�˜@˜5Jš�œ#�œ˜@—Jš�œ
˜—Jš�œ
˜J˜—šŸœ�œ
�œ�œ�œ�œ˜BJš
œA™AJšœ�œ˜Jšœ�œ˜š�œ	�˜š�œ!�˜+Jšœ�œ˜Jšœ�œ
˜Jš�œ
˜—Jš�œ
˜—Jš�œ˜
J˜J˜—šŸ	œ�œ
�œ�œ�œ�œ˜JJš
œK™KJš
�˜Jšœ�œ˜#Jšœ
�œ˜+Jšœ�œ˜$š�œ�œ�œ˜DJš
œ™Jšœ�œ ˜)Jš�œ!�œ%˜LJš�œ0˜4J˜—š�œ�œ˜"Jš
œ™Jš
œ)˜)J˜—Jš�œ	˜Jš�œ
˜—J˜š
Ÿœ�œ
�œ	�œ�œ˜Ešœ
�œ˜	Jš
�œ�œ
�œ�œ
�œ˜3Jš�œ
�œ�œ
�œ˜/Jš�œ
�œ�œ
�œ˜8Jš�œ
�œ#�œ
�œ"˜TJš�œ˜—J˜—J˜šžœ# œ˜OJš
�˜š�œ�˜Jšœ5�œ
˜9—Jš�œ
˜—J˜šŸœ�œ
�œ�œ˜1Jš
�˜J˜šžœ˜3Jš�œ
˜Jšœ7�œ˜<šœ�œ
˜Jš
œE˜E—Jš�œ
˜—J˜Jš
œ
™
Jš�œ2˜9Jš
œI˜IJš�œ
˜—J˜šŸœ�œ
�œ�œ˜=Jš
œC™CJš
œ™Jš
œ*™*Jš
�˜Jš�œ�œ˜7Jš�œ
˜—J˜šŸœ�œ
�œ�œ	�œ�œ˜:Jš
�˜Jš	œ�œ�œ�œ	�œ
˜Bš�œ�œ
�œ�œ
˜š
œ˜Jš�œ�œ�œ
�œ˜6Jš�œ�œ�œ	˜.Jš
œ˜——Jš�œ˜Jš�œ
˜—J˜šŸ
œ�œ
�œ
˜0Jš
œG™GJš
œ'™'Jš
�˜š�œ�œ
�˜Jš�œ
�œ&�œ
�˜5Jš�œ
˜—Jš�œ�œ
�œ
�˜$Jš�œ
˜J˜—šŸœ�œ
�œ�œ
�œ�œ�œ�œ�œ˜tJš
œF™FJš
œ]™]Jš
œG™GJš
œ'™'Jš
�˜Jšœ�œ
˜Jšœ�œ˜Jš
œ˜Jš
œ˜š�œ�œ
�œ˜(š�œ	�œ
�œ
�œ�œ
�œ�œ
�œ˜jJš
œ˜Jš�œ�œ
�œ-˜=Jšœ�˜J˜
—š�œ˜Jš�œ�œ
�œ˜$Jš�œ�œ
�œ˜*Jš
œ8˜8J˜—š�œ�œ˜Jš
œ+˜+J˜
—Jš�œ�˜Jš
œ˜—Jšœ�œ
˜Jš�œ
˜J˜—š
Ÿœ�œ
�œ�œ�œ˜1Jš
œ/™/Jš
�˜Jš�œ:˜@Jš�œ
˜J˜—šŸœ�œ
�œ
�œ�œ�œ
�œ�œ
�œ�œ�œ�œ�œ˜�
Jš
œY™YJš
œ[™[Jš
œ9™9Jš
œS™SJš
œ!™!Jš
œX™XJš
œ[™[Jš
œR™RJš
œ*™*Jš
œT™TJ™ Jš
œ!™!Jš
�˜Jš
œ˜šžœ!˜0Jš
œ>™>š�œ�œ
�œ˜&Jš�œ
�œ@�œ
�œ
˜QJš
œQ˜QJ˜
—Jš
œ˜—Jš�œ
�œ
�œ
˜š�œ#�œ
˜*Jš�œ
�œ
�œ
�œ?˜S—Jš
œ ˜ š�œ�œ
�œ˜š�œ�œ˜Jš
œ˜Jš
œ3˜3J˜—Jš
œB˜BJš�œ�œ™1J˜J˜
—Jš�œ�˜
Jš�œ
˜—J˜šŸœ�œ
�œ
�œ�œ�œ
�œ
�œ	˜]Jš
œa™aJš
œ[™[Jš
œ9™9Jš
œK™KJš
œ!™!Jš
�˜Jš
œ0˜0šžœ!˜0Jš
œ>™>š�œ
�˜Jš�œ
�œ@�œ
�œ
˜QJš
œQ˜QJ˜
—Jš
œ˜—Jš�œ
�œ
�œ
˜š�œ#�œ
˜*Jš�œ
�œ
�œ
�œF˜Z—š
�œ�œ
�œ
�œ�œ�œ
�˜8Jš
œ8˜8Jš
�˜—Jš
œB˜BJš
œ˜Jš
œ™Jš�œ
˜—J˜Jš�œ
˜J˜J˜J˜J˜J˜—…— 7¥