diff --git a/.gitignore b/.gitignore index 05dfa4ac..3c9271a4 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 b551332e..fefa7ddc 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 60c35031..f0568196 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 5862edc9..7d0a35e0 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 7e097410..29fac787 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 bf0ff5ca..f97890b2 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 ad3c04a9..5e1beeee 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 9a675e6e..e3651170 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 4e42bf3e..6cdbed7e 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 c7d70781..33f60077 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 0ddaa3e2..5d6749ff 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 686ab999..34408957 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 937e5ec9..9a59f476 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 f66b84d2..b4bb5110 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 3f42b67a..ac1432e4 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 c77aec9a..428d4c7f 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 6d2afa99..2b005161 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 13d8deb3..062e37b7 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 69e2f79a..3533e867 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 6910398c..f00d0db9 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 e1fd46a5..cba3d531 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 d7899b11..4645dc51 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 935417cf..e81035b2 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 b6cb0eb9..c318f8b7 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 91cbdf1a..03461db2 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 f1c486a5..c623c4f6 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 69071ab5..1e191280 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 ab4b66c0..5d0ecf2c 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 b73e8f8f..4a4de2a7 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 bfae6477..01356b28 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 7582fcfe..1e1294f6 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 7a6c26c5..618f6910 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 5a9f8db1..00a88410 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 5bab2758..9b791696 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 602378a4..13ef5bb5 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 05f0cb03..fe9125ad 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 f57be8b7..8848c29c 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 bef29c47..a21ca793 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 b39546e0..7e0107b4 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 38fa036e..53944a3b 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 d0adb6e8..0ff3544d 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 2fc103e5..cc2a960c 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 84d2f90b..2d4b8aaf 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 ea61ba75..6fcf22dc 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 657c1a6a..20bb6ef1 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 ae19e6c5..5864e3e9 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 1780022d..1b32d1e0 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 2a26521f..61541677 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 6dcb0f0b..61ecf472 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 22381a5b..d15d5f41 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 0155a1f6..7ef2bd8c 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 31273373..74654bf3 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 65323aff..30c52112 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 76bba70a..2209c15d 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 d30310da..1f4f3d01 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 6a074ab1..31df1b2a 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 595cd1b6..e7eaeff7 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 c5fb32ea..ce0cb4fd 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 2f3e4e30..b01cebd5 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 3113db1a..e93572bd 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 c3842790..7ef7b50e 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 2f109992..4c164d88 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 6a294d9b..d6705f72 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 63d5a043..1ce0fe4c 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 941c2342..a215cafa 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 ec96a35a..24d1f394 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 54766a90..18c26eeb 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 fb79d651..2df453d0 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 009c0b89..02057418 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 cfe6f2ae..2525767c 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 a02573ed..2ecfe75d 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 65b5386e..cfcadc0f 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 6cfa533f..a54cba0c 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 c264951c..d8327fd1 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 b38ff0cc..59ca3a1d 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 4bf1da56..a54dd837 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 85824628..6a7097fd 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 86700494..da0d5327 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 0eba79fa..7bda9ca6 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 100e6705..6aa2868e 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 09380969..b28feedd 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 e142a0ff..3eb1351d 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 35352708..52474303 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 582b838e..117c5a2a 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 757c9677..f5c76540 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 28b59dd9..c79f1645 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 3150b898..16680330 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 84e45f41..dc077048 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 ba3894c8..108d601c 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 eddb73c2..e25587ed 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 997d07fa..958193f2 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 da96ebb3..fefcb78e 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 6aa28f62..2e9447a2 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 4a8b3e8f..f9da7c09 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 209e302f..00c2a345 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 0c1e1b21..d3f62062 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 6cc841cc..0d4a2fb3 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 6c765132..ef9720d2 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 fcd6f98a..8c195fd1 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 3d805194..ecad4861 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 00000000..08ae605c 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 92c61f01..e129c8c2 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 57e14507..fd525dba 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 ef591039..df14c505 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 e360e8dc..9baf3c8d 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 dedb5a78..f1f80a75 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 0ae39c69..e4e3fc92 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 370f5e1a..ed64bc23 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 b39098e9..564949e6 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 3677b2f4..b4a7eea0 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 4395de50..5644fafd 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 5e951aa2..6c4a2276 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 b9066bc0..b309c5a5 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 d1806732..c254931e 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 afee037a..08d3b01f 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 5de7a734..6a280afa 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 14c2849d..ed5cd66b 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 06dc993a..f53ec4f4 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 ed130af7..89e59231 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 7a6d6017..0e721682 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 a09b820a..a38ab1e6 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 b07cff62..77c2aa02 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 7635574d..d1b2e5b9 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 12f0ebd3..5224bee9 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 174d6f8f..1a3f9333 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 cf3abcdc..51674120 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 eb3d292b..08d6ff51 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 00e8b68a..2c716040 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 4d38bf9b..2145cbb2 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 f0da3b4c..5189c2b6 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 76834e15..f6d371fa 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 a3a3fe0a..3f9f66a6 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 061e0acf..ee0bce61 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 68e33e30..f720fb0f 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 9b07379a..c29cd1e3 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 a0ef4568..4f7ae150 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 434744e8..9bfb5d3b 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 06cc06f1..21569a28 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 3ece2bb8..1c98a8b4 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 4794c0d7..bb5ada93 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 1684628c..702c290c 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 85702654..03fbf37f 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 3514c1d1..5b9d3baf 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 d7049b38..2a66a9bb 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 a203b4dc..788b1eec 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 ec037e6a..5b663b84 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 2da2adec..1caf09bb 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 4024b5c7..e19ce4d1 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 acf6dfee..260e5bc2 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 31caeada..3f725940 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 b6c03d6d..c8ae78b9 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 227a575a..ab3bfefe 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 683a48a4..a47035ec 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 23247993..78ec0e18 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 7b3b444f..f5906daa 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 3297fff3..626a42b7 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 23bb4146..7a4afafb 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 14c5e271..a3446411 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 14f75684..5365620c 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 32cad1a9..4e91b535 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 17515bca..f4b0a7bd 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 3df06e8c..56d23f23 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 fd8f923f..e36d05a4 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 32265288..67e01094 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 29bbf403..486af530 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 fa6cdb7f..1db25d21 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 eba69c23..bd91ad8c 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 4c227188..26f19daf 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 0fbf0029..f9bc3b70 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 eb5237a8..1f2ae0be 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 fe01c5c1..1548c041 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 6614fad9..cf0ad88d 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 db20313d..7468c5c7 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 2ffbde84..f704b67c 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 30ce68e1..570e3222 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 2081f3c9..6ee2cd11 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 0d2092ee..7cc2765d 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 e103896e..b5fa6cdf 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 4c5ce497..20a7f41a 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 02f2655c..21e5e085 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 89143a4b..ef404596 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 6d380404..a05ba1b8 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 976e8574..6cee6dbf 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 371aa640..0e61adbb 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 109dc7a2..f09b841c 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 bac61e3b..c525e384 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 62ce7106..9265692a 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 5dce481b..4debef3f 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 2da9f706..187c1cd5 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 cdb26c38..83c5d748 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 9e2be3b3..524135a8 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 f2595ad4..9642a7db 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 ca7bbf79..16e25c5b 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 72649022..ae06799a 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 6ccaaa1b..48d3931d 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 879d8f98..f3de6e8b 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 e40b3317..02301193 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 668b67ed..4e5e0659 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 8a37a21e..f498a53a 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 813319ef..7d6db09e 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 5344b462..48206af1 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 35cc9938..69a3b0cb 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 7bd96de2..bc88af66 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 55557aba..be9eb6cb 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 52e9d680..92e34ab9 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 c29eb4b2..60e85e57 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 2e38763b..359bec45 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 6a821f07..9e8220d6 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 057ef5a4..02a98454 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 0bf77789..4067aaed 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 4333fee4..32894128 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 982cf494..9c0ceb6c 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 b7dd890c..d438f962 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 83c96acf..6bcb0d87 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 75fc5dcd..db45bbf5 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 738b4062..fbe52278 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 a4c0a42a..9efa309b 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 44d84023..540ede91 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 68a8ddfe..3113d84a 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 58bdacf3..1ffd4e71 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 5e16f67a..47a91ae5 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 2c97f591..b446d462 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 08cf7bf5..42216f28 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 bcb48dfa..5765c14c 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 bba53d34..63005c6e 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 565b4ca5..9b2c8015 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 112fda5b..e97bf08c 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 2791a46e..c9cc18a7 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 4161e3cc..df0e8133 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 7882febd..78f65780 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 bdc564a5..c49f6666 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 140cd7f3..0e3a4476 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 5b3c4b28..a6ba92f7 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 9e92e11b..79d844a7 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 54939d69..b0ad0a36 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 bd5bb2df..eaa7c45d 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 2a34f2dc..adbc9378 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 80fa3524..eeac5dcc 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 fc7ef985..7c5d8155 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 b32bc387..8ebbbed5 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 b6a02188..004e3f0b 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 5a5a47dc..5adf6485 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 80811492..262ee029 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 4e2a59e8..34f4b64d 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 d8949ed2..665b18b1 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 e7b786cb..49e38622 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 e252c0a7..a48d162a 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 e3c75b95..97c0f8ff 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 9f3a1c33..7a27b845 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 f65434d8..615b2138 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 7fc4a650..d4751fde 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 965f0fbb..f90d6679 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 b8cf422e..b71e7cb5 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 37e61038..24b45edc 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 81116f3a..89e397c1 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 139ab7c0..9d1aae3e 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 94621017..c81127cb 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 76b36917..57c464cf 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 3bb4f000..ae27b12f 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 5fb575fb..fd12e988 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 f69385b5..e6c433b1 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 361fd9be..32f3b861 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 158a9589..41d627ef 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 0eb8291e..f6c771fe 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 da159397..5b7b9df4 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 804d9253..8f12eabe 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 44ce64f4..591165e2 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 a8838eb5..1045cacf 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 1433f6d4..e2707bd2 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 906f6164..1f22e1c0 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 c0f9260e..49bcae8c 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 56621117..2d63bf20 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 984f1eb1..cf578e34 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 c50de730..a07b6f2c 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 841213b4..31edaacc 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 eb0d3a4c..539ea1ee 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 c2f6e204..992ac377 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 286dd663..ad6e3490 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 fe30c703..947a43a5 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 db5f35a0..b35c312b 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 2dec349b..adbe84da 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 37388286..bfef0b9f 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 108249f2..fb9a0863 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 fa0d85df..92e48391 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 d344204e..fed45f32 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 f3b67660..cfaf98fe 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 04dc1c2f..9588aa43 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 e9038580..72a09963 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 57afd0a7..5c0127b8 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 63fc17ae..61e61d16 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 4f227a00..cdf6e840 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 1b69a883..824c5d98 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 f3f398bf..f638517c 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 cce65430..010bd05f 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 9e1ac57c..f6a4836e 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 4753c507..6b25f35c 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 1a3abf24..c3f99048 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 5682c241..bec58a72 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 396235c1..13471565 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 2609a021..9acbbc2b 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 8f83544c..b2365c9e 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 39864870..6a985074 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 cf3ab299..f17a0264 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 08343668..9fc3968f 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 631932c1..63bfb81c 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 7fb98080..a3d7073e 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 8455c394..f211680b 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 c5227622..adc95620 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 cf847707..dbe2e7a7 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 107951a5..d8081c52 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 9d7dca17..b681d3ac 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 2bbfe60e..e13f8ab0 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 00000000..460c1507 --- /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 00000000..91ebfacd 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 00000000..59b6c048 Binary files /dev/null and b/library/IMPORTFONTS.TEDIT differ diff --git a/library/POSTSCRIPTSTREAM b/library/POSTSCRIPTSTREAM index c715c964..3ddd19d3 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 "11-May-2026 10:22:21" {MEDLEY}POSTSCRIPTSTREAM.;73 258415 - :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 "26-Apr-2026 11:39:26" {MEDLEY}POSTSCRIPTSTREAM.;71) (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)) @@ -154,6 +150,7 @@ (LOGO (HELVETICA 1)) (OPTIMA (PALATINO 1)) (TITAN (COURIER 1)) + (* CLASSIC) (* (* 1] (POSTSCRIPTCHARCOERCIONS NIL) (\POSTSCRIPT.MAX.WILD.FONTSIZE 72)) @@ -878,7 +875,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 +996,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 +4298,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)) @@ -4319,6 +4316,7 @@ (LOGO (HELVETICA 1)) (OPTIMA (PALATINO 1)) (TITAN (COURIER 1)) + (* CLASSIC) (* (* 1)))) (RPAQ? POSTSCRIPTCHARCOERCIONS NIL) @@ -4393,37 +4391,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 (22135 32454 (POSTSCRIPT.INIT 22145 . 29060) (POSTSCRIPT.PUTRGBCOLOR 29062 . 30084) ( +\PSC.COLOR.TO.RGB 30086 . 32452)) (33440 69285 (PSCFONT.READFONT 33450 . 35461) (PSCFONT.SPELLFILE +35463 . 36276) (PSCFONT.COERCEFILE 36278 . 37850) (PSCFONTFROMCACHE.SPELLFILE 37852 . 38837) ( +PSCFONTFROMCACHE.COERCEFILE 38839 . 40491) (PSCFONT.WRITEFONT 40493 . 41508) (READ-AFM-FILE 41510 . +47381) (CONVERT-AFM-FILES 47383 . 48595) (POSTSCRIPT.GETFONTID 48597 . 49992) (POSTSCRIPT.FONTCREATE +49994 . 63208) (\POSTSCRIPT.SPECIALFONT.SCALEDWIDTHS 63210 . 65607) (POSTSCRIPT.FONTSAVAILABLE 65609 + . 67896) (POSTSCRIPT.FONTEXISTS? 67898 . 69283)) (69286 79195 (OPENPOSTSCRIPTSTREAM 69296 . 78861) ( +CLOSEPOSTSCRIPTSTREAM 78863 . 79193)) (79240 85566 (POSTSCRIPT.HARDCOPYW 79250 . 82357) ( +POSTSCRIPT.TEDIT 82359 . 82811) (POSTSCRIPTFILEP 82813 . 84301) (MAKEEPSFILE 84303 . 85564)) (85567 +129311 (POSTSCRIPT.BITMAPSCALE 85577 . 88033) (POSTSCRIPT.CLOSESTRING 88035 . 88588) ( +POSTSCRIPT.ENDPAGE 88590 . 89481) (POSTSCRIPT.OUTSTR 89483 . 90700) (POSTSCRIPT.PUTBITMAPBYTES 90702 + . 99173) (POSTSCRIPT.PUTCOMMAND 99175 . 100164) (POSTSCRIPT.SET-FAKE-LANDSCAPE 100166 . 104686) ( +POSTSCRIPT.SHOWACCUM 104688 . 106843) (POSTSCRIPT.STARTPAGE 106845 . 109547) (\POSTSCRIPTTAB 109549 . +110346) (\PS.BOUTFIXP 110348 . 111628) (\PS.SCALEHACK 111630 . 114273) (\PS.SCALEREGION 114275 . +114835) (\SCALEDBITBLT.PSC 114837 . 119147) (\SETPOS.PSC 119149 . 119630) (\SETXFORM.PSC 119632 . +122216) (\STRINGWIDTH.PSC 122218 . 122691) (\SWITCHFONTS.PSC 122693 . 128185) (\TERPRI.PSC 128187 . +129309)) (129346 183202 (\BITBLT.PSC 129356 . 129908) (\BLTSHADE.PSC 129910 . 134571) (\CHARWIDTH.PSC +134573 . 135080) (\CREATECHARSET.PSC 135082 . 136438) (\DRAWARC.PSC 136440 . 138818) (\DRAWCIRCLE.PSC +138820 . 141071) (\DRAWCURVE.PSC 141073 . 144917) (\DRAWELLIPSE.PSC 144919 . 147283) (\DRAWLINE.PSC +147285 . 150025) (\DRAWPOINT.PSC 150027 . 150603) (\DRAWPOLYGON.PSC 150605 . 153734) ( +\DSPBOTTOMMARGIN.PSC 153736 . 154423) (\DSPCLIPPINGREGION.PSC 154425 . 155800) (\DSPCOLOR.PSC 155802 + . 156733) (\DSPFONT.PSC 156735 . 160372) (\DSPLEFTMARGIN.PSC 160374 . 161060) (\DSPLINEFEED.PSC +161062 . 161652) (\DSPPUSHSTATE.PSC 161654 . 163114) (\DSPPOPSTATE.PSC 163116 . 166601) (\DSPRESET.PSC + 166603 . 167268) (\DSPRIGHTMARGIN.PSC 167270 . 167959) (\DSPROTATE.PSC 167961 . 168960) ( +\DSPSCALE.PSC 168962 . 169914) (\DSPSCALE2.PSC 169916 . 170756) (\DSPSPACEFACTOR.PSC 170758 . 171679) +(\DSPTOPMARGIN.PSC 171681 . 172252) (\DSPTRANSLATE.PSC 172254 . 174285) (\DSPXPOSITION.PSC 174287 . +174851) (\DSPYPOSITION.PSC 174853 . 175444) (\FILLCIRCLE.PSC 175446 . 177671) (\FILLPOLYGON.PSC 177673 + . 180910) (\FIXLINELENGTH.PSC 180912 . 182231) (\MOVETO.PSC 182233 . 183003) (\NEWPAGE.PSC 183005 . +183200)) (183258 205404 (\POSTSCRIPT.CHANGECHARSET 183268 . 183986) (\POSTSCRIPT.OUTCHARFN 183988 . +196258) (\POSTSCRIPT.PRINTSLUG 196260 . 197984) (\POSTSCRIPT.SPECIALOUTCHARFN 197986 . 200337) ( +\UPDATE.PSC 200339 . 201585) (\POSTSCRIPT.ACCENTFN 201587 . 202529) (\POSTSCRIPT.ACCENTPAIR 202531 . +205402)) (205502 207147 (\PSC.SPACEDISP 205512 . 205791) (\PSC.SPACEWID 205793 . 206412) (\PSC.SYMBOLS + 206414 . 207145)) (207256 210247 (\POSTSCRIPT.NSHASH 207266 . 210245))))) STOP diff --git a/library/POSTSCRIPTSTREAM.LCOM b/library/POSTSCRIPTSTREAM.LCOM index 1778b1df..6ffd409c 100644 Binary files a/library/POSTSCRIPTSTREAM.LCOM and b/library/POSTSCRIPTSTREAM.LCOM differ diff --git a/library/PSEUDOHOSTS b/library/PSEUDOHOSTS index a563e43b..5cfb61c6 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))) + SETFILEINFO _ (FUNCTION SETFILEINFO.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.") + (* ;; "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. ") - (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))) + (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 27-Apr-2026 18:43 by rmk") + + (* ;; "Edited 26-Apr-2026 10:31 by rmk") (* ;; "Edited 22-Sep-2023 14:30 by rmk") - (* ;; "Edited 30-Jan-2022 00:20 by rmk: the smallest pseudoname for NAME. If the NAME was constructed by expanding, then") + (* ;; "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.") - (* ;; "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.") + (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) - (* ;; "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. ") + (* ;; + "PREFIXMAPs of PHDEVare sorted so that the longest one comes first, if PHOST isn't specified") - (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. ") + (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 SUFFIX (SUBSTRING NAME (ADD1 (NCHARS PREFIX] - (CL:WHEN (STRPOS ">" SUFFIX 1 NIL NIL NIL FILEDIRCASEARRAY) + (* ;; "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.") - (* ;; "CONNECTOR tells us whether to use / or > depending on what the prefix has") + (if PREFIXMAP + then (SETQ PREFIX (CADR PREFIXMAP)) + [SETQ SUFFIX (SUBSTRING TRUENAME (ADD1 (NCHARS PREFIX] + (CL:WHEN (STRPOS ">" SUFFIX) - (SETQ CONNECTOR (CADDR PM)) - [SETQ SUFFIX (CONCAT CONNECTOR (IF (EQ CONNECTOR '/) - THEN (SLASHIT SUFFIX) - ELSE (UNSLASHIT SUFFIX]) - (RETURN (PACK* '{ (CADR PM) + (* ;; + "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 ""))) FINALLY - - (* ;; "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.") - - (RETURN NAME)))]) + (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 3f8e0a28..0252b146 100644 Binary files a/library/PSEUDOHOSTS.LCOM and b/library/PSEUDOHOSTS.LCOM differ diff --git a/library/PSEUDOHOSTS.TEDIT b/library/PSEUDOHOSTS.TEDIT index ea981028..462899ae 100644 Binary files a/library/PSEUDOHOSTS.TEDIT and b/library/PSEUDOHOSTS.TEDIT differ diff --git a/library/SAMEDIR b/library/SAMEDIR index 1ff27939..1b1e67fa 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] + (* ; "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?") - (* ;; "The file is going somewhere it has never been before. ") + (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.") - (* ;; "Check that that is really what the user wants.") + (* ;; "Ask if he should over-write it.") - (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]) + (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 3185b143..32bfbbfe 100644 Binary files a/library/SAMEDIR.LCOM and b/library/SAMEDIR.LCOM differ diff --git a/library/UNICODE-TABLES b/library/UNICODE-TABLES index 166adc52..1f275912 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 6819f919..26c0cfeb 100644 Binary files a/library/UNICODE-TABLES.LCOM and b/library/UNICODE-TABLES.LCOM differ diff --git a/lispusers/EDITFONT b/lispusers/EDITFONT index ede826c6..01e163c7 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 ce1d1ae3..cac25bf6 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 96e8e6d9..420d71a7 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 00000000..f5acc7ca 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 9338e3cf..00000000 Binary files a/sources/AFONT.DFASL and /dev/null differ diff --git a/sources/FILESETS b/sources/FILESETS index 15ac01f1..2feef07f 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 1a92ec84..89c7010c 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") + (* ;; + "Makes an empty fontdescriptor for FONTSPEC, with parameters taken from SOURCEFONT if given") - (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]) + (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 + 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") - (* ;; "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.") + (* ;; "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. ") - (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 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") - (* ;; "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).") + (* ;; " 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, 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*") + (LET (PAIRINFO) - [MAPHASH PAIRS (FUNCTION (LAMBDA (VAL KEY) - (CL:UNLESS (EQ VAL KEY) - (\MOVEFONTCHAR (\MOVEFONTCHARS.SOURCEDATA KEY - DEFAULTSOURCEFONT) - VAL DESTFONT))] - else (LET (PAIRINFO) + (* ;; "Collect and execute at the end, so that we have validated all of the source information before making any changes. ") - (* ;; "Fix/check arguments, and expand out the information for all the source characters, so there is no toe-stepping if there are overlaps.") + [if (HARRAYP PAIRS) + then + (* ;; "E.g. *UNICODETOMCCS*") - (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))) + [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)))] - (* ;; "Install source character information into the destination font. ") + (* ;; + "Arguments checked out. install source character information into destfont slots. ") - (for P in PAIRINFO do (\MOVEFONTCHAR (CAR P) - (CADR P) - DESTFONT]) + (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. ") + (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)) + (SETQ CSINFO (\INSURECHARSETINFO SFONT 0)) + (SETQ CHAR8CODE SLUGCHARINDEX)) - (* ;; "Use (plural) vector field names for UPDATEINFOELEMENT. Don't know if the CHAR8CODE is useful, but...") + (* ;; "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)) + `((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.") + (* ;; "Considers all posible names for font files that respect the given characteristics, returns a list of the names of files that actually exist somewhere in DIRLST. If FONTSPEC is a FONT with a FILENAME that exists, that is the only one returned. Does not validate their contents.") - (LET (FAMILY SIZE FACE ROTATION DEVICE) - (SPREADFONTSPEC FONTSPEC) - [SETQ DIRLST (MKLIST (OR DIRLST (FONTDEVICEPROP DEVICE 'FONTDIRECTORIES] - [SETQ EXTLST (MKLIST (OR EXTLST (FONTDEVICEPROP DEVICE 'FONTEXTENSIONS] - (CL:UNLESS CHARSET (SETQ CHARSET \DEFAULTCHARSET)) - (APPEND (MKLIST (\FINDFONTFILE FAMILY SIZE FACE ROTATION DEVICE 'NOCHARSET DIRLST EXTLST)) - (MKLIST (\FINDFONTFILE FAMILY SIZE FACE ROTATION DEVICE CHARSET DIRLST EXTLST]) + (if (type? FONTDESCRIPTOR FONTSPEC) + then + (* ;; "Prefer the same version, but maybe a different version if coming up in a new environment. 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") + FONTSPEC NOCOERCIONS) + (AND (NOT NOCOERCIONS) + (SETQ COERCED (CAR (OR (COERCEFONTSPEC FONTSPEC 'FONTCOERCIONS) + (COERCEFONTSPEC FONTSPEC 'FACECOERCIONS] - (STOREMULTI \FONTEXISTS?-CACHE FONTSPEC VAL 'SASSOC) - else (STOREMULTI \FONTEXISTS?-CACHE FONTSPEC 'NO 'SASSOC) - NIL]) + (* ;; "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") + (* ;; "Removes information for font(s) from the caches in CACHES, if CACHES 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]) + (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") + (* ;; "Creates and returns the CHARSETINFO for charset CHARSET in fontdesc FONT, installing it in FONT's 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]) + (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.") - (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]) + (* ;; "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") + + (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. ") + (* ;; "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.") - (* ;; "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 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 (\READCHARSET FONT CHARSET) + else + (* ;; "Successful transformations must set the CSINFO so that it can be returned.") - (* ;; - "If no COERCIONS, skip that first \COERCECHARSET call--easier debugging of the other cases.") + (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)) - (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.") + (* ;; "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") - (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]) + (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") + (* ;; "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.") - (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]) + (* ;; "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") + (* ; "Edited 16-Aug-2025 12:53 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.") + (* ;; "Caller has determined that slug characters in FONT should be replaced by applying FAKEFN to the corresponding SOURCEFACE characters.") - (LET ([MFONT (FONTCREATE1 (create FONTSPEC using FONTSPEC FSFACE ↠(create FONTFACE - using (fetch (FONTSPEC - FSFACE) - of FONTSPEC) - WEIGHT ↠'MEDIUM] - CSINFO) + (* ;; "This assumes that SOURCEFONT has already been faked up.") - (* ;; "MFONT is the corresponding Medium font.") + (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?") - (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)]) + (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]) ) + + + +(* ; "Bitmap faking") + (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....") - - (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)))) - - (* ;; "If you uncomment out the code above, remove this comment and the NIL below") - - NIL]) - (\SFROTATECSINFO - [LAMBDA (CSINFO ROTATION) (* gbn "15-Sep-85 14:38") + [LAMBDA (FONTSPEC FONT CHARSET) (* ; "Edited 5-Apr-2026 01:31 by rmk") + (* gbn "15-Sep-85 14:38") - (* ;; "takes a CHARSETINFO and rotates it and produces a rotated equivalent one.") + (* ;; + "Replaces the CSINFO of CHARSET in FONT with one in which all the characters have been rotated.") - (create CHARSETINFO using CSINFO CHARSETBITMAP ↠(\SFROTATEFONTCHARACTERS (fetch (CHARSETINFO - CHARSETBITMAP) - of CSINFO) - ROTATION) - OFFSETS ↠(\SFROTATECSINFOOFFSETS CSINFO ROTATION]) + (* ;; "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.") + + (LET ((ROTATION (fetch (FONTSPEC FSROTATION) of FONTSPEC)) + CSINFO)) + (if (MEMB ROTATION '(90 270)) + then + (* ;; "WHAT ABOUT 180 ?") + + (* ;; "CAN THE RECURSIVE CALL BE REPLACED BY \READCHARSET ??") + + (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 a5dd6584..a050e71a 100644 Binary files a/sources/FONT.LCOM and b/sources/FONT.LCOM differ diff --git a/sources/INTERPRESS b/sources/INTERPRESS index f2097c89..d3f976cb 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 19d50a01..64fcee5b 100644 Binary files a/sources/INTERPRESS.LCOM and b/sources/INTERPRESS.LCOM differ diff --git a/sources/LLBIGNUM b/sources/LLBIGNUM index 0ffdb3eb..2e46a59b 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 a2f49541..ab7ff099 100644 Binary files a/sources/LLBIGNUM.LCOM and b/sources/LLBIGNUM.LCOM differ diff --git a/sources/LLCHAR b/sources/LLCHAR index 5959ed8d..20e66e6e 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 8fd7f263..91fcf6a2 100644 Binary files a/sources/LLCHAR.LCOM and b/sources/LLCHAR.LCOM differ diff --git a/sources/LLDISPLAY b/sources/LLDISPLAY index 6cafa80c..51f76e73 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 c1b38fe4..6033a4d9 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 d3897704..03d0d72e 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 0a78b0a6..73bb8944 100644 Binary files a/sources/LLREAD.LCOM and b/sources/LLREAD.LCOM differ diff --git a/sources/MCCS b/sources/MCCS index f4524019..db81355e 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 4b2d7afd..fd682274 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 00000000..c95fe4af --- /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 00000000..ca8a2a6c Binary files /dev/null and b/sources/MCCSFONTS.LCOM differ diff --git a/sources/MEDLEYDIR b/sources/MEDLEYDIR index 886f4497..c5ab914b 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) + (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") + (* ;; "(MEDLEYDIR a list -- recurse") - (for X Y in DIRNAME when (SETQ Y (MEDLEYDIR X FILENAME OUTPUT NOERROR)) collect Y)) - [FILENAME + (for X Y in DIRNAME when (SETQ Y (MEDLEYDIR X FILENAME OUTPUT NOERROR)) + collect Y)) + [FILENAME - (* ;; " if FILENAME, find it as a file. ") + (* ;; " 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 (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 d348dc27..6c08ba81 100644 Binary files a/sources/MEDLEYDIR.LCOM and b/sources/MEDLEYDIR.LCOM differ diff --git a/sources/MEDLEYFONTFORMAT b/sources/MEDLEYFONTFORMAT index 96f410e0..fd2dbae2 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") + + (* ;; "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)) - (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) + (CL:WITH-OPEN-FILE + (STREAM (MEDLEYFONT.FILENAME FILE) + :DIRECTION :OUTPUT :IF-EXISTS :NEW-VERSION) + (MEDLEYFONT.WRITE.HEADER STREAM OTHERFONTPROPS FONT) - (* ;; "Figure out the actual non empty/sluggish charsets that will be wrtitten.") + (* ;; "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.") - (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)) + (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") - (* ;; "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.") + (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") - (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 + (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") - (* ;; - "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]) + (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") + `(PROGN (CLOSEF? OLDVALUE]) + (MEDLEYFONT.FILEVERSION STREAM 1) + (MEDLEYFONT.READ.ITEM STREAM 'MAXCHARSET) + (MEDLEYFONT.GETCHARSET.INTERNAL STREAM CHARSET FONT (\FIXPIN STREAM)))]) - (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.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") - (MEDLEYFONT.READ.VERIFIEDFONT STREAM FONT)) - (replace (FONTDESCRIPTOR FONTCOMPLETEP) of FONT with NIL) + (* ;; "Caller guarantees STREAM and CSLOC as the location of the charset info. CHARSET is less than (MAXCHARSTE FONT).") - (* ;; - "One charset doesn't %"complete%" a complete font--maybe that's only an incore property? ") + (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") - (* ;; "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.") + (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?") - (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))))]) + (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 ") + (* ;; "File contains only one instantiated 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))) + (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.") + (* ;; "Returns a font descriptor containing the requested charsets from FILE. If FILE is a FONTSPEC, it is coerced to a standard font name on DIRECTORY.") - (SETQ 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]) + (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). ") + (* ;; "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.") - (SETQ INDIRECT (MEDLEYFONT.READ.ITEM STREAM 'INDIRECTCHARSET)) - (\READCHARSET INDIRECT CHARSET FONT) + (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.") + (* ;; "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 'INDIRECTCHARSET (CHARSETPROP CSINFO 'SOURCE) + (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 23ade3fc..e3b59460 100644 Binary files a/sources/MEDLEYFONTFORMAT.LCOM and b/sources/MEDLEYFONTFORMAT.LCOM differ