<<>> <> <> <> <> <> <> 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]; <> <> <<>> <<(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.)>> <<>> <> <<>> <> <<>> <> <<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]; <> 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 -- %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..