
    <<X11EvalServerImpl.mesa>>
        <<Copyright Ó 1991, 1992 by Xerox Corporation.  All rights reserved.>>
        <<Christian Jacobi, April 24, 1991 5:26 pm PDT>>
        <<Christian Jacobi, March 27, 1992 11:18 am PST>>
        <<>>
    DIRECTORY 
        Ascii, Atom, Rope, RuntimeError, Xl, XlPredefinedAtoms, X11EvalServer, X11SelectionOwner, X11SelectionRequestor, XTk, XTkWidgets;

    X11EvalServerImpl: CEDAR PROGRAM
        IMPORTS Atom, Rope, RuntimeError, Xl, X11SelectionOwner, X11SelectionRequestor, XTk, XTkWidgets
        EXPORTS X11EvalServer ~ 
    BEGIN OPEN X11EvalServer;

    Listener: TYPE = REF ListenerRec;
    ListenerRec: TYPE = RECORD [
        connection: Xl.Connection Ź NIL, iMadeIt: BOOL Ź FALSE,
        myFeatureName: Rope.ROPE Ź NIL,
        myFeatureXAtom: Xl.XAtom Ź [0],
        insertPropertyXAtom: Xl.XAtom Ź [0],
        insertSelectionXAtom: Xl.XAtom Ź [0],
        atomPairXAtom: Xl.XAtom Ź [0],
        dummyShell: XTk.Widget Ź NIL,
        oac: X11SelectionOwner.ApplicationClass Ź NIL,
        oh: X11SelectionOwner.OwnershipHandle Ź NIL,
        proc: CommandProc Ź NIL,
        environment: REF Ź NIL,
        lost: DataProc Ź NIL,
        lostData: REF Ź NIL
        ];

    ErrorEvent: Xl.EventProcType = {
        };

    Create: PUBLIC PROC [server: REF, selection: Rope.ROPE, proc: CommandProc, environment: REF Ź NIL, lost: DataProc Ź NIL, lostData: 
    REF Ź NIL] RETURNS [ok: BOOL Ź FALSE, explanation: Rope.ROPE Ź NIL] = {
        ENABLE {
            Xl.connectionNotCreated => {explanation Ź why.reason; GOTO oops};
            };
        CreateConnection: PROC [display: Rope.ROPE] = {
            errorMatch: Xl.Match Ź NEW[Xl.MatchRep Ź [ErrorEvent, Xl.CreateEventFilter[errorNotify], NIL, ls]];
            ls.connection Ź Xl.CreateConnection[server: display, errorMatch: errorMatch];
            ls.iMadeIt Ź TRUE;
            };
        ls: Listener ~ NEW[ListenerRec Ź [
            myFeatureName: selection,
            proc: proc,
            environment: environment,
            lost: lost,
            lostData: lostData
            ]];
        IF server=NIL 
            THEN CreateConnection[NIL]
            ELSE 
                WITH server SELECT FROM
                    connection: Xl.Connection => {
                        ls.connection Ź connection;
                        };
                    display: Rope.ROPE => CreateConnection[display];
                    ENDCASE => ERROR;
        ls.myFeatureXAtom Ź Xl.MakeAtom[ls.connection, ls.myFeatureName];
        ls.insertPropertyXAtom Ź Xl.MakeAtom[ls.connection, "INSERT_PROPERTY"];
        ls.insertSelectionXAtom Ź Xl.MakeAtom[ls.connection, "INSERT_SELECTION"];
        ls.atomPairXAtom Ź Xl.MakeAtom[ls.connection, "ATOM_PAIR"];
        ls.dummyShell Ź XTkWidgets.CreateShell[deletionProtocol: FALSE, focusProtocol: FALSE];
        ls.dummyShell.attributes.overrideRedirect Ź true;
        XTkWidgets.BindScreenShell[shell: ls.dummyShell, connection: ls.connection];
        XTkWidgets.RealizeShell[shell: ls.dummyShell, mapping: unmapped];
        ls.oac Ź NEW[X11SelectionOwner.ApplicationClassRec Ź [
            selection: ls.myFeatureName,
            convert: MyConvert,
            lostOwnership: MyLostOwnership,
            classData: NIL,
            targets: LIST["INSERT_PROPERTY", "INSERT_SELECTION"]
            ]];
        ls.oh Ź X11SelectionOwner.EstablishSelectionOwnerProtocol[w: ls.dummyShell, ac: ls.oac, ownershipData: ls];
        ok Ź X11SelectionOwner.AquireOwnership[ls.oh, Xl.currentTime];
        IF ~ok THEN {
            DestroyListener[ls];
            explanation Ź "failed to aquire selection";
            };
        EXITS oops => {};
        };
        <<>>
    DestroyListener: PROC [ls: Listener] = {
        XTk.DestroyWidget[ls.dummyShell];
        IF ls.iMadeIt THEN Xl.CloseConnection[ls.connection];
        };

    MyLostOwnership: X11SelectionOwner.LostOwnershipNotifyProc = {
        ls: Listener ~ NARROW[oh.ownershipData];
        lost: DataProc Ź ls.lost;
        DestroyListener[ls];
        IF lost#NIL THEN lost[ls.lostData];
        };

    ToRope: PROC [value: LIST OF REF ANY] RETURNS [r: Rope.ROPE Ź NIL] = {
        FOR l: LIST OF REF ANY Ź value, l.rest WHILE l#NIL DO
            WITH l.first SELECT FROM
                rr: Rope.ROPE => r Ź Rope.Concat[r, rr];
                ENDCASE => {};
            ENDLOOP;
        };

    InsertSelectionReceived: X11SelectionRequestor.SelectionReceivedProc = {
        originalRequest: X11SelectionOwner.Request ~ NARROW[clientData];
        SELECT result FROM
            ok => originalRequest.ownerData Ź value;
            none => originalRequest.ownerData Ź $noSelection;
            timeout => originalRequest.ownerData Ź $timeoutSelection;
            ENDCASE => ERROR;
        };

    MyConvert: X11SelectionOwner.RequestProc = {
        ls: Listener ~ NARROW[request.oh.ownershipData];
        c: Xl.Connection Ź ls.connection;
        BadFailure: PROC [n: NAT] = {
            request[n].response Ź $Failed
            };
        Report: PROC [n: NAT, what, why: Rope.ROPE] = {
            request[n].response Ź what;
            request[n].type Ź Xl.MakeAtom[c, why];
            };
        Handle: PROC [data: REF, n: NAT] = {
            WITH data SELECT FROM
                r: Rope.ROPE => {
                    out: Rope.ROPE Ź NIL; result: REF Ź NIL;
                    [out, result] Ź ProtectedDoCommandRope[ls.proc, r, ls.environment];
                    SELECT TRUE FROM
                        result=$Failure => Report[n, out, "FAIL"];
                        result=crashed => Report[n, out, "CRASH"];
                        ENDCASE => Report[n, out, "STRING"];
                    };
                ENDCASE => Report[n, "bad input", "PROTOCOL"];
            };
        FOR n: INT IN [0..request.length) DO
            SELECT request[n].target FROM
                ls.insertPropertyXAtom => {
                    ENABLE Xl.XError => {BadFailure[n]; GOTO oops};
                    property: Xl.XAtom Ź request[n].property;
                    w: Xl.Window Ź request.event.requestor;
                    pr: Xl.PropertyReturnRec Ź Xl.GetProperty[c: c, w: w, property: property, delete: TRUE];
                    Handle[pr.value, n];
                    EXITS oops => {};
                    };
                ls.insertSelectionXAtom => {
                    ENABLE Xl.XError => {BadFailure[n]; GOTO oops};
                    property: Xl.XAtom Ź request[n].property;
                    w: Xl.Window Ź request.event.requestor;
                    pr: Xl.PropertyReturnRec Ź Xl.GetProperty[c: c, w: w, property: property, delete: TRUE];
                    WITH pr.value SELECT FROM
                        ws: REF Xl.Card32Sequence => {
                            selection, target: Xl.XAtom;
                            IF pr.type#ls.atomPairXAtom THEN {
                                Report[n, "Not atompair", "PROTOCOL"]; GOTO oops
                                };
                            IF ws.leng#2 THEN {Report[n, "not 2", "PROTOCOL"]; GOTO oops};
                            selection Ź [ws[0]];
                            target Ź [ws[1]];
                            request.ownerData Ź ws; --to recognize if no value would be put there
                            X11SelectionRequestor.GetSelection[
                                c: c, selection: selection, timeStamp: Xl.currentTime<<request.event.timeStamp>>, 
                                request: [target: target, callback: InsertSelectionReceived, clientData: request]
                                ];
                            SELECT request.ownerData FROM 
                                ws => Report[n, "none", "PROTOCOL"]; --something went wrong in GetSelection
                                NIL => Report[n, "nil", "PROTOCOL"]; --GetSelection returned nil
                                ENDCASE => {
                                    WITH request.ownerData SELECT FROM
                                        lora: LIST OF REF ANY => {
                                            r: Rope.ROPE Ź ToRope[lora];
                                            IF r#NIL OR lora=NIL 
                                                THEN Handle[r, n] 
                                                ELSE Report[n, "list", "PROTOCOL"]; 
                                            };
                                        r: Rope.ROPE => Handle[r, n];
                                        a: ATOM => Report[n, Atom.GetPName[a], "PROTOCOL"];
                                        ENDCASE => Report[n, "wrong type", "PROTOCOL"];
                                    };
                            };
                        ENDCASE => Report[n, "bad parameters", "PROTOCOL"];
                    EXITS oops => {};
                    };
                ENDCASE => {
                    [] Ź X11SelectionOwner.FillSomeTargets[request, n, TRUE];
                    };
            ENDLOOP;
        };

    crashed: REF ATOM ~ NEW[ATOM Ź $Crashed];
    ProtectedDoCommandRope: PROC [proc: CommandProc, r: Rope.ROPE, environment: REF] RETURNS [out: Rope.ROPE Ź NIL, result: REF Ź NIL] 
    = {
        length: INT ~ Rope.Length[r];
        IF length>0 THEN { 
            SELECT Rope.Fetch[r, length-1] FROM
                Ascii.LF, Ascii.CR => {};
                ENDCASE => {r Ź Rope.Concat[r, "\n"]}; 
            };
        [out, result] Ź proc[in: r, environment: environment 
            ! RuntimeError.UNCAUGHT => {result Ź crashed; CONTINUE}
            ];
        };

    END.