DIRECTORY Rope, XTk, XTkButtons, XTkCollections, XTkContainers, XTkLabels, XTkChoiceWidgets, XTkFriends; XTkChoiceWidgetsImpl: CEDAR MONITOR IMPORTS Rope, XTkButtons, XTkCollections, XTkContainers, XTk, XTkFriends, XTkLabels EXPORTS XTkChoiceWidgets = BEGIN OPEN XTk, XTkChoiceWidgets; myKey: REF ATOM = NEW[ATOM ¬ $choice]; choiceXClass: ImplementorClass ¬ XTkFriends.CreateClass[[key: $xchoice, wDataNum: 1, super: XTkContainers.xStack]]; choiceYClass: ImplementorClass ¬ XTkFriends.CreateClass[[key: $ychoice, wDataNum: 1, super: XTkContainers.yStack]]; toggleClass: ImplementorClass ¬ XTkFriends.CreateClass[[key: $toggle, wDataNum: 1, super: XTkButtons.buttonClass]]; CRec: TYPE = RECORD [ hitProc: XTk.WidgetNotifyProc, originalStyle: ATOM, registerData: REF ¬ NIL, choices: ChoiceList ¬ NIL, current: ChoiceList ¬ NIL, selected: Widget ¬ NIL, callData: REF ¬ NIL ]; ChoicesHitProc: XTk.WidgetNotifyProc = { cRef: REF CRec ¬ NARROW[registerData]; cRef.callData ¬ callData; IF cRef.selected=widget THEN RETURN; IF cRef.selected#NIL THEN XTkLabels.SetStyleKey[cRef.selected, NIL, delayed]; cRef.selected ¬ widget; XTkLabels.SetStyleKey[widget, $Gray1]; IF cRef.hitProc#NIL THEN cRef.hitProc[widget: widget.parent, registerData: cRef.registerData, callData: callData, event: event]; }; Choose: PUBLIC PROC [widget: XTk.Widget, ce: ChoiceElement] = { IF XTk.HasClass[widget, toggleClass] THEN ChooseForToggle[widget, ce] ELSE ChooseForChoice[widget, ce]; }; ChooseForChoice: PROC [widget: XTk.Widget, ce: ChoiceElement] = { cRef: REF CRec ~ NARROW[XTkFriends.InstPart[widget, choiceYClass]]; c: ChoiceList ¬ FindChoice[cRef.choices, ce]; EachChild: XTkCollections.EachChildProc = { IF c=XTk.GetWidgetProp[child, myKey] THEN { cRef.selected ¬ child; XTkLabels.SetStyleKey[child, $Gray1]; stop ¬ TRUE }; }; IF c#NIL THEN { IF cRef.selected#NIL THEN XTkLabels.SetStyleKey[cRef.selected, NIL, delayed]; XTkCollections.EnumerateChildren[widget, EachChild]; }; }; ChooseForToggle: PROC [widget: XTk.Widget, ce: ChoiceElement] = { cRef: REF CRec ~ NARROW[XTkFriends.InstPart[widget, toggleClass]]; c: ChoiceList ¬ FindChoice[cRef.choices, ce]; IF c#NIL THEN { cRef.current ¬ c; XTkLabels.SetText[widget, cRef.current.first.text]; }; }; FindChoice: PROC [choices: ChoiceList, el: ChoiceElement] RETURNS [ChoiceList ¬ NIL] = { FOR c: ChoiceList ¬ choices, c.rest WHILE c#NIL DO IF c.first=el THEN RETURN [c]; ENDLOOP; IF el.text#NIL THEN FOR c: ChoiceList ¬ choices, c.rest WHILE c#NIL DO IF Rope.Equal[c.first.text, el.text] THEN RETURN [c]; ENDLOOP; IF el.callData#NIL THEN FOR c: ChoiceList ¬ choices, c.rest WHILE c#NIL DO IF c.first.callData=el.callData THEN RETURN [c]; ENDLOOP; }; CreateChoices: PUBLIC PROC [widgetSpec: WidgetSpec, choices: ChoiceList, horizontal: BOOL ¬ TRUE, hitProc: XTk.WidgetNotifyProc, registerData: REF, tq: XTk.TQ, style: StyleSpec] RETURNS [widget: ChoiceWidget] = { cRef: REF CRec = NEW[CRec ¬ [hitProc: hitProc, registerData: registerData, originalStyle: style.styleKey, choices: choices]]; class: Class ¬ SELECT horizontal FROM TRUE => choiceXClass, FALSE => choiceYClass ENDCASE => ERROR; IF choices=NIL THEN ERROR; widgetSpec.class ¬ XTkFriends.InitClassField[widgetSpec.class, class]; widget ¬ XTkCollections.Create[widgetSpec]; XTkFriends.AssignInstPart[widget, class, cRef]; FOR c: ChoiceList ¬ choices, c.rest WHILE c#NIL DO child: Widget; style.styleKey ¬ cRef.originalStyle; IF c.first.callData=NIL THEN child ¬ XTkLabels.CreateLabel[text: c.first.text, style: style] ELSE { IF cRef.selected=NIL THEN {style.styleKey ¬ $Gray1}; child ¬ XTkButtons.CreateButton[text: c.first.text, style: style, hitProc: ChoicesHitProc, registerData: cRef, callData: c.first.callData, hitTQ: tq ]; IF cRef.selected=NIL THEN { cRef.selected ¬ child; cRef.callData ¬ c.first.callData }; }; XTk.PutWidgetProp[child, myKey, c]; XTkCollections.AddChildLR[widget, child]; --this is creation ENDLOOP; }; ToggleHitProc: XTk.WidgetNotifyProc = { cRef: REF CRec ¬ NARROW[registerData]; curr: ChoiceList ¬ cRef.current; ce: ChoiceElement; IF curr=NIL OR curr.rest=NIL THEN cRef.current ¬ cRef.choices ELSE cRef.current ¬ curr.rest; ce ¬ cRef.current.first; XTkLabels.SetText[widget, ce.text]; IF cRef.hitProc#NIL THEN cRef.hitProc[widget: widget, registerData: cRef.registerData, callData: ce.callData, event: event]; }; CreateToggle: PUBLIC PROC [widgetSpec: WidgetSpec, choices: ChoiceList, hitProc: XTk.WidgetNotifyProc, registerData: REF, tq: XTk.TQ, style: StyleSpec] RETURNS [widget: ChoiceWidget] = { cRef: REF CRec = NEW[CRec ¬ [registerData: registerData, current: choices, choices: choices, hitProc: hitProc]]; IF choices=NIL THEN ERROR; widgetSpec.class ¬ XTkFriends.InitClassField[widgetSpec.class, toggleClass]; widget ¬ XTkButtons.CreateButton[widgetSpec: widgetSpec, text: choices.first.text, hitProc: ToggleHitProc, registerData: cRef, hitTQ: tq]; XTkFriends.AssignInstPart[widget, toggleClass, cRef]; }; GetCRef: PROC [w: Widget] RETURNS [cRef: REF CRec] = { SELECT w.s.class FROM choiceXClass => RETURN [NARROW[XTkFriends.InstPart[w, choiceXClass]]]; choiceYClass => RETURN [NARROW[XTkFriends.InstPart[w, choiceYClass]]]; toggleClass => RETURN [NARROW[XTkFriends.InstPart[w, toggleClass]]]; ENDCASE => ERROR; }; CurrentChoice: PUBLIC PROC [widget: Widget] RETURNS [REF ANY] = { cRef: REF CRec ~ GetCRef[widget]; RETURN [cRef.callData]; }; IsChoice: PUBLIC PROC [w: XTk.Widget] RETURNS [BOOL] = { IF w=NIL THEN RETURN [FALSE]; RETURN [w.s.class=choiceXClass OR w.s.class=choiceYClass OR w.s.class=toggleClass] }; END. V XTkChoiceWidgetsImpl.mesa Copyright Σ 1989, 1990, 1991 by Xerox Corporation. All rights reserved. Created by Christian Jacobi, February 22, 1989 7:53:06 pm PST Christian Jacobi, October 1, 1992 9:47 pm PDT --does NOT call the hitproc --does NOT call the hitproc --does NOT call the hitproc Returns sub list starting with found choice Κζ–(cedarcode) style•NewlineDelimiter ™codešœ™Kšœ Οeœ=™HKšœ=™=K™-—K˜šΟk œ˜ Kšœ˜Kšœ˜Kšœ ˜ Kšœ˜Kšœ˜Kšœ ˜ Kšœ˜Kšœ ˜ K˜—šΟnœžœžœ˜$KšžœL˜SKšžœ˜—Kšžœžœ˜!K˜Kš œžœžœžœžœ ˜&Kšœs˜sKšœs˜sKšœs˜sK˜šœžœžœ˜Kšœ˜Kšœžœ˜Kšœžœžœ˜Kšœžœ˜Kšœžœ˜Kšœžœ˜Kšœ žœž˜Kšœ˜K˜—šŸœ˜(Kšœžœžœ˜&Kšœ˜Kšžœžœžœ˜$Kšžœžœžœ&žœ ˜MKšœ˜Kšœ&˜&šžœžœžœ˜Kšœg˜g—Kšœ˜—K˜šŸœžœžœ,˜?Kšœ™šžœ"˜$Kšžœ˜ Kšžœ˜!—K˜K˜—šŸœžœ,˜AKšœ™Kšœžœžœ,˜CKšœ-˜-šŸ œ"˜+šžœ#žœ˜+Kšœ˜Kšœ%˜%Kšœž˜ K˜—K˜—šžœžœžœ˜Kšžœžœžœ&žœ ˜MKšœ4˜4K˜—K˜K˜—šŸœžœ,˜AKšœ™Kšœžœžœ+˜BKšœ-˜-šžœžœžœ˜Kšœ˜Kšœ3˜3K˜—K˜K˜—šŸ œžœ*žœžœ˜XKšœ+™+šžœ!žœžœž˜2Kšžœ žœžœ˜Kšžœ˜—šžœ žœž˜šžœ!žœžœž˜2Kšžœ#žœžœ˜5Kšžœ˜——šžœ žœžœ˜šžœ!žœžœž˜2Kšžœžœžœ˜0Kšžœ˜——K˜—K˜šŸ œžœžœ;žœžœ/žœ žœžœ˜ΤKšœžœžœi˜}Kš œžœ žœžœžœžœžœ˜cKšžœ žœžœžœ˜KšœF˜FKšœ+˜+Kšœ/˜/šžœ!žœžœž˜2Kšœ˜Kšœ$˜$šžœžœ˜Kšžœ@˜Dšžœ˜Kšžœžœžœ˜4šœ4˜4Kšœ˜KšœR˜RKšœ˜—šžœžœžœ˜Kšœ7˜7Kšœ˜—K˜——Kšœ#˜#Kšœ<˜