<> <> <> <> <> <> <<>> DIRECTORY Atom, Basics32, Convert, ForkOps, IO, NetworkStream, Process, PropList, Rope, RuntimeError, Xl, XlAccess, XlAuthFriends, XlDetails, XlDispatch, XlEndianPrivate, XlFinalizePrivate, XlPrivate, XlPrivateErrorHandling, XlPrivateResources, XlPrivateSplit, XlPrivateTypes, XlUtils; XlImplSetup: CEDAR MONITOR LOCKS c USING c: Connection IMPORTS Atom, Basics32, Convert, ForkOps, IO, NetworkStream, Process, PropList, Rope, RuntimeError, Xl, XlAccess, XlDispatch, XlEndianPrivate, XlFinalizePrivate, XlPrivate, XlPrivateErrorHandling, XlPrivateResources, XlPrivateSplit EXPORTS Xl, XlAuthFriends, XlDetails, XlPrivate, XlUtils SHARES IO, XlDispatch, XlPrivate, XlPrivateResources, XlPrivateTypes ~ BEGIN OPEN Xl, XlEndianPrivate, XlPrivate; <>ConnectionPrivate: PUBLIC TYPE = XlPrivateTypes.ConnectionPrivateImplRec; <<>> <<--Types usefull for interpreter usage in LOOPHOLE >> MutableScreen: TYPE = REF ScreenRec; MutableConnectionResponse: TYPE = REF ConnectionResponseInfoRec; xPortNumber: INT ~ 6000; debugLastConnection: Connection ¬ NIL; --for debugging weAreDebugging: BOOL ~ TRUE; --constant! enables eventual compile time code omissions replyModulusKey: REF CARD32 ~ NEW[CARD32]; authentifier: PUBLIC <> XlAuthFriends.AuthentifierProc ¬ NIL; ProduceConnectionNotCreated: PROC [rejected: REF ConnectionRejectInfo] = { SIGNAL connectionNotCreated[rejected]; }; PutConnectionInitialization: PROC [c: Connection, authorizationProtocolName, authorizationProtocolData: ROPE ¬ NIL] ~ { IF c.sequenceNumber#0 THEN ERROR; SELECT XlEndianPrivate.communicationByteOrder FROM msbFirst => DPutBYTE[c, 042H]; lsbFirst => DPutBYTE[c, 06CH]; ENDCASE => ERROR; DPutBYTE[c, 000H]; -- unused DPutCARD16[c, 11]; -- protocol-major-version DPutCARD16[c, 0]; -- protocol-minor-version DPutCARD16[c, Rope.Size[authorizationProtocolName]]; -- length of ... DPutCARD16[c, Rope.Size[authorizationProtocolData]]; -- length of ... DPutCARD16[c, 0]; -- unused DPutPaddedRope[c, authorizationProtocolName]; DPutPaddedRope[c, authorizationProtocolData]; c.bufSkipped ¬ 0; IO.Flush[c.xmit]; }; GetBYTE: PROC [c: Connection] RETURNS [BYTE] ~ { RETURN [XlEndianPrivate.InlineGet8[c]] }; GetCARD16: PROC [c: Connection] RETURNS [CARD16] ~ { RETURN [XlEndianPrivate.InlineGet16[c]] }; GetCARD32: PROC [c: Connection] RETURNS [CARD32] ~ { RETURN [XlEndianPrivate.InlineGet32[c]] }; GetFormat: PROC [c: Connection] RETURNS [f: Format] ~ { f.depth ¬ GetBYTE[c]; f.bitsPerPixel ¬ GetBYTE[c]; f.scanlinePad ¬ GetBYTE[c]; [] ¬ GetBYTE[c]; [] ¬ GetCARD32[c]; }; GetFormats: PROC [c: Connection, n: INT] RETURNS [list: LIST OF Format ¬ NIL] ~ { IF n > 0 THEN { last: LIST OF Format ¬ list ¬ LIST[GetFormat[c]]; FOR i: INT IN [1..n) DO last ¬ last.rest ¬ LIST[GetFormat[c]]; ENDLOOP; }; }; ReadScreen: PROC [c: Connection, i: INT] RETURNS [s: REF ScreenRec] ~ { s ¬ NEW[Xl.ScreenRec]; s.root ¬ ToWindow[c, GetCARD32[c]]; s.defaultColorMap ¬ [GetCARD32[c]]; s.whitePixel ¬ GetCARD32[c]; s.blackPixel ¬ GetCARD32[c]; s.currentInputMasks ¬ LOOPHOLE[GetCARD32[c]]; s.sizeInPixels ¬ Size[width: GetCARD16[c], height: GetCARD16[c]]; s.sizeInMillimeters ¬ Size[width: GetCARD16[c], height: GetCARD16[c]]; s.minInstalledMaps ¬ GetCARD16[c]; s.maxInstalledMaps ¬ GetCARD16[c]; s.rootVisual ¬ ToVisual[c, GetCARD32[c]]; BEGIN b: BYTE ¬ GetBYTE[c]; IF b<=2 THEN s.backingStores ¬ VAL[b] ELSE s.backingStores ¬ never; END; s.saveUnders ¬ GetBYTE[c]; s.rootDepth ¬ GetBYTE[c]; s.nDepths ¬ GetBYTE[c]; s.connection ¬ c; s.screenNumber ¬ i; s.properties ¬ PropList.NewPropList[]; s.screenDepthL ¬ GetDepths[c, s]; }; ReadScreens: PROC [c: Connection, n: INT] RETURNS [s: REF ScreenSequence] ~ { s ¬ NEW[ScreenSequence[n]]; FOR i: INT IN [0..n) DO s[i] ¬ ReadScreen[c, i]; ENDLOOP; }; CreateScreenDepthS: PROC [c: Connection] RETURNS [t: REF ScreenDepthTuples] = { t ¬ NEW[ScreenDepthTuples[c.screenDepthTuplesCount]]; FOR sno: NAT IN [0..ScreenCount[c]) DO s: Screen ¬ NthScreen[c, sno]; FOR dl: LIST OF READONLY ScreenDepth ¬ s.screenDepthL, dl.rest WHILE dl#NIL DO t[dl.first.screenDepthIndex] ¬ dl.first; ENDLOOP; ENDLOOP; }; GetDepth: PROC [c: Connection, s: REF ScreenRec] RETURNS [d: REF ScreenDepthRec] ~ { d ¬ NEW[ScreenDepthRec]; d.screenDepthIndex ¬ c.screenDepthTuplesCount; c.screenDepthTuplesCount ¬ c.screenDepthTuplesCount+1; d.screen ¬ s; d.depth ¬ GetBYTE[c]; [] ¬ GetBYTE[c]; --unused d.nVisualTypes ¬ GetCARD16[c]; [] ¬ GetCARD32[c]; --unused d.visuals ¬ GetVisualTypes[c, d.nVisualTypes]; d.properties ¬ PropList.NewPropList[]; }; GetDepths: PROC [c: Connection, s: REF ScreenRec] RETURNS [list: LIST OF ScreenDepth ¬ NIL] ~ { IF s.nDepths > 0 THEN { last: LIST OF ScreenDepth ¬ list ¬ LIST[GetDepth[c, s]]; FOR i: INT IN [1..s.nDepths) DO last ¬ last.rest ¬ LIST[GetDepth[c, s]]; ENDLOOP; }; }; GetVisualType: PROC [c: Connection] RETURNS [VisualType] ~ { vt: REF VisualTypeRec ¬ NEW[VisualTypeRec]; vt.visual ¬ [GetCARD32[c]]; vt.class ¬ VAL[GetBYTE[c]]; vt.bitsPerRgbValue ¬ GetBYTE[c]; vt.colorMapEntries ¬ GetCARD16[c]; vt.redMask ¬ GetCARD32[c]; vt.greenMask ¬ GetCARD32[c]; vt.blueMask ¬ GetCARD32[c]; [] ¬ GetCARD32[c]; --unused vt.properties ¬ PropList.NewPropList[]; RETURN [vt] }; GetVisualTypes: PROC [c: Connection, n: INT] RETURNS [LIST OF VisualType] ~ { list: LIST OF VisualType ¬ NIL; IF n > 0 THEN { last: LIST OF VisualType ¬ list ¬ LIST[GetVisualType[c]]; FOR i: INT IN [1..n) DO last ¬ last.rest ¬ LIST[GetVisualType[c]]; ENDLOOP; }; RETURN [list] }; GetPAD: PROC [c: Connection, n: CARD] ~ { WHILE n MOD 4 # 0 DO [] ¬ GetBYTE[c]; n ¬ n + 1; ENDLOOP; }; GetSTRING8: PROC [c: Connection, length: INT] RETURNS [rope: ROPE] ~ { rope ¬ IO.GetRope[self: c.recv, len: length, demand: TRUE]; }; GetInitialConnectionResponse: PROC [c: Connection] RETURNS [success: BOOL] = { successByte: BYTE ~ GetBYTE[c]; IF successByte=1 THEN { vendorLength, maxLength: CARD16; noOfScreens: BYTE; r: REF ConnectionResponseInfoRec ¬ NEW[ConnectionResponseInfoRec]; [] ¬ GetBYTE[c];--unused r.protocolMajorVersion ¬ GetCARD16[c]; r.protocolMinorVersion ¬ GetCARD16[c]; [] ¬ GetCARD16[c]; --additionalDataFWORDS r.releaseNumber ¬ GetCARD32[c]; r.resourceIdBase ¬ GetCARD32[c]; r.resourceIdMask ¬ GetCARD32[c]; r.motionBufferSize ¬ GetCARD32[c]; vendorLength ¬ GetCARD16[c]; -- length of vendor maxLength ¬ GetCARD16[c]; r.maxRequestLength ¬ maxLength-8; r.maxRequestLengthBytes ¬ 4*r.maxRequestLength; noOfScreens ¬ GetBYTE[c]; r.numberOfFORMATs ¬ GetBYTE[c]; r.imageByteOrder ¬ VAL[GetBYTE[c]]; r.bitmapFormatBitOrder ¬ VAL[GetBYTE[c]]; r.bitmapFormatScanlineUnit ¬ GetBYTE[c]; r.bitmapFormatScanlinePad ¬ GetBYTE[c]; r.minKeycode ¬ VAL[GetBYTE[c]]; r.maxKeycode ¬ VAL[GetBYTE[c]]; [] ¬ GetCARD32[c]; --unused r.vendor ¬ GetSTRING8[c, vendorLength]; GetPAD[c, vendorLength]; r.formats ¬ GetFormats[c, r.numberOfFORMATs]; r.screens ¬ ReadScreens[c, noOfScreens]; c.info ¬ r; RETURN [TRUE]; } ELSE { r: REF ConnectionRejectInfo ¬ NEW[ConnectionRejectInfo]; reasonBytes: BYTE ¬ GetBYTE[c]; additionalDataFWORDS: CARD16; r.failedBeforeReachingXServer ¬ FALSE; r.protocolMajorVersion ¬ GetCARD16[c]; r.protocolMinorVersion ¬ GetCARD16[c]; additionalDataFWORDS ¬ GetCARD16[c]; IF (INT[reasonBytes]+3)/4 # INT[additionalDataFWORDS] THEN ERROR; r.reason ¬ GetSTRING8[c, reasonBytes]; GetPAD[c, reasonBytes]; c.alive ¬ FALSE; r.reason ¬ Rope.Concat[r.reason, " (refused by X server)"]; ProduceConnectionNotCreated[r]; RETURN [FALSE]; }; }; replyTimeout: Process.Ticks ¬ Process.MsecToTicks[10000]; CloseStream: PROC [s: IO.STREAM] = { IF s#NIL THEN IO.Close[s, TRUE ! RuntimeError.UNCAUGHT => CONTINUE]; }; ScanedName: TYPE = RECORD [ protocolFamily: ATOM, transportClass: ATOM, remoteAddress: ROPE, displayNumber: INT ¬ 0, defaultScreenNumber: INT ¬ 0, error: ROPE ¬ NIL ]; ScanName: PROC [name: ROPE] RETURNS [sn: ScanedName] = { length: INT ¬ Rope.Length[name]; colonPos: INT ¬ Rope.SkipTo[s: name, skip: ":"]; sn.protocolFamily ¬ $ARPA; sn.transportClass ¬ $TCP; sn.remoteAddress ¬ XlAccess.AddressFromName[Rope.Substr[name, 0, colonPos] ! XlAccess.AddressFromNameFailed => {sn.error ¬ msg; GOTO oops} ]; IF Rope.IsEmpty[sn.remoteAddress] THEN sn.remoteAddress ¬ "127.0.0.1"; --the local host by convention IF (colonPos+1)> dotPos: INT ¬ Rope.SkipTo[s: name, pos: colonPos, skip: "."]; lastNumberPos: INT ¬ Rope.SkipOver[s: name, pos: colonPos+1, skip: "0123456789"]; IF lastNumberPos>colonPos+1 THEN { sn.displayNumber ¬ Convert.IntFromRope[ Rope.Substr[base: name, start: colonPos+1, len: lastNumberPos-colonPos-1] ! Convert.Error => {sn.error ¬ "BadDisplayNumber"; CONTINUE} ]; IF (dotPos+1)> sn.defaultScreenNumber ¬ Convert.IntFromRope[ Rope.Substr[base: name, start: dotPos+1] ! Convert.Error => CONTINUE ]; }; } }; EXITS oops => {}; }; ErrorFromStream: PROC [self: IO.STREAM] RETURNS [msg: Rope.ROPE] = { msg ¬ NetworkStream.GetIOErrorDetails[self].msg }; ErrorDetails: PROC [codes: LIST OF ATOM] RETURNS [r: Rope.ROPE] = { r ¬ " [details: "; FOR l: LIST OF ATOM ¬ codes, l.rest WHILE l#NIL DO r ¬ Rope.Concat[r, Atom.GetPName[l.first]]; IF l.rest#NIL THEN r ¬ Rope.Concat[r, ", "]; ENDLOOP; r ¬ Rope.Concat[r, "] "]; }; DeadConnection: PUBLIC PROC [debugHelp: REF ¬ NIL] RETURNS [c: Xl.Connection] = { c ¬ NEW[ConnectionRep ¬ [xmit: IO.noWhereStream, recv: IO.noInputStream, name: "dead", sendSoon: NIL, synchCount: 0, bufProblem: $DeadConnection, info: NEW[ConnectionResponseInfoRec _ [ protocolMajorVersion: 0, protocolMinorVersion: 0, releaseNumber: 0, resourceIdBase: 0, resourceIdMask: 0, motionBufferSize: 0, maxRequestLength: 10000, maxRequestLengthBytes: 10000, numberOfFORMATs: 0, imageByteOrder: msbFirst, bitmapFormatBitOrder: leastSignificant, bitmapFormatScanlineUnit: 32, bitmapFormatScanlinePad: 32, minKeycode: keycode0, maxKeycode: keycode255, vendor: NIL, formats: NIL, screens: NIL ]], alive: FALSE, bufNext: 0, defaultScreenNumber: 0, applicationKey: $DeadConnection ]]; c.cPriv ¬ NEW[ConnectionPrivate ¬ [ refRefSelf: NEW[Xl.Connection ¬ NIL] ]]; XlPrivate.RealAssertBuffer[c, 1000]; XlPrivateSplit.StartMainLoop[c]; }; CreateConnection: PUBLIC PROC [server: ROPE ¬ NIL, synchronized: BOOL ¬ FALSE, applicationKey: ATOM ¬ NIL, errorMatch: Match ¬ NIL, finalMatch: Match ¬ NIL, debugHelp: REF ¬ NIL] RETURNS [Connection ¬ NIL] = { c: Connection; success: BOOL; beforeReachingXServer: BOOL ¬ TRUE; state: Rope.ROPE ¬ " (Before establishing connection to display)"; Failure: PROC [r1, r2: ROPE ¬ NIL] = { serverPart: ROPE ¬ Rope.Cat[" [server: ", server, "]"]; rejected: REF ConnectionRejectInfo ¬ NEW[ConnectionRejectInfo]; rejected.failedBeforeReachingXServer ¬ beforeReachingXServer; rejected.reason ¬ Rope.Cat[r1, r2, state, serverPart]; success ¬ FALSE; ProduceConnectionNotCreated[rejected]; }; TryOnce: PROC [in, out: IO.STREAM] RETURNS [Xl.Connection ¬ NIL] = { ENABLE { IO.Error => {Failure[ErrorFromStream[stream]]; GOTO Oops}; IO.EndOfStream => {Failure["end of stream"]; GOTO Oops}; UNWIND => { CloseStream[in]; CloseStream[out]; }; }; c: Xl.Connection; state ¬ " (Stream to display machine created; Trying to send first bytes)"; c ¬ NEW[ConnectionRep ¬ [xmit: out, recv: in, name: server, sendSoon: NIL, debugHelp: debugHelp, errorFromStreamProc: ErrorFromStream, <<--for PCedar2.0 only: putChar: out.streamProcs.putChar, >> <<--for PCedar2.0 only: getChar: in.streamProcs.getChar, >> synchCount: (IF synchronized THEN 1000 ELSE 0), alive: TRUE, bufNext: 0, defaultScreenNumber: 0, -- set later when we know valid range applicationKey: applicationKey ]]; c.properties ¬ PropList.NewPropList[]; [] ¬ XlPrivate.AssertBuffer[c, 4000]; BEGIN generator: XlAuthFriends.AuthentifierProc ¬ authentifier; method, data: Rope.ROPE ¬ NIL; IF generator#NIL THEN [method: method, data: data] ¬ generator[family: 0<>, adress: sn.remoteAddress, display: Convert.RopeFromInt[sn.displayNumber], proposedMethod: NIL]; PutConnectionInitialization[c, method, data]; END; state ¬ " (Stream to display machine created; Awaiting first response from X server)"; beforeReachingXServer ¬ FALSE; success ¬ GetInitialConnectionResponse[c]; IF ~success THEN { CloseStream[in]; CloseStream[out]; RETURN [NIL] }; state ¬ " (Initial communication established; Retrieving X server display information)"; IF sn.defaultScreenNumber>=0 AND sn.defaultScreenNumber> s: Screen ¬ FirstScreen[c]; pixmap: Pixmap ¬ CreatePixmap[c: c, drawable: s.root, size: [1, 1], depth: s.rootDepth]; PutConnectionProp[c, $XlImplSomeResource, NEW[ID ¬ PixmapId[pixmap]]]; END; Xl.PutConnectionProp[c, replyModulusKey, NEW[CARD32 ¬ 0]]; ForkOps.ForkPeriodically[99, ConnectionPeriodical, c]; RETURN [c] EXITS Oops => RETURN [NIL]; }; sn: ScanedName; pStart: INT ¬ Rope.SkipOver[server, 0, " \t\r\l"];--remove leading whitespace pStop: INT ¬ Rope.SkipTo[server, pStart, "\r\l;"];--restrict to single line IF pStart>=pStop THEN server ¬ NIL ELSE server ¬ Rope.Substr[server, pStart, pStop-pStart]; IF Rope.IsEmpty[server] THEN { server ¬ XlAccess.DefaultServer[applicationKey]; }; sn ¬ ScanName[server]; IF ~Rope.IsEmpty[sn.error] THEN { Failure["server name problem : ", sn.error]; ERROR; --proceed won't help }; DO --until succeeds and RETURNs, or, until signal is aborted in, out: IO.STREAM; state ¬ " (Trying to open streams to display machine but not yet on X level)"; success ¬ TRUE; c ¬ NIL; [in, out] ¬ NetworkStream.CreateStreams[ protocolFamily: sn.protocolFamily, remote: IO.PutFR["%g:%g", IO.rope[sn.remoteAddress], IO.int[sn.displayNumber+xPortNumber]], transportClass: sn.transportClass ! NetworkStream.Error => {Failure[msg, ErrorDetails[codes]]; success ¬ FALSE; CONTINUE}; ]; IF success THEN { c ¬ TryOnce[in, out]; IF Xl.Alive[c] THEN RETURN [c]; }; ENDLOOP; }; CloseConnection: PUBLIC PROC [c: Connection] = { <> <> IF c#NIL THEN { c.alive ¬ FALSE; BEGIN <<--Extra stuff to implement atomiticity without entering connections monitor>> CalledJustOnce: InitializeProcType = {firstTime ¬ TRUE}; firstTime: BOOL ¬ FALSE; [] ¬ GetConnectionPropAndInit[c, $unique, CalledJustOnce]; IF firstTime THEN ForkOps.Fork[DetachedClose, c]; END; }; }; DetachedClose: PROC [data: REF] = { <<--Detached, so bad connection does not wedge others>> <<--Called on foreground priority>> ENABLE RuntimeError.UNCAUGHT <> => GOTO oops; c: Connection ~ NARROW[data]; rid: REF ID ¬ NIL; xmit: IO.STREAM ¬ c.xmit; WITH Xl.GetConnectionProp[c, $XlImplOutputStream] SELECT FROM s: IO.STREAM => { xmit ¬ s; Xl.PutConnectionProp[c, $XlImplOutputStream, NIL]; }; ENDCASE => {}; WITH Xl.GetConnectionProp[c, $XlImplSomeResource] SELECT FROM i: REF ID => { rid ¬ i; Xl.PutConnectionProp[c, $XlImplSomeResource, NIL]; }; ENDCASE => {}; IF xmit#NIL AND xmit#IO.noWhereStream THEN { IF rid#NIL AND c.bufNext=0 THEN TRUSTED { <<--KillClient on prepared resource so windows disappear fast>> <<--Not on connection monitor but ok since>> <<--No other transmission happens outside monitor>> <<--We check whether we are at a logical beginning point>> <<--This is entered once only>> BInit[c, 113, 0, 2]; --KillClient request BPut32[c, rid­]; IO.UnsafePutBlock[xmit, [base: LOOPHOLE[c.buf], startIndex: 0, count: 8]]; IO.Flush[xmit]; }; c.xmit ¬ IO.noWhereStream; CloseStream[xmit]; }; CloseStream[c.recv]; EXITS oops => {}; }; DetachedKilling: PROC [data: REF] = { <<--Detached, so bad connection does not wedge others>> <<--Call this delayed to give a chance for an extra KillConnection request...>> c: Connection ~ NARROW[data]; recv: IO.STREAM ¬ c.recv; c.recv ¬ IO.noInputStream; WITH Xl.GetConnectionProp[c, $XlImplOutputStream] SELECT FROM xmit: IO.STREAM => { Xl.PutConnectionProp[c, $XlImplOutputStream, NIL]; CloseStream[xmit]; }; ENDCASE => {}; XlPrivateSplit.ReleaseService[c]; XlPrivateSplit.KillReplies[c, FALSE]; <<--dont bother about c.replyStuff.r[i].replyReceived; there is a time out>> XlPrivateResources.MarkDead[c]; IF recv#NIL AND recv#IO.noInputStream THEN CloseStream[recv]; }; ConnectionPeriodical: PROC [data: REF] = { c: Connection ~ NARROW[data]; IF ~Xl.Alive[c] OR c.bufProblem#NIL THEN { c.alive ¬ FALSE; ForkOps.Stop[ConnectionPeriodical, data]; ForkOps.ForkDelayed[200, DetachedKilling, c]; --extra delay RETURN }; WITH GetConnectionProp[c, replyModulusKey] SELECT FROM ri: REF CARD32 => { IF ri­#LAST[CARD32] AND ((LOOPHOLE[c.sequenceNumber, CARD32]-ri­) MOD 10000H) > 4000 THEN { ri­ ¬ LAST[CARD32]; ForkOps.Fork[EnsureReplyModulus, c]; }; }; ENDCASE => {}; IF c.needFlushing OR c.bufReady#0 THEN Xl.Flush[c, FALSE]; }; EnsureReplyModulus: PROC [data: REF] = { c: Connection ~ NARROW[data]; WITH GetConnectionProp[c, replyModulusKey] SELECT FROM ri: REF CARD32 => { Xl.RoundTrip[c, ignoreErrors]; ri­ ¬ c.sequenceNumber; }; ENDCASE => {}; }; CheckReply: PUBLIC PROC [r: Reply] = { IF r=NIL OR r.fix[0]#1 THEN NotAReply[r]; r.next ¬ 1 }; NotAReply: PROC [r: Reply] = { ev: REF EventRep.errorNotify ~ XlPrivateErrorHandling.NewErrorEvent[r]; ev.serverGenerated ¬ TRUE; XlPrivateErrorHandling.RaiseErrorEvent[ev]; }; EventRope: PUBLIC PROC [event: Event] RETURNS [r: Rope.ROPE] = { IF event=NIL THEN RETURN ["NIL-Event"]; r ¬ EventCodeRope[event.type]; r ¬ IO.PutFR["%g(%g)", IO.rope[r], IO.int[ORD[event.originalCodeByte]]]; }; EventCodeRope: PUBLIC PROC [code: EventCode] RETURNS [r: Rope.ROPE] = { SELECT code FROM local => r ¬ "local"; extension => r ¬ "extension"; errorNotify => r ¬ "errorNotify"; keyPress => r ¬ "keyPress"; keyRelease => r ¬ "keyRelease"; buttonPress => r ¬ "buttonPress"; buttonRelease => r ¬ "buttonRelease"; motionNotify => r ¬ "motionNotify"; enterNotify => r ¬ "enterNotify"; leaveNotify => r ¬ "leaveNotify"; focusIn => r ¬ "focusIn"; focusOut => r ¬ "focusOut"; keymapNotify => r ¬ "keymapNotify"; expose => r ¬ "expose"; graphicsExposure => r ¬ "graphicsExposure"; noExposure => r ¬ "noExposure"; visibilityNotify => r ¬ "visibilityNotify"; createNotify => r ¬ "createNotify"; destroyNotify => r ¬ "destroyNotify"; unmapNotify => r ¬ "unmapNotify"; mapNotify => r ¬ "mapNotify"; mapRequest => r ¬ "mapRequest"; reparentNotify => r ¬ "reparentNotify"; configureNotify => r ¬ "configureNotify"; configureRequest => r ¬ "configureRequest"; gravityNotify => r ¬ "gravityNotify"; resizeRequest => r ¬ "resizeRequest"; circulateNotify => r ¬ "circulateNotify"; circulateRequest => r ¬ "circulateRequest"; propertyNotify => r ¬ "propertyNotify"; selectionClear => r ¬ "selectionClear"; selectionRequest => r ¬ "selectionRequest"; selectionNotify => r ¬ "selectionNotify"; colorMapNotify => r ¬ "colorMapNotify"; clientMessage => r ¬ "clientMessage"; mappingNotify => r ¬ "mappingNotify"; tipEvent => r ¬ "tipEvent"; ENDCASE => r ¬ "event"; }; FirstRoot: PUBLIC PROC [c: Connection] RETURNS [w: Window] = { RETURN [Xl.FirstScreen[c].root] }; DefaultRoot: PUBLIC PROC [c: Connection] RETURNS [w: Window] = { RETURN [Xl.DefaultScreen[c].root] }; LegalEvents: PUBLIC PROC [e: SetOfEvent] RETURNS [SetOfEvent] = { RETURN [LOOPHOLE[Basics32.BITAND[LOOPHOLE[e], 1FFFFFFH]]] }; PointerEvents: PUBLIC PROC [e: SetOfEvent] RETURNS [SetOfEvent] = { RETURN [LOOPHOLE[Basics32.BITAND[LOOPHOLE[e], 07FFCH]]] }; DeviceEvents: PUBLIC PROC [e: SetOfEvent] RETURNS [SetOfEvent] = { RETURN [LOOPHOLE[Basics32.BITAND[LOOPHOLE[e], 0304FH]]] }; MergeAttributes: PUBLIC PROC [win, loose: Attributes] RETURNS [x: Attributes] = { x ¬ loose; IF win.backgroundPixmap#illegalPixmap THEN x.backgroundPixmap ¬ win.backgroundPixmap; IF win.backgroundPixel#illegalPixel THEN x.backgroundPixel ¬ win.backgroundPixel; IF win.borderPixmap#illegalPixmap THEN x.borderPixmap ¬ win.borderPixmap; IF win.borderPixel#illegalPixel THEN x.borderPixel ¬ win.borderPixel; IF win.bitGravity#illegal THEN x.bitGravity ¬ win.bitGravity; IF win.winGravity#illegal THEN x.winGravity ¬ win.winGravity; IF win.backingStore#illegal THEN x.backingStore ¬ win.backingStore; IF win.backingPlanes#undefinedBackingPlanes THEN x.backingPlanes ¬ win.backingPlanes; IF win.backingPixel#illegalPixel THEN x.backingPixel ¬ win.backingPixel; IF win.overrideRedirect#illegal THEN x.overrideRedirect ¬ win.overrideRedirect; IF win.saveUnder#illegal THEN x.saveUnder ¬ win.saveUnder; x.eventMask ¬ Xl.ORSetOfEvents[x.eventMask, win.eventMask]; x.doNotPropagateMask ¬ Xl.ORSetOfEvents[x.doNotPropagateMask, win.doNotPropagateMask]; IF win.colorMap#illegalColorMap THEN x.colorMap ¬ win.colorMap; IF win.cursor#illegalCursor THEN x.cursor ¬ win.cursor; }; FullCreateEventFilter: PUBLIC PROC [eventCodes: LIST OF EventCode ¬ NIL, activate: EventCodes ¬ ALL[FALSE], extensions: LIST OF REF ANY ¬ NIL] RETURNS [filter: EventFilter] = { filter ¬ NEW[EventFilterRec ¬ [activate: activate, activateExtensions: extensions]]; FOR l: LIST OF EventCode ¬ eventCodes, l.rest WHILE l#NIL DO filter.activate[l.first] ¬ TRUE ENDLOOP }; CreateEventFilter: PUBLIC PROC [c1, c2, c3, c4: EventCode ¬ extension] RETURNS [filter: EventFilter] = { filter ¬ NEW[EventFilterRec]; filter.activate[c1] ¬ TRUE; filter.activate[c2] ¬ TRUE; filter.activate[c3] ¬ TRUE; filter.activate[c4] ¬ TRUE; filter.activate[extension] ¬ FALSE; }; SetEventCodes: PUBLIC PROC [list: LIST OF EventCode] RETURNS [ec: EventCodes ¬ ALL[FALSE]] = { FOR l: LIST OF EventCode ¬ list, l.rest WHILE l#NIL DO ec[l.first] ¬ TRUE ENDLOOP }; QueryScreen: PUBLIC PROC [c: Connection, drawable: Drawable] RETURNS [Screen] = { SELECT ScreenCount[c] FROM 1 => RETURN [FirstScreen[c]]; ENDCASE => { IF drawable=nullDrawable THEN RETURN [DefaultScreen[c]]; FOR i: INT IN [0..ScreenCount[c]) DO s: Screen ¬ NthScreen[c, i]; IF s.root.drawable=drawable THEN RETURN [s]; ENDLOOP; BEGIN <<--should do caching... use LRUCache>> gr: GeometryRec ¬ GetGeometry[c, drawable]; RETURN [QueryScreen[c, gr.root.drawable]]; END; }; }; QueryScreenDepth: PUBLIC PROC [c: Connection, drawable: Drawable] RETURNS [depth: ScreenDepth] = { gr: GeometryRec; s: Screen; IF ScreenCount[c]=1 THEN { s ¬ FirstScreen[c]; IF s.nDepths=1 THEN RETURN [s.screenDepthL.first]; }; IF drawable=nullDrawable THEN drawable ¬ DefaultRoot[c].drawable; gr ¬ GetGeometry[c, drawable]; s ¬ QueryScreen[c, gr.root.drawable]; FOR ld: LIST OF READONLY ScreenDepth ¬ s.screenDepthL, ld.rest WHILE ld#NIL DO IF ld.first.depth=gr.depth THEN RETURN [ld.first]; ENDLOOP; ERROR; }; synchronousErrors: PUBLIC Xl.Details ¬ NEW[Xl.DetailsRec ¬ [synchronous: TRUE, localErrors: inline]]; ignoreErrors: PUBLIC Xl.Details ¬ NEW[Xl.DetailsRec ¬ [localErrors: ignore, errorMatch: NEW[Xl.MatchRep ¬ [proc: IgnoreErrors, handles: NIL, tq: Xl.CreateTQ[]]]]]; debugErrCount: CARD ¬ 0; IgnoreErrors: Xl.EventProcType = {debugErrCount ¬ debugErrCount+1}; flushIgnoreErrors: PUBLIC Xl.Details ¬ NEW[Xl.DetailsRec ¬ [flush: now, errorMatch: NEW[Xl.MatchRep ¬ [proc: IgnoreErrors, handles: NIL, tq: Xl.CreateTQ[]]]]]; flushSoonIgnoreErrors: PUBLIC Xl.Details ¬ NEW[Xl.DetailsRec ¬ [flush: soon, errorMatch: NEW[Xl.MatchRep ¬ [proc: IgnoreErrors, handles: NIL, tq: Xl.CreateTQ[]]]]]; END.