FILE: ViewRecOther.Mesa
last edited by Spreitzer April 25, 1985 12:59:11 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;
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;
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 ← "";
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: Data ← RVToData[rv];
e: Data ← 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: Data, 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
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: Data, 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: Data ← RVToData[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: Data;
IF ISTYPE[asAny, ProcData] THEN RETURN [NARROW[asAny]];
d ← RVToData[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;
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.asRV]};
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: Data;
IF in = NIL THEN RETURN [TRUE];
d ← RVToData[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.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 ANY ← LIST[$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 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;
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:
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: ButtonClick ← [],
parent: RecordViewer ← NIL,
asElement: EltHandle ← NIL,
sample: BOOLEAN ← TRUE,
createOptions: CreateOptions ← [],
viewerInit: ViewerClasses.ViewerRec ← [],
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, paint: paint]];
END;
ViewInterface:
PUBLIC
PROC [name:
ROPE,
specs: BindingList ← NIL,
label: ROPE ← NIL,
otherStuff: OtherStuffProc ← NIL,
toButt: ButtonClick ← [],
parent: RecordViewer ← NIL,
asElement: EltHandle ← NIL,
sample: BOOLEAN ← TRUE,
createOptions: CreateOptions ← [],
viewerInit: ViewerClasses.ViewerRec ← [],
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, 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.