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.