ViewRecCreate.Mesa
last edited by Spreitzer April 25, 1986 6:15:27 pm PST
Last Edited by: Maxwell, November 16, 1982 3:29 pm
DIRECTORY AMBridge, AMTypes, Atom, Buttons, Containers, Icons,
IO, Labels, MJSContainers, PrintTV, Process, ProcessProps, Real, Rope, Rules, TypeProps, VFonts, ViewerClasses, ViewerLocks, ViewerOps, ViewerTools, ViewRec, ViewRecInsides;
ViewRecCreate:
CEDAR
PROGRAM
IMPORTS AMBridge, AMTypes, Atom, Buttons, Containers, Icons, IO, Labels, MJSContainers, PrintTV, Process, ProcessProps, Real, Rope, Rules, TypeProps, ViewerLocks, ViewerOps, VFonts, ViewerTools, ViewRec, ViewRecInsides
EXPORTS ViewRec, ViewRecInsides =
BEGIN OPEN VF: VFonts, VT: ViewerTools, VO: ViewerOps, ViewRecInsides;
RecordViewer: TYPE = REF RecordViewerPrivate;
RecordViewerPrivate: PUBLIC TYPE = ViewRecInsides.RecordViewerPrivate;
nameStyles: PUBLIC NameStyles;
myIconFlavors: ARRAY [0..2] OF Icons.IconFlavor;
ecHandlerProp: PUBLIC ATOM ← Atom.MakeAtom["Mike Spreitzer December 12, 1983 6:16 pm"];
gtHandlerProp: PUBLIC ATOM ← Atom.MakeAtom["Mike Spreitzer December 12, 1983 6:17 pm"];
befores: PUBLIC ARRAY Reductions OF RList ← ALL[NIL];
afterAlls: PUBLIC RList ← NIL;
classRecers: PUBLIC ARRAY AMTypes.Class OF RList ← ALL[NIL];
evClass: ViewerClasses.ViewerClass;
rvClass: MJSContainers.MJSContainerClass;
RegisterRecognizerByType:
PUBLIC
PROC [r: Recognizer, end: AddPlace, type: Type
--unreduced--, reductions: Reductions] =
BEGIN
IF reductions # EquivalenceClass THEN type ← AMTypes.GroundStar[type];
IF reductions = TypeClass
THEN
BEGIN
tc: AMTypes.Class ← AMTypes.TypeClass[type];
classRecers[tc] ← AddToList[classRecers[tc], r, end];
END
ELSE
BEGIN
hp: ATOM ← IF reductions = StripSubranges THEN gtHandlerProp ELSE ecHandlerProp;
rl: RList ← NARROW[TypeProps.Get[type: type, key: hp]];
rl ← AddToList[rl, r, end];
TypeProps.Put[type: type, key: hp, val: rl];
END;
END;
RegisterRecognizerBeforeReductions:
PUBLIC
PROC [r: Recognizer, end: AddPlace, applyBefore: Reductions] =
BEGIN
befores[applyBefore] ← AddToList[befores[applyBefore], r, end];
END;
RegisterRecognizerToApplyAfterAll:
PUBLIC
PROC [r: Recognizer, end: AddPlace] =
BEGIN
afterAlls ← AddToList[afterAlls, r, end];
END;
AddToList:
PROC [rl: RList, r: Recognizer, end: AddPlace]
RETURNS [new: RList] =
BEGIN
IF end = Front THEN RETURN [CONS[r, rl]];
IF rl = NIL THEN RETURN [LIST[r]];
new ← rl;
WHILE rl.rest # NIL DO rl ← rl.rest ENDLOOP;
rl.rest ← LIST[r];
END;
DoBindings:
PROC [obj: TypedVariable, type: Type, bl: BindingList] =
BEGIN
index: TypedVariable;
len: CARDINAL;
vt, ut: Type;
tc: AMTypes.Class ← AMTypes.TypeClass[type];
SELECT tc
FROM
record, structure =>
BEGIN
len ← AMTypes.NComponents[type];
END;
sequence =>
BEGIN
index ← AMTypes.First[AMTypes.TVType[AMTypes.Tag[obj]]];
len ← AMTypes.Length[obj];
vt ← AMTypes.Range[type];
ut ← AMTypes.GroundStar[vt];
END;
array =>
BEGIN
dt: Type ← AMTypes.Domain[type];
index ← AMTypes.First[dt];
len ← NElts[dt];
END;
ENDCASE => ERROR NotAnAggregate;
FOR i:
CARDINAL
IN [1 .. len]
DO
var, val: TypedVariable;
name: ROPE;
sublist: BindingList;
inList, dontAssign: BOOLEAN;
SELECT tc
FROM
record, structure =>
BEGIN
var ← AMTypes.IndexToTV[obj, i];
vt ← AMTypes.IndexToType[type, i];
ut ← AMTypes.GroundStar[vt];
name ← AMTypes.IndexToName[type, i];
END;
sequence, array =>
BEGIN
s: IO.STREAM ← IO.ROS[];
IF i > 1 THEN index ← AMTypes.Next[index];
var ← AMTypes.Apply[mapper: obj, arg: index];
PrintTV.Print[index, s];
name ← s.RopeFromROS[];
END;
ENDCASE => ERROR;
[sublist, , val, inList, , , dontAssign, ,] ← SelectBindings[bl, name, i];
IF inList
THEN
BEGIN
IF
NOT dontAssign
THEN
BEGIN
c: TypedVariable;
c ← AMTypes.Coerce[val, vt];
AMTypes.Assign[var, val];
END;
END
ELSE
IF sublist #
NIL
THEN
SELECT AMTypes.TypeClass[ut]
FROM
record, structure, sequence, array => DoBindings[var, ut, sublist];
ENDCASE => ERROR;
ENDLOOP;
END;
FillInDefaultFields:
PROC [tv: TypedVariable, type: Type] =
BEGIN
n: CARDINAL ← AMTypes.NComponents[type];
FOR i:
CARDINAL
IN [1..n]
DO
div: TypedVariable ← NIL;
div ← AMTypes.IndexToDefaultInitialValue[type, i !AMTypes.Error => {div ← NIL; CONTINUE}];
IF div #
NIL
THEN
BEGIN
field: TypedVariable ← AMTypes.IndexToTV[tv, i];
AMTypes.Assign[lhs: field, rhs: div];
END;
ENDLOOP;
END;
GetName:
PUBLIC
PROC [tv: TypedVariable]
RETURNS [name:
ROPE] =
BEGIN
type: Type ← AMTypes.UnderType[AMTypes.TVType[tv]];
class: AMTypes.Class ← AMTypes.TypeClass[type];
name ← NIL;
SELECT class
FROM
record, structure =>
BEGIN
ok: BOOLEAN ← TRUE;
index: CARDINAL;
index ← AMTypes.NameToIndex[type, "name" !AMTypes.Error => {ok ← FALSE; CONTINUE}];
IF ok
THEN
BEGIN
nameTV: TypedVariable ← AMTypes.IndexToTV[tv, index];
name ← AMTypes.TVToName[nameTV !AMTypes.Error => {ok ← FALSE; CONTINUE}];
IF NOT ok THEN name ← NIL;
END;
END;
ENDCASE;
END;
wFudge: INTEGER ← 0;
ViewTV:
PUBLIC
PROC [agg: TypedVariable,
specs: ViewRec.BindingList ← NIL,
label: Rope.ROPE ← NIL,
otherStuff: OtherStuffProc ← NIL,
toButt: ButtonClick ← [],
parent: RecordViewer ← NIL,
asElement: EltHandle ← NIL,
sample: BOOLEAN ← TRUE,
createOptions: CreateOptions ← [],
viewerInit: ViewerClasses.ViewerRec ← [],
wDir: ROPE ← NIL,
paint: BOOLEAN ← TRUE]
RETURNS [rv: RecordViewer] =
BEGIN
NewProcedure:
PROC [pt: Type, p: TypedVariable, name:
ROPE, hasDom, hasRange:
BOOLEAN, argSpecs, retSpecs: BindingList]
RETURNS [Viewer] =
BEGIN
pd: ProcData ← NEW [EltDataRec[Proc]];
pco: CreateOptions ← createOptions;
dt: Type ← AMTypes.Domain[pt];
rt: Type ← AMTypes.Range[pt];
pco.feedBackHeight ← 0;
pco.mayInitiateRelayout ← FALSE;
pd.name ← name;
pd.domainInst ← AMTypes.New[dt];
IF hasDom THEN FillInDefaultFields[pd.domainInst, dt];
pd.sampleable ← FALSE;
pd.var ← pd.old ← NIL;
pd.proc ← p;
pd.parent ← d;
pd.prev ← d.last;
d.last ← pd;
pd.variable ← FALSE;
pd.update ← ProcUpdate;
pd.hasDom ← hasDom;
pd.hasRet ← hasRange;
pd.argret ← Containers.Create[paint:
FALSE,
info: [parent: d.argContainer, scrollable:
TRUE, border:
FALSE,
wx: nowhere, ww: d.argContainer.cw, wh: 10, name: name]];
d.argretScrollDiffX ← pd.argret.ww - pd.argret.cw;
IF
NOT createOptions.holdOff
THEN
BEGIN
pd.doitButton ← Buttons.Create[paint:
FALSE,
font: ViewRec.RightFont[createOptions.doitFont],
proc: InnerProcButtonProc, clientData: pd,
info: [parent: pd.argret, border: createOptions.bordDoit,
name: Rope.Cat["Do ", name]] ];
pd.stateLabel ← Labels.Create[paint:
FALSE,
font: ViewRec.RightFont[createOptions.stateFont],
info: [parent: pd.argret, border: createOptions.bordState,
wx: pd.doitButton.wx + pd.doitButton.ww + createOptions.hSep,
name: "working on old"]];
Labels.Set[label: pd.stateLabel, value: "", paint: FALSE];
END;
pd.container ← Buttons.Create[paint:
FALSE,
font: ViewRec.RightFont[
IF hasDom
OR hasRange
THEN createOptions.preProcFont
ELSE createOptions.immProcFont],
proc: ProcButtonProc, clientData: pd,
info: [parent: d.eltsContainer,
name: name,
border:
IF hasDom
OR hasRange
THEN createOptions.bordPreProcs
ELSE createOptions.bordImmProcs]];
IF hasDom
THEN
BEGIN
pd.argRV ← ViewTV[agg: pd.domainInst,
specs: argSpecs,
toButt: [pd.doitButton],
parent: rv, sample: FALSE,
createOptions: pco,
viewerInit: [parent: pd.argret, wy: 0, ww: pd.argret.cw, border: FALSE, scrollable: FALSE, name: "args"],
paint: FALSE];
pd.argRV.edParent ← pd;
END
ELSE
BEGIN
IF AMTypes.TypeClass[dt] # nil
THEN
DoBindings[pd.domainInst, dt, argSpecs];
END;
pd.retInst ← AMTypes.New[rt];
IF pd.hasRet
THEN
BEGIN
IF hasDom
THEN
BEGIN
pd.rule ← Rules.Create[paint:
FALSE,
info: [parent: pd.argret, wx: 0, wy: 0, ww: 1023, wh: 1, border: FALSE]];
END;
pd.retRV ← ViewTV[agg: pd.retInst,
specs: retSpecs,
parent: rv, sample: FALSE,
createOptions: pco,
viewerInit: [parent: pd.argret, ww: pd.argret.cw, wy: 0, border: FALSE, scrollable: FALSE, name: "rets"],
paint: FALSE];
pd.retRV.edParent ← pd;
END;
IF pd.hasRet
OR hasDom
THEN
BEGIN
FinishProc[pd, d];
argH ← MAX[argH, pd.argret.wh];
argretWidth ← MAX[argretWidth, pd.argret.ww];
argumentive ← TRUE;
END
ELSE
BEGIN
VO.DestroyViewer[viewer: pd.argret, paint: FALSE];
pd.argret ← NIL;
END;
RETURN [pd.container];
END;
NewSimple:
PROC [tt, wt: Type, sv: TypedVariable, handler: SimpleHandler, name:
ROPE, editable:
BOOLEAN, notifies: NotifyList, handlerData:
REF
ANY]
RETURNS [v: Viewer] =
BEGIN
mx, diff: INTEGER;
askLines: REAL;
sd: SimpleData ← NEW [EltDataRec[Simple]];
ut: Type ← AMTypes.UnderType[tt];
sd.container ← v ←
VO.CreateViewer[flavor: $EltViewer, paint:
FALSE,
info: [parent: d.eltsContainer, name: name, data: sd, ww: 20, wh: 20, border: createOptions.bordElts]];
diff ← v.ww - v.cw;
sd.name ← name;
sd.var ← sv;
sd.sampleable ← TRUE;
sd.old ← AMTypes.Copy[sd.var];
sd.handler ← handler;
sd.handlerData ← handlerData;
sd.wideAsTV ← AMTypes.New[wt];
sd.targType ← tt;
sd.variable ← editable AND AMTypes.TVStatus[sv] = mutable AND handler.Parse # NIL;
sd.notifyRequests ← notifies;
sd.ToRope ← SimpleToRope;
sd.AssignRope ← SimpleAssignRope;
sd.typeDoc ← TellType[tt, ut];
sd.parent ← d;
sd.prev ← d.last;
d.last ← sd;
sd.update ← UpdateNV;
sd.nameButton ← Buttons.Create[paint:
FALSE,
proc: NVButtonProc,
clientData: sd,
info: [parent: v, name: name.Concat[":"], border:
FALSE,
wy: MAX[createOptions.vStilts, 0]],
font: ViewRec.RightFont[createOptions.nameFont]];
mx ← sd.nameButton.wx + sd.nameButton.ww + createOptions.nvSep;
[sd.askW, askLines] ← handler.Max[sv, tt, handlerData];
sd.valueText ←
VO.CreateViewer[flavor: $Text, paint:
FALSE,
info: [parent: v, border:
FALSE, scrollable: askLines > 1,
wx: mx,
wy: MAX[-createOptions.vStilts, 0],
ww: MIN[sd.askW + d.hPad + wFudge, placing.targetWidth - diff - mx],
wh: Real.RoundI[askLines*VF.FontHeight[]+createOptions.vPad] ]];
VO.AddProp[viewer: sd.valueText, prop: $EltData, val: sd];
VT.InhibitUserEdits[sd.valueText];
VO.MoveViewer[viewer: v, x: v.wx, y: v.wy,
w: diff + sd.valueText.wx + sd.valueText.ww,
h: (v.wh - v.ch) +
MAX[
sd.nameButton.wy+sd.nameButton.wh,
sd.valueText.wy + sd.valueText.wh],
paint: FALSE];
SetRope[sd, SimpleToRope[sd], FALSE];
ShowState[sd, FALSE];
END;
TellType:
PROC [tt, ut: Type]
RETURNS [td:
ROPE] =
BEGIN
t2: ROPE;
s: IO.STREAM ← IO.ROS[];
PrintTV.PrintType[tt, s];
td ← s.RopeFromROS[];
IF AMTypes.TypeClass[tt] # definition THEN RETURN;
s ← IO.ROS[];
PrintTV.PrintType[ut, s];
t2 ← s.RopeFromROS[];
IF NOT Rope.Equal[td, t2] THEN td ← td.Cat["=", t2];
END;
NewComplex:
PROC [tt, ut: Type, cv: TypedVariable, handler: ComplexHandler, name:
ROPE, bindings: BindingList, editable:
BOOLEAN, notifies: NotifyList, handlerData:
REF
ANY]
RETURNS [v: Viewer] =
BEGIN
cd: ComplexData ← NEW [EltDataRec[Complex]];
cco: CreateOptions ← createOptions;
cco.feedBackHeight ← 0;
cco.mayInitiateRelayout ← FALSE;
cd.name ← name;
cd.handler ← handler;
cd.handlerData ← handlerData;
[v, cd.clientData, cd.sampleable] ← handler.producer[cv, [main: d.eltsContainer, for: rv, maxWidth: placing.targetWidth, name: name, thisElement: cd, createOptions: cco, notifies: notifies, bindings: bindings, toButt: toButt], handlerData];
cd.container ← v;
IF v = NIL THEN RETURN;
VO.AddProp[viewer: v, prop: $EltData, val: cd];
cd.sampleable ← cd.sampleable AND handler.updater # NIL;
cd.update ← UpdateComplex;
cd.var ← cv;
IF cd.sampleable THEN cd.old ← AMTypes.Copy[cd.var] ELSE cd.old ← NIL;
cd.notifyRequests ← notifies;
cd.variable ← editable AND AMTypes.TVStatus[cv] = mutable;
cd.typeDoc ← TellType[tt, ut];
cd.parent ← d;
cd.prev ← d.last;
d.last ← cd;
END;
aggsType: Type ← AMTypes.UnderType[AMTypes.TVType[agg]];
aggsClass: AMTypes.Class ← AMTypes.TypeClass[aggsType];
len: CARDINAL;
placing: Placing ← NEW [PlacingRep ← [createOptions.hSep, createOptions.vSep, 0, 0]];
argH: INTEGER ← 0;
argretWidth: INTEGER ← 0;
argumentive: BOOLEAN ← FALSE;
d: RecordViewer;
index: TypedVariable;
rv ← d ← NEW [RecordViewerPrivate ← []];
viewerInit.data ← d;
d.wDir ←
IF wDir #
NIL
THEN wDir
ELSE
WITH ProcessProps.GetProp[$WorkingDirectory]
SELECT
FROM
r: ROPE => r,
ENDCASE => NIL;
d.toButt ← toButt;
d.edParent ← NARROW[asElement];
d.exclusiveProcs ← createOptions.exclusiveProcs;
d.holdOff ← createOptions.holdOff;
d.highlightSelectedProc ← createOptions.highlightSelectedProc;
d.relayoutable ← createOptions.relayoutable;
d.mayInitiateRelayout ← createOptions.mayInitiateRelayout;
d.hSep ← createOptions.hSep;
d.vSep ← createOptions.vSep;
d.nvSep ← createOptions.nvSep;
d.hPad ← createOptions.hPad;
d.maxEltsHeight ← createOptions.maxEltsHeight;
d.minFeedBackWidth ← createOptions.minFeedBackWidth;
d.feedBackHeight ← createOptions.feedBackHeight;
SELECT aggsClass
FROM
record, structure, sequence, array => NULL;
ENDCASE => ERROR ViewRec.NotAnAggregate;
IF viewerInit.name = NIL THEN viewerInit.name ← GetName[agg];
d.targetWidth ← viewerInit.ww;
IF viewerInit.parent = NIL THEN viewerInit.ww ← 0;
IF viewerInit.icon = unInit
THEN
viewerInit.icon ← myIconFlavors[
SELECT
VF.StringWidth[viewerInit.name]
FROM
< 75 => 0,
< 150 => 1,
ENDCASE => 2];
d.v ← MJSContainers.Create[viewerFlavor: $RecordViewer, paint: FALSE, info: viewerInit];
d.curWW ← d.v.ww;
d.outerScrollDiffX ← d.v.ww - d.v.cw;
d.eltsContainer ← Containers.Create[paint: FALSE, info: [parent: d.v, border: FALSE, scrollable: TRUE, ww: d.v.cw, wh: 10, name: "Elements"]];
d.eltsScrollDiffX ← d.eltsContainer.ww - d.eltsContainer.cw;
d.targetWidth ←
IF d.v.parent = NIL AND NOT d.v.iconic THEN d.v.ww
ELSE IF d.targetWidth # 0 THEN d.targetWidth
ELSE createOptions.defaultTargetWidth;
placing.targetWidth ← d.targetWidth - (d.outerScrollDiffX + d.eltsScrollDiffX);
d.argContainer ← Containers.Create[paint:
FALSE,
info: [parent: d.v, wx: 0, wy: 0, ww: (d.targetWidth - d.outerScrollDiffX), wh: 10,
border: FALSE, scrollable: FALSE, name: "Preparations"]];
d.prepsDiffX ← d.argContainer.ww - d.argContainer.cw;
d.maxArgretHeight ← createOptions.maxArgsHeight - (d.argContainer.wh - d.argContainer.ch);
IF label.Length[] > 0
THEN
BEGIN
fnr: BOOLEAN ← FALSE;
IF label.Fetch[label.Length[] - 1] = '\n
THEN
BEGIN
label ← label.Substr[len: label.Length[] - 1];
fnr ← TRUE;
END;
Place[placing, d.label ← Labels.Create[paint:
FALSE,
info: [name: label, parent: d.eltsContainer, border: FALSE],
font: ViewRec.RightFont[createOptions.labelFont] ]];
placing.forceNewRow ← d.loneLabel ← fnr;
END;
IF otherStuff #
NIL
THEN
BEGIN
stuff: LIST OF Viewer ← d.otherStuff ← otherStuff[d.eltsContainer];
WHILE stuff # NIL DO Place[placing, stuff.first]; stuff ← stuff.rest ENDLOOP;
END;
SELECT aggsClass
FROM
record, structure => len ← AMTypes.NComponents[aggsType];
sequence =>
BEGIN
tag: TypedVariable ← AMTypes.Tag[agg];
index ← AMTypes.First[AMTypes.TVType[tag]];
len ← AMTypes.Length[agg];
END;
array =>
BEGIN
dt: Type ← AMTypes.Domain[aggsType];
index ← AMTypes.First[dt];
len ← NElts[dt];
END;
ENDCASE => ERROR;
FOR i:
CARDINAL
IN [1..len]
DO
GetComponent:
PROC =
{
SELECT aggsClass
FROM
record, structure =>
BEGIN
v ← AMTypes.IndexToTV[agg, i];
name ← AMTypes.IndexToName[aggsType, i];
END;
sequence, array =>
BEGIN
s: IO.STREAM ← IO.ROS[];
IF i > 1 THEN {IF (index ← AMTypes.Next[index]) = NIL THEN ERROR};
v ← AMTypes.Apply[mapper: agg, arg: index];
PrintTV.Print[index, s];
name ← s.RopeFromROS[];
END;
ENDCASE => ERROR};
v: TypedVariable;
iType: Type;
cType: Type;
cClass: AMTypes.Class;
name: ROPE;
val: TypedVariable;
sublist, altSublist: BindingList;
inList, visible, editable, dontAssign: BOOLEAN;
notifies: NotifyList;
recers: RList;
GetComponent[];
IF v = NIL THEN LOOP;
IF name.Length[] = 0 THEN name ← "anonymous";
iType ← AMTypes.TVType[v];
cType ← AMTypes.GroundStar[iType];
cClass ← AMTypes.TypeClass[cType];
[sublist, altSublist, val, inList, visible, editable, dontAssign, notifies, recers] ← SelectBindings[specs, name, i];
IF inList
THEN
BEGIN
IF
NOT dontAssign
THEN
BEGIN
c: TypedVariable;
c ← AMTypes.Coerce[val, iType];
AMTypes.Assign[v, c];
END;
END;
IF
NOT (inList
AND
NOT visible)
THEN
BEGIN
recognized: BOOLEAN;
handler, handlerData: REF ANY;
[recognized, handler, handlerData] ← Recognize[t: iType, specials: recers, onlyRecognize: FALSE, specs: sublist, createOptions: createOptions];
IF recognized
THEN
WITH handler
SELECT
FROM
sh: SimpleHandler =>
BEGIN
Place[placing, NewSimple[iType, cType, v, sh, name, editable, notifies, handlerData]];
END;
ch: ComplexHandler =>
BEGIN
sv: Viewer ← NewComplex[iType, AMTypes.UnderType[iType], v, ch, name, sublist, editable, notifies, handlerData];
IF sv # NIL THEN Place[placing, sv];
END;
ENDCASE => ERROR
ELSE
SELECT cClass
FROM
procedure =>
BEGIN
ok, hasDom, hasRange: BOOLEAN;
[ok, hasDom, hasRange] ← OKProc[cType, sublist, altSublist, createOptions];
IF ok THEN Place[placing, NewProcedure[cType, v, name, hasDom, hasRange, sublist, altSublist]];
END;
ENDCASE;
END;
ENDLOOP;
FOR e: EltData ← d.last, e.prev
WHILE e #
NIL
DO
IF e.prev # NIL THEN e.prev.next ← e ELSE d.first ← e;
ENDLOOP;
IF argumentive
THEN
BEGIN
d.rule1 ← Rules.Create[paint:
FALSE,
info: [parent: d.v, wx: 0, wy: 0, ww: 1023, wh: 1, border: FALSE]];
END
ELSE
BEGIN
VO.DestroyViewer[viewer: d.argContainer, paint: FALSE];
d.argContainer ← NIL;
END;
IF createOptions.feedBackHeight > 0
THEN
BEGIN
d.rule2 ← Rules.Create[paint:
FALSE,
info: [parent: d.v, wx: 0, wy: 0, wh: 1, ww: 1023, border: FALSE]];
d.feedBack ←
VT.MakeNewTextViewer[paint:
FALSE, info: [
parent: d.v, name: "FeedBack", border: FALSE,
wx: 0, wy: 0, ww: 50, wh: 20]];
VT.InhibitUserEdits[d.feedBack];
MJSContainers.ChildYBound[d.v, d.feedBack];
END
ELSE d.feedBack ← NIL;
d.rvParent ← IF parent # NIL THEN parent ELSE NIL;
FinishRV[placing, d, argH, argretWidth, argumentive, paint, FALSE];
IF sample THEN roots ← CONS[d, roots];
d.initializing ← FALSE;
END;
NoticeRecordViewerSizeChange:
PROC [self: Viewer]
RETURNS [adjusted:
BOOL ←
FALSE]
--ViewerClasses.AdjustProc-- =
BEGIN
d: RecordViewer ← NARROW[MJSContainers.GetClientData[self]];
IF d.initializing THEN RETURN;
IF self # d.v THEN ERROR;
IF adjusted ← (d.curWW # d.v.ww
AND (
NOT d.v.iconic)
AND d.mayInitiateRelayout
AND d.relayoutable)
THEN {
d.curWW ← d.v.ww;
ReLayout[d, d.v.ww, FALSE, TRUE];
};
adjusted ← adjusted;
END;
LongViewerName:
PROC [v: Viewer]
RETURNS [r:
ROPE] = {
r ← v.name;
FOR v ← v.parent, v.parent
WHILE v #
NIL
DO
r ← v.name.Cat[".", r];
ENDLOOP;
};
Placing: TYPE = REF PlacingRep;
PlacingRep:
TYPE =
RECORD [
hSep, vSep, targetWidth, offset--stupid fucking containers--: INTEGER,
bottomY, bottomRightX, rightX, rowH: INTEGER ← 0,
forceNewRow: BOOLEAN ← FALSE];
Place:
PROC [p: Placing, v: Viewer] =
BEGIN
dx: INTEGER ← IF p.bottomRightX # 0 THEN p.hSep ELSE 0;
IF p.forceNewRow
OR (v.ww + dx + p.bottomRightX > p.targetWidth)
THEN
BEGIN
p.rightX ← MAX[p.rightX, p.bottomRightX];
p.bottomY ← p.bottomY + p.rowH +
(IF p.rightX > 0 THEN p.vSep ELSE 0);
p.rowH ← dx ← p.bottomRightX ← 0;
END;
VO.MoveViewer[viewer: v,
x: p.bottomRightX + dx, y: p.bottomY+p.offset, w: v.ww, h: v.wh, paint: FALSE];
p.bottomRightX ← v.wx+v.ww;
p.rowH ← MAX[p.rowH, v.wh];
p.forceNewRow ← FALSE;
END;
ReLayout:
PUBLIC
PROC [rv: RecordViewer, targetWidth:
INTEGER ← 0, paint, forkResize:
BOOLEAN] =
BEGIN
d: RecordViewer ← rv;
placing: Placing;
argH: INTEGER ← 0;
argretWidth: INTEGER ← 0;
argumentive: BOOLEAN ← FALSE;
IF NOT d.relayoutable THEN RETURN;
IF targetWidth = 0 THEN targetWidth ← d.v.ww;
IF d.targetWidth = targetWidth THEN RETURN;
d.targetWidth ← targetWidth;
TRUSTED {placing ← NEW [PlacingRep ← [d.hSep, d.vSep, d.targetWidth - (d.outerScrollDiffX + d.eltsScrollDiffX), Containers.ScrollOffset[d.eltsContainer]]]};
IF d.label # NIL THEN Place[placing, d.label];
IF d.loneLabel THEN placing.forceNewRow ← TRUE;
FOR stuff:
LIST
OF Viewer ← d.otherStuff, stuff.rest
WHILE stuff #
NIL
DO
Place[placing, stuff.first];
ENDLOOP;
FOR ed: EltData ← d.first, ed.next
WHILE ed #
NIL
DO
WITH ed
SELECT
FROM
cd: ComplexData =>
BEGIN
IF cd.handler.relayouter # NIL THEN cd.handler.relayouter[cd.container, placing.targetWidth, cd.handlerData, cd.clientData];
END;
sd: SimpleData =>
BEGIN
v: Viewer ← sd.container;
diff: INTEGER ← v.ww - v.cw;
mx: INTEGER ← sd.nameButton.wx + sd.nameButton.ww + d.nvSep;
textTarget: INTEGER ← MIN[sd.askW + d.hPad + wFudge, placing.targetWidth - diff - mx];
IF sd.valueText.ww # textTarget
THEN
BEGIN
VO.MoveViewer[viewer: sd.valueText, x: sd.valueText.wx, y: sd.valueText.wy, w: textTarget, h: sd.valueText.wh, paint: FALSE];
VO.MoveViewer[viewer: v, x: v.wx, y: v.wy, w: diff + sd.valueText.wx + sd.valueText.ww, h: v.wh, paint: FALSE];
END;
END;
pd: ProcData =>
BEGIN
Do:
PROC [subData: RecordViewer] =
{IF subData # NIL THEN ReLayout[subData, d.targetWidth - (d.outerScrollDiffX + d.prepsDiffX + d.argretScrollDiffX), FALSE, forkResize]};
Do[pd.argRV]; Do[pd.retRV];
IF pd.argRV #
NIL
OR pd.retRV #
NIL
THEN
BEGIN
FinishProc[pd, d];
argH ← MAX[argH, pd.argret.wh];
argretWidth ← MAX[argretWidth, pd.argret.ww];
argumentive ← TRUE;
END;
END;
ENDCASE;
Place[placing, ed.container];
ENDLOOP;
FinishRV[placing, d, argH, argretWidth, argumentive, paint, forkResize];
END;
FinishRV:
PROC [placing: Placing, d: RecordViewer, argH, argretWidth:
INTEGER, argumentive, paint, forkResize:
BOOLEAN] =
BEGIN
desiredEltsHeight: INTEGER;
offset: INTEGER ← MJSContainers.ScrollOffset[d.v];
oldScroll: BOOLEAN ← d.eltsContainer.scrollable;
placing.bottomY ← placing.bottomY + placing.rowH;
placing.rightX ← MAX[placing.rightX, placing.bottomRightX];
desiredEltsHeight ← placing.bottomY + d.eltsContainer.wh - d.eltsContainer.ch;
IF desiredEltsHeight > d.maxEltsHeight
THEN
{desiredEltsHeight ← d.maxEltsHeight; d.eltsContainer.scrollable ← TRUE}
ELSE d.eltsContainer.scrollable ← FALSE;
VO.MoveViewer[viewer: d.eltsContainer, paint:
FALSE,
x: d.eltsContainer.wx, y: d.eltsContainer.wy,
w: placing.rightX + d.eltsContainer.ww - d.eltsContainer.cw,
h: desiredEltsHeight];
IF d.eltsContainer.scrollable # oldScroll
THEN
VO.MoveViewer[
viewer: d.eltsContainer, paint: FALSE,
x: d.eltsContainer.wx, y: d.eltsContainer.wy,
w: placing.rightX + d.eltsContainer.ww - d.eltsContainer.cw,
h: desiredEltsHeight];
placing.bottomY ← d.eltsContainer.wy + d.eltsContainer.wh;
placing.rightX ← d.eltsContainer.wx + d.eltsContainer.ww;
IF argumentive
THEN
BEGIN
desiredArgsHeight: INT ← argH + d.argContainer.wh - d.argContainer.ch;
VO.MoveViewer[viewer: d.rule1, x: 0, y: placing.bottomY + d.vSep, w: d.rule1.ww, h: d.rule1.wh, paint: FALSE];
d.argPlace ← (d.rule1.wy - offset) + d.rule1.wh + d.vSep;
VO.MoveViewer[viewer: d.argContainer, paint:
FALSE,
x: 0, y: d.argPlace + offset,
w: argretWidth + d.argContainer.ww - d.argContainer.cw,
h: desiredArgsHeight];
placing.bottomY ← d.argContainer.wy + d.argContainer.wh;
placing.rightX ← MAX[placing.rightX, d.argContainer.wx + d.argContainer.ww];
END;
IF d.feedBackHeight > 0
THEN
BEGIN
VO.MoveViewer[viewer: d.rule2, x: 0, y: placing.bottomY + d.vSep, w: d.rule2.ww, h: d.rule2.wh, paint: FALSE];
VO.MoveViewer[viewer: d.feedBack, x: 0, y: d.rule2.wy + d.rule2.wh + d.vSep, w: MAX[d.minFeedBackWidth, d.targetWidth - d.outerScrollDiffX], h: d.feedBackHeight, paint: FALSE];
placing.rightX ← MAX[placing.rightX, d.feedBack.wx + d.feedBack.ww];
placing.bottomY ← d.feedBack.wy + d.feedBack.wh;
END;
placing.bottomY ← placing.bottomY - offset;
IF d.v.parent =
NIL
THEN
BEGIN
d.curWW ← d.v.ww;
IF placing.bottomY < 650
--don't confuse Viewers!--
THEN {
IF (
NOT d.v.iconic)
AND forkResize
AND reallyForkResize
THEN TRUSTED {Process.Detach[FORK TopReSize[d.v, d.curWW, placing.bottomY, alwaysPaintWhenFork OR paint, TRUE]]}
ELSE TopReSize[d.v, d.curWW, placing.bottomY, paint, FALSE];
}
ELSE IF paint THEN VO.PaintViewer[viewer: d.v, hint: all];
END
ELSE
BEGIN
ww: INTEGER ← d.curWW ← (d.v.ww - d.v.cw) + placing.rightX;
wh: INTEGER ← (d.v.wh - d.v.ch) + placing.bottomY;
VO.MoveViewer[viewer: d.v, x: d.v.wx, y: d.v.wy,
w: ww,
h: wh,
paint: FALSE];
IF forkResize
AND reallyForkResize
THEN TRUSTED {Process.Detach[FORK ChildResize[d, paint]]}
ELSE ChildResize[d, paint];
END;
END;
reallyForkResize: BOOL ← TRUE;
alwaysPaintWhenFork: BOOL ← TRUE;
TopReSize:
PROC [v: Viewer, width, height:
INTEGER, paint, lock:
BOOL] = {
Doit:
PROC = {
VO.SetOpenHeight[v, height];
IF NOT v.iconic THEN VO.ComputeColumn[v.column, paint]
ELSE IF paint THEN VO.PaintViewer[viewer: v, hint: all];
};
IF v.ww = width
THEN {
IF lock THEN ViewerLocks.CallUnderColumnLock[Doit, v.column] ELSE Doit[];
};
};
ChildResize:
PROC [d: RecordViewer, paint:
BOOL] = {
viewerToPaint: Viewer;
paintColumn: BOOL;
[viewerToPaint, paintColumn] ← MJSContainers.NoteChildSize[d.v];
IF paint AND viewerToPaint = NIL THEN viewerToPaint ← d.v.parent;
IF paint
THEN {
IF paintColumn THEN ViewerOps.ComputeColumn[d.v.column, TRUE] ELSE ViewerOps.PaintViewer[viewerToPaint, all];
};
};
FinishProc:
PROC [pd: ProcData, d: RecordViewer] =
BEGIN
offset: INTEGER;
by: INTEGER;
rx: INTEGER ← 0;
desiredArgretHeight: INT;
oldScroll: BOOLEAN ← pd.argret.scrollable;
TRUSTED {by ← offset ← Containers.ScrollOffset[pd.argret]};
IF pd.stateLabel #
NIL
THEN
BEGIN
by ← MAX[pd.doitButton.wy + pd.doitButton.wh, pd.stateLabel.wy + pd.stateLabel.wh];
rx ← pd.stateLabel.wx + pd.stateLabel.ww;
END;
IF pd.argRV #
NIL
THEN
BEGIN
VO.MoveViewer[viewer: pd.argRV.v, x: 0, y: by + d.vSep, w: pd.argRV.v.ww, h: pd.argRV.v.wh, paint: FALSE];
rx ← MAX[rx, pd.argRV.v.wx + pd.argRV.v.ww];
by ← pd.argRV.v.wy + pd.argRV.v.wh;
END;
IF pd.rule #
NIL
THEN
BEGIN
VO.MoveViewer[viewer: pd.rule, x: 0, y: by + d.vSep, w: pd.rule.ww, h: pd.rule.wh];
by ← pd.rule.wy + pd.rule.wh;
END;
IF pd.retRV #
NIL
THEN
BEGIN
VO.MoveViewer[viewer: pd.retRV.v, x: 0, y: by + d.vSep, w: pd.retRV.v.ww, h: pd.retRV.v.wh, paint: FALSE];
rx ← MAX[rx, pd.retRV.v.wx + pd.retRV.v.ww];
by ← pd.retRV.v.wy + pd.retRV.v.wh;
END;
by ← by - offset;
desiredArgretHeight ← by + pd.argret.wh - pd.argret.ch;
IF desiredArgretHeight > d.maxArgretHeight
THEN
{desiredArgretHeight ← d.maxArgretHeight; pd.argret.scrollable ← TRUE}
ELSE pd.argret.scrollable ← FALSE;
VO.MoveViewer[viewer: pd.argret, paint:
FALSE,
x: pd.argret.wx, y: 0,
w: rx + pd.argret.ww - pd.argret.cw,
h: desiredArgretHeight];
IF oldScroll # pd.argret.scrollable
THEN
VO.MoveViewer[
viewer: pd.argret, paint: FALSE,
x: pd.argret.wx, y: 0,
w: rx + pd.argret.ww - pd.argret.cw,
h: desiredArgretHeight];
END;
BindAllOfANameFromRef:
PUBLIC
PROC [agInst:
REF
ANY, name:
ROPE, val:
REF
ANY, visible, editable, dontAssign:
BOOLEAN ←
FALSE]
RETURNS [bl: BindingList] =
TRUSTED
BEGIN
asTV: TypedVariable ← AMBridge.TVForReferent[val];
b: Binding ← [name: NIL, it: Value[val: asTV, visible: visible, editable: editable, dontAssign: dontAssign]];
bl ← BindAllOfANameInType[AMTypes.UnderType[AMTypes.TVType[AMBridge.TVForReferent[agInst]]], name, b];
END;
BindAllOfANameInType:
PUBLIC
PROC [agType: Type, name:
ROPE, b: Binding]
RETURNS [bl: BindingList] =
BEGIN
agClass: AMTypes.Class ← AMTypes.TypeClass[agType];
len: CARDINAL;
SELECT agClass
FROM
record, structure => len ← AMTypes.NComponents[agType];
sequence, array => len ← 1;
ENDCASE => ERROR NotAnAggregate[];
bl ← NIL;
FOR i:
CARDINAL
IN [1 .. len]
DO
id: Id;
eType, euType: Type;
eClass: AMTypes.Class;
SELECT agClass
FROM
record, structure =>
BEGIN
eName: ROPE;
b.name ← id ← NEW [INT ← i];
eType ← AMTypes.IndexToType[agType, i];
eName ← AMTypes.IndexToName[agType, i];
IF name.Equal[eName] THEN bl ← CONS[b, bl];
END;
sequence, array =>
BEGIN
id ← ViewRec.all;
eType ← AMTypes.Range[agType];
END;
ENDCASE => ERROR;
eClass ← AMTypes.TypeClass[euType ← AMTypes.UnderType[eType]];
SELECT eClass
FROM
procedure =>
BEGIN
domType: Type ← AMTypes.Domain[euType];
rangeType: Type ← AMTypes.Range[euType];
argBL, retBL: BindingList;
SELECT AMTypes.TypeClass[domType]
FROM
nil => argBL ← NIL;
record, structure => argBL ← BindAllOfANameInType[domType, name, b];
ENDCASE => ERROR;
SELECT AMTypes.TypeClass[rangeType]
FROM
nil => retBL ← NIL;
record, structure => retBL ← BindAllOfANameInType[rangeType, name, b];
ENDCASE => ERROR;
IF argBL # NIL OR retBL # NIL THEN bl ← CONS[[id, Group[argBL, retBL]], bl];
END;
record, structure, sequence, array =>
BEGIN
subList: BindingList ← BindAllOfANameInType[euType, name, b];
IF subList # NIL THEN bl ← CONS[[id, Group[subList]], bl];
END;
ENDCASE;
ENDLOOP;
END;
NElts:
PROC [dt: Type]
RETURNS [
LONG
CARDINAL] =
TRUSTED
BEGIN
RETURN [(1+AMBridge.TVToLC[AMTypes.Last[dt]]) - AMBridge.TVToLC[AMTypes.First[dt]]];
END;
RVQuaViewer:
PUBLIC
PROC [rv: RecordViewer]
RETURNS [Viewer] =
{RETURN [rv.v]};
ViewerIsRV:
PUBLIC
PROC [v: Viewer]
RETURNS [
BOOLEAN] =
BEGIN
cd: REF ANY;
IF NOT MJSContainers.IsMJSContainer[v] THEN RETURN [FALSE];
cd ← MJSContainers.GetClientData[v];
RETURN [cd # NIL AND ISTYPE[cd, RecordViewer]];
END;
ViewerQuaRV:
PUBLIC
PROC [v: Viewer]
RETURNS [RecordViewer] =
BEGIN
cd: REF ANY;
IF NOT MJSContainers.IsMJSContainer[v] THEN RETURN [NIL];
cd ← MJSContainers.GetClientData[v];
IF cd = NIL OR NOT ISTYPE[cd, RecordViewer] THEN RETURN [NIL];
RETURN [NARROW[cd]];
END;
IsRV:
PUBLIC
PROC [x:
REF
ANY]
RETURNS [is:
BOOL] =
{is ← ISTYPE[x, RecordViewer]};
NarrowToRV:
PUBLIC
PROC [x:
REF
ANY]
RETURNS [RecordViewer] =
{RETURN [NARROW[x]]};
Setup:
PROC =
BEGIN
myIconFlavors[0] ← Icons.NewIconFromFile["ViewRec.Icons", 0];
myIconFlavors[1] ← Icons.NewIconFromFile["ViewRec.Icons", 1];
myIconFlavors[2] ← Icons.NewIconFromFile["ViewRec.Icons", 2];
evClass ←
NEW [ViewerClasses.ViewerClassRec ← [
flavor: $EltViewer,
destroy: DestroyEltViewer,
topDownCoordSys: TRUE]];
VO.RegisterViewerClass[$EltViewer, evClass];
rvClass ←
NEW [MJSContainers.MJSContainerClassRep ← [
adjust: NoticeRecordViewerSizeChange]];
MJSContainers.RegisterClass[$RecordViewer, rvClass];
nameStyles ← [quiescent: $BlackOnWhite,
opened: $WhiteOnBlack, running: $WhiteOnBlack,
invariant: $BlackOnGrey, beingShown: $BlackOnGrey];
END;
Setup[];
END.