
    <<XTkHelpShellsImpl.mesa>>
        <<Copyright Ó 1992 by Xerox Corporation.  All rights reserved.>>
        <<Created by Christian Jacobi, March 9, 1992 3:33 pm PST>>
        <<Christian Jacobi, April 19, 1993 10:40 am PDT>>
        <<>>
    DIRECTORY 
        ForkOps,
        HelpStrings,
        Rope,
        XTk,
        XTkHelpStrings, 
        XTkLabels,
        XTkHelpShells,
        XTkShellWidgets;

    XTkHelpShellsImpl: CEDAR MONITOR 
        IMPORTS ForkOps, Rope, XTk, XTkHelpStrings, XTkLabels, XTkShellWidgets
        EXPORTS XTkHelpShells =
    BEGIN 

    <<Locking: Make sure widgets are not created double or zero times.  However we do not care about  which help message is displayed 
    when conflicts would occur. >>

    clear: Rope.ROPE ~ "                                  ";

    myHelpClass: REF HelpStrings.ClassRec ~ NEW[HelpStrings.ClassRec ¬ [
        display: MyDisplay,
        clear: MyClear,
        makeVisible: MakeVisible,
        hide: NoVisible,
        more: NIL
        ]];

    MyData: TYPE = RECORD [
        label: XTk.Widget ¬ NIL,
        makeVisibleWhenUsed: BOOL ¬ FALSE,
        data: REF ¬ NIL,
        string: REF ¬ NIL,
        text: Rope.ROPE ¬ NIL,
        key: REF ¬ NIL
        ];

    AssignLabel: ENTRY PROC [md: REF MyData, label: XTk.Widget] RETURNS [previous: XTk.Widget] = {
        <<Atomic so destruction and maximum of one help widget is guaranteed>>
        previous  ¬ md.label;
        md.label ¬ label;
        };

    CreateHelpWithPopShell: PUBLIC PROC [for: XTk.Widget] RETURNS [h: HelpStrings.Handle] = {
        h ¬ MyCreateHandle[];
        IF for#NIL THEN XTk.RegisterNotifier[for, XTk.preStopFastAccessKey, ParentDestroyed, h];
        };

    ParentDestroyed: XTk.WidgetNotifyProc = {
        h: HelpStrings.Handle ¬ NARROW[registerData];
        WITH h.data SELECT FROM
            md: REF MyData => Remove[AssignLabel[md, NIL]];
            ENDCASE => {}
        };

    MyCreateHandle: PROC [] RETURNS [h: HelpStrings.Handle ¬ NIL] = {
        md: REF MyData ~ NEW[MyData ¬ []];
        h ¬ NEW [HelpStrings.HandleRec ¬ [myHelpClass, md]] 
        };

    MyDisplay: PROC [h: HelpStrings.Handle, string: REF, key: REF ¬ NIL] = {
        WITH h.data SELECT FROM
            md: REF MyData => {
                previousText: Rope.ROPE ¬ md.text;
                label: XTk.Widget;
                WITH string SELECT FROM
                    r: Rope.ROPE => md.text ¬ r;
                    ENDCASE => RETURN;
                md.string ¬ string; md.key ¬ key;
                IF md.makeVisibleWhenUsed AND (md.label=NIL OR md.label.state#realized) THEN {
                    <<not locked; worst case if multiple widgets are created is that all but one will be destroyed again>>
                    md.makeVisibleWhenUsed _ FALSE;
                    previousText ¬ NIL;
                    ForkOps.ForkDelayed[0, ForkedCreate, h]; --use other thread to move slow widget creation out of the way of fast redisplay 
                    };
                label ¬ md.label;
                IF label#NIL AND ~Rope.Equal[previousText, md.text] THEN 
                    XTkLabels.SetText[label, md.text, immediately];
                };
            ENDCASE => {}
        };

    MyClear: PROC [h: HelpStrings.Handle, string: REF, key: REF ¬ NIL] = {
        WITH h.data SELECT FROM
            md: REF MyData => {
                IF md.string=string OR md.key=key THEN {
                    label: XTk.Widget ~ md.label;
                    IF label#NIL THEN XTkLabels.SetText[md.label, clear, delayed];
                    md.text ¬ NIL;
                    };
                };
            ENDCASE => {}
        };

    ForkedCreate: PROC [x: REF] = {
        h: HelpStrings.Handle ~ NARROW[x];
        WITH h.data SELECT FROM
            md: REF MyData => {
                connection: REF ANY;
                label: XTk.Widget ~ XTkLabels.CreateLabel[widgetSpec: [geometry: XTk.G[350, 20]], text: clear];
                shell: XTk.Widget ~ XTkShellWidgets.CreateShell[windowHeader: "Help", child: label, className: $Help, focusProtocol: FALSE];
                old: XTk.Widget ~ AssignLabel[md, label];
                BEGIN
                    ENABLE UNCAUGHT => GOTO Oops;
                    XTkHelpStrings.SetHandle[shell, h];
                    WITH md.data SELECT FROM
                        w: XTk.Widget => connection ¬ w.connection;
                        ENDCASE => connection ¬ md.data; 
                    XTkShellWidgets.BindScreenShell[shell: shell, connection: connection];
                    XTkLabels.SetText[label, md.text, immediately];
                    XTkShellWidgets.RealizeShell[shell];
                    EXITS Oops => {};
                    END;
                Remove[old];
                };
            ENDCASE => {};
        };

    MakeVisible: PROC [h: HelpStrings.Handle, data: REF] = {
        WITH h.data SELECT FROM
            md: REF MyData => {
                md.data ¬ data;
                md.makeVisibleWhenUsed ¬ TRUE;
                };
            ENDCASE => {}
        };

    NoVisible: PROC [h: HelpStrings.Handle, data: REF] = {
        WITH h.data SELECT FROM
            md: REF MyData => {
                md.makeVisibleWhenUsed ¬ FALSE;
                Remove[AssignLabel[md, NIL]];
                };
            ENDCASE => {}
        };

    Remove: PROC [old: XTk.Widget] = {
        IF old#NIL THEN ForkOps.ForkDelayed[0, ForkedDestroy, old];
        };

    ForkedDestroy: PROC [x: REF] = {
        shell: XTk.Widget ¬ XTk.RootWidget[NARROW[x]];
        IF shell#NIL AND XTkShellWidgets.IsShell[shell] THEN 
            XTkShellWidgets.DestroyShell[shell];
        };

    END.