ViewRecOther.Mesa
Mike Spreitzer November 14, 1986 8:26:44 pm PST
DIRECTORY AMBridge, AMEvents, AMMiniModel, AMTypes, Containers, Icons, Imager, ImagerBackdoor, IO, Labels, List, MessageWindow, PopUpButtons, Process, ProcessProps, Real, Rope, Rules, SafeStorage, TiogaOps, TIPUser, TypeProps, VFonts, ViewerClasses, ViewerOps, ViewerTools, ViewRec, ViewRecInsides, WorldVM;
ViewRecOther: CEDAR MONITOR
IMPORTS AMBridge, AMEvents, AMMiniModel, AMTypes, Imager, ImagerBackdoor, IO, Labels, List, MessageWindow, PopUpButtons, Process, ProcessProps, Rope, SafeStorage, TiogaOps, TypeProps, ViewRec, ViewRecInsides, VO:ViewerOps, VT:ViewerTools, WorldVM
EXPORTS ViewRec, ViewRecInsides =
BEGIN OPEN PUB:PopUpButtons, ViewRecInsides;
RecordViewer: TYPE = REF RecordViewerPrivate;
RecordViewerPrivate: PUBLIC TYPE = ViewRecInsides.RecordViewerPrivate;
NotAnAggregate: PUBLIC ERROR = CODE;
NoSelectedProc: PUBLIC ERROR = CODE;
BadID: PUBLIC ERROR [id: ViewRec.Id] = CODE;
NotFound: PUBLIC ERROR [name: ViewRec.Path] = CODE;
Event: TYPE = {Call, Return, Abort, Edit};
Pending: TYPE = RECORD [f: FinishProc ← NIL, data: REF ANYNIL];
FinishProc: TYPE = ViewRec.FinishProc;
NameStyles: TYPE = RECORD [quiescent, opened, invariant, running, beingShown: PUB.Colors];
all: PUBLIC REF ANYNEW [REAL ← 47];
transitions: ARRAY GregState OF ARRAY Event OF GregState;
nvDocFmt, nvcDocFmt: ROPE;
procDoc, selDoc, butDoc: ROPENIL;
doitDocFmt: ARRAY BOOLEAN OF ROPEALL[NIL];
abortDocFmt: ROPENIL;
toFinish: Pending;
experimental: BOOLEANFALSE;
clearMessagePlace: PUBLIC ROPE ← "flush here";
mwTotal: ROPE ← "";
sparseGrey: Imager.Color = ImagerBackdoor.MakeStipple[stipple: 8020H];
denseGrey: Imager.Color = ImagerBackdoor.MakeStipple[stipple: 7FDFH];
almostWhite: Imager.Color = ImagerBackdoor.MakeStipple[stipple: 8000H];
almostBlack: Imager.Color = ImagerBackdoor.MakeStipple[stipple: 7FFFH];
greyColors: PUB.Colors = NEW [PUB.ColorsPrivate ← [
[ALL[[Imager.black, almostWhite]], ALL[[Imager.black, sparseGrey]]],
[ALL[[Imager.white, almostBlack]], ALL[[Imager.white, denseGrey]]]
]];
nameStyles: NameStyles ← [
quiescent: PUB.defaultColors,
opened: PUB.inverseColors,
running: PUB.inverseColors,
invariant: greyColors,
beingShown: greyColors
];
Recognize: PUBLIC PROC [t: Type, specials: RList, onlyRecognize: BOOLEAN, specs: BindingList, createOptions: CreateOptions] RETURNS [recognized: BOOLEAN, handler, handlerData: REF ANY] =
BEGIN
TryRecognizers: PROC [rl: RList] RETURNS [found: BOOLEAN] =
BEGIN
WHILE rl # NIL DO
[found, handler, handlerData] ← rl.first[t: t, onlyRecognize: onlyRecognize, specs: specs, createOptions: createOptions];
IF found THEN {recognized ← TRUE; RETURN};
rl ← rl.rest;
ENDLOOP;
found ← FALSE;
END;
gt: Type;
tc: AMTypes.Class;
IF TryRecognizers[specials] THEN RETURN;
IF TryRecognizers[befores[EquivalenceClass]] THEN RETURN;
IF TryRecognizers[NARROW[TypeProps.Get[type: t, key: ecHandlerProp]]] THEN RETURN;
IF TryRecognizers[befores[StripSubranges]] THEN RETURN;
gt ← AMTypes.GroundStar[t];
IF TryRecognizers[NARROW[TypeProps.Get[type: gt, key: gtHandlerProp]]] THEN RETURN;
IF TryRecognizers[befores[TypeClass]] THEN RETURN;
tc ← AMTypes.TypeClass[gt];
IF TryRecognizers[classRecers[tc]] THEN RETURN;
IF TryRecognizers[afterAlls] THEN RETURN;
recognized ← FALSE;
END;
SelectBindings: PUBLIC PROC [bl: BindingList, name: ROPE, pos: INT] RETURNS [sublist, altSublist: BindingList, val: TypedVariable, found, visible, editable, dontAssign: BOOLEAN, notifies: NotifyList, recers: RList] =
BEGIN
sublist ← altSublist ← NIL;
found ← dontAssign ← FALSE;
visible ← editable ← TRUE;
notifies ← NIL;
recers ← NIL;
FOR bl ← bl, bl.rest WHILE bl # NIL DO
IF bl.first.name = all THEN NULL
ELSE WITH bl.first.name SELECT FROM
r: ROPE => IF NOT r.Equal[name] THEN LOOP;
i: Int => IF i^ # pos THEN LOOP;
rt: REF TEXT => IF NOT Rope.FromRefText[rt].Equal[name] THEN LOOP;
ENDCASE => ERROR BadID[bl.first.name];
WITH bl.first SELECT FROM
v: Binding[Value] => {val ← v.val;
visible ← visible AND v.visible;
editable ← editable AND v.editable;
dontAssign ← dontAssign OR v.dontAssign;
found ← TRUE};
n: Binding[Notify] => notifies ← CONS[[n.notify, n.clientData], notifies];
r: Binding[TryRecognizer] => recers ← CONS[r.recognizer, recers];
g: Binding[Group] => {sublist ← BindingListAppend[g.sublist, sublist];
altSublist ← BindingListAppend[g.altSublist, altSublist]};
ENDCASE => ERROR;
ENDLOOP;
saver ← recers; --make sure GC don't take it
END;
saver: RList ← NIL; --to combat UNSAFEty of long REF-containing arg/return record
BindingListAppend: PUBLIC PROC [a, b: BindingList] RETURNS [c: BindingList] =
BEGIN
IF a = NIL THEN RETURN [b];
c ← a;
WHILE a.rest # NIL DO a ← a.rest ENDLOOP;
a.rest ← b;
END;
GetEltHandle: PUBLIC PROC [rv: RecordViewer, name: ViewRec.Path] RETURNS [eh: REF ANY] =
BEGIN
d: RecordViewer ← rv;
e: RecordViewer ← NIL;
cd: ComplexData ← NIL;
IF name = NIL THEN ERROR NotFound[name];
DO
ed: EltData ← NIL;
IF cd # NIL THEN
BEGIN
IF cd.handler.elementGiver # NIL THEN ed ← NARROW[cd.handler.elementGiver[agg: cd.var, which: name.first, handlerData: cd.handlerData, clientData: cd.clientData]];
END
ELSE BEGIN
IF ed = NIL AND e # NIL THEN ed ← Find[e, name.first];
IF ed = NIL AND d # NIL THEN ed ← Find[d, name.first];
END;
IF ed = NIL THEN ERROR NotFound[name];
name ← name.rest;
IF name = NIL THEN RETURN [ed];
WITH ed SELECT FROM
pd: ProcData => {d ← pd.argRV; e ← pd.retRV; cd ← NIL};
x: ComplexData => {d ← e ← NIL; cd ← x};
ENDCASE => ERROR NotFound[name];
ENDLOOP;
END;
Find: PROC [d: RecordViewer, name: REF ANY] RETURNS [ed: EltData] =
BEGIN
idx: INT ← 1;
WITH name SELECT FROM
r: ROPE => FOR ed ← d.first, ed.next WHILE ed # NIL DO
IF r.Equal[ed.name] THEN RETURN [ed];
ENDLOOP;
rt: REF TEXT => BEGIN
r: ROPE ← Rope.FromRefText[rt];
FOR ed ← d.first, ed.next WHILE ed # NIL DO
IF r.Equal[ed.name] THEN RETURN [ed];
ENDLOOP;
END;
ri: REF INT =>
IF ri^ > 0 THEN
BEGIN
FOR ed ← d.first, ed.next WHILE ed # NIL DO
IF idx = ri^ THEN RETURN [ed];
idx ← idx + 1;
ENDLOOP;
END
ELSE IF ri^ < 0 THEN
BEGIN
FOR ed ← d.last, ed.prev WHILE ed # NIL DO
IF idx = -ri^ THEN RETURN [ed];
idx ← idx + 1;
ENDLOOP;
END
ELSE ERROR BadID[name];
ENDCASE => ERROR BadID[name];
RETURN [NIL];
END;
Open: PROC [ed: EltData] =
BEGIN
ed.opened ← TRUE;
ShowState[ed];
END;
DeOpen: PROC [ed: EltData] =
BEGIN
ed.opened ← FALSE;
ShowState[ed];
END;
Poke: PROC [ed: EltData, how: Event] =
BEGIN
WITH ed SELECT FROM
pd: ProcData => BEGIN
oldState: GregState ← pd.gregState;
pd.gregState ← transitions[pd.gregState][how];
IF pd.gregState # oldState AND pd.stateLabel # NIL THEN
Labels.Set[pd.stateLabel, StateToRope[pd.gregState]];
END;
ENDCASE => BEGIN
IF ed.parent.edParent # NIL THEN
Poke[ed.parent.edParent, how];
END;
END;
StateToRope: PROC [s: GregState] RETURNS [ROPE] =
{RETURN [SELECT s FROM
Other => "",
Dispatched => "working",
DispatchedAndEdited => "working on old",
Returned => "done",
Aborted => "aborted",
ENDCASE => ERROR]};
FinishPendingBusiness: PUBLIC PROC RETURNS [okToProceed: BOOLEAN] =
BEGIN
IF toFinish.f # NIL THEN
okToProceed ← toFinish.f[toFinish.data]
ELSE okToProceed ← TRUE;
END;
SetPendingBusiness: PUBLIC PROC [proc: FinishProc ← NIL, data: REF ANYNIL] =
{toFinish ← [proc, data]};
ShowState: PUBLIC PROC [ed: EltData, paint: BOOLEANTRUE] =
BEGIN
colors: PUB.Colors;
image: PUB.Image;
ri: PUB.RopeImage;
b: Viewer;
WITH ed SELECT FROM
pd: ProcData =>
BEGIN
b ← pd.container;
colors ← IF pd.running THEN nameStyles.running
ELSE IF pd.parent.highlightSelectedProc AND pd.parent.curProc = pd THEN nameStyles.beingShown
ELSE nameStyles.quiescent;
END;
sd: SimpleData =>
BEGIN
b ← sd.nameButton;
colors ← IF NOT sd.variable THEN nameStyles.invariant
ELSE IF sd.opened THEN nameStyles.opened
ELSE nameStyles.quiescent;
END;
ENDCASE => ERROR;
image ← PUB.GetInstanceSpec[b].image;
ri ← NARROW[image.data];
ri.colors ← colors;
IF paint THEN VO.PaintViewer[b, client];
END;
SendMsg: PROC [rv: RecordViewer, to: ROPE] =
BEGIN
old: ROPE;
FOR rv ← rv, rv.rvParent WHILE rv # NIL DO
IF rv.feedBack # NIL THEN EXIT;
ENDLOOP;
IF (IF rv = NIL THEN TRUE ELSE rv.feedBack = NIL OR rv.v.destroyed) THEN
BEGIN
IF to=clearMessagePlace THEN to ← ""
ELSE BEGIN
IF mwTotal.Length[] > 0 THEN to ← mwTotal.Cat["; ", to];
END;
MessageWindow.Append[message: mwTotal ← to, clearFirst: TRUE];
RETURN;
END;
IF to = clearMessagePlace THEN {VT.SetContents[rv.feedBack, ""]; RETURN};
old ← VT.GetContents[rv.feedBack];
IF old.Length[] > 0 THEN to ← old.Cat["; ", to];
VT.SetContents[rv.feedBack, to];
END;
SetMsg: PROC [ed: EltData, to: ROPE] =
BEGIN
SendMsg[IF ed = NIL THEN NIL ELSE ed.parent, to];
END;
DisplayMessage: PUBLIC PROC [rv: RecordViewer, msg: ROPE] =
BEGIN
d: RecordViewer ← rv;
SendMsg[d, msg];
END;
Scream: PROC [msg: ROPE] =
BEGIN
MessageWindow.Append[msg, TRUE];
MessageWindow.Blink[];
END;
Runnable: ENTRY PROC [ed: EltData] RETURNS [BOOLEAN] =
BEGIN
pd: ProcData ← NARROW[ed];
IF pd.parent.exclusiveProcs AND pd.parent.runCount > 0 THEN RETURN [FALSE];
IF pd.runningProcess # NIL THEN RETURN [FALSE];
pd.parent.runningProcs ← CONS[pd, pd.parent.runningProcs];
pd.parent.runCount ← pd.parent.runCount + 1;
RETURN [pd.running ← TRUE];
END;
UnRun: ENTRY PROC [ed: EltData] =
BEGIN ENABLE UNWIND => NULL;
pd: ProcData ← NARROW[ed];
pd.runningProcess ← NIL;
IF pd.parent.runningProcs.first = pd THEN pd.parent.runningProcs ← pd.parent.runningProcs.rest
ELSE BEGIN
procs: LIST OF ProcData;
FOR procs ← pd.parent.runningProcs, procs.rest WHILE procs.rest.first # pd DO NULL ENDLOOP;
procs.rest ← procs.rest.rest;
END;
pd.running ← FALSE;
pd.parent.runCount ← pd.parent.runCount - 1;
pd.userAbort ← 0;
END;
GetARunner: PROC [asAny: REF ANY] RETURNS [runner: ProcData] =
BEGIN
d: RecordViewer;
IF ISTYPE[asAny, ProcData] THEN RETURN [NARROW[asAny]];
d ← ViewRec.NarrowToRV[asAny];
IF d.runningProcs = NIL THEN RETURN [NIL];
runner ← d.runningProcs.first;
END;
ProcessAbort: PUBLIC ENTRY PROC [who: REF ANY] RETURNS [found: BOOLEAN] =
BEGIN
pd: ProcData ← GetARunner[who];
IF pd = NIL THEN RETURN [FALSE];
IF NOT pd.running THEN RETURN [FALSE];
TRUSTED {Process.Abort[LOOPHOLE[pd.runningProcess, UNSPECIFIED]]};
RETURN [TRUE];
END;
TestAndMaybeResetUserAbort: PUBLIC ENTRY PROC [who: REF ANY, threshold: CARDINAL] RETURNS [abort: CARDINAL --will be 0 or >= threshold--] =
BEGIN
pd: ProcData ← GetARunner[who];
IF pd = NIL THEN RETURN [0];
IF pd.userAbort >= threshold THEN
BEGIN
abort ← pd.userAbort;
pd.userAbort ← 0;
END
ELSE abort ← 0;
END;
TestUserAbort: PUBLIC ENTRY PROC [who: REF ANY] RETURNS [abort: CARDINAL] =
BEGIN
pd: ProcData ← GetARunner[who];
IF pd = NIL THEN RETURN [0];
abort ← pd.userAbort;
END;
SetUserAbort: PUBLIC ENTRY PROC [who: REF ANY, newLevel: CARDINAL ← 100] =
BEGIN
pd: ProcData ← GetARunner[who];
IF pd = NIL THEN RETURN;
pd.userAbort ← newLevel;
END;
IncrementUserAbortBy: PROC [pd: ProcData, deltaLevel: INTEGER] =
BEGIN
old: CARDINAL ← pd.userAbort;
pd.userAbort ← INT[MAX[MIN[INT[deltaLevel] + pd.userAbort, LAST[CARDINAL]], 0]];
SetMsg[pd,
IF old = pd.userAbort THEN "UserAbort pegged"
ELSE IF deltaLevel > 0 THEN IO.PutFR["UserAbort incremented to %g", IO.card[pd.userAbort]]
ELSE IF pd.userAbort > 0 THEN IO.PutFR["UserAbort decremented to %g", IO.card[pd.userAbort]]
ELSE "UserAbort cancelled"];
END;
IncrementUserAbort: PUBLIC PROC [who: REF ANY, deltaLevel: INTEGER] =
BEGIN
pd: ProcData ← GetARunner[who];
IF pd = NIL THEN RETURN;
pd.userAbort ← INT[MAX[MIN[INT[deltaLevel] + pd.userAbort, LAST[CARDINAL]], 0]];
END;
CallClient: PROC [pd: ProcData] =
BEGIN
ReallyDoit: PROC = TRUSTED {
Process.SetPriority[Process.priorityNormal];
ans ← AMEvents.Apply[control: pd.proc, args: pd.domainInst !
ABORTED =>
BEGIN
SetMsg[pd, "Aborted"];
event ← Abort; ok ← FALSE;
CONTINUE;
END;
UNWIND =>
BEGIN
SetMsg[pd, "Unwound"];
UnRun[pd];
ShowState[pd];
END];
};
event: Event ← Return;
ok: BOOLEANTRUE;
ans: TypedVariable;
IF pd = NIL THEN ERROR;
IF pd.parent = NIL THEN ERROR;
IF pd.parent.wDir # NIL
THEN ProcessProps.AddPropList[
propList: List.PutAssoc[
key: $WorkingDirectory,
val: pd.parent.wDir,
aList: NIL],
inner: ReallyDoit]
ELSE ReallyDoit[];
IF ok AND pd.hasRet THEN AMTypes.Assign[pd.retInst, ans];
UnRun[pd];
Poke[pd, event];
ShowState[pd];
END;
ImmProcButtonClass: PUBLIC PUB.Class ← PUB.MakeClass[[
proc: ProcButtonProc,
choices: LIST[
[$Invoke, "Invoke it"],
[$Invoke, "Invoke it"],
[$Invoke, "Invoke it"],
[$IncrementUserAbort, "Increment the degree of user abortion"],
[$ShowUserAbort, "Display the degree of user abortion"],
[$DecrementUserAbort, "Decrement the degree of user abortion"]
],
decodeShift: FALSE,
doc: "Control for a PROC"]];
PrepProcButtonClass: PUBLIC PUB.Class ← PUB.MakeClass[[
proc: ProcButtonProc,
choices: LIST[
[$Select, "Show arguments and results"],
[$Select, "Show arguments and results"],
[$Select, "Show arguments and results"],
[$IncrementUserAbort, "Increment the degree of user abortion"],
[$ShowUserAbort, "Display the degree of user abortion"],
[$DecrementUserAbort, "Decrement the degree of user abortion"]
],
decodeShift: FALSE,
doc: "Control for a PROC"]];
HoldProcButtonClass: PUBLIC PUB.Class ← PUB.MakeClass[[
proc: ProcButtonProc,
choices: LIST[
[$Select, "Show arguments and results"],
[$Select, "Show arguments and results"],
[$Select, "Show arguments and results"],
[$IncrementUserAbort, "Increment the degree of user abortion"],
[$ShowUserAbort, "Display the degree of user abortion"],
[$DecrementUserAbort, "Decrement the degree of user abortion"]
],
decodeShift: FALSE,
doc: "Control for a PROC"]];
ProcButtonProc: PROC [viewer: Viewer, instanceData, classData, key: REF ANY] --PUB.PopUpButtonProc-- = {
pd: ProcData = NARROW[instanceData];
old: ProcData ← pd.parent.curProc;
new: ProcData ← pd;
SetMsg[pd, clearMessagePlace];
IF NOT FinishPendingBusiness[] THEN RETURN;
IF old # new THEN
BEGIN
IF (IF old # NIL THEN old.argret # NIL ELSE FALSE) THEN
BEGIN
VO.MoveViewer[viewer: old.argret, x: nowhere, y: 0,
w: old.argret.ww, h: old.argret.wh, paint: new.argret = NIL];
old.argsShown ← FALSE;
END;
IF new.argret # NIL THEN
BEGIN
VO.MoveViewer[viewer: new.argret, x: 0, y: 0,
w: new.argret.ww, h: new.argret.wh];
new.argsShown ← TRUE;
END;
pd.parent.curProc ← new;
IF old # NIL THEN ShowState[old];
ShowState[new];
END;
SELECT key FROM
$IncrementUserAbort => {
IncrementUserAbortBy[pd, 100];
IF pd.userAbort >= 300 THEN [] ← ProcessAbort[pd.parent]};
$DecrementUserAbort => IncrementUserAbortBy[pd, -100];
$ShowUserAbort => SetMsg[pd, IO.PutFR[abortDocFmt, IO.card[pd.userAbort]]];
$Select => NULL;
$Invoke => TryToCall[pd];
ENDCASE => ERROR;
};
TryToCall: PROC [pd: ProcData] = TRUSTED
BEGIN
IF AMBridge.TVToProc[pd.proc] = NIL THEN SetMsg[pd, "Procedure Unbound!"]
ELSE IF Runnable[pd] THEN BEGIN
Poke[pd, Call];
ShowState[pd];
Process.Detach[pd.runningProcess ← FORK CallClient[pd]];
END
ELSE SetMsg[pd, "Busy"];
END;
InnerProcButtonClass: PUBLIC PUB.Class ← PUB.MakeClass[[
proc: InnerProcButtonProc,
doc: "Invoke the procedure"
]];
InnerProcButtonProc: PROC [viewer: Viewer, instanceData, classData, key: REF ANY] --PUB.PopUpButtonProc-- = {
pd: ProcData = NARROW[instanceData];
SetMsg[pd, clearMessagePlace];
IF pd = NIL THEN {SetMsg[pd, "InnerProcButtonProc invoked on NIL ProcData!"]; RETURN};
IF NOT FinishPendingBusiness[] THEN RETURN;
TryToCall[pd];
};
CallPD: PUBLIC PROC [data: REF ANY] = {
pd: ProcData = NARROW[data];
TryToCall[pd];
};
ProcUpdate: PUBLIC UpdateProc =
BEGIN
pd: ProcData ← NARROW[ed];
IF pd.argsShown THEN
BEGIN
IF pd.hasDom THEN SampleData[pd.argRV];
IF pd.hasRet THEN SampleData[pd.retRV];
END;
END;
CallSelectedProc: PUBLIC PROC [in: RecordViewer] RETURNS [refused: BOOLEAN] = TRUSTED
BEGIN
d: RecordViewer;
IF in = NIL THEN RETURN [TRUE];
d ← in;
IF (refused ← NOT FinishPendingBusiness[]) THEN RETURN;
IF d.curProc = NIL THEN ERROR NoSelectedProc[];
IF AMBridge.TVToProc[d.curProc.proc] = NIL THEN RETURN [TRUE];
IF (refused ← NOT Runnable[d.curProc]) THEN RETURN;
Poke[d.curProc, Call];
ShowState[d.curProc];
Process.Detach[d.curProc.runningProcess ← FORK CallClient[d.curProc]];
END;
NotherElt: PROC [ed: EltData, forward, mustBeMutable: BOOLEAN] RETURNS [new: SimpleData] =
BEGIN
Next: PROC [ed: EltData] RETURNS [fd: EltData] =
BEGIN
WHILE TRUE DO
v: Viewer;
IF ed = NIL THEN RETURN [NIL];
fd ← IF forward THEN ed.next ELSE ed.prev;
IF fd # NIL THEN RETURN;
v ← ed.parent.v;
IF (ed ← ed.parent.edParent) = NIL THEN BEGIN
FOR v ← v.parent, v.parent WHILE v # NIL DO
ed ← NARROW[VO.FetchProp[viewer: v, prop: $EltData]];
IF ed # NIL THEN EXIT;
ENDLOOP;
END;
ENDLOOP;
END;
starting: BOOLEANTRUE;
WHILE TRUE DO
IF ed = NIL THEN RETURN [NIL];
WITH ed SELECT FROM
sd: SimpleData => IF starting THEN {starting ← FALSE; ed ← Next[ed]}
ELSE IF ed.variable OR NOT mustBeMutable THEN RETURN [sd]
ELSE ed ← Next[ed];
cd: ComplexData => ed ← IF cd.handler.elementGiver = NIL THEN Next[ed] ELSE NARROW[cd.handler.elementGiver[agg: ed, which: NEW [INTIF forward THEN 1 ELSE -1], handlerData: cd.handlerData, clientData: cd.clientData]];
pd: ProcData => ed ← Next[ed];
ENDCASE => ERROR;
ENDLOOP;
END;
TiogaDoit: TiogaOps.CommandProc =
BEGIN
eda: REF ANYVO.FetchProp[viewer: viewer, prop: $EltData];
ed: EltData;
IF (IF eda = NIL THEN TRUE ELSE NOT ISTYPE[eda, EltData]) THEN RETURN [recordAtom: FALSE, quit: FALSE];
recordAtom ← FALSE; quit ← TRUE;
ed ← NARROW[eda];
SetMsg[ed, clearMessagePlace];
IF NOT FinishPendingBusiness[] THEN RETURN;
IF ed.parent.toButt.Proc # NIL THEN TRUSTED {Process.Detach[FORK CallToDo[ed]]};
END;
CallToDo: PROC [ed: EltData] =
BEGIN
TRUSTED {Process.SetPriority[Process.priorityNormal]};
ed.parent.toButt.Proc[ed.parent.toButt.data !ABORTED => {
SetMsg[ed, "Aborted"];
CONTINUE
}];
END;
TiogaClose: TiogaOps.CommandProc =
BEGIN
eda: REF ANYVO.FetchProp[viewer: viewer, prop: $EltData];
ed: EltData;
IF (IF eda = NIL THEN TRUE ELSE NOT ISTYPE[eda, EltData]) THEN RETURN [recordAtom: FALSE, quit: FALSE];
recordAtom ← FALSE; quit ← TRUE;
ed ← NARROW[eda];
SetMsg[ed, clearMessagePlace];
[] ← FinishPendingBusiness[];
END;
TiogaNext: TiogaOps.CommandProc =
BEGIN
eda: REF ANYVO.FetchProp[viewer: viewer, prop: $EltData];
ed: EltData;
ned: SimpleData;
IF (IF eda = NIL THEN TRUE ELSE NOT ISTYPE[eda, EltData]) THEN RETURN [recordAtom: FALSE, quit: FALSE];
recordAtom ← FALSE; quit ← TRUE;
ed ← NARROW[eda];
SetMsg[ed, clearMessagePlace];
IF NOT FinishPendingBusiness[] THEN RETURN;
ned ← NotherElt[ed, TRUE, TRUE];
IF ned = NIL THEN SetMsg[ed, "Ran off end!"]
ELSE BEGIN
Open[ned];
VT.EnableUserEdits[ned.valueText];
VT.SetSelection[ned.valueText];
toFinish ← [FinishNV, ned];
END;
END;
TiogaPrev: TiogaOps.CommandProc =
BEGIN
eda: REF ANYVO.FetchProp[viewer: viewer, prop: $EltData];
ed: EltData;
ned: SimpleData;
IF (IF eda = NIL THEN TRUE ELSE NOT ISTYPE[eda, EltData]) THEN RETURN [recordAtom: FALSE, quit: FALSE];
recordAtom ← FALSE; quit ← TRUE;
ed ← NARROW[eda];
SetMsg[ed, clearMessagePlace];
IF NOT FinishPendingBusiness[] THEN RETURN;
ned ← NotherElt[ed, FALSE, TRUE];
IF ned = NIL THEN SetMsg[ed, "Ran off end!"]
ELSE BEGIN
Open[ned];
VT.EnableUserEdits[ned.valueText];
VT.SetSelection[ned.valueText];
toFinish ← [FinishNV, ned];
END;
END;
TiogaGiveUp: TiogaOps.CommandProc =
BEGIN
eda: REF ANYVO.FetchProp[viewer: viewer, prop: $EltData];
sd: SimpleData;
IF (IF eda = NIL THEN TRUE ELSE NOT ISTYPE[eda, SimpleData]) THEN RETURN [recordAtom: FALSE, quit: FALSE];
recordAtom ← FALSE; quit ← TRUE;
sd ← NARROW[eda];
SetMsg[sd, clearMessagePlace];
IF NOT sd.opened THEN ERROR;
SetMsg[sd, "OK, I give up!"];
VT.InhibitUserEdits[sd.valueText];
DeOpen[sd];
ResetRope[sd];
toFinish ← [NIL, NIL];
END;
NVButtonClass: PUBLIC PUB.Class ← PUB.MakeClass[[
proc: NVButtonProc,
choices: LIST[
[$Open, "Edit the value"],
[$Selection, "Take the current Tioga selection as the value"],
[$SUCC, "Increment"],
[$ShowType, "Show the type of this variable or value"],
[NIL, NIL],
[$PRED, "Decrement"]
],
doc: "Operations on a variable whose value is presented textually"]];
NVButtonProc: PROC [viewer: Viewer, instanceData, classData, key: REF ANY] --PUB.PopUpButtonProc-- = {
sd: SimpleData = NARROW[instanceData];
SetMsg[sd, clearMessagePlace];
IF NOT FinishPendingBusiness[] THEN RETURN;
IF key # $ShowType AND NOT sd.variable THEN {
SetMsg[sd, "You can't change that."];
RETURN};
SELECT key FROM
$Open => {
Open[sd];
VT.EnableUserEdits[sd.valueText];
VT.SetSelection[sd.valueText];
toFinish ← [FinishNV, sd];
};
$Selection => [] ← Try[sd, VT.GetSelectionContents[], FALSE];
$SUCC, $PRED => WITH sd SELECT FROM
sd: SimpleData => BEGIN
new: TypedVariable;
msg: ROPE;
IF sd.handler.Butt = NIL THEN SetMsg[sd, "You can't SUCC or PRED that."]
ELSE BEGIN
[new, msg] ← sd.handler.Butt[sd.var, sd.targType, sd.handler, sd.handlerData, IF key = $SUCC THEN Succ ELSE Pred];
IF msg # NIL THEN SetMsg[sd, msg];
IF msg = NIL THEN
BEGIN
DoNotify: PROC = {
FOR nl: NotifyList ← sd.notifyRequests, nl.rest WHILE nl # NIL DO
nl.first.proc[nl.first.clientData];
ENDLOOP};
AMTypes.Assign[sd.var, new];
ShowRight[sd];
Poke[sd, Edit];
IF sd.parent.wDir = NIL
THEN DoNotify[]
ELSE ProcessProps.AddPropList[
propList: List.PutAssoc[
key: $WorkingDirectory,
val: sd.parent.wDir,
aList: NIL],
inner: DoNotify]
END;
END;
END;
ENDCASE => SetMsg[sd, "You can't SUCC or PRED that."];
$ShowType => SetMsg[sd, sd.typeDoc];
ENDCASE => ERROR;
};
ShowRight: ENTRY PROC [sd: SimpleData] = {
AMTypes.Assign[sd.old, sd.var];
IF sd.valueText # NIL THEN ResetRope[sd];
};
FinishNV: FinishProc =
BEGIN
sd: SimpleData ← NARROW[data];
[] ← Try[sd, VT.GetContents[sd.valueText], TRUE];
okToProceed ← TRUE;
VT.InhibitUserEdits[sd.valueText];
DeOpen[sd];
toFinish ← [NIL, NIL];
END;
Try: PROC [sd: SimpleData, asRope: ROPE, mightNeedRefresh: BOOLEAN]
RETURNS [success: BOOLEAN] =
BEGIN
Quick: ENTRY PROC RETURNS [success: BOOLEAN] =
BEGIN
IF (success ← sd.AssignRope[sd, asRope]) THEN
BEGIN
AMTypes.Assign[sd.old, sd.var];
IF sd.valueText # NIL THEN ResetRope[sd];
END
ELSE BEGIN
IF mightNeedRefresh AND sd.valueText # NIL THEN ResetRope[sd];
END;
END;
IF (success ← Quick[]) THEN
BEGIN
DoNotify: PROC = {
FOR nl: NotifyList ← sd.notifyRequests, nl.rest WHILE nl # NIL DO
nl.first.proc[nl.first.clientData];
ENDLOOP};
Poke[sd, Edit];
IF sd.parent.wDir = NIL
THEN DoNotify[]
ELSE ProcessProps.AddPropList[
propList: List.PutAssoc[
key: $WorkingDirectory,
val: sd.parent.wDir,
aList: NIL],
inner: DoNotify]
END
ELSE BEGIN
SetMsg[sd, Rope.Cat["Parse failed; please use a valid character string for a ", sd.typeDoc]];
END;
END;
ResetRope: PROC [sd: SimpleData] = INLINE {SetRope[sd, sd.ToRope[sd]]};
valuePostfix: ROPE ← "0 pt rightIndent";
SetRope: PUBLIC PROC [sd: SimpleData, to: ROPE, paint: BOOLEANTRUE] =
{IF NOT sd.destroyed THEN {
VT.SetContents[viewer: sd.valueText, contents: to, paint: FALSE];
TiogaOps.PutProp[TiogaOps.ViewerDoc[sd.valueText], $Postfix, valuePostfix];
IF paint THEN VO.PaintViewer[sd.valueText, all];
};
};
UpdateNV: PUBLIC ENTRY UpdateProc =
BEGIN
sd: SimpleData ← NARROW[ed];
IF (IF AMTypes.TVEqual[sd.old, sd.var] THEN always ELSE TRUE) THEN
BEGIN
AMTypes.Assign[sd.old, sd.var];
SetRope[sd, sd.ToRope[sd]];
END;
END;
UpdateComplex: PUBLIC UpdateProc =
BEGIN
News: ENTRY PROC RETURNS [news: BOOLEAN] =
{IF (news ← NOT AMTypes.TVEqual[ed.old, ed.var]) THEN AMTypes.Assign[ed.old, ed.var]};
IF (IF NOT ed.sampleable THEN FALSE ELSE IF News[] THEN TRUE ELSE always) THEN
BEGIN
cd: ComplexData ← NARROW[ed];
cd.handler.updater[tv: cd.var, v: cd.container, handlerData: cd.handlerData, clientData: cd.clientData];
END;
END;
SimpleToRope: PUBLIC ToRopeProc =
BEGIN
sd: SimpleData ← NARROW[ed];
asRope ← sd.handler.UnParse[sd.var, sd.targType, sd.handlerData];
END;
SimpleAssignRope: PUBLIC AssignRopeProc =
BEGIN
sd: SimpleData ← NARROW[ed];
IF NOT (success ← sd.handler.Parse[asRope, sd.wideAsTV, sd.targType, sd.handlerData]) THEN RETURN;
AMTypes.Assign[sd.var,
AMTypes.Coerce[sd.wideAsTV, sd.targType !
AMTypes.Error => {success ← FALSE; CONTINUE}]];
END;
BindAllOfATypeFromTVs: PUBLIC PROC [aggType, eltType: Type, name: ROPENIL, b: Binding] RETURNS [bl: BindingList] =
BEGIN
NameTest: PROC [i: CARDINAL] RETURNS [BOOLEAN] =
{RETURN [IF name = NIL OR recClass = sequence OR recClass = array THEN TRUE
ELSE name.Equal[AMTypes.IndexToName[aggType, i]]]};
eultType: Type ← AMTypes.UnderType[eltType];
recClass: AMTypes.Class;
len: CARDINAL;
aggType ← AMTypes.UnderType[aggType];
recClass ← AMTypes.TypeClass[aggType];
SELECT recClass FROM
record, structure => len ← AMTypes.NComponents[aggType];
sequence, array => len ← 1;
ENDCASE => ERROR NotAnAggregate[];
bl ← NIL;
FOR i: CARDINAL IN [1 .. len] DO
id: Id;
eType, cType: Type;
SELECT recClass FROM
record, structure => BEGIN
id ← NEW [INT ← i];
eType ← AMTypes.IndexToType[aggType, i];
END;
sequence, array => BEGIN
id ← all;
eType ← AMTypes.Range[aggType];
END;
ENDCASE => ERROR;
cType ← AMTypes.UnderType[eType];
IF SafeStorage.EquivalentTypes[cType, eultType] AND NameTest[i] THEN
{b.name ← id; bl ← CONS[b, bl]}
ELSE SELECT AMTypes.TypeClass[cType] FROM
procedure => BEGIN
domType: Type ← AMTypes.Domain[cType];
rangeType: Type ← AMTypes.Range[cType];
argBL, retBL: BindingList;
SELECT AMTypes.TypeClass[domType] FROM
nil => argBL ← NIL;
record, structure => argBL ← BindAllOfATypeFromTVs[domType, eltType, name, b];
ENDCASE => ERROR;
SELECT AMTypes.TypeClass[rangeType] FROM
nil => retBL ← NIL;
record, structure => retBL ← BindAllOfATypeFromTVs[rangeType, eltType, 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 ← BindAllOfATypeFromTVs[cType, eltType, name, b];
IF subList # NIL THEN bl ← CONS[[id, Group[subList]], bl];
END;
ENDCASE;
ENDLOOP;
END;
BindAllOfATypeFromRefs: PUBLIC PROC [rec, handle: REF ANY, name: ROPE, visible, editable, dontAssign: BOOLEANFALSE] RETURNS [BindingList] = TRUSTED
BEGIN
handleAsTV: TypedVariable ← AMBridge.TVForReferent[handle];
RETURN [BindAllOfATypeFromTVs[
aggType: AMTypes.UnderType[ AMTypes.TVType[ AMBridge.TVForReferent[ rec]]],
eltType: AMTypes.TVType[handleAsTV],
name: name,
b: [name: NIL, it: Value[val: handleAsTV, visible: visible, editable: editable, dontAssign: dontAssign]]]];
END;
ViewRef: PUBLIC PROC [agg: REF ANY,
specs: BindingList ← NIL,
label: Rope.ROPENIL,
otherStuff: OtherStuffProc ← NIL,
toButt: Closure ← [],
parent: RecordViewer ← NIL,
asElement: EltHandle ← NIL,
sample: BOOLEANTRUE,
createOptions: CreateOptions ← [],
viewerInit: ViewerClasses.ViewerRec ← [],
wDir: ROPENIL,
paint: BOOLEANTRUE]
RETURNS [rv: RecordViewer] = TRUSTED
BEGIN
RETURN [ViewRec.ViewTV[agg: AMBridge.TVForReferent[agg], specs: specs, label: label, otherStuff: otherStuff, toButt: toButt, parent: parent, asElement: asElement, sample: sample, createOptions: createOptions, viewerInit: viewerInit, wDir: wDir, paint: paint]];
END;
ViewInterface: PUBLIC PROC [name: ROPE,
specs: BindingList ← NIL,
label: ROPENIL,
otherStuff: OtherStuffProc ← NIL,
toButt: Closure ← [],
parent: RecordViewer ← NIL,
asElement: EltHandle ← NIL,
sample: BOOLEANTRUE,
createOptions: CreateOptions ← [],
viewerInit: ViewerClasses.ViewerRec ← [],
wDir: ROPENIL,
paint: BOOLEANTRUE] RETURNS [RecordViewer] = TRUSTED
BEGIN
RETURN [ViewRec.ViewTV[agg: AMMiniModel.GetInterfaceRecord[name, WorldVM.LocalWorld[]], specs: specs, label: label, otherStuff: otherStuff, toButt: toButt, parent: parent, asElement: asElement, sample: sample, createOptions: createOptions, viewerInit: viewerInit, wDir: wDir, paint: paint]];
END;
ViewSelf: PUBLIC PROC = TRUSTED
BEGIN
ift: Type ← AMTypes.TVType[AMMiniModel.GetInterfaceRecord["ViewRec", WorldVM.LocalWorld[]]];
[] ← ViewInterface[name: "ViewRec",
specs: BindAllOfATypeFromTVs[ift,
CODE[BOOLEAN],
"iconic",
[name: NIL,
it: Value[val: AMBridge.TVForReferent[NEW [BOOLEANFALSE]],
visible: TRUE,
editable: TRUE]]],
createOptions: [doAllRecords: TRUE],
viewerInit: [name: "ViewRec", iconic: FALSE, column: right]];
END;
Help: PUBLIC PROC =
BEGIN
[] ← VT.MakeNewTextViewer[info: [name: "ViewRec.doc", file: "ViewRec.doc", iconic: FALSE]];
END;
DestroyEltViewer: PUBLIC ENTRY ViewerClasses.DestroyProc =
BEGIN
ed: EltData ← NARROW[self.data];
ed.destroyed ← TRUE;
END;
Setup: PROC =
BEGIN
nvDocFmt ←
"Red => Open this component for editing,
Yellow => Take current Tioga Selection, and try to use it,
%gControl Shift Red, Yellow, or Blue => Gives the following description of what this should be: \"%g\"";
nvcDocFmt ←
"Control Shift Red, Yellow, or Blue => Gives the following description of what this should be: \"%g\"";
procDoc ← "Hitting me in any way will cause this PROCEDURE's Arguments and Results to be displayed; also:
Shift Left will increment abort urgency by 100 (and do a Process.Abort if it goes over 299).
Shift Middle will display the abort urgency.
Shift Right will decrement abort urgency by 100.";
selDoc ← "Hitting me in any way selects this PROCEDURE; also
Shift Left will increment abort urgency by 100 (and do a Process.Abort if it goes over 299).
Shift Middle will display the abort urgency.
Shift Right will decrement abort urgency by 100.";
butDoc ← "Not-Shifted Left, Middle, or Right will invoke this PROCEDURE.
Shift Left will increment abort urgency by 100 (and do a Process.Abort if it goes over 299).
Shift Middle will display abort urgency.
Shift Right will decrement abort urgency by 100.";
doitDocFmt[FALSE] ← "Hitting me will invoke %g (it takes no arguments)";
doitDocFmt[TRUE] ← "Hitting me will invoke %g with the given arguments";
abortDocFmt ← "Abort Urgency is %g";
transitions ← [
Other: [Edit: Other, Call: Dispatched, Return: Other, Abort: Other],
Dispatched: [Edit: DispatchedAndEdited, Call: Dispatched, Return: Returned, Abort: Aborted],
DispatchedAndEdited: [Edit: DispatchedAndEdited, Call: Dispatched, Return: Other, Abort: Other],
Returned: [Edit: Other, Call: Dispatched, Return: Other, Abort: Other],
Aborted: [Edit: Other, Call: Dispatched, Return: Other, Abort: Other]];
TiogaOps.RegisterCommand[name: $NextPlaceholder, proc: TiogaNext];
TiogaOps.RegisterCommand[name: $PreviousPlaceholder, proc: TiogaPrev];
TiogaOps.RegisterCommand[name: $CtrlPrevPlaceholder, proc: TiogaGiveUp];
TiogaOps.RegisterCommand[name: $CtrlNextPlaceholder, proc: TiogaClose];
TiogaOps.RegisterCommand[name: $InsertLineBreak, proc: TiogaClose];
TiogaOps.RegisterCommand[name: $Break, proc: TiogaDoit];
END;
Setup[];
END.