ViewRecOther.Mesa
last edited by Spreitzer November 11, 1985 6:58:53 pm PST
DIRECTORY AMBridge, AMEvents, AMMiniModel, AMTypes, Buttons, Containers, Icons, IO, Labels, List, Menus, MessageWindow, Process, ProcessProps, Real, Rope, Rules, SafeStorage, TiogaOps, TIPUser, TypeProps, VFonts, ViewerOps, ViewerTools, ViewerClasses, ViewRec, ViewRecInsides, WorldVM;
ViewRecOther: CEDAR MONITOR
IMPORTS AMBridge, AMEvents, AMMiniModel, AMTypes, Buttons, IO, Labels, List, MessageWindow, Process, ProcessProps, Rope, SafeStorage, TiogaOps, TypeProps, VO:ViewerOps, VT:ViewerTools, ViewRec, ViewRecInsides, WorldVM
EXPORTS ViewRec, ViewRecInsides =
BEGIN OPEN 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;
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 ← "";
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
style: ATOM;
b: Buttons.Button;
WITH ed SELECT FROM
pd: ProcData =>
BEGIN
b ← pd.container;
style ← 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;
style ← IF NOT sd.variable THEN nameStyles.invariant
ELSE IF sd.opened THEN nameStyles.opened
ELSE nameStyles.quiescent;
END;
ENDCASE => ERROR;
Buttons.SetDisplayStyle[b, style, paint];
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;
ProcButtonProc: PUBLIC Menus.ClickProc =
BEGIN
pd: ProcData ← NARROW[clientData];
old: ProcData ← pd.parent.curProc;
new: ProcData ← pd;
SetMsg[pd, clearMessagePlace];
IF NOT FinishPendingBusiness[] THEN RETURN;
IF control THEN
BEGIN
SetMsg[pd, IF pd.hasDom OR pd.hasRet THEN procDoc ELSE IF pd.parent.holdOff THEN selDoc ELSE butDoc];
RETURN;
END;
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;
IF shift THEN
BEGIN
SELECT mouseButton FROM
red => {IncrementUserAbortBy[pd, 100]; IF pd.userAbort >= 300 THEN [] ← ProcessAbort[pd.parent]};
blue => IncrementUserAbortBy[pd, -100];
yellow => SetMsg[pd, IO.PutFR[abortDocFmt, IO.card[pd.userAbort]]];
ENDCASE => ERROR;
END
ELSE IF pd.parent.holdOff THEN NULL
ELSE IF NOT (pd.hasDom OR pd.hasRet) THEN TryToCall[pd];
END;
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;
InnerProcButtonProc: PUBLIC Menus.ClickProc =
BEGIN
pd: ProcData ← NARROW[clientData];
SetMsg[pd, clearMessagePlace];
IF pd = NIL THEN {SetMsg[pd, "InnerProcButtonProc invoked on NIL ProcData!"]; RETURN};
IF NOT FinishPendingBusiness[] THEN RETURN;
IF control THEN
BEGIN
SetMsg[pd, IO.PutFR[doitDocFmt[pd.hasDom], IO.rope[pd.name]]];
END
ELSE TryToCall[pd];
END;
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.button # NIL THEN TRUSTED {Process.Detach[FORK CallToDo[ed]]};
END;
CallToDo: PROC [ed: EltData] =
BEGIN
TRUSTED {Process.SetPriority[Process.priorityNormal]};
PushButton[ed.parent.toButt !ABORTED =>
BEGIN
SetMsg[ed, "Aborted"];
CONTINUE
END];
END;
PushButton: PROC [bc: ButtonClick] =
BEGIN
coords: TIPUser.TIPScreenCoords ← NEW [TIPUser.TIPScreenCoordsRec ← [mouseX: 1, mouseY: 1, color: bc.button.column = color]];
l: LIST OF REF ANYLIST[$Hit];
l ← CONS[SELECT bc.mouseButton FROM red => $Red, yellow => $Yellow, blue => $Blue, ENDCASE => ERROR, l];
IF bc.shift THEN l ← CONS[$Shift, l];
IF bc.control THEN l ← CONS[$Control, l];
l ← CONS[coords, CONS[$Mark, l]];
bc.button.class.notify[self: bc.button, input: l];
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;
NVButtonProc: PUBLIC Menus.ClickProc =
BEGIN
sd: SimpleData ← NARROW[clientData];
SetMsg[sd, clearMessagePlace];
IF NOT FinishPendingBusiness[] THEN RETURN;
IF control THEN SetMsg[sd,
IF shift THEN sd.typeDoc
ELSE IF NOT sd.variable THEN IO.PutFR[nvcDocFmt, IO.rope[sd.typeDoc]]
ELSE WITH sd SELECT FROM
sd: SimpleData => IO.PutFR[nvDocFmt, IO.rope[sd.handler.blueDoc], IO.rope[sd.typeDoc]],
ENDCASE => ERROR]
ELSE IF sd.variable THEN SELECT mouseButton FROM
red => BEGIN
IF shift THEN SetMsg[sd, "Don't do that"]
ELSE BEGIN
Open[sd];
VT.EnableUserEdits[sd.valueText];
VT.SetSelection[sd.valueText];
toFinish ← [FinishNV, sd];
END;
END;
yellow => BEGIN
IF shift THEN SetMsg[sd, "Don't do that"]
ELSE [] ← Try[sd, VT.GetSelectionContents[], FALSE];
END;
blue => WITH sd SELECT FROM
sd: SimpleData => BEGIN
new: TypedVariable;
msg: ROPE;
IF sd.handler.Butt = NIL THEN SetMsg[sd, "No meaning for NotCtl Right clicking that screen button (Ctl click it for help)."]
ELSE BEGIN
[new, msg] ← sd.handler.Butt[sd.var, sd.targType, sd.handler, sd.handlerData, shift];
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, "No meaning for NotCtl Right clicking that screen button (Ctl click it for help)."];
ENDCASE => ERROR
ELSE SetMsg[sd, "You can't change that."];
END;
ShowRight: ENTRY PROCEDURE [sd: SimpleData] =
BEGIN
AMTypes.Assign[sd.old, sd.var];
IF sd.valueText # NIL THEN ResetRope[sd];
END;
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: ButtonClick ← [],
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: ButtonClick ← [],
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.