<> <> <> <> DIRECTORY Basics, CardTab, IO, RefText, Rope, SymTab, Xl, XlEndianPrivate, XlPredefinedAtoms, XlPrivate, XlPrivateErrorHandling, XlPrivateSplit, XlPrivateTypes, XlService; XlImplAtPropSel: CEDAR MONITOR LOCKS c USING c: Connection IMPORTS Basics, CardTab, RefText, Rope, SymTab, Xl, XlEndianPrivate, XlPrivate, XlPrivateErrorHandling, XlService EXPORTS Xl, XlPrivateSplit SHARES XlPrivateTypes ~ BEGIN OPEN Xl, XlPrivate; ConnectionPrivateImplRec: TYPE = XlPrivateTypes.ConnectionPrivateImplRec; <>ConnectionPrivate: PUBLIC TYPE = ConnectionPrivateImplRec; ROPE: TYPE ~ Rope.ROPE; RaiseClientError: PROC [c: Xl.Connection, what: REF ¬ NIL] = { XlPrivateErrorHandling.RaiseClientError[c, what]; }; maxPredefinedAtom: CARD = 68; atomToName: REF ARRAY [0..maxPredefinedAtom] OF ROPE ¬ NEW[ARRAY [0..maxPredefinedAtom] OF ROPE]; nameToAtom: SymTab.Ref ¬ SymTab.Create[maxPredefinedAtom]; StandardAtom: PUBLIC PROC [name: ROPE] RETURNS [atom: XAtom] = { WITH SymTab.Fetch[nameToAtom, name].val SELECT FROM ra: REF XAtom => RETURN [ra­]; ENDCASE => ERROR; --not a standard name used }; InitializeNameToAtom: InitializeProcType = { RETURN [SymTab.Create[7]]; }; InitializeAtomToName: InitializeProcType = { RETURN [CardTab.Create[7]]; }; InitAtomStuff: PUBLIC PROC [c: Connection] = { cp: REF ConnectionPrivateImplRec ~ c.cPriv; cp.atomToName ¬ NARROW[XlService.GetServicePropAndInit[c, atomToName, InitializeAtomToName]]; cp.nameToAtom ¬ NARROW[XlService.GetServicePropAndInit[c, nameToAtom, InitializeNameToAtom]]; <<--order: nameToAtom defined second>> }; MakeAtom: PUBLIC PROC [c: Connection, name: ROPE] RETURNS [atom: XAtom] = { atom ¬ InternAtom[c, name, TRUE].atom }; InternAtom: PUBLIC PROC [c: Connection, name: ROPE, create: BOOL ¬ FALSE] RETURNS [atom: XAtom, exist: BOOL] = { reply: Reply; n: INT; action: PROC [c: Connection] = { BInit[c, 16, IF create THEN 0 ELSE 1, 2+(n+3)/4]; BPut16[c, n]; BPut16[c, 0]; --unused BPutPaddedRope[c, name]; reply ¬ FinishWithReply[c]; }; cp: REF ConnectionPrivateImplRec ~ c.cPriv; <<--try to avoid asking the server>> IF Rope.IsEmpty[name] THEN RETURN [[0], FALSE]; WITH SymTab.Fetch[nameToAtom, name].val SELECT FROM ra: REF XAtom => RETURN [ra­, TRUE]; ENDCASE => {}; IF cp.nameToAtom#NIL THEN WITH SymTab.Fetch[cp.nameToAtom, name].val SELECT FROM ra: REF XAtom => RETURN [ra­, TRUE]; ENDCASE => {}; <<--ask the server>> n ¬ Rope.Length[name]; IF n=0 THEN RaiseClientError[c, $NILAtom]; IF c.info.maxRequestLengthBytes<=n THEN RaiseClientError[c, $AtomTooLong]; DoWithLocks[c, action, NIL]; CheckReply[reply]; Skip[reply, 7]; atom.a ¬ ERead32[reply]; DisposeReply[c, reply]; exist ¬ atom.a#0; IF exist AND create AND cp.nameToAtom#NIL THEN { [] ¬ SymTab.Insert[cp.nameToAtom, name, NEW[XAtom¬atom]]; [] ¬ CardTab.Insert[cp.atomToName, atom.a, name]; }; }; BPutProp: PROC [c: Connection, atom: XAtom] = { IBPut32[c, atom]; }; GetAtomName: PUBLIC PROC [c: Connection, atom: XAtom] RETURNS [name: ROPE] = { reply: Reply; nameLeng: INT; action: PROC [c: Connection] = { BInit[c, 17, 0, 2]; BPutProp[c, atom]; reply ¬ FinishWithReply[c]; }; cp: REF ConnectionPrivateImplRec ~ c.cPriv; <<--try to avoid asking the server>> IF atom.a<=maxPredefinedAtom THEN RETURN [atomToName[atom.a]]; WITH CardTab.Fetch[cp.atomToName, atom.a].val SELECT FROM r: ROPE => RETURN [r]; ENDCASE => {}; <<--ask the server>> DoWithLocks[c, action, NIL]; CheckReply[reply]; Skip[reply, 7]; nameLeng ¬ ERead16[reply]; TRUSTED { name ¬ XlPrivate.RopeFromRaw[p: LOOPHOLE[reply.varPart], start: 0, len: nameLeng]; }; DisposeReply[c, reply]; IF ~Rope.IsEmpty[name] AND cp.nameToAtom#NIL THEN { [] ¬ SymTab.Insert[cp.nameToAtom, name, NEW[XAtom¬atom]]; [] ¬ CardTab.Insert[cp.atomToName, atom.a, name]; }; }; ChangeProperty: PUBLIC PROC [c: Connection, w: Window, property: XAtom, type: XAtom, mode: ChangePropertyMode ¬ replace, data: REF, start: INT, num: INT, details: Details ¬ NIL] = { numberOfUnits, unitSize, numberOfBytes: INT; action: PROC [c: Connection] = { BInit[c, 18, ORD[mode], 6+(numberOfBytes+3)/4]; BPutDrawable[c, w]; BPutProp[c, property]; BPutProp[c, type]; BPut8[c, unitSize*8]; BSkip[c, 3]; BPut32[c, numberOfUnits]; WITH data SELECT FROM r: ROPE => BPutPaddedRope[c, r, start, numberOfUnits]; rc: REF Card32Sequence => { FOR i: INT IN [start..start+numberOfUnits) DO IBPut32[c, rc[i]] ENDLOOP; }; rc: REF Card16Sequence => { FOR i: INT IN [start..start+numberOfUnits) DO IBPut16[c, rc[i]] ENDLOOP; IF numberOfUnits MOD 2 #0 THEN IBPut16[c, 0]; }; ra: REF XAtom => BPut32[c, ra­]; rc: REF CARD32 => BPut32[c, rc­]; ri: REF INT32 => BPut32[c, LOOPHOLE[ri­]]; rp: REF Xl.Pixel => BPut32[c, LOOPHOLE[rp­]]; rt: REF TEXT => BPutPaddedText[c, rt, numberOfUnits]; ENDCASE => {}; FinishWithDetails[c, details]; }; IF start<0 OR num<0 THEN RaiseClientError[c, $badData]; IF property.a=0 THEN RaiseClientError[c, $badProperty]; <<--w.id=0 is a frequent error while debugging. I'm not sure whether this test should remain or should be made to look like a regular X error. >> IF w.id=0 THEN RaiseClientError[c, $badWindow]; [numberOfUnits, unitSize] ¬ XPropInfo[data]; numberOfUnits ¬ MAX[0, MIN[numberOfUnits-start, num]]; numberOfBytes ¬ numberOfUnits * unitSize; IF numberOfUnits>c.info.maxRequestLengthBytes THEN RaiseClientError[c, $ToLong]; DoWithLocks[c, action, details]; }; BPutPaddedText: PROC [c: Connection, text: REF READONLY TEXT, requiredLength: INTEGER] = { size: INTEGER ~ RefText.Length[text]; FOR i: INTEGER IN [0..MIN[size, requiredLength]) DO XlPrivate.IBPut8[c, ORD[text[i]]] ENDLOOP; IF size {numberOfUnits ¬ Rope.Length[r]; unitSize ¬ 1}; rc: REF Xl.Card32Sequence => {numberOfUnits ¬ rc.leng; unitSize ¬ 4}; rc: REF Xl.Card16Sequence => {numberOfUnits ¬ rc.leng; unitSize ¬ 2}; rc: REF Xl.XAtom => {numberOfUnits ¬ 1; unitSize ¬ 4}; rc: REF INT32 => {numberOfUnits ¬ 1; unitSize ¬ 4}; rc: REF CARD32 => {numberOfUnits ¬ 1; unitSize ¬ 4}; rt: REF TEXT => {numberOfUnits ¬ RefText.Length[rt]; unitSize ¬ 1}; ENDCASE => IF data=NIL THEN {numberOfUnits ¬ 0; unitSize ¬ 1} --ICCCM explicitely requires NIL to work ELSE ERROR; }; DeleteProperty: PUBLIC PROC [c: Connection, w: Window, property: XAtom, details: Details] = { action: PROC [c: Connection] = { BInit[c, 19, 0, 3]; BPutDrawable[c, w]; BPutProp[c, property]; FinishWithDetails[c, details]; }; IF property.a=0 THEN ERROR; DoWithLocks[c, action, details]; }; GetProperty: PUBLIC PROC [c: Connection, w: Window, property: XAtom, supposedType: XAtom, delete: BOOL, longOff: INT, longLength: INT, supposedFormat: BYTE] RETURNS [ret: PropertyReturnRec] = { reply: Reply; action: PROC [c: Connection] = { BInit[c, 20, ToCBool[delete], 6]; BPutDrawable[c, w]; BPutProp[c, property]; BPutProp[c, supposedType]; BPut32[c, offset32]; BPut32[c, leng32]; reply ¬ FinishWithReply[c]; }; offset32: CARD32 ¬ longOff; leng32: CARD32 ¬ MIN[longLength, Info[c].maxRequestLength]; lengUnits: INT; IF property.a=0 THEN ERROR; DoWithLocks[c, action, NIL]; CheckReply[reply]; ret.format ¬ ERead8[reply]; Skip[reply, 6]; ret.type.a ¬ ERead32[reply]; ret.bytesAfter ¬ ERead32[reply]; lengUnits ¬ ERead32[reply]; --range checking! TRUSTED { SELECT ret.format FROM 8 => { ret.value ¬ XlPrivate.RopeFromRaw[p: LOOPHOLE[reply.varPart], start: 0, len: lengUnits]; }; 32 => { rcs: REF Card32Sequence ¬ NEW[Card32Sequence[lengUnits]]; FOR i: INT IN [0..lengUnits) DO rcs[i] ¬ XlEndianPrivate.InlineRawGet32[LOOPHOLE[reply.varPart], i*4] ENDLOOP; ret.value ¬ rcs }; 16 => { rcs: REF Card16Sequence ¬ NEW[Card16Sequence[lengUnits]]; FOR i: INT IN [0..lengUnits) DO rcs[i] ¬ XlEndianPrivate.InlineRawGet16[LOOPHOLE[reply.varPart], i*2] ENDLOOP; ret.value ¬ rcs }; 0 => ret.value ¬ NIL; ENDCASE => ERROR; }; DisposeReply[c, reply]; }; ListProperties: PUBLIC PROC [c: Connection, w: Window] RETURNS [list: LIST OF XAtom ¬ NIL, num: INT] = { reply: Reply; action: PROC [c: Connection] = { BInit[c, 21, 0, 2]; BPutDrawable[c, w]; reply ¬ FinishWithReply[c]; }; DoWithLocks[c, action, NIL]; CheckReply[reply]; Skip[reply, 7]; num ¬ ERead16[reply]; Skip[reply, 22]; FOR i: INT IN [0..num) DO a: XAtom ¬ [ERead32[reply]]; list ¬ CONS[a, list] ENDLOOP; DisposeReply[c, reply]; }; RotateProperties: PUBLIC PROC [c: Connection, w: Window, delta: INT, properties: LIST OF XAtom, details: Details] = { action: PROC [c: Connection] = { BInit[c, 114, 0, 3+cnt]; BPutDrawable[c, w]; BPutINT32as16[c, cnt]; BPut16[c, Basics.LowHalf[LOOPHOLE[delta]]]; FOR i: INT IN [0..cnt) DO IF properties=NIL THEN properties ¬ LIST[[0]]; --be safe against concurrent turkey damaging list, this is an entry proc! BPutProp[c, properties.first]; properties ¬ properties.rest ENDLOOP; FinishWithDetails[c, details]; }; cnt: INT16 ¬ 0; lst: LIST OF XAtom ¬ properties; WHILE lst#NIL AND cnt1000 THEN RaiseClientError[c, $ToLong]; IF cnt=0 OR delta=0 THEN RETURN; DoWithLocks[c, action, details]; }; PredefineAtoms: PROC [] = {OPEN XlPredefinedAtoms; Def: PROC [r: ROPE, atom: XAtom] = { key: CARD32 ¬ Xl.AtomId[atom]; IF key>maxPredefinedAtom THEN ERROR; atomToName[key] ¬ r; [] ¬ SymTab.Insert[nameToAtom, r, NEW[XAtom ¬ atom]]; }; Def[NIL, nullNotAnAtom]; Def["PRIMARY", primary]; Def["SECONDARY", secondary]; Def["ARC", arc]; Def["ATOM", atom]; Def["BITMAP", bitmap]; Def["CARDINAL", cardinal]; Def["COLORMAP", colormap]; Def["CURSOR", cursor]; Def["CUT_BUFFER0", cutBuffer0]; Def["CUT_BUFFER1", cutBuffer1]; Def["CUT_BUFFER2", cutBuffer2]; Def["CUT_BUFFER3", cutBuffer3]; Def["CUT_BUFFER4", cutBuffer4]; Def["CUT_BUFFER5", cutBuffer5]; Def["CUT_BUFFER6", cutBuffer6]; Def["CUT_BUFFER7", cutBuffer7]; Def["DRAWABLE", drawable]; Def["FONT", font]; Def["INTEGER", point]; Def["PIXMAP", pixmap]; Def["POINT", point]; Def["RECTANGLE", rectangle]; Def["RESOURCE_MANAGER", resourceManager]; Def["RGB_COLOR_MAP", rgbColorMap]; Def["RGB_BEST_MAP", rgbBestMap]; Def["RGB_BLUE_MAP", rgbBlueMap]; Def["RGB_DEFAULT_MAP", rgbDefaultMap]; Def["RGB_GRAY_MAP", rgbGrayMap]; Def["RGB_GREEN_MAP", rgbGreenMap]; Def["RGB_RED_MAP", rgbRedMap]; Def["STRING", string]; Def["VISUALID", visualid]; Def["WINDOW", window]; Def["WM_COMMAND", wmCommand]; Def["WM_HINTS", wmHints]; Def["WM_CLIENT_MACHINE", wmClientMachine]; Def["WM_ICON_NAME", wmIconName]; Def["WM_ICON_SIZE", wmIconSize]; Def["WM_NAME", wmName]; Def["WM_NORMAL_HINTS", wmNormalHints]; Def["WM_SIZE_HINTS", wmSizeHints]; Def["WM_ZOOM_HINTS", wmZoomHints]; Def["MIN_SPACE", minSpace]; Def["NORM_SPACE", normSpace]; Def["MAX_SPACE", maxSpace]; Def["END_SPACE", endSpace]; Def["SUPERSCRIPT_X", superscriptX]; Def["SUPERSCRIPT_Y", superscriptY]; Def["SUBSCRIPT_X", subscriptX]; Def["SUBSCRIPT_Y", subscriptY]; Def["UNDERLINE_POSITION", underlinePosition]; Def["UNDERLINE_THICKNESS", underlineThickness]; Def["STRIKEOUT_ASCENT", strikeoutAscent]; Def["STRIKEOUT_DESCENT", strikeoutDescent]; Def["ITALIC_ANGLE", italicAngle]; Def["X_HEIGHT", xHeight]; Def["QUAD_WIDTH", quadWidth]; Def["WEIGHT", weight]; Def["POINT_SIZE", pointSize]; Def["RESOLUTION", resolution]; Def["COPYRIGHT", copyright]; Def["NOTICE", notice]; Def["FONT_NAME", fontName]; Def["FAMILY_NAME", familyName]; Def["FULL_NAME", fullName]; Def["CAP_HEIGHT", capHeight]; Def["WM_CLASS", wmClass]; Def["WM_TRANSIENT_FOR", wmTransientFor]; }; SetSelectionOwner: PUBLIC PROC [c: Connection, owner: Window ¬ nullWindow, selection: XAtom, time: TimeStamp, details: Details] = { action: PROC [c: Connection] = { BInit[c, 22, 0, 4]; BPutDrawable[c, owner]; BPutProp[c, selection]; BPutTime[c, time]; FinishWithDetails[c, details]; --dont flush now: ICCCM requires calling GetSelectionOwner anyway }; DoWithLocks[c, action, details]; }; GetSelectionOwner: PUBLIC PROC [c: Connection, selection: XAtom] RETURNS [owner: Window ¬ nullWindow] = { action: PROC [c: Connection] ~ { BInit[c, 23, 0, 2]; BPutProp[c, selection]; reply ¬ FinishWithReply[c]; }; reply: Reply; DoWithLocks[c, action, NIL]; CheckReply[reply]; Skip[reply, 7]; owner ¬ ToWindow[c, ERead32[reply]]; DisposeReply[c, reply]; }; ConvertSelection: PUBLIC PROC [c: Connection, requestor: Window, selection: XAtom, target: XAtom, property: XAtom ¬ [0], time: TimeStamp ¬ currentTime, details: Details] = { action: PROC [c: Connection] ~ { BInit[c, 24, 0, 6]; BPutDrawable[c, requestor]; BPutProp[c, selection]; BPutProp[c, target]; BPutProp[c, property]; BPutTime[c, time]; FinishWithDetails[c, details]; IF details=NIL THEN XlPrivate.HardFlushBuffer[c]; }; DoWithLocks[c, action, details]; }; SendSelectionNotifyEvent: PUBLIC PROC [c: Connection, destination: Window, selection: XAtom, target: XAtom, property: XAtom ¬ [0], timeStamp: TimeStamp, details: Details] = { action: PROC [c: Connection] ~ { BInit[c, 25, 1--propagate: true--, 11]; BPutDrawable[c, destination]; BPut32[c, 0]; --event mask BPut8[c, 31]; --code BPut8[c, 0]; --unused BPut16[c, 0]; --I hope sequence number is filled in by server BPutTime[c, timeStamp]; BPutDrawable[c, destination]; --requestor BPutProp[c, selection]; BPutProp[c, target]; BPutProp[c, property]; BSkip[c, 8]; --unused FinishWithDetails[c, details]; IF details=NIL THEN XlPrivate.HardFlushBuffer[c]; }; DoWithLocks[c, action, details]; }; SetInputFocus: PUBLIC PROC [c: Connection, window: Window ¬ nullWindow, revertTo: FocusReversion ¬ parent, timeStamp: TimeStamp, details: Details] = { action: PROC [c: Connection] ~ { BInit[c, 42, ORD[revertTo], 3]; BPutDrawable[c, window]; BPutTime[c, timeStamp]; FinishWithDetails[c, details]; IF details=NIL THEN XlPrivate.HardFlushBuffer[c, window#nullWindow]; }; DoWithLocks[c, action, details]; }; GetInputFocus: PUBLIC PROC [c: Connection] RETURNS [window: Window ¬ nullWindow, revertTo: FocusReversion] = { <<--window one of regular window, nullWindow or focusPointerRoot>> action: PROC [c: Connection] ~ { BInit[c, 43, 0, 1]; reply ¬ FinishWithReply[c]; }; reply: Reply; DoWithLocks[c, action, NIL]; CheckReply[reply]; revertTo ¬ VAL[ERead8[reply]]; Skip[reply, 6]; window ¬ ToWindow[c, ERead32[reply]]; DisposeReply[c, reply]; }; ListExtensions: PUBLIC PROC [c: Connection] RETURNS [LIST OF ROPE] ~ { action: PROC [c: Connection] ~ { BInit[c, 99, 0, 1]; reply ¬ FinishWithReply[c]; }; reply: Reply; head: LIST OF ROPE ~ LIST[NIL]; last: LIST OF ROPE ¬ head; nSTR: BYTE; DoWithLocks[c, action, NIL]; CheckReply[reply]; nSTR ¬ Read8[reply]; Skip[reply, 30]; FOR i: CARD16 IN [0..nSTR) DO name: ROPE ~ EReadRope[reply]; last ¬ last.rest ¬ LIST[name]; ENDLOOP; DisposeReply[c, reply]; RETURN [head.rest]; }; QueryExtension: PUBLIC PROC [c: Connection, name: ROPE] RETURNS [xr: QueryExtensionRec] = { action: PROC [c: Connection] ~ { BInit[c, 98, 0, 2+(leng+3)/4]; BPut16[c, leng]; BPut16[c, 0]; BPutPaddedRope[c, name]; reply ¬ FinishWithReply[c]; }; leng: INT ¬ Rope.Length[name]; reply: Reply; IF leng>100 THEN ERROR; DoWithLocks[c, action, NIL]; CheckReply[reply]; Skip[reply, 7]; xr.presentOnServer ¬ ERead8[reply]=1; xr.majorOpcode ¬ ERead8[reply]; xr.firstEvent ¬ ERead8[reply]; xr.firstError ¬ ERead8[reply]; DisposeReply[c, reply]; }; MapWindow: PUBLIC PROC [c: Connection, window: Window, details: Details] ~ { action: PROC [c: Connection] = { BInit[c, 8, 0, 2]; BPutDrawable[c, window]; FinishWithDetails[c, details]; }; DoWithLocks[c, action, details]; }; MapSubWindows: PUBLIC PROC [c: Connection, window: Window, details: Details] ~ { action: PROC [c: Connection] = { BInit[c, 9, 0, 2]; BPutDrawable[c, window]; FinishWithDetails[c, details]; }; DoWithLocks[c, action, details]; }; UnmapWindow: PUBLIC PROC [c: Connection, window: Window, details: Details] ~ { action: PROC [c: Connection] = { BInit[c, 10, 0, 2]; BPutDrawable[c, window]; FinishWithDetails[c, details]; }; DoWithLocks[c, action, details]; }; UnmapSubWindows: PUBLIC PROC [c: Connection, window: Window, details: Details] ~ { action: PROC [c: Connection] = { BInit[c, 11, 0, 2]; BPutDrawable[c, window]; FinishWithDetails[c, details]; }; DoWithLocks[c, action, details]; }; DestroyWindow: PUBLIC PROC [c: Connection, window: Window, details: Details] = { action: PROC [c: Connection] = { BInit[c, 4, 0, 2]; BPutDrawable[c, window]; FinishWithDetails[c, details]; }; DoWithLocks[c, action, details]; }; DestroySubWindows: PUBLIC PROC [c: Connection, window: Window, details: Details] = { action: PROC [c: Connection] = { BInit[c, 5, 0, 2]; BPutDrawable[c, window]; FinishWithDetails[c, details]; }; DoWithLocks[c, action, details]; }; Bell: PUBLIC PROC [c: Connection, percent: INT ¬ 0, details: Details] = { action: PROC [c: Connection] = { IF percent>=-100 AND percent<=100 THEN { BInit[c, 104, percent, 1]; FinishWithDetails[c, details]; }; IF details=NIL THEN XlPrivate.HardFlushBuffer[c, TRUE]; }; DoWithLocks[c, action, details]; }; PredefineAtoms[]; END.