From ef5012f9dd34bf173d03b58631f17ef8a8545eda Mon Sep 17 00:00:00 2001 From: rmkaplan Date: Fri, 17 Apr 2026 14:34:36 -0700 Subject: [PATCH] Better control over source of fonts --- library/IMPORTFONTS | 69 ++++++----- library/IMPORTFONTS.LCOM | Bin 25748 -> 25943 bytes sources/FONT | 195 +++++++++++++++++------------- sources/FONT.LCOM | Bin 65717 -> 66382 bytes sources/MEDLEYFONTFORMAT | 215 +++++++++++++++++----------------- sources/MEDLEYFONTFORMAT.LCOM | Bin 22260 -> 21955 bytes 6 files changed, 262 insertions(+), 217 deletions(-) diff --git a/library/IMPORTFONTS b/library/IMPORTFONTS index 5c960d3e..153a7346 100644 --- a/library/IMPORTFONTS +++ b/library/IMPORTFONTS @@ -1,12 +1,12 @@ (DEFINE-FILE-INFO :PACKAGE "INTERLISP" :READTABLE "INTERLISP" :BASE 10 :FORMAT :UTF-8) -(FILECREATED " 5-Apr-2026 14:27:30" {WMEDLEY}IMPORTFONTS.;94 59200 +(FILECREATED "16-Apr-2026 22:39:37" {WMEDLEY}IMPORTFONTS.;98 60135 :EDIT-BY rmk - :CHANGES-TO (FNS IMPORTFONTS IMPORTFONTS.DIRECTORY FAKEFACE) + :CHANGES-TO (FNS LEGACYDISPLAYFONT) - :PREVIOUS-DATE " 5-Apr-2026 11:51:28" {WMEDLEY}IMPORTFONTS.;92) + :PREVIOUS-DATE "15-Apr-2026 22:10:41" {WMEDLEY}IMPORTFONTS.;97) (PRETTYCOMPRINT IMPORTFONTSCOMS) @@ -29,6 +29,7 @@ (IMPORTFONTS [LAMBDA (PHASE FONTSPECS DEVICE FROMDIRECTORY TODIRECTORY IMPORTFN NODRIBBLE) + (* ; "Edited 11-Apr-2026 10:55 by rmk") (* ; "Edited 5-Apr-2026 14:22 by rmk") (* ; "Edited 3-Apr-2026 08:15 by rmk") (* ; "Edited 1-Apr-2026 08:25 by rmk") @@ -61,7 +62,8 @@ (IMPORTFONTS.CONTEXT PHASE FROMDIRECTORY TODIRECTORY DEVICE)) (IMPORTFONTS.CLEAR PHASE FONTSPECS TODIRECTORY DEVICE) (SETQ FONTSPECS (IMPORTFONTS.FONTSPECS PHASE FONTSPECS FROMDIRECTORY DEVICE)) - (CL:WHEN (AND (CDR FONTSPECS) + (CL:WHEN (AND (IGEQ (LENGTH FONTSPECS) + 5) (NOT NODRIBBLE)) (* ;  "Put all the dribbles together one up") [DRIBBLE (PSEUDOFILENAME (PACKFILENAME 'BODY @@ -195,7 +197,8 @@ 'REGION]))]) (FONT.TO.MCCS - [LAMBDA (FONT) (* ; "Edited 10-Mar-2026 00:23 by rmk") + [LAMBDA (FONT) (* ; "Edited 11-Apr-2026 15:43 by rmk") + (* ; "Edited 10-Mar-2026 00:23 by rmk") (* ; "Edited 7-Mar-2026 12:55 by rmk") (* ; "Edited 1-Mar-2026 13:43 by rmk") (* ; "Edited 7-Oct-2025 17:13 by rmk") @@ -212,20 +215,20 @@ (LET [(PAIRS (MCCSMAPPAIRS (FONTPROP FONT 'CHARENCODING] (CL:WHEN PAIRS (MOVEFONTCHARS PAIRS FONT FONT) + (replace (FONTDESCRIPTOR FONTCOMPLETEP) of FONT with NIL) (* ;; "Keep the map function even for coerced MCCS fonts--can still be used for code conversion (e.g. Tedit file updating) ") [replace (FONTDESCRIPTOR FONTTOMCCSFN) of FONT with (MCCSMAPFN (FONTPROP FONT 'CHARENCODING] - (replace (FONTDESCRIPTOR FONTCOMPLETEP) of FONT with NIL) (CL:WHEN (MEMB (FONTPROP FONT 'CHARENCODING) - '(GACHA XCCS$ ALTOTEXT PALATINO UNICODE)) + '(GACHA XCCS$ ALTOTEXT PALATINO UNICODE HIPPO CYRILLIC)) (replace (FONTDESCRIPTOR FONTCHARENCODING) of FONT with 'MCCS) (* ; "These fonts made it all the way") (CHARSETPROP (\GETCHARSETINFO FONT 0) 'CSCHARENCODING 'MCCS)) - T)]) + FONT)]) (IMPORTFONTS.FONTSPECS [LAMBDA (PHASE FONTSPECS FROMDIRECTORY DEVICE) (* ; "Edited 4-Apr-2026 11:41 by rmk") @@ -678,7 +681,9 @@ (IMPORTFONTS 'IMPORT FONTSPECS 'DISPLAY NIL NIL (FUNCTION LEGACYDISPLAYFONT]) (LEGACYDISPLAYFONT - [LAMBDA (FONTSPEC FROMDIRECTORY) (* ; "Edited 31-Mar-2026 15:01 by rmk") + [LAMBDA (FONTSPEC FROMDIRECTORY) (* ; "Edited 16-Apr-2026 22:37 by rmk") + (* ; "Edited 12-Apr-2026 13:22 by rmk") + (* ; "Edited 31-Mar-2026 15:01 by rmk") (* ; "Edited 28-Mar-2026 09:27 by rmk") (* ;; "Loads legacy display fonts (ac or strike format, gacha, terminal, helevetica...) from FROMDIRECTORY. If NIL, the current directory") @@ -691,9 +696,9 @@ FROMDIRECTORY) `(PROGN (FONTDEVICEPROP 'DISPLAY 'FONTEXTENSIONS OLDVALUE] (for CSNO CSINFO (FONT ← (FONTSPEC.TO.FONTDESCRIPTOR FONTSPEC 255)) from 0 to 255 - do [SETQ CSINFO (\READCHARSET FONTSPEC CSNO FONT '((AC ACFONT.FILEP ACFONT.GETCHARSET) - (STRIKE STRIKEFONT.FILEP - STRIKEFONT.GETCHARSET] + do (SETQ CSINFO (\READCHARSET FONT CSNO '((AC ACFONT.FILEP ACFONT.GETCHARSET) + (STRIKE STRIKEFONT.FILEP STRIKEFONT.GETCHARSET)) + FROMDIRECTORY)) (* ;; "NIL means empty") @@ -746,22 +751,28 @@ (DEFINEQ (PEF - [LAMBDA (PHASE FONTSPEC CHARSET DIRECTORY) (* ; "Edited 30-Mar-2026 09:14 by rmk") + [LAMBDA (PHASE FONTSPEC CHARSET DIRECTORY) (* ; "Edited 12-Apr-2026 19:32 by rmk") + (* ; "Edited 30-Mar-2026 09:14 by rmk") (* ; "Edited 25-Mar-2026 00:11 by rmk") (* ; "Edited 22-Mar-2026 00:19 by rmk") (* ; "Edited 16-Mar-2026 08:43 by rmk") (* ; "Edited 13-Mar-2026 10:33 by rmk") - (CL:UNLESS CHARSET (SETQ CHARSET 0)) (if (type? FONTSPEC FONTSPEC) then (SETQ FONTSPEC (\FONT.CHECKARGS FONTSPEC NIL NIL NIL NIL T)) else (SETQ FONTSPEC (FONTSPECFROMFILENAME FONTSPEC))) (LET* ((DIR (IMPORTFONTS.DIRECTORY FONTSPEC DIRECTORY (IMPORTFONTS.SUBDIR PHASE))) (FONTFILE (MEDLEYFONT.FILENAME FONTSPEC DIR)) TITLETAG CHARSETNAME) - (if (NLSETQ (MEDLEYFONT.FILEP FONTFILE)) - then (SETQ CHARSET (OR (CHARSET.DECODE CHARSET) - 0)) - (SETQ TITLETAG (CL:IF (EQ PHASE 'MCCS) + (SETQ CHARSET (if (EQ CHARSET T) + then (for C in (MEDLEYFONT.GETFILEPROP FONTFILE 'CHARSETS) + unless (OR (KANJICHARSETP C) + (CHINESECHARSETP C)) collect C) + elseif (CHARSET.DECODE CHARSET) + else 0)) + (if (LISTP CHARSET) + then (for C in CHARSET do (PEF PHASE FONTSPEC C DIRECTORY T)) + elseif (NLSETQ (MEDLEYFONT.FILEP FONTFILE)) + then (SETQ TITLETAG (CL:IF (EQ PHASE 'MCCS) 'MCCS (L-CASE PHASE T))) (SETQ CHARSETNAME (CHARSET.ENCODE CHARSET)) @@ -892,15 +903,15 @@ (FILESLOAD EDITFONT) (DECLARE%: DONTCOPY - (FILEMAP (NIL (1215 32446 (IMPORTFONTS 1225 . 12900) (FONT.TO.MCCS 12902 . 15025) ( -IMPORTFONTS.FONTSPECS 15027 . 22493) (IMPORTFONTS.CONTEXT 22495 . 26086) (IMPORTFONTS.NOCACHE 26088 . -26339) (IMPORTFONTS.DIRECTORY 26341 . 28506) (IMPORTFONTS.CLEAR 28508 . 31075) (IMPORTFONTS.SUBDIR -31077 . 31825) (IMPORTFONTS.DIRSIZE 31827 . 32444)) (32447 35871 (IMPORTFONTS.AVAILABLE 32457 . 33072) - (IMPORTFONTS.EXISTS? 33074 . 33680) (IMPORTFONTS.DEPLOY 33682 . 35869)) (35872 42467 (FAKEFACE 35882 - . 39619) (FAKEFACE.FROMFILE 39621 . 41777) (FAKEFACE.FROMFONT 41779 . 42465)) (42468 45798 ( -IMPORTFONTS.PHASES 42478 . 43219) (MISSINGFACE 43221 . 45796)) (45842 47607 (IMPORT.DISPLAY 45852 . -46175) (LEGACYDISPLAYFONT 46177 . 47605)) (47656 49870 (IPF 47666 . 48433) (IPFSIZES 48435 . 49868)) ( -49871 55607 (PEF 49881 . 51945) (AEF 51947 . 52691) (IEF 52693 . 53296) (MEF 53298 . 53899) (CEF 53901 - . 54506) (FEF 54508 . 55327) (EFCLOSE 55329 . 55605)) (55608 59155 (SHOWCHARS 55618 . 57648) ( -CSSOURCE 57650 . 58363) (FONTDEFFONTS 58365 . 59153))))) + (FILEMAP (NIL (1190 32701 (IMPORTFONTS 1200 . 13028) (FONT.TO.MCCS 13030 . 15280) ( +IMPORTFONTS.FONTSPECS 15282 . 22748) (IMPORTFONTS.CONTEXT 22750 . 26341) (IMPORTFONTS.NOCACHE 26343 . +26594) (IMPORTFONTS.DIRECTORY 26596 . 28761) (IMPORTFONTS.CLEAR 28763 . 31330) (IMPORTFONTS.SUBDIR +31332 . 32080) (IMPORTFONTS.DIRSIZE 32082 . 32699)) (32702 36126 (IMPORTFONTS.AVAILABLE 32712 . 33327) + (IMPORTFONTS.EXISTS? 33329 . 33935) (IMPORTFONTS.DEPLOY 33937 . 36124)) (36127 42722 (FAKEFACE 36137 + . 39874) (FAKEFACE.FROMFILE 39876 . 42032) (FAKEFACE.FROMFONT 42034 . 42720)) (42723 46053 ( +IMPORTFONTS.PHASES 42733 . 43474) (MISSINGFACE 43476 . 46051)) (46097 48043 (IMPORT.DISPLAY 46107 . +46430) (LEGACYDISPLAYFONT 46432 . 48041)) (48092 50306 (IPF 48102 . 48869) (IPFSIZES 48871 . 50304)) ( +50307 56542 (PEF 50317 . 52880) (AEF 52882 . 53626) (IEF 53628 . 54231) (MEF 54233 . 54834) (CEF 54836 + . 55441) (FEF 55443 . 56262) (EFCLOSE 56264 . 56540)) (56543 60090 (SHOWCHARS 56553 . 58583) ( +CSSOURCE 58585 . 59298) (FONTDEFFONTS 59300 . 60088))))) STOP diff --git a/library/IMPORTFONTS.LCOM b/library/IMPORTFONTS.LCOM index cbbabb6a1d3274873f8d542c1dee62e2f19828cd..461923226c2ea6b01dce180d13baade814c1f077 100644 GIT binary patch delta 3898 zcmZu!OKcoj6?MCv$!8`X+i`vnxG4=o9K}t&_v&i|q+DGc*SNc@r>mTfMPOp5?YJ|J z+p;|h!-5tp03jjGP>4-7zzzXYW=vQOlQj_nu>tmo-7JD;!3v4<>en4ISvarWz4zSv z?!SNf$I{=Qmfqc%X2zVevpdICZV>15!k*XPdq)hcSvsbS(iod(py>*&?XKVH-{0wN zt#@htTRXdZUzn%5cinMUs(#q2J1e!I8BuSWl-hE=PNN`|N=2dW>OLf2K02G7k|Gj>OVhoWUSPwbkxq(j`qqJ{vDNnCQD!b*RG=k$)e=|1JN%#N)pnJvZLbVrO}JVr#s^<9|&& z{LF|r?^L>XrH*Gmd2;WE9qr)Zp{M1N7H=H=WMFfOymqVY!>yK1I5ZiKrYMevRva}G zacN$U7QrF3p&&O47B<9CO^TcaV)}>1=qJ zE70shzc$3zOd}W93?5&5`RqU|o+8Y`P9fBUFKR9~hzV9m2{mO;3EWQE;2myS>C3p0 zqGTLeel4sKM9y=q1I8I2p)fn;10=IjwJ8!a5f$k=s2b&GMO2uYx+&#Xt<2S`A?Ugn z$%OZtwSbtau_8?BEuQ)=6GEsGC90bH!nQ?nWg8Z`^}t;sTery#S}PKfY|W;ISFL+V zK~_3#Kk_O`ZQ4SM-*8S3$i@TZO{*QW$U&-`#55sQY0=mZ27m zm0CM!B%l^-cY{W&?&WGM{`~VS)fzRZebIBOsX?Y~Bz9Dypwe(rg{G;-w~x;pw+W8H zV_IbDnazf+XRkG^JRpXZzC)TG1x^$+$T0KFG~g6jD2X2pEf0zz3I<-B)Dc$QQuF%J z3$U-~85$#*`&oVINL3jeUBC`m7&^;Cq9a^sa5S4Ct!K)bVaC5$n;vMoMhi>fO1Q9G zBMo+Cm92?9r#0lFgw%LB9v znbd$rtH|?HDpD!QG$t&K{6;HiM<`$&jVs}nRt>osLXvW;cwf$~4t-(6lTE)FMou&G z<=}D`op$I&;Q*DybGt0GoCMy2RRy|*T*(Z#@EQj*(?kr?Iv6P`GKI))RUsIFih%lTrHLVFnd z+uc0{-*~t}m)G9jr|teeJ=pE-@2_vqCNm#Yl#@am{q6ld+KeAgo*zi*r3DD;2AZeJ zwTgNSA8@g}ze;y^*B{W@JNRNcT4>6FGa9H8_4ik|Xs`F}b?WU&4wMo88yce_=M`Gr z?&fx6W@u>Z%Eszj>)n9@ZL*dWxwmYsWBrgg$RkCrGF@yV`~Ad6xE2_HO7H$oe>Y_l zhO}N1;ML2uI=TyCQ<{~tM=Az|qkCa%xk<(>6mjH};`VoXfR#jD8>CbnG8}<_4um84 zDG0__27(|+BWUic5`bZR4GEa1nY;-jppGH)6q1Z8#zDcTA_zI-VQH>y+p#r$ae$g; zs;X90GSJecY6Ej3k&}3akZ`!fxKS$dpvq_CablKqWRN0*peLd-#5kj$WQZD&q_Bop zD$k`yZ~N}7Lh$VXRL!dbTUDk**v+>{SFMoM+Jx3;z=FJO#GTMRHbc3qwS+dDs=vKYZZTqb#XvdounkQ+|Z?yt)SK5BP?z{1Q<=nxa zFMLut`nunjx;j$_PyO$dO8mfI`rhG^8ULw$>5M_4KR7%Lfv5ELg(T%}ExA*LW>JxwH!Aa*xz5Mv4#?&Ld^yaC=p9klH^zhr@ z)SD-sG#?)iPHbNI<{#?gw;ug1IPuy?kN%VJJucr{o9LE5xY&I((=APwj$U(uDYtk0 zko4B{c=_?io2MpE9lI?*JFi~o^~Xq_Ub`?^J|3J&Ag0ni`*#z;>8W47KlbbR!$|w$ ziQ8byByxet;B)^c@Y(q6avv+|$k@&&vrPYV`fA1ctD#xs^Bqk-8_rl|vXfQZ6|1hm z%*?2|Nr4+V^=#;geDV%ZE10)f*-+9Pl_Jpin=V=uNB>SluqJT^^mz3q1c$*MZf8VUIxZwCUIJFny>rW6>jjpk-an9 zBGVO<%e}KqCXe3@&W>Xd`c>eZlq>ywGiW!QI#v=Me|+QoC61y=>X)NJ(*u6OWM`7YYVyPJszhfw#Vxk*Qw}A&1dUw z8mEa@OF_a2aX^RzWfp|AoZt^wErC5D^{^*aLL523odcIjoVXxpZEp<0_!8L$*Oq6l*Xj+= z?Re$TtG+;#7^gq|nRZ5ybhxfZj|(*Wf@)SPuX(ky>n&5M-SKYM{cf;Qg}4`_v65sZ zZfi92^ygII$Nw(eEzDOz?|M`t1S58)?YTj8cgi^bn}t^<3cX@a@7?V2=(kg^T@&hc zZUX-R7CcoVd1!8HX?VodAm^$Lb4^#35&Ik-;8D2u-x^V z?S_|WvDsr{i5KR}*_I+m7uhhJLZ>x&c`xkKR5%f1VM-0$31#xa$hJ~f zO*>15X(e8$W)J;x=r_qUv$`}95!EJf3{4|Th{NoIs?pr{u{Xq~Y^RdgF(xkEyjR9Oq|1eI=$1dL33Rq(91 z1&UJX5PIIo1{x|E07hPy211d-Odc~BNLC6_y*i3J*g&r;X$H&Wa|lb_;dy`Zyghl| zoje~fT82< z7aCNWX+qGw0&^>-R+gMlGo&G**5Ol`b9Bv(h0BgJS8Ni4*Cp3*y91%)ZP_%#bwNaL^=g zJ@i^Z-EYAGhvK-R(kp)T4tB2EDh&Ja2#bAx`$)sL)T4Lju1zu{`oY}S?kVJ21#l@1 z2;icq&)@^mQt+E}|8VC6+I)g9CNT;V3cN80wQw-p*rTKV_jjm&q$to5`0qrQK-2$k z?#f6fZFl3noo(C*Ox3-nu8h4MTnmZ`IoH(Tv5n(lIEeiP*ud7(`i~9H_pCm4>QgDYd5%w;Izr~}O%9Q1ca>L_6xEg54acsP=HN(e_HWAO|- zCl!M5DkEs++lrrI=bRw022*|uMnIj8e$z-1>KNiVp^jlR8l%Lphaas0_4kj48~ek4 zd^2r5*f>1e86rOp`jY9oUew9NgjOb*nEJ6irN`t-4S?7kS`iQFsBpk(W0@qXL{piN zG3)MNe~335SG|Hh`FcL zZQ_+RwMAj zcWRCD>J300x`CDKdR}$KEeBqpV0KKH(5>7qH@Y5x7;VHw|GISeb^6tStO!Ku2*@m&9ysxtJUb z1rf90@Q4Ow)%NAX&KQw z-?;oOoR6xW0{qH|@2PC#siR9Fita7XT`PB10}N@7fRtK(r&(^GFGTdu-c{(wsizJn z%;NL`S28MWClL9l(Hm;W8$fAsEAI~8-`~b;Q7xzj%@=_2HW=(GJm#V1CWA+PqEy=J WZ_F|r3#x-L#_;{sFONT.;780 256466 +(FILECREATED "17-Apr-2026 08:42:29" {MEDLEY}FONT.;788 259513 :EDIT-BY rmk - :CHANGES-TO (FNS \CREATEDISPLAYFONT) + :CHANGES-TO (FNS FAKEFACE.CHARSET \READCHARSET FONTFILES) + (OPTIMIZERS FONTPROP) - :PREVIOUS-DATE " 5-Apr-2026 11:55:11" {WMEDLEY}FONT.;779) + :PREVIOUS-DATE "15-Apr-2026 22:12:03" {WMEDLEY}FONT.;785) (PRETTYCOMPRINT FONTCOMS) @@ -619,7 +620,9 @@ (CLOSEF? STRM))))]) (\READCHARSET - [LAMBDA (FONTSPEC CHARSET FONT CHARSETFNS) (* ; "Edited 2-Apr-2026 15:52 by rmk") + [LAMBDA (FONT CHARSET CHARSETFNS) (* ; "Edited 16-Apr-2026 22:38 by rmk") + (* ; "Edited 12-Apr-2026 12:59 by rmk") + (* ; "Edited 2-Apr-2026 15:52 by rmk") (* ; "Edited 28-Mar-2026 07:51 by rmk") (* ; "Edited 17-Mar-2026 08:57 by rmk") (* ; "Edited 12-Mar-2026 13:39 by rmk") @@ -639,13 +642,13 @@ (* ;; "This finds the first file in the directories/extensions order that contains information about charset, determines its format, and reads it in. The assumption is that the first such existing file is the one we want. ") - (CL:WHEN (AND FONTSPEC (EQ 0 (fetch (FONTSPEC FSROTATION) of FONTSPEC))) + (CL:WHEN (EQ 0 (FONTPROP FONT 'ROTATION)) (RESETLST - (for FILE STRM CSINFO in (FONTFILES FONTSPEC CHARSET) + (for FILE STRM CSINFO in (FONTFILES FONT CHARSET) do (* ;; "We know that FILE exists and is the best source of information about charset--maybe none. We assume FILE is one of the valid formats, we open it separately for each format-type, and ensure it is closed on exit. We can't used CL:WITHOPEN-FILE because that doesn't exist in the loadup when the first font is created.") - (for FNS in [OR CHARSETFNS (FONTDEVICEPROP FONTSPEC 'CHARSETFNS) + (for FNS in [OR CHARSETFNS (FONTDEVICEPROP FONT 'CHARSETFNS) '((MEDLEYFONT MEDLEYFONT.FILEP MEDLEYFONT.GETCHARSET] do [RESETSAVE (SETQ STRM (OPENSTREAM FILE 'INPUT)) `(PROGN (CLOSEF? OLDVALUE] @@ -662,11 +665,12 @@ (* ;; "The file didn't know its own encoding") (CHARSETPROP CSINFO 'CSCHARENCODING - (APPLY* (OR (FONTDEVICEPROP FONTSPEC 'ENCODINGFN) + (APPLY* (OR (FONTDEVICEPROP FONT 'ENCODINGFN) (FUNCTION NILL)) FONTSPEC))) (CL:UNLESS (CHARSETPROP CSINFO 'SOURCE) - (CHARSETPROP CSINFO 'SOURCE (create FONTSPEC using FONTSPEC))) + [CHARSETPROP CSINFO 'SOURCE (create FONTSPEC + using (FONTPROP FONT 'DEVICESPEC]) (replace (CHARSETINFO CHARSETNO) of CSINFO with CHARSET) (RETURN))) @@ -932,7 +936,8 @@ (DEFINEQ (MAKEFONTSPEC - [LAMBDA (FAMILY SIZE FACE ROTATION DEVICE BASE) (* ; "Edited 7-Nov-2025 07:52 by rmk") + [LAMBDA (FAMILY SIZE FACE ROTATION DEVICE BASE) (* ; "Edited 15-Apr-2026 00:25 by rmk") + (* ; "Edited 7-Nov-2025 07:52 by rmk") (* ; "Edited 28-Aug-2025 14:32 by rmk") (* ; "Edited 17-Aug-2025 20:44 by rmk") @@ -940,12 +945,13 @@ (* ;; "BASE (fontspec or font) provides defaults for NIL arguments, essentialy models a (create using BASE...)") - (CL:WHEN (FONTP BASE) - (SETQ BASE (FONTPROP BASE 'SPEC))) + (CL:WHEN FACE + (SETQ FACE (\FONTFACE FACE))) (create FONTSPEC FSFAMILY ← (OR FAMILY (fetch (FONTSPEC FSFAMILY) of BASE)) FSSIZE ← (OR SIZE (fetch (FONTSPEC FSSIZE) of BASE)) - FSFACE ← (OR FACE (fetch (FONTSPEC FSFACE) of BASE)) + FSFACE ← (OR (AND FACE (\FONTFACE FACE)) + (fetch (FONTSPEC FSFACE) of BASE)) FSROTATION ← (OR ROTATION (fetch (FONTSPEC FSROTATION) of BASE)) FSDEVICE ← (OR DEVICE (fetch (FONTSPEC FSDEVICE) of BASE]) @@ -1136,7 +1142,8 @@ (fetch (FONTDESCRIPTOR \SFHeight) of (FONTCREATE FONTSPEC]) (FONTPROP - [LAMBDA (FONT PROP) (* ; "Edited 28-Mar-2026 07:51 by rmk") + [LAMBDA (FONT PROP) (* ; "Edited 12-Apr-2026 12:52 by rmk") + (* ; "Edited 28-Mar-2026 07:51 by rmk") (* ; "Edited 18-Mar-2026 23:11 by rmk") (* ; "Edited 25-Jan-2026 20:08 by rmk") (* ; "Edited 2-Dec-2025 16:01 by rmk") @@ -1167,6 +1174,8 @@ (BACKCOLOR (ffetch BACKCOLOR of (ffetch FONTFACE of FONT))) (ROTATION (ffetch ROTATION of FONT)) (DEVICE (ffetch FONTDEVICE of FONT)) + (FILENAME (CL:WHEN (ffetch FONTFILENAME of FONT) + (INFILEP (ffetch FONTFILENAME of FONT)))) (CHARENCODING [OR (ffetch FONTCHARENCODING of FONT) (freplace FONTCHARENCODING of FONT with (if (MEMB (fetch (FONTDESCRIPTOR FONTFAMILY) of FONT) @@ -1258,6 +1267,7 @@ (FONTTOMCCSFN `(fetch (FONTDESCRIPTOR FONTTOMCCSFN) of ,(CAR ARGS))) (MAXCHARSET `(MAXCHARSET ,(CAR ARGS))) + (FILENAME `(fetch (FONTDESCRIPTOR FONTFILENAME) of ,(CAR ARGS))) 'IGNOREMACRO)) (* "END EXPORTED DEFINITIONS") @@ -1860,7 +1870,8 @@ (DEFINEQ (FONTFILES - [LAMBDA (FONTSPEC CHARSET DIRLST EXTLST) (* ; "Edited 28-Aug-2025 14:42 by rmk") + [LAMBDA (FONTSPEC CHARSET DIRLST EXTLST) (* ; "Edited 16-Apr-2026 22:26 by rmk") + (* ; "Edited 28-Aug-2025 14:42 by rmk") (* ; "Edited 25-Aug-2025 10:22 by rmk") (* ; "Edited 16-Aug-2025 21:03 by rmk") (* ; "Edited 11-Jul-2025 09:42 by rmk") @@ -1871,15 +1882,27 @@ (* ; "Edited 17-May-2025 00:06 by rmk") (* ; "Edited 15-May-2025 16:29 by rmk") - (* ;; "Considers all posible names for font files that respect the given characteristics, returns a list of the names of files that actually exist somewhere in DIRLST. Does not validate their contents.") + (* ;; "Considers all posible names for font files that respect the given characteristics, returns a list of the names of files that actually exist somewhere in DIRLST. If FONTSPEC is a FONT with a FILENAME that exists, that is the only one returned. Does not validate their contents.") - (LET (FAMILY SIZE FACE ROTATION DEVICE) - (SPREADFONTSPEC FONTSPEC) - [SETQ DIRLST (MKLIST (OR DIRLST (FONTDEVICEPROP DEVICE 'FONTDIRECTORIES] - [SETQ EXTLST (MKLIST (OR EXTLST (FONTDEVICEPROP DEVICE 'FONTEXTENSIONS] - (CL:UNLESS CHARSET (SETQ CHARSET \DEFAULTCHARSET)) - (APPEND (MKLIST (\FINDFONTFILE FAMILY SIZE FACE ROTATION DEVICE 'NOCHARSET DIRLST EXTLST)) - (MKLIST (\FINDFONTFILE FAMILY SIZE FACE ROTATION DEVICE CHARSET DIRLST EXTLST]) + (if (type? FONTDESCRIPTOR FONTSPEC) + then + (* ;; "Prefer the same version, but maybe a different version if coming up in a new environment? Or always the latest version?") + + (OR [MKLIST (INFILEP (FONTPROP FONTSPEC 'FILENAME] + [AND (FONTPROP FONTSPEC 'FILENAME) + (MKLIST (INFILEP (PACKFILENAME 'VERSION NIL 'BODY (FONTPROP FONTSPEC + 'FILENAME] + (FONTFILES (FONTPROP FONTSPEC 'DEVICESPEC) + CHARSET DIRLST EXTLST)) + else (LET (FAMILY SIZE FACE ROTATION DEVICE) + (SETQ FONTSPEC (\FONT.CHECKARGS FONTSPEC NIL NIL NIL NIL T)) + (SPREADFONTSPEC FONTSPEC) + [SETQ DIRLST (MKLIST (OR DIRLST (FONTDEVICEPROP DEVICE 'FONTDIRECTORIES] + [SETQ EXTLST (MKLIST (OR EXTLST (FONTDEVICEPROP DEVICE 'FONTEXTENSIONS] + (CL:UNLESS CHARSET (SETQ CHARSET \DEFAULTCHARSET)) + (APPEND (MKLIST (\FINDFONTFILE FAMILY SIZE FACE ROTATION DEVICE 'NOCHARSET DIRLST + EXTLST)) + (MKLIST (\FINDFONTFILE FAMILY SIZE FACE ROTATION DEVICE CHARSET DIRLST EXTLST]) (\FINDFONTFILE [LAMBDA (FAMILY SIZE FACE ROTATION DEVICE CHARSET DIRLST EXTLST) @@ -1918,7 +1941,8 @@ (for EXT inside EXTENSIONS collect (\FONTFILENAME FAMILY SIZE FACE EXT 0]) (\FONTFILENAME - [LAMBDA (FAMILY SIZE FACE EXTENSION CHARSET) (* ; "Edited 22-Jan-2026 14:25 by rmk") + [LAMBDA (FAMILY SIZE FACE EXTENSION CHARSET) (* ; "Edited 15-Apr-2026 00:44 by rmk") + (* ; "Edited 22-Jan-2026 14:25 by rmk") (* ; "Edited 11-Jul-2025 09:39 by rmk") (* ; "Edited 15-May-2025 15:51 by rmk") (* ; "Edited 5-Mar-93 16:10 by rmk:") @@ -1947,14 +1971,15 @@ (* ;; "Fortunately, PACKFILENAME ignores packages") - (SETQ FILENAME (PACKFILENAME.STRING 'NAME (CONCAT (CL:IF CSETNAME + [SETQ FILENAME (PACKFILENAME.STRING 'NAME (CONCAT (CL:IF CSETNAME (CONCAT "c" CSETNAME ">") "") FAMILY SIZEPATT "-" (FONTFACETOATOM FACE) (CL:IF CSETNAME (CONCAT "-C" CSETNAME) "")) - 'EXTENSION EXTENSION)) + 'EXTENSION + (OR EXTENSION (CAR (MKLIST (FONTDEVICEPROP DEVICE 'FONTEXTENSIONS] (* ;;  " Avoid adjacent wildcards because some devices (notably old DSK) get exponentially slower.") @@ -2802,13 +2827,15 @@ do (push FONTSFOUND THISFONT))) finally (RETURN (DREVERSE FONTSFOUND]) (FLUSHFONTCACHE - [LAMBDA (CACHES FAMILY SIZE FACE ROTATION DEVICE) (* ; "Edited 4-Apr-2026 23:04 by rmk") + [LAMBDA (CACHES FAMILY SIZE FACE ROTATION DEVICE) (* ; "Edited 15-Apr-2026 22:11 by rmk") + (* ; "Edited 12-Apr-2026 11:54 by rmk") + (* ; "Edited 4-Apr-2026 23:04 by rmk") (* ; "Edited 27-Nov-2025 10:02 by rmk") (* ; "Edited 22-Nov-2025 15:52 by rmk") (* ;; "Removes information for font(s) from the caches in CACHES, if CACHES is NIL, all caches are flushed") - (for CACHE NFLUSHED inside (OR CACHES '(:INCORE :EXISTS :AVAILABLE)) declare (SPEVARS NFLUSHED) + (for CACHE NFLUSHED inside (OR CACHES '(:INCORE :EXISTS :AVAILABLE)) declare (SPECVARS NFLUSHED) first (CL:WHEN (type? FONTSPEC FAMILY) (SPREADFONTSPEC (\FONT.CHECKARGS FAMILY SIZE FACE ROTATION DEVICE T))) (CL:UNLESS FAMILY @@ -2827,6 +2854,7 @@ (:AVAILABLE \FONTSAVAILABLEFILECACHE) (\ILLEGAL.ARG CACHE)) (FUNCTION (LAMBDA (FM S FC R DPAIR) + (DECLARE (USEDFREE NFLUSHED)) (CL:WHEN (AND (OR (EQ FAMILY FM) (EQ FAMILY '*)) (OR (EQ SIZE S) @@ -3089,7 +3117,7 @@ (NIL SIGNEDWORD) (* ; "Was FBBDX") (NIL SIGNEDWORD) (* ; "Was FBBDY") (FONTTOMCCSFN POINTER) (* ; "Was \SFLKerns. Function that translates codes in the font's pre-MCCS encoding into MCCS (e.g. Hippo A to Greek,Alpha) ") - (NIL POINTER) (* ; "Was \SFRWidths") + (FONTFILENAME POINTER) (* ; "For a font read from a Medleyfont file, the name of that file. For access to future properties and to instantiate future charsets.") (FONTDEVICESPEC POINTER) (* ;  "Holds the spec by which the font is known to the printing device, if coercion has been done") (OTHERDEVICEFONTPROPS POINTER) (* ; @@ -3477,7 +3505,7 @@ (NIL SIGNEDWORD) (NIL SIGNEDWORD) (FONTTOMCCSFN POINTER) - (NIL POINTER) + (FONTFILENAME POINTER) (FONTDEVICESPEC POINTER) (OTHERDEVICEFONTPROPS POINTER) (FONTSCALE POINTER) @@ -3541,7 +3569,8 @@ (DEFINEQ (\CREATEFONT - [LAMBDA (FONTSPEC) (* ; "Edited 4-Apr-2026 23:29 by rmk") + [LAMBDA (FONTSPEC) (* ; "Edited 15-Apr-2026 00:13 by rmk") + (* ; "Edited 4-Apr-2026 23:29 by rmk") (* ; "Edited 2-Apr-2026 23:01 by rmk") (* ; "Edited 31-Mar-2026 22:55 by rmk") (* ; "Edited 18-Mar-2026 22:44 by rmk") @@ -3562,7 +3591,8 @@ 'FONTCREATE] (if FN then (APPLY* FN FONTSPEC) - elseif (MEDLEYFONT.READ.FONT FONTSPEC NIL T) + elseif (MEDLEYFONT.READ.FONT (CAR (FONTFILES FONTSPEC)) + NIL T) else (FONTSPEC.TO.FONTDESCRIPTOR FONTSPEC)) elseif [SETQ COERCIONSPEC (CAR (COERCEFONTSPEC FONTSPEC 'FONTCOERCIONS] then @@ -3584,7 +3614,8 @@ then (FONTSPEC.TO.FONTDESCRIPTOR FONTSPEC (MAXCHARSET (\CREATEFONT COERCIONSPEC]) (\CREATECHARSET - [LAMBDA (CHARSET FONT GETCHARSETFN) (* ; "Edited 4-Apr-2026 14:39 by rmk") + [LAMBDA (CHARSET FONT GETCHARSETFN) (* ; "Edited 12-Apr-2026 18:47 by rmk") + (* ; "Edited 4-Apr-2026 14:39 by rmk") (* ; "Edited 31-Mar-2026 17:44 by rmk") (* ; "Edited 29-Mar-2026 10:33 by rmk") (* ; "Edited 27-Mar-2026 07:52 by rmk") @@ -3605,16 +3636,16 @@ (* ;; "Creates and returns the CHARSETINFO for charset CHARSET in fontdesc FONT, installing it in FONT's FONTCHARSETVECTOR") (OR (\GETCHARSETINFO FONT CHARSET) - (LET ((FONTSPEC (FONTPROP FONT 'DEVICESPEC)) - CSINFO) (* ; + (LET (CSINFO) (* ;  "Use DEVICESPEC in case it was coerced") (SETQ CSINFO (if [OR GETCHARSETFN (SETQ GETCHARSETFN (CAR (GETMULTI IMAGESTREAMTYPES (fetch (FONTDESCRIPTOR FONTDEVICE) of FONT) 'CREATECHARSET] - then (APPLY* GETCHARSETFN FONTSPEC FONT CHARSET) - else (\READCHARSET FONTSPEC CHARSET FONT))) + then (APPLY* GETCHARSETFN (FONTPROP FONT 'DEVICESPEC) + FONT CHARSET) + else (\READCHARSET FONT CHARSET))) (CL:WHEN CSINFO (* ;  "CSINFO could be a slug, an instantiated charset, or NIL meaning uninstantiated") (\INSTALLCHARSETINFO FONT CSINFO CHARSET))]) @@ -3732,7 +3763,8 @@ (DEFINEQ (\CREATEDISPLAYFONT - [LAMBDA (FONTSPEC) (* ; "Edited 11-Apr-2026 10:10 by rmk") + [LAMBDA (FONTSPEC) (* ; "Edited 15-Apr-2026 00:20 by rmk") + (* ; "Edited 11-Apr-2026 10:10 by rmk") (* ; "Edited 29-Mar-2026 10:23 by rmk") (* ; "Edited 16-Mar-2026 12:39 by rmk") (* ; "Edited 28-Aug-2025 16:00 by rmk") @@ -3750,10 +3782,12 @@ (* ;; "FONTEXISTS? has determined that there is at least one source file for this font, so the font exists in at least some character sets.") - (MEDLEYFONT.READ.FONT FONTSPEC NIL T]) + (MEDLEYFONT.READ.FONT (CAR (FONTFILES FONTSPEC)) + NIL T]) (\CREATECHARSET.DISPLAY - [LAMBDA (FONTSPEC FONT CHARSET) (* ; "Edited 5-Apr-2026 10:02 by rmk") + [LAMBDA (FONTSPEC FONT CHARSET) (* ; "Edited 12-Apr-2026 18:52 by rmk") + (* ; "Edited 5-Apr-2026 10:02 by rmk") (* ; "Edited 1-Apr-2026 10:32 by rmk") (* ; "Edited 29-Mar-2026 10:30 by rmk") (* ; "Edited 17-Mar-2026 16:11 by rmk") @@ -3771,7 +3805,7 @@ (* ;; "") - (if (\READCHARSET FONTSPEC CHARSET FONT) + (if (\READCHARSET FONT CHARSET) else (* ;; "Successful transformations must set the CSINFO so that it can be returned.") @@ -3827,7 +3861,8 @@ (DEFINEQ (FAKEFACE.CHARSET - [LAMBDA (FONT CHARSET FAKEFN SOURCEFONT) (* ; "Edited 5-Apr-2026 00:25 by rmk") + [LAMBDA (FONT CHARSET FAKEFN SOURCEFONT) (* ; "Edited 17-Apr-2026 08:42 by rmk") + (* ; "Edited 5-Apr-2026 00:25 by rmk") (* ; "Edited 1-Apr-2026 09:10 by rmk") (* ; "Edited 31-Mar-2026 00:39 by rmk") (* ; "Edited 24-Mar-2026 10:26 by rmk") @@ -3850,7 +3885,7 @@ (CL:WHEN (AND (SETQ SCSINFO (\GETCHARSETINFO SOURCEFONT CHARSET)) (NOT (fetch (CHARSETINFO CSSLUGP) of SCSINFO))) (if (OR (KANJICHARSETP CHARSET) - (CHINESECHARSETP CHARSET)) + (UNIHANCHARSETP CHARSET)) then (SETQ FCSINFO (COPYALL SCSINFO)) (* ; "Copy and set up an indirect") (CHARSETPROP FCSINFO 'SOURCE (FONTPROP SOURCEFONT 'DEVICESPEC)) (\INSTALLCHARSETINFO FONT FCSINFO CHARSET) @@ -4075,41 +4110,41 @@ (ADDTOVAR LAMA FONTCOPY FONTDEVICEPROP) ) (DECLARE%: DONTCOPY - (FILEMAP (NIL (6426 16093 (CHARWIDTH 6436 . 7225) (CHARWIDTHY 7227 . 8744) (STRINGWIDTH 8746 . 9783) ( -\CHARWIDTH.DISPLAY 9785 . 10200) (\STRINGWIDTH.DISPLAY 10202 . 10630) (\STRINGWIDTH.GENERIC 10632 . -16091)) (16094 22726 (DEFAULTFONT 16104 . 17389) (FONTCLASS 17391 . 19663) (FONTCLASSUNPARSE 19665 . -20566) (FONTCLASSCOMPONENT 20568 . 21156) (SETFONTCLASSCOMPONENT 21158 . 21600) (GETFONTCLASSCOMPONENT - 21602 . 22724)) (24174 43430 (FONTCREATE 24184 . 27429) (FONTCREATE1 27431 . 30090) ( -FONTCREATE.SLUGFD 30092 . 32656) (\FONT.CHECKARGS1 32658 . 37363) (\FONTCREATE1.NOFN 37365 . 37579) ( -FONTFILEP 37581 . 38469) (\READCHARSET 38471 . 43010) (FONTCHARSETS 43012 . 43428)) (43431 50507 ( -\FONT.CHECKARGS 43441 . 50190) (\CHARSET.CHECK 50192 . 50505)) (50508 56868 (COERCEFONTSPEC 50518 . -56179) (COERCEFONTSPEC.TARGETFACE 56181 . 56866)) (59063 62042 (MAKEFONTSPEC 59073 . 60410) ( -FONTSPEC.TO.FONTDESCRIPTOR 60412 . 62040)) (62043 71705 (COMPLETE.FONT 62053 . 64078) (COMPLETEFONTP -64080 . 64818) (COMPLETE.CHARSET 64820 . 68886) (PRUNESLUGCSINFOS 68888 . 70199) (MONOSPACEFONTP 70201 - . 71703)) (71744 81312 (FONTASCENT 71754 . 72138) (FONTDESCENT 72140 . 72625) (FONTHEIGHT 72627 . -73029) (FONTPROP 73031 . 80589) (\AVGCHARWIDTH 80591 . 81310)) (82035 83905 (FONTDEVICEPROP 82045 . -83903)) (84022 84876 (EDITCHAR 84032 . 84874)) (84922 97112 (GETCHARBITMAP 84932 . 86056) ( -PUTCHARBITMAP 86058 . 88216) (\GETCHARBITMAP.CSINFO 88218 . 90234) (\PUTCHARBITMAP.CSINFO 90236 . -97110)) (97113 119454 (MOVECHARBITMAP 97123 . 99017) (MOVEFONTCHARS 99019 . 104169) (\MOVEFONTCHAR -104171 . 109043) (\MOVEFONTCHARS.SOURCEDATA 109045 . 115800) (\MAKESLUGCHAR 115802 . 118337) ( -SLUGCHARP 118339 . 119452)) (120369 132218 (FONTFILES 120379 . 122212) (\FINDFONTFILE 122214 . 124191) - (\FONTFILENAMES 124193 . 124753) (\FONTFILENAME 124755 . 127666) (FONTSPECFROMFILENAME 127668 . -132216)) (132219 168552 (FONTCOPY 132229 . 137312) (FONTP 137314 . 137613) (FONTUNPARSE 137615 . -139338) (SETFONTDESCRIPTOR 139340 . 140804) (\STREAMCHARWIDTH 140806 . 144817) (\COERCECHARSET 144819 - . 148208) (\BUILDSLUGCSINFO 148210 . 151903) (\FONTSYMBOL 151905 . 152559) (\DEVICESYMBOL 152561 . -153345) (\FONTFACE 153347 . 160551) (\FONTFACE.COLOR 160553 . 167335) (SETFONTCHARENCODING 167337 . -168550)) (168553 189124 (FONTSAVAILABLE 168563 . 173927) (FONTEXISTS? 173929 . 177737) ( -\SEARCHFONTFILES 177739 . 180953) (FLUSHFONTCACHE 180955 . 183199) (FINDFONTFILES 183201 . 186417) ( -SORTFONTSPECS 186419 . 189122)) (189125 194663 (MATCHFONTFACE 189135 . 190210) (MAKEFONTFACE 190212 . -191246) (FONTFACETOATOM 191248 . 193498) (FONTFACE.STARS 193500 . 194661)) (195294 195786 ( -\UNITWIDTHSVECTOR 195304 . 195784)) (212590 214657 (FONTDESCRIPTOR.DEFPRINT 212600 . 214179) ( -FONTCLASS.DEFPRINT 214181 . 214655)) (218570 221360 (\CREATEKERNELEMENT 218580 . 218938) ( -\FSETLEFTKERN 218940 . 219431) (\FGETLEFTKERN 219433 . 221358)) (221361 232242 (\CREATEFONT 221371 . -224814) (\CREATECHARSET 224816 . 227993) (\INSTALLCHARSETINFO 227995 . 231329) ( -\INSTALLCHARSETINFO.CHARENCODING 231331 . 232240)) (232564 233932 (\FONTRESETCHARWIDTHS 232574 . -233930)) (234455 242071 (\CREATEDISPLAYFONT 234465 . 236230) (\CREATECHARSET.DISPLAY 236232 . 239656) -(\FONTEXISTS?.DISPLAY 239658 . 242069)) (242072 250342 (FAKEFACE.CHARSET 242082 . 246036) ( -MAKEBOLD.CHAR 246038 . 247891) (MAKEITALIC.CHAR 247893 . 250340)) (250373 254628 (\SFROTATECSINFO -250383 . 252525) (\SFROTATEFONTCHARACTERS 252527 . 252911) (\SFROTATECSINFOOFFSETS 252913 . 254626)) ( -254629 255803 (\SFMAKECOLOR 254639 . 255801))))) + (FILEMAP (NIL (6486 16153 (CHARWIDTH 6496 . 7285) (CHARWIDTHY 7287 . 8804) (STRINGWIDTH 8806 . 9843) ( +\CHARWIDTH.DISPLAY 9845 . 10260) (\STRINGWIDTH.DISPLAY 10262 . 10690) (\STRINGWIDTH.GENERIC 10692 . +16151)) (16154 22786 (DEFAULTFONT 16164 . 17449) (FONTCLASS 17451 . 19723) (FONTCLASSUNPARSE 19725 . +20626) (FONTCLASSCOMPONENT 20628 . 21216) (SETFONTCLASSCOMPONENT 21218 . 21660) (GETFONTCLASSCOMPONENT + 21662 . 22784)) (24234 43749 (FONTCREATE 24244 . 27489) (FONTCREATE1 27491 . 30150) ( +FONTCREATE.SLUGFD 30152 . 32716) (\FONT.CHECKARGS1 32718 . 37423) (\FONTCREATE1.NOFN 37425 . 37639) ( +FONTFILEP 37641 . 38529) (\READCHARSET 38531 . 43329) (FONTCHARSETS 43331 . 43747)) (43750 50826 ( +\FONT.CHECKARGS 43760 . 50509) (\CHARSET.CHECK 50511 . 50824)) (50827 57187 (COERCEFONTSPEC 50837 . +56498) (COERCEFONTSPEC.TARGETFACE 56500 . 57185)) (59382 62504 (MAKEFONTSPEC 59392 . 60872) ( +FONTSPEC.TO.FONTDESCRIPTOR 60874 . 62502)) (62505 72167 (COMPLETE.FONT 62515 . 64540) (COMPLETEFONTP +64542 . 65280) (COMPLETE.CHARSET 65282 . 69348) (PRUNESLUGCSINFOS 69350 . 70661) (MONOSPACEFONTP 70663 + . 72165)) (72206 82020 (FONTASCENT 72216 . 72600) (FONTDESCENT 72602 . 73087) (FONTHEIGHT 73089 . +73491) (FONTPROP 73493 . 81297) (\AVGCHARWIDTH 81299 . 82018)) (82843 84713 (FONTDEVICEPROP 82853 . +84711)) (84830 85684 (EDITCHAR 84840 . 85682)) (85730 97920 (GETCHARBITMAP 85740 . 86864) ( +PUTCHARBITMAP 86866 . 89024) (\GETCHARBITMAP.CSINFO 89026 . 91042) (\PUTCHARBITMAP.CSINFO 91044 . +97918)) (97921 120262 (MOVECHARBITMAP 97931 . 99825) (MOVEFONTCHARS 99827 . 104977) (\MOVEFONTCHAR +104979 . 109851) (\MOVEFONTCHARS.SOURCEDATA 109853 . 116608) (\MAKESLUGCHAR 116610 . 119145) ( +SLUGCHARP 119147 . 120260)) (121177 134229 (FONTFILES 121187 . 124024) (\FINDFONTFILE 124026 . 126003) + (\FONTFILENAMES 126005 . 126565) (\FONTFILENAME 126567 . 129677) (FONTSPECFROMFILENAME 129679 . +134227)) (134230 170563 (FONTCOPY 134240 . 139323) (FONTP 139325 . 139624) (FONTUNPARSE 139626 . +141349) (SETFONTDESCRIPTOR 141351 . 142815) (\STREAMCHARWIDTH 142817 . 146828) (\COERCECHARSET 146830 + . 150219) (\BUILDSLUGCSINFO 150221 . 153914) (\FONTSYMBOL 153916 . 154570) (\DEVICESYMBOL 154572 . +155356) (\FONTFACE 155358 . 162562) (\FONTFACE.COLOR 162564 . 169346) (SETFONTCHARENCODING 169348 . +170561)) (170564 191422 (FONTSAVAILABLE 170574 . 175938) (FONTEXISTS? 175940 . 179748) ( +\SEARCHFONTFILES 179750 . 182964) (FLUSHFONTCACHE 182966 . 185497) (FINDFONTFILES 185499 . 188715) ( +SORTFONTSPECS 188717 . 191420)) (191423 196961 (MATCHFONTFACE 191433 . 192508) (MAKEFONTFACE 192510 . +193544) (FONTFACETOATOM 193546 . 195796) (FONTFACE.STARS 195798 . 196959)) (197592 198084 ( +\UNITWIDTHSVECTOR 197602 . 198082)) (215005 217072 (FONTDESCRIPTOR.DEFPRINT 215015 . 216594) ( +FONTCLASS.DEFPRINT 216596 . 217070)) (220994 223784 (\CREATEKERNELEMENT 221004 . 221362) ( +\FSETLEFTKERN 221364 . 221855) (\FGETLEFTKERN 221857 . 223782)) (223785 234939 (\CREATEFONT 223795 . +227403) (\CREATECHARSET 227405 . 230690) (\INSTALLCHARSETINFO 230692 . 234026) ( +\INSTALLCHARSETINFO.CHARENCODING 234028 . 234937)) (235261 236629 (\FONTRESETCHARWIDTHS 235271 . +236627)) (237152 245010 (\CREATEDISPLAYFONT 237162 . 239069) (\CREATECHARSET.DISPLAY 239071 . 242595) +(\FONTEXISTS?.DISPLAY 242597 . 245008)) (245011 253389 (FAKEFACE.CHARSET 245021 . 249083) ( +MAKEBOLD.CHAR 249085 . 250938) (MAKEITALIC.CHAR 250940 . 253387)) (253420 257675 (\SFROTATECSINFO +253430 . 255572) (\SFROTATEFONTCHARACTERS 255574 . 255958) (\SFROTATECSINFOOFFSETS 255960 . 257673)) ( +257676 258850 (\SFMAKECOLOR 257686 . 258848))))) STOP diff --git a/sources/FONT.LCOM b/sources/FONT.LCOM index e219801d7c20c4de30368f7a4bec9b7c00f286ce..a86162b0fafc620e045de6c50a578bc9cd197aa1 100644 GIT binary patch delta 4610 zcmZu#eQaCR75B4~v~|CnGzpDM!)@qj5;flY^0OTV^~>|M{hH_ZjNeO~Kt|JG()445 zF}7){G>d@{VnS+nY0IV#v?A>vhSbJ28c<>OB{kESn3xdKkk(2Y3<*Y&#`e$D?%ey{ zOB`pBV&9K*&%O7Y-}#+$U4NqOk59LqI&xQHM1AzJ5s?=a#3x5(aa7_5(BQyBi{E(k z=!u6bXz>v=fKHOHayz5RAv7Q;tMY;{Dx^l^@qzH^w|Ci16R}uq096h@4$E5?i2Nuo z4Ge_`v$}z`5>_3Y0ikuL5L4c+83<7fV)g2#pp?cv80}?2!y?4Ex4cZzGDMf=CaC!eoSta`D=4 zxz~C-h7dxqA$l!G9W!tdNs@x} zf||ot(MFP(La-@T3rI{R$!A~g4aP+hzU$6@QH(dQ5>hFY0b5NN4!wWv{#`E*2SuLT z!h5(B*^})_CDAZgMZ-8VqNz5vhfxs;31sV|qox72y>DbvH6}0}RZ!Nnp&`<}3*?() zy9%Pfj*YTN6p?>V=txY#a0!EktW_$2S{Rjm5vm9JakkhlVvY6`^2NR#K`{Y`+noc0 z|GH;GfGZD|_lK#qJFjochw5z$5$^ReU+*aoAEBdcs=i^7Npwc6{!o4Mj`8}3`QX&W z_qaod6mz|1Ec#Ha(HZHSrBY=%dX$Nmm1t+E+uFN{j&?C^H!inX16|yOOWb}71%up` zgXR6@;S(Wa`?d#uL&adGi(JlSZ(FlFTYG3*qb!ond|&XnadPU3zP8?mbvx1XcT}5X z5AEcvok98^wJ_u6U8U zNJoOd0NT9oY6%&-U7X76wljnRBOxvjO0Rn3*p18mW|(Vhr0Z>% zQ|s+G$c>$IN9!FJjHuN&z*msV)Hl-aAh*Em83_zRB+W3!06swwpMHBNZ0g3+{lPGI znuIDBxGUu6m45E0QJ6~+1m%A=M0v~MShzp*j2g&D^nW|dxy8R#(OfR>kmphnP z`s(KNa=_czlZmD)%iZUeyPNbdNJo4v=NnYw!lj!(T<+$)jm~>RPcC-{xfRK!9Za+e zvfqP=Ab08Jx7=M`^5mcJhEMv+y(O@s>`mRbcEyZ0Jn64^9`3Z$zwf~`1LM`Lm18$Z z-=^76ssAH1O-|MTk?|8kI=o4RK64+gx z%+Y9Kw2zX~Is#9MNwRyPZ(ovM8+Hk0ooFJSKm;w^R+U!bk431GlG(mZX+cTGk%*v%tF&Nl4Zds8py>+hST`71>Kki-vC$8EFekAgfGeZ zalxN(UD;#^NrWqcH;8px@05sC!?7GZMVV!tdBr4;ra*KrBpEm7H0cp#zysVHo0^q@ zG!B^z6oBVVwSa3K$4riUl}sG}E_w2Jchy5^ANyu$gthW6pSZA$1b{ihgF=Ewdd{>; zxS(n!3kl$o#d##i2{ixk;}0z$0l3=V2MIukO%4+%Hdp;8@CsdOjlUYE_W@(8tm)~?9*Sc zg{Bu4QO&D<*~IU2fs5xmXWP>Yl}hF4R;Fw&P$6eeovVrpu)10-VlyK`c83Be3$)J| z73>LBLA-SYf|5?VXrR0gwFg+GWk_Dl3rK+Cgpo89e^?ubIJc1(omHkFA^VYwAkvGf zHtt&rYAt^XN>A!$)AA!kNV%v11Yrhp8&2W{iC)4QRAf4aF}MOlsz5=)j=55>rMCN^ zXA+7?gzAp2F)K5T;yjv!8kEM4%#){HiP!#m`o$nON52337d`bJowH2Py`2E=wbmp9XCLp9-J3OC zmYg|zAgCnC`)8k|#qNJ1f!epv&2bw~){f6oNRSU-_|X8QZ>r3mE{s_QL^W^(t9)bl zz6sSpQc9|w`tcwKj6ubkv`Y|nD_vIEvQpM9VV&tBwrlVI&|GO(d-gxtl@PS4r z?^bN&+MCaEca!5+Vq5;p43%Lgs$ICUm8(J>Y?WATOO0+L85ncIWQI;cX7|A;OJEt* zwk_b86dc=Y#=)Cj6FA9him=dc#${wOh>1}B`h$>X{AQkC(JKH7yj1FF zjEw;gd1_*cZ16RJvellzVy@?HbyC$0`i4M4GC|eN3c$|Hk1JDN`4xxoWfMAZVF?xh z{aPjvv;ZlLf!d3bCi(NA#d0g^{9}Z8W)kfs}wej1- zRCo;u7cCtSRDvfQ30)uO!o7cSz%GCaJeN(9G-B2LF zb@IV<GAl0Ex79C;{)T z7OB=O)?NZ%#ff&;SN5(`nF8{JB+SkYabcrGoP7GxVvo%Q0wHy|KYi`p%wr_h{O*3OoRW66se0nqG1gM^q|WwkOYgmfI-7 z>X14Xu6^*C#Pz~#>#qo+Ad@|xcUK`gTBjiFTp!Ta5=%4i9M`Nu(ZJ5?&k*!cV`teD z1-Qtq;MQ1%Ivs+ngmV*yT7tj@+*p$gUkuHx_IQBmg;$RazlqQy!j}dQLrpM_bw@RH zjs5lk)dYk->r*ZPGw2fqM5|bk1CGwPQi_OZ2MVv+_8a%McK|`=RkP-Nd3f{x06~tv A)&Kwi delta 4162 zcmZt}ZERat)$ch;7q?C9Hce6|YcC;coT!c7m%pNI^~>|M{gUVRJU=H+O130zx}+al z%hUn0zPI-z_jX>>Sp>qLPTJ#(|AQZl$&faut*^ZHnR;hOWZv?gC(hh@qW}+`DZX zJX|qU9PoMI7x-{<#=G3G;ODLu2bZ@ML-Q2Mj+QqZV;F%}tJ}N0aqH;vA2a;KJHO?o zca+(QzJj}NAs8&~4j$ND4*2~ul&mNP4>7Ew5)62^T0PAax@CaT+`H0Xp)K6SB@S6T zc%Hj9QXD7>N4-XC%jbSZ@!+J1+)k%DR>{L?r(4R!5P3Yaedo#1>CUnP3tF8`l&;d! zzT9VZPPdn>AbBCPb1?*}^7N1Aod50y_6*4Ld=Ny3a|clSP;fA~y*$eJ76*RiFE2ef zHNvzgTiyJ0_tJx}ctVO4MVevRIJFlXAiJS6u4@>aokL`|KGGuA97W@}MD$NMqXweB z(~-moVX@+79jyug85xk66B*rxwDb&kIZs1k?(!}wH@P<2n+mf?%43MRF|(+fNk}3z zl^qAF0u6{Mnjvlose&MgP$wi|Em7%lgR61*7TpleaSUBC>Ja_mWDL?n=r-uW>jpWDAC_z`fZFLAB?^Qq{`T55;T^c#^ z(R=!l-(7v@4{AOS6c9}di-$Q;r-|Cu@ByM)qZv9?4QStj7b9q9sSPV_+ zhJn+nF{tL#NRB(f$Kq9vK>%90NhB*_XCcMoD2ubhNQ#EtMObncz=`2HWtDXgGPBSa zjYe2B7p$zN*(npnA~I6P(=_;sda{r~G10-OtKl&rLf&53-WR0;I9-4h{b((xYUMsE zD~McJXkUzqt8pXIYW~%5BXG5ev$?{g%hX1Z^&BI>F{@6vC@3Nbt7HfRlQk_T9G1~y zjb&JYMAB3Pqp%o;&PUT9Pvlh7)-4k$aoPy&ngH5fsBm@7x83Q!60LyXF>Gp9Qa973(}zutdzJj@$QKe$P`|}K84gm} zNm9SZ)D2%ql%q&bn^qoYRV{BJ5qfo<8${@*zd!m?>C4al@3YOGx0;~h1!fw_?K2&u z<@8A`hD9``=5p9fN=TIBXetF&kE%w;A0$E>UJa?W|5|m9NaX%6cEAWDAk(UPKjzp6 zY=N2oY!r5f1U-*6m^XB6BiiG^(&Xf|j?#VdHqT|r>u3H+&b=|4mmr_aLWZ&fgJ8%T znkJ^E7U&in00v%l4xt1SO3s2KMMODO8>I@EY8DRy94ty^&z>NEJ^KW&L`mq)m%8bI z6>&x!XS69y=CIw5xPSY(($bszxyCP+7K(^;ojctFJ%F0Tp3Dwg28%R@=OBJ^Of?|5 zgwm~ZA#R70!*xo_5ee0{rGfJ|5xY0`uzT-q;mG};?A-8JIUodzz2r03zs1GKkFF0k z|ChNwS?n$S<@#oB5j3^(Y$l}EvylQNWXxnqLWjVrHx(Mls%={k(=^!KB}``3C8U|V zlz_0hRAR`4k_Lu^mRki1H3m{f5UXG@UgIFfYJ5dVD9wW6s1>p>yh1w$YHB}L93e6c z6}o9yChxu9*8*;~Oh{K+Vl0zvx`Ft(LIO9s_-KrN2EdzBHij_BRHG6kgBWKHQO8x? zpaUz!5~T_nV#ICuwIkN2VH||+&1iH;u{;ofo|XxfKop$Li{f=@$+EJ<|MUaog)Ac< z{kgZ@Dr9iptuU@KHu8}zcSgz6ce*$q`O=-y?*9IM6oM&VrO~vi{)K$xHlXhQ7*I>; zkDI;H2VRed3kZB-?hxy}mm|&`mS9bP2F3?ZJKxT86LYU8j$~R}{0Z{PCl|JY?(U#Z z)q#8$5SiWA6&0c2)*paFGz;f7%(SKzEvl@AfYmAOUZ?_DoHQ_dunf{6XV76@O=FmU z?7cATP><7-x~3z>Br>(D_i3naYfsj{0z`OLti=-6v5bKypolZ^A+Dj_#K{YPJ2q9| zJsz)G*^#*Yn~G<7L}huwY!?V{!=-MvSDhKwvtq#g4QDfI;;47HwdI?cgu0Phc5?2D zPt_A_?T3aglD&7^pMm;UH{ro!i3v;N7IcTQ&0a)x6RfyuXj(es5w}-B^15p3E&m zE~umMP}J~X^-c*cT?Z7QL9YWs7B~vj>N%*SS=pR{3w8X!Fm@_$L0m({ab}9DsTSF5 zlMccV0ePGrGt@ki{2iU&nF>0m+p4mZILDRSut|9YZvgO<@vnBGf&|Ih5k{{ugHORfL_ diff --git a/sources/MEDLEYFONTFORMAT b/sources/MEDLEYFONTFORMAT index 3c2c630b..58ca4b32 100644 --- a/sources/MEDLEYFONTFORMAT +++ b/sources/MEDLEYFONTFORMAT @@ -1,12 +1,12 @@ (DEFINE-FILE-INFO :PACKAGE "INTERLISP" :READTABLE "INTERLISP" :BASE 10) -(FILECREATED "12-Apr-2026 00:46:54" {WMEDLEY}MEDLEYFONTFORMAT.;306 63906 +(FILECREATED "17-Apr-2026 09:32:49" {MEDLEY}MEDLEYFONTFORMAT.;310 64484 :EDIT-BY rmk - :CHANGES-TO (FNS MEDLEYFONT.READ.FONT MEDLEYFONT.FILENAME) + :CHANGES-TO (FNS MEDLEYFONT.FILEVERSION MEDLEYFONT.GETFILEPROP) - :PREVIOUS-DATE " 6-Apr-2026 09:45:18" {WMEDLEY}MEDLEYFONTFORMAT.;304) + :PREVIOUS-DATE "15-Apr-2026 23:17:13" {WMEDLEY}MEDLEYFONTFORMAT.;308) (PRETTYCOMPRINT MEDLEYFONTFORMATCOMS) @@ -145,7 +145,9 @@ (FULLNAME STREAM]) (MEDLEYFONT.GETCHARSET - [LAMBDA (STREAM CHARSET FONT DIRECTORY) (* ; "Edited 6-Apr-2026 09:45 by rmk") + [LAMBDA (STREAM CHARSET FONT) (* ; "Edited 15-Apr-2026 13:29 by rmk") + (* ; "Edited 12-Apr-2026 22:14 by rmk") + (* ; "Edited 6-Apr-2026 09:45 by rmk") (* ; "Edited 30-Mar-2026 08:42 by rmk") (* ; "Edited 24-Mar-2026 00:04 by rmk") (* ; "Edited 21-Mar-2026 15:28 by rmk") @@ -162,47 +164,49 @@ (SETQ CHARSET (CHARSET.DECODE CHARSET)) (RESETLST (CL:UNLESS (\GETSTREAM STREAM 'INPUT T) - (CL:WHEN (type? FONTSPEC STREAM) - (SETQ STREAM (MEDLEYFONT.FILENAME STREAM DIRECTORY))) [RESETSAVE (SETQ STREAM (OPENSTREAM STREAM 'INPUT)) `(PROGN (CLOSEF? OLDVALUE]) (MEDLEYFONT.FILEVERSION STREAM 1) - (CL:IF (IGREATERP CHARSET (MEDLEYFONT.READ.ITEM STREAM 'MAXCHARSET)) - (SLUGCSINFO FONT) - (MEDLEYFONT.GETCHARSET.INTERNAL STREAM CHARSET FONT (\FIXPIN STREAM))))]) + (MEDLEYFONT.READ.ITEM STREAM 'MAXCHARSET) + (MEDLEYFONT.GETCHARSET.INTERNAL STREAM CHARSET FONT (\FIXPIN STREAM)))]) (MEDLEYFONT.GETCHARSET.INTERNAL - [LAMBDA (STREAM CHARSET FONT CSLOC) (* ; "Edited 29-Mar-2026 22:42 by rmk") + [LAMBDA (STREAM CHARSET FONT CSLOC) (* ; "Edited 15-Apr-2026 11:09 by rmk") + (* ; "Edited 12-Apr-2026 14:04 by rmk") + (* ; "Edited 29-Mar-2026 22:42 by rmk") (* ;; "Caller guarantees STREAM and CSLOC as the location of the charset info. CHARSET is less than (MAXCHARSTE FONT).") - (LET (CSINFO FILECHARSET ALLOTHERS) - (if (ILESSP CSLOC 0) - then - (* ;; + (if (IGREATERP CHARSET (fetch (FONTDESCRIPTOR MAXCHARSET) of FONT)) + then (SLUGCSINFO FONT) + else (LET (CSINFO FILECHARSET ALLOTHERS) + (if (ILESSP CSLOC 0) + then + (* ;;  "File contains at most one instantiated charset, others are either all empty or all uninstantiated") - (SETFILEPTR STREAM (IMINUS CSLOC)) - (SETQ FILECHARSET (\FIXPIN STREAM)) - (SETQ ALLOTHERS (BIN STREAM)) (* ; "If not the one we wanted") - [SELECTQ FILECHARSET - (-1 (* ; "All empty") - (SLUGCSINFO FONT)) - (-2 (* ; "All uninstantiated") - NIL) - (PROGN (if (IEQP CHARSET FILECHARSET) - then (MEDLEYFONT.READ.CHARSET STREAM CHARSET) - elseif (EQ 1 ALLOTHERS) - then (SLUGCSINFO FONT] - else - (* ;; "CSLOC points to the vector, what does it say about the requested CHARSET?") + (SETFILEPTR STREAM (IMINUS CSLOC)) + (SETQ FILECHARSET (\FIXPIN STREAM)) + (SETQ ALLOTHERS (BIN STREAM)) (* ; "If not the one we wanted") + [SELECTQ FILECHARSET + (-1 (* ; "All empty") + (SLUGCSINFO FONT)) + (-2 (* ; "All uninstantiated") + NIL) + (PROGN (if (IEQP CHARSET FILECHARSET) + then (MEDLEYFONT.READ.CHARSET STREAM CHARSET) + elseif (EQ 1 ALLOTHERS) + then (SLUGCSINFO FONT] + else + (* ;; + "CSLOC points to the vector, what does it say about the requested CHARSET?") - (SETFILEPTR STREAM (IPLUS CSLOC (UNFOLD CHARSET BYTESPERCELL))) - (SELECTQ (SETQ CSLOC (\FIXPIN STREAM)) - (0 NIL) - (-1 (SLUGCSINFO FONT)) - (PROGN (SETFILEPTR STREAM CSLOC) - (MEDLEYFONT.READ.CHARSET STREAM CHARSET FONT]) + (SETFILEPTR STREAM (IPLUS CSLOC (UNFOLD CHARSET BYTESPERCELL))) + (SELECTQ (SETQ CSLOC (\FIXPIN STREAM)) + (0 NIL) + (-1 (SLUGCSINFO FONT)) + (PROGN (SETFILEPTR STREAM CSLOC) + (MEDLEYFONT.READ.CHARSET STREAM CHARSET FONT]) (MEDLEYFONT.CHARSET? [LAMBDA (FILE CHARSET) (* ; "Edited 16-Mar-2026 00:31 by rmk") @@ -218,7 +222,10 @@ CHARSETS)]) (MEDLEYFONT.GETFILEPROP - [LAMBDA (FILE PROP) (* ; "Edited 31-Mar-2026 14:43 by rmk") + [LAMBDA (FILE PROP) (* ; "Edited 16-Apr-2026 22:30 by rmk") + (* ; "Edited 15-Apr-2026 00:19 by rmk") + (* ; "Edited 12-Apr-2026 19:31 by rmk") + (* ; "Edited 31-Mar-2026 14:43 by rmk") (* ; "Edited 28-Mar-2026 22:59 by rmk") (* ; "Edited 24-Mar-2026 10:56 by rmk") (* ; "Edited 20-Mar-2026 13:23 by rmk") @@ -229,24 +236,25 @@ (* ; "Edited 21-May-2025 11:36 by rmk") (* ; "Edited 17-May-2025 19:07 by rmk") (* ; "Edited 14-May-2025 17:46 by rmk") - [if (\GETSTREAM FILE 'INPUT T) - then (* ; "Shouldn't need to reopen") - (SETQ FILE (FULLNAME FILE)) - elseif (OR (LITATOM FILE) - (STRINGP FILE)) - else (SETQ FILE (CAR (FONTFILES (FONTPROP (FONTCREATE FILE) - 'SPEC] + (* ; "FONTPROP version") + (SETQ FILE (if (\GETSTREAM FILE 'INPUT T) + then (* ; "Shouldn't need to reopen") + (FULLNAME FILE) + elseif (CAR (FONTFILES FILE)) + else (ERROR "FILE NOT FOUND" FILE))) (CL:WITH-OPEN-FILE (STREAM FILE :DIRECTION :INPUT) - (LET (HEADERPROPS CSLOC SINGLECS) + (LET (HEADERPROPS CSLOC SINGLECS MAXCHARSET) (CL:UNLESS (SETQ HEADERPROPS (MEDLEYFONT.FILEP STREAM)) (ERROR "Not a MEDLEYFONT file" (FULLNAME STREAM))) - (MEDLEYFONT.READ.ITEM STREAM 'MAXCHARSET) + (SETQ MAXCHARSET (MEDLEYFONT.READ.ITEM STREAM 'MAXCHARSET)) (SETQ CSLOC (\FIXPIN STREAM)) (SELECTQ PROP (OTHERPROPS (CDDR HEADERPROPS)) (DATE (CADR HEADERPROPS)) + (MAXCHARSET MAXCHARSET) (FONTPROPS (MEDLEYFONT.READ.FONTPROPS STREAM)) - (CHARSETS (if (ILESSP CSLOC 0) + (CHARSETS (* ; "Skips slugs and indirects") + (if (ILESSP CSLOC 0) then (* ;; "File contains only one instantiated charset ") @@ -255,8 +263,8 @@ (CL:WHEN (IGEQ SINGLECS 0) (CONS SINGLECS)) else (SETFILEPTR STREAM CSLOC) - (for CS from 0 to \MAXCHARSET when (IGREATERP (\FIXPIN STREAM) - 0) collect CS))) + (for CS from 0 to MAXCHARSET when (IGREATERP (\FIXPIN STREAM) + 0) collect CS))) (INDIRECTS (CADR (ASSOC 'INDIRECTS (MEDLEYFONT.READ.FONTPROPS STREAM)))) (ERROR "Unknown MEDLEYFONT property"]) @@ -296,14 +304,17 @@ ,@(MEDLEYFONT.READ.ITEM STREAM 'OTHERFONTPROPS])])]) (MEDLEYFONT.FILEVERSION - [LAMBDA (FILE REQUIRED) (* ; "Edited 4-Apr-2026 00:10 by rmk") + [LAMBDA (FILE REQUIRED) (* ; "Edited 17-Apr-2026 09:32 by rmk") + (* ; "Edited 4-Apr-2026 00:10 by rmk") (* ; "Edited 30-Mar-2026 12:08 by rmk") (* ; "Edited 29-Mar-2026 11:21 by rmk") - (LET [(FILEVERSION (CADR (ASSOC 'VERSION (MEDLEYFONT.FILEP FILE] - (CL:WHEN (AND REQUIRED (NEQ REQUIRED FILEVERSION)) - (ERROR (CONCAT "Medley font version is " FILEVERSION ", " REQUIRED " is required") - FILE)) - FILEVERSION]) + (LET* [(PROPS (OR (MEDLEYFONT.FILEP FILE) + (ERROR "Not a Medley font" FILE))) + (FILEVERSION (CADR (ASSOC 'VERSION PROPS] + (CL:WHEN (AND REQUIRED (NEQ REQUIRED FILEVERSION)) + (ERROR (CONCAT "Medley font version is " FILEVERSION ", " REQUIRED " is required") + FILE)) + FILEVERSION]) ) @@ -313,7 +324,8 @@ (DEFINEQ (MEDLEYFONT.READ.FONT - [LAMBDA (FILE CHARSETS NOERROR DIRECTORY) (* ; "Edited 12-Apr-2026 00:30 by rmk") + [LAMBDA (FILE CHARSETS NOERROR DIRECTORY) (* ; "Edited 15-Apr-2026 00:50 by rmk") + (* ; "Edited 12-Apr-2026 00:30 by rmk") (* ; "Edited 6-Apr-2026 09:07 by rmk") (* ; "Edited 4-Apr-2026 15:29 by rmk") (* ; "Edited 31-Mar-2026 22:53 by rmk") @@ -330,34 +342,34 @@ (* ; "Edited 9-Jul-2025 00:06 by rmk") (* ; "Edited 6-Jul-2025 11:45 by rmk") - (* ;; "Returns a font descriptor containing the requested charsets from FILE. If FILE is not given, the filename is determined from the FONTSPEC and the FONTDEVICEPROP's for its FSDEVICE.") + (* ;; "Returns a font descriptor containing the requested charsets from FILE. If FILE is a FONTSPEC, it is coerced to a standard font name on DIRECTORY.") - (SETQ FILE (MEDLEYFONT.FILENAME FILE DIRECTORY)) - (if (NOT (INFILEP FILE)) - then (CL:UNLESS NOERROR (ERROR "FILE NOT FOUND" FILE)) - elseif [OR (MEMB CHARSETS '(NIL ALL)) + (CL:WHEN [OR (MEMB CHARSETS '(NIL ALL)) (SETQ CHARSETS (SORT (CHARSET.DECODE (MKLIST CHARSETS) NOERROR] - then (RESETLST - (LET (STREAM FONT CSLOC MAXCHARSET) (* ; + (RESETLST + (PROG ((FILENAME (MEDLEYFONT.FILENAME FILE DIRECTORY)) + STREAM FONT CSLOC MAXCHARSET) (* ;  "CL:OPEN-FILE doesn't exist in the init") - [RESETSAVE (SETQ STREAM (OPENSTREAM FILE 'INPUT)) - '(PROGN (CLOSEF? OLDVALUE] - (MEDLEYFONT.FILEVERSION STREAM 1) - (SETQ MAXCHARSET (MEDLEYFONT.READ.ITEM STREAM 'MAXCHARSET)) - (SETQ CSLOC (\FIXPIN STREAM)) (* ; + [RESETSAVE (SETQ STREAM (OPENSTREAM FILENAME 'INPUT)) + '(PROGN (CLOSEF? OLDVALUE] + (MEDLEYFONT.FILEVERSION STREAM 1) + (SETQ MAXCHARSET (MEDLEYFONT.READ.ITEM STREAM 'MAXCHARSET)) + (SETQ CSLOC (\FIXPIN STREAM)) (* ;  "CSLOC here so MEDLEYFONT.GETCHARSET can skip over the font stuff.") - (SETQ FONT (MEDLEYFONT.READ.VERIFIEDFONT STREAM)) - (for CSNO from 0 to MAXCHARSET while CHARSETS - when (if (EQ CHARSETS 'ALL) - elseif (EQ CSNO (CAR CHARSETS)) - then (pop CHARSETS)) do (\SETCHARSETINFO FONT CSNO - (MEDLEYFONT.GETCHARSET.INTERNAL - STREAM CSNO FONT CSLOC))) - FONT))]) + (SETQ FONT (MEDLEYFONT.READ.VERIFIEDFONT STREAM)) + (for CSNO from 0 to MAXCHARSET while CHARSETS + when (if (EQ CHARSETS 'ALL) + elseif (EQ CSNO (CAR CHARSETS)) + then (pop CHARSETS)) do (\SETCHARSETINFO FONT CSNO + (MEDLEYFONT.GETCHARSET.INTERNAL STREAM + CSNO FONT CSLOC))) + (RETURN FONT))))]) (MEDLEYFONT.READ.CHARSET - [LAMBDA (STREAM CHARSET FONT) (* ; "Edited 30-Mar-2026 08:36 by rmk") + [LAMBDA (STREAM CHARSET FONT) (* ; "Edited 14-Apr-2026 22:32 by rmk") + (* ; "Edited 12-Apr-2026 13:59 by rmk") + (* ; "Edited 30-Mar-2026 08:36 by rmk") (* ; "Edited 22-Mar-2026 00:21 by rmk") (* ; "Edited 17-Mar-2026 10:00 by rmk") (* ; "Edited 14-Feb-2026 00:36 by rmk") @@ -376,7 +388,7 @@ (MEDLEYFONT.GETCHARSET (MEDLEYFONT.FILENAME (MEDLEYFONT.READ.ITEM STREAM 'INDIRECTCHARSET) - STREAM) + (FULLNAME STREAM)) CHARSET FONT) else (bind PAIR LABEL ITEM (CSINFO _ (create CHARSETINFO WIDTHS _ NIL @@ -523,7 +535,9 @@ (bind PAIR until [EQ 'STOP (CAR (SETQ PAIR (MEDLEYFONT.READ.ITEM STREAM] collect PAIR]) (MEDLEYFONT.READ.VERIFIEDFONT - [LAMBDA (STREAM FONT) (* ; "Edited 28-Mar-2026 17:03 by rmk") + [LAMBDA (STREAM FONT) (* ; "Edited 15-Apr-2026 23:16 by rmk") + (* ; "Edited 12-Apr-2026 12:51 by rmk") + (* ; "Edited 28-Mar-2026 17:03 by rmk") (* ; "Edited 23-Mar-2026 11:37 by rmk") (* ; "Edited 19-Mar-2026 11:48 by rmk") (* ; "Edited 18-Mar-2026 08:18 by rmk") @@ -589,6 +603,9 @@ (INDIRECTS (* ; "Only a file prop")) (\SFFACECODE (* ; "to be deprecated")) (HELP "UNKNOWN FONTDESCRIPTOR PROPERTY: P"))) + (replace (FONTDESCRIPTOR FONTFILENAME) of FONT with (PSEUDOFILENAME (FULLNAME STREAM))) + (* ; + "PSEUDOFILENAME so that a deployed fontfile is redirected in a new sysout/makesys environment ") (replace (FONTDESCRIPTOR FONTCHARSETVECTOR) of FONT with (\CREATEFONTCHARSETVECTOR FONT)) FONT]) ) @@ -879,34 +896,16 @@ (DEFINEQ (MEDLEYFONT.FILENAME - [LAMBDA (FILE DIRECTORY EXTENSION) (* ; "Edited 12-Apr-2026 00:41 by rmk") - (* ; "Edited 6-Apr-2026 09:31 by rmk") - (* ; "Edited 1-Apr-2026 09:46 by rmk") - (* ; "Edited 30-Mar-2026 09:19 by rmk") - (* ; "Edited 17-Mar-2026 10:15 by rmk") - (* ; "Edited 2-Mar-2026 22:45 by rmk") + [LAMBDA (FILE DIRECTORY) (* ; "Edited 15-Apr-2026 00:41 by rmk") (* ; "Edited 23-Jan-2026 15:10 by rmk") (* ; "Edited 7-Oct-2025 11:50 by rmk") (* ; "Edited 4-Sep-2025 08:48 by rmk") (* ; "Edited 10-Jun-2025 11:02 by rmk") (* ; "Edited 19-May-2025 17:42 by rmk") - - (* ;; "Defaults to components of DIRECTORY, e.g. host/directory. Current directory if T, device directory if NIL. ") - - (LET (FONTSPEC HOST DIR EXT) - (if (type? FONTSPEC FILE) - then (SETQ FONTSPEC FILE) - (SETQ FILE (\FONTFILENAME (\FONT.CHECKARGS FILE NIL NIL NIL NIL T))) - else (SETQ FONTSPEC (FONTSPECFROMFILENAME FILE))) - (SETQ DIRECTORY (SELECTQ DIRECTORY - (NIL (* ; "Deployed font directory") - [CAR (MKLIST (FONTDEVICEPROP FONTSPEC 'FONTDIRECTORIES]) - (T (* ; "Connected directory") - (DIRECTORYNAME T)) - DIRECTORY)) - (SETQ HOST (FILENAMEFIELD DIRECTORY 'HOST)) - (PACKFILENAME 'BODY FILE 'HOST HOST 'DIRECTORY DIRECTORY 'EXTENSION - (OR EXTENSION (CAR (MKLIST (FONTDEVICEPROP FONTSPEC 'FONTEXTENSIONS]) + (PACKFILENAME 'BODY (CL:IF (type? FONTSPEC FILE) + (\FONTFILENAME (\FONT.CHECKARGS FILE NIL NIL NIL NIL T)) + FILE) + 'BODY DIRECTORY]) ) (ADDTOVAR DISPLAYFONTEXTENSIONS MEDLEYDISPLAYFONT) @@ -957,12 +956,12 @@ ) ) (DECLARE%: DONTCOPY - (FILEMAP (NIL (2201 19416 (MEDLEYFONT.WRITE.FONT 2211 . 8614) (MEDLEYFONT.GETCHARSET 8616 . 10664) ( -MEDLEYFONT.GETCHARSET.INTERNAL 10666 . 12403) (MEDLEYFONT.CHARSET? 12405 . 13283) ( -MEDLEYFONT.GETFILEPROP 13285 . 16349) (MEDLEYFONT.FILEP 16351 . 18779) (MEDLEYFONT.FILEVERSION 18781 - . 19414)) (19442 41377 (MEDLEYFONT.READ.FONT 19452 . 23020) (MEDLEYFONT.READ.CHARSET 23022 . 28069) ( -MEDLEYFONT.READ.ITEM 28071 . 34220) (MEDLEYFONT.PEEK.ITEM 34222 . 35084) (MEDLEYFONT.READ.FONTPROPS -35086 . 35551) (MEDLEYFONT.READ.VERIFIEDFONT 35553 . 41375)) (41403 60753 (MEDLEYFONT.WRITE.CHARSET -41413 . 46052) (MEDLEYFONT.WRITE.ITEM 46054 . 55107) (MEDLEYFONT.WRITE.FONTPROPS 55109 . 59878) ( -MEDLEYFONT.WRITE.HEADER 59880 . 60751)) (60754 63021 (MEDLEYFONT.FILENAME 60764 . 63019))))) + (FILEMAP (NIL (2205 20684 (MEDLEYFONT.WRITE.FONT 2215 . 8618) (MEDLEYFONT.GETCHARSET 8620 . 10701) ( +MEDLEYFONT.GETCHARSET.INTERNAL 10703 . 12956) (MEDLEYFONT.CHARSET? 12958 . 13836) ( +MEDLEYFONT.GETFILEPROP 13838 . 17417) (MEDLEYFONT.FILEP 17419 . 19847) (MEDLEYFONT.FILEVERSION 19849 + . 20682)) (20710 43327 (MEDLEYFONT.READ.FONT 20720 . 24236) (MEDLEYFONT.READ.CHARSET 24238 . 29514) ( +MEDLEYFONT.READ.ITEM 29516 . 35665) (MEDLEYFONT.PEEK.ITEM 35667 . 36529) (MEDLEYFONT.READ.FONTPROPS +36531 . 36996) (MEDLEYFONT.READ.VERIFIEDFONT 36998 . 43325)) (43353 62703 (MEDLEYFONT.WRITE.CHARSET +43363 . 48002) (MEDLEYFONT.WRITE.ITEM 48004 . 57057) (MEDLEYFONT.WRITE.FONTPROPS 57059 . 61828) ( +MEDLEYFONT.WRITE.HEADER 61830 . 62701)) (62704 63599 (MEDLEYFONT.FILENAME 62714 . 63597))))) STOP diff --git a/sources/MEDLEYFONTFORMAT.LCOM b/sources/MEDLEYFONTFORMAT.LCOM index e760235f374cd2ad711827e44af1435d6233763e..e6753f2966f09b098b7f31e9d9ef884ef23b6453 100644 GIT binary patch delta 4343 zcma)9U2G#)74|sU?IxReovf4W=5KG@Rg};snL9uB*i@~@<8eHRJ!3phylK;Jw{hD1 z>`(Wn6%`-@63=vX5i9LOODRtvP!ba)D5{Hi=}I7VMTNFc1PK9eBy1m{%enX3$s}F` zD{aPe&b{ZJdw#y}%;!H9e)|*Q?F*yP3H|jO6Ot%JkQj^0Qe26J(O7ut+LhN=FE5wT zwW}zMzIMCvWIq4@ zZb^)ba(KLbENx{?qhRVqGljzVu|82BPGAv56h%|WcZ8?tk+vkYQO!BQ9&cmwhdG@f3mGZL~aqh$e}dC zMC=c}Dj_4I7hJOl5*g8B#*uHv*Xk4UuleBL>Ph;yI(UsfxTu}}T=K2-_kX2-$zRK_ zGl55!FSz+Ox~PNx3HrvOSqOj{T7mW|XX`SVk~ElLED;834miV?AM z@VqLaoPMFu9r`&8GAq6^gT$d8K1EzB-on81bQ)BzVc{yD_={N z>*pL;`taVcz4OUE-!?t5wQ=GL|Id+EzSzCJ64bMwt?k}P=NErIg&I6DCuN((wtKXs*upehMNR0;B6($<)|4;AFK*SOTKSfWn zvVzi3WR-jrJX=zvD1s_v^<69=MU0`vY9mdgpTNq=nEe(^dc&H-BMAi=}(=`fKzUUN?tVvBG6(1Ezn%X3aMw>)R zlPw&L9IUDzi6h#9jC+A)&oVBGG}%(2^r4wO&O_TQJR=gZ`~GPa8MHfOPp6S%r<0YK z2OUI2afadqM!JYqWgH2?wichzm1rq-vogO>4KY}#zp~WUO5F@M*vkiX%`Z!#GL!Cp zzn1a)H+?nFtFY=@ZEMqx z;ONCbPi^CKyL;nF?&`bjQR*gEXketbcK)~k7jyGj%Pk^FjUcm7fVz+r>Gu5| zvg00)Va-!l5eVo(O=CqnC^-d?*rUP?1LR@IHe`x+DXU-_MHfku=6S;sZXmXcu*maH zGvy*J=FR6DJ>z~AlOOc_4ZrO7`TPlX9S-MrI81Hy@~5!f$?}+BL3_nlCco=d&wx22 z8#l6!Ya%G$#;v2Izi)U*)sT}nZRpcR2zX7>{&mUqzM+$vjN*FIDHKtJ-0d6IRCwo5 z4q=G%%UKSvzyYw!3a~2}K(+&Pe+) zei=3a0Ri&VouF)_#$bF{y@_rtUw>ou#&S7~;HKfHL8wGgIJaEBy!;k=_1e{2=*{ID zH&oZC4pfv5rMX}9Y$Lo3Z#8%xLL;l1y48p0KnorPQySQ zv-O-wt`83cq6g)XMjGXKXloW#Xk`)cz&nKnp!x4U0W@FgE`?a$yYyBTl?)3Q6DEC?&15Tz;^3QkgeOT_S)rAK)}0OqcwPz0{*2y zZR_j|BSgl5mOV4ehJ=u>X0Lzx(#A)=F)T~uo%vomF0>**Ka!ss>Wtw1)=?EcHppyj z2mo);O00*2-0$eoAT1bDcm)5To?$dVinmLkxem$?li|T}NJJZnpsyZFwg|pf@&{zl z47*l5UNE6y=j;-6CIWPA^n((E)_+A^#XD33thK__=PxdzGbtcW9M_ZJ|Q}lFOJ`$i9SW4E&l# zBh`X{vEFU(d4kdh45wuB{Pl{q4-=d^qcG^XhLg)@&7uh<1(&M3$n`*DoMkzd$np`r zETW`U%;~Td@86DZ6*ZJK)5Te{U?VBUl@*8;(@KDcl!Qzh!V-l_=Cc^rLC5KJ6*SEu zm7<`9l9eiE001GZhjfyRteie=HuTU-hxDS1Do#2LE&xOVi+hzAD7?N8)0lYN!BAv} z-c7!y_|K0!8)M`4v8#`&|D5`Zp#9x9rbc952{9Qh(t+1V z!v9$W!*kv>=Tc4s5-14Knqcs-i%|vgyy&LWy20yGRUnr8RHMRxb);)l2sRa&7m5Wv zZJF7WgjBIv@1WXon+C;`&6K)+;$Hy8vI$O>SbCDCjQ3F$;#70*s^KI(%0Q zK)}~DU<~7?fM9@HzK^C50lRyx^ue?iX)M_HU%{kPo${+%^;z|={S^!7b)P4ZRcBZr zOdCEJ{fyfZ<(92jS=dsAvYgo6nn;xW!ZG1aZ9U-^_U^(T&VXB?#7enbUhQP9&YJw2 z9NhK&Z(|kZbz^qFVIvUhMe6dt1QNyslSalgX7$3f3p4^*O**LssCe`x_{^ohtHXsq Gw*Ci3G+f94 delta 4597 zcmb7IYit}>6`q-OLhQ!QIs@;z zBqC*I=brmK=R4nbu7CRm|F56$-QzB4aYUL5B2w5ymIO4+~Q0T zUAc_<(C5dOzIZGoh6hkfpCr{rNMc-);MsBNSAu7iVv zeW>`^fZAs2Gc@T3m|up%yxWAgcIWb9Z?_NH%vW$n{{=EJ`C4rJbAyKQ#P8 zPe&Q0{K-}K~yExu`nuC9H50Gd1xEojtytu->c!hj2Qw#Zd zarbN}G#a|tQgIh(!&seh4H1n z=I^euvT3_xo=fN2OC}6*{jwBASu^B6Bb*`M`fhj zw&P{Yf{XG4C85(bgF_4JKO>O&dE;8YzSU!6eczGN|Clpj==biuTetn`-2kBSOJx6cdDgWpZhmjmuYeRuY=ncXM7MAwLqO~L z%VGq-5Ihi26gpi=67M%&-5L&{tc?aN$T4{*e&i_2;W|jkT4ZN0DH>~RlJNW4{Sk4e zA=ohB6-F83@AB~2YbJhvyn@$I58 z9;9%YD0fie@IR@?E8{_$u+DOL$Aj}0!+o{SujYp~zCSb@T7GJF`SJ0f#g<&$oNt#uWe&hB46#&-4^yqY*}JcvIz(B0cnIlh}GoT7%& zRCdg^To1{rh|EF(C_sjM-jG5uBt^7ZptW#aq=9DYOmd{&6pNA3_=g>iD#d^#7)iUp zR)jjLUy>NDQn`!#*praBINmuRC>oyW{J^{}aGa2!Ct#fZ9mWdN-16xJq15s*)==(d zZ`zf5iu#$K<|+yNe3#ZOi7{l@al>|86UBfc{Zj*6@#~$T&q{>&oV=Ms8Y4iGKrYf0 ziam-ImHlRNh~WGHCM$OycnwB?xaRb%34DsC&YK>?8RUZ`Dk!ceoq~s=5wg^Sry|h8 zC^Q^Japn)p$srZsnKz9pv10yksQm4N+O87dA2u@vBuctjz@r6oWE7+?1s}`^`u8vo zzM|)6uILi@cAnGMnli!6dig&T${G69>9chg5taml)$(7teogh`4;wL@oS}OpIkILP zG-r~C@E|1>IFyR~%@FceWf1ncXVJBpXP%q8HdE|FN*MK>fks8dKRyz|c(4nf5Ki@L zkcK%2bU>-slRT24-F6Hn5U>n>?eNLAEuD9X&{OFLFM}K4q%Z9zd723L*;$ME1jzb$ zTj*k2hRJ%SX8KHq0^$ODO%Bhu3%j!RM>ogTnk<&m>*WL4;uycadb~2mj|ms|R#p#N zzM=q2XS%Z15Y^%iu9982``GgDxPD0%@pnhMh#EJcu!wN?xg)KBnW`wOOm`Ixbk~Gr zAONd_M!134fQ+C@Q@1Iuq}G%+0z%u5AMS0&4*J}Q=>X3)`C2f|73m4zOuj+=!U7wd z4dOo{1I0iTta!X&0$Gpd#vu(+w3hl&2{N|x5nU8T3CcL+61YMh_?kbMG7TqXl1OLG zY!b;)A1HKZ6ch*!di0CagKEK~+$%-4kU=XOB^&|x7)~~Co1O{S z0u=k(W_DmWRs>OUL5i}&E^8=hd08EXLhf!G3aM+GX>ZspfsxIVgiDSVXFGZ-#l_8cS}UYlZtrax3ap(uz_MsjuvYz_Tcz1r(_;Bg=l;Qm zJ|^@dF$_e2LP^5Cu&{i6IwVcxZou}c04?q8L}~$mq@^%hYL44hGYUbICGnb)<@4vd>k+gswy59jvX6FIFbq7;LjI?ut5-yKu{|uFg5CT9!_kc;P0@c5a1C