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.