diff --git a/.gitignore b/.gitignore index 05dfa4ac5..3c9271a47 100644 --- a/.gitignore +++ b/.gitignore @@ -34,6 +34,9 @@ loadups/build/ loadups/tagged loadups/gitinfo +# font-importing working directories +internal/fonts/** + # manual cross-reference files diff --git a/docs/internal/FONTCODECHANGES.tedit b/docs/internal/FONTCODECHANGES.tedit index b551332e0..8c70ec5db 100644 Binary files a/docs/internal/FONTCODECHANGES.tedit and b/docs/internal/FONTCODECHANGES.tedit differ diff --git a/docs/internal/MCCS.TEDIT b/docs/internal/MCCS.TEDIT index 60c350314..f0568196f 100644 Binary files a/docs/internal/MCCS.TEDIT and b/docs/internal/MCCS.TEDIT differ diff --git a/docs/internal/MEDLEYFONTFORMAT.TEDIT b/docs/internal/MEDLEYFONTFORMAT.TEDIT index 5862edc92..035efd108 100644 Binary files a/docs/internal/MEDLEYFONTFORMAT.TEDIT and b/docs/internal/MEDLEYFONTFORMAT.TEDIT differ diff --git a/fonts/medleydisplayfonts/AMTEX10-MRR.MEDLEYDISPLAYFONT b/fonts/medleydisplayfonts/AMTEX10-MRR.MEDLEYDISPLAYFONT index 7e0974102..29fac7876 100644 Binary files a/fonts/medleydisplayfonts/AMTEX10-MRR.MEDLEYDISPLAYFONT and b/fonts/medleydisplayfonts/AMTEX10-MRR.MEDLEYDISPLAYFONT differ diff --git a/fonts/medleydisplayfonts/APL14-MRR.MEDLEYDISPLAYFONT b/fonts/medleydisplayfonts/APL14-MRR.MEDLEYDISPLAYFONT index bf0ff5cac..f97890b24 100644 Binary files a/fonts/medleydisplayfonts/APL14-MRR.MEDLEYDISPLAYFONT and b/fonts/medleydisplayfonts/APL14-MRR.MEDLEYDISPLAYFONT differ diff --git a/fonts/medleydisplayfonts/ARROWS10-MRR.MEDLEYDISPLAYFONT b/fonts/medleydisplayfonts/ARROWS10-MRR.MEDLEYDISPLAYFONT index ad3c04a99..5e1beeeec 100644 Binary files a/fonts/medleydisplayfonts/ARROWS10-MRR.MEDLEYDISPLAYFONT and b/fonts/medleydisplayfonts/ARROWS10-MRR.MEDLEYDISPLAYFONT differ diff --git a/fonts/medleydisplayfonts/ARROWSTWO10-MRR.MEDLEYDISPLAYFONT b/fonts/medleydisplayfonts/ARROWSTWO10-MRR.MEDLEYDISPLAYFONT index 9a675e6ec..e36511707 100644 Binary files a/fonts/medleydisplayfonts/ARROWSTWO10-MRR.MEDLEYDISPLAYFONT and b/fonts/medleydisplayfonts/ARROWSTWO10-MRR.MEDLEYDISPLAYFONT differ diff --git a/fonts/medleydisplayfonts/ASTERISK10-MRR.MEDLEYDISPLAYFONT b/fonts/medleydisplayfonts/ASTERISK10-MRR.MEDLEYDISPLAYFONT index 4e42bf3eb..6cdbed7ea 100644 Binary files a/fonts/medleydisplayfonts/ASTERISK10-MRR.MEDLEYDISPLAYFONT and b/fonts/medleydisplayfonts/ASTERISK10-MRR.MEDLEYDISPLAYFONT differ diff --git a/fonts/medleydisplayfonts/BLOCKFONT10-MRR.MEDLEYDISPLAYFONT b/fonts/medleydisplayfonts/BLOCKFONT10-MRR.MEDLEYDISPLAYFONT index c7d707812..33f600771 100644 Binary files a/fonts/medleydisplayfonts/BLOCKFONT10-MRR.MEDLEYDISPLAYFONT and b/fonts/medleydisplayfonts/BLOCKFONT10-MRR.MEDLEYDISPLAYFONT differ diff --git a/fonts/medleydisplayfonts/BOLDPS10-BIR.MEDLEYDISPLAYFONT b/fonts/medleydisplayfonts/BOLDPS10-BIR.MEDLEYDISPLAYFONT index 0ddaa3e27..5d6749fff 100644 Binary files a/fonts/medleydisplayfonts/BOLDPS10-BIR.MEDLEYDISPLAYFONT and b/fonts/medleydisplayfonts/BOLDPS10-BIR.MEDLEYDISPLAYFONT differ diff --git a/fonts/medleydisplayfonts/BOLDPS10-BRR.MEDLEYDISPLAYFONT b/fonts/medleydisplayfonts/BOLDPS10-BRR.MEDLEYDISPLAYFONT index 686ab9994..344089576 100644 Binary files a/fonts/medleydisplayfonts/BOLDPS10-BRR.MEDLEYDISPLAYFONT and b/fonts/medleydisplayfonts/BOLDPS10-BRR.MEDLEYDISPLAYFONT differ diff --git a/fonts/medleydisplayfonts/BOLDPS10-MIR.MEDLEYDISPLAYFONT b/fonts/medleydisplayfonts/BOLDPS10-MIR.MEDLEYDISPLAYFONT index 937e5ec98..9a59f476c 100644 Binary files a/fonts/medleydisplayfonts/BOLDPS10-MIR.MEDLEYDISPLAYFONT and b/fonts/medleydisplayfonts/BOLDPS10-MIR.MEDLEYDISPLAYFONT differ diff --git a/fonts/medleydisplayfonts/BOLDPS10-MRR.MEDLEYDISPLAYFONT b/fonts/medleydisplayfonts/BOLDPS10-MRR.MEDLEYDISPLAYFONT index f66b84d2a..b4bb51108 100644 Binary files a/fonts/medleydisplayfonts/BOLDPS10-MRR.MEDLEYDISPLAYFONT and b/fonts/medleydisplayfonts/BOLDPS10-MRR.MEDLEYDISPLAYFONT differ diff --git a/fonts/medleydisplayfonts/BRAVOX12-MRR.MEDLEYDISPLAYFONT b/fonts/medleydisplayfonts/BRAVOX12-MRR.MEDLEYDISPLAYFONT index 3f42b67aa..ac1432e4e 100644 Binary files a/fonts/medleydisplayfonts/BRAVOX12-MRR.MEDLEYDISPLAYFONT and b/fonts/medleydisplayfonts/BRAVOX12-MRR.MEDLEYDISPLAYFONT differ diff --git a/fonts/medleydisplayfonts/CARDSTWO12-MRR.MEDLEYDISPLAYFONT b/fonts/medleydisplayfonts/CARDSTWO12-MRR.MEDLEYDISPLAYFONT index c77aec9a4..428d4c7f3 100644 Binary files a/fonts/medleydisplayfonts/CARDSTWO12-MRR.MEDLEYDISPLAYFONT and b/fonts/medleydisplayfonts/CARDSTWO12-MRR.MEDLEYDISPLAYFONT differ diff --git a/fonts/medleydisplayfonts/CARDSZERO12-MRR.MEDLEYDISPLAYFONT b/fonts/medleydisplayfonts/CARDSZERO12-MRR.MEDLEYDISPLAYFONT index 6d2afa996..2b0051610 100644 Binary files a/fonts/medleydisplayfonts/CARDSZERO12-MRR.MEDLEYDISPLAYFONT and b/fonts/medleydisplayfonts/CARDSZERO12-MRR.MEDLEYDISPLAYFONT differ diff --git a/fonts/medleydisplayfonts/CHINESE12-MRR.MEDLEYDISPLAYFONT b/fonts/medleydisplayfonts/CHINESE12-MRR.MEDLEYDISPLAYFONT index 13d8deb3d..062e37b76 100644 Binary files a/fonts/medleydisplayfonts/CHINESE12-MRR.MEDLEYDISPLAYFONT and b/fonts/medleydisplayfonts/CHINESE12-MRR.MEDLEYDISPLAYFONT differ diff --git a/fonts/medleydisplayfonts/CLARITY12-MRR.MEDLEYDISPLAYFONT b/fonts/medleydisplayfonts/CLARITY12-MRR.MEDLEYDISPLAYFONT index 69e2f79ad..3533e8678 100644 Binary files a/fonts/medleydisplayfonts/CLARITY12-MRR.MEDLEYDISPLAYFONT and b/fonts/medleydisplayfonts/CLARITY12-MRR.MEDLEYDISPLAYFONT differ diff --git a/fonts/medleydisplayfonts/CLARITY14-MRR.MEDLEYDISPLAYFONT b/fonts/medleydisplayfonts/CLARITY14-MRR.MEDLEYDISPLAYFONT index 6910398cf..f00d0db9f 100644 Binary files a/fonts/medleydisplayfonts/CLARITY14-MRR.MEDLEYDISPLAYFONT and b/fonts/medleydisplayfonts/CLARITY14-MRR.MEDLEYDISPLAYFONT differ diff --git a/fonts/medleydisplayfonts/CLASSIC06-BRR.MEDLEYDISPLAYFONT b/fonts/medleydisplayfonts/CLASSIC06-BRR.MEDLEYDISPLAYFONT index e1fd46a50..cba3d531a 100644 Binary files a/fonts/medleydisplayfonts/CLASSIC06-BRR.MEDLEYDISPLAYFONT and b/fonts/medleydisplayfonts/CLASSIC06-BRR.MEDLEYDISPLAYFONT differ diff --git a/fonts/medleydisplayfonts/CLASSIC06-MIR.MEDLEYDISPLAYFONT b/fonts/medleydisplayfonts/CLASSIC06-MIR.MEDLEYDISPLAYFONT index d7899b117..4645dc518 100644 Binary files a/fonts/medleydisplayfonts/CLASSIC06-MIR.MEDLEYDISPLAYFONT and b/fonts/medleydisplayfonts/CLASSIC06-MIR.MEDLEYDISPLAYFONT differ diff --git a/fonts/medleydisplayfonts/CLASSIC06-MRR.MEDLEYDISPLAYFONT b/fonts/medleydisplayfonts/CLASSIC06-MRR.MEDLEYDISPLAYFONT index 935417cfb..e81035b25 100644 Binary files a/fonts/medleydisplayfonts/CLASSIC06-MRR.MEDLEYDISPLAYFONT and b/fonts/medleydisplayfonts/CLASSIC06-MRR.MEDLEYDISPLAYFONT differ diff --git a/fonts/medleydisplayfonts/CLASSIC08-BRR.MEDLEYDISPLAYFONT b/fonts/medleydisplayfonts/CLASSIC08-BRR.MEDLEYDISPLAYFONT index b6cb0eb99..c318f8b7b 100644 Binary files a/fonts/medleydisplayfonts/CLASSIC08-BRR.MEDLEYDISPLAYFONT and b/fonts/medleydisplayfonts/CLASSIC08-BRR.MEDLEYDISPLAYFONT differ diff --git a/fonts/medleydisplayfonts/CLASSIC08-MIR.MEDLEYDISPLAYFONT b/fonts/medleydisplayfonts/CLASSIC08-MIR.MEDLEYDISPLAYFONT index 91cbdf1a9..03461db27 100644 Binary files a/fonts/medleydisplayfonts/CLASSIC08-MIR.MEDLEYDISPLAYFONT and b/fonts/medleydisplayfonts/CLASSIC08-MIR.MEDLEYDISPLAYFONT differ diff --git a/fonts/medleydisplayfonts/CLASSIC08-MRR.MEDLEYDISPLAYFONT b/fonts/medleydisplayfonts/CLASSIC08-MRR.MEDLEYDISPLAYFONT index f1c486a55..c623c4f6d 100644 Binary files a/fonts/medleydisplayfonts/CLASSIC08-MRR.MEDLEYDISPLAYFONT and b/fonts/medleydisplayfonts/CLASSIC08-MRR.MEDLEYDISPLAYFONT differ diff --git a/fonts/medleydisplayfonts/CLASSIC10-BRR.MEDLEYDISPLAYFONT b/fonts/medleydisplayfonts/CLASSIC10-BRR.MEDLEYDISPLAYFONT index 69071ab58..1e1912801 100644 Binary files a/fonts/medleydisplayfonts/CLASSIC10-BRR.MEDLEYDISPLAYFONT and b/fonts/medleydisplayfonts/CLASSIC10-BRR.MEDLEYDISPLAYFONT differ diff --git a/fonts/medleydisplayfonts/CLASSIC10-MIR.MEDLEYDISPLAYFONT b/fonts/medleydisplayfonts/CLASSIC10-MIR.MEDLEYDISPLAYFONT index ab4b66c05..5d0ecf2cf 100644 Binary files a/fonts/medleydisplayfonts/CLASSIC10-MIR.MEDLEYDISPLAYFONT and b/fonts/medleydisplayfonts/CLASSIC10-MIR.MEDLEYDISPLAYFONT differ diff --git a/fonts/medleydisplayfonts/CLASSIC10-MRR.MEDLEYDISPLAYFONT b/fonts/medleydisplayfonts/CLASSIC10-MRR.MEDLEYDISPLAYFONT index b73e8f8fc..4a4de2a75 100644 Binary files a/fonts/medleydisplayfonts/CLASSIC10-MRR.MEDLEYDISPLAYFONT and b/fonts/medleydisplayfonts/CLASSIC10-MRR.MEDLEYDISPLAYFONT differ diff --git a/fonts/medleydisplayfonts/CLASSIC12-BRR.MEDLEYDISPLAYFONT b/fonts/medleydisplayfonts/CLASSIC12-BRR.MEDLEYDISPLAYFONT index bfae64774..01356b289 100644 Binary files a/fonts/medleydisplayfonts/CLASSIC12-BRR.MEDLEYDISPLAYFONT and b/fonts/medleydisplayfonts/CLASSIC12-BRR.MEDLEYDISPLAYFONT differ diff --git a/fonts/medleydisplayfonts/CLASSIC12-MIR.MEDLEYDISPLAYFONT b/fonts/medleydisplayfonts/CLASSIC12-MIR.MEDLEYDISPLAYFONT index 7582fcfe8..1e1294f6a 100644 Binary files a/fonts/medleydisplayfonts/CLASSIC12-MIR.MEDLEYDISPLAYFONT and b/fonts/medleydisplayfonts/CLASSIC12-MIR.MEDLEYDISPLAYFONT differ diff --git a/fonts/medleydisplayfonts/CLASSIC12-MRR.MEDLEYDISPLAYFONT b/fonts/medleydisplayfonts/CLASSIC12-MRR.MEDLEYDISPLAYFONT index 7a6c26c56..618f69104 100644 Binary files a/fonts/medleydisplayfonts/CLASSIC12-MRR.MEDLEYDISPLAYFONT and b/fonts/medleydisplayfonts/CLASSIC12-MRR.MEDLEYDISPLAYFONT differ diff --git a/fonts/medleydisplayfonts/CLASSIC14-BRR.MEDLEYDISPLAYFONT b/fonts/medleydisplayfonts/CLASSIC14-BRR.MEDLEYDISPLAYFONT index 5a9f8db11..00a88410e 100644 Binary files a/fonts/medleydisplayfonts/CLASSIC14-BRR.MEDLEYDISPLAYFONT and b/fonts/medleydisplayfonts/CLASSIC14-BRR.MEDLEYDISPLAYFONT differ diff --git a/fonts/medleydisplayfonts/CLASSIC14-MIR.MEDLEYDISPLAYFONT b/fonts/medleydisplayfonts/CLASSIC14-MIR.MEDLEYDISPLAYFONT index 5bab2758e..9b7916968 100644 Binary files a/fonts/medleydisplayfonts/CLASSIC14-MIR.MEDLEYDISPLAYFONT and b/fonts/medleydisplayfonts/CLASSIC14-MIR.MEDLEYDISPLAYFONT differ diff --git a/fonts/medleydisplayfonts/CLASSIC14-MRR.MEDLEYDISPLAYFONT b/fonts/medleydisplayfonts/CLASSIC14-MRR.MEDLEYDISPLAYFONT index 602378a4e..13ef5bb5a 100644 Binary files a/fonts/medleydisplayfonts/CLASSIC14-MRR.MEDLEYDISPLAYFONT and b/fonts/medleydisplayfonts/CLASSIC14-MRR.MEDLEYDISPLAYFONT differ diff --git a/fonts/medleydisplayfonts/CLASSIC18-BRR.MEDLEYDISPLAYFONT b/fonts/medleydisplayfonts/CLASSIC18-BRR.MEDLEYDISPLAYFONT index 05f0cb03e..fe9125ad0 100644 Binary files a/fonts/medleydisplayfonts/CLASSIC18-BRR.MEDLEYDISPLAYFONT and b/fonts/medleydisplayfonts/CLASSIC18-BRR.MEDLEYDISPLAYFONT differ diff --git a/fonts/medleydisplayfonts/CLASSIC18-MIR.MEDLEYDISPLAYFONT b/fonts/medleydisplayfonts/CLASSIC18-MIR.MEDLEYDISPLAYFONT index f57be8b70..8848c29ce 100644 Binary files a/fonts/medleydisplayfonts/CLASSIC18-MIR.MEDLEYDISPLAYFONT and b/fonts/medleydisplayfonts/CLASSIC18-MIR.MEDLEYDISPLAYFONT differ diff --git a/fonts/medleydisplayfonts/CLASSIC18-MRR.MEDLEYDISPLAYFONT b/fonts/medleydisplayfonts/CLASSIC18-MRR.MEDLEYDISPLAYFONT index bef29c477..a21ca793d 100644 Binary files a/fonts/medleydisplayfonts/CLASSIC18-MRR.MEDLEYDISPLAYFONT and b/fonts/medleydisplayfonts/CLASSIC18-MRR.MEDLEYDISPLAYFONT differ diff --git a/fonts/medleydisplayfonts/CLASSIC24-BRR.MEDLEYDISPLAYFONT b/fonts/medleydisplayfonts/CLASSIC24-BRR.MEDLEYDISPLAYFONT index b39546e03..7e0107b45 100644 Binary files a/fonts/medleydisplayfonts/CLASSIC24-BRR.MEDLEYDISPLAYFONT and b/fonts/medleydisplayfonts/CLASSIC24-BRR.MEDLEYDISPLAYFONT differ diff --git a/fonts/medleydisplayfonts/CLASSIC24-MIR.MEDLEYDISPLAYFONT b/fonts/medleydisplayfonts/CLASSIC24-MIR.MEDLEYDISPLAYFONT index 38fa036ec..53944a3bd 100644 Binary files a/fonts/medleydisplayfonts/CLASSIC24-MIR.MEDLEYDISPLAYFONT and b/fonts/medleydisplayfonts/CLASSIC24-MIR.MEDLEYDISPLAYFONT differ diff --git a/fonts/medleydisplayfonts/CLASSIC24-MRR.MEDLEYDISPLAYFONT b/fonts/medleydisplayfonts/CLASSIC24-MRR.MEDLEYDISPLAYFONT index d0adb6e86..0ff3544d9 100644 Binary files a/fonts/medleydisplayfonts/CLASSIC24-MRR.MEDLEYDISPLAYFONT and b/fonts/medleydisplayfonts/CLASSIC24-MRR.MEDLEYDISPLAYFONT differ diff --git a/fonts/medleydisplayfonts/CLASSIC48-BRR.MEDLEYDISPLAYFONT b/fonts/medleydisplayfonts/CLASSIC48-BRR.MEDLEYDISPLAYFONT index 2fc103e54..cc2a960c7 100644 Binary files a/fonts/medleydisplayfonts/CLASSIC48-BRR.MEDLEYDISPLAYFONT and b/fonts/medleydisplayfonts/CLASSIC48-BRR.MEDLEYDISPLAYFONT differ diff --git a/fonts/medleydisplayfonts/CLASSIC48-MIR.MEDLEYDISPLAYFONT b/fonts/medleydisplayfonts/CLASSIC48-MIR.MEDLEYDISPLAYFONT index 84d2f90b6..2d4b8aaf4 100644 Binary files a/fonts/medleydisplayfonts/CLASSIC48-MIR.MEDLEYDISPLAYFONT and b/fonts/medleydisplayfonts/CLASSIC48-MIR.MEDLEYDISPLAYFONT differ diff --git a/fonts/medleydisplayfonts/CLASSIC48-MRR.MEDLEYDISPLAYFONT b/fonts/medleydisplayfonts/CLASSIC48-MRR.MEDLEYDISPLAYFONT index ea61ba753..6fcf22dc1 100644 Binary files a/fonts/medleydisplayfonts/CLASSIC48-MRR.MEDLEYDISPLAYFONT and b/fonts/medleydisplayfonts/CLASSIC48-MRR.MEDLEYDISPLAYFONT differ diff --git a/fonts/medleydisplayfonts/CLASSIC72-BRR.MEDLEYDISPLAYFONT b/fonts/medleydisplayfonts/CLASSIC72-BRR.MEDLEYDISPLAYFONT index 657c1a6ae..20bb6ef12 100644 Binary files a/fonts/medleydisplayfonts/CLASSIC72-BRR.MEDLEYDISPLAYFONT and b/fonts/medleydisplayfonts/CLASSIC72-BRR.MEDLEYDISPLAYFONT differ diff --git a/fonts/medleydisplayfonts/CLASSIC72-MIR.MEDLEYDISPLAYFONT b/fonts/medleydisplayfonts/CLASSIC72-MIR.MEDLEYDISPLAYFONT index ae19e6c59..5864e3e9e 100644 Binary files a/fonts/medleydisplayfonts/CLASSIC72-MIR.MEDLEYDISPLAYFONT and b/fonts/medleydisplayfonts/CLASSIC72-MIR.MEDLEYDISPLAYFONT differ diff --git a/fonts/medleydisplayfonts/CLASSIC72-MRR.MEDLEYDISPLAYFONT b/fonts/medleydisplayfonts/CLASSIC72-MRR.MEDLEYDISPLAYFONT index 1780022d5..1b32d1e00 100644 Binary files a/fonts/medleydisplayfonts/CLASSIC72-MRR.MEDLEYDISPLAYFONT and b/fonts/medleydisplayfonts/CLASSIC72-MRR.MEDLEYDISPLAYFONT differ diff --git a/fonts/medleydisplayfonts/CLASSICPIONE08-MRR.MEDLEYDISPLAYFONT b/fonts/medleydisplayfonts/CLASSICPIONE08-MRR.MEDLEYDISPLAYFONT index 2a26521f3..615416771 100644 Binary files a/fonts/medleydisplayfonts/CLASSICPIONE08-MRR.MEDLEYDISPLAYFONT and b/fonts/medleydisplayfonts/CLASSICPIONE08-MRR.MEDLEYDISPLAYFONT differ diff --git a/fonts/medleydisplayfonts/CLASSICPIONE10-MRR.MEDLEYDISPLAYFONT b/fonts/medleydisplayfonts/CLASSICPIONE10-MRR.MEDLEYDISPLAYFONT index 6dcb0f0b1..61ecf4726 100644 Binary files a/fonts/medleydisplayfonts/CLASSICPIONE10-MRR.MEDLEYDISPLAYFONT and b/fonts/medleydisplayfonts/CLASSICPIONE10-MRR.MEDLEYDISPLAYFONT differ diff --git a/fonts/medleydisplayfonts/CLASSICPIONE12-MRR.MEDLEYDISPLAYFONT b/fonts/medleydisplayfonts/CLASSICPIONE12-MRR.MEDLEYDISPLAYFONT index 22381a5bf..d15d5f41d 100644 Binary files a/fonts/medleydisplayfonts/CLASSICPIONE12-MRR.MEDLEYDISPLAYFONT and b/fonts/medleydisplayfonts/CLASSICPIONE12-MRR.MEDLEYDISPLAYFONT differ diff --git a/fonts/medleydisplayfonts/CLASSICPIONE14-MRR.MEDLEYDISPLAYFONT b/fonts/medleydisplayfonts/CLASSICPIONE14-MRR.MEDLEYDISPLAYFONT index 0155a1f65..7ef2bd8cd 100644 Binary files a/fonts/medleydisplayfonts/CLASSICPIONE14-MRR.MEDLEYDISPLAYFONT and b/fonts/medleydisplayfonts/CLASSICPIONE14-MRR.MEDLEYDISPLAYFONT differ diff --git a/fonts/medleydisplayfonts/CLASSICTHIN16-BRR.MEDLEYDISPLAYFONT b/fonts/medleydisplayfonts/CLASSICTHIN16-BRR.MEDLEYDISPLAYFONT index 31273373e..74654bf3c 100644 Binary files a/fonts/medleydisplayfonts/CLASSICTHIN16-BRR.MEDLEYDISPLAYFONT and b/fonts/medleydisplayfonts/CLASSICTHIN16-BRR.MEDLEYDISPLAYFONT differ diff --git a/fonts/medleydisplayfonts/CLASSICTHIN16-MRR.MEDLEYDISPLAYFONT b/fonts/medleydisplayfonts/CLASSICTHIN16-MRR.MEDLEYDISPLAYFONT index 65323affb..30c521125 100644 Binary files a/fonts/medleydisplayfonts/CLASSICTHIN16-MRR.MEDLEYDISPLAYFONT and b/fonts/medleydisplayfonts/CLASSICTHIN16-MRR.MEDLEYDISPLAYFONT differ diff --git a/fonts/medleydisplayfonts/CLASSICTHIN20-BRR.MEDLEYDISPLAYFONT b/fonts/medleydisplayfonts/CLASSICTHIN20-BRR.MEDLEYDISPLAYFONT index 76bba70ac..2209c15d5 100644 Binary files a/fonts/medleydisplayfonts/CLASSICTHIN20-BRR.MEDLEYDISPLAYFONT and b/fonts/medleydisplayfonts/CLASSICTHIN20-BRR.MEDLEYDISPLAYFONT differ diff --git a/fonts/medleydisplayfonts/CLASSICTHIN20-MRR.MEDLEYDISPLAYFONT b/fonts/medleydisplayfonts/CLASSICTHIN20-MRR.MEDLEYDISPLAYFONT index d30310da0..1f4f3d01f 100644 Binary files a/fonts/medleydisplayfonts/CLASSICTHIN20-MRR.MEDLEYDISPLAYFONT and b/fonts/medleydisplayfonts/CLASSICTHIN20-MRR.MEDLEYDISPLAYFONT differ diff --git a/fonts/medleydisplayfonts/CLASSICTHIN26-BRR.MEDLEYDISPLAYFONT b/fonts/medleydisplayfonts/CLASSICTHIN26-BRR.MEDLEYDISPLAYFONT index 6a074ab1a..31df1b2a1 100644 Binary files a/fonts/medleydisplayfonts/CLASSICTHIN26-BRR.MEDLEYDISPLAYFONT and b/fonts/medleydisplayfonts/CLASSICTHIN26-BRR.MEDLEYDISPLAYFONT differ diff --git a/fonts/medleydisplayfonts/CLASSICTHIN26-MRR.MEDLEYDISPLAYFONT b/fonts/medleydisplayfonts/CLASSICTHIN26-MRR.MEDLEYDISPLAYFONT index 595cd1b6f..e7eaeff75 100644 Binary files a/fonts/medleydisplayfonts/CLASSICTHIN26-MRR.MEDLEYDISPLAYFONT and b/fonts/medleydisplayfonts/CLASSICTHIN26-MRR.MEDLEYDISPLAYFONT differ diff --git a/fonts/medleydisplayfonts/CLASSICTHIN30-BRR.MEDLEYDISPLAYFONT b/fonts/medleydisplayfonts/CLASSICTHIN30-BRR.MEDLEYDISPLAYFONT index c5fb32ea3..ce0cb4fde 100644 Binary files a/fonts/medleydisplayfonts/CLASSICTHIN30-BRR.MEDLEYDISPLAYFONT and b/fonts/medleydisplayfonts/CLASSICTHIN30-BRR.MEDLEYDISPLAYFONT differ diff --git a/fonts/medleydisplayfonts/CLASSICTHIN30-MRR.MEDLEYDISPLAYFONT b/fonts/medleydisplayfonts/CLASSICTHIN30-MRR.MEDLEYDISPLAYFONT index 2f3e4e305..b01cebd54 100644 Binary files a/fonts/medleydisplayfonts/CLASSICTHIN30-MRR.MEDLEYDISPLAYFONT and b/fonts/medleydisplayfonts/CLASSICTHIN30-MRR.MEDLEYDISPLAYFONT differ diff --git a/fonts/medleydisplayfonts/CREAM10-MRR.MEDLEYDISPLAYFONT b/fonts/medleydisplayfonts/CREAM10-MRR.MEDLEYDISPLAYFONT index 3113db1a4..e93572bd7 100644 Binary files a/fonts/medleydisplayfonts/CREAM10-MRR.MEDLEYDISPLAYFONT and b/fonts/medleydisplayfonts/CREAM10-MRR.MEDLEYDISPLAYFONT differ diff --git a/fonts/medleydisplayfonts/CREAM12-MRR.MEDLEYDISPLAYFONT b/fonts/medleydisplayfonts/CREAM12-MRR.MEDLEYDISPLAYFONT index c3842790e..7ef7b50e1 100644 Binary files a/fonts/medleydisplayfonts/CREAM12-MRR.MEDLEYDISPLAYFONT and b/fonts/medleydisplayfonts/CREAM12-MRR.MEDLEYDISPLAYFONT differ diff --git a/fonts/medleydisplayfonts/CYRILLIC10-MRR.MEDLEYDISPLAYFONT b/fonts/medleydisplayfonts/CYRILLIC10-MRR.MEDLEYDISPLAYFONT index 2f109992f..4c164d884 100644 Binary files a/fonts/medleydisplayfonts/CYRILLIC10-MRR.MEDLEYDISPLAYFONT and b/fonts/medleydisplayfonts/CYRILLIC10-MRR.MEDLEYDISPLAYFONT differ diff --git a/fonts/medleydisplayfonts/CYRILLIC12-MRR.MEDLEYDISPLAYFONT b/fonts/medleydisplayfonts/CYRILLIC12-MRR.MEDLEYDISPLAYFONT index 6a294d9be..d6705f72f 100644 Binary files a/fonts/medleydisplayfonts/CYRILLIC12-MRR.MEDLEYDISPLAYFONT and b/fonts/medleydisplayfonts/CYRILLIC12-MRR.MEDLEYDISPLAYFONT differ diff --git a/fonts/medleydisplayfonts/DANATEN10-MRR.MEDLEYDISPLAYFONT b/fonts/medleydisplayfonts/DANATEN10-MRR.MEDLEYDISPLAYFONT index 63d5a0434..1ce0fe4cc 100644 Binary files a/fonts/medleydisplayfonts/DANATEN10-MRR.MEDLEYDISPLAYFONT and b/fonts/medleydisplayfonts/DANATEN10-MRR.MEDLEYDISPLAYFONT differ diff --git a/fonts/medleydisplayfonts/DANATWELVE12-MRR.MEDLEYDISPLAYFONT b/fonts/medleydisplayfonts/DANATWELVE12-MRR.MEDLEYDISPLAYFONT index 941c23428..a215cafa6 100644 Binary files a/fonts/medleydisplayfonts/DANATWELVE12-MRR.MEDLEYDISPLAYFONT and b/fonts/medleydisplayfonts/DANATWELVE12-MRR.MEDLEYDISPLAYFONT differ diff --git a/fonts/medleydisplayfonts/DANATWELVE14-MRR.MEDLEYDISPLAYFONT b/fonts/medleydisplayfonts/DANATWELVE14-MRR.MEDLEYDISPLAYFONT index ec96a35a3..24d1f3945 100644 Binary files a/fonts/medleydisplayfonts/DANATWELVE14-MRR.MEDLEYDISPLAYFONT and b/fonts/medleydisplayfonts/DANATWELVE14-MRR.MEDLEYDISPLAYFONT differ diff --git a/fonts/medleydisplayfonts/DANCER10-MRR.MEDLEYDISPLAYFONT b/fonts/medleydisplayfonts/DANCER10-MRR.MEDLEYDISPLAYFONT index 54766a908..18c26eeb3 100644 Binary files a/fonts/medleydisplayfonts/DANCER10-MRR.MEDLEYDISPLAYFONT and b/fonts/medleydisplayfonts/DANCER10-MRR.MEDLEYDISPLAYFONT differ diff --git a/fonts/medleydisplayfonts/DANCER12-MRR.MEDLEYDISPLAYFONT b/fonts/medleydisplayfonts/DANCER12-MRR.MEDLEYDISPLAYFONT index fb79d6517..2df453d05 100644 Binary files a/fonts/medleydisplayfonts/DANCER12-MRR.MEDLEYDISPLAYFONT and b/fonts/medleydisplayfonts/DANCER12-MRR.MEDLEYDISPLAYFONT differ diff --git a/fonts/medleydisplayfonts/ELITE10-MRR.MEDLEYDISPLAYFONT b/fonts/medleydisplayfonts/ELITE10-MRR.MEDLEYDISPLAYFONT index 009c0b895..020574189 100644 Binary files a/fonts/medleydisplayfonts/ELITE10-MRR.MEDLEYDISPLAYFONT and b/fonts/medleydisplayfonts/ELITE10-MRR.MEDLEYDISPLAYFONT differ diff --git a/fonts/medleydisplayfonts/GACHA08-MRC.MEDLEYDISPLAYFONT b/fonts/medleydisplayfonts/GACHA08-MRC.MEDLEYDISPLAYFONT index cfe6f2aeb..2525767cc 100644 Binary files a/fonts/medleydisplayfonts/GACHA08-MRC.MEDLEYDISPLAYFONT and b/fonts/medleydisplayfonts/GACHA08-MRC.MEDLEYDISPLAYFONT differ diff --git a/fonts/medleydisplayfonts/GACHA08-MRR.MEDLEYDISPLAYFONT b/fonts/medleydisplayfonts/GACHA08-MRR.MEDLEYDISPLAYFONT index a02573edb..2ecfe75d1 100644 Binary files a/fonts/medleydisplayfonts/GACHA08-MRR.MEDLEYDISPLAYFONT and b/fonts/medleydisplayfonts/GACHA08-MRR.MEDLEYDISPLAYFONT differ diff --git a/fonts/medleydisplayfonts/GACHA10-MRC.MEDLEYDISPLAYFONT b/fonts/medleydisplayfonts/GACHA10-MRC.MEDLEYDISPLAYFONT index 65b5386e7..cfcadc0fa 100644 Binary files a/fonts/medleydisplayfonts/GACHA10-MRC.MEDLEYDISPLAYFONT and b/fonts/medleydisplayfonts/GACHA10-MRC.MEDLEYDISPLAYFONT differ diff --git a/fonts/medleydisplayfonts/GACHA10-MRR.MEDLEYDISPLAYFONT b/fonts/medleydisplayfonts/GACHA10-MRR.MEDLEYDISPLAYFONT index 6cfa533fd..a54cba0c9 100644 Binary files a/fonts/medleydisplayfonts/GACHA10-MRR.MEDLEYDISPLAYFONT and b/fonts/medleydisplayfonts/GACHA10-MRR.MEDLEYDISPLAYFONT differ diff --git a/fonts/medleydisplayfonts/GACHA12-MRC.MEDLEYDISPLAYFONT b/fonts/medleydisplayfonts/GACHA12-MRC.MEDLEYDISPLAYFONT index c264951c8..d8327fd17 100644 Binary files a/fonts/medleydisplayfonts/GACHA12-MRC.MEDLEYDISPLAYFONT and b/fonts/medleydisplayfonts/GACHA12-MRC.MEDLEYDISPLAYFONT differ diff --git a/fonts/medleydisplayfonts/GACHA12-MRR.MEDLEYDISPLAYFONT b/fonts/medleydisplayfonts/GACHA12-MRR.MEDLEYDISPLAYFONT index b38ff0cc6..59ca3a1dc 100644 Binary files a/fonts/medleydisplayfonts/GACHA12-MRR.MEDLEYDISPLAYFONT and b/fonts/medleydisplayfonts/GACHA12-MRR.MEDLEYDISPLAYFONT differ diff --git a/fonts/medleydisplayfonts/GATES10-MRR.MEDLEYDISPLAYFONT b/fonts/medleydisplayfonts/GATES10-MRR.MEDLEYDISPLAYFONT index 4bf1da569..a54dd837b 100644 Binary files a/fonts/medleydisplayfonts/GATES10-MRR.MEDLEYDISPLAYFONT and b/fonts/medleydisplayfonts/GATES10-MRR.MEDLEYDISPLAYFONT differ diff --git a/fonts/medleydisplayfonts/GATES32-MRR.MEDLEYDISPLAYFONT b/fonts/medleydisplayfonts/GATES32-MRR.MEDLEYDISPLAYFONT index 858246284..6a7097fdc 100644 Binary files a/fonts/medleydisplayfonts/GATES32-MRR.MEDLEYDISPLAYFONT and b/fonts/medleydisplayfonts/GATES32-MRR.MEDLEYDISPLAYFONT differ diff --git a/fonts/medleydisplayfonts/HELVETICA03-MRR.MEDLEYDISPLAYFONT b/fonts/medleydisplayfonts/HELVETICA03-MRR.MEDLEYDISPLAYFONT index 867004941..da0d53274 100644 Binary files a/fonts/medleydisplayfonts/HELVETICA03-MRR.MEDLEYDISPLAYFONT and b/fonts/medleydisplayfonts/HELVETICA03-MRR.MEDLEYDISPLAYFONT differ diff --git a/fonts/medleydisplayfonts/HELVETICA04-MRR.MEDLEYDISPLAYFONT b/fonts/medleydisplayfonts/HELVETICA04-MRR.MEDLEYDISPLAYFONT index 0eba79faa..7bda9ca68 100644 Binary files a/fonts/medleydisplayfonts/HELVETICA04-MRR.MEDLEYDISPLAYFONT and b/fonts/medleydisplayfonts/HELVETICA04-MRR.MEDLEYDISPLAYFONT differ diff --git a/fonts/medleydisplayfonts/HELVETICA05-MRR.MEDLEYDISPLAYFONT b/fonts/medleydisplayfonts/HELVETICA05-MRR.MEDLEYDISPLAYFONT index 100e67051..6aa2868e1 100644 Binary files a/fonts/medleydisplayfonts/HELVETICA05-MRR.MEDLEYDISPLAYFONT and b/fonts/medleydisplayfonts/HELVETICA05-MRR.MEDLEYDISPLAYFONT differ diff --git a/fonts/medleydisplayfonts/HELVETICA07-MIR.MEDLEYDISPLAYFONT b/fonts/medleydisplayfonts/HELVETICA07-MIR.MEDLEYDISPLAYFONT index 093809693..b28feedda 100644 Binary files a/fonts/medleydisplayfonts/HELVETICA07-MIR.MEDLEYDISPLAYFONT and b/fonts/medleydisplayfonts/HELVETICA07-MIR.MEDLEYDISPLAYFONT differ diff --git a/fonts/medleydisplayfonts/HELVETICA07-MRR.MEDLEYDISPLAYFONT b/fonts/medleydisplayfonts/HELVETICA07-MRR.MEDLEYDISPLAYFONT index e142a0ffd..3eb1351de 100644 Binary files a/fonts/medleydisplayfonts/HELVETICA07-MRR.MEDLEYDISPLAYFONT and b/fonts/medleydisplayfonts/HELVETICA07-MRR.MEDLEYDISPLAYFONT differ diff --git a/fonts/medleydisplayfonts/HELVETICA08-BRR.MEDLEYDISPLAYFONT b/fonts/medleydisplayfonts/HELVETICA08-BRR.MEDLEYDISPLAYFONT index 353527084..524743031 100644 Binary files a/fonts/medleydisplayfonts/HELVETICA08-BRR.MEDLEYDISPLAYFONT and b/fonts/medleydisplayfonts/HELVETICA08-BRR.MEDLEYDISPLAYFONT differ diff --git a/fonts/medleydisplayfonts/HELVETICA08-MRC.MEDLEYDISPLAYFONT b/fonts/medleydisplayfonts/HELVETICA08-MRC.MEDLEYDISPLAYFONT index 582b838e5..117c5a2aa 100644 Binary files a/fonts/medleydisplayfonts/HELVETICA08-MRC.MEDLEYDISPLAYFONT and b/fonts/medleydisplayfonts/HELVETICA08-MRC.MEDLEYDISPLAYFONT differ diff --git a/fonts/medleydisplayfonts/HELVETICA08-MRR.MEDLEYDISPLAYFONT b/fonts/medleydisplayfonts/HELVETICA08-MRR.MEDLEYDISPLAYFONT index 757c96775..f5c765405 100644 Binary files a/fonts/medleydisplayfonts/HELVETICA08-MRR.MEDLEYDISPLAYFONT and b/fonts/medleydisplayfonts/HELVETICA08-MRR.MEDLEYDISPLAYFONT differ diff --git a/fonts/medleydisplayfonts/HELVETICA09-MRC.MEDLEYDISPLAYFONT b/fonts/medleydisplayfonts/HELVETICA09-MRC.MEDLEYDISPLAYFONT index 28b59dd92..c79f16458 100644 Binary files a/fonts/medleydisplayfonts/HELVETICA09-MRC.MEDLEYDISPLAYFONT and b/fonts/medleydisplayfonts/HELVETICA09-MRC.MEDLEYDISPLAYFONT differ diff --git a/fonts/medleydisplayfonts/HELVETICA09-MRR.MEDLEYDISPLAYFONT b/fonts/medleydisplayfonts/HELVETICA09-MRR.MEDLEYDISPLAYFONT index 3150b8981..16680330f 100644 Binary files a/fonts/medleydisplayfonts/HELVETICA09-MRR.MEDLEYDISPLAYFONT and b/fonts/medleydisplayfonts/HELVETICA09-MRR.MEDLEYDISPLAYFONT differ diff --git a/fonts/medleydisplayfonts/HELVETICA10-BRR.MEDLEYDISPLAYFONT b/fonts/medleydisplayfonts/HELVETICA10-BRR.MEDLEYDISPLAYFONT index 84e45f41b..dc077048b 100644 Binary files a/fonts/medleydisplayfonts/HELVETICA10-BRR.MEDLEYDISPLAYFONT and b/fonts/medleydisplayfonts/HELVETICA10-BRR.MEDLEYDISPLAYFONT differ diff --git a/fonts/medleydisplayfonts/HELVETICA10-MRC.MEDLEYDISPLAYFONT b/fonts/medleydisplayfonts/HELVETICA10-MRC.MEDLEYDISPLAYFONT index ba3894c86..108d601c0 100644 Binary files a/fonts/medleydisplayfonts/HELVETICA10-MRC.MEDLEYDISPLAYFONT and b/fonts/medleydisplayfonts/HELVETICA10-MRC.MEDLEYDISPLAYFONT differ diff --git a/fonts/medleydisplayfonts/HELVETICA10-MRR.MEDLEYDISPLAYFONT b/fonts/medleydisplayfonts/HELVETICA10-MRR.MEDLEYDISPLAYFONT index eddb73c2c..e25587ed9 100644 Binary files a/fonts/medleydisplayfonts/HELVETICA10-MRR.MEDLEYDISPLAYFONT and b/fonts/medleydisplayfonts/HELVETICA10-MRR.MEDLEYDISPLAYFONT differ diff --git a/fonts/medleydisplayfonts/HELVETICA11-MRR.MEDLEYDISPLAYFONT b/fonts/medleydisplayfonts/HELVETICA11-MRR.MEDLEYDISPLAYFONT index 997d07fa3..958193f2b 100644 Binary files a/fonts/medleydisplayfonts/HELVETICA11-MRR.MEDLEYDISPLAYFONT and b/fonts/medleydisplayfonts/HELVETICA11-MRR.MEDLEYDISPLAYFONT differ diff --git a/fonts/medleydisplayfonts/HELVETICA12-BRR.MEDLEYDISPLAYFONT b/fonts/medleydisplayfonts/HELVETICA12-BRR.MEDLEYDISPLAYFONT index da96ebb33..fefcb78ec 100644 Binary files a/fonts/medleydisplayfonts/HELVETICA12-BRR.MEDLEYDISPLAYFONT and b/fonts/medleydisplayfonts/HELVETICA12-BRR.MEDLEYDISPLAYFONT differ diff --git a/fonts/medleydisplayfonts/HELVETICA12-MIR.MEDLEYDISPLAYFONT b/fonts/medleydisplayfonts/HELVETICA12-MIR.MEDLEYDISPLAYFONT index 6aa28f625..2e9447a2f 100644 Binary files a/fonts/medleydisplayfonts/HELVETICA12-MIR.MEDLEYDISPLAYFONT and b/fonts/medleydisplayfonts/HELVETICA12-MIR.MEDLEYDISPLAYFONT differ diff --git a/fonts/medleydisplayfonts/HELVETICA12-MRC.MEDLEYDISPLAYFONT b/fonts/medleydisplayfonts/HELVETICA12-MRC.MEDLEYDISPLAYFONT index 4a8b3e8fe..f9da7c097 100644 Binary files a/fonts/medleydisplayfonts/HELVETICA12-MRC.MEDLEYDISPLAYFONT and b/fonts/medleydisplayfonts/HELVETICA12-MRC.MEDLEYDISPLAYFONT differ diff --git a/fonts/medleydisplayfonts/HELVETICA12-MRR.MEDLEYDISPLAYFONT b/fonts/medleydisplayfonts/HELVETICA12-MRR.MEDLEYDISPLAYFONT index 209e302f6..00c2a3457 100644 Binary files a/fonts/medleydisplayfonts/HELVETICA12-MRR.MEDLEYDISPLAYFONT and b/fonts/medleydisplayfonts/HELVETICA12-MRR.MEDLEYDISPLAYFONT differ diff --git a/fonts/medleydisplayfonts/HELVETICA13-MRR.MEDLEYDISPLAYFONT b/fonts/medleydisplayfonts/HELVETICA13-MRR.MEDLEYDISPLAYFONT index 0c1e1b21c..d3f62062c 100644 Binary files a/fonts/medleydisplayfonts/HELVETICA13-MRR.MEDLEYDISPLAYFONT and b/fonts/medleydisplayfonts/HELVETICA13-MRR.MEDLEYDISPLAYFONT differ diff --git a/fonts/medleydisplayfonts/HELVETICA14-MRC.MEDLEYDISPLAYFONT b/fonts/medleydisplayfonts/HELVETICA14-MRC.MEDLEYDISPLAYFONT index 6cc841cc8..0d4a2fb39 100644 Binary files a/fonts/medleydisplayfonts/HELVETICA14-MRC.MEDLEYDISPLAYFONT and b/fonts/medleydisplayfonts/HELVETICA14-MRC.MEDLEYDISPLAYFONT differ diff --git a/fonts/medleydisplayfonts/HELVETICA14-MRR.MEDLEYDISPLAYFONT b/fonts/medleydisplayfonts/HELVETICA14-MRR.MEDLEYDISPLAYFONT index 6c765132b..ef9720d27 100644 Binary files a/fonts/medleydisplayfonts/HELVETICA14-MRR.MEDLEYDISPLAYFONT and b/fonts/medleydisplayfonts/HELVETICA14-MRR.MEDLEYDISPLAYFONT differ diff --git a/fonts/medleydisplayfonts/HELVETICA16-MRR.MEDLEYDISPLAYFONT b/fonts/medleydisplayfonts/HELVETICA16-MRR.MEDLEYDISPLAYFONT index fcd6f98aa..8c195fd10 100644 Binary files a/fonts/medleydisplayfonts/HELVETICA16-MRR.MEDLEYDISPLAYFONT and b/fonts/medleydisplayfonts/HELVETICA16-MRR.MEDLEYDISPLAYFONT differ diff --git a/fonts/medleydisplayfonts/HELVETICA18-BRC.MEDLEYDISPLAYFONT b/fonts/medleydisplayfonts/HELVETICA18-BRC.MEDLEYDISPLAYFONT index 3d805194c..ecad48614 100644 Binary files a/fonts/medleydisplayfonts/HELVETICA18-BRC.MEDLEYDISPLAYFONT and b/fonts/medleydisplayfonts/HELVETICA18-BRC.MEDLEYDISPLAYFONT differ diff --git a/fonts/medleydisplayfonts/HELVETICA18-BRR.MEDLEYDISPLAYFONT b/fonts/medleydisplayfonts/HELVETICA18-BRR.MEDLEYDISPLAYFONT new file mode 100644 index 000000000..08ae605c5 Binary files /dev/null and b/fonts/medleydisplayfonts/HELVETICA18-BRR.MEDLEYDISPLAYFONT differ diff --git a/fonts/medleydisplayfonts/HELVETICA18-LRR.MEDLEYDISPLAYFONT b/fonts/medleydisplayfonts/HELVETICA18-LRR.MEDLEYDISPLAYFONT index 92c61f01f..e129c8c26 100644 Binary files a/fonts/medleydisplayfonts/HELVETICA18-LRR.MEDLEYDISPLAYFONT and b/fonts/medleydisplayfonts/HELVETICA18-LRR.MEDLEYDISPLAYFONT differ diff --git a/fonts/medleydisplayfonts/HELVETICA18-MRC.MEDLEYDISPLAYFONT b/fonts/medleydisplayfonts/HELVETICA18-MRC.MEDLEYDISPLAYFONT index 57e14507a..fd525dba0 100644 Binary files a/fonts/medleydisplayfonts/HELVETICA18-MRC.MEDLEYDISPLAYFONT and b/fonts/medleydisplayfonts/HELVETICA18-MRC.MEDLEYDISPLAYFONT differ diff --git a/fonts/medleydisplayfonts/HELVETICA18-MRR.MEDLEYDISPLAYFONT b/fonts/medleydisplayfonts/HELVETICA18-MRR.MEDLEYDISPLAYFONT index ef591039d..df14c5050 100644 Binary files a/fonts/medleydisplayfonts/HELVETICA18-MRR.MEDLEYDISPLAYFONT and b/fonts/medleydisplayfonts/HELVETICA18-MRR.MEDLEYDISPLAYFONT differ diff --git a/fonts/medleydisplayfonts/HELVETICA24-MRR.MEDLEYDISPLAYFONT b/fonts/medleydisplayfonts/HELVETICA24-MRR.MEDLEYDISPLAYFONT index e360e8dc4..9baf3c8dd 100644 Binary files a/fonts/medleydisplayfonts/HELVETICA24-MRR.MEDLEYDISPLAYFONT and b/fonts/medleydisplayfonts/HELVETICA24-MRR.MEDLEYDISPLAYFONT differ diff --git a/fonts/medleydisplayfonts/HELVETICA30-MRR.MEDLEYDISPLAYFONT b/fonts/medleydisplayfonts/HELVETICA30-MRR.MEDLEYDISPLAYFONT index dedb5a78c..f1f80a753 100644 Binary files a/fonts/medleydisplayfonts/HELVETICA30-MRR.MEDLEYDISPLAYFONT and b/fonts/medleydisplayfonts/HELVETICA30-MRR.MEDLEYDISPLAYFONT differ diff --git a/fonts/medleydisplayfonts/HELVETICA32-MRR.MEDLEYDISPLAYFONT b/fonts/medleydisplayfonts/HELVETICA32-MRR.MEDLEYDISPLAYFONT index 0ae39c69e..e4e3fc925 100644 Binary files a/fonts/medleydisplayfonts/HELVETICA32-MRR.MEDLEYDISPLAYFONT and b/fonts/medleydisplayfonts/HELVETICA32-MRR.MEDLEYDISPLAYFONT differ diff --git a/fonts/medleydisplayfonts/HELVETICA36-MRR.MEDLEYDISPLAYFONT b/fonts/medleydisplayfonts/HELVETICA36-MRR.MEDLEYDISPLAYFONT index 370f5e1ad..ed64bc234 100644 Binary files a/fonts/medleydisplayfonts/HELVETICA36-MRR.MEDLEYDISPLAYFONT and b/fonts/medleydisplayfonts/HELVETICA36-MRR.MEDLEYDISPLAYFONT differ diff --git a/fonts/medleydisplayfonts/HELVETICAD24-MRR.MEDLEYDISPLAYFONT b/fonts/medleydisplayfonts/HELVETICAD24-MRR.MEDLEYDISPLAYFONT index b39098e92..564949e6f 100644 Binary files a/fonts/medleydisplayfonts/HELVETICAD24-MRR.MEDLEYDISPLAYFONT and b/fonts/medleydisplayfonts/HELVETICAD24-MRR.MEDLEYDISPLAYFONT differ diff --git a/fonts/medleydisplayfonts/HIPPO08-MRR.MEDLEYDISPLAYFONT b/fonts/medleydisplayfonts/HIPPO08-MRR.MEDLEYDISPLAYFONT index 3677b2f4f..b4a7eea0f 100644 Binary files a/fonts/medleydisplayfonts/HIPPO08-MRR.MEDLEYDISPLAYFONT and b/fonts/medleydisplayfonts/HIPPO08-MRR.MEDLEYDISPLAYFONT differ diff --git a/fonts/medleydisplayfonts/HIPPO10-MRR.MEDLEYDISPLAYFONT b/fonts/medleydisplayfonts/HIPPO10-MRR.MEDLEYDISPLAYFONT index 4395de50f..5644fafd5 100644 Binary files a/fonts/medleydisplayfonts/HIPPO10-MRR.MEDLEYDISPLAYFONT and b/fonts/medleydisplayfonts/HIPPO10-MRR.MEDLEYDISPLAYFONT differ diff --git a/fonts/medleydisplayfonts/HIPPO12-MRR.MEDLEYDISPLAYFONT b/fonts/medleydisplayfonts/HIPPO12-MRR.MEDLEYDISPLAYFONT index 5e951aa29..6c4a22762 100644 Binary files a/fonts/medleydisplayfonts/HIPPO12-MRR.MEDLEYDISPLAYFONT and b/fonts/medleydisplayfonts/HIPPO12-MRR.MEDLEYDISPLAYFONT differ diff --git a/fonts/medleydisplayfonts/HIPPO18-MRR.MEDLEYDISPLAYFONT b/fonts/medleydisplayfonts/HIPPO18-MRR.MEDLEYDISPLAYFONT index b9066bc08..b309c5a58 100644 Binary files a/fonts/medleydisplayfonts/HIPPO18-MRR.MEDLEYDISPLAYFONT and b/fonts/medleydisplayfonts/HIPPO18-MRR.MEDLEYDISPLAYFONT differ diff --git a/fonts/medleydisplayfonts/IBM-US14-MRR.MEDLEYDISPLAYFONT b/fonts/medleydisplayfonts/IBM-US14-MRR.MEDLEYDISPLAYFONT index d18067321..c254931e2 100644 Binary files a/fonts/medleydisplayfonts/IBM-US14-MRR.MEDLEYDISPLAYFONT and b/fonts/medleydisplayfonts/IBM-US14-MRR.MEDLEYDISPLAYFONT differ diff --git a/fonts/medleydisplayfonts/IBM-US16-MRR.MEDLEYDISPLAYFONT b/fonts/medleydisplayfonts/IBM-US16-MRR.MEDLEYDISPLAYFONT index afee037ad..08d3b01fb 100644 Binary files a/fonts/medleydisplayfonts/IBM-US16-MRR.MEDLEYDISPLAYFONT and b/fonts/medleydisplayfonts/IBM-US16-MRR.MEDLEYDISPLAYFONT differ diff --git a/fonts/medleydisplayfonts/IBM14-MRR.MEDLEYDISPLAYFONT b/fonts/medleydisplayfonts/IBM14-MRR.MEDLEYDISPLAYFONT index 5de7a7341..6a280afa4 100644 Binary files a/fonts/medleydisplayfonts/IBM14-MRR.MEDLEYDISPLAYFONT and b/fonts/medleydisplayfonts/IBM14-MRR.MEDLEYDISPLAYFONT differ diff --git a/fonts/medleydisplayfonts/IBM16-MRR.MEDLEYDISPLAYFONT b/fonts/medleydisplayfonts/IBM16-MRR.MEDLEYDISPLAYFONT index 14c2849d3..ed5cd66b6 100644 Binary files a/fonts/medleydisplayfonts/IBM16-MRR.MEDLEYDISPLAYFONT and b/fonts/medleydisplayfonts/IBM16-MRR.MEDLEYDISPLAYFONT differ diff --git a/fonts/medleydisplayfonts/IBMREV14-MRR.MEDLEYDISPLAYFONT b/fonts/medleydisplayfonts/IBMREV14-MRR.MEDLEYDISPLAYFONT index 06dc993a2..f53ec4f49 100644 Binary files a/fonts/medleydisplayfonts/IBMREV14-MRR.MEDLEYDISPLAYFONT and b/fonts/medleydisplayfonts/IBMREV14-MRR.MEDLEYDISPLAYFONT differ diff --git a/fonts/medleydisplayfonts/IBMREV16-MRR.MEDLEYDISPLAYFONT b/fonts/medleydisplayfonts/IBMREV16-MRR.MEDLEYDISPLAYFONT index ed130af7c..89e592311 100644 Binary files a/fonts/medleydisplayfonts/IBMREV16-MRR.MEDLEYDISPLAYFONT and b/fonts/medleydisplayfonts/IBMREV16-MRR.MEDLEYDISPLAYFONT differ diff --git a/fonts/medleydisplayfonts/LETTERGOTHIC10-BRR.MEDLEYDISPLAYFONT b/fonts/medleydisplayfonts/LETTERGOTHIC10-BRR.MEDLEYDISPLAYFONT index 7a6d60177..0e721682b 100644 Binary files a/fonts/medleydisplayfonts/LETTERGOTHIC10-BRR.MEDLEYDISPLAYFONT and b/fonts/medleydisplayfonts/LETTERGOTHIC10-BRR.MEDLEYDISPLAYFONT differ diff --git a/fonts/medleydisplayfonts/LETTERGOTHIC10-MRR.MEDLEYDISPLAYFONT b/fonts/medleydisplayfonts/LETTERGOTHIC10-MRR.MEDLEYDISPLAYFONT index a09b820ab..a38ab1e60 100644 Binary files a/fonts/medleydisplayfonts/LETTERGOTHIC10-MRR.MEDLEYDISPLAYFONT and b/fonts/medleydisplayfonts/LETTERGOTHIC10-MRR.MEDLEYDISPLAYFONT differ diff --git a/fonts/medleydisplayfonts/LETTERGOTHIC12-MRR.MEDLEYDISPLAYFONT b/fonts/medleydisplayfonts/LETTERGOTHIC12-MRR.MEDLEYDISPLAYFONT index b07cff62a..77c2aa02f 100644 Binary files a/fonts/medleydisplayfonts/LETTERGOTHIC12-MRR.MEDLEYDISPLAYFONT and b/fonts/medleydisplayfonts/LETTERGOTHIC12-MRR.MEDLEYDISPLAYFONT differ diff --git a/fonts/medleydisplayfonts/LOGO12-MRR.MEDLEYDISPLAYFONT b/fonts/medleydisplayfonts/LOGO12-MRR.MEDLEYDISPLAYFONT index 7635574d2..d1b2e5b91 100644 Binary files a/fonts/medleydisplayfonts/LOGO12-MRR.MEDLEYDISPLAYFONT and b/fonts/medleydisplayfonts/LOGO12-MRR.MEDLEYDISPLAYFONT differ diff --git a/fonts/medleydisplayfonts/LOGO14-MRR.MEDLEYDISPLAYFONT b/fonts/medleydisplayfonts/LOGO14-MRR.MEDLEYDISPLAYFONT index 12f0ebd3e..5224bee93 100644 Binary files a/fonts/medleydisplayfonts/LOGO14-MRR.MEDLEYDISPLAYFONT and b/fonts/medleydisplayfonts/LOGO14-MRR.MEDLEYDISPLAYFONT differ diff --git a/fonts/medleydisplayfonts/LOGO18-MRR.MEDLEYDISPLAYFONT b/fonts/medleydisplayfonts/LOGO18-MRR.MEDLEYDISPLAYFONT index 174d6f8ff..1a3f9333c 100644 Binary files a/fonts/medleydisplayfonts/LOGO18-MRR.MEDLEYDISPLAYFONT and b/fonts/medleydisplayfonts/LOGO18-MRR.MEDLEYDISPLAYFONT differ diff --git a/fonts/medleydisplayfonts/LOGO20-MRR.MEDLEYDISPLAYFONT b/fonts/medleydisplayfonts/LOGO20-MRR.MEDLEYDISPLAYFONT index cf3abcdca..516741208 100644 Binary files a/fonts/medleydisplayfonts/LOGO20-MRR.MEDLEYDISPLAYFONT and b/fonts/medleydisplayfonts/LOGO20-MRR.MEDLEYDISPLAYFONT differ diff --git a/fonts/medleydisplayfonts/LOGO24-MRR.MEDLEYDISPLAYFONT b/fonts/medleydisplayfonts/LOGO24-MRR.MEDLEYDISPLAYFONT index eb3d292b5..08d6ff516 100644 Binary files a/fonts/medleydisplayfonts/LOGO24-MRR.MEDLEYDISPLAYFONT and b/fonts/medleydisplayfonts/LOGO24-MRR.MEDLEYDISPLAYFONT differ diff --git a/fonts/medleydisplayfonts/LOGO26-MRR.MEDLEYDISPLAYFONT b/fonts/medleydisplayfonts/LOGO26-MRR.MEDLEYDISPLAYFONT index 00e8b68a9..2c7160400 100644 Binary files a/fonts/medleydisplayfonts/LOGO26-MRR.MEDLEYDISPLAYFONT and b/fonts/medleydisplayfonts/LOGO26-MRR.MEDLEYDISPLAYFONT differ diff --git a/fonts/medleydisplayfonts/MATH08-MRR.MEDLEYDISPLAYFONT b/fonts/medleydisplayfonts/MATH08-MRR.MEDLEYDISPLAYFONT index 4d38bf9b0..2145cbb2d 100644 Binary files a/fonts/medleydisplayfonts/MATH08-MRR.MEDLEYDISPLAYFONT and b/fonts/medleydisplayfonts/MATH08-MRR.MEDLEYDISPLAYFONT differ diff --git a/fonts/medleydisplayfonts/MATH10-MRR.MEDLEYDISPLAYFONT b/fonts/medleydisplayfonts/MATH10-MRR.MEDLEYDISPLAYFONT index f0da3b4c4..5189c2b65 100644 Binary files a/fonts/medleydisplayfonts/MATH10-MRR.MEDLEYDISPLAYFONT and b/fonts/medleydisplayfonts/MATH10-MRR.MEDLEYDISPLAYFONT differ diff --git a/fonts/medleydisplayfonts/MATH12-BRR.MEDLEYDISPLAYFONT b/fonts/medleydisplayfonts/MATH12-BRR.MEDLEYDISPLAYFONT index 76834e150..f6d371fa2 100644 Binary files a/fonts/medleydisplayfonts/MATH12-BRR.MEDLEYDISPLAYFONT and b/fonts/medleydisplayfonts/MATH12-BRR.MEDLEYDISPLAYFONT differ diff --git a/fonts/medleydisplayfonts/MATH12-MRR.MEDLEYDISPLAYFONT b/fonts/medleydisplayfonts/MATH12-MRR.MEDLEYDISPLAYFONT index a3a3fe0a1..3f9f66a60 100644 Binary files a/fonts/medleydisplayfonts/MATH12-MRR.MEDLEYDISPLAYFONT and b/fonts/medleydisplayfonts/MATH12-MRR.MEDLEYDISPLAYFONT differ diff --git a/fonts/medleydisplayfonts/MODERN06-BIR.MEDLEYDISPLAYFONT b/fonts/medleydisplayfonts/MODERN06-BIR.MEDLEYDISPLAYFONT index 061e0acf3..ee0bce612 100644 Binary files a/fonts/medleydisplayfonts/MODERN06-BIR.MEDLEYDISPLAYFONT and b/fonts/medleydisplayfonts/MODERN06-BIR.MEDLEYDISPLAYFONT differ diff --git a/fonts/medleydisplayfonts/MODERN06-BRR.MEDLEYDISPLAYFONT b/fonts/medleydisplayfonts/MODERN06-BRR.MEDLEYDISPLAYFONT index 68e33e305..f720fb0fd 100644 Binary files a/fonts/medleydisplayfonts/MODERN06-BRR.MEDLEYDISPLAYFONT and b/fonts/medleydisplayfonts/MODERN06-BRR.MEDLEYDISPLAYFONT differ diff --git a/fonts/medleydisplayfonts/MODERN06-MIR.MEDLEYDISPLAYFONT b/fonts/medleydisplayfonts/MODERN06-MIR.MEDLEYDISPLAYFONT index 9b07379a2..c29cd1e37 100644 Binary files a/fonts/medleydisplayfonts/MODERN06-MIR.MEDLEYDISPLAYFONT and b/fonts/medleydisplayfonts/MODERN06-MIR.MEDLEYDISPLAYFONT differ diff --git a/fonts/medleydisplayfonts/MODERN06-MRR.MEDLEYDISPLAYFONT b/fonts/medleydisplayfonts/MODERN06-MRR.MEDLEYDISPLAYFONT index a0ef45685..4f7ae150e 100644 Binary files a/fonts/medleydisplayfonts/MODERN06-MRR.MEDLEYDISPLAYFONT and b/fonts/medleydisplayfonts/MODERN06-MRR.MEDLEYDISPLAYFONT differ diff --git a/fonts/medleydisplayfonts/MODERN08-BIR.MEDLEYDISPLAYFONT b/fonts/medleydisplayfonts/MODERN08-BIR.MEDLEYDISPLAYFONT index 434744e86..9bfb5d3b2 100644 Binary files a/fonts/medleydisplayfonts/MODERN08-BIR.MEDLEYDISPLAYFONT and b/fonts/medleydisplayfonts/MODERN08-BIR.MEDLEYDISPLAYFONT differ diff --git a/fonts/medleydisplayfonts/MODERN08-BRR.MEDLEYDISPLAYFONT b/fonts/medleydisplayfonts/MODERN08-BRR.MEDLEYDISPLAYFONT index 06cc06f14..21569a287 100644 Binary files a/fonts/medleydisplayfonts/MODERN08-BRR.MEDLEYDISPLAYFONT and b/fonts/medleydisplayfonts/MODERN08-BRR.MEDLEYDISPLAYFONT differ diff --git a/fonts/medleydisplayfonts/MODERN08-MIR.MEDLEYDISPLAYFONT b/fonts/medleydisplayfonts/MODERN08-MIR.MEDLEYDISPLAYFONT index 3ece2bb84..1c98a8b4f 100644 Binary files a/fonts/medleydisplayfonts/MODERN08-MIR.MEDLEYDISPLAYFONT and b/fonts/medleydisplayfonts/MODERN08-MIR.MEDLEYDISPLAYFONT differ diff --git a/fonts/medleydisplayfonts/MODERN08-MRR.MEDLEYDISPLAYFONT b/fonts/medleydisplayfonts/MODERN08-MRR.MEDLEYDISPLAYFONT index 4794c0d74..bb5ada93b 100644 Binary files a/fonts/medleydisplayfonts/MODERN08-MRR.MEDLEYDISPLAYFONT and b/fonts/medleydisplayfonts/MODERN08-MRR.MEDLEYDISPLAYFONT differ diff --git a/fonts/medleydisplayfonts/MODERN10-BIR.MEDLEYDISPLAYFONT b/fonts/medleydisplayfonts/MODERN10-BIR.MEDLEYDISPLAYFONT index 1684628c3..702c290c2 100644 Binary files a/fonts/medleydisplayfonts/MODERN10-BIR.MEDLEYDISPLAYFONT and b/fonts/medleydisplayfonts/MODERN10-BIR.MEDLEYDISPLAYFONT differ diff --git a/fonts/medleydisplayfonts/MODERN10-BRR.MEDLEYDISPLAYFONT b/fonts/medleydisplayfonts/MODERN10-BRR.MEDLEYDISPLAYFONT index 85702654e..03fbf37f8 100644 Binary files a/fonts/medleydisplayfonts/MODERN10-BRR.MEDLEYDISPLAYFONT and b/fonts/medleydisplayfonts/MODERN10-BRR.MEDLEYDISPLAYFONT differ diff --git a/fonts/medleydisplayfonts/MODERN10-MIR.MEDLEYDISPLAYFONT b/fonts/medleydisplayfonts/MODERN10-MIR.MEDLEYDISPLAYFONT index 3514c1d15..5b9d3baff 100644 Binary files a/fonts/medleydisplayfonts/MODERN10-MIR.MEDLEYDISPLAYFONT and b/fonts/medleydisplayfonts/MODERN10-MIR.MEDLEYDISPLAYFONT differ diff --git a/fonts/medleydisplayfonts/MODERN10-MRR.MEDLEYDISPLAYFONT b/fonts/medleydisplayfonts/MODERN10-MRR.MEDLEYDISPLAYFONT index d7049b386..2a66a9bbd 100644 Binary files a/fonts/medleydisplayfonts/MODERN10-MRR.MEDLEYDISPLAYFONT and b/fonts/medleydisplayfonts/MODERN10-MRR.MEDLEYDISPLAYFONT differ diff --git a/fonts/medleydisplayfonts/MODERN12-BIR.MEDLEYDISPLAYFONT b/fonts/medleydisplayfonts/MODERN12-BIR.MEDLEYDISPLAYFONT index a203b4dc1..788b1eec9 100644 Binary files a/fonts/medleydisplayfonts/MODERN12-BIR.MEDLEYDISPLAYFONT and b/fonts/medleydisplayfonts/MODERN12-BIR.MEDLEYDISPLAYFONT differ diff --git a/fonts/medleydisplayfonts/MODERN12-BRR.MEDLEYDISPLAYFONT b/fonts/medleydisplayfonts/MODERN12-BRR.MEDLEYDISPLAYFONT index ec037e6ad..5b663b84e 100644 Binary files a/fonts/medleydisplayfonts/MODERN12-BRR.MEDLEYDISPLAYFONT and b/fonts/medleydisplayfonts/MODERN12-BRR.MEDLEYDISPLAYFONT differ diff --git a/fonts/medleydisplayfonts/MODERN12-MIR.MEDLEYDISPLAYFONT b/fonts/medleydisplayfonts/MODERN12-MIR.MEDLEYDISPLAYFONT index 2da2adec7..1caf09bba 100644 Binary files a/fonts/medleydisplayfonts/MODERN12-MIR.MEDLEYDISPLAYFONT and b/fonts/medleydisplayfonts/MODERN12-MIR.MEDLEYDISPLAYFONT differ diff --git a/fonts/medleydisplayfonts/MODERN12-MRR.MEDLEYDISPLAYFONT b/fonts/medleydisplayfonts/MODERN12-MRR.MEDLEYDISPLAYFONT index 4024b5c7e..e19ce4d1d 100644 Binary files a/fonts/medleydisplayfonts/MODERN12-MRR.MEDLEYDISPLAYFONT and b/fonts/medleydisplayfonts/MODERN12-MRR.MEDLEYDISPLAYFONT differ diff --git a/fonts/medleydisplayfonts/MODERN14-BIR.MEDLEYDISPLAYFONT b/fonts/medleydisplayfonts/MODERN14-BIR.MEDLEYDISPLAYFONT index acf6dfee7..260e5bc29 100644 Binary files a/fonts/medleydisplayfonts/MODERN14-BIR.MEDLEYDISPLAYFONT and b/fonts/medleydisplayfonts/MODERN14-BIR.MEDLEYDISPLAYFONT differ diff --git a/fonts/medleydisplayfonts/MODERN14-BRR.MEDLEYDISPLAYFONT b/fonts/medleydisplayfonts/MODERN14-BRR.MEDLEYDISPLAYFONT index 31caeadad..3f7259409 100644 Binary files a/fonts/medleydisplayfonts/MODERN14-BRR.MEDLEYDISPLAYFONT and b/fonts/medleydisplayfonts/MODERN14-BRR.MEDLEYDISPLAYFONT differ diff --git a/fonts/medleydisplayfonts/MODERN14-MIR.MEDLEYDISPLAYFONT b/fonts/medleydisplayfonts/MODERN14-MIR.MEDLEYDISPLAYFONT index b6c03d6dc..c8ae78b9e 100644 Binary files a/fonts/medleydisplayfonts/MODERN14-MIR.MEDLEYDISPLAYFONT and b/fonts/medleydisplayfonts/MODERN14-MIR.MEDLEYDISPLAYFONT differ diff --git a/fonts/medleydisplayfonts/MODERN14-MRR.MEDLEYDISPLAYFONT b/fonts/medleydisplayfonts/MODERN14-MRR.MEDLEYDISPLAYFONT index 227a575ad..ab3bfefee 100644 Binary files a/fonts/medleydisplayfonts/MODERN14-MRR.MEDLEYDISPLAYFONT and b/fonts/medleydisplayfonts/MODERN14-MRR.MEDLEYDISPLAYFONT differ diff --git a/fonts/medleydisplayfonts/MODERN18-BIR.MEDLEYDISPLAYFONT b/fonts/medleydisplayfonts/MODERN18-BIR.MEDLEYDISPLAYFONT index 683a48a42..a47035ec2 100644 Binary files a/fonts/medleydisplayfonts/MODERN18-BIR.MEDLEYDISPLAYFONT and b/fonts/medleydisplayfonts/MODERN18-BIR.MEDLEYDISPLAYFONT differ diff --git a/fonts/medleydisplayfonts/MODERN18-BRR.MEDLEYDISPLAYFONT b/fonts/medleydisplayfonts/MODERN18-BRR.MEDLEYDISPLAYFONT index 23247993a..78ec0e182 100644 Binary files a/fonts/medleydisplayfonts/MODERN18-BRR.MEDLEYDISPLAYFONT and b/fonts/medleydisplayfonts/MODERN18-BRR.MEDLEYDISPLAYFONT differ diff --git a/fonts/medleydisplayfonts/MODERN18-MIR.MEDLEYDISPLAYFONT b/fonts/medleydisplayfonts/MODERN18-MIR.MEDLEYDISPLAYFONT index 7b3b444f1..f5906daaf 100644 Binary files a/fonts/medleydisplayfonts/MODERN18-MIR.MEDLEYDISPLAYFONT and b/fonts/medleydisplayfonts/MODERN18-MIR.MEDLEYDISPLAYFONT differ diff --git a/fonts/medleydisplayfonts/MODERN18-MRR.MEDLEYDISPLAYFONT b/fonts/medleydisplayfonts/MODERN18-MRR.MEDLEYDISPLAYFONT index 3297fff33..626a42b74 100644 Binary files a/fonts/medleydisplayfonts/MODERN18-MRR.MEDLEYDISPLAYFONT and b/fonts/medleydisplayfonts/MODERN18-MRR.MEDLEYDISPLAYFONT differ diff --git a/fonts/medleydisplayfonts/MODERN24-BIR.MEDLEYDISPLAYFONT b/fonts/medleydisplayfonts/MODERN24-BIR.MEDLEYDISPLAYFONT index 23bb41462..7a4afafb4 100644 Binary files a/fonts/medleydisplayfonts/MODERN24-BIR.MEDLEYDISPLAYFONT and b/fonts/medleydisplayfonts/MODERN24-BIR.MEDLEYDISPLAYFONT differ diff --git a/fonts/medleydisplayfonts/MODERN24-BRR.MEDLEYDISPLAYFONT b/fonts/medleydisplayfonts/MODERN24-BRR.MEDLEYDISPLAYFONT index 14c5e2710..a3446411d 100644 Binary files a/fonts/medleydisplayfonts/MODERN24-BRR.MEDLEYDISPLAYFONT and b/fonts/medleydisplayfonts/MODERN24-BRR.MEDLEYDISPLAYFONT differ diff --git a/fonts/medleydisplayfonts/MODERN24-MIR.MEDLEYDISPLAYFONT b/fonts/medleydisplayfonts/MODERN24-MIR.MEDLEYDISPLAYFONT index 14f75684a..5365620cd 100644 Binary files a/fonts/medleydisplayfonts/MODERN24-MIR.MEDLEYDISPLAYFONT and b/fonts/medleydisplayfonts/MODERN24-MIR.MEDLEYDISPLAYFONT differ diff --git a/fonts/medleydisplayfonts/MODERN24-MRR.MEDLEYDISPLAYFONT b/fonts/medleydisplayfonts/MODERN24-MRR.MEDLEYDISPLAYFONT index 32cad1a95..4e91b5350 100644 Binary files a/fonts/medleydisplayfonts/MODERN24-MRR.MEDLEYDISPLAYFONT and b/fonts/medleydisplayfonts/MODERN24-MRR.MEDLEYDISPLAYFONT differ diff --git a/fonts/medleydisplayfonts/MODERN30-BIR.MEDLEYDISPLAYFONT b/fonts/medleydisplayfonts/MODERN30-BIR.MEDLEYDISPLAYFONT index 17515bca8..f4b0a7bda 100644 Binary files a/fonts/medleydisplayfonts/MODERN30-BIR.MEDLEYDISPLAYFONT and b/fonts/medleydisplayfonts/MODERN30-BIR.MEDLEYDISPLAYFONT differ diff --git a/fonts/medleydisplayfonts/MODERN30-BRR.MEDLEYDISPLAYFONT b/fonts/medleydisplayfonts/MODERN30-BRR.MEDLEYDISPLAYFONT index 3df06e8c0..56d23f233 100644 Binary files a/fonts/medleydisplayfonts/MODERN30-BRR.MEDLEYDISPLAYFONT and b/fonts/medleydisplayfonts/MODERN30-BRR.MEDLEYDISPLAYFONT differ diff --git a/fonts/medleydisplayfonts/MODERN30-MIR.MEDLEYDISPLAYFONT b/fonts/medleydisplayfonts/MODERN30-MIR.MEDLEYDISPLAYFONT index fd8f923f2..e36d05a44 100644 Binary files a/fonts/medleydisplayfonts/MODERN30-MIR.MEDLEYDISPLAYFONT and b/fonts/medleydisplayfonts/MODERN30-MIR.MEDLEYDISPLAYFONT differ diff --git a/fonts/medleydisplayfonts/MODERN30-MRR.MEDLEYDISPLAYFONT b/fonts/medleydisplayfonts/MODERN30-MRR.MEDLEYDISPLAYFONT index 322652883..67e01094c 100644 Binary files a/fonts/medleydisplayfonts/MODERN30-MRR.MEDLEYDISPLAYFONT and b/fonts/medleydisplayfonts/MODERN30-MRR.MEDLEYDISPLAYFONT differ diff --git a/fonts/medleydisplayfonts/MODERN36-BIR.MEDLEYDISPLAYFONT b/fonts/medleydisplayfonts/MODERN36-BIR.MEDLEYDISPLAYFONT index 29bbf4031..486af5306 100644 Binary files a/fonts/medleydisplayfonts/MODERN36-BIR.MEDLEYDISPLAYFONT and b/fonts/medleydisplayfonts/MODERN36-BIR.MEDLEYDISPLAYFONT differ diff --git a/fonts/medleydisplayfonts/MODERN36-BRR.MEDLEYDISPLAYFONT b/fonts/medleydisplayfonts/MODERN36-BRR.MEDLEYDISPLAYFONT index fa6cdb7ff..1db25d21d 100644 Binary files a/fonts/medleydisplayfonts/MODERN36-BRR.MEDLEYDISPLAYFONT and b/fonts/medleydisplayfonts/MODERN36-BRR.MEDLEYDISPLAYFONT differ diff --git a/fonts/medleydisplayfonts/MODERN36-MIR.MEDLEYDISPLAYFONT b/fonts/medleydisplayfonts/MODERN36-MIR.MEDLEYDISPLAYFONT index eba69c236..bd91ad8c8 100644 Binary files a/fonts/medleydisplayfonts/MODERN36-MIR.MEDLEYDISPLAYFONT and b/fonts/medleydisplayfonts/MODERN36-MIR.MEDLEYDISPLAYFONT differ diff --git a/fonts/medleydisplayfonts/MODERN36-MRR.MEDLEYDISPLAYFONT b/fonts/medleydisplayfonts/MODERN36-MRR.MEDLEYDISPLAYFONT index 4c2271889..26f19daf3 100644 Binary files a/fonts/medleydisplayfonts/MODERN36-MRR.MEDLEYDISPLAYFONT and b/fonts/medleydisplayfonts/MODERN36-MRR.MEDLEYDISPLAYFONT differ diff --git a/fonts/medleydisplayfonts/MODERN48-BRR.MEDLEYDISPLAYFONT b/fonts/medleydisplayfonts/MODERN48-BRR.MEDLEYDISPLAYFONT index 0fbf0029c..f9bc3b702 100644 Binary files a/fonts/medleydisplayfonts/MODERN48-BRR.MEDLEYDISPLAYFONT and b/fonts/medleydisplayfonts/MODERN48-BRR.MEDLEYDISPLAYFONT differ diff --git a/fonts/medleydisplayfonts/MODERN48-MIR.MEDLEYDISPLAYFONT b/fonts/medleydisplayfonts/MODERN48-MIR.MEDLEYDISPLAYFONT index eb5237a8b..1f2ae0be0 100644 Binary files a/fonts/medleydisplayfonts/MODERN48-MIR.MEDLEYDISPLAYFONT and b/fonts/medleydisplayfonts/MODERN48-MIR.MEDLEYDISPLAYFONT differ diff --git a/fonts/medleydisplayfonts/MODERN48-MRR.MEDLEYDISPLAYFONT b/fonts/medleydisplayfonts/MODERN48-MRR.MEDLEYDISPLAYFONT index fe01c5c1f..1548c041a 100644 Binary files a/fonts/medleydisplayfonts/MODERN48-MRR.MEDLEYDISPLAYFONT and b/fonts/medleydisplayfonts/MODERN48-MRR.MEDLEYDISPLAYFONT differ diff --git a/fonts/medleydisplayfonts/MODERN72-BIR.MEDLEYDISPLAYFONT b/fonts/medleydisplayfonts/MODERN72-BIR.MEDLEYDISPLAYFONT index 6614fad98..cf0ad88d5 100644 Binary files a/fonts/medleydisplayfonts/MODERN72-BIR.MEDLEYDISPLAYFONT and b/fonts/medleydisplayfonts/MODERN72-BIR.MEDLEYDISPLAYFONT differ diff --git a/fonts/medleydisplayfonts/MODERN72-BRR.MEDLEYDISPLAYFONT b/fonts/medleydisplayfonts/MODERN72-BRR.MEDLEYDISPLAYFONT index db20313df..7468c5c72 100644 Binary files a/fonts/medleydisplayfonts/MODERN72-BRR.MEDLEYDISPLAYFONT and b/fonts/medleydisplayfonts/MODERN72-BRR.MEDLEYDISPLAYFONT differ diff --git a/fonts/medleydisplayfonts/MODERN72-MIR.MEDLEYDISPLAYFONT b/fonts/medleydisplayfonts/MODERN72-MIR.MEDLEYDISPLAYFONT index 2ffbde843..f704b67c9 100644 Binary files a/fonts/medleydisplayfonts/MODERN72-MIR.MEDLEYDISPLAYFONT and b/fonts/medleydisplayfonts/MODERN72-MIR.MEDLEYDISPLAYFONT differ diff --git a/fonts/medleydisplayfonts/MODERN72-MRR.MEDLEYDISPLAYFONT b/fonts/medleydisplayfonts/MODERN72-MRR.MEDLEYDISPLAYFONT index 30ce68e1f..570e32225 100644 Binary files a/fonts/medleydisplayfonts/MODERN72-MRR.MEDLEYDISPLAYFONT and b/fonts/medleydisplayfonts/MODERN72-MRR.MEDLEYDISPLAYFONT differ diff --git a/fonts/medleydisplayfonts/MUSIC08-MRR.MEDLEYDISPLAYFONT b/fonts/medleydisplayfonts/MUSIC08-MRR.MEDLEYDISPLAYFONT index 2081f3c9d..6ee2cd11d 100644 Binary files a/fonts/medleydisplayfonts/MUSIC08-MRR.MEDLEYDISPLAYFONT and b/fonts/medleydisplayfonts/MUSIC08-MRR.MEDLEYDISPLAYFONT differ diff --git a/fonts/medleydisplayfonts/MUSIC09-MRR.MEDLEYDISPLAYFONT b/fonts/medleydisplayfonts/MUSIC09-MRR.MEDLEYDISPLAYFONT index 0d2092eea..7cc2765dd 100644 Binary files a/fonts/medleydisplayfonts/MUSIC09-MRR.MEDLEYDISPLAYFONT and b/fonts/medleydisplayfonts/MUSIC09-MRR.MEDLEYDISPLAYFONT differ diff --git a/fonts/medleydisplayfonts/MUSIC10-MRR.MEDLEYDISPLAYFONT b/fonts/medleydisplayfonts/MUSIC10-MRR.MEDLEYDISPLAYFONT index e103896e0..b5fa6cdf4 100644 Binary files a/fonts/medleydisplayfonts/MUSIC10-MRR.MEDLEYDISPLAYFONT and b/fonts/medleydisplayfonts/MUSIC10-MRR.MEDLEYDISPLAYFONT differ diff --git a/fonts/medleydisplayfonts/MUSIC12-MRR.MEDLEYDISPLAYFONT b/fonts/medleydisplayfonts/MUSIC12-MRR.MEDLEYDISPLAYFONT index 4c5ce497d..20a7f41a3 100644 Binary files a/fonts/medleydisplayfonts/MUSIC12-MRR.MEDLEYDISPLAYFONT and b/fonts/medleydisplayfonts/MUSIC12-MRR.MEDLEYDISPLAYFONT differ diff --git a/fonts/medleydisplayfonts/MUSIC14-MRR.MEDLEYDISPLAYFONT b/fonts/medleydisplayfonts/MUSIC14-MRR.MEDLEYDISPLAYFONT index 02f2655c9..21e5e085e 100644 Binary files a/fonts/medleydisplayfonts/MUSIC14-MRR.MEDLEYDISPLAYFONT and b/fonts/medleydisplayfonts/MUSIC14-MRR.MEDLEYDISPLAYFONT differ diff --git a/fonts/medleydisplayfonts/MUSICFONT10-MRR.MEDLEYDISPLAYFONT b/fonts/medleydisplayfonts/MUSICFONT10-MRR.MEDLEYDISPLAYFONT index 89143a4bf..ef4045965 100644 Binary files a/fonts/medleydisplayfonts/MUSICFONT10-MRR.MEDLEYDISPLAYFONT and b/fonts/medleydisplayfonts/MUSICFONT10-MRR.MEDLEYDISPLAYFONT differ diff --git a/fonts/medleydisplayfonts/OLDENGLISH10-MRR.MEDLEYDISPLAYFONT b/fonts/medleydisplayfonts/OLDENGLISH10-MRR.MEDLEYDISPLAYFONT index 6d380404b..a05ba1b85 100644 Binary files a/fonts/medleydisplayfonts/OLDENGLISH10-MRR.MEDLEYDISPLAYFONT and b/fonts/medleydisplayfonts/OLDENGLISH10-MRR.MEDLEYDISPLAYFONT differ diff --git a/fonts/medleydisplayfonts/OLDENGLISH18-MRR.MEDLEYDISPLAYFONT b/fonts/medleydisplayfonts/OLDENGLISH18-MRR.MEDLEYDISPLAYFONT index 976e8574a..6cee6dbfc 100644 Binary files a/fonts/medleydisplayfonts/OLDENGLISH18-MRR.MEDLEYDISPLAYFONT and b/fonts/medleydisplayfonts/OLDENGLISH18-MRR.MEDLEYDISPLAYFONT differ diff --git a/fonts/medleydisplayfonts/OPTIMA06-BIR.MEDLEYDISPLAYFONT b/fonts/medleydisplayfonts/OPTIMA06-BIR.MEDLEYDISPLAYFONT index 371aa6400..0e61adbb4 100644 Binary files a/fonts/medleydisplayfonts/OPTIMA06-BIR.MEDLEYDISPLAYFONT and b/fonts/medleydisplayfonts/OPTIMA06-BIR.MEDLEYDISPLAYFONT differ diff --git a/fonts/medleydisplayfonts/OPTIMA06-BRR.MEDLEYDISPLAYFONT b/fonts/medleydisplayfonts/OPTIMA06-BRR.MEDLEYDISPLAYFONT index 109dc7a22..f09b841c2 100644 Binary files a/fonts/medleydisplayfonts/OPTIMA06-BRR.MEDLEYDISPLAYFONT and b/fonts/medleydisplayfonts/OPTIMA06-BRR.MEDLEYDISPLAYFONT differ diff --git a/fonts/medleydisplayfonts/OPTIMA06-MIR.MEDLEYDISPLAYFONT b/fonts/medleydisplayfonts/OPTIMA06-MIR.MEDLEYDISPLAYFONT index bac61e3b0..c525e3840 100644 Binary files a/fonts/medleydisplayfonts/OPTIMA06-MIR.MEDLEYDISPLAYFONT and b/fonts/medleydisplayfonts/OPTIMA06-MIR.MEDLEYDISPLAYFONT differ diff --git a/fonts/medleydisplayfonts/OPTIMA06-MRR.MEDLEYDISPLAYFONT b/fonts/medleydisplayfonts/OPTIMA06-MRR.MEDLEYDISPLAYFONT index 62ce71063..9265692a0 100644 Binary files a/fonts/medleydisplayfonts/OPTIMA06-MRR.MEDLEYDISPLAYFONT and b/fonts/medleydisplayfonts/OPTIMA06-MRR.MEDLEYDISPLAYFONT differ diff --git a/fonts/medleydisplayfonts/OPTIMA07-BIR.MEDLEYDISPLAYFONT b/fonts/medleydisplayfonts/OPTIMA07-BIR.MEDLEYDISPLAYFONT index 5dce481b5..4debef3f6 100644 Binary files a/fonts/medleydisplayfonts/OPTIMA07-BIR.MEDLEYDISPLAYFONT and b/fonts/medleydisplayfonts/OPTIMA07-BIR.MEDLEYDISPLAYFONT differ diff --git a/fonts/medleydisplayfonts/OPTIMA07-BRR.MEDLEYDISPLAYFONT b/fonts/medleydisplayfonts/OPTIMA07-BRR.MEDLEYDISPLAYFONT index 2da9f7062..187c1cd5c 100644 Binary files a/fonts/medleydisplayfonts/OPTIMA07-BRR.MEDLEYDISPLAYFONT and b/fonts/medleydisplayfonts/OPTIMA07-BRR.MEDLEYDISPLAYFONT differ diff --git a/fonts/medleydisplayfonts/OPTIMA07-MIR.MEDLEYDISPLAYFONT b/fonts/medleydisplayfonts/OPTIMA07-MIR.MEDLEYDISPLAYFONT index cdb26c38f..83c5d7483 100644 Binary files a/fonts/medleydisplayfonts/OPTIMA07-MIR.MEDLEYDISPLAYFONT and b/fonts/medleydisplayfonts/OPTIMA07-MIR.MEDLEYDISPLAYFONT differ diff --git a/fonts/medleydisplayfonts/OPTIMA07-MRR.MEDLEYDISPLAYFONT b/fonts/medleydisplayfonts/OPTIMA07-MRR.MEDLEYDISPLAYFONT index 9e2be3b36..524135a8c 100644 Binary files a/fonts/medleydisplayfonts/OPTIMA07-MRR.MEDLEYDISPLAYFONT and b/fonts/medleydisplayfonts/OPTIMA07-MRR.MEDLEYDISPLAYFONT differ diff --git a/fonts/medleydisplayfonts/OPTIMA08-BIR.MEDLEYDISPLAYFONT b/fonts/medleydisplayfonts/OPTIMA08-BIR.MEDLEYDISPLAYFONT index f2595ad4f..9642a7db5 100644 Binary files a/fonts/medleydisplayfonts/OPTIMA08-BIR.MEDLEYDISPLAYFONT and b/fonts/medleydisplayfonts/OPTIMA08-BIR.MEDLEYDISPLAYFONT differ diff --git a/fonts/medleydisplayfonts/OPTIMA08-BRR.MEDLEYDISPLAYFONT b/fonts/medleydisplayfonts/OPTIMA08-BRR.MEDLEYDISPLAYFONT index ca7bbf79e..16e25c5b9 100644 Binary files a/fonts/medleydisplayfonts/OPTIMA08-BRR.MEDLEYDISPLAYFONT and b/fonts/medleydisplayfonts/OPTIMA08-BRR.MEDLEYDISPLAYFONT differ diff --git a/fonts/medleydisplayfonts/OPTIMA08-MIR.MEDLEYDISPLAYFONT b/fonts/medleydisplayfonts/OPTIMA08-MIR.MEDLEYDISPLAYFONT index 72649022a..ae06799ad 100644 Binary files a/fonts/medleydisplayfonts/OPTIMA08-MIR.MEDLEYDISPLAYFONT and b/fonts/medleydisplayfonts/OPTIMA08-MIR.MEDLEYDISPLAYFONT differ diff --git a/fonts/medleydisplayfonts/OPTIMA08-MRR.MEDLEYDISPLAYFONT b/fonts/medleydisplayfonts/OPTIMA08-MRR.MEDLEYDISPLAYFONT index 6ccaaa1bb..48d3931d0 100644 Binary files a/fonts/medleydisplayfonts/OPTIMA08-MRR.MEDLEYDISPLAYFONT and b/fonts/medleydisplayfonts/OPTIMA08-MRR.MEDLEYDISPLAYFONT differ diff --git a/fonts/medleydisplayfonts/OPTIMA09-BIR.MEDLEYDISPLAYFONT b/fonts/medleydisplayfonts/OPTIMA09-BIR.MEDLEYDISPLAYFONT index 879d8f98c..f3de6e8bb 100644 Binary files a/fonts/medleydisplayfonts/OPTIMA09-BIR.MEDLEYDISPLAYFONT and b/fonts/medleydisplayfonts/OPTIMA09-BIR.MEDLEYDISPLAYFONT differ diff --git a/fonts/medleydisplayfonts/OPTIMA09-BRR.MEDLEYDISPLAYFONT b/fonts/medleydisplayfonts/OPTIMA09-BRR.MEDLEYDISPLAYFONT index e40b3317e..02301193d 100644 Binary files a/fonts/medleydisplayfonts/OPTIMA09-BRR.MEDLEYDISPLAYFONT and b/fonts/medleydisplayfonts/OPTIMA09-BRR.MEDLEYDISPLAYFONT differ diff --git a/fonts/medleydisplayfonts/OPTIMA09-MIR.MEDLEYDISPLAYFONT b/fonts/medleydisplayfonts/OPTIMA09-MIR.MEDLEYDISPLAYFONT index 668b67edc..4e5e0659a 100644 Binary files a/fonts/medleydisplayfonts/OPTIMA09-MIR.MEDLEYDISPLAYFONT and b/fonts/medleydisplayfonts/OPTIMA09-MIR.MEDLEYDISPLAYFONT differ diff --git a/fonts/medleydisplayfonts/OPTIMA09-MRR.MEDLEYDISPLAYFONT b/fonts/medleydisplayfonts/OPTIMA09-MRR.MEDLEYDISPLAYFONT index 8a37a21e4..f498a53af 100644 Binary files a/fonts/medleydisplayfonts/OPTIMA09-MRR.MEDLEYDISPLAYFONT and b/fonts/medleydisplayfonts/OPTIMA09-MRR.MEDLEYDISPLAYFONT differ diff --git a/fonts/medleydisplayfonts/OPTIMA10-BIR.MEDLEYDISPLAYFONT b/fonts/medleydisplayfonts/OPTIMA10-BIR.MEDLEYDISPLAYFONT index 813319ef9..7d6db09e3 100644 Binary files a/fonts/medleydisplayfonts/OPTIMA10-BIR.MEDLEYDISPLAYFONT and b/fonts/medleydisplayfonts/OPTIMA10-BIR.MEDLEYDISPLAYFONT differ diff --git a/fonts/medleydisplayfonts/OPTIMA10-BRR.MEDLEYDISPLAYFONT b/fonts/medleydisplayfonts/OPTIMA10-BRR.MEDLEYDISPLAYFONT index 5344b4624..48206af1c 100644 Binary files a/fonts/medleydisplayfonts/OPTIMA10-BRR.MEDLEYDISPLAYFONT and b/fonts/medleydisplayfonts/OPTIMA10-BRR.MEDLEYDISPLAYFONT differ diff --git a/fonts/medleydisplayfonts/OPTIMA10-MIR.MEDLEYDISPLAYFONT b/fonts/medleydisplayfonts/OPTIMA10-MIR.MEDLEYDISPLAYFONT index 35cc99386..69a3b0cbe 100644 Binary files a/fonts/medleydisplayfonts/OPTIMA10-MIR.MEDLEYDISPLAYFONT and b/fonts/medleydisplayfonts/OPTIMA10-MIR.MEDLEYDISPLAYFONT differ diff --git a/fonts/medleydisplayfonts/OPTIMA10-MRR.MEDLEYDISPLAYFONT b/fonts/medleydisplayfonts/OPTIMA10-MRR.MEDLEYDISPLAYFONT index 7bd96de2e..bc88af66d 100644 Binary files a/fonts/medleydisplayfonts/OPTIMA10-MRR.MEDLEYDISPLAYFONT and b/fonts/medleydisplayfonts/OPTIMA10-MRR.MEDLEYDISPLAYFONT differ diff --git a/fonts/medleydisplayfonts/OPTIMA11-BIR.MEDLEYDISPLAYFONT b/fonts/medleydisplayfonts/OPTIMA11-BIR.MEDLEYDISPLAYFONT index 55557abac..be9eb6cbd 100644 Binary files a/fonts/medleydisplayfonts/OPTIMA11-BIR.MEDLEYDISPLAYFONT and b/fonts/medleydisplayfonts/OPTIMA11-BIR.MEDLEYDISPLAYFONT differ diff --git a/fonts/medleydisplayfonts/OPTIMA11-BRR.MEDLEYDISPLAYFONT b/fonts/medleydisplayfonts/OPTIMA11-BRR.MEDLEYDISPLAYFONT index 52e9d680d..92e34ab94 100644 Binary files a/fonts/medleydisplayfonts/OPTIMA11-BRR.MEDLEYDISPLAYFONT and b/fonts/medleydisplayfonts/OPTIMA11-BRR.MEDLEYDISPLAYFONT differ diff --git a/fonts/medleydisplayfonts/OPTIMA11-MIR.MEDLEYDISPLAYFONT b/fonts/medleydisplayfonts/OPTIMA11-MIR.MEDLEYDISPLAYFONT index c29eb4b25..60e85e576 100644 Binary files a/fonts/medleydisplayfonts/OPTIMA11-MIR.MEDLEYDISPLAYFONT and b/fonts/medleydisplayfonts/OPTIMA11-MIR.MEDLEYDISPLAYFONT differ diff --git a/fonts/medleydisplayfonts/OPTIMA11-MRR.MEDLEYDISPLAYFONT b/fonts/medleydisplayfonts/OPTIMA11-MRR.MEDLEYDISPLAYFONT index 2e38763bb..359bec459 100644 Binary files a/fonts/medleydisplayfonts/OPTIMA11-MRR.MEDLEYDISPLAYFONT and b/fonts/medleydisplayfonts/OPTIMA11-MRR.MEDLEYDISPLAYFONT differ diff --git a/fonts/medleydisplayfonts/OPTIMA12-BIR.MEDLEYDISPLAYFONT b/fonts/medleydisplayfonts/OPTIMA12-BIR.MEDLEYDISPLAYFONT index 6a821f07a..9e8220d61 100644 Binary files a/fonts/medleydisplayfonts/OPTIMA12-BIR.MEDLEYDISPLAYFONT and b/fonts/medleydisplayfonts/OPTIMA12-BIR.MEDLEYDISPLAYFONT differ diff --git a/fonts/medleydisplayfonts/OPTIMA12-BRR.MEDLEYDISPLAYFONT b/fonts/medleydisplayfonts/OPTIMA12-BRR.MEDLEYDISPLAYFONT index 057ef5a42..02a984547 100644 Binary files a/fonts/medleydisplayfonts/OPTIMA12-BRR.MEDLEYDISPLAYFONT and b/fonts/medleydisplayfonts/OPTIMA12-BRR.MEDLEYDISPLAYFONT differ diff --git a/fonts/medleydisplayfonts/OPTIMA12-MIR.MEDLEYDISPLAYFONT b/fonts/medleydisplayfonts/OPTIMA12-MIR.MEDLEYDISPLAYFONT index 0bf777893..4067aaed4 100644 Binary files a/fonts/medleydisplayfonts/OPTIMA12-MIR.MEDLEYDISPLAYFONT and b/fonts/medleydisplayfonts/OPTIMA12-MIR.MEDLEYDISPLAYFONT differ diff --git a/fonts/medleydisplayfonts/OPTIMA12-MRR.MEDLEYDISPLAYFONT b/fonts/medleydisplayfonts/OPTIMA12-MRR.MEDLEYDISPLAYFONT index 4333fee41..328941284 100644 Binary files a/fonts/medleydisplayfonts/OPTIMA12-MRR.MEDLEYDISPLAYFONT and b/fonts/medleydisplayfonts/OPTIMA12-MRR.MEDLEYDISPLAYFONT differ diff --git a/fonts/medleydisplayfonts/OPTIMA14-BIR.MEDLEYDISPLAYFONT b/fonts/medleydisplayfonts/OPTIMA14-BIR.MEDLEYDISPLAYFONT index 982cf4947..9c0ceb6c6 100644 Binary files a/fonts/medleydisplayfonts/OPTIMA14-BIR.MEDLEYDISPLAYFONT and b/fonts/medleydisplayfonts/OPTIMA14-BIR.MEDLEYDISPLAYFONT differ diff --git a/fonts/medleydisplayfonts/OPTIMA14-BRR.MEDLEYDISPLAYFONT b/fonts/medleydisplayfonts/OPTIMA14-BRR.MEDLEYDISPLAYFONT index b7dd890c3..d438f962a 100644 Binary files a/fonts/medleydisplayfonts/OPTIMA14-BRR.MEDLEYDISPLAYFONT and b/fonts/medleydisplayfonts/OPTIMA14-BRR.MEDLEYDISPLAYFONT differ diff --git a/fonts/medleydisplayfonts/OPTIMA14-MIR.MEDLEYDISPLAYFONT b/fonts/medleydisplayfonts/OPTIMA14-MIR.MEDLEYDISPLAYFONT index 83c96acfa..6bcb0d87a 100644 Binary files a/fonts/medleydisplayfonts/OPTIMA14-MIR.MEDLEYDISPLAYFONT and b/fonts/medleydisplayfonts/OPTIMA14-MIR.MEDLEYDISPLAYFONT differ diff --git a/fonts/medleydisplayfonts/OPTIMA14-MRR.MEDLEYDISPLAYFONT b/fonts/medleydisplayfonts/OPTIMA14-MRR.MEDLEYDISPLAYFONT index 75fc5dcda..db45bbf5d 100644 Binary files a/fonts/medleydisplayfonts/OPTIMA14-MRR.MEDLEYDISPLAYFONT and b/fonts/medleydisplayfonts/OPTIMA14-MRR.MEDLEYDISPLAYFONT differ diff --git a/fonts/medleydisplayfonts/OPTIMA18-BIR.MEDLEYDISPLAYFONT b/fonts/medleydisplayfonts/OPTIMA18-BIR.MEDLEYDISPLAYFONT index 738b40625..fbe522783 100644 Binary files a/fonts/medleydisplayfonts/OPTIMA18-BIR.MEDLEYDISPLAYFONT and b/fonts/medleydisplayfonts/OPTIMA18-BIR.MEDLEYDISPLAYFONT differ diff --git a/fonts/medleydisplayfonts/OPTIMA18-BRR.MEDLEYDISPLAYFONT b/fonts/medleydisplayfonts/OPTIMA18-BRR.MEDLEYDISPLAYFONT index a4c0a42a5..9efa309bd 100644 Binary files a/fonts/medleydisplayfonts/OPTIMA18-BRR.MEDLEYDISPLAYFONT and b/fonts/medleydisplayfonts/OPTIMA18-BRR.MEDLEYDISPLAYFONT differ diff --git a/fonts/medleydisplayfonts/OPTIMA18-MIR.MEDLEYDISPLAYFONT b/fonts/medleydisplayfonts/OPTIMA18-MIR.MEDLEYDISPLAYFONT index 44d840237..540ede917 100644 Binary files a/fonts/medleydisplayfonts/OPTIMA18-MIR.MEDLEYDISPLAYFONT and b/fonts/medleydisplayfonts/OPTIMA18-MIR.MEDLEYDISPLAYFONT differ diff --git a/fonts/medleydisplayfonts/OPTIMA18-MRR.MEDLEYDISPLAYFONT b/fonts/medleydisplayfonts/OPTIMA18-MRR.MEDLEYDISPLAYFONT index 68a8ddfea..3113d84a5 100644 Binary files a/fonts/medleydisplayfonts/OPTIMA18-MRR.MEDLEYDISPLAYFONT and b/fonts/medleydisplayfonts/OPTIMA18-MRR.MEDLEYDISPLAYFONT differ diff --git a/fonts/medleydisplayfonts/OPTIMA24-BIR.MEDLEYDISPLAYFONT b/fonts/medleydisplayfonts/OPTIMA24-BIR.MEDLEYDISPLAYFONT index 58bdacf36..1ffd4e71f 100644 Binary files a/fonts/medleydisplayfonts/OPTIMA24-BIR.MEDLEYDISPLAYFONT and b/fonts/medleydisplayfonts/OPTIMA24-BIR.MEDLEYDISPLAYFONT differ diff --git a/fonts/medleydisplayfonts/OPTIMA24-BRR.MEDLEYDISPLAYFONT b/fonts/medleydisplayfonts/OPTIMA24-BRR.MEDLEYDISPLAYFONT index 5e16f67a4..47a91ae5a 100644 Binary files a/fonts/medleydisplayfonts/OPTIMA24-BRR.MEDLEYDISPLAYFONT and b/fonts/medleydisplayfonts/OPTIMA24-BRR.MEDLEYDISPLAYFONT differ diff --git a/fonts/medleydisplayfonts/OPTIMA24-MIR.MEDLEYDISPLAYFONT b/fonts/medleydisplayfonts/OPTIMA24-MIR.MEDLEYDISPLAYFONT index 2c97f591d..b446d4622 100644 Binary files a/fonts/medleydisplayfonts/OPTIMA24-MIR.MEDLEYDISPLAYFONT and b/fonts/medleydisplayfonts/OPTIMA24-MIR.MEDLEYDISPLAYFONT differ diff --git a/fonts/medleydisplayfonts/OPTIMA24-MRR.MEDLEYDISPLAYFONT b/fonts/medleydisplayfonts/OPTIMA24-MRR.MEDLEYDISPLAYFONT index 08cf7bf55..42216f28f 100644 Binary files a/fonts/medleydisplayfonts/OPTIMA24-MRR.MEDLEYDISPLAYFONT and b/fonts/medleydisplayfonts/OPTIMA24-MRR.MEDLEYDISPLAYFONT differ diff --git a/fonts/medleydisplayfonts/PALATINO10-BIR.MEDLEYDISPLAYFONT b/fonts/medleydisplayfonts/PALATINO10-BIR.MEDLEYDISPLAYFONT index bcb48dfa3..5765c14c1 100644 Binary files a/fonts/medleydisplayfonts/PALATINO10-BIR.MEDLEYDISPLAYFONT and b/fonts/medleydisplayfonts/PALATINO10-BIR.MEDLEYDISPLAYFONT differ diff --git a/fonts/medleydisplayfonts/PALATINO10-BRR.MEDLEYDISPLAYFONT b/fonts/medleydisplayfonts/PALATINO10-BRR.MEDLEYDISPLAYFONT index bba53d34a..63005c6e8 100644 Binary files a/fonts/medleydisplayfonts/PALATINO10-BRR.MEDLEYDISPLAYFONT and b/fonts/medleydisplayfonts/PALATINO10-BRR.MEDLEYDISPLAYFONT differ diff --git a/fonts/medleydisplayfonts/PALATINO10-MIR.MEDLEYDISPLAYFONT b/fonts/medleydisplayfonts/PALATINO10-MIR.MEDLEYDISPLAYFONT index 565b4ca51..9b2c80158 100644 Binary files a/fonts/medleydisplayfonts/PALATINO10-MIR.MEDLEYDISPLAYFONT and b/fonts/medleydisplayfonts/PALATINO10-MIR.MEDLEYDISPLAYFONT differ diff --git a/fonts/medleydisplayfonts/PALATINO10-MRR.MEDLEYDISPLAYFONT b/fonts/medleydisplayfonts/PALATINO10-MRR.MEDLEYDISPLAYFONT index 112fda5b9..e97bf08c2 100644 Binary files a/fonts/medleydisplayfonts/PALATINO10-MRR.MEDLEYDISPLAYFONT and b/fonts/medleydisplayfonts/PALATINO10-MRR.MEDLEYDISPLAYFONT differ diff --git a/fonts/medleydisplayfonts/PALATINO12-BIR.MEDLEYDISPLAYFONT b/fonts/medleydisplayfonts/PALATINO12-BIR.MEDLEYDISPLAYFONT index 2791a46ec..c9cc18a78 100644 Binary files a/fonts/medleydisplayfonts/PALATINO12-BIR.MEDLEYDISPLAYFONT and b/fonts/medleydisplayfonts/PALATINO12-BIR.MEDLEYDISPLAYFONT differ diff --git a/fonts/medleydisplayfonts/PALATINO12-BRR.MEDLEYDISPLAYFONT b/fonts/medleydisplayfonts/PALATINO12-BRR.MEDLEYDISPLAYFONT index 4161e3cca..df0e81336 100644 Binary files a/fonts/medleydisplayfonts/PALATINO12-BRR.MEDLEYDISPLAYFONT and b/fonts/medleydisplayfonts/PALATINO12-BRR.MEDLEYDISPLAYFONT differ diff --git a/fonts/medleydisplayfonts/PALATINO12-MIR.MEDLEYDISPLAYFONT b/fonts/medleydisplayfonts/PALATINO12-MIR.MEDLEYDISPLAYFONT index 7882febd6..78f657801 100644 Binary files a/fonts/medleydisplayfonts/PALATINO12-MIR.MEDLEYDISPLAYFONT and b/fonts/medleydisplayfonts/PALATINO12-MIR.MEDLEYDISPLAYFONT differ diff --git a/fonts/medleydisplayfonts/PALATINO12-MRR.MEDLEYDISPLAYFONT b/fonts/medleydisplayfonts/PALATINO12-MRR.MEDLEYDISPLAYFONT index bdc564a5c..c49f6666c 100644 Binary files a/fonts/medleydisplayfonts/PALATINO12-MRR.MEDLEYDISPLAYFONT and b/fonts/medleydisplayfonts/PALATINO12-MRR.MEDLEYDISPLAYFONT differ diff --git a/fonts/medleydisplayfonts/PALATINO14-BIR.MEDLEYDISPLAYFONT b/fonts/medleydisplayfonts/PALATINO14-BIR.MEDLEYDISPLAYFONT index 140cd7f33..0e3a4476b 100644 Binary files a/fonts/medleydisplayfonts/PALATINO14-BIR.MEDLEYDISPLAYFONT and b/fonts/medleydisplayfonts/PALATINO14-BIR.MEDLEYDISPLAYFONT differ diff --git a/fonts/medleydisplayfonts/PALATINO14-BRR.MEDLEYDISPLAYFONT b/fonts/medleydisplayfonts/PALATINO14-BRR.MEDLEYDISPLAYFONT index 5b3c4b283..a6ba92f7b 100644 Binary files a/fonts/medleydisplayfonts/PALATINO14-BRR.MEDLEYDISPLAYFONT and b/fonts/medleydisplayfonts/PALATINO14-BRR.MEDLEYDISPLAYFONT differ diff --git a/fonts/medleydisplayfonts/PALATINO14-MIR.MEDLEYDISPLAYFONT b/fonts/medleydisplayfonts/PALATINO14-MIR.MEDLEYDISPLAYFONT index 9e92e11bc..79d844a71 100644 Binary files a/fonts/medleydisplayfonts/PALATINO14-MIR.MEDLEYDISPLAYFONT and b/fonts/medleydisplayfonts/PALATINO14-MIR.MEDLEYDISPLAYFONT differ diff --git a/fonts/medleydisplayfonts/PALATINO14-MRR.MEDLEYDISPLAYFONT b/fonts/medleydisplayfonts/PALATINO14-MRR.MEDLEYDISPLAYFONT index 54939d69b..b0ad0a368 100644 Binary files a/fonts/medleydisplayfonts/PALATINO14-MRR.MEDLEYDISPLAYFONT and b/fonts/medleydisplayfonts/PALATINO14-MRR.MEDLEYDISPLAYFONT differ diff --git a/fonts/medleydisplayfonts/PALATINO18-BIR.MEDLEYDISPLAYFONT b/fonts/medleydisplayfonts/PALATINO18-BIR.MEDLEYDISPLAYFONT index bd5bb2df9..eaa7c45d8 100644 Binary files a/fonts/medleydisplayfonts/PALATINO18-BIR.MEDLEYDISPLAYFONT and b/fonts/medleydisplayfonts/PALATINO18-BIR.MEDLEYDISPLAYFONT differ diff --git a/fonts/medleydisplayfonts/PALATINO18-BRR.MEDLEYDISPLAYFONT b/fonts/medleydisplayfonts/PALATINO18-BRR.MEDLEYDISPLAYFONT index 2a34f2dcb..adbc93787 100644 Binary files a/fonts/medleydisplayfonts/PALATINO18-BRR.MEDLEYDISPLAYFONT and b/fonts/medleydisplayfonts/PALATINO18-BRR.MEDLEYDISPLAYFONT differ diff --git a/fonts/medleydisplayfonts/PALATINO18-MIR.MEDLEYDISPLAYFONT b/fonts/medleydisplayfonts/PALATINO18-MIR.MEDLEYDISPLAYFONT index 80fa3524e..eeac5dcc7 100644 Binary files a/fonts/medleydisplayfonts/PALATINO18-MIR.MEDLEYDISPLAYFONT and b/fonts/medleydisplayfonts/PALATINO18-MIR.MEDLEYDISPLAYFONT differ diff --git a/fonts/medleydisplayfonts/PALATINO18-MRR.MEDLEYDISPLAYFONT b/fonts/medleydisplayfonts/PALATINO18-MRR.MEDLEYDISPLAYFONT index fc7ef9856..7c5d81559 100644 Binary files a/fonts/medleydisplayfonts/PALATINO18-MRR.MEDLEYDISPLAYFONT and b/fonts/medleydisplayfonts/PALATINO18-MRR.MEDLEYDISPLAYFONT differ diff --git a/fonts/medleydisplayfonts/PALATINO24-BIR.MEDLEYDISPLAYFONT b/fonts/medleydisplayfonts/PALATINO24-BIR.MEDLEYDISPLAYFONT index b32bc3874..8ebbbed5b 100644 Binary files a/fonts/medleydisplayfonts/PALATINO24-BIR.MEDLEYDISPLAYFONT and b/fonts/medleydisplayfonts/PALATINO24-BIR.MEDLEYDISPLAYFONT differ diff --git a/fonts/medleydisplayfonts/PALATINO24-BRR.MEDLEYDISPLAYFONT b/fonts/medleydisplayfonts/PALATINO24-BRR.MEDLEYDISPLAYFONT index b6a021883..004e3f0bd 100644 Binary files a/fonts/medleydisplayfonts/PALATINO24-BRR.MEDLEYDISPLAYFONT and b/fonts/medleydisplayfonts/PALATINO24-BRR.MEDLEYDISPLAYFONT differ diff --git a/fonts/medleydisplayfonts/PALATINO24-MIR.MEDLEYDISPLAYFONT b/fonts/medleydisplayfonts/PALATINO24-MIR.MEDLEYDISPLAYFONT index 5a5a47dc6..5adf64852 100644 Binary files a/fonts/medleydisplayfonts/PALATINO24-MIR.MEDLEYDISPLAYFONT and b/fonts/medleydisplayfonts/PALATINO24-MIR.MEDLEYDISPLAYFONT differ diff --git a/fonts/medleydisplayfonts/PALATINO24-MRR.MEDLEYDISPLAYFONT b/fonts/medleydisplayfonts/PALATINO24-MRR.MEDLEYDISPLAYFONT index 80811492a..262ee029d 100644 Binary files a/fonts/medleydisplayfonts/PALATINO24-MRR.MEDLEYDISPLAYFONT and b/fonts/medleydisplayfonts/PALATINO24-MRR.MEDLEYDISPLAYFONT differ diff --git a/fonts/medleydisplayfonts/PCTERMINAL12-BRR.MEDLEYDISPLAYFONT b/fonts/medleydisplayfonts/PCTERMINAL12-BRR.MEDLEYDISPLAYFONT index 4e2a59e8a..34f4b64db 100644 Binary files a/fonts/medleydisplayfonts/PCTERMINAL12-BRR.MEDLEYDISPLAYFONT and b/fonts/medleydisplayfonts/PCTERMINAL12-BRR.MEDLEYDISPLAYFONT differ diff --git a/fonts/medleydisplayfonts/PCTERMINAL12-MRR.MEDLEYDISPLAYFONT b/fonts/medleydisplayfonts/PCTERMINAL12-MRR.MEDLEYDISPLAYFONT index d8949ed2f..665b18b13 100644 Binary files a/fonts/medleydisplayfonts/PCTERMINAL12-MRR.MEDLEYDISPLAYFONT and b/fonts/medleydisplayfonts/PCTERMINAL12-MRR.MEDLEYDISPLAYFONT differ diff --git a/fonts/medleydisplayfonts/PCTERMINAL14-BRR.MEDLEYDISPLAYFONT b/fonts/medleydisplayfonts/PCTERMINAL14-BRR.MEDLEYDISPLAYFONT index e7b786cb5..49e386226 100644 Binary files a/fonts/medleydisplayfonts/PCTERMINAL14-BRR.MEDLEYDISPLAYFONT and b/fonts/medleydisplayfonts/PCTERMINAL14-BRR.MEDLEYDISPLAYFONT differ diff --git a/fonts/medleydisplayfonts/PCTERMINAL14-MRR.MEDLEYDISPLAYFONT b/fonts/medleydisplayfonts/PCTERMINAL14-MRR.MEDLEYDISPLAYFONT index e252c0a79..a48d162a2 100644 Binary files a/fonts/medleydisplayfonts/PCTERMINAL14-MRR.MEDLEYDISPLAYFONT and b/fonts/medleydisplayfonts/PCTERMINAL14-MRR.MEDLEYDISPLAYFONT differ diff --git a/fonts/medleydisplayfonts/PHONETICTR12-MRR.MEDLEYDISPLAYFONT b/fonts/medleydisplayfonts/PHONETICTR12-MRR.MEDLEYDISPLAYFONT index e3c75b95b..97c0f8ff0 100644 Binary files a/fonts/medleydisplayfonts/PHONETICTR12-MRR.MEDLEYDISPLAYFONT and b/fonts/medleydisplayfonts/PHONETICTR12-MRR.MEDLEYDISPLAYFONT differ diff --git a/fonts/medleydisplayfonts/ROMANPS10-MRR.MEDLEYDISPLAYFONT b/fonts/medleydisplayfonts/ROMANPS10-MRR.MEDLEYDISPLAYFONT index 9f3a1c338..7a27b845f 100644 Binary files a/fonts/medleydisplayfonts/ROMANPS10-MRR.MEDLEYDISPLAYFONT and b/fonts/medleydisplayfonts/ROMANPS10-MRR.MEDLEYDISPLAYFONT differ diff --git a/fonts/medleydisplayfonts/ROMANPS12-MRR.MEDLEYDISPLAYFONT b/fonts/medleydisplayfonts/ROMANPS12-MRR.MEDLEYDISPLAYFONT index f65434d88..615b2138d 100644 Binary files a/fonts/medleydisplayfonts/ROMANPS12-MRR.MEDLEYDISPLAYFONT and b/fonts/medleydisplayfonts/ROMANPS12-MRR.MEDLEYDISPLAYFONT differ diff --git a/fonts/medleydisplayfonts/SAIL10-BRR.MEDLEYDISPLAYFONT b/fonts/medleydisplayfonts/SAIL10-BRR.MEDLEYDISPLAYFONT index 7fc4a6505..d4751fde8 100644 Binary files a/fonts/medleydisplayfonts/SAIL10-BRR.MEDLEYDISPLAYFONT and b/fonts/medleydisplayfonts/SAIL10-BRR.MEDLEYDISPLAYFONT differ diff --git a/fonts/medleydisplayfonts/SAIL10-MRR.MEDLEYDISPLAYFONT b/fonts/medleydisplayfonts/SAIL10-MRR.MEDLEYDISPLAYFONT index 965f0fbb9..f90d66795 100644 Binary files a/fonts/medleydisplayfonts/SAIL10-MRR.MEDLEYDISPLAYFONT and b/fonts/medleydisplayfonts/SAIL10-MRR.MEDLEYDISPLAYFONT differ diff --git a/fonts/medleydisplayfonts/SAIL12-MRR.MEDLEYDISPLAYFONT b/fonts/medleydisplayfonts/SAIL12-MRR.MEDLEYDISPLAYFONT index b8cf422ea..b71e7cb5b 100644 Binary files a/fonts/medleydisplayfonts/SAIL12-MRR.MEDLEYDISPLAYFONT and b/fonts/medleydisplayfonts/SAIL12-MRR.MEDLEYDISPLAYFONT differ diff --git a/fonts/medleydisplayfonts/SIGMA20-MRR.MEDLEYDISPLAYFONT b/fonts/medleydisplayfonts/SIGMA20-MRR.MEDLEYDISPLAYFONT index 37e610388..24b45edc8 100644 Binary files a/fonts/medleydisplayfonts/SIGMA20-MRR.MEDLEYDISPLAYFONT and b/fonts/medleydisplayfonts/SIGMA20-MRR.MEDLEYDISPLAYFONT differ diff --git a/fonts/medleydisplayfonts/SMALLTALK10-MRR.MEDLEYDISPLAYFONT b/fonts/medleydisplayfonts/SMALLTALK10-MRR.MEDLEYDISPLAYFONT index 81116f3a8..89e397c1a 100644 Binary files a/fonts/medleydisplayfonts/SMALLTALK10-MRR.MEDLEYDISPLAYFONT and b/fonts/medleydisplayfonts/SMALLTALK10-MRR.MEDLEYDISPLAYFONT differ diff --git a/fonts/medleydisplayfonts/SNAIL10-BRR.MEDLEYDISPLAYFONT b/fonts/medleydisplayfonts/SNAIL10-BRR.MEDLEYDISPLAYFONT index 139ab7c0e..9d1aae3ee 100644 Binary files a/fonts/medleydisplayfonts/SNAIL10-BRR.MEDLEYDISPLAYFONT and b/fonts/medleydisplayfonts/SNAIL10-BRR.MEDLEYDISPLAYFONT differ diff --git a/fonts/medleydisplayfonts/SNAIL10-MRR.MEDLEYDISPLAYFONT b/fonts/medleydisplayfonts/SNAIL10-MRR.MEDLEYDISPLAYFONT index 94621017a..c81127cb2 100644 Binary files a/fonts/medleydisplayfonts/SNAIL10-MRR.MEDLEYDISPLAYFONT and b/fonts/medleydisplayfonts/SNAIL10-MRR.MEDLEYDISPLAYFONT differ diff --git a/fonts/medleydisplayfonts/SNAIL12-MRR.MEDLEYDISPLAYFONT b/fonts/medleydisplayfonts/SNAIL12-MRR.MEDLEYDISPLAYFONT index 76b369172..57c464cfa 100644 Binary files a/fonts/medleydisplayfonts/SNAIL12-MRR.MEDLEYDISPLAYFONT and b/fonts/medleydisplayfonts/SNAIL12-MRR.MEDLEYDISPLAYFONT differ diff --git a/fonts/medleydisplayfonts/SYMBOL10-MRR.MEDLEYDISPLAYFONT b/fonts/medleydisplayfonts/SYMBOL10-MRR.MEDLEYDISPLAYFONT index 3bb4f000c..ae27b12fa 100644 Binary files a/fonts/medleydisplayfonts/SYMBOL10-MRR.MEDLEYDISPLAYFONT and b/fonts/medleydisplayfonts/SYMBOL10-MRR.MEDLEYDISPLAYFONT differ diff --git a/fonts/medleydisplayfonts/TEMPLATE10-MRR.MEDLEYDISPLAYFONT b/fonts/medleydisplayfonts/TEMPLATE10-MRR.MEDLEYDISPLAYFONT index 5fb575fba..fd12e9881 100644 Binary files a/fonts/medleydisplayfonts/TEMPLATE10-MRR.MEDLEYDISPLAYFONT and b/fonts/medleydisplayfonts/TEMPLATE10-MRR.MEDLEYDISPLAYFONT differ diff --git a/fonts/medleydisplayfonts/TEMPLATE64-MRR.MEDLEYDISPLAYFONT b/fonts/medleydisplayfonts/TEMPLATE64-MRR.MEDLEYDISPLAYFONT index f69385b54..e6c433b1e 100644 Binary files a/fonts/medleydisplayfonts/TEMPLATE64-MRR.MEDLEYDISPLAYFONT and b/fonts/medleydisplayfonts/TEMPLATE64-MRR.MEDLEYDISPLAYFONT differ diff --git a/fonts/medleydisplayfonts/TERMINAL06-BRR.MEDLEYDISPLAYFONT b/fonts/medleydisplayfonts/TERMINAL06-BRR.MEDLEYDISPLAYFONT index 361fd9be9..32f3b861c 100644 Binary files a/fonts/medleydisplayfonts/TERMINAL06-BRR.MEDLEYDISPLAYFONT and b/fonts/medleydisplayfonts/TERMINAL06-BRR.MEDLEYDISPLAYFONT differ diff --git a/fonts/medleydisplayfonts/TERMINAL06-MRR.MEDLEYDISPLAYFONT b/fonts/medleydisplayfonts/TERMINAL06-MRR.MEDLEYDISPLAYFONT index 158a95898..41d627ef6 100644 Binary files a/fonts/medleydisplayfonts/TERMINAL06-MRR.MEDLEYDISPLAYFONT and b/fonts/medleydisplayfonts/TERMINAL06-MRR.MEDLEYDISPLAYFONT differ diff --git a/fonts/medleydisplayfonts/TERMINAL08-BRR.MEDLEYDISPLAYFONT b/fonts/medleydisplayfonts/TERMINAL08-BRR.MEDLEYDISPLAYFONT index 0eb8291ea..f6c771fec 100644 Binary files a/fonts/medleydisplayfonts/TERMINAL08-BRR.MEDLEYDISPLAYFONT and b/fonts/medleydisplayfonts/TERMINAL08-BRR.MEDLEYDISPLAYFONT differ diff --git a/fonts/medleydisplayfonts/TERMINAL08-MRR.MEDLEYDISPLAYFONT b/fonts/medleydisplayfonts/TERMINAL08-MRR.MEDLEYDISPLAYFONT index da1593970..5b7b9df41 100644 Binary files a/fonts/medleydisplayfonts/TERMINAL08-MRR.MEDLEYDISPLAYFONT and b/fonts/medleydisplayfonts/TERMINAL08-MRR.MEDLEYDISPLAYFONT differ diff --git a/fonts/medleydisplayfonts/TERMINAL10-BRR.MEDLEYDISPLAYFONT b/fonts/medleydisplayfonts/TERMINAL10-BRR.MEDLEYDISPLAYFONT index 804d9253f..8f12eabe4 100644 Binary files a/fonts/medleydisplayfonts/TERMINAL10-BRR.MEDLEYDISPLAYFONT and b/fonts/medleydisplayfonts/TERMINAL10-BRR.MEDLEYDISPLAYFONT differ diff --git a/fonts/medleydisplayfonts/TERMINAL10-MRR.MEDLEYDISPLAYFONT b/fonts/medleydisplayfonts/TERMINAL10-MRR.MEDLEYDISPLAYFONT index 44ce64f44..591165e2d 100644 Binary files a/fonts/medleydisplayfonts/TERMINAL10-MRR.MEDLEYDISPLAYFONT and b/fonts/medleydisplayfonts/TERMINAL10-MRR.MEDLEYDISPLAYFONT differ diff --git a/fonts/medleydisplayfonts/TERMINAL12-BRR.MEDLEYDISPLAYFONT b/fonts/medleydisplayfonts/TERMINAL12-BRR.MEDLEYDISPLAYFONT index a8838eb56..1045cacf3 100644 Binary files a/fonts/medleydisplayfonts/TERMINAL12-BRR.MEDLEYDISPLAYFONT and b/fonts/medleydisplayfonts/TERMINAL12-BRR.MEDLEYDISPLAYFONT differ diff --git a/fonts/medleydisplayfonts/TERMINAL12-MRR.MEDLEYDISPLAYFONT b/fonts/medleydisplayfonts/TERMINAL12-MRR.MEDLEYDISPLAYFONT index 1433f6d4c..e2707bd24 100644 Binary files a/fonts/medleydisplayfonts/TERMINAL12-MRR.MEDLEYDISPLAYFONT and b/fonts/medleydisplayfonts/TERMINAL12-MRR.MEDLEYDISPLAYFONT differ diff --git a/fonts/medleydisplayfonts/TESTFONT12-MRR.MEDLEYDISPLAYFONT b/fonts/medleydisplayfonts/TESTFONT12-MRR.MEDLEYDISPLAYFONT index 906f6164b..1f22e1c0c 100644 Binary files a/fonts/medleydisplayfonts/TESTFONT12-MRR.MEDLEYDISPLAYFONT and b/fonts/medleydisplayfonts/TESTFONT12-MRR.MEDLEYDISPLAYFONT differ diff --git a/fonts/medleydisplayfonts/TIMESROMAN06-MRR.MEDLEYDISPLAYFONT b/fonts/medleydisplayfonts/TIMESROMAN06-MRR.MEDLEYDISPLAYFONT index c0f9260e1..49bcae8c9 100644 Binary files a/fonts/medleydisplayfonts/TIMESROMAN06-MRR.MEDLEYDISPLAYFONT and b/fonts/medleydisplayfonts/TIMESROMAN06-MRR.MEDLEYDISPLAYFONT differ diff --git a/fonts/medleydisplayfonts/TIMESROMAN08-BRR.MEDLEYDISPLAYFONT b/fonts/medleydisplayfonts/TIMESROMAN08-BRR.MEDLEYDISPLAYFONT index 56621117b..2d63bf20e 100644 Binary files a/fonts/medleydisplayfonts/TIMESROMAN08-BRR.MEDLEYDISPLAYFONT and b/fonts/medleydisplayfonts/TIMESROMAN08-BRR.MEDLEYDISPLAYFONT differ diff --git a/fonts/medleydisplayfonts/TIMESROMAN08-MIR.MEDLEYDISPLAYFONT b/fonts/medleydisplayfonts/TIMESROMAN08-MIR.MEDLEYDISPLAYFONT index 984f1eb14..cf578e341 100644 Binary files a/fonts/medleydisplayfonts/TIMESROMAN08-MIR.MEDLEYDISPLAYFONT and b/fonts/medleydisplayfonts/TIMESROMAN08-MIR.MEDLEYDISPLAYFONT differ diff --git a/fonts/medleydisplayfonts/TIMESROMAN08-MRC.MEDLEYDISPLAYFONT b/fonts/medleydisplayfonts/TIMESROMAN08-MRC.MEDLEYDISPLAYFONT index c50de7301..a07b6f2c5 100644 Binary files a/fonts/medleydisplayfonts/TIMESROMAN08-MRC.MEDLEYDISPLAYFONT and b/fonts/medleydisplayfonts/TIMESROMAN08-MRC.MEDLEYDISPLAYFONT differ diff --git a/fonts/medleydisplayfonts/TIMESROMAN08-MRR.MEDLEYDISPLAYFONT b/fonts/medleydisplayfonts/TIMESROMAN08-MRR.MEDLEYDISPLAYFONT index 841213b40..31edaacc5 100644 Binary files a/fonts/medleydisplayfonts/TIMESROMAN08-MRR.MEDLEYDISPLAYFONT and b/fonts/medleydisplayfonts/TIMESROMAN08-MRR.MEDLEYDISPLAYFONT differ diff --git a/fonts/medleydisplayfonts/TIMESROMAN09-MRC.MEDLEYDISPLAYFONT b/fonts/medleydisplayfonts/TIMESROMAN09-MRC.MEDLEYDISPLAYFONT index eb0d3a4c7..539ea1eea 100644 Binary files a/fonts/medleydisplayfonts/TIMESROMAN09-MRC.MEDLEYDISPLAYFONT and b/fonts/medleydisplayfonts/TIMESROMAN09-MRC.MEDLEYDISPLAYFONT differ diff --git a/fonts/medleydisplayfonts/TIMESROMAN09-MRR.MEDLEYDISPLAYFONT b/fonts/medleydisplayfonts/TIMESROMAN09-MRR.MEDLEYDISPLAYFONT index c2f6e2042..992ac377a 100644 Binary files a/fonts/medleydisplayfonts/TIMESROMAN09-MRR.MEDLEYDISPLAYFONT and b/fonts/medleydisplayfonts/TIMESROMAN09-MRR.MEDLEYDISPLAYFONT differ diff --git a/fonts/medleydisplayfonts/TIMESROMAN10-BRR.MEDLEYDISPLAYFONT b/fonts/medleydisplayfonts/TIMESROMAN10-BRR.MEDLEYDISPLAYFONT index 286dd6635..ad6e34907 100644 Binary files a/fonts/medleydisplayfonts/TIMESROMAN10-BRR.MEDLEYDISPLAYFONT and b/fonts/medleydisplayfonts/TIMESROMAN10-BRR.MEDLEYDISPLAYFONT differ diff --git a/fonts/medleydisplayfonts/TIMESROMAN10-MIR.MEDLEYDISPLAYFONT b/fonts/medleydisplayfonts/TIMESROMAN10-MIR.MEDLEYDISPLAYFONT index fe30c7038..947a43a59 100644 Binary files a/fonts/medleydisplayfonts/TIMESROMAN10-MIR.MEDLEYDISPLAYFONT and b/fonts/medleydisplayfonts/TIMESROMAN10-MIR.MEDLEYDISPLAYFONT differ diff --git a/fonts/medleydisplayfonts/TIMESROMAN10-MRC.MEDLEYDISPLAYFONT b/fonts/medleydisplayfonts/TIMESROMAN10-MRC.MEDLEYDISPLAYFONT index db5f35a01..b35c312b9 100644 Binary files a/fonts/medleydisplayfonts/TIMESROMAN10-MRC.MEDLEYDISPLAYFONT and b/fonts/medleydisplayfonts/TIMESROMAN10-MRC.MEDLEYDISPLAYFONT differ diff --git a/fonts/medleydisplayfonts/TIMESROMAN10-MRR.MEDLEYDISPLAYFONT b/fonts/medleydisplayfonts/TIMESROMAN10-MRR.MEDLEYDISPLAYFONT index 2dec349b6..adbe84da1 100644 Binary files a/fonts/medleydisplayfonts/TIMESROMAN10-MRR.MEDLEYDISPLAYFONT and b/fonts/medleydisplayfonts/TIMESROMAN10-MRR.MEDLEYDISPLAYFONT differ diff --git a/fonts/medleydisplayfonts/TIMESROMAN11-MRR.MEDLEYDISPLAYFONT b/fonts/medleydisplayfonts/TIMESROMAN11-MRR.MEDLEYDISPLAYFONT index 373882868..bfef0b9f0 100644 Binary files a/fonts/medleydisplayfonts/TIMESROMAN11-MRR.MEDLEYDISPLAYFONT and b/fonts/medleydisplayfonts/TIMESROMAN11-MRR.MEDLEYDISPLAYFONT differ diff --git a/fonts/medleydisplayfonts/TIMESROMAN12-BRR.MEDLEYDISPLAYFONT b/fonts/medleydisplayfonts/TIMESROMAN12-BRR.MEDLEYDISPLAYFONT index 108249f2d..fb9a0863e 100644 Binary files a/fonts/medleydisplayfonts/TIMESROMAN12-BRR.MEDLEYDISPLAYFONT and b/fonts/medleydisplayfonts/TIMESROMAN12-BRR.MEDLEYDISPLAYFONT differ diff --git a/fonts/medleydisplayfonts/TIMESROMAN12-MIR.MEDLEYDISPLAYFONT b/fonts/medleydisplayfonts/TIMESROMAN12-MIR.MEDLEYDISPLAYFONT index fa0d85dfd..92e483915 100644 Binary files a/fonts/medleydisplayfonts/TIMESROMAN12-MIR.MEDLEYDISPLAYFONT and b/fonts/medleydisplayfonts/TIMESROMAN12-MIR.MEDLEYDISPLAYFONT differ diff --git a/fonts/medleydisplayfonts/TIMESROMAN12-MRC.MEDLEYDISPLAYFONT b/fonts/medleydisplayfonts/TIMESROMAN12-MRC.MEDLEYDISPLAYFONT index d344204ef..fed45f32d 100644 Binary files a/fonts/medleydisplayfonts/TIMESROMAN12-MRC.MEDLEYDISPLAYFONT and b/fonts/medleydisplayfonts/TIMESROMAN12-MRC.MEDLEYDISPLAYFONT differ diff --git a/fonts/medleydisplayfonts/TIMESROMAN12-MRR.MEDLEYDISPLAYFONT b/fonts/medleydisplayfonts/TIMESROMAN12-MRR.MEDLEYDISPLAYFONT index f3b676602..cfaf98fee 100644 Binary files a/fonts/medleydisplayfonts/TIMESROMAN12-MRR.MEDLEYDISPLAYFONT and b/fonts/medleydisplayfonts/TIMESROMAN12-MRR.MEDLEYDISPLAYFONT differ diff --git a/fonts/medleydisplayfonts/TIMESROMAN13-MRR.MEDLEYDISPLAYFONT b/fonts/medleydisplayfonts/TIMESROMAN13-MRR.MEDLEYDISPLAYFONT index 04dc1c2fd..9588aa434 100644 Binary files a/fonts/medleydisplayfonts/TIMESROMAN13-MRR.MEDLEYDISPLAYFONT and b/fonts/medleydisplayfonts/TIMESROMAN13-MRR.MEDLEYDISPLAYFONT differ diff --git a/fonts/medleydisplayfonts/TIMESROMAN14-MRC.MEDLEYDISPLAYFONT b/fonts/medleydisplayfonts/TIMESROMAN14-MRC.MEDLEYDISPLAYFONT index e90385806..72a099636 100644 Binary files a/fonts/medleydisplayfonts/TIMESROMAN14-MRC.MEDLEYDISPLAYFONT and b/fonts/medleydisplayfonts/TIMESROMAN14-MRC.MEDLEYDISPLAYFONT differ diff --git a/fonts/medleydisplayfonts/TIMESROMAN14-MRR.MEDLEYDISPLAYFONT b/fonts/medleydisplayfonts/TIMESROMAN14-MRR.MEDLEYDISPLAYFONT index 57afd0a72..5c0127b82 100644 Binary files a/fonts/medleydisplayfonts/TIMESROMAN14-MRR.MEDLEYDISPLAYFONT and b/fonts/medleydisplayfonts/TIMESROMAN14-MRR.MEDLEYDISPLAYFONT differ diff --git a/fonts/medleydisplayfonts/TIMESROMAN16-MRR.MEDLEYDISPLAYFONT b/fonts/medleydisplayfonts/TIMESROMAN16-MRR.MEDLEYDISPLAYFONT index 63fc17aeb..61e61d16d 100644 Binary files a/fonts/medleydisplayfonts/TIMESROMAN16-MRR.MEDLEYDISPLAYFONT and b/fonts/medleydisplayfonts/TIMESROMAN16-MRR.MEDLEYDISPLAYFONT differ diff --git a/fonts/medleydisplayfonts/TIMESROMAN18-MRC.MEDLEYDISPLAYFONT b/fonts/medleydisplayfonts/TIMESROMAN18-MRC.MEDLEYDISPLAYFONT index 4f227a002..cdf6e8403 100644 Binary files a/fonts/medleydisplayfonts/TIMESROMAN18-MRC.MEDLEYDISPLAYFONT and b/fonts/medleydisplayfonts/TIMESROMAN18-MRC.MEDLEYDISPLAYFONT differ diff --git a/fonts/medleydisplayfonts/TIMESROMAN18-MRR.MEDLEYDISPLAYFONT b/fonts/medleydisplayfonts/TIMESROMAN18-MRR.MEDLEYDISPLAYFONT index 1b69a883f..824c5d980 100644 Binary files a/fonts/medleydisplayfonts/TIMESROMAN18-MRR.MEDLEYDISPLAYFONT and b/fonts/medleydisplayfonts/TIMESROMAN18-MRR.MEDLEYDISPLAYFONT differ diff --git a/fonts/medleydisplayfonts/TIMESROMAN36-MRR.MEDLEYDISPLAYFONT b/fonts/medleydisplayfonts/TIMESROMAN36-MRR.MEDLEYDISPLAYFONT index f3f398bf2..f638517c3 100644 Binary files a/fonts/medleydisplayfonts/TIMESROMAN36-MRR.MEDLEYDISPLAYFONT and b/fonts/medleydisplayfonts/TIMESROMAN36-MRR.MEDLEYDISPLAYFONT differ diff --git a/fonts/medleydisplayfonts/TIMESROMAND24-MRR.MEDLEYDISPLAYFONT b/fonts/medleydisplayfonts/TIMESROMAND24-MRR.MEDLEYDISPLAYFONT index cce654309..010bd05fc 100644 Binary files a/fonts/medleydisplayfonts/TIMESROMAND24-MRR.MEDLEYDISPLAYFONT and b/fonts/medleydisplayfonts/TIMESROMAND24-MRR.MEDLEYDISPLAYFONT differ diff --git a/fonts/medleydisplayfonts/TIMESROMAND30-MRR.MEDLEYDISPLAYFONT b/fonts/medleydisplayfonts/TIMESROMAND30-MRR.MEDLEYDISPLAYFONT index 9e1ac57c6..f6a4836e1 100644 Binary files a/fonts/medleydisplayfonts/TIMESROMAND30-MRR.MEDLEYDISPLAYFONT and b/fonts/medleydisplayfonts/TIMESROMAND30-MRR.MEDLEYDISPLAYFONT differ diff --git a/fonts/medleydisplayfonts/TIMESROMAND36-MRR.MEDLEYDISPLAYFONT b/fonts/medleydisplayfonts/TIMESROMAND36-MRR.MEDLEYDISPLAYFONT index 4753c5071..6b25f35c5 100644 Binary files a/fonts/medleydisplayfonts/TIMESROMAND36-MRR.MEDLEYDISPLAYFONT and b/fonts/medleydisplayfonts/TIMESROMAND36-MRR.MEDLEYDISPLAYFONT differ diff --git a/fonts/medleydisplayfonts/TIMESROMAND72-MRR.MEDLEYDISPLAYFONT b/fonts/medleydisplayfonts/TIMESROMAND72-MRR.MEDLEYDISPLAYFONT index 1a3abf24e..c3f990484 100644 Binary files a/fonts/medleydisplayfonts/TIMESROMAND72-MRR.MEDLEYDISPLAYFONT and b/fonts/medleydisplayfonts/TIMESROMAND72-MRR.MEDLEYDISPLAYFONT differ diff --git a/fonts/medleydisplayfonts/TITAN10-BIR.MEDLEYDISPLAYFONT b/fonts/medleydisplayfonts/TITAN10-BIR.MEDLEYDISPLAYFONT index 5682c241b..bec58a72d 100644 Binary files a/fonts/medleydisplayfonts/TITAN10-BIR.MEDLEYDISPLAYFONT and b/fonts/medleydisplayfonts/TITAN10-BIR.MEDLEYDISPLAYFONT differ diff --git a/fonts/medleydisplayfonts/TITAN10-BRR.MEDLEYDISPLAYFONT b/fonts/medleydisplayfonts/TITAN10-BRR.MEDLEYDISPLAYFONT index 396235c10..134715650 100644 Binary files a/fonts/medleydisplayfonts/TITAN10-BRR.MEDLEYDISPLAYFONT and b/fonts/medleydisplayfonts/TITAN10-BRR.MEDLEYDISPLAYFONT differ diff --git a/fonts/medleydisplayfonts/TITAN10-MIR.MEDLEYDISPLAYFONT b/fonts/medleydisplayfonts/TITAN10-MIR.MEDLEYDISPLAYFONT index 2609a0210..9acbbc2b0 100644 Binary files a/fonts/medleydisplayfonts/TITAN10-MIR.MEDLEYDISPLAYFONT and b/fonts/medleydisplayfonts/TITAN10-MIR.MEDLEYDISPLAYFONT differ diff --git a/fonts/medleydisplayfonts/TITAN10-MRR.MEDLEYDISPLAYFONT b/fonts/medleydisplayfonts/TITAN10-MRR.MEDLEYDISPLAYFONT index 8f83544c5..b2365c9e9 100644 Binary files a/fonts/medleydisplayfonts/TITAN10-MRR.MEDLEYDISPLAYFONT and b/fonts/medleydisplayfonts/TITAN10-MRR.MEDLEYDISPLAYFONT differ diff --git a/fonts/medleydisplayfonts/TITAN12-BRR.MEDLEYDISPLAYFONT b/fonts/medleydisplayfonts/TITAN12-BRR.MEDLEYDISPLAYFONT index 398648709..6a9850743 100644 Binary files a/fonts/medleydisplayfonts/TITAN12-BRR.MEDLEYDISPLAYFONT and b/fonts/medleydisplayfonts/TITAN12-BRR.MEDLEYDISPLAYFONT differ diff --git a/fonts/medleydisplayfonts/TITAN12-MRR.MEDLEYDISPLAYFONT b/fonts/medleydisplayfonts/TITAN12-MRR.MEDLEYDISPLAYFONT index cf3ab299c..f17a02640 100644 Binary files a/fonts/medleydisplayfonts/TITAN12-MRR.MEDLEYDISPLAYFONT and b/fonts/medleydisplayfonts/TITAN12-MRR.MEDLEYDISPLAYFONT differ diff --git a/fonts/medleydisplayfonts/TITAN14-MRR.MEDLEYDISPLAYFONT b/fonts/medleydisplayfonts/TITAN14-MRR.MEDLEYDISPLAYFONT index 083436687..9fc3968f5 100644 Binary files a/fonts/medleydisplayfonts/TITAN14-MRR.MEDLEYDISPLAYFONT and b/fonts/medleydisplayfonts/TITAN14-MRR.MEDLEYDISPLAYFONT differ diff --git a/fonts/medleydisplayfonts/TITANLEGAL12-MRR.MEDLEYDISPLAYFONT b/fonts/medleydisplayfonts/TITANLEGAL12-MRR.MEDLEYDISPLAYFONT index 631932c1f..63bfb81cf 100644 Binary files a/fonts/medleydisplayfonts/TITANLEGAL12-MRR.MEDLEYDISPLAYFONT and b/fonts/medleydisplayfonts/TITANLEGAL12-MRR.MEDLEYDISPLAYFONT differ diff --git a/fonts/medleydisplayfonts/TITANLEGAL14-MRR.MEDLEYDISPLAYFONT b/fonts/medleydisplayfonts/TITANLEGAL14-MRR.MEDLEYDISPLAYFONT index 7fb98080c..a3d7073ed 100644 Binary files a/fonts/medleydisplayfonts/TITANLEGAL14-MRR.MEDLEYDISPLAYFONT and b/fonts/medleydisplayfonts/TITANLEGAL14-MRR.MEDLEYDISPLAYFONT differ diff --git a/fonts/medleydisplayfonts/TONTO14-MRR.MEDLEYDISPLAYFONT b/fonts/medleydisplayfonts/TONTO14-MRR.MEDLEYDISPLAYFONT index 8455c3946..f211680be 100644 Binary files a/fonts/medleydisplayfonts/TONTO14-MRR.MEDLEYDISPLAYFONT and b/fonts/medleydisplayfonts/TONTO14-MRR.MEDLEYDISPLAYFONT differ diff --git a/fonts/medleydisplayfonts/VISIBLE10-MRR.MEDLEYDISPLAYFONT b/fonts/medleydisplayfonts/VISIBLE10-MRR.MEDLEYDISPLAYFONT index c5227622d..adc95620b 100644 Binary files a/fonts/medleydisplayfonts/VISIBLE10-MRR.MEDLEYDISPLAYFONT and b/fonts/medleydisplayfonts/VISIBLE10-MRR.MEDLEYDISPLAYFONT differ diff --git a/fonts/medleydisplayfonts/XEROXBOOK12-MRR.MEDLEYDISPLAYFONT b/fonts/medleydisplayfonts/XEROXBOOK12-MRR.MEDLEYDISPLAYFONT index cf847707d..dbe2e7a75 100644 Binary files a/fonts/medleydisplayfonts/XEROXBOOK12-MRR.MEDLEYDISPLAYFONT and b/fonts/medleydisplayfonts/XEROXBOOK12-MRR.MEDLEYDISPLAYFONT differ diff --git a/fonts/medleydisplayfonts/XEROXLOGO48-MRR.MEDLEYDISPLAYFONT b/fonts/medleydisplayfonts/XEROXLOGO48-MRR.MEDLEYDISPLAYFONT index 107951a5c..d8081c524 100644 Binary files a/fonts/medleydisplayfonts/XEROXLOGO48-MRR.MEDLEYDISPLAYFONT and b/fonts/medleydisplayfonts/XEROXLOGO48-MRR.MEDLEYDISPLAYFONT differ diff --git a/internal/loadups/LOADUP-LISP b/internal/loadups/LOADUP-LISP index 9d7dca177..b681d3ac3 100644 --- a/internal/loadups/LOADUP-LISP +++ b/internal/loadups/LOADUP-LISP @@ -1,14 +1,12 @@ -(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "XCL" BASE 10) +(DEFINE-FILE-INFO :PACKAGE "INTERLISP" :READTABLE "XCL" :BASE 10) -(FILECREATED "26-Mar-2026 18:38:22"  -|{DSK}briggs>Projects>medley>internal>loadups>LOADUP-LISP.;14| 7604 +(FILECREATED "16-Apr-2026 09:06:26" |{WMEDLEY}loadups>LOADUP-LISP.;32| 7864 - :EDIT-BY "briggs" + :EDIT-BY |rmk| :CHANGES-TO (FNS LOADUP-LISP) - :PREVIOUS-DATE "22-Feb-2026 14:15:31" -|{DSK}briggs>Projects>medley>internal>loadups>LOADUP-LISP.;13|) + :PREVIOUS-DATE "15-Apr-2026 23:27:22" |{WMEDLEY}loadups>LOADUP-LISP.;31|) (PRETTYCOMPRINT LOADUP-LISPCOMS) @@ -21,7 +19,9 @@ (DEFINEQ (LOADUP-LISP - (LAMBDA (DRIBBLEFILE) (* \; "Edited 26-Mar-2026 18:38 by briggs") + (LAMBDA (DRIBBLEFILE) (* \; "Edited 16-Apr-2026 09:06 by rmk") + (* \; "Edited 5-Apr-2026 21:35 by rmk") + (* \; "Edited 26-Mar-2026 18:38 by briggs") (* \; "Edited 22-Feb-2026 14:15 by rmk") (* \; "Edited 28-Jan-2026 14:30 by lmm") (* \; "Edited 27-Dec-2025 15:02 by rmk") @@ -38,15 +38,15 @@ (* \; "Edited 13-Jul-2022 14:09 by rmk") (* \; "Edited 4-Mar-2022 19:13 by larry") (* \; "Edited 29-Apr-2021 22:30 by rmk:") - (SETQQ COMPILE.EXT LCOM) - (MEDLEY-INIT-VARS) (* \; "should be set earlier") + (SETQQ COMPILE.EXT LCOM) (* (MEDLEY-INIT-VARS) + (* \; "should be set earlier")) (DRIBBLE DRIBBLEFILE) (FOR X IN BOOTLOADEDFILES DO (CL:UNLESS (MEMB X SYSFILES) (PRINTOUT T X " bootloaded" T) (SETQ SYSFILES (CONS X SYSFILES)))) (SETQ BOOTLOADEDFILES NIL) (IF (NOT (BOUNDP 'DIRECTORIES)) - THEN (SETQ DIRECTORIES LOADUPDIRECTORIES)) + THEN (SETQ DIRECTORIES LOADUPDIRECTORIES)) (* (LOADUP (QUOTE (PSEUDOHOSTS)))) (* |;;| "following files are really loaded earlier, this call to LOADUP just cleans up") @@ -75,7 +75,7 @@ (LOADUP '(STACKFNS CMLMVS MACROS MACROAUX UNWINDMACROS)) (LOADUP '(COMMON XCLC-RUNTIME CMLTYPES CL-ERROR)) - (LOADUP '(AFONT EDIT WEDIT PRETTY DSPRINTDEF NEWPRINTDEF SPELLFILE PRINTFN LOADFNS DMISC + (LOADUP '(ACFONT EDIT WEDIT PRETTY DSPRINTDEF NEWPRINTDEF SPELLFILE PRINTFN LOADFNS DMISC DIRECTORY FILEPKG RESOURCE)) (* |;;| "needed for makesys") @@ -110,7 +110,7 @@ (LOADUP '(DSK UFS UFSCALLC MAIKOBITBLT)) (LOADUP '(TIME)) (LOADUP '(BRKDWN)) - (LOADUP '(LOGOW IDLER UNIXUTILS PSEUDOHOSTS HARDCOPY ICONW FREEMENU SEDIT)) + (LOADUP '(LOGOW IDLER UNIXUTILS HARDCOPY ICONW FREEMENU SEDIT)) (LOADUP '(XCL-EXTRAS)) (* |;;| "CMLPACKAGE pushes onto INSPECTMACROS") @@ -151,5 +151,5 @@ (GLOBALVARS MAKESYSFILENAME MEDLEY-INIT-VARS MEDLEYDIR SYSTEMINITVARS USERRECLST) ) (DECLARE\: DONTCOPY - (FILEMAP (NIL (695 7398 (LOADUP-LISP 705 . 7396))))) + (FILEMAP (NIL (640 7658 (LOADUP-LISP 650 . 7656))))) STOP diff --git a/internal/loadups/LOADUP-LISP.LCOM b/internal/loadups/LOADUP-LISP.LCOM index 2bbfe60e0..e13f8ab08 100644 Binary files a/internal/loadups/LOADUP-LISP.LCOM and b/internal/loadups/LOADUP-LISP.LCOM differ diff --git a/library/IMPORTFONTS b/library/IMPORTFONTS new file mode 100644 index 000000000..460c15076 --- /dev/null +++ b/library/IMPORTFONTS @@ -0,0 +1,877 @@ +(DEFINE-FILE-INFO :PACKAGE "INTERLISP" :READTABLE "INTERLISP" :BASE 10 :FORMAT :UTF-8) + +(FILECREATED " 5-May-2026 12:21:37" {MEDLEY}IMPORTFONTS.;116 58246 + + :EDIT-BY rmk + + :CHANGES-TO (FNS PEF) + + :PREVIOUS-DATE " 4-May-2026 15:26:51" {MEDLEY}IMPORTFONTS.;115) + + +(PRETTYCOMPRINT IMPORTFONTSCOMS) + +(RPAQQ IMPORTFONTSCOMS + ((FNS IMPORTFONTS FONT.TO.MCCS IMPORTFONTS.FONTSPECS IMPORTFONTS.CONTEXT IMPORTFONTS.NOCACHE + IMPORTFONTS.DIRECTORY IMPORTFONTS.CLEAR IMPORTFONTS.SUBDIR IMPORTFONTS.DIRSIZE) + (FNS IMPORTFONTS.AVAILABLE IMPORTFONTS.EXISTS?) + (FNS FAKEFACE FAKEFACE.FROMFILE FAKEFACE.FROMFONT) + (COMS (* ; "For legacy display imports") + (FNS IMPORT.DISPLAY LEGACYDISPLAYFONT) + (FILES ACFONT)) + (COMS (* ; "For testing") + (FNS IPF IPFSIZES) + (FNS PEF AEF IEF MEF CEF FEF DEF EFCLOSE) + (FNS SHOWCHARS CSSOURCE FONTDEFFONTS) + (FILES EDITFONT)))) +(DEFINEQ + +(IMPORTFONTS + [LAMBDA (PHASE FONTSPECS DEVICE FROMDIR TODIR IMPORTFN NODRIBBLE) + (* ; "Edited 4-May-2026 13:49 by rmk") + (* ; "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") + (* ; "Edited 30-Mar-2026 16:41 by rmk") + (* ; "Edited 29-Mar-2026 11:33 by rmk") + (* ; "Edited 26-Mar-2026 12:47 by rmk") + (* ; "Edited 24-Mar-2026 15:00 by rmk") + (* ; "Edited 21-Mar-2026 11:16 by rmk") + (* ; "Edited 4-Mar-2026 09:44 by rmk") + (* ; "Edited 9-Oct-2025 15:56 by rmk") + + (* ;; "Device-dependent IMPORTFN must be provided if PHASE is IMPORT, the other phases (MCCS, COMPLETE, FAKE) operate on Medleyfont files.") + + (* ;; "If PHASE is MCCS, recodes source FONTSPECS to MCCS without completion, otherwise coerces/completes the specified MCCS fonts.") + + (* ;; "Unless TODIRECTORY=DONT, writes the resultiing fonts Medley fontfiles, otherwise collects and returns them in a list (which will eat up storage). ") + + (CL:UNLESS (MEMB (SETQ PHASE (U-CASE PHASE)) + '(IMPORT MCCS COMPLETE FAKE DEPLOY)) + (\ILLEGAL.ARG PHASE)) + (CL:UNLESS DEVICE + (SETQ DEVICE 'DISPLAY)) + (CL:WHEN (AND (EQ PHASE 'IMPORT) + (NOT (GETD IMPORTFN))) + (ERROR "Importing from source requires an IMPORTFN")) + (PROG1 + (RESETLST (* ; + "Close dribble outside of this context") + (CL:MULTIPLE-VALUE-SETQ (FROMDIR TODIR) + (IMPORTFONTS.CONTEXT PHASE FROMDIR TODIR DEVICE)) + (IMPORTFONTS.CLEAR PHASE FONTSPECS TODIR DEVICE) + (SETQ FONTSPECS (IMPORTFONTS.FONTSPECS PHASE FONTSPECS FROMDIR DEVICE)) + (CL:WHEN (AND (IGEQ (LENGTH FONTSPECS) + 5) + (NOT NODRIBBLE)) (* ; + "Put all the dribbles together one up") + [DRIBBLE (PSEUDOFILENAME (PACKFILENAME 'BODY + (OR (SUBSTRING TODIR 1 + (STRPOS ">" TODIR -2 NIL NIL NIL NIL T)) + LOGINHOST/DIR) + 'NAME PHASE 'EXTENSION 'DRIBBLE] + (PRINTOUT T "Dribbling to " (FULLNAME (DRIBBLEFILE)) + T)) + (PRINTOUT T (SELECTQ PHASE + (IMPORT "Importing ") + (MCCS "MCCS recoding ") + (COMPLETE "Completing ") + (FAKE "Faking ") + (DEPLOY "Deploying ") + NIL) + (LENGTH FONTSPECS) + " " DEVICE " font" (CL:IF (IGEQ (LENGTH FONTSPECS) + 2) + "s" + "")) + (if TODIR + then (PRINTOUT T 3 "from " FROMDIR 3 "to " TODIR T) + else (PRINTOUT T " from " FROMDIR T 3 "(but not writing)" T)) + (BKSYSBUF " ") + (IMPORTFONTS.CLEAR PHASE FONTSPECS TODIR DEVICE) + (for FS FONT FONT FONTSTART TOFILE FROMFILE CAPTIONS THISTIME FROMSIZE TOSIZE CHANGED + NOTINSTANTIATED TOTALTIME TODIRSIZE (FROMDIRSIZE ↠(CL:IF (EQ PHASE 'IMPORT) + 0 + (IMPORTFONTS.DIRSIZE PHASE + DEVICE FROMDIR))) + (NNOCHARSETS ↠0) in FONTSPECS as I from 1 first (SETQ TOTALTIME (CLOCK 0)) + eachtime (PRINTOUT T .I3 I ". " (fetch (FONTSPEC FSFAMILY) of FS) + " " .I2 (fetch (FONTSPEC FSSIZE) of FS) + " " + (FONTFACETOATOM (fetch (FONTSPEC FSFACE) of FS))) + (SETQ THISTIME (CLOCK 0)) + collect (SELECTQ PHASE + (IMPORT (SETQ FONT (APPLY* IMPORTFN FS FROMDIR)) + (SETQ CHANGED T)) + ((MCCS COMPLETE) + (SETQ FROMFILE (INFILEP (MEDLEYFONT.FILENAME FS FROMDIR))) + (if FROMFILE + then (SETQ FONT (MEDLEYFONT.READ.FONT FROMFILE 'ALL)) + (SETQ FROMSIZE (GETFILEINFO FROMFILE 'LENGTH)) + else (SETQ FONT (FONTCREATE.SLUGFD FS)) + (SETQ FROMSIZE 0)) + (SETQ CHANGED (SELECTQ PHASE + (MCCS (FONT.TO.MCCS FONT)) + (COMPLETE (COMPLETE.FONT FONT T)) + NIL))) + (FAKE (CL:MULTIPLE-VALUE-SETQ (FONT FROMFILE) + (FAKEFACE.FROMFONT FS FROMDIR)) + (SETQ FROMSIZE (GETFILEINFO FROMFILE 'LENGTH)) + (SETQ CHANGED (FAKEFACE FONT))) + (DEPLOY (SETQ FROMFILE (MEDLEYFONT.FILENAME FS FROMDIR)) + (SETQ FROMSIZE (GETFILEINFO FROMFILE 'LENGTH))) + NIL) + (CL:WHEN [SETQ NOTINSTANTIATED (EQ 0 (FONTPROP FONT 'NINSTANTIATEDCHARSETS] + (add NNOCHARSETS 1)) + (CL:WHEN TODIR + (SETQ TOFILE (MEDLEYFONT.FILENAME FS TODIR)) + (SETQ TOFILE (CL:IF CHANGED + (MEDLEYFONT.WRITE.FONT FONT TOFILE) + (COPYFILE FROMFILE TOFILE)))) + (SETQ THISTIME (FQUOTIENT (IDIFFERENCE (CLOCK 0) + THISTIME) + 1000)) + (if NOTINSTANTIATED + then (PRINTOUT T 26 "No instantiated charsets" 41 .F7.2 THISTIME) + elseif TOFILE + then (SETQ TOSIZE (GETFILEINFO TOFILE 'LENGTH)) + (SELECTQ PHASE + (IMPORT (PRINTOUT T 25 .I6 TOSIZE " " .F7.2 THISTIME)) + ((MCCS COMPLETE FAKE DEPLOY) + (if CHANGED + then (PRINTOUT T 25 .I6 FROMSIZE " -> " .I6 TOSIZE " " + .F6.2 THISTIME 50 .I5 (IDIFFERENCE TOSIZE + FROMSIZE)) + else (PRINTOUT T 28 "Copied " .I6 TOSIZE " " .F6.2 THISTIME) + )) + NIL)) + (TERPRI T) + (CL:IF TODIR + TOFILE + FONT) finally (SETQ TOTALTIME (FIXR (FQUOTIENT (IDIFFERENCE (CLOCK 0) + TOTALTIME) + 1000))) + (PRINTOUT T 4 (IDIFFERENCE (LENGTH $$VAL) + NNOCHARSETS) + " font" + (CL:IF (IGEQ (LENGTH $$VAL) + 2) + "s " + " ") + (SELECTQ PHASE + (IMPORT "imported") + (MCCS "recoded to MCCS") + (COMPLETE "completed") + (FAKE "faked") + (DEPLOY "deployed") + NIL)) + (if TODIR + then (SETQ TODIRSIZE (IMPORTFONTS.DIRSIZE PHASE DEVICE TODIR + )) + (PRINTOUT T " and written in " TOTALTIME " seconds" 4 + "Total size is " (FIXR (FQUOTIENT TODIRSIZE 1024 + )) + " KB, grew by " + (FIXR (FQUOTIENT (IDIFFERENCE TODIRSIZE + FROMDIRSIZE) + 1024)) + " KB" T) + (CL:UNLESS (EQ 0 NNOCHARSETS) + (PRINTOUT T 4 NNOCHARSETS + " fonts had no character sets" T)) + (CL:WHEN (AND TODIR (IGEQ (LENGTH $$VAL) + 5)) + (SETQ $$VAL TODIR)) + else (PRINTOUT T " (but not written) in " TOTALTIME " seconds" + T)))) + (CL:WHEN (DRIBBLEFILE) + (PRINTOUT T "Dribbled to " (FULLNAME (DRIBBLEFILE)) + T) + [TEDIT (DRIBBLE) + 'Dribble NIL `(TITLE ,(CONCAT PHASE " font dribble" " " (DATE)) + LEAVETTY T READONLY QUIET PARABREAKCHARS NIL FONT DEFAULTFONT + OPENWIDTH ,(fetch (REGION WIDTH) of (WINDOWPROP (WFROMDS + T) + 'REGION)) + OPENHEIGHT + ,(fetch (REGION HEIGHT) of (WINDOWPROP (WFROMDS T) + 'REGION]))]) + +(FONT.TO.MCCS + [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") + (* ; "Edited 6-Sep-2025 16:43 by rmk") + (* ; "Edited 2-Sep-2025 15:20 by rmk") + (* ; "Edited 29-Aug-2025 11:25 by rmk") + (* ; "Edited 27-Aug-2025 17:36 by rmk") + + (* ;; + "Move character information in font to their MCCS positions, with coercions otherwise suppressed. ") + + (* ;; "If there are no mappings, prints a message and returns INFONT.") + + (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] + (CL:WHEN (MEMB (FONTPROP FONT 'CHARENCODING) + '(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)) + FONT)]) + +(IMPORTFONTS.FONTSPECS + [LAMBDA (PHASE FONTSPECS FROMDIR DEVICE) (* ; "Edited 4-May-2026 08:59 by rmk") + (* ; "Edited 4-Apr-2026 11:41 by rmk") + (* ; "Edited 3-Apr-2026 00:51 by rmk") + (* ; "Edited 1-Apr-2026 12:50 by rmk") + (* ; "Edited 30-Mar-2026 23:27 by rmk") + (* ; "Edited 23-Mar-2026 13:17 by rmk") + (* ; "Edited 21-Mar-2026 08:58 by rmk") + (* ; "Edited 14-Mar-2026 23:50 by rmk") + (* ; "Edited 13-Mar-2026 10:53 by rmk") + (* ; "Edited 4-Mar-2026 10:44 by rmk") + + (* ;; "Crucially, the fontspecs for COMPLETE and FAKEFACE must be ordered so that coercions or faces come before the fontspecs that depend on them. E.g. the order of faces has to be MRR MIR/BRR BIR. That means that the TODIR can be the source for the completion/faking of later fonts.") + + (CL:UNLESS DEVICE + (SETQ DEVICE 'DISPLAY)) + (SETQ FROMDIR (IMPORTFONTS.DIRECTORY DEVICE FROMDIR PHASE)) + (RESETLST + (IMPORTFONTS.NOCACHE) + [RESETSAVE (FONTDEVICEPROP DEVICE 'FONTDIRECTORIES FROMDIR) + `(PROGN (FONTDEVICEPROP ',DEVICE 'FONTDIRECTORIES OLDVALUE] + (LET [(EXPANDED (CL:REMOVE-DUPLICATES + (for F inside (CL:IF (type? FONTSPEC FONTSPECS) + (CONS FONTSPECS) + (OR FONTSPECS '*)) + join (if (type? FONTSPEC F) + then (for FACE in (FONTFACE.STARS (fetch (FONTSPEC FSFACE) + of (\FONT.CHECKARGS F))) + collect (create FONTSPEC + using F FSFACE ↠FACE FSDEVICE ↠DEVICE + FSROTATION ↠0)) + elseif (LITATOM F) + then + (* ;; "Looks in FROMDIR") + + (IMPORTFONTS.AVAILABLE PHASE (MAKEFONTSPEC + (OR F '*) + '* + '* 0 DEVICE) + FROMDIR) + else (\ILLEGAL.ARG F))) + :TEST + (FUNCTION EQUAL] + (SELECTQ PHASE + (COMPLETE + (* ;; "Fonts have to be ordered so that a coercion target is done before the font that needs it (e.g. CLASSIC before MODERN before TERMINAL before GACHA). This is essentially a topsort") + + (for FONTSPEC NEWFONTS in EXPANDED + do (for F in (DREVERSE (CONS FONTSPEC (COERCEFONTSPEC FONTSPEC + 'CHARCOERCIONS T))) + unless (MEMBER F NEWFONTS) when (IMPORTFONTS.EXISTS? 'COMPLETE F + FROMDIR) + do (push NEWFONTS F)) finally + + (* ;; + "We may have requested a font that doesn't exist at all on its own: HELVETICA 10 MIR") + + (for F in EXPANDED + unless (MEMBER F NEWFONTS) + do (push NEWFONTS F)) + (RETURN (DREVERSE NEWFONTS)))) + (FAKE + (* ;; + "If e.g. BIR is in the list, then so should be BMR, MIR, and if those are there, then so should MRR") + + (for ETAIL FS FACE SOURCE NEWFONTS on EXPANDED + do (SETQ FS (CAR ETAIL)) + (SETQ FACE (fetch (FONTSPEC FSFACE) of FS)) + (CL:WHEN (EQ 'BOLD (fetch (FONTFACE WEIGHT) of FACE)) + (* ; + "BRR -> MRR, BIR ->MIR which goes to MRR") + (for FC SOURCE in (FONTFACE.STARS (create FONTFACE + using FACE WEIGHT ↠+ 'MEDIUM)) + eachtime (SETQ SOURCE (create FONTSPEC using FS FSFACE ↠FC)) + when (IMPORTFONTS.EXISTS? 'FAKE SOURCE FROMDIR) + do (push NEWFONTS SOURCE))) + (CL:WHEN (EQ 'ITALIC (fetch (FONTFACE SLOPE) of FACE)) + (* ; "MIR -> MRR, BIR ->BMR") + (for F SOURCE in (FONTFACE.STARS (create FONTFACE + using FACE SLOPE ↠'REGULAR)) + eachtime (SETQ SOURCE (create FONTSPEC using FS FSFACE ↠F)) + when (IMPORTFONTS.EXISTS? 'FAKE SOURCE FROMDIR) + do (push NEWFONTS SOURCE))) + (CL:WHEN (EQ 'COMPRESSED (fetch (FONTFACE EXPANSION) of FACE)) + (* ; "MRC -> MRR") + (for F SOURCE in (FONTFACE.STARS (create FONTFACE + using FACE EXPANSION ↠+ 'REGULAR)) + eachtime (SETQ SOURCE (create FONTSPEC using FS FSFACE ↠F)) + when (IMPORTFONTS.EXISTS? 'FAKE SOURCE FROMDIR) + do (push NEWFONTS SOURCE))) + finally (for F in EXPANDED unless (MEMBER F NEWFONTS) + do (push NEWFONTS F)) + (RETURN (DREVERSE NEWFONTS)))) + (DEPLOY (* ; + "Make sure we copy consistent versions of the indirects") + (SORTFONTSPECS (CL:REMOVE-DUPLICATES (APPEND + (for FS in EXPANDED + join (MEDLEYFONT.GETFILEPROP + (MEDLEYFONT.FILENAME FS + FROMDIR) + 'INDIRECTS)) + EXPANDED) + :TEST + (FUNCTION EQUAL)))) + (SORTFONTSPECS EXPANDED))))]) + +(IMPORTFONTS.CONTEXT + [LAMBDA (PHASE FROMDIR TODIR DEVICE) (* ; "Edited 4-May-2026 00:16 by rmk") + (* ; "Edited 4-Apr-2026 09:33 by rmk") + (* ; "Edited 24-Mar-2026 23:11 by rmk") + (* ; "Edited 23-Mar-2026 13:17 by rmk") + (* ; "Edited 21-Mar-2026 09:53 by rmk") + (* ; "Edited 18-Mar-2026 22:36 by rmk") + (* ; "Edited 16-Mar-2026 09:01 by rmk") + (* ; "Edited 14-Mar-2026 23:56 by rmk") + (* ; "Edited 13-Mar-2026 10:52 by rmk") + (* ; "Edited 3-Mar-2026 21:58 by rmk") + + (* ;; "This sets up the FONTDEVICE props according to PHASE, using default values for the directories if they aren't specified. Returns the TODIR, or NIL if the TODIR was DONT=don't file.") + + (SETQ FROMDIR (IMPORTFONTS.DIRECTORY DEVICE FROMDIR + (SELECTQ PHASE + (IMPORT 'SOURCE) + (MCCS 'IMPORT) + (COMPLETE 'MCCS) + (FAKE 'COMPLETE) + (DEPLOY (for P in '(FAKE COMPLETE MCCS IMPORT) + suchthat (DIRECTORYNAMEP (IMPORTFONTS.DIRECTORY DEVICE + FROMDIR P)))) + NIL))) + (SETQ TODIR (CL:IF (EQ PHASE 'DEPLOY) + (CONCAT [CAR (MKLIST (FONTDEVICEPROP DEVICE 'FONTDIRECTORIES] + ">") + (IMPORTFONTS.DIRECTORY DEVICE TODIR PHASE))) + [RESETSAVE (FONTDEVICEPROP DEVICE 'FONTCOERCIONS NIL) + `(PROGN (FONTDEVICEPROP ',DEVICE 'FONTCOERCIONS OLDVALUE] + (SELECTQ PHASE + ((IMPORT MCCS) + [RESETSAVE (FONTDEVICEPROP DEVICE 'FONTDIRECTORIES FROMDIR) + `(PROGN (FONTDEVICEPROP ',DEVICE 'FONTDIRECTORIES OLDVALUE]) + (COMPLETE + (* ;; "Make FONTCREATE1 in the COMPLETE phase draw from previously import-completed fonts, not from the currently active fonts") + + [RESETSAVE (FONTDEVICEPROP DEVICE 'FONTDIRECTORIES (LIST TODIR FROMDIR)) + `(PROGN (FONTDEVICEPROP ',DEVICE 'FONTDIRECTORIES OLDVALUE] + (* ; "Suppress face faking") + [RESETSAVE (FONTDEVICEPROP DEVICE 'FACECOERCIONS NIL) + `(PROGN (FONTDEVICEPROP ',DEVICE 'FACECOERCIONS OLDVALUE]) + (FAKE + (* ;; "Make FONTCREATE1 in the FAKE phase draw from previously import-completed fonts, not from the currently active fonts") + + [RESETSAVE (FONTDEVICEPROP DEVICE 'FONTDIRECTORIES (LIST TODIR FROMDIR)) + `(PROGN (FONTDEVICEPROP ',DEVICE 'FONTDIRECTORIES OLDVALUE] + (* ; "Completion has already been done") + [RESETSAVE (FONTDEVICEPROP DEVICE 'FONTCOERCIONS NIL) + `(PROGN (FONTDEVICEPROP ',DEVICE 'FONTCOERCIONS OLDVALUE]) + NIL) + (IMPORTFONTS.NOCACHE) + (CL:VALUES FROMDIR TODIR]) + +(IMPORTFONTS.NOCACHE + [LAMBDA NIL (* ; "Edited 3-Mar-2026 11:54 by rmk") + (RESETSAVE \FONTSINCORE NIL) + (RESETSAVE \FONTEXISTS?-CACHE NIL) + (RESETSAVE \FONTSAVAILABLEFILECACHE NIL]) + +(IMPORTFONTS.DIRECTORY + [LAMBDA (DEVICE DIRECTORY PHASE) (* ; "Edited 4-May-2026 00:52 by rmk") + (* ; "Edited 5-Apr-2026 14:17 by rmk") + (* ; "Edited 22-Mar-2026 22:59 by rmk") + (* ; "Edited 21-Mar-2026 22:40 by rmk") + (* ; "Edited 12-Mar-2026 09:35 by rmk") + (* ; "Edited 9-Mar-2026 09:14 by rmk") + (* ; "Edited 4-Mar-2026 00:46 by rmk") + (CL:UNLESS (MEMB DIRECTORY '(DONT DON'T)) + [PSEUDOFILENAME (OR DIRECTORY + (SELECTQ PHASE + (DEPLOY (CONCAT [CAR (MKLIST (FONTDEVICEPROP DEVICE 'FONTDIRECTORIES] + ">")) + (CONCAT "{MEDLEY}fonts>" + (L-CASE (CONCAT (OR (if (type? FONTDESCRIPTOR DEVICE) + then (FONTPROP DEVICE 'DEVICE) + elseif (type? FONTSPEC DEVICE) + then (fetch (FONTSPEC FSDEVICE) + of (\FONT.CHECKARGS DEVICE)) + elseif (NOT (LITATOM DEVICE)) + then (\ILLEGAL.ARG DEVICE) + elseif DEVICE + else 'DISPLAY)) + ">" + (CL:IF PHASE + (CONCAT (IMPORTFONTS.SUBDIR PHASE) + ">") + "")])]) + +(IMPORTFONTS.CLEAR + [LAMBDA (PHASE FONTSPECS TODIR DEVICE) (* ; "Edited 3-May-2026 22:40 by rmk") + (* ; "Edited 4-Apr-2026 10:03 by rmk") + (* ; "Edited 3-Apr-2026 01:06 by rmk") + (* ; "Edited 30-Mar-2026 12:37 by rmk") + (* ; "Edited 23-Mar-2026 13:18 by rmk") + (* ; "Edited 14-Mar-2026 22:51 by rmk") + (* ; "Edited 12-Mar-2026 09:31 by rmk") + (CL:WHEN [AND TODIR (MEMB PHASE '(COMPLETE FAKE] (* ; + "Previous completions could serve as inputs for later ones, start fresh.") + (LET (NDELETED) + [SETQ NDELETED (if FONTSPECS + then (for FS in (CL:IF (type? FONTSPEC FONTSPECS) + (CONS FONTSPECS) + FONTSPECS) + sum (for FILE in (FILDIR (PACKFILENAME 'VERSION '* + 'BODY + (MEDLEYFONT.FILENAME FS TODIR + ))) + count (DELFILE FILE))) + else (for FILE + in [FILDIR (PACKFILENAME 'DIRECTORY TODIR 'NAME '* 'VERSION + '* + 'EXTENSION + (CAR (MKLIST (FONTDEVICEPROP DEVICE + 'FONTEXTENSIONS] + count (DELFILE FILE] + (CL:UNLESS (EQ 0 NDELETED) + (PRINTOUT T (SELECTQ NDELETED + (1 "1 font") + (CONCAT NDELETED " fonts")) + " deleted from " + (PSEUDOFILENAME TODIR) + T))))]) + +(IMPORTFONTS.SUBDIR + [LAMBDA (PHASE) (* ; "Edited 4-May-2026 00:27 by rmk") + (* ; "Edited 30-Mar-2026 16:27 by rmk") + (* ; "Edited 23-Mar-2026 13:18 by rmk") + (* ; "Edited 21-Mar-2026 09:53 by rmk") + (SELECTQ PHASE + (SOURCE "source") + (IMPORT "imported") + (MCCS "mccs") + (COMPLETE "completed") + (FAKE "faked") + (DEPLOY) + (\ILLEGAL.ARG]) + +(IMPORTFONTS.DIRSIZE + [LAMBDA (PHASE DEVICE DIRECTORY) (* ; "Edited 4-May-2026 00:26 by rmk") + (* ; "Edited 30-Mar-2026 16:30 by rmk") + (DIRECTORY (PACKFILENAME 'DIRECTORY (IMPORTFONTS.DIRECTORY DEVICE DIRECTORY PHASE) + 'NAME + '* + 'EXTENSION + [CAR (MKLIST (FONTDEVICEPROP (OR DEVICE 'DISPLAY) + 'FONTEXTENSIONS] + 'VERSION "") + 'COUNTLENGTH]) +) +(DEFINEQ + +(IMPORTFONTS.AVAILABLE + [LAMBDA (PHASE FONTSPEC FROMDIR) (* ; "Edited 4-May-2026 00:00 by rmk") + (* ; "Edited 22-Mar-2026 13:36 by rmk") + (RESETLST + [RESETSAVE (FONTDEVICEPROP FONTSPEC 'FONTDIRECTORIES (IMPORTFONTS.DIRECTORY FONTSPEC FROMDIR + PHASE)) + `(PROGN (FONTDEVICEPROP ',FONTSPEC 'FONTDIRECTORIES OLDVALUE] + (IMPORTFONTS.NOCACHE) + (FONTSAVAILABLE FONTSPEC NIL NIL NIL NIL 'ONLY))]) + +(IMPORTFONTS.EXISTS? + [LAMBDA (PHASE FONTSPEC FROMDIR) (* ; "Edited 4-May-2026 00:00 by rmk") + (* ; "Edited 22-Mar-2026 14:55 by rmk") + (RESETLST + [RESETSAVE (FONTDEVICEPROP FONTSPEC 'FONTDIRECTORIES (IMPORTFONTS.DIRECTORY FONTSPEC FROMDIR + PHASE)) + `(PROGN (FONTDEVICEPROP ',FONTSPEC 'FONTDIRECTORIES OLDVALUE] + (IMPORTFONTS.NOCACHE) + (FONTEXISTS? FONTSPEC NIL NIL NIL NIL T))]) +) +(DEFINEQ + +(FAKEFACE + [LAMBDA (FONT) (* ; "Edited 5-Apr-2026 14:10 by rmk") + (* ; "Edited 4-Apr-2026 09:38 by rmk") + (* ; "Edited 1-Apr-2026 09:00 by rmk") + (* ; "Edited 24-Mar-2026 22:14 by rmk") + (* ; "Edited 21-Mar-2026 14:37 by rmk") + (* ; "Edited 14-Mar-2026 23:53 by rmk") + + (* ;; "FONTSPEC describes a font that has already been completed in terms of its CHARCOERCIONS.") + + (* ;; "Suppose FONTSPEC describes a (display) BRR font. If it has not been completed (i.e., it is still just MCCS), then all of the glyphs in all of its character sets are natively bold.") + + (* ;; "If it has been completed without facefaking, then some of its characters may have been retrieved from other fonts, and those are mixed in with its native glyphs. But presumably, those characters are also drawn from a BRR font, on the assumption that CHARCOERCIONS tends to preserve faces.") + + (* ;; "So: it is correct to run through all of the slugs, grab the corresponding glyphs from the already completed MRR, if it exists, and insert the bolded versions of those characters.") + + (* ;; "") + + (LET* ((FONTSPEC (FONTPROP FONT 'DEVICESPEC)) + (FACE (fetch (FONTSPEC FSFACE) of FONTSPEC)) + SOURCEFONT CHANGED) + (CL:UNLESS (EQ 'DISPLAY (FONTPROP FONT 'DEVICE)) + (ERROR "Only display fonts can be face-faked" FONT)) + (CL:UNLESS (fetch (FONTDESCRIPTOR FONTCOMPLETEP) of FONT) + (ERROR "Fonts must be completed before face-faking" FONTSPEC)) + (CL:WHEN [AND (EQ 'BOLD (fetch (FONTFACE WEIGHT) of FACE)) + (SETQ SOURCEFONT (FONTCREATE1 (create FONTSPEC using FONTSPEC FSWEIGHT ↠+ 'MEDIUM] + (for CHARSET from 0 to (MAXCHARSET FONT) when (FAKEFACE.CHARSET FONT CHARSET + (FUNCTION MAKEBOLD.CHAR) + SOURCEFONT) + do (SETQ CHANGED T))) + (CL:WHEN [AND (EQ 'ITALIC (fetch (FONTFACE SLOPE) of FACE)) + (SETQ SOURCEFONT (FONTCREATE1 (create FONTSPEC using FONTSPEC FSSLOPE ↠+ 'REGULAR] + (for CHARSET from 0 to (MAXCHARSET FONT) when (FAKEFACE.CHARSET FONT CHARSET + (FUNCTION MAKEITALIC.CHAR) + SOURCEFONT) + do (SETQ CHANGED T))) + (CL:WHEN [AND (EQ 'COMPRESSED (fetch (FONTFACE EXPANSION) of FACE)) + (SETQ SOURCEFONT (FONTCREATE1 (create FONTSPEC using FONTSPEC FSEXPANSION ↠+ 'REGULAR] + (for CHARSET from 0 to (MAXCHARSET FONT) when (FAKEFACE.CHARSET FONT CHARSET + (FUNCTION MOVEFONTCHARS) + SOURCEFONT) + do (SETQ CHANGED T))) + CHANGED]) + +(FAKEFACE.FROMFILE + [LAMBDA (FONTSPEC FROMDIR) (* ; "Edited 3-May-2026 22:37 by rmk") + (* ; "Edited 4-Apr-2026 09:42 by rmk") + (* ; "Edited 30-Mar-2026 23:17 by rmk") + (* ; "Edited 21-Mar-2026 09:03 by rmk") + (* ; "Edited 19-Mar-2026 11:53 by rmk") + (* ; + "Start with MRR for a face that doesn't yet exist (HELVETICA MIR).") + (OR (INFILEP (MEDLEYFONT.FILENAME FONTSPEC FROMDIR)) + (LET ((FACE (fetch (FONTSPEC FSFACE) of FONTSPEC))) + (OR (AND (EQ 'BOLD (fetch (FONTFACE WEIGHT) of FACE)) + (INFILEP (MEDLEYFONT.FILENAME (create FONTSPEC using FONTSPEC FSFACE ↠+ (MAKEFONTFACE 'MEDIUM NIL + NIL FACE)) + FROMDIR))) + (AND (EQ 'ITALIC (fetch (FONTFACE SLOPE) of FACE)) + (FAKEFACE.FROMFILE (create FONTSPEC using FONTSPEC FSFACE ↠(MAKEFONTFACE + NIL + 'REGULAR NIL FACE) + ) + FROMDIR)) + (AND (EQ 'COMPRESSED (fetch (FONTFACE EXPANSION) of FACE)) + (FAKEFACE.FROMFILE (create FONTSPEC using FONTSPEC FSFACE ↠(MAKEFONTFACE + NIL NIL + 'REGULAR FACE)) + FROMDIR)) + (ERROR "No source for face-faking" FONTSPEC]) + +(FAKEFACE.FROMFONT + [LAMBDA (FONTSPEC FROMDIR) (* ; "Edited 3-May-2026 22:37 by rmk") + (* ; "Edited 19-Mar-2026 20:42 by rmk") + + (* ;; "If FONTSPEC doesn't identifyan existing font that needs to be coerced, we create an empty starting font full of slug charsets. ") + + (LET (FROMFILE FONT) + (SETQ FROMFILE (FAKEFACE.FROMFILE FONTSPEC FROMDIR)) + (SETQ FONT (MEDLEYFONT.READ.FONT FROMFILE 'ALL)) + (CL:UNLESS (EQUAL FONTSPEC (FONTPROP FONT 'SPEC)) + + (* ;; "We catch all the other properties of the backing font--encoding etc.") + + (SETQ FONT (FONTCREATE.SLUGFD FONTSPEC FONT))) + (CL:VALUES FONT FROMFILE]) +) + + + +(* ; "For legacy display imports") + +(DEFINEQ + +(IMPORT.DISPLAY + [LAMBDA (FONTSPECS) (* ; "Edited 4-May-2026 15:18 by rmk") + (* ; "Edited 28-Mar-2026 23:08 by rmk") + (* ; "Edited 18-Mar-2026 23:54 by rmk") + (IMPORTFONTS 'IMPORT FONTSPECS 'DISPLAY '{MEDLEY}/fonts/displayfonts/ NIL (FUNCTION + LEGACYDISPLAYFONT]) + +(LEGACYDISPLAYFONT + [LAMBDA (FONTSPEC FROMDIR) (* ; "Edited 3-May-2026 22:38 by rmk") + (* ; "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 FROMDIR. If NIL, the current directory") + + (SETQ FONTSPEC (\FONT.CHECKARGS FONTSPEC NIL NIL NIL 'DISPLAY T)) + (RESETLST + [RESETSAVE (FONTDEVICEPROP 'DISPLAY 'FONTDIRECTORIES FROMDIR) + `(PROGN (FONTDEVICEPROP 'DISPLAY 'FONTDIRECTORIES OLDVALUE] + [RESETSAVE (FONTDEVICEPROP 'DISPLAY 'FONTEXTENSIONS '(DISPLAYFONT) + FROMDIR) + `(PROGN (FONTDEVICEPROP 'DISPLAY 'FONTEXTENSIONS OLDVALUE] + (for CSNO CSINFO (FONT ↠(FONTSPEC.TO.FONTDESCRIPTOR FONTSPEC 255)) from 0 to 255 + do (SETQ CSINFO (\READCHARSET FONT CSNO '((AC ACFONT.FILEP ACFONT.GETCHARSET) + (STRIKE STRIKEFONT.FILEP STRIKEFONT.GETCHARSET)) + FROMDIR)) + + (* ;; "NIL means empty") + + (CL:IF CSINFO + (\INSTALLCHARSETINFO FONT CSINFO CSNO) + (\SETCHARSETINFO FONT CSNO (SLUGCSINFO FONT))) finally (RETURN FONT)))]) +) + +(FILESLOAD ACFONT) + + + +(* ; "For testing") + +(DEFINEQ + +(IPF + [LAMBDA (PHASE FONTSPEC) (* ; "Edited 4-May-2026 00:01 by rmk") + (* ; "Edited 30-Mar-2026 12:44 by rmk") + (* ; "Edited 21-Mar-2026 22:46 by rmk") + (* ; "Edited 10-Mar-2026 00:54 by rmk") + (MEDLEYFONT.READ.FONT (MEDLEYFONT.FILENAME FONTSPEC (IMPORTFONTS.DIRECTORY + (OR (fetch (FONTSPEC FSDEVICE) of FONTSPEC) + 'DISPLAY) + NIL PHASE)) + 'ALL]) + +(IPFSIZES + [LAMBDA (FONTSPEC) (* ; "Edited 4-May-2026 00:49 by rmk") + (* ; "Edited 30-Mar-2026 12:45 by rmk") + (* ; "Edited 23-Mar-2026 13:18 by rmk") + (* ; "Edited 21-Mar-2026 00:59 by rmk") + (* ; "Edited 16-Mar-2026 08:43 by rmk") + (* ; "Edited 13-Mar-2026 10:33 by rmk") + + (* ;; "Returns the file sizes for all the phases of FONTSPEC") + + (if (type? FONTSPEC FONTSPEC) + then (SETQ FONTSPEC (\FONT.CHECKARGS FONTSPEC NIL NIL NIL NIL T)) + else (SETQ FONTSPEC (FONTSPECFROMFILENAME FONTSPEC))) + (for PHASE DIR FONTFILE SIZE LASTSIZE in '(IMPORT MCCS COMPLETE FAKE DEPLOY) + eachtime (SETQ DIR (IMPORTFONTS.DIRECTORY FONTSPEC NIL PHASE)) + when (SETQ FONTFILE (INFILEP (MEDLEYFONT.FILENAME FONTSPEC DIR))) + collect (SETQ FONTFILE (INFILEP (MEDLEYFONT.FILENAME FONTSPEC DIR))) + [SETQ SIZE (CL:IF FONTFILE + (GETFILEINFO FONTFILE 'LENGTH))] + (PROG1 [LIST* PHASE SIZE (CL:IF LASTSIZE + (CONS (IDIFFERENCE SIZE LASTSIZE)))] + (SETQ LASTSIZE SIZE]) +) +(DEFINEQ + +(PEF + [LAMBDA (PHASES FONTSPEC CHARSET) (* ; "Edited 5-May-2026 12:20 by rmk") + (* ; "Edited 4-May-2026 08:27 by rmk") + (* ; "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") + (if (type? FONTSPEC FONTSPEC) + then (SETQ FONTSPEC (\FONT.CHECKARGS FONTSPEC NIL NIL NIL NIL T)) + else (SETQ FONTSPEC (FONTSPECFROMFILENAME FONTSPEC))) + (for PHASE TITLETAG CHARSETNAME DIR FONTFILE inside PHASES + do (* ; + "Some phases may not have some charsets") + (SETQ CHARSET (if (EQ CHARSET T) + then (for C in (MEDLEYFONT.GETFILEPROP FONTFILE 'CHARSET) + unless (OR (KANJICHARSETP C) + (UNIHANCHARSETP C)) collect C) + elseif (CHARSET.DECODE CHARSET) + else 0)) + (if (LISTP CHARSET) + then (for C in CHARSET do (PEF PHASE FONTSPEC C)) + elseif (EQ PHASE 'DEPLOY) + then (EDITFONT FONTSPEC CHARSET NIL NIL "Deployed") + else (SETQ DIR (IMPORTFONTS.DIRECTORY FONTSPEC NIL PHASE)) + (SETQ FONTFILE (MEDLEYFONT.FILENAME FONTSPEC DIR)) + (if (NLSETQ (MEDLEYFONT.FILEP FONTFILE)) + then (SETQ TITLETAG (CL:IF (EQ PHASE 'MCCS) + 'MCCS + (L-CASE PHASE T))) + (SETQ CHARSETNAME (CHARSET.ENCODE CHARSET)) + (CL:UNLESS (OCTALNUM? CHARSETNAME) + (SETQ TITLETAG (CONCAT CHARSETNAME " " TITLETAG))) + (if [CAR (NLSETQ (RESETLST + (IMPORTFONTS.CONTEXT PHASE DIR NIL (fetch (FONTSPEC + FSDEVICE) + of FONTSPEC)) + (EDITFONT (MEDLEYFONT.READ.FONT FONTFILE CHARSET) + CHARSET NIL NIL TITLETAG))] + else (PRINTOUT T "Charset " (OCTALSTRING CHARSET) + " of " FONTSPEC " not found in " DIR T) + NIL) + else (PRINTOUT T FONTSPEC " not found in " DIR T]) + +(AEF + [LAMBDA (FONTSPEC CHARSET CLOSE) (* ; "Edited 4-May-2026 08:22 by rmk") + (* ; "Edited 5-Apr-2026 11:50 by rmk") + (* ; "Edited 21-Mar-2026 15:09 by rmk") + (* ; "Edited 14-Mar-2026 12:59 by rmk") + (* ; "Edited 12-Mar-2026 22:56 by rmk") + + (* ;; "Show CHARSET for all phases of FONTSPEC") + + (CL:WHEN CLOSE (EFCLOSE)) + (PEF '(IMPORT MCCS COMPLETE FAKE DEPLOY) + FONTSPEC CHARSET]) + +(IEF + [LAMBDA (FONTSPEC CHARSET) (* ; "Edited 4-May-2026 08:34 by rmk") + (* ; "Edited 12-Mar-2026 11:38 by rmk") + (* ; "Edited 10-Mar-2026 01:02 by rmk") + (* ; "Edited 4-Mar-2026 00:31 by rmk") + (* ; "Edited 1-Mar-2026 23:56 by rmk") + (* ; "Edited 27-Feb-2026 14:24 by rmk") + (PEF 'IMPORT FONTSPEC CHARSET]) + +(MEF + [LAMBDA (FONTSPEC CHARSET) (* ; "Edited 4-May-2026 08:35 by rmk") + (* ; "Edited 12-Mar-2026 11:38 by rmk") + (* ; "Edited 10-Mar-2026 01:01 by rmk") + (* ; "Edited 4-Mar-2026 00:31 by rmk") + (* ; "Edited 1-Mar-2026 23:57 by rmk") + (* ; "Edited 9-Oct-2025 20:38 by rmk") + (PEF 'MCCS FONTSPEC CHARSET]) + +(CEF + [LAMBDA (FONTSPEC CHARSET) (* ; "Edited 4-May-2026 08:35 by rmk") + (* ; "Edited 12-Mar-2026 11:38 by rmk") + (* ; "Edited 10-Mar-2026 01:03 by rmk") + (* ; "Edited 4-Mar-2026 00:31 by rmk") + (* ; "Edited 2-Mar-2026 00:00 by rmk") + (* ; "Edited 9-Oct-2025 22:58 by rmk") + (PEF 'COMPLETE FONTSPEC CHARSET]) + +(FEF + [LAMBDA (FONTSPEC CHARSET) (* ; "Edited 4-May-2026 08:35 by rmk") + (* ; "Edited 23-Mar-2026 13:18 by rmk") + (* ; "Edited 19-Mar-2026 00:42 by rmk") + (* ; "Edited 12-Mar-2026 11:38 by rmk") + (* ; "Edited 10-Mar-2026 01:03 by rmk") + (* ; "Edited 4-Mar-2026 00:31 by rmk") + (* ; "Edited 2-Mar-2026 00:00 by rmk") + (* ; "Edited 9-Oct-2025 22:58 by rmk") + (PEF 'FAKE FONTSPEC CHARSET]) + +(DEF + [LAMBDA (FONTSPEC CHARSET) (* ; "Edited 4-May-2026 08:34 by rmk") + (* ; "Edited 12-Mar-2026 11:38 by rmk") + (* ; "Edited 10-Mar-2026 01:02 by rmk") + (* ; "Edited 4-Mar-2026 00:31 by rmk") + (* ; "Edited 1-Mar-2026 23:56 by rmk") + (* ; "Edited 27-Feb-2026 14:24 by rmk") + (PEF 'DEPLOY FONTSPEC CHARSET]) + +(EFCLOSE + [LAMBDA NIL (* ; "Edited 9-Oct-2025 19:48 by rmk") + (for W in (OPENWINDOWS) when (AND (WINDOWPROP W 'FONT) + (WINDOWPROP W 'CHARITEMS)) do (CLOSEW W]) +) +(DEFINEQ + +(SHOWCHARS + [LAMBDA (FONT FROMCHAR TOCHAR ONELINE) (* ; "Edited 5-Oct-2025 17:41 by rmk") + (* ; "Edited 7-Sep-2025 20:29 by rmk") + (* ; "Edited 2-Sep-2025 10:26 by rmk") + (* ; "Edited 24-Jul-2025 11:30 by rmk") + (* ; "Edited 8-Jun-2025 20:05 by rmk") + (* ; "Edited 26-Jan-2024 14:18 by mth") + (* ; "Edited 1-Aug-2020 09:27 by rmk:") + [SETQ FONT (FONTCREATE (OR FONT '(CLASSIC 12] + (RESETLST + [LET ((OLDFONT (DSPFONT NIL T)) + CHARS) + (CL:UNLESS (CHARCODEP FROMCHAR) + (SETQ FROMCHAR (OR (CHARCODE.DECODE FROMCHAR T) + FROMCHAR))) + (SETQ CHARS (if (LISTP FROMCHAR) + elseif (CHARCODEP FROMCHAR) + then (CL:UNLESS (CHARCODEP TOCHAR) + (SETQ TOCHAR (OR (CHARCODE.DECODE TOCHAR) + FROMCHAR))) + (for C from FROMCHAR to TOCHAR collect C) + else (CHCON FROMCHAR))) + [RESETSAVE OLDFONT '(PROGN (DSPFONT OLDVALUE] + (TERPRI) + (for C in CHARS do (PRINTOUT T .FONT OLDFONT (CONCAT (OCTALSTRING (\CHARSET C)) + "," + (OCTALSTRING (\CHAR8CODE C))) + 10 .FONT FONT (CHARACTER C)) + (CL:UNLESS ONELINE (PRINTOUT T T]) + (TERPRI]) + +(CSSOURCE + [LAMBDA (PHASE FONT INDIRECT) (* ; "Edited 22-Mar-2026 00:26 by rmk") + + (* ;; "Shows the source properties of all the charsets") + + (CL:UNLESS (FONTP FONT) + (SETQ FONT (IPF PHASE FONT))) + (LIST* PHASE (FONTPROP FONT 'SPEC) + (for CS CSINFO SOURCE (FONTSPEC ↠(FONTPROP FONT 'SPEC)) from 0 to (MAXCHARSET FONT) + eachtime (SETQ CSINFO (\GETCHARSETINFO FONT CS)) when CSINFO + unless (fetch (CHARSETINFO CSSLUGP) of CSINFO) + unless [AND INDIRECT (EQUAL FONTSPEC (CHARSETPROP CSINFO 'SOURCE] + collect (LIST CS (CHARSETPROP CSINFO 'SOURCE]) + +(FONTDEFFONTS + [LAMBDA (FACES) (* ; "Edited 22-Mar-2026 12:48 by rmk") + (SETQ FACES (for F inside FACES collect (\FONTFACE F))) + (for FD FONTLIST in FONTDEFS + do (for FP in (CDR (ASSOC 'FONTPROFILE FD)) + do (for FONT in (CDDR FP) when FONT unless (MEMB (CAR FONT) + '(PDF POSTSCRIPT)) + when (OR (NOT FACES) + (MEMBER (\FONTFACE (fetch (FONTSPEC FSFACE) of FONT)) + FACES)) do (push FONTLIST FONT))) + finally (RETURN (SORTFONTSPECS (CL:REMOVE-DUPLICATES FONTLIST :TEST (FUNCTION EQUAL]) +) + +(FILESLOAD EDITFONT) +(DECLARE%: DONTCOPY + (FILEMAP (NIL (1116 33853 (IMPORTFONTS 1126 . 13073) (FONT.TO.MCCS 13075 . 15325) ( +IMPORTFONTS.FONTSPECS 15327 . 23722) (IMPORTFONTS.CONTEXT 23724 . 27433) (IMPORTFONTS.NOCACHE 27435 . +27686) (IMPORTFONTS.DIRECTORY 27688 . 30039) (IMPORTFONTS.CLEAR 30041 . 32587) (IMPORTFONTS.SUBDIR +32589 . 33238) (IMPORTFONTS.DIRSIZE 33240 . 33851)) (33854 35077 (IMPORTFONTS.AVAILABLE 33864 . 34473) + (IMPORTFONTS.EXISTS? 34475 . 35075)) (35078 41861 (FAKEFACE 35088 . 38825) (FAKEFACE.FROMFILE 38827 + . 41068) (FAKEFACE.FROMFONT 41070 . 41859)) (41905 44151 (IMPORT.DISPLAY 41915 . 42453) ( +LEGACYDISPLAYFONT 42455 . 44149)) (44200 46532 (IPF 44210 . 45004) (IPFSIZES 45006 . 46530)) (46533 +54653 (PEF 46543 . 49912) (AEF 49914 . 50637) (IEF 50639 . 51341) (MEF 51343 . 52043) (CEF 52045 . +52749) (FEF 52751 . 53669) (DEF 53671 . 54373) (EFCLOSE 54375 . 54651)) (54654 58201 (SHOWCHARS 54664 + . 56694) (CSSOURCE 56696 . 57409) (FONTDEFFONTS 57411 . 58199))))) +STOP diff --git a/library/IMPORTFONTS.LCOM b/library/IMPORTFONTS.LCOM new file mode 100644 index 000000000..91ebfacda Binary files /dev/null and b/library/IMPORTFONTS.LCOM differ diff --git a/library/IMPORTFONTS.TEDIT b/library/IMPORTFONTS.TEDIT new file mode 100644 index 000000000..59b6c0480 Binary files /dev/null and b/library/IMPORTFONTS.TEDIT differ diff --git a/library/POSTSCRIPTSTREAM b/library/POSTSCRIPTSTREAM index c715c964f..39b40a82e 100644 --- a/library/POSTSCRIPTSTREAM +++ b/library/POSTSCRIPTSTREAM @@ -1,13 +1,12 @@ -(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10) +(DEFINE-FILE-INFO :PACKAGE "INTERLISP" :READTABLE "INTERLISP" :BASE 10) -(FILECREATED "12-Feb-2026 12:19:03" {DSK}matt>Interlisp>medley>library>POSTSCRIPTSTREAM.;6 258522 +(FILECREATED "26-Apr-2026 11:39:26" {MEDLEY}POSTSCRIPTSTREAM.;71 258340 - :EDIT-BY "mth" + :EDIT-BY rmk - :CHANGES-TO (FNS PSCFONT.READFONT) + :CHANGES-TO (VARS POSTSCRIPTSTREAMCOMS) - :PREVIOUS-DATE "27-Jan-2026 17:57:49" -{DSK}matt>Interlisp>medley>library>POSTSCRIPTSTREAM.;5) + :PREVIOUS-DATE "17-Mar-2026 20:19:19" {MEDLEY}POSTSCRIPTSTREAM.;67) (PRETTYCOMPRINT POSTSCRIPTSTREAMCOMS) @@ -136,10 +135,7 @@ (POSTSCRIPT.TEXTFILE.LANDSCAPE NIL) (POSTSCRIPT.DEFAULT.PAGEREGION '(4800 4800 52800 70800)) (POSTSCRIPT.TEXTURE.SCALE 4) - [POSTSCRIPTFONTDIRECTORIES (LIST (COND ((EQ (MACHINETYPE) - 'MAIKO) - "{dsk}/USR/LOCAL/LDE/FONTS/POSTSCRIPT/") - (T "{DSK}POSTSCRIPT>"] + (POSTSCRIPTFONTDIRECTORIES (LIST "{MEDLEY}/fonts/postscriptfonts")) (POSTSCRIPTFONTEXTENSIONS '(PSCFONT PF PSC)) [POSTSCRIPTFONTCOERCIONS '((HELVETICA (HELVETICA 1)) (HELVETICAD (HELVETICA 1)) @@ -878,7 +874,8 @@ FONTID]) (POSTSCRIPT.FONTCREATE - [LAMBDA (FONTSPEC) (* ; "Edited 13-Oct-2025 18:04 by rmk") + [LAMBDA (FONTSPEC) (* ; "Edited 17-Mar-2026 16:29 by rmk") + (* ; "Edited 13-Oct-2025 18:04 by rmk") (* ; "Edited 7-Sep-2025 23:44 by rmk") (* ; "Edited 30-Aug-2025 23:24 by rmk") (* ; "Edited 21-Aug-2025 18:21 by rmk") @@ -998,10 +995,12 @@ (COND ((AND TMP (NEQ FAMILY (CAR TMP))) - (replace FONTDEVICESPEC of FD with (LIST (CAR TMP) - SIZE - (COPY FACE) - 0 DEVICE] + (replace FONTDEVICESPEC of FD with (create FONTSPEC + FSFAMILY _ (CAR TMP) + FSSIZE _ SIZE + FSFACE _ (COPY FACE) + FSROTATION _ 0 + FSDEVICE _ DEVICE] [LET ((SYMWIDTHS (\POSTSCRIPT.SPECIALFONT.SCALEDWIDTHS 'SYMBOL FD ROTATION DEVICE) ) (DINGWIDTHS (\POSTSCRIPT.SPECIALFONT.SCALEDWIDTHS 'ZAPFDINGBATS FD ROTATION @@ -4298,10 +4297,7 @@ (RPAQ? POSTSCRIPT.TEXTURE.SCALE 4) -(RPAQ? POSTSCRIPTFONTDIRECTORIES (LIST (COND ((EQ (MACHINETYPE) - 'MAIKO) - "{dsk}/USR/LOCAL/LDE/FONTS/POSTSCRIPT/") - (T "{DSK}POSTSCRIPT>")))) +(RPAQ? POSTSCRIPTFONTDIRECTORIES (LIST "{MEDLEY}/fonts/postscriptfonts")) (RPAQ? POSTSCRIPTFONTEXTENSIONS '(PSCFONT PF PSC)) @@ -4393,37 +4389,37 @@ (ADDTOVAR LAMA POSTSCRIPT.PUTCOMMAND) ) (DECLARE%: DONTCOPY - (FILEMAP (NIL (22366 32685 (POSTSCRIPT.INIT 22376 . 29291) (POSTSCRIPT.PUTRGBCOLOR 29293 . 30315) ( -\PSC.COLOR.TO.RGB 30317 . 32683)) (33671 69196 (PSCFONT.READFONT 33681 . 35692) (PSCFONT.SPELLFILE -35694 . 36507) (PSCFONT.COERCEFILE 36509 . 38081) (PSCFONTFROMCACHE.SPELLFILE 38083 . 39068) ( -PSCFONTFROMCACHE.COERCEFILE 39070 . 40722) (PSCFONT.WRITEFONT 40724 . 41739) (READ-AFM-FILE 41741 . -47612) (CONVERT-AFM-FILES 47614 . 48826) (POSTSCRIPT.GETFONTID 48828 . 50223) (POSTSCRIPT.FONTCREATE -50225 . 63119) (\POSTSCRIPT.SPECIALFONT.SCALEDWIDTHS 63121 . 65518) (POSTSCRIPT.FONTSAVAILABLE 65520 - . 67807) (POSTSCRIPT.FONTEXISTS? 67809 . 69194)) (69197 79106 (OPENPOSTSCRIPTSTREAM 69207 . 78772) ( -CLOSEPOSTSCRIPTSTREAM 78774 . 79104)) (79151 85477 (POSTSCRIPT.HARDCOPYW 79161 . 82268) ( -POSTSCRIPT.TEDIT 82270 . 82722) (POSTSCRIPTFILEP 82724 . 84212) (MAKEEPSFILE 84214 . 85475)) (85478 -129222 (POSTSCRIPT.BITMAPSCALE 85488 . 87944) (POSTSCRIPT.CLOSESTRING 87946 . 88499) ( -POSTSCRIPT.ENDPAGE 88501 . 89392) (POSTSCRIPT.OUTSTR 89394 . 90611) (POSTSCRIPT.PUTBITMAPBYTES 90613 - . 99084) (POSTSCRIPT.PUTCOMMAND 99086 . 100075) (POSTSCRIPT.SET-FAKE-LANDSCAPE 100077 . 104597) ( -POSTSCRIPT.SHOWACCUM 104599 . 106754) (POSTSCRIPT.STARTPAGE 106756 . 109458) (\POSTSCRIPTTAB 109460 . -110257) (\PS.BOUTFIXP 110259 . 111539) (\PS.SCALEHACK 111541 . 114184) (\PS.SCALEREGION 114186 . -114746) (\SCALEDBITBLT.PSC 114748 . 119058) (\SETPOS.PSC 119060 . 119541) (\SETXFORM.PSC 119543 . -122127) (\STRINGWIDTH.PSC 122129 . 122602) (\SWITCHFONTS.PSC 122604 . 128096) (\TERPRI.PSC 128098 . -129220)) (129257 183113 (\BITBLT.PSC 129267 . 129819) (\BLTSHADE.PSC 129821 . 134482) (\CHARWIDTH.PSC -134484 . 134991) (\CREATECHARSET.PSC 134993 . 136349) (\DRAWARC.PSC 136351 . 138729) (\DRAWCIRCLE.PSC -138731 . 140982) (\DRAWCURVE.PSC 140984 . 144828) (\DRAWELLIPSE.PSC 144830 . 147194) (\DRAWLINE.PSC -147196 . 149936) (\DRAWPOINT.PSC 149938 . 150514) (\DRAWPOLYGON.PSC 150516 . 153645) ( -\DSPBOTTOMMARGIN.PSC 153647 . 154334) (\DSPCLIPPINGREGION.PSC 154336 . 155711) (\DSPCOLOR.PSC 155713 - . 156644) (\DSPFONT.PSC 156646 . 160283) (\DSPLEFTMARGIN.PSC 160285 . 160971) (\DSPLINEFEED.PSC -160973 . 161563) (\DSPPUSHSTATE.PSC 161565 . 163025) (\DSPPOPSTATE.PSC 163027 . 166512) (\DSPRESET.PSC - 166514 . 167179) (\DSPRIGHTMARGIN.PSC 167181 . 167870) (\DSPROTATE.PSC 167872 . 168871) ( -\DSPSCALE.PSC 168873 . 169825) (\DSPSCALE2.PSC 169827 . 170667) (\DSPSPACEFACTOR.PSC 170669 . 171590) -(\DSPTOPMARGIN.PSC 171592 . 172163) (\DSPTRANSLATE.PSC 172165 . 174196) (\DSPXPOSITION.PSC 174198 . -174762) (\DSPYPOSITION.PSC 174764 . 175355) (\FILLCIRCLE.PSC 175357 . 177582) (\FILLPOLYGON.PSC 177584 - . 180821) (\FIXLINELENGTH.PSC 180823 . 182142) (\MOVETO.PSC 182144 . 182914) (\NEWPAGE.PSC 182916 . -183111)) (183169 205315 (\POSTSCRIPT.CHANGECHARSET 183179 . 183897) (\POSTSCRIPT.OUTCHARFN 183899 . -196169) (\POSTSCRIPT.PRINTSLUG 196171 . 197895) (\POSTSCRIPT.SPECIALOUTCHARFN 197897 . 200248) ( -\UPDATE.PSC 200250 . 201496) (\POSTSCRIPT.ACCENTFN 201498 . 202440) (\POSTSCRIPT.ACCENTPAIR 202442 . -205313)) (205413 207058 (\PSC.SPACEDISP 205423 . 205702) (\PSC.SPACEWID 205704 . 206323) (\PSC.SYMBOLS - 206325 . 207056)) (207167 210158 (\POSTSCRIPT.NSHASH 207177 . 210156))))) + (FILEMAP (NIL (22081 32400 (POSTSCRIPT.INIT 22091 . 29006) (POSTSCRIPT.PUTRGBCOLOR 29008 . 30030) ( +\PSC.COLOR.TO.RGB 30032 . 32398)) (33386 69231 (PSCFONT.READFONT 33396 . 35407) (PSCFONT.SPELLFILE +35409 . 36222) (PSCFONT.COERCEFILE 36224 . 37796) (PSCFONTFROMCACHE.SPELLFILE 37798 . 38783) ( +PSCFONTFROMCACHE.COERCEFILE 38785 . 40437) (PSCFONT.WRITEFONT 40439 . 41454) (READ-AFM-FILE 41456 . +47327) (CONVERT-AFM-FILES 47329 . 48541) (POSTSCRIPT.GETFONTID 48543 . 49938) (POSTSCRIPT.FONTCREATE +49940 . 63154) (\POSTSCRIPT.SPECIALFONT.SCALEDWIDTHS 63156 . 65553) (POSTSCRIPT.FONTSAVAILABLE 65555 + . 67842) (POSTSCRIPT.FONTEXISTS? 67844 . 69229)) (69232 79141 (OPENPOSTSCRIPTSTREAM 69242 . 78807) ( +CLOSEPOSTSCRIPTSTREAM 78809 . 79139)) (79186 85512 (POSTSCRIPT.HARDCOPYW 79196 . 82303) ( +POSTSCRIPT.TEDIT 82305 . 82757) (POSTSCRIPTFILEP 82759 . 84247) (MAKEEPSFILE 84249 . 85510)) (85513 +129257 (POSTSCRIPT.BITMAPSCALE 85523 . 87979) (POSTSCRIPT.CLOSESTRING 87981 . 88534) ( +POSTSCRIPT.ENDPAGE 88536 . 89427) (POSTSCRIPT.OUTSTR 89429 . 90646) (POSTSCRIPT.PUTBITMAPBYTES 90648 + . 99119) (POSTSCRIPT.PUTCOMMAND 99121 . 100110) (POSTSCRIPT.SET-FAKE-LANDSCAPE 100112 . 104632) ( +POSTSCRIPT.SHOWACCUM 104634 . 106789) (POSTSCRIPT.STARTPAGE 106791 . 109493) (\POSTSCRIPTTAB 109495 . +110292) (\PS.BOUTFIXP 110294 . 111574) (\PS.SCALEHACK 111576 . 114219) (\PS.SCALEREGION 114221 . +114781) (\SCALEDBITBLT.PSC 114783 . 119093) (\SETPOS.PSC 119095 . 119576) (\SETXFORM.PSC 119578 . +122162) (\STRINGWIDTH.PSC 122164 . 122637) (\SWITCHFONTS.PSC 122639 . 128131) (\TERPRI.PSC 128133 . +129255)) (129292 183148 (\BITBLT.PSC 129302 . 129854) (\BLTSHADE.PSC 129856 . 134517) (\CHARWIDTH.PSC +134519 . 135026) (\CREATECHARSET.PSC 135028 . 136384) (\DRAWARC.PSC 136386 . 138764) (\DRAWCIRCLE.PSC +138766 . 141017) (\DRAWCURVE.PSC 141019 . 144863) (\DRAWELLIPSE.PSC 144865 . 147229) (\DRAWLINE.PSC +147231 . 149971) (\DRAWPOINT.PSC 149973 . 150549) (\DRAWPOLYGON.PSC 150551 . 153680) ( +\DSPBOTTOMMARGIN.PSC 153682 . 154369) (\DSPCLIPPINGREGION.PSC 154371 . 155746) (\DSPCOLOR.PSC 155748 + . 156679) (\DSPFONT.PSC 156681 . 160318) (\DSPLEFTMARGIN.PSC 160320 . 161006) (\DSPLINEFEED.PSC +161008 . 161598) (\DSPPUSHSTATE.PSC 161600 . 163060) (\DSPPOPSTATE.PSC 163062 . 166547) (\DSPRESET.PSC + 166549 . 167214) (\DSPRIGHTMARGIN.PSC 167216 . 167905) (\DSPROTATE.PSC 167907 . 168906) ( +\DSPSCALE.PSC 168908 . 169860) (\DSPSCALE2.PSC 169862 . 170702) (\DSPSPACEFACTOR.PSC 170704 . 171625) +(\DSPTOPMARGIN.PSC 171627 . 172198) (\DSPTRANSLATE.PSC 172200 . 174231) (\DSPXPOSITION.PSC 174233 . +174797) (\DSPYPOSITION.PSC 174799 . 175390) (\FILLCIRCLE.PSC 175392 . 177617) (\FILLPOLYGON.PSC 177619 + . 180856) (\FIXLINELENGTH.PSC 180858 . 182177) (\MOVETO.PSC 182179 . 182949) (\NEWPAGE.PSC 182951 . +183146)) (183204 205350 (\POSTSCRIPT.CHANGECHARSET 183214 . 183932) (\POSTSCRIPT.OUTCHARFN 183934 . +196204) (\POSTSCRIPT.PRINTSLUG 196206 . 197930) (\POSTSCRIPT.SPECIALOUTCHARFN 197932 . 200283) ( +\UPDATE.PSC 200285 . 201531) (\POSTSCRIPT.ACCENTFN 201533 . 202475) (\POSTSCRIPT.ACCENTPAIR 202477 . +205348)) (205448 207093 (\PSC.SPACEDISP 205458 . 205737) (\PSC.SPACEWID 205739 . 206358) (\PSC.SYMBOLS + 206360 . 207091)) (207202 210193 (\POSTSCRIPT.NSHASH 207212 . 210191))))) STOP diff --git a/library/POSTSCRIPTSTREAM.LCOM b/library/POSTSCRIPTSTREAM.LCOM index 1778b1df4..fd5b03f9a 100644 Binary files a/library/POSTSCRIPTSTREAM.LCOM and b/library/POSTSCRIPTSTREAM.LCOM differ diff --git a/library/PSEUDOHOSTS b/library/PSEUDOHOSTS index a563e43b0..5cfb61c60 100644 --- a/library/PSEUDOHOSTS +++ b/library/PSEUDOHOSTS @@ -1,10 +1,12 @@ -(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10) +(DEFINE-FILE-INFO :PACKAGE "INTERLISP" :READTABLE "INTERLISP" :BASE 10) -(FILECREATED "16-May-2025 12:07:44" {DSK}frank>il>qmedley>library>PSEUDOHOSTS.;2 31408 +(FILECREATED "28-Apr-2026 08:31:30" {WMEDLEY}PSEUDOHOSTS.;191 30987 - :CHANGES-TO (FNS PSEUDOHOSTS) + :EDIT-BY rmk - :PREVIOUS-DATE "31-Dec-2024 11:45:23" {DSK}frank>il>qmedley>library>PSEUDOHOSTS.;1) + :CHANGES-TO (FNS PSEUDOHOST) + + :PREVIOUS-DATE "27-Apr-2026 22:55:50" {MEDLEY}PSEUDOHOSTS.;190) (PRETTYCOMPRINT PSEUDOHOSTSCOMS) @@ -13,22 +15,19 @@ ( (* ;; "Public entries") - (FNS PSEUDOHOST PSEUDOHOSTP PSEUDOHOSTS TARGETHOST TRUEDEVICE TRUEFILENAME PSEUDOFILENAME) + (FNS PSEUDOHOST PSEUDOHOSTP PSEUDOHOSTS TARGETHOST TRUEDEVICE TRUEFILENAME PSEUDOFILENAME + PSEUDOFILENAMES) + (FNS CDPSEUDO) (* ;; "Internals") (FNS EXPAND.PH CONTRACT.PH UNSLASHIT GETHOSTINFO.PH) - (FNS CDPSEUDO) (FNS OPENFILE.PH GETFILENAME.PH DIRECTORYNAMEP.PH CLOSEFILE.PH REOPENFILE.PH DELETEFILE.PH - OPENP.PH UNREGISTERFILE.PH REGISTERFILE.PH GENERATEFILES.PH GETFILEINFO.PH - SETFILEINFO.PH NEXTFILEFN.PH FILEINFOFN.PH RENAMEFILE.PH) - (DECLARE%: DONTEVAL@LOAD DOCOPY (P (PSEUDOHOST 'LI LOGINHOST/DIR))) + GENERATEFILES.PH GETFILEINFO.PH SETFILEINFO.PH NEXTFILEFN.PH FILEINFOFN.PH) (P (MOVD? 'GETHOSTINFO 'GETHOSTINFO.ORIG) (MOVD 'GETHOSTINFO.PH 'GETHOSTINFO)) (DECLARE%: EVAL@COMPILE DONTCOPY (RECORDS PHDEVICE PHGENFILESTATE TARGETDEVICE) - (MACROS PSEUDOHOST.NAME PSEUDOHOST.TARGETVAL) - (FILES (FROM LOADUPS) - EXPORTS.ALL)))) + (MACROS PSEUDOHOST.NAME PSEUDOHOST.TARGETVAL)))) @@ -37,7 +36,15 @@ (DEFINEQ (PSEUDOHOST - [LAMBDA (HOST PREFIX) + [LAMBDA (HOST PREFIX CDSUFFIX NOERROR) + + (* ;; "Edited 28-Apr-2026 08:31 by rmk") + + (* ;; "Edited 25-Apr-2026 15:51 by rmk") + + (* ;; "Edited 2-Feb-2025 10:05 by rmk") + + (* ;; "Edited 30-Jan-2025 23:32 by rmk") (* ;; "Edited 2-Nov-2023 10:53 by rmk") @@ -58,12 +65,14 @@ (CHARCODE })) (SETQ HOST (SUBSTRING HOST 1 -2))) (SETQ HOST (U-CASE (MKATOM HOST))) - [if PREFIX - then (SETQ PREFIX (TRUEFILENAME PREFIX)) + (if PREFIX + then (CL:UNLESS (SETQ PREFIX (TRUEFILENAME PREFIX NOERROR)) + (RETFROM (FUNCTION PSEUDOHOST) + NIL)) (CL:WHEN (PSEUDOHOSTP HOST) (* ;  "Redefining: first clear out the previous one") (PSEUDOHOST HOST NIL)) - [LET (TARGETHOST TARGETDEVICE PREFIXHOST) + [LET (TARGETHOST TARGETDEVICE PREFIXHOST PHDEV) (CL:UNLESS [SETQ PREFIXHOST (U-CASE (FILENAMEFIELD PREFIX 'HOST] (SETQ PREFIX (UNSLASHIT (PACKFILENAME 'HOST (SETQ PREFIXHOST 'DSK) 'BODY PREFIX)))) @@ -86,6 +95,8 @@ (UNIX (SETQ PREFIX (SLASHIT PREFIX))) NIL) (SETQ TARGETDEVICE (OR (\GETDEVICEFROMHOSTNAME TARGETHOST) + (AND NOERROR (RETFROM (FUNCTION PSEUDOHOST) + NIL)) (ERROR "UNKNOWN TARGET HOST" TARGETHOST))) (* ;; "Save the last directory marker to pack on if needed.") @@ -104,38 +115,52 @@ REGISTERFILE _ (FUNCTION \ADD-OPEN-STREAM) GENERATEFILES _ (FUNCTION GENERATEFILES.PH) GETFILEINFO _ (FUNCTION GETFILEINFO.PH) - SETFILEINFO _ (FUNCTION SETFILEINFO.PH) - RENAMEFILE _ (FUNCTION RENAMEFILE.PH))) - - (* ;; "The ultimate target device keeps a map of prefixes and the hostnames they map to. The longest matching prefix is chosen when a name that expands to the target device is contracted.") - - (change (fetch (TARGETDEVICE PREFIXMAP) OF TARGETDEVICE) - (SORT (CONS (LIST PREFIX HOST (CL:IF (EQ (CHARCODE /) - (NTHCHARCODE PREFIX -1)) - '/ - '<)) - DATUM) - (FUNCTION (LAMBDA (P1 P2) - (IGREATERP (NCHARS (CAR P1)) - (NCHARS (CAR P2] - elseif (SETQ PREFIX (CADR (PSEUDOHOSTP HOST))) + SETFILEINFO _ (FUNCTION SETFILEINFO.PH))) + + (* ;; "The ultimate target device keeps a map of prefixes and the hostnames they map to. If a PHOST preference isn't provided and two prefixes have common initial substrings, choose the one that provides the smallest file name. ") + + (UNINTERRUPTABLY + [change (fetch (TARGETDEVICE PREFIXMAPS) OF TARGETDEVICE) + (SORT (CONS (LIST HOST PREFIX (CL:IF (EQ (CHARCODE /) + (NTHCHARCODE PREFIX -1)) + '/ + '<)) + DATUM) + (FUNCTION (LAMBDA (P1 P2) + + (* ;; "To give smallest file names, longest prefix comes first. If same length (synonyms), the one with the smallest host comes first. So MEDLEY before WMEDLEY") + + (if (IGREATERP (NCHARS (CADR P1)) + (NCHARS (CADR P2))) + elseif (EQ (NCHARS (CADR P1)) + (NCHARS (CADR P2))) + then (ILESSP (NCHARS (CAR P1)) + (NCHARS (CAR P2])] + elseif (PSEUDOHOSTP HOST) then (* ;; "\DEFINEDEVICE removes the name-mapping but doesn't remove the device. Maybe that's on purpose for other devices, but not here.") (LET* ((PHHOST (\GETDEVICEFROMNAME HOST \FILEDEVICES)) - (TARGETDEV (fetch (PHDEVICE TARGETDEV) OF PHHOST))) + (TARGETDEV (fetch (PHDEVICE TARGETDEV) of PHHOST))) (UNINTERRUPTABLY (CL:WHEN TARGETDEV (* ;  "Don't want to fail uninterruptably") - (CHANGE (FETCH (TARGETDEVICE PREFIXMAP) OF TARGETDEV) - (DREMOVE (ASSOC PREFIX DATUM) + (CHANGE (fetch (TARGETDEVICE PREFIXMAPS) of TARGETDEV) + (DREMOVE (ASSOC HOST DATUM) DATUM))) (SETQ \FILEDEVICES (DREMOVE PHHOST \FILEDEVICES)) - (\DEFINEDEVICE HOST NIL))] - HOST]) + (\DEFINEDEVICE HOST NIL))) + elseif NOERROR + else (ERROR (CONCAT "PREFIX FOR PSEUDOHOST " HOST " NOT FOUND"))) + (CL:WHEN (AND PREFIX CDSUFFIX) + (CDPSEUDO HOST CDSUFFIX)) + (CL:WHEN PREFIX (* ; + "If no prefix, we didn't get a pseudohost") + HOST)]) (PSEUDOHOSTP - [LAMBDA (HOST) (* ; "Edited 16-Dec-2024 21:15 by rmk") + [LAMBDA (HOST) (* ; "Edited 27-Apr-2026 17:27 by rmk") + (* ; "Edited 16-Dec-2024 21:15 by rmk") (* ; "Edited 24-Feb-2022 23:51 by rmk") (* ; "Edited 18-Jan-2022 11:29 by rmk") (LET [(DEV (if (type? FDEV HOST) @@ -144,37 +169,14 @@ then (fetch (STREAM DEVICE) of HOST) else (\GETDEVICEFROMNAME HOST T T] (CL:WHEN (AND DEV (type? FDEV (fetch (PHDEVICE TARGETDEV) OF DEV))) - (LIST (FETCH (FDEV DEVICENAME) OF DEV) - (FETCH (PHDEVICE PREFIX) - DEV)))]) + (LIST (fetch (FDEV DEVICENAME) of DEV) + (fetch (PHDEVICE PREFIX) of DEV)))]) (PSEUDOHOSTS - [LAMBDA (NEW.HOSTS) (* ; "Edited 17-Jan-2022 18:15 by rmk") - (* ; "Edited 16-May-2025 9:16 by fgh") - - (* ;; "") - - (* ;; " Returns existing list of PSEUDOHOST pairs. If NEW.HOSTS is T, all current pseudohosts are removed by calling (PSEUDOHOST HOST NIL) on each current pseudohost in turn. Otherwise, NEW.HOSTS should be a list of (HOST PREFIX) pairs and all current pseudohosts are r(PSEUDOHOSTSemoved (as above) and the NEW.HOSTS pairs are used to create new pseudohosts by calling (PSEUDOHOST HOST PREFIX) sequentially in reverse order of the NEW.HOSTS list. Reverse order to ensure that (PSEUDOHOSTS (PSEUDOHOSTS)) doesn't impact the ordering in the PSEUDOHOST list. This function is designed to be used cleanly with RESETSAVE.") - - (* ;; "") - - (LET [(CURRENT.HOSTS (for DEV in \FILEDEVICES when (type? FDEV (fetch (PHDEVICE TARGETDEV) - of DEV)) - collect (LIST (fetch (FDEV DEVICENAME) of DEV) - (fetch (PHDEVICE PREFIX) of DEV] - [COND - ((EQ NEW.HOSTS T) - (for HOST in CURRENT.HOSTS do (PSEUDOHOST (CAR HOST) - NIL))) - [[AND (LISTP NEW.HOSTS) - (for HOST in NEW.HOSTS always (AND (LISTP HOST) - (NOT (CDDR HOST] - (for HOST in CURRENT.HOSTS do (PSEUDOHOST (CAR HOST) - NIL)) - (for HOST in (REVERSE NEW.HOSTS) do (PSEUDOHOST (CAR HOST) - (CADR HOST] - (NEW.HOSTS (ERROR (CONCAT "PSEUDOHOSTS: Argument not valid:" NEW.HOSTS] - CURRENT.HOSTS]) + [LAMBDA NIL (* ; "Edited 17-Jan-2022 18:15 by rmk") + (FOR DEV IN \FILEDEVICES WHEN (TYPE? FDEV (FETCH (PHDEVICE TARGETDEV) OF DEV)) + COLLECT (LIST (FETCH (FDEV DEVICENAME) OF DEV) + (FETCH (PHDEVICE PREFIX) OF DEV]) (TARGETHOST [LAMBDA (HOST) (* ; "Edited 14-Dec-2024 15:26 by rmk") @@ -203,7 +205,8 @@ else DEV]) (TRUEFILENAME - [LAMBDA (FILE) (* ; "Edited 1-Oct-2023 20:16 by rmk") + [LAMBDA (FILE NOERROR) (* ; "Edited 2-Feb-2025 09:12 by rmk") + (* ; "Edited 1-Oct-2023 20:16 by rmk") (* ; "Edited 26-Jul-2023 07:53 by rmk") (* ; "Edited 26-Jan-2022 23:33 by rmk") (* ; "Edited 25-Jan-2022 08:47 by rmk") @@ -215,22 +218,60 @@ FILE)) (SETQ DEVICE (FETCH (STREAM DEVICE) OF FILE)) ELSE (SETQ FILENAME (\ADD.CONNECTED.DIR FILE)) - (SETQ DEVICE (\GETDEVICEFROMNAME FILENAME))) - (CL:IF (TYPE? PHDEVICE DEVICE) - (EXPAND.PH FILENAME DEVICE) - FILENAME)]) + (SETQ DEVICE (\GETDEVICEFROMNAME FILENAME NOERROR))) + (CL:WHEN DEVICE + (CL:IF (TYPE? PHDEVICE DEVICE) + (EXPAND.PH FILENAME DEVICE) + FILENAME))]) (PSEUDOFILENAME - [LAMBDA (FILE) (* ; "Edited 26-Jul-2023 12:34 by rmk") + [LAMBDA (FILE PHOST) (* ; "Edited 27-Apr-2026 18:50 by rmk") + (* ; "Edited 26-Apr-2026 09:00 by rmk: If PHOST is non-NIL and a pseudohost, that's the one that the caller wants.") + (* ; "Edited 24-Apr-2026 22:52 by rmk") + (* ; "Edited 26-Jul-2023 12:34 by rmk") (* ; "Edited 29-Jan-2022 23:08 by rmk") (* ; "Edited 28-Jan-2022 09:06 by rmk") (if (LISTP FILE) - then (for F in FILE collect (PSEUDOFILENAME F)) - else (FOR D PN (FILENAME _ (IF (STREAMP FILE) - THEN (FETCH (STREAM FULLFILENAME) OF FILE) - ELSE (\ADD.CONNECTED.DIR FILE))) IN \FILEDEVICES - WHEN (TYPE? PHDEVICE D) UNLESS (EQ FILENAME (SETQ PN (CONTRACT.PH FILENAME D))) - DO (RETURN PN) FINALLY (RETURN FILENAME]) + then (for F in FILE collect (PSEUDOFILENAME F PHOST)) + else (for D PN (FILENAME _ (if (STREAMP FILE) + then (fetch (STREAM FULLFILENAME) of FILE) + else (\ADD.CONNECTED.DIR FILE))) in \FILEDEVICES + when (type? PHDEVICE D) when (OR (NULL PHOST) + (EQ PHOST (fetch (FDEV DEVICENAME) of D))) + unless (EQ FILENAME (SETQ PN (CONTRACT.PH FILENAME D PHOST))) do (RETURN PN) + finally (RETURN FILENAME]) + +(PSEUDOFILENAMES + [LAMBDA (FILE) (* ; "Edited 27-Apr-2026 19:23 by rmk") + (* ; + "Edited 27-Apr-2026 10:00 by rmk; Edited 27-Apr-2026 09:33 by rmk") + + (* ;; "Shows all the pseudohost synonyms for FILE (including its truename)") + + (for D PN (TRUENAME _ (TRUEFILENAME FILE)) in \FILEDEVICES when (type? PHDEVICE D) + unless [EQ TRUENAME (SETQ PN (PSEUDOFILENAME TRUENAME (fetch (FDEV DEVICENAME) of D] + collect PN finally (RETURN (CONS TRUENAME $$VAL]) +) +(DEFINEQ + +(CDPSEUDO + [LAMBDA (PHOST CDSUFFIX FILEPKGFLG) (* ; "Edited 27-Apr-2026 22:54 by rmk") + (* ; "Edited 25-Apr-2026 23:53 by rmk") + (* ; "Edited 21-Dec-2024 13:48 by rmk") + (* ; "Edited 6-Feb-2024 15:50 by rmk") + + (* ;; "Makes a cd command for PHOST. The command name is %"cd%" followed by the lower-case letters of CDSUFFIX (e.g. cdf for PHOST FOO and CDSUFFIX %"f%".") + + (* ;; "Does not notify FILEPKG unless FILEPKGFLG") + + (DECLARE (SPECVARS FILEPKGFLG)) + (CL:WHEN (AND (SETQ PHOST (CAR (PSEUDOHOSTP PHOST))) + CDSUFFIX) + [LET [(CNAME (CONCAT "cd" (L-CASE CDSUFFIX] + (SETQ PHOST (CONCAT "{" PHOST "}")) + (EVAL `(DEFCOMMAND ,CNAME (SUBDIR) (/CNDIR (CL:IF SUBDIR + (CONCAT ,PHOST "/" SUBDIR) + ,PHOST)))])]) ) @@ -242,67 +283,76 @@ (EXPAND.PH [LAMBDA (FILENAME PHDEV) - (* ;; "Edited 25-Apr-2022 09:35 by rmk: that FILENAME contains }, because HOST was identified in it. If FILENAME is a stream, expand its full name") + (* ;; "Edited 27-Apr-2026 17:27 by rmk") + + (* ;; "Edited 25-Apr-2022 09:35 by rmk: that FILENAME contains }, because HOST was identified in it. If FILENAME is a stream, expand to its true name") (* ;; "Assumes that FILENAME contains }, because HOST was identified in it. If FILENAME is a stream, expand its full name") - [IF (TYPE? STREAM FILENAME) - THEN (CL:UNLESS PHDEV - (SETQ PHDEV (FETCH (STREAM DEVICE) OF FILENAME))) - (SETQ FILENAME (FETCH (STREAM FULLNAME) OF FILENAME)) - ELSEIF (NOT (TYPE? FDEV PHDEV)) - THEN (SETQ PHDEV (\GETDEVICEFROMNAME (OR PHDEV FILENAME] - (IF (TYPE? PHDEVICE PHDEV) - THEN (LET (SUFFIX SUFFIXPOS) + [if (type? STREAM FILENAME) + then (CL:UNLESS PHDEV + (SETQ PHDEV (fetch (STREAM DEVICE) of FILENAME))) + (SETQ FILENAME (fetch (STREAM FULLNAME) of FILENAME)) + elseif (NOT (type? FDEV PHDEV)) + then (SETQ PHDEV (\GETDEVICEFROMNAME (OR PHDEV FILENAME] + (if (type? PHDEVICE PHDEV) + then (LET (SUFFIX SUFFIXPOS) (CL:WHEN (SETQ SUFFIXPOS (STRPOS "}" FILENAME)) (SETQ SUFFIX (OR (SUBSTRING FILENAME (ADD1 SUFFIXPOS)) "")) (CL:WHEN (FMEMB (CHCON1 SUFFIX) (CHARCODE (< > /))) (SETQ SUFFIX (SUBSTRING SUFFIX 2))) - (CONCAT (FETCH (PHDEVICE PREFIX) OF PHDEV) + (CONCAT (fetch (PHDEVICE PREFIX) of PHDEV) SUFFIX))) - ELSE FILENAME]) + else FILENAME]) (CONTRACT.PH - [LAMBDA (NAME PHDEV) + [LAMBDA (TRUENAME PHDEV PHOST) - (* ;; "Edited 22-Sep-2023 14:30 by rmk") + (* ;; "Edited 27-Apr-2026 18:43 by rmk") - (* ;; "Edited 30-Jan-2022 00:20 by rmk: the smallest pseudoname for NAME. If the NAME was constructed by expanding, then") + (* ;; "Edited 26-Apr-2026 10:31 by rmk") - (* ;; "Finds the smallest pseudoname for NAME. The PHDEV is used only to find its targetdev, that's where we scan for matching prefixes. This is so we can find the lowest matching pseudohost in the target's prefix map. If the hosts are defined as {DSK}...{H1}...{H2}, DSK knows the prefixes that lead to H1 and H2, picks the longest matching prefix and replaces it by the corresponding host.") + (* ;; "Edited 22-Sep-2023 14:30 by rmk") - (* ;; "If pseudohosts are defined in terms of other pseudohosts (e.g. FUM is defined in terms of FOO which is defined in terms of LI which is rooted in DSK, then the pseudodevices presumably were created in that order, so the first name we encounter will be the one with the longest prefix. So {DSK}... might collapse to {FUM}. But {FOO}... will not. ") + (* ;; "Finds the preferred pseudoname for TRUENAME, the name on PHOST if given, else the shortest one. The PHDEV is used only to find its targetdev, that's where we scan for matching prefixes. This replaces the chosen prefix of TRUENAME with the corresponding pseudohost.") - (CL:UNLESS (TYPE? FDEV PHDEV) - (SETQ PHDEV (\GETDEVICEFROMNAME PHDEV))) - (CL:WHEN NAME - (FOR PM PREFIX SUFFIX CONNECTOR IN (FETCH (TARGETDEVICE PREFIXMAP) OF (FETCH (PHDEVICE - TARGETDEV - ) - OF PHDEV)) - WHEN (STRPOS (SETQ PREFIX (CAR PM)) - NAME 1 NIL T NIL FILEDIRCASEARRAY) - DO - (* ;; "This is the lowest host. ") + (CL:WHEN TRUENAME + (CL:UNLESS (type? FDEV PHDEV) + (SETQ PHDEV (\GETDEVICEFROMNAME PHDEV))) + (CL:WHEN (EQ PHOST T) + (SETQ PHOST (fetch (FDEV DEVICENAME) of PHDEV))) + (LET ((PREFIXMAPS (fetch (TARGETDEVICE PREFIXMAPS) of (fetch (PHDEVICE TARGETDEV) + of PHDEV))) + PREFIXMNAP SUFFIX CONNECTOR) - [SETQ SUFFIX (SUBSTRING NAME (ADD1 (NCHARS PREFIX] - (CL:WHEN (STRPOS ">" SUFFIX 1 NIL NIL NIL FILEDIRCASEARRAY) + (* ;; + "PREFIXMAPs of PHDEVare sorted so that the longest one comes first, if PHOST isn't specified") - (* ;; "CONNECTOR tells us whether to use / or > depending on what the prefix has") + (SETQ PREFIXMAP (find PM in PREFIXMAPS when (OR (NULL PHOST) + (EQ PHOST (CAR PM))) + suchthat (STRPOS (CADR PM) + TRUENAME 1 NIL T NIL FILEDIRCASEARRAY))) - (SETQ CONNECTOR (CADDR PM)) - [SETQ SUFFIX (CONCAT CONNECTOR (IF (EQ CONNECTOR '/) - THEN (SLASHIT SUFFIX) - ELSE (UNSLASHIT SUFFIX]) - (RETURN (PACK* '{ (CADR PM) - "}" - (OR SUFFIX ""))) FINALLY + (* ;; "If we didn't find a prefix map, TRUENAME was not related to any pseudohost descending from the target, it is a pure target name, presumably because something like a relative .. reference took it off all paths. We return the original name.") - (* ;; "If we didn't match a prefix, then this was not related to any pseudhost descending from the target, it is a pure target name, presumably because something like a relative .. reference took it off all paths. We return the original name.") + (if PREFIXMAP + then (SETQ PREFIX (CADR PREFIXMAP)) + [SETQ SUFFIX (SUBSTRING TRUENAME (ADD1 (NCHARS PREFIX] + (CL:WHEN (STRPOS ">" SUFFIX) - (RETURN NAME)))]) + (* ;; + "CONNECTOR tells us whether to use / or > depending on what the prefix has") + + (SETQ CONNECTOR (CADDR PREFIXMAP)) + [SETQ SUFFIX (CONCAT CONNECTOR (CL:IF (EQ CONNECTOR '/) + (SLASHIT SUFFIX) + (UNSLASHIT SUFFIX))]) + (PACK* '{ (CAR PREFIXMAP) + "}" + (OR SUFFIX "")) + else TRUENAME)))]) (UNSLASHIT [LAMBDA (X LCASEDIRS) (* ; "Edited 26-Jan-2022 15:09 by rmk") @@ -338,37 +388,23 @@ (GETHOSTINFO.PH [LAMBDA (HOST ATTRIBUTE) + (* ;; "Edited 26-Nov-2025 17:26 by rmk") + (* ;; "Edited 24-Apr-2022 14:16 by rmk: the info from the true host") (* ;; "Want the info from the true host") (GETHOSTINFO.ORIG (OR (TARGETHOST HOST) HOST) - HOST ATTRIBUTE]) -) -(DEFINEQ - -(CDPSEUDO - [LAMBDA (PHOST CDSUFFIX FILEPKG) (* ; "Edited 21-Dec-2024 13:48 by rmk") - (* ; "Edited 6-Feb-2024 15:50 by rmk") - - (* ;; "Makes a cd command for PHOST. The command name is %"cd%" followed by the lower-case letters of CDSUFFIX (e.g. cdf for PHOST FOO and CDSUFFIX %"f%".") - - (CL:WHEN (AND (SETQ PHOST (CAR (PSEUDOHOSTP PHOST))) - CDSUFFIX) - [LET ((C (PACK* "cd" (L-CASE CDSUFFIX))) - (FILEPKGFLG FILEPKG)) - (DECLARE (SPECVARS FILEPKGFLG)) - (SETQ PHOST (CONCAT "{" PHOST "}")) - (EVAL `(DEFCOMMAND ,C (SUBDIR) (/CNDIR (CL:IF SUBDIR - (CONCAT ,PHOST "/" SUBDIR) - ,PHOST)))])]) + ATTRIBUTE]) ) (DEFINEQ (OPENFILE.PH [LAMBDA (FILE ACCESS RECOG OTHERINFO FDEV OLDSTRING) + (* ;; "Edited 26-Apr-2026 10:25 by rmk") + (* ;; "Edited 31-Oct-2022 23:32 by rmk") (* ;; "Edited 14-Jul-2022 17:53 by rmk") @@ -379,18 +415,19 @@ (* ;; "Edited 18-Jan-2022 10:29 by rmk") - (LET ((TARGETDEV (FETCH (PHDEVICE TARGETDEV) OF FDEV)) + (LET ((TARGETDEV (fetch (PHDEVICE TARGETDEV) of FDEV)) (STREAM (PSEUDOHOST.TARGETVAL OPENFILE (FILE ACCESS RECOG OTHERINFO FDEV OLDSTRING) FDEV))) (CL:WHEN STREAM (FDEVOP 'UNREGISTERFILE TARGETDEV TARGETDEV STREAM) - (CHANGE (FETCH (STREAM FULLFILENAME) OF STREAM) - (CONTRACT.PH DATUM FDEV)) - (REPLACE (STREAM DEVICE) OF STREAM WITH FDEV)) + (change (fetch (STREAM FULLFILENAME) of STREAM) + (CONTRACT.PH DATUM FDEV T)) + (replace (STREAM DEVICE) of STREAM with FDEV)) STREAM]) (GETFILENAME.PH - [LAMBDA (NAME RECOG FDEV) (* ; "Edited 25-Jan-2022 22:56 by rmk") + [LAMBDA (NAME RECOG FDEV) (* ; "Edited 25-Apr-2026 16:11 by rmk") + (* ; "Edited 25-Jan-2022 22:56 by rmk") (* ; "Edited 16-Jan-2022 20:27 by rmk") (PSEUDOHOST.NAME GETFILENAME (NAME RECOG FDEV]) @@ -413,52 +450,24 @@ STREAM ABORTFLG]) (REOPENFILE.PH - [LAMBDA (FILE ACCESS RECOG OTHERINFO FDEV OLDSTREAM) (* ; "Edited 25-Jan-2022 12:50 by rmk") + [LAMBDA (FILE ACCESS RECOG OTHERINFO FDEV OLDSTREAM) (* ; "Edited 26-Apr-2026 10:26 by rmk") + (* ; "Edited 25-Jan-2022 12:50 by rmk") (* ; "Edited 18-Jan-2022 11:41 by rmk") (LET ((STREAM (PSEUDOHOST.TARGETVAL REOPENFILE (FILE ACCESS RECOG OTHERINFO FDEV OLDSTREAM) FDEV))) - (CHANGE (FETCH (STREAM FULLFILENAME) OF STREAM) - (CONTRACT.PH DATUM FDEV)) - (REPLACE (STREAM DEVICE) OF STREAM WITH FDEV) + (CHANGE (fetch (STREAM FULLFILENAME) of STREAM) + (CONTRACT.PH DATUM FDEV T)) + (replace (STREAM DEVICE) of STREAM with FDEV) STREAM]) (DELETEFILE.PH - [LAMBDA (FILENAME DEV) (* ; "Edited 25-Jan-2022 22:56 by rmk") - (* ; "Edited 18-Jan-2022 10:23 by rmk") + [LAMBDA (FILENAME DEV) (* ; "Edited 25-Apr-2026 23:41 by rmk") + (* ; "Edited 25-Jan-2022 22:56 by rmk") (PSEUDOHOST.NAME DELETEFILE (FILENAME DEV]) -(OPENP.PH - [LAMBDA (FILENAME ACCESS DEVICE) - - (* ;; "Edited 25-Jun-2022 15:48 by rmk: No longer called. Streams are registered in the pseudohost, not in the target device.") - - (* ;; "Edited 18-Jan-2022 10:29 by rmk") - - (PSEUDOHOST.TARGETVAL OPENP (FILENAME ACCESS DEVICE]) - -(UNREGISTERFILE.PH - [LAMBDA (DEVICE STREAM) (* ; "Edited 25-Jun-2022 15:07 by rmk") - (* ; "Edited 16-Jan-2022 16:47 by rmk") - - (* ;; - "This isn't called now because files are now registered in the pseudohost, not the target device.") - - (APPLY* (FETCH (FDEV UNREGISTERFILE) OF (FETCH (PHDEVICE TARGETDEV) OF DEVICE)) - (FETCH (PHDEVICE TARGETDEV) OF DEVICE) - STREAM]) - -(REGISTERFILE.PH - [LAMBDA (DEVICE STREAM) (* ; "Edited 25-Jun-2022 15:07 by rmk") - (* ; "Edited 16-Jan-2022 16:46 by rmk") - - (* ;; "This isn't called now, because the stream is registered in the pseudohost, not in the target device.") - - (APPLY* (FETCH (FDEV REGISTERFILE) OF (FETCH (PHDEVICE TARGETDEV) OF DEVICE)) - (FETCH (PHDEVICE TARGETDEV) OF DEVICE) - STREAM]) - (GENERATEFILES.PH - [LAMBDA (FDEV PATTERN DESIREDPROPS OPTIONS) (* ; "Edited 17-Jan-2022 20:46 by rmk") + [LAMBDA (FDEV PATTERN DESIREDPROPS OPTIONS) (* ; "Edited 25-Apr-2026 23:21 by rmk") + (* ; "Edited 17-Jan-2022 20:46 by rmk") (* ;; "FDEV is the pseudohost. We will generate from the target directory using its GENFILESTATE, but fiddle the output so that it looks like it is coming from the pseudo host.") @@ -473,26 +482,33 @@ (CREATE FILEGENOBJ NEXTFILEFN _ (FUNCTION NEXTFILEFN.PH) FILEINFOFN _ (FUNCTION FILEINFOFN.PH) - GENFILESTATE _ (LIST FDEV TARGETGENOBJ]) + GENFILESTATE _ (LIST FDEV TARGETGENOBJ (fetch (FDEV DEVICENAME) of FDEV]) (GETFILEINFO.PH - [LAMBDA (STREAM ATTRIBUTE DEVICE) (* ; "Edited 25-Jan-2022 12:43 by rmk") + [LAMBDA (STREAM ATTRIBUTE DEVICE) (* ; "Edited 22-Apr-2026 18:12 by rmk") + (* ; "Edited 20-Apr-2026 08:30 by rmk") + (* ; "Edited 25-Jan-2022 12:43 by rmk") (* ; "Edited 17-Jan-2022 18:21 by rmk") - (PSEUDOHOST.TARGETVAL GETFILEINFO (STREAM ATTRIBUTE DEVICE]) + (GETFILEINFO (TRUEFILENAME STREAM) + ATTRIBUTE]) (SETFILEINFO.PH - [LAMBDA (STREAM ATTRIBUTE VALUE DEVICE) (* ; "Edited 25-Jan-2022 12:37 by rmk") - (PSEUDOHOST.TARGETVAL SETFILEINFO (STREAM ATTRIBUTE VALUE DEVICE]) + [LAMBDA (STREAM ATTRIBUTE VALUE DEVICE) (* ; "Edited 25-Apr-2026 15:52 by rmk") + (* ; "Edited 25-Jan-2022 12:37 by rmk") + (SETFILEINFO (TRUEFILENAME STREAM) + ATTRIBUTE VALUE]) (NEXTFILEFN.PH - [LAMBDA (GENFILESTATE NAMEONLY) (* ; "Edited 17-Jan-2022 21:27 by rmk") + [LAMBDA (GENFILESTATE NAMEONLY) (* ; "Edited 25-Apr-2026 23:21 by rmk") + (* ; "Edited 17-Jan-2022 21:27 by rmk") (LET* ((TARGETGENOBJ (CADR GENFILESTATE)) (TARGETGENFILESTATE (FETCH GENFILESTATE OF TARGETGENOBJ)) (FILENAME (APPLY* (FETCH NEXTFILEFN OF TARGETGENOBJ) TARGETGENFILESTATE NAMEONLY))) (CL:WHEN FILENAME (CL:UNLESS NAMEONLY - (SETQ FILENAME (CONTRACT.PH FILENAME (CAR GENFILESTATE))))) + (SETQ FILENAME (CONTRACT.PH FILENAME (CAR GENFILESTATE) + (CADDR GENFILESTATE))))) FILENAME]) (FILEINFOFN.PH @@ -500,27 +516,6 @@ (APPLY* (FETCH FILEINFOFN OF (CADR GENFILESTATE)) (FETCH GENFILESTATE OF (CADR GENFILESTATE)) ATTRIBUTE]) - -(RENAMEFILE.PH - [LAMBDA (OLD-DEVICE OLD-NAME NEW-DEVICE NEW-NAME) (* ; "Edited 18-Jan-2022 09:52 by rmk") - (LET ((OLDTARGETDEV (FETCH (PHDEVICE TARGETDEV) OF OLD-DEVICE)) - (NEWTARGETDEV (FETCH (PHDEVICE TARGETDEV) OF NEW-DEVICE)) - (NEWTARGETNAME NEW-NAME) - RESULT) - (CL:WHEN (TYPE? FDEV NEWTARGETDEV) (* ; "NEW-DEVICE is a pseudo host") - (SETQ NEWTARGETNAME (EXPAND.PH NEW-NAME NEW-DEVICE))) - (SETQ RESULT (APPLY* (FETCH (FDEV RENAMEFILE) OF OLDTARGETDEV) - OLDTARGETDEV - (EXPAND.PH OLD-NAME OLD-DEVICE) - (OR NEWTARGETDEV NEW-DEVICE) - NEWTARGETNAME)) - (CL:WHEN (AND RESULT (NEQ NEWTARGETDEV NEW-DEVICE)) - (SETQ RESULT (CONTRACT.PH RESULT NEW-DEVICE))) - RESULT]) -) -(DECLARE%: DONTEVAL@LOAD DOCOPY - -(PSEUDOHOST 'LI LOGINHOST/DIR) ) (MOVD? 'GETHOSTINFO 'GETHOSTINFO.ORIG) @@ -536,7 +531,7 @@ (RECORD PHGENFILESTATE (PHDEVICE . TARGETGENFILESTATE)) -(ACCESSFNS TARGETDEVICE ((PREFIXMAP (FETCH (FDEV FDEV3) OF DATUM) +(ACCESSFNS TARGETDEVICE ((PREFIXMAPS (FETCH (FDEV FDEV3) OF DATUM) (REPLACE (FDEV FDEV3) OF DATUM WITH NEWVALUE)))) ) @@ -551,14 +546,14 @@ (* ;;  "Assumes that the name is (CAR ARGS), the device is the last or args if not specified separately") - `(CONTRACT.PH [APPLY* (FETCH (FDEV ,OPNAME) OF (FETCH (PHDEVICE TARGETDEV) + `(CONTRACT.PH [APPLY* (fetch (FDEV ,OPNAME) of (fetch (PHDEVICE TARGETDEV) OF ,DEV)) (EXPAND.PH ,(CAR ARGS) ,DEV) - ,@(SUBST `(FETCH (PHDEVICE TARGETDEV) OF ,DEV) + ,@(SUBST `(fetch (PHDEVICE TARGETDEV) of ,DEV) DEV (CDR ARGS] - ,DEV]) + ,DEV T]) (PUTPROPS PSEUDOHOST.TARGETVAL MACRO [TAIL (LET [(OPNAME (CAR TAIL)) @@ -576,19 +571,14 @@ DEV (CDR ARGS]) ) - - -(FILESLOAD (FROM LOADUPS) - EXPORTS.ALL) ) (DECLARE%: DONTCOPY - (FILEMAP (NIL (1331 13754 (PSEUDOHOST 1341 . 7049) (PSEUDOHOSTP 7051 . 7880) (PSEUDOHOSTS 7882 . 9925) - (TARGETHOST 9927 . 10796) (TRUEDEVICE 10798 . 11754) (TRUEFILENAME 11756 . 12881) (PSEUDOFILENAME -12883 . 13752)) (13782 19797 (EXPAND.PH 13792 . 15045) (CONTRACT.PH 15047 . 17758) (UNSLASHIT 17760 . -19506) (GETHOSTINFO.PH 19508 . 19795)) (19798 20699 (CDPSEUDO 19808 . 20697)) (20700 28720 ( -OPENFILE.PH 20710 . 21783) (GETFILENAME.PH 21785 . 22074) (DIRECTORYNAMEP.PH 22076 . 22700) ( -CLOSEFILE.PH 22702 . 23169) (REOPENFILE.PH 23171 . 23736) (DELETEFILE.PH 23738 . 24022) (OPENP.PH -24024 . 24319) (UNREGISTERFILE.PH 24321 . 24863) (REGISTERFILE.PH 24865 . 25399) (GENERATEFILES.PH -25401 . 26445) (GETFILEINFO.PH 26447 . 26749) (SETFILEINFO.PH 26751 . 26950) (NEXTFILEFN.PH 26952 . -27498) (FILEINFOFN.PH 27500 . 27775) (RENAMEFILE.PH 27777 . 28718))))) + (FILEMAP (NIL (1128 14735 (PSEUDOHOST 1138 . 8248) (PSEUDOHOSTP 8250 . 9169) (PSEUDOHOSTS 9171 . 9532) + (TARGETHOST 9534 . 10403) (TRUEDEVICE 10405 . 11361) (TRUEFILENAME 11363 . 12650) (PSEUDOFILENAME +12652 . 14064) (PSEUDOFILENAMES 14066 . 14733)) (14736 15885 (CDPSEUDO 14746 . 15883)) (15913 21797 ( +EXPAND.PH 15923 . 17229) (CONTRACT.PH 17231 . 19713) (UNSLASHIT 19715 . 21461) (GETHOSTINFO.PH 21463 + . 21795)) (21798 28419 (OPENFILE.PH 21808 . 22933) (GETFILENAME.PH 22935 . 23333) (DIRECTORYNAMEP.PH +23335 . 23959) (CLOSEFILE.PH 23961 . 24428) (REOPENFILE.PH 24430 . 25106) (DELETEFILE.PH 25108 . 25392 +) (GENERATEFILES.PH 25394 . 26588) (GETFILEINFO.PH 26590 . 27111) (SETFILEINFO.PH 27113 . 27422) ( +NEXTFILEFN.PH 27424 . 28140) (FILEINFOFN.PH 28142 . 28417))))) STOP diff --git a/library/PSEUDOHOSTS.LCOM b/library/PSEUDOHOSTS.LCOM index 3f8e0a289..0252b1469 100644 Binary files a/library/PSEUDOHOSTS.LCOM and b/library/PSEUDOHOSTS.LCOM differ diff --git a/library/PSEUDOHOSTS.TEDIT b/library/PSEUDOHOSTS.TEDIT index ea9810284..462899aea 100644 Binary files a/library/PSEUDOHOSTS.TEDIT and b/library/PSEUDOHOSTS.TEDIT differ diff --git a/library/SAMEDIR b/library/SAMEDIR index 1ff279395..1b1e67faa 100644 --- a/library/SAMEDIR +++ b/library/SAMEDIR @@ -1,15 +1,13 @@ -(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10) +(DEFINE-FILE-INFO :PACKAGE "INTERLISP" :READTABLE "INTERLISP" :BASE 10) -(FILECREATED "31-Oct-2022 13:09:14" {WMEDLEY}SAMEDIR.;4 6221 +(FILECREATED "27-Apr-2026 21:18:26" {WMEDLEY}SAMEDIR.;6 6540 - :CHANGES-TO (FNS CHECKSAMEDIR HOST&DIRECTORYFIELD) + :EDIT-BY rmk - :PREVIOUS-DATE "25-Apr-2022 09:23:16" {WMEDLEY}SAMEDIR.;3) + :CHANGES-TO (FNS CHECKSAMEDIR) + :PREVIOUS-DATE "31-Oct-2022 13:09:14" {MEDLEY}SAMEDIR.;4) -(* ; " -Copyright (c) 1982, 1984-1987, 1990, 2018, 2020 by Venue & Xerox Corporation. -") (PRETTYCOMPRINT SAMEDIRCOMS) @@ -24,7 +22,8 @@ Copyright (c) 1982, 1984-1987, 1990, 2018, 2020 by Venue & Xerox Corporation. (DEFINEQ (CHECKSAMEDIR - [LAMBDA (FILE) (* ; "Edited 31-Oct-2022 13:08 by rmk") + [LAMBDA (FILE) (* ; "Edited 27-Apr-2026 21:18 by rmk") + (* ; "Edited 31-Oct-2022 13:08 by rmk") (* ; "Edited 25-Apr-2022 09:16 by rmk") (* ; "Edited 1-Sep-2020 11:40 by rmk:") @@ -32,70 +31,75 @@ Copyright (c) 1982, 1984-1987, 1990, 2018, 2020 by Venue & Xerox Corporation. (* ;; " OKHOST/DIRS is a list of places it's OK for the file to be winding up, so if your'e migrating code from one place ot another, you can do it gracefully.") + (* ;; + "MIGRATIONS may be provided as a global variable, to suppress the askusers. See documentation. ") + [RESETSAVE (DIRECTORYNAME T) - '(PROGN (CNDIR OLDVALUE] (* ; + '(PROGN (CNDIR OLDVALUE] + (SETQ FILE (ROOTFILENAME FILE)) (* ;  "Assumes that MAKEFILE has RESETLST") (PROG ((*UPPER-CASE-FILE-NAMES* NIL) - (DATES (GET (SETQ FILE (ROOTFILENAME FILE)) - 'FILEDATES)) - HOST/DIR HOST DIR NEWV OKHOST/DIRS) + [OLDFILE (CDAR (LISTP (GET FILE 'FILEDATES] + PREVPDIRS HOST/DIR NEWV OKHOST/DIRS OLDDIR) + (CL:UNLESS OLDFILE (RETURN)) + + (* ;; "Only the first previor location matters. If we moved it, we don't want to move it back.") + + (SETQ OLDDIR (HOST&DIRECTORYFIELD OLDFILE)) + + (* ;; "PREVPDIRS is a list of all possible pseudohost synonyms for the previous location of FILE. Use HOST&DIRECTORYFIELD to canonicalize both file and connected directory") + + (SETQ PREVPDIRS (PSEUDOFILENAMES OLDDIR)) (* ; + "Any pseudohost or migrating pseudohost is good") + (SETQ OKHOST/DIRS (APPEND (for M in MIGRATIONS when (CL:MEMBER (CAR M) + PREVPDIRS :TEST + (FUNCTION STRING-EQUAL)) + collect (CDR M)) + PREVPDIRS)) AGAIN - (OR (LISTP DATES) - (RETURN)) (* ; - "RMK: Use HOST&DIRECTORYFIELD to canonicalize both file and connected directory") - [SETQ OKHOST/DIRS (CONS (SETQ HOST/DIR (HOST&DIRECTORYFIELD (DIRECTORYNAME T))) - (MKLIST (CDR (OR (ASSOC HOST/DIR MIGRATIONS :TEST 'STRING-EQUAL) - (ASSOC (TRUEFILENAME HOST/DIR) - MIGRATIONS :TEST 'STRING-EQUAL) - (ASSOC (PSEUDOFILENAME HOST/DIR) - MIGRATIONS :TEST 'STRING-EQUAL] - (COND - ([for OLDFILE in DATES bind HOST DIR - never (OR (CL:MEMBER (HOST&DIRECTORYFIELD (CDR OLDFILE)) - OKHOST/DIRS :TEST 'STRING-EQUAL) - (CL:MEMBER (TRUEFILENAME (HOST&DIRECTORYFIELD (CDR OLDFILE))) - OKHOST/DIRS :TEST 'STRING-EQUAL) - (CL:MEMBER (PSEUDOFILENAME (HOST&DIRECTORYFIELD (CDR OLDFILE))) - OKHOST/DIRS :TEST 'STRING-EQUAL] - - (* ;; "The file is going somewhere it has never been before. ") - - (* ;; "Check that that is really what the user wants.") - - (SELECTQ (ASKUSER SAMEDIRWAIT SAMEDIRDEFAULT (LIST "You haven't loaded or written" FILE - "in your connected directory" - HOST/DIR "-- write it out anyway") - `[[O ,(CONCAT "Oops! Make file on " (SETQ HOST/DIR ( - HOST&DIRECTORYFIELD - (CDAR DATES] - (C "Make file on other directory: ") - (Y ,(CONCAT "Yes, write it here") - (CHARACTER (CHARCODE EOL))) - (N ,(CONCAT "No, abort MAKEFILE") - (CHARACTER (CHARCODE EOL] - NIL NIL '(NOECHOFLG T)) - (Y (RETURN)) - (N (ERROR!)) - (C (SETQ HOST/DIR)) - (O (TERPRI T)) - (SHOULDNT)) - [NLSETQ (CNDIR (OR HOST/DIR (READ T T] - (GO AGAIN)) - ([AND [SETQ NEWV (INFILEP (PACKFILENAME.STRING 'VERSION NIL 'BODY (CDAR DATES] - (NOT (STRING-EQUAL NEWV (CDAR DATES] - - (* ;; "A newer version appeared while the user was editing this file.") - - (* ;; "Ask if he should over-write it.") - - (SELECTQ (ASKUSER 15 'Y (LIST (CDAR DATES) - "is not the most recent version (version" - (FILENAMEFIELD.STRING NEWV 'VERSION) - "has since appeared)." - "Do you want to make the file anyway")) - (Y) - (N (ERROR!)) - (SHOULDNT]) + (* ; "Come here on new directory") + (SETQ HOST/DIR (DIRECTORYNAME T)) (* ; + "Current directory, maybe newly connected") + (if (NOT (CL:MEMBER HOST/DIR OKHOST/DIRS :TEST (FUNCTION STRING-EQUAL))) + then + (* ;; "The file would go somewhere new. Is that what the user really wants?") + + (SELECTQ (ASKUSER SAMEDIRWAIT SAMEDIRDEFAULT (LIST "You haven't loaded or written" + FILE + "in your connected directory" + HOST/DIR + "-- write it out anyway") + `[[O ,(CONCAT "Oops! Make file on " (SETQ HOST/DIR OLDDIR] + (C "Make file on other directory: ") + (Y ,(CONCAT "Yes, write it here") + (CHARACTER (CHARCODE EOL))) + (N ,(CONCAT "No, abort MAKEFILE") + (CHARACTER (CHARCODE EOL] + NIL NIL '(NOECHOFLG T)) + (Y (RETURN)) + (N (ERROR!)) + (C (SETQ HOST/DIR NIL)) + (O (* ; + "Choose DATE directory above, switch in NLSETQ below, switch back in RESETSAVE above") + (TERPRI T)) + (SHOULDNT)) + (CL:WHEN [NLSETQ (CNDIR (OR HOST/DIR (READ T T] + (RETURN)) + (GO AGAIN) + elseif (AND (SETQ NEWV (INFILEP (PACKFILENAME.STRING 'VERSION NIL 'BODY OLDFILE))) + (NOT (STRING-EQUAL NEWV OLDFILE))) + then + (* ;; "A newer version appeared while the user was editing this file.") + + (* ;; "Ask if he should over-write it.") + + (SELECTQ (ASKUSER 15 'Y (LIST OLDFILE "is not the most recent version (version" + (FILENAMEFIELD.STRING NEWV 'VERSION) + "has since appeared)." + "Do you want to make the file anyway")) + (Y) + (N (ERROR!)) + (SHOULDNT]) (HOST&DIRECTORYFIELD [LAMBDA (FILENAME) (* ; "Edited 31-Oct-2022 13:03 by rmk") @@ -120,7 +124,6 @@ Copyright (c) 1982, 1984-1987, 1990, 2018, 2020 by Venue & Xerox Corporation. (GLOBALVARS MIGRATIONS) ) -(PUTPROPS SAMEDIR COPYRIGHT ("Venue & Xerox Corporation" 1982 1984 1985 1986 1987 1990 2018 2020)) (DECLARE%: DONTCOPY - (FILEMAP (NIL (731 5838 (CHECKSAMEDIR 741 . 5249) (HOST&DIRECTORYFIELD 5251 . 5836))))) + (FILEMAP (NIL (641 6256 (CHECKSAMEDIR 651 . 5667) (HOST&DIRECTORYFIELD 5669 . 6254))))) STOP diff --git a/library/SAMEDIR.LCOM b/library/SAMEDIR.LCOM index 3185b143f..32bfbbfe3 100644 Binary files a/library/SAMEDIR.LCOM and b/library/SAMEDIR.LCOM differ diff --git a/library/UNICODE-TABLES b/library/UNICODE-TABLES index 166adc522..1f2759122 100644 --- a/library/UNICODE-TABLES +++ b/library/UNICODE-TABLES @@ -1,12 +1,12 @@ (DEFINE-FILE-INFO :PACKAGE "INTERLISP" :READTABLE "INTERLISP" :BASE 10 :FORMAT :UTF-8) -(FILECREATED "31-Mar-2026 09:01:05" {WMEDLEY}UNICODE-TABLES.;22 44782 +(FILECREATED "26-Apr-2026 10:44:13" {MEDLEY}UNICODE-TABLES.;23 44829 :EDIT-BY rmk - :CHANGES-TO (VARS XCCS-CHARSETS) + :CHANGES-TO (VARS UNICODE-TABLESCOMS) - :PREVIOUS-DATE "22-Feb-2026 10:44:33" {WMEDLEY}UNICODE-TABLES.;20) + :PREVIOUS-DATE "31-Mar-2026 09:01:05" {MEDLEY}UNICODE-TABLES.;22) (PRETTYCOMPRINT UNICODE-TABLESCOMS) @@ -16,7 +16,7 @@ (* ;; "This is code for reading/writing the XCCS-to-UNICODE mapping tables. It runs offline, when UNICODE-UTF8 is modified. ") (COMS (* ; "Read Unicode mapping files") - (INITVARS (UNICODEDIRECTORIES NIL)) + [INITVARS (UNICODEDIRECTORIES '({MEDLEY}/unicode/xerox/] (GLOBALVARS UNICODEDIRECTORIES) (VARS XCCS-CHARSETS) (FNS READ-UNICODE-MAPPING-FILENAMES READ-UNICODE-MAPPING)) @@ -56,7 +56,7 @@ (* ; "Read Unicode mapping files") -(RPAQ? UNICODEDIRECTORIES NIL) +(RPAQ? UNICODEDIRECTORIES '({MEDLEY}/unicode/xerox/)) (DECLARE%: DOEVAL@COMPILE DONTCOPY (GLOBALVARS UNICODEDIRECTORIES) @@ -792,12 +792,12 @@ UNICODE-EXPORTS) ) (DECLARE%: DONTCOPY - (FILEMAP (NIL (3929 12651 (READ-UNICODE-MAPPING-FILENAMES 3939 . 8408) (READ-UNICODE-MAPPING 8410 . -12649)) (12718 19526 (MAKE-UNICODE-TRANSLATION-TABLES 12728 . 15488) (GET-MCCS-UNICODE-MAPPING 15490 - . 16510) (INVERT-UNICODE-MAPPING 16512 . 18305) (XCCSTOMCCS-MAPPING 18307 . 19524)) (19527 26150 ( -ALL-UNICODE-MAPPINGS 19537 . 24813) (XCCSJAPANESECHARSETS 24815 . 26148)) (26195 36957 ( -WRITE-UNICODE-MAPPING 26205 . 29949) (WRITE-UNICODE-INCLUDED 29951 . 34263) ( -WRITE-UNICODE-MAPPING-HEADER 34265 . 35513) (WRITE-UNICODE-MAPPING-FILENAME 35515 . 36955)) (36958 -37634 (XCCS-UTF8-AFTER-OPEN 36968 . 37632)) (40159 42248 (UTF8HEXSTRING 40169 . 42246)) (42275 44317 ( -SHOWCHARS 42285 . 44315))))) + (FILEMAP (NIL (3976 12698 (READ-UNICODE-MAPPING-FILENAMES 3986 . 8455) (READ-UNICODE-MAPPING 8457 . +12696)) (12765 19573 (MAKE-UNICODE-TRANSLATION-TABLES 12775 . 15535) (GET-MCCS-UNICODE-MAPPING 15537 + . 16557) (INVERT-UNICODE-MAPPING 16559 . 18352) (XCCSTOMCCS-MAPPING 18354 . 19571)) (19574 26197 ( +ALL-UNICODE-MAPPINGS 19584 . 24860) (XCCSJAPANESECHARSETS 24862 . 26195)) (26242 37004 ( +WRITE-UNICODE-MAPPING 26252 . 29996) (WRITE-UNICODE-INCLUDED 29998 . 34310) ( +WRITE-UNICODE-MAPPING-HEADER 34312 . 35560) (WRITE-UNICODE-MAPPING-FILENAME 35562 . 37002)) (37005 +37681 (XCCS-UTF8-AFTER-OPEN 37015 . 37679)) (40206 42295 (UTF8HEXSTRING 40216 . 42293)) (42322 44364 ( +SHOWCHARS 42332 . 44362))))) STOP diff --git a/library/UNICODE-TABLES.LCOM b/library/UNICODE-TABLES.LCOM index 6819f9193..26c0cfeb8 100644 Binary files a/library/UNICODE-TABLES.LCOM and b/library/UNICODE-TABLES.LCOM differ diff --git a/lispusers/EDITFONT b/lispusers/EDITFONT index ede826c64..01e163c73 100644 --- a/lispusers/EDITFONT +++ b/lispusers/EDITFONT @@ -1,13 +1,13 @@ (DEFINE-FILE-INFO :PACKAGE "INTERLISP" :READTABLE "INTERLISP" :BASE 10) -(FILECREATED "16-Mar-2026 23:19:02" {WMEDLEY}EDITFONT.;42 26474 +(FILECREATED " 5-May-2026 12:21:24" {MEDLEY}EDITFONT.;53 27357 :EDIT-BY rmk :CHANGES-TO (FNS EDITFONT) (RECORDS CHARITEM) - :PREVIOUS-DATE "12-Oct-2025 17:39:29" {WMEDLEY}EDITFONT.;41) + :PREVIOUS-DATE " 5-Apr-2026 11:56:20" {MEDLEY}EDITFONT.;51) (PRETTYCOMPRINT EDITFONTCOMS) @@ -19,8 +19,8 @@ (INITVARS (EF.MENU NIL) (EF.TITLEMENU NIL)) (FNS EF.INIT EF.PROMPT EF.MESSAGE EF.CLOSEFN EF.CHARITEMS EF.BUTTONEVENTFN EF.WHENSELECTEDFN - EF.EDITBM EF.MIDDLEBUTTONFN EF.CHANGESIZE EF.DELETE EF.ENTER EF.REPLACE EF.SAVE COPYFONT - READSTRIKEFONTFILE) + EF.EDITBM EF.MIDDLEBUTTONFN EF.CHANGESIZE EF.DELETE EF.ENTER EF.REPLACE EF.SAVE + EF.INSPECT COPYFONT READSTRIKEFONTFILE) (FNS BLANKCHARSETCREATE EDITFONT) (DECLARE%: EVAL@COMPILE DONTCOPY (RECORDS CHARITEM) (FILES (LOADCOMP) @@ -38,14 +38,16 @@ (DEFINEQ (EF.INIT - [LAMBDA NIL (* ; "Edited 4-Aug-2025 13:16 by rmk") + [LAMBDA NIL (* ; "Edited 5-Apr-2026 11:56 by rmk") + (* ; "Edited 4-Aug-2025 13:16 by rmk") [SETQ EF.MENU (create MENU - ITEMS _ '((CHANGESIZE 'EF.CHANGESIZE "Change size of character.") - (DELETE 'EF.DELETE "Delete character.") - (EDITBM 'EF.EDITBM "Edit character.") - (REPLACE 'EF.REPLACE "Prompt for bitmap to replace character."] + ITEMS _ '((Changesize 'EF.CHANGESIZE "Change size of character.") + (Delete 'EF.DELETE "Delete character.") + (EditBM 'EF.EDITBM "Edit character.") + (Replace 'EF.REPLACE "Prompt for bitmap to replace character."] (SETQ EF.TITLEMENU (create MENU - ITEMS _ '((SAVE 'EF.SAVE "Save EDITFONT's work back into font."]) + ITEMS _ '((Save 'EF.SAVE "Save EDITFONT's work back into font.") + (Inspect 'EF.INSPECT "Inspect this charset info"]) (EF.PROMPT [LAMBDA (STRING WINDOW) (* kbr%: "16-Oct-85 22:48") @@ -81,7 +83,8 @@ (WINDOWPROP WINDOW 'MENU NIL]) (EF.CHARITEMS - [LAMBDA (FONT CHARSET ROWMAJOR) (* ; "Edited 5-Oct-2025 14:42 by rmk") + [LAMBDA (FONT CHARSET ROWMAJOR) (* ; "Edited 18-Mar-2026 16:13 by rmk") + (* ; "Edited 5-Oct-2025 14:42 by rmk") (* ; "Edited 29-Aug-2025 11:34 by rmk") (* ; "Edited 27-Aug-2025 22:50 by rmk") (* ; "Edited 4-Aug-2025 00:14 by rmk") @@ -95,7 +98,7 @@ collect (create CHARITEM BITMAP _ (GETCHARBITMAP C FONT) CHARCODE _ C8 - SLUGCHARP _ (SLUGCHARP.DISPLAY C FONT))) + SLUGCHARP _ (SLUGCHARP C FONT))) else (for ROW from 0 to 15 join (for COL CODE from 0 to 15 collect (SETQ CODE (LOGOR (LLSH CHARSET 8) (IPLUS (TIMES COL 16) @@ -103,7 +106,7 @@ (create CHARITEM BITMAP _ (GETCHARBITMAP CODE FONT) CHARCODE _ CODE - SLUGCHARP _ (SLUGCHARP.DISPLAY CODE FONT]) + SLUGCHARP _ (SLUGCHARP CODE FONT]) (EF.BUTTONEVENTFN [LAMBDA (WINDOW) (* kbr%: "16-Oct-85 22:19") @@ -313,6 +316,12 @@ (\SETCHARSETINFO FONT CHARSET CSINFO]) +(EF.INSPECT + [LAMBDA (WINDOW) (* ; "Edited 5-Apr-2026 11:41 by rmk") + (* ; "Save EDITFONT changes to FONT. *") + (INSPECT (\GETCHARSETINFO (WINDOWPROP WINDOW 'FONT) + (WINDOWPROP WINDOW 'CHARSET]) + (COPYFONT [LAMBDA (FONT) (* ; "Edited 3-Aug-2025 17:37 by rmk") (* jds "26-Aug-86 16:01") @@ -429,18 +438,20 @@ (RETURN FONT]) (EDITFONT - [LAMBDA (FONT CHARSET ROWMAJOR NCOLUMNS TITLETAG) (* ; "Edited 16-Mar-2026 23:17 by rmk") + [LAMBDA (FONT CHARSET ROWMAJOR NCOLUMNS TITLETAG) (* ; "Edited 5-May-2026 12:19 by rmk") + (* ; "Edited 4-Apr-2026 18:14 by rmk") + (* ; "Edited 30-Mar-2026 12:10 by rmk") + (* ; "Edited 25-Mar-2026 00:04 by rmk") + (* ; "Edited 21-Mar-2026 10:43 by rmk") + (* ; "Edited 16-Mar-2026 23:17 by rmk") (* ; "Edited 7-Oct-2025 14:55 by rmk") - (* ; "Edited 5-Oct-2025 15:06 by rmk") (* ; "Edited 4-Sep-2025 09:27 by rmk") - (* ; "Edited 29-Aug-2025 22:34 by rmk") (* ; "Edited 17-Aug-2025 12:03 by rmk") - (* ; "Edited 3-Aug-2025 23:25 by rmk") (* ; "Edited 2-Aug-2025 10:11 by rmk") (* mjs "27-Mar-85 14:48") (* kbr%: "21-Oct-85 15:35") (* kbr%: "21-Oct-85 15:35") - (SETQ FONT (FONTCREATE FONT)) + (SETQ FONT (FONTCREATE FONT NIL NIL NIL NIL NIL CHARSET)) (CL:UNLESS (EQ 'DISPLAY (FONTPROP FONT 'DEVICE)) (ERROR FONT " is not a display font")) (SETQ CHARSET (OR (CHARSET.DECODE CHARSET) @@ -497,10 +508,10 @@ (EF.INIT) (DECLARE%: DONTCOPY - (FILEMAP (NIL (1147 16904 (EF.INIT 1157 . 1791) (EF.PROMPT 1793 . 2375) (EF.MESSAGE 2377 . 2589) ( -EF.CLOSEFN 2591 . 3118) (EF.CHARITEMS 3120 . 4956) (EF.BUTTONEVENTFN 4958 . 5370) (EF.WHENSELECTEDFN -5372 . 5776) (EF.EDITBM 5778 . 7272) (EF.MIDDLEBUTTONFN 7274 . 7519) (EF.CHANGESIZE 7521 . 8850) ( -EF.DELETE 8852 . 10033) (EF.ENTER 10035 . 10976) (EF.REPLACE 10978 . 11951) (EF.SAVE 11953 . 16196) ( -COPYFONT 16198 . 16473) (READSTRIKEFONTFILE 16475 . 16902)) (16905 26286 (BLANKCHARSETCREATE 16915 . -23000) (EDITFONT 23002 . 26284))))) + (FILEMAP (NIL (1157 17541 (EF.INIT 1167 . 1996) (EF.PROMPT 1998 . 2580) (EF.MESSAGE 2582 . 2794) ( +EF.CLOSEFN 2796 . 3323) (EF.CHARITEMS 3325 . 5254) (EF.BUTTONEVENTFN 5256 . 5668) (EF.WHENSELECTEDFN +5670 . 6074) (EF.EDITBM 6076 . 7570) (EF.MIDDLEBUTTONFN 7572 . 7817) (EF.CHANGESIZE 7819 . 9148) ( +EF.DELETE 9150 . 10331) (EF.ENTER 10333 . 11274) (EF.REPLACE 11276 . 12249) (EF.SAVE 12251 . 16494) ( +EF.INSPECT 16496 . 16833) (COPYFONT 16835 . 17110) (READSTRIKEFONTFILE 17112 . 17539)) (17542 27169 ( +BLANKCHARSETCREATE 17552 . 23637) (EDITFONT 23639 . 27167))))) STOP diff --git a/lispusers/EDITFONT.LCOM b/lispusers/EDITFONT.LCOM index ce1d1ae3e..cac25bf65 100644 Binary files a/lispusers/EDITFONT.LCOM and b/lispusers/EDITFONT.LCOM differ diff --git a/sources/AFONT b/sources/ACFONT similarity index 54% rename from sources/AFONT rename to sources/ACFONT index 96e8e6d9f..420d71a7c 100644 --- a/sources/AFONT +++ b/sources/ACFONT @@ -1,36 +1,33 @@ -(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10) +(DEFINE-FILE-INFO :PACKAGE "INTERLISP" :READTABLE "INTERLISP" :BASE 10 :FORMAT :UTF-8) -(FILECREATED "22-Jul-2025 23:20:06"  -{DSK}kaplan>Local>medley3.5>working-medley>sources>AFONT.;15 27510 +(FILECREATED "15-Apr-2026 09:04:48" {WMEDLEY}ACFONT.;11 42920 :EDIT-BY rmk - :CHANGES-TO (VARS AFONTCOMS) + :CHANGES-TO (VARS ACFONTCOMS) - :PREVIOUS-DATE "21-Jul-2025 00:14:04" -{DSK}kaplan>Local>medley3.5>working-medley>sources>AFONT.;14) + :PREVIOUS-DATE "13-Apr-2026 09:00:05" {WMEDLEY}ACFONT.;10) -(PRETTYCOMPRINT AFONTCOMS) +(PRETTYCOMPRINT ACFONTCOMS) -(RPAQQ AFONTCOMS +(RPAQQ ACFONTCOMS [ - (* ;; "AC font file support. ACFONT.FILEP is on FONT") + (* ;; "AC and STRIKE font file support. ") - (XCL:FILE-ENVIRONMENTS "AFONT") (DECLARE%: EVAL@COMPILE DONTCOPY (RECORDS BOUNDINGBOX FONTBOUNDINGBOX)) (FNS ACFONT.FILEP ACFONT.GETCHARSET \READACFONTBOXES \READACFONTFILE \ACCHARIMAGELIST \ACCHARWIDTHLIST \GETFBB \ACCHARPOSLIST \ACROTATECHAR \FACECODE \FAMILYCODE) - (ADDVARS (DISPLAYCHARSETFNS (AC ACFONT.FILEP ACFONT.GETCHARSET]) + (PROP FILETYPE ACFONT) + [APPENDVARS (DISPLAYCHARSETFNS '(AC ACFONT.FILEP ACFONT.GETCHARSET] + (COMS (* ; "STRIKE format files") + (FNS STRIKEFONT.FILEP STRIKEFONT.GETCHARSET WRITESTRIKEFONTFILE STRIKECSINFO) + (APPENDVARS (DISPLAYCHARSETFNS '(STRIKE STRIKEFONT.FILEP STRIKEFONT.GETCHARSET]) -(* ;; "AC font file support. ACFONT.FILEP is on FONT") +(* ;; "AC and STRIKE font file support. ") - -(XCL:DEFINE-FILE-ENVIRONMENT "AFONT" :PACKAGE "IL" - :READTABLE "INTERLISP" - :COMPILER :COMPILE-FILE) (DECLARE%: EVAL@COMPILE DONTCOPY (DECLARE%: EVAL@COMPILE @@ -78,7 +75,9 @@ 4))))]) (ACFONT.GETCHARSET - [LAMBDA (STRM CHARSET) (* ; "Edited 14-Jul-2025 19:50 by rmk") + [LAMBDA (STRM CHARSET FONT) (* ; "Edited 28-Mar-2026 23:02 by rmk") + (* ; "Edited 27-Mar-2026 07:59 by rmk") + (* ; "Edited 14-Jul-2025 19:50 by rmk") (* ; "Edited 17-May-2025 10:15 by rmk") (* ;; @@ -87,36 +86,31 @@ (\READACFONTFILE STRM]) (\READACFONTBOXES - [LAMBDA (FILE STARTCHAR ENDCHAR) (* jds "15-Jun-85 11:48") + [LAMBDA (FILE STARTCHAR ENDCHAR) (* jds "15-Jun-85 11:48") (* ;  "GETACCHARSPECS returns (bbox bboy bbdx bbdy)") (* ;  "if bbdx and bbdy are both zero, then treat it as a space.") - (SETFILEPTR FILE 48) (* ;  "Move to the start of AC file's width info.") - (for X from STARTCHAR to ENDCHAR collect (* ;  "Now collect the 4 bounding box values into a list") - (create BOUNDINGBOX - RASTERWIDTHX _ (PROG1 (\WIN FILE) + RASTERWIDTHX ↠(PROG1 (\WIN FILE) (* ;  "Read a fraction, and truncate it to an integer # of raster bits") - - (\WIN FILE)) - RASTERWIDTHY _ (PROG1 (\WIN FILE) + (\WIN FILE)) + RASTERWIDTHY ↠(PROG1 (\WIN FILE) (* ;  "Read a fraction, and truncate it to an integer # of raster bits") - - (\WIN FILE)) - BBOX _ (SIGNED (\WIN FILE) + (\WIN FILE)) + BBOX ↠(SIGNED (\WIN FILE) BITSPERWORD) - BBOY _ (SIGNED (\WIN FILE) + BBOY ↠(SIGNED (\WIN FILE) BITSPERWORD) - BBDX _ (SIGNED (\WIN FILE) + BBDX ↠(SIGNED (\WIN FILE) BITSPERWORD) - BBDY _ (SIGNED (\WIN FILE) + BBDY ↠(SIGNED (\WIN FILE) BITSPERWORD]) (\READACFONTFILE @@ -129,8 +123,8 @@ (PROG [FBBLIST STARTCHAR ENDCHAR CHARWIDTHLIST CHARIMAGEWIDTHLIST OFFSETS WIDTHS IMAGEWIDTHS FONTDESC FBBBITMAP CHARBITMAP STARTWORDLIST BBOXLIST DUMMYCHAROFFSET DUMMYWIDTH (CSINFO (create CHARSETINFO - IMAGEWIDTHS _ (\CREATECSINFOELEMENT) - LEFTKERN _ (\CREATEKERNELEMENT] + IMAGEWIDTHS ↠(\CREATECSINFOELEMENT) + LEFTKERN ↠(\CREATEKERNELEMENT] (CL:UNLESS (GETSTREAM STRM 'INPUT T) [RESETSAVE (SETQ STRM (OPENSTREAM STRM 'INPUT 'OLD)) `(PROGN (CLOSEF? OLDVALUE]) @@ -215,7 +209,7 @@ of FBBLIST] [replace CHARSETBITMAP of CSINFO with (SETQ CHARBITMAP (BITMAPCREATE (IPLUS (SETQ DUMMYCHAROFFSET - (for (X _ STARTCHAR) + (for (X ↠STARTCHAR) to ENDCHAR sum (\FGETWIDTH IMAGEWIDTHS @@ -226,7 +220,7 @@ (SETQ OFFSETS (fetch (CHARSETINFO OFFSETS) of CSINFO)) (for I from 0 to (ADD1 \MAXTHINCHAR) do (\FSETOFFSET OFFSETS I DUMMYCHAROFFSET)) (SETQ STARTWORDLIST (\ACCHARPOSLIST STRM STARTCHAR ENDCHAR)) - (bind (DESTLEFT _ 0) for NTHCHAR from STARTCHAR to ENDCHAR as BBLIST in BBOXLIST + (bind (DESTLEFT ↠0) for NTHCHAR from STARTCHAR to ENDCHAR as BBLIST in BBOXLIST as STARTWORD in STARTWORDLIST as CHARWIDTH in CHARWIDTHLIST do (PROG (RASTERINFO BBOX BBBITMAP BBBMBASE)(* ;  "\ACCHARPOSLIST returns NIL if no raster exists for the code") @@ -296,19 +290,18 @@ (RETURN CSINFO)))]) (\ACCHARIMAGELIST - [LAMBDA (BOXLIST) (* jds "15-Jun-85 11:37") - - (* ;; "Returns a list of the ESCAPEMENTS (ie how far to move after printng this character) for each char in the font.") + [LAMBDA (BOXLIST) (* jds "15-Jun-85 11:37") + + (* ;; "Returns a list of the ESCAPEMENTS (ie how far to move after printng this character) for each char in the font.") (for BOX in BOXLIST collect (fetch (BOUNDINGBOX RASTERWIDTHX) of BOX]) (\ACCHARWIDTHLIST - [LAMBDA (BOXLIST FBBOX) (* jds " 4-Dec-84 16:05") + [LAMBDA (BOXLIST FBBOX) (* jds " 4-Dec-84 16:05") (* ;  "GETACCHARSPECS returns (bbox bboy bbdx bbdy)") (* ;  "if bbdx and bbdy are both zero, then treat it as a space.") - (for BOX in BOXLIST bind (STARTWORD BBOX BBOY BBDX BBDY) collect (SETQ BBOX (fetch BBOX of BOX)) (SETQ BBOY (fetch BBOY of BOX)) @@ -318,7 +311,6 @@ ((AND (ZEROP BBDX) (ZEROP BBDY)) (* ;  "we've found a Space. Smash in a quarter of the maximum width. Maybe should be an explicit em?") - (IMAX 2 (FOLDLO (IPLUS 2 (fetch (FONTBOUNDINGBOX FBBBDX) of FBBOX)) 4))) (T (COND @@ -327,14 +319,12 @@ (T (IPLUS BBDX (IMAX 0 BBOX]) (\GETFBB - [LAMBDA (BOXLIST) (* jds "17-May-85 10:22") + [LAMBDA (BOXLIST) (* jds "17-May-85 10:22") (* ;  "Read a font bounding box from an AC file") - - (PROG (RESULTLIST CHARCOUNT BBLIST MAXBBOX MAXBBOY MINBBOX MINBBOY MAXSUMBBOXBBDX MAXSUMBBOYBBDY + (PROG (RESULTLIST CHARCOUNT BBLIST MAXBBOX MAXBBOY MINBBOX MINBBOY MAXSUMBBOXBBDX MAXSUMBBOYBBDY BBOX BBOY BBDX BBDY) (* ;  "\GETFBB returns the fbbdx fbbdy fbbox fbboy of an acfont") - (SETQ MINBBOX 32767) (SETQ MINBBOY 32767) (SETQ MAXBBOX -32768) @@ -347,11 +337,9 @@ (SETQ BBDY (fetch (BOUNDINGBOX BBDY) of BOX)) (* ;  "GETACCHARSPECS returns bbox bboy bbdx bbdy") - (COND [(IEQP BBDY -1) (* ;  "This character doesn't exist. Create a dummy bounding box for it") - (SETQ BBLIST '(0 0 0 -1] (T (COND ((IGREATERP BBOX MAXBBOX) @@ -375,25 +363,22 @@ (SETQ MAXSUMBBOYBBDY (IPLUS BBOY BBDY] (* ;  "\GETFBB returns the fbbdx fbbdy fbbox fbboy of an acfont") - (RETURN (create FONTBOUNDINGBOX - FBBBDX _ (IDIFFERENCE MAXSUMBBOXBBDX MINBBOX) - FBBBDY _ (IDIFFERENCE MAXSUMBBOYBBDY MINBBOY) - FBBBOX _ MINBBOX - FBBBOY _ MINBBOY]) + FBBBDX ↠(IDIFFERENCE MAXSUMBBOXBBDX MINBBOX) + FBBBDY ↠(IDIFFERENCE MAXSUMBBOYBBDY MINBBOY) + FBBBOX ↠MINBBOX + FBBBOY ↠MINBBOY]) (\ACCHARPOSLIST - [LAMBDA (FILE STARTCHAR ENDCHAR) (* jds "10-NOV-83 20:19") + [LAMBDA (FILE STARTCHAR ENDCHAR) (* jds "10-NOV-83 20:19") (* ;  "\ACCHARPOSLIST returns the word position of the raster for the nth character of the file") - [SETFILEPTR FILE (IPLUS 48 (ITIMES 16 (ADD1 (IDIFFERENCE ENDCHAR STARTCHAR] - (bind HIWORD LOWORD [DIRECTORYSTART _ (IPLUS 48 (ITIMES 16 (ADD1 (IDIFFERENCE ENDCHAR STARTCHAR] + (bind HIWORD LOWORD [DIRECTORYSTART ↠(IPLUS 48 (ITIMES 16 (ADD1 (IDIFFERENCE ENDCHAR STARTCHAR] first (SETFILEPTR FILE DIRECTORYSTART) for X from STARTCHAR to ENDCHAR collect (SETQ HIWORD (\WIN FILE)) (SETQ LOWORD (\WIN FILE)) (* ;  "If the position of the acchar is given as -1,-1 then the raster does not exist so return nil") - (COND ((AND (IEQP HIWORD 65535) (IEQP LOWORD 65535)) @@ -404,13 +389,13 @@ (\ACROTATECHAR [LAMBDA (BITMAP) (* ; "Edited 28-Jul-87 18:49 by Snow") - - (* ;; "(prog (new.bitmap (width (|fetch| (bitmap bitmapwidth) |of| bitmap)) (height (|fetch| (bitmap bitmapheight) |of| bitmap))) (setq new.bitmap (bitmapcreate height width)) (|for| y |from| 0 |to| (sub1 height) |do| (|for| x |from| 0 |to| (sub1 width) |bind| (y1 _ (idifference (sub1 height) y)) |do| (bitmapbit new.bitmap y1 x (bitmapbit bitmap x y)))) (return new.bitmap))") + + (* ;; "(prog (new.bitmap (width (|fetch| (bitmap bitmapwidth) |of| bitmap)) (height (|fetch| (bitmap bitmapheight) |of| bitmap))) (setq new.bitmap (bitmapcreate height width)) (|for| y |from| 0 |to| (sub1 height) |do| (|for| x |from| 0 |to| (sub1 width) |bind| (y1 ↠(idifference (sub1 height) y)) |do| (bitmapbit new.bitmap y1 x (bitmapbit bitmap x y)))) (return new.bitmap))") (ROTATE-BITMAP-LEFT BITMAP]) (\FACECODE - [LAMBDA (FACE) (* rmk%: "27-FEB-81 12:16") + [LAMBDA (FACE) (* rmk%: "27-FEB-81 12:16") (IPLUS (SELECTQ (fetch (FONTFACE EXPANSION) of FACE) (REGULAR 0) (COMPRESSED 6) @@ -427,13 +412,13 @@ (SHOULDNT]) (\FAMILYCODE - [LAMBDA (FAMILY WSTRM) (* rmk%: "11-Sep-84 10:54") - - (* ;; "Returns the family CODE for FAMILY in a standard widths file, leaving the file positioned at the beginning of the next file entry. Returns NIL if FAMILY not found. If FAMILY is T, returns the code for the first family in the index.") + [LAMBDA (FAMILY WSTRM) (* rmk%: "11-Sep-84 10:54") + + (* ;; "Returns the family CODE for FAMILY in a standard widths file, leaving the file positioned at the beginning of the next file entry. Returns NIL if FAMILY not found. If FAMILY is T, returns the code for the first family in the index.") (SETFILEPTR WSTRM 0) - (bind TYPE CODE LENGTH (NCHARS _ (NCHARS FAMILY)) - (NEXT _ 0) + (bind TYPE CODE LENGTH (NCHARS ↠(NCHARS FAMILY)) + (NEXT ↠0) do (SETFILEPTR WSTRM NEXT) (SETQ TYPE (\BIN WSTRM)) (SETQ LENGTH (\BIN WSTRM)) @@ -448,16 +433,264 @@ (for I from 1 to NCHARS always (EQ (\BIN WSTRM) (NTHCHARCODE FAMILY I] (SETFILEPTR WSTRM NEXT) (* ; "Move file to next entry") - (RETURN CODE)))) (0 (RETURN NIL)) NIL]) ) -(ADDTOVAR DISPLAYCHARSETFNS (AC ACFONT.FILEP ACFONT.GETCHARSET)) +(PUTPROPS ACFONT FILETYPE CL:COMPILE-FILE) + +(APPENDTOVAR DISPLAYCHARSETFNS '(AC ACFONT.FILEP ACFONT.GETCHARSET)) + + + +(* ; "STRIKE format files") + +(DEFINEQ + +(STRIKEFONT.FILEP + [LAMBDA (FILE) (* ; "Edited 15-May-2025 17:47 by rmk") + + (* ;; "If high bit of type is on, then must be strike. If 2nd bit is on, must be strike-index, and we punt. We don't care about the 3rd bit") + + (* ;; "first word has high bits (onebit index fixed). Onebit means 'new-style font' , index is 0 for simple strike, 1 for index, and fixed is if all chars have max width. Lisp doesn't care about 'fixed'") + + (RESETLST + (CL:UNLESS (OPENP FILE 'INPUT) + [RESETSAVE (SETQ FILE (OPENSTREAM FILE 'INPUT 'OLD)) + `(PROGN (CLOSEF? OLDVALUE]) + (CL:WHEN [MEMB (\WIN FILE) + (CONSTANT (LIST (LLSH 1 15) + (LOGOR (LLSH 1 15) + (LLSH 1 13] + T))]) + +(STRIKEFONT.GETCHARSET + [LAMBDA (STRM) (* ; "Edited 3-Aug-2025 22:27 by rmk") + (* ; "Edited 1-Aug-2025 23:50 by rmk") + (* ; "Edited 14-Jul-2025 19:52 by rmk") + (* ; "Edited 9-Jun-2025 14:22 by rmk") + (* ; "Edited 12-Jul-2022 09:19 by rmk") + (* ; "Edited 4-Dec-92 12:11 by jds") + + (* ;; "STRM has already been determined to be a vanilla strike-format file holding only the desired charset.") + (* ; "returns a charsetinfo") + (RESETLST + (CL:UNLESS (\GETSTREAM STRM 'INPUT T) + [RESETSAVE (SETQ STRM (OPENSTREAM STRM 'INPUT 'OLD)) + `(PROGN (CLOSEF? OLDVALUE]) + (SETFILEPTR STRM 0) + (CL:UNLESS (STRIKEFONT.FILEP STRM) + (ERROR "Not a STRIKE font file" STRM)) + (CL:UNLESS (EQ 2 (GETFILEPTR STRM)) + (SETFILEPTR STRM 2)) + (LET (CSINFO NUMBCODES RW BITMAP OFFSETS FIRSTCHAR LASTCHAR HEIGHT WIDTHS) + (SETQ CSINFO (create CHARSETINFO)) + (SETQ FIRSTCHAR (\WIN STRM)) (* ; "minimum ascii code") + (SETQ LASTCHAR (\WIN STRM)) (* ; "maximum ascii code") + (\WIN STRM) (* ; + "MaxWidth which isn't used by anyone.") + (\WIN STRM) (* ; + "number of words in this StrikeBody") + (replace (CHARSETINFO CHARSETASCENT) of CSINFO with (\WIN STRM)) + (* ; + "ascent in scan lines (=FBBdy+FBBoy)") + (replace (CHARSETINFO CHARSETDESCENT) of CSINFO with (\WIN STRM)) + (* ; "descent in scan-lines (=FBBoy)") + (\WIN STRM) (* ; + "offset in bits (<0 for kerning, else 0, =FBBox)") + (SETQ RW (\WIN STRM)) (* ; "raster width of bitmap") + (* ; "height of bitmap") + + (* ;; "JDS 12/4/92: Apparently, these fields can be signed values, if all chars, e.g., ride above the base line.") + + (SETQ HEIGHT (IPLUS (SIGNED (fetch (CHARSETINFO CHARSETASCENT) of CSINFO) + 16) + (SIGNED (fetch (CHARSETINFO CHARSETDESCENT) of CSINFO) + 16))) + (SETQ BITMAP (BITMAPCREATE (UNFOLD RW BITSPERWORD) + HEIGHT)) + (\BINS STRM (fetch BITMAPBASE of BITMAP) + 0 + (UNFOLD (ITIMES RW HEIGHT) + BYTESPERWORD)) (* ; "read bits into bitmap") + (replace (CHARSETINFO CHARSETBITMAP) of CSINFO with BITMAP) + (SETQ NUMBCODES (IDIFFERENCE (ADD1 LASTCHAR) + FIRSTCHAR)) + (SETQ OFFSETS (fetch (CHARSETINFO OFFSETS) of CSINFO)) + + (* ;; + "Initialize the offsets to 0, all but FIRSTCHAR to be replaced with the slug offset") + + (for I from 0 to (IPLUS \MAXTHINCHAR 2) do (\FSETOFFSET OFFSETS I 0)) + (for I from FIRSTCHAR as J from 1 to NUMBCODES do + (* ;; + "J starts at 1 because we know that the offset of J=0 is 0 ?") + + (\FSETOFFSET OFFSETS I (\WIN STRM))) + (for I (SLUGOFFSET ↠(\WIN STRM)) from 0 to \MAXTHINCHAR + when (EQ 0 (\FGETOFFSET OFFSETS I)) unless (EQ I FIRSTCHAR) + do (\FSETOFFSET OFFSETS I SLUGOFFSET) finally (\FSETOFFSET OFFSETS SLUGCHARINDEX + SLUGOFFSET) + + (* ;; + "There's one more so that \FONTRESETCHARWIDTHS can get the slug width, otherwise not necessary") + + (\FSETOFFSET OFFSETS (ADD1 SLUGCHARINDEX) + (\WIN STRM))) + + (* ;; "Initialize the widths to 0") + + (SETQ WIDTHS (fetch (CHARSETINFO WIDTHS) of CSINFO)) + (for I from 0 to (IPLUS \MAXTHINCHAR 2) do (\FSETWIDTH WIDTHS I 0)) + (\FONTRESETCHARWIDTHS CSINFO 0 SLUGCHARINDEX) + (replace (CHARSETINFO IMAGEWIDTHS) of CSINFO with (fetch (CHARSETINFO WIDTHS) + of CSINFO)) + CSINFO))]) + +(WRITESTRIKEFONTFILE + [LAMBDA (FONT CHARSET FILE) (* ; "Edited 30-Aug-2025 23:21 by rmk") + (* ; "Edited 28-Aug-2025 15:09 by rmk") + (* ; "Edited 24-Aug-2025 11:39 by rmk") + (* ; "Edited 3-Aug-2025 22:33 by rmk") + (* ; "Edited 22-May-2025 09:53 by rmk") + (* ; "Edited 1-Feb-2025 12:27 by mth") + (* ; "Edited 12-Jul-2022 14:36 by rmk") + (* kbr%: "21-Oct-85 15:08") + (* ; + "Write strike FILE using info in FONT. ") + (CL:UNLESS (FONTP FONT) + (LISPERROR "ILLEGAL ARG" FONT)) + (CL:UNLESS CHARSET (SETQ CHARSET 0)) + (CL:UNLESS (AND (IGEQ CHARSET 0) + (ILEQ CHARSET \MAXCHARSET)) + (LISPERROR "ILLEGAL ARG" CHARSET)) + (LET (STREAM CSINFO FIRSTCHAR LASTCHAR WIDTHS MAXWIDTH LENGTH RASTERWIDTH SLUGOFFSET OFFSETS) + (SETQ CSINFO (\INSURECHARSETINFO FONT CHARSET)) + (CL:UNLESS CSINFO (ERROR "Couldn't find charset " CHARSET)) + (SETQ WIDTHS (fetch (CHARSETINFO WIDTHS) of CSINFO)) + (SETQ OFFSETS (fetch (CHARSETINFO OFFSETS) of CSINFO)) + (SETQ SLUGOFFSET (\FGETOFFSET OFFSETS SLUGCHARINDEX)) + + (* ;; "Find the first and last non-slug characters") + + [SETQ FIRSTCHAR (for I from 0 to \MAXTHINCHAR thereis (NEQ SLUGOFFSET (\FGETOFFSET OFFSETS I + ] + [SETQ LASTCHAR (for I from \MAXTHINCHAR to 0 by -1 thereis (NEQ SLUGOFFSET (\FGETOFFSET + OFFSETS I] + [SETQ STREAM (OPENSTREAM FILE 'OUTPUT 'NEW '((TYPE BINARY] + (\WOUT STREAM 32768) (* ; "STRIKE HEADER. ") + (\WOUT STREAM FIRSTCHAR) + (\WOUT STREAM LASTCHAR) + (SETQ MAXWIDTH 0) + [for I from 0 to SLUGCHARINDEX do (SETQ MAXWIDTH (IMAX MAXWIDTH (\FGETWIDTH WIDTHS I] + (\WOUT STREAM MAXWIDTH) (* ; "STRIKE BODY. ") + (* ; "Length. ") + (SETQ RASTERWIDTH (fetch (BITMAP BITMAPRASTERWIDTH) of (fetch (CHARSETINFO CHARSETBITMAP) + of CSINFO))) + (SETQ LENGTH (IPLUS 8 (IDIFFERENCE LASTCHAR FIRSTCHAR) + (ITIMES (fetch (FONTDESCRIPTOR \SFHeight) of FONT) + RASTERWIDTH))) + (\WOUT STREAM LENGTH) (* ; + "Ascent, Descent, Xoffset (no longer used) and Rasterwidth. ") + (\WOUT STREAM (fetch (CHARSETINFO CHARSETASCENT) of CSINFO)) + (\WOUT STREAM (fetch (CHARSETINFO CHARSETDESCENT) of CSINFO)) + (\WOUT STREAM 0) + (\WOUT STREAM RASTERWIDTH) (* ; "Bitmap. ") + [\BOUTS STREAM (fetch (BITMAP BITMAPBASE) of (fetch (CHARSETINFO CHARSETBITMAP) of CSINFO)) + 0 + (ITIMES 2 RASTERWIDTH (IPLUS (fetch (CHARSETINFO CHARSETASCENT) of CSINFO) + (fetch (CHARSETINFO CHARSETDESCENT) of CSINFO] + (* ; "Offsets. ") + [for I (OFFSET ↠0) from FIRSTCHAR to LASTCHAR first (\WOUT STREAM OFFSET) + (* ; "Offset of the first char") + do (CL:UNLESS (EQ SLUGOFFSET (\FGETOFFSET OFFSETS I)) + (* ; + "The slug isn't really here in the bitmap") + (ADD OFFSET (\FGETWIDTH WIDTHS I))) + (\WOUT STREAM OFFSET) finally (* ; + "Offset for the after-slug, for width") + (\WOUT STREAM (IPLUS OFFSET (\FGETWIDTH WIDTHS + SLUGCHARINDEX] + (CLOSEF STREAM]) + +(STRIKECSINFO + [LAMBDA (CSINFO) (* ; "Edited 27-Apr-89 13:39 by atm") + + (* ;; "Returns a STRIKE type font descriptor (EQ WIDTHS IMAGEWIDTHS), cause we know how to write those guys out (they read quicker but display slower). If (EQ WIDTHS IMAGEWIDTHS), just return original.") + + (PROG (WIDTHS OFFSETS IMWIDTHS OLDBM BMWIDTH BMHEIGHT NEWBM NEWOFFSET NEWWIDTH OLDOFFSET + DUMMYOFFSET NEWOFFSETS) + (SETQ WIDTHS (fetch (CHARSETINFO WIDTHS) of CSINFO)) + (SETQ IMWIDTHS (fetch (CHARSETINFO IMAGEWIDTHS) of CSINFO)) + (if (EQ WIDTHS IMWIDTHS) + then (RETURN CSINFO)) + (SETQ OFFSETS (fetch (CHARSETINFO OFFSETS) of CSINFO)) + (SETQ OLDBM (fetch (CHARSETINFO CHARSETBITMAP) of CSINFO)) + (SETQ DUMMYOFFSET (\FGETOFFSET OFFSETS 256)) + (SETQ BMHEIGHT (BITMAPHEIGHT OLDBM)) + [SETQ BMWIDTH (for I from 0 to \MAXTHINCHAR + sum (if (IEQP DUMMYOFFSET (\FGETOFFSET OFFSETS I)) + then 0 + else (IMAX (\FGETIMAGEWIDTH IMWIDTHS I) + (\FGETWIDTH WIDTHS I] + + (* ;; "") + + (* ;; "Initialize new offsets vector") + + (* ;; "") + + (SETQ NEWOFFSETS (\CREATECSINFOELEMENT)) + (for I from 0 to (IPLUS \MAXTHINCHAR 2) do (\FSETOFFSET NEWOFFSETS I 0)) + (\FSETOFFSET NEWOFFSETS (ADD1 \MAXTHINCHAR) + BMWIDTH) + + (* ;; "") + + (* ;; "Adjust bitmap with so width = imagewidth, fill offsets") + + (* ;; "") + + (SETQ NEWBM (BITMAPCREATE BMWIDTH BMHEIGHT 1)) + (SETQ NEWOFFSET 0) + [for I from 0 to 255 do (SETQ OLDOFFSET (\FGETOFFSET OFFSETS I)) + (if (IEQP DUMMYOFFSET OLDOFFSET) + then (\FSETOFFSET NEWOFFSETS I BMWIDTH) + else (\FSETOFFSET NEWOFFSETS I NEWOFFSET) + (SETQ NEWWIDTH (IMAX (\FGETIMAGEWIDTH IMWIDTHS I) + (\FGETWIDTH WIDTHS I))) + (BITBLT OLDBM OLDOFFSET 0 NEWBM NEWOFFSET 0 (\FGETWIDTH + IMWIDTHS I) + BMHEIGHT + 'REPLACE) + (SETQ NEWOFFSET (IPLUS NEWOFFSET NEWWIDTH] + + (* ;; "") + + (* ;; "Make new CSInfo record withs IMAGEWIDTHS, WIDTHS the same") + + (* ;; "") + + (SETQ WIDTHS (COPYALL WIDTHS)) + [for I from 0 to \MAXTHINCHAR do (\FSETWIDTH WIDTHS I (IMAX (\FGETWIDTH WIDTHS I) + (\FGETIMAGEWIDTH IMWIDTHS I] + (RETURN (create CHARSETINFO + WIDTHS ↠WIDTHS + OFFSETS ↠NEWOFFSETS + IMAGEWIDTHS ↠WIDTHS + CHARSETBITMAP ↠NEWBM + YWIDTHS ↠(fetch (CHARSETINFO YWIDTHS) of CSINFO) + CHARSETASCENT ↠(fetch (CHARSETINFO CHARSETASCENT) of CSINFO) + CHARSETDESCENT ↠(fetch (CHARSETINFO CHARSETDESCENT) of CSINFO]) +) + +(APPENDTOVAR DISPLAYCHARSETFNS '(STRIKE STRIKEFONT.FILEP STRIKEFONT.GETCHARSET)) (DECLARE%: DONTCOPY - (FILEMAP (NIL (2626 27417 (ACFONT.FILEP 2636 . 3520) (ACFONT.GETCHARSET 3522 . 3914) (\READACFONTBOXES - 3916 . 6143) (\READACFONTFILE 6145 . 18986) (\ACCHARIMAGELIST 18988 . 19345) (\ACCHARWIDTHLIST 19347 - . 20613) (\GETFBB 20615 . 23895) (\ACCHARPOSLIST 23897 . 24947) (\ACROTATECHAR 24949 . 25513) ( -\FACECODE 25515 . 26109) (\FAMILYCODE 26111 . 27415))))) + (FILEMAP (NIL (2704 27651 (ACFONT.FILEP 2714 . 3598) (ACFONT.GETCHARSET 3600 . 4210) (\READACFONTBOXES + 4212 . 6436) (\READACFONTFILE 6438 . 19287) (\ACCHARIMAGELIST 19289 . 19626) (\ACCHARWIDTHLIST 19628 + . 20888) (\GETFBB 20890 . 24168) (\ACCHARPOSLIST 24170 . 25216) (\ACROTATECHAR 25218 . 25768) ( +\FACECODE 25770 . 26360) (\FAMILYCODE 26362 . 27649)) (27814 42811 (STRIKEFONT.FILEP 27824 . 28712) ( +STRIKEFONT.GETCHARSET 28714 . 34304) (WRITESTRIKEFONTFILE 34306 . 39215) (STRIKECSINFO 39217 . 42809)) +))) STOP diff --git a/sources/ACFONT.DFASL b/sources/ACFONT.DFASL new file mode 100644 index 000000000..f5acc7caf Binary files /dev/null and b/sources/ACFONT.DFASL differ diff --git a/sources/AFONT.DFASL b/sources/AFONT.DFASL deleted file mode 100644 index 9338e3cfc..000000000 Binary files a/sources/AFONT.DFASL and /dev/null differ diff --git a/sources/FILESETS b/sources/FILESETS index 15ac01f15..2feef07fc 100644 --- a/sources/FILESETS +++ b/sources/FILESETS @@ -1,12 +1,12 @@ -(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10) +(DEFINE-FILE-INFO :PACKAGE "INTERLISP" :READTABLE "INTERLISP" :BASE 10) -(FILECREATED "23-Feb-2026 10:32:36" {WMEDLEY}FILESETS.;32 6226 +(FILECREATED "26-Apr-2026 11:53:54" {FOO}FILESETS.;37 6268 :EDIT-BY rmk - :CHANGES-TO (VARS 0LISPSET) + :CHANGES-TO (VARS 1LISPSET 0LISPSET) - :PREVIOUS-DATE "23-Feb-2026 09:36:51" {WMEDLEY}FILESETS.;31) + :PREVIOUS-DATE "16-Apr-2026 09:01:52" {WMEDLEY}FILESETS.;34) (PRETTYCOMPRINT FILESETSCOMS) @@ -50,15 +50,16 @@ (RPAQQ 0LISPSET (PACKAGE-CONVERSION-TABLE LLFAULT LLSUBRS LLBFS LLNEW FILEIO LLARRAYELT EXTERNALFORMAT IOCHAR UNICODE-FORMATS IMAGEIO LLBASIC LLGC LLINTERP LLMVS - DEFSTRUCT-RUN-TIME SETF-RUNTIME CMLSEQBASICS LLARITH LLFLOAT LLBIGNUM LLREAD + DEFSTRUCT-RUN-TIME SETF-RUNTIME CMLSEQBASICS LLARITH LLFLOAT LLREAD LLBIGNUM MCCS LLCHAR LLSTK LLDATATYPE LLKEY LLTIMER)) (RPAQQ 1LISPSET (ASTACK DTDECLARE ATBL LLCODE ACODE COREIO AOFD ADIR PMAP VANILLADISK ATERM APRINT ABASIC AERROR AINTERRUPT MISC BOOTSTRAP CMLMACROS CMLEVAL CMLPROGV CMLSPECIALFORMS LLRESTART LLERROR LLSYMBOL LLPACKAGE PACKAGE-STARTUP CONDITION-PACKAGE XCL-PACKAGE PROC CMLARRAY - DSK UFS UFSCALLC PASSWORDS FONT MEDLEYFONTFORMAT APUTDQ COMPATIBILITY DMISC CMLMACROS - CMLLIST CMLCHARACTER CMLREADTABLE MAIKOLOADUPFNS MAIKOBITBLT MAIKOINIT LLDISPLAY)) + DSK UFS UFSCALLC PASSWORDS PSEUDOHOSTS MEDLEYDIR FONT MEDLEYFONTFORMAT MCCSFONTS APUTDQ + COMPATIBILITY DMISC CMLMACROS CMLLIST CMLCHARACTER CMLREADTABLE MAIKOLOADUPFNS + MAIKOBITBLT MAIKOINIT LLDISPLAY)) (RPAQQ 2LISPSET (MACHINEINDEPENDENT)) diff --git a/sources/FONT b/sources/FONT index 1a92ec841..89c7010cd 100644 --- a/sources/FONT +++ b/sources/FONT @@ -1,57 +1,58 @@ (DEFINE-FILE-INFO :PACKAGE "INTERLISP" :READTABLE "INTERLISP" :BASE 10 :FORMAT :UTF-8) -(FILECREATED "26-Feb-2026 17:01:47" {WMEDLEY}FONT.;677 278005 +(FILECREATED " 5-May-2026 09:56:41" {MEDLEY}FONT.;797 260815 :EDIT-BY rmk - :CHANGES-TO (FNS MOVEFONTCHARS) + :CHANGES-TO (FNS \CREATEDISPLAYFONT FONTSPEC.TO.FONTDESCRIPTOR) - :PREVIOUS-DATE "20-Feb-2026 12:54:44" {WMEDLEY}FONT.;675) + :PREVIOUS-DATE " 4-May-2026 12:39:02" {MEDLEY}FONT.;796) (PRETTYCOMPRINT FONTCOMS) (RPAQQ FONTCOMS [ - (* ;; "font functions ") + (* ;; "Font functions ") (FNS CHARWIDTH CHARWIDTHY STRINGWIDTH \CHARWIDTH.DISPLAY \STRINGWIDTH.DISPLAY \STRINGWIDTH.GENERIC) (COMS (FNS DEFAULTFONT FONTCLASS FONTCLASSUNPARSE FONTCLASSCOMPONENT SETFONTCLASSCOMPONENT GETFONTCLASSCOMPONENT) (MACROS \GETFONTCLASSCOMPONENT \SETFONTCLASSCOMPONENT)) - (VARS NSFONTFAMILIES ALTOFONTFAMILIES) - (INITVARS MCCSFONTFAMILIES) (COMS (* ;; "Creation: ") (FNS FONTCREATE FONTCREATE1 FONTCREATE.SLUGFD \FONT.CHECKARGS1 \FONTCREATE1.NOFN - FONTFILEP \READCHARSET) + FONTFILEP \READCHARSET FONTCHARSETS) (FNS \FONT.CHECKARGS \CHARSET.CHECK) (FNS COERCEFONTSPEC COERCEFONTSPEC.TARGETFACE) (DECLARE%: EVAL@COMPILE DONTCOPY (MACROS COERCEFONTSPEC.MATCH COERCEFONTSPEC.TARGET)) (MACROS SPREADFONTSPEC) - (FNS MAKEFONTSPEC) + (FNS MAKEFONTSPEC FONTSPEC.TO.FONTDESCRIPTOR) (FNS COMPLETE.FONT COMPLETEFONTP COMPLETE.CHARSET PRUNESLUGCSINFOS MONOSPACEFONTP)) (COMS (* ;; "Property extraction:") (FNS FONTASCENT FONTDESCENT FONTHEIGHT FONTPROP \AVGCHARWIDTH) (EXPORT (OPTIMIZERS FONTPROP)) - (FNS FONTDEVICEPROP)) + (FNS FONTDEVICEPROP) + (PROP ARGNAMES FONTDEVICEPROP)) (COMS (* ; "Moving character information") (FNS EDITCHAR) (* ; "Should this be on EDITFONT ?") (FNS GETCHARBITMAP PUTCHARBITMAP \GETCHARBITMAP.CSINFO \PUTCHARBITMAP.CSINFO) (FNS MOVECHARBITMAP MOVEFONTCHARS \MOVEFONTCHAR \MOVEFONTCHARS.SOURCEDATA \MAKESLUGCHAR - SLUGCHARP.DISPLAY) + SLUGCHARP) + [DECLARE%: DONTCOPY (EXPORT (CONSTANTS (SLUGCHARINDEX (ADD1 \MAXTHINCHAR] + (* ; "At the end of each csinfo") (MACROS UPDATEINFOELEMENT)) (FNS FONTFILES \FINDFONTFILE \FONTFILENAMES \FONTFILENAME FONTSPECFROMFILENAME) (FNS FONTCOPY FONTP FONTUNPARSE SETFONTDESCRIPTOR \STREAMCHARWIDTH \COERCECHARSET \BUILDSLUGCSINFO \FONTSYMBOL \DEVICESYMBOL \FONTFACE \FONTFACE.COLOR SETFONTCHARENCODING ) (FNS FONTSAVAILABLE FONTEXISTS? \SEARCHFONTFILES FLUSHFONTCACHE FINDFONTFILES SORTFONTSPECS) - (FNS MATCHFONTFACE MAKEFONTFACE FONTFACETOATOM) + (FNS MATCHFONTFACE MAKEFONTFACE FONTFACETOATOM FONTFACE.STARS) (INITVARS \FONTSINCORE \FONTEXISTS?-CACHE \FONTSAVAILABLEFILECACHE \DEFAULTDEVICEFONTS) (* ;; "The INITVARS value of MEDLEY-INIT-VARS in MEDLEY dalso includes these entries. That's because FONT is in the INIT, so these entries would be lost when MEDLEY-INIT-VARS is reinitialized when the Lisp loadup starts") @@ -62,15 +63,14 @@ (INITVARS \UNITWIDTHSVECTOR) (FNS \UNITWIDTHSVECTOR) (DECLARE%: DONTEVAL@LOAD DOCOPY (P (\UNITWIDTHSVECTOR] - (DECLARE%: DONTCOPY [EXPORT (RECORDS FONTCLASS FONTDESCRIPTOR FONTFACE CHARSETINFO FONTSPEC) + (DECLARE%: DONTCOPY (EXPORT (RECORDS FONTCLASS FONTDESCRIPTOR FONTFACE CHARSETINFO FONTSPEC) (MACROS FONTASCENT FONTDESCENT FONTHEIGHT \FGETOFFSET \FSETOFFSET \FGETWIDTH \FSETWIDTH \FGETCHARWIDTH \FSETCHARWIDTH - \FGETIMAGEWIDTH \FSETIMAGEWIDTH) + \FGETIMAGEWIDTH \FSETIMAGEWIDTH MAXCHARSET) (MACROS \GETCHARSETINFO \SETCHARSETINFO \INSURECHARSETINFO - \CREATECSINFOELEMENT \CREATEFONTCHARSETVECTOR CHARSETPROP) - (PROP ARGNAMES CHARSETPROP) - (CONSTANTS (SLUGCHARINDEX (ADD1 \MAXTHINCHAR)) - (SLUGCHARSET (ADD1 \MAXCHARSET] + \CREATECSINFOELEMENT \CREATEFONTCHARSETVECTOR CHARSETPROP + SLUGCSINFO) + (PROP ARGNAMES CHARSETPROP)) (MACROS INDIRECTCHARSETP)) (FNS FONTDESCRIPTOR.DEFPRINT FONTCLASS.DEFPRINT) (INITRECORDS FONTCLASS FONTDESCRIPTOR CHARSETINFO) @@ -80,8 +80,6 @@ (DECLARE%: DONTCOPY (MACROS FIRSTCHARSETCODE LASTCHARSETCODE)) (FNS \FONTRESETCHARWIDTHS) (MACROS \FGETCHARIMAGEWIDTH) - (LOCALVARS . T) - (PROP FILETYPE FONT) (* ;; "") @@ -90,115 +88,33 @@ (COMS (* ;  "Functions for DISPLAY IMAGESTREAMTYPES ") - (FNS \CREATEDISPLAYFONT \CREATECHARSET.DISPLAY \FONTEXISTS?.DISPLAY)) - (FNS STRIKEFONT.FILEP STRIKEFONT.GETCHARSET WRITESTRIKEFONTFILE STRIKECSINFO) + (FNS \CREATEDISPLAYFONT \CREATECHARSET.DISPLAY \FONTEXISTS?.DISPLAY) + (FNS FAKEFACE.CHARSET MAKEBOLD.CHAR MAKEITALIC.CHAR)) (COMS (* ; "Bitmap faking") - (FNS MAKEBOLD.CHARSET MAKEBOLD.CHAR MAKEITALIC.CHARSET MAKEITALIC.CHAR \SFMAKEBOLD - \SFMAKEITALIC) - (FNS \SFMAKEROTATEDFONT \SFROTATECSINFO \SFROTATEFONTCHARACTERS \SFROTATECSINFOOFFSETS) + (FNS \SFROTATECSINFO \SFROTATEFONTCHARACTERS \SFROTATECSINFOOFFSETS) (FNS \SFMAKECOLOR)) - (EXPORT (GLOBALVARS DISPLAYFONTDIRECTORIES DISPLAYFONTEXTENSIONS DISPLAYCHARCOERCIONS - DISPLAYFONTCOERCIONS DISPLAYCHARSETFNS)) - (DECLARE%: DONTEVAL@LOAD DOCOPY (INITVARS (DISPLAYFONTDIRECTORIES NIL)) - (ADDVARS (DISPLAYCHARSETFNS (STRIKE STRIKEFONT.FILEP STRIKEFONT.GETCHARSET))) + [DECLARE%: DONTEVAL@LOAD DOCOPY (INITVARS (DISPLAYFONTDIRECTORIES (LIST + "{MEDLEY}/fonts/medleydisplayfonts" + ))) (* ; "The loadup might have fewer") - (ADDVARS (DISPLAYFONTEXTENSIONS MEDLEYDISPLAYFONT DISPLAYFONT))) - (INITVARS [DISPLAYFONTCOERCIONS '(((HELVETICA (<= * 2)) - (HELVETICA 4)) - ((MODERN (<= 15 * 16)) - (* 14)) - ((MODERN (<= 17 * 21)) - (* 18)) - ((MODERN (<= 22 * 28)) - (* 24)) - ((MODERN (<= 29 * 33)) - (* 30)) - ((MODERN (<= 34 * 40)) - (* 36)) - ((MODERN (<= 41 * 65)) - (* 48)) - ((MODERN (<= 66 *)) - (* 72)) - ((PALATINO 9) - (PALATINO 12)) - ((PALATINO (<= * 8)) - (PALATINO 10)) - ((TITAN (<= * 9) - BOLD) - (MODERN 10)) - ((TITAN (<= * 9) - ITALIC) - (MODERN 10)) - ((TITAN (<= * 9)) - (TITAN 10)) - (LPT AMTEX] - [DISPLAYCHARCOERCIONS '((GACHA TERMINAL) - (MODERN CLASSIC) - (TIMESROMAN CLASSIC) - (HELVETICA MODERN) - (TERMINAL MODERN) - (HIPPO CLASSIC) - (CYRILLIC CLASSIC) - (MATH CLASSIC) - (SIGMA MODERN) - (SYMBOL MODERN) - (TITAN CLASSIC) - (PALATINO CLASSIC) - (OPTIMA MODERN) - (BOLDPS CLASSIC) - (PCTERMINAL CLASSIC) - (TITANLEGAL CLASSIC] - (\DEFAULTCHARSET 0)) - - (* ;; "") - - - (* ;; "Defunct coercions? Mapping for DOS filenames, Adobe equivalences") - - [COMS (INITVARS [ADOBEDISPLAYFONTCOERCIONS '(((HELVETICABLACK 16) - (HELVETICABLACK 18)) - ((SYMBOL) - (ADOBESYMBOL)) - ((SYMBOL 11) - (ADOBESYMBOL 10)) - ((AVANTGARDE-DEMI) - (AVANTGARDE)) - ((AVANTGARDE-BOOK) - (AVANTGARDE)) - ((NEWCENTURYSCHLBK) - (CENTURYSCHOOLBOOK)) - ((BOOKMAN-LIGHT) - (BOOKMAN)) - ((BOOKMAN-DEMI) - (BOOKMAN)) - ((HELVETICA-NARROW) - (HELVETICANARROW)) - ((HELVETICA 24) - (ADOBEHELVETICA 24] - (*DISPLAY-FONT-NAME-MAP* '((TIMESROMAN . TR) - (HELVETICA . HV) - (TIMESROMAND . TD) - (HELVETICAD . HD) - (MODERN . MD) - (CLASSIC . CL) - (GACHA . GC) - (TITAN . TI) - (LETTERGOTHIC . LG) - (BOLDPS . BP) - (TERMINAL . TM) - (CLASSICTHIN . CT) - (HIPPO . HP) - (LOGO . LG) - (MATH . MA) - (OLDENGLISH . OE) - (SYMBOL . SY] + (ADDVARS (DISPLAYFONTEXTENSIONS MEDLEYDISPLAYFONT)) + (INITVARS (DISPLAYFACECOERCIONS '(((* * (BOLD * *)) + (* * (MEDIUM * *))) + ((* * (* ITALIC *)) + (* * (* REGULAR *))) + ((* * (* * COMPRESSED)) + (* * (* * REGULAR] + (INITVARS (\DEFAULTCHARSET 0)) + (LOCALVARS . T) + (PROP FILETYPE FONT) (DECLARE%: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY COMPILERVARS (ADDVARS (NLAMA) (NLAML) - (LAMA FONTCOPY]) + (LAMA FONTCOPY + FONTDEVICEPROP]) -(* ;; "font functions ") +(* ;; "Font functions ") (DEFINEQ @@ -484,13 +400,6 @@ DEVICE NEWFONT)))) ) -(RPAQQ NSFONTFAMILIES (CLASSIC MODERN TERMINAL OPTIMA TITAN BOLDPS PCTERMINAL)) - -(RPAQQ ALTOFONTFAMILIES (TIMESROMAN TIMESROMAND HELVETICA HELVETICAD CLARITY BRAVOX TONTO CREAM - OLDENGLISH)) - -(RPAQ? MCCSFONTFAMILIES NIL) - (* ;; "Creation: ") @@ -544,7 +453,8 @@ (GO RETRY]) (FONTCREATE1 - [LAMBDA (FONTSPEC CHARSET) (* ; "Edited 25-Sep-2025 18:41 by rmk") + [LAMBDA (FONTSPEC CHARSET) (* ; "Edited 17-Mar-2026 23:41 by rmk") + (* ; "Edited 25-Sep-2025 18:41 by rmk") (* ; "Edited 30-Aug-2025 23:13 by rmk") (* ; "Edited 28-Aug-2025 14:32 by rmk") (* ; "Edited 26-Aug-2025 23:45 by rmk") @@ -567,8 +477,7 @@ (CL:UNLESS CHARSET (SETQ CHARSET \DEFAULTCHARSET)) (LET (FONT) (CL:WHEN (if (SETQ FONT (FETCHMULTI \FONTSINCORE FONTSPEC T)) - elseif (AND (FONTEXISTS? FONTSPEC) - (SETQ FONT (\CREATEFONT FONTSPEC))) + elseif (SETQ FONT (\CREATEFONT FONTSPEC)) then (* ;; "Storing stops internal charset recursions") @@ -581,30 +490,37 @@ FONT)]) (FONTCREATE.SLUGFD - [LAMBDA (FAMILY SIZE FACE ROTATION DEVICE CHARSET) (* ; "Edited 31-Aug-2025 14:36 by rmk") + [LAMBDA (FONTSPEC SOURCEFONT) (* ; "Edited 21-Mar-2026 09:20 by rmk") + (* ; "Edited 19-Mar-2026 20:47 by rmk") + (* ; "Edited 31-Aug-2025 14:36 by rmk") (* ; "Edited 14-Jun-2025 23:25 by rmk") (* ; "Edited 13-Jun-2025 09:44 by rmk") (* ; "Edited 11-Jun-2025 10:59 by rmk") - (* ;; "For the REMEMBER case, dummy font descriptor completely fillled with a slug charsetinfo") - - (LET* ([FONTDESC (create FONTDESCRIPTOR - FONTDEVICE ↠DEVICE - FONTFAMILY ↠FAMILY - FONTSIZE ↠SIZE - FONTFACE ↠FACE - \SFAscent ↠SIZE - \SFDescent ↠0 - \SFHeight ↠SIZE - ROTATION ↠ROTATION - FONTDEVICESPEC ↠(LIST FAMILY SIZE FACE ROTATION DEVICE) - FONTCHARENCODING ↠'MCCS - FONTAVGCHARWIDTH ↠(FIXR (FTIMES SIZE 0.75] - (SLUGCSINFO (\BUILDSLUGCSINFO FONTDESC))) - (if CHARSET - then (\SETCHARSETINFO FONTDESC CHARSET SLUGCSINFO) - else (for CS from 0 to (ADD1 \MAXCHARSET) do (\SETCHARSETINFO FONTDESC CS SLUGCSINFO))) - FONTDESC]) + (* ;; + "Makes an empty fontdescriptor for FONTSPEC, with parameters taken from SOURCEFONT if given") + + (LET ((FONTDESC (if SOURCEFONT + then (create FONTDESCRIPTOR using SOURCEFONT FONTFAMILY ↠(fetch (FONTSPEC + FSFAMILY) + of FONTSPEC) + FONTSIZE ↠(fetch (FONTSPEC FSSIZE) + of FONTSPEC) + FONTFACE ↠(fetch (FONTSPEC FSFACE) + of FONTSPEC) + ROTATION ↠(fetch (FONTSPEC FSROTATION) + of FONTSPEC) + FONTDEVICE ↠(fetch (FONTSPEC FSDEVICE) + of FONTSPEC) + FONTDEVICESPEC ↠FONTSPEC FONTCHARSETVECTOR + ↠NIL) + else (FONTSPEC.TO.FONTDESCRIPTOR FONTSPEC))) + SLUGCSINFO) + (replace (FONTDESCRIPTOR FONTCHARSETVECTOR) of FONTDESC with (\CREATEFONTCHARSETVECTOR + FONTDESC)) + (SETQ SLUGCSINFO (\BUILDSLUGCSINFO)) + (for CS from 0 to (ADD1 (MAXCHARSET FONTDESC)) do (\SETCHARSETINFO FONTDESC CS SLUGCSINFO)) + FONTDESC]) (\FONT.CHECKARGS1 [LAMBDA (SPEC STREAM NOERRORFLG) (* ; "Edited 19-Feb-2026 00:03 by rmk") @@ -705,7 +621,15 @@ (CLOSEF? STRM))))]) (\READCHARSET - [LAMBDA (FONTSPEC CHARSET FONT) (* ; "Edited 14-Feb-2026 09:47 by rmk") + [LAMBDA (FONT CHARSET CHARSETFNS) (* ; "Edited 18-Apr-2026 20:44 by rmk") + (* ; "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") + (* ; "Edited 8-Mar-2026 21:41 by rmk") + (* ; "Edited 14-Feb-2026 09:47 by rmk") (* ; "Edited 6-Feb-2026 00:03 by rmk") (* ; "Edited 11-Nov-2025 14:30 by rmk") (* ; "Edited 2-Sep-2025 23:57 by rmk") @@ -720,14 +644,14 @@ (* ;; "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 FAMILY in [OR (FONTDEVICEPROP FONTSPEC 'CHARSETFNS) - '((MEDLEYFONT MEDLEYFONT.FILEP MEDLEYFONT.GETCHARSET] + (for FNS in [OR CHARSETFNS (FONTDEVICEPROP FONT 'CHARSETFNS) + '((MEDLEYFONT MEDLEYFONT.FILEP MEDLEYFONT.GETCHARSET] do [RESETSAVE (SETQ STRM (OPENSTREAM FILE 'INPUT)) `(PROGN (CLOSEF? OLDVALUE] (CL:WHEN (CAR (NLSETQ (APPLY* (CADR FNS) @@ -742,22 +666,16 @@ (* ;; "The file didn't know its own encoding") - (SETQ FAMILY (fetch (FONTSPEC FSFAMILY) of FONTSPEC)) (CHARSETPROP CSINFO 'CSCHARENCODING - (if (OR (NEQ CHARSET 0) - (MEMB FAMILY MCCSFONTFAMILIES)) - then 'MCCS - elseif (MEMB FAMILY NSFONTFAMILIES) - then 'XCCS$ - elseif (MEMB FAMILY ALTOFONTFAMILIES) - then 'ALTOTEXT - else FAMILY))) - - (* ;; "Remember the file that this basic charset information came from, before any character coercions, for informational purposes. Path and version won't be valid if sysout moves, or if PSEUDOFILENAME's aren't aligned. Don't want files to be new atoms, for loadup.") - - (CHARSETPROP CSINFO 'FILE (MKSTRING (PSEUDOFILENAME FILE))) + (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 (CL:IF (type? FONTSPEC FONT) + FONT + (FONTPROP FONT + 'DEVICESPEC))]) (replace (CHARSETINFO CHARSETNO) of CSINFO with CHARSET) (RETURN))) @@ -765,6 +683,14 @@ (CLOSEF? STRM)) (CL:WHEN CSINFO (RETURN CSINFO)))))]) + +(FONTCHARSETS + [LAMBDA (FONT) (* ; "Edited 26-Mar-2026 12:46 by rmk") + + (* ;; "Returns a list of the charset numbers for nonempty instantiated charsets.") + + (for CSNO CSINFO from 0 to (MAXCHARSET FONT) when (SETQ CSINFO (\GETCHARSETINFO FONT CSNO)) + unless (fetch (CHARSETINFO CSSLUGP) of CSINFO) collect CSNO]) ) (DEFINEQ @@ -886,7 +812,9 @@ (DEFINEQ (COERCEFONTSPEC - [LAMBDA (FONTSPEC COERCIONS ALL) (* ; "Edited 22-Dec-2025 22:56 by rmk") + [LAMBDA (FONTSPEC COERCIONS ALL MISSINGOK) (* ; "Edited 2-Apr-2026 00:08 by rmk") + (* ; "Edited 11-Mar-2026 10:18 by rmk") + (* ; "Edited 22-Dec-2025 22:56 by rmk") (* ; "Edited 18-Dec-2025 16:06 by rmk") (* ; "Edited 2-Dec-2025 17:24 by rmk") (* ; "Edited 25-Nov-2025 20:37 by rmk") @@ -947,20 +875,12 @@ (EQUAL FACE TFACE) (EQ ROTATION TROTATION] (MAKEFONTSPEC TFAMILY TSIZE TFACE TROTATION DEVICE] - unless (MEMBER COERCED RESULT) - when (SETQ COERCED (if (FONTEXISTS? COERCED NIL NIL NIL NIL T) - then (CONS COERCED) - elseif ALL - then (COERCEFONTSPEC COERCED COERCIONS T) - elseif (SETQ COERCED (COERCEFONTSPEC COERCED COERCIONS)) - then (CONS COERCED))) do - - (* ;; "If COERCED exists, it's a singleton whether or not ALL. We always inflate it to a list, to simplify code") + unless (MEMBER COERCED RESULT) when (OR MISSINGOK (FONTEXISTS? COERCED T)) + do + (* ;; "If COERCED exists, it's a singleton whether or not ALL. We always inflate it to a list, to simplify code") - (for C in COERCED - unless (MEMBER C RESULT) - do (push RESULT C)) - finally (RETURN (DREVERSE RESULT]) + (for C in (CONS COERCED (CL:IF ALL (COERCEFONTSPEC COERCED COERCIONS ALL MISSINGOK))) + unless (MEMBER C RESULT) do (push RESULT C)) finally (RETURN (DREVERSE RESULT]) (COERCEFONTSPEC.TARGETFACE [LAMBDA (TFACE FFACE) (* ; "Edited 22-Dec-2025 22:54 by rmk") @@ -1021,7 +941,9 @@ (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 4-May-2026 12:38 by rmk") + (* ; "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") @@ -1029,58 +951,89 @@ (* ;; "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 (LISTP FAMILY) + (SPREADFONTSPEC FAMILY)) + (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]) + +(FONTSPEC.TO.FONTDESCRIPTOR + [LAMBDA (FONTSPEC MAXCHARSET) (* ; "Edited 5-May-2026 09:55 by rmk") + (* ; "Edited 29-Mar-2026 10:29 by rmk") + (* ; "Edited 28-Mar-2026 09:29 by rmk") + (* ; "Edited 20-Mar-2026 23:57 by rmk") + (* ; "Edited 19-Mar-2026 10:24 by rmk") + (* ; "Edited 12-Mar-2026 13:29 by rmk") + (if (NULL MAXCHARSET) + then (SETQ MAXCHARSET 255) + elseif (<= 0 MAXCHARSET \MAXCHARSET) + else (\ILLEGAL.ARG MAXCHARSET)) + (LET ((FONT (create FONTDESCRIPTOR + FONTFAMILY ↠(fetch (FONTSPEC FSFAMILY) of FONTSPEC) + FONTSIZE ↠(fetch (FONTSPEC FSSIZE) of FONTSPEC) + FONTFACE ↠(COPY (fetch (FONTSPEC FSFACE) of FONTSPEC)) + ROTATION ↠(fetch (FONTSPEC FSROTATION) of FONTSPEC) + FONTDEVICE ↠(fetch (FONTSPEC FSDEVICE) of FONTSPEC) + \SFAscent ↠0 + \SFDescent ↠0 + \SFHeight ↠0 + FONTDEVICESPEC ↠(COPY (create FONTSPEC using FONTSPEC)) + MAXCHARSET ↠MAXCHARSET + FONTCHARSETVECTOR ↠NIL))) + (replace (FONTDESCRIPTOR FONTCHARSETVECTOR) of FONT with (\CREATEFONTCHARSETVECTOR FONT)) + FONT]) ) (DEFINEQ (COMPLETE.FONT - [LAMBDA (FONTSPEC EVENIFCOMPLETE) (* ; "Edited 7-Oct-2025 17:01 by rmk") - (* ; "Edited 2-Sep-2025 22:59 by rmk") - (* ; "Edited 29-Aug-2025 23:51 by rmk") - (* ; "Edited 27-Aug-2025 10:51 by rmk") + [LAMBDA (FONT EVENIFCOMPLETE) (* ; "Edited 5-Apr-2026 01:01 by rmk") + (* ; "Edited 24-Mar-2026 22:35 by rmk") + (* ; "Edited 22-Mar-2026 22:32 by rmk") + (* ; "Edited 21-Mar-2026 09:20 by rmk") + (* ; "Edited 19-Mar-2026 09:30 by rmk") + (* ; "Edited 16-Mar-2026 09:30 by rmk") + (* ; "Edited 7-Oct-2025 17:01 by rmk") (* ; "Edited 21-Jun-2025 11:37 by rmk") - (* ; "Edited 19-Jun-2025 14:42 by rmk") - (* ; "Edited 12-Jun-2025 22:06 by rmk") - (* ; "Edited 8-Jun-2025 15:57 by rmk") - (* ; "Edited 7-Jun-2025 15:18 by rmk") (* ; "Edited 23-May-2025 22:57 by rmk") - (* ; "Edited 20-May-2025 19:57 by rmk") (* ; "Edited 16-May-2025 21:26 by rmk") - (* ;; "This returns a FONTDESCRIPTOR for FONTSPEC that is complete with respect to all known character sources. A caller that wants to insure that only files sources are considered should reset \FONTSINCORE and \FONTEXISTS?-CACHE. If reset, we still get the benefit of previous completions/coercions in this run if medleyfont files have been created for them.") - - (LET ((FONT (FONTCREATE FONTSPEC))) - (SETQ FONTSPEC (FONTPROP FONT 'SPEC)) (* ; "Normalized version") - (CL:WHEN (OR EVENIFCOMPLETE (NOT (fetch (FONTDESCRIPTOR FONTCOMPLETEP) of FONT))) - (for CHARSET CSINFO from 0 to \MAXCHARSET - do (if (SETQ CSINFO (\GETCHARSETINFO FONT CHARSET)) - then (CL:WHEN EVENIFCOMPLETE - (replace (CHARSETINFO CSCOMPLETEP) of CSINFO with NIL)) - else (SETQ CSINFO (\CREATECHARSET CHARSET FONT))) - (COMPLETE.CHARSET CSINFO FONTSPEC CHARSET FONT)) - (replace (FONTDESCRIPTOR FONTCOMPLETEP) of FONT with T)) - (PRUNESLUGCSINFOS FONT) - FONT]) + (* ;; "This completes FONT with respect to all currently known character sources. A caller that wants to insure that only file sources are considered should reset \FONTSINCORE and \FONTEXISTS?-CACHE. ") + + (* ;; "This assumes that all of the fonts in the coercion chain are already complete. ") + + (LET (CHANGED) + (CL:WHEN (AND (OR EVENIFCOMPLETE (NOT (fetch (FONTDESCRIPTOR FONTCOMPLETEP) of FONT))) + (COERCEFONTSPEC (FONTPROP FONT 'SPEC) + 'CHARCOERCIONS NIL T)) + (for CHARSET from 0 to (MAXCHARSET FONT) when (COMPLETE.CHARSET FONT CHARSET) + do (SETQ CHANGED T))) + (CL:UNLESS (fetch (FONTDESCRIPTOR FONTCOMPLETEP) of FONT) + (replace (FONTDESCRIPTOR FONTCOMPLETEP) of FONT with T) + (SETQ CHANGED T)) + CHANGED]) (COMPLETEFONTP - [LAMBDA (FONT) (* ; "Edited 2-Sep-2025 22:59 by rmk") + [LAMBDA (FONT) (* ; "Edited 18-Mar-2026 23:10 by rmk") + (* ; "Edited 2-Sep-2025 22:59 by rmk") (* ; "Edited 24-May-2025 20:55 by rmk") (* ; "Edited 20-May-2025 14:37 by rmk") (* ;; "A font is incomplete if there is a NIL in any charset slot. Completing will install a charset everywhere, even if it is a slug charset.") (SETQ FONT (FONTCREATE FONT)) - (for CS from 0 to \MAXCHARSET always (\GETCHARSETINFO FONT CS]) + (for CS from 0 to (MAXCHARSET FONT) always (\GETCHARSETINFO FONT CS]) (COMPLETE.CHARSET - [LAMBDA (CSINFO FONTSPEC CHARSET FONT) (* ; "Edited 7-Sep-2025 11:23 by rmk") + [LAMBDA (FONT CHARSET) (* ; "Edited 5-Apr-2026 11:33 by rmk") + (* ; "Edited 15-Mar-2026 17:20 by rmk") + (* ; "Edited 6-Mar-2026 21:42 by rmk") + (* ; "Edited 7-Sep-2025 11:23 by rmk") (* ; "Edited 31-Aug-2025 14:36 by rmk") (* ; "Edited 28-Aug-2025 20:46 by rmk") (* ; "Edited 27-Aug-2025 12:37 by rmk") @@ -1093,39 +1046,62 @@ (* ; "Edited 8-Jun-2025 20:20 by rmk") (* ; "Edited 7-Jun-2025 13:52 by rmk") - (* ;; "CSINFO has some characters for this charset in FONT, but others may fill in from the FONTSPEC of later fonts in the coercion chain. We assume that CSINFO is or will be the charsetinfo for the charset/font described by FONTSPEC. For each missing code we look through all the possible coercions to find the first font with real information about that character. We copy that character up to CSINFO.") + (* ;; "Return T if anything changed.") - (\SETCHARSETINFO FONT CHARSET CSINFO) - (CL:UNLESS (fetch (CHARSETINFO CSCOMPLETEP) of CSINFO) - (for CODE SOURCEFONT from (FIRSTCHARSETCODE CHARSET) to (LASTCHARSETCODE CHARSET) - when [AND (SLUGCHARP.DISPLAY CODE FONT) - (SETQ SOURCEFONT (CAR (\COERCECHARSET FONTSPEC CHARSET CODE] - collect (LIST (LIST CODE SOURCEFONT) - CODE) finally (CL:WHEN $$VAL (* ; "The source is now here") - (MOVEFONTCHARS $$VAL FONT) - (CHARSETPROP CSINFO 'SOURCE FONTSPEC))) - (CL:WHEN (FONTDEVICEPROP FONT 'CHARCOERCIONS) (* ; + (LET ((FONTSPEC (FONTPROP FONT 'DEVICESPEC)) + (CSINFO (\GETCHARSETINFO FONT CHARSET)) + CHANGED) + (CL:UNLESS CSINFO + (SETQ CSINFO (SLUGCSINFO FONT)) + (SETQ CHANGED T)) + (CL:UNLESS (fetch (CHARSETINFO CSCOMPLETEP) of CSINFO) + [if (fetch (CHARSETINFO CSSLUGP) of CSINFO) + then + (* ;; "If CSINFO is a slug and there is a non-slug down the coercion chain, copy that in. Presumably that gets filed as an indirect.") + + [SETQ CSINFO (CADR (\COERCECHARSET FONTSPEC CHARSET NIL 'CHARCOERCIONS] + (CL:WHEN (AND CSINFO (NOT (fetch (CHARSETINFO CSSLUGP) of CSINFO))) + (\INSTALLCHARSETINFO FONT (COPYALL CSINFO) + CHARSET) + (SETQ CHANGED T)) + else + (* ;; "CSINFO in FONT has some characters for this charset, but others may fill in from later fonts in the coercion chain. We assume that CSINFO is or will be the charsetinfo for the charset/font described by FONTSPEC. For each missing code we look through all the possible coercions to find the first font with real information about that character. We copy that character up to CSINFO.") + + (for CODE SOURCEFONT from (FIRSTCHARSETCODE CHARSET) to (LASTCHARSETCODE CHARSET) + when [AND (SLUGCHARP CODE FONT) + (SETQ SOURCEFONT (CAR (\COERCECHARSET FONTSPEC CHARSET CODE] + collect (LIST CODE (LIST CODE SOURCEFONT)) + finally (CL:WHEN $$VAL + (MOVEFONTCHARS $$VAL FONT)(* ; "The source is now here") + (CHARSETPROP CSINFO 'SOURCE FONTSPEC)) + (CL:UNLESS (FONTDEVICEPROP FONT 'CHARCOERCIONS) + (* ;  "Maybe coercions are just being delayed") - (replace (CHARSETINFO CSCOMPLETEP) of CSINFO with T))) - CSINFO]) + (replace (CHARSETINFO CSCOMPLETEP) of CSINFO with T)) + (CL:WHEN $$VAL (SETQ CHANGED T]) + CHANGED]) (PRUNESLUGCSINFOS - [LAMBDA (FONT) (* ; "Edited 2-Sep-2025 22:59 by rmk") + [LAMBDA (FONT) (* ; "Edited 22-Mar-2026 18:21 by rmk") + (* ; "Edited 19-Mar-2026 09:29 by rmk") + (* ; "Edited 2-Sep-2025 22:59 by rmk") (* ; "Edited 31-Aug-2025 14:36 by rmk") (* ; "Edited 17-Aug-2025 19:44 by rmk") (* ; "Edited 9-Jun-2025 15:02 by rmk") (* ; "Edited 24-May-2025 21:11 by rmk") - (* ;; "Replaces slug csinfos in FONT with NIL") + (* ;; "Replaces slug csinfos in FONT with NIL, returns the number of non-slug charsets") (SETQ FONT (FONTCREATE FONT)) - (for CS CSINFO from 0 to \MAXCHARSET when (AND (SETQ CSINFO (\GETCHARSETINFO FONT CS)) - (fetch (CHARSETINFO CSSLUGP) of CSINFO)) - do (\SETCHARSETINFO FONT CS NIL)) - FONT]) + (for CS CSINFO CHANGED (NREAL ↠0) from 0 to (MAXCHARSET FONT) when (SETQ CSINFO (\GETCHARSETINFO + FONT CS)) + do (CL:IF (fetch (CHARSETINFO CSSLUGP) of CSINFO) + (\SETCHARSETINFO FONT CS NIL) + (add NREAL 1)) finally (RETURN NREAL]) (MONOSPACEFONTP - [LAMBDA (FONT CODES SKIPSLUGS RETURNVARIABLES) (* ; "Edited 12-Oct-2025 21:13 by rmk") + [LAMBDA (FONT CODES SKIPSLUGS RETURNVARIABLES) (* ; "Edited 15-Mar-2026 14:24 by rmk") + (* ; "Edited 12-Oct-2025 21:13 by rmk") (* ;; "Returns T if all the CODES are the same width. Skips slugs if SKIPSLUGHTS, returns the list of variable width characters if RETURNVARIABLES (instead of NIL).") @@ -1141,7 +1117,7 @@ (LIST (FIRSTCHARSETCODE CODES) (LASTCHARSETCODE CODES] (for CODE WIDTH from (CAR CODES) to (CADR CODES) - unless (OR (AND SKIPSLUGS (SLUGCHARP.DISPLAY CODE FONT)) + unless (OR (AND SKIPSLUGS (SLUGCHARP CODE FONT)) (EQ (OR WIDTH (SETQ WIDTH (CHARWIDTH CODE FONT))) (CHARWIDTH CODE FONT))) collect CODE finally (RETURN (if (NULL $$VAL) @@ -1175,7 +1151,10 @@ (fetch (FONTDESCRIPTOR \SFHeight) of (FONTCREATE FONTSPEC]) (FONTPROP - [LAMBDA (FONT PROP) (* ; "Edited 25-Jan-2026 20:08 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") (* ; "Edited 2-Sep-2025 22:21 by rmk") (* ; "Edited 12-Aug-2025 21:10 by rmk") @@ -1204,6 +1183,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) @@ -1249,10 +1230,22 @@ (fetch (FONTSPEC FSFACE) of (ffetch FONTDEVICESPEC of FONT)) (ffetch FONTFACE of FONT)))) (SCALE (ffetch FONTSCALE of FONT)) - (CHARSETS (for CS CSINFO (CSVECTOR ↠(ffetch FONTCHARSETVECTOR of FONT)) from 0 to - \MAXCHARSET - eachtime (SETQ CSINFO (\GETBASEPTR CSVECTOR (UNFOLD CS 2))) when CSINFO - unless (fetch (CHARSETINFO CSSLUGP) of CSINFO) collect CS)) + (CHARSETS (for CS CSINFO from 0 to (MAXCHARSET FONT) eachtime (SETQ CSINFO (\GETCHARSETINFO + FONT CS)) + when CSINFO unless (fetch (CHARSETINFO CSSLUGP) of CSINFO) collect CS)) + (MAXCHARSET (MAXCHARSET FONT)) + (NEMPTYCHARSETS + (for CS CSINFO from 0 to (MAXCHARSET FONT) eachtime (SETQ CSINFO (\GETCHARSETINFO FONT + CS)) + when CSINFO count (fetch (CHARSETINFO CSSLUGP) of CSINFO))) + (NINSTANTIATEDCHARSETS + (for CS CSINFO from 0 to (MAXCHARSET FONT) eachtime (SETQ CSINFO (\GETCHARSETINFO FONT + CS)) + when CSINFO count (NOT (fetch (CHARSETINFO CSSLUGP) of CSINFO)))) + (NUNINSTANTIATEDCHARSETS + (for CS CSINFO from 0 to (MAXCHARSET FONT) eachtime (SETQ CSINFO (\GETCHARSETINFO FONT + CS)) + count (NULL CSINFO))) (AVGCHARWIDTH (ffetch (FONTDESCRIPTOR FONTAVGCHARWIDTH) of FONT)) (FONTTOMCCSFN (ffetch FONTTOMCCSFN of FONT)) (\ILLEGAL.ARG PROP]) @@ -1273,15 +1266,16 @@ else 1]) ) (* "FOLLOWING DEFINITIONS EXPORTED") -(DEFOPTIMIZER FONTPROP (&REST ARGS) - (SELECTQ (AND (EQ (CAADR ARGS) +(DEFOPTIMIZER FONTPROP (FONT PROP &REST REST) + (SELECTQ (AND (EQ (CAR PROP) 'QUOTE) - (CADADR ARGS)) - (ASCENT `(FONTASCENT ,(CAR ARGS))) - (DESCENT `(FONTDESCENT ,(CAR ARGS))) - (HEIGHT `(FONTHEIGHT ,(CAR ARGS))) - (FONTTOMCCSFN `(fetch (FONTDESCRIPTOR FONTTOMCCSFN) - of ,(CAR ARGS))) + (CADR PROP)) + (ASCENT `(FONTASCENT ,FONT)) + (DESCENT `(FONTDESCENT ,FONT)) + (HEIGHT `(FONTHEIGHT ,FONT)) + (FONTTOMCCSFN `(fetch (FONTDESCRIPTOR FONTTOMCCSFN) of ,FONT)) + (MAXCHARSET `(MAXCHARSET ,FONT)) + (FILENAME `(fetch (FONTDESCRIPTOR FONTFILENAME) of ,FONT)) 'IGNOREMACRO)) (* "END EXPORTED DEFINITIONS") @@ -1289,23 +1283,43 @@ (DEFINEQ (FONTDEVICEPROP - [LAMBDA (FONTDEVICE PROP) (* ; "Edited 25-Aug-2025 21:23 by rmk") + [LAMBDA NARGS (* ; "Edited 8-Mar-2026 21:48 by rmk") + (* ; "Edited 2-Mar-2026 13:14 by rmk") + (* ; "Edited 1-Mar-2026 12:22 by rmk") + (* ; "Edited 25-Aug-2025 21:23 by rmk") (* ;; "Returns the value of the PROP property of the FONTDEVICE. E.g. if FONTDEVICE is DISPLAY and PROP is %"FONTCOERCIONS%", returns the value of DISPLAYFONTCOERCIONS ((HELVETICA 1)(HELVETICA 4)...)") - [if (LITATOM FONTDEVICE) - then (SETQ FONTDEVICE (\FONTSYMBOL FONTDEVICE)) - else (SETQ FONTDEVICE (\FONT.CHECKARGS FONTDEVICE)) - (SETQ FONTDEVICE (CL:IF (type? FONTDESCRIPTOR FONTDEVICE) - (FONTPROP FONTDEVICE 'DEVICE) - (fetch (FONTSPEC FSDEVICE) of FONTDEVICE))] - (CL:UNLESS FONTDEVICE - (SETQ FONTDEVICE 'DISPLAY)) - (LET ((VAR (PACK* FONTDEVICE PROP))) - (CL:WHEN (BOUNDP VAR) - (GETATOMVAL VAR]) + (CL:WHEN (ILESSP NARGS 2) + (ERROR "DEVICE/PROP not specified")) + (LET ((FONTDEVICE (ARG NARGS 1)) + (PROP (ARG NARGS 2)) + VAR) + [if (LITATOM FONTDEVICE) + then (SETQ FONTDEVICE (\FONTSYMBOL FONTDEVICE)) + else (SETQ FONTDEVICE (\FONT.CHECKARGS FONTDEVICE)) + (SETQ FONTDEVICE (CL:IF (type? FONTDESCRIPTOR FONTDEVICE) + (FONTPROP FONTDEVICE 'DEVICE) + (fetch (FONTSPEC FSDEVICE) of FONTDEVICE))] + (CL:UNLESS FONTDEVICE + (SETQ FONTDEVICE 'DISPLAY)) + (SETQ VAR (PACK* FONTDEVICE PROP)) + (if (EQ PROP 'ENCODINGFN) + then + (* ;; "The name of a function") + + (PROG1 (CL:IF (GETD VAR) + VAR) + (CL:WHEN (IGEQ NARGS 3) + (PUTD VAR (ARG NARGS 3)))) + else (PROG1 (CL:WHEN (BOUNDP VAR) + (GETATOMVAL VAR)) + (CL:WHEN (IGEQ NARGS 3) + (SETATOMVAL VAR (ARG NARGS 3))))]) ) +(PUTPROPS FONTDEVICEPROP ARGNAMES (FONTDEVICE PROP NEWVALUE)) + (* ; "Moving character information") @@ -1550,7 +1564,11 @@ NEWDESCENT]) (MOVEFONTCHARS - [LAMBDA (PAIRS DESTFONT DEFAULTSOURCEFONT) (* ; "Edited 26-Feb-2026 16:59 by rmk") + [LAMBDA (PAIRS DESTFONT DEFAULTSOURCEFONT) (* ; "Edited 9-Mar-2026 23:00 by rmk") + (* ; "Edited 7-Mar-2026 11:41 by rmk") + (* ; "Edited 4-Mar-2026 10:33 by rmk") + (* ; "Edited 1-Mar-2026 09:40 by rmk") + (* ; "Edited 26-Feb-2026 16:59 by rmk") (* ; "Edited 4-Sep-2025 11:07 by rmk") (* ; "Edited 30-Aug-2025 23:20 by rmk") (* ; "Edited 26-Aug-2025 23:10 by rmk") @@ -1566,9 +1584,13 @@ (* ;; "The character information for schar in sfont replaces the information for the destination character in the destination font.") - (* ;; "Pairs is a list of (SOURCE DEST) pairs where each source is a list of the form (schar/code sfont) or just a character, and each DEST is a destination character/code. If a pair is a character code C, it is treated as (C C).") + (* ;; "Pairs is either") + + (* ;; " a hasharray that maps destination codes to source codes") + + (* ;; " a list of (DEST SOURCE) pairs where each source is a list of the form (schar/scode sfont) or just a schar/scode, and each DEST is a destination character/code. An schar/scode of NIL designates a slug source.") - (* ;; "If a pair does not contain its own source font, then information is extracted from the DEFAULTSOURCEFONT. If the DEFAULTSOURCEFONT is not provided, thenSFONT it is assumed that the source is the DESTFONT (which must always be provided).") + (* ;; "If a pair does not contain its own source font, then information is extracted from the DEFAULTSOURCEFONT. If the DEFAULTSOURCEFONT is not provided, then it is assumed that the source is the DESTFONT (which must always be provided).") (* ;; "This collects the source information for all the pairs before it starts, to make sure that it doesn't step on itself when source and destination are the same font.") @@ -1578,41 +1600,42 @@ (FONTCREATE DEFAULTSOURCEFONT NIL NIL NIL (FONTPROP DESTFONT 'DEVICE)) DESTFONT)) - [if (HARRAYP PAIRS) - then - (* ;; "E.g. *UNICODETOMCCS*") - - [MAPHASH PAIRS (FUNCTION (LAMBDA (VAL KEY) - (CL:UNLESS (EQ VAL KEY) - (\MOVEFONTCHAR (\MOVEFONTCHARS.SOURCEDATA KEY - DEFAULTSOURCEFONT) - VAL DESTFONT))] - else (LET (PAIRINFO) - - (* ;; "Fix/check arguments, and expand out the information for all the source characters, so there is no toe-stepping if there are overlaps.") - - (SETQ PAIRINFO (for P S DCODE in PAIRS collect (CL:WHEN (SMALLP P) - (SETQ P (LIST P P))) - (SETQ DCODE (CADR P)) - (CL:UNLESS (CHARCODEP DCODE) - (SETQ DCODE (CHARCODE.DECODE - DCODE))) - (\INSURECHARSETINFO DESTFONT - (\CHARSET DCODE)) - (LIST (\MOVEFONTCHARS.SOURCEDATA - (CAR P) - DEFAULTSOURCEFONT) - DCODE))) - - (* ;; "Install source character information into the destination font. ") - - (for P in PAIRINFO do (\MOVEFONTCHAR (CAR P) - (CADR P) - DESTFONT]) + (LET (PAIRINFO) + + (* ;; "Collect and execute at the end, so that we have validated all of the source information before making any changes. ") + + [if (HARRAYP PAIRS) + then + (* ;; "E.g. *UNICODETOMCCS*") + + [MAPHASH PAIRS (FUNCTION (LAMBDA (SCODE DCODE) + (\INSURECHARSETINFO DESTFONT (\CHARSET DCODE)) + (LET ((SD (\MOVEFONTCHARS.SOURCEDATA SCODE + DEFAULTSOURCEFONT DESTFONT DCODE + DESTFONT))) + (CL:WHEN (push PAIRINFO (LIST SD DCODE] + else (for P DCODE SD in PAIRS do (CL:WHEN (SMALLP P) + (SETQ P (LIST P P))) + (SETQ DCODE (CAR P)) + (CL:UNLESS (CHARCODEP DCODE) + (SETQ DCODE (CHARCODE.DECODE DCODE))) + (\INSURECHARSETINFO DESTFONT (\CHARSET DCODE)) + (SETQ SD (\MOVEFONTCHARS.SOURCEDATA (CADR P) + DEFAULTSOURCEFONT DCODE DESTFONT)) + (CL:WHEN SD + (push PAIRINFO (LIST SD DCODE)))] + + (* ;; + "Arguments checked out. install source character information into destfont slots. ") + + (for P in PAIRINFO do (\MOVEFONTCHAR (CAR P) + (CADR P) + DESTFONT)))) DESTFONT]) (\MOVEFONTCHAR - [LAMBDA (SOURCEDATA DCODE DFONT) (* ; "Edited 25-Sep-2025 21:25 by rmk") + [LAMBDA (SOURCEDATA DCODE DFONT) (* ; "Edited 4-Mar-2026 11:03 by rmk") + (* ; "Edited 25-Sep-2025 21:25 by rmk") (* ; "Edited 4-Sep-2025 12:37 by rmk") (* ; "Edited 31-Aug-2025 14:36 by rmk") (* ; "Edited 28-Aug-2025 20:50 by rmk") @@ -1660,7 +1683,6 @@ (UPDATEINFOELEMENT YWIDTHS) (CL:WHEN (GETMULTI SOURCEDATA 'LEFTKERN) (\FSETLEFTKERN DCSINFO DTHINCODE (GETMULTI SOURCEDATA 'LEFTKERN))) - (replace (CHARSETINFO CSSLUGP) of DCSINFO with NIL) (CHARSETPROP DCSINFO 'SOURCE (FONTPROP DFONT 'SPEC)))] (SETQ DESCENT (IMAX (GETMULTI SOURCEDATA 'DESCENT) (fetch (CHARSETINFO CHARSETDESCENT) of DCSINFO))) @@ -1677,7 +1699,10 @@ DCSINFO]) (\MOVEFONTCHARS.SOURCEDATA - [LAMBDA (SOURCE DEFAULTSOURCEFONT) (* ; "Edited 6-Sep-2025 12:59 by rmk") + [LAMBDA (SOURCE DEFAULTSOURCEFONT DCODE DESTFONT) (* ; "Edited 15-Mar-2026 14:24 by rmk") + (* ; "Edited 9-Mar-2026 23:00 by rmk") + (* ; "Edited 7-Mar-2026 11:41 by rmk") + (* ; "Edited 6-Sep-2025 12:59 by rmk") (* ; "Edited 4-Sep-2025 11:01 by rmk") (* ; "Edited 2-Sep-2025 13:28 by rmk") (* ; "Edited 30-Aug-2025 23:20 by rmk") @@ -1695,6 +1720,8 @@ (* ;; " a list of the form (sourcechar sourcefont) where sourcechar is a name or code and sourcefont is a full or partial font specification with defaults taken from the DEFAULTSOURCE FONT. E.g. if the defaultsource font is GACHA 10 then the pair (94 TERMINAL) is interpreted as (TERMINAL 10).") + (* ;; "DCODE and DESTFONT provided so that we can avoid vacuous translations") + (LET (SCODE CHAR8CODE SFONT CSINFO TEMP) (if (LISTP SOURCE) then (SETQ SFONT (CADR SOURCE)) @@ -1729,34 +1756,36 @@ else (SETQ SFONT DEFAULTSOURCEFONT))) (CL:UNLESS (CHARCODEP SCODE) (SETQ SCODE (CHARCODE.DECODE SCODE))) - (CL:WHEN (AND SCODE (SLUGCHARP.DISPLAY SCODE SFONT)) - (SETQ SCODE NIL)) - (if SCODE - then (SETQ CSINFO (\INSURECHARSETINFO SFONT (\CHARSET SCODE))) - (SETQ CHAR8CODE (\CHAR8CODE SCODE)) - else - (* ;; "NIL SCODE means replace with slug. We calculate the source-slug information, but that should be ignored later in favor of the slug information from the destination's character set. ") - - (SETQ CSINFO (\INSURECHARSETINFO SFONT 0)) - (SETQ CHAR8CODE SLUGCHARINDEX)) - - (* ;; "Use (plural) vector field names for UPDATEINFOELEMENT. Don't know if the CHAR8CODE is useful, but...") - - `((CHAR8CODE \, CHAR8CODE) - (ASCENT \, (fetch (CHARSETINFO CHARSETASCENT) of CSINFO)) - (DESCENT \, (fetch (CHARSETINFO CHARSETDESCENT) of CSINFO)) - (WIDTHS \, (CL:WHEN (SETQ TEMP (ffetch (CHARSETINFO WIDTHS) of CSINFO)) - (\FGETWIDTH TEMP CHAR8CODE))) - (YWIDTHS \, (CL:WHEN (SETQ TEMP (ffetch (CHARSETINFO YWIDTHS) of CSINFO)) - (\FGETWIDTH TEMP CHAR8CODE))) - (IMAGEWIDTHS \, (CL:WHEN (SETQ TEMP (ffetch (CHARSETINFO IMAGEWIDTHS) of CSINFO)) + (CL:UNLESS (AND (EQ DCODE SCODE) + (EQ SFONT DESTFONT)) (* ; "Nothing to do") + (CL:WHEN (AND SCODE (SLUGCHARP SCODE SFONT)) + (SETQ SCODE NIL)) + (if SCODE + then (SETQ CSINFO (\INSURECHARSETINFO SFONT (\CHARSET SCODE))) + (SETQ CHAR8CODE (\CHAR8CODE SCODE)) + else + (* ;; "NIL SCODE means replace with slug. We calculate the source-slug information, but that should be ignored later in favor of the slug information from the destination's character set. ") + + (SETQ CSINFO (\INSURECHARSETINFO SFONT 0)) + (SETQ CHAR8CODE SLUGCHARINDEX)) + + (* ;; "Use (plural) vector field names for UPDATEINFOELEMENT. Don't know if the CHAR8CODE is useful, but...") + + `((CHAR8CODE \, CHAR8CODE) + (ASCENT \, (fetch (CHARSETINFO CHARSETASCENT) of CSINFO)) + (DESCENT \, (fetch (CHARSETINFO CHARSETDESCENT) of CSINFO)) + (WIDTHS \, (CL:WHEN (SETQ TEMP (ffetch (CHARSETINFO WIDTHS) of CSINFO)) + (\FGETWIDTH TEMP CHAR8CODE))) + (YWIDTHS \, (CL:WHEN (SETQ TEMP (ffetch (CHARSETINFO YWIDTHS) of CSINFO)) (\FGETWIDTH TEMP CHAR8CODE))) - (LEFTKERN \, (CL:WHEN (ARRAYP (fetch (CHARSETINFO LEFTKERN) of CSINFO)) - (ELT (fetch (CHARSETINFO LEFTKERN) of CSINFO) - CHAR8CODE))) - (BITMAP \, (CL:WHEN (SETQ TEMP (fetch (CHARSETINFO CHARSETBITMAP) of CSINFO)) - (\GETCHARBITMAP.CSINFO CHAR8CODE CSINFO))) - (SLUG \, (NOT SCODE]) + (IMAGEWIDTHS \, (CL:WHEN (SETQ TEMP (ffetch (CHARSETINFO IMAGEWIDTHS) of CSINFO)) + (\FGETWIDTH TEMP CHAR8CODE))) + (LEFTKERN \, (CL:WHEN (ARRAYP (fetch (CHARSETINFO LEFTKERN) of CSINFO)) + (ELT (fetch (CHARSETINFO LEFTKERN) of CSINFO) + CHAR8CODE))) + (BITMAP \, (CL:WHEN (SETQ TEMP (fetch (CHARSETINFO CHARSETBITMAP) of CSINFO)) + (\GETCHARBITMAP.CSINFO CHAR8CODE CSINFO))) + (SLUG \, (NOT SCODE))))]) (\MAKESLUGCHAR [LAMBDA (CODE FONT/CSINFO) (* ; "Edited 30-Aug-2025 23:20 by rmk") @@ -1800,7 +1829,7 @@ SLUGCHARINDEX)))) CSINFO]) -(SLUGCHARP.DISPLAY +(SLUGCHARP [LAMBDA (CODE FONT/CHARSETINFO) (* ; "Edited 2-Sep-2025 22:59 by rmk") (* ; "Edited 28-Aug-2025 22:56 by rmk") (* ; "Edited 6-Jun-2025 10:24 by rmk") @@ -1818,6 +1847,23 @@ (\FGETOFFSET (fetch (CHARSETINFO OFFSETS) of CSINFO) (ADD1 \MAXTHINCHAR]) ) +(DECLARE%: DONTCOPY +(* "FOLLOWING DEFINITIONS EXPORTED")(DECLARE%: EVAL@COMPILE + +(RPAQ SLUGCHARINDEX (ADD1 \MAXTHINCHAR)) + + +(CONSTANTS (SLUGCHARINDEX (ADD1 \MAXTHINCHAR))) +) + +(* "END EXPORTED DEFINITIONS") + +) + + + +(* ; "At the end of each csinfo") + (DECLARE%: EVAL@COMPILE (PUTPROPS UPDATEINFOELEMENT MACRO [(FIELD) @@ -1832,7 +1878,9 @@ (DEFINEQ (FONTFILES - [LAMBDA (FONTSPEC CHARSET DIRLST EXTLST) (* ; "Edited 28-Aug-2025 14:42 by rmk") + [LAMBDA (FONTSPEC CHARSET DIRLST EXTLST) (* ; "Edited 19-Apr-2026 09:54 by rmk") + (* ; "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") @@ -1843,15 +1891,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.") - - (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]) + (* ;; "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.") + + (if (type? FONTDESCRIPTOR FONTSPEC) + then + (* ;; "Prefer the same version, but maybe a different version if coming up in a new environment. E.g. a font that was created in a loadup sysout that was then distributed into an environment with different font versions.") + + (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) @@ -1890,7 +1950,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:") @@ -1919,14 +1980,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.") @@ -2212,7 +2274,8 @@ (SHOULDNT]) (\COERCECHARSET - [LAMBDA (FONTSPEC CHARSET CODE COERCIONS FONT) (* ; "Edited 17-Dec-2025 21:51 by rmk") + [LAMBDA (FONTSPEC CHARSET CODE COERCIONS FONT) (* ; "Edited 15-Mar-2026 14:23 by rmk") + (* ; "Edited 17-Dec-2025 21:51 by rmk") (* ; "Edited 7-Oct-2025 17:25 by rmk") (* ; "Edited 31-Aug-2025 00:00 by rmk") (* ; "Edited 28-Aug-2025 23:07 by rmk") @@ -2243,8 +2306,7 @@ (SETQ CFONT (FONTCREATE1 CFS CHARSET)) - when (SETQ CSINFO (\INSURECHARSETINFO CFONT CHARSET)) unless (AND CODE (SLUGCHARP.DISPLAY - CODE CFONT)) + when (SETQ CSINFO (\INSURECHARSETINFO CFONT CHARSET)) unless (AND CODE (SLUGCHARP CODE CFONT)) do (CL:WHEN FONT (replace (FONTDESCRIPTOR FONTCHARENCODING) of FONT with (fetch (FONTDESCRIPTOR FONTCHARENCODING) @@ -2254,7 +2316,8 @@ (RETURN (LIST CFONT CSINFO]) (\BUILDSLUGCSINFO - [LAMBDA (FONT SLUGWIDTH) (* ; "Edited 17-Aug-2025 12:46 by rmk") + [LAMBDA (FONT SLUGWIDTH) (* ; "Edited 15-Mar-2026 23:39 by rmk") + (* ; "Edited 17-Aug-2025 12:46 by rmk") (* ; "Edited 10-Aug-2025 12:43 by rmk") (* ; "Edited 6-Aug-2025 22:42 by rmk") (* ; "Edited 3-Aug-2025 16:11 by rmk") @@ -2291,8 +2354,7 @@ (SETQ CSINFO (create CHARSETINFO CHARSETASCENT ↠(IDIFFERENCE SLUGHEIGHT DESCENT) CHARSETDESCENT ↠DESCENT - CSSLUGP ↠T - CSCOMPLETEP ↠T)) + CSSLUGP ↠T)) (SETQ WIDTHS (fetch (CHARSETINFO WIDTHS) of CSINFO)) (for I from 0 to \MAXTHINCHAR do (\FSETWIDTH WIDTHS I SLUGWIDTH)) (replace IMAGEWIDTHS OF CSINFO with WIDTHS) @@ -2678,7 +2740,10 @@ then FILEFONTS)))]) (FONTEXISTS? - [LAMBDA (FAMILY SIZE FACE ROTATION DEVICE NOCOERCIONS) (* ; "Edited 22-Jan-2026 09:07 by rmk") + [LAMBDA (FONTSPEC NOCOERCIONS) (* ; "Edited 4-Apr-2026 12:27 by rmk") + (* ; "Edited 2-Apr-2026 23:52 by rmk") + (* ; "Edited 17-Mar-2026 23:04 by rmk") + (* ; "Edited 22-Jan-2026 09:07 by rmk") (* ; "Edited 18-Dec-2025 13:10 by rmk") (* ; "Edited 25-Nov-2025 20:18 by rmk") (* ; "Edited 26-Sep-2025 10:10 by rmk") @@ -2689,14 +2754,14 @@ (* ; "Edited 9-Aug-2025 00:08 by rmk") (* ; "Edited 5-Aug-2025 17:54 by rmk") - (* ;; "Do we have any way of finding or creating the font, even by coercion from other fonts? The DEVICE can have a FONTEXISTS? function for the case where we can't find a file--presumably returns the file for a coercion to a different font specification.") + (* ;; "Do we have any way of finding or creating the font, even by coercion from other fonts? The IMAGESTREAM DEVICE can have a FONTEXISTS? function for the case where we can't find a file--presumably returns the file for a coercion to a different font specification.") (* ;; - "Tries device specific coercions if the original request can't be satisfied and NOCOERCIONS is NIL.") + "Tries device-specific coercions if the original request can't be satisfied and NOCOERCIONS is NIL.") (DECLARE (GLOBALVARS \FONTSINCORE \FONTEXISTS?-CACHE IMAGESTREAMTYPES)) - (LET ((FONTSPEC (\FONT.CHECKARGS FAMILY SIZE FACE ROTATION DEVICE T)) - VAL DEVICE) + (SETQ FONTSPEC (\FONT.CHECKARGS FONTSPEC NIL NIL NIL NIL T)) + (LET (VAL DEVICE COERCED) (* ;; "SASSOC everywhere because of face") @@ -2705,30 +2770,30 @@ then (CL:UNLESS (EQ VAL 'NO) VAL) else (* ; - "Only 0 really exists. Cache just the first file") + "Only 0 really exists--but is that true only for the display? Cache just the first file") (SETQ DEVICE (fetch (FONTSPEC FSDEVICE) of FONTSPEC)) - (SETQ VAL (OR (CAR (FONTFILES (CL:IF (MEMB (fetch (FONTSPEC FSROTATION) of FONTSPEC) + [SETQ VAL (OR (CAR (FONTFILES (CL:IF (MEMB (fetch (FONTSPEC FSROTATION) of FONTSPEC) '(90 270)) (create FONTSPEC using FONTSPEC FSROTATION ↠0) FONTSPEC))) (APPLY* (OR (CAR (GETMULTI IMAGESTREAMTYPES DEVICE 'FONTEXISTS?)) (CAR (GETMULTI IMAGESTREAMTYPES DEVICE 'FONTSAVAILABLE)) (FUNCTION NILL)) - FONTSPEC))) - (if VAL - then (STOREMULTI \FONTEXISTS?-CACHE FONTSPEC VAL 'SASSOC) - elseif [AND (NOT NOCOERCIONS) - (SETQ VAL (COERCEFONTSPEC FONTSPEC (FONTDEVICEPROP DEVICE - 'FONTCOERCIONS] - then - (* ;; "It's coerceable...even though coercion may not yet be instantiated") - - (STOREMULTI \FONTEXISTS?-CACHE FONTSPEC VAL 'SASSOC) - else (STOREMULTI \FONTEXISTS?-CACHE FONTSPEC 'NO 'SASSOC) - NIL]) + FONTSPEC NOCOERCIONS) + (AND (NOT NOCOERCIONS) + (SETQ COERCED (CAR (OR (COERCEFONTSPEC FONTSPEC 'FONTCOERCIONS) + (COERCEFONTSPEC FONTSPEC 'FACECOERCIONS] + + (* ;; "Don't cache NO if the font isn't found and coercion is suppressed. A later coercive call might produce a different result.") + + (CL:WHEN (OR VAL COERCED) + (STOREMULTI \FONTEXISTS?-CACHE FONTSPEC (OR VAL 'NO) + 'SASSOC)) + VAL]) (\SEARCHFONTFILES - [LAMBDA (FONTSPEC) (* ; "Edited 28-Aug-2025 14:47 by rmk") + [LAMBDA (FONTSPEC) (* ; "Edited 4-Mar-2026 00:14 by rmk") + (* ; "Edited 28-Aug-2025 14:47 by rmk") (* ; "Edited 25-Aug-2025 10:23 by rmk") (* ; "Edited 23-Aug-2025 12:36 by rmk") (* ; "Edited 21-Jul-2025 08:57 by rmk") @@ -2762,8 +2827,8 @@ (* ;;  "make sure the face, size, and family really match.") - when (AND (OR (EQ FAMILY '*) - (EQ FAMILY (fetch (FONTSPEC FSFAMILY) of THISFONT))) + when (AND THISFONT (OR (EQ FAMILY '*) + (EQ FAMILY (fetch (FONTSPEC FSFAMILY) of THISFONT))) (OR (EQ SIZE '*) (EQ SIZE (fetch (FONTSPEC FSSIZE) of THISFONT))) (MATCHFONTFACE FACE (fetch (FONTSPEC FSFACE) of THISFONT))) unless (MEMBER THISFONT @@ -2771,47 +2836,47 @@ do (push FONTSFOUND THISFONT))) finally (RETURN (DREVERSE FONTSFOUND]) (FLUSHFONTCACHE - [LAMBDA (TYPE FAMILY SIZE FACE ROTATION DEVICE) (* ; "Edited 27-Nov-2025 10:02 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 TYPE cache, if TYPE is NIL, all caches are flushed") - - (CL:UNLESS TYPE - (SETQ TYPE '(:INCORE :EXISTS :AVAILABLE))) - (if (LISTP TYPE) - then (for TY in TYPE collect (FLUSHFONTCACHE TY FAMILY SIZE FACE ROTATION DEVICE)) - else - (* ;; "If all NILs, don't want the default font") - - (SPREADFONTSPEC (\FONT.CHECKARGS (OR FAMILY '*) - (OR SIZE '*) - (OR FACE '*) - (OR ROTATION '*) - (OR DEVICE '*) - T)) - (LET ((NFLUSHED 0) - FONTX) - (DECLARE (SPECVARS NFLUSHED)) - [MAPMULTI (SELECTQ TYPE - (:INCORE \FONTSINCORE) - (:EXISTS \FONTEXISTS?-CACHE) - (:AVAILABLE \FONTSAVAILABLEFILECACHE) - (\ILLEGAL.ARG TYPE)) - (FUNCTION (LAMBDA (FM S FC R DPAIR) - (CL:WHEN (AND (OR (EQ FAMILY FM) - (EQ FAMILY '*)) - (OR (EQ SIZE S) - (EQ SIZE '*)) - (MATCHFONTFACE FACE FC) - (OR (EQ ROTATION R) - (EQ ROTATION '*)) - (OR (EQ DEVICE (CAR DPAIR)) - (EQ DEVICE '*)) - (CDR DPAIR)) - (ADD NFLUSHED 1) - (RPLACD DPAIR))] - (LIST TYPE NFLUSHED]) + (* ;; "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 (SPECVARS NFLUSHED) + first (CL:WHEN (type? FONTSPEC FAMILY) + (SPREADFONTSPEC (\FONT.CHECKARGS FAMILY SIZE FACE ROTATION DEVICE T))) + (CL:UNLESS FAMILY + (SETQ FAMILY '*)) + (CL:UNLESS SIZE + (SETQ SIZE '*)) + (CL:UNLESS FACE + (SETQ FACE '*)) + (CL:UNLESS ROTATION + (SETQ ROTATION '*)) + (CL:UNLESS DEVICE + (SETQ DEVICE '*)) eachtime (SETQ NFLUSHED 0) + collect [MAPMULTI (SELECTQ CACHE + (:INCORE \FONTSINCORE) + (:EXISTS \FONTEXISTS?-CACHE) + (: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) + (EQ SIZE '*)) + (MATCHFONTFACE FACE FC) + (OR (EQ ROTATION R) + (EQ ROTATION '*)) + (OR (EQ DEVICE (CAR DPAIR)) + (EQ DEVICE '*)) + (CDR DPAIR)) + (ADD NFLUSHED 1) + (RPLACD DPAIR))] + (LIST CACHE NFLUSHED]) (FINDFONTFILES [LAMBDA (FAMILY SIZE FACE ROTATION DEVICE DIRLST EXTLST) (* ; "Edited 28-Aug-2025 14:45 by rmk") @@ -2862,10 +2927,11 @@ ) finally (RETURN (DREVERSE FONTSFOUND]) (SORTFONTSPECS - [LAMBDA (FONTSPECS) (* ; "Edited 30-Aug-2025 15:12 by rmk") + [LAMBDA (FONTSPECS) (* ; "Edited 22-Mar-2026 12:44 by rmk") + (* ; "Edited 13-Mar-2026 11:33 by rmk") + (* ; "Edited 30-Aug-2025 15:12 by rmk") - (* ;; - "Sort FONTSPECS by alphabetically by family, then by smaller sizes, then by medium/regular faces") + (* ;; "Sort FONTSPECS by alphabetically by family, then by smaller sizes, then by faces. For faces the order is MRR MIR BRR BIR and any others, so that coercions from earlier fonts are possible.") (SORT FONTSPECS @@ -2878,8 +2944,10 @@ (fetch (FONTSPEC FSSIZE) of FS2)) (CL:WHEN (EQ (fetch (FONTSPEC FSSIZE) of FS1) (fetch (FONTSPEC FSSIZE) of FS2)) - [LET ((FACE1 (fetch (FONTSPEC FSFACE) of FS1)) - (FACE2 (fetch (FONTSPEC FSFACE) of FS2))) + [LET [(FACE1 (\FONTFACE (fetch (FONTSPEC FSFACE) + of FS1))) + (FACE2 (\FONTFACE (fetch (FONTSPEC FSFACE) + of FS2] (OR (EQUAL FACE1 FACE2) (AND (EQ 'MEDIUM (fetch (FONTFACE WEIGHT) of FACE1)) @@ -2897,21 +2965,24 @@ (DEFINEQ (MATCHFONTFACE - [LAMBDA (PATTERN FACE) (* ; "Edited 21-Jun-2025 11:57 by rmk") + [LAMBDA (PATTERN FACE) (* ; "Edited 18-Mar-2026 13:39 by rmk") + (* ; "Edited 21-Jun-2025 11:57 by rmk") (* ;; "Does FACE match a PATTERN that may contain stars?") - (OR (EQ PATTERN '*) - (EQUAL PATTERN FACE) - (LET ((PWEIGHT (fetch (FONTFACE WEIGHT) of PATTERN)) - (PSLOPE (fetch (FONTFACE SLOPE) of PATTERN)) - (PEXPANSION (fetch (FONTFACE EXPANSION) of PATTERN))) - (AND (OR (EQ PWEIGHT (fetch (FONTFACE WEIGHT) of FACE)) - (EQ PWEIGHT '*)) - (OR (EQ PSLOPE (fetch (FONTFACE SLOPE) of FACE)) - (EQ PSLOPE '*)) - (OR (EQ PEXPANSION (fetch (FONTFACE EXPANSION) of FACE)) - (EQ PEXPANSION '*]) + (if (EQ PATTERN '*) + elseif (EQUAL PATTERN FACE) + else (CL:WHEN (AND PATTERN (LITATOM PATTERN)) + (SETQ PATTERN (\FONTFACE PATTERN))) + (LET ((PWEIGHT (fetch (FONTFACE WEIGHT) of PATTERN)) + (PSLOPE (fetch (FONTFACE SLOPE) of PATTERN)) + (PEXPANSION (fetch (FONTFACE EXPANSION) of PATTERN))) + (AND (OR (EQ PWEIGHT (fetch (FONTFACE WEIGHT) of FACE)) + (EQ PWEIGHT '*)) + (OR (EQ PSLOPE (fetch (FONTFACE SLOPE) of FACE)) + (EQ PSLOPE '*)) + (OR (EQ PEXPANSION (fetch (FONTFACE EXPANSION) of FACE)) + (EQ PEXPANSION '*]) (MAKEFONTFACE [LAMBDA (WEIGHT SLOPE EXPANSION BASE COLOR) (* ; "Edited 7-Nov-2025 08:50 by rmk") @@ -2971,6 +3042,27 @@ then FACE elseif (NOT NOERROR) then (\ILLEGAL.ARG FACE]) + +(FONTFACE.STARS + [LAMBDA (FACE) (* ; "Edited 19-Mar-2026 23:31 by rmk") + + (* ;; "Produces a list of font faces formed by expanding eacy of the starred components of FACE") + + (CL:WHEN (EQ FACE '*) + (SETQ FACE (create FONTFACE + WEIGHT ↠'* + SLOPE ↠'* + EXPANSION ↠'*))) + (for W VAL inside (CL:IF (EQ '* (fetch (FONTFACE WEIGHT) of FACE)) + '(BOLD MEDIUM) + (fetch (FONTFACE WEIGHT) of FACE)) + do [for S inside (CL:IF (EQ '* (fetch (FONTFACE SLOPE) of FACE)) + '(ITALIC REGULAR) + (fetch (FONTFACE SLOPE) of FACE)) + do (for E inside (CL:IF (EQ '* (fetch (FONTFACE EXPANSION) of FACE)) + '(COMPRESSED REGULAR) + (fetch (FONTFACE EXPANSION) of FACE)) + do (push VAL (MAKEFONTFACE W S E] finally (RETURN VAL]) ) (RPAQ? \FONTSINCORE NIL) @@ -3019,6 +3111,8 @@ (DATATYPE FONTDESCRIPTOR ((FONTDEVICE POINTER) (FONTCOMPLETEP FLAG) + (FONTCOERCEDP FLAG) (* ; + "Indirects to another font via FONTCOERCIONS") (FONTFAMILY POINTER) (FONTSIZE POINTER) (FONTFACE POINTER) @@ -3027,12 +3121,12 @@ (\SFHeight WORD) (ROTATION WORD) (FONTSLUGWIDTH WORD) (* ; "Was FBBOX. The width of the slug character in the font, used by the generic \BUILDSLUGCSINFO to create the slug charsetinfo") - (NIL SIGNEDWORD) (* ; - "Was FBBOY. Can be removed if all references are recompiled.") + (MAXCHARSET WORD) (* ; + "Maximum number of charsets, usually \MAXCHARSET but maybe more for Unicode fonts.") (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) (* ; @@ -3042,11 +3136,11 @@ (FONTAVGCHARWIDTH WORD) (* ;  "Set in FONTCREATE, used to fix up the linelength when DSPFONT is called") (FONTCHARENCODING POINTER) (* ; "Was FONTIMAGEWIDTHS: This is the image width, as opposed to the advanced width; initial hack for accents, kerning. Fields is referenced by FONTCREATE.") - (FONTCHARSETVECTOR POINTER) (* ; "A 257-pointer block, with one pointer per 'character set' --each group of 256 character codes. Each pointer is either NIL if there's no info for that charset, or is a CHARSETINFO, containing widths, char bitmap, etc for the characters in that charset. The last cell if not NIL is the %"slug%" charsetinfo that can be shared as the dummy entry for otherwise NIL charsets") + (FONTCHARSETVECTOR POINTER) (* ; "A MAXCHARSET+1-pointer block, with one pointer per 'character set' --each group of 256 character codes. Each pointer is either NIL if there's no info for that charset, or is a CHARSETINFO, containing widths, char bitmap, etc for the characters in that charset. The last cell if not NIL is the %"slug%" charsetinfo that can be shared as the dummy entry for otherwise NIL charsets") (FONTHASLEFTKERNS FLAG) (* ;  "T if at least one character set has an entry for left kerns") (FONTEXTRAFIELD2 POINTER)) - FONTCHARSETVECTOR ↠(\CREATEFONTCHARSETVECTOR) + MAXCHARSET ↠\MAXCHARSET FONTCHARSETVECTOR ↠(\CREATEFONTCHARSETVECTOR) (INIT (DEFPRINT 'FONTDESCRIPTOR (FUNCTION FONTDESCRIPTOR.DEFPRINT)))) (RECORD FONTFACE (WEIGHT SLOPE EXPANSION) @@ -3095,7 +3189,14 @@ CHARSETNO ↠MAX.SMALLP) (RECORD FONTSPEC (FSFAMILY FSSIZE FSFACE FSROTATION FSDEVICE) - (TYPE? LISTP)) + (RECORD FSFACE (FSWEIGHT FSSLOPE FSEXPANSION)) + FSROTATION ↠0 [TYPE? (AND (LISTP DATUM) + (AND (fetch (FONTSPEC FSFAMILY) of DATUM) + (LITATOM (fetch (FONTSPEC FSFAMILY) of DATUM))) + (OR (AND (SMALLP (fetch (FONTSPEC FSSIZE) of DATUM)) + (IGEQ (fetch (FONTSPEC FSSIZE) of DATUM) + 1)) + (EQ '* (fetch (FONTSPEC FSSIZE) of DATUM]) ) (/DECLAREDATATYPE 'FONTCLASS '(BYTE POINTER POINTER POINTER POINTER POINTER) @@ -3110,11 +3211,12 @@ (DEFPRINT 'FONTCLASS (FUNCTION FONTCLASS.DEFPRINT)) (/DECLAREDATATYPE 'FONTDESCRIPTOR - '(POINTER FLAG POINTER POINTER POINTER WORD WORD WORD WORD WORD SIGNEDWORD SIGNEDWORD + '(POINTER FLAG FLAG POINTER POINTER POINTER WORD WORD WORD WORD WORD WORD SIGNEDWORD SIGNEDWORD POINTER POINTER POINTER POINTER POINTER (BITS 8) WORD POINTER POINTER FLAG POINTER) '((FONTDESCRIPTOR 0 POINTER) (FONTDESCRIPTOR 0 (FLAGBITS . 0)) + (FONTDESCRIPTOR 0 (FLAGBITS . 16)) (FONTDESCRIPTOR 2 POINTER) (FONTDESCRIPTOR 4 POINTER) (FONTDESCRIPTOR 6 POINTER) @@ -3123,7 +3225,7 @@ (FONTDESCRIPTOR 10 (BITS . 15)) (FONTDESCRIPTOR 11 (BITS . 15)) (FONTDESCRIPTOR 12 (BITS . 15)) - (FONTDESCRIPTOR 13 (SIGNEDBITS . 15)) + (FONTDESCRIPTOR 13 (BITS . 15)) (FONTDESCRIPTOR 14 (SIGNEDBITS . 15)) (FONTDESCRIPTOR 15 (SIGNEDBITS . 15)) (FONTDESCRIPTOR 16 POINTER) @@ -3197,22 +3299,31 @@ (PUTPROPS \FSETIMAGEWIDTH DMACRO ((WIDTHSBLOCK INDEX WIDTH) (\PUTBASE WIDTHSBLOCK INDEX WIDTH))) + +(PUTPROPS MAXCHARSET MACRO ((FONT) + + (* ;; "0 test until all old files are gone") + + (LET ((MAX (fetch (FONTDESCRIPTOR MAXCHARSET) of FONT))) + (CL:IF (EQ MAX 0) + \MAXCHARSET + MAX)))) ) (DECLARE%: EVAL@COMPILE -(PUTPROPS \GETCHARSETINFO MACRO ((FONTDESC CHARSET) +(PUTPROPS \GETCHARSETINFO MACRO (OPENLAMBDA (FONTDESC CHARSET) - (* ;; + (* ;;  "Temporary until other callers of \GETCHARSETINFO are changes to \INSURECHARSETINFO") - (* ;; + (* ;;  "Fetches the charsetinfo for charset CHARSET in fontdescriptor FONTDESC. ") - (* ;; + (* ;;  "NOTE Current \GETCHARSETINFO takes the vector, not the font, as does current \SETCHARSETINFO") - (\GETBASEPTR (ffetch FONTCHARSETVECTOR of FONTDESC) - (UNFOLD CHARSET 2)))) + (\GETBASEPTR (ffetch FONTCHARSETVECTOR of FONTDESC) + (UNFOLD CHARSET 2)))) (PUTPROPS \SETCHARSETINFO MACRO ((FONTDESC CHARSET CSINFO) (\RPLPTR (fetch (FONTDESCRIPTOR FONTCHARSETVECTOR) of FONTDESC) @@ -3223,19 +3334,23 @@ (* ;; "fetches the charsetinfo for charset CHARSET in fontdescriptor FONTDESC. If NIL, then creates and installs the required charset, maybe a slug (with CSSLUGP T).") - (OR (\GETCHARSETINFO FONTDESC CHARSET) - (\SETCHARSETINFO FONTDESC CHARSET (\CREATECHARSET CHARSET - FONTDESC]) + (CL:IF (IGREATERP CHARSET (MAXCHARSET FONTDESC)) + (SLUGCSINFO FONTDESC) + (OR (\GETCHARSETINFO FONTDESC CHARSET) + (\SETCHARSETINFO FONTDESC CHARSET (\CREATECHARSET + CHARSET + FONTDESC))))]) (PUTPROPS \CREATECSINFOELEMENT MACRO (NIL (\ALLOCBLOCK (FOLDHI (IPLUS \MAXTHINCHAR 3) WORDSPERCELL)))) -(PUTPROPS \CREATEFONTCHARSETVECTOR MACRO (NIL +(PUTPROPS \CREATEFONTCHARSETVECTOR MACRO (OPENLAMBDA (FONT) - (* ;; "Allocates a block for the character set records, including one extra slot to hold the common slug charsetinfo") + (* ;; "Allocates a block for the character set records, including one extra slot to hold the common slug charsetinfo") - (\ALLOCBLOCK (IPLUS 2 \MAXCHARSET) - T))) + (\ALLOCBLOCK (IPLUS 2 (OR (AND FONT (MAXCHARSET FONT)) + \MAXCHARSET)) + T))) (PUTPROPS CHARSETPROP MACRO [ARGS (if (CDDR ARGS) then `(PUTMULTI (fetch (CHARSETINFO CSINFOPROPS) @@ -3245,19 +3360,14 @@ else `(GETMULTI (fetch (CHARSETINFO CSINFOPROPS) of ,(CAR ARGS)) ,(CADR ARGS]) + +(PUTPROPS SLUGCSINFO MACRO [(FONT) + (OR (\GETCHARSETINFO FONT (ADD1 (MAXCHARSET FONT))) + (\SETCHARSETINFO FONT (ADD1 (MAXCHARSET FONT)) + (\BUILDSLUGCSINFO FONT]) ) (PUTPROPS CHARSETPROP ARGNAMES (CSINFO PROP NEWVALUE)) -(DECLARE%: EVAL@COMPILE - -(RPAQ SLUGCHARINDEX (ADD1 \MAXTHINCHAR)) - -(RPAQ SLUGCHARSET (ADD1 \MAXCHARSET)) - - -(CONSTANTS (SLUGCHARINDEX (ADD1 \MAXTHINCHAR)) - (SLUGCHARSET (ADD1 \MAXCHARSET))) -) (* "END EXPORTED DEFINITIONS") @@ -3270,8 +3380,12 @@ (LET [(SOURCE (CL:UNLESS (fetch (CHARSETINFO CSSLUGP) of CSINFO) (CHARSETPROP CSINFO 'SOURCE))] - (CL:WHEN SOURCE - [NOT (EQUAL SOURCE (FONTPROP FONT 'DEVICESPEC])]) + (CL:WHEN [AND SOURCE (NOT (EQUAL SOURCE (FONTPROP FONT + 'DEVICESPEC] + (create FONTSPEC using SOURCE FSFACE ↠+ (FONTFACETOATOM (fetch (FONTSPEC + FSFACE) + of SOURCE))))]) ) ) (DEFINEQ @@ -3333,11 +3447,12 @@ (DEFPRINT 'FONTCLASS (FUNCTION FONTCLASS.DEFPRINT)) (/DECLAREDATATYPE 'FONTDESCRIPTOR - '(POINTER FLAG POINTER POINTER POINTER WORD WORD WORD WORD WORD SIGNEDWORD SIGNEDWORD + '(POINTER FLAG FLAG POINTER POINTER POINTER WORD WORD WORD WORD WORD WORD SIGNEDWORD SIGNEDWORD POINTER POINTER POINTER POINTER POINTER (BITS 8) WORD POINTER POINTER FLAG POINTER) '((FONTDESCRIPTOR 0 POINTER) (FONTDESCRIPTOR 0 (FLAGBITS . 0)) + (FONTDESCRIPTOR 0 (FLAGBITS . 16)) (FONTDESCRIPTOR 2 POINTER) (FONTDESCRIPTOR 4 POINTER) (FONTDESCRIPTOR 6 POINTER) @@ -3346,7 +3461,7 @@ (FONTDESCRIPTOR 10 (BITS . 15)) (FONTDESCRIPTOR 11 (BITS . 15)) (FONTDESCRIPTOR 12 (BITS . 15)) - (FONTDESCRIPTOR 13 (SIGNEDBITS . 15)) + (FONTDESCRIPTOR 13 (BITS . 15)) (FONTDESCRIPTOR 14 (SIGNEDBITS . 15)) (FONTDESCRIPTOR 15 (SIGNEDBITS . 15)) (FONTDESCRIPTOR 16 POINTER) @@ -3386,6 +3501,7 @@ (DATATYPE FONTDESCRIPTOR ((FONTDEVICE POINTER) (FONTCOMPLETEP FLAG) + (FONTCOERCEDP FLAG) (FONTFAMILY POINTER) (FONTSIZE POINTER) (FONTFACE POINTER) @@ -3394,11 +3510,11 @@ (\SFHeight WORD) (ROTATION WORD) (FONTSLUGWIDTH WORD) - (NIL SIGNEDWORD) + (MAXCHARSET WORD) (NIL SIGNEDWORD) (NIL SIGNEDWORD) (FONTTOMCCSFN POINTER) - (NIL POINTER) + (FONTFILENAME POINTER) (FONTDEVICESPEC POINTER) (OTHERDEVICEFONTPROPS POINTER) (FONTSCALE POINTER) @@ -3462,100 +3578,86 @@ (DEFINEQ (\CREATEFONT - [LAMBDA (FONTSPEC) (* ; "Edited 26-Jan-2026 15:24 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") + (* ; "Edited 26-Jan-2026 15:24 by rmk") (* ; "Edited 25-Dec-2025 10:58 by rmk") (* ; "Edited 25-Sep-2025 21:24 by rmk") (* ; "Edited 28-Aug-2025 14:30 by rmk") - (* ; "Edited 18-Aug-2025 00:17 by rmk") - (* ; "Edited 16-Aug-2025 20:52 by rmk") - (* ; "Edited 12-Aug-2025 23:36 by rmk") (* ; "Edited 24-Jul-2025 19:51 by rmk") (* ; "Edited 20-May-2025 21:10 by rmk") - (* ;; "Generic font creation. Uses fontcreate method from device to build the font fontdescriptor but doesn't call SETFONTDESCRIPTOR to install it and doesn't instantiate a charset. That's deferred to FONTCREATE1. ") + (* ;; "Generic font creation. Uses fontcreate method from device to build the font fontdescriptor with font-level properties but doesn't call SETFONTDESCRIPTOR to install it and doesn't instantiate a charset. That's deferred to \CREATECHARSET. ") (* ;; "") - (LET ([FN (CAR (GETMULTI IMAGESTREAMTYPES (fetch (FONTSPEC FSDEVICE) of FONTSPEC) - 'FONTCREATE] - FONT) - [if FN - then (SETQ FONT (if (EQ (NARGS FN) - 1) - then (APPLY* FN FONTSPEC) - else (* ; "Old form: spreading FONTSPEC") - (APPLY FN FONTSPEC))) - (CL:UNLESS FONT - (CL:WHEN (SETQ FONTSPEC (COERCEFONTSPEC FONTSPEC)) - (SETQ FONT (if (EQ (NARGS FN) - 1) - then (APPLY* FN FONTSPEC) - else (APPLY FN FONTSPEC))))) - else (SETQ FONT (create FONTDESCRIPTOR - FONTFAMILY ↠(fetch (FONTSPEC FSFAMILY) of FONTSPEC) - FONTSIZE ↠(fetch (FONTSPEC FSSIZE) of FONTSPEC) - FONTFACE ↠(fetch (FONTSPEC FSFACE) of FONTSPEC) - ROTATION ↠(fetch (FONTSPEC FSROTATION) of FONTSPEC) - FONTDEVICE ↠(fetch (FONTSPEC FSDEVICE) of FONTSPEC) - \SFAscent ↠0 - \SFDescent ↠0 - \SFHeight ↠0 - FONTDEVICESPEC ↠(create FONTSPEC using FONTSPEC] - FONT]) + (LET (FN COERCIONSPEC FONT) + (if (FONTEXISTS? FONTSPEC T) + then [SETQ FN (CAR (GETMULTI IMAGESTREAMTYPES (fetch (FONTSPEC FSDEVICE) of FONTSPEC) + 'FONTCREATE] + (if FN + then (APPLY* FN FONTSPEC) + elseif (MEDLEYFONT.READ.FONT (CAR (FONTFILES FONTSPEC)) + NIL T) + else (FONTSPEC.TO.FONTDESCRIPTOR FONTSPEC)) + elseif [SETQ COERCIONSPEC (CAR (COERCEFONTSPEC FONTSPEC 'FONTCOERCIONS] + then + (* ;; "(Re)load the target font, change its spec labeling. Maybe the DEVICESPEC should also change, in case this is dumped? But \CREATECHARSET needs to know the device name so it doesn't keep coercing.") + + (SETQ FONT (\CREATEFONT COERCIONSPEC)) + (replace (FONTDESCRIPTOR FONTCOERCEDP) of FONT with T) + (replace (FONTDESCRIPTOR FONTFAMILY) of FONT with (fetch (FONTSPEC FSFAMILY) + of FONTSPEC)) + (replace (FONTDESCRIPTOR FONTSIZE) of FONT with (fetch (FONTSPEC FSSIZE) + of FONTSPEC)) + (replace (FONTDESCRIPTOR FONTFACE) of FONT with (fetch (FONTSPEC FSFACE) + of FONTSPEC)) + (replace (FONTDESCRIPTOR ROTATION) of FONT with (fetch (FONTSPEC FSROTATION) + of FONTSPEC)) + (replace (FONTDESCRIPTOR FONTDEVICESPEC) of FONT with COERCIONSPEC) + FONT + elseif [SETQ COERCIONSPEC (CAR (COERCEFONTSPEC FONTSPEC 'FACECOERCIONS] + then (FONTSPEC.TO.FONTDESCRIPTOR FONTSPEC (MAXCHARSET (\CREATEFONT COERCIONSPEC]) (\CREATECHARSET - [LAMBDA (CHARSET FONT) (* ; "Edited 14-Feb-2026 13:12 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") + (* ; "Edited 18-Mar-2026 23:11 by rmk") + (* ; "Edited 16-Mar-2026 12:35 by rmk") + (* ; "Edited 13-Mar-2026 10:06 by rmk") + (* ; "Edited 14-Feb-2026 13:12 by rmk") (* ; "Edited 25-Sep-2025 21:24 by rmk") (* ; "Edited 2-Sep-2025 22:59 by rmk") (* ; "Edited 31-Aug-2025 14:36 by rmk") (* ; "Edited 28-Aug-2025 14:31 by rmk") - (* ; "Edited 27-Aug-2025 12:55 by rmk") - (* ; "Edited 25-Aug-2025 22:51 by rmk") - (* ; "Edited 16-Aug-2025 21:06 by rmk") - (* ; "Edited 12-Aug-2025 23:36 by rmk") - (* ; "Edited 5-Aug-2025 22:29 by rmk") - (* ; "Edited 3-Aug-2025 17:41 by rmk") - (* ; "Edited 29-Jul-2025 12:10 by rmk") - (* ; "Edited 22-Jul-2025 22:48 by rmk") (* ; "Edited 9-Jul-2025 11:12 by rmk") - (* ; "Edited 15-Jun-2025 14:50 by rmk") - (* ; "Edited 13-Jun-2025 20:00 by rmk") - (* ; "Edited 10-Jun-2025 13:55 by rmk") - (* ; "Edited 7-Jun-2025 15:10 by rmk") (* ; "Edited 18-May-2025 21:40 by rmk") - (* ; "Edited 16-May-2025 21:37 by rmk") (* ; "Edited 12-Jul-2022 14:37 by rmk") (* ; "Edited 8-May-93 23:42 by rmk:") (* ; "Edited 4-Dec-92 11:43 by jds") - (* ;; "Creates and returns the CHARSETINFO for charset CHARSET in fontdesc FONT, installing it in fonts FONTCHARSETVECTOR") - - (CL:UNLESS (<= 0 CHARSET \MAXCHARSET) - (\ILLEGAL.ARG CHARSET)) - (LET [(CSINFO (if (fetch (FONTDESCRIPTOR FONTCOMPLETEP) of FONT) - then (\GETCHARSETINFO FONT CHARSET) - else (APPLY* [OR (CAR (GETMULTI IMAGESTREAMTYPES (fetch (FONTDESCRIPTOR - FONTDEVICE) - of FONT) - 'CREATECHARSET)) - (FUNCTION (LAMBDA (FONTSPEC FONT CHARSET) - (* ; - "No function: read or read-coerced-font") - (OR (\READCHARSET FONTSPEC CHARSET FONT) - (\READCHARSET (COERCEFONTSPEC FONTSPEC) - CHARSET FONT] - (create FONTSPEC using (FONTPROP FONT 'DEVICESPEC)) - FONT CHARSET] - - (* ;; "Create a descriptor of info for that charset. If we got one, the subfunction may have ignored NOSLUG?. But if not, we store it in the vector so that we don't search later. ") - - (if (AND CSINFO (NOT (fetch (CHARSETINFO CSSLUGP) of CSINFO))) - then (\INSTALLCHARSETINFO FONT CSINFO CHARSET) - elseif (SETQ CSINFO (\GETCHARSETINFO FONT SLUGCHARSET)) - else (SETQ CSINFO (\BUILDSLUGCSINFO FONT)) - (\SETCHARSETINFO FONT SLUGCHARSET CSINFO) - (\SETCHARSETINFO FONT CHARSET CSINFO)) - CSINFO]) + (* ;; "Creates and returns the CHARSETINFO for charset CHARSET in fontdesc FONT, installing it in FONT's FONTCHARSETVECTOR") + + (OR (\GETCHARSETINFO FONT CHARSET) + (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 (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))]) (\INSTALLCHARSETINFO [LAMBDA (FONT CSINFO CHARSET) (* ; "Edited 31-Aug-2025 14:36 by rmk") @@ -3652,12 +3754,6 @@ ) (\CHAR8CODE CHARCODE)))) ) -(DECLARE%: DOEVAL@COMPILE DONTCOPY - -(LOCALVARS . T) -) - -(PUTPROPS FONT FILETYPE :FAKE-COMPILE-FILE) @@ -3676,7 +3772,12 @@ (DEFINEQ (\CREATEDISPLAYFONT - [LAMBDA (FONTSPEC) (* ; "Edited 28-Aug-2025 16:00 by rmk") + [LAMBDA (FONTSPEC) (* ; "Edited 5-May-2026 09:54 by rmk") + (* ; "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") (* ; "Edited 18-Aug-2025 11:32 by rmk") (* ; "Edited 16-Aug-2025 18:46 by rmk") (* ; "Edited 10-Aug-2025 13:24 by rmk") @@ -3687,93 +3788,65 @@ (* ; "Edited 22-May-2025 09:52 by rmk") (* ; "gbn: 25-Jan-86 18:02") - (* ;; "FONTEXISTS? has determined that there is at least one source file for this font, so the font exists in at least some character sets, d FONTCREATED1 tells us that the font descriptor is not yet availabe.") + (* ;; "Eventually, this should be removed from IMAGESTREAMTYPES, since it is the default. Left here in case something else turns up.") + + (* ;; "FONTEXISTS? has determined that there is at least one source file for this font, so the font exists or can be faked in at least some character sets.") + + (LET [(FILE (CAR (FONTFILES FONTSPEC] + (if FILE + then (MEDLEYFONT.READ.FONT FILE NIL T) + else + (* ;; "Set up for faking") - (create FONTDESCRIPTOR - FONTFAMILY ↠(fetch (FONTSPEC FSFAMILY) of FONTSPEC) - FONTSIZE ↠(fetch (FONTSPEC FSSIZE) of FONTSPEC) - FONTFACE ↠(fetch (FONTSPEC FSFACE) of FONTSPEC) - ROTATION ↠(fetch (FONTSPEC FSROTATION) of FONTSPEC) - FONTDEVICE ↠(fetch (FONTSPEC FSDEVICE) of FONTSPEC) - \SFAscent ↠0 - \SFDescent ↠0 - \SFHeight ↠0 - FONTDEVICESPEC ↠(create FONTSPEC using FONTSPEC]) + (FONTSPEC.TO.FONTDESCRIPTOR FONTSPEC]) (\CREATECHARSET.DISPLAY - [LAMBDA (FONTSPEC FONT CHARSET) (* ; "Edited 7-Oct-2025 17:05 by rmk") - (* ; "Edited 2-Sep-2025 23:42 by rmk") - (* ; "Edited 30-Aug-2025 19:42 by rmk") - (* ; "Edited 28-Aug-2025 23:08 by rmk") - (* ; "Edited 26-Aug-2025 23:29 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") + (* ; "Edited 14-Mar-2026 12:26 by rmk") + (* ; "Edited 7-Oct-2025 17:05 by rmk") (* ; "Edited 18-Aug-2025 09:12 by rmk") (* ; "Edited 31-Jul-2025 10:14 by rmk") (* ; "Edited 13-Jul-2025 11:44 by rmk") - (* ; "Edited 20-May-2025 15:00 by rmk") (* ; "Edited 18-May-2025 23:31 by rmk") (* ; "Edited 14-Jan-88 23:42 by FS") - (* ;; "The first case is simple: A DISPLAYFONTCOERCIONS substitution for one font for another. E.g. Use the information derived for HELVETICA 4 to construct the fontdescriptor for Helvetic 3. ") - - (* ;; "After that, it uses requested source files and/or DISPLAYCHARCOERCIONS to produce and complete the CHARSETINFO:") - - (* ;; "This first tries to find a source file that exactly matches the characteristics of the requested charset. The charset is %"completed%" by filling in any missing characters from further down the coercion chain. Thus, the missing characters for e.g. TERMINAL 357 will be filled in from MODERN357, and then perhaps CLASSIC357.") - - (* ;; "If an exact match file cannot be found for a requested rotation, the rotation 0 charset is obtained and rotated.") - - (* ;; "If a non-existent Kanji or Chinese charset is requested for a non-MRR face, the MRR charset is used unmodified. We don't try to boldify or italicize Kanji or Chinese.") - - (* ;; "When all coercions have been exhausted and FACE is bold and/or italic, the search process repeats with bold/italice changed to Regular, and algorithmic transformations are applied to the first result, if any.") + (* ;; "If the CHARSETINFO can be read from a file, then any appropriate charset or character coercions (complete, rotated, faked) are assumed to have already taken place.") - (* ;; "If all else fails, it looks for the next charset in the coercion list, and fills that in with further coercions for missing characters.") + (* ;; "But if it doesn't exist on a file, it may be that face-faking or rotation can be applied to a character set that can be retrieved from an existing complete file.") (* ;; "") - (LET ((ROTATION (fetch (FONTSPEC FSROTATION) of FONTSPEC)) - (FACE (fetch (FONTSPEC FSFACE) of FONTSPEC)) - CSINFO) - - (* ;; - "If no COERCIONS, skip that first \COERCECHARSET call--easier debugging of the other cases.") - - (SETQ CSINFO (if (AND (FONTDEVICEPROP 'DISPLAY 'FONTCOERCIONS) - (CADR (\COERCECHARSET FONTSPEC CHARSET NIL 'FONTCOERCIONS FONT))) - elseif [SETQ CSINFO (OR (\READCHARSET FONTSPEC CHARSET FONT) - (CADR (\COERCECHARSET FONTSPEC CHARSET NIL - 'CHARCOERCIONS] - then - (* ;; "This completes CSINFO with glyphs for all codes from possibly different sources, even if just asking for a single THINCODE. We never return an incomplete CSINFO.") - - (COMPLETE.CHARSET CSINFO FONTSPEC CHARSET FONT) - elseif (NEQ ROTATION 0) - then (CL:UNLESS (MEMB ROTATION '(90 270)) - (ERROR "Only implemented rotations are 0, 90 and 270." ROTATION - )) - (CL:WHEN (SETQ CSINFO (\CREATECHARSET.DISPLAY (create FONTSPEC - using FONTSPEC - FSROTATION ↠0) - FONT CHARSET)) - (\SFROTATECSINFO CSINFO ROTATION)) - elseif (OR (KANJICHARSETP CHARSET) - (CHINESECHARSETP CHARSET)) - then (CL:UNLESS (EQUAL FACE '(MEDIUM REGULAR REGULAR)) - (\CREATECHARSET.DISPLAY (create FONTSPEC - using FONTSPEC FSFACE ↠- '(MEDIUM REGULAR REGULAR)) - FONT CHARSET)) - elseif (EQ 'BOLD (fetch (FONTFACE WEIGHT) of FACE)) - then (MAKEBOLD.CHARSET FONTSPEC CHARSET FONT) - elseif (EQ 'ITALIC (fetch (FONTFACE SLOPE) of FACE)) - then (MAKEITALIC.CHARSET FONTSPEC CHARSET FONT) - elseif (EQ 'COMPRESSED (fetch (FONTFACE EXPANSION) of FACE)) - then (\CREATECHARSET.DISPLAY (create FONTSPEC - using FONTSPEC FSFACE ↠- '(MEDIUM REGULAR REGULAR)) - FONT CHARSET))) - CSINFO]) + (if (\READCHARSET FONT CHARSET) + else + (* ;; "Successful transformations must set the CSINFO so that it can be returned.") + + (CL:UNLESS (EQ 0 (fetch (FONTSPEC FSROTATION) of FONTSPEC)) + (\SFROTATECSINFO FONTSPEC FONT CHARSET)) + (COMPLETE.CHARSET FONT CHARSET) + (CL:WHEN (FONTDEVICEPROP FONTSPEC 'FACECOERCIONS) (* ; + "Suppresses face-faking in offline COMPLETE phase") + (CL:WHEN (EQ 'BOLD (fetch (FONTSPEC FSWEIGHT) of FONTSPEC)) + + (* ;; "Heuristically, an actual glyph from a completed/inherited font with the same face ought to be better than the fake from a more regular version of FONT--the algorithms aren't so good. So here the complete happens first. The problem is that the inherited font may have glyphs from its own faking, in the offline importfont sequence. There is no way to know on the fly whether any individual inherited character was faked or not") + + (FAKEFACE.CHARSET FONT CHARSET (FUNCTION MAKEBOLD.CHAR) + (create FONTSPEC using FONTSPEC FSWEIGHT ↠'MEDIUM))) + (CL:WHEN (EQ 'ITALIC (fetch (FONTSPEC FSSLOPE) of FONTSPEC)) + (FAKEFACE.CHARSET FONT CHARSET (FUNCTION MAKEITALIC.CHAR) + (create FONTSPEC using FONTSPEC FSSLOPE ↠'REGULAR))) + (CL:WHEN (EQ 'COMPRESSED (fetch (FONTSPEC FSEXPANSION) of FONTSPEC)) + (FAKEFACE.CHARSET FONT CHARSET (FUNCTION MOVEFONTCHARS) + (create FONTSPEC using FONTSPEC FSEXPANSION ↠'REGULAR)))) + (\GETCHARSETINFO FONT CHARSET]) (\FONTEXISTS?.DISPLAY - [LAMBDA (FONTSPEC) (* ; "Edited 17-Dec-2025 20:56 by rmk") + [LAMBDA (FONTSPEC NOCOERCIONS) (* ; "Edited 4-Apr-2026 09:03 by rmk") + (* ; "Edited 18-Mar-2026 11:45 by rmk") + (* ; "Edited 17-Dec-2025 20:56 by rmk") (* ; "Edited 28-Aug-2025 22:12 by rmk") (* ; "Edited 25-Aug-2025 15:04 by rmk") (* ; "Edited 17-Aug-2025 09:56 by rmk") @@ -3784,323 +3857,88 @@ (* ; "Edited 13-Jul-2025 11:45 by rmk") (* ; "Edited 22-Jun-2025 08:53 by rmk") - (* ;; "Order doesn't matter here, only need one to work") - - (LET ((FACE (fetch (FONTSPEC FSFACE) of FONTSPEC))) - (OR [AND (EQ 'BOLD (fetch (FONTFACE WEIGHT) of FACE)) - (FONTEXISTS? (create FONTSPEC using FONTSPEC FSFACE ↠- (create FONTFACE using FACE WEIGHT ↠- 'MEDIUM] - [AND (EQ 'ITALIC (fetch (FONTFACE SLOPE) of FACE)) - (FONTEXISTS? (create FONTSPEC using FONTSPEC FSFACE ↠- (create FONTFACE using FACE SLOPE ↠- 'REGULAR] - [AND (EQ 'COMPRESSED (fetch (FONTFACE EXPANSION) of FACE)) - (FONTEXISTS? (create FONTSPEC using FONTSPEC FSFACE ↠- (create FONTFACE using FACE EXPANSION ↠- 'REGULAR] - (COERCEFONTSPEC FONTSPEC (APPEND (FONTDEVICEPROP 'DISPLAY 'FONTCOERCIONS) - (FONTDEVICEPROP 'DISPLAY 'CHARCOERCIONS]) + (* ;; "Order doesn't matter here, only need one to work. The CHAR coercions are done generically, if this fails. This considers the face faking to be a form of coercion, suppressed by NOCOERCION.") + + (* ;; "BIR is possible if either MIR or BRR is available, doesn't always go to MRR.") + + (CL:UNLESS NOCOERCIONS + (CL:WHEN (FONTDEVICEPROP FONTSPEC 'FACECOERCIONS) + (OR (AND (EQ 'BOLD (fetch (FONTSPEC FSWEIGHT) of FONTSPEC)) + (FONTEXISTS? (create FONTSPEC using FONTSPEC FSWEIGHT ↠'MEDIUM) + NOCOERCIONS)) + (AND (EQ 'ITALIC (fetch (FONTSPEC FSSLOPE) of FONTSPEC)) + (FONTEXISTS? (create FONTSPEC using FONTSPEC FSSLOPE ↠'REGULAR) + NOCOERCIONS)) + (AND (EQ 'COMPRESSED (fetch (FONTSPEC FSEXPANSION) of FONTSPEC)) + (FONTEXISTS? (create FONTSPEC using FONTSPEC FSEXPANSION ↠'REGULAR) + NOCOERCIONS)))))]) ) (DEFINEQ -(STRIKEFONT.FILEP - [LAMBDA (FILE) (* ; "Edited 15-May-2025 17:47 by rmk") - - (* ;; "If high bit of type is on, then must be strike. If 2nd bit is on, must be strike-index, and we punt. We don't care about the 3rd bit") - - (* ;; "first word has high bits (onebit index fixed). Onebit means 'new-style font' , index is 0 for simple strike, 1 for index, and fixed is if all chars have max width. Lisp doesn't care about 'fixed'") - - (RESETLST - (CL:UNLESS (OPENP FILE 'INPUT) - [RESETSAVE (SETQ FILE (OPENSTREAM FILE 'INPUT 'OLD)) - `(PROGN (CLOSEF? OLDVALUE]) - (CL:WHEN [MEMB (\WIN FILE) - (CONSTANT (LIST (LLSH 1 15) - (LOGOR (LLSH 1 15) - (LLSH 1 13] - T))]) - -(STRIKEFONT.GETCHARSET - [LAMBDA (STRM) (* ; "Edited 3-Aug-2025 22:27 by rmk") - (* ; "Edited 1-Aug-2025 23:50 by rmk") - (* ; "Edited 14-Jul-2025 19:52 by rmk") - (* ; "Edited 9-Jun-2025 14:22 by rmk") - (* ; "Edited 12-Jul-2022 09:19 by rmk") - (* ; "Edited 4-Dec-92 12:11 by jds") - - (* ;; "STRM has already been determined to be a vanilla strike-format file holding only the desired charset.") - (* ; "returns a charsetinfo") - (RESETLST - (CL:UNLESS (\GETSTREAM STRM 'INPUT T) - [RESETSAVE (SETQ STRM (OPENSTREAM STRM 'INPUT 'OLD)) - `(PROGN (CLOSEF? OLDVALUE]) - (SETFILEPTR STRM 0) - (CL:UNLESS (STRIKEFONT.FILEP STRM) - (ERROR "Not a STRIKE font file" STRM)) - (CL:UNLESS (EQ 2 (GETFILEPTR STRM)) - (SETFILEPTR STRM 2)) - (LET (CSINFO NUMBCODES RW BITMAP OFFSETS FIRSTCHAR LASTCHAR HEIGHT WIDTHS) - (SETQ CSINFO (create CHARSETINFO)) - (SETQ FIRSTCHAR (\WIN STRM)) (* ; "minimum ascii code") - (SETQ LASTCHAR (\WIN STRM)) (* ; "maximum ascii code") - (\WIN STRM) (* ; - "MaxWidth which isn't used by anyone.") - (\WIN STRM) (* ; - "number of words in this StrikeBody") - (replace (CHARSETINFO CHARSETASCENT) of CSINFO with (\WIN STRM)) - (* ; - "ascent in scan lines (=FBBdy+FBBoy)") - (replace (CHARSETINFO CHARSETDESCENT) of CSINFO with (\WIN STRM)) - (* ; "descent in scan-lines (=FBBoy)") - (\WIN STRM) (* ; - "offset in bits (<0 for kerning, else 0, =FBBox)") - (SETQ RW (\WIN STRM)) (* ; "raster width of bitmap") - (* ; "height of bitmap") - - (* ;; "JDS 12/4/92: Apparently, these fields can be signed values, if all chars, e.g., ride above the base line.") - - (SETQ HEIGHT (IPLUS (SIGNED (fetch (CHARSETINFO CHARSETASCENT) of CSINFO) - 16) - (SIGNED (fetch (CHARSETINFO CHARSETDESCENT) of CSINFO) - 16))) - (SETQ BITMAP (BITMAPCREATE (UNFOLD RW BITSPERWORD) - HEIGHT)) - (\BINS STRM (fetch BITMAPBASE of BITMAP) - 0 - (UNFOLD (ITIMES RW HEIGHT) - BYTESPERWORD)) (* ; "read bits into bitmap") - (replace (CHARSETINFO CHARSETBITMAP) of CSINFO with BITMAP) - (SETQ NUMBCODES (IDIFFERENCE (ADD1 LASTCHAR) - FIRSTCHAR)) - (SETQ OFFSETS (fetch (CHARSETINFO OFFSETS) of CSINFO)) - - (* ;; - "Initialize the offsets to 0, all but FIRSTCHAR to be replaced with the slug offset") - - (for I from 0 to (IPLUS \MAXTHINCHAR 2) do (\FSETOFFSET OFFSETS I 0)) - (for I from FIRSTCHAR as J from 1 to NUMBCODES do - (* ;; - "J starts at 1 because we know that the offset of J=0 is 0 ?") - - (\FSETOFFSET OFFSETS I (\WIN STRM))) - (for I (SLUGOFFSET ↠(\WIN STRM)) from 0 to \MAXTHINCHAR - when (EQ 0 (\FGETOFFSET OFFSETS I)) unless (EQ I FIRSTCHAR) - do (\FSETOFFSET OFFSETS I SLUGOFFSET) finally (\FSETOFFSET OFFSETS SLUGCHARINDEX - SLUGOFFSET) - - (* ;; - "There's one more so that \FONTRESETCHARWIDTHS can get the slug width, otherwise not necessary") - - (\FSETOFFSET OFFSETS (ADD1 SLUGCHARINDEX) - (\WIN STRM))) - - (* ;; "Initialize the widths to 0") - - (SETQ WIDTHS (fetch (CHARSETINFO WIDTHS) of CSINFO)) - (for I from 0 to (IPLUS \MAXTHINCHAR 2) do (\FSETWIDTH WIDTHS I 0)) - (\FONTRESETCHARWIDTHS CSINFO 0 SLUGCHARINDEX) - (replace (CHARSETINFO IMAGEWIDTHS) of CSINFO with (fetch (CHARSETINFO WIDTHS) - of CSINFO)) - CSINFO))]) - -(WRITESTRIKEFONTFILE - [LAMBDA (FONT CHARSET FILE) (* ; "Edited 30-Aug-2025 23:21 by rmk") - (* ; "Edited 28-Aug-2025 15:09 by rmk") - (* ; "Edited 24-Aug-2025 11:39 by rmk") - (* ; "Edited 3-Aug-2025 22:33 by rmk") - (* ; "Edited 22-May-2025 09:53 by rmk") - (* ; "Edited 1-Feb-2025 12:27 by mth") - (* ; "Edited 12-Jul-2022 14:36 by rmk") - (* kbr%: "21-Oct-85 15:08") - (* ; - "Write strike FILE using info in FONT. ") - (CL:UNLESS (FONTP FONT) - (LISPERROR "ILLEGAL ARG" FONT)) - (CL:UNLESS CHARSET (SETQ CHARSET 0)) - (CL:UNLESS (AND (IGEQ CHARSET 0) - (ILEQ CHARSET \MAXCHARSET)) - (LISPERROR "ILLEGAL ARG" CHARSET)) - (LET (STREAM CSINFO FIRSTCHAR LASTCHAR WIDTHS MAXWIDTH LENGTH RASTERWIDTH SLUGOFFSET OFFSETS) - (SETQ CSINFO (\INSURECHARSETINFO FONT CHARSET)) - (CL:UNLESS CSINFO (ERROR "Couldn't find charset " CHARSET)) - (SETQ WIDTHS (fetch (CHARSETINFO WIDTHS) of CSINFO)) - (SETQ OFFSETS (fetch (CHARSETINFO OFFSETS) of CSINFO)) - (SETQ SLUGOFFSET (\FGETOFFSET OFFSETS SLUGCHARINDEX)) - - (* ;; "Find the first and last non-slug characters") - - [SETQ FIRSTCHAR (for I from 0 to \MAXTHINCHAR thereis (NEQ SLUGOFFSET (\FGETOFFSET OFFSETS I - ] - [SETQ LASTCHAR (for I from \MAXTHINCHAR to 0 by -1 thereis (NEQ SLUGOFFSET (\FGETOFFSET - OFFSETS I] - [SETQ STREAM (OPENSTREAM FILE 'OUTPUT 'NEW '((TYPE BINARY] - (\WOUT STREAM 32768) (* ; "STRIKE HEADER. ") - (\WOUT STREAM FIRSTCHAR) - (\WOUT STREAM LASTCHAR) - (SETQ MAXWIDTH 0) - [for I from 0 to SLUGCHARINDEX do (SETQ MAXWIDTH (IMAX MAXWIDTH (\FGETWIDTH WIDTHS I] - (\WOUT STREAM MAXWIDTH) (* ; "STRIKE BODY. ") - (* ; "Length. ") - (SETQ RASTERWIDTH (fetch (BITMAP BITMAPRASTERWIDTH) of (fetch (CHARSETINFO CHARSETBITMAP) - of CSINFO))) - (SETQ LENGTH (IPLUS 8 (IDIFFERENCE LASTCHAR FIRSTCHAR) - (ITIMES (fetch (FONTDESCRIPTOR \SFHeight) of FONT) - RASTERWIDTH))) - (\WOUT STREAM LENGTH) (* ; - "Ascent, Descent, Xoffset (no longer used) and Rasterwidth. ") - (\WOUT STREAM (fetch (CHARSETINFO CHARSETASCENT) of CSINFO)) - (\WOUT STREAM (fetch (CHARSETINFO CHARSETDESCENT) of CSINFO)) - (\WOUT STREAM 0) - (\WOUT STREAM RASTERWIDTH) (* ; "Bitmap. ") - [\BOUTS STREAM (fetch (BITMAP BITMAPBASE) of (fetch (CHARSETINFO CHARSETBITMAP) of CSINFO)) - 0 - (ITIMES 2 RASTERWIDTH (IPLUS (fetch (CHARSETINFO CHARSETASCENT) of CSINFO) - (fetch (CHARSETINFO CHARSETDESCENT) of CSINFO] - (* ; "Offsets. ") - [for I (OFFSET ↠0) from FIRSTCHAR to LASTCHAR first (\WOUT STREAM OFFSET) - (* ; "Offset of the first char") - do (CL:UNLESS (EQ SLUGOFFSET (\FGETOFFSET OFFSETS I)) - (* ; - "The slug isn't really here in the bitmap") - (ADD OFFSET (\FGETWIDTH WIDTHS I))) - (\WOUT STREAM OFFSET) finally (* ; - "Offset for the after-slug, for width") - (\WOUT STREAM (IPLUS OFFSET (\FGETWIDTH WIDTHS - SLUGCHARINDEX] - (CLOSEF STREAM]) - -(STRIKECSINFO - [LAMBDA (CSINFO) (* ; "Edited 27-Apr-89 13:39 by atm") - - (* ;; "Returns a STRIKE type font descriptor (EQ WIDTHS IMAGEWIDTHS), cause we know how to write those guys out (they read quicker but display slower). If (EQ WIDTHS IMAGEWIDTHS), just return original.") - - (PROG (WIDTHS OFFSETS IMWIDTHS OLDBM BMWIDTH BMHEIGHT NEWBM NEWOFFSET NEWWIDTH OLDOFFSET - DUMMYOFFSET NEWOFFSETS) - (SETQ WIDTHS (fetch (CHARSETINFO WIDTHS) of CSINFO)) - (SETQ IMWIDTHS (fetch (CHARSETINFO IMAGEWIDTHS) of CSINFO)) - (if (EQ WIDTHS IMWIDTHS) - then (RETURN CSINFO)) - (SETQ OFFSETS (fetch (CHARSETINFO OFFSETS) of CSINFO)) - (SETQ OLDBM (fetch (CHARSETINFO CHARSETBITMAP) of CSINFO)) - (SETQ DUMMYOFFSET (\FGETOFFSET OFFSETS 256)) - (SETQ BMHEIGHT (BITMAPHEIGHT OLDBM)) - [SETQ BMWIDTH (for I from 0 to \MAXTHINCHAR - sum (if (IEQP DUMMYOFFSET (\FGETOFFSET OFFSETS I)) - then 0 - else (IMAX (\FGETIMAGEWIDTH IMWIDTHS I) - (\FGETWIDTH WIDTHS I] - - (* ;; "") - - (* ;; "Initialize new offsets vector") - - (* ;; "") - - (SETQ NEWOFFSETS (\CREATECSINFOELEMENT)) - (for I from 0 to (IPLUS \MAXTHINCHAR 2) do (\FSETOFFSET NEWOFFSETS I 0)) - (\FSETOFFSET NEWOFFSETS (ADD1 \MAXTHINCHAR) - BMWIDTH) - - (* ;; "") - - (* ;; "Adjust bitmap with so width = imagewidth, fill offsets") - - (* ;; "") - - (SETQ NEWBM (BITMAPCREATE BMWIDTH BMHEIGHT 1)) - (SETQ NEWOFFSET 0) - [for I from 0 to 255 do (SETQ OLDOFFSET (\FGETOFFSET OFFSETS I)) - (if (IEQP DUMMYOFFSET OLDOFFSET) - then (\FSETOFFSET NEWOFFSETS I BMWIDTH) - else (\FSETOFFSET NEWOFFSETS I NEWOFFSET) - (SETQ NEWWIDTH (IMAX (\FGETIMAGEWIDTH IMWIDTHS I) - (\FGETWIDTH WIDTHS I))) - (BITBLT OLDBM OLDOFFSET 0 NEWBM NEWOFFSET 0 (\FGETWIDTH - IMWIDTHS I) - BMHEIGHT - 'REPLACE) - (SETQ NEWOFFSET (IPLUS NEWOFFSET NEWWIDTH] - - (* ;; "") - - (* ;; "Make new CSInfo record withs IMAGEWIDTHS, WIDTHS the same") - - (* ;; "") - - (SETQ WIDTHS (COPYALL WIDTHS)) - [for I from 0 to \MAXTHINCHAR do (\FSETWIDTH WIDTHS I (IMAX (\FGETWIDTH WIDTHS I) - (\FGETIMAGEWIDTH IMWIDTHS I] - (RETURN (create CHARSETINFO - WIDTHS ↠WIDTHS - OFFSETS ↠NEWOFFSETS - IMAGEWIDTHS ↠WIDTHS - CHARSETBITMAP ↠NEWBM - YWIDTHS ↠(fetch (CHARSETINFO YWIDTHS) of CSINFO) - CHARSETASCENT ↠(fetch (CHARSETINFO CHARSETASCENT) of CSINFO) - CHARSETDESCENT ↠(fetch (CHARSETINFO CHARSETDESCENT) of CSINFO]) -) - - - -(* ; "Bitmap faking") - -(DEFINEQ - -(MAKEBOLD.CHARSET - [LAMBDA (FONTSPEC CHARSET FONT) (* ; "Edited 7-Sep-2025 12:02 by rmk") +(FAKEFACE.CHARSET + [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") + (* ; "Edited 21-Mar-2026 22:31 by rmk") + (* ; "Edited 15-Mar-2026 14:26 by rmk") + (* ; "Edited 7-Sep-2025 12:02 by rmk") (* ; "Edited 2-Sep-2025 22:59 by rmk") (* ; "Edited 31-Aug-2025 14:36 by rmk") (* ; "Edited 26-Aug-2025 22:35 by rmk") (* ; "Edited 18-Aug-2025 09:08 by rmk") - (* ; "Edited 16-Aug-2025 12:53 by rmk") - (* ; "Edited 21-Jun-2025 09:10 by rmk") - - (* ;; "BOLD is requested in FACE, so we look for an MRR or MIR that we can bold. If we find one, we presume that it is complete for all characters in its face. But there may be other fonts in the coercion chain that have true information about the bold face that we are after. We look for those before we try to adjust the characters in the non-bold CSINFO that we found.") - - (LET ([MFONT (FONTCREATE1 (create FONTSPEC using FONTSPEC FSFACE ↠(create FONTFACE - using (fetch (FONTSPEC - FSFACE) - of FONTSPEC) - WEIGHT ↠'MEDIUM] - CSINFO) - - (* ;; "MFONT is the corresponding Medium font.") - - (CL:WHEN (AND MFONT (SETQ CSINFO (\GETCHARSETINFO MFONT CHARSET)) - (NOT (fetch (CHARSETINFO CSSLUGP) of CSINFO))) - (replace (FONTDESCRIPTOR FONTCHARENCODING) of FONT with (fetch (FONTDESCRIPTOR - FONTCHARENCODING) - of MFONT)) - (replace (FONTDESCRIPTOR FONTTOMCCSFN) of FONT with (fetch (FONTDESCRIPTOR FONTTOMCCSFN) - of MFONT)) - (SETQ CSINFO (COPYALL CSINFO)) (* ; "CSINFO is now the CS to be bolded") - (\SETCHARSETINFO FONT CHARSET CSINFO) - (for CODE SOURCEFONT (CHARCOERCIONS ↠(FONTDEVICEPROP FONT 'CHARCOERCIONS)) - from (FIRSTCHARSETCODE CHARSET) to (LASTCHARSETCODE CHARSET) - do (if (SLUGCHARP.DISPLAY CODE FONT) - then - (* ;; "The Medium font doesn't have a glyph for THINCODE. Look for a bold glyph for THINCODE lurking somewhere down the chain, copy it up. There may be different sources for different codes. We're starting from FONT and FONTSPEC, still hoping for BOLD.") - - (CL:WHEN (SETQ SOURCEFONT (CAR (\COERCECHARSET FONTSPEC CHARSET CODE))) - (\MOVEFONTCHAR (\MOVEFONTCHARS.SOURCEDATA CODE SOURCEFONT) - CODE FONT)) - else - (* ;; "There is Medium glyph, bold it") - - (MAKEBOLD.CHAR CODE FONT))) - (replace (CHARSETINFO CSCOMPLETEP) of CSINFO with T) - CSINFO)]) + (* ; "Edited 16-Aug-2025 12:53 by rmk") + + (* ;; "Caller has determined that slug characters in FONT should be replaced by applying FAKEFN to the corresponding SOURCEFACE characters.") + + (* ;; "This assumes that SOURCEFONT has already been faked up.") + + (LET [CHANGED FCSINFO SCSINFO INDIRECT (FONTSPEC (FONTPROP FONT 'DEVICESPEC] + (CL:WHEN (type? FONTSPEC SOURCEFONT) + (SETQ SOURCEFONT (FONTCREATE1 SOURCEFONT CHARSET))) + (CL:WHEN (AND (SETQ SCSINFO (\GETCHARSETINFO SOURCEFONT CHARSET)) + (NOT (fetch (CHARSETINFO CSSLUGP) of SCSINFO))) + (if (OR (KANJICHARSETP CHARSET) + (UNIHANCHARSETP CHARSET)) + then (SETQ FCSINFO (COPYALL SCSINFO)) (* ; "Copy and set up an indirect") + (CHARSETPROP FCSINFO 'SOURCE (FONTPROP SOURCEFONT 'DEVICESPEC)) + (\INSTALLCHARSETINFO FONT FCSINFO CHARSET) + (SETQ CHANGED T) + elseif (AND [NOT (EQUAL FONTSPEC (SETQ INDIRECT (CHARSETPROP SCSINFO 'SOURCE] + (EQUAL (fetch (FONTSPEC FSFACE) of FONTSPEC) + (fetch (FONTSPEC FSFACE) of INDIRECT)) + (FONTFILES INDIRECT CHARSET)) + then + (* ;; "Indirect: font charset adds nothing new, it can inherit the faking of its charset-source: MODERN MIR for HELVETICA MIR rather than faking from HELVETICA MRR. Smaller file size?") + + (SETQ FCSINFO (COPYALL (MEDLEYFONT.GETCHARSET INDIRECT CHARSET))) + (\INSTALLCHARSETINFO FONT FCSINFO CHARSET) + (SETQ CHANGED FCSINFO) + else (SETQ FCSINFO (OR (\GETCHARSETINFO FONT CHARSET) + (\INSTALLCHARSETINFO FONT (SLUGCSINFO FONT) + CHARSET))) + (for CODE from (FIRSTCHARSETCODE CHARSET) to (LASTCHARSETCODE CHARSET) + when (SLUGCHARP CODE FONT) unless (SLUGCHARP CODE SOURCEFONT) + do (\MOVEFONTCHAR (\MOVEFONTCHARS.SOURCEDATA CODE SOURCEFONT) + CODE FONT) + (APPLY* FAKEFN CODE FONT SOURCEFONT) + (SETQ CHANGED FCSINFO)) + (CL:WHEN CHANGED + (CHARSETPROP FCSINFO 'SOURCE FONTSPEC))) + (replace (CHARSETINFO CSCOMPLETEP) of FCSINFO with T) + CHANGED)]) (MAKEBOLD.CHAR - [LAMBDA (CODE FONT) (* ; "Edited 2-Sep-2025 22:59 by rmk") + [LAMBDA (CODE FONT) (* ; "Edited 15-Mar-2026 14:32 by rmk") + (* ; "Edited 2-Sep-2025 22:59 by rmk") (* ; "Edited 27-Aug-2025 23:55 by rmk") (* ; "Edited 26-Aug-2025 22:36 by rmk") (* ; "Edited 17-Jun-2025 08:22 by rmk") (* ;; "Replaces the bitmap for CODE in FONT with a bolder one: overlaps 2 bits to produce the bold effect. Could be iterated for bigger fonts, but eventually the open spaces would be closed up.") - (CL:UNLESS (SLUGCHARP.DISPLAY CODE FONT) + (CL:UNLESS (SLUGCHARP CODE FONT) (LET* [(THINCODE (\CHAR8CODE CODE)) (CSINFO (\GETCHARSETINFO FONT (\CHARSET CODE))) (OLDCHARBITMAP (\GETCHARBITMAP.CSINFO THINCODE CSINFO)) @@ -4118,61 +3956,16 @@ (BITBLT OLDCHARBITMAP 0 0 NEWCHARBITMAP 1 0 CWIDTH HEIGHT 'INPUT 'PAINT) (\PUTCHARBITMAP.CSINFO THINCODE CSINFO NEWCHARBITMAP)))]) -(MAKEITALIC.CHARSET - [LAMBDA (FONTSPEC CHARSET FONT) (* ; "Edited 7-Sep-2025 12:03 by rmk") - (* ; "Edited 2-Sep-2025 22:59 by rmk") - (* ; "Edited 31-Aug-2025 14:36 by rmk") - (* ; "Edited 26-Aug-2025 22:35 by rmk") - (* ; "Edited 18-Aug-2025 09:10 by rmk") - (* ; "Edited 16-Aug-2025 12:53 by rmk") - (* ; "Edited 21-Jun-2025 09:10 by rmk") - - (* ;; "ITALIC is requested, so we look for an MRR or MIR that we can italicize. If we find one, we presume that it is complete for all characters in its face. But there may be other fonts in the coercion chain that have true information about the italic face that we are after. We look for those before we try to adjust the characters in non-italic CSINFO that we found.") - - (LET ([RFONT (FONTCREATE1 (create FONTSPEC using FONTSPEC FSFACE ↠(create FONTFACE - using (fetch (FONTSPEC - FSFACE) - of FONTSPEC) - SLOPE ↠'REGULAR] - CSINFO) - - (* ;; "RFONT is the corresponding Regular font.") - - (CL:WHEN (AND RFONT (SETQ CSINFO (\GETCHARSETINFO RFONT CHARSET)) - (NOT (fetch (CHARSETINFO CSSLUGP) of CSINFO))) - (replace (FONTDESCRIPTOR FONTCHARENCODING) of FONT with (fetch (FONTDESCRIPTOR - FONTCHARENCODING) - of RFONT)) - (replace (FONTDESCRIPTOR FONTTOMCCSFN) of FONT with (fetch (FONTDESCRIPTOR FONTTOMCCSFN) - of RFONT)) - (SETQ CSINFO (COPYALL CSINFO)) (* ; - "CSINFO is now the CS to be italicized") - (\SETCHARSETINFO FONT CHARSET CSINFO) - (for CODE SOURCEFONT (CHARCOERCIONS ↠(FONTDEVICEPROP FONT 'CHARCOERCIONS)) - from (FIRSTCHARSETCODE CHARSET) to (LASTCHARSETCODE CHARSET) - do (if (SLUGCHARP.DISPLAY CODE FONT) - then - (* ;; "The regular font doesn't have a glyph for THINCODE. Look for an italic glyph for THINCODE lurking somewhere down the chain, copy it up. There may be different sources for different codes.") - - (CL:WHEN (SETQ SOURCEFONT (CAR (\COERCECHARSET FONTSPEC CHARSET CODE))) - (\MOVEFONTCHAR (\MOVEFONTCHARS.SOURCEDATA CODE SOURCEFONT) - CODE FONT)) - else - (* ;; "There is a Regular glyph, Italicize it.") - - (MAKEITALIC.CHAR CODE FONT))) - (replace (CHARSETINFO CSCOMPLETEP) of CSINFO with T) - CSINFO)]) - (MAKEITALIC.CHAR - [LAMBDA (CODE FONT) (* ; "Edited 2-Sep-2025 22:59 by rmk") + [LAMBDA (CODE FONT) (* ; "Edited 15-Mar-2026 14:32 by rmk") + (* ; "Edited 2-Sep-2025 22:59 by rmk") (* ; "Edited 26-Aug-2025 22:36 by rmk") (* ; "Edited 18-Jun-2025 14:12 by rmk") (* ; "Edited 17-Jun-2025 09:54 by rmk") (* ;; "Replaces the bitmap for CODE in FONT with a slanted one: It shifts rows to the right as a function of their vertical position. ") - (CL:UNLESS (SLUGCHARP.DISPLAY CODE FONT) + (CL:UNLESS (SLUGCHARP CODE FONT) (LET* ((THINCODE (\CHAR8CODE CODE)) (CSINFO (\GETCHARSETINFO FONT (\CHARSET CODE))) (OLDBITMAP (\GETCHARBITMAP.CSINFO THINCODE CSINFO)) @@ -4199,111 +3992,46 @@ 'INPUT 'REPLACE))] (\PUTCHARBITMAP.CSINFO THINCODE CSINFO NEWBITMAP)))]) - -(\SFMAKEBOLD - [LAMBDA (CSINFO) (* ; "Edited 28-Aug-2025 15:10 by rmk") - (* ; "Edited 24-Aug-2025 11:41 by rmk") - (* ; "Edited 16-Jun-2025 23:22 by rmk") - (* gbn "25-Jul-85 04:52") - (LET ((OLDCHARBITMAP (fetch (CHARSETINFO CHARSETBITMAP) of CSINFO)) - (WIDTHS (fetch (CHARSETINFO WIDTHS) of CSINFO)) - (OFFSETS (fetch (CHARSETINFO OFFSETS) of CSINFO)) - (HEIGHT (IPLUS (fetch (CHARSETINFO CHARSETASCENT) of CSINFO) - (fetch (CHARSETINFO CHARSETDESCENT) of CSINFO))) - NEWCHARBITMAP OFFSET SLUGOFFSET SLUGWIDTH) - (SETQ NEWCHARBITMAP (BITMAPCREATE (fetch BITMAPWIDTH of OLDCHARBITMAP) - (fetch BITMAPHEIGHT of OLDCHARBITMAP))) - (SETQ SLUGOFFSET (\FGETOFFSET OFFSETS SLUGCHARINDEX)) - (SETQ SLUGWIDTH (\FGETWIDTH WIDTHS SLUGCHARINDEX)) - (for I from 0 to \MAXTHINCHAR unless (EQ SLUGOFFSET (SETQ OFFSET (\FGETOFFSET OFFSETS I))) - do (* ; - "overlap two blts to produce bold effect") - (BITBLT OLDCHARBITMAP OFFSET 0 NEWCHARBITMAP OFFSET 0 (\FGETWIDTH WIDTHS I) - HEIGHT - 'INPUT - 'REPLACE) - (BITBLT OLDCHARBITMAP OFFSET 0 NEWCHARBITMAP (ADD1 OFFSET) - 0 - (SUB1 (\FGETWIDTH WIDTHS I)) - HEIGHT - 'INPUT - 'PAINT)) (* ; - "fill in the slug for the magic charcode") - (BITBLT OLDCHARBITMAP SLUGOFFSET 0 NEWCHARBITMAP SLUGOFFSET 0 SLUGWIDTH HEIGHT 'INPUT - 'REPLACE) - (create CHARSETINFO using CSINFO CHARSETBITMAP ↠NEWCHARBITMAP]) - -(\SFMAKEITALIC - [LAMBDA (CSINFO) (* ; "Edited 16-Jun-2025 23:20 by rmk") - (* gbn "18-Sep-85 17:57") - (LET ((WIDTHS (fetch (CHARSETINFO WIDTHS) of CSINFO)) - (OFFSETS (fetch (CHARSETINFO OFFSETS) of CSINFO)) - (ASCENT (fetch (CHARSETINFO CHARSETASCENT) of CSINFO)) - (DESCENT (fetch (CHARSETINFO CHARSETDESCENT) of CSINFO)) - (OLDBITMAP (fetch (CHARSETINFO CHARSETBITMAP) of CSINFO)) - HEIGHT OFFSET NEWBITMAP WIDTH SLUGOFFSET SLUGWIDTH N M R XN XX YN YX) - (SETQ HEIGHT (IPLUS ASCENT DESCENT)) - (SETQ NEWBITMAP (BITMAPCREATE (fetch BITMAPWIDTH of OLDBITMAP) - (fetch BITMAPHEIGHT of OLDBITMAP))) - (SETQ SLUGOFFSET (\FGETOFFSET OFFSETS (ADD1 \MAXTHINCHAR))) - (SETQ SLUGWIDTH (\FGETWIDTH WIDTHS (ADD1 \MAXTHINCHAR))) - (SETQ N (IDIFFERENCE 0 (IQUOTIENT (IPLUS DESCENT 3) - 4))) - (SETQ M (IQUOTIENT (IPLUS ASCENT 3) - 4)) - [for I from 0 to \MAXTHINCHAR unless (EQ SLUGOFFSET (SETQ OFFSET (\FGETOFFSET OFFSETS I))) - do (SETQ WIDTH (\FGETWIDTH WIDTHS I)) - (for J from N to M do (SETQ R (IPLUS OFFSET WIDTH)) - (SETQ XN (IMIN R (IMAX (IPLUS OFFSET J) - 0))) - (SETQ XX (IMIN R (IMAX (IPLUS R J) - 0))) - [SETQ YN (IMAX 0 (IPLUS DESCENT (ITIMES J 4] - [SETQ YX (IMIN HEIGHT (IPLUS DESCENT (IPLUS (ITIMES J 4) - 4] - (CL:WHEN (AND (IGREATERP XX XN) - (IGREATERP YX YN)) - (BITBLT OLDBITMAP OFFSET YN NEWBITMAP XN YN (IDIFFERENCE - XX XN) - (IDIFFERENCE YX YN) - 'INPUT - 'REPLACE))] - (BITBLT OLDBITMAP SLUGOFFSET 0 NEWBITMAP SLUGOFFSET 0 SLUGWIDTH HEIGHT 'INPUT 'REPLACE) - (create CHARSETINFO using CSINFO CHARSETBITMAP ↠NEWBITMAP]) ) -(DEFINEQ -(\SFMAKEROTATEDFONT - [LAMBDA (FONTDESC ROTATION) (* ; "Edited 30-Mar-87 20:35 by FS") - (* ;; "takes a fontdecriptor and rotates it.") - (* ;; "1/5/86 JDS. Masterscope claims nobody calls this. Let's find out....") +(* ; "Bitmap faking") - (HELP "ROTATED fonts need to be fixed for NS Chars & New FONTDESCRIPTOR fields") - (* (create FONTDESCRIPTOR using - FONTDESC (SETQ CHARACTERBITMAP - (\SFROTATEFONTCHARACTERS - (fetch (FONTDESCRIPTOR CHARACTERBITMAP) - of FONTDESC) ROTATION)) (SETQ ROTATION ROTATION) (SETQ \SFOffsets (\SFFIXOFFSETSAFTERROTATION - FONTDESC ROTATION)) (SETQ - FONTCHARSETVECTOR (\ALLOCBLOCK - (ADD1 \MAXCHARSET) T)))) +(DEFINEQ + +(\SFROTATECSINFO + [LAMBDA (FONTSPEC FONT CHARSET) (* ; "Edited 5-Apr-2026 01:31 by rmk") + (* gbn "15-Sep-85 14:38") - (* ;; "If you uncomment out the code above, remove this comment and the NIL below") + (* ;; + "Replaces the CSINFO of CHARSET in FONT with one in which all the characters have been rotated.") - NIL]) + (* ;; "Only non-zero rotations are coerced here, since it isn't worth creating and storing rotated versions of all fonts. So in that case, it rotates the charset from the otherwise complete font.") -(\SFROTATECSINFO - [LAMBDA (CSINFO ROTATION) (* gbn "15-Sep-85 14:38") + (LET ((ROTATION (fetch (FONTSPEC FSROTATION) of FONTSPEC)) + CSINFO)) + (if (MEMB ROTATION '(90 270)) + then + (* ;; "WHAT ABOUT 180 ?") - (* ;; "takes a CHARSETINFO and rotates it and produces a rotated equivalent one.") + (* ;; "CAN THE RECURSIVE CALL BE REPLACED BY \READCHARSET ??") - (create CHARSETINFO using CSINFO CHARSETBITMAP ↠(\SFROTATEFONTCHARACTERS (fetch (CHARSETINFO - CHARSETBITMAP) - of CSINFO) - ROTATION) - OFFSETS ↠(\SFROTATECSINFOOFFSETS CSINFO ROTATION]) + (CL:WHEN (SETQ CSINFO (\CREATECHARSET.DISPLAY (create FONTSPEC + using FONTSPEC FSROTATION ↠0) + FONT CHARSET)) + (\SETCHARSETINFO FONT CHARSET (create CHARSETINFO using CSINFO CHARSETBITMAP ↠+ (\SFROTATEFONTCHARACTERS + (fetch (CHARSETINFO + CHARSETBITMAP + ) + of CSINFO) + ROTATION) + OFFSETS ↠( + \SFROTATECSINFOOFFSETS + CSINFO ROTATION)) + )) + else (ERROR "Only rotations of 0, 90 and 270 are allowed" ROTATION]) (\SFROTATEFONTCHARACTERS [LAMBDA (CHARBITMAP ROTATION) (* ; "Edited 22-Sep-87 10:38 by Snow") @@ -4364,172 +4092,74 @@ (SETQ COLORCSINFO (create CHARSETINFO using BWCSINFO CHARSETBITMAP ↠CHARACTERBITMAP)) (RETURN COLORCSINFO]) ) -(* "FOLLOWING DEFINITIONS EXPORTED")(DECLARE%: DOEVAL@COMPILE DONTCOPY - -(GLOBALVARS DISPLAYFONTDIRECTORIES DISPLAYFONTEXTENSIONS DISPLAYCHARCOERCIONS DISPLAYFONTCOERCIONS - DISPLAYCHARSETFNS) -) - -(* "END EXPORTED DEFINITIONS") - (DECLARE%: DONTEVAL@LOAD DOCOPY -(RPAQ? DISPLAYFONTDIRECTORIES NIL) +(RPAQ? DISPLAYFONTDIRECTORIES (LIST "{MEDLEY}/fonts/medleydisplayfonts")) -(ADDTOVAR DISPLAYCHARSETFNS (STRIKE STRIKEFONT.FILEP STRIKEFONT.GETCHARSET)) +(ADDTOVAR DISPLAYFONTEXTENSIONS MEDLEYDISPLAYFONT) -(ADDTOVAR DISPLAYFONTEXTENSIONS MEDLEYDISPLAYFONT DISPLAYFONT) +(RPAQ? DISPLAYFACECOERCIONS + '[((* * (BOLD * *)) + (* * (MEDIUM * *))) + ((* * (* ITALIC *)) + (* * (* REGULAR *))) + ((* * (* * COMPRESSED)) + (* * (* * REGULAR]) ) -(RPAQ? DISPLAYFONTCOERCIONS - '(((HELVETICA (<= * 2)) - (HELVETICA 4)) - ((MODERN (<= 15 * 16)) - (* 14)) - ((MODERN (<= 17 * 21)) - (* 18)) - ((MODERN (<= 22 * 28)) - (* 24)) - ((MODERN (<= 29 * 33)) - (* 30)) - ((MODERN (<= 34 * 40)) - (* 36)) - ((MODERN (<= 41 * 65)) - (* 48)) - ((MODERN (<= 66 *)) - (* 72)) - ((PALATINO 9) - (PALATINO 12)) - ((PALATINO (<= * 8)) - (PALATINO 10)) - ((TITAN (<= * 9) - BOLD) - (MODERN 10)) - ((TITAN (<= * 9) - ITALIC) - (MODERN 10)) - ((TITAN (<= * 9)) - (TITAN 10)) - (LPT AMTEX))) - -(RPAQ? DISPLAYCHARCOERCIONS - '((GACHA TERMINAL) - (MODERN CLASSIC) - (TIMESROMAN CLASSIC) - (HELVETICA MODERN) - (TERMINAL MODERN) - (HIPPO CLASSIC) - (CYRILLIC CLASSIC) - (MATH CLASSIC) - (SIGMA MODERN) - (SYMBOL MODERN) - (TITAN CLASSIC) - (PALATINO CLASSIC) - (OPTIMA MODERN) - (BOLDPS CLASSIC) - (PCTERMINAL CLASSIC) - (TITANLEGAL CLASSIC))) - (RPAQ? \DEFAULTCHARSET 0) +(DECLARE%: DOEVAL@COMPILE DONTCOPY +(LOCALVARS . T) +) - -(* ;; "") - - - - -(* ;; "Defunct coercions? Mapping for DOS filenames, Adobe equivalences") - - -(RPAQ? ADOBEDISPLAYFONTCOERCIONS - '(((HELVETICABLACK 16) - (HELVETICABLACK 18)) - ((SYMBOL) - (ADOBESYMBOL)) - ((SYMBOL 11) - (ADOBESYMBOL 10)) - ((AVANTGARDE-DEMI) - (AVANTGARDE)) - ((AVANTGARDE-BOOK) - (AVANTGARDE)) - ((NEWCENTURYSCHLBK) - (CENTURYSCHOOLBOOK)) - ((BOOKMAN-LIGHT) - (BOOKMAN)) - ((BOOKMAN-DEMI) - (BOOKMAN)) - ((HELVETICA-NARROW) - (HELVETICANARROW)) - ((HELVETICA 24) - (ADOBEHELVETICA 24)))) - -(RPAQ? *DISPLAY-FONT-NAME-MAP* - '((TIMESROMAN . TR) - (HELVETICA . HV) - (TIMESROMAND . TD) - (HELVETICAD . HD) - (MODERN . MD) - (CLASSIC . CL) - (GACHA . GC) - (TITAN . TI) - (LETTERGOTHIC . LG) - (BOLDPS . BP) - (TERMINAL . TM) - (CLASSICTHIN . CT) - (HIPPO . HP) - (LOGO . LG) - (MATH . MA) - (OLDENGLISH . OE) - (SYMBOL . SY))) +(PUTPROPS FONT FILETYPE :FAKE-COMPILE-FILE) (DECLARE%: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY COMPILERVARS (ADDTOVAR NLAMA ) (ADDTOVAR NLAML ) -(ADDTOVAR LAMA FONTCOPY) +(ADDTOVAR LAMA FONTCOPY FONTDEVICEPROP) ) (DECLARE%: DONTCOPY - (FILEMAP (NIL (11429 21096 (CHARWIDTH 11439 . 12228) (CHARWIDTHY 12230 . 13747) (STRINGWIDTH 13749 . -14786) (\CHARWIDTH.DISPLAY 14788 . 15203) (\STRINGWIDTH.DISPLAY 15205 . 15633) (\STRINGWIDTH.GENERIC -15635 . 21094)) (21097 27729 (DEFAULTFONT 21107 . 22392) (FONTCLASS 22394 . 24666) (FONTCLASSUNPARSE -24668 . 25569) (FONTCLASSCOMPONENT 25571 . 26159) (SETFONTCLASSCOMPONENT 26161 . 26603) ( -GETFONTCLASSCOMPONENT 26605 . 27727)) (29442 47482 (FONTCREATE 29452 . 32697) (FONTCREATE1 32699 . -35314) (FONTCREATE.SLUGFD 35316 . 36820) (\FONT.CHECKARGS1 36822 . 41527) (\FONTCREATE1.NOFN 41529 . -41743) (FONTFILEP 41745 . 42633) (\READCHARSET 42635 . 47480)) (47483 54559 (\FONT.CHECKARGS 47493 . -54242) (\CHARSET.CHECK 54244 . 54557)) (54560 61171 (COERCEFONTSPEC 54570 . 60482) ( -COERCEFONTSPEC.TARGETFACE 60484 . 61169)) (63366 64715 (MAKEFONTSPEC 63376 . 64713)) (64716 72893 ( -COMPLETE.FONT 64726 . 67249) (COMPLETEFONTP 67251 . 67874) (COMPLETE.CHARSET 67876 . 70561) ( -PRUNESLUGCSINFOS 70563 . 71488) (MONOSPACEFONTP 71490 . 72891)) (72932 81390 (FONTASCENT 72942 . 73326 -) (FONTDESCENT 73328 . 73813) (FONTHEIGHT 73815 . 74217) (FONTPROP 74219 . 80667) (\AVGCHARWIDTH 80669 - . 81388)) (82047 82955 (FONTDEVICEPROP 82057 . 82953)) (83001 83855 (EDITCHAR 83011 . 83853)) (83901 -96091 (GETCHARBITMAP 83911 . 85035) (PUTCHARBITMAP 85037 . 87195) (\GETCHARBITMAP.CSINFO 87197 . 89213 -) (\PUTCHARBITMAP.CSINFO 89215 . 96089)) (96092 117372 (MOVECHARBITMAP 96102 . 97996) (MOVEFONTCHARS -97998 . 102744) (\MOVEFONTCHAR 102746 . 107593) (\MOVEFONTCHARS.SOURCEDATA 107595 . 113710) ( -\MAKESLUGCHAR 113712 . 116247) (SLUGCHARP.DISPLAY 116249 . 117370)) (118030 129879 (FONTFILES 118040 - . 119873) (\FINDFONTFILE 119875 . 121852) (\FONTFILENAMES 121854 . 122414) (\FONTFILENAME 122416 . -125327) (FONTSPECFROMFILENAME 125329 . 129877)) (129880 166129 (FONTCOPY 129890 . 134973) (FONTP -134975 . 135274) (FONTUNPARSE 135276 . 136999) (SETFONTDESCRIPTOR 137001 . 138465) (\STREAMCHARWIDTH -138467 . 142478) (\COERCECHARSET 142480 . 145847) (\BUILDSLUGCSINFO 145849 . 149480) (\FONTSYMBOL -149482 . 150136) (\DEVICESYMBOL 150138 . 150922) (\FONTFACE 150924 . 158128) (\FONTFACE.COLOR 158130 - . 164912) (SETFONTCHARENCODING 164914 . 166127)) (166130 185807 (FONTSAVAILABLE 166140 . 171504) ( -FONTEXISTS? 171506 . 175047) (\SEARCHFONTFILES 175049 . 178136) (FLUSHFONTCACHE 178138 . 180361) ( -FINDFONTFILES 180363 . 183579) (SORTFONTSPECS 183581 . 185805)) (185808 189923 (MATCHFONTFACE 185818 - . 186633) (MAKEFONTFACE 186635 . 187669) (FONTFACETOATOM 187671 . 189921)) (190554 191046 ( -\UNITWIDTHSVECTOR 190564 . 191044)) (205689 207756 (FONTDESCRIPTOR.DEFPRINT 205699 . 207278) ( -FONTCLASS.DEFPRINT 207280 . 207754)) (211585 214375 (\CREATEKERNELEMENT 211595 . 211953) ( -\FSETLEFTKERN 211955 . 212446) (\FGETLEFTKERN 212448 . 214373)) (214376 226042 (\CREATEFONT 214386 . -217282) (\CREATECHARSET 217284 . 221793) (\INSTALLCHARSETINFO 221795 . 225129) ( -\INSTALLCHARSETINFO.CHARENCODING 225131 . 226040)) (226364 227732 (\FONTRESETCHARWIDTHS 226374 . -227730)) (228362 238439 (\CREATEDISPLAYFONT 228372 . 230239) (\CREATECHARSET.DISPLAY 230241 . 235956) -(\FONTEXISTS?.DISPLAY 235958 . 238437)) (238440 253445 (STRIKEFONT.FILEP 238450 . 239338) ( -STRIKEFONT.GETCHARSET 239340 . 244934) (WRITESTRIKEFONTFILE 244936 . 249849) (STRIKECSINFO 249851 . -253443)) (253476 269809 (MAKEBOLD.CHARSET 253486 . 257141) (MAKEBOLD.CHAR 257143 . 258895) ( -MAKEITALIC.CHARSET 258897 . 262576) (MAKEITALIC.CHAR 262578 . 264924) (\SFMAKEBOLD 264926 . 267152) ( -\SFMAKEITALIC 267154 . 269807)) (269810 273834 (\SFMAKEROTATEDFONT 269820 . 271054) (\SFROTATECSINFO -271056 . 271731) (\SFROTATEFONTCHARACTERS 271733 . 272117) (\SFROTATECSINFOOFFSETS 272119 . 273832)) ( -273835 275009 (\SFMAKECOLOR 273845 . 275007))))) + (FILEMAP (NIL (6638 16305 (CHARWIDTH 6648 . 7437) (CHARWIDTHY 7439 . 8956) (STRINGWIDTH 8958 . 9995) ( +\CHARWIDTH.DISPLAY 9997 . 10412) (\STRINGWIDTH.DISPLAY 10414 . 10842) (\STRINGWIDTH.GENERIC 10844 . +16303)) (16306 22938 (DEFAULTFONT 16316 . 17601) (FONTCLASS 17603 . 19875) (FONTCLASSUNPARSE 19877 . +20778) (FONTCLASSCOMPONENT 20780 . 21368) (SETFONTCLASSCOMPONENT 21370 . 21812) (GETFONTCLASSCOMPONENT + 21814 . 22936)) (24386 44288 (FONTCREATE 24396 . 27641) (FONTCREATE1 27643 . 30302) ( +FONTCREATE.SLUGFD 30304 . 32868) (\FONT.CHECKARGS1 32870 . 37575) (\FONTCREATE1.NOFN 37577 . 37791) ( +FONTFILEP 37793 . 38681) (\READCHARSET 38683 . 43868) (FONTCHARSETS 43870 . 44286)) (44289 51365 ( +\FONT.CHECKARGS 44299 . 51048) (\CHARSET.CHECK 51050 . 51363)) (51366 57726 (COERCEFONTSPEC 51376 . +57037) (COERCEFONTSPEC.TARGETFACE 57039 . 57724)) (59921 63339 (MAKEFONTSPEC 59931 . 61584) ( +FONTSPEC.TO.FONTDESCRIPTOR 61586 . 63337)) (63340 73002 (COMPLETE.FONT 63350 . 65375) (COMPLETEFONTP +65377 . 66115) (COMPLETE.CHARSET 66117 . 70183) (PRUNESLUGCSINFOS 70185 . 71496) (MONOSPACEFONTP 71498 + . 73000)) (73041 82855 (FONTASCENT 73051 . 73435) (FONTDESCENT 73437 . 73922) (FONTHEIGHT 73924 . +74326) (FONTPROP 74328 . 82132) (\AVGCHARWIDTH 82134 . 82853)) (83603 85473 (FONTDEVICEPROP 83613 . +85471)) (85590 86444 (EDITCHAR 85600 . 86442)) (86490 98680 (GETCHARBITMAP 86500 . 87624) ( +PUTCHARBITMAP 87626 . 89784) (\GETCHARBITMAP.CSINFO 89786 . 91802) (\PUTCHARBITMAP.CSINFO 91804 . +98678)) (98681 121022 (MOVECHARBITMAP 98691 . 100585) (MOVEFONTCHARS 100587 . 105737) (\MOVEFONTCHAR +105739 . 110611) (\MOVEFONTCHARS.SOURCEDATA 110613 . 117368) (\MAKESLUGCHAR 117370 . 119905) ( +SLUGCHARP 119907 . 121020)) (121937 135191 (FONTFILES 121947 . 124986) (\FINDFONTFILE 124988 . 126965) + (\FONTFILENAMES 126967 . 127527) (\FONTFILENAME 127529 . 130639) (FONTSPECFROMFILENAME 130641 . +135189)) (135192 171525 (FONTCOPY 135202 . 140285) (FONTP 140287 . 140586) (FONTUNPARSE 140588 . +142311) (SETFONTDESCRIPTOR 142313 . 143777) (\STREAMCHARWIDTH 143779 . 147790) (\COERCECHARSET 147792 + . 151181) (\BUILDSLUGCSINFO 151183 . 154876) (\FONTSYMBOL 154878 . 155532) (\DEVICESYMBOL 155534 . +156318) (\FONTFACE 156320 . 163524) (\FONTFACE.COLOR 163526 . 170308) (SETFONTCHARENCODING 170310 . +171523)) (171526 192384 (FONTSAVAILABLE 171536 . 176900) (FONTEXISTS? 176902 . 180710) ( +\SEARCHFONTFILES 180712 . 183926) (FLUSHFONTCACHE 183928 . 186459) (FINDFONTFILES 186461 . 189677) ( +SORTFONTSPECS 189679 . 192382)) (192385 197923 (MATCHFONTFACE 192395 . 193470) (MAKEFONTFACE 193472 . +194506) (FONTFACETOATOM 194508 . 196758) (FONTFACE.STARS 196760 . 197921)) (198554 199046 ( +\UNITWIDTHSVECTOR 198564 . 199044)) (215967 218034 (FONTDESCRIPTOR.DEFPRINT 215977 . 217556) ( +FONTCLASS.DEFPRINT 217558 . 218032)) (221956 224746 (\CREATEKERNELEMENT 221966 . 222324) ( +\FSETLEFTKERN 222326 . 222817) (\FGETLEFTKERN 222819 . 224744)) (224747 235901 (\CREATEFONT 224757 . +228365) (\CREATECHARSET 228367 . 231652) (\INSTALLCHARSETINFO 231654 . 234988) ( +\INSTALLCHARSETINFO.CHARENCODING 234990 . 235899)) (236223 237591 (\FONTRESETCHARWIDTHS 236233 . +237589)) (238114 246273 (\CREATEDISPLAYFONT 238124 . 240332) (\CREATECHARSET.DISPLAY 240334 . 243858) +(\FONTEXISTS?.DISPLAY 243860 . 246271)) (246274 254652 (FAKEFACE.CHARSET 246284 . 250346) ( +MAKEBOLD.CHAR 250348 . 252201) (MAKEITALIC.CHAR 252203 . 254650)) (254683 258938 (\SFROTATECSINFO +254693 . 256835) (\SFROTATEFONTCHARACTERS 256837 . 257221) (\SFROTATECSINFOOFFSETS 257223 . 258936)) ( +258939 260113 (\SFMAKECOLOR 258949 . 260111))))) STOP diff --git a/sources/FONT.LCOM b/sources/FONT.LCOM index a5dd65846..a050e71a2 100644 Binary files a/sources/FONT.LCOM and b/sources/FONT.LCOM differ diff --git a/sources/INTERPRESS b/sources/INTERPRESS index f2097c894..d3f976cbc 100644 --- a/sources/INTERPRESS +++ b/sources/INTERPRESS @@ -1,10 +1,12 @@ -(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10) +(DEFINE-FILE-INFO :PACKAGE "INTERLISP" :READTABLE "INTERLISP" :BASE 10) -(FILECREATED "19-Jan-2026 17:21:17" {WMEDLEY}INTERPRESS.;105 215365 +(FILECREATED "26-Apr-2026 11:31:17" {WMEDLEY}INTERPRESS.;111 215607 :EDIT-BY rmk - :PREVIOUS-DATE "24-Dec-2025 11:24:31" {WMEDLEY}INTERPRESS.;104) + :CHANGES-TO (VARS INTERPRESSCOMS) + + :PREVIOUS-DATE "18-Mar-2026 09:45:13" {MEDLEY}INTERPRESS.;107) (PRETTYCOMPRINT INTERPRESSCOMS) @@ -95,7 +97,8 @@ (ADDVARS (INTERPRESSFONTEXTENSIONS MEDLEYINTERPRESSFONT WD)) [COMS (* ;  "Interpress fonts; but see MEDLEY-INIT-VARS") - [INITVARS (INTERPRESSFONTDIRECTORIES '(fonts>medleyinterpressfonts> fonts>ipfonts>)) + [INITVARS (INTERPRESSFONTDIRECTORIES (LIST "{MEDLEY}medleyinterpressfonts>" + "{MEDLEY}ipfonts>")) (INTERPRESSPRINTWHEELFAMILIES '(BOLDPS ELITE LETTERGOTHIC MASTER PICA PSBOLD SCIENTIFIC SPOKESMAN TITAN TREND TRENDPS TROJAN VINTAGE)) @@ -3529,7 +3532,8 @@ (* ; "Interpress fonts; but see MEDLEY-INIT-VARS") -(RPAQ? INTERPRESSFONTDIRECTORIES '(fonts>medleyinterpressfonts> fonts>ipfonts>)) +(RPAQ? INTERPRESSFONTDIRECTORIES (LIST "{MEDLEY}medleyinterpressfonts>" + "{MEDLEY}ipfonts>")) (RPAQ? INTERPRESSPRINTWHEELFAMILIES '(BOLDPS ELITE LETTERGOTHIC MASTER PICA PSBOLD SCIENTIFIC SPOKESMAN TITAN TREND TRENDPS TROJAN VINTAGE)) @@ -3562,15 +3566,15 @@ FONTTOMCCSFN _ (MCCSMAPFN FONTSPEC]) (\CREATECHARSET.IP - [LAMBDA (FONTSPEC FONT CHARSET) (* ; "Edited 7-Sep-2025 23:23 by rmk") + [LAMBDA (FONTSPEC FONT CHARSET) (* ; "Edited 17-Mar-2026 08:58 by rmk") + (* ; "Edited 7-Sep-2025 23:23 by rmk") (* ; "Edited 30-Aug-2025 14:24 by rmk") (* ; "Edited 28-Aug-2025 23:24 by rmk") (* ; "Edited 26-Aug-2025 23:43 by rmk") (* ; "Edited 16-Aug-2025 17:46 by rmk") (* ; "Edited 5-Aug-2025 22:33 by rmk") (* ; "Edited 23-Jul-2025 13:22 by rmk") - (OR (\READCHARSET FONTSPEC CHARSET FONT) - (CADR (\COERCECHARSET FONTSPEC CHARSET]) + (\READCHARSET FONTSPEC CHARSET]) ) (DEFINEQ @@ -3827,44 +3831,44 @@ (LOADDEF 'BRUSH 'RECORDS 'IMAGEIO) ) (DECLARE%: DONTCOPY - (FILEMAP (NIL (16593 22245 (APPENDBYTE.IP 16603 . 16739) (APPENDIDENTIFIER.IP 16741 . 17263) ( -APPENDINT.IP 17265 . 17716) (APPENDINTEGER.IP 17718 . 18290) (APPENDLARGEVECTOR.IP 18292 . 19257) ( -APPENDNUMBER.IP 19259 . 19728) (APPENDOP.IP 19730 . 20376) (APPENDRATIONAL.IP 20378 . 20871) ( -APPENDSEQUENCEDESCRIPTOR.IP 20873 . 22068) (BYTESININT.IP 22070 . 22243)) (22281 62088 (ARCTO.IP 22291 - . 23572) (BEGINMASTER.IP 23574 . 23847) (BEGINPAGE.IP 23849 . 24205) (BEGINPREAMBLE.IP 24207 . 24578) - (CLIPRECTANGLE.IP 24580 . 25070) (CONCAT.IP 25072 . 25337) (CONCATT.IP 25339 . 25606) (ENDMASTER.IP -25608 . 26052) (ENDPAGE.IP 26054 . 26431) (ENDPREAMBLE.IP 26433 . 27232) (FGET.IP 27234 . 27537) ( -FILLRECTANGLE.IP 27539 . 29867) (FILLTRAJECTORY.IP 29869 . 30504) (FILLNGON.IP 30506 . 32783) (FSET.IP - 32785 . 33088) (GETFRAMEVAR.IP 33090 . 33408) (INITIALIZEMASTER.IP 33410 . 34011) (INITIALIZECOLOR.IP - 34013 . 35334) (ISET.IP 35336 . 35707) (GETCP.IP 35709 . 36018) (LINETO.IP 36020 . 36625) ( -MASKSTROKE.IP 36627 . 36900) (MOVETO.IP 36902 . 37239) (ROTATE.IP 37241 . 37543) (SCALE.IP 37545 . -37848) (SCALE2.IP 37850 . 38187) (SETCOLOR.IP 38189 . 40418) (SETRGB.IP 40420 . 41476) (SETCOLORLV.IP -41478 . 46091) (SETCOLOR16.IP 46093 . 49199) (SETFONT.IP 49201 . 50022) (SETSPACE.IP 50024 . 50336) ( -SETXREL.IP 50338 . 51522) (SETX.IP 51524 . 53041) (SETXY.IP 53043 . 54215) (SETXYREL.IP 54217 . 55523) - (SETY.IP 55525 . 56834) (SETYREL.IP 56836 . 57736) (SHOW.IP 57738 . 60998) (TRAJECTORY.IP 61000 . -61398) (TRANS.IP 61400 . 61739) (TRANSLATE.IP 61741 . 62086)) (62119 68209 (\CHANGE-VISIBLE-REGION.IP -62129 . 65790) (\PAPERSIZE.IP 65792 . 66613) (HEADINGOP.IP 66615 . 68207)) (68210 172730 ( -DEFINEFONT.IP 68220 . 69194) (FONTNAME.IP 69196 . 70126) (INTERPRESS.BITMAPSCALE 70128 . 70921) ( -INTERPRESS.OUTCHARFN 70923 . 77430) (NEWLINE.IP 77432 . 78164) (NEWPAGE.IP 78166 . 83141) (NEWPAGE?.IP - 83143 . 83622) (OPENIPSTREAM 83624 . 91975) (SETUPFONTS.IP 91977 . 92969) (SHOWBITMAP.IP 92971 . -97512) (\BITMAPSIZE.IP 97514 . 98291) (SHOWBITMAP1.IP 98293 . 102665) (SHOWSHADE.IP 102667 . 103620) ( -\BITBLT.IP 103622 . 107826) (\SCALEDBITBLT.IP 107828 . 111473) (\BLTSHADE.IP 111475 . 112933) ( -\CHARWIDTH.IP 112935 . 113385) (\CLOSEIPSTREAM 113387 . 113714) (\DRAWARC.IP 113716 . 114163) ( -\DRAWCURVE.IP 114165 . 116602) (\DRAWPOINT.IP 116604 . 117641) (\DSPCOLOR.IP 117643 . 118594) ( -ENSURE.RGB 118596 . 119260) (\IPCURVE2 119262 . 132516) (\CLIPCURVELINE.IP 132518 . 137216) ( -\DRAWLINE.IP 137218 . 140950) (\CLIPLINE 140952 . 145652) (\DSPBOTTOMMARGIN.IP 145654 . 146070) ( -\DSPFONT.IP 146072 . 150832) (\DSPLEFTMARGIN.IP 150834 . 151294) (\DSPLINEFEED.IP 151296 . 151963) ( -\DSPRIGHTMARGIN.IP 151965 . 152762) (\DSPSPACEFACTOR.IP 152764 . 153893) (\DSPTOPMARGIN.IP 153895 . -154331) (\DSPXPOSITION.IP 154333 . 155320) (\DSPROTATE.IP 155322 . 155500) (\PUSHSTATE.IP 155502 . -156394) (\POPSTATE.IP 156396 . 157031) (\DEFAULTSTATE.IP 157033 . 157385) (\DSPTRANSLATE.IP 157387 . -157568) (\DSPSCALE2.IP 157570 . 157745) (\DSPYPOSITION.IP 157747 . 158048) (FILLCIRCLE.IP 158050 . -159133) (\FILLPOLYGON.IP 159135 . 160466) (\DRAWPOLYGON.IP 160468 . 166598) (\FIXLINELENGTH.IP 166600 - . 167814) (\MOVETO.IP 167816 . 168180) (\SETBRUSH.IP 168182 . 170348) (\STRINGWIDTH.IP 170350 . -170753) (\DSPCLIPPINGREGION.IP 170755 . 171931) (\DSPOPERATION.IP 171933 . 172728)) (172731 174630 ( -INTERPRESSFILEP 172741 . 174174) (INTERPRESS.TEDIT 174176 . 174628)) (174821 175576 (IP-TOS 174831 . -175091) (POP-IP-STACK 175093 . 175388) (PUSH-IP-STACK 175390 . 175574)) (175637 176561 ( -\CHANGECHARSET.IP 175647 . 176559)) (176562 180178 (\INTERPRESSINIT 176572 . 180176)) (193262 195686 ( -INTERPRESSBITMAP 193272 . 195684)) (197983 200604 (\CREATEINTERPRESSFONT 197993 . 199721) ( -\CREATECHARSET.IP 199723 . 200602)) (200605 212778 (IPFONT.FILEP 200615 . 200799) (IPFONT.GETCHARSET -200801 . 210899) (\FACECODE 210901 . 211491) (\FAMILYCODE 211493 . 212776))))) + (FILEMAP (NIL (16717 22369 (APPENDBYTE.IP 16727 . 16863) (APPENDIDENTIFIER.IP 16865 . 17387) ( +APPENDINT.IP 17389 . 17840) (APPENDINTEGER.IP 17842 . 18414) (APPENDLARGEVECTOR.IP 18416 . 19381) ( +APPENDNUMBER.IP 19383 . 19852) (APPENDOP.IP 19854 . 20500) (APPENDRATIONAL.IP 20502 . 20995) ( +APPENDSEQUENCEDESCRIPTOR.IP 20997 . 22192) (BYTESININT.IP 22194 . 22367)) (22405 62212 (ARCTO.IP 22415 + . 23696) (BEGINMASTER.IP 23698 . 23971) (BEGINPAGE.IP 23973 . 24329) (BEGINPREAMBLE.IP 24331 . 24702) + (CLIPRECTANGLE.IP 24704 . 25194) (CONCAT.IP 25196 . 25461) (CONCATT.IP 25463 . 25730) (ENDMASTER.IP +25732 . 26176) (ENDPAGE.IP 26178 . 26555) (ENDPREAMBLE.IP 26557 . 27356) (FGET.IP 27358 . 27661) ( +FILLRECTANGLE.IP 27663 . 29991) (FILLTRAJECTORY.IP 29993 . 30628) (FILLNGON.IP 30630 . 32907) (FSET.IP + 32909 . 33212) (GETFRAMEVAR.IP 33214 . 33532) (INITIALIZEMASTER.IP 33534 . 34135) (INITIALIZECOLOR.IP + 34137 . 35458) (ISET.IP 35460 . 35831) (GETCP.IP 35833 . 36142) (LINETO.IP 36144 . 36749) ( +MASKSTROKE.IP 36751 . 37024) (MOVETO.IP 37026 . 37363) (ROTATE.IP 37365 . 37667) (SCALE.IP 37669 . +37972) (SCALE2.IP 37974 . 38311) (SETCOLOR.IP 38313 . 40542) (SETRGB.IP 40544 . 41600) (SETCOLORLV.IP +41602 . 46215) (SETCOLOR16.IP 46217 . 49323) (SETFONT.IP 49325 . 50146) (SETSPACE.IP 50148 . 50460) ( +SETXREL.IP 50462 . 51646) (SETX.IP 51648 . 53165) (SETXY.IP 53167 . 54339) (SETXYREL.IP 54341 . 55647) + (SETY.IP 55649 . 56958) (SETYREL.IP 56960 . 57860) (SHOW.IP 57862 . 61122) (TRAJECTORY.IP 61124 . +61522) (TRANS.IP 61524 . 61863) (TRANSLATE.IP 61865 . 62210)) (62243 68333 (\CHANGE-VISIBLE-REGION.IP +62253 . 65914) (\PAPERSIZE.IP 65916 . 66737) (HEADINGOP.IP 66739 . 68331)) (68334 172854 ( +DEFINEFONT.IP 68344 . 69318) (FONTNAME.IP 69320 . 70250) (INTERPRESS.BITMAPSCALE 70252 . 71045) ( +INTERPRESS.OUTCHARFN 71047 . 77554) (NEWLINE.IP 77556 . 78288) (NEWPAGE.IP 78290 . 83265) (NEWPAGE?.IP + 83267 . 83746) (OPENIPSTREAM 83748 . 92099) (SETUPFONTS.IP 92101 . 93093) (SHOWBITMAP.IP 93095 . +97636) (\BITMAPSIZE.IP 97638 . 98415) (SHOWBITMAP1.IP 98417 . 102789) (SHOWSHADE.IP 102791 . 103744) ( +\BITBLT.IP 103746 . 107950) (\SCALEDBITBLT.IP 107952 . 111597) (\BLTSHADE.IP 111599 . 113057) ( +\CHARWIDTH.IP 113059 . 113509) (\CLOSEIPSTREAM 113511 . 113838) (\DRAWARC.IP 113840 . 114287) ( +\DRAWCURVE.IP 114289 . 116726) (\DRAWPOINT.IP 116728 . 117765) (\DSPCOLOR.IP 117767 . 118718) ( +ENSURE.RGB 118720 . 119384) (\IPCURVE2 119386 . 132640) (\CLIPCURVELINE.IP 132642 . 137340) ( +\DRAWLINE.IP 137342 . 141074) (\CLIPLINE 141076 . 145776) (\DSPBOTTOMMARGIN.IP 145778 . 146194) ( +\DSPFONT.IP 146196 . 150956) (\DSPLEFTMARGIN.IP 150958 . 151418) (\DSPLINEFEED.IP 151420 . 152087) ( +\DSPRIGHTMARGIN.IP 152089 . 152886) (\DSPSPACEFACTOR.IP 152888 . 154017) (\DSPTOPMARGIN.IP 154019 . +154455) (\DSPXPOSITION.IP 154457 . 155444) (\DSPROTATE.IP 155446 . 155624) (\PUSHSTATE.IP 155626 . +156518) (\POPSTATE.IP 156520 . 157155) (\DEFAULTSTATE.IP 157157 . 157509) (\DSPTRANSLATE.IP 157511 . +157692) (\DSPSCALE2.IP 157694 . 157869) (\DSPYPOSITION.IP 157871 . 158172) (FILLCIRCLE.IP 158174 . +159257) (\FILLPOLYGON.IP 159259 . 160590) (\DRAWPOLYGON.IP 160592 . 166722) (\FIXLINELENGTH.IP 166724 + . 167938) (\MOVETO.IP 167940 . 168304) (\SETBRUSH.IP 168306 . 170472) (\STRINGWIDTH.IP 170474 . +170877) (\DSPCLIPPINGREGION.IP 170879 . 172055) (\DSPOPERATION.IP 172057 . 172852)) (172855 174754 ( +INTERPRESSFILEP 172865 . 174298) (INTERPRESS.TEDIT 174300 . 174752)) (174945 175700 (IP-TOS 174955 . +175215) (POP-IP-STACK 175217 . 175512) (PUSH-IP-STACK 175514 . 175698)) (175761 176685 ( +\CHANGECHARSET.IP 175771 . 176683)) (176686 180302 (\INTERPRESSINIT 176696 . 180300)) (193386 195810 ( +INTERPRESSBITMAP 193396 . 195808)) (198173 200846 (\CREATEINTERPRESSFONT 198183 . 199911) ( +\CREATECHARSET.IP 199913 . 200844)) (200847 213020 (IPFONT.FILEP 200857 . 201041) (IPFONT.GETCHARSET +201043 . 211141) (\FACECODE 211143 . 211733) (\FAMILYCODE 211735 . 213018))))) STOP diff --git a/sources/INTERPRESS.LCOM b/sources/INTERPRESS.LCOM index 19d50a01c..64fcee5bd 100644 Binary files a/sources/INTERPRESS.LCOM and b/sources/INTERPRESS.LCOM differ diff --git a/sources/LLBIGNUM b/sources/LLBIGNUM index 0ffdb3eb9..2e46a59b3 100644 --- a/sources/LLBIGNUM +++ b/sources/LLBIGNUM @@ -1,23 +1,21 @@ -(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10) -(FILECREATED " 1-Jan-99 21:45:52" {DSK}disk3>lispcore3.0>sources>LLBIGNUM.;2 41438 +(DEFINE-FILE-INFO :PACKAGE "INTERLISP" :READTABLE "INTERLISP" :BASE 10) - changes to%: (FNS \INITBIGNUMS) +(FILECREATED "17-Apr-2026 09:00:35" {MEDLEY}LLBIGNUM.;2 41059 - previous date%: "19-Jan-93 10:44:45" {DSK}disk3>lispcore3.0>sources>LLBIGNUM.;1) + :EDIT-BY rmk + :CHANGES-TO (VARS LLBIGNUMCOMS) + + :PREVIOUS-DATE " 1-Jan-99 21:45:52" {MEDLEY}LLBIGNUM.;1) -(* ; " -Copyright (c) 1985, 1986, 1987, 1990, 1993, 1999 by Venue & Xerox Corporation. All rights reserved. -") (PRETTYCOMPRINT LLBIGNUMCOMS) -(RPAQQ LLBIGNUMCOMS +(RPAQQ LLBIGNUMCOMS [(COMS (DECLARE%: EVAL@COMPILE DONTCOPY (RECORDS BIGNUM)) (INITRECORDS BIGNUM) (CONSTANTS \BIGNUM.THETA (\BIGNUM.BETA (EXPT 2 14)) (\BIGNUM.BETA1 (SUB1 \BIGNUM.BETA))) - [DECLARE%: EVAL@COMPILE (ADDVARS (CHARACTERNAMES (INFINITY 8551] (ADDVARS (GLOBALVARS MIN.INTEGER MAX.INTEGER \BIG.0 \BIG.1))) (COMS (* ; "entries") (FNS \BIGNUM.COMPARE \BIGNUM.DIFFERENCE \BIGNUM.INTEGERLENGTH \BIGNUM.LOGAND @@ -40,7 +38,7 @@ Copyright (c) 1985, 1986, 1987, 1990, 1993, 1999 by Venue & Xerox Corporation. (DECLARE%: EVAL@COMPILE (DATATYPE BIGNUM (ELEMENTS) - (INIT (DEFPRINT 'BIGNUM 'BIGNUM.DEFPRINT))) + (INIT (DEFPRINT 'BIGNUM 'BIGNUM.DEFPRINT))) ) (/DECLAREDATATYPE 'BIGNUM '(POINTER) @@ -67,10 +65,6 @@ Copyright (c) 1985, 1986, 1987, 1990, 1993, 1999 by Venue & Xerox Corporation. (CONSTANTS \BIGNUM.THETA (\BIGNUM.BETA (EXPT 2 14)) (\BIGNUM.BETA1 (SUB1 \BIGNUM.BETA))) ) -(DECLARE%: EVAL@COMPILE - -(ADDTOVAR CHARACTERNAMES (INFINITY 8551)) -) (ADDTOVAR GLOBALVARS MIN.INTEGER MAX.INTEGER \BIG.0 \BIG.1) @@ -1134,20 +1128,19 @@ Copyright (c) 1985, 1986, 1987, 1990, 1993, 1999 by Venue & Xerox Corporation. (\INITBIGNUMS) ) -(PUTPROPS LLBIGNUM COPYRIGHT ("Venue & Xerox Corporation" 1985 1986 1987 1990 1993 1999)) (DECLARE%: DONTCOPY - (FILEMAP (NIL (2909 9796 (\BIGNUM.COMPARE 2919 . 3420) (\BIGNUM.DIFFERENCE 3422 . 3650) ( -\BIGNUM.INTEGERLENGTH 3652 . 3819) (\BIGNUM.LOGAND 3821 . 4589) (\BIGNUM.LOGOR 4591 . 5324) ( -\BIGNUM.LOGXOR 5326 . 6213) (\BIGNUM.PLUS 6215 . 6432) (\BIGNUM.LSH 6434 . 8017) (\BIGNUM.TIMES 8019 - . 8238) (\BIGNUM.QUOTIENT 8240 . 9178) (\BIGNUM.REMAINDER 9180 . 9552) (\BIGNUM.TO.FLOAT 9554 . 9794) -) (9797 10175 (FINITEP 9807 . 9993) (INFINITEP 9995 . 10173)) (10211 40300 (\BIGNUM.TO.INT 10221 . -10473) (\BN.2TH 10475 . 10859) (\BN.ABS 10861 . 11066) (\BN.DIFFERENCE 11068 . 11218) (\BN.DIVIDE -11220 . 16135) (\BN.FLOAT 16137 . 19004) (\BN.IGNN 19006 . 19392) (BIGNUM.DEFPRINT 19394 . 22989) ( -\BN.INTEGERLENGTH 22991 . 23418) (\BN.LOGAND 23420 . 23956) (\BN.LOGANDC2 23958 . 24510) (\BN.LOGOR -24512 . 24825) (\BN.LOGXOR 24827 . 25143) (\BN.MINUS 25145 . 25500) (\BN.PLUS2 25502 . 26588) ( -\BN.SIGN 26590 . 27036) (\BN.TIMES2 27038 . 29091) (\BN.COMPAREN 29093 . 30382) (\BN.D2TH 30384 . -31579) (\BN.FROM.FIXP 31581 . 32143) (\BN.ICANON 32145 . 33362) (\BN.IDIVIDE 33364 . 33525) (\BN.ISUM0 - 33527 . 34192) (\BN.ISUM1 34194 . 34927) (\BN.MADD 34929 . 35708) (\BN.TO.FIXP 35710 . 36321) ( -\BN.NZEROS 36323 . 36480) (\BN.QRS 36482 . 37289) (\BN.SIGN 37291 . 37737) (\BN.TH2B 37739 . 38222) ( -\BN.TH2D 38224 . 40298)) (40301 41091 (\INITBIGNUMS 40311 . 41089))))) + (FILEMAP (NIL (2620 9507 (\BIGNUM.COMPARE 2630 . 3131) (\BIGNUM.DIFFERENCE 3133 . 3361) ( +\BIGNUM.INTEGERLENGTH 3363 . 3530) (\BIGNUM.LOGAND 3532 . 4300) (\BIGNUM.LOGOR 4302 . 5035) ( +\BIGNUM.LOGXOR 5037 . 5924) (\BIGNUM.PLUS 5926 . 6143) (\BIGNUM.LSH 6145 . 7728) (\BIGNUM.TIMES 7730 + . 7949) (\BIGNUM.QUOTIENT 7951 . 8889) (\BIGNUM.REMAINDER 8891 . 9263) (\BIGNUM.TO.FLOAT 9265 . 9505) +) (9508 9886 (FINITEP 9518 . 9704) (INFINITEP 9706 . 9884)) (9922 40011 (\BIGNUM.TO.INT 9932 . 10184) +(\BN.2TH 10186 . 10570) (\BN.ABS 10572 . 10777) (\BN.DIFFERENCE 10779 . 10929) (\BN.DIVIDE 10931 . +15846) (\BN.FLOAT 15848 . 18715) (\BN.IGNN 18717 . 19103) (BIGNUM.DEFPRINT 19105 . 22700) ( +\BN.INTEGERLENGTH 22702 . 23129) (\BN.LOGAND 23131 . 23667) (\BN.LOGANDC2 23669 . 24221) (\BN.LOGOR +24223 . 24536) (\BN.LOGXOR 24538 . 24854) (\BN.MINUS 24856 . 25211) (\BN.PLUS2 25213 . 26299) ( +\BN.SIGN 26301 . 26747) (\BN.TIMES2 26749 . 28802) (\BN.COMPAREN 28804 . 30093) (\BN.D2TH 30095 . +31290) (\BN.FROM.FIXP 31292 . 31854) (\BN.ICANON 31856 . 33073) (\BN.IDIVIDE 33075 . 33236) (\BN.ISUM0 + 33238 . 33903) (\BN.ISUM1 33905 . 34638) (\BN.MADD 34640 . 35419) (\BN.TO.FIXP 35421 . 36032) ( +\BN.NZEROS 36034 . 36191) (\BN.QRS 36193 . 37000) (\BN.SIGN 37002 . 37448) (\BN.TH2B 37450 . 37933) ( +\BN.TH2D 37935 . 40009)) (40012 40802 (\INITBIGNUMS 40022 . 40800))))) STOP diff --git a/sources/LLBIGNUM.LCOM b/sources/LLBIGNUM.LCOM index a2f49541f..ab7ff0993 100644 Binary files a/sources/LLBIGNUM.LCOM and b/sources/LLBIGNUM.LCOM differ diff --git a/sources/LLCHAR b/sources/LLCHAR index 5959ed8d6..20e66e6e3 100644 --- a/sources/LLCHAR +++ b/sources/LLCHAR @@ -1,14 +1,12 @@ -(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10) +(DEFINE-FILE-INFO :PACKAGE "INTERLISP" :READTABLE "INTERLISP" :BASE 10) -(FILECREATED "24-Aug-2025 11:50:57"  -{DSK}kaplan>Local>medley3.5>working-medley>sources>LLCHAR.;14 104478 +(FILECREATED "28-Mar-2026 08:50:21" {WMEDLEY}LLCHAR.;16 104725 :EDIT-BY rmk :CHANGES-TO (VARS LLCHARCOMS) - :PREVIOUS-DATE "28-Apr-2022 08:52:36" -{DSK}kaplan>Local>medley3.5>working-medley>sources>LLCHAR.;13) + :PREVIOUS-DATE "24-Aug-2025 11:50:57" {WMEDLEY}LLCHAR.;14) (PRETTYCOMPRINT LLCHARCOMS) @@ -45,7 +43,9 @@ (CONSTANTS (\CHARMASK 255) (\MAXTHINCHAR 255) (\MAXFATCHAR 65535) - (\MAXCHARSET 255) + (\MAXCHARSET 65535) + (\MAXCHAR (LOGOR (LLSH \MAXCHARSET 8) + \MAXTHINCHAR)) (%#STRINGPWORDS 4)) (MACROS \NATOMCHARS \NSTRINGCHARS))) (INITRESOURCES \NUMSTR \NUMSTR1 \PNAMESTRING) @@ -1730,7 +1730,10 @@ (RPAQQ \MAXFATCHAR 65535) -(RPAQQ \MAXCHARSET 255) +(RPAQQ \MAXCHARSET 65535) + +(RPAQ \MAXCHAR (LOGOR (LLSH \MAXCHARSET 8) + \MAXTHINCHAR)) (RPAQQ %#STRINGPWORDS 4) @@ -1738,7 +1741,9 @@ (CONSTANTS (\CHARMASK 255) (\MAXTHINCHAR 255) (\MAXFATCHAR 65535) - (\MAXCHARSET 255) + (\MAXCHARSET 65535) + (\MAXCHAR (LOGOR (LLSH \MAXCHARSET 8) + \MAXTHINCHAR)) (%#STRINGPWORDS 4)) ) (DECLARE%: EVAL@COMPILE @@ -1844,16 +1849,16 @@ (PUTPROPS LLCHAR FILETYPE :FAKE-COMPILE-FILE) (DECLARE%: DONTCOPY - (FILEMAP (NIL (4108 74294 (ALLOCSTRING 4118 . 6141) (MKATOM 6143 . 6778) (SUBATOM 6780 . 8650) ( -CHARACTER 8652 . 9656) (\PARSE.NUMBER 9658 . 25378) (\INVALID.DOTTED.SYMBOL 25380 . 25875) ( -\INVALID.INTEGER 25877 . 27329) (\MKINTEGER 27331 . 30038) (MKSTRING 30040 . 32183) ( -\PRINDATUM.TO.STRING 32185 . 38363) (BKSYSBUF 38365 . 39899) (NCHARS 39901 . 41601) (NTHCHARCODE 41603 - . 43649) (RPLCHARCODE 43651 . 44712) (\RPLCHARCODE 44714 . 46249) (NTHCHAR 46251 . 46444) (RPLSTRING -46446 . 49657) (SUBSTRING 49659 . 52582) (GNC 52584 . 52757) (GNCCODE 52759 . 53527) (GLC 53529 . -53702) (GLCCODE 53704 . 54469) (STREQUAL 54471 . 56585) (STRING.EQUAL 56587 . 60925) (STRINGP 60927 . -61078) (CHCON1 61080 . 61867) (U-CASE 61869 . 65096) (L-CASE 65098 . 68958) (U-CASEP 68960 . 69534) ( -\SMASHABLESTRING 69536 . 69998) (\MAKEWRITABLESTRING 70000 . 70436) (\SMASHSTRING 70438 . 74144) ( -\FATTENSTRING 74146 . 74292)) (74479 79641 (\GETBASESTRING 74489 . 75143) (\PUTBASESTRING 75145 . -77884) (\PUTBASESTRINGFAT 77886 . 78632) (GetBcplString 78634 . 79299) (SetBcplString 79301 . 79639)) -(100978 103792 (%%COPY-ONED-ARRAY 100988 . 102838) (%%COPY-STRING-TO-ARRAY 102840 . 103790))))) + (FILEMAP (NIL (4182 74368 (ALLOCSTRING 4192 . 6215) (MKATOM 6217 . 6852) (SUBATOM 6854 . 8724) ( +CHARACTER 8726 . 9730) (\PARSE.NUMBER 9732 . 25452) (\INVALID.DOTTED.SYMBOL 25454 . 25949) ( +\INVALID.INTEGER 25951 . 27403) (\MKINTEGER 27405 . 30112) (MKSTRING 30114 . 32257) ( +\PRINDATUM.TO.STRING 32259 . 38437) (BKSYSBUF 38439 . 39973) (NCHARS 39975 . 41675) (NTHCHARCODE 41677 + . 43723) (RPLCHARCODE 43725 . 44786) (\RPLCHARCODE 44788 . 46323) (NTHCHAR 46325 . 46518) (RPLSTRING +46520 . 49731) (SUBSTRING 49733 . 52656) (GNC 52658 . 52831) (GNCCODE 52833 . 53601) (GLC 53603 . +53776) (GLCCODE 53778 . 54543) (STREQUAL 54545 . 56659) (STRING.EQUAL 56661 . 60999) (STRINGP 61001 . +61152) (CHCON1 61154 . 61941) (U-CASE 61943 . 65170) (L-CASE 65172 . 69032) (U-CASEP 69034 . 69608) ( +\SMASHABLESTRING 69610 . 70072) (\MAKEWRITABLESTRING 70074 . 70510) (\SMASHSTRING 70512 . 74218) ( +\FATTENSTRING 74220 . 74366)) (74553 79715 (\GETBASESTRING 74563 . 75217) (\PUTBASESTRING 75219 . +77958) (\PUTBASESTRINGFAT 77960 . 78706) (GetBcplString 78708 . 79373) (SetBcplString 79375 . 79713)) +(101225 104039 (%%COPY-ONED-ARRAY 101235 . 103085) (%%COPY-STRING-TO-ARRAY 103087 . 104037))))) STOP diff --git a/sources/LLCHAR.LCOM b/sources/LLCHAR.LCOM index 8fd7f2637..91fcf6a29 100644 Binary files a/sources/LLCHAR.LCOM and b/sources/LLCHAR.LCOM differ diff --git a/sources/LLDISPLAY b/sources/LLDISPLAY index 6cafa80cb..51f76e733 100644 --- a/sources/LLDISPLAY +++ b/sources/LLDISPLAY @@ -1,14 +1,12 @@ -(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10) +(DEFINE-FILE-INFO :PACKAGE "INTERLISP" :READTABLE "INTERLISP" :BASE 10) -(FILECREATED " 2-Sep-2025 22:54:03"  -{DSK}kaplan>Local>medley3.5>working-medley>sources>LLDISPLAY.;50 272104 +(FILECREATED "28-Apr-2026 00:08:21" {WMEDLEY}LLDISPLAY.;54 272196 :EDIT-BY rmk - :CHANGES-TO (FNS \SLOWBLTCHAR) + :CHANGES-TO (FNS INITIALIZEDISPLAYSTREAMS) - :PREVIOUS-DATE " 2-Sep-2025 22:41:14" -{DSK}kaplan>Local>medley3.5>working-medley>sources>LLDISPLAY.;49) + :PREVIOUS-DATE "28-Apr-2026 00:04:31" {WMEDLEY}LLDISPLAY.;53) (PRETTYCOMPRINT LLDISPLAYCOMS) @@ -4579,7 +4577,10 @@ (DEFINEQ (INITIALIZEDISPLAYSTREAMS - [LAMBDA NIL (* ; "Edited 18-Aug-2025 12:15 by rmk") + [LAMBDA NIL (* ; "Edited 28-Apr-2026 00:08 by rmk") + (* ; "Edited 15-Apr-2026 00:25 by rmk") + (* ; "Edited 31-Mar-2026 17:52 by rmk") + (* ; "Edited 18-Aug-2025 12:15 by rmk") (* ; "Edited 6-Jul-2025 12:57 by rmk") (* lmm " 7-Jan-86 16:51") (SETQ WHOLEDISPLAY (create REGION)) @@ -4589,15 +4590,13 @@ (* ;; "A guaranteed display font is initialized here after pup, font, and bitmap code has been loaded. This does not use FONTCREATE, so it doesn't depend on the argument checking and incore cache retrieval ") - [SETQ \GUARANTEEDDISPLAYFONT (\CREATEDISPLAYFONT (MAKEFONTSPEC 'GACHA 10 '(MEDIUM REGULAR REGULAR - ) - 0 - 'DISPLAY] + (SETQ \GUARANTEEDDISPLAYFONT (MEDLEYFONT.READ.FONT + "{MEDLEY}medleydisplayfonts>GACHA10-MRR.MEDLEYDISPLAYFONT" + 0)) (* ;;  "For some reason, charset 0 has to be instantiated, otherwise there is a divide by 0 in the loadup") - (\CREATECHARSET 0 \GUARANTEEDDISPLAYFONT) (SETQ DEFAULTFONT (FONTCLASS 'DEFAULTFONT (LIST 1 \GUARANTEEDDISPLAYFONT]) ) (DECLARE%: DOCOPY DONTEVAL@LOAD @@ -4622,44 +4621,44 @@ (ADDTOVAR LAMA ) ) (DECLARE%: DONTCOPY - (FILEMAP (NIL (20613 23281 (\FBITMAPBIT 20623 . 21083) (\FBITMAPBIT.UFN 21085 . 22104) ( -\NEWPAGE.DISPLAY 22106 . 22241) (INITBITMASKS 22243 . 23279)) (25206 25715 (\CreateCursorBitMap 25216 - . 25713)) (25832 85635 (BITBLT 25842 . 36232) (BLTSHADE 36234 . 37012) (\BITBLTSUB 37014 . 47149) ( -\GETPILOTBBTSCRATCHBM 47151 . 47766) (BITMAPCOPY 47768 . 48344) (BITMAPCREATE 48346 . 49906) ( -BITMAPBIT 49908 . 58295) (BITMAPEQUAL 58297 . 59759) (BLTCHAR 59761 . 60377) (\BLTCHAR 60379 . 60881) -(\MEDW.BLTCHAR 60883 . 65761) (\CHANGECHARSET.DISPLAY 65763 . 67997) (\INDICATESTRING 67999 . 69195) ( -\SLOWBLTCHAR 69197 . 75890) (TEXTUREP 75892 . 76162) (INVERT.TEXTURE 76164 . 76438) ( -INVERT.TEXTURE.BITMAP 76440 . 77975) (BITMAPWIDTH 77977 . 78349) (BITMAPHEIGHT 78351 . 78727) ( -READBITMAP 78729 . 81239) (\INSUREBITSPERPIXEL 81241 . 81536) (MAXIMUMCOLOR 81538 . 81679) ( -OPPOSITECOLOR 81681 . 81860) (MAXIMUMSHADE 81862 . 82073) (OPPOSITESHADE 82075 . 82254) (\MEDW.BITBLT -82256 . 85633)) (85636 87065 (\READBINARYBITMAP 85646 . 86284) (\PRINTBINARYBITMAP 86286 . 87063)) ( -87067 92253 (FINISH-READING-BITMAP 87067 . 92253)) (93375 93856 (BITMAPBIT.EXPANDER 93385 . 93854)) ( -93857 142391 (\BITBLT.DISPLAY 93867 . 117106) (\BITBLT.BITMAP 117108 . 126207) (\BITBLT.MERGE 126209 - . 128462) (\BLTSHADE.DISPLAY 128464 . 135564) (\BLTSHADE.BITMAP 135566 . 142389)) (142392 151712 ( -\BITBLT.BITMAP.SLOW 142402 . 151710)) (151713 168094 (\PUNT.BLTSHADE.BITMAP 151723 . 158819) ( -\PUNT.BITBLT.BITMAP 158821 . 168092)) (168095 171535 (\SCALEDBITBLT.DISPLAY 168105 . 169738) ( -\BACKCOLOR.DISPLAY 169740 . 171533)) (175390 177663 (DISPLAYSTREAMP 175400 . 176008) (DSPSOURCETYPE -176010 . 177019) (DSPXOFFSET 177021 . 177340) (DSPYOFFSET 177342 . 177661)) (177664 191859 ( -DSPDESTINATION 177674 . 180777) (DSPTEXTURE 180779 . 180941) (\DISPLAYSTREAMINCRXPOSITION 180943 . -181230) (\SFFixDestination 181232 . 182410) (\SFFixClippingRegion 182412 . 184584) (\SFFixFont 184586 - . 185636) (\SFFIXLINELENGTH 185638 . 187134) (\UPDATE-SYNONYM-STREAM-LINELENGTH-FIELD 187136 . 188949 -) (\SFFixY 188951 . 191857)) (191860 195707 (\SIMPLE.DSPCREATE 191870 . 192420) (\COMMON.DSPCREATE -192422 . 195705)) (195808 198002 (\MEDW.XOFFSET 195818 . 196959) (\MEDW.YOFFSET 196961 . 198000)) ( -198003 205933 (\DSPCLIPPINGREGION.DISPLAY 198013 . 198759) (\DSPFONT.DISPLAY 198761 . 201135) ( -\DISPLAY.PILOTBITBLT 201137 . 201286) (\DSPLINEFEED.DISPLAY 201288 . 201859) (\DSPLEFTMARGIN.DISPLAY -201861 . 202592) (\DSPOPERATION.DISPLAY 202594 . 203618) (\DSPRIGHTMARGIN.DISPLAY 203620 . 204465) ( -\DSPXPOSITION.DISPLAY 204467 . 205324) (\DSPYPOSITION.DISPLAY 205326 . 205931)) (210121 215157 ( -TTYDISPLAYSTREAM 210131 . 215155)) (215460 216490 (DSPSCROLL 215470 . 216170) (PAGEHEIGHT 216172 . -216488)) (216535 219557 (\DSPRESET.DISPLAY 216545 . 219555)) (219593 220116 (\MAYBE-DRIBBLE-CHAR -219593 . 220116)) (220117 240755 (\DSPPRINTCHAR 220127 . 227965) (\DSPPRINTCR/LF 227967 . 240753)) ( -240756 241348 (\TTYBACKGROUND 240766 . 241346)) (241349 244636 (DSPBACKUP 241359 . 244634)) (244820 -245076 (COLORDISPLAYP 244830 . 245074)) (245077 247148 (DISPLAYBEFOREEXIT 245087 . 245913) ( -DISPLAYAFTERENTRY 245915 . 247146)) (247520 252052 (\DSPCLIPTRANSFORMX 247530 . 248119) ( -\DSPCLIPTRANSFORMY 248121 . 248846) (\DSPTRANSFORMREGION 248848 . 249380) (\DSPUNTRANSFORMY 249382 . -249642) (\DSPUNTRANSFORMX 249644 . 249904) (\OFFSETCLIPPINGREGION 249906 . 252050)) (253366 255953 ( -UPDATESCREENDIMENSIONS 253376 . 254005) (\CreateScreenBitMap 254007 . 255951)) (256512 269671 ( -\CoerceToDisplayDevice 256522 . 256935) (\CREATEDISPLAY 256937 . 258777) (DISPLAYSTREAMINIT 258779 . -261923) (\STARTDISPLAY 261925 . 264836) (\MOVE.WINDOWS.ONTO.SCREEN 264838 . 267030) ( -\UPDATE.PBT.RASTERWIDTHS 267032 . 268814) (\STOPDISPLAY 268816 . 269308) (\DEFINEDISPLAYINFO 269310 . -269669)) (270279 271729 (INITIALIZEDISPLAYSTREAMS 270289 . 271727))))) + (FILEMAP (NIL (20543 23211 (\FBITMAPBIT 20553 . 21013) (\FBITMAPBIT.UFN 21015 . 22034) ( +\NEWPAGE.DISPLAY 22036 . 22171) (INITBITMASKS 22173 . 23209)) (25136 25645 (\CreateCursorBitMap 25146 + . 25643)) (25762 85565 (BITBLT 25772 . 36162) (BLTSHADE 36164 . 36942) (\BITBLTSUB 36944 . 47079) ( +\GETPILOTBBTSCRATCHBM 47081 . 47696) (BITMAPCOPY 47698 . 48274) (BITMAPCREATE 48276 . 49836) ( +BITMAPBIT 49838 . 58225) (BITMAPEQUAL 58227 . 59689) (BLTCHAR 59691 . 60307) (\BLTCHAR 60309 . 60811) +(\MEDW.BLTCHAR 60813 . 65691) (\CHANGECHARSET.DISPLAY 65693 . 67927) (\INDICATESTRING 67929 . 69125) ( +\SLOWBLTCHAR 69127 . 75820) (TEXTUREP 75822 . 76092) (INVERT.TEXTURE 76094 . 76368) ( +INVERT.TEXTURE.BITMAP 76370 . 77905) (BITMAPWIDTH 77907 . 78279) (BITMAPHEIGHT 78281 . 78657) ( +READBITMAP 78659 . 81169) (\INSUREBITSPERPIXEL 81171 . 81466) (MAXIMUMCOLOR 81468 . 81609) ( +OPPOSITECOLOR 81611 . 81790) (MAXIMUMSHADE 81792 . 82003) (OPPOSITESHADE 82005 . 82184) (\MEDW.BITBLT +82186 . 85563)) (85566 86995 (\READBINARYBITMAP 85576 . 86214) (\PRINTBINARYBITMAP 86216 . 86993)) ( +86997 92183 (FINISH-READING-BITMAP 86997 . 92183)) (93305 93786 (BITMAPBIT.EXPANDER 93315 . 93784)) ( +93787 142321 (\BITBLT.DISPLAY 93797 . 117036) (\BITBLT.BITMAP 117038 . 126137) (\BITBLT.MERGE 126139 + . 128392) (\BLTSHADE.DISPLAY 128394 . 135494) (\BLTSHADE.BITMAP 135496 . 142319)) (142322 151642 ( +\BITBLT.BITMAP.SLOW 142332 . 151640)) (151643 168024 (\PUNT.BLTSHADE.BITMAP 151653 . 158749) ( +\PUNT.BITBLT.BITMAP 158751 . 168022)) (168025 171465 (\SCALEDBITBLT.DISPLAY 168035 . 169668) ( +\BACKCOLOR.DISPLAY 169670 . 171463)) (175320 177593 (DISPLAYSTREAMP 175330 . 175938) (DSPSOURCETYPE +175940 . 176949) (DSPXOFFSET 176951 . 177270) (DSPYOFFSET 177272 . 177591)) (177594 191789 ( +DSPDESTINATION 177604 . 180707) (DSPTEXTURE 180709 . 180871) (\DISPLAYSTREAMINCRXPOSITION 180873 . +181160) (\SFFixDestination 181162 . 182340) (\SFFixClippingRegion 182342 . 184514) (\SFFixFont 184516 + . 185566) (\SFFIXLINELENGTH 185568 . 187064) (\UPDATE-SYNONYM-STREAM-LINELENGTH-FIELD 187066 . 188879 +) (\SFFixY 188881 . 191787)) (191790 195637 (\SIMPLE.DSPCREATE 191800 . 192350) (\COMMON.DSPCREATE +192352 . 195635)) (195738 197932 (\MEDW.XOFFSET 195748 . 196889) (\MEDW.YOFFSET 196891 . 197930)) ( +197933 205863 (\DSPCLIPPINGREGION.DISPLAY 197943 . 198689) (\DSPFONT.DISPLAY 198691 . 201065) ( +\DISPLAY.PILOTBITBLT 201067 . 201216) (\DSPLINEFEED.DISPLAY 201218 . 201789) (\DSPLEFTMARGIN.DISPLAY +201791 . 202522) (\DSPOPERATION.DISPLAY 202524 . 203548) (\DSPRIGHTMARGIN.DISPLAY 203550 . 204395) ( +\DSPXPOSITION.DISPLAY 204397 . 205254) (\DSPYPOSITION.DISPLAY 205256 . 205861)) (210051 215087 ( +TTYDISPLAYSTREAM 210061 . 215085)) (215390 216420 (DSPSCROLL 215400 . 216100) (PAGEHEIGHT 216102 . +216418)) (216465 219487 (\DSPRESET.DISPLAY 216475 . 219485)) (219523 220046 (\MAYBE-DRIBBLE-CHAR +219523 . 220046)) (220047 240685 (\DSPPRINTCHAR 220057 . 227895) (\DSPPRINTCR/LF 227897 . 240683)) ( +240686 241278 (\TTYBACKGROUND 240696 . 241276)) (241279 244566 (DSPBACKUP 241289 . 244564)) (244750 +245006 (COLORDISPLAYP 244760 . 245004)) (245007 247078 (DISPLAYBEFOREEXIT 245017 . 245843) ( +DISPLAYAFTERENTRY 245845 . 247076)) (247450 251982 (\DSPCLIPTRANSFORMX 247460 . 248049) ( +\DSPCLIPTRANSFORMY 248051 . 248776) (\DSPTRANSFORMREGION 248778 . 249310) (\DSPUNTRANSFORMY 249312 . +249572) (\DSPUNTRANSFORMX 249574 . 249834) (\OFFSETCLIPPINGREGION 249836 . 251980)) (253296 255883 ( +UPDATESCREENDIMENSIONS 253306 . 253935) (\CreateScreenBitMap 253937 . 255881)) (256442 269601 ( +\CoerceToDisplayDevice 256452 . 256865) (\CREATEDISPLAY 256867 . 258707) (DISPLAYSTREAMINIT 258709 . +261853) (\STARTDISPLAY 261855 . 264766) (\MOVE.WINDOWS.ONTO.SCREEN 264768 . 266960) ( +\UPDATE.PBT.RASTERWIDTHS 266962 . 268744) (\STOPDISPLAY 268746 . 269238) (\DEFINEDISPLAYINFO 269240 . +269599)) (270209 271821 (INITIALIZEDISPLAYSTREAMS 270219 . 271819))))) STOP diff --git a/sources/LLDISPLAY.LCOM b/sources/LLDISPLAY.LCOM index c1b38fe48..6033a4d97 100644 --- a/sources/LLDISPLAY.LCOM +++ b/sources/LLDISPLAY.LCOM @@ -1,12 +1,9 @@ -(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10) +(DEFINE-FILE-INFO :PACKAGE "INTERLISP" :READTABLE "INTERLISP" :BASE 10) -(FILECREATED " 2-Sep-2025 22:54:03" ("compiled on " -{DSK}kaplan>Local>medley3.5>working-medley>sources>LLDISPLAY.;50) " 2-Sep-2025 22:44:30" -"COMPILE-FILEd" in "FULL 2-Sep-2025 ..." dated " 2-Sep-2025 22:44:39") -(FILECREATED " 2-Sep-2025 22:54:03" -{DSK}kaplan>Local>medley3.5>working-medley>sources>LLDISPLAY.;50 272104 :EDIT-BY rmk -:CHANGES-TO (FNS \SLOWBLTCHAR) :PREVIOUS-DATE " 2-Sep-2025 22:41:14" -{DSK}kaplan>Local>medley3.5>working-medley>sources>LLDISPLAY.;49) +(FILECREATED "28-Apr-2026 00:08:21" ("compiled on " {WMEDLEY}LLDISPLAY.;54) +"28-Apr-2026 00:01:36" "COMPILE-FILEd" in "FULL 28-Apr-2026 ..." dated "28-Apr-2026 00:01:44") +(FILECREATED "28-Apr-2026 00:08:21" {WMEDLEY}LLDISPLAY.;54 272196 :EDIT-BY rmk :CHANGES-TO ( +FNS INITIALIZEDISPLAYSTREAMS) :PREVIOUS-DATE "28-Apr-2026 00:04:31" {WMEDLEY}LLDISPLAY.;53) (RPAQQ LLDISPLAYCOMS ((DECLARE%: DONTCOPY (EXPORT (RECORDS PILOTBBT \DISPLAYDATA DISPLAYSTATE DISPLAYINFO) (MACROS \GETDISPLAYDATA))) (* ; "User-visible records are on ADISPLAY --- must be init'ed here") (INITRECORDS BITMAP PILOTBBT REGION @@ -196,7 +193,7 @@ BLTCHAR :D8 (42 \DISPLAYDATA 35 STREAM 24 OUTPUT) () \BLTCHAR :D8 -(P 0 A0152 I 2 DISPLAYDATA I 1 DISPLAYSTREAM I 0 CHARCODE) (Agh bÉ.ÉZ@ABlH(11 \GETSTREAM) +(P 0 A0175 I 2 DISPLAYDATA I 1 DISPLAYSTREAM I 0 CHARCODE) (Agh bÉ.ÉZ@ABlH(11 \GETSTREAM) (25 IMAGEOPS 18 STREAM 5 OUTPUT) () \MEDW.BLTCHAR :D8 @@ -209,11 +206,12 @@ BLTCHAR :D8 (256 \EM.DISPINTERRUPT 191 \TOPWDS 175 \EM.DISPINTERRUPT 167 \EM.DISPINTERRUPT 132 PILOTBBT) () \CHANGECHARSET.DISPLAY :D8 -(P 8 \INTERRUPTABLE P 6 BM P 5 CSINFO P 4 PBT I 1 CHARSET I 0 DISPLAYDATA) ¦ @É*@É HÉAàÐɵHÉAàAH -IJÐK¿K"@MÉ¿@MÉ¿@MÉ0¿@A>¿MɾLNÈàààànÿÿåÍ¿@È'MÈ -ð—@È@MÈ ð©@M -¿°'NÉNÈ@ÉBÚÐ_¿LOÒÍ¿LOÓÍh(122 \SFFixY 35 \CREATECHARSET) -(157 PILOTBBT 145 PILOTBBT 24 FONTDESCRIPTOR) +(P 9 \INTERRUPTABLE P 7 BM P 6 CSINFO P 5 PBT I 1 CHARSET I 0 DISPLAYDATA)  +@É*@É AHÈ djð“¿nÿÿñ²NHdÈ djð“¿nÿÿkعÉIàÐɵXHÉHÈ djð“¿nÿÿkØàH JKÐL¿L°)HÉAàÐɵHÉAàAH +JKÐL¿L" @NÉ¿@NÉ¿@NÉ0¿@A>¿NÉ_¿MOÈàààànÿÿåÍ¿@È'NÈ +ð—@È@NÈ ð©@N +¿°)OÉOÈ@ÉBÚÐ_¿MOÒÍ¿MOÓÍh(221 \SFFixY 131 \CREATECHARSET 90 \BUILDSLUGCSINFO) +(258 PILOTBBT 246 PILOTBBT 120 FONTDESCRIPTOR 71 FONTDESCRIPTOR 63 FONTDESCRIPTOR 35 FONTDESCRIPTOR 15 FONTDESCRIPTOR) () \INDICATESTRINGA0001 :D8 (NAME SI::*UNWIND-PROTECT* I 0 SI::*CLEANUP-FORMS* F 0 SI::*RESETFORMS* F 1 CHARCODE) Hgd gi @@ -225,18 +223,18 @@ BLTCHAR :D8 (75 ^ 52 %# 16 SI::RESETUNWIND) ( 81 "" 58 "") \SLOWBLTCHAR :D8 -(P 18 CSINFO P 17 HEIGHTMOVED P 16 YPOS P 15 SOFTCURSORUP P 14 DISPINTERRUPT P 13 SOURCEBIT P 12 WIDTH P 11 DESTBIT P 10 PILOTBBT P 9 CURX P 8 RIGHT P 7 LEFT P 6 NEWX P 2 DD P 1 CHAR8CODE P 0 ROTATION I 1 DISPLAYSTREAM I 0 CHARCODE F 22 \SOFTCURSORP F 23 \SOFTCURSORUPP F 24 \CURSORDESTINATION F 25 \SCREENBITMAPS) n`@lÿåYAÉ0ZdÉ È Xdj𢱈€ JÉ_JÉIÐÈØ^JÉñ²l A -¿JÉ_JÉIÐÈؾJN¿OJÉØ_¿JÈ"dOñ¢¿O_¿JÈ#NJÉØ»dKñ‘¿K_¿JÉ*_¿OOñ¢±OÈ jð’±O_¿OOÙ_¿JÉIÐÈOØOÙ_¿JÉÈdkð³adlð²¿Oàà_¿Oàà_¿Oàà_°Ddlð²¿Oààà_¿Oààà_¿Oààà_°$lð²lOÚ_¿lOÚ_¿lOÚ_„¿ W,²-W.´ hA -W0ð_²`È_¿`jÍ¿¿A`ð³hA -W2–A ¿OOÍ¿OOÍ¿OOÍ¿Ojv¿OŸ¿`OÍ¿±Ð0JÉ_ ¿JÉIÐÈ_"¿JÉ @ã½\ÉMàÐɵ#LÉMàML -O&O(ÐO*¿O*_$¿HdlZð²;¿AO O"Ø -¿O$ÉjJÉIÐÈAJÉO$È -ÙkØO O$È -O$È ØO" °Hnð²8AO O"Ù -¿O$ÉjJÉIÐÈAJÉO$È ÙJÉO$È -O$È ØO" ‰o h(618 ERROR 607 BKBITBLT 565 \DSPYPOSITION.DISPLAY 546 BKBITBLT 503 \DSPYPOSITION.DISPLAY 465 \CREATECHARSET 397 \SOFTCURSORUPCURRENT 362 \TOTOPWDS 352 DSPDESTINATION 335 \SOFTCURSORDOWN 304 DSPDESTINATION 285 SHOULDNT 55 \DSPPRINTCR/LF) -(454 FONTDESCRIPTOR 403 \EM.DISPINTERRUPT 342 \TOPWDS 326 \EM.DISPINTERRUPT 316 \EM.DISPINTERRUPT 113 \DISPLAYDATA 83 \DISPLAYDATA) -( 613 "Not implemented to rotate by other than 0, 90 or 270") +(P 19 CSINFO P 18 HEIGHTMOVED P 17 YPOS P 16 SOFTCURSORUP P 15 DISPINTERRUPT P 14 SOURCEBIT P 13 WIDTH P 12 DESTBIT P 11 PILOTBBT P 10 CURX P 9 RIGHT P 8 LEFT P 7 NEWX P 2 DD P 1 CHAR8CODE P 0 ROTATION I 1 DISPLAYSTREAM I 0 CHARCODE F 26 \SOFTCURSORP F 27 \SOFTCURSORUPP F 28 \CURSORDESTINATION F 29 \SCREENBITMAPS) Øp@lÿåYAÉ0ZdÉ È Xdj𢱀JÉ_JÉIÐÈØ_JÉñ²l A +¿JÉ_JÉIÐÈØ_¿JO¿OJÉØ_¿JÈ"dOñ¢¿O_¿JÈ#OJÉØ»dKñ‘¿K_¿JÉ*_¿OOñ¢±OÈ jð’±O_¿OOÙ_¿JÉIÐÈOØOÙ_¿JÉÈdkð³adlð²¿Oàà_¿Oàà_¿Oàà_°Ddlð²¿Oààà_¿Oààà_¿Oààà_°$lð²lOÚ_¿lOÚ_¿lOÚ_„¿ W4²-W6´ hA +W8ð_ ²`È_¿`jÍ¿¿A`ð³hA +W:–A ¿OOÍ¿OOÍ¿OOÍ¿Ojv¿O Ÿ¿`OÍ¿±50JÉ_"¿JÉIÐÈ_$¿JÉ @ã¾½NMÈ djð“¿nÿÿñ²RMdÈ djð“¿nÿÿkؼÉLàÐɵ`MÉMÈ djð“¿nÿÿkØàM O(O*ÐO,¿O,°-MÉNàÐɵ#MÉNàNM +O.O0ÐO2¿O2_&¿HdlZð²;¿AO"O$Ø +¿O&ÉjJÉIÐÈAJÉO&È +ÙkØO"O&È +O&È ØO$ °Hnð²8AO"O$Ù +¿O&ÉjJÉIÐÈAJÉO&È ÙJÉO&È +O&È ØO$ ‰o h(724 ERROR 713 BKBITBLT 671 \DSPYPOSITION.DISPLAY 652 BKBITBLT 609 \DSPYPOSITION.DISPLAY 571 \CREATECHARSET 526 \BUILDSLUGCSINFO 402 \SOFTCURSORUPCURRENT 367 \TOTOPWDS 357 DSPDESTINATION 340 \SOFTCURSORDOWN 309 DSPDESTINATION 290 SHOULDNT 56 \DSPPRINTCR/LF) +(560 FONTDESCRIPTOR 507 FONTDESCRIPTOR 499 FONTDESCRIPTOR 471 FONTDESCRIPTOR 451 FONTDESCRIPTOR 408 \EM.DISPINTERRUPT 347 \TOPWDS 331 \EM.DISPINTERRUPT 321 \EM.DISPINTERRUPT 118 \DISPLAYDATA 87 \DISPLAYDATA) +( 719 "Not implemented to rotate by other than 0, 90 or 270") TEXTUREP :D8 (I 0 OBJECT) @d3 ³ô@Èkð´@NIL (18 BITMAP 10 BITMAP) @@ -289,7 +287,7 @@ OPPOSITESHADE :D8 NIL () \MEDW.BITBLT :D8 -(P 9 A0155 P 8 A0154 P 7 SOURCEBOTTOMTRANSFORMED P 6 SOURCELEFTTRANSFORMED P 3 SRCWIN P 2 A0153 P 1 DD P 0 DSTWIN I 11 CLIPPINGREGION I 10 TEXTURE I 9 OPERATION I 8 SOURCETYPE I 7 HEIGHT I 6 WIDTH I 5 DESTINATIONBOTTOM I 4 DESTINATIONLEFT I 3 DESTINATION I 2 SOURCEBOTTOM I 1 SOURCELEFT I 0 SOURCE F 10 \SCREENBITMAPS)  +(P 9 A0178 P 8 A0177 P 7 SOURCEBOTTOMTRANSFORMED P 6 SOURCELEFTTRANSFORMED P 3 SRCWIN P 2 A0176 P 1 DD P 0 DSTWIN I 11 CLIPPINGREGION I 10 TEXTURE I 9 OPERATION I 8 SOURCETYPE I 7 HEIGHT I 6 WIDTH I 5 DESTINATIONBOTTOM I 4 DESTINATIONLEFT I 3 DESTINATION I 2 SOURCEBOTTOM I 1 SOURCELEFT I 0 SOURCE F 10 \SCREENBITMAPS)   @ ³C ªo ¿@òZ@²WCi Cgh É0HÉ2ÉHºHÉ2@ABCDEFGGGGGABlJ±–Cô‚±¯C´‚±¨@i !@gh É0AIÉصABIÉصBKÉ2ÉJ_¿KÉ2IÉNOCDEFGGGGGNIÈ"¼dLñ¡¿LOIÈ$½dMñ¡¿MlO±Þ@ @@ -455,11 +453,11 @@ Q (145 ERASE 138 INVERT 121 INVERT 110 PAINT 99 ERASE 86 \DISPLAYDATA 77 \DISPLAYDATA 53 INVERT 43 INPUT 32 \DISPLAYDATA 23 \DISPLAYDATA 16 STREAM 5 OUTPUT) () DSPXOFFSET :D8 -(P 0 A0169 I 1 DISPLAYSTREAM I 0 XOFFSET) 'Agh bÉ.É\@AlH(11 \GETSTREAM) +(P 0 A0192 I 1 DISPLAYSTREAM I 0 XOFFSET) 'Agh bÉ.É\@AlH(11 \GETSTREAM) (25 IMAGEOPS 18 STREAM 5 OUTPUT) () DSPYOFFSET :D8 -(P 0 A0170 I 1 DISPLAYSTREAM I 0 YOFFSET) 'Agh bÉ.É^@AlH(11 \GETSTREAM) +(P 0 A0193 I 1 DISPLAYSTREAM I 0 YOFFSET) 'Agh bÉ.É^@AlH(11 \GETSTREAM) (25 IMAGEOPS 18 STREAM 5 OUTPUT) () DSPDESTINATION :D8 @@ -544,13 +542,13 @@ A (23 \DISPLAYDATA 16 STREAM 5 OUTPUT) ( 63 " is not a REGION.") \DSPFONT.DISPLAY :D8 -(P 4 \INTERRUPTABLE P 2 DD P 1 OLDFONT P 0 XFONT I 1 FONT I 0 DISPLAYSTREAM) ‹@@É0ZdÉ YA²sAhdd@i µJÉ giA -µ o XIð³CJH ¿JjHÈ -Ù¿JHÉɵHÉjH -[¿KÉÈ ÍA¿@J -(135 \SFFixFont 116 \CREATECHARSET 66 ERROR 54 FONTCOPY 35 FONTCREATE) -(107 FONTDESCRIPTOR 87 FONTDESCRIPTOR 45 NOERROR 17 \DISPLAYDATA 8 STREAM) -( 61 "FONT NOT FOUND OR ILLEGAL FONTCOPY PARAMETER") +(P 5 \INTERRUPTABLE P 2 DD P 1 OLDFONT P 0 XFONT I 1 FONT I 0 DISPLAYSTREAM) ò P@É0ZdÉ YA¢±ÙAhdd@i µJÉ giA +µ o XI𒱧JH ¿JjHÈ +Ù¿JjHÈ djð“¿nÿÿñ²QHdÈ djð“¿nÿÿkØ»ÉKàÐɵOHÉHÈ djð“¿nÿÿkØàH NOÐO¿O°HÉɵHÉjH +\¿LÉÈ ÍA¿@J +(238 \SFFixFont 219 \CREATECHARSET 180 \BUILDSLUGCSINFO 68 ERROR 56 FONTCOPY 37 FONTCREATE) +(210 FONTDESCRIPTOR 161 FONTDESCRIPTOR 153 FONTDESCRIPTOR 125 FONTDESCRIPTOR 105 FONTDESCRIPTOR 91 FONTDESCRIPTOR 47 NOERROR 17 \DISPLAYDATA 8 STREAM) +( 63 "FONT NOT FOUND OR ILLEGAL FONTCOPY PARAMETER") \DISPLAY.PILOTBITBLT :D8 (I 1 N I 0 PILOTBBT) @AvNIL NIL @@ -772,10 +770,10 @@ NIL NIL () \CREATEDISPLAY :D8 -(P 0 FDEV I 0 DISPLAYNAME F 2 *DEFAULT-EXTERNALFORMAT*) ] `d@¿djÏ¿djÏ¿djÏ0¿dg¿dg¿dgD¿dg¿dg^¿dgF¿dg¿dgb¿dg`¿dg¿dg¿dg -¿dg ¿dg¿dg,¿dg.¿dg0¿dgT¿dg>¿dg@¿gh¹dI¿dRh¿dgR¿dgP¿dgN¿dgH¿dgB¿dg<¿dg:¿dg*¿dg ¿dg¿dg¿dg¿X@H -H(345 \DEFINEDEVICE) -(334 \GENERIC.RENAMEFILE 325 NILL 316 NILL 307 NILL 298 NILL 289 \GENERIC.READP 280 \ILLEGAL.DEVICEOP 271 NILL 262 \GENERIC.CHARSET 253 \ILLEGAL.DEVICEOP 244 \IS.NOT.RANDACCESSP 235 \IS.NOT.RANDACCESSP 216 OFF 208 \NONPAGEDBOUTS 199 \ILLEGAL.DEVICEOP 190 \PAGEDBACKFILEPTR 181 \ILLEGAL.DEVICEOP 172 \DSPPRINTCHAR 163 \ILLEGAL.DEVICEOP 154 NILL 145 NILL 136 NILL 127 \CREATEDISPLAYA0023 118 \CREATEDISPLAYA0021 109 \ILLEGAL.DEVICEOP 100 NILL 91 \GENERATENOFILES 82 NILL 73 \ILLEGAL.DEVICEOP 64 \CREATEDISPLAYA0014 55 NILL 46 NILL 37 NILL 7 |FDEVTYPE#|) +(P 0 FDEV I 0 DISPLAYNAME) a `d@¿djÏ¿djÏ¿djÏ0¿dg¿dg¿dgD¿dg¿dg^¿dgF¿dg¿dgb¿dg`¿dg¿dg¿dg +¿dg ¿dg¿dg,¿dg.¿dg0¿dgT¿dg>¿dg@¿gh¹dI¿d`h¿dgR¿dgP¿dgN¿dgH¿dgB¿dg<¿dg:¿dg*¿dg ¿dg¿dg¿dg¿X@H +H(349 \DEFINEDEVICE) +(338 \GENERIC.RENAMEFILE 329 NILL 320 NILL 311 NILL 302 NILL 293 \GENERIC.READP 284 \ILLEGAL.DEVICEOP 275 NILL 266 \GENERIC.CHARSET 257 \ILLEGAL.DEVICEOP 248 \IS.NOT.RANDACCESSP 239 \IS.NOT.RANDACCESSP 230 *DEFAULT-EXTERNALFORMAT* 216 OFF 208 \NONPAGEDBOUTS 199 \ILLEGAL.DEVICEOP 190 \PAGEDBACKFILEPTR 181 \ILLEGAL.DEVICEOP 172 \DSPPRINTCHAR 163 \ILLEGAL.DEVICEOP 154 NILL 145 NILL 136 NILL 127 \CREATEDISPLAYA0023 118 \CREATEDISPLAYA0021 109 \ILLEGAL.DEVICEOP 100 NILL 91 \GENERATENOFILES 82 NILL 73 \ILLEGAL.DEVICEOP 64 \CREATEDISPLAYA0014 55 NILL 46 NILL 37 NILL 7 |FDEVTYPE#|) () DISPLAYSTREAMINIT :D8 (P 2 TTYFONTHEIGHT P 1 TTYHEIGHT P 0 TTYFONT I 0 N F 3 TtyDisplayStream) «chS @@ -815,13 +813,12 @@ NIL (PUTPROPS DISPLAYSTARTEDP MACRO (NIL \DisplayStarted)) (ADDTOVAR GLOBALVARS WHOLESCREEN) INITIALIZEDISPLAYSTREAMS :D8 -(F 0 \GUARANTEEDDISPLAYFONT F 1 DEFAULTFONT) eodnÿdh`ld -gl -ojg  cjP -gkPh -c(96 FONTCLASS 81 \CREATECHARSET 72 \CREATEDISPLAYFONT 67 MAKEFONTSPEC 38 BITMAPCREATE) -(86 DEFAULTFONT 61 DISPLAY 48 GACHA 43 \SYSBBTEXTURE 30 \SYSPILOTBBT 24 |PILOTBBTTYPE#| 19 WHOLEDISPLAY) -( 55 (MEDIUM REGULAR REGULAR) 4 -16383) +(F 0 \GUARANTEEDDISPLAYFONT F 1 DEFAULTFONT) Lodnÿdh`ld +oj +cgkPh +c(71 FONTCLASS 54 MEDLEYFONT.READ.FONT 38 BITMAPCREATE) +(61 DEFAULTFONT 43 \SYSBBTEXTURE 30 \SYSPILOTBBT 24 |PILOTBBTTYPE#| 19 WHOLEDISPLAY) +( 48 "{MEDLEY}medleydisplayfonts>GACHA10-MRR.MEDLEYDISPLAYFONT" 4 -16383) (RPAQQ \DisplayStarted NIL) (RPAQQ \LastTTYLines 12) (INITIALIZEDISPLAYSTREAMS) diff --git a/sources/LLREAD b/sources/LLREAD index d3897704c..03d0d72e9 100644 --- a/sources/LLREAD +++ b/sources/LLREAD @@ -1,13 +1,12 @@ -(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10) +(DEFINE-FILE-INFO :PACKAGE "INTERLISP" :READTABLE "INTERLISP" :BASE 10) -(FILECREATED "20-Sep-2025 14:18:31" {WMEDLEY}LLREAD.;123 99281 +(FILECREATED "29-Apr-2026 22:56:18" {MEDLEY}LLREAD.;128 100032 :EDIT-BY rmk :CHANGES-TO (VARS LLREADCOMS) - (FNS CHARSET.ENCODE) - :PREVIOUS-DATE "24-Aug-2025 11:47:11" {WMEDLEY}LLREAD.;122) + :PREVIOUS-DATE "17-Apr-2026 17:06:49" {MEDLEY}LLREAD.;127) (PRETTYCOMPRINT LLREADCOMS) @@ -40,7 +39,9 @@ (ALISTS (CHARACTERNAMES Page Form FF Rubout Del Null Escape Esc Bell Tab Backspace Bs Newline CR EOL Return Tenexeol Space Sp Linefeed LF Zero One Two Three Four Five Six Seven Eight Nine INFINITY EMQUAD ENQUAD THINSPACE - FIGURESPACE LEFT-DOUBLEQUOTE RIGHT-DOUBLEQUOTE EMDASH) + HAIRSPACE FIGURESPACE LEFT-DOUBLEQUOTE RIGHT-DOUBLEQUOTE EMDASH ENDASH + Union Intersection And Or Contourintegral Integral Summation Product + Radical All Exists Member INFINITY Notmember Minus) (CHARACTERSETNAMES Meta Function Greek Cyrillic Hira Hiragana Kata Katakana Kanji))) (DECLARE%: DOEVAL@COMPILE DONTCOPY (CONSTANTS * READTYPES) @@ -1486,7 +1487,8 @@ (ERROR "BAD CHARACTER SPECIFICATION" C]) (CHARCODE.ENCODE - [LAMBDA (CODE OCTALCHARS NONCHARIDENTITY) (* ; "Edited 13-Aug-2025 08:54 by rmk") + [LAMBDA (CODE OCTALCHARS NONCHARIDENTITY) (* ; "Edited 17-Apr-2026 17:05 by rmk") + (* ; "Edited 13-Aug-2025 08:54 by rmk") (* ; "Edited 7-Aug-2025 11:10 by rmk") (* ; "Edited 23-Apr-2025 19:08 by rmk") (* ; "Edited 26-Mar-2025 10:37 by rmk") @@ -1518,6 +1520,10 @@ then (CL:IF NONCHARIDENTITY CODE (\ILLEGAL.ARG CODE)) + elseif OCTALCHARS + then (CONCAT (OCTALSTRING (LRSH CODE 8)) + "," + (OCTALSTRING (LOGAND CODE 255))) elseif [CAR (find CN in CHARACTERNAMES suchthat (if (CHARCODEP (CADR CN)) then (IEQP CODE (CADR CN)) else (IEQP CODE (CHARCODE.DECODE (CADR CN] @@ -1528,10 +1534,8 @@ (SETQ CSETNAME (if [CAR (find CN in CHARACTERSETNAMES suchthat (STRING.EQUAL CHARSET (CADR CN] else (OCTALSTRING CHARSET))) - [SETQ CHARNAME (if OCTALCHARS - then (OCTALSTRING CHAR) - else (CAR (for CC in CHARACTERNAMES when (EQ CHAR (CADR CC)) - smallest (NCHARS (CAR CC] + [SETQ CHARNAME (CAR (for CC in CHARACTERNAMES when (EQ CHAR (CADR CC)) + smallest (NCHARS (CAR CC] (CL:WHEN (STREQUAL CHARNAME "Tenexeol") (* ;  "Put (%"^_%" Tenexeol) in CHARACTERNAMES ?") (SETQ CHARNAME "^_")) @@ -1551,8 +1555,7 @@ (SETQ CHARNAME (CL:IF (IGEQ CHAR 128) (CONCAT "#" ASCIINAME) ASCIINAME))) - (CL:IF (AND (ZEROP CHARSET) - (NOT OCTALCHARS)) + (CL:IF (ZEROP CHARSET) CHARNAME (CONCAT CSETNAME "," CHARNAME))]) @@ -1723,10 +1726,27 @@ (EMQUAD "357,55") (ENQUAD "357,54") (THINSPACE "357,57") + (HAIRSPACE "356,043") (FIGURESPACE "357,56") (LEFT-DOUBLEQUOTE "0,252") (RIGHT-DOUBLEQUOTE "0,272") - (EMDASH "357,045")) + (EMDASH "357,045") + (ENDASH "357,044") + (Union "357,127") + (Intersection "357,126") + (And "357,266") + (Or "357,267") + (Contourintegral "357,166") + (Integral "357,165") + (Summation "357,172") + (Product "357,173") + (Radical "357,174") + (All "357,265") + (Exists "357,264") + (Member "357,112") + (INFINITY "41,147") + (Notmember "357,113") + (Minus "356,055")) (ADDTOVAR CHARACTERSETNAMES (Meta 1) (Function 2) @@ -1840,19 +1860,19 @@ (ADDTOVAR LAMA CL:PARSE-INTEGER CL:READ-DELIMITED-LIST CL:READ-PRESERVING-WHITESPACE CL:READ) ) (DECLARE%: DONTCOPY - (FILEMAP (NIL (3828 12272 (LASTC 3838 . 4144) (PEEKC 4146 . 4534) (PEEKCCODE 4536 . 4947) (RATOM 4949 - . 6030) (READ 6032 . 6592) (READC 6594 . 7235) (READCCODE 7237 . 7996) (READP 7998 . 8550) ( -SETREADMACROFLG 8552 . 8851) (SKIPSEPRCODES 8853 . 9933) (SKIPSEPRS 9935 . 10321) (SKREAD 10323 . -12270)) (12318 20927 (CL:READ 12328 . 12877) (CL:READ-PRESERVING-WHITESPACE 12879 . 13601) ( -CL:READ-DELIMITED-LIST 13603 . 14518) (CL:PARSE-INTEGER 14520 . 20925)) (21020 33497 (RSTRING 21030 . -21762) (READ-EXTENDED-TOKEN 21764 . 25636) (\RSTRING2 25638 . 33495)) (33533 64266 (\TOP-LEVEL-READ -33543 . 35526) (\SUBREAD 35528 . 60682) (\SUBREADCONCAT 60684 . 61307) (\ORIG-READ.SYMBOL 61309 . -62377) (\ORIG-INVALID.SYMBOL 62379 . 63278) (\APPLYREADMACRO 63280 . 63696) (INREADMACROP 63698 . -64264)) (64425 64600 (READQUOTE 64435 . 64598)) (64625 76529 (READVBAR 64635 . 65966) (READHASHMACRO -65968 . 71778) (DEFMACRO-LAMBDA-LIST-KEYWORD-P 71780 . 72000) (DIGITBASEP 72002 . 72736) ( -READNUMBERINBASE 72738 . 74624) (ESTIMATE-DIMENSIONALITY 74626 . 74951) (SKIP.HASH.COMMENT 74953 . -75921) (CMLREAD.FEATURE.PARSER 75923 . 76527)) (76573 77839 (CHARACTER.READ 76583 . 77837)) (77872 -89790 (CHARCODE.DECODE 77882 . 83051) (CHARCODE.ENCODE 83053 . 87495) (CHARCODEP 87497 . 88026) ( -CHARSET.DECODE 88028 . 88976) (CHARSET.ENCODE 88978 . 89788)) (89791 94287 (HEXNUM? 89801 . 92144) ( -OCTALNUM? 92146 . 92959) (HEXSTRING 92961 . 94285))))) + (FILEMAP (NIL (3984 12428 (LASTC 3994 . 4300) (PEEKC 4302 . 4690) (PEEKCCODE 4692 . 5103) (RATOM 5105 + . 6186) (READ 6188 . 6748) (READC 6750 . 7391) (READCCODE 7393 . 8152) (READP 8154 . 8706) ( +SETREADMACROFLG 8708 . 9007) (SKIPSEPRCODES 9009 . 10089) (SKIPSEPRS 10091 . 10477) (SKREAD 10479 . +12426)) (12474 21083 (CL:READ 12484 . 13033) (CL:READ-PRESERVING-WHITESPACE 13035 . 13757) ( +CL:READ-DELIMITED-LIST 13759 . 14674) (CL:PARSE-INTEGER 14676 . 21081)) (21176 33653 (RSTRING 21186 . +21918) (READ-EXTENDED-TOKEN 21920 . 25792) (\RSTRING2 25794 . 33651)) (33689 64422 (\TOP-LEVEL-READ +33699 . 35682) (\SUBREAD 35684 . 60838) (\SUBREADCONCAT 60840 . 61463) (\ORIG-READ.SYMBOL 61465 . +62533) (\ORIG-INVALID.SYMBOL 62535 . 63434) (\APPLYREADMACRO 63436 . 63852) (INREADMACROP 63854 . +64420)) (64581 64756 (READQUOTE 64591 . 64754)) (64781 76685 (READVBAR 64791 . 66122) (READHASHMACRO +66124 . 71934) (DEFMACRO-LAMBDA-LIST-KEYWORD-P 71936 . 72156) (DIGITBASEP 72158 . 72892) ( +READNUMBERINBASE 72894 . 74780) (ESTIMATE-DIMENSIONALITY 74782 . 75107) (SKIP.HASH.COMMENT 75109 . +76077) (CMLREAD.FEATURE.PARSER 76079 . 76683)) (76729 77995 (CHARACTER.READ 76739 . 77993)) (78028 +90031 (CHARCODE.DECODE 78038 . 83207) (CHARCODE.ENCODE 83209 . 87736) (CHARCODEP 87738 . 88267) ( +CHARSET.DECODE 88269 . 89217) (CHARSET.ENCODE 89219 . 90029)) (90032 94528 (HEXNUM? 90042 . 92385) ( +OCTALNUM? 92387 . 93200) (HEXSTRING 93202 . 94526))))) STOP diff --git a/sources/LLREAD.LCOM b/sources/LLREAD.LCOM index 0a78b0a66..73bb8944a 100644 Binary files a/sources/LLREAD.LCOM and b/sources/LLREAD.LCOM differ diff --git a/sources/MCCS b/sources/MCCS index f45240199..db81355ec 100644 --- a/sources/MCCS +++ b/sources/MCCS @@ -1,18 +1,19 @@ (DEFINE-FILE-INFO :PACKAGE "INTERLISP" :READTABLE "INTERLISP" :BASE 10 :FORMAT :UTF-8) -(FILECREATED "26-Feb-2026 12:57:11" {WMEDLEY}MCCS.;168 61634 +(FILECREATED "17-Apr-2026 08:42:39" {MEDLEY}MCCS.;200 23340 :EDIT-BY rmk - :CHANGES-TO (FNS MCCSMAPPAIRS) + :CHANGES-TO (FNS KANJICHARSETP UNIHANCHARSETP) + (VARS MCCSCOMS) - :PREVIOUS-DATE "20-Feb-2026 09:21:16" {WMEDLEY}MCCS.;167) + :PREVIOUS-DATE "11-Mar-2026 11:58:53" {MEDLEY}MCCS.;199) (PRETTYCOMPRINT MCCSCOMS) (RPAQQ MCCSCOMS - [ + ( (* ;; "Stringlet number encoding common to MCCS and XCCS") (FNS \MCCSINCCODE \MCCSPEEKCCODE \MCCSOUTCHAR \MCCSBACKCCODE \MCCSFORMATBYTESTREAM @@ -37,30 +38,7 @@ (FNS MTOXCODE XTOMCODE XTOMSTRING MTOXSTRING) (FNS MTOX$CODE X$TOMCODE) - (FNS KANJICHARSETP CHINESECHARSETP) - (COMS (* ; " Mapping to MCCS") - (VARS ALTOTEXT2MCCS SYMBOLTOMCCS SIGMATOMCCS HIPPOTOMCCS CYRILLICTOMCCS MATHTOMCCS - PALATINOTOMCCS) - (FNS MCCSCODEMAPARRAY) - (GLOBALVARS ALTOTOMCCSARRAY SYMBOLTOMCCSARRAY HIPPOTOMCCSARRAY CYRILLICTOMCCSARRAY - MATHTOMCCSARRAY SIGMATOMCCSARRAY PALATINOTOMCCSARRAY) - (INITVARS (ALTOTOMCCSARRAY (MCCSCODEMAPARRAY 'MCCS)) - (SYMBOLTOMCCSARRAY (MCCSCODEMAPARRAY SYMBOLTOMCCS)) - (HIPPOTOMCCSARRAY (MCCSCODEMAPARRAY HIPPOTOMCCS)) - (CYRILLICTOMCCSARRAY (MCCSCODEMAPARRAY CYRILLICTOMCCS)) - (MATHTOMCCSARRAY (MCCSCODEMAPARRAY MATHTOMCCS)) - (SIGMATOMCCSARRAY (MCCSCODEMAPARRAY SIGMATOMCCS)) - (PALATINOTOMCCSARRAY (MCCSCODEMAPARRAY PALATINOTOMCCS))) - (FNS MCCSMAPFN MCCSMAPPAIRS XCCS.CS0.UNDEFINED XCCSUNDEFINEDPAIRS) - (COMS - (* ;; - "Mappings into MCCS: needed for hardcopy and Tedit coercion, e.g. \TEDIT.MCCS.TRANSLATE") - - (FNS GACHATOMCODE SYMBOLTOMCODE SIGMATOMCODE ATOMCODE MATHTOMCODE HIPPOTOMCODE - CYRILLICTOMCODE PALATINOTOMCODE)) - (COMS (FNS SYSTEM-EXTERNALFORMAT MTOSYSSTRING SYSTOMSTRING) - (EXPORT (GLOBALVARS *SYSTEM-EXTERNALFORMAT*)) - (INITVARS (*SYSTEM-EXTERNALFORMAT* :UTF-8]) + (FNS KANJICHARSETP UNIHANCHARSETP))) @@ -470,1125 +448,34 @@ (DEFINEQ (KANJICHARSETP - [LAMBDA (CHARSET) (* ; "Edited 13-Jun-2025 16:33 by rmk") + [LAMBDA (CHARSET) (* ; "Edited 17-Apr-2026 08:38 by rmk") + (* ; "Edited 11-Mar-2026 11:58 by rmk") + (* ; "Edited 13-Jun-2025 16:33 by rmk") (* ;; "Returns CHARSET if it is a charset with MCCS Kanji characters") - (AND (<= 48 CHARSET 118) + (AND [OR (<= (CONSTANT (CHARSET.DECODE "60")) + CHARSET + (CONSTANT (CHARSET.DECODE "172"] CHARSET]) -(CHINESECHARSETP - [LAMBDA (CHARSET) (* ; "Edited 18-Jun-2025 23:09 by rmk") +(UNIHANCHARSETP + [LAMBDA (CHARSET) (* ; "Edited 17-Apr-2026 08:41 by rmk") (* ; "Edited 13-Jun-2025 16:33 by rmk") - (* ;; "Returns CHARSET if it is a charset with MCCS Chinese characters") + (* ;; "Returns CHARSET if it is a charset with MCCS Unihan characters") - (AND (<= 161 CHARSET 212) + (AND (<= (CONSTANT (OCTALNUM? "241")) + CHARSET + (CONSTANT (OCTALNUM? "324"))) CHARSET]) ) - - - -(* ; " Mapping to MCCS") - - -(RPAQQ ALTOTEXT2MCCS - ( - (* ;; "From bravo doc") - - (↑N "356,055" MINUS) - (↑V "357,44" ENDASH) - (↑S EMDASH) - (↑O EMQUAD) - (↑X "356,055" MINUS) - (↑Y FIGURESPACE ENQUAD) - - (* ;; "Fom current Helvetica/Timesroman fonts") - - ("0,1" "0,317" HACHEK) - ("0,3" "361,255" DIARESIS) - ("0,4" "0,310" CCEDILLA) - ("0,5" "0,301" GRAVE) - ("0,6" "360,41" ff) - ("0,7" "0,271" LSQ) - ("0,10" "0,241" SPANISHEXCL) - ("0,13" "0,302" ACUTE) - ("0,20" "0,304" TILDE) - ("0,21" "360,42" ffi) - ("0,22" "360,43" ffl) - ("0,24" "360,44" fi) - ("0,25" "360,45" fl) - ("0,26" "357,44" ENDASH) - ("0,27" "0,306" BREVE) - ("0,34" ENQUAD) - ("0,36" "0,304" TILDE) - ("0,140" "0,251") - ("0,200" "361,47" A-umlaut) - ("0,201" "361,124" O-umlaut) - ("0,202" "361,47" A-ring) - ("0,233" "357,44" ENDASH) - ("0,234" EMDASH) - ("0,240" "361,247" a-umlaut) - ("0,241" "361,324" o-umlaut) - ("0,242" "361,250" a-ring) - ("0,243" "361,345" u-umlaut) - ("0,254" Circumflex) - ("0,260" "0,242" CENTS) - ("0,261" "0,243" POUND) - ("0,265" "41,172" STAR) - ("0,266" "0,247" SECTION) - ("0,267" "357,146" BULLET) - ("0,270" "357,60" DAGGER) - ("0,271" "357,061" DOUBLEDAGGER) - ("0,272" "0,266" PARAGRAPH) - ("0,274" "0,261" PLUSMINUS) - ("0,275" "0,241" SPANISHEXCL) - ("0,276" "0,277" SPANISHQUES) - ("0,277" Lowline))) - -(RPAQQ SYMBOLTOMCCS - (("0,1" Null) - ("0,2" "0,264") - ("0,3" "41,142") - ("0,4" Null) - ("0,5" "41,176") - ("0,6" "0,261") - (Bell "357,175") - (Backspace "357,142") - (Tab "357,143") - (Linefeed "357,144") - ("0,13" "357,145") - (Page Null) - (Newline "0,270") - ("0,16" Null) - ("0,17" Null) - ("0,20" "357,160") - ("0,21" "357,162") - ("0,22" "357,131") - ("0,23" "357,130") - ("0,24" "41,145") - ("0,25" "41,146") - ("0,26" Null) - ("0,27" Null) - ("0,30" "356,176") - ("0,31" "357,171") - ("0,32" "357,133") - (Escape "357,132") - ("0,34" "41,142") - ("0,35" "357,163") - ("0,36" Null) - (Tenexeol Null) - (Space Null) - ("0,41" "0,256") - ("0,42" Circumflex) - ("0,43" "0,257") - (Dollar "357,122") - ("0,45" "357,102") - ("0,46" "357,103") - ("0,47" "357,167") - ("0,50" "357,115") - ("0,51" "357,117") - ("0,52" Null) - ("0,53" Null) - ("0,54" "357,116") - ("0,55" Null) - ("0,56" Null) - ("0,57" Null) - (Zero Null) - (One INFINITY) - (Two "357,112") - (Three "357,113") - (Four "357,141") - (Five Null) - (Six "357,154") - (Seven Lowline) - (Eight "357,265") - (Nine "357,264") - ("0,72" "357,152") - ("0,73" "357,247") - ("0,74" Null) - ("0,75" Null) - ("0,76" Null) - ("0,77" "0,57") - ("0,100" Null) - ("0,133" "357,127") - ("0,134" "357,126") - ("0,135" Null) - (Uparrow "357,266") - (Leftarrow "357,267") - ("0,140" "357,66") - ("0,141" "357,67") - ("0,142" "357,262") - ("0,143" "357,263") - ("0,144" "357,260") - ("0,145" "357,261") - ("0,146" "0,173") - ("0,147" "0,175") - ("0,150" "357,62") - ("0,151" "357,63") - ("0,152" "356,174") - ("0,153" "41,102") - ("0,154" "357,73") - ("0,155" "357,72") - ("0,156" "42,44") - ("0,157" "42,46") - ("0,160" "357,174") - ("0,161" "41,142") - ("0,162" Null) - ("0,163" "357,165") - ("0,164" Null) - ("0,165" Null) - ("0,166" Null) - ("0,167" Null) - ("0,170" "0,247") - ("0,171" "357,60") - ("0,172" "357,61") - ("0,173" "0,266") - ("0,174" "0,100") - ("0,175" "0,323") - ("0,176" "0,243") - (Rubout Dollar) - ("0,200" Null) - ("0,201" Null) - ("0,202" Null) - ("0,203" Null) - ("0,204" Null) - ("0,205" Null) - ("0,206" Null) - ("0,207" Null) - ("0,210" Null) - ("0,211" Null) - ("0,212" Null) - ("0,213" Null) - ("0,214" Null) - ("0,215" Null) - ("0,216" Null) - ("0,217" Null) - ("0,220" Null) - ("0,221" Null) - ("0,222" Null) - ("0,223" Null) - ("0,224" Null) - ("0,225" Null) - ("0,226" Null) - ("0,227" Null) - ("0,230" Null) - ("0,231" Null) - ("0,232" Null) - ("0,233" Null) - ("0,234" Null) - ("0,235" Null) - ("0,236" Null) - ("0,237" Null) - ("0,240" Null) - ("0,241" Null) - ("0,242" Null) - ("0,243" Null) - (Currency Null) - ("0,245" Null) - ("0,246" Null) - ("0,247" Null) - ("0,250" Null) - ("0,251" Null) - (LEFT-DOUBLEQUOTE Null) - ("0,253" Null) - (Lowline Null) - (Circumflex Null) - ("0,256" Null) - ("0,257" Null) - ("0,260" Null) - ("0,261" Null) - ("0,262" Null) - ("0,263" Null) - ("0,264" Null) - ("0,265" Null) - ("0,266" Null) - ("0,267" Null) - ("0,270" Null) - ("0,271" Null) - (RIGHT-DOUBLEQUOTE Null) - ("0,273" Null) - ("0,274" Null) - ("0,275" Null) - ("0,276" Null) - ("0,277" Null) - ("0,300" Null) - ("0,301" Null) - ("0,302" Null) - ("0,303" Null) - ("0,304" Null) - ("0,305" Null) - ("0,306" Null) - ("0,307" Null) - ("0,310" Null) - ("0,311" Null) - ("0,312" Null) - ("0,313" Null) - ("0,314" Null) - ("0,315" Null) - ("0,316" Null) - ("0,317" Null) - ("0,320" Null) - ("0,321" Null) - ("0,322" Null) - ("0,323" Null) - ("0,324" Null) - ("0,325" Null) - ("0,326" Null) - ("0,327" Null) - ("0,330" Null) - ("0,331" Null) - ("0,332" Null) - ("0,333" Null) - ("0,334" Null) - ("0,335" Null) - ("0,336" Null) - ("0,337" Null) - ("0,340" Null) - ("0,341" Null) - ("0,342" Null) - ("0,343" Null) - ("0,344" Null) - ("0,345" Null) - ("0,346" Null) - ("0,347" Null) - ("0,350" Null) - ("0,351" Null) - ("0,352" Null) - ("0,353" Null) - ("0,354" Null) - ("0,355" Null) - ("0,356" Null) - ("0,357" Null) - ("0,360" Null) - ("0,361" Null) - ("0,362" Null) - ("0,363" Null) - ("0,364" Null) - ("0,365" Null) - ("0,366" Null) - ("0,367" Null) - ("0,370" Null) - ("0,371" Null) - ("0,372" Null) - ("0,373" Null) - ("0,374" Null) - ("0,375" Null) - ("0,376" Null) - ("0,377" Null))) - -(RPAQQ SIGMATOMCCS - (("0,101" "0,101" low squaredot not in XCCS) - ("0,103" "357,166" contourintegral) - ("0,111" "357,126" intersection) - ("0,114" "357,266" and) - ("0,115" "357,172" Summation) - ("0,120" "357,173" Product) - ("0,122" "357,174" radical) - ("0,123" "357,165" integral) - ("0,125" "357,127" union) - ("0,126" "357,267" or))) - -(RPAQQ HIPPOTOMCCS - (("0,16" "356,55") - ("0,17" EMQUAD) - ("0,23" EMDASH) - ("0,26" "357,44") - ("0,30" "356,55") - ("0,31" ENQUAD) - ("0,101" "Greek,101") - ("0,102" "Greek,102") - ("0,103" "Greek,121") - ("0,104" "Greek,105") - ("0,105" "Greek,106") - ("0,106" "Greek,132") - ("0,107" "Greek,104") - ("0,110" "Greek,112") - ("0,111" "Greek,114") - ("0,113" "Greek,115") - ("0,114" "Greek,116") - ("0,115" "Greek,117") - ("0,116" "Greek,120") - ("0,117" "Greek,122") - ("0,120" "Greek,123") - ("0,121" "Greek,113") - ("0,122" "Greek,125") - ("0,123" "Greek,126") - ("0,124" "Greek,130") - ("0,125" "Greek,131") - ("0,127" "Greek,135") - ("0,130" "Greek,133") - ("0,131" "Greek,134") - ("0,132" "Greek,111") - (Uparrow Circumflex) - (Leftarrow Lowline) - ("0,141" "Greek,141") - ("0,142" "Greek,142") - ("0,143" "Greek,161") - ("0,144" "Greek,145") - ("0,145" "Greek,146") - ("0,146" "Greek,172") - ("0,147" "Greek,144") - ("0,150" "Greek,152") - ("0,151" "Greek,154") - ("0,153" "Greek,155") - ("0,154" "Greek,156") - ("0,155" "Greek,157") - ("0,156" "Greek,160") - ("0,157" "Greek,162") - ("0,160" "Greek,163") - ("0,161" "Greek,153") - ("0,162" "Greek,165") - ("0,163" "Greek,166") - ("0,164" "Greek,170") - ("0,165" "Greek,171") - ("0,167" "Greek,175") - ("0,170" "Greek,173") - ("0,171" "Greek,174") - ("0,172" "Greek,151") - ("0,233" "357,44") - ("0,234" EMDASH) - ("0,267" "357,146"))) - -(RPAQQ CYRILLICTOMCCS - ((Dollar "Cyrillic,47") - ("0,52" "Cyrillic,71") - ("0,55" "41,76") - (Two "Cyrillic,157") - (Four "Cyrillic,127") - (Six "Cyrillic,150") - (Eight "Cyrillic,151") - ("0,74" "0,253") - ("0,76" "0,273") - ("0,100" "Cyrillic,77") - ("0,101" "Cyrillic,41") - ("0,102" "Cyrillic,42") - ("0,103" "Cyrillic,76") - ("0,104" "Cyrillic,45") - ("0,105" "Cyrillic,46") - ("0,106" "Cyrillic,66") - ("0,107" "Cyrillic,44") - ("0,110" "Cyrillic,101") - ("0,111" "Cyrillic,52") - ("0,112" "Cyrillic,53") - ("0,113" "Cyrillic,54") - ("0,114" "Cyrillic,55") - ("0,115" "Cyrillic,56") - ("0,116" "Cyrillic,57") - ("0,117" "Cyrillic,60") - ("0,120" "Cyrillic,61") - ("0,121" "Cyrillic,67") - ("0,122" "Cyrillic,62") - ("0,123" "Cyrillic,63") - ("0,124" "Cyrillic,64") - ("0,125" "Cyrillic,65") - ("0,126" "Cyrillic,43") - ("0,127" "Cyrillic,50") - ("0,130" "Cyrillic,75") - ("0,131" "Cyrillic,100") - ("0,132" "Cyrillic,51") - ("0,133" "Cyrillic,152") - ("0,134" "Cyrillic,0") - ("0,135" "Cyrillic,153") - (Uparrow "Cyrillic,74") - (Leftarrow "Cyrillic,154") - ("0,140" "Cyrillic,0") - ("0,141" "Cyrillic,121") - ("0,142" "Cyrillic,122") - ("0,143" "Cyrillic,176") - ("0,144" "Cyrillic,125") - ("0,145" "Cyrillic,126") - ("0,146" "Cyrillic,146") - ("0,147" "Cyrillic,124") - ("0,150" "Cyrillic,161") - ("0,151" "Cyrillic,132") - ("0,152" "Cyrillic,133") - ("0,153" "Cyrillic,134") - ("0,154" "Cyrillic,135") - ("0,155" "Cyrillic,136") - ("0,156" "Cyrillic,137") - ("0,157" "Cyrillic,140") - ("0,160" "Cyrillic,141") - ("0,161" "Cyrillic,147") - ("0,162" "Cyrillic,142") - ("0,163" "Cyrillic,143") - ("0,164" "Cyrillic,144") - ("0,165" "Cyrillic,145") - ("0,166" "Cyrillic,123") - ("0,167" "Cyrillic,130") - ("0,170" "Cyrillic,155") - ("0,171" "Cyrillic,160") - ("0,172" "Cyrillic,131") - ("0,173" "Cyrillic,72") - ("0,174" "Cyrillic,0") - ("0,175" "Cyrillic,73") - ("0,176" "Cyrillic,70") - (Rubout "Cyrillic,0") - ("0,217" "Cyrillic,156") - ("0,233" "357,44") - ("0,234" EMDASH) - ("0,267" "357,146"))) - -(RPAQQ MATHTOMCCS - (("0,1" "357,173") - ("0,2" "357,62") - ("0,3" "357,63") - ("0,4" Null) - ("0,5" "0,243") - ("0,6" "357,165") - (Bell "357,166") - (Backspace Null) - (Tab Null) - (Linefeed Null) - ("0,13" "0,266") - (Page Null) - (Newline Null) - ("0,16" Null) - ("0,17" "357,146") - ("0,20" Null) - ("0,21" Null) - ("0,22" Null) - ("0,23" "357,172") - ("0,24" Null) - ("0,25" Null) - ("0,26" "357,157") - ("0,27" Null) - ("0,30" Null) - ("0,31" Null) - ("0,32" Null) - (Escape Null) - ("0,34" Null) - ("0,35" Null) - ("0,36" Null) - (Tenexeol Null) - ("0,41" "357,60") - ("0,42" "357,147") - ("0,43" INFINITY) - (Dollar "0,242") - ("0,45" "0,270") - ("0,46" "357,266") - ("0,47" "357,163") - ("0,50" "0,302") - ("0,51" "357,174") - ("0,52" "0,307") - ("0,53" "0,261") - ("0,54" "357,114") - ("0,55" "357,175") - ("0,56" "41,150") - ("0,57" "357,145") - (Zero "357,147") - (One "42,42") - (Two "42,44") - (Three "41,176") - (Four "357,142") - (Five "357,143") - (Six "357,144") - (Seven "357,154") - (Eight "41,172") - (Nine "0,307") - ("0,72" "0,247") - ("0,73" Null) - ("0,74" "41,145") - ("0,75" "41,142") - ("0,76" "41,146") - ("0,77" "0,277") - ("0,100" "357,100") - ("0,101" "357,265") - ("0,102" "357,112") - ("0,103" "357,254") - ("0,104" "357,271") - ("0,105" "357,264") - ("0,106" "357,61") - ("0,107" "357,133") - ("0,110" "357,137") - ("0,111" "357,131") - ("0,112" "357,132") - ("0,113" "357,136") - ("0,114" "357,130") - ("0,115" "360,275") - ("0,116" "357,113") - ("0,117" "357,141") - ("0,120" "357,161") - ("0,121" "357,121") - ("0,122" "357,256") - ("0,123" "357,171") - ("0,124" "357,160") - ("0,125" "357,127") - ("0,126" "357,267") - ("0,127" "357,162") - ("0,130" "0,264") - ("0,131" "360,272") - ("0,132" "357,270") - ("0,133" Null) - ("0,134" Null) - ("0,135" Null) - (Uparrow "0,257") - (Leftarrow "0,256") - ("0,140" Null) - ("0,141" "357,247") - ("0,142" "357,123") - ("0,143" "0,323") - ("0,144" "357,272") - ("0,145" "357,167") - ("0,146" "357,122") - ("0,147" "357,117") - ("0,150" "357,150") - ("0,151" "357,260") - ("0,152" "357,261") - ("0,153" "357,262") - ("0,154" "357,263") - ("0,155" "357,110") - ("0,156" "357,152") - ("0,157" "357,147") - ("0,160" "357,66") - ("0,161" "357,70") - ("0,162" "0,322") - ("0,163" "357,76") - ("0,164" "357,74") - ("0,165" "357,77") - ("0,166" "357,75") - ("0,167" "357,102") - ("0,170" "357,103") - ("0,171" "357,126") - ("0,172" "357,67") - ("0,173" "0,274") - ("0,174" "0,275") - ("0,175" "0,276") - ("0,176" "357,120") - (Rubout Null) - ("0,200" Null) - ("0,201" Null) - ("0,202" Null) - ("0,203" Null) - ("0,204" Null) - ("0,205" Null) - ("0,206" Null) - ("0,207" Null) - ("0,210" Null) - ("0,211" Null) - ("0,212" Null) - ("0,213" Null) - ("0,214" Null) - ("0,215" Null) - ("0,216" Null) - ("0,217" Null) - ("0,220" Null) - ("0,221" Null) - ("0,222" Null) - ("0,223" Null) - ("0,224" Null) - ("0,225" Null) - ("0,226" Null) - ("0,227" Null) - ("0,230" Null) - ("0,231" Null) - ("0,232" Null) - ("0,233" Null) - ("0,234" Null) - ("0,235" Null) - ("0,236" Null) - ("0,237" Null) - ("0,240" Null) - ("0,241" Null) - ("0,242" Null) - ("0,243" Null) - (Currency Null) - ("0,245" Null) - ("0,246" Null) - ("0,247" Null) - ("0,250" Null) - ("0,251" Null) - (LEFT-DOUBLEQUOTE Null) - ("0,253" Null) - (Lowline Null) - (Circumflex Null) - ("0,256" Null) - ("0,257" Null) - ("0,260" Null) - ("0,261" Null) - ("0,262" Null) - ("0,263" Null) - ("0,264" Null) - ("0,265" Null) - ("0,266" Null) - ("0,267" Null) - ("0,270" Null) - ("0,271" Null) - (RIGHT-DOUBLEQUOTE Null) - ("0,273" Null) - ("0,274" Null) - ("0,275" Null) - ("0,276" Null) - ("0,277" Null) - ("0,300" Null) - ("0,301" Null) - ("0,302" Null) - ("0,303" Null) - ("0,304" Null) - ("0,305" Null) - ("0,306" Null) - ("0,307" Null) - ("0,310" Null) - ("0,311" Null) - ("0,312" Null) - ("0,313" Null) - ("0,314" Null) - ("0,315" Null) - ("0,316" Null) - ("0,317" Null) - ("0,320" Null) - ("0,321" Null) - ("0,322" Null) - ("0,323" Null) - ("0,324" Null) - ("0,325" Null) - ("0,326" Null) - ("0,327" Null) - ("0,330" Null) - ("0,331" Null) - ("0,332" Null) - ("0,333" Null) - ("0,334" Null) - ("0,335" Null) - ("0,336" Null) - ("0,337" Null) - ("0,340" Null) - ("0,341" Null) - ("0,342" Null) - ("0,343" Null) - ("0,344" Null) - ("0,345" Null) - ("0,346" Null) - ("0,347" Null) - ("0,350" Null) - ("0,351" Null) - ("0,352" Null) - ("0,353" Null) - ("0,354" Null) - ("0,355" Null) - ("0,356" Null) - ("0,357" Null) - ("0,360" Null) - ("0,361" Null) - ("0,362" Null) - ("0,363" Null) - ("0,364" Null) - ("0,365" Null) - ("0,366" Null) - ("0,367" Null) - ("0,370" Null) - ("0,371" Null) - ("0,372" Null) - ("0,373" Null) - ("0,374" Null) - ("0,375" Null) - ("0,376" Null) - ("0,377" Null))) - -(RPAQQ PALATINOTOMCCS - (("0,32" "361,353") - ("0,34" "361,260") - ("0,35" "361,277") - ("0,36" "361,304") - ("0,37" "361,153") - ("0,136" "0,255") - ("0,137" "0,254") - (NIL "0,240") - ("0,200" "361,047") - ("0,201" "361,124") - ("0,202" "361,043") - ("0,203" "361,077") - ("0,204" "361,114") - ("0,205" "361,120") - ("0,206" "361,121") - ("0,207" "361,117") - ("0,210" "361,122") - ("0,211" "361,134") - ("0,212" "361,140") - ("0,213" "361,141") - ("0,214" "361,145") - ("0,215" "361,137") - ("0,216" "361,155") - ("0,217" "361,160") - ("0,220" "361,142") - ("0,221" "361,241") - ("0,222" "361,243") - ("0,223" "361,276") - ("0,224" "361,250") - ("0,225" "361,320") - ("0,226" "361,321") - ("0,227" "361,322") - ("0,230" "361,322") - ("0,231" "361,334") - ("0,232" "361,244") - ("0,233" "361,341") - ("0,234" "361,261") - ("0,235" "361,337") - ("0,236" "361,262") - ("0,237" "361,255") - ("0,240" "361,247") - ("0,244" "0,057") - (* ; "Slash, but should be fraction") - ("0,246" "357,243") - ("0,250" "0,244") - ("0,254" "357,052") - ("0,255" "357,053") - ("0,256" "360,004") - ("0,257" "360,005") - ("0,261" EMDASH) - ("0,262" "357,060") - ("0,263" "357,061") - ("0,267" "357,146") - ("0,270" "43,262") - ("0,271" "357,050") - ("0,274" "41,104") - ("0,275" "357,101") - ("0,311" "357,153") - ("0,314" "361,314") - ("0,321" "375,261") - ("0,324" "361,324") - ("0,325" "375,362") - ("0,326" "375,363") - ("0,327" "0,274") - ("0,330" "0,275") - ("0,331" "0,264") - ("0,332" "0,270") - ("0,333" "357,152") - ("0,334" "361,265") - ("0,335" "0,261") - ("0,336" "361,042") - ("0,337" "357,044") - ("0,340" "361,340") - ("0,344" "361,041") - ("0,345" "361,345") - ("0,346" "361,050") - ("0,347" "361,044") - ("0,355" "361,355") - ("0,356" "361,055") - ("0,357" "361,061") - ("0,360" "361,360") - ("0,362" "361,062") - ("0,364" "361,065") - ("0,366" "361,060") - ("0,367" "361,277") - ("0,375" "361,100") - ("0,376" "361,104"))) -(DEFINEQ - -(MCCSCODEMAPARRAY - [LAMBDA (MAP INVERT) (* ; "Edited 5-Feb-2026 11:02 by rmk") - (* ; "Edited 2-Feb-2026 23:11 by rmk") - (* ; "Edited 6-Sep-2025 18:26 by rmk") - (* ; "Edited 31-Aug-2025 16:15 by rmk") - (* ; "Edited 7-Aug-2025 08:55 by rmk") - (* ; "Edited 2-Jun-2025 11:45 by rmk") - (* ; "Edited 1-Jun-2025 07:26 by rmk") - (* ; "Edited 24-May-2025 12:22 by rmk") - (* ; "Edited 21-Dec-2024 18:57 by rmk") - - (* ;; "Atom cases for loadup") - - (SELECTQ MAP - (XCCS (SETQ MAP (APPEND MTOXCODEMAP ALTOTEXT2MCCS))) - (MCCS (SETQ MAP ALTOTEXT2MCCS)) - NIL) - (LET ((ARRAY (ARRAY (ADD1 \MAXTHINCHAR) - 'WORD 0 0)) - HARRAY) - (for I from 0 to \MAXTHINCHAR do (SETA ARRAY I I)) (* ; "Default") - [for PAIR FROMCODE in MAP when (LISTP PAIR) unless (EQ '* (CAR PAIR)) - when (SETQ FROMCODE (OR (CHARCODEP (CAR PAIR)) - (CHARCODE.DECODE (CAR PAIR) - T))) do (SETA ARRAY FROMCODE (OR (CHARCODEP (CADR PAIR)) - (CHARCODE.DECODE - (CADR PAIR] - (CL:WHEN INVERT - (SETQ HARRAY (HASHARRAY 20)) - (for I from 0 to \MAXTHINCHAR do (PUTHASH I I HARRAY)) - (for PAIR FROMCODE in MAP when (LISTP PAIR) unless (EQ '* (CAR PAIR)) - do (PUTHASH (OR (CHARCODEP (CADR PAIR)) - (CHARCODE.DECODE (CADR PAIR))) - (OR (CHARCODEP (CAR PAIR)) - (CHARCODE.DECODE (CAR PAIR))) - HARRAY))) - (CL:IF HARRAY - (LIST ARRAY HARRAY) - ARRAY)]) -) -(DECLARE%: DOEVAL@COMPILE DONTCOPY - -(GLOBALVARS ALTOTOMCCSARRAY SYMBOLTOMCCSARRAY HIPPOTOMCCSARRAY CYRILLICTOMCCSARRAY MATHTOMCCSARRAY - SIGMATOMCCSARRAY PALATINOTOMCCSARRAY) -) - -(RPAQ? ALTOTOMCCSARRAY (MCCSCODEMAPARRAY 'MCCS)) - -(RPAQ? SYMBOLTOMCCSARRAY (MCCSCODEMAPARRAY SYMBOLTOMCCS)) - -(RPAQ? HIPPOTOMCCSARRAY (MCCSCODEMAPARRAY HIPPOTOMCCS)) - -(RPAQ? CYRILLICTOMCCSARRAY (MCCSCODEMAPARRAY CYRILLICTOMCCS)) - -(RPAQ? MATHTOMCCSARRAY (MCCSCODEMAPARRAY MATHTOMCCS)) - -(RPAQ? SIGMATOMCCSARRAY (MCCSCODEMAPARRAY SIGMATOMCCS)) - -(RPAQ? PALATINOTOMCCSARRAY (MCCSCODEMAPARRAY PALATINOTOMCCS)) -(DEFINEQ - -(MCCSMAPFN - [LAMBDA (FROMENCODING) (* ; "Edited 5-Oct-2025 19:56 by rmk") - (* ; "Edited 6-Sep-2025 12:40 by rmk") - (* ; "Edited 4-Sep-2025 08:06 by rmk") - (* ; "Edited 24-May-2025 10:55 by rmk") - - (* ;; "Returns the function that maps a FROMENCODING code to the corresponding MCCS code") - - (CL:WHEN (LISTP FROMENCODING) - - (* ;; "Assume it's a FONTSPEC") - - (SETQ FROMENCODING (fetch (FONTSPEC FSFAMILY) of FROMENCODING))) - (if (MEMB FROMENCODING NSFONTFAMILIES) - then (SETQ FROMENCODING 'XCCS$) - elseif (MEMB FROMENCODING ALTOFONTFAMILIES) - then (SETQ FROMENCODING 'ALTOTEXT)) - (SELECTQ FROMENCODING - (XCCS$ (FUNCTION X$TOMCODE)) - (ALTOTEXT (FUNCTION ATOMCODE)) - (SYMBOL (FUNCTION SYMBOLTOMCODE)) - (SIGMA (FUNCTION SIGMATOMCODE)) - (MATH (FUNCTION MATHTOMCODE)) - (HIPPO (FUNCTION HIPPOTOMCODE)) - (CYRILLIC (FUNCTION CYRILLICTOMCODE)) - (XCCS (FUNCTION XTOMCODE)) - (GACHA (FUNCTION GACHATOMCODE)) - (PALATINO (FUNCTION PALATINOTOMCODE)) - (MCCS NIL) - NIL]) - -(MCCSMAPPAIRS - [LAMBDA (FROMENCODING NONIDENTITY) (* ; "Edited 26-Feb-2026 12:56 by rmk") - (* ; "Edited 7-Oct-2025 14:47 by rmk") - (* ; "Edited 6-Oct-2025 09:47 by rmk") - (* ; "Edited 20-Sep-2025 09:45 by rmk") - (* ; "Edited 6-Sep-2025 16:43 by rmk") - (* ; "Edited 31-Aug-2025 16:16 by rmk") - - (* ;; "Returns the pairs for MOVEFONTCHARS to use to move charset-0 glyphs into their MCCS positions. For example, the Leftarrow and Lowline glyphs switch positions in an XCCS$ font. Returns NIL (= nothing to do) if there is no function.") - - (LET (PAIRS KEEPCS0) - [SETQ PAIRS (SELECTQ FROMENCODING - (GACHA (* ; "ctrl and upper are slugged") - [APPEND (XCCSUNDEFINEDPAIRS) - '(((Uparrow TERMINAL) - Circumflex) - (↑X Lowline]) - (ALTOTEXT (APPEND (XCCSUNDEFINEDPAIRS) - ALTOTEXT2MCCS)) - (XCCS$ '((Uparrow Circumflex) - (Leftarrow Lowline) - (Lowline Leftarrow) - (Circumflex Uparrow))) - (UNICODE *UNICODETOMCCS*) - (PALATINO (APPEND (XCCS.CS0.UNDEFINED) - PALATINOTOMCCS)) - (PROGN (SETQ KEEPCS0 T) - (for C M FN from 0 to \MAXTHINCHAR first (CL:UNLESS (SETQ FN - (MCCSMAPFN - FROMENCODING)) - (RETURN)) - when (SETQ M (APPLY* FN C NONIDENTITY)) - collect (LIST C M] - (CL:WHEN (LISTP PAIRS) - - (* ;; "Weed out interspersed comments, convert to charcodes") - - [SETQ PAIRS (for P in PAIRS when (LISTP P) unless (EQ '* (CAR P)) - collect (LIST (if (LISTP (CAR P)) - then - (* ;; - "Allows for the (Uparrow TERMINAL) case above, for MOVEFONTCHARS") - - (CONS (CL:IF (CHARCODEP (CAAR P)) - (CAAR P) - (CHARCODE.DECODE (CAAR P))) - (CDAR P)) - elseif (CHARCODEP (CAR P)) - then (CAR P) - else (CHARCODE.DECODE (CAR P))) - (CL:IF (CHARCODEP (CADR P)) - (CADR P) - (CHARCODE.DECODE (CADR P)))] - - (* ;; "Any character that is moved gets replaced by a slug. It may then be coerced from another font. But families like SYMBOL, HIPPO etc. want to preserve CS0 even if they copy their glyphs also to somewhere else.") - - [SETQ PAIRS (APPEND PAIRS (for P in PAIRS when (CAR P) - unless [OR (AND KEEPCS0 (ILEQ (CAR P) - \MAXTHINCHAR)) - (AND (LISTP (CAR P)) - (LITATOM (CADAR P))) - (thereis X in PAIRS - suchthat (EQ (CADR X) - (CAR P] - collect (LIST NIL (CAR P]) - PAIRS]) - -(XCCS.CS0.UNDEFINED - [LAMBDA NIL (* ; "Edited 5-Oct-2025 22:44 by rmk") - - (* ;; "Maps slugs to all undefined/reserved characters in XCCS") - - (APPEND (for I from 0 to (SUB1 (CHARCODE SPACE)) collect (LIST NIL I)) - (for I from (CHARCODE "0,#NULL") to (SUB1 (CHARCODE "0,#SPACE")) - collect (LIST NIL I)) - (for I in (CHARCODE ("0,177" "0,246" "0,250" "0,300" "0,351" "0,326" "0,327" "0,330" - "0,331" "0,332" "0,333" "0,377")) collect (LIST NIL I]) - -(XCCSUNDEFINEDPAIRS - [LAMBDA NIL (* ; "Edited 5-Oct-2025 22:39 by rmk") - (* ; "Edited 2-Sep-2025 13:14 by rmk") - (APPEND (XCCS.CS0.UNDEFINED) - (for I from 128 to \MAXTHINCHAR collect (LIST NIL I]) -) - - - -(* ;; "Mappings into MCCS: needed for hardcopy and Tedit coercion, e.g. \TEDIT.MCCS.TRANSLATE") - -(DEFINEQ - -(GACHATOMCODE - [LAMBDA (GCODE) (* ; "Edited 7-Sep-2025 22:38 by rmk") - (* ; "Edited 3-Sep-2025 23:23 by rmk") - (* ; "Edited 30-Aug-2025 21:58 by rmk") - - (* ;; "Gacha did not have a code for circumflex, so there is nothing to map") - - (CL:IF (EQ GCODE (CHARCODE ↑X)) - (CHARCODE Lowline) - GCODE)]) - -(SYMBOLTOMCODE - [LAMBDA (SCODE) (* ; "Edited 7-Sep-2025 22:39 by rmk") - (* ; "Edited 3-Sep-2025 10:21 by rmk") - (* ; "Edited 7-Aug-2025 09:37 by rmk") - (* ; "Edited 1-Jun-2025 07:02 by rmk") - (OR (CL:WHEN (ILEQ SCODE \MAXTHINCHAR) - (LET ((MCODE (ELT SYMBOLTOMCCSARRAY SCODE))) - (CL:UNLESS (EQ MCODE SCODE) - MCODE))) - SCODE]) - -(SIGMATOMCODE - [LAMBDA (SCODE) (* ; "Edited 7-Sep-2025 22:39 by rmk") - (* ; "Edited 3-Sep-2025 10:21 by rmk") - (* ; "Edited 1-Jun-2025 07:02 by rmk") - (* ; "Edited 24-May-2025 10:54 by rmk") - (OR (CL:WHEN (ILEQ SCODE \MAXTHINCHAR) - (LET ((MCODE (ELT SIGMATOMCCSARRAY SCODE))) - (CL:UNLESS (EQ MCODE SCODE) - MCODE))) - SCODE]) - -(ATOMCODE - [LAMBDA (ACODE) (* ; "Edited 7-Sep-2025 22:39 by rmk") - (* ; "Edited 3-Sep-2025 10:21 by rmk") - (* ; "Edited 24-May-2025 09:41 by rmk") - (OR (CL:WHEN (ILEQ ACODE \MAXTHINCHAR) - (LET ((MCODE (ELT ALTOTOMCCSARRAY ACODE))) - (CL:UNLESS (EQ MCODE ACODE) - MCODE))) - ACODE]) - -(MATHTOMCODE - [LAMBDA (MATHCODE) (* ; "Edited 7-Sep-2025 22:39 by rmk") - (* ; "Edited 4-Sep-2025 08:18 by rmk") - (* ; "Edited 1-Jun-2025 07:02 by rmk") - (* ; "Edited 24-May-2025 10:58 by rmk") - (OR (CL:WHEN (ILEQ MATHCODE \MAXTHINCHAR) - (LET ((MCODE (ELT MATHTOMCCSARRAY MATHCODE))) - (CL:UNLESS (EQ MCODE MATHCODE) - MCODE))) - MATHCODE]) - -(HIPPOTOMCODE - [LAMBDA (HCODE) (* ; "Edited 7-Sep-2025 22:40 by rmk") - (* ; "Edited 3-Sep-2025 10:22 by rmk") - (* ; "Edited 24-May-2025 09:40 by rmk") - (OR (CL:WHEN (ILEQ HCODE \MAXTHINCHAR) - (LET ((MCODE (ELT HIPPOTOMCCSARRAY HCODE))) - (CL:UNLESS (EQ MCODE HCODE) - MCODE))) - HCODE]) - -(CYRILLICTOMCODE - [LAMBDA (CCODE) (* ; "Edited 7-Sep-2025 22:40 by rmk") - (* ; "Edited 24-May-2025 09:38 by rmk") - (OR (CL:WHEN (ILEQ CCODE \MAXTHINCHAR) - (LET ((MCODE (ELT CYRILLICTOMCCSARRAY CCODE))) - (CL:UNLESS (EQ MCODE CCODE) - MCODE))) - CCODE]) - -(PALATINOTOMCODE - [LAMBDA (PCODE) (* ; "Edited 5-Oct-2025 20:08 by rmk") - (* ; "Edited 7-Sep-2025 22:39 by rmk") - (* ; "Edited 3-Sep-2025 10:21 by rmk") - (* ; "Edited 7-Aug-2025 09:37 by rmk") - (* ; "Edited 1-Jun-2025 07:02 by rmk") - (OR (CL:WHEN (ILEQ PCODE \MAXTHINCHAR) - (LET ((MCODE (ELT PALATINOTOMCCSARRAY PCODE))) - (CL:UNLESS (EQ MCODE PCODE) - MCODE))) - PCODE]) -) -(DEFINEQ - -(SYSTEM-EXTERNALFORMAT - [LAMBDA NIL (* ; "Edited 6-Feb-2026 11:29 by rmk") - (* ; "Edited 31-Jan-2026 18:51 by rmk") - (* ; "Edited 10-Oct-2022 11:55 by lmm") - (* ; "Edited 7-Jul-2022 10:41 by rmk") - - (* ;; "Returns the name, sets the global. For now, UTF-8 or through, could be something else.") - - (fetch (EXTERNALFORMAT NAME) of (SETQ *SYSTEM-EXTERNALFORMAT* - (FIND-FORMAT (FOR X IN '("LC_CTYPE" "LC_ALL" "LANG") - WHEN (STRPOS ".UTF-8" (UNIX-GETENV X)) - DO (RETURN :UTF-8) FINALLY (RETURN :THROUGH]) - -(MTOSYSSTRING - [LAMBDA (MSTRING) (* ; "Edited 6-Feb-2026 00:20 by rmk") - (MCCSTOFORMATBYTES *SYSTEM-EXTERNALFORMAT* (MKSTRING MSTRING]) - -(SYSTOMSTRING - [LAMBDA (SYSTRING) (* ; "Edited 5-Feb-2026 23:36 by rmk") - - (* ;; "SYSSTRING is presumably shared with Unix, guarantee a copy on the way out") - - (CONCAT (FORMATBYTESTOMCCS *SYSTEM-EXTERNALFORMAT* SYSTRING]) -) -(* "FOLLOWING DEFINITIONS EXPORTED")(DECLARE%: DOEVAL@COMPILE DONTCOPY - -(GLOBALVARS *SYSTEM-EXTERNALFORMAT*) -) - -(* "END EXPORTED DEFINITIONS") - - -(RPAQ? *SYSTEM-EXTERNALFORMAT* :UTF-8) (DECLARE%: DONTCOPY - (FILEMAP (NIL (3103 14674 (\MCCSINCCODE 3113 . 6201) (\MCCSPEEKCCODE 6203 . 9090) (\MCCSOUTCHAR 9092 - . 11191) (\MCCSBACKCCODE 11193 . 12737) (\MCCSFORMATBYTESTREAM 12739 . 13469) (\MCCSCHARSETFN 13471 - . 14672)) (14675 17126 (\CREATE.MCCS.EXTERNALFORMAT 14685 . 15555) (\CREATE.XCCS.EXTERNALFORMAT 15557 - . 17124)) (17127 18104 (\MCCS.24BITENCODING.ERROR 17137 . 18102)) (19480 22122 (MTOXCODE 19490 . -20287) (XTOMCODE 20289 . 20946) (XTOMSTRING 20948 . 21535) (MTOXSTRING 21537 . 22120)) (22123 23783 ( -MTOX$CODE 22133 . 22865) (X$TOMCODE 22867 . 23781)) (23784 24424 (KANJICHARSETP 23794 . 24050) ( -CHINESECHARSETP 24052 . 24422)) (45004 47493 (MCCSCODEMAPARRAY 45014 . 47491)) (48109 55125 (MCCSMAPFN - 48119 . 49486) (MCCSMAPPAIRS 49488 . 54131) (XCCS.CS0.UNDEFINED 54133 . 54762) (XCCSUNDEFINEDPAIRS -54764 . 55123)) (55230 59984 (GACHATOMCODE 55240 . 55754) (SYMBOLTOMCODE 55756 . 56404) (SIGMATOMCODE -56406 . 57052) (ATOMCODE 57054 . 57586) (MATHTOMCODE 57588 . 58244) (HIPPOTOMCODE 58246 . 58783) ( -CYRILLICTOMCODE 58785 . 59219) (PALATINOTOMCODE 59221 . 59982)) (59985 61423 (SYSTEM-EXTERNALFORMAT -59995 . 60939) (MTOSYSSTRING 60941 . 61134) (SYSTOMSTRING 61136 . 61421))))) + (FILEMAP (NIL (1608 13179 (\MCCSINCCODE 1618 . 4706) (\MCCSPEEKCCODE 4708 . 7595) (\MCCSOUTCHAR 7597 + . 9696) (\MCCSBACKCCODE 9698 . 11242) (\MCCSFORMATBYTESTREAM 11244 . 11974) (\MCCSCHARSETFN 11976 . +13177)) (13180 15631 (\CREATE.MCCS.EXTERNALFORMAT 13190 . 14060) (\CREATE.XCCS.EXTERNALFORMAT 14062 . +15629)) (15632 16609 (\MCCS.24BITENCODING.ERROR 15642 . 16607)) (17985 20627 (MTOXCODE 17995 . 18792) +(XTOMCODE 18794 . 19451) (XTOMSTRING 19453 . 20040) (MTOXSTRING 20042 . 20625)) (20628 22288 ( +MTOX$CODE 20638 . 21370) (X$TOMCODE 21372 . 22286)) (22289 23317 (KANJICHARSETP 22299 . 22869) ( +UNIHANCHARSETP 22871 . 23315))))) STOP diff --git a/sources/MCCS.LCOM b/sources/MCCS.LCOM index 4b2d7afd7..fd682274a 100644 Binary files a/sources/MCCS.LCOM and b/sources/MCCS.LCOM differ diff --git a/sources/MCCSFONTS b/sources/MCCSFONTS new file mode 100644 index 000000000..c95fe4afb --- /dev/null +++ b/sources/MCCSFONTS @@ -0,0 +1,1280 @@ +(DEFINE-FILE-INFO :PACKAGE "INTERLISP" :READTABLE "INTERLISP" :BASE 10 :FORMAT :UTF-8) + +(FILECREATED "17-Apr-2026 08:58:07" {MEDLEY}MCCSFONTS.;145 51826 + + :EDIT-BY rmk + + :CHANGES-TO (VARS MATHTOMCCS SYMBOLTOMCCS SIGMATOMCCS) + (FNS MCCSMAPPAIRS) + + :PREVIOUS-DATE "15-Apr-2026 22:12:41" {WMEDLEY}MCCSFONTS.;134) + + +(PRETTYCOMPRINT MCCSFONTSCOMS) + +(RPAQQ MCCSFONTSCOMS + [(VARS NSFONTFAMILIES ALTOFONTFAMILIES) + (INITVARS MCCSFONTFAMILIES) + (FNS DISPLAYENCODINGFN) + (COMS (* ; " Mapping to MCCS") + (FNS MCCSCODEMAPARRAY MCCSMAPFN MCCSMAPPAIRS XCCS.CS0.UNDEFINED XCCSUNDEFINEDPAIRS) + (VARS ALTOTEXTTOMCCS SYMBOLTOMCCS SIGMATOMCCS HIPPOTOMCCS CYRILLICTOMCCS MATHTOMCCS + PALATINOTOMCCS TITANTOMCCS TITANLEGALTOMCCS) + (GLOBALVARS GACHATOMCCSARRAY ALTOTOMCCSARRAY SYMBOLTOMCCSARRAY HIPPOTOMCCSARRAY + CYRILLICTOMCCSARRAY MATHTOMCCSARRAY SIGMATOMCCSARRAY PALATINOTOMCCSARRAY + TITANTOMCCSARRAY TITANLEGALTOMCCSARRAY) + + (* ;; "For translation of codes in datastructures (e.g. Tedit)") + + [INITVARS [GACHATOMCCSARRAY (MCCSCODEMAPARRAY (XCCSUNDEFINEDPAIRS '((Lowline ↑X] + (ALTOTOMCCSARRAY (MCCSCODEMAPARRAY ALTOTEXTTOMCCS)) + (SYMBOLTOMCCSARRAY (MCCSCODEMAPARRAY SYMBOLTOMCCS)) + (HIPPOTOMCCSARRAY (MCCSCODEMAPARRAY HIPPOTOMCCS)) + (CYRILLICTOMCCSARRAY (MCCSCODEMAPARRAY CYRILLICTOMCCS)) + (MATHTOMCCSARRAY (MCCSCODEMAPARRAY MATHTOMCCS)) + (SIGMATOMCCSARRAY (MCCSCODEMAPARRAY SIGMATOMCCS)) + (PALATINOTOMCCSARRAY (MCCSCODEMAPARRAY PALATINOTOMCCS)) + (TITANTOMCCSARRAY (MCCSCODEMAPARRAY (XCCSUNDEFINEDPAIRS TITANTOMCCS))) + (TITANLEGALTOMCCSARRAY (MCCSCODEMAPARRAY (XCCSUNDEFINEDPAIRS TITANLEGALTOMCCS] + (COMS + (* ;; + "Mappings into MCCS: needed for e.g. Tedit coercion. \TEDIT.MCCS.TRANSLATE") + + (FNS GACHATOMCODE SYMBOLTOMCODE SIGMATOMCODE ATOMCODE MATHTOMCODE HIPPOTOMCODE + CYRILLICTOMCODE PALATINOTOMCODE TITANTOMCODE TITANLEGALTOMCODE)) + [INITVARS [DISPLAYFONTCOERCIONS '(((HELVETICA (<= * 2)) + (HELVETICA 4)) + ((MODERN (<= 15 * 16)) + (* 14)) + ((MODERN (<= 17 * 21)) + (* 18)) + ((MODERN (<= 22 * 28)) + (* 24)) + ((MODERN (<= 29 * 33)) + (* 30)) + ((MODERN (<= 34 * 40)) + (* 36)) + ((MODERN (<= 41 * 65)) + (* 48)) + ((MODERN (<= 66 *)) + (* 72)) + ((PALATINO 9) + (PALATINO 12)) + ((PALATINO (<= * 8)) + (PALATINO 10)) + ((TITAN (<= * 9) + BOLD) + (MODERN 10)) + ((TITAN (<= * 9) + ITALIC) + (MODERN 10)) + ((TITAN (<= * 9)) + (TITAN 10)) + (LPT AMTEX] + (DISPLAYCHARCOERCIONS '((GACHA TERMINAL) + (MODERN CLASSIC) + (TIMESROMAN CLASSIC) + (HELVETICA MODERN) + (TERMINAL MODERN) + (HIPPO CLASSIC) + (CYRILLIC CLASSIC) + (MATH CLASSIC) + (SIGMA MODERN) + (SYMBOL MODERN) + (TITAN CLASSIC) + (PALATINO CLASSIC) + (OPTIMA MODERN) + (BOLDPS CLASSIC) + (PCTERMINAL CLASSIC) + (TITANLEGAL CLASSIC] + + (* ;; "Defunct coercions? Mapping for DOS filenames, Adobe equivalences") + + (COMS (INITVARS [ADOBEDISPLAYFONTCOERCIONS '(((HELVETICABLACK 16) + (HELVETICABLACK 18)) + ((SYMBOL) + (ADOBESYMBOL)) + ((SYMBOL 11) + (ADOBESYMBOL 10)) + ((AVANTGARDE-DEMI) + (AVANTGARDE)) + ((AVANTGARDE-BOOK) + (AVANTGARDE)) + ((NEWCENTURYSCHLBK) + (CENTURYSCHOOLBOOK)) + ((BOOKMAN-LIGHT) + (BOOKMAN)) + ((BOOKMAN-DEMI) + (BOOKMAN)) + ((HELVETICA-NARROW) + (HELVETICANARROW)) + ((HELVETICA 24) + (ADOBEHELVETICA 24] + (*DISPLAY-FONT-NAME-MAP* '((TIMESROMAN . TR) + (HELVETICA . HV) + (TIMESROMAND . TD) + (HELVETICAD . HD) + (MODERN . MD) + (CLASSIC . CL) + (GACHA . GC) + (TITAN . TI) + (LETTERGOTHIC . LG) + (BOLDPS . BP) + (TERMINAL . TM) + (CLASSICTHIN . CT) + (HIPPO . HP) + (LOGO . LG) + (MATH . MA) + (OLDENGLISH . OE) + (SYMBOL . SY]) + +(RPAQQ NSFONTFAMILIES (CLASSIC CLASSICTHIN MODERN TERMINAL OPTIMA BOLDPS PCTERMINAL)) + +(RPAQQ ALTOFONTFAMILIES (TIMESROMAN TIMESROMAND HELVETICA HELVETICAD CLARITY BRAVOX TONTO CREAM + OLDENGLISH)) + +(RPAQ? MCCSFONTFAMILIES NIL) +(DEFINEQ + +(DISPLAYENCODINGFN + [LAMBDA (FONTSPEC) (* ; "Edited 8-Mar-2026 22:46 by rmk") + (LET ((FAMILY (fetch (FONTSPEC FSFAMILY) of FONTSPEC))) + (if (MEMB FAMILY MCCSFONTFAMILIES) + then 'MCCS + elseif (MEMB FAMILY NSFONTFAMILIES) + then 'XCCS$ + elseif (MEMB FAMILY ALTOFONTFAMILIES) + then 'ALTOTEXT + elseif (EQ FAMILY 'TITAN) + then + (* ;; "The other sizes seem to have already been converted") + + (CL:IF (EQ 14 (fetch (FONTSPEC FSSIZE) of FONTSPEC)) + 'TITAN + 'XCCS$) + else FAMILY]) +) + + + +(* ; " Mapping to MCCS") + +(DEFINEQ + +(MCCSCODEMAPARRAY + [LAMBDA (MAP INVERT) (* ; "Edited 8-Mar-2026 00:42 by rmk") + (* ; "Edited 5-Feb-2026 11:02 by rmk") + (* ; "Edited 2-Feb-2026 23:11 by rmk") + (* ; "Edited 6-Sep-2025 18:26 by rmk") + (* ; "Edited 31-Aug-2025 16:15 by rmk") + (* ; "Edited 7-Aug-2025 08:55 by rmk") + (* ; "Edited 2-Jun-2025 11:45 by rmk") + (* ; "Edited 1-Jun-2025 07:26 by rmk") + (* ; "Edited 24-May-2025 12:22 by rmk") + (* ; "Edited 21-Dec-2024 18:57 by rmk") + + (* ;; "MAP is a list of (destcode source) pairs where source is a code, a (code font) pair, NIL, or (NIL), where the NIL sources designate a slug.") + + (* ;; "If INVERT, this produces a hash table for font-recoding by MOVEFONTCHARS where each key is a destcode the corresponding value is its source. The NIL source is represented as (NIL) in the hash table (as if it is (NIL font)), because putting NIL as a hash value takes it out of the MAPHASH. The INVERT hashtable presumably is used only offline and only once per font, when it is recoded to MCCS.") + + (* ;; "If not INVERT, this produces an array indexed by source codes that maps CS0 sources to their dest codes. This is used for translating old font-dependent codes in data structures (like Tedit) into the MCCS codes at the same time that the font is also changed to an MCCS font. This is used online but presumably only once per document/datastructure, if the result of the code translation is remembered.") + + (* ;; "The restriction to CS0 is because only XCCS fonts have characters outside that, and that's where MCCS agrees with XCCS. Other legacy fonts (HIPPO, SYMBOL...) only have CS0 glyphs. If a CS0 source code does not exist in the mapping, it is assumed to be an identity. ") + + (* ;; "") + + (SETQ MAP (for PAIR SOURCE DEST in MAP when (AND (LISTP PAIR) + (NEQ '* (CAR PAIR))) + collect (SETQ DEST (CAR PAIR)) + (CL:UNLESS (CHARCODEP DEST) (* ; "DEST always designates a code") + (SETQ DEST (CHARCODE.DECODE DEST))) + (SETQ SOURCE (CADR PAIR)) + + (* ;; "NIL source is a slug") + + (if (NULL SOURCE) + then (SETQ SOURCE (CONS NIL)) + elseif (LISTP SOURCE) + then (CL:UNLESS (OR (CHARCODEP (CAR SOURCE)) + (NULL (CAR SOURCE))) + (SETQ SOURCE (LIST (CHARCODE.DECODE (CAR SOURCE)) + (CADR SOURCE)))) + elseif (CHARCODEP SOURCE) + else (SETQ SOURCE (CHARCODE.DECODE SOURCE))) + (LIST DEST SOURCE))) (* ; "Add identities for CS 0") + (for DEST from 0 to \MAXTHINCHAR unless (ASSOC DEST MAP) do (PUSH MAP (LIST DEST DEST))) + (SORT MAP T) (* ; "Just easier to debug") + (LET (VAL) + [if INVERT + then + (* ;; "KEY's are destination codes, good for maphash recoding") + + (SETQ VAL (HASHARRAY (LENGTH MAP))) + (for PAIR in MAP do (PUTHASH (CAR PAIR) + (CADR PAIR) + VAL)) + else (SETQ VAL (ARRAY (ADD1 \MAXTHINCHAR) + NIL NIL 0 0)) + (for PAIR SOURCE in MAP eachtime [SETQ SOURCE (CAR (MKLIST (CADR PAIR] + (* ; "Value for NIL sources is NIL") + when (CHARCODEP SOURCE) do (SETA VAL SOURCE (CAR PAIR] + VAL]) + +(MCCSMAPFN + [LAMBDA (FROMENCODING) (* ; "Edited 5-Oct-2025 19:56 by rmk") + (* ; "Edited 6-Sep-2025 12:40 by rmk") + (* ; "Edited 4-Sep-2025 08:06 by rmk") + (* ; "Edited 24-May-2025 10:55 by rmk") + + (* ;; "Returns the function that maps a FROMENCODING code to the corresponding MCCS code") + + (CL:WHEN (LISTP FROMENCODING) + + (* ;; "Assume it's a FONTSPEC") + + (SETQ FROMENCODING (fetch (FONTSPEC FSFAMILY) of FROMENCODING))) + (if (MEMB FROMENCODING NSFONTFAMILIES) + then (SETQ FROMENCODING 'XCCS$) + elseif (MEMB FROMENCODING ALTOFONTFAMILIES) + then (SETQ FROMENCODING 'ALTOTEXT)) + (SELECTQ FROMENCODING + (XCCS$ (FUNCTION X$TOMCODE)) + (ALTOTEXT (FUNCTION ATOMCODE)) + (SYMBOL (FUNCTION SYMBOLTOMCODE)) + (SIGMA (FUNCTION SIGMATOMCODE)) + (MATH (FUNCTION MATHTOMCODE)) + (HIPPO (FUNCTION HIPPOTOMCODE)) + (CYRILLIC (FUNCTION CYRILLICTOMCODE)) + (XCCS (FUNCTION XTOMCODE)) + (GACHA (FUNCTION GACHATOMCODE)) + (PALATINO (FUNCTION PALATINOTOMCODE)) + (MCCS NIL) + NIL]) + +(MCCSMAPPAIRS + [LAMBDA (FROMENCODING NOIDENTITY) (* ; "Edited 17-Apr-2026 00:02 by rmk") + (* ; "Edited 14-Apr-2026 00:35 by rmk") + (* ; "Edited 11-Apr-2026 23:44 by rmk") + (* ; "Edited 8-Mar-2026 23:43 by rmk") + (* ; "Edited 3-Mar-2026 23:19 by rmk") + (* ; "Edited 26-Feb-2026 12:56 by rmk") + (* ; "Edited 7-Oct-2025 14:47 by rmk") + (* ; "Edited 6-Oct-2025 09:47 by rmk") + (* ; "Edited 20-Sep-2025 09:45 by rmk") + (* ; "Edited 6-Sep-2025 16:43 by rmk") + (* ; "Edited 31-Aug-2025 16:16 by rmk") + + (* ;; "Returns the pairs for MOVEFONTCHARS to use to move charset-0 glyphs into their MCCS positions. For example, the Leftarrow and Lowline glyphs switch positions in an XCCS$ font. Returns NIL (= nothing to do) if there is no function.") + + (LET (PAIRS KEEPCS0) + [SETQ PAIRS (SELECTQ FROMENCODING + (GACHA [XCCSUNDEFINEDPAIRS '((Lowline ↑X]) + (ALTOTEXT (* ; "Wipe the metas") + (XCCSUNDEFINEDPAIRS ALTOTEXTTOMCCS)) + (TITAN (XCCSUNDEFINEDPAIRS TITANTOMCCS)) + (TITANLEGAL (XCCSUNDEFINEDPAIRS TITANLEGALTOMCCS)) + (XCCS$ (* ; "Leave the Metas") + [XCCS.CS0.UNDEFINED '((Circumflex Uparrow) + (Uparrow Circumflex) + (Lowline Leftarrow) + (Leftarrow Lowline]) + (UNICODE *MCCSTOUNICODE*) + (PALATINO (XCCSUNDEFINEDPAIRS PALATINOTOMCCS)) + (PROGN (if (MEMB FROMENCODING '(HIPPO CYRILLIC SYMBOL SIGMA MATH)) + then (SETQ NOIDENTITY T) + (SETQ KEEPCS0 NIL) + else (SETQ KEEPCS0 T)) + (for C M FN from 0 to \MAXTHINCHAR first (CL:UNLESS (SETQ FN + (MCCSMAPFN + FROMENCODING)) + (RETURN)) + when (SETQ M (APPLY* FN C NOIDENTITY)) + collect (LIST M C] + (CL:WHEN (LISTP PAIRS) + + (* ;; "Weed out interspersed comments, convert to charcodes") + + (CL:UNLESS NOIDENTITY + (for DEST from 0 to \MAXTHINCHAR unless (ASSOC DEST PAIRS) + do (push PAIRS (LIST DEST DEST)))) + [SETQ PAIRS (for P SOURCE in PAIRS when (LISTP P) unless (EQ '* (CAR P)) + collect (SETQ SOURCE (CADR P)) + (LIST (OR (CHARCODEP (CAR P)) + (CHARCODE.DECODE (CAR P))) + (if (LISTP SOURCE) + then + (* ;; + "Allows for the (Uparrow TERMINAL) case above, for MOVEFONTCHARS") + + (CONS (CL:IF (CHARCODEP (CAR SOURCE)) + (CAR SOURCE) + (CHARCODE.DECODE (CAR SOURCE))) + (CDR SOURCE)) + elseif (CHARCODEP SOURCE) + else (CHARCODE.DECODE SOURCE] + + (* ;; "If a source is moved to a dest, the default is that that source gets replaced by a slug and there is no separate replacement for that source. That slug may then be coerced from another font. That is, we don't expect two codes to have the same glyph, by default. But families like SYMBOL, HIPPO etc. want to preserve CS0 even if they copy their glyphs also to somewhere else--KEEPCS0.") + + (CL:UNLESS KEEPCS0 + (SETQ PAIRS (APPEND (for C from 0 to \MAXTHINCHAR + when [thereis P SCODE in PAIRS + eachtime [SETQ SCODE (CAR (MKLIST (CADR P] + suchthat + + (* ;; + "C's glyph is moving somewhere else, and nothing is replacing it. Slug it out.") + + (AND (EQ SCODE C) + (NEQ SCODE (CAR P)) + (NOT (ASSOC C PAIRS] + collect (LIST C (CONS NIL))) + PAIRS)) + (SETQ PAIRS (SORT PAIRS T))) + [AND NIL (SETQ PAIRS (APPEND PAIRS (for P DEST SOURCE SCODE in PAIRS + eachtime (SETQ DEST (CAR P)) + (SETQ SOURCE (CADR P)) + (SETQ SCODE (CAR (MKLIST SOURCE))) + (* ; "Already a slug?") when SCODE + unless (OR (AND KEEPCS0 (ILEQ SCODE \MAXTHINCHAR)) + (AND (LISTP SOURCE) + (LITATOM (CADR SOURCE))) + (ASSOC SCODE PAIRS)) + collect + + (* ;; "Don't slugify a source code in this font if it is coming from another font, or if that source is also a destination here.") + + (LIST SCODE (CONS NIL]) + PAIRS]) + +(XCCS.CS0.UNDEFINED + [LAMBDA (ADDITIONS) (* ; "Edited 8-Mar-2026 23:32 by rmk") + (* ; "Edited 5-Oct-2025 22:44 by rmk") + + (* ;; "Maps slugs to all undefined/reserved characters in XCCS, then throw in the additions") + + [SETQ ADDITIONS (for P in ADDITIONS when (LISTP P) unless (EQ '* (CAR P)) + collect (LIST (OR (CHARCODEP (CAR P)) + (CHARCODE.DECODE (CAR P))) + (OR (CHARCODEP (CADR P)) + (CHARCODE.DECODE (CADR P] + (APPEND ADDITIONS (for I from 0 to (SUB1 (CHARCODE SPACE)) collect (LIST I NIL)) + (for I from (CHARCODE "0,#NULL") to (SUB1 (CHARCODE "0,#SPACE")) + collect (LIST I NIL)) + (for I in (CHARCODE ("0,177" "0,246" "0,250" "0,300" "0,351" "0,326" "0,327" "0,330" + "0,331" "0,332" "0,333" "0,377")) collect (LIST I NIL]) + +(XCCSUNDEFINEDPAIRS + [LAMBDA (ADDITIONS) (* ; "Edited 8-Mar-2026 23:42 by rmk") + (* ; "Edited 6-Mar-2026 23:57 by rmk") + (* ; "Edited 5-Oct-2025 22:39 by rmk") + (* ; "Edited 2-Sep-2025 13:14 by rmk") + + (* ;; "This clears out everything above Ascii in charset 0, allowing ony ADDITIONS. XCCS.CS0.UNDEFINED clears out only the truly undefined") + + (LET ((PAIRS (XCCS.CS0.UNDEFINED ADDITIONS))) + (for I from 128 to \MAXTHINCHAR unless (ASSOC I PAIRS) do (push PAIRS (LIST I NIL))) + PAIRS]) +) + +(RPAQQ ALTOTEXTTOMCCS + ( + (* ;; "From bravo doc") + + ("356,055" ↑N MINUS) + ("357,44" ↑V ENDASH) + (EMDASH ↑S) + (EMQUAD ↑O) + ("356,055" ↑X MINUS) + (FIGURESPACE ↑Y ENQUAD) + + (* ;; "Fom current Helvetica/Timesroman fonts") + + ("0,317" "0,1" HACHEK) + ("361,255" "0,3" DIARESIS) + ("0,310" "0,4" CCEDILLA) + ("0,301" "0,5" GRAVE) + ("360,41" "0,6" ff) + ("0,271" "0,7" LSQ) + ("0,241" "0,10" SPANISHEXCL) + ("0,302" "0,13" ACUTE) + ("0,304" "0,20" TILDE) + ("360,42" "0,21" ffi) + ("360,43" "0,22" ffl) + ("360,44" "0,24" fi) + ("360,45" "0,25" fl) + ("357,44" "0,26" ENDASH) + ("0,306" "0,27" BREVE) + (ENQUAD "0,34") + ("0,304" "0,36" TILDE) + ("0,251" "0,140") + ("361,47" "0,200" A-umlaut) + ("361,124" "0,201" O-umlaut) + ("361,47" "0,202" A-ring) + ("357,44" "0,233" ENDASH) + (EMDASH "0,234") + ("361,247" "0,240" a-umlaut) + ("361,324" "0,241" o-umlaut) + ("361,250" "0,242" a-ring) + ("361,345" "0,243" u-umlaut) + (Circumflex "0,254") + ("0,242" "0,260" CENTS) + ("0,243" "0,261" POUND) + ("41,172" "0,265" STAR) + ("0,247" "0,266" SECTION) + ("357,146" "0,267" BULLET) + ("357,60" "0,270" DAGGER) + ("357,061" "0,271" DOUBLEDAGGER) + ("0,266" "0,272" PARAGRAPH) + ("0,261" "0,274" PLUSMINUS) + ("0,241" "0,275" SPANISHEXCL) + ("0,277" "0,276" SPANISHQUES) + (Lowline "0,277"))) + +(RPAQQ SYMBOLTOMCCS + (("42,46" "0,162") + ("41,145" "0,26") + ("41,146" "0,27") + ("42,120" "0,55") + ("42,121" "0,56") + ("0,74" "0,36") + ("0,76" "0,37") + (Null "0,1") + ("0,264" "0,2") + ("41,142" "0,3") + (Null "0,4") + ("41,176" "0,5") + ("0,261" "0,6") + ("357,175" Bell) + ("357,142" Backspace) + ("357,143" Tab) + ("357,144" Linefeed) + ("357,145" "0,13") + (Null Page) + ("0,270" Newline) + (Null "0,16") + (Null "0,17") + ("357,160" "0,20") + ("357,162" "0,21") + ("357,131" "0,22") + ("357,130" "0,23") + ("41,145" "0,24") + ("41,146" "0,25") + (Null "0,26") + (Null "0,27") + ("356,176" "0,30") + ("357,171" "0,31") + ("357,133" "0,32") + ("357,132" Escape) + ("41,142" "0,34") + ("357,163" "0,35") + (Null "0,36") + (Null Tenexeol) + (Null Space) + ("0,256" "0,41") + (Circumflex "0,42") + ("0,257" "0,43") + ("357,122" Dollar) + ("357,102" "0,45") + ("357,103" "0,46") + ("357,167" "0,47") + ("357,115" "0,50") + ("357,117" "0,51") + (Null "0,52") + (Null "0,53") + ("357,116" "0,54") + (Null "0,55") + (Null "0,56") + (Null "0,57") + (Null Zero) + (INFINITY One) + ("357,112" Two) + ("357,113" Three) + ("357,141" Four) + (Null Five) + ("357,154" Six) + (Lowline Seven) + ("357,265" Eight) + ("357,264" Nine) + ("357,152" "0,72") + ("357,247" "0,73") + (Null "0,74") + (Null "0,75") + (Null "0,76") + ("0,57" "0,77") + (Null "0,100") + ("357,127" "0,133") + ("357,126" "0,134") + (Null "0,135") + ("357,266" Uparrow) + ("357,267" Leftarrow) + ("357,66" "0,140") + ("357,67" "0,141") + ("357,262" "0,142") + ("357,263" "0,143") + ("357,260" "0,144") + ("357,261" "0,145") + ("0,173" "0,146") + ("0,175" "0,147") + ("357,62" "0,150") + ("357,63" "0,151") + ("356,174" "0,152") + ("41,102" "0,153") + ("357,73" "0,154") + ("357,72" "0,155") + ("42,44" "0,156") + ("42,46" "0,157") + ("357,174" "0,160") + ("41,142" "0,161") + (Null "0,162") + ("357,165" "0,163") + (Null "0,164") + (Null "0,165") + (Null "0,166") + (Null "0,167") + ("0,247" "0,170") + ("357,60" "0,171") + ("357,61" "0,172") + ("0,266" "0,173") + ("0,100" "0,174") + ("0,323" "0,175") + ("0,243" "0,176") + (Dollar Rubout) + (Null "0,200") + (Null "0,201") + (Null "0,202") + (Null "0,203") + (Null "0,204") + (Null "0,205") + (Null "0,206") + (Null "0,207") + (Null "0,210") + (Null "0,211") + (Null "0,212") + (Null "0,213") + (Null "0,214") + (Null "0,215") + (Null "0,216") + (Null "0,217") + (Null "0,220") + (Null "0,221") + (Null "0,222") + (Null "0,223") + (Null "0,224") + (Null "0,225") + (Null "0,226") + (Null "0,227") + (Null "0,230") + (Null "0,231") + (Null "0,232") + (Null "0,233") + (Null "0,234") + (Null "0,235") + (Null "0,236") + (Null "0,237") + (Null "0,240") + (Null "0,241") + (Null "0,242") + (Null "0,243") + (Null Currency) + (Null "0,245") + (Null "0,246") + (Null "0,247") + (Null "0,250") + (Null "0,251") + (Null LEFT-DOUBLEQUOTE) + (Null "0,253") + (Null Lowline) + (Null Circumflex) + (Null "0,256") + (Null "0,257") + (Null "0,260") + (Null "0,261") + (Null "0,262") + (Null "0,263") + (Null "0,264") + (Null "0,265") + (Null "0,266") + (Null "0,267") + (Null "0,270") + (Null "0,271") + (Null RIGHT-DOUBLEQUOTE) + (Null "0,273") + (Null "0,274") + (Null "0,275") + (Null "0,276") + (Null "0,277") + (Null "0,300") + (Null "0,301") + (Null "0,302") + (Null "0,303") + (Null "0,304") + (Null "0,305") + (Null "0,306") + (Null "0,307") + (Null "0,310") + (Null "0,311") + (Null "0,312") + (Null "0,313") + (Null "0,314") + (Null "0,315") + (Null "0,316") + (Null "0,317") + (Null "0,320") + (Null "0,321") + (Null "0,322") + (Null "0,323") + (Null "0,324") + (Null "0,325") + (Null "0,326") + (Null "0,327") + (Null "0,330") + (Null "0,331") + (Null "0,332") + (Null "0,333") + (Null "0,334") + (Null "0,335") + (Null "0,336") + (Null "0,337") + (Null "0,340") + (Null "0,341") + (Null "0,342") + (Null "0,343") + (Null "0,344") + (Null "0,345") + (Null "0,346") + (Null "0,347") + (Null "0,350") + (Null "0,351") + (Null "0,352") + (Null "0,353") + (Null "0,354") + (Null "0,355") + (Null "0,356") + (Null "0,357") + (Null "0,360") + (Null "0,361") + (Null "0,362") + (Null "0,363") + (Null "0,364") + (Null "0,365") + (Null "0,366") + (Null "0,367") + (Null "0,370") + (Null "0,371") + (Null "0,372") + (Null "0,373") + (Null "0,374") + (Null "0,375") + (Null "0,376") + (Null "0,377"))) + +(RPAQQ SIGMATOMCCS + (("0,101" "0,101" low squaredot not in XCCS) + (Contourintegral "0,103") + (Intersection "0,111") + (And "0,114") + (Summation "0,115") + (Product "0,120") + (Radical "0,122") + (Integral "0,123") + (Union "0,125") + (Or "0,126"))) + +(RPAQQ HIPPOTOMCCS + (("356,55" "0,16") + (EMQUAD "0,17") + (EMDASH "0,23") + ("357,44" "0,26") + ("356,55" "0,30") + (ENQUAD "0,31") + ("Greek,101" "0,101") + ("Greek,102" "0,102") + ("Greek,121" "0,103") + ("Greek,105" "0,104") + ("Greek,106" "0,105") + ("Greek,132" "0,106") + ("Greek,104" "0,107") + ("Greek,112" "0,110") + ("Greek,114" "0,111") + ("Greek,115" "0,113") + ("Greek,116" "0,114") + ("Greek,117" "0,115") + ("Greek,120" "0,116") + ("Greek,122" "0,117") + ("Greek,123" "0,120") + ("Greek,113" "0,121") + ("Greek,125" "0,122") + ("Greek,126" "0,123") + ("Greek,130" "0,124") + ("Greek,131" "0,125") + ("Greek,135" "0,127") + ("Greek,133" "0,130") + ("Greek,134" "0,131") + ("Greek,111" "0,132") + ("Greek,141" "0,141") + ("Greek,142" "0,142") + ("Greek,161" "0,143") + ("Greek,145" "0,144") + ("Greek,146" "0,145") + ("Greek,172" "0,146") + ("Greek,144" "0,147") + ("Greek,152" "0,150") + ("Greek,154" "0,151") + ("Greek,155" "0,153") + ("Greek,156" "0,154") + ("Greek,157" "0,155") + ("Greek,160" "0,156") + ("Greek,162" "0,157") + ("Greek,163" "0,160") + ("Greek,153" "0,161") + ("Greek,165" "0,162") + ("Greek,166" "0,163") + ("Greek,170" "0,164") + ("Greek,171" "0,165") + ("Greek,175" "0,167") + ("Greek,173" "0,170") + ("Greek,174" "0,171") + ("Greek,151" "0,172") + ("357,44" "0,233") + (EMDASH "0,234") + ("357,146" "0,267"))) + +(RPAQQ CYRILLICTOMCCS + (("Cyrillic,47" Dollar) + ("Cyrillic,71" "0,52") + ("41,76" "0,55") + ("Cyrillic,157" Two) + ("Cyrillic,127" Four) + ("Cyrillic,150" Six) + ("Cyrillic,151" Eight) + ("0,253" "0,74") + ("0,273" "0,76") + ("Cyrillic,77" "0,100") + ("Cyrillic,41" "0,101") + ("Cyrillic,42" "0,102") + ("Cyrillic,76" "0,103") + ("Cyrillic,45" "0,104") + ("Cyrillic,46" "0,105") + ("Cyrillic,66" "0,106") + ("Cyrillic,44" "0,107") + ("Cyrillic,101" "0,110") + ("Cyrillic,52" "0,111") + ("Cyrillic,53" "0,112") + ("Cyrillic,54" "0,113") + ("Cyrillic,55" "0,114") + ("Cyrillic,56" "0,115") + ("Cyrillic,57" "0,116") + ("Cyrillic,60" "0,117") + ("Cyrillic,61" "0,120") + ("Cyrillic,67" "0,121") + ("Cyrillic,62" "0,122") + ("Cyrillic,63" "0,123") + ("Cyrillic,64" "0,124") + ("Cyrillic,65" "0,125") + ("Cyrillic,43" "0,126") + ("Cyrillic,50" "0,127") + ("Cyrillic,75" "0,130") + ("Cyrillic,100" "0,131") + ("Cyrillic,51" "0,132") + ("Cyrillic,152" "0,133") + ("Cyrillic,0" "0,134") + ("Cyrillic,153" "0,135") + ("Cyrillic,74" Uparrow) + ("Cyrillic,154" Leftarrow) + ("Cyrillic,0" "0,140") + ("Cyrillic,121" "0,141") + ("Cyrillic,122" "0,142") + ("Cyrillic,176" "0,143") + ("Cyrillic,125" "0,144") + ("Cyrillic,126" "0,145") + ("Cyrillic,146" "0,146") + ("Cyrillic,124" "0,147") + ("Cyrillic,161" "0,150") + ("Cyrillic,132" "0,151") + ("Cyrillic,133" "0,152") + ("Cyrillic,134" "0,153") + ("Cyrillic,135" "0,154") + ("Cyrillic,136" "0,155") + ("Cyrillic,137" "0,156") + ("Cyrillic,140" "0,157") + ("Cyrillic,141" "0,160") + ("Cyrillic,147" "0,161") + ("Cyrillic,142" "0,162") + ("Cyrillic,143" "0,163") + ("Cyrillic,144" "0,164") + ("Cyrillic,145" "0,165") + ("Cyrillic,123" "0,166") + ("Cyrillic,130" "0,167") + ("Cyrillic,155" "0,170") + ("Cyrillic,160" "0,171") + ("Cyrillic,131" "0,172") + ("Cyrillic,72" "0,173") + ("Cyrillic,0" "0,174") + ("Cyrillic,73" "0,175") + ("Cyrillic,70" "0,176") + ("Cyrillic,0" Rubout) + ("Cyrillic,156" "0,217") + ("357,44" "0,233") + (EMDASH "0,234") + ("357,146" "0,267"))) + +(RPAQQ MATHTOMCCS + ((Product "0,1") + ("357,62" "0,2") + ("357,63" "0,3") + (Hairspace "0,4") + ("0,243" "0,5") + (Integral "0,6") + (Contourintegral "0,7") + ("0,266" "0,13") + ("357,146" "0,17") + (Summation "0,23") + ("357,157" "0,26") + ("357,60" "0,41") + ("357,147" "0,42") + (INFINITY "0,43") + ("0,242" "0,44") + ("0,270" "0,45") + (And "0,46") + ("357,163" "0,47") + ("0,302" "0,50") + (Radical "0,51") + ("0,307" "0,52") + ("0,261" "0,53") + ("357,114" "0,54") + ("357,175" "0,55") + ("41,150" "0,56") + ("357,145" "0,57") + ("357,147" "0,60") + ("42,42" "0,61") + ("42,44" "0,62") + ("41,176" "0,63") + ("357,142" "0,64") + ("357,143" "0,65") + ("357,144" "0,66") + ("357,154" "0,67") + ("41,172" "0,70") + ("0,307" "0,71") + ("0,247" "0,72") + ("356,52" "0,73") + ("41,145" "0,74") + ("41,142" "0,75") + ("41,146" "0,76") + ("0,277" "0,77") + ("357,100" "0,100") + (All "0,101") + (Member "0,102") + ("357,254" "0,103") + ("357,271" "0,104") + (Exists "0,105") + ("357,61" "0,106") + ("357,133" "0,107") + ("357,137" "0,110") + ("357,131" "0,111") + ("357,132" "0,112") + ("357,136" "0,113") + ("357,130" "0,114") + ("360,275" "0,115") + (Notmember "0,116") + ("357,141" "0,117") + ("357,161" "0,120") + ("357,121" "0,121") + ("357,256" "0,122") + ("357,171" "0,123") + ("357,160" "0,124") + (Union "0,125") + (Or "0,126") + ("357,162" "0,127") + ("0,264" "0,130") + ("360,272" "0,131") + ("357,270" "0,132") + ("41,120" "0,133") + ("41,121" "0,135") + ("0,257" "0,136") + ("0,256" "0,137") + ("357,247" "0,141") + ("357,123" "0,142") + ("0,323" "0,143") + ("357,272" "0,144") + ("357,167" "0,145") + ("357,122" "0,146") + ("357,117" "0,147") + ("357,150" "0,150") + ("357,260" "0,151") + ("357,261" "0,152") + ("357,262" "0,153") + ("357,263" "0,154") + ("357,110" "0,155") + ("357,152" "0,156") + ("357,147" "0,157") + ("357,66" "0,160") + ("357,70" "0,161") + ("0,322" "0,162") + ("357,76" "0,163") + ("357,74" "0,164") + ("357,77" "0,165") + ("357,75" "0,166") + ("357,102" "0,167") + ("357,103" "0,170") + (Intersection "0,171") + ("357,67" "0,172") + ("0,274" "0,173") + ("0,275" "0,174") + ("0,276" "0,175") + ("357,120" "0,176"))) + +(RPAQQ PALATINOTOMCCS + ((Circumflex Uparrow) + (Uparrow NIL) + (Lowline Leftarrow) + (Leftarrow NIL) + ("361,353" "0,32") + ("361,260" "0,34") + ("361,277" "0,35") + ("361,304" "0,36") + ("361,153" "0,37") + ("0,255" "0,136") + ("0,254" "0,137") + ("0,240" NIL) + ("361,047" "0,200") + ("361,124" "0,201") + ("361,043" "0,202") + ("361,077" "0,203") + ("361,114" "0,204") + ("361,120" "0,205") + ("361,121" "0,206") + ("361,117" "0,207") + ("361,122" "0,210") + ("361,134" "0,211") + ("361,140" "0,212") + ("361,141" "0,213") + ("361,145" "0,214") + ("361,137" "0,215") + ("361,155" "0,216") + ("361,160" "0,217") + ("361,142" "0,220") + ("361,241" "0,221") + ("361,243" "0,222") + ("361,276" "0,223") + ("361,250" "0,224") + ("361,320" "0,225") + ("361,321" "0,226") + ("361,322" "0,227") + ("361,322" "0,230") + ("361,334" "0,231") + ("361,244" "0,232") + ("361,341" "0,233") + ("361,261" "0,234") + ("361,337" "0,235") + ("361,262" "0,236") + ("361,255" "0,237") + ("361,247" "0,240") + ("0,057" "0,244") + (* ; "Slash, but should be fraction") + ("357,243" "0,246") + ("0,244" "0,250") + ("357,052" "0,254") + ("357,053" "0,255") + ("360,004" "0,256") + ("360,005" "0,257") + (EMDASH "0,261") + ("357,060" "0,262") + ("357,061" "0,263") + ("357,146" "0,267") + ("43,262" "0,270") + ("357,050" "0,271") + ("41,104" "0,274") + ("357,101" "0,275") + ("357,153" "0,311") + ("361,314" "0,314") + ("375,261" "0,321") + ("361,324" "0,324") + ("375,362" "0,325") + ("375,363" "0,326") + ("0,274" "0,327") + ("0,275" "0,330") + ("0,264" "0,331") + ("0,270" "0,332") + ("357,152" "0,333") + ("361,265" "0,334") + ("0,261" "0,335") + ("361,042" "0,336") + ("357,044" "0,337") + ("361,340" "0,340") + ("361,041" "0,344") + ("361,345" "0,345") + ("361,050" "0,346") + ("361,044" "0,347") + ("361,355" "0,355") + ("361,055" "0,356") + ("361,061" "0,357") + ("361,360" "0,360") + ("361,062" "0,362") + ("361,065" "0,364") + ("361,060" "0,366") + ("361,277" "0,367") + ("361,100" "0,375") + ("361,104" "0,376"))) + +(RPAQQ TITANTOMCCS + (("0,242" "0,176" cent) + ("0,176" NIL Delete cent) + (Lowline ↑X) + (Lowline "0,277") + ("0,55" "0,337") + ("0,55" "0,55" Hypehn) + ("0,274" "0,74" Quarter) + ("0,74" NIL Delete quarter) + ("0,275" "0,76" Half) + ("0,76" NIL Delete half))) + +(RPAQQ TITANLEGALTOMCCS + (("0,247" "0,176" Section) + ("0,176" NIL Delete section) + (Lowline ↑X) + (Lowline "0,277") + ("0,55" "0,337") + ("0,55" "0,55") + ("0,260" "0,74" Degree) + ("0,74" NIL Delete degree) + ("0,266" "0,100" Paragraph) + ("0,100" NIL Delete Paragraph))) +(DECLARE%: DOEVAL@COMPILE DONTCOPY + +(GLOBALVARS GACHATOMCCSARRAY ALTOTOMCCSARRAY SYMBOLTOMCCSARRAY HIPPOTOMCCSARRAY CYRILLICTOMCCSARRAY + MATHTOMCCSARRAY SIGMATOMCCSARRAY PALATINOTOMCCSARRAY TITANTOMCCSARRAY TITANLEGALTOMCCSARRAY) +) + + + +(* ;; "For translation of codes in datastructures (e.g. Tedit)") + + +(RPAQ? GACHATOMCCSARRAY [MCCSCODEMAPARRAY (XCCSUNDEFINEDPAIRS '((Lowline ↑X]) + +(RPAQ? ALTOTOMCCSARRAY (MCCSCODEMAPARRAY ALTOTEXTTOMCCS)) + +(RPAQ? SYMBOLTOMCCSARRAY (MCCSCODEMAPARRAY SYMBOLTOMCCS)) + +(RPAQ? HIPPOTOMCCSARRAY (MCCSCODEMAPARRAY HIPPOTOMCCS)) + +(RPAQ? CYRILLICTOMCCSARRAY (MCCSCODEMAPARRAY CYRILLICTOMCCS)) + +(RPAQ? MATHTOMCCSARRAY (MCCSCODEMAPARRAY MATHTOMCCS)) + +(RPAQ? SIGMATOMCCSARRAY (MCCSCODEMAPARRAY SIGMATOMCCS)) + +(RPAQ? PALATINOTOMCCSARRAY (MCCSCODEMAPARRAY PALATINOTOMCCS)) + +(RPAQ? TITANTOMCCSARRAY (MCCSCODEMAPARRAY (XCCSUNDEFINEDPAIRS TITANTOMCCS))) + +(RPAQ? TITANLEGALTOMCCSARRAY (MCCSCODEMAPARRAY (XCCSUNDEFINEDPAIRS TITANLEGALTOMCCS))) + + + +(* ;; "Mappings into MCCS: needed for e.g. Tedit coercion. \TEDIT.MCCS.TRANSLATE") + +(DEFINEQ + +(GACHATOMCODE + [LAMBDA (GCODE) (* ; "Edited 7-Mar-2026 23:53 by rmk") + (* ; "Edited 6-Mar-2026 11:19 by rmk") + (* ; "Edited 7-Sep-2025 22:38 by rmk") + (* ; "Edited 3-Sep-2025 23:23 by rmk") + + (* ;; "Gacha did not have a code for circumflex, so there is nothing to map") + + (OR (CL:WHEN (ILEQ GCODE \MAXTHINCHAR) + (ELT GACHATOMCCSARRAY GCODE)) + GCODE]) + +(SYMBOLTOMCODE + [LAMBDA (SCODE) (* ; "Edited 7-Mar-2026 23:53 by rmk") + (* ; "Edited 7-Sep-2025 22:39 by rmk") + (* ; "Edited 3-Sep-2025 10:21 by rmk") + (* ; "Edited 7-Aug-2025 09:37 by rmk") + (* ; "Edited 1-Jun-2025 07:02 by rmk") + (OR (CL:WHEN (ILEQ SCODE \MAXTHINCHAR) + (ELT SYMBOLTOMCCSARRAY SCODE)) + SCODE]) + +(SIGMATOMCODE + [LAMBDA (SCODE) (* ; "Edited 7-Mar-2026 23:54 by rmk") + (* ; "Edited 7-Sep-2025 22:39 by rmk") + (* ; "Edited 3-Sep-2025 10:21 by rmk") + (* ; "Edited 1-Jun-2025 07:02 by rmk") + (* ; "Edited 24-May-2025 10:54 by rmk") + (OR (CL:WHEN (ILEQ SCODE \MAXTHINCHAR) + (ELT SIGMATOMCCSARRAY SCODE)) + SCODE]) + +(ATOMCODE + [LAMBDA (ACODE) (* ; "Edited 7-Mar-2026 23:54 by rmk") + (* ; "Edited 7-Sep-2025 22:39 by rmk") + (* ; "Edited 3-Sep-2025 10:21 by rmk") + (* ; "Edited 24-May-2025 09:41 by rmk") + (OR (CL:WHEN (ILEQ ACODE \MAXTHINCHAR) + (ELT ALTOTOMCCSARRAY ACODE)) + ACODE]) + +(MATHTOMCODE + [LAMBDA (MATHCODE) (* ; "Edited 7-Mar-2026 23:54 by rmk") + (* ; "Edited 7-Sep-2025 22:39 by rmk") + (* ; "Edited 4-Sep-2025 08:18 by rmk") + (* ; "Edited 1-Jun-2025 07:02 by rmk") + (* ; "Edited 24-May-2025 10:58 by rmk") + (OR (CL:WHEN (ILEQ MATHCODE \MAXTHINCHAR) + (ELT MATHTOMCCSARRAY MATHCODE)) + MATHCODE]) + +(HIPPOTOMCODE + [LAMBDA (HCODE) (* ; "Edited 7-Mar-2026 23:54 by rmk") + (* ; "Edited 7-Sep-2025 22:40 by rmk") + (* ; "Edited 3-Sep-2025 10:22 by rmk") + (* ; "Edited 24-May-2025 09:40 by rmk") + (OR (CL:WHEN (ILEQ HCODE \MAXTHINCHAR) + (ELT HIPPOTOMCCSARRAY HCODE)) + HCODE]) + +(CYRILLICTOMCODE + [LAMBDA (CCODE) (* ; "Edited 7-Mar-2026 23:55 by rmk") + (* ; "Edited 7-Sep-2025 22:40 by rmk") + (* ; "Edited 24-May-2025 09:38 by rmk") + (OR (CL:WHEN (ILEQ CCODE \MAXTHINCHAR) + (ELT CYRILLICTOMCCSARRAY CCODE)) + CCODE]) + +(PALATINOTOMCODE + [LAMBDA (PCODE) (* ; "Edited 7-Mar-2026 23:55 by rmk") + (* ; "Edited 5-Oct-2025 20:08 by rmk") + (* ; "Edited 7-Sep-2025 22:39 by rmk") + (* ; "Edited 3-Sep-2025 10:21 by rmk") + (* ; "Edited 7-Aug-2025 09:37 by rmk") + (* ; "Edited 1-Jun-2025 07:02 by rmk") + (OR (CL:WHEN (ILEQ PCODE \MAXTHINCHAR) + (ELT PALATINOTOMCCSARRAY PCODE)) + PCODE]) + +(TITANTOMCODE + [LAMBDA (TCODE) (* ; "Edited 7-Mar-2026 23:51 by rmk") + (* ; "Edited 6-Mar-2026 11:19 by rmk") + (* ; "Edited 7-Sep-2025 22:38 by rmk") + (* ; "Edited 3-Sep-2025 23:23 by rmk") + (* ; "Edited 30-Aug-2025 21:58 by rmk") + (OR (CL:WHEN (ILEQ TCODE \MAXTHINCHAR) + (ELT TITANTOMCCSARRAY TCODE)) + TCODE]) + +(TITANLEGALTOMCODE + [LAMBDA (TCODE) (* ; "Edited 7-Mar-2026 23:52 by rmk") + (* ; "Edited 6-Mar-2026 11:19 by rmk") + (* ; "Edited 7-Sep-2025 22:38 by rmk") + (* ; "Edited 3-Sep-2025 23:23 by rmk") + (* ; "Edited 30-Aug-2025 21:58 by rmk") + (OR (CL:WHEN (ILEQ TCODE \MAXTHINCHAR) + (ELT TITANLEGALTOMCCSARRAY TCODE)) + TCODE]) +) + +(RPAQ? DISPLAYFONTCOERCIONS + '(((HELVETICA (<= * 2)) + (HELVETICA 4)) + ((MODERN (<= 15 * 16)) + (* 14)) + ((MODERN (<= 17 * 21)) + (* 18)) + ((MODERN (<= 22 * 28)) + (* 24)) + ((MODERN (<= 29 * 33)) + (* 30)) + ((MODERN (<= 34 * 40)) + (* 36)) + ((MODERN (<= 41 * 65)) + (* 48)) + ((MODERN (<= 66 *)) + (* 72)) + ((PALATINO 9) + (PALATINO 12)) + ((PALATINO (<= * 8)) + (PALATINO 10)) + ((TITAN (<= * 9) + BOLD) + (MODERN 10)) + ((TITAN (<= * 9) + ITALIC) + (MODERN 10)) + ((TITAN (<= * 9)) + (TITAN 10)) + (LPT AMTEX))) + +(RPAQ? DISPLAYCHARCOERCIONS + '((GACHA TERMINAL) + (MODERN CLASSIC) + (TIMESROMAN CLASSIC) + (HELVETICA MODERN) + (TERMINAL MODERN) + (HIPPO CLASSIC) + (CYRILLIC CLASSIC) + (MATH CLASSIC) + (SIGMA MODERN) + (SYMBOL MODERN) + (TITAN CLASSIC) + (PALATINO CLASSIC) + (OPTIMA MODERN) + (BOLDPS CLASSIC) + (PCTERMINAL CLASSIC) + (TITANLEGAL CLASSIC))) + + + +(* ;; "Defunct coercions? Mapping for DOS filenames, Adobe equivalences") + + +(RPAQ? ADOBEDISPLAYFONTCOERCIONS + '(((HELVETICABLACK 16) + (HELVETICABLACK 18)) + ((SYMBOL) + (ADOBESYMBOL)) + ((SYMBOL 11) + (ADOBESYMBOL 10)) + ((AVANTGARDE-DEMI) + (AVANTGARDE)) + ((AVANTGARDE-BOOK) + (AVANTGARDE)) + ((NEWCENTURYSCHLBK) + (CENTURYSCHOOLBOOK)) + ((BOOKMAN-LIGHT) + (BOOKMAN)) + ((BOOKMAN-DEMI) + (BOOKMAN)) + ((HELVETICA-NARROW) + (HELVETICANARROW)) + ((HELVETICA 24) + (ADOBEHELVETICA 24)))) + +(RPAQ? *DISPLAY-FONT-NAME-MAP* + '((TIMESROMAN . TR) + (HELVETICA . HV) + (TIMESROMAND . TD) + (HELVETICAD . HD) + (MODERN . MD) + (CLASSIC . CL) + (GACHA . GC) + (TITAN . TI) + (LETTERGOTHIC . LG) + (BOLDPS . BP) + (TERMINAL . TM) + (CLASSICTHIN . CT) + (HIPPO . HP) + (LOGO . LG) + (MATH . MA) + (OLDENGLISH . OE) + (SYMBOL . SY))) +(DECLARE%: DONTCOPY + (FILEMAP (NIL (8333 9100 (DISPLAYENCODINGFN 8343 . 9098)) (9134 24123 (MCCSCODEMAPARRAY 9144 . 13712) +(MCCSMAPFN 13714 . 15081) (MCCSMAPPAIRS 15083 . 22184) (XCCS.CS0.UNDEFINED 22186 . 23319) ( +XCCSUNDEFINEDPAIRS 23321 . 24121)) (43112 49480 (GACHATOMCODE 43122 . 43767) (SYMBOLTOMCODE 43769 . +44437) (SIGMATOMCODE 44439 . 45105) (ATOMCODE 45107 . 45659) (MATHTOMCODE 45661 . 46334) (HIPPOTOMCODE + 46336 . 46893) (CYRILLICTOMCODE 46895 . 47349) (PALATINOTOMCODE 47351 . 48132) (TITANTOMCODE 48134 . +48800) (TITANLEGALTOMCODE 48802 . 49478))))) +STOP diff --git a/sources/MCCSFONTS.LCOM b/sources/MCCSFONTS.LCOM new file mode 100644 index 000000000..ca8a2a6c4 Binary files /dev/null and b/sources/MCCSFONTS.LCOM differ diff --git a/sources/MEDLEYDIR b/sources/MEDLEYDIR index 886f4497e..c5ab914bd 100644 --- a/sources/MEDLEYDIR +++ b/sources/MEDLEYDIR @@ -1,12 +1,12 @@ -(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10) +(DEFINE-FILE-INFO :PACKAGE "INTERLISP" :READTABLE "INTERLISP" :BASE 10) -(FILECREATED "31-Jan-2026 23:43:06" {WMEDLEY}MEDLEYDIR.;44 16074 +(FILECREATED "26-Apr-2026 20:46:52" {WMEDLEY}MEDLEYDIR.;61 15717 :EDIT-BY rmk - :CHANGES-TO (FNS MEDLEYDIR) + :CHANGES-TO (VARS MEDLEYDIRCOMS) - :PREVIOUS-DATE "26-Nov-2025 21:51:39" {WMEDLEY}MEDLEYDIR.;43) + :PREVIOUS-DATE "26-Apr-2026 14:56:00" {WMEDLEY}MEDLEYDIR.;60) (PRETTYCOMPRINT MEDLEYDIRCOMS) @@ -16,17 +16,21 @@ (* ;; "set up initialization for file paths relative to where Medley is installed. This assumes that the environment variable MEDLEYDIR is set (usually by the ./run-medley script) to the (unix path) and all of the other directories variables are set relative to that (by MEDLEY-INIT-VARS)") (FNS MEDLEY-INIT-VARS MEDLEYDIR MEDLEYSUBSTDIR SET-SYSOUT-COMMIT) - [INITVARS (MEDLEYDIR) + [INITVARS (MEDLEYDIR (MEDLEYDIR)) (\SAVE.MEDLEYDIR) (SYSOUTCOMMITS (OR (AND (BOUNDP 'SYSOUTCOMMITS) SYSOUTCOMMITS) (LIST (LIST 'MEDLEY NIL] + + (* ;; "PSEUDOHOSTS comes before MEDLEYDIR in the loadup.") + + (P (PSEUDOHOST 'MEDLEY MEDLEYDIR)) (ADDVARS (AROUNDEXITFNS MEDLEY-INIT-VARS)) (* ;; "**WARNING** The EVALed expressions get run early in the lodup.") - (* ;; "The INITVARS prevents this from accumulating entries from other files that happen to have been loaded when this is worked on and saved. The loadup scripts set MEDLEY-INIT-VARS to NOBIND to make sure that these are the initial values (as opposed to whatever there was in the startup sysout. But the FONT cache variables have to be specified here, because FONT is in the INIT and the resetting to NOBIND would wipe out these entries even if they were already correct in the init sysout.") + (* ;; "The INITVARS prevents this from accumulating entries from other files that happen to have been loaded when this is worked on and saved. The loadup scripts set MEDLEY-INIT-VARS to NOBIND to make sure that these are the initial values (as opposed to whatever there was in the startup sysout.") [INITVARS (MEDLEY-INIT-VARS '((\FONTEXISTS?-CACHE NIL RESET) (\FONTSAVAILABLEFILECACHE NIL RESET) @@ -40,28 +44,17 @@ (IRM.DINFOGRAPH) (DIRECTORIES (APPEND LISPUSERSDIRECTORIES LISPSOURCEDIRECTORIES )) - (LOGINHOST/DIR (LET [(LHD (DIRECTORYNAME (OR (UNIX-GETENV - "LOGINDIR") - (UNIX-GETENV - "HOME"] - (AND (GETD 'PSEUDOHOSTS) - (TARGETHOST 'LI) - (PSEUDOHOST 'LI LHD)) - LHD) - RESET) + (LOGINHOST/DIR + (LET [(LHD (DIRECTORYNAME (PACKFILENAME 'HOST 'DSK + 'BODY + (OR (UNIX-GETENV "LOGINDIR") + (UNIX-GETENV "HOME"] + (PSEUDOHOST 'LI LHD) + LHD) + RESET) (USERGREETFILES [LIST (CONS LOGINHOST/DIR '("INIT" COM)) (CONS LOGINHOST/DIR '("INIT"] RESET) - (DISPLAYFONTDIRECTORIES (MEDLEYDIR '("fonts/medleydisplayfonts" - "fonts/displayfonts") - NIL NIL T)) - (POSTSCRIPTFONTDIRECTORIES (MEDLEYDIR '("fonts/postscriptfonts" - ) - NIL NIL T)) - (INTERPRESSFONTDIRECTORIES (MEDLEYDIR '("fonts/ipfonts") - NIL NIL T)) - (UNICODEDIRECTORIES (MEDLEYDIR '("unicode/xerox") - NIL NIL T)) (XCL::*WHERE-IS-CASH-FILES* (MEDLEYDIR '("loadups") "whereis.hash" NIL T)) (LOADUPSDIRECTORIES (MEDLEYDIR '("loadups") @@ -78,7 +71,8 @@ (DEFINEQ (MEDLEY-INIT-VARS - [LAMBDA (EVENT) (* ; "Edited 22-Nov-2022 20:38 by FGH") + [LAMBDA (EVENT) (* ; "Edited 15-Apr-2026 16:44 by rmk") + (* ; "Edited 22-Nov-2022 20:38 by FGH") (* ; "Edited 21-Nov-2022 17:31 by FGH") (* ; "Edited 21-Nov-2022 15:39 by frank") (* ; "Edited 21-Nov-2022 14:33 by FGH") @@ -105,6 +99,7 @@ (* ;;  "Any old values, restore them, substituting the new MEDLEYDIR") + (PSEUDOHOST 'MEDLEY MEDLEYDIR) (PROG (OLDMD NEWMD SAME TMP) (IF (EQ \SAVE.MEDLEYDIR T) THEN (* ; " Already restored") @@ -139,7 +134,8 @@ NIL]) (MEDLEYDIR - [LAMBDA (DIRNAME FILENAME OUTPUT NOERROR) (* ; "Edited 31-Jan-2026 23:42 by rmk") + [LAMBDA (DIRNAME FILENAME OUTPUT NOERROR) (* ; "Edited 16-Apr-2026 11:06 by rmk") + (* ; "Edited 31-Jan-2026 23:42 by rmk") (* ; "Edited 23-Aug-2025 17:21 by lmm") (* ; "Edited 18-Aug-2025 11:15 by FGH") (* ; "Edited 29-Jun-2023 22:48 by rmk") @@ -149,55 +145,60 @@ (* ;; "RMK: MEDLEYDIR defaults to DSK") - (COND - ((NULL DIRNAME) (* ; - "Call to (MEDLEYDIR) or (MEDLEYDIR NIL ...) just set it ") - (if (OR (NOT (BOUNDP 'MEDLEYDIR)) - (NOT MEDLEYDIR)) - then (SETQ MEDLEYDIR (DIRECTORYNAME (if (SETQ MEDLEYDIR (UNIX-GETENV "MEDLEYDIR")) - then (PACKFILENAME 'BODY MEDLEYDIR 'HOST - 'DSK) - else T))) - elseif (STRPOS "/" MEDLEYDIR) - then (SETQ MEDLEYDIR (DIRECTORYNAME MEDLEYDIR)) - else MEDLEYDIR)) - ((LISTP DIRNAME) - - (* ;; "(MEDLEYDIR a list -- recurse") - - (for X Y in DIRNAME when (SETQ Y (MEDLEYDIR X FILENAME OUTPUT NOERROR)) collect Y)) - [FILENAME - - (* ;; " if FILENAME, find it as a file. ") - - (if (NULL (SETQ DIRNAME (MEDLEYDIR DIRNAME NIL OUTPUT NOERROR))) - then (OR NOERROR (SHOULDNT)) - NIL - else (SETQ FILENAME (CONCAT DIRNAME FILENAME)) - (if OUTPUT - then FILENAME - else (OR (INFILEP FILENAME) - (if NOERROR - then NIL - else (ERROR "No such medley file" FILENAME] - ((EQUAL DIRNAME "login") (* ; "special case for login dir") - (DIRECTORYNAME (OR (UNIX-GETENV "LOGINDIR") - (UNIX-GETENV "HOME") - DIRNAME))) - [(EQUAL DIRNAME "loadups") (* ; "special case for loadups dir") - (OR (DIRECTORYNAME (UNIX-GETENV "MEDLEY¬LOADUPS¬DIR")) - (DIRECTORYNAME (CONCAT (MEDLEYDIR) - "loadups" ">") - NIL OUTPUT) - (if NOERROR - then NIL - else (ERROR "Cannot find medley loadups directory" (MEDLEYDIR] - (T (OR (DIRECTORYNAME (CONCAT (MEDLEYDIR) - DIRNAME ">") - NIL OUTPUT) - (if NOERROR - then NIL - else (ERROR "No such medley directory" DIRNAME]) + (if (NULL DIRNAME) + then (* ; + "Call to (MEDLEYDIR) or (MEDLEYDIR NIL ...) just set it--Don't want MEDLEYDIR to be {MEDLEY}.") + (if (OR (NOT (BOUNDP 'MEDLEYDIR)) + (NOT MEDLEYDIR)) + then (SETQ MEDLEYDIR (DIRECTORYNAME (if (SETQ MEDLEYDIR (UNIX-GETENV "MEDLEYDIR")) + then (PACKFILENAME 'BODY MEDLEYDIR + 'HOST + 'DSK) + else T))) + elseif (STRPOS "/" MEDLEYDIR) + then (SETQ MEDLEYDIR (DIRECTORYNAME MEDLEYDIR)) + else MEDLEYDIR) + else (LET (MED) + [SETQ MED (COND + ((LISTP DIRNAME) + + (* ;; "(MEDLEYDIR a list -- recurse") + + (for X Y in DIRNAME when (SETQ Y (MEDLEYDIR X FILENAME OUTPUT NOERROR)) + collect Y)) + [FILENAME + + (* ;; " if FILENAME, find it as a file. ") + + (if (NULL (SETQ DIRNAME (MEDLEYDIR DIRNAME NIL OUTPUT NOERROR))) + then (OR NOERROR (SHOULDNT)) + NIL + else (SETQ FILENAME (CONCAT DIRNAME FILENAME)) + (if OUTPUT + then FILENAME + else (OR (INFILEP FILENAME) + (if NOERROR + then NIL + else (ERROR "No such medley file" FILENAME] + ((EQUAL DIRNAME "login") (* ; "special case for login dir") + (DIRECTORYNAME (OR (UNIX-GETENV "LOGINDIR") + (UNIX-GETENV "HOME") + DIRNAME))) + [(EQUAL DIRNAME "loadups") (* ; "special case for loadups dir") + (OR (DIRECTORYNAME (UNIX-GETENV "MEDLEY¬LOADUPS¬DIR")) + (DIRECTORYNAME (CONCAT (MEDLEYDIR) + "loadups" ">") + NIL OUTPUT) + (if NOERROR + then NIL + else (ERROR "Cannot find medley loadups directory" (MEDLEYDIR] + (T (OR (DIRECTORYNAME (CONCAT (MEDLEYDIR) + DIRNAME ">") + NIL OUTPUT) + (if NOERROR + then NIL + else (ERROR "No such medley directory" DIRNAME] + (CL:WHEN MED (PSEUDOFILENAME MED]) (MEDLEYSUBSTDIR [LAMBDA (OLD NEW BODY) (* ; @@ -227,7 +228,7 @@ SYSOUTCOMMITS]) ) -(RPAQ? MEDLEYDIR ) +(RPAQ? MEDLEYDIR (MEDLEYDIR)) (RPAQ? \SAVE.MEDLEYDIR ) @@ -235,6 +236,13 @@ SYSOUTCOMMITS) (LIST (LIST 'MEDLEY NIL)))) + + +(* ;; "PSEUDOHOSTS comes before MEDLEYDIR in the loadup.") + + +(PSEUDOHOST 'MEDLEY MEDLEYDIR) + (ADDTOVAR AROUNDEXITFNS MEDLEY-INIT-VARS) @@ -245,7 +253,7 @@ (* ;; -"The INITVARS prevents this from accumulating entries from other files that happen to have been loaded when this is worked on and saved. The loadup scripts set MEDLEY-INIT-VARS to NOBIND to make sure that these are the initial values (as opposed to whatever there was in the startup sysout. But the FONT cache variables have to be specified here, because FONT is in the INIT and the resetting to NOBIND would wipe out these entries even if they were already correct in the init sysout." +"The INITVARS prevents this from accumulating entries from other files that happen to have been loaded when this is worked on and saved. The loadup scripts set MEDLEY-INIT-VARS to NOBIND to make sure that these are the initial values (as opposed to whatever there was in the startup sysout." ) @@ -258,24 +266,16 @@ (IRM.HOST&DIR (MEDLEYDIR '"docs/dinfo")) (IRM.DINFOGRAPH) (DIRECTORIES (APPEND LISPUSERSDIRECTORIES LISPSOURCEDIRECTORIES)) - (LOGINHOST/DIR (LET [(LHD (DIRECTORYNAME (OR (UNIX-GETENV "LOGINDIR") - (UNIX-GETENV "HOME"] - (AND (GETD 'PSEUDOHOSTS) - (TARGETHOST 'LI) - (PSEUDOHOST 'LI LHD)) + (LOGINHOST/DIR (LET [(LHD (DIRECTORYNAME (PACKFILENAME 'HOST 'DSK 'BODY (OR (UNIX-GETENV + "LOGINDIR") + (UNIX-GETENV + "HOME"] + (PSEUDOHOST 'LI LHD) LHD) RESET) (USERGREETFILES [LIST (CONS LOGINHOST/DIR '("INIT" COM)) (CONS LOGINHOST/DIR '("INIT"] RESET) - (DISPLAYFONTDIRECTORIES (MEDLEYDIR '("fonts/medleydisplayfonts" "fonts/displayfonts") - NIL NIL T)) - (POSTSCRIPTFONTDIRECTORIES (MEDLEYDIR '("fonts/postscriptfonts") - NIL NIL T)) - (INTERPRESSFONTDIRECTORIES (MEDLEYDIR '("fonts/ipfonts") - NIL NIL T)) - (UNICODEDIRECTORIES (MEDLEYDIR '("unicode/xerox") - NIL NIL T)) (XCL::*WHERE-IS-CASH-FILES* (MEDLEYDIR '("loadups") "whereis.hash" NIL T)) (LOADUPSDIRECTORIES (MEDLEYDIR '("loadups") @@ -285,6 +285,6 @@ (ADDTOVAR GLOBALVARS MEDLEYDIR MEDLEY-INIT-VARS \SAVE.MEDLEYDIR DIRECTORIES SYSOUTCOMMITS) ) (DECLARE%: DONTCOPY - (FILEMAP (NIL (5324 13336 (MEDLEY-INIT-VARS 5334 . 8812) (MEDLEYDIR 8814 . 12136) (MEDLEYSUBSTDIR -12138 . 13116) (SET-SYSOUT-COMMIT 13118 . 13334))))) + (FILEMAP (NIL (4215 13446 (MEDLEY-INIT-VARS 4225 . 7856) (MEDLEYDIR 7858 . 12246) (MEDLEYSUBSTDIR +12248 . 13226) (SET-SYSOUT-COMMIT 13228 . 13444))))) STOP diff --git a/sources/MEDLEYDIR.LCOM b/sources/MEDLEYDIR.LCOM index d348dc275..6c08ba810 100644 Binary files a/sources/MEDLEYDIR.LCOM and b/sources/MEDLEYDIR.LCOM differ diff --git a/sources/MEDLEYFONTFORMAT b/sources/MEDLEYFONTFORMAT index 96f410e04..fd2dbae27 100644 --- a/sources/MEDLEYFONTFORMAT +++ b/sources/MEDLEYFONTFORMAT @@ -1,12 +1,12 @@ -(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10) +(DEFINE-FILE-INFO :PACKAGE "INTERLISP" :READTABLE "INTERLISP" :BASE 10) -(FILECREATED "14-Feb-2026 00:39:34" {WMEDLEY}MEDLEYFONTFORMAT.;250 60733 +(FILECREATED " 5-May-2026 11:06:05" {MEDLEY}MEDLEYFONTFORMAT.;317 67145 :EDIT-BY rmk - :CHANGES-TO (FNS MEDLEYFONT.GETCHARSET MEDLEYFONT.READ.CHARSET) + :CHANGES-TO (FNS MEDLEYFONT.READ.FONT MEDLEYFONT.FILENAME) - :PREVIOUS-DATE "23-Jan-2026 15:10:16" {WMEDLEY}MEDLEYFONTFORMAT.;249) + :PREVIOUS-DATE " 4-May-2026 14:58:55" {MEDLEY}MEDLEYFONTFORMAT.;316) (PRETTYCOMPRINT MEDLEYFONTFORMATCOMS) @@ -18,8 +18,8 @@ (* ;; "Main public entries") - (FNS MEDLEYFONT.WRITE.FONT MEDLEYFONT.GETCHARSET MEDLEYFONT.CHARSET? MEDLEYFONT.GETFILEPROP - MEDLEYFONT.FILEP) + (FNS MEDLEYFONT.WRITE.FONT MEDLEYFONT.GETCHARSET MEDLEYFONT.GETCHARSET.INTERNAL + MEDLEYFONT.CHARSET? MEDLEYFONT.GETFILEPROP MEDLEYFONT.FILEP MEDLEYFONT.FILEVERSION) (* ;; "Reading") @@ -59,191 +59,222 @@ (DEFINEQ (MEDLEYFONT.WRITE.FONT - [LAMBDA (FONT FILE CHARSETNOS OTHERFONTPROPS NOINDIRECTS) (* ; "Edited 20-Jan-2026 22:36 by rmk") + [LAMBDA (FONT FILE OTHERFONTPROPS NOINDIRECTS) (* ; "Edited 30-Mar-2026 12:55 by rmk") + (* ; "Edited 25-Mar-2026 10:48 by rmk") + (* ; "Edited 22-Mar-2026 18:19 by rmk") + (* ; "Edited 21-Mar-2026 15:32 by rmk") + (* ; "Edited 18-Mar-2026 23:16 by rmk") + (* ; "Edited 20-Jan-2026 22:36 by rmk") (* ; "Edited 2-Sep-2025 23:01 by rmk") (* ; "Edited 15-Jul-2025 16:43 by rmk") (* ; "Edited 9-Jul-2025 09:32 by rmk") (* ; "Edited 19-Jun-2025 10:59 by rmk") (* ; "Edited 9-Jun-2025 12:17 by rmk") - (* ; "Edited 25-May-2025 20:48 by rmk") - (* ; "Edited 23-May-2025 14:59 by rmk") - (* ; "Edited 22-May-2025 09:58 by rmk") - (* ; "Edited 16-May-2025 20:17 by rmk") (* ; "Edited 14-May-2025 17:45 by rmk") - (SETQ FONT (FONTCREATE FONT)) - (SETQ FILE (MEDLEYFONT.FILENAME FILE FONT CHARSETNOS)) - (SETQ CHARSETNOS (SORT (MKLIST CHARSETNOS))) - (CL:WITH-OPEN-FILE (STREAM FILE :DIRECTION :OUTPUT :IF-EXISTS :NEW-VERSION) - (MEDLEYFONT.WRITE.HEADER STREAM OTHERFONTPROPS) - (LET ((CHARSETLOCS (CL:MAKE-ARRAY 256 :INITIAL-ELEMENT 0)) - (FONTCHARENCODING (FONTPROP FONT 'CHARENCODING)) - (*READTABLE* (FIND-READTABLE "INTERLISP")) - CSVECTORPTRLOC CSVECTORLOC FILECHARSETS) - - (* ;; "Figure out the actual non empty/sluggish charsets that will be wrtitten.") - - (SETQ FILECHARSETS (for CSNO CSINFO from 0 to \MAXCHARSET - when (OR (NULL CHARSETNOS) - (MEMB CSNO CHARSETNOS)) - when (SETQ CSINFO (\GETCHARSETINFO FONT CSNO)) - unless (fetch (CHARSETINFO CSSLUGP) of CSINFO) collect CSNO)) - (CL:UNLESS FILECHARSETS (ERROR "No character sets to write" FONT)) - - (* ;; "Right after the header, leave 4 bytes for the pointer to the charset dispatch vector. If writing a single charset, we store the negative of the byte location so we can still easily skip the font properties without writing the whole vector. The byte in front of the single charset holds its number.") - - (* ;; "") - - (SETQ CSVECTORPTRLOC (GETFILEPTR STREAM)) (* ; - "Ptr is before fontproperties, vector is after") - (\FIXPOUT STREAM 0) - (MEDLEYFONT.WRITE.FONTPROPS STREAM FONT) - (if (CDR FILECHARSETS) - then (PRINTOUT STREAM "CHARSET LOCATIONS" T) - (* ; - "Allocate the vector space if multiple") - (SETQ CSVECTORLOC (GETFILEPTR STREAM)) - (for I from 0 to \MAXCHARSET do (\FIXPOUT STREAM 0)) - (TERPRI STREAM) - (for CSNO in FILECHARSETS do - - (* ;; - "LOC remains zero for missing charsets, slug properties are determined by font-level properties.") - - (CL:SETF (CL:SVREF CHARSETLOCS CSNO) - (GETFILEPTR STREAM)) - (MEDLEYFONT.WRITE.CHARSET FONT CSNO STREAM - NOINDIRECTS)) - (SETFILEPTR STREAM CSVECTORLOC) - (for CSNO from 0 to \MAXCHARSET do (\FIXPOUT STREAM (CL:SVREF CHARSETLOCS - CSNO))) - else - (* ;; "Only one. The %"vector%" is the charset byte immediately before the charset, the sign bit tells the tale.") - (SETQ CSVECTORLOC (IMINUS (GETFILEPTR STREAM))) - (BOUT STREAM (CAR FILECHARSETS)) - (MEDLEYFONT.WRITE.CHARSET FONT (CAR FILECHARSETS) - STREAM NOINDIRECTS)) - (SETFILEPTR STREAM CSVECTORPTRLOC) - (\FIXPOUT STREAM CSVECTORLOC) (* ; - "Pointer to the charset dispatch vector--or negative of actual location for a singleton") - (FULLNAME STREAM]) + (* ;; "This writes all of the information in the fontdescriptor FONT, this doesn't allow for selecting a subset of character sets to write. The information allows all of the current CHARSETINFOs to be reconstructed when the font is read. An uninstantiated charset (CSINFO is NIL) will be read as NIL, and the CSINFO for an empty charset (CSINFO is CSSLUGP) will be installed as the font's slug. The reader can select a subset of the charsets for MEDLEYFONT.GETCHARSET to read. ") + + (SETQ FONT (FONTCREATE FONT)) + (CL:WITH-OPEN-FILE + (STREAM (MEDLEYFONT.FILENAME FILE) + :DIRECTION :OUTPUT :IF-EXISTS :NEW-VERSION) + (MEDLEYFONT.WRITE.HEADER STREAM OTHERFONTPROPS FONT) + + (* ;; "Right after the header, leave bytes for the maxcharset and a pointer to either the charset dispatch vector or a single-charset. Ptr is before fontproperties, vector is after, so MEDLEYFONT.GETCHARSET can skip the font stuff.") + + (MEDLEYFONT.WRITE.ITEM STREAM 'MAXCHARSET (MAXCHARSET FONT)) + (LET ((CHARSETLOCS (CL:MAKE-ARRAY (ADD1 (MAXCHARSET FONT)) + :INITIAL-ELEMENT 0)) + (FONTCHARENCODING (FONTPROP FONT 'CHARENCODING)) + (*READTABLE* (FIND-READTABLE "INTERLISP")) + CSVECTORPTRLOC CSLOC SINGLECS) + [SETQ SINGLECS (AND (ILEQ (FONTPROP FONT 'NINSTANTIATEDCHARSETS) + 1) + (OR (EQ 0 (FONTPROP FONT 'NEMPTYCHARSETS)) + (EQ 0 (FONTPROP FONT 'NUNINSTANTIATEDCHARSETS] + (SETQ CSVECTORPTRLOC (GETFILEPTR STREAM)) + (\FIXPOUT STREAM 0) (* ; + "Space for the pointer to the charset info") + (MEDLEYFONT.WRITE.FONTPROPS STREAM FONT) + (PRINTOUT STREAM "CHARSET LOCATIONS" T) (* ; "Signpost for debugging") + (SETQ CSLOC (GETFILEPTR STREAM)) + (SETFILEPTR STREAM CSVECTORPTRLOC) (* ; + "Store the address of the charset info") + (\FIXPOUT STREAM (CL:IF SINGLECS + (IMINUS CSLOC) + CSLOC)) (* ; "Negative for single") + (SETFILEPTR STREAM CSLOC) + [if SINGLECS + then + (* ;; "At most one instantiated, others are either all uninstantiated or all empty, no need for the vector") + + (if [SETQ SINGLECS (find CSNO CSINFO from 0 to (MAXCHARSET FONT) + suchthat (AND (SETQ CSINFO (\GETCHARSETINFO FONT CSNO)) + (NOT (fetch (CHARSETINFO CSSLUGP) of CSINFO] + then (\FIXPOUT STREAM SINGLECS) (* ; + "Charsetno prefix as cell, not byte") + (\BOUT STREAM (CL:IF (EQ 0 (FONTPROP FONT 'NUNINSTANTIATEDCHARSETS)) + 1 + 2)) (* ; "All others") + (MEDLEYFONT.WRITE.CHARSET FONT SINGLECS STREAM NOINDIRECTS) + else + (* ;; + "Fake charset meaning all the same: -1 if all empty, -2 if all uninstantiated.") + + (\FIXPOUT STREAM (CL:IF (EQ 0 (FONTPROP FONT 'NUNINSTANTIATEDCHARSETS)) + -1 + -2))) + else + (* ;; "Allocate the vector space") + + (for CSNO from 0 to (MAXCHARSET FONT) do (\FIXPOUT STREAM 0)) + (for CSNO CSINFO from 0 to (MAXCHARSET FONT) when (SETQ CSINFO (\GETCHARSETINFO + FONT CSNO)) + do + (* ;; "LOC remains zero if the charset is NIL=uninstantiated. Could have initialized array to -1, flipped to zero here if uninstantiated") + + (if (fetch (CHARSETINFO CSSLUGP) of CSINFO) + then (CL:SETF (CL:SVREF CHARSETLOCS CSNO) + -1) + else (CL:SETF (CL:SVREF CHARSETLOCS CSNO) + (GETFILEPTR STREAM)) + (MEDLEYFONT.WRITE.CHARSET FONT CSNO STREAM NOINDIRECTS))) + (SETFILEPTR STREAM CSLOC) (* ; "Fill in the vector") + (for CSNO from 0 to (MAXCHARSET FONT) do (\FIXPOUT STREAM (CL:SVREF CHARSETLOCS CSNO + ] + (FULLNAME STREAM]) (MEDLEYFONT.GETCHARSET - [LAMBDA (STREAM CHARSET FONT) (* ; "Edited 14-Feb-2026 00:36 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") + (* ; "Edited 17-Mar-2026 11:42 by rmk") + (* ; "Edited 14-Feb-2026 00:36 by rmk") (* ; "Edited 9-Oct-2025 15:18 by rmk") (* ; "Edited 3-Sep-2025 11:32 by rmk") (* ; "Edited 15-Jul-2025 17:09 by rmk") (* ; "Edited 9-Jul-2025 15:45 by rmk") (* ; "Edited 14-May-2025 17:46 by rmk") - (* ;; "If open, assume its a medleyfont stream, that the initial Me etc. has been checked, and we are positioned after the header information. FONT is provided so that properties of the fontdescriptor can be read through this interface--ottherwise the fontcreate function of each device might have to also have a list of functions to try.") + (* ;; "If open, assume its a medleyfont stream, that the initial %"Medley...%" has been checked, FONT is consistent with information in the file, and we are positioned after the header information, at the location of CSLOC.") - (CL:UNLESS (<= 0 CHARSET \MAXCHARSET) - (\ILLEGAL.ARG CHARSET)) + (SETQ CHARSET (CHARSET.DECODE CHARSET)) (RESETLST (CL:UNLESS (\GETSTREAM STREAM 'INPUT T) [RESETSAVE (SETQ STREAM (OPENSTREAM STREAM 'INPUT)) - `(PROGN (CLOSEF? OLDVALUE] - (CL:UNLESS (MEDLEYFONT.FILEP STREAM) (* ; - "Checks and positions, if reopening.") - (ERROR "NOT A MEDLEYFONT FILE" (FULLNAME STREAM)))) - (LET ((CSVECTORLOC (\FIXPIN STREAM)) - CSLOC) - (if (thereis CS from 0 to \MAXTHINCHAR suchthat (\GETCHARSETINFO FONT CS)) - then - (* ;; "Font fields have been initialized, just update for this charset") - - (for P VAL in (MEDLEYFONT.READ.FONTPROPS STREAM) - do (SETQ VAL (CADR P)) - (SELECTQ (CAR VAL) - (\SFAscent (change (fetch (FONTDESCRIPTOR \SFAscent) of FONT) - (IMAX VAL DATUM))) - (\SFDescent (change (fetch (FONTDESCRIPTOR \SFDescent) of FONT) - (IMAX VAL DATUM))) - (\SFHeight (fetch (FONTDESCRIPTOR \SFHeight) of FONT)) - NIL)) - else - (* ;; "First charset, probably 0: establish the overall font properties. ") - - (MEDLEYFONT.READ.VERIFIEDFONT STREAM FONT)) - (replace (FONTDESCRIPTOR FONTCOMPLETEP) of FONT with NIL) - - (* ;; - "One charset doesn't %"complete%" a complete font--maybe that's only an incore property? ") - - (* ;; "We know now that this file has information about the requested charset, including NIL entries for empty/slugglish ones in the middle of populated ones. A file that would have contain a single empty/sluggish charset cannot be created--the caller would recognize the case of a missing file and provide either NIL or a slug-vector.") - - (CL:WHEN (if (ILESSP CSVECTORLOC 0) - then - (* ;; "File contains only one charset. Is it the one we want? If the intended charset is empty/sluggish, the file would not have been constructed and we wouldn't be here.") - - (SETFILEPTR STREAM (IMINUS CSVECTORLOC)) - (EQ CHARSET (BIN STREAM)) - else - (* ;; "The vector-entry points to the one we want. Is it there?") - - (SETFILEPTR STREAM (IPLUS CSVECTORLOC (UNFOLD CHARSET BYTESPERCELL))) - (CL:UNLESS (EQ 0 (SETQ CSLOC (\FIXPIN STREAM))) - (SETFILEPTR STREAM CSLOC))) - (MEDLEYFONT.READ.CHARSET STREAM CHARSET FONT))))]) + `(PROGN (CLOSEF? OLDVALUE]) + (MEDLEYFONT.FILEVERSION STREAM 1) + (MEDLEYFONT.READ.ITEM STREAM 'MAXCHARSET) + (MEDLEYFONT.GETCHARSET.INTERNAL STREAM CHARSET FONT (\FIXPIN STREAM)))]) + +(MEDLEYFONT.GETCHARSET.INTERNAL + [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).") + + (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 (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 15-Jul-2025 15:21 by rmk") + [LAMBDA (FILE CHARSET) (* ; "Edited 16-Mar-2026 00:31 by rmk") + (* ; "Edited 15-Jul-2025 15:21 by rmk") (* ; "Edited 25-May-2025 20:53 by rmk") (* ; "Edited 21-May-2025 11:35 by rmk") (* ; "Edited 17-May-2025 11:29 by rmk") (* ; "Edited 14-May-2025 17:46 by rmk") - - (* ;; "If CHARSET, returns CHARSET if FILE contains a non-slug entry for CHARSET. If not CHARSET, returns the list of non-slug charsets in FILE.") - - (CL:WITH-OPEN-FILE (STREAM FILE :DIRECTION :INPUT) - (CL:UNLESS (MEDLEYFONT.FILEP STREAM) - (ERROR "Not a MEDLEYFONT file" FILE)) - (LET ((CSVECTORLOC (\FIXPIN STREAM))) - (CL:WHEN (if (ILESSP CSVECTORLOC 0) - then - (* ;; "File contains only one charse, is it the one we want? ") - - (SETFILEPTR STREAM (IMINUS CSVECTORLOC)) - (EQ CHARSET (BIN STREAM)) - else (SETFILEPTR STREAM (IPLUS CSVECTORLOC (UNFOLD CHARSET BYTESPERCELL))) - (NEQ 0 (\FIXPIN STREAM))) - CHARSET]) + (SETQ CHARSET (CHARSET.DECODE CHARSET)) + (LET [(CHARSETS (MEDLEYFONT.GETFILEPROP FILE 'CHARSETS] + (CL:IF CHARSET + (CAR (MEMB CHARSET CHARSETS)) + CHARSETS)]) (MEDLEYFONT.GETFILEPROP - [LAMBDA (FILE PROP) (* ; "Edited 27-Aug-2025 17:12 by rmk") + [LAMBDA (FILE PROP) (* ; "Edited 4-May-2026 09:57 by rmk") + (* ; "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") + (* ; "Edited 27-Aug-2025 17:12 by rmk") (* ; "Edited 15-Jul-2025 20:21 by rmk") (* ; "Edited 10-Jul-2025 17:50 by rmk") (* ; "Edited 25-May-2025 20:53 by rmk") (* ; "Edited 21-May-2025 11:36 by rmk") - (* ; "Edited 17-May-2025 19:07 by rmk") - (* ; "Edited 14-May-2025 17:46 by rmk") - (CL:UNLESS (OR (LITATOM FILE) - (STRINGP FILE)) - [SETQ FILE (CAR (FONTFILES (FONTPROP (FONTCREATE FILE) - 'SPEC]) - (CL:WITH-OPEN-FILE (STREAM FILE :DIRECTION :INPUT) - (LET (HEADERPROPS CSVECTORLOC) + (* ; "Edited 17-May-2025 19:07 by rmk") + (SETQ FILE (OR (MEDLEYFONT.FILENAME FILE) + (ERROR "FILE NOT FOUND" FILE))) + (CL:WITH-OPEN-FILE (STREAM (OR (MEDLEYFONT.FILENAME FILE) + FILE) + :DIRECTION :INPUT) + (LET (HEADERPROPS CSLOC SINGLECS MAXCHARSET) (CL:UNLESS (SETQ HEADERPROPS (MEDLEYFONT.FILEP STREAM)) (ERROR "Not a MEDLEYFONT file" (FULLNAME STREAM))) - (SETQ CSVECTORLOC (\FIXPIN STREAM)) + (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 CSVECTORLOC 0) + (CHARSETS (* ; "Skips slugs and indirects") + (if (ILESSP CSLOC 0) then - (* ;; "File contains only one charset ") - - (SETFILEPTR STREAM (IMINUS CSVECTORLOC)) - (CONS (BIN STREAM)) - else (SETFILEPTR STREAM CSVECTORLOC) - (for CS from 0 to \MAXCHARSET unless (EQ 0 (\FIXPIN STREAM)) - collect CS))) + (* ;; "File contains only one instantiated charset ") + + (SETFILEPTR STREAM (IMINUS CSLOC)) + (SETQ SINGLECS (\FIXPIN STREAM)) + (CL:WHEN (IGEQ SINGLECS 0) + (CONS SINGLECS)) + else (SETFILEPTR STREAM CSLOC) + (for CS from 0 to MAXCHARSET when (IGREATERP (\FIXPIN STREAM) + 0) collect CS))) + (INDIRECTS + (* ;; + "These are fully spelled out FONTSPECS, no need to fill in defaults") + + (CADR (ASSOC 'ICS (MEDLEYFONT.READ.FONTPROPS STREAM)))) (ERROR "Unknown MEDLEYFONT property"]) (MEDLEYFONT.FILEP - [LAMBDA (FILE) (* ; "Edited 6-Jul-2025 11:44 by rmk") + [LAMBDA (FILE) (* ; "Edited 30-Mar-2026 11:58 by rmk") + (* ; "Edited 29-Mar-2026 10:50 by rmk") + (* ; "Edited 24-Mar-2026 00:55 by rmk") + (* ; "Edited 6-Jul-2025 11:44 by rmk") (* ; "Edited 10-Jun-2025 18:19 by rmk") (* ; "Edited 8-Jun-2025 22:55 by rmk") (* ; "Edited 25-May-2025 20:54 by rmk") @@ -258,7 +289,7 @@ (* ;; "If FILE is an open stream, it is left open. Otherwise it is opened and closed.") (RESETLST - [LET (STREAM VERSION DATE) + [LET (STREAM) [if (\GETSTREAM FILE 'INPUT T) then (SETQ STREAM FILE) else (RESETSAVE (SETQ STREAM (OPENSTREAM FILE 'INPUT)) @@ -266,11 +297,26 @@ (CL:UNLESS (ZEROP (GETFILEPTR STREAM)) (SETFILEPTR STREAM 0)) (CL:WHEN (for C in (CONSTANT (CHCON "Medley font")) always (EQ C (READCCODE STREAM))) - [CAR (NLSETQ [CL:WHEN (EQ 0 (SETQ VERSION (MEDLEYFONT.READ.ITEM STREAM 'VERSION] - `(,(FULLNAME STREAM) - ,(MEDLEYFONT.READ.ITEM STREAM 'DATE) - ,VERSION - ,@(MEDLEYFONT.READ.ITEM STREAM 'OTHERFONTPROPS])])]) + + (* ;; "This sticks the file's MAXCHARSET on the stream, so MEDLEYFONT.GETCHARSET can do a bounds check even without decoding all the other font information. ") + + [CAR (NLSETQ `([VERSION ,(MKATOM (MEDLEYFONT.READ.ITEM STREAM 'VERSION] + (FILE ,(FULLNAME STREAM)) + [DATE ,(MEDLEYFONT.READ.ITEM STREAM 'DATE] + ,@(MEDLEYFONT.READ.ITEM STREAM 'OTHERFONTPROPS])])]) + +(MEDLEYFONT.FILEVERSION + [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* [(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]) ) @@ -280,97 +326,82 @@ (DEFINEQ (MEDLEYFONT.READ.FONT - [LAMBDA (FILE CHARSETNOS FONT) (* ; "Edited 20-Jan-2026 22:31 by rmk") + [LAMBDA (FILE CHARSETS NOERROR DIRECTORY) (* ; "Edited 5-May-2026 11:05 by rmk") + (* ; "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") + (* ; "Edited 30-Mar-2026 12:08 by rmk") + (* ; "Edited 26-Mar-2026 23:23 by rmk") + (* ; "Edited 25-Mar-2026 00:07 by rmk") + (* ; "Edited 21-Mar-2026 00:31 by rmk") + (* ; "Edited 18-Mar-2026 23:51 by rmk") + (* ; "Edited 17-Mar-2026 10:16 by rmk") + (* ; "Edited 2-Mar-2026 20:40 by rmk") + (* ; "Edited 20-Jan-2026 22:31 by rmk") (* ; "Edited 31-Aug-2025 14:42 by rmk") (* ; "Edited 15-Jul-2025 20:20 by rmk") (* ; "Edited 9-Jul-2025 00:06 by rmk") (* ; "Edited 6-Jul-2025 11:45 by rmk") - (SETQ FONT (CL:IF FONT - (FONTCREATE FONT) - (create FONTDESCRIPTOR))) - (SETQ FILE (MEDLEYFONT.FILENAME FILE FONT)) - (SETQ CHARSETNOS (SORT (MKLIST CHARSETNOS))) - (CL:WITH-OPEN-FILE (STREAM FILE :DIRECTION :INPUT) - (CL:UNLESS (MEDLEYFONT.FILEP STREAM) - (ERROR "NOT A MEDLEYFONT FILE" (FULLNAME STREAM))) - (LET ((*READTABLE* (FIND-READTABLE "INTERLISP")) - CSVECTORLOC NOTFOUND SINGLECSNO) - (SETQ CSVECTORLOC (\FIXPIN STREAM)) (* ; - "Byte location of the charset dispatch vector") - - (* ;; "We know now that this file has information about all requested charsets, including NIL entries for empty/slugglish ones in the middle of populated ones. A file that would have contain a single empty/sluggish charset cannot be created--the caller would recognize the case of a missing file and provide either NIL or a slug-vector.") - - (SETQ FONT (MEDLEYFONT.READ.VERIFIEDFONT STREAM FONT)) - (CL:UNLESS (EQ CSVECTORLOC 0) (* ; "Not empty") - [if (ILESSP CSVECTORLOC 0) - then - (* ;; - "File contains only one charset and it's the one we want. Its CHARSET number is in the first byte.") - - (* ;; "If the intended charset is empty/sluggish, the file would not have been constructed and we wouldn't be here.") - - (SETFILEPTR STREAM (IMINUS CSVECTORLOC)) - (SETQ SINGLECSNO (BIN STREAM)) - (CL:WHEN CHARSETNOS - (CL:UNLESS (AND (EQ SINGLECSNO (CAR CHARSETNOS)) - (NULL (CDR CHARSETNOS))) - (ERROR (CONCAT FILE - " does not contain information for charsets " - (REMOVE SINGLECSNO CHARSETNOS))))) - (\SETCHARSETINFO FONT SINGLECSNO (MEDLEYFONT.READ.CHARSET STREAM - SINGLECSNO)) - else - (* ;; - "Gather all of the CSLOCS before reading, so that we always move forward") - - (for CSNO CSLOC - in (OR CHARSETNOS (for I from 0 to \MAXCHARSET collect I)) - eachtime (SETFILEPTR STREAM (IPLUS CSVECTORLOC (UNFOLD CSNO - BYTESPERCELL))) - (SETQ CSLOC (\FIXPIN STREAM)) - (CL:WHEN (ZEROP CSLOC) - (push NOTFOUND CSNO)) unless (ZEROP CSLOC) - collect (CONS CSNO CSLOC) - finally (CL:WHEN (AND CHARSETNOS NOTFOUND) - (ERROR FILE (CONCAT - " does not contain information for charsets " - (DREVERSE NOTFOUND)))) - (for X CS in $$VAL do (SETQ CSNO (CAR X)) - (SETFILEPTR STREAM (CDR X)) - (\SETCHARSETINFO FONT CSNO ( - MEDLEYFONT.READ.CHARSET - STREAM CSNO]) - FONT]) + + (* ;; "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.") + + (CL:WHEN [OR (MEMB CHARSETS '(NIL ALL)) + (SETQ CHARSETS (SORT (CHARSET.DECODE (MKLIST CHARSETS) + NOERROR] + (RESETLST + (LET ((FILENAME (MEDLEYFONT.FILENAME FILE DIRECTORY)) + STREAM FONT CSLOC MAXCHARSET) (* ; + "CL:OPEN-FILE doesn't exist in the init") + (if FILENAME + then [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 + elseif NOERROR + then NIL + else (ERROR "FONT FILE NOT FOUND" FILE)))))]) (MEDLEYFONT.READ.CHARSET - [LAMBDA (STREAM CHARSET FONT) (* ; "Edited 14-Feb-2026 00:36 by rmk") + [LAMBDA (STREAM CHARSET FONT) (* ; "Edited 4-May-2026 12:38 by rmk") + (* ; "Edited 30-Apr-2026 08:56 by rmk") + (* ; "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") (* ; "Edited 4-Sep-2025 10:39 by rmk") - (* ; "Edited 28-Aug-2025 15:27 by rmk") - (* ; "Edited 26-Aug-2025 23:36 by rmk") (* ; "Edited 17-Aug-2025 13:01 by rmk") (* ; "Edited 15-Jul-2025 11:27 by rmk") - (* ; "Edited 9-Jul-2025 19:33 by rmk") - (* ; "Edited 6-Jul-2025 10:11 by rmk") - (* ; "Edited 25-May-2025 20:54 by rmk") - (* ; "Edited 23-May-2025 11:01 by rmk") - (* ; "Edited 21-May-2025 16:25 by rmk") - (* ; "Edited 16-May-2025 20:19 by rmk") - (* ; "Edited 14-May-2025 10:43 by rmk") (* ; "Edited 12-May-2025 07:55 by rmk") - - (* ;; "FONT is only needed for the \READCHARSET call below that interprets an INDIRECT and leads to a recursiving invocation of MEDLEYFONT.GETCHARSET and this function. It is the font descriptor provided at the top-level call. ") - - (MEDLEYFONT.READ.ITEM STREAM 'CHARSETSTRING) (* ; + (* ;  "Throwaway for looking with text editor") - (LET (CSNO INDIRECT) - (CL:UNLESS [EQ CHARSET (SETQ CSNO (MEDLEYFONT.READ.ITEM STREAM 'CHARSET] + (LET (CSNO) + (CL:UNLESS [EQ CHARSET (SETQ CSNO (MKATOM (MEDLEYFONT.READ.ITEM STREAM 'CS] (ERROR "Charset mismatch" (LIST CHARSET CSNO))) - (if (EQ 'INDIRECTCHARSET (CAR (MEDLEYFONT.PEEK.ITEM STREAM))) + (if (EQ 'ICS (CAR (MEDLEYFONT.PEEK.ITEM STREAM))) then - (* ;; "Read what we peeked and use it to create a complete charset from another file (e.g. shared Kanji). ") - - (SETQ INDIRECT (MEDLEYFONT.READ.ITEM STREAM 'INDIRECTCHARSET)) - (\READCHARSET INDIRECT CHARSET FONT) + (* ;; "Indirect: Read what we peeked and use it to create a complete charset from another file (e.g. shared Kanji). The indirect source is in the same directory and has the same extension as the starting file.") + + (MEDLEYFONT.GETCHARSET (MEDLEYFONT.FILENAME (MAKEFONTSPEC (MEDLEYFONT.READ.ITEM + STREAM + 'ICS) + NIL NIL NIL NIL + (FONTPROP FONT 'DEVICESPEC)) + (FULLNAME STREAM)) + CHARSET FONT) else (bind PAIR LABEL ITEM (CSINFO _ (create CHARSETINFO WIDTHS _ NIL OFFSETS _ NIL)) eachtime (SETQ PAIR @@ -516,20 +547,31 @@ (bind PAIR until [EQ 'STOP (CAR (SETQ PAIR (MEDLEYFONT.READ.ITEM STREAM] collect PAIR]) (MEDLEYFONT.READ.VERIFIEDFONT - [LAMBDA (STREAM FONT) (* ; "Edited 20-Jan-2026 22:31 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") + (* ; "Edited 2-Mar-2026 20:40 by rmk") + (* ; "Edited 20-Jan-2026 22:31 by rmk") (* ; "Edited 2-Sep-2025 23:52 by rmk") (* ; "Edited 12-Aug-2025 17:57 by rmk") (* ; "Edited 10-Jun-2025 20:57 by rmk") (* ; "Edited 21-May-2025 22:55 by rmk") (* ; "Edited 19-May-2025 17:42 by rmk") (* ; "Edited 16-May-2025 10:28 by rmk") - (LET ((FONTPROPS (MEDLEYFONT.READ.FONTPROPS STREAM))) + (LET ((FONTPROPS (MEDLEYFONT.READ.FONTPROPS STREAM)) + (FONT (create FONTDESCRIPTOR + FONTCHARSETVECTOR _ NIL))) (for P VAL in FONTPROPS do (SETQ VAL (CADR P)) (SELECTQ (CAR P) (FONTDEVICE (replace (FONTDESCRIPTOR FONTDEVICE) of FONT with VAL)) (FONTCOMPLETEP (replace (FONTDESCRIPTOR FONTCOMPLETEP) of FONT with VAL)) + (FONTCOERCEDP (replace (FONTDESCRIPTOR FONTCOERCEDP) + of FONT with VAL)) (FONTFAMILY (replace (FONTDESCRIPTOR FONTFAMILY) of FONT with VAL)) (FONTSIZE (replace (FONTDESCRIPTOR FONTSIZE) of FONT @@ -544,6 +586,8 @@ with VAL)) (ROTATION (replace (FONTDESCRIPTOR ROTATION) of FONT with VAL)) + (MAXCHARSET (replace (FONTDESCRIPTOR MAXCHARSET) of FONT + with VAL)) (FONTSLUGWIDTH (replace (FONTDESCRIPTOR FONTSLUGWIDTH) of FONT with VAL)) (FONTTOMCCSFN (replace (FONTDESCRIPTOR FONTTOMCCSFN) @@ -556,24 +600,25 @@ of FONT with VAL)) (FONTSCALE (replace (FONTDESCRIPTOR FONTSCALE) of FONT with VAL)) - (\SFFACECODE (replace (FONTDESCRIPTOR \SFFACECODE) - of FONT with VAL)) (FONTAVGCHARWIDTH (replace (FONTDESCRIPTOR FONTAVGCHARWIDTH) of FONT with VAL)) (FONTCHARENCODING (replace (FONTDESCRIPTOR FONTCHARENCODING) of FONT with VAL)) - (FONTCHARSETVECTOR - (replace (FONTDESCRIPTOR FONTCHARSETVECTOR) of FONT - with VAL)) (FONTHASLEFTKERNS (replace (FONTDESCRIPTOR FONTHASLEFTKERNS) of FONT with VAL)) (FONTEXTRAFIELD2 (replace (FONTDESCRIPTOR FONTEXTRAFIELD2) of FONT with VAL)) + (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]) ) @@ -584,7 +629,9 @@ (DEFINEQ (MEDLEYFONT.WRITE.CHARSET - [LAMBDA (FONT CHARSET STREAM NOINDIRECTS) (* ; "Edited 4-Sep-2025 11:41 by rmk") + [LAMBDA (FONT CHARSET STREAM NOINDIRECTS) (* ; "Edited 4-May-2026 11:53 by rmk") + (* ; "Edited 1-Apr-2026 09:20 by rmk") + (* ; "Edited 4-Sep-2025 11:41 by rmk") (* ; "Edited 30-Aug-2025 23:44 by rmk") (* ; "Edited 28-Aug-2025 21:00 by rmk") (* ; "Edited 9-Jul-2025 19:14 by rmk") @@ -593,10 +640,9 @@ (* ; "Edited 16-May-2025 20:18 by rmk") (* ; "Edited 13-May-2025 23:26 by rmk") (LET ((CSINFO (\INSURECHARSETINFO FONT CHARSET)) - CSCHARENCODING) - (MEDLEYFONT.WRITE.ITEM STREAM 'CHARSETSTRING (MKSTRING CHARSET)) - (* ; "For human file-scan") - (MEDLEYFONT.WRITE.ITEM STREAM 'CHARSET CHARSET) + CSCHARENCODING INDIRECT) + (MEDLEYFONT.WRITE.ITEM STREAM 'CS (MKSTRING CHARSET)) + (* ; "String for human file-scan") (CL:UNLESS (OR (NULL CSINFO) (fetch (CHARSETINFO CSSLUGP) of CSINFO)) (* ; @@ -604,12 +650,21 @@ (* ;; "Copy the fonts charencoding down to each charset info so that it is available when the charsetinfo is read. The fontdescriptor isn't available at that point and coercion could lead to fonts of different encodings. At least this would make it possible to fix things up.") - (if (CL:UNLESS NOINDIRECTS (INDIRECTCHARSETP CSINFO FONT)) + (if (CL:UNLESS NOINDIRECTS + (SETQ INDIRECT (INDIRECTCHARSETP CSINFO FONT))) then - (* ;; - "This charset is is taken entirely from on another file, no need to copy it to this file.") - - (MEDLEYFONT.WRITE.ITEM STREAM 'INDIRECTCHARSET (CHARSETPROP CSINFO 'SOURCE) + (* ;; "This charset is is taken entirely from another file, no need to copy it to this file. Leave off the redundant FONTSPEC stuff") + + (MEDLEYFONT.WRITE.ITEM STREAM 'ICS (LIST* (fetch (FONTSPEC FSFAMILY) + of INDIRECT) + (fetch (FONTSPEC FSSIZE) of INDIRECT) + (fetch (FONTSPEC FSFACE) of INDIRECT) + (CL:UNLESS + (EQ (FONTPROP FONT 'ROTATION) + (fetch (FONTSPEC FSROTATION) + of INDIRECT)) + (fetch (FONTSPEC FSROTATION) + of INDIRECT))) NIL 'PRINT) else (MEDLEYFONT.WRITE.ITEM STREAM 'CSINFOPROPS (fetch (CHARSETINFO CSINFOPROPS) @@ -774,7 +829,12 @@ (TERPRI STREAM))]) (MEDLEYFONT.WRITE.FONTPROPS - [LAMBDA (STREAM FONT) (* ; "Edited 12-Aug-2025 17:55 by rmk") + [LAMBDA (STREAM FONT) (* ; "Edited 4-May-2026 09:57 by rmk") + (* ; "Edited 31-Mar-2026 14:53 by rmk") + (* ; "Edited 23-Mar-2026 11:52 by rmk") + (* ; "Edited 19-Mar-2026 11:48 by rmk") + (* ; "Edited 18-Mar-2026 08:17 by rmk") + (* ; "Edited 12-Aug-2025 17:55 by rmk") (* ; "Edited 10-Jun-2025 20:50 by rmk") (* ; "Edited 25-May-2025 20:50 by rmk") (* ; "Edited 22-May-2025 10:31 by rmk") @@ -785,7 +845,7 @@ (* ;; "HPRINT would be obvious, but it would get charsetvector etc.") - (* ;; "Exclude FONTCHARSETVECTOR and \SFFACECODE") + (* ;; "Exclude FONTCHARSETVECTOR ") (* ;; "Write even NIL values for default overerides") @@ -793,6 +853,8 @@ T) (MEDLEYFONT.WRITE.ITEM STREAM 'FONTCOMPLETEP (fetch (FONTDESCRIPTOR FONTCOMPLETEP) of FONT) T) + (MEDLEYFONT.WRITE.ITEM STREAM 'FONTCOERCEDP (fetch (FONTDESCRIPTOR FONTCOMPLETEP) of FONT) + T) (MEDLEYFONT.WRITE.ITEM STREAM 'FONTFAMILY (fetch (FONTDESCRIPTOR FONTFAMILY) of FONT) T) (MEDLEYFONT.WRITE.ITEM STREAM 'FONTSIZE (fetch (FONTDESCRIPTOR FONTSIZE) of FONT) @@ -807,6 +869,8 @@ T) (MEDLEYFONT.WRITE.ITEM STREAM 'ROTATION (fetch (FONTDESCRIPTOR ROTATION) of FONT) T) + (MEDLEYFONT.WRITE.ITEM STREAM 'MAXCHARSET (fetch (FONTDESCRIPTOR MAXCHARSET) of FONT) + T) (MEDLEYFONT.WRITE.ITEM STREAM 'FONTSLUGWIDTH (fetch (FONTDESCRIPTOR FONTSLUGWIDTH) of FONT) T) (MEDLEYFONT.WRITE.ITEM STREAM 'FONTTOMCCSFN (fetch (FONTDESCRIPTOR FONTTOMCCSFN) of FONT) @@ -827,53 +891,54 @@ (MEDLEYFONT.WRITE.ITEM STREAM 'FONTHASLEFTKERNS (fetch (FONTDESCRIPTOR FONTHASLEFTKERNS) of FONT) T) - (MEDLEYFONT.WRITE.ITEM STREAM 'FONTEXTRAFIELD2 (fetch (FONTDESCRIPTOR FONTEXTRAFIELD2) - of FONT) + (MEDLEYFONT.WRITE.ITEM STREAM 'INDIRECTS (for CS CSINFO INDIRECT (FSPEC _ (FONTPROP FONT + 'DEVICESPEC)) + from 0 to (MAXCHARSET FONT) + when (SETQ CSINFO (\GETCHARSETINFO FONT CS)) + when (SETQ INDIRECT (CHARSETPROP CSINFO 'SOURCE)) + unless (EQUAL FSPEC INDIRECT) + unless (MEMBER INDIRECT $$VAL) + do (push $$VAL INDIRECT)) T) (MEDLEYFONT.WRITE.ITEM STREAM 'STOP T]) (MEDLEYFONT.WRITE.HEADER - [LAMBDA (STREAM OTHERFONTPROPS) (* ; "Edited 25-May-2025 20:51 by rmk") + [LAMBDA (STREAM OTHERFONTPROPS FONT) (* ; "Edited 29-Mar-2026 10:45 by rmk") + (* ; "Edited 24-Mar-2026 00:55 by rmk") + (* ; "Edited 25-May-2025 20:51 by rmk") (* ; "Edited 16-May-2025 20:20 by rmk") (* ; "Edited 14-May-2025 17:01 by rmk") (* ;; "Me in first 2 bytes distinguishes MEDLEYFONT format from others") (PRINTOUT STREAM "Medley font" T) - (MEDLEYFONT.WRITE.ITEM STREAM 'VERSION 0) + (MEDLEYFONT.WRITE.ITEM STREAM 'VERSION "1") (MEDLEYFONT.WRITE.ITEM STREAM 'DATE (DATE)) (MEDLEYFONT.WRITE.ITEM STREAM 'OTHERFONTPROPS OTHERFONTPROPS T]) ) (DEFINEQ (MEDLEYFONT.FILENAME - [LAMBDA (FILE FONT CHARSET EXTENSION DIRECTORY) (* ; "Edited 23-Jan-2026 15:10 by rmk") - (* ; "Edited 20-Jan-2026 17:39 by rmk") + [LAMBDA (FILE DIRECTORY) (* ; "Edited 5-May-2026 11:02 by rmk") + (* ; "Edited 4-May-2026 09:01 by rmk") + (* ; "Edited 30-Apr-2026 08:54 by rmk") + (* ; "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 25-May-2025 21:25 by rmk") - (* ; "Edited 19-May-2025 17:42 by rmk") - (* ; "Edited 16-May-2025 14:09 by rmk") - (LET [(FONTSPEC (AND FONT (\FONT.CHECKARGS FONT NIL NIL NIL NIL T] - (CL:UNLESS EXTENSION (* ; - "EXTENSION may be needed for DIRECTORY below") - (SETQ EXTENSION (OR (FILENAMEFIELD FILE 'EXTENSION) - (CONCAT "MEDLEY" (OR (AND FONTSPEC (fetch (FONTSPEC FSDEVICE) - of FONTSPEC)) - (ERROR "Font device not known")) - "FONT")))) - (PACKFILENAME.STRING `(BODY ,FILE ,@(UNPACKFILENAME.STRING (AND FONTSPEC - (\FONTFILENAME FONTSPEC NIL - NIL NIL CHARSET))) - DIRECTORY - ,(OR DIRECTORY (FILENAMEFIELD FILE 'DIRECTORY) - (PSEUDOFILENAME (CONCAT (MEDLEYDIR) - "fonts/" - (L-CASE EXTENSION) - "s"))) - EXTENSION - ,EXTENSION]) + (* ; "Edited 10-Jun-2025 11:02 by rmk") + (CL:WHEN (\GETSTREAM FILE 'INPUT T) + (SETQ FILE (FULLNAME FILE))) + (CL:WHEN DIRECTORY (* ; "Keep the host/directory.") + (SETQ DIRECTORY (PACKFILENAME 'NAME NIL 'EXTENSION NIL 'VERSION NIL 'BODY DIRECTORY))) + (if (type? FONTSPEC FILE) + then (SETQ FILE (\FONT.CHECKARGS FILE NIL NIL NIL NIL T)) + (CL:UNLESS DIRECTORY + [SETQ DIRECTORY (CAR (MKLIST (FONTDEVICEPROP FILE 'FONTDIRECTORIES]) + (PACKFILENAME 'DIRECTORY DIRECTORY 'BODY (\FONTFILENAME FILE)) + elseif FILE + then (* ; "File name") + (PACKFILENAME 'BODY FILE 'DIRECTORY DIRECTORY]) ) (ADDTOVAR DISPLAYFONTEXTENSIONS MEDLEYDISPLAYFONT) @@ -924,11 +989,12 @@ ) ) (DECLARE%: DONTCOPY - (FILEMAP (NIL (2152 16901 (MEDLEYFONT.WRITE.FONT 2162 . 7217) (MEDLEYFONT.GETCHARSET 7219 . 11360) ( -MEDLEYFONT.CHARSET? 11362 . 12831) (MEDLEYFONT.GETFILEPROP 12833 . 14933) (MEDLEYFONT.FILEP 14935 . -16899)) (16927 39618 (MEDLEYFONT.READ.FONT 16937 . 21473) (MEDLEYFONT.READ.CHARSET 21475 . 27190) ( -MEDLEYFONT.READ.ITEM 27192 . 33341) (MEDLEYFONT.PEEK.ITEM 33343 . 34205) (MEDLEYFONT.READ.FONTPROPS -34207 . 34672) (MEDLEYFONT.READ.VERIFIEDFONT 34674 . 39616)) (39644 57481 (MEDLEYFONT.WRITE.CHARSET -39654 . 44216) (MEDLEYFONT.WRITE.ITEM 44218 . 53271) (MEDLEYFONT.WRITE.FONTPROPS 53273 . 56826) ( -MEDLEYFONT.WRITE.HEADER 56828 . 57479)) (57482 59848 (MEDLEYFONT.FILENAME 57492 . 59846))))) + (FILEMAP (NIL (2199 20663 (MEDLEYFONT.WRITE.FONT 2209 . 8612) (MEDLEYFONT.GETCHARSET 8614 . 10695) ( +MEDLEYFONT.GETCHARSET.INTERNAL 10697 . 12950) (MEDLEYFONT.CHARSET? 12952 . 13830) ( +MEDLEYFONT.GETFILEPROP 13832 . 17396) (MEDLEYFONT.FILEP 17398 . 19826) (MEDLEYFONT.FILEVERSION 19828 + . 20661)) (20689 44110 (MEDLEYFONT.READ.FONT 20699 . 24534) (MEDLEYFONT.READ.CHARSET 24536 . 30297) ( +MEDLEYFONT.READ.ITEM 30299 . 36448) (MEDLEYFONT.PEEK.ITEM 36450 . 37312) (MEDLEYFONT.READ.FONTPROPS +37314 . 37779) (MEDLEYFONT.READ.VERIFIEDFONT 37781 . 44108)) (44136 64607 (MEDLEYFONT.WRITE.CHARSET +44146 . 49791) (MEDLEYFONT.WRITE.ITEM 49793 . 58846) (MEDLEYFONT.WRITE.FONTPROPS 58848 . 63732) ( +MEDLEYFONT.WRITE.HEADER 63734 . 64605)) (64608 66260 (MEDLEYFONT.FILENAME 64618 . 66258))))) STOP diff --git a/sources/MEDLEYFONTFORMAT.LCOM b/sources/MEDLEYFONTFORMAT.LCOM index 23ade3fca..e3b594602 100644 Binary files a/sources/MEDLEYFONTFORMAT.LCOM and b/sources/MEDLEYFONTFORMAT.LCOM differ