CirioButtonsImpl.mesa
Copyright Ó 1990, 1992 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
Willie-s, May 15, 1992 2:47 pm PDT
DIRECTORY
Atom USING [MakeAtom],
CCTypes USING[CCError, CCErrorCase],
CirioButtons,
Containers USING[ChildXBound, ChildYBound, Create],
Convert USING[Error, IntFromRope, RopeFromCard],
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, 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];
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]]};
RETURN[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;
general button control
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;
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;
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;
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];
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;
};
main code
[] ¬ ViewerEvents.RegisterEventProc[DestroyProc, destroy];
END..