<<>>
    <<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>>

    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] = {
        <<--does NOT call the hitproc>>
        IF XTk.HasClass[widget, toggleClass]
            THEN ChooseForToggle[widget, ce]
            ELSE ChooseForChoice[widget, ce];
        };

    ChooseForChoice: PROC [widget: XTk.Widget, ce: ChoiceElement] = {
        <<--does NOT call the hitproc>>
        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] = {
        <<--does NOT call the hitproc>>
        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] = {
        <<Returns sub list starting with found choice>>
        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.