ChoiceButtonsImpl.mesa
Copyright © 1985 by Xerox Corporation. All rights reserved.
Written by Linda Gass on August 30, 1982 1:21 pm
Last Edit by McGregor October 5, 1982 12:28 pm
Last Edited by: Maxwell, January 3, 1983 12:35 pm
Doug Wyatt, April 6, 1985 3:23:52 pm PST
DIRECTORY
Buttons USING [Button, ButtonProc, Create, ReLabel, SetDisplayStyle],
ChoiceButtons,
Containers USING [ChildXBound],
Labels USING [Create, Label, Set],
Rope USING [ROPE, Equal],
ViewerClasses USING [Viewer],
ViewerOps USING [AddProp, EnumProc, EnumerateChildren, FetchProp],
ViewerTools USING [MakeNewTextViewer, SetContents, SetSelection],
VFonts USING [CharWidth, Font, FontHeight, StringWidth, defaultFont];
ChoiceButtonsImpl: CEDAR PROGRAM
IMPORTS Buttons, Containers, Labels, Rope, ViewerOps, ViewerTools, VFonts
EXPORTS ChoiceButtons
= BEGIN OPEN ChoiceButtons;
ROPE: TYPE ~ Rope.ROPE;
entryHeight: CARDINAL = 15; -- how tall to make each line of items
entryHSpace: CARDINAL = 10; -- horizontal space between title and selections
fudge:
CARDINAL = 5;
-- fudge factor so that the baselines of text viewers are aligned with
their corresponding labels
on: ATOM = $WhiteOnBlack;
off: ATOM = $BlackOnWhite;
DefaultDoesntExist: PUBLIC SIGNAL = CODE;
ChoiceDoesntExist: PUBLIC SIGNAL = CODE;
ButtonsCannotBeUpdated: PUBLIC SIGNAL = CODE;
BuildEnumTypeSelection:
PUBLIC
PROC [viewer: ViewerClasses.Viewer, x, y:
CARDINAL, title:
ROPE, buttonNames: ButtonList, default:
ROPE, borderOnButtons:
BOOL, notifyClientProc: SelectionNotifierProc, permit: EnumPermissionProc, clientdata:
REF
ANY, style: StyleChoice, allInOneRow:
BOOL, maxWidth:
INTEGER]
RETURNS [EnumTypeRef] = {
foundDefault: BOOL ← FALSE;
stateInfo: EnumTypeRef ← NEW[EnumTypeRec];
DefaultFound:
PROC[currentName, defaultName:
ROPE]
RETURNS [
BOOL] = {
IF Rope.Equal[currentName, defaultName,
FALSE]
THEN
RETURN [foundDefault ←
TRUE]
ELSE RETURN [FALSE];
};
BuildMenuSelection:
PROC = {
border: INTEGER ← 10;
startButtons: CARDINAL;
startX: INTEGER ← 0; -- keeps a running tally of where the next x position is
tempButton: Buttons.Button;
eachButton: ButtonList;
stateInfo.type ← menuStyle;
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,
default the width so that it will be computed for us
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;
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;
now set up the initial button
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
width properly (unfortunately when re-labeling a button, the width remains the same)
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.proc ← notifyClientProc;
stateInfo.namesOfButtons ← buttonNames;
stateInfo.clientdata ← clientdata;
stateInfo.permission ← permit;
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;
signal that the default didn't exist if necessary
IF ~foundDefault THEN SIGNAL DefaultDoesntExist;
stateInfo.nexty ← stateInfo.nexty + entryHeight;
RETURN[stateInfo];
};
MenuSelectionProc: Buttons.ButtonProc = {
info: EnumTypeRef ← NARROW[clientData];
viewer: ViewerClasses.Viewer ← NARROW[parent];
IF info.permission #
NIL
THEN {
IF info.permission[info]
THEN {
-- don't do anything without permission first
SwitchButtons[info.buttonOn, viewer]; -- viewer is the button which was just selected
info.buttonOn ← viewer;
Notify client that change has taken place if the client provided a proc for doing this
IF info.proc # NIL THEN info.proc[viewer.name, info.clientdata];
}}
ELSE {
SwitchButtons[info.buttonOn, viewer]; -- viewer is the button which was just selected
info.buttonOn ← viewer;
Notify client that change has taken place if the client provided a proc for doing this
IF info.proc # NIL THEN info.proc[viewer.name, info.clientdata];
};
};
SwitchButtons:
PRIVATE
PROC[oldButton, newButton: Buttons.Button] = {
merely changes the physical appearance of the buttons
Switch off the previously selected button
Buttons.SetDisplayStyle[button: oldButton, style: off];
switch "on" the newly selected button
Buttons.SetDisplayStyle[button: newButton, style: on];
};
FlipThruButtonProc: Buttons.ButtonProc = {
info: EnumTypeRef ← NARROW[clientData];
IF info.permission #
NIL
THEN {
IF info.permission[info]
THEN {
-- don't do anything without permission first
IF mouseButton=red THEN
Display the next name in succession
ViewerTools.SetContents[viewer: info.flipLabel, contents:
GetNextName[info.namesOfButtons, info.flipLabel.name]]
ELSE
-- Display the previous name
ViewerTools.SetContents[viewer: info.flipLabel, contents:
GetPrevName[info.namesOfButtons, info.flipLabel.name]];
Notify client that change has taken place if the client provided a proc for doing this
IF info.proc # NIL THEN info.proc[info.flipLabel.name, info.clientdata];
}}
ELSE {
IF mouseButton=red
THEN
Display the next name in succession
ViewerTools.SetContents[viewer: info.flipLabel, contents:
GetNextName[info.namesOfButtons, info.flipLabel.name]]
ELSE
-- display the previous name
ViewerTools.SetContents[viewer: info.flipLabel, contents:
GetPrevName[info.namesOfButtons, info.flipLabel.name]];
Notify client that change has taken place if the client provided a procedure for doing this
IF info.proc # NIL THEN info.proc[info.flipLabel.name, info.clientdata];
};
};
UpdateChoiceButtons:
PUBLIC
PROC [viewer: ViewerClasses.Viewer, enumTypeInfo: EnumTypeRef, newName:
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;
};
GetSelectedButton:
PUBLIC
PROC [handle: EnumTypeRef]
RETURNS [
ROPE] = {
IF handle.type = menuStyle
THEN {
IF handle.buttonOn = NIL THEN ERROR
ELSE RETURN [handle.buttonOn.name]
}
ELSE {
IF handle.flipLabel = NIL THEN ERROR
ELSE RETURN[handle.flipLabel.name]
};
};
GetNextName:
PRIVATE
PROC[listOfNames: ButtonList, currentName:
ROPE]
RETURNS
[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
find the current button name in list of button names
IF eachButton.rest =
NIL
THEN
we are at the end of our list, cycle around to the beginning
RETURN [listOfNames.first]
ELSE RETURN [(eachButton.rest).first];
};
GetPrevName:
PRIVATE
PROC[listOfNames: ButtonList, currentName:
ROPE]
RETURNS
[ROPE] = {
prev: ROPE ← listOfNames.first;
eachName: ChoiceButtons.ButtonList ← listOfNames.rest;
WHILE (eachName #
NIL)
AND ~Rope.Equal[eachName.first, currentName,
FALSE]
DO
prev ← eachName.first;
eachName ← eachName.rest;
ENDLOOP;
RETURN[prev];
};
MaxNameWidth:
PRIVATE
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];
};
BuildTriStateButton:
PUBLIC
PROC [viewer: ViewerClasses.Viewer, x,y:
INTEGER, name:
ROPE]
RETURNS [stateInfo: ThreeStateRef, nextX:
INTEGER] = {
tempButton: Buttons.Button;
stateInfo ← NEW[ThreeState];
tempButton ← Buttons.Create[
info: [name: name,
wx: x,
wy: y,
default the width so that it will be computed for us
wh: entryHeight, -- specify rather than defaulting so line is uniform
parent: viewer,
border: TRUE
],
proc: TriSwitchProc,
clientData: stateInfo -- this will be passed to our button proc
];
stateInfo.button ← tempButton;
nextX ← tempButton.wx + tempButton.ww + 4;
};
SetButtonState:
PUBLIC
PROC [buttonSelected: Buttons.Button, state: StateType] = {
SELECT state
FROM
on => Buttons.SetDisplayStyle[button: buttonSelected, style: $WhiteOnBlack];
off => Buttons.SetDisplayStyle[button: buttonSelected, style: $BlackOnWhite];
default => Buttons.SetDisplayStyle[button: buttonSelected, style: $BlackOnGrey];
ENDCASE => ERROR;
};
NextState:
PROC [state: StateType]
RETURNS [StateType] = {
IF state = LAST[StateType] THEN RETURN[FIRST[StateType]]
ELSE RETURN[SUCC[state]];
};
TriSwitchProc: Buttons.ButtonProc = {
handle: ThreeStateRef ← NARROW[clientData];
handle.state ← NextState[handle.state];
Indicate which state this button is in.
SetButtonState[handle.button, handle.state];
};
BuildTextPrompt:
PUBLIC
PROC [viewer: ViewerClasses.Viewer, x,y:
CARDINAL, title:
ROPE, default:
ROPE, font: VFonts.Font, textViewerWidth:
INTEGER, clientdata:
REF
ANY, notify: SelectionNotifierProc, permit: PromptPermissionProc]
RETURNS [promptData: PromptDataRef] = {
height: INTEGER ← VFonts.FontHeight[font] + 6;
promptData ← NEW[PromptDataRec];
promptData.promptButton ← Buttons.Create[info: [name: title, wx: x, wy: y, wh: height,
parent: viewer, border: FALSE], font: font, proc: PromptProc, clientData: promptData];
promptData.textViewer ← ViewerTools.MakeNewTextViewer [[
parent: viewer,
wx: promptData.promptButton.wx + promptData.promptButton.ww + entryHSpace,
wy: y + fudge,
ww: textViewerWidth,
wh: height - fudge,
name: title, -- give it the name of the prompt associated with it
data: default,
scrollable: FALSE,
border: FALSE
]];
IF textViewerWidth =
LAST[
INTEGER]
THEN {
Containers.ChildXBound[viewer, promptData.textViewer];
promptData.newx ← LAST[INTEGER];
}
ELSE promptData.newx ← promptData.textViewer.wx + promptData.textViewer.ww;
IF default # NIL THEN ViewerTools.SetContents[promptData.textViewer, default];
promptData.clientdata ← clientdata;
promptData.notify ← notify;
promptData.permission ← permit;
promptData.newy ← y + height;
};
PromptProc: Buttons.ButtonProc = {
handle: PromptDataRef ← NARROW[clientData];
viewer: ViewerClasses.Viewer ← NARROW[parent];
IF handle.permission #
NIL
THEN {
IF handle.permission[handle]
THEN {
-- dont do anything without permission
IF mouseButton=red
THEN
-- make pending delete
ViewerTools.SetSelection[handle.textViewer]
ELSE
-- notify the client if proc provided.
IF handle.notify # NIL THEN handle.notify[viewer.name, handle.clientdata];
}}
ELSE {
IF mouseButton=red
THEN
-- make pending delete
ViewerTools.SetSelection[handle.textViewer]
ELSE
-- notify the client if proc provided.
IF handle.notify # NIL THEN handle.notify[viewer.name, handle.clientdata];
}
};
END.