ViewRecAux.Mesa
Last Edited by: Spreitzer, April 23, 1985 6:58:52 pm PST
Last Edited by: Maxwell, March 11, 1983 10:56 am
DIRECTORY
AMBridge, AMTypes, Atom, Containers, Convert, IO, Labels, MessageWindow, Rope, SafeStorage, VFonts, ViewerOps, ViewRec, ViewRecExtras;
ViewRecAux:
CEDAR PROGRAM
IMPORTS AMBridge, AMTypes, Atom, Containers, Convert, IO, Labels, MessageWindow, Rope, SafeStorage, VF:VFonts, ViewerOps, ViewRec
EXPORTS ViewRec, ViewRecExtras =
BEGIN OPEN ViewRec;
EnumData: TYPE = REF EnumDataRep;
EnumDataRep:
TYPE =
RECORD [
wideType: Type];
enumerationHandler: SimpleHandler ←
NEW [SimpleHandlerRep ← [
Parse: ParseEnumeration,
UnParse: UnParseEnumeration,
Max: MaxEnumeration,
Butt: ButtEnumeration,
blueDoc: "Shift Blue => previous member of enumeration,
Not-Shift Blue => next member of enumeration,
"
]];
ParseEnumeration: ParseProc =
BEGIN
ed: EnumData ← NARROW[handlerData];
new: TypedVariable;
index: CARDINAL;
ok ← TRUE;
index ← AMTypes.NameToIndex[type: ed.wideType, name: asRope !AMTypes.Error => {ok ← FALSE; CONTINUE}];
IF NOT ok THEN {[index, ok] ← ParseCard[asRope]; index ← index+1};
IF NOT ok THEN RETURN [FALSE];
new ← AMTypes.Value[type: ed.wideType, index: index !AMTypes.Error => {ok ← FALSE; CONTINUE}];
IF ok THEN AMTypes.Assign[lhs: tv, rhs: new];
END;
ParseCard:
PROC [asRope:
ROPE]
RETURNS [card:
CARDINAL, ok:
BOOLEAN] =
BEGIN
lc: LONG CARDINAL ← 0;
ok ← TRUE;
lc ← Convert.CardFromWholeNumberLiteral[asRope !Convert.Error => {ok ← FALSE; CONTINUE}];
IF lc <= LAST[CARDINAL] THEN card ← lc ELSE ok ← FALSE;
END;
UnParseEnumeration: UnParseProc =
BEGIN
ed: EnumData ← NARROW[handlerData];
asRope ← MyTVToName[tv, ed.wideType];
END;
MyTVToName:
PROC [et: TypedVariable
--of an enumerated type--, wideType: Type]
RETURNS [r:
ROPE] =
BEGIN
tv: TypedVariable ← AMTypes.Coerce[et, wideType];
r ← AMTypes.TVToName[tv !
AMTypes.Error =>
TRUSTED {
r ← IO.PutFR["%g", IO.card[AMBridge.TVToCardinal[et]]];
CONTINUE}
];
END;
MaxEnumeration: MaxProc =
BEGIN
ed: EnumData ← NARROW[handlerData];
ut: Type ← AMTypes.UnderType[targType];
maxWidthNeeded ← VF.CharWidth['X];
FOR tv ← AMTypes.First[ut], AMTypes.Next[tv]
WHILE tv #
NIL
DO
maxWidthNeeded ← MAX[maxWidthNeeded, VF.StringWidth[MyTVToName[tv, ed.wideType]]];
ENDLOOP;
maxWidthNeeded ← maxWidthNeeded;
END;
ButtEnumeration: ButtProc =
BEGIN
IF shift
THEN {IF (new ← PrevEnum[tv]) = NIL THEN new ← AMTypes.Last[targType]}
ELSE {IF (new ← AMTypes.Next[tv]) = NIL THEN new ← AMTypes.First[targType]};
END;
PrevEnum:
PROC[tv: TypedVariable
--enumerated, subrange, basic--]
RETURNS[TypedVariable] = TRUSTED {
val: LONG INTEGER = AMBridge.TVToLI[tv];
type: Type = AMTypes.TVType[tv];
newTV: TypedVariable;
IF val = AMBridge.TVToLI[AMTypes.First[type]] THEN RETURN[NIL];
newTV ← AMTypes.New[type];
AMBridge.SetTVFromLC[newTV, LOOPHOLE[val - 1, LONG CARDINAL]]; -- NOTE mach dep enum?
RETURN[newTV]};
--modified RTTypedVariablesImpl.Next last modified on May 23, 1983 10:52 am by Paul Rovner--
EnumPrev:
PROC [of: TypedVariable, type: Type]
RETURNS [is: TypedVariable] =
BEGIN
is ← AMTypes.First[type];
WHILE is #
NIL
DO
next: TypedVariable ← AMTypes.Next[is];
IF AMTypes.TVEqual[next, of] THEN RETURN;
is ← next;
ENDLOOP;
is ← AMTypes.Last[type];
END;
RecognizeEnumeration:
PUBLIC Recognizer =
BEGIN
IF
NOT onlyRecognize
THEN
BEGIN
ed: EnumData ←
NEW [EnumDataRep ← [
wideType: AMTypes.GroundStar[t] ]];
handler ← enumerationHandler;
handlerData ← ed;
END;
IKnowYou ← TRUE;
END;
boolShortHandler: SimpleHandler ←
NEW [SimpleHandlerRep ← [
Parse: ParseBoolShort,
UnParse: UnParseBoolShort,
Max: MaxBoolShort,
Butt: ButtBoolShort,
blueDoc: "Blue => invert,
"
]];
true, false: TypedVariable;
ParseBoolShort: ParseProc = {
ok ← TRUE;
SELECT
TRUE
FROM
asRope.Equal["T"] => AMTypes.Assign[tv, true];
asRope.Equal["F"] => AMTypes.Assign[tv, false];
ENDCASE => ok ← FALSE;
};
UnParseBoolShort: UnParseProc = {
SELECT
TRUE
FROM
AMTypes.TVEqual[tv, true] => RETURN ["T"];
AMTypes.TVEqual[tv, false] => RETURN ["F"];
ENDCASE => ERROR;
};
MaxBoolShort: MaxProc =
{maxWidthNeeded ← MAX[VF.StringWidth["T"], VF.StringWidth["F"]]};
ButtBoolShort: ButtProc = {
SELECT
TRUE
FROM
AMTypes.TVEqual[tv, true] => RETURN [false];
AMTypes.TVEqual[tv, false] => RETURN [true];
ENDCASE => ERROR;
};
RecognizeBoolShort:
PUBLIC Recognizer =
BEGIN
IF NOT SafeStorage.EquivalentTypes[t, CODE[BOOL]] THEN RETURN [FALSE, NIL];
IF
NOT onlyRecognize
THEN
BEGIN
handler ← boolShortHandler;
handlerData ← NIL;
END;
IKnowYou ← TRUE;
END;
atomHandler: SimpleHandler ←
NEW [SimpleHandlerRep ← [
Parse: ParseAtom,
UnParse: UnParseAtom,
Max: MaxAtom
]];
ParseAtom: ParseProc
--PROC [asRope: ROPE, tv: TypedVariable, targType: Type, handlerData: REF ANY] RETURNS [ok: BOOLEAN]-- =
TRUSTED
BEGIN
AMTypes.Assign[tv, AMBridge.TVForATOM[Atom.MakeAtom[asRope]]];
END;
UnParseAtom: UnParseProc
--PROC [tv: TypedVariable, targType: Type, handlerData: REF ANY] RETURNS [asRope: ROPE]-- =
TRUSTED
BEGIN
asRope ← IF AMTypes.IsNil[tv] THEN "--NIL--" ELSE Atom.GetPName[AMBridge.TVToATOM[tv]];
END;
MaxAtom: MaxProc
--PROC [tv: TypedVariable, targType: Type, handlerData: REF ANY] RETURNS [maxWidthNeeded: INTEGER, lines: REAL ← 1]-- =
{maxWidthNeeded ← VF.StringWidth["This looks good"]};
RecognizeAtom:
PUBLIC Recognizer =
BEGIN
handler ← atomHandler;
IKnowYou ← TRUE;
END;
NumData: TYPE = REF NumDataRep;
NumDataRep:
TYPE =
RECORD [
typeClass: AMTypes.Class,
cvt: ConvertProc,
tempAsTV: TypedVariable ← NIL,
tempAsRef: REF ANY];
ConvertProc: TYPE = PROC [nd: NumData, asRope: ROPE] RETURNS [ok: BOOLEAN ← TRUE];
numHandlerDatas: ARRAY AMTypes.Class OF NumData ← ALL[NIL];
numberHandler: SimpleHandler ←
NEW [SimpleHandlerRep ← [
Parse: ParseNumber,
UnParse: UnParseNumber,
Max: MaxNumber,
Butt: NIL]];
ParseNumber: ParseProc =
BEGIN
nd: NumData ← NARROW[handlerData];
ok ← nd.cvt[nd, asRope !Convert.Error => {ok ← FALSE; CONTINUE}];
IF ok
THEN
BEGIN
AMTypes.Assign[tv, nd.tempAsTV !AMTypes.Error =>
{ok ← FALSE; CONTINUE}];
END;
END;
ToC: ConvertProc =
BEGIN
c: REF CARDINAL ← NARROW[nd.tempAsRef];
lc: LONG CARDINAL ← 0;
lc ← Convert.CardFromWholeNumberLiteral[asRope];
IF lc <= LAST[CARDINAL] THEN c^ ← lc ELSE ok ← FALSE;
END;
ToI: ConvertProc =
BEGIN
i: REF INTEGER ← NARROW[nd.tempAsRef];
li: INT;
li ← Convert.IntFromRope[asRope];
IF li IN [FIRST[INTEGER] .. LAST[INTEGER]] THEN i^ ← li ELSE ok ← FALSE;
END;
ToLC: ConvertProc =
BEGIN
c: REF LONG CARDINAL ← NARROW[nd.tempAsRef];
c^ ← Convert.CardFromWholeNumberLiteral[asRope];
END;
ToLI: ConvertProc =
BEGIN
i: REF LONG INTEGER ← NARROW[nd.tempAsRef];
i^ ← Convert.IntFromRope[asRope];
END;
ToR: ConvertProc =
BEGIN
r: REF REAL ← NARROW[nd.tempAsRef];
r^ ← Convert.RealFromRope[asRope !Convert.Error =>
{r^ ← Convert.CardFromWholeNumberLiteral[asRope !Convert.Error =>
{r^ ← Convert.IntFromRope[asRope !Convert.Error =>
{ok ← FALSE; CONTINUE}];
CONTINUE}];
CONTINUE}];
END;
UnParseNumber: UnParseProc =
BEGIN
nd: NumData ← NARROW[handlerData];
AMTypes.Assign[nd.tempAsTV, tv];
asRope ←
SELECT nd.typeClass
FROM
cardinal => Convert.RopeFromCard[NARROW[nd.tempAsRef, REF CARDINAL]^],
integer => Convert.RopeFromInt[NARROW[nd.tempAsRef, REF INTEGER]^],
longCardinal => Convert.RopeFromCard[NARROW[nd.tempAsRef, REF LONG CARDINAL]^],
longInteger => Convert.RopeFromInt[NARROW[nd.tempAsRef, REF INT]^],
real => Convert.RopeFromReal[NARROW[nd.tempAsRef, REF REAL]^],
ENDCASE => ERROR;
END;
MaxNumber: MaxProc =
BEGIN
nd: NumData ← NARROW[handlerData];
SELECT nd.typeClass
FROM
cardinal, integer, longCardinal, longInteger => {
Try:
PROC [val: TypedVariable]
RETURNS [width:
INTEGER] = {
width ← VF.StringWidth[UnParseNumber[tv: val, targType: targType, handlerData: handlerData]];
};
maxWidthNeeded ← MAX[Try[AMTypes.First[targType]], Try[AMTypes.Last[targType]]];
};
real => maxWidthNeeded ← VF.StringWidth["-3.456789E-29"];
ENDCASE => ERROR;
END;
RecognizeNumber:
PUBLIC Recognizer =
BEGIN
IF
NOT onlyRecognize
THEN
BEGIN
wt: Type ← AMTypes.GroundStar[t];
tc: AMTypes.Class ← AMTypes.TypeClass[wt];
handler ← numberHandler;
handlerData ← numHandlerDatas[tc];
END;
IKnowYou ← TRUE;
END;
ropeHandler: SimpleHandler ←
NEW [SimpleHandlerRep ← [
Parse: ParseRope,
UnParse: UnParseRope,
Max: MaxRope,
Butt: NIL]];
ParseRope: ParseProc =
TRUSTED
BEGIN
asTV: TypedVariable ← AMBridge.TVForROPE[asRope];
ok ← TRUE;
AMTypes.Assign[tv, asTV !AMTypes.Error => {ok ← FALSE; CONTINUE}];
END;
UnParseRope: UnParseProc =
BEGIN
asRope ← AMTypes.TVToName[tv];
END;
MaxRope: MaxProc = {RETURN [1024, 2]};
RecognizeRope:
PUBLIC Recognizer =
BEGIN
IF NOT onlyRecognize THEN {handler ← ropeHandler; handlerData ← NIL};
IKnowYou ← TRUE;
END;
sequenceHandler: ComplexHandler ←
NEW [ComplexHandlerRep ← [
producer: SequenceProduce,
updater: SequenceUpdate]];
SequenceProduce: ComplexProducer =
BEGIN
rv: RecordViewer ← ViewTV[agg: tv, specs: context.bindings, label: context.name.Concat[":"], parent: context.for, sample: TRUE, createOptions: context.createOptions, viewerInit: [parent: context.main, scrollable: FALSE, iconic: FALSE], paint: FALSE];
clientData ← rv;
v ← rv.RVQuaViewer[];
sampleable ← FALSE;
END;
SequenceUpdate: Updater = {};
SequenceElement: ElementGiver
--PROC [agg: TypedVariable, which: Id, handlerData, clientData: REF ANY] RETURNS [eh: EltHandle]-- =
BEGIN
rv: RecordViewer ← NarrowToRV[clientData];
eh ← rv.GetEltHandle[LIST[which]];
END;
RecognizeSequence:
PUBLIC Recognizer =
BEGIN
IF NOT onlyRecognize THEN {handler ← sequenceHandler; handlerData ← NIL};
IKnowYou ← TRUE;
END;
recordHandler: ComplexHandler ←
NEW [ComplexHandlerRep ← [
producer: RecordProduce,
relayouter: ReLayoutRecord,
updater: RecordUpdate,
elementGiver: RecordElement]];
RecordElement: ElementGiver
--PROC [agg: TypedVariable, which: Id, handlerData, clientData: REF ANY] RETURNS [eh: EltHandle]-- =
BEGIN
rv: RecordViewer ← NarrowToRV[clientData];
eh ← rv.GetEltHandle[LIST[which]];
END;
RecordUpdate: Updater
--PROC [tv: TypedVariable, v: Viewer, handlerData, clientData: REF ANY]-- =
BEGIN
rv: RecordViewer ← NarrowToRV[clientData];
SampleRV[rv];
END;
RecordProduce: ComplexProducer
--PROC [tv: TypedVariable, context: Context, handlerData: REF ANY] RETURNS [v: Viewer, clientData: REF ANY, sampleable: BOOLEAN ← TRUE]-- =
BEGIN
container, name, value: Viewer;
rv: RecordViewer;
mx: INTEGER;
rco: CreateOptions ← context.createOptions;
visibleCount: REF INT ← NARROW[handlerData];
IF visibleCount^ < 1 THEN RETURN [NIL, NIL, FALSE];
container ← Containers.Create[info: [parent: context.main, ww: context.maxWidth, wh: 10, border: context.createOptions.bordElts, scrollable: FALSE], paint: FALSE];
name ← Labels.Create[
info: [parent: container, name: context.name.Concat[":"], border: FALSE],
font: RightFont[context.createOptions.nameFont],
paint: FALSE];
mx ← name.wx + name.ww + context.createOptions.nvSep;
clientData ← rv ← ViewTV[agg: tv,
specs: context.bindings,
toButt: context.toButt,
parent: context.for,
sample: FALSE,
createOptions: rco,
viewerInit: [parent: container,
border: context.createOptions.bordRecs,
wx: mx, wh: 10,
ww: MAX[container.cw - mx, context.createOptions.minRecordWidth],
scrollable: FALSE],
paint: FALSE];
value ← rv.RVQuaViewer[];
ViewerOps.MoveViewer[
viewer: container,
x: container.wx,
y: container.wy,
w: MAX[name.wx + name.ww, value.wx + value.ww],
h: MAX[name.wy + name.wh, value.wy + value.wh],
paint: FALSE];
v ← container;
END;
ReLayoutRecord:
PROC [v: Viewer, maxWidth:
INTEGER, handlerData, clientData:
REF
ANY] =
BEGIN
rv: RecordViewer ← NarrowToRV[clientData];
rvv: Viewer ← rv.RVQuaViewer[];
outerDiff: INTEGER ← v.ww - v.cw;
rv.ReLayout[maxWidth - outerDiff - rvv.wx, FALSE];
ViewerOps.MoveViewer[viewer: v, x: v.wx, y: v.wy,
w: outerDiff + rvv.wx + rvv.ww,
h: MAX[10, (v.wh - v.ch) + rvv.wy + rvv.wh],
paint: FALSE];
END;
RecognizeRecord:
PUBLIC Recognizer =
BEGIN
simpleEnough: BOOLEAN;
visibleCount: INT;
[simpleEnough, visibleCount] ← SimpleEnough[rt: AMTypes.UnderType[t], specs: specs, createOptions: createOptions];
IF IKnowYou ← simpleEnough
THEN
BEGIN
handler ← recordHandler;
handlerData ← NEW [INT ← visibleCount];
END;
END;
Setup:
PROC =
BEGIN
countAsAny: REF ANY;
Foo: TYPE = RECORD [elts: SEQUENCE length: CARDINAL OF CARDINAL];
foo: TypedVariable;
seqType: Type;
TRUSTED {
true ← AMBridge.TVForReferent[NEW[BOOL ← TRUE]];
false ← AMBridge.TVForReferent[NEW[BOOL ← FALSE]];
foo ← AMBridge.TVForReferent[NEW[Foo[1]]];
};
seqType ← AMTypes.TVType[AMTypes.IndexToTV[foo, 1]];
numHandlerDatas[cardinal] ← NEW [NumDataRep ← [typeClass: cardinal, cvt: ToC, tempAsRef: NEW [CARDINAL] ]];
numHandlerDatas[integer] ← NEW [NumDataRep ← [typeClass: integer, cvt: ToI, tempAsRef: NEW [INTEGER] ]];
numHandlerDatas[longCardinal] ← NEW [NumDataRep ← [typeClass: longCardinal, cvt: ToLC, tempAsRef: NEW [LONG CARDINAL] ]];
numHandlerDatas[longInteger] ← NEW [NumDataRep ← [typeClass: longInteger, cvt: ToLI, tempAsRef: NEW [LONG INTEGER] ]];
numHandlerDatas[real] ← NEW [NumDataRep ← [typeClass: real, cvt: ToR, tempAsRef: NEW [REAL] ]];
FOR c: AMTypes.Class
IN AMTypes.Class
DO
TRUSTED {
IF numHandlerDatas[c] # NIL THEN numHandlerDatas[c].tempAsTV ← AMBridge.TVForReferent[numHandlerDatas[c].tempAsRef]};
ENDLOOP;
RegisterRecognizerByType[r: RecognizeEnumeration, end: Back, type: CODE[AddPlace], reductions: TypeClass];
RegisterRecognizerByType[r: RecognizeAtom, end: Back, type: CODE[ATOM], reductions: TypeClass];
RegisterRecognizerByType[r: RecognizeNumber, end: Back, type: CODE[INTEGER], reductions: TypeClass];
RegisterRecognizerByType[r: RecognizeNumber, end: Back, type: CODE[CARDINAL], reductions: TypeClass];
RegisterRecognizerByType[r: RecognizeNumber, end: Back, type: CODE[LONG INTEGER], reductions: TypeClass];
RegisterRecognizerByType[r: RecognizeNumber, end: Back, type: CODE[LONG CARDINAL], reductions: TypeClass];
RegisterRecognizerByType[r: RecognizeNumber, end: Back, type: CODE[REAL], reductions: TypeClass];
RegisterRecognizerByType[r: RecognizeRope, end: Back, type: CODE[ROPE], reductions: TypeClass];
RegisterRecognizerByType[r: RecognizeRecord, end: Back, type: CODE[Context], reductions: TypeClass];
RegisterRecognizerByType[r: RecognizeRecord, end: Back, type: AMTypes.Domain[CODE[Recognizer]], reductions: TypeClass];
RegisterRecognizerByType[r: RecognizeSequence, end: Back, type: seqType, reductions: TypeClass];
RegisterRecognizerByType[r: RecognizeSequence, end: Back, type: CODE[ARRAY BOOLEAN OF REAL], reductions: TypeClass];
countAsAny ← Atom.GetProp[atom: $ViewRecCount, prop: $ViewRecCount];
IF countAsAny =
NIL
THEN
Atom.PutProp[atom: $ViewRecCount, prop: $ViewRecCount, val: NEW [INT ← 1]]
ELSE
BEGIN
ri: REF INT ← NARROW[countAsAny];
ri^ ← ri^ + 1;
MessageWindow.Append[
message: IO.PutFR["ViewRec has been loaded %g times!
Confusion is likely to result.
I recommend you rollback and do things right.", IO.int[ri^]],
clearFirst: TRUE];
ERROR;
END;
END;
Setup[];
END.