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 ANY ← NIL];
FinishProc: TYPE = ViewRec.FinishProc;
NameStyles:
TYPE =
RECORD [quiescent, opened, invariant, running, beingShown:
PUB.Colors];
all: PUBLIC REF ANY ← NEW [REAL ← 47];
transitions: ARRAY GregState OF ARRAY Event OF GregState;
nvDocFmt, nvcDocFmt: ROPE;
procDoc, selDoc, butDoc: ROPE ← NIL;
doitDocFmt: ARRAY BOOLEAN OF ROPE ← ALL[NIL];
abortDocFmt: ROPE ← NIL;
toFinish: Pending;
experimental: BOOLEAN ← FALSE;
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
ANY ←
NIL] =
{toFinish ← [proc, data]};
ShowState:
PUBLIC
PROC [ed: EltData, paint:
BOOLEAN ←
TRUE] =
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: BOOLEAN ← TRUE;
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: BOOLEAN ← TRUE;
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 [INT ← IF 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 ANY ← VO.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 ANY ← VO.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 ANY ← VO.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 ANY ← VO.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 ANY ← VO.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:
BOOLEAN ←
TRUE] =
{
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:
ROPE ←
NIL, 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:
BOOLEAN ←
FALSE]
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.ROPE ← NIL,
otherStuff: OtherStuffProc ← NIL,
toButt: Closure ← [],
parent: RecordViewer ← NIL,
asElement: EltHandle ← NIL,
sample: BOOLEAN ← TRUE,
createOptions: CreateOptions ← [],
viewerInit: ViewerClasses.ViewerRec ← [],
wDir: ROPE ← NIL,
paint: BOOLEAN ← TRUE]
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: ROPE ← NIL,
otherStuff: OtherStuffProc ← NIL,
toButt: Closure ← [],
parent: RecordViewer ← NIL,
asElement: EltHandle ← NIL,
sample: BOOLEAN ← TRUE,
createOptions: CreateOptions ← [],
viewerInit: ViewerClasses.ViewerRec ← [],
wDir: ROPE ← NIL,
paint: BOOLEAN ← TRUE] 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 [
BOOLEAN ←
FALSE]],
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.