
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.

   ¾  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


 ‌تص  •NewlineDelimiter
–(cedarcode) styleک codeڑœ™Kڑœ
دeœ7™BK™,K™-K™ —ڑدk	œک
KڑœپکپKک —ڑدnœ‍œ‍ک Kڑ‍œXک_Kڑ‍œک—Kڑ‍œ‍کKک Kڑœ
‍œ‍œک!ڑœ‍œ‍œکKڑœ‍œ‍œ‍œک7Kڑœ‍œ‍œکKکKک$Kک%KکKڑœ‍œکKڑœ*‍œک.Kڑœ(‍œک,Kڑœ‍œکKڑœ‍œ‍œکKڑœ‍œکKڑœ
‍œ‍کKڑœک—Kک ڑں
œک Kک—Kک ڑںœ‍œ‍œ
‍œ‍œ"‍œ‍œ‍œ‍œ‍œ‍œ‍œ‍œ‍œ‍œکتڑ‍œکKڑœ6‍œکAKک—ڑںœ‍œ‍œک/Kڑœ‍œ1œ‍œکcKکMKڑœ‍œکKڑœک—ڑœ‍œک"KڑœکKڑœکKڑœکKڑœکKڑœکKڑœک—ڑ‍œ‍œکKڑ‍œ‍œکڑ‍œکڑ‍œ‍œ‍کڑœکKکKک—Kڑœ‍œک0Kڑ‍œ‍œک———KکAKکGKکIKک;Kڑœ9‍œ‍œکVKک1KڑœLکLKڑœAکAڑœ	‍œ*ک6KڑœکKڑœکKڑœکKڑœ‍œکKڑœ	‍œ'ک4Kڑœک—KکkKک>ڑ‍œ‍œکKڑœکKک+Kڑœک—Kڑ‍œکKڑœکK™ —ڑںœ‍œک(Kڑœ!ک!Kڑ‍œ‍œ#ک5KڑœکKک —ڑںœ/ک>Kڑœ‍œک(KکKڑœکKڑ‍œ‍œ‍œک#KڑœکKک —ڑںœ‍œ	‍œ‍œ‍œ‍œ‍œ
‍œ‍œکFڑ‍œ‍œ‍œ‍œ‍œ‍œ‍œ‍ک5ڑ‍œ	‍œ‍کKڑœ	‍œک(Kڑ‍œک—Kڑ‍œک—Kک—Kک ڑںœ1کHKڑœ-‍œک@ڑ‍œ‍کKک(Kک1Kک9Kڑ‍œ‍œک—Kک—Kک ڑں	œ#ک,Kڑœ‍œک0Kک!ڑں
œ‍œ‍œکKکKڑœک—ڑںœ‍œ‍œ‍œک/KکKک&Kڑœک—ڑںœ‍œ‍œ‍œک$ڑ‍œ‍œ‍کڑœ‍œکKڑ	œ
‍œ‍œ
‍œ‍œک(KکCڑ‍œ‍œ‍کKڑœ*ک*Kڑœ*ک*Kڑ‍œک$—Kک—Kڑ‍œ'ک.—Kک—ڑ‍œ‍œ‍œ‍ک$ڑ‍œ‍کڑœکKڑ‍œ‍œک/Kک)Kک'KڑœR‍œکXKڑœکKڑ‍œکKڑœک—ڑœکKڑ‍œ‍œک/Kک)Kک'KڑœR‍œکXڑ‍œ
‍œ‍کڑœ‍œکKڑœکڑ‍œ‍œک"Kڑœ'‍œک0Kڑœک—Kڑ‍œ‍œ"‍œک>KکKکKڑœدc-کEڑœ#ک#KڑœRکRKڑœQکQKڑœک—ڑ‍œ‍œکKڑœ% &کKKڑ‍œ" ک@ڑ‍œکڑ‍œ‍œ‍ک"ڑ	œ‍œ‍œ‍œ‍œکKڑœ‍œکڑ‍œ‍œ‍œ‍œکKڑ‍œکKڑ‍œ ک$—Kک—Kڑœ‍œکKڑœ‍œ,ک3Kڑ‍œ(ک/—Kک——Kک—Kڑ‍œ œک3—Kڑ‍œکKڑœک—ڑ‍œکKڑœ3‍œک9Kڑœک——Kڑ‍œک—KڑœکKک —Kڑ	œ	‍œ‍œ‍œ‍œک)ڑںœ‍œ‍œ‍œ‍œ‍œ‍œ
‍œ‍œک†Kڑœ‍œکڑ‍œ
‍œکڑ‍œ‍ک#Kڑœ‍œ‍œکKڑ‍œ ک'—Kک—ک5Kڑœ‍œ‍œک7Kڑœک—Kک—Kک Kڑ‍œکKک — …—    ؛  "M  