<> <> <> <> DIRECTORY Buttons, AtomButtons, FileNames, Imager, IO, Labels, Menus, Rope, TiogaButtons, ViewerClasses, ViewerOps, VFonts, ViewerTools; AtomButtonsImpl: CEDAR PROGRAM IMPORTS Buttons, FileNames, IO, Labels, Rope, TiogaButtons, VFonts, ViewerOps, ViewerTools EXPORTS AtomButtons = BEGIN ButtonLineEntry: TYPE = AtomButtons.ButtonLineEntry; UnQueuedButtonLineEntry: TYPE = AtomButtons.UnQueuedButtonLineEntry; ButtonList: TYPE = AtomButtons.ButtonList; ButtonType: TYPE = AtomButtons.ButtonType; DisplayStyle: TYPE = AtomButtons.DisplayStyle; ConfirmProc: TYPE = AtomButtons.ConfirmProc; Order: TYPE = AtomButtons.Order; HandleButtonProc: TYPE = AtomButtons.HandleButtonProc; ScalarButton: TYPE = AtomButtons.ScalarButton; ScalarButtonClient: TYPE = REF ScalarButtonClientObj; ScalarButtonClientObj: TYPE = AtomButtons.ScalarButtonClientObj; ScalarButtonHandle: TYPE = REF ScalarButtonHandleObj; ScalarButtonHandleObj: TYPE = AtomButtons.ScalarButtonHandleObj; StateType: TYPE = AtomButtons.StateType; StyleChoice: TYPE = AtomButtons.StyleChoice; TwoState: TYPE = REF TwoStateObj; TwoStateObj: TYPE = AtomButtons.TwoStateObj; UpdateProc: TYPE = AtomButtons.UpdateProc; Viewer: TYPE = ViewerClasses.Viewer; EnumTypeRef: TYPE = REF EnumTypeRec; EnumTypeRec: TYPE = AtomButtons.EnumTypeRec; entryHeight: CARDINAL = 15; -- height of a line of items entryHSpace: CARDINAL = 2; -- horizontal space between items on a line <> <<>> <> <<>> GGButtonData: TYPE = REF GGButtonDataObj; GGButtonDataObj: TYPE = RECORD [ clientData: REF ANY, -- compilation dependencies again leftAction: LIST OF REF ANY, rightAction: LIST OF REF ANY, handleProc: HandleButtonProc, confirmProc: ConfirmProc ]; BuildButtonLine: PUBLIC PROC [container: Viewer, x, y: NAT, clientData: REF ANY, handleProc: HandleButtonProc, entries: LIST OF ButtonLineEntry] RETURNS [nextX: INTEGER] = { thisButton, prevButton: Buttons.Button; prevButton _ BuildButton[container, x, y, clientData, handleProc, entries.first.type, entries.first.leftAction, entries.first.rightAction, entries.first.name, entries.first.border, entries.first.ww, entries.first.updateProc, entries.first.confirmProc, entries.first.font]; nextX _ prevButton.wx + prevButton.ww; FOR entryList: LIST OF ButtonLineEntry _ entries.rest, entryList.rest UNTIL entryList = NIL DO thisButton _ BuildButton[container, nextX + entryHSpace, y, clientData, handleProc, entryList.first.type, entryList.first.leftAction, entryList.first.rightAction, entryList.first.name, entryList.first.border, entryList.first.ww, entryList.first.updateProc, entryList.first.confirmProc, entryList.first.font]; prevButton _ thisButton; nextX _ prevButton.wx + prevButton.ww; ENDLOOP; }; BuildButton: PROC [container: Viewer, x, y: NAT, clientData: REF ANY, <> handleProc: HandleButtonProc, type: ButtonType, leftAction: LIST OF REF ANY, rightAction: LIST OF REF ANY, name: Rope.ROPE, border: BOOL, ww: NAT, updateProc: UpdateProc, confirmProc: ConfirmProc, font: Imager.Font] RETURNS [button: Buttons.Button] = { SELECT type FROM button => { buttonData: GGButtonData; buttonData _ NEW[GGButtonDataObj _ [clientData, leftAction, rightAction, handleProc, confirmProc]]; button _ Buttons.Create[ info: [name: name, wx: x, wy: y, wh: entryHeight, parent: container, border: border], proc: HandleButton, clientData: buttonData, documentation: handleConfirm, fork: FALSE, guarded: confirmProc # NIL, font: font ]; }; label => { button _ Labels.Create[ info: [name: name, wx: x, wy: y, wh: entryHeight, parent: container, border: border]]; }; text => { button _ ViewerTools.MakeNewTextViewer[[ parent: container, wx: x, wy: y, ww: ww, wh: entryHeight, data: name, scrollable: FALSE, border: border]]; }; ENDCASE => ERROR; IF updateProc # NIL THEN updateProc[name, clientData, button]; }; HandleButton: Menus.ClickProc = { <<[parent: REF ANY, clientData: REF ANY _ NIL, mouseButton: Menus.MouseButton _ red, shift: BOOL _ FALSE, control: BOOL _ FALSE]>> buttonData: GGButtonData _ NARROW[clientData]; IF buttonData.rightAction#NIL AND mouseButton = blue THEN buttonData.handleProc[buttonData.clientData, buttonData.rightAction] ELSE buttonData.handleProc[buttonData.clientData, buttonData.leftAction]; <> }; handleConfirm: REF Menus.ClickProc _ NEW[Menus.ClickProc _ HandleConfirm]; HandleConfirm: Menus.ClickProc = { buttonData: GGButtonData _ NARROW[clientData]; buttonData.confirmProc[buttonData.clientData]; }; <> <<>> GGUnQueuedButtonData: TYPE = REF GGUnQueuedButtonDataObj; GGUnQueuedButtonDataObj: TYPE = RECORD [ clientData: REF ANY, clickProc: Menus.ClickProc, confirmProc: ConfirmProc ]; BuildUnQueuedButtonLine: PUBLIC PROC [container: Viewer, x, y: NAT, clientData: REF ANY, entries: LIST OF UnQueuedButtonLineEntry] RETURNS [nextX: INTEGER] = { thisButton, prevButton: Buttons.Button; prevButton _ BuildUnQueuedButton[container, x, y, clientData, entries.first.type, entries.first.clickProc, entries.first.name, entries.first.border, entries.first.ww, entries.first.updateProc, entries.first.confirmProc, entries.first.font]; nextX _ prevButton.wx + prevButton.ww; FOR entryList: LIST OF UnQueuedButtonLineEntry _ entries.rest, entryList.rest UNTIL entryList = NIL DO thisButton _ BuildUnQueuedButton[container, nextX + entryHSpace, y, clientData, entryList.first.type, entryList.first.clickProc, entryList.first.name, entryList.first.border, entryList.first.ww, entryList.first.updateProc, entryList.first.confirmProc, entryList.first.font]; prevButton _ thisButton; nextX _ prevButton.wx + prevButton.ww; ENDLOOP; }; BuildUnQueuedButton: PROC [container: Viewer, x, y: NAT, clientData: REF ANY, type: ButtonType, clickProc: Menus.ClickProc, name: Rope.ROPE, border: BOOL, ww: NAT, updateProc: UpdateProc, confirmProc: ConfirmProc, font: Imager.Font] RETURNS [button: Buttons.Button] = { <> <> SELECT type FROM button => { buttonData: GGUnQueuedButtonData; buttonData _ NEW[GGUnQueuedButtonDataObj _ [clientData, clickProc, confirmProc]]; button _ Buttons.Create[ info: [name: name, wx: x, wy: y, wh: entryHeight, parent: container, border: border], proc: HandleUnQueuedButton, clientData: buttonData, documentation: handleUnQueuedConfirm, fork: TRUE, guarded: confirmProc # NIL, font: font ]; }; label => { button _ Labels.Create[ info: [name: name, wx: x, wy: y, wh: entryHeight, parent: container, border: border]]; }; text => { button _ ViewerTools.MakeNewTextViewer[[ parent: container, wx: x, wy: y, ww: ww, wh: entryHeight, data: name, scrollable: FALSE, border: border]]; }; ENDCASE => ERROR; IF updateProc # NIL THEN updateProc[name, clientData, button]; }; HandleUnQueuedButton: Menus.ClickProc = { buttonData: GGUnQueuedButtonData _ NARROW[clientData]; buttonData.clickProc[NIL, buttonData.clientData, mouseButton, shift, control]; }; handleUnQueuedConfirm: REF Menus.ClickProc _ NEW[Menus.ClickProc _ HandleUnQueuedConfirm]; HandleUnQueuedConfirm: Menus.ClickProc = { buttonData: GGUnQueuedButtonData _ NARROW[clientData]; buttonData.confirmProc[buttonData.clientData]; }; <> BuildTwoStateButton: PUBLIC PROC [viewer: ViewerClasses.Viewer, x, y: NAT, clientData: REF ANY, handleProc: HandleButtonProc, name: Rope.ROPE, border: BOOL _ TRUE, init: StateType _ off, action: LIST OF REF ANY] RETURNS [stateInfo: TwoState, nextX: INTEGER] = { tempButton: Buttons.Button; stateInfo _ NEW[TwoStateObj]; tempButton _ Buttons.Create[ info: [name: name, wx: x, wy: y, <> wh: entryHeight, -- specify rather than defaulting so line is uniform parent: viewer, border: border ], proc: TwoSwitchProc, clientData: stateInfo -- this will be passed to our button proc ]; stateInfo.button _ tempButton; stateInfo.action _ action; stateInfo.clientData _ clientData; stateInfo.handleProc _ handleProc; SetButtonState[stateInfo, init]; nextX _ tempButton.wx + tempButton.ww + 4; }; SetButtonState: PUBLIC PROC [twoState: TwoState, state: StateType] = { twoState.state _ state; SELECT state FROM on => Buttons.SetDisplayStyle[button: twoState.button, style: $WhiteOnBlack]; off => Buttons.SetDisplayStyle[button: twoState.button, style: $BlackOnWhite]; ENDCASE => ERROR; }; GetButtonState: PUBLIC PROC [twoState: TwoState] RETURNS [state: StateType] = { state _ twoState.state; }; NextState: PROC [state: StateType] RETURNS [StateType] = { IF state = LAST[StateType] THEN RETURN[FIRST[StateType]] ELSE RETURN[SUCC[state]]; }; TwoSwitchProc: Buttons.ButtonProc = { handle: TwoState _ NARROW[clientData]; handle.handleProc[handle.clientData, handle.action]; }; SwitchState: PUBLIC PROC [handle: TwoState] = { nextState: StateType; nextState _ NextState[handle.state]; SetButtonState[handle, nextState]; }; <> <<>> <> <> <<>> CreateScalarButtonViewer: PUBLIC PROC [container: Viewer, x, y: NAT] RETURNS [AtomButtons.ScalarButtonHandle] = { sbHandle: AtomButtons.ScalarButtonHandle _ NEW[AtomButtons.ScalarButtonHandleObj]; sbHandle.viewer _ MakeViewer[container, x, y]; sbHandle.headerButton _ NewHeaderButton[sbHandle.viewer, NIL]; RETURN[sbHandle]; }; BuildScalarButtons: PUBLIC PROC [handle: ScalarButtonHandle, clientData: REF ANY, handleProc: HandleButtonProc, header: Rope.ROPE, scalarButtonList: LIST OF ScalarButton] = { buttons: ScalarButtonClient; prevButton: TiogaButtons.TiogaButton; oldScalarButtons: ScalarButtonClient _ handle.scalarButtons; <> FOR thisButton: ScalarButtonClient _ oldScalarButtons, thisButton.next UNTIL thisButton=NIL DO TiogaButtons.DeleteButton[thisButton.button]; ENDLOOP; <> prevButton _ handle.headerButton; FOR list: LIST OF ScalarButton _ scalarButtonList, list.rest UNTIL list = NIL DO prevButton _ AppendScalarButton[prevButton, clientData, handleProc, list.first.name, list.first.value, list.first.init = on, list.first.action]; IF list = scalarButtonList THEN buttons _ NARROW[prevButton.clientData]; ENDLOOP; handle.scalarButtons _ buttons; handle.handleProc _ handleProc; }; StartScalarButtonList: PROC [] RETURNS [entityList, ptr: LIST OF ScalarButton] = { ptr _ entityList _ NIL; }; AddScalarButton: PROC [entity: ScalarButton, entityList, ptr: LIST OF ScalarButton] RETURNS [newList, newPtr: LIST OF ScalarButton] = { IF ptr = NIL THEN { IF NOT entityList = NIL THEN ERROR; newPtr _ newList _ CONS[entity, NIL]; RETURN; } ELSE { newList _ entityList; ptr.rest _ CONS[entity, NIL]; newPtr _ ptr.rest; }; }; AddValueSorted: PUBLIC PROC [clientData: REF ANY, scalarButtonHandle: ScalarButtonHandle, value: ScalarButton, order: Order _ incr] RETURNS [oldFoundButton: ScalarButtonClient _ NIL] = { <> epsilon: REAL = 0.001; list, finger: LIST OF AtomButtons.ScalarButton; inserted: BOOL _ FALSE; oldScalarButtons: ScalarButtonClient _ scalarButtonHandle.scalarButtons; [list, finger] _ StartScalarButtonList[]; FOR thisButton: ScalarButtonClient _ oldScalarButtons, thisButton.next UNTIL thisButton=NIL DO <> IF ABS[thisButton.value-value.value] < epsilon THEN { thisButton.on _ value.init = on; IF thisButton.on THEN TiogaButtons.ChangeButtonLooks[thisButton.button, "b", ""] ELSE TiogaButtons.ChangeButtonLooks[thisButton.button, "", "b"]; RETURN[thisButton]; }; IF NOT inserted AND order=decr AND thisButton.valuevalue.value THEN { -- insert new value behind thisButton [list, finger] _ AddScalarButton[value, list, finger]; inserted _ TRUE; }; [list, finger] _ AddScalarButton[[thisButton.name, thisButton.value, thisButton.action, IF thisButton.on THEN on ELSE off], list, finger]; ENDLOOP; IF NOT inserted THEN { -- tack new slope onto proper end of the list [list, finger] _ AddScalarButton[value, list, finger]; }; <> FOR thisButton: ScalarButtonClient _ oldScalarButtons, thisButton.next UNTIL thisButton=NIL DO TiogaButtons.DeleteButton[thisButton.button]; ENDLOOP; scalarButtonHandle.scalarButtons _ RebuildScalarButtons[viewer: scalarButtonHandle.viewer, headerButton: scalarButtonHandle.headerButton, clientData: clientData, handleProc: scalarButtonHandle.handleProc, scalarButtonList: list]; FOR thisButton: ScalarButtonClient _ scalarButtonHandle.scalarButtons, thisButton.next UNTIL thisButton=NIL DO IF thisButton.on THEN TiogaButtons.ChangeButtonLooks[thisButton.button, "b", ""] ELSE TiogaButtons.ChangeButtonLooks[thisButton.button, "", "b"]; ENDLOOP; }; RebuildScalarButtons: PUBLIC PROC [viewer: Viewer, headerButton: TiogaButtons.TiogaButton, clientData: REF ANY, handleProc: HandleButtonProc, scalarButtonList: LIST OF ScalarButton] RETURNS [buttons: ScalarButtonClient _ NIL] = { <> <> prevButton: TiogaButtons.TiogaButton _ headerButton; FOR list: LIST OF ScalarButton _ scalarButtonList, list.rest UNTIL list = NIL DO prevButton _ AppendScalarButton[prevButton, clientData, handleProc, list.first.name, list.first.value, list.first.init = on, list.first.action]; IF list = scalarButtonList THEN buttons _ NARROW[prevButton.clientData]; ENDLOOP; }; AppendScalarButton: PROC [prevButton: TiogaButtons.TiogaButton, clientData: REF ANY, handleProc: HandleButtonProc, name: Rope.ROPE _ NIL, value: REAL, on: BOOL, action: LIST OF REF ANY] RETURNS [button: TiogaButtons.TiogaButton] = { <> buttonData, prevButtonData: ScalarButtonClient; IF name = NIL THEN { space: CHAR = ' ; name _ IO.PutFR["%1.2f", [real[value]]]; <> <> name _ FileNames.Tail[name, space]; -- strip off leading spaces <> UNTIL Rope.Fetch[base: name, index: Rope.Length[name]-1]# '0 DO name _ Rope.Substr[base: name, start: 0, len: Rope.Length[name]-1]; ENDLOOP; }; buttonData _ NEW[ScalarButtonClientObj _ [NIL, name, value, action, on, NIL, clientData, handleProc]]; button _ TiogaButtons.AppendToButton[ button: prevButton, rope: Rope.Concat[name, " "], looks: "", proc: ToggleScalar, clientData: buttonData, fork: FALSE]; prevButtonData _ NARROW[prevButton.clientData]; IF prevButtonData # NIL THEN prevButtonData.next _ buttonData; <> buttonData.button _ button; }; ToggleScalar: TiogaButtons.TiogaButtonProc ~ { button: TiogaButtons.TiogaButton _ NARROW[parent]; buttonData: ScalarButtonClient _ NARROW[clientData]; buttonData.handleProc[buttonData.clientData, buttonData.action]; }; MakeViewer: PROC [container: Viewer, x, y: NAT] RETURNS [viewer: Viewer] = { viewer _ TiogaButtons.CreateViewer[ info: [wx: x, wy: y, ww: container.ww, wh: entryHeight, parent: container, border: FALSE] ]; <> container.class.set[self: container, data: viewer, op: $XBound]; }; NewHeaderButton: PROC [v: Viewer, name: Rope.ROPE] RETURNS [button: TiogaButtons.TiogaButton] = { button _ TiogaButtons.CreateButton[ viewer: v, rope: name, format: "", looks: "", proc: NIL, clientData: NIL]; }; <> <<>> <<(like Choice Buttons, but built for the new User Interface Architecture (queues atoms onto the slack process queue and waits for them to return before acting. Thus, the buttons can be "pushed" from the TIP Table as well as with the mouse.>> BuildEnumTypeSelection: PUBLIC PROC [ viewer: ViewerClasses.Viewer, x, y: NAT, maxWidth: NAT, clientData: REF ANY, handleProc: HandleButtonProc, title: Rope.ROPE, default: Rope.ROPE, borderOnButtons: BOOL, style: StyleChoice, allInOneRow: BOOL, buttonNames: ButtonList, atom: ATOM] RETURNS [EnumTypeRef] = { foundDefault: BOOL _ FALSE; stateInfo: EnumTypeRef _ NEW[EnumTypeRec]; DefaultFound: PROC[currentName, defaultName: Rope.ROPE] RETURNS [BOOL] = { IF Rope.Equal[currentName, defaultName, FALSE] THEN RETURN [foundDefault _ TRUE] ELSE RETURN [FALSE]; }; BuildMenuSelection: PROC = { border: INTEGER _ 10; startButtons: NAT; startX: NAT _ 0; -- keeps a running tally of where the next x position is tempButton: Buttons.Button; eachButton: ButtonList; stateInfo.type _ menuStyle; stateInfo.handleProc _ handleProc; IF title # NIL THEN { titleLabel: Labels.Label_ Labels.Create[[ name: title, parent: viewer, wx: x, wy: y, wh: entryHeight, border: FALSE ]]; startButtons _ titleLabel.wx + titleLabel.ww + entryHSpace; } ELSE startButtons _ x; startX _ startButtons; FOR eachButton _ buttonNames, eachButton.rest UNTIL eachButton = NIL DO IF ~allInOneRow THEN { IF startX + VFonts.StringWidth[eachButton.first, VFonts.defaultFont] + border >= maxWidth THEN { startX _ startButtons; stateInfo.nexty _ stateInfo.nexty + entryHeight; }; }; tempButton _ Buttons.Create[info: [ name: eachButton.first, wx: startX, wy: stateInfo.nexty, <> wh: entryHeight, -- specify rather than defaulting so line is uniform parent: viewer, border: borderOnButtons ], proc: MenuSelectionProc, clientData: stateInfo ]; ViewerOps.AddProp[tempButton, $ChoiceButtons, stateInfo]; IF DefaultFound[eachButton.first, default] THEN { stateInfo.buttonOn _ tempButton; Buttons.SetDisplayStyle[button: tempButton, style: on]; }; startX _ tempButton.wx + tempButton.ww; ENDLOOP; stateInfo.nextx _ startX; }; BuildFlipThru: PROC = { eachButton: ButtonList; titleButton: Buttons.Button; nextx: INTEGER _ x; IF title # NIL THEN { -- create a title button stateInfo.type _ flipThruWithTitle; stateInfo.handleProc _ handleProc; titleButton _ Buttons.Create[ info: [name: title, parent: viewer, wx: nextx, wy: y, wh: entryHeight, border: TRUE ], proc: FlipThruButtonProc, clientData: stateInfo ]; nextx _ titleButton.wx + titleButton.ww + 3; } ELSE stateInfo.type _ flipThruNoTitle; FOR eachButton _ buttonNames, eachButton.rest UNTIL (eachButton = NIL) OR DefaultFound[eachButton.first, default] DO -- do nothing ENDLOOP; <> IF title # NIL THEN stateInfo.flipLabel _ Labels.Create[[ name: eachButton.first, wx: nextx, wy: y, ww: MaxNameWidth[buttonNames], -- first find the longest name so we can set up the <> wh: entryHeight, parent: viewer, border: FALSE ]] ELSE stateInfo.flipLabel _ Buttons.Create[ info: [name: eachButton.first, wx: nextx, wy: y, ww: MaxNameWidth[buttonNames], wh: entryHeight, parent: viewer, border: borderOnButtons ], proc: FlipThruButtonProc, clientData: stateInfo ]; stateInfo.nextx _ stateInfo.flipLabel.wx + stateInfo.flipLabel.ww; }; stateInfo.nextx _ x; stateInfo.nexty _ y; stateInfo.atom _ atom; stateInfo.namesOfButtons _ buttonNames; stateInfo.clientData _ clientData; IF default = NIL THEN -- set it to be the first name of the list of button names default _ buttonNames.first; SELECT style FROM menuSelection => BuildMenuSelection; flipThru => BuildFlipThru; ENDCASE => ERROR; <> IF ~foundDefault THEN SIGNAL DefaultDoesntExist; stateInfo.nexty _ stateInfo.nexty + entryHeight; RETURN[stateInfo]; }; FlipThruButtonProc: Buttons.ButtonProc = { info: EnumTypeRef _ NARROW[clientData]; IF mouseButton=red THEN info.handleProc[info.clientData, LIST[info.atom, $FlipForward--, info--]] ELSE info.handleProc[info.clientData, LIST[info.atom, $FlipBackward--, info--]]; }; TimeToFlipThru: PUBLIC PROC [event: LIST OF REF ANY] = { info: EnumTypeRef _ NARROW[event.rest.first]; IF event.first = $FlipForward THEN <> ViewerTools.SetContents[viewer: info.flipLabel, contents: GetNextName[info.namesOfButtons, info.flipLabel.name]] ELSE IF event.first = $FlipBackward THEN ViewerTools.SetContents[viewer: info.flipLabel, contents: GetPrevName[info.namesOfButtons, info.flipLabel.name]]; }; UpdateChoiceButtons: PUBLIC PROC [viewer: ViewerClasses.Viewer, enumTypeInfo: EnumTypeRef, newName: Rope.ROPE] = { newButton: Buttons.Button _ NIL; GetDesiredButton: ViewerOps.EnumProc = { IF (Rope.Equal[v.name, newName, FALSE]) AND (ViewerOps.FetchProp[v, $ChoiceButtons] = enumTypeInfo) THEN { newButton _ v; RETURN [FALSE]; }; }; IF enumTypeInfo = NIL THEN SIGNAL ButtonsCannotBeUpdated; SELECT enumTypeInfo.type FROM menuStyle => {ViewerOps.EnumerateChildren[viewer, GetDesiredButton]; IF newButton # NIL THEN { SwitchButtons[enumTypeInfo.buttonOn, newButton]; enumTypeInfo.buttonOn _ newButton; } ELSE SIGNAL ChoiceDoesntExist; }; flipThruWithTitle => Labels.Set[label: enumTypeInfo.flipLabel, value: newName]; flipThruNoTitle => Buttons.ReLabel[button: enumTypeInfo.flipLabel, newName: newName]; ENDCASE => ERROR; }; DefaultDoesntExist: PUBLIC SIGNAL = CODE; ChoiceDoesntExist: PUBLIC SIGNAL = CODE; ButtonsCannotBeUpdated: PUBLIC SIGNAL = CODE; MaxNameWidth: PROC[listOfNames: ButtonList] RETURNS [CARDINAL] = { eachButton: ButtonList _ listOfNames; maxWidth: CARDINAL; IF eachButton # NIL THEN { maxWidth _ VFonts.StringWidth[string: eachButton.first, font: VFonts.defaultFont]; eachButton _ eachButton.rest } ELSE RETURN [0]; WHILE (eachButton # NIL) DO IF VFonts.StringWidth[string: eachButton.first, font: VFonts.defaultFont] > maxWidth THEN maxWidth _ VFonts.StringWidth[string: eachButton.first, font: VFonts.defaultFont]; eachButton _ eachButton.rest; ENDLOOP; maxWidth _ maxWidth + VFonts.CharWidth['M]; -- add on a little extra just to be sure RETURN[maxWidth]; }; MenuSelectionProc: Buttons.ButtonProc = { info: EnumTypeRef _ NARROW[clientData]; viewer: ViewerClasses.Viewer _ NARROW[parent]; SwitchButtons[info.buttonOn, viewer]; -- viewer is the button which was just selected info.buttonOn _ viewer; <> <> }; GetNextName: PROC[listOfNames: ButtonList, currentName: Rope.ROPE] RETURNS [Rope.ROPE] = { eachButton: ButtonList _ listOfNames; WHILE (eachButton # NIL) AND (eachButton.first # currentName) DO eachButton _ eachButton.rest; ENDLOOP; IF eachButton = NIL THEN ERROR; -- This shouldn't happen; we should always be able to <> IF eachButton.rest = NIL THEN <> RETURN [listOfNames.first] ELSE RETURN [(eachButton.rest).first]; }; GetPrevName: PROC[listOfNames: ButtonList, currentName: Rope.ROPE] RETURNS [Rope.ROPE] = { prev: Rope.ROPE _ listOfNames.first; eachName: ButtonList _ listOfNames.rest; WHILE (eachName # NIL) AND ~Rope.Equal[eachName.first, currentName, FALSE] DO prev _ eachName.first; eachName _ eachName.rest; ENDLOOP; RETURN[prev]; }; on: ATOM = $WhiteOnBlack; off: ATOM = $BlackOnWhite; SwitchButtons: PROC[oldButton, newButton: Buttons.Button] = { <> <> Buttons.SetDisplayStyle[button: oldButton, style: off]; <> Buttons.SetDisplayStyle[button: newButton, style: on]; }; END.