ButtonsImpl.mesa
Copyright Ó 1985, 1986, 1987, 1991 by Xerox Corporation. All rights reserved.
Russ Atkinson (RRA) May 7, 1986 0:36:03 am PDT
Rick Beach, May 10, 1986 4:32:02 pm PDT
Doug Wyatt, February 26, 1987 9:17:24 pm PST
Bier, December 5, 1988 12:46:55 pm PST
Philip James, March 20, 1990 11:07 am PST
Michael Plass, March 13, 1992 12:50 pm PST
DIRECTORY
Buttons USING [Button, ButtonProc],
ButtonsPrivate USING [ButtonData, ButtonDataRec, DisplayStyle],
CedarProcess USING [SetPriority],
ChoiceButtons,
Containers USING [ChildXBound],
Imager USING [black, Color, Font, MaskRectangleI, SetColor, SetFont, SetXYI, ShowRope, white],
ImagerBackdoor USING [invert, MakeStipple],
InputFocus USING [CaptureButtons, ReleaseButtons],
Labels USING [Create, Label, Set],
MessageWindowBackdoor,
Process USING [Detach, Milliseconds, MsecToTicks, SetTimeout],
Rope USING [ROPE, Equal],
TIPUser USING [InstantiateNewTIPTable, TIPScreenCoords],
VFonts USING [CharWidth, defaultFont, DefaultFont, Font, FontHeight, StringWidth],
ViewerClasses USING [GetProc, GuardState, MouseButton, NotifyProc, PaintProc, PaintRectangle, SetProc, Viewer, ViewerClass, ViewerClassRec, ViewerRec],
ViewerOps USING [AddProp, CreateViewer, DestroyViewer, EnumerateChildren, EnumProc, FetchProp, MouseInViewer, PaintViewer, RegisterViewerClass],
ViewerPrivate USING [Document],
ViewerTools USING [MakeNewTextViewer, SetContents, SetSelection];
ButtonsImpl: CEDAR MONITOR LOCKS data USING data: ButtonData
IMPORTS CedarProcess, Containers, Imager, ImagerBackdoor, InputFocus, Labels, MessageWindowBackdoor, Process, Rope, TIPUser, VFonts, ViewerOps, ViewerPrivate, ViewerTools
EXPORTS Buttons, ChoiceButtons
= BEGIN OPEN Buttons, ButtonsPrivate, ChoiceButtons, ViewerClasses;
Types & constants
bottomOffset: INTEGER = 2;
guardOffset: INTEGER = 3;
sideMargin: INTEGER = 3;
extraHeight: INTEGER = 3;
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;
Global variables
armingTime: Process.Milliseconds ¬ 100; -- cover removal time.
armedTime: Process.Milliseconds ¬ 5000; -- unguarded interval.
procedures for Buttons
Create: PUBLIC PROC [info: ViewerRec ¬ [], proc: ButtonProc, clientData: REF ANY ¬ NIL,
fork: BOOL ¬ FALSE, font: Imager.Font ¬ NIL, documentation: REF ANY ¬ NIL,
guarded: BOOL ¬ FALSE, paint: BOOL ¬ TRUE] RETURNS [button: Button] = {
data: ButtonData ¬ NEW[ButtonDataRec ¬ [proc: proc,
font: VFonts.DefaultFont[font], clientData: clientData, documentation: documentation, fork: fork, guarded: guarded, state: IF guarded THEN guarded ELSE armed]];
IF info.ww=0 THEN info.ww ¬ VFonts.StringWidth[info.name, data.font]+sideMargin*2;
IF info.wh=0 THEN info.wh ¬ VFonts.FontHeight[data.font]+extraHeight;
IF info.parent=NIL AND info.wx=0 AND info.wy=0 THEN {
[info.wx, info.wy, info.ww, info.wh] ¬ MessageWindowBackdoor.AllocateStaticArea[info.ww];
info.column ¬ static;
info.spare5 ¬ TRUE; -- mark as top row
};
info.data ¬ data;
IF documentation#NIL THEN WITH documentation SELECT FROM
doc: REF TEXT => NULL;
doc: REF ButtonProc => NULL;
doc: Rope.ROPE => NULL;
ENDCASE => ERROR; -- not valid documentation
RETURN[ViewerOps.CreateViewer[$Button, info, paint]];
};
buttonGrey: Imager.Color ~ ImagerBackdoor.MakeStipple[stipple: 001010B];
ButtonPaint: PaintProc = {
data: ButtonData ~ NARROW[self.data];
margin: INTEGER ~ 1;
x: INTEGER ~ margin-self.cx;
y: INTEGER ~ margin-self.cy;
w: INTEGER ~ self.ww-2*margin;
h: INTEGER ~ self.wh-2*margin;
x, y, w, h is a box whose edges are "margin" units inside the window (not client) area
IF data = NIL THEN RETURN;
IF ISTYPE[whatChanged, PaintRectangle] THEN whatChanged ¬ NIL;
IF whatChanged=NIL THEN {
paint in label (derived from name)
background: Imager.Color ¬ Imager.white;
IF data.greyCount#0 THEN background ¬ buttonGrey
ELSE SELECT data.displayStyle FROM
blackOnWhite => background ¬ Imager.white;
blackOnGrey => background ¬ buttonGrey;
whiteOnBlack => background ¬ Imager.black;
ENDCASE;
IF clear AND background=Imager.white THEN NULL
ELSE {
Imager.SetColor[context, background];
Imager.MaskRectangleI[context, x, y, w, h];
};
Imager.SetColor[context, IF data.displayStyle=whiteOnBlack THEN Imager.white ELSE Imager.black];
Imager.SetXYI[context, x+sideMargin, y+bottomOffset];
Imager.SetFont[context, data.font];
Imager.ShowRope[context, self.name];
IF data.guarded AND data.state#armed THEN {
Imager.MaskRectangleI[context, x, y+bottomOffset+guardOffset, w, 1];
};
};
IF whatChanged=$Invert OR data.inverted THEN { -- invert to indicate highlighting
Imager.SetColor[context, ImagerBackdoor.invert];
Imager.MaskRectangleI[context, x, y, w, h];
IF whatChanged=$Invert THEN data.inverted ¬ ~data.inverted;
};
};
ButtonNotify: NotifyProc = {
data: ButtonData ¬ NARROW[self.data];
EntryButtonNotify[self, input, data];
};
EntryButtonNotify: ENTRY PROC [self: Viewer, input: LIST OF REF ANY, data: ButtonData] = {
ENABLE UNWIND => InputFocus.ReleaseButtons[];
button: ViewerClasses.MouseButton ¬ red;
shift, control: BOOL ¬ FALSE;
mouse: TIPUser.TIPScreenCoords;
IF data = NIL THEN RETURN;
FOR list: LIST OF REF ANY ¬ input, list.rest UNTIL list = NIL DO
WITH list.first SELECT FROM
x: ATOM => SELECT x FROM
$Blue => button ¬ blue;
$Control => control ¬ TRUE;
$Documentation => IF data.documentation#NIL THEN
ViewerPrivate.Document[data.documentation, self, data.clientData,
button, shift, control];
$Hit => IF data.inverted THEN SELECT data.state FROM
guarded => {
data.state¬arming;
ViewerOps.PaintViewer[self, client, FALSE, $Invert];
InputFocus.ReleaseButtons[];
TRUSTED {Process.Detach[FORK ArmButtonProc[data, self]]};
IF data.documentation#NIL THEN -- post documentation
ViewerPrivate.Document[data.documentation, self, data.clientData,
button, shift, control];
};
arming=> NULL; -- no action
armed=> {
InputFocus.ReleaseButtons[];
ViewerOps.PaintViewer[self, client, FALSE, $Invert];
IF data.guarded THEN {
data.state¬guarded;
ViewerOps.PaintViewer[self, client];
};
IF data.fork THEN TRUSTED {Process.Detach[FORK ButtonPusher[self,
data, data.proc, data.clientData, button, shift, control, TRUE]]}
ELSE ButtonPusher[self, data, data.proc, data.clientData,
button, shift, control, FALSE]; };
ENDCASE;
$Mark => IF ~data.inverted THEN {
InputFocus.CaptureButtons[ButtonNotify, buttonClass.tipTable, self];
ViewerOps.PaintViewer[self, client, FALSE, $Invert];
}
ELSE {
v: Viewer;
c: BOOL;
[v, c] ¬ ViewerOps.MouseInViewer[mouse];
IF v=self AND c THEN RETURN;
ViewerOps.PaintViewer[self, client, FALSE, $Invert];
InputFocus.ReleaseButtons[];
};
$Red => button ¬ red;
$Shift => shift ¬ TRUE;
$Yellow => button ¬ yellow;
ENDCASE => NULL;
z: TIPUser.TIPScreenCoords => mouse ¬ z;
ENDCASE => ERROR;
ENDLOOP;
};
ArmButtonProc: ENTRY PROC [data: ButtonData, button: Buttons.Button] = {
assert: state=arming
IF data = NIL THEN RETURN;
ButtonWait[data, armingTime];
IF data.state = arming THEN {
data.state¬armed;
ViewerOps.PaintViewer[button, client];
ButtonWait[data, armedTime];
};
IF data.state#guarded THEN {
data.state¬guarded;
ViewerOps.PaintViewer[button, client];
};
};
ButtonWait: INTERNAL PROC[data: ButtonData, ticks: Process.Milliseconds] = TRUSTED {
buttonWaitCondition: CONDITION;
Process.SetTimeout[LONG[@buttonWaitCondition], Process.MsecToTicks[ticks]];
WAIT buttonWaitCondition;
};
ButtonPusher: PROC [button: Button, myData: ButtonData, proc: ButtonProc, data: REF ANY,
mouseButton: ViewerClasses.MouseButton, shift, control, normalPriority: BOOL] = {
IF myData = NIL THEN RETURN;
myData.greyCount ¬ myData.greyCount + 1;
IF myData.displayStyle#blackOnGrey THEN ViewerOps.PaintViewer[button, client];
IF normalPriority THEN CedarProcess.SetPriority[normal];
proc[button, data, mouseButton, shift, control ! ABORTED => CONTINUE];
myData.greyCount ¬ MAX[myData.greyCount - 1, 0];
IF myData.displayStyle#blackOnGrey THEN ViewerOps.PaintViewer[button, client];
};
ButtonGet: PRIVATE GetProc = {
RETURN[self.name];
};
ButtonSet: PRIVATE SetProc = {
IF op=NIL
THEN self.name ¬ NARROW[data]
ELSE WITH self.data SELECT FROM
myData: ButtonData =>
SELECT data FROM
$BlackOnWhite => {
myData.greyCount ¬ MAX[myData.greyCount - 1, 0];
IF myData.greyCount <= 0 THEN myData.displayStyle ¬ blackOnWhite};
$WhiteOnBlack => {
myData.greyCount ¬ MAX[myData.greyCount - 1, 0];
IF myData.greyCount <= 0 THEN myData.displayStyle ¬ whiteOnBlack};
$BlackOnGrey, $BlackOnGray => {
myData.greyCount ¬ myData.greyCount + 1;
myData.displayStyle ¬ blackOnWhite};
ENDCASE => ERROR;
ENDCASE => RETURN;
IF finalise THEN ViewerOps.PaintViewer[self, all];
};
Destroy: PUBLIC PROC [button: Button] = {
ViewerOps.DestroyViewer[button];
};
ReLabel: PUBLIC PROC [button: Button, newName: Rope.ROPE, paint: BOOL ¬ TRUE] = {
button.class.set[button, newName, paint];
};
SetDisplayStyle: PUBLIC PROC [button: Button, style: ATOM, paint: BOOL ¬ TRUE] = {
button.class.set[button, style, paint, $DisplayStyle]
};
procedure for ChoiceButtons
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 ¬ 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;
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 ¬ 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 ¬ 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 = {
viewer: ViewerClasses.Viewer ¬ NARROW[parent];
WITH clientData SELECT FROM
info: EnumTypeRef =>
IF info.permission = NIL OR info.permission[info] THEN {
SwitchButtons[info.buttonOn, viewer];
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];
};
ENDCASE;
};
SwitchButtons: PRIVATE PROC[oldButton, newButton: Buttons.Button] = {
merely changes the physical appearance of the buttons
Switch off the previously selected button
SetDisplayStyle[button: oldButton, style: off];
switch "on" the newly selected button
SetDisplayStyle[button: newButton, style: on];
};
FlipThruButtonProc: Buttons.ButtonProc = {
WITH clientData SELECT FROM
info: EnumTypeRef =>
IF info.permission = NIL OR info.permission[info] THEN {
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];
};
ENDCASE;
};
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 => 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;
RETURN [handle.buttonOn.name]
}
ELSE {
IF handle.flipLabel = NIL THEN ERROR;
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 ¬ 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 => SetDisplayStyle[button: buttonSelected, style: $WhiteOnBlack];
off => SetDisplayStyle[button: buttonSelected, style: $BlackOnWhite];
default => SetDisplayStyle[button: buttonSelected, style: $BlackOnGrey];
ENDCASE => ERROR;
};
TriSwitchProc: Buttons.ButtonProc = {
handle: ThreeStateRef ¬ NARROW[clientData];
state: StateType ¬ handle.state;
handle.state ¬ state ¬ IF state = LAST[StateType] THEN FIRST[StateType] ELSE SUCC[state];
Indicate which state this button is in.
SetButtonState[handle.button, 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] = {
container: BOOL ~ viewer.class # NIL AND viewer.class.flavor = $Container;
buttonY: NAT ~ IF container THEN y+3 ELSE y;
textY: NAT ~ IF container THEN y+1 ELSE y+2;
height: INTEGER ¬ VFonts.FontHeight[font];
promptData ¬ NEW[PromptDataRec];
promptData.promptButton ¬ Create[info: [name: title, wx: x, wy: buttonY, 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: textY,
ww: textViewerWidth,
wh: height,
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 = {
viewer: ViewerClasses.Viewer ¬ NARROW[parent];
WITH clientData SELECT FROM
handle: PromptDataRef =>
IF handle.permission = NIL OR handle.permission[handle] THEN
SELECT TRUE FROM
mouseButton=red =>
make pending delete
ViewerTools.SetSelection[handle.textViewer];
handle.notify # NIL =>
notify the client if proc provided.
handle.notify[viewer.name, handle.clientdata];
ENDCASE;
ENDCASE;
};
Initialization
buttonClass: ViewerClasses.ViewerClass ¬ NEW[ViewerClasses.ViewerClassRec ¬ [
paint: ButtonPaint,
get: ButtonGet,
set: ButtonSet,
notify: ButtonNotify,
tipTable: TIPUser.InstantiateNewTIPTable["Button.tip"],
cursor: bullseye
]];
ViewerOps.RegisterViewerClass[$Button, buttonClass]; -- plug in to Viewers
END.