FILE: ViewRecOther.Mesa
last edited by Spreitzer March 10, 1983 4:46 pm
Last Edited by: Maxwell, November 16, 1982 3:29 pm
DIRECTORY
AMBridge, AMTypes, Atom, RTTypesBasic, RTMiniModel, BBApply, Rope, ViewerClasses, ViewerOps, ViewerTools, ViewRec, ViewRecInsides, VFonts, Buttons, Containers, Labels, Rules, Process, UserTerminal, MessageWindow, IO, Icons, Real, ShowTime, Menus, TiogaOps;
ViewRecOther:
CEDAR
MONITOR
IMPORTS AMBridge, AMTypes, Atom, RTTypesBasic, BBApply, VO:ViewerOps, VT:ViewerTools, TiogaOps, Buttons, Labels, Rope, RTMiniModel, Process, UserTerminal, MessageWindow, IO, Real, ShowTime, ViewRec, ViewRecInsides
EXPORTS ViewRec, ViewRecInsides
SHARES Atom =
BEGIN OPEN ViewRecInsides;
NotARecord: 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;
behavior: PUBLIC ViewRec.BehaviorOptions ← [];
delayed: PUBLIC REAL ← 0;
roots: PUBLIC DataList ← NIL;
z: PUBLIC REAL ← 0;
transitions: ARRAY GregState OF ARRAY Event OF GregState;
nvDocFmt, recDocFmt, nvcDocFmt: ROPE;
procDoc, selDoc, butDoc: ROPE ← NIL;
doitDocFmt: ARRAY BOOLEAN OF ROPE ← ALL[NIL];
abortDocFmt: ROPE ← NIL;
toFinish: Pending;
activeCount, extantCount, eltCount: CARDINAL ← 0;
experimental: BOOLEAN ← FALSE;
clearMessagePlace: PUBLIC ROPE ← "flush here";
mwTotal: ROPE ← "";
OKProc:
PUBLIC
PROC [pt: Type, argSpecs, retSpecs: BindingList, doAllRecords:
BOOLEAN]
RETURNS [ok, hasDom, hasRange:
BOOLEAN] =
BEGIN
dom: Type ← AMTypes.Domain[pt];
range: Type ← AMTypes.Range[pt];
domArgs, rangeArgs: CARDINAL;
SELECT AMTypes.TypeClass[dom]
FROM
structure, record => [ok, domArgs] ←
SimpleEnough[dom, argSpecs, doAllRecords];
nil => {ok ← TRUE; domArgs ← 0};
ENDCASE => ok ← FALSE;
IF NOT ok THEN RETURN [FALSE, FALSE, FALSE];
SELECT AMTypes.TypeClass[range]
FROM
structure, record => [ok, rangeArgs] ←
SimpleEnough[range, retSpecs, doAllRecords];
nil => {ok ← TRUE; rangeArgs ← 0};
ENDCASE => ok ← FALSE;
IF NOT ok THEN RETURN [FALSE, FALSE, FALSE];
RETURN [ok, domArgs > 0, rangeArgs > 0];
END;
SimpleEnough:
PUBLIC
PROC [rt: Type, specs: BindingList, doAllRecords:
BOOLEAN]
RETURNS [ok:
BOOLEAN, count:
CARDINAL] =
BEGIN
count ← 0;
FOR i:
INTEGER
IN [1..AMTypes.NComponents[rt]]
DO
tt: Type ← AMTypes.IndexToType[rt, i];
t: Type ← AMTypes.GroundStar[tt];
val: TypedVariable;
sublist: BindingList;
ok, visible: BOOLEAN;
recers: RList;
[sublist, ,val, ok, visible, , , recers] ← SelectBindings[specs, AMTypes.IndexToName[rt, i], i];
count ← count + 1;
IF ok AND NOT visible THEN count ← count - 1
ELSE BEGIN
exception: BOOLEAN ← FALSE;
IF Recognize[t: t, specials: recers, onlyRecognize: TRUE].recognized THEN ok ← TRUE
ELSE
SELECT AMTypes.TypeClass[t]
FROM
record, structure =>
BEGIN
presentable: CARDINAL;
[ok, presentable] ← SimpleEnough[t, sublist, doAllRecords];
exception ← exception OR presentable < 1;
END;
ENDCASE => ok ← FALSE;
IF doAllRecords
THEN
{IF exception OR NOT ok THEN count ← count - 1}
ELSE IF NOT ok THEN RETURN [FALSE, 0]
ELSE IF exception THEN count ← count - 1;
END;
ENDLOOP;
ok ← TRUE;
END;
Recognize:
PUBLIC
PROC [t: Type, specials: RList, onlyRecognize:
BOOLEAN]
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, onlyRecognize];
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[Atom.TypeGetProp[type: t, prop: ecHandlerProp]]] THEN RETURN;
IF TryRecognizers[befores[StripSubranges]] THEN RETURN;
gt ← AMTypes.GroundStar[t];
IF TryRecognizers[NARROW[Atom.TypeGetProp[type: gt, prop: 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: BOOLEAN, notifies: NotifyList, recers: RList] =
BEGIN
sublist ← altSublist ← NIL;
found ← FALSE;
visible ← editable ← TRUE;
notifies ← NIL;
recers ← NIL;
FOR bl ← bl, bl.rest
WHILE bl #
NIL
DO
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 ← v.visible;
editable ← v.editable;
found ← TRUE};
e: Binding[Editable] => editable ← e.editable;
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;
Sample:
PROCEDURE =
BEGIN
oldPriority: ViewRec.DelayPriority ← behavior.delayParms.priority;
TRUSTED {Process.SetPriority[DPToP[oldPriority]]};
WHILE
TRUE
DO
parm: REAL;
asCard: CARDINAL;
start: ShowTime.Microseconds ← ShowTime.GetMark[];
IF behavior.delayParms.priority # oldPriority THEN TRUSTED {Process.SetPriority[DPToP[oldPriority ← behavior.delayParms.priority]]};
activeCount ← extantCount ← eltCount ← 0;
FOR r: DataList ← roots, r.rest
WHILE r #
NIL
DO
SampleData[r.first];
ENDLOOP;
BEGIN OPEN behavior.delayParms;
parm ←
MIN[max,
MAX[min,
offset + dActive*activeCount + dExtant*extantCount +
dElt*eltCount + dMicroseconds*ShowTime.SinceMark[start] ]];
END;
IF (z > 0)
AND (z < 1)
THEN
delayed ← (parm*(1-z) + delayed*z)
ELSE delayed ← parm;
asCard ← Real.RoundC[ABS[parm]];
IF behavior.delayParms.interp = Milliseconds
THEN
Process.Pause[Process.MsecToTicks[asCard]]
ELSE
FOR i:
CARDINAL ← 0, i+1
WHILE i < asCard
DO
TRUSTED {UserTerminal.WaitForScanLine[0]};
ENDLOOP;
ENDLOOP;
END;
DPToP:
PROC [dp: ViewRec.DelayPriority]
RETURNS [Process.Priority] =
INLINE
{
RETURN [
SELECT dp
FROM
Normal => Process.priorityNormal,
Background => Process.priorityBackground,
Foreground => Process.priorityForeground,
ENDCASE => ERROR]};
RedisplayElt:
PUBLIC
PROC [eh:
REF
ANY] =
BEGIN
ed: EltData ← NARROW[eh];
IF ed.update # NIL THEN ed.update[ed, TRUE];
END;
SampleData:
PROC [d: Data] =
BEGIN
IF d.destroyed OR d.v.iconic THEN {extantCount ← extantCount + 1; RETURN};
activeCount ← activeCount + 1;
FOR ed: EltData ← d.last, ed.prev
WHILE ed #
NIL
DO
IF ed.update # NIL THEN {eltCount ← eltCount + 1; ed.update[ed, FALSE]};
ENDLOOP;
END;
SampleRV:
PUBLIC
PROC [rv: RecordViewer] =
{SampleData[RVToData[rv]]};
GetEltHandle:
PUBLIC
PROC [rv: RecordViewer, name: ViewRec.Path]
RETURNS [eh:
REF
ANY] =
BEGIN
d: Data ← RVToData[rv];
e: Data ← NIL;
IF name = NIL THEN ERROR NotFound[name];
DO
ed: EltData ← Find[d, name.first];
IF ed = NIL AND e # NIL THEN ed ← Find[e, name.first];
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};
rd: RecordData => {d ← rd.d; e ← NIL};
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 =>
FOR ed ← d.first, ed.next
WHILE ed #
NIL
DO
IF idx = ri^ THEN RETURN [ed];
idx ← idx + 1;
ENDLOOP;
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;
IF ed.b = NIL THEN {Scream["ViewRec: This can't happen #2"]; RETURN};
SELECT ed.et
FROM
Proc =>
BEGIN
pd: ProcData ← NARROW[ed];
style ← IF pd.running THEN nameStyles.running
ELSE
IF pd.parent.highlightSelectedProc
AND pd.parent.curProc = pd THEN nameStyles.beingShown
ELSE nameStyles.quiescent;
END;
ENDCASE => style ←
IF
NOT ed.variable
THEN nameStyles.invariant
ELSE IF ed.opened THEN nameStyles.opened
ELSE nameStyles.quiescent;
Buttons.SetDisplayStyle[ed.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.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.running THEN RETURN [FALSE];
pd.parent.runningProc ← pd;
RETURN [pd.parent.running ← pd.running ← TRUE];
END;
UnRun:
ENTRY
PROC [ed: EltData] =
BEGIN
pd: ProcData ← NARROW[ed];
pd.parent.runningProc.runningProcess ← NIL;
pd.parent.runningProc ← NIL;
pd.parent.running ← pd.running ← FALSE;
pd.userAbort ← 0;
END;
ProcessAbort:
PUBLIC
ENTRY
PROC [rv: RecordViewer]
RETURNS [found:
BOOLEAN] =
BEGIN
data: Data;
IF rv = NIL THEN RETURN [FALSE];
data ← RVToData[rv];
IF data.runningProc = NIL THEN RETURN [FALSE];
TRUSTED {Process.Abort[data.runningProc.runningProcess]};
RETURN [TRUE];
END;
TestAndResetUserAbort:
PUBLIC
ENTRY
PROC [rv: RecordViewer, threshold:
CARDINAL]
RETURNS [abort:
CARDINAL
--will be 0 or >= threshold--] =
BEGIN
data: Data;
IF rv = NIL THEN RETURN [0];
data ← RVToData[rv];
IF data.runningProc = NIL THEN RETURN [0];
IF data.runningProc.userAbort >= threshold
THEN
BEGIN
abort ← data.runningProc.userAbort;
data.runningProc.userAbort ← 0;
END
ELSE abort ← 0;
END;
TestUserAbort:
PUBLIC
ENTRY
PROC [rv: RecordViewer]
RETURNS [abort:
CARDINAL] =
BEGIN
data: Data;
IF rv = NIL THEN RETURN [0];
data ← RVToData[rv];
IF data.runningProc = NIL THEN RETURN [0];
abort ← data.runningProc.userAbort;
END;
SetUserAbort:
PUBLIC
ENTRY
PROC [rv: RecordViewer, newLevel:
CARDINAL ← 100] =
BEGIN
data: Data;
IF rv = NIL THEN RETURN;
data ← RVToData[rv];
IF data.runningProc = NIL THEN RETURN;
data.runningProc.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 [rv: RecordViewer, deltaLevel:
INTEGER] =
BEGIN
data: Data;
IF rv = NIL THEN RETURN;
data ← RVToData[rv];
IF data.runningProc = NIL THEN RETURN;
data.runningProc.userAbort ← INT[MAX[MIN[INT[deltaLevel] + data.runningProc.userAbort, LAST[CARDINAL]], 0]];
END;
CallClient:
PROC [pd: ProcData] =
BEGIN
Use:
PROC [ret: TypedVariable] =
{IF pd.hasRet THEN AMTypes.Assign[pd.retInst, ret]};
event: Event ← Return;
IF pd = NIL THEN ERROR;
IF pd.parent = NIL THEN ERROR;
TRUSTED {Process.SetPriority[Process.priorityNormal]};
Use[BBApply.ApplyProcToRecord[proc: pd.proc, args: pd.domainInst !
ABORTED =>
BEGIN
SetMsg[pd, "Aborted"];
event ← Abort;
CONTINUE;
END;
UNWIND =>
BEGIN
SetMsg[pd, "Unwound"];
UnRun[pd];
ShowState[pd];
END]];
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 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
IF NOT shift THEN SetMsg[pd, IO.PutFR[doitDocFmt[pd.hasDom], IO.rope[pd.name]]]
ELSE
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 TryToCall[pd];
END;
ProcDoit:
PUBLIC DoitProc =
BEGIN
ed: EltData ← RVToData[rv].edParent;
WHILE NOT ISTYPE[ed, ProcData] DO ed ← ed.parent.edParent ENDLOOP;
TryToCall[NARROW[ed]];
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: EltData] =
BEGIN
Next:
PROC [ed: EltData]
RETURNS [fd: EltData] =
BEGIN
WHILE
TRUE
DO
IF ed = NIL THEN RETURN [NIL];
fd ← IF forward THEN ed.next ELSE ed.prev;
IF fd = NIL THEN ed ← ed.parent.edParent ELSE RETURN;
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 [ed]
ELSE ed ← Next[ed];
rd: RecordData => ed ← IF forward THEN rd.d.first ELSE rd.d.last;
cd: ComplexData => ed ← Next[ed];
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.toDo # NIL THEN TRUSTED {Process.Detach[FORK CallToDo[ed]]};
END;
CallToDo:
PROC [ed: EltData] =
BEGIN
TRUSTED {Process.SetPriority[Process.priorityNormal]};
ed.parent.toDo[ed.parent.asRV, ed.parent.toDoData !
ABORTED =>
BEGIN
SetMsg[ed, "Aborted"];
CONTINUE
END];
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, ned: 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;
ned ← NotherElt[ed, TRUE, TRUE];
IF ned = NIL THEN SetMsg[ed, "Ran off end!"]
ELSE
BEGIN
Open[ned];
VT.EnableUserEdits[ned.t];
VT.SetSelection[ned.t];
toFinish ← [FinishNV, ned];
END;
END;
TiogaPrev: TiogaOps.CommandProc =
BEGIN
eda: REF ANY ← VO.FetchProp[viewer: viewer, prop: $EltData];
ed, ned: 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;
ned ← NotherElt[ed, FALSE, TRUE];
IF ned = NIL THEN SetMsg[ed, "Ran off end!"]
ELSE
BEGIN
Open[ned];
VT.EnableUserEdits[ned.t];
VT.SetSelection[ned.t];
toFinish ← [FinishNV, ned];
END;
END;
TiogaGiveUp: 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 ed.opened THEN ERROR;
SetMsg[ed, "OK, I give up!"];
VT.InhibitUserEdits[ed.t];
DeOpen[ed];
VT.SetContents[ed.t, ed.ToRope[ed]];
toFinish ← [NIL, NIL];
END;
NVButtonProc:
PUBLIC Menus.ClickProc =
BEGIN
ed: EltData ← NARROW[clientData];
SetMsg[ed, clearMessagePlace];
IF NOT FinishPendingBusiness[] THEN RETURN;
IF control
THEN SetMsg[ed,
IF shift THEN ed.typeDoc
ELSE IF NOT ed.variable THEN IO.PutFR[nvcDocFmt, IO.rope[ed.typeDoc]]
ELSE
WITH ed
SELECT
FROM
sd: SimpleData => IO.PutFR[nvDocFmt, IO.rope[sd.handler.blueDoc], IO.rope[sd.typeDoc]],
rd: RecordData => IO.PutFR[recDocFmt, IO.rope[rd.typeDoc]],
ENDCASE => ERROR]
ELSE
IF ed.variable
THEN
SELECT mouseButton
FROM
red =>
BEGIN
IF shift OR ed.t = NIL THEN SetMsg[ed, "Don't do that"]
ELSE
BEGIN
Open[ed];
VT.EnableUserEdits[ed.t];
VT.SetSelection[ed.t];
toFinish ← [FinishNV, ed];
END;
END;
yellow =>
BEGIN
IF shift OR ed.t = NIL THEN SetMsg[ed, "Don't do that"]
ELSE [] ← Try[ed, VT.GetSelectionContents[], FALSE];
END;
blue =>
WITH ed
SELECT
FROM
sd: SimpleData =>
BEGIN
new: TypedVariable;
msg: ROPE;
IF sd.handler.Butt = NIL THEN SetMsg[ed, "Don't do that"]
ELSE
BEGIN
[new, msg] ← sd.handler.Butt[sd.var, sd.targType, sd.handler, sd.handlerData, shift];
IF msg # NIL THEN SetMsg[ed, msg];
IF msg =
NIL
THEN
BEGIN
AMTypes.Assign[sd.var, new];
Poke[ed, Edit];
FOR nl: NotifyList ← ed.notifyRequests, nl.rest
WHILE nl #
NIL
DO
nl.first.proc[nl.first.clientData];
ENDLOOP;
END;
END;
END;
ENDCASE => SetMsg[ed, "Don't do that"];
ENDCASE => ERROR
ELSE SetMsg[ed, "You can't change that!"];
END;
FinishNV: FinishProc =
BEGIN
ed: EltData ← NARROW[data];
[] ← Try[ed, VT.GetContents[ed.t], TRUE];
okToProceed ← TRUE;
VT.InhibitUserEdits[ed.t];
DeOpen[ed];
toFinish ← [NIL, NIL];
END;
Try:
PROC [ed: EltData, asRope:
ROPE, mightNeedRefresh:
BOOLEAN]
RETURNS [success: BOOLEAN] =
BEGIN
Quick:
ENTRY
PROC
RETURNS [success:
BOOLEAN] =
BEGIN
IF (success ← ed.AssignRope[ed, asRope])
THEN
BEGIN
AMTypes.Assign[ed.old, ed.var];
IF ed.t # NIL THEN VT.SetContents[ed.t, ed.ToRope[ed]];
END
ELSE
BEGIN
IF mightNeedRefresh AND ed.t # NIL THEN VT.SetContents[ed.t, ed.ToRope[ed]];
END;
END;
IF (success ← Quick[])
THEN
BEGIN
Poke[ed, Edit];
FOR nl: NotifyList ← ed.notifyRequests, nl.rest
WHILE nl #
NIL
DO
nl.first.proc[nl.first.clientData];
ENDLOOP;
END
ELSE
BEGIN
SetMsg[ed, Rope.Cat["That should have been a ", ed.typeDoc]];
END;
END;
SetRope:
PUBLIC
PROC [ed: EltData, to:
ROPE, paint:
BOOLEAN ←
TRUE] =
{
IF
NOT ed.destroyed
THEN
VT.SetContents[viewer: ed.t, contents: to, paint: paint]};
UpdateNV:
PUBLIC
ENTRY UpdateProc =
BEGIN
IF (
IF AMTypes.TVEqual[ed.old, ed.var]
THEN always
ELSE
TRUE)
THEN
BEGIN
AMTypes.Assign[ed.old, ed.var];
IF ed.t # NIL THEN SetRope[ed, ed.ToRope[ed]];
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 News[]
THEN
TRUE
ELSE always)
THEN
BEGIN
cd: ComplexData ← NARROW[ed];
cd.updater[tv: cd.var, v: cd.t, 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;
UpdateRecord:
PUBLIC UpdateProc =
BEGIN
rd: RecordData ← NARROW[ed];
IF (
IF AMTypes.TVEqual[rd.old, rd.var]
THEN always
ELSE
TRUE)
THEN
BEGIN
AMTypes.Assign[rd.old, rd.var];
SampleData[rd.d];
END;
END;
BindAllOfATypeFromTVs:
PUBLIC
PROC [recType: Type,
handle: TypedVariable, name:
ROPE ←
NIL, visible, editable:
BOOLEAN ←
FALSE]
RETURNS [bl: BindingList] =
BEGIN
NameTest:
PROC [i:
CARDINAL]
RETURNS [
BOOLEAN] =
{
RETURN [
IF name =
NIL
THEN
TRUE
ELSE name.Equal[AMTypes.IndexToName[recType, i]]]};
handsType: Type ← AMTypes.TVType[handle];
SELECT AMTypes.TypeClass[recType]
FROM
record, structure => NULL;
ENDCASE => ERROR NotARecord[];
bl ← NIL;
FOR i:
CARDINAL
IN [1..AMTypes.NComponents[recType]]
DO
Doit:
PROC [t: Type] =
BEGIN
b: BindingList ← BindAllOfATypeFromTVs[t, handle, name, visible, editable];
IF b # NIL THEN bl ← CONS[[ii, Group[b]], bl];
END;
ii: Int ← NEW [INT ← i];
cType: Type ← AMTypes.UnderType[AMTypes.IndexToType[recType, i]];
IF RTTypesBasic.EquivalentTypes[cType, handsType]
AND NameTest[i]
THEN
bl ← CONS[[ii, Value[handle, visible, editable]], 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, handle, name, visible, editable];
ENDCASE => ERROR;
SELECT AMTypes.TypeClass[rangeType]
FROM
nil => retBL ← NIL;
record, structure => retBL ← BindAllOfATypeFromTVs[rangeType, handle, name, visible, editable];
ENDCASE => ERROR;
IF argBL #
NIL
OR retBL #
NIL
THEN
bl ← CONS[[ii, Group[argBL, retBL]], bl];
END;
record, structure => Doit[cType];
ENDCASE;
ENDLOOP;
END;
BindAllOfATypeFromRefs:
PUBLIC
PROC [rec, handle:
REF
ANY, name:
ROPE, visible, editable:
BOOLEAN ←
FALSE]
RETURNS [BindingList] =
TRUSTED
BEGIN
RETURN [BindAllOfATypeFromTVs[
recType: AMTypes.UnderType[AMTypes.TVType[AMBridge.TVForReferent[rec]]],
handle: AMBridge.TVForReferent[handle],
name: name,
visible: visible, editable: editable]];
END;
ViewRef:
PUBLIC
PROC [rec:
REF
ANY,
specs: BindingList ← NIL,
label: Rope.ROPE ← NIL,
otherStuff: OtherStuffProc ← NIL,
toDo: DoitProc ← NIL,
toDoData: REF ANY ← NIL,
parent: RecordViewer ← NIL,
sample: BOOLEAN ← TRUE,
holdOff: BOOLEAN ← FALSE,
highlightSelectedProc: BOOLEAN ← TRUE,
createOptions: CreateOptions ← [],
viewerInit: ViewerClasses.ViewerRec ← [],
paint: BOOLEAN ← TRUE]
RETURNS [rv: RecordViewer] = TRUSTED
BEGIN
RETURN [ViewRec.ViewTV[rec: AMBridge.TVForReferent[rec],
specs: specs, label: label, otherStuff: otherStuff, toDo: toDo, toDoData: toDoData,
parent: parent, sample: sample,
holdOff: holdOff,
highlightSelectedProc: highlightSelectedProc,
createOptions: createOptions,
viewerInit: viewerInit, paint: paint]];
END;
ViewInterface:
PUBLIC
PROC [name:
ROPE,
specs: BindingList ← NIL,
label: ROPE ← NIL,
otherStuff: OtherStuffProc ← NIL,
toDo: DoitProc ← NIL,
toDoData: REF ANY ← NIL,
parent: RecordViewer ← NIL,
sample: BOOLEAN ← TRUE,
holdOff: BOOLEAN ← FALSE,
highlightSelectedProc: BOOLEAN ← TRUE,
createOptions: CreateOptions ← [],
viewerInit: ViewerClasses.ViewerRec ← [],
paint: BOOLEAN ← TRUE] RETURNS [RecordViewer] =
BEGIN
RETURN [ViewRec.ViewTV[rec: RTMiniModel.AcquireIRInstance[name],
specs: specs, label: label, otherStuff: otherStuff, toDo: toDo, toDoData: toDoData,
parent: parent, sample: sample,
holdOff: holdOff, highlightSelectedProc: highlightSelectedProc,
createOptions: createOptions,
viewerInit: viewerInit, paint: paint]];
END;
ViewSelf:
PUBLIC
PROC =
TRUSTED
BEGIN
ift: Type ← AMTypes.TVType[RTMiniModel.AcquireIRInstance["ViewRec"]];
[] ← ViewInterface[name: "ViewRec",
specs: BindAllOfATypeFromTVs[ift,
AMBridge.TVForReferent[NEW [BOOLEAN ← FALSE]],
"iconic", TRUE, TRUE],
createOptions: [doAllRecords: TRUE],
viewerInit: [name: "ViewRec", iconic: FALSE, column: right]];
END;
SetBehavior:
PUBLIC
PROC [newBehavior: ViewRec.BehaviorOptions ← []] =
{behavior ← newBehavior};
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\"";
recDocFmt ←
"Control Shift Red, Yellow, or Blue => Describe the TYPE of this component (%g)";
nvcDocFmt ←
"Control Shift Red, Yellow, or Blue => Gives the following description of what this should be: \"%g\"";
procDoc ← "Hitting me will cause this PROCEDURE's Arguments and Results to be displayed";
selDoc ← "Hitting me selects this PROCEDURE";
butDoc ← "Hitting me will invoke this PROCEDURE";
doitDocFmt[FALSE] ←
"Control Shift Red => increment UserAbort (Process.Abort when 300 reached),
Control Shift Blue => decrement UserAbort,
Control Shift Yellow => inquire about UserAbort,
Red, Yellow, or Blue => invoke %g (it takes no arguments)";
doitDocFmt[TRUE] ←
"Control Shift Red => increment UserAbort (Process.Abort when 300 reached),
Control Shift Blue => decrement UserAbort,
Control Shift Yellow => inquire about UserAbort,
Red, Yellow, or Blue => invoke %g with the given arguments";
abortDocFmt ← "UserAbort 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]];
TRUSTED {Process.Detach[FORK Sample[]]};
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.