<> <> <> <> <<>> DIRECTORY Rope, RopeList, Xl, XlDispatch, XlPredefinedAtoms, XlTQOps, X11SelectionOwner, X11SelectionOwnerPrivate, X11SelectionPrivate, XTk; X11SelectionOwnerImpl: CEDAR MONITOR IMPORTS RopeList, X11SelectionPrivate, Xl, XlDispatch, XlTQOps, XTk EXPORTS X11SelectionOwner ~ BEGIN OPEN X11SelectionOwner, X11SelectionOwnerPrivate, X11SelectionPrivate; <<>> <> <> <> <<------------------>> IgnoreErrors: Xl.EventProcType = {}; detailsForSynchronous: Xl.Details ~ NEW[Xl.DetailsRec ¬ [synchronous: TRUE]]; detailsForIgnoreErrors: Xl.Details ~ NEW[Xl.DetailsRec ¬ [errorMatch: NEW[Xl.MatchRep ¬ [proc: IgnoreErrors, handles: NIL, tq: Xl.CreateTQ[]]]]]; propertyNotifyEvents: Xl.EventFilter ~ Xl.CreateEventFilter[propertyNotify]; selectionEvents: Xl.EventFilter ~ Xl.CreateEventFilter[selectionRequest, selectionClear]; myPropertyKey: REF ~ NEW[INT]; WidgetOData: TYPE = REF WidgetODataRec; --per Widget selection Owner Data (for all selections) WidgetODataRec: PUBLIC TYPE = X11SelectionOwnerPrivate.ImplWidgetODataRec; GetWidgetOData: PROC [w: XTk.Widget] RETURNS [wod: WidgetOData] = { EntryGetWidgetOData: ENTRY PROC [w: XTk.Widget] RETURNS [wod: WidgetOData] = { WITH XTk.GetWidgetProp[w, myPropertyKey] SELECT FROM ok: WidgetOData => wod ¬ ok; ENDCASE => { wod ¬ NEW[WidgetODataRec]; XTk.PutWidgetProp[w, myPropertyKey, wod]; }; }; WITH XTk.GetWidgetProp[w, myPropertyKey] SELECT FROM ok: WidgetOData => wod ¬ ok; ENDCASE => wod ¬ EntryGetWidgetOData[w]; IF wod.cd=NIL OR wod.cd.connection#w.connection THEN { c: Xl.Connection ¬ w.connection; IF Xl.Alive[c] THEN wod.cd ¬ GetConnectionData[c]; }; }; AssertServiceMatch: ENTRY PROC [wod: WidgetOData, w: XTk.Widget] = { IF ~wod.matchEstablished THEN { wod.matchEstablished ¬ TRUE; IF wod.serviceTQ=NIL THEN wod.serviceTQ ¬ Xl.CreateTQ[]; XTk.AddPermanentMatch[w, [proc: ServiceEventProc, handles: selectionEvents, tq: wod.serviceTQ, data: wod]]; XTk.RegisterNotifier[w, XTk.bindScreenKey, BindScreen, wod]; }; }; BindScreen: XTk.WidgetNotifyProc = { wod: WidgetOData ~ NARROW[registerData]; FOR list: LIST OF OwnershipHandle ¬ wod.selections, list.rest WHILE list#NIL DO list.first.selection ¬ Xl.MakeAtom[widget.connection, list.first.ac.selection]; ENDLOOP; }; PreEstablishServiceTQ: PUBLIC PROC [w: XTk.Widget, serviceTQ: Xl.TQ ¬ NIL] = { <> <> <> wod: WidgetOData ~ GetWidgetOData[w]; IF wod.serviceTQ=NIL THEN { IF serviceTQ=NIL THEN serviceTQ ¬ Xl.CreateTQ[]; wod.serviceTQ ¬ serviceTQ; AssertServiceMatch[wod, w] }; }; GetOwnership: PROC [wod: WidgetOData, selection: Xl.XAtom] RETURNS [OwnershipHandle ¬ NIL] = { FOR list: LIST OF OwnershipHandle ¬ wod.selections, list.rest WHILE list#NIL DO IF list.first.selection=selection THEN RETURN [list.first]; ENDLOOP; }; AppendOwnership: ENTRY PROC [wod: WidgetOData, oh: OwnershipHandle] RETURNS [error: BOOL ¬ FALSE] = { <<--Careful ordering: GetOwnership is not monitored for speed>> newTail: LIST OF OwnershipHandle ~ LIST[oh]; p: LIST OF OwnershipHandle ¬ wod.selections; IF p=NIL THEN {wod.selections ¬ newTail; RETURN}; DO <<--Assert: p#NIL>> IF p.first.selection=oh.selection THEN RETURN [error¬TRUE]; IF p.rest=NIL THEN {p.rest ¬ newTail; RETURN}; p ¬ p.rest; ENDLOOP; }; RemoveOwnership: ENTRY PROC [wod: WidgetOData, oh: OwnershipHandle] = { IF wod.selections=NIL THEN RETURN; IF wod.selections.first=oh THEN {wod.selections ¬ wod.selections.rest; RETURN}; FOR l: LIST OF OwnershipHandle ¬ wod.selections, l.rest WHILE l#NIL AND l.rest#NIL DO IF l.rest.first=oh THEN {l.rest ¬ l.rest.rest; RETURN}; ENDLOOP }; AcknowledgeConversion: PROC [e: Xl.SelectionRequestEvent, property: Xl.XAtom] RETURNS [failed: BOOL ¬ FALSE] = INLINE { <<--send acknowledging SendSelectionNotifyEvent; use only if no event handlers need un-registration>> <<--careful about catching errors; this is not our window; it could have been destroyed>> Xl.SendSelectionNotifyEvent[c: e.connection, destination: e.requestor, selection: e.selection, target: e.target, property: property, timeStamp: e.timeStamp, details: detailsForSynchronous ! Xl.XError => {failed ¬ TRUE; CONTINUE}]; }; RefuseConversion: PROC [e: Xl.SelectionRequestEvent] = { <<--send denying SendSelectionNotifyEvent; use only if no event handlers need un-registration>> [] ¬ AcknowledgeConversion[e, [0]]; }; ReleaseConversion: --transferTQ-- PROC [r: Request, success: BOOL] = { <<--unregisters event handlers and send final SendSelectionNotifyEvent>> IF ~Xl.Alive[r.event.connection] THEN RETURN; IF r.transferMatch#NIL THEN XlDispatch.RemoveMatch[c: r.event.connection, w: r.event.requestor, match: r.transferMatch, details: detailsForIgnoreErrors <>]; IF success THEN success ¬ ~AcknowledgeConversion[r.event, r.event.property] ELSE RefuseConversion[r.event]; IF ~success THEN r.anyFailed ¬ TRUE; r.timeOutData ¬ $allDone; IF r.oh.sharedTransferTQ#NIL --so transferTQ is shared-- THEN { RemoveServicing[r]; FOR n: Request ¬ r.next, n.next WHILE n#NIL DO IF n.event.requestor=r.event.requestor AND n.isDelayed THEN { n.isDelayed ¬ FALSE; [] ¬ WakeUp[n]; }; ENDLOOP }; }; FindTargetIdx: PROC [r: Request, property: Xl.XAtom] RETURNS [idx: INT ¬ -1] = { FOR i: NAT IN [0..r.length) DO IF r[i].property=property THEN RETURN [i]; ENDLOOP }; PropertyDeletedEvent: --transferTQ-- Xl.EventProcType = { <<--requestor acknowledges by deleting property>> WITH event SELECT FROM e: Xl.PropertyNotifyEvent => { WITH clientData SELECT FROM r: Request => { idx: INT ~ FindTargetIdx[r, e.atom]; IF idx>=0 AND idx=r.index THEN [] ¬ WakeUp[r]; }; ENDCASE => {}; }; ENDCASE => {}; }; TimeoutCheckEvent: --transferTQ-- Xl.EventProcType = { <<--Called when the time ticks. Use right transferTQ to protect r.timeOutData and for reporting timeout. >> r: Request ~ NARROW[clientData]; SELECT r.timeOutData FROM $reset => { <<--Start new timeslice, as we didn't know when in the last timeslice was started.>> r.timeOutData ¬ $alert; XlTQOps.EnqueueSoon[ms: r.oh.timeoutMsec, tq: tq --is transferTQ--, proc: TimeoutCheckEvent, data: r, event: event]; }; $alert => { <<--A whole timeslice was inactive; do the timing out.>> ReleaseConversion[r, FALSE]; IF r.oh.ac.done#NIL THEN r.oh.ac.done[r]; }; ENDCASE => {--e.g. after a timeout--}; }; EnqueueOrCall: PROC [selfTQ, callTQ: Xl.TQ, proc: Xl.EventProcType, data: REF ¬ NIL, event: Xl.Event ¬ NIL] = INLINE { IF selfTQ=callTQ THEN proc[event, data, callTQ] ELSE Xl.Enqueue[callTQ, proc, data, event] }; ServiceEventProc: --serviceTQ-- Xl.EventProcType = { <<--Received a request; initiate handling it.>> wod: WidgetOData ~ NARROW[clientData]; WITH event SELECT FROM e: Xl.SelectionRequestEvent => { oh: OwnershipHandle ~ GetOwnership[wod, e.selection]; IF oh#NIL --otherwise not ours-- THEN { transferTQ: Xl.TQ ¬ NIL; getTransferTQ: GetTQProc ~ oh.ac.getTransferTQ; IF getTransferTQ#NIL THEN transferTQ ¬ getTransferTQ[oh, e]; IF transferTQ=NIL THEN { transferTQ ¬ oh.sharedTransferTQ; IF transferTQ=NIL THEN transferTQ ¬ Xl.CreateTQ[]; }; EnqueueOrCall[tq, transferTQ, StartConversion, oh, e]; }; }; e: Xl.SelectionClearEvent => { oh: OwnershipHandle ~ GetOwnership[wod, e.selection]; IF oh#NIL --otherwise not ours-- THEN { EnqueueOrCall[tq, oh.initiateTQ, NotifyLostOwnership, oh, e]; }; }; ENDCASE => {}; }; EnqueueServicing: --shared transferTQ-- PROC [r: Request] = { <<--Enqueue this request into queue of requests currently in works... >> <<--Set delay if conflicting request is in progreass >> tail: Request ¬ r.oh.serviceQueue; IF tail=NIL THEN r.oh.serviceQueue ¬ r ELSE { IF tail.event.requestor=r.event.requestor THEN r.isDelayed ¬ TRUE; WHILE tail.next#NIL DO tail ¬ tail.next; IF tail.event.requestor=r.event.requestor THEN r.isDelayed ¬ TRUE; ENDLOOP; tail.next ¬ r }; r.isInQueue ¬ TRUE; }; RemoveServicing: --shared transferTQ-- PROC [r: Request] = { <<--Remove this request from queue of requests currently in works... >> <<--If there was a conflicting request, continue its servicing >> front: Request ¬ r.oh.serviceQueue; IF front=r THEN r.oh.serviceQueue ¬ r.next ELSE { WHILE front.next#NIL DO IF front.next=r THEN { front.next ¬ r.next; ReviveDelayed[front.next, r.event.requestor]; RETURN }; front ¬ front.next; ENDLOOP; }; }; ReviveDelayed: --shared transferTQ-- PROC [front: Request, requestor: Xl.Window] = { <<--Checks queue for a request whose servicing ought to be continued and do it>> FOR r: Request ¬ front, r.next WHILE r#NIL DO IF r.isDelayed AND r.event.requestor=requestor THEN { <> <> <> <<[] _ WakeUp[r]; --possibly infinite tail recursion>> <> Xl.Enqueue[r.oh.sharedTransferTQ, DelayedTailRecursion, r, r.event]; RETURN; }; ENDLOOP }; DelayedTailRecursion: --shared transferTQ-- Xl.EventProcType = { r: Request ~ NARROW[clientData]; r.isDelayed ¬ FALSE; [] ¬ WakeUp[r]; }; StartConversion: Xl.EventProcType = { <<--Service the request >> <<--Use a per selection thread (transferTQ) to enable re-entrant calling on other selections or other requests>> oh: OwnershipHandle ~ NARROW[clientData]; e: Xl.SelectionRequestEvent ~ NARROW[event]; r: Request; failed, somefailed: BOOL ¬ FALSE; IF oh.ac.checkTime AND Xl.Period[from: oh.ownedSince, to: e.timeStamp]<0 AND oh.ownedSince#Xl.currentTime THEN { <<--See note about Xl.currentTime in NotifyLostOwnership>> RefuseConversion[e]; RETURN }; IF e.target=oh.wod.cd.multipleXAtom THEN { pr: Xl.PropertyReturnRec; IF e.property=XlPredefinedAtoms.nullNotAnAtom THEN { RefuseConversion[e]; RETURN }; pr ¬ Xl.GetProperty[c: e.connection, w: e.requestor, property: e.property ! Xl.XError => {failed ¬ TRUE; CONTINUE} ]; IF failed OR pr.format#32 OR pr.bytesAfter>0--nobody will do that-- THEN { RefuseConversion[e]; RETURN }; WITH pr.value SELECT FROM ms: REF Xl.Card32Sequence => { IF ms.leng MOD 2 # 0 THEN {RefuseConversion[e]; RETURN}; r ¬ NEW[RequestSequence[ms.leng / 2]]; r.multiSeq ¬ ms; FOR i: INT IN [0..r.length) DO r[i].target ¬ [ms[2*i]]; r[i].property ¬ [ms[2*i+1]]; r[i].num ¬ INT.LAST; ENDLOOP; }; ENDCASE => { RefuseConversion[e]; RETURN; }; } ELSE { property: Xl.XAtom ¬ e.property; IF property=XlPredefinedAtoms.nullNotAnAtom THEN { property ¬ e.target; IF property=XlPredefinedAtoms.nullNotAnAtom THEN { RefuseConversion[e]; RETURN; }; }; r ¬ NEW[RequestSequence[1]]; r[0].target ¬ e.target; r[0].property ¬ property; r[0].num ¬ INT.LAST; }; r.oh ¬ oh; r.event ¬ e; r.transferTQ ¬ tq; oh.ac.convert[r]; IF r.refuse OR (r.multiSeq=NIL AND r[0].response=$Failed) THEN { RefuseConversion[e]; RETURN; }; FOR i: NAT IN [0..r.length) DO IF r[i].response=$Failed THEN { somefailed ¬ TRUE; IF r.multiSeq#NIL THEN r.multiSeq[i*2+1] ¬ 0; r[i].remain ¬ 0; } ELSE { num: INT; [num, r[i].unit] ¬ Xl.XPropInfo[r[i].response]; r[i].remain ¬ MIN[num-r[i].start, r[i].num]; }; ENDLOOP; IF somefailed THEN { IF r.multiSeq=NIL THEN failed ¬ TRUE ELSE { <<--is it ok to do this before transmitting the real answers?>> Xl.ChangeProperty[c: e.connection, w: e.requestor, property: e.property, data: r.multiSeq, type: XlPredefinedAtoms.atom, details: detailsForSynchronous ! Xl.XError => {failed ¬ TRUE; CONTINUE;} ]; }; IF failed THEN {RefuseConversion[e]; RETURN}; }; <<--start funny loop transmittinmg real answers>> IF ~r.isInQueue AND r.oh.sharedTransferTQ#NIL THEN EnqueueServicing[r]; IF ~r.isDelayed THEN [] ¬ WakeUp[r]; }; WakeUp: --transferTQ-- PROC [r: Request] RETURNS [allDone: BOOL ¬ FALSE] = { <<--Funny loop; all loop control state is stored in r.>> cpMode: Xl.ChangePropertyMode ¬ replace; thisNum, thisStart: INT; response: REF; type: Xl.XAtom; e: Xl.SelectionRequestEvent ¬ r.event; idx: INT ¬ r.index; --expected index; but might be all done and need increment newStep: BOOL; --first time we visit index DO --until we find one which did not fail (? ICCCM doesn't really say what to do) newStep ¬ FALSE; SELECT TRUE FROM r.timeOutData=$timedOut => RETURN; idx<0 => { <<--synchrounous first call>> r.index ¬ idx ¬ 0; newStep ¬ TRUE; r.transferMatch ¬ NEW[Xl.MatchRep ¬ [ proc: PropertyDeletedEvent, handles: propertyNotifyEvents, tq: r.transferTQ, data: r ]]; XlDispatch.AddMatch[c: e.connection, w: e.requestor, match: r.transferMatch, generate: [propertyChange: TRUE <>]]; XlTQOps.EnqueueSoon[ms: r.oh.timeoutMsec, tq: r.transferTQ, proc: TimeoutCheckEvent, data: r, event: e]; }; idx { <<--called from an event (or previous response was failed)>> SELECT r[idx].state FROM $waitForAck => { r.index ¬ idx ¬ idx + 1; newStep ¬ TRUE; IF idx>=r.length THEN { ReleaseConversion[r, TRUE]; IF r.oh.ac.done#NIL THEN r.oh.ac.done[r]; allDone ¬ TRUE; RETURN }; }; $startIncr => cpMode ¬ replace; $continueIncr => cpMode ¬ append; ENDCASE => ERROR; }; ENDCASE => ERROR; response ¬ r[idx].response; IF response#$Failed THEN EXIT ELSE {--similar to $waitForAck r.index ¬ idx ¬ idx + 1; newStep ¬ TRUE; IF idx>=r.length THEN { ReleaseConversion[r, TRUE]; IF r.oh.ac.done#NIL THEN r.oh.ac.done[r]; allDone ¬ TRUE; RETURN }; }; ENDLOOP; type ¬ r[idx].type; thisNum ¬ MIN[r[idx].remain, 1000, Xl.Info[e.connection].maxRequestLength]; thisStart ¬ r[idx].next; IF newStep THEN { IF thisNum0 THEN { <<--start an incr>> cs: REF Xl.Card32Sequence ¬ response ¬ NEW[Xl.Card32Sequence[1]]; cs[0] ¬ r[idx].remain; r[idx].state ¬ $startIncr; thisNum ¬ 1; thisStart ¬ 0; type ¬ r.oh.wod.cd.incrXAtom; } ELSE { <<--use single request>> r[idx].state ¬ $waitForAck; }; } ELSE { <<--continue incr>> r[idx].next ¬ thisStart+thisNum; r[idx].remain ¬ r[idx].remain-thisNum; IF r[idx].remain<=0 THEN r[idx].state ¬ $waitForAck --note incr is terminated by appending zero bytes ELSE r[idx].state ¬ $continueIncr; }; Xl.ChangeProperty[c: e.connection, w: e.requestor, property: r[idx].property, type: type, mode: cpMode, data: response, start: thisStart, num: thisNum, details: detailsForIgnoreErrors--this is NOT our window-- <> < {ReleaseConversion[r, FALSE]; --?? ought to really report failure --GOTO oops}>> ]; r.timeOutData ¬ $reset; }; EstablishSelectionOwnerProtocol: PUBLIC PROC [w: XTk.Widget, ac: ApplicationClass, initiateTQ: Xl.TQ ¬ NIL, transferTQ: Xl.TQ ¬ NIL, ownershipData: REF ¬ NIL] RETURNS [oh: OwnershipHandle] = { <> c: Xl.Connection ~ w.connection; selection: Xl.XAtom ¬ [0]; wod: WidgetOData ~ GetWidgetOData[w]; IF Xl.Alive[c] THEN selection ¬ Xl.MakeAtom[c, ac.selection]; IF initiateTQ=NIL THEN { initiateTQ ¬ transferTQ; IF initiateTQ=NIL THEN initiateTQ ¬ Xl.CreateTQ[]; }; oh ¬ NEW[OwnershipRec ¬ [ ac: ac, initiateTQ: initiateTQ, sharedTransferTQ: transferTQ, w: w, selection: selection, timeoutMsec: ac.defaultTimeoutMsec, ownershipData: ownershipData, wod: wod ]]; PreEstablishServiceTQ[w, NIL]; IF AppendOwnership[wod, oh].error THEN ERROR; }; DeEstablishSelectionOwnerProtocol: PUBLIC PROC [oh: OwnershipHandle] = { w: XTk.Widget ¬ oh.w; wod: WidgetOData ~ GetWidgetOData[w]; RemoveOwnership[wod, oh]; }; ChangeTimeOut: PUBLIC PROC [oh: OwnershipHandle, timeoutMsec: INT] = { oh.timeoutMsec ¬ timeoutMsec }; NotifyLostOwnership: --initiateTQ-- Xl.EventProcType = { oh: OwnershipHandle ~ NARROW[clientData]; e: Xl.SelectionClearEvent ~ NARROW[event]; <<--We do not test "IF oh.iHaveIt THEN" for robustness reasons: if an errounous state happens, loosing the selection the next time will automatically put us into a correct state again. >> <<--We do let Xl.currentTime through: Some clients which don't use the connection for any other purpose as to state selection-ownership might not have a timeStamp when aquiring the selection (and Xl.LastTime might not have a reasonable value either). Those clients have to watch themself for race conditions. >> IF (Xl.Period[from: oh.ownedSince, to: e.timeStamp]>=0 OR oh.ownedSince=Xl.currentTime) AND e.owner=oh.w.window THEN { notify: LostOwnershipNotifyProc ¬ oh.ac.lostOwnership; previousTime: Xl.TimeStamp ¬ oh.ownedSince; oh.iHaveIt ¬ FALSE; IF notify#NIL THEN notify[oh: oh, timeStamp: e.timeStamp, event: e, previousTime: previousTime]; }; }; AquireOwnership: PUBLIC PROC [oh: OwnershipHandle, time: Xl.TimeStamp] RETURNS [success: BOOL ¬ FALSE] = { <<--Aquires active selection ownership. >> <<--OwnershipHandle must have been previously established. >> <<--Do not use Xl.currentTime. >> IF oh.w.state=realized AND oh.w.fastAccessAllowed=ok THEN { action: PROC = { window: Xl.Window; <<--Helpful X protocol twist: Noop in buggy situation of time in the future>> Xl.SetSelectionOwner[c: oh.w.connection, owner: oh.w.window, selection: oh.selection, time: time]; window ¬ Xl.GetSelectionOwner[oh.w.connection, oh.selection]; success ¬ window=oh.w.window; IF success THEN { notify: GotOwnershipNotifyProc ¬ oh.ac.gotOnwership; previouslyOwned: BOOL ¬ oh.iHaveIt; previousTime: Xl.TimeStamp ¬ oh.ownedSince; oh.iHaveIt ¬ TRUE; oh.ownedSince ¬ time; IF notify#NIL THEN notify[oh, time, previouslyOwned, previousTime]; } }; IF time=Xl.currentTime THEN time ¬ Xl.LastTime[oh.w.connection]; Xl.CallWithLock[tq: oh.initiateTQ, proc: action]; }; }; ReleaseOwnership: PUBLIC PROC [oh: OwnershipHandle, time: Xl.TimeStamp ¬ Xl.currentTime] = { <<--Voluntarily releases selection ownership.>> <<--OwnershipHandle must have been previously established>> IF oh.w.fastAccessAllowed#ok THEN RETURN; Xl.SetSelectionOwner[c: oh.w.connection, owner: Xl.nullWindow, selection: oh.selection, time: time] }; FillSomeTargets: PUBLIC PROC [request: Request, targetIdx: NAT, assignFailed: BOOL ¬ FALSE] RETURNS [success: BOOL ¬ TRUE] = { wod: WidgetOData ~ request.oh.wod; cd: X11SelectionPrivate.ConnectionData ~ wod.cd; SELECT request[targetIdx].target FROM cd.timeStampXAtom => { t: Xl.TimeStamp ~ request.oh.ownedSince; request[targetIdx].response ¬ NEW[CARD32 ¬ t]; request[targetIdx].type ¬ XlPredefinedAtoms.integer; }; cd.targetsXAtom => { ConsIfMissing: PROC [r: Rope.ROPE, list: LIST OF Rope.ROPE] RETURNS [LIST OF Rope.ROPE] = { IF ~RopeList.Memb[list, r] THEN list ¬ RopeList.Cons[list, r]; RETURN [list]; }; count: INT; n: NAT ¬ 0; targetSeq: REF Xl.Card32Sequence; list: LIST OF Rope.ROPE ¬ request.oh.ac.targets; list ¬ ConsIfMissing["TARGETS", list]; list ¬ ConsIfMissing["MULTIPLE", list]; list ¬ ConsIfMissing["TIMESTAMP", list]; count ¬ RopeList.Length[list]; targetSeq ¬ NEW[Xl.Card32Sequence[count]]; FOR l: LIST OF Rope.ROPE ¬ list, l.rest WHILE l#NIL AND n { success ¬ FALSE; IF assignFailed THEN request[targetIdx].response ¬ $Failed; }; }; END.