DIRECTORY
Atom USING [MakeAtom],
CCTypes USING[CCError, CCErrorCase],
CirioButtons,
Containers USING[ChildXBound, ChildYBound, Create],
Convert USING[Error, IntFromRope, RopeFromCard],
EditedStream USING[Rubout],
IO,
Labels USING[Create, Set],
MBQueue USING[Create, Queue],
PopUpButtons,
Rope,
Rules USING[Create],
StackCirio USING[GetCurrentFrameBanner, ReportDesiredLanguage, ResetStack, SetDesiredLanguage, ShowCurrentFrame, ShowSourcePosition, Stack, WalkStack, WalkStackCedarFrames],
TiogaOps USING[GetSelection, LastLocWithin, SelectPoint, ViewerDoc],
TypeScript USING[Create],
ViewerClasses USING[Viewer],
ViewerEvents USING[EventProc, RegisterEventProc, ViewerEvent],
ViewerIO USING[CreateViewerStreams],
ViewerOps USING[AddProp, DestroyViewer, FetchProp, OpenIcon, SetOpenHeight],
ViewerTools USING[GetSelectionContents];

CirioButtonsImpl: CEDAR MONITOR
LOCKS control USING control: CirioButtons.ViewerControl
IMPORTS Atom, CCTypes, Containers, Convert, EditedStream, IO, Labels, MBQueue, PopUpButtons, Rope, Rules, StackCirio, TiogaOps, TypeScript, ViewerEvents, ViewerIO, ViewerOps, ViewerTools
EXPORTS CirioButtons
= BEGIN OPEN PUB:PopUpButtons;

CCE: ERROR[case: CCTypes.CCErrorCase, msg: Rope.ROPE _ NIL] _ CCTypes.CCError;

classesLock: CirioButtons.ViewerControl ~ NEW [CirioButtons.ViewerControlBody];

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];


RETURN[vc];

END;

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;

IF NOT control.destroyStarted THEN {
prompt _ control.formatPrompt[counter, control.clientData];
IO.PutRope[control.out, prompt]};
line _ IO.GetLineRope[control.in ! 
IO.Error =>
{IF ec = StreamClosed THEN streamClosed _ TRUE; line _ ""; CONTINUE};
EditedStream.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;


IF NOT control.destroyStarted AND NOT Rope.IsEmpty[line] AND NOT Rope.Equal[line, "\n"] THEN
BEGIN
IO.PutF[control.out, "  %g\n", IO.rope[control.interpretTextLine[prompt.Concat[line], control.out, control.clientData]]];
line _ NIL;
counter _ counter + 1;
END;

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;


ButtonAction: TYPE = CirioButtons.ButtonAction;
ButtonActionBody: TYPE = CirioButtons.ButtonActionBody;

QueueButtonAction: ENTRY PROC[control: CirioButtons.ViewerControl, action: ButtonAction] =
BEGIN
ENABLE UNWIND => NULL;
cell: LIST OF ButtonAction _ LIST[action];
IF control.nextButtonAction = NIL THEN control.nextButtonAction _ cell ELSE control.lastButtonAction.rest _ cell;
control.lastButtonAction _ cell;
IF TiogaOps.GetSelection[].viewer = control.script THEN
TiogaOps.SelectPoint[viewer: control.script, caret: TiogaOps.LastLocWithin[TiogaOps.ViewerDoc[control.script]]];
control.script.class.notify[control.script, LIST["\n"]]; -- MainActionProc will wake up and get an empty line.  (Or will it: will this "\n" be appended to existing text, or go in front of existing text?)
END;

GetNextButtonAction: ENTRY PROC[control: CirioButtons.ViewerControl] RETURNS[ButtonAction] =
BEGIN
ENABLE UNWIND => NULL;
WHILE control.nextButtonAction # NIL DO
result: LIST OF ButtonAction _ control.nextButtonAction;
control.nextButtonAction _ control.nextButtonAction.rest;
IF NOT control.destroyStarted OR result.first.ignoreDestroyStarted THEN RETURN[result.first];
ENDLOOP;
RETURN[NIL];
END;

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.PutF[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.PutF[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.PutF[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.PutF[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.PutF[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.PutF[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.PutF[out, "  (end of stack reached after %g frames)\n", IO.int[actualMove]];
END;
END;
IO.PutF[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.PutF[out, "Showing source ... "];
StackCirio.ShowSourcePosition[stack, out];
IO.PutF[out, " done.\n"];
END;

InstallSourceLanguageButton: 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;


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;


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];
END;

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;
};


[] _ ViewerEvents.RegisterEventProc[DestroyProc, destroy];

END..




CirioButtonsImpl.mesa
Copyright Σ 1990 by Xerox Corporation.  All rights reserved.
Sturgis, April 3, 1990 1:26 pm PDT
Linda Howe, January 8, 1990 1:18:43 pm PST
Last tweaked by Mike Spreitzer on January 9, 1992 3:30 pm PST
Coolidge, June 29, 1990 12:27 pm PDT
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.


TRUSTED{Process.Detach[FORK MainActionProc[vc]]};
will be forked and detached
runs outside the mbQueue
we put out an appropriate herald

now, we collect a line to examine
first we interpret any text in line
now we check for button actions

general button control

Stack debug buttons



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.

Button installation procedures
main code
Κ•NewlineDelimiter

™
codeš
œ™K™<Kš
œ"™"K™*K™=K™$—K˜š
Οk	˜	Kšœœ˜Kšœœ˜$Kš
œ
˜
Kšœœ#˜3Kšœœ#˜0Kšœ
œ	˜Kšœ
˜Kšœœ˜Kšœœ˜K˜
Kš
œ˜Kšœœ	˜Kšœœ
˜­
Kšœ	œ6˜DKšœœ	˜Kšœœ	˜Kšœ
œ,˜>Kšœ	œ˜$Kšœ
œ=˜LKšœœ˜(K˜—šΟnœœ
˜Kšœ	œ$˜7Kšœ3œ~˜Ί
Kšœ
˜Kšœœ
œ
œ˜K˜Kšœœ&œœ˜NK˜Kšœ*œ"˜OK˜™™<K™K™₯K™Kš
œρ™ρK™Kš
œ³
™³
K™™.K™Kš
ϣ
™£
Kš
œ•™•Kš
œ{™{Kš
œr™rK™>Kš
œΪ
™Ϊ
—K™—K™šžœœ
˜š
œ
˜
Kšœœ
˜Kšœ	œ
˜Kš
œœœœ
œœœ˜KKšœœœœ
œœ
œœœ˜eKšœ
œ
œ
œœ
œ˜8Kšœœ
œ
˜—Kšœ˜%Kš
˜˜,Kšœ.œ
œ˜D—K˜šœ!œ!˜EKšœœ
˜Kšœ
œ
˜Kš
œ˜KšœœΟc˜KšœœŸ˜KšœœŸ˜K˜Kšœœ
˜Kšœœ
˜Kš
œ˜Kš
œ%˜%Kš
œ˜Kš
œ˜K˜—K˜K˜1K˜K˜%K˜˜Kšœ6œ˜S—K˜K˜%˜%K˜—Kšœ8œ
˜HK˜Kš
œ4˜4K˜K˜Kšœœ™1K˜šœ˜K˜—Kšœ
˜—˜K™K™—šžœœ
œ)˜Dšœ
œŸ.˜@Kšœœ
˜Kš
œ!˜!Kš
œ˜—KšœŸ:˜XKšœœ
œ'˜AKšœœ
˜Kš
œ˜K˜—šžœœ'˜@Kš
˜Kšœ	œ˜š
˜Kšœœœ
˜Kšœœœ
˜Kšœœœ
˜K˜™ šœ
œœ˜$Kš
œ;˜;Kšœ˜!——K™™!šœœ˜#šœ	˜Kš	œ
œœœ
œ˜E—š
œ˜Kšœ
œœ˜——K˜Kšœœ
œ
˜šœ˜Kš
˜Kšœœ ˜6KšœIœ˜`Kš
œ
˜
Kšœ
˜—K˜—K˜™#š
œ
œœ
œœ
œ˜\Kš
˜KšœœX˜yKšœœ
˜K˜Kšœ
˜——K˜™šœSœ
œ
˜kKš
œ˜KšœŸ½
˜Σ
Kšœ
˜——K˜Kšœœ
œ
˜!K˜Kšœ
˜—Kšœ
˜K˜—K™K˜—K™™Kšœœ˜/Kšœœ!˜7K˜šžœœ
œ=˜ZKš
˜Kšœ
œœ
˜Kšœœ
œœ	˜*Kšœœ
œ!œ&˜qKš
œ ˜ šœ1˜7Kš
œp˜p—Kšœ,œ	Ÿ’
˜Λ
šœ
˜K˜——šžœœ
œ&œ˜\Kš
˜Kšœ
œœ
˜šœœ
˜'Kšœœ
œ)˜8Kš
œ9˜9Kš
œ
œœ#œ
œ˜]Kšœ
˜—Kšœ
œ˜Kšœ
˜K˜——™K™Kšœœœ˜8šœœœ
˜'Kš
œ˜Kšœœ
˜Kš
œ"˜"—K˜šžœœ
œ?œ*˜
Kš
˜KšœœD˜cš
œ˜Kš
œ-˜-šœ	œ
˜Kšœ
œ4˜9Kšœ
œ'˜,Kšœ
œ4˜9K˜Kšœ
œD˜IKšœ
œ7˜<Kšœ
œD˜IK˜Kšœ
œ<˜AKšœ
œ/˜4Kšœ
œ<˜AK˜Kšœ
œL˜QKšœ
œ?˜DKšœ
œL˜QKš
œ˜—Kš
œ2˜2—Kšœ
˜Kšœœ˜ —K™šžœœQœ
œœœ
œ˜
Kš
˜Kšœœ&˜5Kšœœ
œ
œ
œœ
˜$Kšœ
œ˜Kšœ
˜—K˜Kšœœœ
˜K˜šžœœ^œ
œ˜~Kš
˜Kšœœ
œ
œ
œœ˜$Kšœœ
œ˜Kšœœ
œ˜ Kšœœ
œ˜%Kšœœ˜0Kš	œœœœœ˜EKšœœ
œ
˜Kš
œ%˜%šžœœ
œ
œ˜(Kš
˜Kšœœœ˜1Kš
œœœœ
œ
œ
œ
˜@KšœœŸ˜š
œ˜Kšœœ˜—Kšœ˜Kšœ
˜—Kšœ
œ
˜šœ	œ
˜Kšœ
œ%œ˜1—šœ
œŸ ˜5Kš
˜šœœ
Ÿ!˜3Kš
˜Kšœ
œ˜"Kšœ
œ%˜3Kšœœ
˜Kšœ,œ˜CKš
œa˜aKšœ7œ!œœœœœ˜«
Kš
˜—šœ
œ
Ÿ!˜'Kš
˜Kšœœ
˜šœœœ˜Kš
œ˜Kš
œ˜KšœœŸ˜9—Kšœ*œ˜<Kš
œU˜UKšœ7œœœœœœ˜
šœ˜#Kšœ?œ˜]—Kšœ
˜—Kš
˜—šœ
˜Kš
˜šœœ
Ÿ˜1Kš
˜Kšœ
œ˜"Kšœœ5˜MKšœœ%˜4Kšœœ
˜Kšœ&œ˜=Kš
œF˜FKšœ.œœœœœœ˜„
šœ˜Kšœ9œ˜O—Kš
˜—šœ
œ
Ÿ˜!Kš
˜šœœœ˜Kš
œ˜Kš
œ˜KšœœŸ˜9—Kšœœ
˜Kšœ$œ˜6Kš
œB˜BKšœ.œœœœœœ˜„
šœ˜Kšœ9œ˜O—Kšœ
˜—Kšœ
˜—Kšœœ5˜MKš
œg˜gKšœ
˜—K˜Kšœœœ˜0šœœœ
˜#Kš
œ˜—K˜šžœœ
œ*˜MKš
˜Kšœœ˜8Kš
œ_˜_Kšœ
˜K˜—šžœœ^œ
œ˜Kšœœ˜+Kšœœ
œ
˜Kš
œ$˜$Kš
œ	œ
œœ%œ˜DKšœ"˜$Kš
œ5˜5Kš
œ˜—K˜K˜šžœœ
œ*˜RKš
˜Kšœœ˜8Kš
œi˜iKšœ
˜—K˜š	Πbnžœœ^œ
œ˜‚
Kš
˜Kšœœ˜+Kšœœ
œ
˜Kš
œ$˜$Kš
œ	œ
œœ%œ˜DKšœ"˜$Kš
œ*˜*Kšœ˜Kšœ
˜—K˜šž œœ
œ*˜RKš
˜Kšœœ˜8Kšœfœ“˜ύKšœ
˜K™—šžœœ^œ
œ˜|Kš
˜Kšœœ˜+Kšœœ
œ
˜Kš
œ$˜$Kš
œ	œ
œœ%œ˜Dšœ˜Kš
œ4˜4Kš
œ<˜<Kš
œ@˜@Kš
œ<˜<Kšœ8˜?—Kšœ
˜——K˜K˜™™K™@K™=Kšœœ"œ²™α—šžœœIœœ	œœŸœ˜œ
Kšœœ
œ+˜8šœœ
˜šœœ
˜š
œ#˜#KšœœŸM˜gšœ
œœ˜Kšœœ*œ"œ˜pKšœ
œŸ)˜6K˜—Kš
œ˜—KšœœŸ?˜P——Kš
œ˜—K˜šœœœ
˜)Kš
œ ˜ —K˜šžœœ˜3Kš
˜Kšœœœ˜:Kš
œ!˜!Kšœ
˜—K˜šžœœ"˜?Kš
˜Kš	œ
œœ
œŸ4˜Yšœ
œ˜Kš
˜KšœœŸ9˜Qš
œ!˜!Kš	œ
œœœ
œ#˜C—Kšœœ
œ"˜7Kšœ
œ
˜Kšœ
˜—Kšœ
˜—K˜—K™™K˜Kšœœ˜)Kšœœ˜1Kšœœ˜+K˜šžœœ
œHœœ	œœœ
˜­
Kšœ
œ
œ,œ%˜`—K˜š
ž
œœ
œœœ
˜NKš
˜šœœ
˜Kš
˜Kšœœ
˜šœœ
˜Kš
˜Kš
œ/˜/Kšœœ
˜Kš
œ*˜*Kšœ
˜—Kšœ
˜—Kšœ
œ˜šœ
˜K˜——šžœœ
œ˜'Kš
œ˜Kš
œ˜—K˜šžœœ
œœ˜.K˜—K˜šžœœ
œœ˜,K˜ —K˜šžœœ
œœ˜.Kš
œ˜—K˜šžœœ
œœ˜,Kš
œ˜—K˜š
ž
œœ
œœœ˜CKšœœ
˜Kšœ	œ˜Kšœ˜Kš
œ˜—K˜Kšœœœ˜.šœœœ
˜"Kš
œ˜Kš
œ˜Kšœœ
˜Kšœ
œ
œ
˜Kš
œœQœ
œœœ
œ˜„
Kšœœ^œ
œ˜s—K˜šžœœ
˜!š
œ
˜
Kš
œ˜Kšœœ
œœœœ
˜=Kšœ
œ
œ
˜Kšœ#œ
˜'KšœœQœ
œœœ
œœ
˜‰
Kšœœ^œ
œ˜r—Kšœ˜Kš
œ˜Kš
œ'˜'Kšœœ7˜AKšœœœ3˜ešœœ
Ÿ‘
˜Ώ
Kš
œ
˜
KšœKœœœ	˜€
Kš
œ˜—Kšœœœœ˜JK˜Kšœ˜K˜——˜Kšœœœ˜.šœœœ
˜"Kš
œ˜Kšœœ
œ˜K˜—šžœœœ
œ œ
œŸœ˜aKšœœ˜,Kšœ
œ
œœœ
œ
œ
œ9˜qKšœœ.˜HKšœœ%˜CK˜—K˜šžœœ˜&Kš
˜Kšœœ˜+Kš
œ!˜!KšœœP˜fKšœ
˜—K˜Kšœœœ
œ˜$Kšœœœ
œ-œ	œ˜nKšœœ
˜Kšœ	œœ˜6K˜šžœœ
œ2œ-œœœ˜”
Kšœ
œœ
˜šœ"œœ
˜4Kš
œœœœ
œ˜xKšœ
˜—šœ
œ
˜šœœ˜(Kš
œ˜Kš
œ ˜ Kšœœ
˜Kš
œ˜Kšœœ!œ	˜7Kš
œ˜—Kš
œ	˜	—Kšœ˜—K˜šž
œœ$œœ˜SKš
œ	œ
œ
œœ˜!KšœœH˜T—K˜š
žœœ
œœœ˜aKš
œ'˜'š
œ,˜,šœ1œ
˜7Kšœœ˜$——Kšœœœœ˜JKšœ˜Kš
œ˜—K˜šžœœ
œ˜+š
œ+˜+Kšœ%œ7œ˜g—Kš
œ,˜,Kš
œ	˜	Kš
œ˜K˜—K˜—™	K˜K˜:K˜—Kšœ˜——…—NJrΝ