<<>>
    <<X11SelectionsCuttingImpl.mesa>>
        <<Copyright Ó 1991, 1992, 1993 by Xerox Corporation.  All rights reserved.>>
        <<Christian Jacobi, March 21, 1991 10:07 am PST>>
        <<Christian Jacobi, February 12, 1993 1:03 pm PST>>
        <<>>
        <<This module uses the ICCCM selection and clipboard conventions to implement improved cut and paste.  It registers those 
        procedures with XlCutBuffersBackdoor.>>

    DIRECTORY 
        Atom, Rope, X11SelectionOwner, X11SelectionRequestor, Xl, XlCutBuffers, XlCutBuffersBackdoor, XlPredefinedAtoms, XTk, 
        XTkShellWidgets;

    X11SelectionsCuttingImpl: CEDAR MONITOR
        IMPORTS Rope, X11SelectionOwner, X11SelectionRequestor, Xl, XlCutBuffers, XlCutBuffersBackdoor, XTkShellWidgets
    ~ BEGIN OPEN Atom, Xl, XlCutBuffers, XlCutBuffersBackdoor;

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

    GetReceive: X11SelectionRequestor.SelectionReceivedProc = {
        container: REF Rope.ROPE ~ NARROW[clientData];
        IF result=ok THEN container­ Ź ToRope[value];
        };

    GetPrimary: PROC [c: Connection, convention: ATOM Ź NIL] RETURNS [Rope.ROPE] = {
        container: REF Rope.ROPE ~ NEW[ROPE Ź NIL];
        X11SelectionRequestor.GetSelection[c: c, selection: XlPredefinedAtoms.primary, timeStamp: Xl.currentTime, 
            request: [target: XlPredefinedAtoms.string, callback: GetReceive, clientData: container, setUp: NIL],
            tq: NIL
            ];
        RETURN [container­];
        };

    GetClipboard: PROC [c: Connection, convention: ATOM Ź NIL] RETURNS [Rope.ROPE] = {
        cd: ConnectionData ~ GetConnectionData[c];
        container: REF Rope.ROPE ~ NEW[ROPEŹNIL];
        X11SelectionRequestor.GetSelection[c: c, selection: cd.clipboardXatom, timeStamp: Xl.currentTime, 
            request: [target: XlPredefinedAtoms.string, callback: GetReceive, clientData: container, setUp: NIL],
            tq: NIL
            ];
        RETURN [container­];
        };

    GetHWR: PROC [c: Connection, convention: ATOM Ź NIL] RETURNS [Rope.ROPE] = {
        container: REF Rope.ROPE ~ NEW[ROPEŹNIL];
        key: Xl.XAtom Ź Xl.MakeAtom[c, "PARC_HWR_SELECTION"];
        X11SelectionRequestor.GetSelection[c: c, selection: key, timeStamp: Xl.currentTime, 
            request: [target: XlPredefinedAtoms.string, callback: GetReceive, clientData: container, setUp: NIL],
            tq: NIL
            ];
        RETURN [container­];
        };

    ConnectionData: TYPE = REF ConnectionDataRec;
    ConnectionDataRec: TYPE = RECORD [
        connection: Xl.Connection,
        poh: X11SelectionOwner.OwnershipHandle Ź NIL,
        coh: X11SelectionOwner.OwnershipHandle Ź NIL,
        hwrOh: X11SelectionOwner.OwnershipHandle Ź NIL,
        pValue: Rope.ROPE Ź NIL,
        cValue: Rope.ROPE Ź NIL,
        hwrValue: Rope.ROPE Ź NIL,
        dummyWidget: XTk.Widget,
        lengthXAtom: XAtom Ź [0],
        textXAtom: XAtom Ź [0],
        clipboardXatom: XAtom Ź [0]
        ];

    myPropertyKey: REF ATOM Ź NEW[ATOM Ź $selections];
    cachedConnectionData: ConnectionData Ź NEW[ConnectionDataRec];

    GetConnectionData: PROC [c: Xl.Connection] RETURNS [ConnectionData] = {
        <<--Return cached (or eventually created) per connection data>>
        cd: ConnectionData Ź cachedConnectionData;
        IF cd.connection=c THEN RETURN [cd];
        cachedConnectionData Ź cd Ź NARROW[Xl.GetConnectionPropAndInit[c, myPropertyKey, InitConnection]];
        RETURN [cd];
        };

    InitConnection: Xl.InitializeProcType = {
        <<--Initializes the per connection data>>
        cd: ConnectionData Ź NEW[ConnectionDataRec Ź [connection: c]];
        InitCD[cd]; 
        RETURN [cd]
        };

    InitCD: PROC [cd: ConnectionData] = {
        c: Xl.Connection ~ cd.connection;
        dummyShell: XTk.Widget Ź XTkShellWidgets.CreateShell[deletionProtocol: FALSE, focusProtocol: FALSE];
        dummyShell.attributes.overrideRedirect Ź true;
        XTkShellWidgets.BindScreenShell[dummyShell, c];
        cd.clipboardXatom Ź Xl.MakeAtom[c, "CLIPBOARD"];
        cd.lengthXAtom Ź Xl.MakeAtom[c, "LENGTH"];
        cd.textXAtom Ź Xl.MakeAtom[c, "TEXT"];
        XTkShellWidgets.RealizeShell[shell: dummyShell, mapping: unmapped];
        Xl.DecRefCount[c, dummyShell];
        cd.poh Ź X11SelectionOwner.EstablishSelectionOwnerProtocol[w: dummyShell, ac: primaryOwner, ownershipData: cd];
        cd.coh Ź X11SelectionOwner.EstablishSelectionOwnerProtocol[w: dummyShell, ac: clipboardOwner, ownershipData: cd];
        cd.hwrOh Ź X11SelectionOwner.EstablishSelectionOwnerProtocol[w: dummyShell, ac: hwrOwner, ownershipData: cd];
        cd.dummyWidget Ź dummyShell;
        };

    primaryOwner: X11SelectionOwner.ApplicationClass Ź NEW[X11SelectionOwner.ApplicationClassRec Ź [
        selection: "PRIMARY",
        convert: MyConvert,
        classData: $PRIMARY,
        targets: LIST["LENGTH", "TEXT", "STRING"],
        checkTime: FALSE
        ]];

    clipboardOwner: X11SelectionOwner.ApplicationClass Ź NEW[X11SelectionOwner.ApplicationClassRec Ź [
        selection: "CLIPBOARD",
        convert: MyConvert,
        classData: $CLIPBOARD,
        targets: primaryOwner.targets,
        checkTime: FALSE
        ]];

    hwrOwner: X11SelectionOwner.ApplicationClass Ź NEW[X11SelectionOwner.ApplicationClassRec Ź [
        selection: "PARC_HWR_SELECTION",
        convert: MyConvert,
        classData: $HWR,
        targets: LIST["LENGTH", "TEXT", "STRING"],
        checkTime: FALSE
        ]];

    MyConvert: X11SelectionOwner.RequestProc = {
        cd: ConnectionData ~ NARROW[request.oh.ownershipData];
        c: Xl.Connection Ź cd.connection;
        value: Rope.ROPE Ź SELECT request.oh.ac.classData FROM
            $PRIMARY => cd.pValue,
            $CLIPBOARD => cd.cValue,
            $HWR => cd.hwrValue
            ENDCASE => NIL;
        FOR n: INT IN [0..request.length) DO
            SELECT request[n].target FROM
                XlPredefinedAtoms.string => {
                    request[n].response Ź value;
                    request[n].type Ź XlPredefinedAtoms.string;
                    };
                cd.lengthXAtom => {
                    request[n].response Ź NEW[INT32 Ź Rope.Length[value]];
                    request[n].type Ź XlPredefinedAtoms.integer;
                    };
                cd.textXAtom => {
                    request[n].response Ź value;
                    request[n].type Ź XlPredefinedAtoms.string;
                    };
                ENDCASE => {
                    [] Ź X11SelectionOwner.FillSomeTargets[request, n, TRUE];
                    };
            ENDLOOP;
        };

    PrimaryPut: PROC [c: Connection, data: ROPE, convention: ATOM Ź NIL] = {
        cd: ConnectionData Ź GetConnectionData[c];
        cd.pValue Ź data;
        [] Ź X11SelectionOwner.AquireOwnership[cd.poh, Xl.LastTime[c]];
        };

    ClipboardPut: PROC [c: Connection, data: ROPE, convention: ATOM Ź NIL] = {
        cd: ConnectionData Ź GetConnectionData[c];
        cd.cValue Ź data;
        [] Ź X11SelectionOwner.AquireOwnership[cd.coh, Xl.LastTime[c]];
        };

    HWRPut: PROC [c: Connection, data: ROPE, convention: ATOM Ź NIL] = {
        cd: ConnectionData Ź GetConnectionData[c];
        cd.hwrValue Ź data;
        [] Ź X11SelectionOwner.AquireOwnership[cd.hwrOh, Xl.LastTime[c]];
        };

    DefaultGet: PROC [c: Connection, convention: ATOM Ź NIL] RETURNS [r: Rope.ROPE] = {
        r Ź XlCutBuffers.Get[c, $PRIMARY];
        IF Rope.IsEmpty[r] THEN r Ź XlCutBuffers.Get[c, $CLIPBOARD];
        IF Rope.IsEmpty[r] THEN r Ź XlCutBuffers.Get[c, $CutBuffer0];
        };

    DefaultPut: PROC [c: Connection, data: ROPE, convention: ATOM Ź NIL] = {
        XlCutBuffers.Put[c, data, $CutBuffer0];
        XlCutBuffers.Put[c, data, $PRIMARY];
        XlCutBuffers.Put[c, data, $CLIPBOARD];
        };

    XlCutBuffersBackdoor.RegisterGetProc[$PRIMARY, GetPrimary];
    XlCutBuffersBackdoor.RegisterGetProc[$CLIPBOARD, GetClipboard];
    XlCutBuffersBackdoor.RegisterGetProc[$Handwriting, GetHWR];
    XlCutBuffersBackdoor.RegisterGetProc[NIL, DefaultGet];
    XlCutBuffersBackdoor.RegisterPutProc[$PRIMARY, PrimaryPut];
    XlCutBuffersBackdoor.RegisterPutProc[$CLIPBOARD, ClipboardPut];
    XlCutBuffersBackdoor.RegisterPutProc[$Handwriting, HWRPut];
    XlCutBuffersBackdoor.RegisterPutProc[NIL, DefaultPut];
    END.