XlImplTexts.mesa
Copyright Ó 1988, 1989, 1990, 1991, 1992, 1993 by Xerox Corporation. All rights reserved.
Christian Jacobi, April 13, 1988 11:53 am PST
Christian Jacobi, February 3, 1993 12:03 pm PST
Willie-s, October 30, 1991 10:51 am PST
Weiser, August 4, 1992 6:36 pm PDT
DIRECTORY
Basics,
Finalize,
FinalizeOps,
KeyMapping,
Rope,
SpecialKeySyms,
SymTab,
Xl,
XlDetails,
XlEndianPrivate,
XlGContextOps,
XlPrivate,
XlPrivateErrorHandling,
XlFontPrivate,
XlPrivateResources,
XlPrivateTypes,
XlService;
XlImplTexts:
CEDAR
MONITOR
LOCKS c
USING c: Connection
IMPORTS Basics, Finalize, FinalizeOps, KeyMapping, Rope, SymTab, Xl, XlDetails, XlEndianPrivate, XlGContextOps, XlPrivate, XlPrivateErrorHandling, XlPrivateResources, XlService
EXPORTS Xl, XlPrivateTypes
SHARES XlPrivateResources ~
BEGIN
OPEN Xl, XlPrivate;
ConnectionPrivateImplRec: TYPE = XlPrivateTypes.ConnectionPrivateImplRec;
<<Xl.>>ConnectionPrivate: PUBLIC TYPE = ConnectionPrivateImplRec;
FontRec: TYPE = XlFontPrivate.FontRec;
FontRep: PUBLIC TYPE = FontRec;
<<XlPrivateTypes.>>FontPrivate:
PUBLIC
TYPE =
RECORD [
table: SymTab.Ref, --never NIL
finalizationQueue: FinalizeOps.CallQueue --never NIL
];
ROPE: TYPE ~ Rope.ROPE;
TooLong: ERROR = CODE;
FontId:
PUBLIC
PROC [f: Font]
RETURNS [
ID] = {
Warning: Actual font on server is freed when font on host is garbage collected
RETURN [f.resourceID]
};
IsFont:
PUBLIC
PROC [x:
REF
ANY]
RETURNS [
BOOL] = {
RETURN [ISTYPE[x, REF FontRec]]
};
NarrowFont:
PUBLIC
PROC [x:
REF
ANY]
RETURNS [Font] = {
RETURN [NARROW[x, REF FontRec]]
};
GetFontStuff:
PROC [c: Connection]
RETURNS [fp:
REF FontPrivate] = {
InitFontTable:
ENTRY
PROC [c: Connection] = {
cPriv: REF ConnectionPrivateImplRec ~ c.cPriv;
IF cPriv#
NIL
AND cPriv.fontTable=
NIL
THEN {
fp ¬
NEW[FontPrivate¬[
table: SymTab.Create[case: FALSE],
finalizationQueue: FinalizeOps.CreateCallQueue[FinalizeFont]
]];
cPriv.fontTable ¬ fp;
}
};
IF Xl.Alive[c]
THEN {
cPriv: REF ConnectionPrivateImplRec ~ c.cPriv;
IF cPriv#
NIL
THEN {
fp ¬ cPriv.fontTable;
IF fp=NIL THEN {InitFontTable[c]; fp ¬ cPriv.fontTable};
}
};
};
FinalizeFont: FinalizeOps.FinalizeProc= {
RemoveFontFromFontCache:
PROC [font: Xl.Font] = {
owner: REF Connection ¬ font.owner;
IF owner#
NIL
AND ~font.dontFreeOnGC
THEN {
WITH font.reserved
SELECT
FROM
name: Rope.
ROPE => {
c: Connection ¬ owner;
fp: REF FontPrivate ~ GetFontStuff[c];
IF fp#
NIL
THEN {
UpdateTable: SymTab.UpdateAction = {
handle: Finalize.Handle;
TRUSTED {handle ¬ LOOPHOLE[val]};
IF handle=
NIL
OR Finalize.HandleToObject[handle]=font
THEN op ¬ delete
ELSE op ¬ none
};
SymTab.Update[fp.table, name, UpdateTable];
};
};
ENDCASE => {};
};
};
FreeFont:
PROC [font: Xl.Font] = {
action:
PROC [c: Connection] = {
XlPrivate.BInit[c, 46, 0, 2];
XlPrivate.BPut32[c, id];
XlPrivate.FinishWithDetails[c];
XlPrivateResources.InternalFreeResourceID[c, id];
};
id: ID;
IF font#
NIL
THEN {
owner: REF Connection ¬ font.owner;
IF ~font.dontFreeOnGC THEN RemoveFontFromFontCache[font];
IF owner#
NIL
THEN {
c: Connection ¬ owner;
id ¬ font.resourceID;
IF ~font.dontFreeOnGC
AND id#0
AND Xl.Alive[c]
AND XlPrivateResources.ValidID[c, id]
THEN {
DoWithLocks[c, action, XlDetails.ignoreErrors];
};
};
};
};
f: REF FontRec ~ NARROW[object];
FreeFont[f ! ANY => CONTINUE];
};
OpenFont:
PUBLIC
PROC [c: Connection, name: Rope.
ROPE, details: Details]
RETURNS [font:
REF FontRec] ~ {
handle: Finalize.Handle;
IF c=NIL AND Rope.Equal[name, "fake"] THEN RETURN [NEW[FontRec]];
BEGIN
cPriv: REF ConnectionPrivateImplRec ~ c.cPriv;
fp: REF FontPrivate ~ GetFontStuff[c];
IF fp#
NIL
THEN {
val: REF ~ SymTab.Fetch[fp.table, name].val;
IF val#
NIL
THEN {
TRUSTED {handle ¬ LOOPHOLE[val]};
font ¬ NARROW[ Finalize.HandleToObject[handle] ];
IF Finalize.GetFinalizationState[handle]=enabled THEN RETURN;
};
};
font ¬ NEW[FontRep];
font.owner ¬ cPriv.refRefSelf;
font.resourceID ¬ OpenFontId[c, name, details];
font.reserved ¬ name;
IF fp#
NIL
THEN {
handle ¬ FinalizeOps.EnableFinalization[font, fp.finalizationQueue];
[] ¬ SymTab.Store[fp.table, name, handle];
};
END;
};
OpenFontId:
PROC [c: Connection, name: Rope.
ROPE, details: Details]
RETURNS [font:
ID ¬ nullID] ~ {
n: INT ¬ Rope.Length[name];
action:
PROC [c: Connection] = {
font ¬ XlPrivateResources.NewResourceID[c];
BInit[c, 45, 0, 3+(n+3)/4];
BPut32[c, font]; -- id for the new font
BPut16[c, n]; -- length of name
BSkip[c, 2];
BPutPaddedRope[c, name];
FinishWithDetails[c, details];
};
IF n>=c.info.maxRequestLengthBytes THEN ERROR TooLong;
DoWithLocks[c, action, details];
};
PreventGcOnServer:
PUBLIC
PROC [font: Font] = {
font.dontFreeOnGC ¬ TRUE;
};
ListFonts:
PUBLIC
PROC [c: Connection, each: NameProc, pattern:
ROPE, maxNames:
NAT, data:
REF ¬
NIL] ~ {
reply: Reply; nSTR: CARD16;
action:
PROC [c: Connection] ~ {
BInit[c, 49, 0, 2+(n+3)/4];
BPut16[c, maxNames];
BPut16[c, n];
BPutPaddedRope[c, pattern];
reply ¬ FinishWithReply[c];
};
n: CARD16 ~ Rope.Length[pattern];
IF n>=c.info.maxRequestLengthBytes THEN ERROR TooLong;
DoWithLocks[c, action, NIL];
CheckReply[reply];
Skip[reply, 7];
nSTR ¬ ERead16[reply];
Skip[reply, 22];
FOR i:
CARD
IN [0..nSTR)
DO
name: ROPE ~ EReadRope[reply];
quit: BOOL ¬ each[name, data];
IF quit THEN EXIT;
ENDLOOP;
DisposeReply[c, reply];
};
GetFontPath:
PUBLIC
PROC [c: Connection]
RETURNS [
LIST
OF
ROPE] ~ {
action:
PROC [c: Connection] ~ {
BInit[c, 52, 0, 1];
reply ¬ FinishWithReply[c];
};
reply: Reply; nSTR: CARD16;
head: LIST OF ROPE ~ LIST[NIL];
last: LIST OF ROPE ¬ head;
DoWithLocks[c, action, NIL];
CheckReply[reply];
Skip[reply, 7];
nSTR ¬ ERead16[reply];
Skip[reply, 22];
FOR i:
CARD16
IN [0..nSTR)
DO
name: ROPE ~ EReadRope[reply];
last ¬ last.rest ¬ LIST[name];
ENDLOOP;
DisposeReply[c, reply];
RETURN [head.rest];
};
IntERead16:
PROC [r: Reply]
RETURNS [i:
INT] = {
small: INT16 ¬ LOOPHOLE[ERead16[r], INT16];
i ¬ small
};
QueryFont:
PUBLIC
PROC [c: Connection, font: Fontable]
RETURNS [inf:
REF
READONLY FontInfoRec] = {
WITH font
SELECT
FROM
f:
REF FontRec => {
inf ¬ f.info;
IF inf=
NIL
THEN {
inf ¬ f.info ¬ QueryFontID[c, f.resourceID];
};
};
ENDCASE => {
IF IsGContext[font]
THEN {
id: ID ¬ XlGContextOps.GCID[NarrowGContext[font], TRUE];
inf ¬ QueryFontID[c, id];
}
ELSE ERROR;
};
};
QueryFontID:
PROC [c: Connection, fontableId:
ID]
RETURNS [fi:
REF FontInfoRec] = {
reply: Reply;
action:
PROC [c: Connection] ~ {
BInit[c, 47, 0, 2];
BPut32[c, fontableId];
reply ¬ FinishWithReply[c];
};
DoWithLocks[c, action, NIL];
fi ¬ ReadFontReply[reply, TRUE].fi;
DisposeReply[c, reply];
};
ReplyCollectionRec:
TYPE =
RECORD [
count: INT ¬ 0,
list: LIST OF XlPrivate.Reply ¬ NIL,
tail: LIST OF XlPrivate.Reply ¬ NIL
];
InternalReportOneFont: <<INTERNAL>> XlPrivate.ReplyGotProc =
TRUSTED {
IF reply.cheat[0]=1
AND reply.cheat[1]#0
THEN {
rcr: REF ReplyCollectionRec ¬ NARROW[data];
new: LIST OF XlPrivate.Reply ¬ LIST[reply];
--reorder list to enumerate fonts in same order as server
IF rcr.count=0 THEN rcr.list ¬ new ELSE rcr.tail.rest ¬ new;
rcr.tail ¬ new;
rcr.count ¬ rcr.count + 1;
more ¬ TRUE
}
ELSE more ¬ FALSE
};
ListFontsWithInfo:
PUBLIC
PROC [c: Connection, each: FontInfoProc, pattern:
ROPE, maxNames:
NAT, data:
REF ¬
NIL]
RETURNS [count:
INT] = {
Sorry we do allocations, but this is not a frequent request
rcr: REF ReplyCollectionRec ¬ NEW[ReplyCollectionRec];
ProtectedListFontsWithInfo:
PROC [c: Connection] = {
XlPrivate.BInit[c, 50, 0, 2+(n+3)/4];
XlPrivate.BPut16[c, maxNames];
XlPrivate.BPut16[c, n];
XlPrivate.BPutPaddedRope[c, pattern];
XlPrivate.FinishWithMultipleReplies[c: c, callback: InternalReportOneFont, data: rcr];
};
n: INT ~ Rope.Length[pattern];
IF n>=c.info.maxRequestLengthBytes THEN XlPrivateErrorHandling.RaiseClientError[c, $tooLong];
XlPrivate.DoWithLocks[c, ProtectedListFontsWithInfo, NIL];
count ¬ rcr.count;
FOR l:
LIST
OF XlPrivate.Reply ¬ rcr.list, l.rest
WHILE l#
NIL
DO
info: REF FontInfoRec; name: Rope.ROPE;
[info, name] ¬ ReadFontReply[l.first, FALSE];
IF each[name: name, info: info, data: data].quit THEN EXIT;
ENDLOOP;
FOR l:
LIST
OF XlPrivate.Reply ¬ rcr.list, l.rest
WHILE l#
NIL
DO
XlPrivate.DisposeReply[c, l.first];
ENDLOOP;
};
ReadFontReply:
PROC [reply: XlPrivate.Reply, hasCharInfo:
BOOL]
RETURNS [fi:
REF FontInfoRec, name: Rope.
ROPE ¬
NIL] = {
hasCharInfo FALSE for ListFontsWithInfo
hasCharInfo TRUE for QueryFont
IF not hasCharInfo, assumes font name
ReadFontProp:
PROC [reply: XlPrivate.Reply]
RETURNS [fp: FontPropRec] = {
fp.name ¬ [XlPrivate.ERead32[reply]];
fp.value ¬ XlPrivate.ERead32[reply];
};
ReadCharInfo:
PROC [reply: XlPrivate.Reply, ci:
LONG
POINTER
TO CharInfoRec] =
TRUSTED {
ci.leftBearing ¬ LOOPHOLE[XlPrivate.ERead16[reply], INT16];
ci.rightBearing ¬ LOOPHOLE[XlPrivate.ERead16[reply], INT16];
ci.charWidth ¬ LOOPHOLE[XlPrivate.ERead16[reply], INT16];
ci.ascent ¬ LOOPHOLE[XlPrivate.ERead16[reply], INT16];
ci.descent ¬ LOOPHOLE[XlPrivate.ERead16[reply], INT16];
ci.attributes ¬ XlPrivate.ERead16[reply];
};
replyLeng: INT;
nameLength: INT;
fontPropNum: CARD16;
charInfoNum: CARD32;
prop: REF FontPropSequence;
fi ¬ NEW[FontInfoRec];
XlPrivate.CheckReply[reply];
nameLength ¬ XlPrivate.Read8[reply]; --In ListFontsWithInfo; not in QueryFont
XlPrivate.Skip[reply, 2]; --sequence number
replyLeng ¬ XlPrivate.ERead32[reply];
fi.minBounds ¬ NEW[CharInfoRec];
TRUSTED{ ReadCharInfo[reply, LOOPHOLE[fi.minBounds]] };
XlPrivate.Skip[reply, 4]; --unused
TRUSTED{ ReadCharInfo[reply, @fi.maxBounds] };
XlPrivate.Skip[reply, 4]; --unused
fi.minCharOrByte2 ¬ XlPrivate.ERead16[reply];
fi.maxCharOrByte2 ¬ XlPrivate.ERead16[reply];
fi.defaultChar ¬ XlPrivate.ERead16[reply];
fontPropNum ¬ XlPrivate.ERead16[reply];
fi.drawDirection ¬ VAL[XlPrivate.ERead8[reply]];
fi.minByte1 ¬ XlPrivate.ERead8[reply];
fi.maxByte1 ¬ XlPrivate.ERead8[reply];
fi.allCharsExist ¬ XlPrivate.ERead8[reply]#0;
fi.fontAscent ¬ LOOPHOLE[XlPrivate.ERead16[reply], INT16];
fi.fontDescent ¬ LOOPHOLE[XlPrivate.ERead16[reply], INT16];
charInfoNum ¬ XlPrivate.ERead32[reply]; --in ListFontsWithInfo this is replies-hint
fi.properties ¬ prop ¬ NEW[Xl.FontPropSequence[fontPropNum]];
FOR i:
CARD16
IN [0..fontPropNum)
DO
prop[i] ¬ ReadFontProp[reply];
ENDLOOP;
IF hasCharInfo
THEN {
--QueryFont
chars: REF CharInfoSequence;
IF charInfoNum>0
THEN {
fi.charInfos ¬ chars ¬ NEW[CharInfoSequence[charInfoNum]];
FOR i:
CARD32
IN [0..charInfoNum)
DO
TRUSTED{ ReadCharInfo[reply, @chars[i]] };
ENDLOOP
};
}
ELSE {
--ListFontsWithInfo
name ¬ ReadRopeOfKnownLength[reply, nameLength];
};
};
ReadRopeOfKnownLength:
PROC [r: XlPrivate.Reply, length:
NAT]
RETURNS [rope:
ROPE] =
TRUSTED {
Read a rope with already known length starting at current position.
Used only in the var part of a reply.
m: NAT ¬ length;
IF r.next<32 THEN ERROR;
WHILE m>0 AND r.varPart[r.next+m-33]=0 DO m ¬ m-1 ENDLOOP;
rope ¬ RopeFromRaw[p: LOOPHOLE[r.varPart], start: r.next-32, len: m];
r.next ¬ r.next + length;
};
QueryTextExtents16OnServer:
PROC [c: Connection, fontableID:
ID, s: String16]
RETURNS [te: TextExtentsRec] = {
reply: Reply;
r: ROPE ¬ s.s; --immutable now
n: INT ¬ Rope.Length[r];
odd: [0..1];
action:
PROC [c: Connection] ~ {
BInit[c, 48, odd, 2+(n+3)/4];
BPut32[c, fontableID];
BPutPaddedRope[c, r];
reply ¬ FinishWithReply[c];
};
IF n MOD 2 # 0 THEN ERROR TooLong;
odd ¬ (n/2) MOD 2;
DoWithLocks[c, action, NIL];
CheckReply[reply];
te.drawDirection ¬ VAL[ERead8[reply]];
[] ¬ ERead16[reply]; --sequence number
[] ¬ ERead32[reply]; --reply length
te.fontAscent ¬ IntERead16[reply];
te.fontDescent ¬ IntERead16[reply];
te.overallAscent ¬ IntERead16[reply];
te.overallDescent ¬ IntERead16[reply];
te.overallWidth ¬ LOOPHOLE[ERead32[reply]];
te.overallLeft ¬ LOOPHOLE[ERead32[reply]];
te.overallRight ¬ LOOPHOLE[ERead32[reply]];
DisposeReply[c, reply];
};
CharIsDefined:
PROC [attributes:
CARD16]
RETURNS [
BOOL] =
INLINE {
undocumentedNonExistChar:
CARD16 = 04000H;
--Protocol says server dependent
--This numerical value copied from /net/pooh/pooh/XlR3/share/lib/X/XTextExt16.c
RETURN [ (Basics.BITAND[attributes, undocumentedNonExistChar]=0) ]
};
QueryTextExtents:
PUBLIC
PROC [c: Connection, font: Fontable, r:
ROPE]
RETURNS [t: TextExtentsRec] = {
fi: REF READONLY FontInfoRec ¬ QueryFont[c, font];
TRUSTED {ComputeTextExtents[fi, r, @t]};
};
QueryTextExtents16:
PUBLIC
PROC [c: Connection, font: Fontable, s: String16]
RETURNS [t: TextExtentsRec] = {
fi: REF READONLY FontInfoRec ¬ QueryFont[c, font];
TRUSTED {ComputeTextExtents16[fi, s.s, @t]};
};
CharExtent:
PROC [p:
LONG
POINTER
TO
READONLY CharInfoRec, t:
LONG
POINTER
TO TextExtentsRec] =
TRUSTED {
--Executed for every character when computing extents
--t.fontAscent missused as counter
IF ~CharIsDefined[p.attributes] THEN RETURN;
t.overallAscent ¬ MAX[t.overallAscent, p.ascent];
t.overallDescent ¬ MAX[t.overallDescent, p.ascent];
t.overallLeft ¬ MIN[t.overallLeft, t.overallWidth+p.leftBearing];
t.overallRight ¬ MAX[t.overallRight, t.overallWidth+p.rightBearing];
t.overallWidth ¬ t.overallWidth+p.charWidth;
t.fontAscent ¬ t.fontAscent+1; --char counter
};
DoExtent:
PROC [fi:
REF
READONLY FontInfoRec, t:
LONG
POINTER
TO TextExtentsRec, r:
ROPE, charAction: Rope.ActionType] =
TRUSTED {
--Common part for TextExtents16 and TextExtents8
t.overallWidth ¬ 0;
t.fontAscent ¬ 0; --char counter
t.overallAscent ¬ FIRST[INT16];
t.overallDescent ¬ FIRST[INT16];
t.overallLeft ¬ LAST[INT32];
t.overallRight ¬ FIRST[INT32];
[] ¬ Rope.Map[base: r, action: charAction];
IF
--char counter--t.fontAscent=0
THEN {
t.overallAscent ¬ 0;
t.overallDescent ¬ 0;
t.overallLeft ¬ 0;
t.overallRight ¬ 0;
};
t.fontAscent ¬ fi.fontAscent;
t.fontDescent ¬ fi.fontDescent;
t.drawDirection ¬ fi.drawDirection;
};
ComputeTextExtents:
PROC [fi:
REF
READONLY FontInfoRec, r:
ROPE, t:
LONG
POINTER
TO TextExtentsRec] =
TRUSTED {
CharAction:
PROC [c:
CHAR]
RETURNS [quit:
BOOL ¬
FALSE] =
TRUSTED {
idx: INT ¬ ORD[c];
idx ¬ idx - firstCol; --separate statement because of arithmetic type
IF idx<0
OR idx>=numCols
OR (fi.charInfos#
NIL
AND fi.charInfos.size>idx
AND ~CharIsDefined[fi.charInfos[idx].attributes])
THEN {
idx ¬ fi.defaultChar; --separate statement because of arithmetic type
idx ¬ idx - firstCol;
IF idx<0 OR idx >= numCols THEN RETURN; --char won't be printed
};
TRUSTED {
--I don't want to optimize loop of fixed width font;
-- it is good enough to avoid calling the server
p: LONG POINTER TO READONLY CharInfoRec;
IF fi.charInfos#
NIL
AND idx<fi.charInfos.size
THEN p ¬ LOOPHOLE[fi.charInfos, LONG POINTER]+UNITS[CharInfoSequence[0]]+idx*UNITS[CharInfoRec]
ELSE p ¬ LOOPHOLE[fi.minBounds, LONG POINTER];
CharExtent[p, t]
};
};
firstCol: INT ¬ fi.minCharOrByte2;
numCols: INT ¬ fi.maxCharOrByte2-firstCol+1;
DoExtent[fi, t, r, CharAction];
};
ComputeTextExtents16:
PROC [fi:
REF
READONLY FontInfoRec, r:
ROPE, t:
LONG
POINTER
TO TextExtentsRec] =
TRUSTED {
highByte: INT;
oddChar: BOOL ¬ FALSE;
CharAction:
PROC [c:
CHAR]
RETURNS [quit:
BOOL ¬
FALSE] =
TRUSTED {
idx: INT;
lowByte: INT ¬ ORD[c];
oddChar ¬ ~oddChar;
IF oddChar THEN {highByte ¬ lowByte; RETURN};
IF fi.maxByte1=0
THEN {
idx ¬ highByte*256 + lowByte - firstCol;
IF idx<0
OR idx>=numCols
OR (fi.charInfos#
NIL
AND fi.charInfos.size>idx
AND ~CharIsDefined[fi.charInfos[idx].attributes])
THEN {
idx ¬ fi.defaultChar; --separate statement because of arithmetic type
idx ¬ idx - firstCol;
IF idx<0 OR idx >= numCols THEN RETURN; --char won't be printed
};
}
ELSE {
row: INT ¬ highByte - firstRow;
col: INT ¬ lowByte - firstCol;
IF row<0
OR col<0
OR row>=numRows
OR col>=numCols
THEN {
row ¬ fi.defaultChar / 256 - firstRow;
col ¬ fi.defaultChar MOD 256 - firstCol;
IF row<0 OR col<0 OR row >= numRows OR col >= numCols THEN RETURN; --char won't be printed
};
idx ¬ row*numCols + col;
};
TRUSTED {
--I don't want to optimize loop of fixed width font;
-- it is good enough to avoid calling the server
p: LONG POINTER TO READONLY CharInfoRec;
IF fi.charInfos#
NIL AND idx<fi.charInfos.size
THEN p ¬ LOOPHOLE[fi.charInfos, LONG POINTER]+UNITS[CharInfoSequence[0]]+idx*UNITS[CharInfoRec]
ELSE p ¬ LOOPHOLE[fi.minBounds, LONG POINTER];
CharExtent[p, t]
};
};
firstCol: INT ¬ fi.minCharOrByte2;
numCols: INT ¬ fi.maxCharOrByte2-firstCol+1;
firstRow: INT ¬ fi.minByte1;
numRows: INT ¬ fi.maxByte1-firstRow+1;
DoExtent[fi, t, r, CharAction];
};
QueryKeymap:
PUBLIC
PROC [c: Connection, reUse:
REF KeyboardState ¬
NIL]
RETURNS [rka:
REF KeyboardState] = {
action:
PROC [c: Connection] ~ {
BInit[c, 44, 0, 1];
reply ¬ FinishWithReply[c];
};
reply: Reply;
DoWithLocks[c, action, NIL];
IF reUse=NIL THEN rka ¬ NEW[KeyboardState] ELSE rka ¬ reUse;
TRUSTED {
FixPart: TYPE = PACKED ARRAY [0..24) OF BYTE;
VarPart: TYPE = PACKED ARRAY [0..8) OF BYTE;
src1: LONG POINTER TO FixPart = LOOPHOLE[LOOPHOLE[@reply.fix, CARD32]+UNITS[VarPart]];
dst1: LONG POINTER TO FixPart = LOOPHOLE[rka];
src2: LONG POINTER TO VarPart = LOOPHOLE[reply.varPart];
dst2: LONG POINTER TO VarPart ¬ LOOPHOLE[LOOPHOLE[rka, CARD32] + UNITS[FixPart]];
dst1 ¬ src1;
dst2 ¬ src2;
};
DisposeReply[c, reply];
};
KeyboardMapping: TYPE = REF KeyboardMappingImplRec;
KeyboardMappingRep: PUBLIC TYPE = KeyboardMappingImplRec;
KMappingCacheRep: PUBLIC TYPE = KeyboardMappingImplRec;
KeyboardMappingImplRec:
TYPE =
RECORD [
min, max: KeyCode,
firstKeyCode: KeyCode,
count: INT,
symsPerCode: BYTE,
stuff: REF Basics.RawBytes,
mapping: KeyMapping.Mapping
];
GetKeyboardMapping:
PUBLIC
PROC [c: Xl.Connection]
RETURNS [mapping: Xl.KeyboardMapping] = {
action:
PROC [c: Connection] ~ {
keyTable: KeyMapping.KeyTable;
maxCode: KeyCode;
count: BYTE ¬ 255;
firstKeyCode: KeyCode ¬ keycode0;
replyLength: INT; symsPerCode: BYTE;
km: REF KeyboardMappingImplRec ¬ NEW[KeyboardMappingImplRec];
IF firstKeyCode<Info[c].minKeycode
THEN {
count ¬ count - (ORD[Info[c].minKeycode]-ORD[firstKeyCode]);
firstKeyCode ¬ Info[c].minKeycode;
};
count ¬ MIN[count, ORD[Info[c].maxKeycode]-ORD[firstKeyCode]+1];
km.firstKeyCode ¬ firstKeyCode;
km.count ¬ count;
km.min ¬ Info[c].minKeycode;
km.max ¬ Info[c].maxKeycode;
BInit[c, 101, 0, 2];
BPut8[c, ORD[firstKeyCode]];
BPut8[c, count];
BPut16[c, 0]; --unused
reply ¬ FinishWithReply[c];
internal to protect the cache setting
IF reply.fix[0]#1 THEN RETURN --not a reply--;
km.stuff ¬ reply.varPart;
symsPerCode ¬ ERead8[reply];
Skip[reply, 2]; --sequencenumber
replyLength ¬ ERead32[reply];
km.symsPerCode ¬ symsPerCode;
IF replyLength # km.symsPerCode*km.count THEN ERROR;
[keyTable, maxCode] ¬ MakeKeyTable[km];
km.mapping ¬ mapping ¬ KeyMapping.NewMapping[keyTable, maxCode];
XlService.PutServiceProp[c, $x11PrivateKMappings, km];
cp.kMappings ¬ km;
};
reply: Reply;
cp: REF ConnectionPrivateImplRec ~ c.cPriv;
cache: REF KeyboardMappingImplRec ¬ cp.kMappings; --copy because it could be nilled out
IF cache#
NIL
THEN RETURN [cache.mapping]
ELSE
WITH XlService.GetServiceProp[c, $x11PrivateMMappings]
SELECT
FROM
km: REF KeyboardMappingImplRec => {cp.kMappings ¬ km; RETURN [km.mapping]};
ENDCASE => {
DoWithLocks[c, action, NIL];
--do not return reply to scratch pool; it is used in GetKeySym
CheckReply[reply];
reply.varPart ¬ NIL;
DisposeReply[c, reply];
};
};
MakeKeyTable:
PROC [xKeyMap:
REF KeyboardMappingImplRec]
RETURNS [keyTable: KeyMapping.KeyTable, maxCode: Xl.KeyCode] = {
tab: KeyMapping.KeyTable;
min, max: Xl.KeyCode;
count: BYTE ¬ XMapCount[xKeyMap];
[min, max] ¬ XMapRange[xKeyMap];
tab ¬ NEW[KeyMapping.KeyTableRep ¬ ALL[NIL]];
FOR keyCode: Xl.KeyCode
IN [min..max]
DO
ks: REF KeyMapping.KeySymsRep ¬ NEW[KeyMapping.KeySymsRep[count]];
FOR n:
BYTE
IN [0..count)
DO
ks[n] ¬ XMapKeyCode[xKeyMap, keyCode, n];
ENDLOOP;
tab[keyCode] ¬ ks;
ENDLOOP;
BEGIN
ksl: REF KeyMapping.KeySymsRep ¬ NEW[KeyMapping.KeySymsRep[1]];
ksm: REF KeyMapping.KeySymsRep ¬ NEW[KeyMapping.KeySymsRep[1]];
ksr: REF KeyMapping.KeySymsRep ¬ NEW[KeyMapping.KeySymsRep[1]];
ksl[0] ¬ SpecialKeySyms.Button1; tab[VAL[1]] ¬ ksl;
ksm[0] ¬ SpecialKeySyms.Button2; tab[VAL[2]] ¬ ksm;
ksr[0] ¬ SpecialKeySyms.Button3; tab[VAL[3]] ¬ ksr;
END;
keyTable ¬ tab;
maxCode ¬ MAX[max, VAL[3]]; -- MDW August 4, 1992, to leave room for the three button mappings if there are no other keys
};
MMappingCacheRep: PUBLIC TYPE = ModifierMappingSequence;
GetModifierMapping:
PUBLIC
PROC [c: Connection]
RETURNS [modifierMapping: ModifierMapping] = {
cp: REF ConnectionPrivateImplRec ~ c.cPriv;
cache: REF ModifierMappingSequence ¬ cp.mMappings;
IF cache#NIL THEN RETURN [cache]
ELSE
WITH XlService.GetServiceProp[c, $x11PrivateMMappings]
SELECT
FROM
mm: REF ModifierMappingSequence => {cp.mMappings ¬ mm; RETURN [mm]};
ENDCASE => {
reply: Reply;
action:
PROC [c: Connection] ~ {
mm: REF ModifierMappingSequence; keycodesPerModifier: BYTE;
BInit[c, 119, 0, 1];
reply ¬ FinishWithReply[c];
internal to protect the cache setting
IF reply.fix[0]#1 THEN RETURN --not a reply--;
keycodesPerModifier ¬ ERead8[reply];
Skip[reply, 30];
mm ¬ NEW[ModifierMappingSequence[keycodesPerModifier]];
FOR i:
BYTE
IN [0..mm.num)
DO
FOR m: Modifier
IN [shift..mod5]
DO
mm[i][m] ¬ VAL[ERead8[reply]];
ENDLOOP;
ENDLOOP;
XlService.PutServiceProp[c, $x11PrivateMMappings, mm];
cp.mMappings ¬ modifierMapping ¬ mm;
};
DoWithLocks[c, action, NIL];
CheckReply[reply];
DisposeReply[c, reply];
};
};
PMappingCacheRep: PUBLIC TYPE = PointerMappingSequence;
GetPointerMapping:
PUBLIC
PROC [c: Connection]
RETURNS [pointerMapping: PointerMapping] = {
cp: REF ConnectionPrivateImplRec ~ c.cPriv;
cache: REF PointerMappingSequence ¬ cp.pMappings; --local copy protects nilling out
IF cache#NIL THEN RETURN [cache]
ELSE
WITH XlService.GetServiceProp[c, $x11PrivateMMappings]
SELECT
FROM
pm: REF PointerMappingSequence => {cp.pMappings ¬ pm; RETURN [pm]};
ENDCASE => {
reply: Reply;
action:
PROC [c: Connection] ~ {
pm: REF PointerMappingSequence; n: BYTE;
BInit[c, 117, 0, 1];
reply ¬ FinishWithReply[c];
--internal to protect the cache setting
IF reply.fix[0]#1 THEN RETURN --not a reply--;
n ¬ ERead8[reply]; --length of cache
Skip[reply, 30];
pm ¬ NEW[PointerMappingSequence[n+1]];
pm[0] ¬ 0;
FOR i:
BYTE
IN [1..pm.leng)
DO
pm[i] ¬ ERead8[reply];
ENDLOOP;
XlService.PutServiceProp[c, $x11PrivateMMappings, pm];
cp.pMappings ¬ pointerMapping ¬ pm;
};
DoWithLocks[c, action, NIL];
CheckReply[reply];
DisposeReply[c, reply];
};
};
XMapCount:
PUBLIC
PROC [mapping:
REF KeyboardMappingImplRec]
RETURNS [count:
BYTE] = {
RETURN [mapping.symsPerCode]
};
XMapRange:
PUBLIC
PROC [mapping:
REF KeyboardMappingImplRec]
RETURNS [min, max: KeyCode] = {
maxCard: CARDINAL ¬ ORD[mapping.firstKeyCode]+mapping.count-1;
min ¬ mapping.firstKeyCode;
max ¬ VAL[maxCard];
};
XMapKeyCode:
PUBLIC
PROC [mapping:
REF KeyboardMappingImplRec, key: KeyCode, no:
INT ¬ 0]
RETURNS [keysym: KeySym ¬ [0]] = {
index: INT;
IF no<0 OR no>=mapping.symsPerCode THEN RETURN;
IF key<mapping.firstKeyCode THEN RETURN;
IF ORD[key]>=ORD[mapping.firstKeyCode]+mapping.count THEN RETURN;
index ¬ ((INT[ORD[key]]-ORD[mapping.firstKeyCode]) * mapping.symsPerCode + no)*4;
TRUSTED {
keysym ¬ [XlEndianPrivate.InlineRawGet32[LOOPHOLE[mapping.stuff], index]];
};
};
END.