<<>> <> <> <> <> <> <> <> 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 <> 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]; <> <> <> <> <> <> <> <<>> <> popUpStateClass: EBButtonClasses.ButtonClass ¬ NEW[EBButtonClasses.ButtonClassObj ¬ [ name: $PopUpStateButton, 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 = { <> menuName: ROPE; choices: AtomButtons.PopUpChoices; self: PopUpStateData; quickClickEnabled: BOOL ¬ TRUE; IF language # $Poppy THEN RETURN[NIL]; self ¬ NEW[PopUpStateDataObj]; self.multi ¬ NEW[MultiRec ¬ [ name: NIL, 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[ name: menuName, 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 [ count: NAT, message: LIST OF REF, value: REF ]; GetMenuListAndName: PROC [obj: REF, instanceData: ROPE] RETURNS [o: LIST OF REF, menuName: ROPE ¬ NIL, success: BOOL ¬ TRUE] = { <> 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]; <> 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; <> 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 ¬ [ count: i, 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 ¬ [ count: count, 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 ¬ [ count: i, 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]>> <> 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]; <" expressions in "event">> IF message # NIL THEN PassEvent[message, buttonInfo]; }; ENDCASE => { EmbeddedButtons.Error["Pop-up buttons: button is wrong type (PopUpStatePassEventToApplication)"]; }; }; PopUpStateUnparse: EBButtonClasses.UnparseInstanceDataProc = { <> <<>> <> <<>> self: PopUpStateData; rope: ROPE; ppListPoppy: LIST OF REF; multi: Multi; <> 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; <> ppListPoppy ¬ LIST[ "", refFALSE, "\n ", refFALSE]; <> IF multi.name # NIL AND NOT ButtonClassesCommon.IsGeneratedRope[Atom.GetPName[multi.name]] THEN EmbeddedButtons.SetFieldRope[$Name, EBMesaLisp.Unparse[multi.name], buttonInfo]; <> 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; <> SELECT language FROM $Poppy => IF multi.message # NIL THEN EmbeddedButtons.SetFieldRope[$UpClickMessage, EBMesaLisp.Unparse[multi.message, ppListPoppy], buttonInfo]; ENDCASE; <<>> <> 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]; <> ProduceStandardFeedback[event, buttonInfo]; <> 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]; <> }; EXITS NoPop => EmbeddedButtons.Error["This PopUpStateButton is broken (syntax problem?)"]; }; PopUpStateGet: EBButtonClasses.GetValueProc = { <> self: PopUpStateData; multi: Multi; <> 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; <<>> <> value ¬ multi.value.value; EmbeddedButtons.RegisterNameValuePair[multi.name, value, buttonInfo]; }; PopUpStateSet: EBButtonClasses.SetValueProc = { <> 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 = { <> 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]; }; }; <> <> <> <> <> <<>> <> <<>> <<$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 ¬ [ name: $GuardedButton, 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 = { <> <> 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]; }; <> BEGIN entry: AtomButtons.ButtonLineEntry ¬ [button[ name: "", 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]; <" 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]; <> 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, name: Rope.ROPE, 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, name: name, 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; <> tipParseInfo.inCreek ¬ event.handle; userEvent ¬ TIPPrivate.WideMatchEvent[tipParseInfo, event.action­]; IF instanceData.handleProc # NIL THEN { ButtonHandlerEvent[buttonInfo, instanceData, userEvent]; }; }; ButtonNotify: ViewerClasses.NotifyProc = { <> 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; <> 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[]; <> EmbeddedButtons.FeedbackNotify[LIST[$Unhighlight], self]; data.inverted ¬ FALSE; IF data.guarded THEN { data.state ¬ guarded; <> EmbeddedButtons.FeedbackNotify[LIST[$Guard, $On], self]; }; <> <> <> ButtonPusher[self, data, data.handleProc, data.clientData, input, FALSE]; }; ENDCASE; $Down => { IF ~data.inverted THEN { InputFocus.CaptureButtons[ButtonNotify, tipParseInfo.tableHead, data.viewer]; <> EmbeddedButtons.FeedbackNotify[LIST[$Highlight], self]; data.inverted ¬ TRUE; } ELSE { <> <<[v, c] _ ViewerOps.MouseInViewer[mouse];>> <> <> <> }; }; $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] = { <> IF data = NIL THEN RETURN; ButtonWait[data, armingTime]; IF data.state = arming THEN { data.state ¬ armed; <> EmbeddedButtons.FeedbackNotify[LIST[$Guard, $Off], button]; ButtonWait[data, armedTime]; }; IF data.state#guarded THEN { data.state ¬ guarded; <> 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 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 EmbeddedButtons.FeedbackNotify[LIST[$Done], button]; }; <> <> <> <> <> <<>> <> popUpClass: EBButtonClasses.ButtonClass ¬ NEW[EBButtonClasses.ButtonClassObj ¬ [ name: $PopUpButton, instantiate: PopUpInstantiate, unparseInstanceData: NIL, handleEvent: PopUpHandle, getValue: NIL, setValue: NIL, defaultBehavior: NIL]]; PopUpInstantiate: EBButtonClasses.InstantiateProc = { <> <> menuName: ROPE; choices: AtomButtons.PopUpChoices; quickClickEnabled: BOOL ¬ TRUE; CodeTimer.StartInt[$PopUpInstantiate, $EmbeddedButtons]; CodeTimer.StartInt[$PopUpInstantiateParse, $EmbeddedButtons]; <> 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]; <> BEGIN entry: AtomButtons.ButtonLineEntry ¬ [popUpButton[ name: menuName, 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; <> 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]; <" 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]; <> 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]; <> }; 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 = { <> buttonInfo: ButtonInfo; <> IF NOT ISTYPE[view, ButtonInfo] THEN { EmbeddedButtons.Error["Pop-up buttons: Internal Error, button is wrong type (PopUpInButton)"]; RETURN[TRUE]; }; buttonInfo ¬ NARROW[view]; <> 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]; }; <> <> <> <> <> <> <<>> <> <<>> <> <<$Enter>> <<>> <> <<$Exit the mouse left the button without an up-click>> <<$Value value the button's value has changed to value.>> <<>> <> <<>> <> multiClass: EBButtonClasses.ButtonClass ¬ NEW[EBButtonClasses.ButtonClassObj ¬ [ name: $MultiStateButton, instantiate: MultiInstantiate, unparseInstanceData: MultiUnparse, handleEvent: MultiHandle, getValue: MultiGet, setValue: MultiSet, defaultBehavior: MultiDefaultBehavior]]; <> Multi: TYPE = REF MultiRec; MultiRec: TYPE = RECORD[ nameExists: BOOL ¬ FALSE, name: ATOM, value: Variable, message: REF, mouseInside: BOOL, defaultDirection: BOOL -- direction to change state by default FALSE => up, TRUE => down ]; MultiInstantiate: EBButtonClasses.InstantiateProc = { <> self: Multi; CodeTimer.StartInt[$MultiInstantiate, $EmbeddedButtons]; <> self ¬ NEW[MultiRec ¬ [ name: NIL, 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]; <> fieldValue ¬ EmbeddedButtons.GetFieldRope[$UpClickMessage, buttonInfo]; self.message ¬ EBMesaLisp.Parse[IO.RIS[fieldValue]].val; <> IF initFeedback THEN { EmbeddedButtons.FeedbackNotify[ feedbackEvent: LIST[$Value, self.value.value], buttonInfo: buttonInfo]; }; }; MultiUnparse: EBButtonClasses.UnparseInstanceDataProc = { <> <<>> <> <<>> self: Multi; rope: ROPE; ppListPoppy: LIST OF REF; <> 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]; <> ppListPoppy ¬ LIST[ "", refFALSE, "\n ", refFALSE]; <> IF self.name # NIL AND NOT ButtonClassesCommon.IsGeneratedRope[Atom.GetPName[self.name]] THEN EmbeddedButtons.SetFieldRope[$Name, EBMesaLisp.Unparse[self.name], buttonInfo]; <> 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; <> SELECT language FROM $Poppy => IF self.message # NIL THEN EmbeddedButtons.SetFieldRope[$UpClickMessage, EBMesaLisp.Unparse[self.message, ppListPoppy], buttonInfo]; ENDCASE; <<>> <> 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; <> ProduceStandardFeedback[event, buttonInfo]; <> tipParseInfo.inCreek ¬ event.handle; userEvent ¬ TIPPrivate.WideMatchEvent[tipParseInfo, event.action­]; MultiEvent[instanceData, userEvent, buttonInfo]; }; gClientData: REF; MultiCaptureNotify: InputFocus.NotifyProc = { <> acd: ActiveClientData; <> 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. <> 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 = { <> self: Multi; <> 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]; <<>> <> value ¬ self.value.value; EmbeddedButtons.RegisterNameValuePair[self.name, value, buttonInfo]; }; MultiSet: EBButtonClasses.SetValueProc = { <> 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 = { <> 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]; }; }; <> <> <> <> <> <<>> <> twoStateClass: EBButtonClasses.ButtonClass ¬ NEW[EBButtonClasses.ButtonClassObj ¬ [ name: $TwoStateButton, instantiate: TwoStateInstantiate, unparseInstanceData: MultiUnparse, handleEvent: MultiHandle, getValue: MultiGet, setValue: MultiSet, defaultBehavior: MultiDefaultBehavior]]; TwoStateInstantiate: EBButtonClasses.InstantiateProc = { <> <<>> <> self: Multi ¬ NEW[MultiRec ¬ [ name: NIL, value: NEW[VariableObj ¬ [ type: booleanEnumeratedType, value: refFALSE]], message: NIL, mouseInside: FALSE, defaultDirection: FALSE -- up ]]; MultiInstantiateAux[buttonInfo, language, languageVersion, self, initFeedback]; RETURN[self]; }; <> <> <> <> <> <> <<>> <> <<$Enter>> <<>> <> <<$Exit -- the mouse left the button without an up-click>> <<($State TRUE) -- change to the "on" appearance>> <<($State FALSE) -- change to the "off" appearance>> <<>> <> radioClass: EBButtonClasses.ButtonClass ¬ NEW[EBButtonClasses.ButtonClassObj ¬ [ name: $RadioButton, instantiate: RadioInstantiate, unparseInstanceData: RadioUnparse, handleEvent: RadioHandle, getValue: RadioGet, setValue: RadioSet, defaultBehavior: RadioDefaultBehavior]]; <> Radio: TYPE = REF RadioRec; RadioRec: TYPE = RECORD[ nameExists: BOOL ¬ FALSE, name: ATOM, value: REF, on: BOOL, mouseInside: BOOL, message: LIST OF REF]; RadioInstantiate: EBButtonClasses.InstantiateProc = { <> <> <> <> <> <> 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 = { <> self: Radio; <> 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 => { <> 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; <> ProduceStandardFeedback[event, buttonInfo]; <> tipParseInfo.inCreek ¬ event.handle; userEvent ¬ TIPPrivate.WideMatchEvent[tipParseInfo, event.action­]; RadioEvent[instanceData, userEvent, buttonInfo]; }; RadioCaptureNotify: InputFocus.NotifyProc = { <> acd: ActiveClientData; <> 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]; <> IF ButtonClassesCommon.CountMatches[userEvent, LIST[$Up]] > 0 THEN { <> IF self.mouseInside THEN { self.mouseInside ¬ FALSE; InputFocus.ReleaseButtons[]; }; <> 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 NOT self.mouseInside THEN { 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. <> 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 = { <> self: Radio; <> 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]; <> value ¬ self.value; IF self.on THEN { EmbeddedButtons.RegisterNameValuePair[self.name, value, buttonInfo]; RETURN[value]; }; RETURN[NIL]; }; RadioSet: EBButtonClasses.SetValueProc = { <> 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 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 = { <> self: Radio; <> 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]; }; <> CountMatches: PUBLIC PROC [a, b: LIST OF REF] RETURNS [result: INT ¬ 0] = { <> 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; 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] = { <> 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]; }; <> 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] = { <> userEvents: LIST OF REF; CodeTimer.StartInt[$ProduceStandardFeedback, $EmbeddedButtons]; <> 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]]]]; }; <> <> 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; <<>> <> 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.