
    <<ChoiceButtonsImpl.mesa>>
        <<Copyright © 1985 by Xerox Corporation.  All rights reserved.>>
        <<Written by Linda Gass on August 30, 1982 1:21 pm>>
        <<Last Edit by McGregor October 5, 1982 12:28 pm>>
        <<Last Edited by: Maxwell, January 3, 1983 12:35 pm>>
        <<Doug Wyatt, April 6, 1985 3:23:52 pm PST>>

    DIRECTORY
        Buttons USING [Button, ButtonProc, Create, ReLabel, SetDisplayStyle],
        ChoiceButtons,
        Containers USING [ChildXBound],
        Labels USING [Create, Label, Set],
        Rope USING [ROPE, Equal],
        ViewerClasses USING [Viewer],
        ViewerOps USING [AddProp, EnumProc, EnumerateChildren, FetchProp],
        ViewerTools USING [MakeNewTextViewer, SetContents, SetSelection],
        VFonts USING [CharWidth, Font, FontHeight, StringWidth, defaultFont];

    ChoiceButtonsImpl: CEDAR PROGRAM
    IMPORTS Buttons, Containers, Labels, Rope, ViewerOps, ViewerTools, VFonts 
    EXPORTS ChoiceButtons
    = BEGIN OPEN ChoiceButtons;

    ROPE: TYPE ~ Rope.ROPE;

    entryHeight: CARDINAL = 15; -- how tall to make each line of items
    entryHSpace: CARDINAL = 10; -- horizontal space between title and selections
    fudge: CARDINAL = 5; -- fudge factor so that the baselines of text viewers are aligned with
        <<their corresponding labels>>

    on: ATOM = $WhiteOnBlack;
    off: ATOM = $BlackOnWhite;

    DefaultDoesntExist: PUBLIC SIGNAL = CODE;
    ChoiceDoesntExist: PUBLIC SIGNAL = CODE;
    ButtonsCannotBeUpdated: PUBLIC SIGNAL = CODE;

    BuildEnumTypeSelection: PUBLIC PROC [viewer: ViewerClasses.Viewer, x, y: CARDINAL, title: ROPE, buttonNames: ButtonList, default: 
    ROPE, borderOnButtons: BOOL, notifyClientProc: SelectionNotifierProc, permit: EnumPermissionProc, clientdata: REF ANY, style: 
    StyleChoice, allInOneRow: BOOL, maxWidth: INTEGER] RETURNS [EnumTypeRef] = {
        foundDefault: BOOL _ FALSE;
        stateInfo: EnumTypeRef _ NEW[EnumTypeRec];
        DefaultFound: PROC[currentName, defaultName: ROPE] RETURNS [BOOL] = {
            IF Rope.Equal[currentName, defaultName, FALSE]  THEN RETURN [foundDefault _ TRUE]
                ELSE RETURN [FALSE];
        };
        BuildMenuSelection: PROC = {
            border: INTEGER _ 10;
            startButtons: CARDINAL;
            startX: INTEGER _ 0; -- keeps a running tally of where the next x position is
            tempButton:  Buttons.Button;
            eachButton: ButtonList;
            stateInfo.type _ menuStyle;
            IF title # NIL THEN {
                titleLabel:  Labels.Label_ Labels.Create[[
                    name: title, 
                    parent: viewer,
                    wx: x,
                    wy: y,
                    wh: entryHeight,
                    border: FALSE
                    ]];
                startButtons _ titleLabel.wx + titleLabel.ww + entryHSpace;
                }
            ELSE startButtons _ x;
            startX _ startButtons;

                FOR eachButton _ buttonNames, eachButton.rest UNTIL eachButton = NIL DO
                    IF ~allInOneRow THEN {
                        IF startX + VFonts.StringWidth[eachButton.first, VFonts.defaultFont] +
                        border >= maxWidth THEN {
                            startX _ startButtons;
                            stateInfo.nexty _ stateInfo.nexty + entryHeight;
                            };
                        };
                    tempButton _ Buttons.Create[info: [
                        name: eachButton.first,
                        wx: startX,
                        wy: stateInfo.nexty,
                        <<default the width so that it will be computed for us>>
                        wh: entryHeight, -- specify rather than defaulting so line is uniform
                        parent: viewer, 
                        border: borderOnButtons
                        ],
                        proc: MenuSelectionProc,
                        clientData: stateInfo
                        ];
                    ViewerOps.AddProp[tempButton, $ChoiceButtons, stateInfo];
                    IF DefaultFound[eachButton.first, default] THEN {
                        stateInfo.buttonOn _ tempButton;
                        Buttons.SetDisplayStyle[button: tempButton, style: on];
                        };
                    startX _ tempButton.wx + tempButton.ww;
                    ENDLOOP;
                stateInfo.nextx _ startX;
                };
        BuildFlipThru: PROC = {
            eachButton: ButtonList;
            titleButton: Buttons.Button;
            nextx: INTEGER _ x;
            IF title # NIL THEN { -- create a title button
                stateInfo.type _ flipThruWithTitle;
                titleButton _ Buttons.Create[
                    info: [name: title, 
                        parent: viewer,
                        wx: nextx,
                        wy: y,
                        wh: entryHeight,
                        border: TRUE
                        ],
                    proc: FlipThruButtonProc,
                    clientData: stateInfo
                    ];
                nextx _ titleButton.wx + titleButton.ww + 3;
                }
            ELSE stateInfo.type _ flipThruNoTitle;
            FOR eachButton _ buttonNames, eachButton.rest UNTIL (eachButton = NIL) OR
                DefaultFound[eachButton.first, default] DO -- do nothing
                ENDLOOP;
            <<now set up the initial button>>
            IF title # NIL THEN stateInfo.flipLabel _ Labels.Create[[
                name: eachButton.first,
                wx: nextx,
                wy: y,
                ww: MaxNameWidth[buttonNames], -- first find the longest name so we can set up the
                <<width properly (unfortunately when re-labeling a button, the width remains the same)>>
                wh: entryHeight, 
                parent: viewer, 
                border: FALSE
                ]]
            ELSE stateInfo.flipLabel _ Buttons.Create[
                info:  [name: eachButton.first,
                    wx: nextx,
                    wy: y,
                    ww: MaxNameWidth[buttonNames],
                    wh: entryHeight,
                    parent: viewer, 
                    border: borderOnButtons
                    ],
                proc: FlipThruButtonProc,
                clientData: stateInfo
                ];
            stateInfo.nextx _ stateInfo.flipLabel.wx + stateInfo.flipLabel.ww;
            };
        stateInfo.nextx _ x;
        stateInfo.nexty _ y;
        stateInfo.proc _ notifyClientProc;
        stateInfo.namesOfButtons _ buttonNames;
        stateInfo.clientdata _ clientdata;
        stateInfo.permission _ permit;
        IF default = NIL THEN -- set it to be the first name of the list of button names
            default _ buttonNames.first;

        SELECT style FROM
            menuSelection => BuildMenuSelection;
            flipThru => BuildFlipThru;
            ENDCASE => ERROR;

        <<signal that the default didn't exist if necessary>>
        IF ~foundDefault THEN SIGNAL DefaultDoesntExist;

        stateInfo.nexty _ stateInfo.nexty + entryHeight; 
        RETURN[stateInfo];
        };

    MenuSelectionProc: Buttons.ButtonProc = {
        info: EnumTypeRef _ NARROW[clientData];
        viewer: ViewerClasses.Viewer _ NARROW[parent];
        IF info.permission # NIL THEN {
            IF info.permission[info] THEN { -- don't do anything without permission first
                SwitchButtons[info.buttonOn, viewer]; -- viewer is the button which was just selected
                info.buttonOn _ viewer;
                <<Notify client that change has taken place if the client provided a proc for doing this>>
                IF info.proc # NIL THEN info.proc[viewer.name, info.clientdata];
                }}
        ELSE {
            SwitchButtons[info.buttonOn, viewer]; -- viewer is the button which was just selected
            info.buttonOn _ viewer;
            <<Notify client that change has taken place if the client provided a proc for doing this>>
            IF info.proc # NIL THEN info.proc[viewer.name, info.clientdata];
            };
        };

    SwitchButtons: PRIVATE PROC[oldButton, newButton: Buttons.Button] = {
        <<merely changes the physical appearance of the buttons>>
        <<Switch off the previously selected button>>
        Buttons.SetDisplayStyle[button: oldButton, style: off];
        <<switch "on" the newly selected button>>
        Buttons.SetDisplayStyle[button: newButton, style: on];
        };

    FlipThruButtonProc: Buttons.ButtonProc = {
        info: EnumTypeRef _ NARROW[clientData];
        IF info.permission # NIL THEN {
            IF info.permission[info] THEN { -- don't do anything without permission first
                IF mouseButton=red THEN 
                <<Display the next name in succession>>
                    ViewerTools.SetContents[viewer: info.flipLabel, contents:
                        GetNextName[info.namesOfButtons, info.flipLabel.name]]
                ELSE -- Display the previous name
                    ViewerTools.SetContents[viewer: info.flipLabel, contents:
                        GetPrevName[info.namesOfButtons, info.flipLabel.name]];
                <<Notify client that change has taken place if the client provided a proc for doing this>>
                IF info.proc # NIL THEN info.proc[info.flipLabel.name, info.clientdata];
                }}
        ELSE {
            IF mouseButton=red THEN
                <<Display the next name in succession>>
                ViewerTools.SetContents[viewer: info.flipLabel, contents:
                    GetNextName[info.namesOfButtons, info.flipLabel.name]]
            ELSE -- display the previous name
                ViewerTools.SetContents[viewer: info.flipLabel, contents:
                    GetPrevName[info.namesOfButtons, info.flipLabel.name]];
            <<Notify client that change has taken place if the client provided a procedure for doing this>>
            IF info.proc # NIL THEN info.proc[info.flipLabel.name, info.clientdata];
            };
        };

    UpdateChoiceButtons: PUBLIC PROC [viewer: ViewerClasses.Viewer, enumTypeInfo: EnumTypeRef, newName: ROPE] = {
        newButton: Buttons.Button _ NIL;
        GetDesiredButton: ViewerOps.EnumProc = {
            IF (Rope.Equal[v.name, newName, FALSE]) AND 
                (ViewerOps.FetchProp[v, $ChoiceButtons] = enumTypeInfo) THEN {
                newButton _ v;
                RETURN [FALSE];
                };
            };
        IF enumTypeInfo = NIL THEN SIGNAL ButtonsCannotBeUpdated;
        SELECT enumTypeInfo.type FROM
            menuStyle  => {ViewerOps.EnumerateChildren[viewer, GetDesiredButton];
                IF newButton # NIL THEN {
                    SwitchButtons[enumTypeInfo.buttonOn, newButton];
                    enumTypeInfo.buttonOn _ newButton;
                    }
                ELSE SIGNAL ChoiceDoesntExist;
                };
            flipThruWithTitle =>  Labels.Set[label: enumTypeInfo.flipLabel, value: newName];
            flipThruNoTitle  => Buttons.ReLabel[button: enumTypeInfo.flipLabel, newName: newName];
            ENDCASE => ERROR;
        };

    GetSelectedButton: PUBLIC PROC [handle: EnumTypeRef] RETURNS [ROPE] = {
        IF handle.type = menuStyle THEN {
            IF handle.buttonOn = NIL THEN ERROR 
            ELSE RETURN [handle.buttonOn.name]
            }
        ELSE {
            IF handle.flipLabel = NIL THEN ERROR
            ELSE RETURN[handle.flipLabel.name]
            };
        };

    GetNextName: PRIVATE PROC[listOfNames: ButtonList,  currentName: ROPE] RETURNS
        [ROPE] = {
        eachButton: ButtonList _ listOfNames;
        WHILE (eachButton # NIL) AND (eachButton.first # currentName) DO 
            eachButton _ eachButton.rest;
            ENDLOOP;
        IF eachButton = NIL THEN ERROR; -- This shouldn't happen; we should always be able to
            <<find the current button name in list of button names>>
        IF eachButton.rest = NIL THEN 
            <<we are at the end of our list, cycle around to the beginning>>
            RETURN [listOfNames.first]
        ELSE RETURN [(eachButton.rest).first];
        };

    GetPrevName: PRIVATE PROC[listOfNames: ButtonList,  currentName: ROPE] RETURNS
        [ROPE] = {
        prev: ROPE _ listOfNames.first;
        eachName:  ChoiceButtons.ButtonList _ listOfNames.rest;
        WHILE (eachName # NIL) AND ~Rope.Equal[eachName.first, currentName, FALSE] DO
            prev _ eachName.first;
            eachName _ eachName.rest;
            ENDLOOP;
        RETURN[prev];
        };

    MaxNameWidth: PRIVATE PROC[listOfNames: ButtonList] RETURNS [CARDINAL] = {
        eachButton: ButtonList _ listOfNames;
        maxWidth: CARDINAL;
        IF eachButton # NIL THEN {
            maxWidth _ VFonts.StringWidth[string: eachButton.first, font: VFonts.defaultFont];
            eachButton _ eachButton.rest }
        ELSE RETURN [0];
        WHILE (eachButton # NIL) DO
            IF VFonts.StringWidth[string: eachButton.first, font: VFonts.defaultFont] > maxWidth THEN
                maxWidth _ VFonts.StringWidth[string: eachButton.first, font: VFonts.defaultFont]; 
            eachButton _ eachButton.rest;
            ENDLOOP;
        maxWidth _ maxWidth + VFonts.CharWidth['M]; -- add on a little extra just to be sure
        RETURN[maxWidth];
        };

    BuildTriStateButton: PUBLIC PROC [viewer: ViewerClasses.Viewer, x,y: INTEGER, name: ROPE] RETURNS [stateInfo: ThreeStateRef, nextX: 
    INTEGER] = {
        tempButton: Buttons.Button;
        stateInfo _ NEW[ThreeState];
        tempButton _ Buttons.Create[
        info: [name: name,
            wx: x,
            wy: y,
            <<default the width so that it will be computed for us>>
            wh: entryHeight, -- specify rather than defaulting so line is uniform
            parent: viewer, 
            border: TRUE
            ],
            proc: TriSwitchProc,
            clientData: stateInfo -- this will be passed to our button proc
            ];
        stateInfo.button _ tempButton;
        nextX _ tempButton.wx + tempButton.ww + 4;
        };

    SetButtonState: PUBLIC PROC [buttonSelected:  Buttons.Button, state: StateType] = {
        SELECT state FROM 
            on => Buttons.SetDisplayStyle[button: buttonSelected, style: $WhiteOnBlack];
            off => Buttons.SetDisplayStyle[button: buttonSelected, style: $BlackOnWhite];
            default => Buttons.SetDisplayStyle[button: buttonSelected, style: $BlackOnGrey];
            ENDCASE => ERROR;
        };

    NextState: PROC [state: StateType] RETURNS [StateType] = {
        IF state = LAST[StateType] THEN RETURN[FIRST[StateType]]
        ELSE RETURN[SUCC[state]];
        };

    TriSwitchProc: Buttons.ButtonProc = {
        handle: ThreeStateRef _ NARROW[clientData];
        handle.state _ NextState[handle.state];
        <<Indicate which state this button is in.>>
        SetButtonState[handle.button, handle.state];
        };

    BuildTextPrompt: PUBLIC PROC [viewer: ViewerClasses.Viewer, x,y: CARDINAL, title: ROPE, default: ROPE, font: VFonts.Font, 
    textViewerWidth: INTEGER, clientdata: REF ANY, notify: SelectionNotifierProc, permit: PromptPermissionProc] RETURNS 
    [promptData: PromptDataRef] = {
        height: INTEGER _ VFonts.FontHeight[font] + 6;
        promptData _ NEW[PromptDataRec];
        promptData.promptButton _ Buttons.Create[info: [name: title, wx: x, wy: y, wh: height,
            parent: viewer, border: FALSE], font: font, proc: PromptProc, clientData: promptData];
        promptData.textViewer _ ViewerTools.MakeNewTextViewer [[
            parent: viewer,
            wx: promptData.promptButton.wx + promptData.promptButton.ww + entryHSpace,
            wy: y + fudge,
            ww: textViewerWidth,
            wh: height - fudge,
            name: title, -- give it the name of the prompt associated with it
            data: default,
            scrollable: FALSE,
            border: FALSE
            ]];
        IF textViewerWidth = LAST[INTEGER] THEN {
            Containers.ChildXBound[viewer, promptData.textViewer];
            promptData.newx _ LAST[INTEGER];
            }
        ELSE promptData.newx _ promptData.textViewer.wx + promptData.textViewer.ww;
        IF default # NIL THEN ViewerTools.SetContents[promptData.textViewer, default];
        promptData.clientdata _ clientdata;
        promptData.notify _ notify;
        promptData.permission _ permit;
        promptData.newy _ y + height;
        };

    PromptProc: Buttons.ButtonProc = {
        handle: PromptDataRef _ NARROW[clientData];
        viewer: ViewerClasses.Viewer _ NARROW[parent];
        IF handle.permission # NIL THEN {
            IF handle.permission[handle] THEN {  -- dont do anything without permission
                IF mouseButton=red THEN   -- make pending delete
                    ViewerTools.SetSelection[handle.textViewer]
                ELSE -- notify the client if proc provided.
                    IF handle.notify # NIL THEN handle.notify[viewer.name, handle.clientdata];
                }}
        ELSE {
            IF mouseButton=red THEN   -- make pending delete
                ViewerTools.SetSelection[handle.textViewer]
            ELSE -- notify the client if proc provided.
                IF handle.notify # NIL THEN handle.notify[viewer.name, handle.clientdata];
            } 
        };


    END.