<<>> <> <> <> <> <<>> DIRECTORY Basics, CardTab, Xl, XlDetails, XlDispatch, XlExtensions, XlRecycleMotionEvents, XlPrivate, XlPrivateResources; XlDispatchImpl: CEDAR MONITOR IMPORTS Basics, CardTab, Xl, XlDetails, XlPrivate, XlPrivateResources EXPORTS Xl, XlDispatch, XlRecycleMotionEvents SHARES XlPrivate, XlPrivateResources ~ BEGIN OPEN Xl, XlPrivate; DispatchHandle: TYPE = REF DispatchHandleRec; DispatchHandleRec: <>PUBLIC TYPE = RECORD [ wDataTab: CardTab.Ref ¬ NIL, priviledgeds: DispatchList ¬ NIL, junkies: REF DispatchList ¬ NIL, --REF to make type intersting only... cache: REF XlRecycleMotionEvents.EventCache ]; DispatchStuffRep: <>PUBLIC TYPE = DispatchHandleRec; DispatchList: TYPE = REF DispatchListRep; DispatchListRep: TYPE = RECORD [ currLength: NAT ¬ 0, s: SEQUENCE maxLength: NAT OF DispatchRec ]; DispatchRec: TYPE = RECORD [activate: EventCodes, tq: TQ, proc: EventProcType, data: REF, activateExtensions: LIST OF REF ¬ NIL, events: SetOfEvent ¬ unspecifiedEvents]; WindowData: TYPE = REF WindowDataRec; WindowDataRec: PUBLIC TYPE = RECORD [ <> dl: DispatchList ¬ NIL, externalEvents: SetOfEvent ¬ unspecifiedEvents, --best guess on what external clients want <> actualEvents: SetOfEvent ¬ unspecifiedEvents --believed server settings ]; NotYetDefined: EventProcType = {--prevent trapping if called before initialized--}; ProcRemoved: EventProcType = {--prevent trapping if called after removal--}; dummy: REF XlRecycleMotionEvents.EventCache ¬ NEW[XlRecycleMotionEvents.EventCache]; GetCache: <>PUBLIC PROC [c: Xl.Connection, w: Xl.Window] RETURNS [cache: REF XlRecycleMotionEvents.EventCache ¬ dummy] = { h: DispatchHandle ¬ GetDispatchHandle[c]; IF Xl.WindowId[w]=CARD.LAST THEN RETURN [h.cache]; --sentinell for allocator WITH CardTab.Fetch[h.wDataTab, w.id].val SELECT FROM wd: WindowData => { dl: DispatchList ¬ wd.dl; IF dl#NIL THEN { count: INT ¬ 0; FOR i: NAT IN [0..dl.currLength) DO IF dl[i].activate[motionNotify] THEN count ¬ count+1 ENDLOOP; IF count=1 THEN cache ¬ h.cache }; }; ENDCASE => {}; }; GetDispatchHandle: PUBLIC PROC [c: Connection] RETURNS [DispatchHandle] = { RETURN [c.dispatchStuff] }; InlineDispatch: PROC [handle: DispatchHandle, event: Event] = INLINE { WITH CardTab.Fetch[handle.wDataTab, event.dispatchDrawable.id].val SELECT FROM wd: WindowData => DispatchOneList[event, wd.dl]; ENDCASE => DispatchOneList[event, handle.junkies­]; IF handle.priviledgeds#NIL THEN DispatchOneList[event, handle.priviledgeds]; }; FindAndDispatch: PUBLIC PROC [event: Event] = { InlineDispatch[event.connection.dispatchStuff, event]; }; Dispatch: PUBLIC PROC [handle: DispatchHandle, event: Event] = { InlineDispatch[handle, event]; }; <<>> DispatchExplicite: PUBLIC PROC [wd: WindowData, event: Event] = { DispatchOneList[event, wd.dl]; }; <<>> DispatchOneList: PROC [e: Event, dl: DispatchList] = { <> IF dl=NIL THEN RETURN; IF Basics.BITAND[e.originalCodeByte, 127]>=XlExtensions.firstExtension THEN { <<--extension event>> WITH e SELECT FROM xEvent: ExtensionEvent => { FOR i: NAT IN [0..dl.currLength) DO FOR xl: LIST OF REF ANY ¬ dl[i].activateExtensions, xl.rest WHILE xl#NIL DO IF xl.first=xEvent.match THEN { p: EventProcType ~ dl[i].proc; --order! Enqueue[dl[i].tq, p, dl[i].data, e]; EXIT --innermost loop } ENDLOOP ENDLOOP }; ENDCASE => {} } ELSE { <<--normal case: standard event>> FOR i: NAT IN [0..dl.currLength) DO IF dl[i].activate[e.type] THEN { p: EventProcType ~ dl[i].proc; --order! Enqueue[dl[i].tq, p, dl[i].data, e]; }; ENDLOOP; }; }; RemoveWindowData: <> PROC [c: Connection, w: Window] = { h: DispatchHandle ~ c.dispatchStuff; [] ¬ CardTab.Delete[h.wDataTab, w.id]; }; <<>> GetWindowData: PUBLIC PROC [c: Connection, w: Window] RETURNS [WindowData] = { h: DispatchHandle ~ c.dispatchStuff; RETURN [NARROW[CardTab.Fetch[h.wDataTab, w.id].val]]; }; <<>> GetOrCreateWindowData: <> PROC [c: Connection, w: Window] RETURNS [wd: WindowData] = { <> h: DispatchHandle ~ c.dispatchStuff; wd ¬ NARROW[CardTab.Fetch[h.wDataTab, w.id].val]; IF wd=NIL THEN { wd ¬ NEW[WindowDataRec]; IF CardTab.Insert[h.wDataTab, w.id, wd] THEN RETURN [wd]; wd ¬ GetOrCreateWindowData[c, w]; }; }; UsedLength: PROC [dl: DispatchList] RETURNS [n: CARD ¬ 0] = { <> IF dl#NIL THEN FOR i: NAT IN [0..dl.currLength) DO IF dl[i].proc#ProcRemoved THEN n ¬ n+1; ENDLOOP; }; <> < use DispatchList (for junkies)>> < use wd.dl (for normal events)>> < use h.priviledged (for priviledged events)>> <> <> <> <<>> SetDispatchList: INTERNAL PROC [container: REF, dl: DispatchList] = { WITH container SELECT FROM wd: WindowData => wd.dl ¬ dl; rdl: REF DispatchList => rdl­ ¬ dl; h: REF DispatchHandleRec => h.priviledgeds ¬ dl; ENDCASE => ERROR; }; GetDispatchList: INTERNAL PROC [container: REF] RETURNS [dl: DispatchList] = { WITH container SELECT FROM wd: WindowData => dl ¬ wd.dl; rdl: REF DispatchList => dl ¬ rdl­; h: REF DispatchHandleRec => dl ¬ h.priviledgeds; ENDCASE => ERROR; }; EnsureEntry: INTERNAL PROC [container: REF] RETURNS [i: NAT, dl: DispatchList] = { <> <> dl ¬ GetDispatchList[container]; IF dl=NIL THEN {dl ¬ NEW[DispatchListRep[4]]; SetDispatchList[container, dl]} ELSE IF dl.currLength >= dl.maxLength THEN { use: NAT ¬ UsedLength[dl]; IF use>=NAT.LAST-4 THEN { <<--silly error too long dispatch list, >> <<--wedge or crash the connection but not inside global monitor please>> dl.currLength ¬ dl.currLength-1; } ELSE { new: NAT ¬ use+4; dl2: DispatchList ¬ NEW[DispatchListRep[new]]; dl2.currLength ¬ 0; IF dl#NIL THEN { FOR i: NAT IN [0..dl.currLength) DO IF dl[i].proc#ProcRemoved THEN { dl2[dl2.currLength] ¬ dl[i]; dl2.currLength ¬ dl2.currLength + 1; }; ENDLOOP; }; dl ¬ dl2; SetDispatchList[container, dl]; }; }; <<--order of (dl.currLength) !>> i ¬ dl.currLength; dl[i].activate ¬ ALL[FALSE]; dl[i].activateExtensions ¬ NIL; dl[i].proc ¬ NotYetDefined; dl.currLength ¬ dl.currLength+1; }; AddMatchToList: ENTRY PROC [container: REF, match: Match, events: SetOfEvent ¬ unspecifiedEvents] = { IF match#NIL THEN { activate: EventCodes; tq: TQ ¬ match.tq; handles: EventFilter ¬ match.handles; proc: EventProcType ¬ match.proc; IF tq=NIL THEN tq ¬ CreateTQ[]; IF handles=NIL OR proc=NIL OR (handles.activate=ALL[FALSE] AND handles.activateExtensions=NIL) THEN RETURN; BEGIN n: NAT; dl: DispatchList; [n, dl] ¬ EnsureEntry[container]; <<--get order right as dispatching is not monitored>> dl[n].data ¬ match.data; dl[n].tq ¬ tq; dl[n].events ¬ events; dl[n].proc ¬ proc; dl[n].activateExtensions ¬ handles.activateExtensions; dl[n].activate ¬ handles.activate; END; }; }; RemoveMatchFromList: ENTRY PROC [container: REF, proc: EventProcType, tq: Xl.TQ, data: REF] = { <<--makes entry a noop; still needs external removing>> <<--entry and indirection to safe against allocating a new list>> dl: DispatchList ¬ GetDispatchList[container]; IF dl#NIL THEN FOR i: NAT IN [0..dl.currLength) DO IF dl[i].proc = proc AND dl[i].tq=tq AND dl[i].data=data THEN { <> dl[i].activate ¬ ALL[FALSE]; dl[i].activateExtensions ¬ NIL; dl[i].proc ¬ ProcRemoved; }; ENDLOOP }; GetInternalEvents: PROC [dl: DispatchList] RETURNS [events: SetOfEvent ¬ unspecifiedEvents] = { IF dl#NIL THEN FOR i: NAT IN [0..dl.currLength) DO IF dl[i].proc#ProcRemoved THEN events ¬ Xl.ORSetOfEvents[events, dl[i].events]; ENDLOOP; }; <<>> PrivateChangeEvents: <> PROC [c: Connection, w: Window, e: SetOfEvent, details: Details ¬ NIL] = { IF w=Xl.nullWindow THEN ERROR; BInit[c, 2, 0, 3+1]; --ChangeWindowAttributes BPutDrawable[c, w]; BPut32[c, 0800H]; --use event-mask field BPut32[c, LOOPHOLE[e]]; FinishWithDetails[c, details]; IF details=NIL THEN { XlPrivate.HardFlushBuffer[c: c, delay: XlPrivateResources.ValidID[c, w]]; <> <> <> <> }; }; InternalAddMatch: PUBLIC <> PROC [c: Connection, w: Window, match: Match, generate: SetOfEvent] = { wd: WindowData ¬ GetOrCreateWindowData[c, w]; generate.structureNotify ¬ TRUE; wd.actualEvents ¬ Xl.ORSetOfEvents[generate, wd.actualEvents]; --trust the caller to actually set it AddMatchToList[wd, match, generate]; }; <<>> AddMatches: PUBLIC PROC [c: Connection, w: Window, matchList: MatchList, generate: SetOfEvent, details: Details ¬ NIL] = { FOR l: MatchList ¬ matchList, l.rest WHILE l#NIL DO AddMatch[c, w, l.first, generate, details]; ENDLOOP }; AddMatch: PUBLIC PROC [c: Connection, w: Window, match: Match, generate: SetOfEvent, details: Details] = { <<--You wouldn't believe it, but the nullWindow is ok (used for mapping changes)>> action: PROC [c: Connection] = { wd: WindowData ¬ GetOrCreateWindowData[c, w]; newEvents: Xl.SetOfEvent ¬ Xl.ORSetOfEvents[wd.externalEvents, wd.actualEvents]; newEvents ¬ Xl.ORSetOfEvents[newEvents, generate]; newEvents.structureNotify ¬ TRUE; AddMatchToList[wd, match, generate]; <<--Make sure the right events are requested.>> <<--Can ignore internalEvents as (except for generate) they are included in actualEvents.>> IF newEvents#wd.actualEvents THEN { wd.actualEvents ¬ newEvents; IF w#Xl.nullWindow THEN PrivateChangeEvents[c, w, wd.actualEvents, details]; }; }; generate.structureNotify ¬ TRUE; DoWithLocks[c, action, details]; }; <<>> RemoveMatch: PUBLIC PROC [c: Connection, w: Window, match: Match, details: Details] = { action: PROC [c: Connection] = { --Need C-Lock to protect wd.dl and wd.externalEvents RemoveMatchFromList[wd, proc, match.tq, match.data]; IF ~XlPrivateResources.ValidID[c, w] THEN {--other connection owns this w n: NAT ¬ UsedLength[wd.dl]; IF n=0 THEN RemoveWindowData[c, w]; }; BEGIN internal: SetOfEvent ¬ GetInternalEvents[wd.dl]; --necessary structureNotifies are embedded new: SetOfEvent ¬ ORSetOfEvents[internal, wd.externalEvents]; IF new#wd.actualEvents THEN { wd.actualEvents ¬ new; IF w#Xl.nullWindow THEN PrivateChangeEvents[c, w, new, details]; }; END; }; <<--local copy prevents troubles inside monitor>> proc: EventProcType ¬ match.proc; wd: WindowData = GetWindowData[c, w]; IF wd#NIL AND match#NIL THEN DoWithLocks[c, action, details]; }; <<>> AddMatchForUnregistered: PUBLIC PROC [c: Connection, match: Match] = { action: PROC [c: Connection] = { h: DispatchHandle ~ c.dispatchStuff; AddMatchToList[h.junkies, match]; }; DoWithLocks[c, action, XlDetails.ignoreErrors]; }; <<>> EnforcedSetOfEvent: PUBLIC <> PROC [c: Connection, w: Window, external: SetOfEvent] RETURNS [SetOfEvent ¬ unspecifiedEvents] = { IF external#unspecifiedEvents THEN { wd: WindowData = GetOrCreateWindowData[c, w]; internal: SetOfEvent ¬ GetInternalEvents[wd.dl]; wd.externalEvents ¬ external; external ¬ Xl.ORSetOfEvents[internal, external]; external.structureNotify ¬ TRUE; --enforce future removal of WindowData RETURN [external]; }; }; AddPriviledgedMatch: PUBLIC PROC [c: Connection, match: Match] = { action: PROC [c: Connection] = { h: DispatchHandle ~ c.dispatchStuff; AddMatchToList[h, match]; }; DoWithLocks[c, action, XlDetails.ignoreErrors]; }; <<>> RemovePriviledgedMatch: PUBLIC PROC [c: Connection, match: Match] = { action: PROC [c: Connection] = { CheckForEmpty: ENTRY PROC [h: DispatchHandle] = { <<--speed up normal case of no priviledgeds; normally there aren't any>> IF UsedLength[h.priviledgeds]=0 THEN h.priviledgeds ¬ NIL }; h: DispatchHandle ~ c.dispatchStuff; RemoveMatchFromList[h, proc, match.tq, match.data]; CheckForEmpty[h]; }; proc: EventProcType ¬ match.proc; DoWithLocks[c, action, XlDetails.ignoreErrors]; }; InitWindow: PUBLIC PROC [c: Connection, w: Window] = { <> h: DispatchHandle ~ c.dispatchStuff; [] ¬ CardTab.Delete[h.wDataTab, w.id]; }; <<>> RemoveWindow: PUBLIC PROC [c: Connection, w: Window] = { h: DispatchHandle ~ c.dispatchStuff; IF w#nullWindow THEN { deleted: BOOL ¬ CardTab.Delete[h.wDataTab, w.id]; <<--Check for deleted; "openwin-3.0-beta" used to send multiple DestroyNotify events!>> <<--A window id leak for windows without not beeing included in the table is benign enough to accept for the benefit of not debugging openwin-3.0-beta again and again. >> IF deleted AND XlPrivateResources.ValidID[c, w.id] THEN XlPrivateResources.EntryFreeResourceID[c, w.id]; } }; InitConnection: PUBLIC PROC [c: Connection] = { c.dispatchStuff ¬ NEW[DispatchHandleRec ¬ [ wDataTab: CardTab.Create[], junkies: NEW[DispatchList], cache: NEW[XlRecycleMotionEvents.EventCache] ]]; [] ¬ GetOrCreateWindowData[c, Xl.nullWindow]; FOR i: NAT IN [0..Xl.ScreenCount[c]) DO [] ¬ GetOrCreateWindowData[c, Xl.NthScreen[c, i].root]; ENDLOOP }; END.