From 32c52cd5392988b371c6d925282ba65a2c80a967 Mon Sep 17 00:00:00 2001 From: Matt Heffron Date: Tue, 9 Dec 2025 14:06:38 -0800 Subject: [PATCH] Fixed unloaded charset didn't display. Checking for charset *known* to be EQ to the SLUG charset, didn't verify that the font *had* a SLUG charset, so was comparing to NIL, which excluded *all* unloaded charsets. --- lispusers/FONTSAMPLER | 50 ++++++++++++++++++++++--------------- lispusers/FONTSAMPLER.LCOM | Bin 7427 -> 7520 bytes 2 files changed, 30 insertions(+), 20 deletions(-) diff --git a/lispusers/FONTSAMPLER b/lispusers/FONTSAMPLER index f83435cd..cc932f12 100644 --- a/lispusers/FONTSAMPLER +++ b/lispusers/FONTSAMPLER @@ -1,12 +1,12 @@ (DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10) -(FILECREATED " 8-Dec-2025 22:17:11" {DSK}matt>Interlisp>medley>lispusers>FONTSAMPLER.;7 13846 +(FILECREATED " 9-Dec-2025 14:00:20" {DSK}matt>Interlisp>medley>lispusers>FONTSAMPLER.;2 14236 :EDIT-BY "mth" - :CHANGES-TO (FNS FontSample FontTable FontSampleFaked) + :CHANGES-TO (FNS FontTable FontSample) - :PREVIOUS-DATE " 5-Dec-2025 11:09:30" {DSK}matt>Interlisp>medley>lispusers>FONTSAMPLER.;1 + :PREVIOUS-DATE " 8-Dec-2025 22:17:11" {DSK}matt>Interlisp>medley>lispusers>FONTSAMPLER.;1 ) @@ -21,7 +21,7 @@ (FontSample [LAMBDA (Fonts CharacterSets Printer StreamType Hexadecimal ColumnMajor) - (* ; "Edited 8-Dec-2025 22:15 by mth") + (* ; "Edited 9-Dec-2025 13:48 by mth") (* ; "Edited 5-Dec-2025 11:06 by mth") (* ; "Edited 5-Feb-2025 17:02 by mth") (* ; "Edited 29-Apr-87 22:03") @@ -31,12 +31,10 @@ [Stream (OPENIMAGESTREAM Printer StreamType (LIST 'FONTS (CONS TitleFont FontList] (InchesToPrinterUnits (FTIMES 72.0 (DSPSCALE NIL Stream))) (LastFont (CAR (LAST FontList))) - [CharacterSets (if (LISTP CharacterSets) - then CharacterSets - elseif (MEMB CharacterSets '(T :INCORE :ALL :INTERESTING)) - then CharacterSets - else (LIST (OR CharacterSets 0] (AllCharacterSets (CONSTANT (for CS from 0 to 255 collect CS] + (CL:UNLESS [OR (LISTP CharacterSets) + (MEMB CharacterSets '(T :INCORE :ALL :INTERESTING] + (SETQ CharacterSets (LIST (OR CharacterSets 0)))) (DSPRIGHTMARGIN (fetch (REGION WIDTH) of (DSPCLIPPINGREGION NIL Stream)) Stream) (for Font in FontList do @@ -63,11 +61,24 @@ (* ;;  "Exclude any CharacterSet known to reference the SlugCharsetInfo") - (SETQ FontCharacterSets (for CS in FontCharacterSets - unless (EQ SlugCharsetInfo - (\GETCHARSETINFO Font - CS)) - collect CS)) + (CL:WHEN SlugCharsetInfo + + (* ;; + "Only if SlugCharsetInfo is non-NIL, else it won't load a requested charset") + + (SETQ FontCharacterSets + (for CS in FontCharacterSets + unless (EQ SlugCharsetInfo (\GETCHARSETINFO Font CS)) + collect CS))) + + (* ;; + "Probably ought to report charsets eliminated by the above.") + + (* ;; " At least report if NO charsets remain for this font.") + + (CL:UNLESS FontCharacterSets (printout T + "All requested character sets are empty for this font: " + Font T)) (for CharacterSet in FontCharacterSets bind (LastCharacterSet _ (CAR (LAST FontCharacterSets))) do (FontTable Font CharacterSet Stream @@ -93,7 +104,7 @@ (FontTable [LAMBDA (Font CharacterSet Stream FormFeed TitleFont InchesToPrinterUnits Hexadecimal ColumnMajor) - (* ; "Edited 8-Dec-2025 22:05 by mth") + (* ; "Edited 9-Dec-2025 13:23 by mth") (* ; "Edited 5-Dec-2025 11:09 by mth") (* ; "Edited 5-Feb-2025 17:03 by mth") (* ; "Edited 3-Feb-2025 20:07 by mth") @@ -106,10 +117,10 @@ " " (L-CASE Face T) " Character set ")) + (StreamType (IMAGESTREAMTYPE Stream)) [UseDisplayFontBitmaps (AND (EQ (FONTPROP Font 'DEVICE) 'DISPLAY) - (NOT (EQ (IMAGESTREAMTYPE Stream) - 'DISPLAY] + (NOT (EQ StreamType 'DISPLAY] [RelativeDescent (FQUOTIENT (FONTPROP Font 'DESCENT) (FONTPROP Font 'HEIGHT] (XCellSpacing (TIMES 0.45 InchesToPrinterUnits)) @@ -174,8 +185,7 @@ 'PAINT Stream) (CL:UNLESS UseDisplayFontBitmaps (DSPFONT Font Stream)) (for XPosition from (TIMES 0.75 InchesToPrinterUnits) by XCellSpacing as XCounter from 0 - to 15 bind [RangedCodesStreamType _ (MEMB (IMAGESTREAMTYPE Stream) - '(DISPLAY INTERPRESS] + to 15 bind [RangedCodesStreamType _ (MEMB StreamType '(DISPLAY INTERPRESS] do [for YPosition from (TIMES 9 InchesToPrinterUnits) by (MINUS YCellSpacing) as YCounter from 0 to 15 @@ -240,6 +250,6 @@ FONT) ) (DECLARE%: DONTCOPY - (FILEMAP (NIL (671 13683 (FontSample 681 . 4890) (FontSampleFaked 4892 . 5850) (FontTable 5852 . 13681 + (FILEMAP (NIL (655 14073 (FontSample 665 . 5357) (FontSampleFaked 5359 . 6317) (FontTable 6319 . 14071 ))))) STOP diff --git a/lispusers/FONTSAMPLER.LCOM b/lispusers/FONTSAMPLER.LCOM index 82afa9103085afefa837a890310672c10cc102b2..06eb6cb526aa01255366663b1062cb3d791e0362 100644 GIT binary patch delta 2314 zcmZWrU5pyn72W}No!!Kn9U$xVdX0~XMOezB`GtX4?hZfe#Rd*xu)Qlq9pPnaSYy~O z>6NvbNsOHdx7YNS5ZQX~1njVeDmQWPoe%UbSp(lZ0t>y!uP z{LVS|-t&ETewloj{Pm_cv6?ZqR|QUxftQjTmlVX?H!d9)Rv-Y%Q=cFtB{?bG{_NH7 zlN3*KVqj%9w4Tdn)8(vM$z~}0|6gT(!Mr*x(2E7p>@u&Ie`4n6S0Gs`XRqY&vbLI` zOw-RS-u_v_Ty`xK6-d{sd)4i(v8NebD1jJNS|wM!u$tab%UZUgg;&7!(^t%2xv%uvQ}p|*>K+_d z9dXvyKTwD6o%+%>msP*$7+fx9B;;83Xwf~Ky*OjX)#n*~?ykS(n!0y)ie+ci+I8D} zu)kv!SalA4?%{K|;JGvPC8IA}NTIm=kU|G5I5%xa-tE~IT*f)44C`jmk8lqIz9|a> zo_!xK>q{0c4n4S3U(y%#1q*#H-PivRmxB7D)qgxL*tl9`)df839v;P@r{87t$f#cA z*?NAAJjBS8awmEiMeZI7c0Iwa7tzBOhNxbc>V@>6g=by*+5Vp~9MnTpPi-80I9cZJ z?N$0wat}{o%%giOoZo*NJ*@gNo_7zExJI^qgVE28S~+L8LM6`WNedM!k*qKEbVZL@ zD7kd0|0yPexb0f;a$JVIs#QRa#ek-)RL+4cCxD(so+NH8iJ}Ov zk5Dt7KoDr6ZPOg#VPfMY(ezLAZk`j(*QSd-8IrkT8p~M_c^Y^uRx(*FUCxy%SOy`k z*zPB@4FacpH-@LSl4?E=lHj;Bh(n=VCK!V(Nf1z*P1rMj{D#r#8a3FS01-Myw*%GX zJp+uJyWLyxqxK$j>x~Wxt!~oBy<)yId)lSM2j5J;;~orWzn<>JAb0a>qt>kx5Q$oH zH#dyN^|}pdK_X3S{KT+j5iT@u?K(k(>2$m1Sox^pMWj9ci?#Q%Ib;7+Xe$ z7?h1>wcB{p$QYe%qh)W3Y~J&nctHZE`J0tnyN3Cd=e>Dize)KOa5qkxzx8gFQqJVE z%#k$*?aqLYaR2f1`H@gRV43f&IdOlV89!(L!!pwjCbFNi%+ZN-X4d?HFLWfvo;haT z@V(V5yuX$jVW#=wIA$mB2qR89!Xn`E5*LW#f~n^nU={W+^)RwFD#RSeXno{h z&nzLw=#qt;OBXDR?$lCt8VbdKe~l6f&Z?ciV@|Ty+ZQq1eBoda!NC404A+{cAH8ce zdl-K75jp<&Xy4oXmXx12-o?mxy7%g5cW@-Hfd?Iwi{X#(y0}>PDrf%^V(jjDjVBLHnlyj*KHH2VsYywcIw)t zaX}z~L2yQtl~50e9|;Ko63P$ehF0PNJs|Z^5bA{<-~b#*)jMT&?KEj}@XmZQ^S*gc z@0*wV@;mbT3;x7p+PFN)vwRGAUgqL5$KAYg=IQttgkWckm3dK)-Te9aC|Q!sa-p$- z$c&oJq>34(lu7SO?=2OAn{Oui;=l)1=lRYnvS5BPJhXQV zJm(_jCGYvRQt@v1D@_;u4cI@Qcf8BhAmi?Hpzo{m4(jo^yN1dz`|*&sGcez8XIBT^ z`rz%6hR1d1wu@l~@|7hU-dta{a*T2qhrFHrc+|J%`opb{SV*Zja-UK+#&EFD&TKmf zj^Lof!+3oN7`lU_0hfiNzV!f(=))EUJ3bt)2KAtR)WRW;KD7EJ4u|!iwfe9}Si4YQ zl&3N5?d-#dZ?)ytqg}q}6MRG$y^qnybnPIr$lpQH<`Zqcs6JugIPpyo-?$#JFznI8 zt6$+nSRW_8d~Nf~t!;i}@A5cG-p(W@e0qRUMsdp9Ig8WeRGbrXGrp5J@9n(o_v0at zerWB#AKm)tZfmFS-)Y}=5$9?Bl!Y>Jo+3_JPgp2rQea6Bx)yz;$TA#LX%A-%MzKb(qJ?+%wi3RiXIGEk6Zg%=HkG3&)CY^a|zkT)= z&U;ZmlU(MoE57I-$fJBO3vAS>A{h`bZhAP%`= zkz@=U$8WUvedzTh1@nb{$2X1~_^YoS1NG{KTBTK`i_VMW%o(+%sx2|x; zhuQjT*PJ8{QmJOeLD_As^dK$?i>c;~1__nQxCAT~nk%(dt=X_$35w;$l2NgfSG3l3 zqinw6>!%(TcGQTlu(O5-+HIz!mFzh|YjB{cvOMm9Gg!=N<2K4dR@Dj%b1EIYE%0LV z)ol5aQP*0=H3AZlYSwoGaca}3*R^Zq%eChkOOzr}6I+M_#Gq)@%dOfgM%q}pY&7gM z5lzm2%v|(;HYjZqj)AupGzS8U*(pa*jvBkt`gU;IxyfCxy2-frOgX?${k`wNKa6{? zGcPi~ZcPrdPV}1_fyf?_IdRbZJ@9Hf`^D6>v#wP?+{<3>F17s28DU3)f+T)C@{tp1F?d-fQ)_Z#C5C=Ivk9!AJK zg2OmEeZUztR(Aaij!$(5jeCd$-VHD(j$zcT^A<)uI&0y?a%I{sLpJyKU&tft?A-Zz z$|?5yR|SmJ4{mNuAgn)&kxKpegIiX;jgbf6P~g)C>;C#9a^9-l!tvgo{Q*CYF5{tJ z?&_m7Q>f|i+M~&h%FxH2HV=iOn&&`}Sjc5^(;&oHP;<&GX@nlFTxqdDViE*MYXw_R zBrFlqMddd^^HRu^kb5IPGia+`4o53u-=1nqc8#u6>>^9x0oi zoX5|d!m=z!;$(rOO5FjM6nb593C^)f`ExnaLt+aSsGOSXjtk)U_!BN&@7+5}(#)ZP zg13kT^WS4{D_k533JnL^1-oTY-R`bAYBWt!$tsJa8t$>3)$*N;i$3p7EJkchJM<-0!Zi=|4M1aSzR c4FMMyf&QUb02UHs^iJE$QB;)HhhKF64