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
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] =
--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.
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] =
--enumerate me and its children objects
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
--mark visited
me.properties ← Atom.PutPropOnList[me.properties, $CDExtrasImplsTouched, pair.key];
--enumerate my children first
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] = {
--position of last "char", only before '!, '], '>, '/ considered
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] =
--defaultExt is appended to name, if name does not already has an extension
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 {
--copy extension
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 {
--put version number back
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;
--RemoveProps
TRUSTED{Process.SetPriority[Process.priorityBackground]};
[] ← CDDirectory.Enumerate[design: design, action: RPEachDirectoryEntry];
END;
RemoveProperties:
PUBLIC PROC [design:
CD.Design, key:
REF] =
--tries to remove the propertiy "key" from all objects of "design";
--may be delayed or incomplete
--(only from objects, not applications...)
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] =
--if "design" is pushed in, it will be popped out, either by flushing,
--replacing cells or creating new cells
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] =
--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
BEGIN
done: BOOL;
al: CD.ApplicationList;
PopToTopLevel[design];
CDCommands.SelectAll[design];
IF (al�Ops.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] =
--skip everything after and inclusive first "@"
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] =
--"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
BEGIN
m: CDMarks.MarkRange;
IncludeOneEntry: CDDirectory.EachEntryAction = {
--[name: Rope.ROPE, ob: CD.ObPtr] RETURNS [quit: BOOL�LSE]--
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];
IF ~fullDirectory THEN CDMarks.ReturnMark[from];
CDOps.ResetDesign[from];
}
ELSE ob ← NIL
END;
MergeInObjects:
PUBLIC
PROC [design:
CD.Design, from:
CD.Design, objects:
LIST
OF
CD.ObPtr] =
--"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
BEGIN
m: CDMarks.MarkRange = CDMarks.GetNewMark[from];
IncludeOneEntry: CDDirectory.EachEntryAction = {
--[name: Rope.ROPE, ob: CD.ObPtr] RETURNS [quit: BOOL�LSE]--
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];
CDMarks.ReturnMark[from]
END;
END.