general viewer control
following remarks are copied from a version of RemoteDriver2
(Note: we generally depend on MBQueues to control access to the data body. However, in order to use a condition variable we need to be inside a monitor. So, we have added sufficient structure to have an object monitor. On the other hand, we do not enter the monitor except in a few places.)
A few notes are in order about serialization. There are three mechanisms. The button queue controls access to MyViewerDataBody for major changes. The MainActionProc (a forked process) serializes access to the typescript. (any action that might produce text for d.out must be performed by the MainActionProc, this includes calls to the connection which carry a report parameter.) This arrangement is hoped to lead to proper interleaving of text in the typescript. Finally, an object monitor in RemoteCirioImpl will control access to the connection. For the moment, this includes calls to flush the FlushUnknownMobCache.
Perhaps it will be more convenient later to serialize all viewer related code through MainActionProc. We shall see. In which case, perhaps the buttons need not be on an mbQueue.
Note: The viewer is shut down in several steps
1) The user clicks Destroy
2) Our DestroyProc gets called, sets d.destroy ← TRUE and checks d.okToDestroy. It will be FALSE. Our DestroyProc queues a button action: ViewerGoingAwayAction.
3) Eventually the first instance of ViewerGoingAwayAction runs. It checks d.okToDestroy. If will be FALSE. It sets d.okToDestroy ← TRUE, calls ViewerOps.DestroyViewer[d.self], and calls RemoteCirio.CloseConnection[d.connection]. (This last call may hang up, but so be it.)
4) Our DestroyProc will get called again, but it will find d.okToDestroy = TRUE, and will allow the destruction to proceed.
5) If any subsequent instance of ViewerGoingAwayAction runs, it will find d.okToDestroy = TRUE and simply return.
6) Any action finding d.destroy = TRUE should act as a no-op.
7) The MainActionProc should not interpret any text if d.destroy = TRUE. (However, it should continue to call action procs, so that ViewerGoingAwayAction can execute.) It should exit if it finds d.okToDestroy = TRUE.
CreateViewer:
PUBLIC
PROC
[
name: Rope.ROPE,
scriptY: CARD,
formatPrompt: PROC [counter: INT, clientData: REF ANY] RETURNS [Rope.ROPE],
interpretTextLine: PROC[line: Rope.ROPE, reports: IO.STREAM, clientData: REF ANY] RETURNS[Rope.ROPE],
shutDown: PROC[clientData: REF ANY, reports: IO.STREAM],
clientData: REF ANY]
RETURNS[CirioButtons.ViewerControl] =
BEGIN
v: ViewerClasses.Viewer = Containers.Create[
info: [name: name, column: right, scrollable: FALSE, iconic: TRUE]];
vc: CirioButtons.ViewerControl ¬
NEW[CirioButtons.ViewerControlBody¬[
destroyStarted: FALSE,
okToDestroy: FALSE,
self: v,
script: NIL, -- temporary
in: NIL, --temporary
out: NIL, --temporary
mbQueue: MBQueue.Create[],
nextButtonAction: NIL,
lastButtonAction: NIL,
formatPrompt: formatPrompt,
interpretTextLine: interpretTextLine,
shutDown: shutDown,
clientData: clientData
]];
sample: ButtonSize ¬ GetButtonSize["SampleText"];
ViewerOps.AddProp[v, $CirioTool, vc];
vc.script ¬ TypeScript.Create[
info: [parent: v, wh: v.ch-scriptY, ww: v.cw, border: FALSE, wy: scriptY, wx: 0] ];
Containers.ChildXBound[v, vc.script];
Containers.ChildYBound[v, vc.script];
[in: vc.in, out: vc.out] ¬ ViewerIO.CreateViewerStreams[NIL, vc.script];
ViewerOps.SetOpenHeight[v, scriptY + 10 * sample.h];
ViewerOps.OpenIcon[v];
TRUSTED{Process.Detach[FORK MainActionProc[vc]]};
END;
will be forked and detached
runs outside the mbQueue
MainActionProc:
PUBLIC
PROC[control: CirioButtons.ViewerControl] = {
ENABLE
UNWIND => {
-- the world is unexpectedly comming to an end
control.destroyStarted ¬ TRUE;
ViewerGoingAwayInternal[control];
};
MainActionProcInner[control]; -- so that address faults will ultimately lead to cleanups
IF control.self # NIL THEN ViewerOps.DestroyViewer[control.self];
control.self ¬ NIL;
};
MainActionProcInner:
PROC[control: CirioButtons.ViewerControl] =
BEGIN
counter: CARD ¬ 1;
DO
streamClosed: BOOLEAN ¬ FALSE;
rubout: BOOLEAN ¬ FALSE;
prompt, line: Rope.ROPE ¬ NIL;
we put out an appropriate herald
IF
NOT control.destroyStarted
THEN {
prompt ¬ control.formatPrompt[counter, control.clientData];
IO.PutRope[control.out, prompt]};
now, we collect a line to examine
line ¬
IO.GetLineRope[control.in !
IO.Error =>
{IF ec = StreamClosed THEN streamClosed ¬ TRUE; line ¬ ""; CONTINUE};
IO.Rubout =>
{rubout ¬ TRUE; CONTINUE}];
IF streamClosed THEN EXIT;
IF rubout
THEN
BEGIN
looksItalic: Rope.ROPE ~ "ABCDEFGHiJKLMNOPQRSTUVWXYZ";
IO.PutF[control.out, "%l -- <DEL>%l\n", [rope[looksItalic]], [rope["I"]]]; IO.Reset[control.in];
line ¬ "";
END;
first we interpret any text in line
IF
NOT control.destroyStarted
AND
NOT Rope.IsEmpty[line]
AND
NOT Rope.Equal[line, "\n"]
THEN
BEGIN
IO.PutF1[control.out, " %g\n", IO.rope[control.interpretTextLine[prompt.Concat[line], control.out, control.clientData]]];
line ¬ NIL;
counter ¬ counter + 1;
END;
now we check for button actions
FOR action: ButtonAction ¬ GetNextButtonAction[control], GetNextButtonAction[control]
WHILE action #
NIL
DO
action.action[action];
IO.Reset[control.in]; -- kill any type-ahead, this must be done before the next GetNextButtonAction, so that if it returns NIL we will be guaranteed of being notified when any subsequent button action is queued.
ENDLOOP;
IF control.okToDestroy THEN EXIT;
ENDLOOP;
END;
Stack debug buttons
WalkStackButtonData: TYPE = REF WalkStackButtonDataBody;
WalkStackButtonDataBody:
TYPE =
RECORD[
stack: StackCirio.Stack,
threadIndexText: Rope.ROPE,
frameLabel: ViewerClasses.Viewer];
InstallWalkStackButton:
PUBLIC
PROC[bs: ButtonSet, stack: StackCirio.Stack, threadIndexText: Rope.
ROPE, frameIndexLabel: ViewerClasses.Viewer] =
BEGIN
wsbd: WalkStackButtonData ¬ NEW[WalkStackButtonDataBody¬[stack, threadIndexText, frameIndexLabel]];
[] ¬ InstallCommandButton[
bs: bs, name: "WalkStack", clientData1: wsbd,
choices:
LIST[
[LIST[$Cooler, aOne, $C], "walk to next cooler C frame"],
[LIST[$Ith, aOne, $C], "walk to C frame 1"],
[LIST[$Warmer, aOne, $C], "walk to next warmer C frame"],
[LIST[$Cooler, $Sel, $C], "walk to [tioga selection]'th cooler C frame"],
[LIST[$Ith, $Sel, $C], "walk to C frame [tioga selection]"],
[LIST[$Warmer, $Sel, $C], "walk to [tioga selection]'th warmer C frame"],
[LIST[$Cooler, aOne, $Cedar], "walk to next cooler Cedar frame"],
[LIST[$Ith, aOne, $Cedar], "walk to Cedar frame 1"],
[LIST[$Warmer, aOne, $Cedar], "walk to next warmer Cedar frame"],
[LIST[$Cooler, $Sel, $Cedar], "walk to [tioga selection]'th cooler Cedar frame"],
[LIST[$Ith, $Sel, $Cedar], "walk to Cedar frame [tioga selection]"],
[LIST[$Warmer, $Sel, $Cedar], "walk to [tioga selection]'th warmer Cedar frame"],
],
proc1: WalkStackAction1, proc2: WalkStackAction2];
END;
aOne: ATOM ~ Atom.MakeAtom["1"];
WalkStackAction1:
PROC[button: ViewerClasses.Viewer, vc: CirioButtons.ViewerControl, key, clientData1:
REF
ANY]
RETURNS[clientData2:
REF
ANY] =
BEGIN
rope: Rope.ROPE ¬ ViewerTools.GetSelectionContents[];
IF rope = NIL THEN RETURN[NIL] ELSE
RETURN[NEW[RopeHolder ¬ rope]];
END;
RopeHolder: TYPE = Rope.ROPE;
WalkStackAction2:
PROC[button: ViewerClasses.Viewer, vc: CirioButtons.ViewerControl, key, clientData1, clientData2:
REF
ANY] =
BEGIN
keys: LIST OF REF ANY ~ NARROW[key];
key1: REF ANY ~ keys.first;
key2: REF ANY ~ keys.rest.first;
key3: REF ANY ~ keys.rest.rest.first;
wsbd: WalkStackButtonData ~ NARROW[clientData1];
selectedNumber: INT ~ IF key2=$Sel THEN NumbFromClientData2[] ELSE 1;
out: IO.STREAM ¬ vc.out;
stack: StackCirio.Stack ¬ wsbd.stack;
NumbFromClientData2:
PROC
RETURNS[
INT] =
BEGIN
ropeHolder: REF RopeHolder ¬ NARROW[clientData2];
rope: Rope.ROPE ¬ IF ropeHolder = NIL THEN NIL ELSE ropeHolder;
val: INT ¬ 1; -- tentative
val ¬ Convert.IntFromRope[rope
! Convert.Error => CONTINUE];
RETURN[val];
END;
newIndex: CARD;
IF stack =
NIL
THEN
{IO.PutRope[out, "no current stack\N"]; RETURN};
IF key3=$Cedar
THEN
-- work in terms of Cedar frames
BEGIN
IF key1=$Ith
THEN
-- moving to specific Cedar frame
BEGIN
targetFrame: INT ¬ selectedNumber;
hotFrame: CARD ¬ StackCirio.ResetStack[stack, out];
actualNCedarFramesFromHot: INT;
IO.PutF1[out, "Walking to Cedar frame %g ...", IO.int[targetFrame]];
[actualNCedarFramesFromHot, newIndex] ¬ StackCirio.WalkStackCedarFrames[stack, targetFrame, out];
IO.PutF[out, "walked %g Cedar frame%g to (C)frame %g\N", IO.int[actualNCedarFramesFromHot], IO.rope[IF actualNCedarFramesFromHot = 1 THEN "" ELSE "s"], IO.card[newIndex]];
END
ELSE
-- moving to relative Cedar frame
BEGIN
actualNCedarFrames: INT;
change:
INT ¬
SELECT key1
FROM
$Cooler => selectedNumber,
$Warmer => -selectedNumber,
ENDCASE => CCE[cirioError]; -- hmm, who will catch this?;
IO.PutF1[out, "Walking %g Cedar frames ...", IO.int[change]];
[actualNCedarFrames, newIndex] ¬ StackCirio.WalkStackCedarFrames[stack, change, out];
IO.PutF[out, "walked %g Cedar frame%g to (C)frame %g\N", IO.int[actualNCedarFrames], IO.rope[IF actualNCedarFrames = 1 THEN "" ELSE "s"], IO.card[newIndex]];
IF actualNCedarFrames # change
THEN
IO.PutF1[out, " (end of stack reached after %g Cedar frames)\n", IO.int[actualNCedarFrames]];
END;
END
ELSE
BEGIN
IF key1=$Ith
THEN
-- moving to specific (C) frame
BEGIN
targetFrame: INT ¬ selectedNumber;
startingFrameIndex: CARD ¬ StackCirio.WalkStack[stack, 0, out].newFrameIndex;
neededMove: INT ¬ selectedNumber-startingFrameIndex;
actualMove: INT;
IO.PutF1[out, "Walking to frame %g ...", IO.int[targetFrame]];
[actualMove, newIndex] ¬ StackCirio.WalkStack[stack, neededMove, out];
IO.PutF[out, "walked %g frame%g to frame %g\N", IO.int[actualMove], IO.rope[IF actualMove = 1 THEN "" ELSE "s"], IO.card[newIndex]];
IF actualMove # neededMove
THEN
IO.PutF1[out, " (end of stack reached after %g frames)\n", IO.int[actualMove]];
END
ELSE
-- moving to relative frame
BEGIN
change:
INT ¬
SELECT key1
FROM
$Cooler => selectedNumber,
$Warmer => -selectedNumber,
ENDCASE => CCE[cirioError]; -- hmm, who will catch this?;
actualMove: INT;
IO.PutF1[out, "Walking %g frames ...", IO.int[change]];
[actualMove, newIndex] ¬ StackCirio.WalkStack[stack, change, out];
IO.PutF[out, "walked %g frame%g to frame %g\N", IO.int[actualMove], IO.rope[IF actualMove = 1 THEN "" ELSE "s"], IO.card[newIndex]];
IF actualMove # change
THEN
IO.PutF1[out, " (end of stack reached after %g frames)\n", IO.int[actualMove]];
END;
END;
IO.PutF1[out, " %g\n", IO.rope[StackCirio.GetCurrentFrameBanner[stack, out]]];
Labels.Set[wsbd.frameLabel, Rope.Cat["frame: ", wsbd.threadIndexText, Convert.RopeFromCard[newIndex]]];
END;
StackButtonData: TYPE = REF StackButtonDataBody;
StackButtonDataBody:
TYPE =
RECORD[
stack: StackCirio.Stack];
InstallShowFrameButton:
PUBLIC
PROC[bs: ButtonSet, stack: StackCirio.Stack] =
BEGIN
sbd: StackButtonData ¬ NEW[StackButtonDataBody¬[stack]];
[] ¬ InstallCommandButton[bs: bs, name: "ShowFrame", clientData1: sbd, proc2: ShowFrameAction];
END;
ShowFrameAction:
PROC[button: ViewerClasses.Viewer, vc: CirioButtons.ViewerControl, key, clientData1, clientData2:
REF
ANY] = {
sbd: StackButtonData ¬ NARROW[clientData1];
out: IO.STREAM ¬ vc.out;
stack: StackCirio.Stack ¬ sbd.stack;
IF stack = NIL THEN {IO.PutRope[out, "no current stack\N"]; RETURN};
IO.PutRope[out, "Showing frame:\n"];
out.PutRope[StackCirio.ShowCurrentFrame[stack, out]];
out.PutChar['\n]};
InstallSourcePositionButton:
PUBLIC
PROC[bs: ButtonSet, stack: StackCirio.Stack] =
BEGIN
sbd: StackButtonData ¬ NEW[StackButtonDataBody¬[stack]];
[] ¬ InstallCommandButton[bs: bs, name: "SourcePosition", clientData1: sbd, proc2: SourcePositionAction];
END;
SourcePositionAction:
PROC[button: ViewerClasses.Viewer, vc: CirioButtons.ViewerControl, key, clientData1, clientData2:
REF
ANY] =
BEGIN
sbd: StackButtonData ¬ NARROW[clientData1];
out: IO.STREAM ¬ vc.out;
stack: StackCirio.Stack ¬ sbd.stack;
IF stack = NIL THEN {IO.PutRope[out, "no current stack\N"]; RETURN};
IO.PutRope[out, "Showing source ... "];
StackCirio.ShowSourcePosition[stack, out];
IO.PutRope[out, " done.\n"];
END;
Install
SourceLanguageButton:
PUBLIC
PROC[bs: ButtonSet, stack: StackCirio.Stack] =
BEGIN
sbd: StackButtonData ¬ NEW[StackButtonDataBody¬[stack]];
[] ¬ InstallCommandButton[bs: bs, name: "Language", clientData1: sbd, proc2: LanguageAction, choices: LIST[[$Cedar, "Set desired language to Cedar"], [$Machine, "Set desired language to Machine"], [$C, "Set desired language to C"], [$Query, "Report the current desired language"], [$Query, "Report the current desired language"], [$Query, "Report the current desired language"]] ];
END;
LanguageAction:
PROC[button: ViewerClasses.Viewer, vc: CirioButtons.ViewerControl, key, clientData1, clientData2:
REF
ANY] =
BEGIN
sbd: StackButtonData ¬ NARROW[clientData1];
out: IO.STREAM ¬ vc.out;
stack: StackCirio.Stack ¬ sbd.stack;
IF stack = NIL THEN {IO.PutRope[out, "no current stack\N"]; RETURN};
SELECT key
FROM
$C => StackCirio.SetDesiredLanguage[stack, $C, out];
$Cedar => StackCirio.SetDesiredLanguage[stack, $Cedar, out];
$Machine => StackCirio.SetDesiredLanguage[stack, $Machine, out];
$Query => [] ¬ StackCirio.ReportDesiredLanguage[stack, out];
ENDCASE => out.PutRope["\nLanguageAction[Unrecognized key]\n"];
END;
viewer destruction etc
the tool viewer is going away, so we should close the connection
what about race conditions, monitor locks, button queues etc?
NOTE: (UGH) this procedure gets called when ANY viewer is destroyed. It is not an "object" procedure. Thus, the property search is potentially long, since I may be presented with a viewer with a long property list. (Unless viewers was smart enough to use a hash table??). If viewers doesn't hash, then I should hash from viewer ref to MyViewerData.
DestroyProc:
PROC [viewer: ViewerClasses.Viewer, event: ViewerEvents.ViewerEvent, before:
BOOL]
RETURNS [abort:
BOOL ¬
FALSE]
--ViewerEvents.EventProc-- = {
data: REF ANY ¬ ViewerOps.FetchProp[viewer, $CirioTool];
IF data #
NIL
THEN
WITH data
SELECT
FROM
vc: CirioButtons.ViewerControl => {
vc.destroyStarted ¬ TRUE; -- this should stop all but what ever action that might be currently underway
IF
NOT vc.okToDestroy
THEN {
QueueButtonAction[vc, NEW[ButtonActionBody¬[ViewerGoingAwayAction, NEW[ViewerGoingAwayActionBody¬[vc]], TRUE]]];
RETURN[TRUE] -- don't let it be destroyed on this pass
};
};
ENDCASE => NULL; -- happens when earlier versions of the tool are hanging around
};
ViewerGoingAwayActionBody:
TYPE =
RECORD[
vc: CirioButtons.ViewerControl];
ViewerGoingAwayAction:
PROC[action: ButtonAction] =
BEGIN
data: REF ViewerGoingAwayActionBody ¬ NARROW[action.data];
ViewerGoingAwayInternal[data.vc];
END;
ViewerGoingAwayInternal:
PROC[vc: CirioButtons.ViewerControl] =
BEGIN
IF NOT vc.destroyStarted THEN ERROR; -- should have been set before our action was queued
IF
NOT vc.okToDestroy
THEN
BEGIN
vc.okToDestroy ¬ TRUE; -- thus we should make only one actual attempt to destroy
vc.shutDown[vc.clientData, vc.out
!UNWIND => IF vc.self # NIL THEN ViewerOps.DestroyViewer[vc.self]];
IF vc.self # NIL THEN ViewerOps.DestroyViewer[vc.self];
vc.self ¬ NIL;
END;
END;
Button installation procedures
ButtonSet: TYPE = CirioButtons.ButtonSet;
ButtonSetBody: TYPE = CirioButtons.ButtonSetBody;
ButtonSize: TYPE = CirioButtons.ButtonSize;
CreateButtonSet:
PUBLIC
PROC[container: ViewerClasses.Viewer, vc: CirioButtons.ViewerControl, x, y:
CARD, colX:
CARD, lineH:
CARD, fixedWidth:
CARD ¬ 0]
RETURNS[ButtonSet] =
{RETURN[NEW[CirioButtons.ButtonSetBody¬[container, vc, TRUE, x, y, colX, lineH, fixedWidth]]]};
KillButtonSet:
PUBLIC
PROC[bs: ButtonSet, paint:
BOOLEAN]
RETURNS[ButtonSet] =
BEGIN
IF bs #
NIL
THEN
BEGIN
bs.validFlag ¬ FALSE;
IF bs.container #
NIL
THEN
BEGIN
container: ViewerClasses.Viewer ¬ bs.container;
bs.container ¬ NIL;
ViewerOps.DestroyViewer[container, paint];
END;
END;
RETURN[NIL];
NewLine:
PUBLIC
PROC[bs: ButtonSet] = {
bs.x ¬ bs.colX;
bs.y ¬ bs.y + bs.lineH};
MoveToY:
PUBLIC
PROC[bs: ButtonSet, y:
CARD] =
{bs.y ¬ y; bs.x ¬ bs.colX};
SkipY:
PUBLIC
PROC[bs: ButtonSet, h:
CARD] =
{bs.y ¬ bs.y+h; bs.x ¬ bs.colX};
MoveToX:
PUBLIC
PROC[bs: ButtonSet, x:
CARD] =
{bs.x ¬ x};
SkipX:
PUBLIC
PROC[bs: ButtonSet, w:
CARD] =
{bs.x ¬ bs.x+w};
GetButtonSize:
PUBLIC
PROC[name: Rope.
ROPE]
RETURNS[ButtonSize] = {
w, h: INTEGER;
[w, h] ¬ PUB.DefaultSize[name];
RETURN[[w: w, h: h]];
};
CmdButtonData1: TYPE = REF CmdButtonData1Body;
CmdButtonData1Body:
TYPE =
RECORD[
button: ViewerClasses.Viewer,
vc: CirioButtons.ViewerControl,
validFlag: BOOLEAN,
clientData1: REF ANY,
proc1: PROC[button: ViewerClasses.Viewer, vc: CirioButtons.ViewerControl, key, clientData1: REF ANY] RETURNS [clientData2: REF ANY],
proc2: PROC[button: ViewerClasses.Viewer, vc: CirioButtons.ViewerControl, key, clientData1, clientData2: REF ANY]];
InstallCommandButton:
PUBLIC
PROC
[
bs: ButtonSet,
name: Rope.ROPE, border: BOOL ¬ FALSE, guarded: BOOL ¬ FALSE,
clientData1: REF ANY,
choices: CirioButtons.ChoiceList ¬ NIL,
proc1: PROC[button: ViewerClasses.Viewer, vc: CirioButtons.ViewerControl, key, clientData1: REF ANY] RETURNS[clientData2: REF ANY] ¬ NIL,
proc2: PROC[button: ViewerClasses.Viewer, vc: CirioButtons.ViewerControl, key, clientData1, clientData2: REF ANY]]
RETURNS[ViewerClasses.Viewer]
= {
size: ButtonSize ~ GetButtonSize[name];
class: PUB.Class ~ GetClass[classesLock, name, choices, guarded];
cbd1: CmdButtonData1 ~ NEW[CmdButtonData1Body¬[NIL, bs.vc, bs.validFlag, clientData1, proc1, proc2]];
child: ViewerClasses.Viewer ~
PUB.Instantiate[
--these used to (before June 18, 1990, MJS) serialize CmdProc1 via an MBQueue, but don't anymore - why should they, since CmdProc2 is serialized?
class: class,
viewerInfo: [parent: bs.container, border: border, wy: bs.y, wx: bs.x, ww: IF bs.fixedWidth # 0 THEN bs.fixedWidth ELSE size.w],
instanceData: cbd1];
bs.x ¬ bs.x + (IF bs.fixedWidth # 0 THEN bs.fixedWidth ELSE child.ww) - 1;
cbd1.button ¬ child;
RETURN[child];
};
CmdButtonData2: TYPE = REF CmdButtonData2Body;
CmdButtonData2Body:
TYPE =
RECORD[
cbd1: CmdButtonData1,
key, clientData2: REF ANY];
CmdProc1:
PROC [view:
REF
ANY, instanceData, classData, key:
REF
ANY]
--PUB.PopUpButtonProc-- = {
cbd1: CmdButtonData1 ~ NARROW[instanceData];
clientData2: REF ANY ¬ IF cbd1.proc1 = NIL THEN NIL ELSE cbd1.proc1[cbd1.button, cbd1.vc, key, cbd1.clientData1];
cbd2: CmdButtonData2 ¬ NEW[CmdButtonData2Body¬[cbd1, key, clientData2]];
QueueButtonAction[cbd1.vc, NEW[ButtonActionBody¬[CmdProc2, cbd2]]];
};
CmdProc2:
PROC[action: ButtonAction] =
BEGIN
cbd2: CmdButtonData2 ¬ NARROW[action.data];
cbd1: CmdButtonData1 ¬ cbd2.cbd1;
IF cbd1.validFlag THEN cbd1.proc2[cbd1.button, cbd1.vc, cbd2.key, cbd1.clientData1, cbd2.clientData2];
END;
ClassList: TYPE ~ LIST OF ClassInfo;
ClassInfo: TYPE ~ RECORD [name: Rope.ROPE, choices: CirioButtons.ChoiceList, guarded: BOOL, class: PUB.Class];
classes: ClassList ¬ NIL;
docHelp: PUB.Help ~ PUB.HelpFromDoc["CirioDoc.tioga"];
GetClass:
ENTRY
PROC [control: CirioButtons.ViewerControl, name: Rope.
ROPE, choices: CirioButtons.ChoiceList, guarded:
BOOL]
RETURNS [
PUB.Class] ~ {
ENABLE UNWIND => NULL;
FOR cl: ClassList ¬ classes, cl.rest
WHILE cl#
NIL
DO
IF cl.first.choices = choices AND cl.first.guarded = guarded AND name.Equal[cl.first.name] THEN RETURN [cl.first.class];
ENDLOOP;
classes ¬
CONS[
[name, choices, guarded,
PUB.MakeClass[[
proc: CmdProc1,
choices: ChangeChoices[choices],
fork: FALSE,
guarded: guarded,
image: PUB.ImageForRope[rope: name, align: PUB.center],
help: docHelp]]],
classes];
RETURN [classes.first.class]};
ChangeChoices:
PROC [choices: CirioButtons.ChoiceList]
RETURNS [
PUB.ChoiceList] ~ {
IF choices=NIL THEN RETURN [NIL];
RETURN [CONS[[choices.first.key, choices.first.doc], ChangeChoices[choices.rest]]]};
InstallLabelButton:
PUBLIC
PROC[bs: ButtonSet, name: Rope.
ROPE]
RETURNS[ViewerClasses.Viewer] = {
size: ButtonSize ¬ GetButtonSize[name];
child: ViewerClasses.Viewer ¬ Labels.Create[
info: [name: name, parent: bs.container, border:
FALSE,
wy: bs.y, wx: bs.x+1], paint: TRUE];
bs.x ¬ bs.x + (IF bs.fixedWidth # 0 THEN bs.fixedWidth ELSE child.ww) - 1;
RETURN[child];
};
InstallRule:
PUBLIC
PROC[bs: ButtonSet] = {
child: ViewerClasses.Viewer ¬ Rules.Create[
info: [parent: bs.container, border: FALSE, wy: bs.y, wx: 0, ww: bs.container.ww, wh: 1], paint: TRUE];
Containers.ChildXBound[bs.container, child];
bs.x ¬ 1;
bs.y ¬ child.wy + child.wh + 1;
};