<> <> <> <> <<>> DIRECTORY Basics, Customize, Rope, Xl, XlDetails, XlFontOps, XlDB; XlFontOpsImpl: CEDAR MONITOR IMPORTS Basics, Customize, Rope, Xl, XlDB, XlDetails EXPORTS XlFontOps = BEGIN OPEN XlFontOps; myKey: REF INT ~ NEW[INT]; Init: Xl.InitializeProcType = { rf: REF Xl.Font ¬ NEW[Xl.Font ¬ NIL]; XlDB.RegisterDBInvalidator[c, InvalidateDB, NIL]; RETURN [rf] }; InvalidateDB: Xl.EventProcType = { rf: REF Xl.Font ¬ NARROW[Xl.GetConnectionProp[event.connection, myKey]]; IF rf#NIL THEN rf­ ¬ Xl.nullFont; }; NiceOpenFont: PROC [c: Xl.Connection, name: Rope.ROPE] RETURNS [font: Xl.Font ¬ Xl.nullFont] = { font ¬ Xl.OpenFont[c, name, XlDetails.synchronousErrors ! Xl.XError => GOTO Oops]; EXITS Oops => RETURN [Xl.nullFont]; }; GetDefaultFont: PUBLIC PROC [c: Xl.Connection] RETURNS [font: Xl.Font] = { rf: REF Xl.Font ¬ NARROW[Xl.GetConnectionPropAndInit[c, myKey, Init]]; Each: PROC [name: Rope.ROPE, data: REF ¬ NIL] RETURNS [quit: BOOL] = { font ¬ NiceOpenFont[c, name]; quit ¬ font#Xl.nullFont }; IF rf=NIL THEN RETURN [Xl.nullFont]; font ¬ rf­; IF font=Xl.nullFont THEN { dbx: Customize.DBreadonly ¬ XlDB.GetStandardDB[c]; fontName: Rope.ROPE ¬ NIL; WITH Customize.DoQueryString[dbx, "(Cedar)(defaultFont)"] SELECT FROM r: Rope.ROPE => fontName ¬ r; ENDCASE => {}; IF Rope.IsEmpty[fontName] THEN fontName ¬ "8x13"; [] ¬ Each[fontName, NIL]; IF font=Xl.nullFont THEN { <<--Try hard. Don't crash simply because fonts are not loaded>> <<--It will be obvious if a bad font is chosen>> IF ~Rope.Equal[fontName, "8x13"] THEN [] ¬ Each["8x13", NIL]; IF font=Xl.nullFont THEN [] ¬ Each["serif12", NIL]; IF font=Xl.nullFont THEN Xl.ListFonts[c, Each, "*adobe-helvetica-medium*normal--12*", 3]; IF font=Xl.nullFont THEN Xl.ListFonts[c, Each, "*helvetica*", 3]; IF font=Xl.nullFont THEN Xl.ListFonts[c, Each, "*times*", 3]; IF font=Xl.nullFont THEN Xl.ListFonts[c, Each, "*", 5]; }; IF font#Xl.nullFont --don't overwrite old, possibly good default-- THEN rf­ ¬ font; } }; QueryPosInfo: PUBLIC PROC [c: Xl.Connection, font: Xl.Fontable, text: Rope.ROPE, x: INT] RETURNS [p: PosInfo ¬ [0, 0, 0]] = { fi: REF READONLY Xl.FontInfoRec ¬ Xl.QueryFont[c, font]; IF fi#NIL THEN p ¬ FindIdx[fi, text, x]; }; CharIsDefined: PROC [attributes: CARD16] RETURNS [BOOL] = INLINE { undocumentedNonExistChar: CARD16 = 04000H; <<--Protocol says server dependent>> <<--This numerical value copied from /net/pooh/pooh/X11R3/share/lib/X/XTextExt16.c>> RETURN [ (Basics.BITAND[attributes, undocumentedNonExistChar]=0) ] }; FindIdx: PROC [fi: REF READONLY Xl.FontInfoRec, text: Rope.ROPE, xPos: INT] RETURNS [pi: PosInfo ¬ [0, 0, 0]] = { charPos: INT ¬ 0; overallRight, overallWidth, lastOverallRight: INT ¬ 0; firstCol: INT ~ fi.minCharOrByte2; numCols: INT ~ fi.maxCharOrByte2-firstCol+1; length: INT ~ Rope.Length[text]; idx: INT; DO IF charPos>=length THEN RETURN [[charPos, charPos, overallRight]]; idx ¬ ORD[Rope.Fetch[text, charPos]]; idx ¬ idx - 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; idx ¬ idx - firstCol; IF idx<0 OR idx >= numCols THEN {charPos ¬ charPos+1; LOOP}; --char won't be printed }; TRUSTED { p: LONG POINTER TO READONLY Xl.CharInfoRec; IF fi.charInfos#NIL AND idx=xPos THEN { IF (overallRight-xPos)<(xPos-lastOverallRight) THEN RETURN [[gapIndex: charPos, charIndex: charPos-1, gapX: overallRight]] ELSE RETURN [[gapIndex: charPos-1, charIndex: charPos-1, gapX: lastOverallRight]]; }; ENDLOOP; }; END.