[_CDCSL_93-16_]<1>Cedar>release>ButtonClasses>ButtonClassesImpl.mesa

ButtonClassesImpl.mesa

Contents: EmbeddedButtons button classes

Last edited by Goodisman, August 18, 1989 1:57:51 pm PDT

Kenneth A. Pier, August 27, 1990 4:18 pm PDT

Bier, July 24, 1992 6:26 pm PDT

Doug Wyatt, April 16, 1992 11:12 am PDT

DIRECTORY

Atom, AtomButtons, AtomButtonsTypes, BasicTime, ButtonClassesCommon, CedarProcess, CodeTimer, Convert, EBButtonClasses, EBEvent, EBLanguage, EBMesaLisp, EBTypes, EmbeddedButtons, Imager, InputFocus, IO, List, PopUpButtons, Process, RefTab, Rope, RuntimeError, ScreenCoordsTypes, SimpleFeedback, TIPPrivate, TIPTypes, TIPUser, UserInput, UserInputLookahead, UserInputOps, ViewerClasses;

ButtonClassesImpl: CEDAR MONITOR

IMPORTS Atom, AtomButtons, BasicTime, ButtonClassesCommon, CedarProcess, CodeTimer, Convert, EBButtonClasses, EBLanguage, EBMesaLisp, EmbeddedButtons, Imager, InputFocus, IO, PopUpButtons, Process, Rope, RuntimeError, SimpleFeedback, UserInputLookahead, UserInputOps, TIPPrivate, TIPUser

EXPORTS ButtonClassesCommon, EBTypes =

BEGIN

ButtonInfo: TYPE = EBTypes.ButtonInfo;

Context: TYPE = EBTypes.Context;

EventRep: PUBLIC TYPE = EBEvent.EventRep; -- for EBTypes

HandleRep: PUBLIC TYPE = UserInputPrivate.Rep; -- for UserInput

ROPE: TYPE = Rope.ROPE;

Variable: TYPE = EBLanguage.Variable;

VariableObj: TYPE = EBLanguage.VariableObj;

VariableType: TYPE = EBLanguage.VariableType;

VariableTypeObj: TYPE = EBLanguage.VariableTypeObj;

VariableTable: TYPE = EBLanguage.VariableTable;

TIPScreenCoords: TYPE = ScreenCoordsTypes.TIPScreenCoords;

ActiveClientData: TYPE = REF ActiveClientDataRec;

ActiveClientDataRec: TYPE = RECORD[

buttonInfo: ButtonInfo,

instanceData: REF];

Used for packing information away to be passed through other package's clientData fields.

Pop-up State Button Class

Behavior:

Pop-up state buttons have both a pop-up menu and a state. The menu lists the possible states of the button. By selecting a given menu item (either by slow-clicking or fast-clicking; see the PopUp class below) the user moves the button to the new state.

Feedback:

Pop-up state buttons always succeed. Either they change state if a selection was made or they don't. The Feedback section of these buttons usually describes how to display each possible state value.

Example: PopUpStateButton

Pop-up state button class record definition

popUpStateClass: EBButtonClasses.ButtonClass ¬ NEW[EBButtonClasses.ButtonClassObj ¬ [

instantiate: PopUpStateInstantiate,

unparseInstanceData: PopUpStateUnparse,

handleEvent: PopUpStateHandle,

getValue: PopUpStateGet,

setValue: PopUpStateSet,

defaultBehavior: PopUpStateDefaultBehavior]];

PopUpStateData: TYPE = REF PopUpStateDataObj;

PopUpStateDataObj: TYPE = RECORD[

popUp: REF,

multi: Multi,

newValue: REF ¬ NIL

];

bigFont: Imager.Font ¬ Imager.FindFontScaled["xerox/tiogafonts/helvetica10", 1.0];

PopUpStateInstantiate: EBButtonClasses.InstantiateProc = {

PROC [buttonInfo: ButtonInfo, language: ATOM, languageVersion: NAT, initFeedback: BOOL ← FALSE] RETURNS [instance: REF];

menuName: ROPE;

choices: AtomButtons.PopUpChoices;

self: PopUpStateData;

quickClickEnabled: BOOL ¬ TRUE;

IF language # $Poppy THEN RETURN[NIL];

self ¬ NEW[PopUpStateDataObj];

self.multi ¬ NEW[MultiRec ¬ [

nameExists: FALSE,

value: NEW[VariableObj ¬ [

type: NEW[VariableTypeObj[3]],

value: NEW[INT ¬ 1]]],

message: NIL,

mouseInside: FALSE,

defaultDirection: FALSE -- down

]];

self.multi.value.type.class ¬ enumerated;

FOR i: INT IN [1..3] DO

self.multi.value.type.enumeration[i-1] ¬ NEW[INT ¬ i];

ENDLOOP;

MultiInstantiateAux[buttonInfo, language, languageVersion, self.multi, initFeedback];

BEGIN

menuRope: ROPE ¬ EmbeddedButtons.GetFieldRope[$Menu, buttonInfo];

IF menuRope = NIL THEN {

choices ¬ PopUpStateMakeMenu[self.multi];

menuName ¬ "Values";

}

ELSE {

ropeStream: IO.STREAM ¬ IO.RIS[menuRope];

object: REF;

quickClickRope: ROPE ¬ EmbeddedButtons.GetFieldRope[$QuickClickEnabled, buttonInfo];

quickClickEnabled ¬ IF quickClickRope = NIL THEN TRUE

ELSE Convert.BoolFromRope[quickClickRope ! Convert.Error => {quickClickEnabled ¬ TRUE; CONTINUE}];

object ¬ EBMesaLisp.Parse[ropeStream].val;

IF object = NIL THEN {

menuName ¬ "DummyName";

choices ¬ LIST[[action: LIST[$Dummy], actionImage: "No Action", doc: "Embedded Buttons couldn't parse the Menu entry for this button"]];

}

ELSE [menuName, choices] ¬ PopUpStateParseMenu[object, menuRope];

};

END;

BEGIN

entry: AtomButtons.ButtonLineEntry ¬ [popUpButton[

choices: choices,

help: PopUpButtons.noHelp, -- providing this field saves lots of compute time in PCedar

font: bigFont,

disableDecoding: NOT quickClickEnabled

]];

self.popUp ¬ AtomButtons.BuildPopUp[

clientData: self,

handleProc: PopUpStatePassEventToApplication,

paint: PopUpPaint,

inButton: PopUpInButton,

entry: entry,

clientPackageName: "ButtonClasses"];

END;

RETURN[self];

};

PopUpStateMenuAction: TYPE = REF PopUpStateMenuActionObj;

PopUpStateMenuActionObj: TYPE = RECORD [

message: LIST OF REF,

value: REF

];

GetMenuListAndName: PROC [obj: REF, instanceData: ROPE] RETURNS [o: LIST OF REF, menuName: ROPE ¬ NIL, success: BOOL ¬ TRUE] = {

Make sure that the object is a list, since a menu must be.

IF NOT ISTYPE[obj, LIST OF REF] THEN {

EmbeddedButtons.Error["Pop-up button: Invalid ButtonData!", Rope.Concat["The ButtonData for this pop-up button is invalid:\n", instanceData]];

RETURN[NIL, NIL, FALSE];

};

o ¬ NARROW[obj];

Get the menu name if there is one. If o.first is NIL, we assume that it is a blank first entry rather than a blank menu name.

IF o.first # NIL AND ISTYPE[o.first, ROPE] THEN {

menuName ¬ NARROW[o.first];

o ¬ o.rest;

};

GetMessageAsList: PROC [entry: LIST OF REF] RETURNS [event: LIST OF REF] = {

IF entry.first = NIL THEN event ¬ NIL

ELSE {

WITH entry.first SELECT FROM

lor: LIST OF REF => event ¬ lor;

ENDCASE => event ¬ LIST[entry.first];

};

GetMenuEntry: PROC [entry: LIST OF REF] RETURNS [menuEntry: ROPE, success: BOOL ¬ TRUE] = {

IF entry.rest = NIL THEN RETURN[NIL, FALSE];

IF NOT ISTYPE[entry.rest.first, ROPE] THEN RETURN[NIL, FALSE];

menuEntry ¬ NARROW[entry.rest.first];

};

GetDocString: PROC [entry: LIST OF REF] RETURNS [docString: ROPE ¬ NIL, success: BOOL ¬ TRUE] = {

IF entry.rest.rest = NIL THEN docString ¬ ""

ELSE {

IF NOT ISTYPE[entry.rest.rest.first, ROPE] THEN RETURN[NIL, FALSE];

docString ¬ NARROW[entry.rest.rest.first];

};

PopUpStateParseMenu: PROC [obj: REF, instanceData: ROPE] RETURNS [menuName: ROPE ¬ NIL, choices: AtomButtons.PopUpChoices ¬ NIL] = {

o: LIST OF REF;

success: BOOL ¬ TRUE;

choice: AtomButtons.PopUpChoice;

i: NAT ¬ 0;

[o, menuName, success] ¬ GetMenuListAndName[obj, instanceData];

IF NOT success THEN RETURN;

Pull out the menu fields from the list, building data structures

FOR list: LIST OF REF ¬ o, list.rest UNTIL list = NIL DO -- for each entry...

entry: LIST OF REF;

event: LIST OF REF;

menuEntry: ROPE;

docString: ROPE;

BEGIN

action: PopUpStateMenuAction;

IF NOT ISTYPE[list.first, LIST OF REF] THEN GOTO FieldTypeError;

entry ¬ NARROW[list.first];

IF entry # NIL THEN { -- get the application message, entry name, and doc string

event ¬ GetMessageAsList[entry];

[menuEntry, success] ¬ GetMenuEntry[entry];

IF NOT success THEN GOTO FieldTypeError;

[docString, success] ¬ GetDocString[entry];

IF NOT success THEN GOTO FieldTypeError;

}

ELSE {event ¬ NIL; menuEntry ¬ NIL; docString ¬ NIL};

action ¬ NEW[PopUpStateMenuActionObj ¬ [

message: event,

value: NIL

]];

choice ¬ [action: LIST[action], actionImage: menuEntry, doc: docString, font: bigFont];

choices ¬ PopUpAppend[choices, LIST[choice]];

EXITS

FieldTypeError => {

EmbeddedButtons.Error["Pop-up buttons: Invalid field in menu!", Rope.Concat["The menu description for this pop-up button contains an invalid field:\n", instanceData]];

};

END;

i ¬ i + 1;

ENDLOOP;

};

PopUpStateMakeMenu: PROC [multi: Multi] RETURNS [choices: AtomButtons.PopUpChoices ¬ NIL] = {

AddChoice: PROC [action: ATOM, entry: ROPE, doc: ROPE, count: NAT] = {

choice: AtomButtons.PopUpChoice;

pusmAction: PopUpStateMenuAction;

pusmAction ¬ NEW[PopUpStateMenuActionObj ¬ [

message: LIST[action],

value: NIL

]];

choice ¬ [action: LIST[pusmAction], actionImage: entry, doc: doc, font: bigFont];

choices ¬ PopUpAppend[choices, LIST[choice]];

};

SELECT multi.value.type.class FROM

enumerated => {

FOR i: NAT IN [0..multi.value.type.count) DO

docString, menuEntry: ROPE;

choice: AtomButtons.PopUpChoice;

action: PopUpStateMenuAction;

WITH multi.value.type[i] SELECT FROM

rope: Rope.ROPE => menuEntry ¬ rope;

atom: ATOM => menuEntry ¬ Atom.GetPName[atom];

ENDCASE => menuEntry ¬ "no value";

docString ¬ IO.PutFR1["Set to value %g", [rope[menuEntry]] ];

action ¬ NEW[PopUpStateMenuActionObj ¬ [

message: LIST[$ButtonSetValue, menuEntry],

value: multi.value.type[i]

]];

choice ¬ [action: LIST[action], actionImage: menuEntry, doc: docString, font: bigFont];

choices ¬ PopUpAppend[choices, LIST[choice]];

ENDLOOP;

};

integer => {

AddChoice[$ButtonValueUp, "Up", "increase value by 1", 0];

AddChoice[$ButtonValueUp, "Up", "increase value by 1", 1];

AddChoice[$ButtonValueDown, "Down", "decrease value by 1", 2];

};

real => {

AddChoice[$ButtonValueUp, "Up", "multiply value by 2", 0];

AddChoice[$ButtonValueUp, "Up", "multiply value by 2", 1];

AddChoice[$ButtonValueDown, "Down", "divide value by 2", 2];

};

ENDCASE => NULL;

};

PassEvent: PROC [msg: REF, buttonInfo: ButtonInfo] = {

msgAsList: LIST OF REF;

WITH msg SELECT FROM

list: LIST OF REF => msgAsList ¬ list;

ENDCASE => msgAsList ¬ LIST[msg];

EmbeddedButtons.PassEventToApplication[msgAsList, buttonInfo];

};

PopUpStatePassEventToApplication: AtomButtons.HandlePopUpProc = {

[button: REF, clientData: REF, event: LIST OF REF]

If the event is one of ours, then update the click direction and extract the real application message before passing on the event. clientData is a PopUpStateData

PreprocessEvent: PROC [event: LIST OF REF] RETURNS [newEvent: LIST OF REF] = {

IF event = NIL THEN RETURN[event];

IF event.first = NIL THEN RETURN[event];

WITH event.first SELECT FROM

ours: PopUpStateMenuAction => {

self: PopUpStateData ¬ NARROW[clientData];

newEvent ¬ ours.message;

self.newValue ¬ ours.value;

IF self.newValue = NIL THEN {

IF (ours.count MOD 3 = 2) THEN self.multi.defaultDirection ¬ TRUE

ELSE self.multi.defaultDirection ¬ FALSE;

};

ENDCASE => newEvent ¬ event;

};

WITH button SELECT FROM

buttonInfo: ButtonInfo => {

message: REF;

event ¬ PreprocessEvent[event];

EBLanguage.SetSystemValue[clickContext, $MessageReceiver, EmbeddedButtons.GetApplications[buttonInfo]];

message ¬ EBLanguage.Evaluate[event, buttonInfo, clientData, clickContext];

Evaluate any angle bracket "<>" expressions in "event"

IF message # NIL THEN PassEvent[message, buttonInfo];

};

ENDCASE => {

EmbeddedButtons.Error["Pop-up buttons: button is wrong type (PopUpStatePassEventToApplication)"];

};

PopUpStateUnparse: EBButtonClasses.UnparseInstanceDataProc = {

PROC [instanceData: REF, buttonInfo: ButtonInfo ← NIL, language: ATOM ← NIL, languageVersion: NAT ← 0] RETURNS [ROPE ← NIL];

If language is Poppy, unparses fields into symbol table of buttonInfo. Tries very hard not to unparse something if it has a default value so that a button specified with Name: Gravity will get unparsed with only Name: Gravity unless it is necessary to give more information.

self: PopUpStateData;

rope: ROPE;

ppListPoppy: LIST OF REF;

multi: Multi;

Get self.

IF instanceData = NIL THEN RETURN[""];

IF NOT ISTYPE[instanceData, PopUpStateData] THEN {

EmbeddedButtons.Error["PopUpState buttons: Internal Error, button is wrong type (PopUpStateUnparse)"];

RETURN[""];

};

self ¬ NARROW[instanceData];

multi ¬ self.multi;

Set pretty print lists

ppListPoppy ¬ LIST[

"", refFALSE,

"\n ", refFALSE];

Unparse name

IF multi.name # NIL AND NOT ButtonClassesCommon.IsGeneratedRope[Atom.GetPName[multi.name]]

THEN EmbeddedButtons.SetFieldRope[$Name, EBMesaLisp.Unparse[multi.name], buttonInfo];

Unparse value

SELECT language FROM

$Poppy => {

tableRef: REF;

table: VariableTable;

type: VariableType;

tableRef ¬ EmbeddedButtons.GetFieldRef[$Variables, buttonInfo];

IF ISTYPE[tableRef, VariableTable] AND tableRef # NIL THEN

table ¬ NARROW[tableRef]

ELSE {

table ¬ EBLanguage.CreateVariableTable[];

EmbeddedButtons.SetFieldRef[$Variables, table, buttonInfo];

};

IF multi.value.type = booleanEnumeratedType THEN {

type ¬ NEW[VariableTypeObj[0]];

type.class ¬ boolean;

EBLanguage.SetVariable[table, $Value, NEW[VariableObj ¬ [

value: multi.value.value,

type: type]]];

}

ELSE

EBLanguage.SetVariable[table, $Value, multi.value];

};

ENDCASE;

Unparse transitions

SELECT language FROM

$Poppy =>

IF multi.message # NIL THEN

EmbeddedButtons.SetFieldRope[$UpClickMessage, EBMesaLisp.Unparse[multi.message, ppListPoppy], buttonInfo];

ENDCASE;

Generate rope

SELECT language FROM

$Poppy => rope ¬ NIL; -- A button class doesn't know enough to unparse any further. Embedded Buttons will.

ENDCASE;

RETURN[rope];

};

PopUpStateHandle: EBButtonClasses.HandleEventProc ~ {

ENABLE UNWIND => {

SimpleFeedback.Append[$EmbeddedButtons, oneLiner, $Error, "Pressing that PopUpButton caused an internal error."];

};

self: PopUpStateData ¬ NARROW[instanceData];

Produce any feedback associated with this mouse or keyboard action

ProduceStandardFeedback[event, buttonInfo];

Let pop-up buttons handle the rest

IF instanceData = NIL OR self.popUp = NIL THEN GOTO NoPop

ELSE {

maybeInstance: PopUpButtons.MaybeInstance ¬ PopUpButtons.QuaInstance[self.popUp];

IF NOT maybeInstance.is THEN GOTO NoPop;

PopUpButtons.RawNotify[buttonInfo, maybeInstance.inst, event.handle, event.action];

Will call PopUpStatePassEventToApplication with the menu selection

};

EXITS

NoPop => EmbeddedButtons.Error["This PopUpStateButton is broken (syntax problem?)"];

};

PopUpStateGet: EBButtonClasses.GetValueProc = {

PROC[instanceData: REF, buttonInfo: ButtonInfo] RETURNS [value: REF];

self: PopUpStateData;

multi: Multi;

Get self

IF instanceData = NIL THEN RETURN[NIL];

IF NOT ISTYPE[instanceData, PopUpStateData] THEN {

EmbeddedButtons.Error["PopUpState buttons: Internal error. Button is wrong type (PopUpStateGet)."];

RETURN[NIL];

};

self ¬ NARROW[instanceData];

multi ¬ self.multi;

name ← multi.name;

value ¬ multi.value.value;

EmbeddedButtons.RegisterNameValuePair[multi.name, value, buttonInfo];

};

PopUpStateSet: EBButtonClasses.SetValueProc = {

PROC[instanceData: REF, value: REF, buttonInfo: ButtonInfo] RETURNS[changed: BOOL ← FALSE];

self: PopUpStateData;

multi: Multi;

IF instanceData = NIL THEN RETURN;

IF NOT ISTYPE[instanceData, PopUpStateData] THEN {EmbeddedButtons.Error["PopUpState buttons: Internal error. Button is wrong type (PopUpStateSet)."]; RETURN};

self ¬ NARROW[instanceData];

multi ¬ self.multi;

IF multi.value.type.class = integer THEN {

WITH value SELECT FROM

i: REF INT => {

multi.value.value ¬ value;

changed ¬ TRUE;

EmbeddedButtons.FeedbackNotify[LIST[$Value, value], buttonInfo];

};

ENDCASE => EmbeddedButtons.Error[IO.PutFR["Attempt to set button %g (type INT) to %g", [rope[Atom.GetPName[multi.name]]], [rope[EBMesaLisp.Unparse[value]]] ]];

}

ELSE IF multi.value.type.class = real THEN {

WITH value SELECT FROM

i: REF REAL => {

multi.value.value ¬ value;

changed ¬ TRUE;

EmbeddedButtons.FeedbackNotify[LIST[$Value, value], buttonInfo];

};

ENDCASE => EmbeddedButtons.Error[IO.PutFR["Attempt to set button %g (type REAL) to %g", [rope[Atom.GetPName[multi.name]]], [rope[EBMesaLisp.Unparse[value]]] ]];

}

ELSE {

FOR i: NAT IN [0..multi.value.type.count) DO

IF EBLanguage.Equal[value, multi.value.type.enumeration[i]] THEN {

multi.value.value ¬ value;

changed ¬ TRUE;

EmbeddedButtons.FeedbackNotify[LIST[$Value, value], buttonInfo];

EXIT;

};

ENDLOOP;

};

PopUpStateDefaultBehavior: EBButtonClasses.DefaultBehaviorProc = {

PROC[instanceData: REF, buttonInfo: ButtonInfo];

self: PopUpStateData;

multi: Multi;

state: INT ¬ 0;

newValue: REF;

IF instanceData = NIL THEN RETURN;

IF NOT ISTYPE[instanceData, PopUpStateData] THEN {

EmbeddedButtons.Error["PopUpState: Internal error. Button is wrong type (PopUpStateDefaultBehavior)."];

RETURN;

};

self ¬ NARROW[instanceData];

multi ¬ self.multi;

IF self.newValue # NIL THEN {

newValue ¬ self.newValue;

}

ELSE {

IF multi.value.type.class = integer THEN {

oldValue: REF INT ¬ NARROW[multi.value.value];

IF NOT multi.defaultDirection THEN newValue ¬ NEW[INT ¬ oldValue +1]

ELSE newValue ¬ NEW[INT ¬ oldValue -1];

}

ELSE IF multi.value.type.class = real THEN {

oldValue: REF REAL ¬ NARROW[multi.value.value];

IF NOT multi.defaultDirection THEN newValue ¬ NEW[REAL ¬ oldValue *2.0]

ELSE newValue ¬ NEW[REAL ¬ oldValue /2.0];

}

ELSE {

FOR i: NAT IN [0..multi.value.type.count) DO

IF EBLanguage.Equal[multi.value.value, multi.value.type.enumeration[i]]

THEN { state ¬ i; EXIT };

ENDLOOP;

IF NOT multi.defaultDirection THEN {

state ¬ state + 1;

IF state >= multi.value.type.count THEN state ¬ 0; -- Greater than equal for safety?

}

ELSE {

state ¬ state - 1;

IF state < 0 THEN state ¬ multi.value.type.count-1;

};

newValue ¬ multi.value.type.enumeration[state];

};

IF multi.nameExists THEN

EmbeddedButtons.SetValue[multi.name, newValue, buttonInfo.doc]

ELSE {

changed: BOOL ¬ PopUpStateSet[instanceData, newValue, buttonInfo];

IF changed THEN EBButtonClasses.MarkButtonAsChanged[buttonInfo];

};

Guarded Button Class

Behavior:

Guarded buttons act much like the buttons implemented in Buttons.mesa. They perform a single action when clicked. If they are guarded, they must be clicked twice to trigger the action. The first click removes a guard, often displayed as a strike-through line. The second click causes the action to be performed.

Feedback:

Multi-state buttons generate the following events for feedback:

The standard feedback events (Down, Up, Enter, Exit) and

$Highlight -- when a mouse button goes down over the button

$UnHighlight -- when a mouse button goes up over the button

$Guard $Off -- when a mouse button goes up over the button for the first time

$Guard $On -- when the guard returns to the button after 5 seconds

$Pressed -- when a mouse button goes up over the button and it is unguarded

$Done -- when the button has finished performing its action

buttonClass: EBButtonClasses.ButtonClass ¬ NEW[EBButtonClasses.ButtonClassObj ¬ [

instantiate: ButtonInstantiate,

unparseInstanceData: NIL,

handleEvent: ButtonHandle,

getValue: NIL,

setValue: NIL,

defaultBehavior: NIL]];

ObjectAsEvents: PROC [object: REF] RETURNS [events: LIST OF LIST OF REF] = {

WITH object SELECT FROM

es: LIST OF LIST OF REF => RETURN[es];

e: LIST OF REF => RETURN[LIST[e]];

ENDCASE => RETURN[LIST[LIST[object]]];

};

ButtonInstantiate: EBButtonClasses.InstantiateProc = {

PROC [buttonInfo: ButtonInfo, language: ATOM, languageVersion: NAT, initFeedback: BOOL ← FALSE] RETURNS [instance: REF];

Instantiate and return the button. The input rope is a EBLanguage expression describing the behavior of the button. See ButtonClasses.form for the form of this expression.

menuName: ROPE;

events: LIST OF AtomButtons.Event;

guarded: BOOL ¬ FALSE;

CodeTimer.StartInt[$GuardedInstantiate, $EmbeddedButtons];

SELECT language FROM

$Poppy => {

object: REF;

actionRope: ROPE ¬ EmbeddedButtons.GetFieldRope[$Message, buttonInfo];

guardedRope: ROPE ¬ EmbeddedButtons.GetFieldRope[$GuardMessage, buttonInfo];

ropeStream: IO.STREAM ¬ IO.RIS[actionRope];

object ¬ EBMesaLisp.Parse[ropeStream].val;

events ¬ ObjectAsEvents[object];

guarded ¬ guardedRope # NIL;

};

ENDCASE => {

CodeTimer.StopInt[$GuardedInstantiate, $EmbeddedButtons];

RETURN[NIL];

};

Build the button

BEGIN

entry: AtomButtons.ButtonLineEntry ¬ [button[

events: events,

font: bigFont,

confirmProc: NIL -- overridden by the confirmProc argument below

]];

instance ¬ BuildButtonHandler[

clientData: NIL,

handleProc: ButtonPassEventToApplication,

confirmProc: IF guarded THEN ButtonConfirm ELSE NIL,

entry: entry,

clientPackageName: "ButtonClasses"];

END;

CodeTimer.StopInt[$GuardedInstantiate, $EmbeddedButtons];

RETURN[instance];

};

ButtonConfirm: AtomButtons.HandlePopUpProc = {

[button: REF, clientData: REF, event: LIST OF REF]

ENABLE RuntimeError.Uncaught => {

GOTO Error;

};

message: REF;

buttonInfo: ButtonInfo;

WITH button SELECT FROM

buttonInfo: ButtonInfo => {

confirmRope: ROPE ¬ EmbeddedButtons.GetFieldRope[$GuardMessage, buttonInfo];

ropeStream: IO.STREAM ¬ IO.RIS[confirmRope];

object: REF;

event: LIST OF REF;

EBLanguage.SetSystemValue[clickContext, $MessageReceiver, EmbeddedButtons.GetApplications[buttonInfo]];

object ¬ EBMesaLisp.Parse[ropeStream].val;

message ¬ EBLanguage.Evaluate[object, buttonInfo, clientData, clickContext];

IF message # NIL THEN PassEvent[message, buttonInfo];

};

ENDCASE =>

SimpleFeedback.Append[$EmbeddedButtons, oneLiner, $Error, "Pressing that guarded button caused an internal error."];

EXITS

Error => {

SimpleFeedback.Append[$EmbeddedButtons, oneLiner, $Error, "ButtonConfirm received an uncaught error."];

};

ButtonPassEventToApplication: AtomButtons.HandlePopUpProc = {

[button: REF, clientData: REF, event: LIST OF REF]

message: REF;

WITH button SELECT FROM

buttonInfo: ButtonInfo => {

EBLanguage.SetSystemValue[clickContext, $MessageReceiver, EmbeddedButtons.GetApplications[buttonInfo]];

message ¬ EBLanguage.Evaluate[event, buttonInfo, clientData, clickContext];

Evaluate any angle bracket "<>" expressions in "event"

IF message # NIL THEN PassEvent[message, buttonInfo];

};

ENDCASE => {

EmbeddedButtons.Error["Button is wrong type (ButtonPassEventToApplication)"];

};

ButtonHandle: EBButtonClasses.HandleEventProc = {

errorMsg: ROPE;

BEGIN

ENABLE BEGIN

RuntimeError.NarrowRefFault => {errorMsg ¬ "NarrowRefFault"; GOTO InternalError};

RuntimeError.NarrowFault => {errorMsg ¬ "NarrowFault"; GOTO InternalError};

RuntimeError.NilFault => {errorMsg ¬ "NilFault"; GOTO InternalError};

RuntimeError.BoundsFault => {errorMsg ¬ "BoundsFault"; GOTO InternalError};

RuntimeError.Uncaught => {errorMsg ¬ "Uncaught error"; GOTO InternalError};

RuntimeError.UnnamedError => {errorMsg ¬ "UnnamedError"; GOTO InternalError};

RuntimeError.UnnamedSignal => {errorMsg ¬ "UnnamedSignal"; GOTO InternalError};

UNWIND => {errorMsg ¬ "internal error"; GOTO InternalError};

END;

buttonData: ButtonData ¬ NARROW[instanceData];

ProduceStandardFeedback[event, buttonInfo];

Let AtomButtons handle the rest

IF instanceData = NIL THEN GOTO NoButton

ELSE {

success: BOOL ¬ PushButtonHandler[buttonInfo, buttonData, event];

IF NOT success THEN GOTO NoButton;

};

EXITS

NoButton => {

SimpleFeedback.Append[$EmbeddedButtons, oneLiner, $Error, "A button was pressed that has no button handler"];

};

InternalError => {

SimpleFeedback.Append[$EmbeddedButtons, oneLiner, $Error, Rope.Concat["Pressing that GuardedButton caused ", errorMsg]];

};

END;

};

BuildButtonHandler: PROC [clientData: REF, handleProc: HandleButtonProc, entry: ButtonLineEntry, confirmProc: HandleButtonProc, clientPackageName: Rope.ROPE] RETURNS [instance: REF] = {

WITH entry SELECT FROM

b: ButtonLineEntry.button => instance ¬ BuildButtonHandlerAux[clientData, handleProc, b.name, b.events, b.font, confirmProc, b.initProc, clientPackageName];

ENDCASE => ERROR;

};

ButtonLineEntry: TYPE = AtomButtons.ButtonLineEntry;

Event: TYPE = AtomButtons.Event;

InitButtonProc: TYPE = AtomButtonsTypes.InitButtonProc;

ButtonData: TYPE = REF ButtonDataObj;

ButtonDataObj: TYPE = RECORD [

clientData: REF,

events: LIST OF Event,

handleProc: HandleButtonProc,

font: Imager.Font,

confirmProc: HandleButtonProc,

initProc: InitButtonProc,

clientPackageName: Rope.ROPE,

inverted: BOOL ¬ FALSE,

state: GuardState,

guarded: BOOL ¬ FALSE,

greyCount: INTEGER ¬ 0,

buttonInfo: ButtonInfo ¬ NIL,

viewer: ViewerClasses.Viewer ¬ NIL,

displayStyle: DisplayStyle ¬ blackOnWhite

];

DisplayStyle: TYPE = {blackOnWhite, whiteOnBlack, blackOnGrey};

GuardState: TYPE = { guarded, arming, armed };

BuildButtonHandlerAux: PROC [clientData: REF, handleProc: HandleButtonProc, name: Rope.ROPE, events: LIST OF Event, font: Imager.Font, confirmProc: HandleButtonProc, initProc: InitButtonProc, clientPackageName: Rope.ROPE] RETURNS [instanceData: ButtonData] = {

choiceList, ptr: LIST OF PopUpButtons.Choice;

image: PopUpButtons.Image;

fakeViewer: ViewerClasses.Viewer;

fakeViewer ¬ NEW[ViewerClasses.ViewerRec];

instanceData ¬ NEW[ButtonDataObj ¬ [

clientData: clientData,

handleProc: handleProc,

events: events,

font: font,

confirmProc: confirmProc,

guarded: confirmProc # NIL,

initProc: initProc,

clientPackageName: clientPackageName,

state: IF confirmProc = NIL THEN armed ELSE guarded,

buttonInfo: NIL, -- for now

viewer: fakeViewer

]];

fakeViewer.data ¬ instanceData;

};

PushButtonHandler: PROC [buttonInfo: ButtonInfo, instanceData: ButtonData,
event: EBEvent.Event] RETURNS [success: BOOL ¬ TRUE] = {

userEvent, buttonEvent: LIST OF REF;

Run the input action through TIP

tipParseInfo.inCreek ¬ event.handle;

userEvent ¬ TIPPrivate.WideMatchEvent[tipParseInfo, event.action];

IF instanceData.handleProc # NIL THEN {

ButtonHandlerEvent[buttonInfo, instanceData, userEvent];

};

ButtonNotify: ViewerClasses.NotifyProc = {

PROC [self: Viewer, input: LIST OF REF];

data: ButtonData ¬ NARROW[self.data];

ButtonHandlerEvent[data.buttonInfo, data, input];

};

HandleButtonProc: TYPE = PROC [button: ButtonInfo, clientData: REF, event: LIST OF REF];

ButtonHandlerEvent: ENTRY PROC [self: ButtonInfo, data: ButtonData, input: LIST OF REF] = {

ENABLE BEGIN

UNWIND => InputFocus.ReleaseButtons[];

RuntimeError.Uncaught => GOTO Uncaught;

RuntimeError.NarrowRefFault => GOTO NarrowRefFault;

END;

button: ViewerClasses.MouseButton ¬ red;

shift, control: BOOL ¬ FALSE;

mouse: TIPScreenCoords;

IF data = NIL THEN RETURN;

data.buttonInfo ¬ self;

FOR list: LIST OF REF ¬ input, list.rest UNTIL list = NIL DO

WITH list.first SELECT FROM

x: ATOM => SELECT x FROM

$Blue => button ¬ blue;

$Control => control ¬ TRUE;

$Up => IF data.inverted THEN SELECT data.state FROM

guarded => {

data.state¬arming;

ViewerOps.PaintViewer[self, client, FALSE, $Invert];

EmbeddedButtons.FeedbackNotify[LIST[$Unhighlight], self];

data.inverted ¬ FALSE;

InputFocus.ReleaseButtons[];

TRUSTED {Process.Detach[FORK ArmButtonProc[data, self]]};

IF data.confirmProc # NIL THEN data.confirmProc[self, data.clientData, input];

};

arming=> NULL; -- no action

armed=> {

InputFocus.ReleaseButtons[];

ViewerOps.PaintViewer[self, client, FALSE, $Invert];

EmbeddedButtons.FeedbackNotify[LIST[$Unhighlight], self];

data.inverted ¬ FALSE;

IF data.guarded THEN {

data.state ¬ guarded;

ViewerOps.PaintViewer[self, client];

EmbeddedButtons.FeedbackNotify[LIST[$Guard, $On], self];

};

IF data.fork THEN TRUSTED {Process.Detach[FORK ButtonPusher[self,

data, data.handleProc, data.clientData, button, shift, control, TRUE]]}

ELSE

ButtonPusher[self, data, data.handleProc, data.clientData, input, FALSE];

};

ENDCASE;

$Down => {

IF ~data.inverted THEN {

InputFocus.CaptureButtons[ButtonNotify, tipParseInfo.tableHead, data.viewer];

ViewerOps.PaintViewer[self, client, FALSE, $Invert];

EmbeddedButtons.FeedbackNotify[LIST[$Highlight], self];

data.inverted ¬ TRUE;

}

ELSE {

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: TIPScreenCoords => mouse ¬ z;

ENDCASE => ERROR;

ENDLOOP;

EXITS

Uncaught => {

SimpleFeedback.Append[$EmbeddedButtons, oneLiner, $Error, "ButtonHandlerEvent received an uncaught error."];

};

NarrowRefFault => {

SimpleFeedback.Append[$EmbeddedButtons, oneLiner, $Error, "ButtonHandlerEvent received a NarrowRefFault."];

};

armingTime: Process.Milliseconds ¬ 100; -- cover removal time.

armedTime: Process.Milliseconds ¬ 5000; -- unguarded interval.

ArmButtonProc: ENTRY PROC [data: ButtonData, button: ButtonInfo] = {

assert: state=arming

IF data = NIL THEN RETURN;

ButtonWait[data, armingTime];

IF data.state = arming THEN {

data.state ¬ armed;

ViewerOps.PaintViewer[button, client];

EmbeddedButtons.FeedbackNotify[LIST[$Guard, $Off], button];

ButtonWait[data, armedTime];

};

IF data.state#guarded THEN {

data.state ¬ guarded;

ViewerOps.PaintViewer[button, client];

EmbeddedButtons.FeedbackNotify[LIST[$Guard, $On], button];

};

ButtonWait: INTERNAL PROC[data: ButtonData, msec: Process.Milliseconds] = TRUSTED {

buttonWaitCondition: CONDITION;

Process.SetTimeout[LONG[@buttonWaitCondition], Process.MsecToTicks[msec]];

WAIT buttonWaitCondition;

};

DoPush: PROC [button: ButtonInfo, instanceData: ButtonData, userEvent: LIST OF REF] = {

buttonEvent: LIST OF REF;

buttonEvent ¬ IF ButtonClassesCommon.CountMatches[LIST[$Red, $Up], userEvent] = 2 THEN instanceData.events.first

ELSE IF ButtonClassesCommon.CountMatches[LIST[$Yellow, $Up], userEvent] = 2 THEN IF instanceData.events.rest = NIL THEN instanceData.events.first ELSE instanceData.events.rest.first

ELSE IF ButtonClassesCommon.CountMatches[LIST[$Blue, $Up], userEvent] = 2 THEN IF instanceData.events.rest = NIL OR instanceData.events.rest.rest = NIL THEN instanceData.events.first ELSE instanceData.events.rest.rest.first

ELSE NIL;

IF instanceData.handleProc # NIL AND buttonEvent # NIL

THEN instanceData.handleProc[button, instanceData.clientData, buttonEvent];

};

ButtonPusher: PROC [button: ButtonInfo, myData: ButtonData, proc: HandleButtonProc, clientData: REF, userEvent: LIST OF REF, normalPriority: BOOL] = {

IF myData = NIL THEN RETURN;

myData.greyCount ¬ myData.greyCount + 1;

IF myData.displayStyle#blackOnGrey

THEN ViewerOps.PaintViewer[button, client];

THEN EmbeddedButtons.FeedbackNotify[LIST[$Pressed], button];

IF normalPriority THEN CedarProcess.SetPriority[normal];

DoPush[button, myData, userEvent ! ABORTED => CONTINUE];

myData.greyCount ¬ MAX[myData.greyCount - 1, 0];

IF myData.displayStyle#blackOnGrey

THEN ViewerOps.PaintViewer[button, client];

THEN EmbeddedButtons.FeedbackNotify[LIST[$Done], button];

};

Pop-up Button Class

Behavior:

Pop-up buttons have no state. When a pop-up button is quick-clicked, it sends an application message corresponding to the mouse button that was clicked and any modifier keys that were pressed (Shift, Control, etc.). If a mouse button is clicked and held on a pop-up button, the button "pops up" a two dimensional menu of the button's functions (from which the user can choose) and displays a documentation string for the choice at which the cursor is pointing.

Feedback:

Pop-up buttons generate no special feedback. Like all buttons, the generate $Done, $Warning, or $Error to indicate the success of the button action (see EBImpl).

Pop-up button class record definition

popUpClass: EBButtonClasses.ButtonClass ¬ NEW[EBButtonClasses.ButtonClassObj ¬ [

instantiate: PopUpInstantiate,

unparseInstanceData: NIL,

handleEvent: PopUpHandle,

getValue: NIL,

setValue: NIL,

defaultBehavior: NIL]];

PopUpInstantiate: EBButtonClasses.InstantiateProc = {

PROC [buttonInfo: ButtonInfo, language: ATOM, languageVersion: NAT, initFeedback: BOOL ← FALSE] RETURNS [instance: REF];

Instantiate and return the button. The input rope is a EBLanguage expression describing the behavior of the pop-up button. See ButtonClasses.form for the form of this expression.

menuName: ROPE;

choices: AtomButtons.PopUpChoices;

quickClickEnabled: BOOL ¬ TRUE;

CodeTimer.StartInt[$PopUpInstantiate, $EmbeddedButtons];

CodeTimer.StartInt[$PopUpInstantiateParse, $EmbeddedButtons];

Get the menu name and the menu

SELECT language FROM

$Poppy => {

menuRope: ROPE ¬ EmbeddedButtons.GetFieldRope[$Menu, buttonInfo];

ropeStream: IO.STREAM ¬ IO.RIS[menuRope];

object: REF;

quickClickRope: ROPE ¬ EmbeddedButtons.GetFieldRope[$QuickClickEnabled, buttonInfo];

quickClickEnabled ¬ IF quickClickRope = NIL THEN TRUE

ELSE Convert.BoolFromRope[quickClickRope ! Convert.Error => {quickClickEnabled ¬ TRUE; CONTINUE}];

object ¬ EBMesaLisp.Parse[ropeStream].val;

IF object = NIL THEN {

menuName ¬ "DummyName";

choices ¬ LIST[[action: LIST[$Dummy], actionImage: "No Action", doc: "Embedded Buttons couldn't parse the Menu entry for this button"]];

}

ELSE [menuName, choices] ¬ PopUpParseMenu[object, menuRope];

};

ENDCASE => {

CodeTimer.StopInt[$PopUpInstantiateParse, $EmbeddedButtons];

CodeTimer.StopInt[$PopUpInstantiate, $EmbeddedButtons];

RETURN[NIL];

};

CodeTimer.StopInt[$PopUpInstantiateParse, $EmbeddedButtons];

Build the button

BEGIN

entry: AtomButtons.ButtonLineEntry ¬ [popUpButton[

choices: choices,

help: PopUpButtons.noHelp, -- providing this field saves lots of compute time in PCedar

font: bigFont,

disableDecoding: NOT quickClickEnabled

]];

instance ¬ AtomButtons.BuildPopUp[

clientData: NIL,

handleProc: PopUpPassEventToApplication,

paint: PopUpPaint,

inButton: PopUpInButton,

entry: entry,

clientPackageName: "ButtonClasses"];

END;

CodeTimer.StopInt[$PopUpInstantiate, $EmbeddedButtons];

RETURN[instance];

};

PopUpParseMenu: PROC[obj: REF, instanceData: ROPE] RETURNS [menuName: ROPE ¬ "", choices: AtomButtons.PopUpChoices ¬ NIL] = {

o: LIST OF REF;

success: BOOL ¬ TRUE;

CodeTimer.StartInt[$PopUpParseMenu, $EmbeddedButtons];

[o, menuName, success] ¬ GetMenuListAndName[obj, instanceData];

IF NOT success THEN RETURN;

Now go through the list and pull out the menu fields, building the data structures that PopUpButtons needs.

FOR list: LIST OF REF ¬ o, list.rest UNTIL list = NIL DO -- for each entry...

entry: LIST OF REF;

event: LIST OF REF;

menuEntry: ROPE;

docString: ROPE;

choice: AtomButtons.PopUpChoice;

BEGIN

IF NOT ISTYPE[list.first, LIST OF REF] THEN GOTO FieldTypeError;

entry ¬ NARROW[list.first];

IF entry # NIL THEN { -- get the application message, entry name, and doc string

event ¬ GetMessageAsList[entry];

[menuEntry, success] ¬ GetMenuEntry[entry];

IF NOT success THEN GOTO FieldTypeError;

[docString, success] ¬ GetDocString[entry];

IF NOT success THEN GOTO FieldTypeError;

}

ELSE {event ¬ NIL; menuEntry ¬ ""; docString ¬ ""};

choice ¬ [action: event, actionImage: menuEntry, doc: docString, font: bigFont];

choices ¬ PopUpAppend[choices, LIST[choice]];

EXITS

FieldTypeError => {

EmbeddedButtons.Error["Pop-up buttons: Invalid field in menu!", Rope.Concat["The menu description for this pop-up button contains an invalid field:\n", instanceData]];

};

END;

ENDLOOP;

CodeTimer.StopInt[$PopUpParseMenu, $EmbeddedButtons];

};

PopUpPassEventToApplication: AtomButtons.HandlePopUpProc = {

[button: REF, clientData: REF, event: LIST OF REF]

message: REF;

WITH button SELECT FROM

buttonInfo: ButtonInfo => {

EBLanguage.SetSystemValue[clickContext, $MessageReceiver, EmbeddedButtons.GetApplications[buttonInfo]];

message ¬ EBLanguage.Evaluate[event, buttonInfo, clientData, clickContext];

Evaluate any angle bracket "<>" expressions in "event"

IF message # NIL THEN PassEvent[message, buttonInfo];

};

ENDCASE => {

EmbeddedButtons.Error["Pop-up buttons: button is wrong type (PopUpPassEventToApplication)"];

};

PopUpHandle: EBButtonClasses.HandleEventProc = {

ENABLE UNWIND => {GOTO InternalError};

CodeTimer.StartInt[$PopUpHandle, $EmbeddedButtons];

ProduceStandardFeedback[event, buttonInfo];

Let pop-up buttons handle the rest

IF instanceData = NIL THEN GOTO NoPop

ELSE {

maybeInstance: PopUpButtons.MaybeInstance ¬ PopUpButtons.QuaInstance[instanceData];

IF NOT maybeInstance.is THEN GOTO NoPop

ELSE PopUpButtons.RawNotify[buttonInfo, maybeInstance.inst, event.handle, event.action];

Will call PopUpPassEventToApplication with the menu selection

};

CodeTimer.StopInt[$PopUpHandle, $EmbeddedButtons];

EXITS

NoPop => {

EmbeddedButtons.Error["This PopUpButton is broken (syntax problem?)"];

CodeTimer.StopInt[$PopUpHandle, $EmbeddedButtons];

};

InternalError => {

SimpleFeedback.Append[$EmbeddedButtons, oneLiner, $Error, "Pressing that PopUpButton caused an internal error."];

CodeTimer.StopInt[$PopUpHandle, $EmbeddedButtons];

};

clickContext: Context ¬ EBLanguage.CreateContext[];

PopUpPaint: PopUpButtons.PaintProc = {

};

PopUpInButton: PopUpButtons.InTestProc = {

PROC [view: View, coords: TIPScreenCoords] RETURNS [in: BOOL];

buttonInfo: ButtonInfo;

Get the button info

IF NOT ISTYPE[view, ButtonInfo] THEN {

EmbeddedButtons.Error["Pop-up buttons: Internal Error, button is wrong type (PopUpInButton)"];

RETURN[TRUE];

};

buttonInfo ¬ NARROW[view];

Ask EmbeddedButtons if this position is in this button.

RETURN[EmbeddedButtons.InButton[coords.mouseX, coords.mouseY, buttonInfo]];

};

PopUpAppend: PROC [l1: AtomButtons.PopUpChoices, l2: AtomButtons.PopUpChoices ¬ NIL] RETURNS[val: AtomButtons.PopUpChoices] = {

z: AtomButtons.PopUpChoices ¬ NIL;

val ¬ l2;

IF l1 = NIL THEN RETURN[val];

val ¬ CONS[l1.first, val];

z ¬ val;

UNTIL (l1 ¬ l1.rest) = NIL DO

z.rest ¬ CONS[l1.first, z.rest];

z ¬ z.rest;

ENDLOOP;

RETURN[val];

};

Multi-State Buttons

Behavior:

When a multi-state button is clicked, it does not automatically change state. Instead, it sends the message corresponding to its current state to the application to which it is linked. It is the responsibility of that application to call EBApplications.SetKeyValuePair to cause the actual change, unless the button's MessageHandler includes Default, in which case EmbeddedButtons will cause the default behavior. The default behavior of a multi-state button is to change to the next state on a mouse up, wrapping around to the first state when reaching the last state.

A multi-state button has a value associated with each of its states. (If no values are specified when the button is created, they default to the integers 1 through n, where n is the number of states.) A button's state is set by calling EBApplications.SetKeyValuePair with the value of the state to which the button is to change (not the number of the state, unless the two are the same).

Feedback:

Multi-state buttons generate the following events for feedback:

The standard feedback events (Down, Up, etc.) and

If the mouse enters the button with a mouse button down, the button generates

$Enter

Then the button generates one of:

$Exit the mouse left the button without an up-click

$Value value the button's value has changed to value.

The $Value value events are generated when the actual change of state is made, and not when the request for state change is sent to the application.

Multi-state button class record definition

multiClass: EBButtonClasses.ButtonClass ¬ NEW[EBButtonClasses.ButtonClassObj ¬ [

instantiate: MultiInstantiate,

unparseInstanceData: MultiUnparse,

handleEvent: MultiHandle,

getValue: MultiGet,

setValue: MultiSet,

defaultBehavior: MultiDefaultBehavior]];

The internal representation of a multi-state button

Multi: TYPE = REF MultiRec;

MultiRec: TYPE = RECORD[

nameExists: BOOL ¬ FALSE,

value: Variable,

message: REF,

mouseInside: BOOL,

defaultDirection: BOOL -- direction to change state by default FALSE => up, TRUE => down

];

MultiInstantiate: EBButtonClasses.InstantiateProc = {

PROC [buttonInfo: ButtonInfo, language: ATOM, languageVersion: NAT, initFeedback: BOOL ← FALSE] RETURNS [instance: REF];

self: Multi;

CodeTimer.StartInt[$MultiInstantiate, $EmbeddedButtons];

Set default values

self ¬ NEW[MultiRec ¬ [

nameExists: FALSE,

value: NEW[VariableObj ¬ [

type: NEW[VariableTypeObj[3]],

value: NEW[INT ¬ 1]]],

message: NIL,

mouseInside: FALSE,

defaultDirection: FALSE -- down

]];

self.value.type.class ¬ enumerated;

FOR i: INT IN [1..3] DO

self.value.type.enumeration[i-1] ¬ NEW[INT ¬ i];

ENDLOOP;

MultiInstantiateAux[buttonInfo, language, languageVersion, self, initFeedback];

CodeTimer.StopInt[$MultiInstantiate, $EmbeddedButtons];

RETURN[self];

};

MultiInstantiateAux: PROC [buttonInfo: ButtonInfo, language: ATOM, languageVersion: NAT, self: Multi, initFeedback: BOOL ¬ FALSE] = {

fieldError, fieldValue: ROPE;

val: REF;

success: BOOL ¬ FALSE;

varTable: REF;

found: BOOL ¬ FALSE;

self.name ¬ EmbeddedButtons.GetButtonName[buttonInfo];

self.nameExists ¬ self.name # NIL;

varTable ¬ EmbeddedButtons.GetFieldRef[$Variables, buttonInfo];

IF varTable # NIL THEN {

v: Variable ¬ EBLanguage.GetVariable[NARROW[varTable, VariableTable], $Value];

IF v # NIL THEN {

SELECT v.type.class FROM

boolean => {

self.value.type ¬ booleanEnumeratedType;

self.value.value ¬ v.value;

};

integer => {

self.value.type ¬ v.type;

self.value.value ¬ v.value;

};

real => {

self.value.type ¬ v.type;

self.value.value ¬ v.value;

};

enumerated => self.value ¬ v;

ENDCASE =>

EmbeddedButtons.Error["Multi-state buttons: Invalid Value variable. Must be a boolean, integer, real or enumerated type."];

};

IF self.value.value = NIL AND self.name # NIL THEN { -- get value from like-named button?

val ¬ EmbeddedButtons.GetValue[self.name, buttonInfo.doc];

IF val # NIL THEN {

fieldError ¬ EBMesaLisp.Unparse[val];

IF self.value.type.class = integer THEN found ¬ ISTYPE[val, REF INT]

ELSE IF self.value.type.class = real THEN found ¬ ISTYPE[val, REF REAL]

ELSE { -- Search through the values list.

found ¬ FALSE;

FOR i: NAT IN [1 .. self.value.type.count) DO

IF EBLanguage.Equal[val, self.value.type.enumeration[i]] THEN

{self.value.value ¬ val; found ¬ TRUE};

ENDLOOP;

};

IF NOT found THEN

EmbeddedButtons.Error[IO.PutFR["Two multi-state buttons of name %g have incompatible values, including %g", [rope[Atom.GetPName[self.name]]], [rope[fieldError]] ]];

};

IF self.value.value = NIL -- button still has no value. Give it a default

THEN self.value.value ¬ self.value.type.enumeration[0];

Transition message:

fieldValue ¬ EmbeddedButtons.GetFieldRope[$UpClickMessage, buttonInfo];

self.message ¬ EBMesaLisp.Parse[IO.RIS[fieldValue]].val;

Cause the feedback events corresponding to this button changing to its current state.

IF initFeedback THEN {

EmbeddedButtons.FeedbackNotify[

feedbackEvent: LIST[$Value, self.value.value],

buttonInfo: buttonInfo];

};

MultiUnparse: EBButtonClasses.UnparseInstanceDataProc = {

PROC [instanceData: REF, buttonInfo: ButtonInfo ← NIL, language: ATOM ← NIL, languageVersion: NAT ← 0] RETURNS [ROPE ← NIL];

self: Multi;

rope: ROPE;

ppListPoppy: LIST OF REF;

Get self.

IF instanceData = NIL THEN RETURN[""];

IF NOT ISTYPE[instanceData, Multi] THEN {

EmbeddedButtons.Error["Multiple-state buttons: Internal Error, button is wrong type (MultiUnparse)"];

RETURN[""];

};

self ¬ NARROW[instanceData];

Set pretty print lists

ppListPoppy ¬ LIST[

"", refFALSE,

"\n ", refFALSE];

Unparse name

IF self.name # NIL AND NOT ButtonClassesCommon.IsGeneratedRope[Atom.GetPName[self.name]]

THEN EmbeddedButtons.SetFieldRope[$Name, EBMesaLisp.Unparse[self.name], buttonInfo];

Unparse value

SELECT language FROM

$Poppy => {

tableRef: REF;

table: VariableTable;

type: VariableType;

tableRef ¬ EmbeddedButtons.GetFieldRef[$Variables, buttonInfo];

IF ISTYPE[tableRef, VariableTable] AND tableRef # NIL THEN

table ¬ NARROW[tableRef]

ELSE {

table ¬ EBLanguage.CreateVariableTable[];

EmbeddedButtons.SetFieldRef[$Variables, table, buttonInfo];

};

IF self.value.type = booleanEnumeratedType THEN {

type ¬ NEW[VariableTypeObj[0]];

type.class ¬ boolean;

EBLanguage.SetVariable[table, $Value, NEW[VariableObj ¬ [

value: self.value.value,

type: type]]];

}

ELSE

EBLanguage.SetVariable[table, $Value, self.value];

};

ENDCASE;

Unparse transitions

SELECT language FROM

$Poppy =>

IF self.message # NIL THEN

EmbeddedButtons.SetFieldRope[$UpClickMessage, EBMesaLisp.Unparse[self.message, ppListPoppy], buttonInfo];

ENDCASE;

Generate rope

SELECT language FROM

$Poppy => rope ¬ NIL; -- A button class doesn't know enough to unparse any further. Embedded Buttons will.

ENDCASE;

RETURN[rope];

};

MultiHandle: EBButtonClasses.HandleEventProc = {

userEvent: LIST OF REF;

Produce standard feedback

ProduceStandardFeedback[event, buttonInfo];

Run the input action through TIP

tipParseInfo.inCreek ¬ event.handle;

userEvent ¬ TIPPrivate.WideMatchEvent[tipParseInfo, event.action];

MultiEvent[instanceData, userEvent, buttonInfo];

};

gClientData: REF;

MultiCaptureNotify: InputFocus.NotifyProc = {

PROC [self: Viewer, input: LIST OF REF]

acd: ActiveClientData;

Unpack the client data

IF NOT ISTYPE[gClientData, ActiveClientData] THEN {

EmbeddedButtons.Error["Multiple-state buttons: Internal error. Client data is wrong type (MultiCaptureNotify)."];

RETURN;

};

acd ¬ NARROW[gClientData];

MultiEvent[acd.instanceData, input, acd.buttonInfo];

};

MultiEvent: PROC [instanceData: REF, userEvent: LIST OF REF, buttonInfo: ButtonInfo] = {

self: Multi;

mousePos: TIPScreenCoords ¬ NIL;

IF userEvent = NIL OR instanceData = NIL THEN RETURN;

IF NOT ISTYPE[instanceData, Multi] THEN {EmbeddedButtons.Error["Multiple-state buttons: Internal error. Button is wrong type (MultiEvent)."]; RETURN};

self ¬ NARROW[instanceData];

IF ButtonClassesCommon.CountMatches[userEvent, LIST[$Up]] > 0 THEN { -- up event

message: REF ¬ self.message;

self.defaultDirection ¬ ButtonClassesCommon.CountMatches[userEvent, LIST[$Right]] > 0;

IF self.mouseInside THEN {self.mouseInside ¬ FALSE; InputFocus.ReleaseButtons[]};

EBLanguage.SetSystemValue[clickContext, $MessageReceiver, EmbeddedButtons.GetApplications[buttonInfo]];

message ¬ EBLanguage.Evaluate[message, buttonInfo, NIL, clickContext];

IF ISTYPE[message, LIST OF REF]

THEN EmbeddedButtons.PassEventToApplication[NARROW[message], buttonInfo]

ELSE EmbeddedButtons.PassEventToApplication[LIST[message], buttonInfo];

}

ELSE { -- not a button up event. Generate Enter or Exit actions

IF NOT self.mouseInside THEN { -- Enter action

self.mouseInside ¬ TRUE;

EmbeddedButtons.FeedbackNotify[LIST[$Enter], buttonInfo];

RETURN;

};

IF ButtonClassesCommon.CountMatches[userEvent, LIST[$MouseMoved]] = 0 THEN RETURN; -- can't deal with this event. Ignoring it.

Get mouse position

FOR l: LIST OF REF ¬ userEvent, l.rest UNTIL l = NIL DO

IF ISTYPE[l.first, TIPScreenCoords] THEN mousePos ¬ NARROW[userEvent.rest.first];

ENDLOOP;

IF mousePos = NIL THEN {

EmbeddedButtons.Error["Multiple-state buttons: Internal error, NIL mouse position (MultiEvent)."];

RETURN;

};

IF NOT EmbeddedButtons.InButton[mousePos.mouseX, mousePos.mouseY, buttonInfo] THEN {

self.mouseInside ¬ FALSE;

InputFocus.ReleaseButtons[];

EmbeddedButtons.FeedbackNotify[LIST[$Exit], buttonInfo];

};

MultiGet: EBButtonClasses.GetValueProc = {

PROC[instanceData: REF, buttonInfo: ButtonInfo] RETURNS [value: REF];

self: Multi;

Get self

IF instanceData = NIL THEN RETURN[NIL];

IF NOT ISTYPE[instanceData, Multi] THEN {

EmbeddedButtons.Error["Multiple-state buttons: Internal error. Button is wrong type (MultiGet)."];

RETURN[NIL];

};

self ¬ NARROW[instanceData];

name ← self.name;

value ¬ self.value.value;

EmbeddedButtons.RegisterNameValuePair[self.name, value, buttonInfo];

};

MultiSet: EBButtonClasses.SetValueProc = {

PROC[instanceData: REF, value: REF, buttonInfo: ButtonInfo] RETURNS[changed: BOOL ← FALSE];

self: Multi;

IF instanceData = NIL THEN RETURN;

IF NOT ISTYPE[instanceData, Multi] THEN {EmbeddedButtons.Error["Multiple-state buttons: Internal error. Button is wrong type (MultiSet)."]; RETURN};

self ¬ NARROW[instanceData];

IF self.value.type.class = integer THEN {

WITH value SELECT FROM

i: REF INT => {

self.value.value ¬ value;

changed ¬ TRUE;

EmbeddedButtons.RegisterNameValuePair[self.name, value, buttonInfo];

EmbeddedButtons.FeedbackNotify[LIST[$Value, value], buttonInfo];

};

ENDCASE => EmbeddedButtons.Error[IO.PutFR["Attempt to set button %g (type INT) to %g", [rope[Atom.GetPName[self.name]]], [rope[EBMesaLisp.Unparse[value]]] ]];

}

ELSE IF self.value.type.class = real THEN {

WITH value SELECT FROM

r: REF REAL => {

self.value.value ¬ value;

changed ¬ TRUE;

EmbeddedButtons.RegisterNameValuePair[self.name, value, buttonInfo];

EmbeddedButtons.FeedbackNotify[LIST[$Value, value], buttonInfo];

};

ENDCASE => EmbeddedButtons.Error[IO.PutFR["Attempt to set button %g (type REAL) to %g", [rope[Atom.GetPName[self.name]]], [rope[EBMesaLisp.Unparse[value]]] ]];

}

ELSE {

FOR i: NAT IN [0..self.value.type.count) DO

IF EBLanguage.Equal[value, self.value.type.enumeration[i]] THEN {

self.value.value ¬ value;

changed ¬ TRUE;

EmbeddedButtons.RegisterNameValuePair[self.name, value, buttonInfo];

EmbeddedButtons.FeedbackNotify[LIST[$Value, value], buttonInfo];

EXIT;

};

ENDLOOP;

};

MultiDefaultBehavior: EBButtonClasses.DefaultBehaviorProc = {

PROC[instanceData: REF, buttonInfo: ButtonInfo];

self: Multi;

state: INT ¬ 0;

newValue: REF;

IF instanceData = NIL THEN RETURN;

IF NOT ISTYPE[instanceData, Multi] THEN {

EmbeddedButtons.Error["Multiple-state buttons: Internal error. Button is wrong type (MultiDefaultNotify)."];

RETURN;

};

self ¬ NARROW[instanceData];

IF self.value.type.class = integer THEN {

oldValue: REF INT ¬ NARROW[self.value.value];

IF NOT self.defaultDirection THEN newValue ¬ NEW[INT ¬ oldValue +1]

ELSE newValue ¬ NEW[INT ¬ oldValue -1];

}

ELSE IF self.value.type.class = real THEN {

oldValue: REF REAL ¬ NARROW[self.value.value];

IF NOT self.defaultDirection THEN newValue ¬ NEW[REAL ¬ oldValue *2.0]

ELSE newValue ¬ NEW[REAL ¬ oldValue /2.0];

}

ELSE {

FOR i: NAT IN [0..self.value.type.count) DO

IF EBLanguage.Equal[self.value.value, self.value.type.enumeration[i]]

THEN { state ¬ i; EXIT };

ENDLOOP;

IF NOT self.defaultDirection THEN {

state ¬ state + 1;

IF state >= self.value.type.count THEN state ¬ 0; -- Greater than equal for safety?

}

ELSE {

state ¬ state - 1;

IF state < 0 THEN state ¬ self.value.type.count-1;

};

newValue ¬ self.value.type.enumeration[state];

};

IF self.nameExists THEN

EmbeddedButtons.SetValue[self.name, newValue, buttonInfo.doc]

ELSE {

changed: BOOL ¬ MultiSet[instanceData, newValue, buttonInfo];

IF changed THEN EBButtonClasses.MarkButtonAsChanged[buttonInfo];

};

Two-state button class

Behavior:

Two-stae buttons are exactly like multi-state buttons, except that they have only two states and default values of FALSE and TRUE. In fact, two-state buttons are implemented with mostly multi-state buttons code.

Feedback:

Two-state buttons generate feedback like any other multi-state buttons.

Two-state button class record definition

twoStateClass: EBButtonClasses.ButtonClass ¬ NEW[EBButtonClasses.ButtonClassObj ¬ [

instantiate: TwoStateInstantiate,

unparseInstanceData: MultiUnparse,

handleEvent: MultiHandle,

getValue: MultiGet,

setValue: MultiSet,

defaultBehavior: MultiDefaultBehavior]];

TwoStateInstantiate: EBButtonClasses.InstantiateProc = {

PROC [buttonInfo: ButtonInfo, language: ATOM, languageVersion: NAT, initFeedback: BOOL ← FALSE] RETURNS [instance: REF];

Set default values

self: Multi ¬ NEW[MultiRec ¬ [

value: NEW[VariableObj ¬ [

type: booleanEnumeratedType,

value: refFALSE]],

message: NIL,

mouseInside: FALSE,

defaultDirection: FALSE -- up

]];

MultiInstantiateAux[buttonInfo, language, languageVersion, self, initFeedback];

RETURN[self];

};

Radio Button Class

Behavior:

Radio buttons are sets of buttons. In each set, only one button may be "on" at any given time. Clicking on a radio button turns that button on and all the other buttons in the set off. A set of radio buttons is defined as all radio buttons in a document which have the same Name. Each radio button has a value and the value of the radio button which is currently on is associated with the Name of the set of buttons. When a radio button is clicked, it sends its request message to the application to which it is linked. It is the responsibility of the application to call EBApplications.SetNameValuePair with the new value for the radio button set, unless the radio buttons have their default behavior.

Radio buttons look at a boolean variable (in the Poppy variables field) called "State." This variable specifies whether a particular Radio button is on or not.

Feedback:

Radio buttons generate the following events for feedback:

If the mouse enters the button with a mouse button down, the button generates:

$Enter

Then the button generates one of:

$Exit -- the mouse left the button without an up-click

($State TRUE) -- change to the "on" appearance

($State FALSE) -- change to the "off" appearance

Radio button class record definition

radioClass: EBButtonClasses.ButtonClass ¬ NEW[EBButtonClasses.ButtonClassObj ¬ [

instantiate: RadioInstantiate,

unparseInstanceData: RadioUnparse,

handleEvent: RadioHandle,

getValue: RadioGet,

setValue: RadioSet,

defaultBehavior: RadioDefaultBehavior]];

The internal representation of a radio button

Radio: TYPE = REF RadioRec;

RadioRec: TYPE = RECORD[

nameExists: BOOL ¬ FALSE,

value: REF,

on: BOOL,

mouseInside: BOOL,

message: LIST OF REF];

RadioInstantiate: EBButtonClasses.InstantiateProc = {

PROC [buttonInfo: ButtonInfo, language: ATOM, languageVersion: NAT, initFeedback: BOOL ← FALSE] RETURNS [instance: REF];

In Poppy, then the following fields are used:

Name: name -- (an ATOM)

RadioButtonValue: value

Variables: State -- (FALSE, TRUE, Off, or On)

Message: message

self: Radio;

fieldError, fieldValue: ROPE;

success: BOOL;

val, varTable: REF;

CodeTimer.StartInt[$RadioInstantiate, $EmbeddedButtons];

self ¬ NEW[RadioRec ¬ [nameExists: FALSE, name: NIL, value: NIL, on: FALSE, mouseInside: FALSE, message: NIL]];

self.name ¬ EmbeddedButtons.GetButtonName[buttonInfo];

self.nameExists ¬ self.name # NIL;

IF self.name = NIL THEN {

EmbeddedButtons.Error["Every radio button must have a Name: field."];

CodeTimer.StopInt[$PopUpInstantiate, $EmbeddedButtons];

RETURN[NIL];

};

fieldValue ¬ EmbeddedButtons.GetFieldRope[$RadioButtonValue, buttonInfo];

fieldError ¬ fieldValue;

self.value ¬ EBMesaLisp.Parse[IO.RIS[fieldValue]].val;

IF self.value = NIL THEN -- Create a value if none provided

self.value ¬ ButtonClassesCommon.GenerateUniqueRope[];

varTable ¬ EmbeddedButtons.GetFieldRef[$Variables, buttonInfo];

success ¬ FALSE;

IF varTable # NIL THEN {

v: Variable ¬ EBLanguage.GetVariable[NARROW[varTable, VariableTable], $State];

IF v # NIL THEN {

IF v.type.class = boolean THEN {

success ¬ TRUE;

self.on ¬ NARROW[v.value, REF BOOL];

}

ELSE EmbeddedButtons.Error["Radio buttons: Invalid State variable. Must be a boolean."];

};

IF NOT success AND self.name # NIL THEN { -- get State from another like-named button?

val ¬ EmbeddedButtons.GetValue[self.name, buttonInfo.doc];

IF val # NIL AND EBLanguage.Equal[val, self.value] THEN self.on ¬ TRUE;

};

fieldValue ¬ EmbeddedButtons.GetFieldRope[$UpClickMessage, buttonInfo];

fieldError ¬ fieldValue;

val ¬ EBMesaLisp.Parse[IO.RIS[fieldValue]].val;

IF val # NIL THEN {

IF ISTYPE[val, LIST OF REF] THEN self.message ¬ NARROW[val]

ELSE EmbeddedButtons.Error[IO.PutFR1["Radio button: invalid message field: %g", [rope[fieldError]] ]];

};

CodeTimer.StopInt[$PopUpInstantiate, $EmbeddedButtons];

RETURN[self];

};

RadioUnparse: EBButtonClasses.UnparseInstanceDataProc = {

PROC [instanceData: REF, buttonInfo: ButtonInfo ← NIL, language: ATOM ← NIL, languageVersion: NAT ← 0] RETURNS [ROPE ← NIL];

self: Radio;

Get self.

IF instanceData = NIL THEN RETURN[""];

IF NOT ISTYPE[instanceData, Radio] THEN {

EmbeddedButtons.Error["Radio buttons: Internal Error, button is wrong type (RadioUnparse)"];

RETURN[""];

};

self ¬ NARROW[instanceData];

SELECT language FROM

$Poppy => {

Unparse each field.

IF NOT ISTYPE[self.value, ROPE] OR NOT ButtonClassesCommon.IsGeneratedRope[NARROW[self.value, ROPE]] THEN

EmbeddedButtons.SetFieldRope[$RadioButtonValue, EBMesaLisp.Unparse[self.value], buttonInfo];

EmbeddedButtons.SetFieldRope[$Name, EBMesaLisp.Unparse[self.name], buttonInfo];

EmbeddedButtons.SetFieldRope[$UpClickMessage, EBMesaLisp.Unparse[self.message], buttonInfo];

BEGIN

tableRef: REF;

table: VariableTable;

type: VariableType;

tableRef ¬ EmbeddedButtons.GetFieldRef[$Variables, buttonInfo];

IF ISTYPE[tableRef, VariableTable] AND tableRef # NIL THEN

table ¬ NARROW[tableRef]

ELSE {

table ¬ EBLanguage.CreateVariableTable[];

EmbeddedButtons.SetFieldRef[$Variables, table, buttonInfo];

};

type ¬ NEW[VariableTypeObj[0]];

type.class ¬ boolean;

EBLanguage.SetVariable[table, $State, NEW[VariableObj ¬ [

type: type,

value: IF self.on THEN refTRUE ELSE refFALSE

]]];

END;

RETURN;

};

ENDCASE;

};

RadioHandle: EBButtonClasses.HandleEventProc = {

userEvent: LIST OF REF;

Produce standard feedback

ProduceStandardFeedback[event, buttonInfo];

Run the input action through TIP

tipParseInfo.inCreek ¬ event.handle;

userEvent ¬ TIPPrivate.WideMatchEvent[tipParseInfo, event.action];

RadioEvent[instanceData, userEvent, buttonInfo];

};

RadioCaptureNotify: InputFocus.NotifyProc = {

PROC [self: Viewer, clientData: REF, input: LIST OF REF]

acd: ActiveClientData;

Extract client data.

IF NOT ISTYPE[gClientData, ActiveClientData] THEN {

EmbeddedButtons.Error["Radio buttons: Internal error. Client data is wrong type (RadioCaptureNotify).", "Radio buttons: Internal error. Client data is wrong type (RadioCaptureNotify)."];

RETURN;

};

acd ¬ NARROW[gClientData];

RadioEvent[acd.instanceData, input, acd.buttonInfo];

};

RadioEvent: PROC [instanceData: REF, userEvent: LIST OF REF, buttonInfo: ButtonInfo] = {

self: Radio;

mousePos: TIPScreenCoords ¬ NIL;

message: REF;

IF userEvent = NIL OR instanceData = NIL THEN RETURN;

IF NOT ISTYPE[instanceData, Radio] THEN {

EmbeddedButtons.Error["Radio buttons: Internal error. Button is incorrect type (RadioHandle)."];

RETURN;

};

self ¬ NARROW[instanceData];

On an upclick, send an application message.

IF ButtonClassesCommon.CountMatches[userEvent, LIST[$Up]] > 0 THEN {

Release mouse keys if necessary

IF self.mouseInside THEN {

self.mouseInside ¬ FALSE;

InputFocus.ReleaseButtons[];

};

Evaluate message and pass it to application.

EBLanguage.SetSystemValue[clickContext, $MessageReceiver, EmbeddedButtons.GetApplications[buttonInfo]];

message ¬ EBLanguage.Evaluate[self.message, buttonInfo, NIL, clickContext];

IF ISTYPE[message, LIST OF REF] THEN

EmbeddedButtons.PassEventToApplication[NARROW[message], buttonInfo]

ELSE

EmbeddedButtons.PassEventToApplication[LIST[message], buttonInfo];

RETURN;

};

If the mouse was not previously in the button, then generate feedback and capture buttons

IF NOT self.mouseInside THEN {

self.mouseInside ¬ TRUE;

EmbeddedButtons.FeedbackNotify[LIST[$Enter], buttonInfo];

RETURN;

};

If the mouse was previously inside the button, check if it still is and generate feedback if not, releasing buttons.

IF ButtonClassesCommon.CountMatches[userEvent, LIST[$MouseMoved]] = 0 THEN RETURN; -- can't deal with this event. Ignoring it.

Get mouse position

FOR l: LIST OF REF ¬ userEvent, l.rest UNTIL l = NIL DO

IF ISTYPE[l.first, TIPScreenCoords] THEN mousePos ¬ NARROW[userEvent.rest.first];

ENDLOOP;

IF mousePos = NIL THEN {

EmbeddedButtons.Error["Radio buttons: Internal error, TIP table probably mashed (RadioEvent)."];

RETURN;

};

IF NOT EmbeddedButtons.InButton[mousePos.mouseX, mousePos.mouseY, buttonInfo] THEN {

self.mouseInside ¬ FALSE;

InputFocus.ReleaseButtons[];

EmbeddedButtons.FeedbackNotify[LIST[$Exit], buttonInfo];

};

RadioGet: EBButtonClasses.GetValueProc = {

PROC[instanceData: REF, buttonInfo: ButtonInfo] RETURNS [value: REF];

self: Radio;

Get self

IF NOT ISTYPE[instanceData, Radio] THEN {

EmbeddedButtons.Error["Radio buttons: Internal error. Button is incorrect type (RadioHandle)."];

RETURN[NIL];

};

self ¬ NARROW[instanceData];

IF instanceData = NIL THEN RETURN[NIL];

name ← self.name;

value ¬ self.value;

IF self.on THEN {

EmbeddedButtons.RegisterNameValuePair[self.name, value, buttonInfo];

RETURN[value];

};

RETURN[NIL];

};

RadioSet: EBButtonClasses.SetValueProc = {

PROC[instanceData: REF, value: REF, buttonInfo: ButtonInfo] RETURNS[changed: BOOL ← FALSE];

self: Radio;

IF instanceData = NIL THEN RETURN;

IF NOT ISTYPE[instanceData, Radio] THEN {EmbeddedButtons.Error["RadioSet: This radio button is not a radio button."]; RETURN};

self ¬ NARROW[instanceData];

If this button has been pressed, turn it on (if not already on)

IF EBLanguage.Equal[value, self.value] THEN {

IF NOT self.on THEN {

self.on ¬ TRUE;

changed ¬ TRUE;

IF self.nameExists THEN

EmbeddedButtons.RegisterNameValuePair[self.name, self.value, buttonInfo];

EmbeddedButtons.FeedbackNotify[LIST[$State, refTRUE], buttonInfo];

}

ELSE EmbeddedButtons.FeedbackNotify[LIST[$StateStill, refTRUE], buttonInfo];

}

ELSE { -- someone else has been pressed. Turn off, (if you're not already off)

IF self.on THEN {

self.on ¬ FALSE;

changed ¬ TRUE;

EmbeddedButtons.FeedbackNotify[LIST[$State, refFALSE], buttonInfo];

};

RadioDefaultBehavior: EBButtonClasses.DefaultBehaviorProc = {

PROC[instanceData: REF, buttonInfo: ButtonInfo];

self: Radio;

Get self

IF instanceData = NIL THEN RETURN;

IF NOT ISTYPE[instanceData, Radio] THEN {

EmbeddedButtons.Error["Radio buttons: Internal error. Button is wrong type (RadioDefaultBehavior)."];

RETURN;

};

self ¬ NARROW[instanceData];

EmbeddedButtons.SetValue[self.name, self.value, buttonInfo.doc];

};

Routines Shared By Several Button Classes

CountMatches: PUBLIC PROC [a, b: LIST OF REF] RETURNS [result: INT ¬ 0] = {

Returns the number of elements of the first list that also occur in the second list with the following provisos: $Red matches $Left, $Yellow matches $Middle, $Blue matches $Right.

FOR c: LIST OF REF ¬ a, c.rest UNTIL c = NIL DO

FOR d: LIST OF REF ¬ b, d.rest UNTIL d = NIL DO

IF Match[c.first, d.first] THEN result ¬ result + 1;

ENDLOOP;

};

Match: PROC [a, b: REF] RETURNS [BOOL] = {

IF a = b THEN RETURN[TRUE]

ELSE IF EBLanguage.Equal[a, b] THEN RETURN[TRUE]

ELSE IF a = $Red AND b = $Left THEN RETURN[TRUE]

ELSE IF a = $Yellow AND b = $Middle THEN RETURN[TRUE]

ELSE IF a = $Blue AND b = $Right THEN RETURN[TRUE]

ELSE IF a = $Left AND b = $Red THEN RETURN[TRUE]

ELSE IF a = $Middle AND b = $Yellow THEN RETURN[TRUE]

ELSE IF a = $Right AND b = $Blue THEN RETURN[TRUE]

ELSE RETURN[FALSE];

};

ExactMatch: PUBLIC PROC [a, b: LIST OF REF] RETURNS [BOOL] = {

Returns TRUE iff a and b contain the same REFS in the same order. The atom $Mouse matches any of $Red, $Yellow, $Blue, $Left, $Middle, or $Right. The atom $Highlight matches ($Mouse $Down) or $Enter, where $Mouse matches all the patterns just mentioned. The atom $UnHighlight matches ($Mouse $Up) or $Exit.

blist: LIST OF REF ¬ b;

FOR alist: LIST OF REF ¬ a, alist.rest UNTIL alist = NIL DO

IF NOT Match[alist.first, blist.first] THEN RETURN[FALSE];

blist ¬ blist.rest;

ENDLOOP;

RETURN[TRUE];

};

Subset: PUBLIC PROC [a, b: LIST OF REF] RETURNS [BOOL] = {

Included: PROC [a: REF, b: LIST OF REF] RETURNS [BOOL] = {

FOR list: LIST OF REF ¬ b, list.rest UNTIL list = NIL DO

IF Match[a, list.first] THEN RETURN[TRUE];

ENDLOOP;

RETURN[FALSE];

};

Returns TRUE iff all REFs of a (or their equivalents, see ExactMatch) are also in b.

FOR alist: LIST OF REF ¬ a, alist.rest UNTIL alist = NIL DO

IF NOT Included[alist.first, b] THEN RETURN[FALSE];

ENDLOOP;

RETURN[TRUE];

};

KeyValueExtract: PUBLIC PROC [object: LIST OF REF, key: ATOM, screenError, fileError: ROPE] RETURNS [val: REF ¬ NIL, success: BOOL ¬ FALSE] = {

FOR list: LIST OF REF ¬ object, list.rest UNTIL list = NIL DO

first: LIST OF REF;

keyword: ATOM;

IF ~ISTYPE[list.first, LIST OF REF] OR list.first = NIL THEN {

EmbeddedButtons.Error[screenError, fileError];

LOOP;

};

first ¬ NARROW[list.first];

IF ~ISTYPE[first.first, ATOM] OR first.first = NIL THEN {

EmbeddedButtons.Error[screenError, fileError];

LOOP;

};

keyword ¬ NARROW[first.first];

IF keyword = key THEN {

val ¬ first.rest.first;

success ¬ TRUE;

RETURN;

};

ENDLOOP;

};

ProduceStandardFeedback: PROC [event: EBEvent.Event, buttonInfo: ButtonInfo] = {

Runs a copy of the action and queue through a standard tip table and produces standard feedback events such as Down, Up, etc.

userEvents: LIST OF REF;

CodeTimer.StartInt[$ProduceStandardFeedback, $EmbeddedButtons];

Copy queue into tipParseInfo since TIPPrivate.WideMatchEvent may eat actions off the queue.

TRUSTED {

UserInputLookahead.SaveState[saved: standardFeedbackTIPParseInfo.inCreek, handle: event.handle];

};

userEvents ¬ TIPPrivate.WideMatchEvent[standardFeedbackTIPParseInfo, event.action];

IF userEvents # NIL THEN {

EmbeddedButtons.FeedbackNotify[userEvents, buttonInfo]; -- do the feedback

};

UserInputOps.Close[standardFeedbackTIPParseInfo.inCreek]; -- so garbage collection can proceed

CodeTimer.StopInt[$ProduceStandardFeedback, $EmbeddedButtons];

};

uniqueHeader: ROPE ¬ "EBButtonString";

GenerateUniqueRope: PUBLIC PROC [] RETURNS [rope: ROPE] = {

rope ¬ uniqueHeader;

rope ¬ Rope.Concat[rope, Convert.RopeFromCard[BasicTime.ToNSTime[BasicTime.Now[]]]];

rope ¬ Rope.Concat[rope, Convert.RopeFromCard[BasicTime.PulsesToMicroseconds[BasicTime.GetClockPulses[]]]];

};

IsGeneratedRope: PUBLIC PROC[rope: ROPE] RETURNS [BOOL] = {

RETURN[Rope.Equal[uniqueHeader, Rope.Substr[rope, 0, Rope.Length[uniqueHeader]]]];

};

Load-time Processing

Create the TIPParseInfo for event decoding

tipParseInfo: TIPPrivate.TIPParseInfo;

standardFeedbackTIPParseInfo: TIPPrivate.TIPParseInfo;

booleanEnumeratedType: VariableType ¬ NEW[VariableTypeObj[2]];

refFALSE: REF BOOL ¬ NEW[BOOL ¬ FALSE];

refTRUE: REF BOOL ¬ NEW[BOOL ¬ TRUE];

tipParseInfo ¬ TIPPrivate.CreateParseInfo[name: "ButtonClasses"];

tipParseInfo.tableHead ¬ TIPUser.InstantiateNewTIPTable["ButtonClasses.tip"];

standardFeedbackTIPParseInfo ¬ TIPPrivate.CreateParseInfo[name: "ButtonClassesFeedback"];

standardFeedbackTIPParseInfo.tableHead ¬ TIPUser.InstantiateNewTIPTable["ButtonClassesCommon.tip"];

booleanEnumeratedType.class ¬ enumerated;

booleanEnumeratedType.enumeration[0] ¬ refFALSE;

booleanEnumeratedType.enumeration[1] ¬ refTRUE;

Register the button classes.

EBButtonClasses.RegisterButtonClass[$TwoStateButton, twoStateClass]; -- for backwards compat.

EBButtonClasses.RegisterButtonClass[$MultiStateButton, multiClass];

EBButtonClasses.RegisterButtonClass[$PopUpButton, popUpClass];

EBButtonClasses.RegisterButtonClass[$RadioButton, radioClass];

EBButtonClasses.RegisterButtonClass[$PopUpStateButton, popUpStateClass]; -- experimental

EBButtonClasses.RegisterButtonClass[$GuardedButton, buttonClass];

END.