X11SelectionsTest.mesa
Copyright Ó 1990, 1991, 1992 by Xerox Corporation. All rights reserved.
Christian Jacobi, March 21, 1991 4:04 pm PST
Christian Jacobi, December 9, 1991 10:36 am PST
Willie-s, January 17, 1992 12:03 pm PST
DIRECTORY Commander, IO, Process, Rope, Xl, X11SelectionOwner, X11SelectionRequestor, XTkWidgets;
X11SelectionsTest: CEDAR PROGRAM
IMPORTS Commander, IO, Process, Rope, Xl, X11SelectionOwner, X11SelectionRequestor, XTkWidgets ~
BEGIN
debugHelp: Instance;
Instance: TYPE = REF InstanceRec;
InstanceRec: TYPE = RECORD [
shell: XTkWidgets.Widget,
logWidget: XTkWidgets.Widget,
lastValue: Rope.ROPE ¬ NIL,
poh: X11SelectionOwner.OwnershipHandle ¬ NIL,
coh: X11SelectionOwner.OwnershipHandle ¬ NIL,
log: IO.STREAM ¬ NIL
];
clipBoardOwner: X11SelectionOwner.ApplicationClass ¬ NEW[X11SelectionOwner.ApplicationClassRec ¬ [
selection: "CLIPBOARD",
convert: MyConvert,
done: MyDone,
gotOnwership: MyGotOwnership,
lostOwnership: MyLostOwnership
]];
primaryOwner: X11SelectionOwner.ApplicationClass ¬ NEW[X11SelectionOwner.ApplicationClassRec ¬ [
selection: "PRIMARY",
convert: MyConvert,
done: MyDone,
gotOnwership: MyGotOwnership,
lostOwnership: MyLostOwnership
]];
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;
};
CheckedPutRope: PROC[out: IO.STREAM, r: Rope.ROPE] = {
l: INT ¬ Rope.Length[r];
IF l<2000
THEN IO.PutRope[out, r]
ELSE {IO.PutF1[out, "too long; length: %g", IO.int[l]]};
};
GetReceive: X11SelectionRequestor.SelectionReceivedProc = {
i: Instance ¬ NARROW[clientData];
c: Xl.Connection ¬ i.shell.connection;
rope: Rope.ROPE;
IO.PutF1[i.log, "selection: %g\n", IO.rope[Xl.GetAtomName[c, selection]]];
IO.PutF1[i.log, "target: %g\n", IO.rope[Xl.GetAtomName[c, target]]];
IO.PutF1[i.log, "type: %g\n", IO.rope[Xl.GetAtomName[c, type]]];
SELECT result FROM
ok =>  IO.PutRope[i.log, "ok => "];
none =>  IO.PutRope[i.log, "none => "];
timeout =>  IO.PutRope[i.log, "timeout => "];
ENDCASE => ERROR;
IF Xl.MakeAtom[c, "TIMESTAMP"]=target
THEN {
rope ¬ "time: unknown";
IF value#NIL THEN {
WITH value.first SELECT FROM
s32: REF Xl.Card32Sequence => IF s32.leng=1 THEN {
rope ¬ IO.PutFR1["time: %g", IO.card[s32[0]]];
};
ENDCASE => {};
};
}
ELSE rope ¬ ToRope[value];
CheckedPutRope[i.log, rope];
IO.PutRope[i.log, "\n"];
i.lastValue ¬ rope;
};
PutReceive: X11SelectionRequestor.SelectionReceivedProc = {
Same as GetReceive, except lastValue not set
i: Instance ¬ NARROW[clientData];
c: Xl.Connection ¬ i.shell.connection;
rope: Rope.ROPE;
IO.PutF1[i.log, "selection: %g\n", IO.rope[Xl.GetAtomName[c, selection]]];
IO.PutF1[i.log, "target: %g\n", IO.rope[Xl.GetAtomName[c, target]]];
IO.PutF1[i.log, "type: %g\n", IO.rope[Xl.GetAtomName[c, type]]];
SELECT result FROM
ok =>  IO.PutRope[i.log, "ok => "];
none =>  IO.PutRope[i.log, "none => "];
timeout =>  IO.PutRope[i.log, "timeout => "];
ENDCASE => ERROR;
rope ¬ ToRope[value];
CheckedPutRope[i.log, rope];
IO.PutRope[i.log, "\n"];
};
GetHit: XTkWidgets.ButtonHitProcType = {
c1: Xl.Connection ¬
IF newConnection THEN Xl.CreateConnection[":1.0", TRUE] ELSE widget.connection;
selection: Rope.ROPE ¬ NARROW[callData];
i: Instance ¬ NARROW[registerData];
t: Xl.TimeStamp ¬ EventTime[event];
target: Xl.XAtom ¬ Xl.MakeAtom[widget.connection, "STRING"];
IF t=Xl.currentTime THEN {IO.PutRope[i.log, "bad event type or time\n"]; RETURN};
IO.PutF1[i.log, "get-start (%g)\n", IO.rope[selection]];
X11SelectionRequestor.GetSelection[c: c1, selection: Xl.MakeAtom[i.shell.connection, selection], timeStamp: t,
request: [target: target, callback: GetReceive, clientData: i, setUp: NIL],
tq: NIL
];
IO.PutF1[i.log, "(%g)stop\n", IO.rope[selection]];
IF c1#widget.connection THEN {
Process.PauseMsec[2000];
Xl.CloseConnection[c1];
};
};
newConnection: BOOL ¬ FALSE;
Toggle: PROC [] = {
newConnection ¬ NOT newConnection
};
GetHitM: XTkWidgets.ButtonHitProcType = {
c1: Xl.Connection ¬
IF newConnection THEN Xl.CreateConnection[":1.0", TRUE] ELSE widget.connection;
selection: Rope.ROPE ¬ NARROW[callData];
i: Instance ¬ NARROW[registerData];
t: Xl.TimeStamp ¬ EventTime[event];
target: Xl.XAtom ¬ Xl.MakeAtom[widget.connection, "STRING"];
timeStamp: Xl.XAtom ¬ Xl.MakeAtom[widget.connection, "TIMESTAMP"];
IF t=Xl.currentTime THEN {IO.PutRope[i.log, "bad event type or time\n"]; RETURN};
IO.PutF1[i.log, "get-start (%g)\n", IO.rope[selection]];
X11SelectionRequestor.GetSelectionMultiple[c: c1, selection: Xl.MakeAtom[i.shell.connection, selection], timeStamp: t,
requests: LIST[
[target: target, callback: GetReceive, clientData: i, setUp: NIL],
[target: timeStamp, callback: GetReceive, clientData: i, setUp: NIL]
],
tq: NIL
];
IO.PutF1[i.log, "(%g)stop\n", IO.rope[selection]];
IF c1#widget.connection THEN {
Process.PauseMsec[2000];
Xl.CloseConnection[c1];
};
};
GetHitMM: XTkWidgets.ButtonHitProcType = {
c1: Xl.Connection ¬
IF newConnection THEN Xl.CreateConnection[":1.0", TRUE] ELSE widget.connection;
selection: Rope.ROPE ¬ NARROW[callData];
i: Instance ¬ NARROW[registerData];
t: Xl.TimeStamp ¬ EventTime[event];
target: Xl.XAtom ¬ Xl.MakeAtom[widget.connection, "STRING"];
timeStamp: Xl.XAtom ¬ Xl.MakeAtom[widget.connection, "TIMESTAMP"];
oops: Xl.XAtom ¬ Xl.MakeAtom[widget.connection, "OOPS"];
IF t=Xl.currentTime THEN {IO.PutRope[i.log, "bad event type or time\n"]; RETURN};
IO.PutF1[i.log, "get-start multiple with oops (%g)\n", IO.rope[selection]];
X11SelectionRequestor.GetSelectionMultiple[c: c1, selection: Xl.MakeAtom[i.shell.connection, selection], timeStamp: t,
requests: LIST[
[target: target, callback: GetReceive, clientData: i, setUp: NIL],
[target: oops, callback: GetReceive, clientData: i, setUp: NIL],
[target: timeStamp, callback: GetReceive, clientData: i, setUp: NIL]
],
tq: NIL
];
IO.PutF1[i.log, "(%g)stop\n", IO.rope[selection]];
IF c1#widget.connection THEN {
Process.PauseMsec[2000];
Xl.CloseConnection[c1];
};
};
GetHitT: XTkWidgets.ButtonHitProcType = {
c1: Xl.Connection ¬
IF newConnection THEN Xl.CreateConnection[":1.0", TRUE] ELSE widget.connection;
selection: Rope.ROPE ¬ NARROW[callData];
i: Instance ¬ NARROW[registerData];
t: Xl.TimeStamp ¬ EventTime[event];
target: Xl.XAtom ¬ Xl.MakeAtom[widget.connection, "TIMESTAMP"];
IF t=Xl.currentTime THEN {IO.PutRope[i.log, "bad event type or time\n"]; RETURN};
IO.PutF1[i.log, "get-timestamp-start (%g)\n", IO.rope[selection]];
X11SelectionRequestor.GetSelection[c: c1, selection: Xl.MakeAtom[i.shell.connection, selection], timeStamp: t,
request: [target: target, callback: GetReceive, clientData: i, setUp: NIL],
tq: NIL
];
IO.PutF1[i.log, "(%g)stop\n", IO.rope[selection]];
IF c1#widget.connection THEN {
Process.PauseMsec[2000];
Xl.CloseConnection[c1];
};
};
EventTime: PROC [event: Xl.Event] RETURNS [t: Xl.TimeStamp ¬ Xl.currentTime] = {
SELECT event.type FROM
buttonPress => t ¬ NARROW[event, Xl.ButtonPressEvent].timeStamp;
buttonRelease => t ¬ NARROW[event, Xl.ButtonReleaseEvent].timeStamp;
ENDCASE => {};
};
PutHit: XTkWidgets.ButtonHitProcType = {
i: Instance ¬ NARROW[registerData];
t: Xl.TimeStamp ¬ EventTime[event];
insertProp: Xl.XAtom ¬ Xl.MakeAtom[widget.connection, "INSERT←PROPERTY"];
IF t=Xl.currentTime THEN {IO.PutRope[i.log, "bad event type or time\n"]; RETURN};
IO.PutRope[i.log, "put-start\n"];
X11SelectionRequestor.GetSelection[c: widget.connection, timeStamp: t,
request: [target: insertProp, callback: PutReceive, clientData: i, setUp: PutSetUp],
tq: NIL
];
IO.PutRope[i.log, "stop\n"];
};
MyDone: X11SelectionOwner.RequestProc = {
i: Instance ¬ NARROW[request.oh.ownershipData];
IF request.anyFailed
THEN IO.PutF1[i.log, "callback %g some failed\n", IO.rope[request.oh.ac.selection]]
ELSE IO.PutF1[i.log, "callback %g done\n", IO.rope[request.oh.ac.selection]]
};
MyConvert: X11SelectionOwner.RequestProc = {
i: Instance ¬ NARROW[request.oh.ownershipData];
IO.PutF[i.log, "callback (%g) do %g conversion: ", IO.rope[request.oh.ac.selection], IO.int[request.length]];
FOR n: INT IN [0..request.length) DO
SELECT request[n].target FROM
Xl.MakeAtom[i.shell.connection, "TEXT"] => {
request[n].response ¬ Rope.Cat["<<", i.lastValue, ">>"];
request[n].type ¬ Xl.MakeAtom[i.shell.connection, "STRING"];
IO.PutRope[i.log, "TEXT\n"];
};
Xl.MakeAtom[i.shell.connection, "STRING"] => {
request[n].response ← Rope.Cat["<[", i.lastValue, "]>"];
Fixed temporarily
request[n].response ¬ i.lastValue;
request[n].type ¬ Xl.MakeAtom[i.shell.connection, "STRING"];
IO.PutRope[i.log, "STRING\n"];
};
Xl.MakeAtom[i.shell.connection, "LENGTH"] => {
request[n].response ¬ NEW[INT ¬ Rope.Length[i.lastValue]];
request[n].type ¬ Xl.MakeAtom[i.shell.connection, "INTEGER"];
IO.PutRope[i.log, "LENGTH\n"];
};
ENDCASE => {
r: Rope.ROPE ¬ Xl.GetAtomName[i.shell.connection, request[n].target];
request[n].response ¬ $Failed;
IO.PutF1[i.log, "target type %g, not handled\n", IO.rope[r]];
};
ENDLOOP;
};
MyGotOwnership: X11SelectionOwner.GotOwnershipNotifyProc = {
i: Instance ¬ NARROW[oh.ownershipData];
IO.PutF1[i.log, "callback %g got ownership\n", IO.rope[oh.ac.selection]]
};
MyLostOwnership: X11SelectionOwner.LostOwnershipNotifyProc = {
i: Instance ¬ NARROW[oh.ownershipData];
IO.PutF1[i.log, "callback %g lost ownership\n", IO.rope[oh.ac.selection]]
};
SetupOwner: PROC [i: Instance] = {
i.poh ¬ X11SelectionOwner.EstablishSelectionOwnerProtocol[w: i.logWidget, ac: primaryOwner, ownershipData: i];
i.coh ¬ X11SelectionOwner.EstablishSelectionOwnerProtocol[w: i.logWidget, ac: clipBoardOwner, ownershipData: i];
};
AquireOwner: XTkWidgets.ButtonHitProcType = {
selection: ATOM ¬ NARROW[callData];
i: Instance ¬ NARROW[registerData];
t: Xl.TimeStamp ¬ EventTime[event];
success: BOOL;
IO.PutF1[i.log, "start aquire (%g) ownership\n", IO.atom[selection]];
IF t=Xl.currentTime THEN {IO.PutRope[i.log, "bad event type or time\n"]; RETURN};
SELECT selection FROM
$primary => success ¬ X11SelectionOwner.AquireOwnership[i.poh, t];
$clipboard => success ¬ X11SelectionOwner.AquireOwnership[i.coh, t];
ENDCASE => ERROR;
IF success
THEN IO.PutF1[i.log, "aquired (%g) ownership\n", IO.atom[selection]]
ELSE IO.PutF1[i.log, "failed to aquire (%g) ownership\n", IO.atom[selection]];
};
LongProc: XTkWidgets.ButtonHitProcType = {
AllAs: PROC RETURNS [CHAR] = {RETURN ['a]};
i: Instance ¬ NARROW[registerData];
i.lastValue ¬ Rope.FromProc[90000, AllAs];
IO.PutRope[i.log, "very very long selection\n"];
};
PutSetUp: X11SelectionRequestor.SelectionSetupProc = {
i: Instance ¬ NARROW[clientData];
c: Xl.Connection ¬ i.shell.connection;
contents: Rope.ROPE ¬ Rope.Concat[i.lastValue, "\000"];
stringType: Xl.XAtom ¬ Xl.MakeAtom[c, "STRING"];
Xl.ChangeProperty[c: c, w: window, property: property, type: stringType, data: contents];
};
HRule: PROC[] RETURNS [XTkWidgets.Widget] = {
RETURN[ XTkWidgets.CreateRuler[widgetSpec: [geometry: [size: [-1, 1]]]] ]
};
X11SelectionsTestCommand: Commander.CommandProc ~ {
i: Instance ¬ debugHelp ¬ NEW[InstanceRec];
shell: XTkWidgets.Widget ¬ i.shell ¬ XTkWidgets.CreateShell[windowHeader: "X11 Selection test", className: $X11SelectionTester, standardMigration: TRUE];
logWidget: XTkWidgets.Widget ¬ i.logWidget ¬ XTkWidgets.CreateStreamWidget[widgetSpec: [geometry: [size: [400, 200]]]];
getPrimary: XTkWidgets.Widget ¬ XTkWidgets.CreateButton[
text: "get primary", hitProc: GetHit, registerData: i, callData: Rope.Flatten["PRIMARY"]
];
getClipboard: XTkWidgets.Widget ¬ XTkWidgets.CreateButton[
text: "get clipboard", hitProc: GetHit, registerData: i, callData: Rope.Flatten["CLIPBOARD"]
];
getPrimaryM: XTkWidgets.Widget ¬ XTkWidgets.CreateButton[
text: "get primary m", hitProc: GetHitM, registerData: i, callData: Rope.Flatten["PRIMARY"]
];
getPrimaryMM: XTkWidgets.Widget ¬ XTkWidgets.CreateButton[
text: "get primary m with nonsense", hitProc: GetHitMM, registerData: i, callData: Rope.Flatten["PRIMARY"]
];
getClipboardM: XTkWidgets.Widget ¬ XTkWidgets.CreateButton[
text: "get clipboard m", hitProc: GetHitM, registerData: i, callData: Rope.Flatten["CLIPBOARD"]
];
getPrimaryT: XTkWidgets.Widget ¬ XTkWidgets.CreateButton[
text: "get PRIMARY time", hitProc: GetHitT, registerData: i, callData: Rope.Flatten["PRIMARY"]
];
getClipboardT: XTkWidgets.Widget ¬ XTkWidgets.CreateButton[
text: "get clipboard time", hitProc: GetHitT, registerData: i, callData: Rope.Flatten["CLIPBOARD"]
];
put: XTkWidgets.Widget ¬ XTkWidgets.CreateButton[
text: "put selection", hitProc: PutHit, registerData: i
];
aquireClipboard: XTkWidgets.Widget ¬ XTkWidgets.CreateButton[
text: "aquire clipboard ownership", hitProc: AquireOwner, registerData: i, callData: $clipboard
];
aquirePrimary: XTkWidgets.Widget ¬ XTkWidgets.CreateButton[
text: "aquire primary ownership", hitProc: AquireOwner, registerData: i, callData: $primary
];
looong: XTkWidgets.Widget ¬ XTkWidgets.CreateButton[
text: "own long selection", hitProc: LongProc, registerData: i
];
contents: XTkWidgets.Widget ¬ XTkWidgets.CreateYStack[[], LIST[getPrimary, HRule[], getClipboard, HRule[], getPrimaryM, HRule[], getClipboardM, HRule[], getPrimaryT, HRule[], getClipboardT, HRule[], getPrimaryMM, HRule[], put, HRule[], aquirePrimary, HRule[], aquireClipboard, HRule[], looong, HRule[], logWidget]];
XTkWidgets.SetShellChild[shell, contents];
i.log ¬ XTkWidgets.CreateStream[logWidget];
XTkWidgets.RealizeShell[shell];
SetupOwner[i];
};
Commander.Register["X11SelectionsTest", X11SelectionsTestCommand, "Open a X11SelectionTester widget"];
END.