diff --git a/docs/internal/FONTCODECHANGES.tedit b/docs/internal/FONTCODECHANGES.tedit
index 732c117e0..8502fdebc 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
new file mode 100644
index 000000000..60c350314
Binary files /dev/null and b/docs/internal/MCCS.TEDIT differ
diff --git a/docs/internal/MEDLEYFONTFORMAT.TEDIT b/docs/internal/MEDLEYFONTFORMAT.TEDIT
index 36fe18ff0..5862edc92 100644
Binary files a/docs/internal/MEDLEYFONTFORMAT.TEDIT and b/docs/internal/MEDLEYFONTFORMAT.TEDIT differ
diff --git a/fonts/displayfonts/c0/CREAM12-MRR-C0.DISPLAYFONT b/fonts/displayfonts/c0/CREAM12-MRR-C0.DISPLAYFONT
index b3692631e..91165d7be 100644
Binary files a/fonts/displayfonts/c0/CREAM12-MRR-C0.DISPLAYFONT and b/fonts/displayfonts/c0/CREAM12-MRR-C0.DISPLAYFONT differ
diff --git a/fonts/medleydisplayfonts/AMTEX10-MRR.MEDLEYDISPLAYFONT b/fonts/medleydisplayfonts/AMTEX10-MRR.MEDLEYDISPLAYFONT
new file mode 100644
index 000000000..7e0974102
Binary files /dev/null and b/fonts/medleydisplayfonts/AMTEX10-MRR.MEDLEYDISPLAYFONT differ
diff --git a/fonts/medleydisplayfonts/APL14-MRR.MEDLEYDISPLAYFONT b/fonts/medleydisplayfonts/APL14-MRR.MEDLEYDISPLAYFONT
new file mode 100644
index 000000000..bf0ff5cac
Binary files /dev/null and b/fonts/medleydisplayfonts/APL14-MRR.MEDLEYDISPLAYFONT differ
diff --git a/fonts/medleydisplayfonts/ARROWS10-MRR.MEDLEYDISPLAYFONT b/fonts/medleydisplayfonts/ARROWS10-MRR.MEDLEYDISPLAYFONT
new file mode 100644
index 000000000..ad3c04a99
Binary files /dev/null and b/fonts/medleydisplayfonts/ARROWS10-MRR.MEDLEYDISPLAYFONT differ
diff --git a/fonts/medleydisplayfonts/ARROWSTWO10-MRR.MEDLEYDISPLAYFONT b/fonts/medleydisplayfonts/ARROWSTWO10-MRR.MEDLEYDISPLAYFONT
new file mode 100644
index 000000000..9a675e6ec
Binary files /dev/null and b/fonts/medleydisplayfonts/ARROWSTWO10-MRR.MEDLEYDISPLAYFONT differ
diff --git a/fonts/medleydisplayfonts/ASTERISK10-MRR.MEDLEYDISPLAYFONT b/fonts/medleydisplayfonts/ASTERISK10-MRR.MEDLEYDISPLAYFONT
new file mode 100644
index 000000000..4e42bf3eb
Binary files /dev/null and b/fonts/medleydisplayfonts/ASTERISK10-MRR.MEDLEYDISPLAYFONT differ
diff --git a/fonts/medleydisplayfonts/BLOCKFONT10-MRR.MEDLEYDISPLAYFONT b/fonts/medleydisplayfonts/BLOCKFONT10-MRR.MEDLEYDISPLAYFONT
new file mode 100644
index 000000000..c7d707812
Binary files /dev/null and b/fonts/medleydisplayfonts/BLOCKFONT10-MRR.MEDLEYDISPLAYFONT differ
diff --git a/fonts/medleydisplayfonts/BOLDPS10-BIR.MEDLEYDISPLAYFONT b/fonts/medleydisplayfonts/BOLDPS10-BIR.MEDLEYDISPLAYFONT
new file mode 100644
index 000000000..0ddaa3e27
Binary files /dev/null and b/fonts/medleydisplayfonts/BOLDPS10-BIR.MEDLEYDISPLAYFONT differ
diff --git a/fonts/medleydisplayfonts/BOLDPS10-BRR.MEDLEYDISPLAYFONT b/fonts/medleydisplayfonts/BOLDPS10-BRR.MEDLEYDISPLAYFONT
new file mode 100644
index 000000000..686ab9994
Binary files /dev/null and b/fonts/medleydisplayfonts/BOLDPS10-BRR.MEDLEYDISPLAYFONT differ
diff --git a/fonts/medleydisplayfonts/BOLDPS10-MIR.MEDLEYDISPLAYFONT b/fonts/medleydisplayfonts/BOLDPS10-MIR.MEDLEYDISPLAYFONT
new file mode 100644
index 000000000..937e5ec98
Binary files /dev/null and b/fonts/medleydisplayfonts/BOLDPS10-MIR.MEDLEYDISPLAYFONT differ
diff --git a/fonts/medleydisplayfonts/BOLDPS10-MRR.MEDLEYDISPLAYFONT b/fonts/medleydisplayfonts/BOLDPS10-MRR.MEDLEYDISPLAYFONT
new file mode 100644
index 000000000..f66b84d2a
Binary files /dev/null and b/fonts/medleydisplayfonts/BOLDPS10-MRR.MEDLEYDISPLAYFONT differ
diff --git a/fonts/medleydisplayfonts/BRAVOX12-MRR.MEDLEYDISPLAYFONT b/fonts/medleydisplayfonts/BRAVOX12-MRR.MEDLEYDISPLAYFONT
new file mode 100644
index 000000000..3f42b67aa
Binary files /dev/null and b/fonts/medleydisplayfonts/BRAVOX12-MRR.MEDLEYDISPLAYFONT differ
diff --git a/fonts/medleydisplayfonts/CARDSTWO12-MRR.MEDLEYDISPLAYFONT b/fonts/medleydisplayfonts/CARDSTWO12-MRR.MEDLEYDISPLAYFONT
new file mode 100644
index 000000000..c77aec9a4
Binary files /dev/null and b/fonts/medleydisplayfonts/CARDSTWO12-MRR.MEDLEYDISPLAYFONT differ
diff --git a/fonts/medleydisplayfonts/CARDSZERO12-MRR.MEDLEYDISPLAYFONT b/fonts/medleydisplayfonts/CARDSZERO12-MRR.MEDLEYDISPLAYFONT
new file mode 100644
index 000000000..6d2afa996
Binary files /dev/null and b/fonts/medleydisplayfonts/CARDSZERO12-MRR.MEDLEYDISPLAYFONT differ
diff --git a/fonts/medleydisplayfonts/CHINESE12-MRR.MEDLEYDISPLAYFONT b/fonts/medleydisplayfonts/CHINESE12-MRR.MEDLEYDISPLAYFONT
new file mode 100644
index 000000000..13d8deb3d
Binary files /dev/null and b/fonts/medleydisplayfonts/CHINESE12-MRR.MEDLEYDISPLAYFONT differ
diff --git a/fonts/medleydisplayfonts/CLARITY12-MRR.MEDLEYDISPLAYFONT b/fonts/medleydisplayfonts/CLARITY12-MRR.MEDLEYDISPLAYFONT
new file mode 100644
index 000000000..69e2f79ad
Binary files /dev/null and b/fonts/medleydisplayfonts/CLARITY12-MRR.MEDLEYDISPLAYFONT differ
diff --git a/fonts/medleydisplayfonts/CLARITY14-MRR.MEDLEYDISPLAYFONT b/fonts/medleydisplayfonts/CLARITY14-MRR.MEDLEYDISPLAYFONT
new file mode 100644
index 000000000..6910398cf
Binary files /dev/null and b/fonts/medleydisplayfonts/CLARITY14-MRR.MEDLEYDISPLAYFONT differ
diff --git a/fonts/medleydisplayfonts/CLASSIC06-BRR.MEDLEYDISPLAYFONT b/fonts/medleydisplayfonts/CLASSIC06-BRR.MEDLEYDISPLAYFONT
new file mode 100644
index 000000000..e1fd46a50
Binary files /dev/null and b/fonts/medleydisplayfonts/CLASSIC06-BRR.MEDLEYDISPLAYFONT differ
diff --git a/fonts/medleydisplayfonts/CLASSIC06-MIR.MEDLEYDISPLAYFONT b/fonts/medleydisplayfonts/CLASSIC06-MIR.MEDLEYDISPLAYFONT
new file mode 100644
index 000000000..d7899b117
Binary files /dev/null and b/fonts/medleydisplayfonts/CLASSIC06-MIR.MEDLEYDISPLAYFONT differ
diff --git a/fonts/medleydisplayfonts/CLASSIC06-MRR.MEDLEYDISPLAYFONT b/fonts/medleydisplayfonts/CLASSIC06-MRR.MEDLEYDISPLAYFONT
new file mode 100644
index 000000000..935417cfb
Binary files /dev/null and b/fonts/medleydisplayfonts/CLASSIC06-MRR.MEDLEYDISPLAYFONT differ
diff --git a/fonts/medleydisplayfonts/CLASSIC08-BRR.MEDLEYDISPLAYFONT b/fonts/medleydisplayfonts/CLASSIC08-BRR.MEDLEYDISPLAYFONT
new file mode 100644
index 000000000..b6cb0eb99
Binary files /dev/null and b/fonts/medleydisplayfonts/CLASSIC08-BRR.MEDLEYDISPLAYFONT differ
diff --git a/fonts/medleydisplayfonts/CLASSIC08-MIR.MEDLEYDISPLAYFONT b/fonts/medleydisplayfonts/CLASSIC08-MIR.MEDLEYDISPLAYFONT
new file mode 100644
index 000000000..91cbdf1a9
Binary files /dev/null and b/fonts/medleydisplayfonts/CLASSIC08-MIR.MEDLEYDISPLAYFONT differ
diff --git a/fonts/medleydisplayfonts/CLASSIC08-MRR.MEDLEYDISPLAYFONT b/fonts/medleydisplayfonts/CLASSIC08-MRR.MEDLEYDISPLAYFONT
new file mode 100644
index 000000000..f1c486a55
Binary files /dev/null and b/fonts/medleydisplayfonts/CLASSIC08-MRR.MEDLEYDISPLAYFONT differ
diff --git a/fonts/medleydisplayfonts/CLASSIC10-BRR.MEDLEYDISPLAYFONT b/fonts/medleydisplayfonts/CLASSIC10-BRR.MEDLEYDISPLAYFONT
new file mode 100644
index 000000000..69071ab58
Binary files /dev/null and b/fonts/medleydisplayfonts/CLASSIC10-BRR.MEDLEYDISPLAYFONT differ
diff --git a/fonts/medleydisplayfonts/CLASSIC10-MIR.MEDLEYDISPLAYFONT b/fonts/medleydisplayfonts/CLASSIC10-MIR.MEDLEYDISPLAYFONT
new file mode 100644
index 000000000..ab4b66c05
Binary files /dev/null and b/fonts/medleydisplayfonts/CLASSIC10-MIR.MEDLEYDISPLAYFONT differ
diff --git a/fonts/medleydisplayfonts/CLASSIC10-MRR.MEDLEYDISPLAYFONT b/fonts/medleydisplayfonts/CLASSIC10-MRR.MEDLEYDISPLAYFONT
new file mode 100644
index 000000000..b73e8f8fc
Binary files /dev/null and b/fonts/medleydisplayfonts/CLASSIC10-MRR.MEDLEYDISPLAYFONT differ
diff --git a/fonts/medleydisplayfonts/CLASSIC12-BRR.MEDLEYDISPLAYFONT b/fonts/medleydisplayfonts/CLASSIC12-BRR.MEDLEYDISPLAYFONT
new file mode 100644
index 000000000..bfae64774
Binary files /dev/null and b/fonts/medleydisplayfonts/CLASSIC12-BRR.MEDLEYDISPLAYFONT differ
diff --git a/fonts/medleydisplayfonts/CLASSIC12-MIR.MEDLEYDISPLAYFONT b/fonts/medleydisplayfonts/CLASSIC12-MIR.MEDLEYDISPLAYFONT
new file mode 100644
index 000000000..7582fcfe8
Binary files /dev/null and b/fonts/medleydisplayfonts/CLASSIC12-MIR.MEDLEYDISPLAYFONT differ
diff --git a/fonts/medleydisplayfonts/CLASSIC12-MRR.MEDLEYDISPLAYFONT b/fonts/medleydisplayfonts/CLASSIC12-MRR.MEDLEYDISPLAYFONT
new file mode 100644
index 000000000..7a6c26c56
Binary files /dev/null and b/fonts/medleydisplayfonts/CLASSIC12-MRR.MEDLEYDISPLAYFONT differ
diff --git a/fonts/medleydisplayfonts/CLASSIC14-BRR.MEDLEYDISPLAYFONT b/fonts/medleydisplayfonts/CLASSIC14-BRR.MEDLEYDISPLAYFONT
new file mode 100644
index 000000000..5a9f8db11
Binary files /dev/null and b/fonts/medleydisplayfonts/CLASSIC14-BRR.MEDLEYDISPLAYFONT differ
diff --git a/fonts/medleydisplayfonts/CLASSIC14-MIR.MEDLEYDISPLAYFONT b/fonts/medleydisplayfonts/CLASSIC14-MIR.MEDLEYDISPLAYFONT
new file mode 100644
index 000000000..5bab2758e
Binary files /dev/null and b/fonts/medleydisplayfonts/CLASSIC14-MIR.MEDLEYDISPLAYFONT differ
diff --git a/fonts/medleydisplayfonts/CLASSIC14-MRR.MEDLEYDISPLAYFONT b/fonts/medleydisplayfonts/CLASSIC14-MRR.MEDLEYDISPLAYFONT
new file mode 100644
index 000000000..602378a4e
Binary files /dev/null and b/fonts/medleydisplayfonts/CLASSIC14-MRR.MEDLEYDISPLAYFONT differ
diff --git a/fonts/medleydisplayfonts/CLASSIC18-BRR.MEDLEYDISPLAYFONT b/fonts/medleydisplayfonts/CLASSIC18-BRR.MEDLEYDISPLAYFONT
new file mode 100644
index 000000000..05f0cb03e
Binary files /dev/null and b/fonts/medleydisplayfonts/CLASSIC18-BRR.MEDLEYDISPLAYFONT differ
diff --git a/fonts/medleydisplayfonts/CLASSIC18-MIR.MEDLEYDISPLAYFONT b/fonts/medleydisplayfonts/CLASSIC18-MIR.MEDLEYDISPLAYFONT
new file mode 100644
index 000000000..f57be8b70
Binary files /dev/null and b/fonts/medleydisplayfonts/CLASSIC18-MIR.MEDLEYDISPLAYFONT differ
diff --git a/fonts/medleydisplayfonts/CLASSIC18-MRR.MEDLEYDISPLAYFONT b/fonts/medleydisplayfonts/CLASSIC18-MRR.MEDLEYDISPLAYFONT
new file mode 100644
index 000000000..bef29c477
Binary files /dev/null and b/fonts/medleydisplayfonts/CLASSIC18-MRR.MEDLEYDISPLAYFONT differ
diff --git a/fonts/medleydisplayfonts/CLASSIC24-BRR.MEDLEYDISPLAYFONT b/fonts/medleydisplayfonts/CLASSIC24-BRR.MEDLEYDISPLAYFONT
new file mode 100644
index 000000000..b39546e03
Binary files /dev/null and b/fonts/medleydisplayfonts/CLASSIC24-BRR.MEDLEYDISPLAYFONT differ
diff --git a/fonts/medleydisplayfonts/CLASSIC24-MIR.MEDLEYDISPLAYFONT b/fonts/medleydisplayfonts/CLASSIC24-MIR.MEDLEYDISPLAYFONT
new file mode 100644
index 000000000..38fa036ec
Binary files /dev/null and b/fonts/medleydisplayfonts/CLASSIC24-MIR.MEDLEYDISPLAYFONT differ
diff --git a/fonts/medleydisplayfonts/CLASSIC24-MRR.MEDLEYDISPLAYFONT b/fonts/medleydisplayfonts/CLASSIC24-MRR.MEDLEYDISPLAYFONT
new file mode 100644
index 000000000..d0adb6e86
Binary files /dev/null and b/fonts/medleydisplayfonts/CLASSIC24-MRR.MEDLEYDISPLAYFONT differ
diff --git a/fonts/medleydisplayfonts/CLASSIC48-BRR.MEDLEYDISPLAYFONT b/fonts/medleydisplayfonts/CLASSIC48-BRR.MEDLEYDISPLAYFONT
new file mode 100644
index 000000000..2fc103e54
Binary files /dev/null and b/fonts/medleydisplayfonts/CLASSIC48-BRR.MEDLEYDISPLAYFONT differ
diff --git a/fonts/medleydisplayfonts/CLASSIC48-MIR.MEDLEYDISPLAYFONT b/fonts/medleydisplayfonts/CLASSIC48-MIR.MEDLEYDISPLAYFONT
new file mode 100644
index 000000000..84d2f90b6
Binary files /dev/null and b/fonts/medleydisplayfonts/CLASSIC48-MIR.MEDLEYDISPLAYFONT differ
diff --git a/fonts/medleydisplayfonts/CLASSIC48-MRR.MEDLEYDISPLAYFONT b/fonts/medleydisplayfonts/CLASSIC48-MRR.MEDLEYDISPLAYFONT
new file mode 100644
index 000000000..ea61ba753
Binary files /dev/null and b/fonts/medleydisplayfonts/CLASSIC48-MRR.MEDLEYDISPLAYFONT differ
diff --git a/fonts/medleydisplayfonts/CLASSIC72-BRR.MEDLEYDISPLAYFONT b/fonts/medleydisplayfonts/CLASSIC72-BRR.MEDLEYDISPLAYFONT
new file mode 100644
index 000000000..657c1a6ae
Binary files /dev/null and b/fonts/medleydisplayfonts/CLASSIC72-BRR.MEDLEYDISPLAYFONT differ
diff --git a/fonts/medleydisplayfonts/CLASSIC72-MIR.MEDLEYDISPLAYFONT b/fonts/medleydisplayfonts/CLASSIC72-MIR.MEDLEYDISPLAYFONT
new file mode 100644
index 000000000..ae19e6c59
Binary files /dev/null and b/fonts/medleydisplayfonts/CLASSIC72-MIR.MEDLEYDISPLAYFONT differ
diff --git a/fonts/medleydisplayfonts/CLASSIC72-MRR.MEDLEYDISPLAYFONT b/fonts/medleydisplayfonts/CLASSIC72-MRR.MEDLEYDISPLAYFONT
new file mode 100644
index 000000000..1780022d5
Binary files /dev/null and b/fonts/medleydisplayfonts/CLASSIC72-MRR.MEDLEYDISPLAYFONT differ
diff --git a/fonts/medleydisplayfonts/CLASSICPIONE08-MRR.MEDLEYDISPLAYFONT b/fonts/medleydisplayfonts/CLASSICPIONE08-MRR.MEDLEYDISPLAYFONT
new file mode 100644
index 000000000..2a26521f3
Binary files /dev/null and b/fonts/medleydisplayfonts/CLASSICPIONE08-MRR.MEDLEYDISPLAYFONT differ
diff --git a/fonts/medleydisplayfonts/CLASSICPIONE10-MRR.MEDLEYDISPLAYFONT b/fonts/medleydisplayfonts/CLASSICPIONE10-MRR.MEDLEYDISPLAYFONT
new file mode 100644
index 000000000..6dcb0f0b1
Binary files /dev/null and b/fonts/medleydisplayfonts/CLASSICPIONE10-MRR.MEDLEYDISPLAYFONT differ
diff --git a/fonts/medleydisplayfonts/CLASSICPIONE12-MRR.MEDLEYDISPLAYFONT b/fonts/medleydisplayfonts/CLASSICPIONE12-MRR.MEDLEYDISPLAYFONT
new file mode 100644
index 000000000..22381a5bf
Binary files /dev/null and b/fonts/medleydisplayfonts/CLASSICPIONE12-MRR.MEDLEYDISPLAYFONT differ
diff --git a/fonts/medleydisplayfonts/CLASSICPIONE14-MRR.MEDLEYDISPLAYFONT b/fonts/medleydisplayfonts/CLASSICPIONE14-MRR.MEDLEYDISPLAYFONT
new file mode 100644
index 000000000..0155a1f65
Binary files /dev/null and b/fonts/medleydisplayfonts/CLASSICPIONE14-MRR.MEDLEYDISPLAYFONT differ
diff --git a/fonts/medleydisplayfonts/CLASSICTHIN16-BRR.MEDLEYDISPLAYFONT b/fonts/medleydisplayfonts/CLASSICTHIN16-BRR.MEDLEYDISPLAYFONT
new file mode 100644
index 000000000..31273373e
Binary files /dev/null and b/fonts/medleydisplayfonts/CLASSICTHIN16-BRR.MEDLEYDISPLAYFONT differ
diff --git a/fonts/medleydisplayfonts/CLASSICTHIN16-MRR.MEDLEYDISPLAYFONT b/fonts/medleydisplayfonts/CLASSICTHIN16-MRR.MEDLEYDISPLAYFONT
new file mode 100644
index 000000000..65323affb
Binary files /dev/null and b/fonts/medleydisplayfonts/CLASSICTHIN16-MRR.MEDLEYDISPLAYFONT differ
diff --git a/fonts/medleydisplayfonts/CLASSICTHIN20-BRR.MEDLEYDISPLAYFONT b/fonts/medleydisplayfonts/CLASSICTHIN20-BRR.MEDLEYDISPLAYFONT
new file mode 100644
index 000000000..76bba70ac
Binary files /dev/null and b/fonts/medleydisplayfonts/CLASSICTHIN20-BRR.MEDLEYDISPLAYFONT differ
diff --git a/fonts/medleydisplayfonts/CLASSICTHIN20-MRR.MEDLEYDISPLAYFONT b/fonts/medleydisplayfonts/CLASSICTHIN20-MRR.MEDLEYDISPLAYFONT
new file mode 100644
index 000000000..d30310da0
Binary files /dev/null and b/fonts/medleydisplayfonts/CLASSICTHIN20-MRR.MEDLEYDISPLAYFONT differ
diff --git a/fonts/medleydisplayfonts/CLASSICTHIN26-BRR.MEDLEYDISPLAYFONT b/fonts/medleydisplayfonts/CLASSICTHIN26-BRR.MEDLEYDISPLAYFONT
new file mode 100644
index 000000000..6a074ab1a
Binary files /dev/null and b/fonts/medleydisplayfonts/CLASSICTHIN26-BRR.MEDLEYDISPLAYFONT differ
diff --git a/fonts/medleydisplayfonts/CLASSICTHIN26-MRR.MEDLEYDISPLAYFONT b/fonts/medleydisplayfonts/CLASSICTHIN26-MRR.MEDLEYDISPLAYFONT
new file mode 100644
index 000000000..595cd1b6f
Binary files /dev/null and b/fonts/medleydisplayfonts/CLASSICTHIN26-MRR.MEDLEYDISPLAYFONT differ
diff --git a/fonts/medleydisplayfonts/CLASSICTHIN30-BRR.MEDLEYDISPLAYFONT b/fonts/medleydisplayfonts/CLASSICTHIN30-BRR.MEDLEYDISPLAYFONT
new file mode 100644
index 000000000..c5fb32ea3
Binary files /dev/null and b/fonts/medleydisplayfonts/CLASSICTHIN30-BRR.MEDLEYDISPLAYFONT differ
diff --git a/fonts/medleydisplayfonts/CLASSICTHIN30-MRR.MEDLEYDISPLAYFONT b/fonts/medleydisplayfonts/CLASSICTHIN30-MRR.MEDLEYDISPLAYFONT
new file mode 100644
index 000000000..2f3e4e305
Binary files /dev/null and b/fonts/medleydisplayfonts/CLASSICTHIN30-MRR.MEDLEYDISPLAYFONT differ
diff --git a/fonts/medleydisplayfonts/CREAM10-MRR.MEDLEYDISPLAYFONT b/fonts/medleydisplayfonts/CREAM10-MRR.MEDLEYDISPLAYFONT
new file mode 100644
index 000000000..3113db1a4
Binary files /dev/null and b/fonts/medleydisplayfonts/CREAM10-MRR.MEDLEYDISPLAYFONT differ
diff --git a/fonts/medleydisplayfonts/CREAM12-MRR.MEDLEYDISPLAYFONT b/fonts/medleydisplayfonts/CREAM12-MRR.MEDLEYDISPLAYFONT
new file mode 100644
index 000000000..c3842790e
Binary files /dev/null and b/fonts/medleydisplayfonts/CREAM12-MRR.MEDLEYDISPLAYFONT differ
diff --git a/fonts/medleydisplayfonts/CYRILLIC10-MRR.MEDLEYDISPLAYFONT b/fonts/medleydisplayfonts/CYRILLIC10-MRR.MEDLEYDISPLAYFONT
new file mode 100644
index 000000000..2f109992f
Binary files /dev/null and b/fonts/medleydisplayfonts/CYRILLIC10-MRR.MEDLEYDISPLAYFONT differ
diff --git a/fonts/medleydisplayfonts/CYRILLIC12-MRR.MEDLEYDISPLAYFONT b/fonts/medleydisplayfonts/CYRILLIC12-MRR.MEDLEYDISPLAYFONT
new file mode 100644
index 000000000..6a294d9be
Binary files /dev/null and b/fonts/medleydisplayfonts/CYRILLIC12-MRR.MEDLEYDISPLAYFONT differ
diff --git a/fonts/medleydisplayfonts/DANATEN10-MRR.MEDLEYDISPLAYFONT b/fonts/medleydisplayfonts/DANATEN10-MRR.MEDLEYDISPLAYFONT
new file mode 100644
index 000000000..63d5a0434
Binary files /dev/null and b/fonts/medleydisplayfonts/DANATEN10-MRR.MEDLEYDISPLAYFONT differ
diff --git a/fonts/medleydisplayfonts/DANATWELVE12-MRR.MEDLEYDISPLAYFONT b/fonts/medleydisplayfonts/DANATWELVE12-MRR.MEDLEYDISPLAYFONT
new file mode 100644
index 000000000..941c23428
Binary files /dev/null and b/fonts/medleydisplayfonts/DANATWELVE12-MRR.MEDLEYDISPLAYFONT differ
diff --git a/fonts/medleydisplayfonts/DANATWELVE14-MRR.MEDLEYDISPLAYFONT b/fonts/medleydisplayfonts/DANATWELVE14-MRR.MEDLEYDISPLAYFONT
new file mode 100644
index 000000000..ec96a35a3
Binary files /dev/null and b/fonts/medleydisplayfonts/DANATWELVE14-MRR.MEDLEYDISPLAYFONT differ
diff --git a/fonts/medleydisplayfonts/DANCER10-MRR.MEDLEYDISPLAYFONT b/fonts/medleydisplayfonts/DANCER10-MRR.MEDLEYDISPLAYFONT
new file mode 100644
index 000000000..54766a908
Binary files /dev/null and b/fonts/medleydisplayfonts/DANCER10-MRR.MEDLEYDISPLAYFONT differ
diff --git a/fonts/medleydisplayfonts/DANCER12-MRR.MEDLEYDISPLAYFONT b/fonts/medleydisplayfonts/DANCER12-MRR.MEDLEYDISPLAYFONT
new file mode 100644
index 000000000..fb79d6517
Binary files /dev/null and b/fonts/medleydisplayfonts/DANCER12-MRR.MEDLEYDISPLAYFONT differ
diff --git a/fonts/medleydisplayfonts/ELITE10-MRR.MEDLEYDISPLAYFONT b/fonts/medleydisplayfonts/ELITE10-MRR.MEDLEYDISPLAYFONT
new file mode 100644
index 000000000..009c0b895
Binary files /dev/null and b/fonts/medleydisplayfonts/ELITE10-MRR.MEDLEYDISPLAYFONT differ
diff --git a/fonts/medleydisplayfonts/GACHA08-MRC.MEDLEYDISPLAYFONT b/fonts/medleydisplayfonts/GACHA08-MRC.MEDLEYDISPLAYFONT
new file mode 100644
index 000000000..cfe6f2aeb
Binary files /dev/null and b/fonts/medleydisplayfonts/GACHA08-MRC.MEDLEYDISPLAYFONT differ
diff --git a/fonts/medleydisplayfonts/GACHA08-MRR.MEDLEYDISPLAYFONT b/fonts/medleydisplayfonts/GACHA08-MRR.MEDLEYDISPLAYFONT
new file mode 100644
index 000000000..a02573edb
Binary files /dev/null and b/fonts/medleydisplayfonts/GACHA08-MRR.MEDLEYDISPLAYFONT differ
diff --git a/fonts/medleydisplayfonts/GACHA10-MRC.MEDLEYDISPLAYFONT b/fonts/medleydisplayfonts/GACHA10-MRC.MEDLEYDISPLAYFONT
new file mode 100644
index 000000000..65b5386e7
Binary files /dev/null and b/fonts/medleydisplayfonts/GACHA10-MRC.MEDLEYDISPLAYFONT differ
diff --git a/fonts/medleydisplayfonts/GACHA10-MRR.MEDLEYDISPLAYFONT b/fonts/medleydisplayfonts/GACHA10-MRR.MEDLEYDISPLAYFONT
index 54e689495..6cfa533fd 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
new file mode 100644
index 000000000..c264951c8
Binary files /dev/null and b/fonts/medleydisplayfonts/GACHA12-MRC.MEDLEYDISPLAYFONT differ
diff --git a/fonts/medleydisplayfonts/GACHA12-MRR.MEDLEYDISPLAYFONT b/fonts/medleydisplayfonts/GACHA12-MRR.MEDLEYDISPLAYFONT
new file mode 100644
index 000000000..b38ff0cc6
Binary files /dev/null and b/fonts/medleydisplayfonts/GACHA12-MRR.MEDLEYDISPLAYFONT differ
diff --git a/fonts/medleydisplayfonts/GATES10-MRR.MEDLEYDISPLAYFONT b/fonts/medleydisplayfonts/GATES10-MRR.MEDLEYDISPLAYFONT
new file mode 100644
index 000000000..4bf1da569
Binary files /dev/null and b/fonts/medleydisplayfonts/GATES10-MRR.MEDLEYDISPLAYFONT differ
diff --git a/fonts/medleydisplayfonts/GATES32-MRR.MEDLEYDISPLAYFONT b/fonts/medleydisplayfonts/GATES32-MRR.MEDLEYDISPLAYFONT
new file mode 100644
index 000000000..858246284
Binary files /dev/null and b/fonts/medleydisplayfonts/GATES32-MRR.MEDLEYDISPLAYFONT differ
diff --git a/fonts/medleydisplayfonts/HELVETICA03-MRR.MEDLEYDISPLAYFONT b/fonts/medleydisplayfonts/HELVETICA03-MRR.MEDLEYDISPLAYFONT
new file mode 100644
index 000000000..867004941
Binary files /dev/null and b/fonts/medleydisplayfonts/HELVETICA03-MRR.MEDLEYDISPLAYFONT differ
diff --git a/fonts/medleydisplayfonts/HELVETICA04-MRR.MEDLEYDISPLAYFONT b/fonts/medleydisplayfonts/HELVETICA04-MRR.MEDLEYDISPLAYFONT
new file mode 100644
index 000000000..0eba79faa
Binary files /dev/null and b/fonts/medleydisplayfonts/HELVETICA04-MRR.MEDLEYDISPLAYFONT differ
diff --git a/fonts/medleydisplayfonts/HELVETICA05-MRR.MEDLEYDISPLAYFONT b/fonts/medleydisplayfonts/HELVETICA05-MRR.MEDLEYDISPLAYFONT
new file mode 100644
index 000000000..100e67051
Binary files /dev/null and b/fonts/medleydisplayfonts/HELVETICA05-MRR.MEDLEYDISPLAYFONT differ
diff --git a/fonts/medleydisplayfonts/HELVETICA07-MIR.MEDLEYDISPLAYFONT b/fonts/medleydisplayfonts/HELVETICA07-MIR.MEDLEYDISPLAYFONT
new file mode 100644
index 000000000..093809693
Binary files /dev/null and b/fonts/medleydisplayfonts/HELVETICA07-MIR.MEDLEYDISPLAYFONT differ
diff --git a/fonts/medleydisplayfonts/HELVETICA07-MRR.MEDLEYDISPLAYFONT b/fonts/medleydisplayfonts/HELVETICA07-MRR.MEDLEYDISPLAYFONT
new file mode 100644
index 000000000..e142a0ffd
Binary files /dev/null and b/fonts/medleydisplayfonts/HELVETICA07-MRR.MEDLEYDISPLAYFONT differ
diff --git a/fonts/medleydisplayfonts/HELVETICA08-BRR.MEDLEYDISPLAYFONT b/fonts/medleydisplayfonts/HELVETICA08-BRR.MEDLEYDISPLAYFONT
new file mode 100644
index 000000000..353527084
Binary files /dev/null and b/fonts/medleydisplayfonts/HELVETICA08-BRR.MEDLEYDISPLAYFONT differ
diff --git a/fonts/medleydisplayfonts/HELVETICA08-MRC.MEDLEYDISPLAYFONT b/fonts/medleydisplayfonts/HELVETICA08-MRC.MEDLEYDISPLAYFONT
new file mode 100644
index 000000000..582b838e5
Binary files /dev/null and b/fonts/medleydisplayfonts/HELVETICA08-MRC.MEDLEYDISPLAYFONT differ
diff --git a/fonts/medleydisplayfonts/HELVETICA08-MRR.MEDLEYDISPLAYFONT b/fonts/medleydisplayfonts/HELVETICA08-MRR.MEDLEYDISPLAYFONT
new file mode 100644
index 000000000..757c96775
Binary files /dev/null and b/fonts/medleydisplayfonts/HELVETICA08-MRR.MEDLEYDISPLAYFONT differ
diff --git a/fonts/medleydisplayfonts/HELVETICA09-MRC.MEDLEYDISPLAYFONT b/fonts/medleydisplayfonts/HELVETICA09-MRC.MEDLEYDISPLAYFONT
new file mode 100644
index 000000000..28b59dd92
Binary files /dev/null and b/fonts/medleydisplayfonts/HELVETICA09-MRC.MEDLEYDISPLAYFONT differ
diff --git a/fonts/medleydisplayfonts/HELVETICA09-MRR.MEDLEYDISPLAYFONT b/fonts/medleydisplayfonts/HELVETICA09-MRR.MEDLEYDISPLAYFONT
new file mode 100644
index 000000000..3150b8981
Binary files /dev/null and b/fonts/medleydisplayfonts/HELVETICA09-MRR.MEDLEYDISPLAYFONT differ
diff --git a/fonts/medleydisplayfonts/HELVETICA10-BRR.MEDLEYDISPLAYFONT b/fonts/medleydisplayfonts/HELVETICA10-BRR.MEDLEYDISPLAYFONT
new file mode 100644
index 000000000..84e45f41b
Binary files /dev/null and b/fonts/medleydisplayfonts/HELVETICA10-BRR.MEDLEYDISPLAYFONT differ
diff --git a/fonts/medleydisplayfonts/HELVETICA10-MRC.MEDLEYDISPLAYFONT b/fonts/medleydisplayfonts/HELVETICA10-MRC.MEDLEYDISPLAYFONT
new file mode 100644
index 000000000..ba3894c86
Binary files /dev/null and b/fonts/medleydisplayfonts/HELVETICA10-MRC.MEDLEYDISPLAYFONT differ
diff --git a/fonts/medleydisplayfonts/HELVETICA10-MRR.MEDLEYDISPLAYFONT b/fonts/medleydisplayfonts/HELVETICA10-MRR.MEDLEYDISPLAYFONT
index a418135dd..eddb73c2c 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
new file mode 100644
index 000000000..997d07fa3
Binary files /dev/null and b/fonts/medleydisplayfonts/HELVETICA11-MRR.MEDLEYDISPLAYFONT differ
diff --git a/fonts/medleydisplayfonts/HELVETICA12-BRR.MEDLEYDISPLAYFONT b/fonts/medleydisplayfonts/HELVETICA12-BRR.MEDLEYDISPLAYFONT
new file mode 100644
index 000000000..da96ebb33
Binary files /dev/null and b/fonts/medleydisplayfonts/HELVETICA12-BRR.MEDLEYDISPLAYFONT differ
diff --git a/fonts/medleydisplayfonts/HELVETICA12-MIR.MEDLEYDISPLAYFONT b/fonts/medleydisplayfonts/HELVETICA12-MIR.MEDLEYDISPLAYFONT
new file mode 100644
index 000000000..6aa28f625
Binary files /dev/null and b/fonts/medleydisplayfonts/HELVETICA12-MIR.MEDLEYDISPLAYFONT differ
diff --git a/fonts/medleydisplayfonts/HELVETICA12-MRC.MEDLEYDISPLAYFONT b/fonts/medleydisplayfonts/HELVETICA12-MRC.MEDLEYDISPLAYFONT
new file mode 100644
index 000000000..4a8b3e8fe
Binary files /dev/null and b/fonts/medleydisplayfonts/HELVETICA12-MRC.MEDLEYDISPLAYFONT differ
diff --git a/fonts/medleydisplayfonts/HELVETICA12-MRR.MEDLEYDISPLAYFONT b/fonts/medleydisplayfonts/HELVETICA12-MRR.MEDLEYDISPLAYFONT
new file mode 100644
index 000000000..209e302f6
Binary files /dev/null and b/fonts/medleydisplayfonts/HELVETICA12-MRR.MEDLEYDISPLAYFONT differ
diff --git a/fonts/medleydisplayfonts/HELVETICA13-MRR.MEDLEYDISPLAYFONT b/fonts/medleydisplayfonts/HELVETICA13-MRR.MEDLEYDISPLAYFONT
new file mode 100644
index 000000000..0c1e1b21c
Binary files /dev/null and b/fonts/medleydisplayfonts/HELVETICA13-MRR.MEDLEYDISPLAYFONT differ
diff --git a/fonts/medleydisplayfonts/HELVETICA14-MRC.MEDLEYDISPLAYFONT b/fonts/medleydisplayfonts/HELVETICA14-MRC.MEDLEYDISPLAYFONT
new file mode 100644
index 000000000..6cc841cc8
Binary files /dev/null and b/fonts/medleydisplayfonts/HELVETICA14-MRC.MEDLEYDISPLAYFONT differ
diff --git a/fonts/medleydisplayfonts/HELVETICA14-MRR.MEDLEYDISPLAYFONT b/fonts/medleydisplayfonts/HELVETICA14-MRR.MEDLEYDISPLAYFONT
new file mode 100644
index 000000000..6c765132b
Binary files /dev/null and b/fonts/medleydisplayfonts/HELVETICA14-MRR.MEDLEYDISPLAYFONT differ
diff --git a/fonts/medleydisplayfonts/HELVETICA16-MRR.MEDLEYDISPLAYFONT b/fonts/medleydisplayfonts/HELVETICA16-MRR.MEDLEYDISPLAYFONT
new file mode 100644
index 000000000..fcd6f98aa
Binary files /dev/null and b/fonts/medleydisplayfonts/HELVETICA16-MRR.MEDLEYDISPLAYFONT differ
diff --git a/fonts/medleydisplayfonts/HELVETICA18-BRC.MEDLEYDISPLAYFONT b/fonts/medleydisplayfonts/HELVETICA18-BRC.MEDLEYDISPLAYFONT
new file mode 100644
index 000000000..3d805194c
Binary files /dev/null and b/fonts/medleydisplayfonts/HELVETICA18-BRC.MEDLEYDISPLAYFONT differ
diff --git a/fonts/medleydisplayfonts/HELVETICA18-LRR.MEDLEYDISPLAYFONT b/fonts/medleydisplayfonts/HELVETICA18-LRR.MEDLEYDISPLAYFONT
new file mode 100644
index 000000000..92c61f01f
Binary files /dev/null and b/fonts/medleydisplayfonts/HELVETICA18-LRR.MEDLEYDISPLAYFONT differ
diff --git a/fonts/medleydisplayfonts/HELVETICA18-MRC.MEDLEYDISPLAYFONT b/fonts/medleydisplayfonts/HELVETICA18-MRC.MEDLEYDISPLAYFONT
new file mode 100644
index 000000000..57e14507a
Binary files /dev/null and b/fonts/medleydisplayfonts/HELVETICA18-MRC.MEDLEYDISPLAYFONT differ
diff --git a/fonts/medleydisplayfonts/HELVETICA18-MRR.MEDLEYDISPLAYFONT b/fonts/medleydisplayfonts/HELVETICA18-MRR.MEDLEYDISPLAYFONT
new file mode 100644
index 000000000..ef591039d
Binary files /dev/null and b/fonts/medleydisplayfonts/HELVETICA18-MRR.MEDLEYDISPLAYFONT differ
diff --git a/fonts/medleydisplayfonts/HELVETICA24-MRR.MEDLEYDISPLAYFONT b/fonts/medleydisplayfonts/HELVETICA24-MRR.MEDLEYDISPLAYFONT
new file mode 100644
index 000000000..e360e8dc4
Binary files /dev/null and b/fonts/medleydisplayfonts/HELVETICA24-MRR.MEDLEYDISPLAYFONT differ
diff --git a/fonts/medleydisplayfonts/HELVETICA30-MRR.MEDLEYDISPLAYFONT b/fonts/medleydisplayfonts/HELVETICA30-MRR.MEDLEYDISPLAYFONT
new file mode 100644
index 000000000..dedb5a78c
Binary files /dev/null and b/fonts/medleydisplayfonts/HELVETICA30-MRR.MEDLEYDISPLAYFONT differ
diff --git a/fonts/medleydisplayfonts/HELVETICA32-MRR.MEDLEYDISPLAYFONT b/fonts/medleydisplayfonts/HELVETICA32-MRR.MEDLEYDISPLAYFONT
new file mode 100644
index 000000000..0ae39c69e
Binary files /dev/null and b/fonts/medleydisplayfonts/HELVETICA32-MRR.MEDLEYDISPLAYFONT differ
diff --git a/fonts/medleydisplayfonts/HELVETICA36-MRR.MEDLEYDISPLAYFONT b/fonts/medleydisplayfonts/HELVETICA36-MRR.MEDLEYDISPLAYFONT
new file mode 100644
index 000000000..370f5e1ad
Binary files /dev/null and b/fonts/medleydisplayfonts/HELVETICA36-MRR.MEDLEYDISPLAYFONT differ
diff --git a/fonts/medleydisplayfonts/HELVETICAD24-MRR.MEDLEYDISPLAYFONT b/fonts/medleydisplayfonts/HELVETICAD24-MRR.MEDLEYDISPLAYFONT
new file mode 100644
index 000000000..b39098e92
Binary files /dev/null and b/fonts/medleydisplayfonts/HELVETICAD24-MRR.MEDLEYDISPLAYFONT differ
diff --git a/fonts/medleydisplayfonts/HIPPO08-MRR.MEDLEYDISPLAYFONT b/fonts/medleydisplayfonts/HIPPO08-MRR.MEDLEYDISPLAYFONT
new file mode 100644
index 000000000..3677b2f4f
Binary files /dev/null and b/fonts/medleydisplayfonts/HIPPO08-MRR.MEDLEYDISPLAYFONT differ
diff --git a/fonts/medleydisplayfonts/HIPPO10-MRR.MEDLEYDISPLAYFONT b/fonts/medleydisplayfonts/HIPPO10-MRR.MEDLEYDISPLAYFONT
new file mode 100644
index 000000000..4395de50f
Binary files /dev/null and b/fonts/medleydisplayfonts/HIPPO10-MRR.MEDLEYDISPLAYFONT differ
diff --git a/fonts/medleydisplayfonts/HIPPO12-MRR.MEDLEYDISPLAYFONT b/fonts/medleydisplayfonts/HIPPO12-MRR.MEDLEYDISPLAYFONT
new file mode 100644
index 000000000..5e951aa29
Binary files /dev/null and b/fonts/medleydisplayfonts/HIPPO12-MRR.MEDLEYDISPLAYFONT differ
diff --git a/fonts/medleydisplayfonts/HIPPO18-MRR.MEDLEYDISPLAYFONT b/fonts/medleydisplayfonts/HIPPO18-MRR.MEDLEYDISPLAYFONT
new file mode 100644
index 000000000..b9066bc08
Binary files /dev/null and b/fonts/medleydisplayfonts/HIPPO18-MRR.MEDLEYDISPLAYFONT differ
diff --git a/fonts/medleydisplayfonts/IBM-US14-MRR.MEDLEYDISPLAYFONT b/fonts/medleydisplayfonts/IBM-US14-MRR.MEDLEYDISPLAYFONT
new file mode 100644
index 000000000..d18067321
Binary files /dev/null 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
new file mode 100644
index 000000000..afee037ad
Binary files /dev/null and b/fonts/medleydisplayfonts/IBM-US16-MRR.MEDLEYDISPLAYFONT differ
diff --git a/fonts/medleydisplayfonts/IBM14-MRR.MEDLEYDISPLAYFONT b/fonts/medleydisplayfonts/IBM14-MRR.MEDLEYDISPLAYFONT
new file mode 100644
index 000000000..5de7a7341
Binary files /dev/null and b/fonts/medleydisplayfonts/IBM14-MRR.MEDLEYDISPLAYFONT differ
diff --git a/fonts/medleydisplayfonts/IBM16-MRR.MEDLEYDISPLAYFONT b/fonts/medleydisplayfonts/IBM16-MRR.MEDLEYDISPLAYFONT
new file mode 100644
index 000000000..14c2849d3
Binary files /dev/null and b/fonts/medleydisplayfonts/IBM16-MRR.MEDLEYDISPLAYFONT differ
diff --git a/fonts/medleydisplayfonts/IBMREV14-MRR.MEDLEYDISPLAYFONT b/fonts/medleydisplayfonts/IBMREV14-MRR.MEDLEYDISPLAYFONT
new file mode 100644
index 000000000..06dc993a2
Binary files /dev/null and b/fonts/medleydisplayfonts/IBMREV14-MRR.MEDLEYDISPLAYFONT differ
diff --git a/fonts/medleydisplayfonts/IBMREV16-MRR.MEDLEYDISPLAYFONT b/fonts/medleydisplayfonts/IBMREV16-MRR.MEDLEYDISPLAYFONT
new file mode 100644
index 000000000..ed130af7c
Binary files /dev/null and b/fonts/medleydisplayfonts/IBMREV16-MRR.MEDLEYDISPLAYFONT differ
diff --git a/fonts/medleydisplayfonts/LETTERGOTHIC10-BRR.MEDLEYDISPLAYFONT b/fonts/medleydisplayfonts/LETTERGOTHIC10-BRR.MEDLEYDISPLAYFONT
new file mode 100644
index 000000000..7a6d60177
Binary files /dev/null and b/fonts/medleydisplayfonts/LETTERGOTHIC10-BRR.MEDLEYDISPLAYFONT differ
diff --git a/fonts/medleydisplayfonts/LETTERGOTHIC10-MRR.MEDLEYDISPLAYFONT b/fonts/medleydisplayfonts/LETTERGOTHIC10-MRR.MEDLEYDISPLAYFONT
new file mode 100644
index 000000000..a09b820ab
Binary files /dev/null and b/fonts/medleydisplayfonts/LETTERGOTHIC10-MRR.MEDLEYDISPLAYFONT differ
diff --git a/fonts/medleydisplayfonts/LETTERGOTHIC12-MRR.MEDLEYDISPLAYFONT b/fonts/medleydisplayfonts/LETTERGOTHIC12-MRR.MEDLEYDISPLAYFONT
new file mode 100644
index 000000000..b07cff62a
Binary files /dev/null and b/fonts/medleydisplayfonts/LETTERGOTHIC12-MRR.MEDLEYDISPLAYFONT differ
diff --git a/fonts/medleydisplayfonts/LOGO12-MRR.MEDLEYDISPLAYFONT b/fonts/medleydisplayfonts/LOGO12-MRR.MEDLEYDISPLAYFONT
new file mode 100644
index 000000000..7635574d2
Binary files /dev/null and b/fonts/medleydisplayfonts/LOGO12-MRR.MEDLEYDISPLAYFONT differ
diff --git a/fonts/medleydisplayfonts/LOGO14-MRR.MEDLEYDISPLAYFONT b/fonts/medleydisplayfonts/LOGO14-MRR.MEDLEYDISPLAYFONT
new file mode 100644
index 000000000..12f0ebd3e
Binary files /dev/null and b/fonts/medleydisplayfonts/LOGO14-MRR.MEDLEYDISPLAYFONT differ
diff --git a/fonts/medleydisplayfonts/LOGO18-MRR.MEDLEYDISPLAYFONT b/fonts/medleydisplayfonts/LOGO18-MRR.MEDLEYDISPLAYFONT
new file mode 100644
index 000000000..174d6f8ff
Binary files /dev/null and b/fonts/medleydisplayfonts/LOGO18-MRR.MEDLEYDISPLAYFONT differ
diff --git a/fonts/medleydisplayfonts/LOGO20-MRR.MEDLEYDISPLAYFONT b/fonts/medleydisplayfonts/LOGO20-MRR.MEDLEYDISPLAYFONT
new file mode 100644
index 000000000..cf3abcdca
Binary files /dev/null and b/fonts/medleydisplayfonts/LOGO20-MRR.MEDLEYDISPLAYFONT differ
diff --git a/fonts/medleydisplayfonts/LOGO24-MRR.MEDLEYDISPLAYFONT b/fonts/medleydisplayfonts/LOGO24-MRR.MEDLEYDISPLAYFONT
new file mode 100644
index 000000000..eb3d292b5
Binary files /dev/null and b/fonts/medleydisplayfonts/LOGO24-MRR.MEDLEYDISPLAYFONT differ
diff --git a/fonts/medleydisplayfonts/LOGO26-MRR.MEDLEYDISPLAYFONT b/fonts/medleydisplayfonts/LOGO26-MRR.MEDLEYDISPLAYFONT
new file mode 100644
index 000000000..00e8b68a9
Binary files /dev/null and b/fonts/medleydisplayfonts/LOGO26-MRR.MEDLEYDISPLAYFONT differ
diff --git a/fonts/medleydisplayfonts/MATH08-MRR.MEDLEYDISPLAYFONT b/fonts/medleydisplayfonts/MATH08-MRR.MEDLEYDISPLAYFONT
new file mode 100644
index 000000000..4d38bf9b0
Binary files /dev/null and b/fonts/medleydisplayfonts/MATH08-MRR.MEDLEYDISPLAYFONT differ
diff --git a/fonts/medleydisplayfonts/MATH10-MRR.MEDLEYDISPLAYFONT b/fonts/medleydisplayfonts/MATH10-MRR.MEDLEYDISPLAYFONT
new file mode 100644
index 000000000..f0da3b4c4
Binary files /dev/null and b/fonts/medleydisplayfonts/MATH10-MRR.MEDLEYDISPLAYFONT differ
diff --git a/fonts/medleydisplayfonts/MATH12-BRR.MEDLEYDISPLAYFONT b/fonts/medleydisplayfonts/MATH12-BRR.MEDLEYDISPLAYFONT
new file mode 100644
index 000000000..76834e150
Binary files /dev/null and b/fonts/medleydisplayfonts/MATH12-BRR.MEDLEYDISPLAYFONT differ
diff --git a/fonts/medleydisplayfonts/MATH12-MRR.MEDLEYDISPLAYFONT b/fonts/medleydisplayfonts/MATH12-MRR.MEDLEYDISPLAYFONT
new file mode 100644
index 000000000..a3a3fe0a1
Binary files /dev/null and b/fonts/medleydisplayfonts/MATH12-MRR.MEDLEYDISPLAYFONT differ
diff --git a/fonts/medleydisplayfonts/MODERN06-BIR.MEDLEYDISPLAYFONT b/fonts/medleydisplayfonts/MODERN06-BIR.MEDLEYDISPLAYFONT
new file mode 100644
index 000000000..061e0acf3
Binary files /dev/null and b/fonts/medleydisplayfonts/MODERN06-BIR.MEDLEYDISPLAYFONT differ
diff --git a/fonts/medleydisplayfonts/MODERN06-BRR.MEDLEYDISPLAYFONT b/fonts/medleydisplayfonts/MODERN06-BRR.MEDLEYDISPLAYFONT
new file mode 100644
index 000000000..68e33e305
Binary files /dev/null and b/fonts/medleydisplayfonts/MODERN06-BRR.MEDLEYDISPLAYFONT differ
diff --git a/fonts/medleydisplayfonts/MODERN06-MIR.MEDLEYDISPLAYFONT b/fonts/medleydisplayfonts/MODERN06-MIR.MEDLEYDISPLAYFONT
new file mode 100644
index 000000000..9b07379a2
Binary files /dev/null and b/fonts/medleydisplayfonts/MODERN06-MIR.MEDLEYDISPLAYFONT differ
diff --git a/fonts/medleydisplayfonts/MODERN06-MRR.MEDLEYDISPLAYFONT b/fonts/medleydisplayfonts/MODERN06-MRR.MEDLEYDISPLAYFONT
new file mode 100644
index 000000000..a0ef45685
Binary files /dev/null and b/fonts/medleydisplayfonts/MODERN06-MRR.MEDLEYDISPLAYFONT differ
diff --git a/fonts/medleydisplayfonts/MODERN08-BIR.MEDLEYDISPLAYFONT b/fonts/medleydisplayfonts/MODERN08-BIR.MEDLEYDISPLAYFONT
new file mode 100644
index 000000000..434744e86
Binary files /dev/null and b/fonts/medleydisplayfonts/MODERN08-BIR.MEDLEYDISPLAYFONT differ
diff --git a/fonts/medleydisplayfonts/MODERN08-BRR.MEDLEYDISPLAYFONT b/fonts/medleydisplayfonts/MODERN08-BRR.MEDLEYDISPLAYFONT
new file mode 100644
index 000000000..06cc06f14
Binary files /dev/null and b/fonts/medleydisplayfonts/MODERN08-BRR.MEDLEYDISPLAYFONT differ
diff --git a/fonts/medleydisplayfonts/MODERN08-MIR.MEDLEYDISPLAYFONT b/fonts/medleydisplayfonts/MODERN08-MIR.MEDLEYDISPLAYFONT
new file mode 100644
index 000000000..3ece2bb84
Binary files /dev/null and b/fonts/medleydisplayfonts/MODERN08-MIR.MEDLEYDISPLAYFONT differ
diff --git a/fonts/medleydisplayfonts/MODERN08-MRR.MEDLEYDISPLAYFONT b/fonts/medleydisplayfonts/MODERN08-MRR.MEDLEYDISPLAYFONT
new file mode 100644
index 000000000..4794c0d74
Binary files /dev/null and b/fonts/medleydisplayfonts/MODERN08-MRR.MEDLEYDISPLAYFONT differ
diff --git a/fonts/medleydisplayfonts/MODERN10-BIR.MEDLEYDISPLAYFONT b/fonts/medleydisplayfonts/MODERN10-BIR.MEDLEYDISPLAYFONT
new file mode 100644
index 000000000..1684628c3
Binary files /dev/null and b/fonts/medleydisplayfonts/MODERN10-BIR.MEDLEYDISPLAYFONT differ
diff --git a/fonts/medleydisplayfonts/MODERN10-BRR.MEDLEYDISPLAYFONT b/fonts/medleydisplayfonts/MODERN10-BRR.MEDLEYDISPLAYFONT
new file mode 100644
index 000000000..85702654e
Binary files /dev/null and b/fonts/medleydisplayfonts/MODERN10-BRR.MEDLEYDISPLAYFONT differ
diff --git a/fonts/medleydisplayfonts/MODERN10-MIR.MEDLEYDISPLAYFONT b/fonts/medleydisplayfonts/MODERN10-MIR.MEDLEYDISPLAYFONT
new file mode 100644
index 000000000..3514c1d15
Binary files /dev/null and b/fonts/medleydisplayfonts/MODERN10-MIR.MEDLEYDISPLAYFONT differ
diff --git a/fonts/medleydisplayfonts/MODERN10-MRR.MEDLEYDISPLAYFONT b/fonts/medleydisplayfonts/MODERN10-MRR.MEDLEYDISPLAYFONT
new file mode 100644
index 000000000..d7049b386
Binary files /dev/null and b/fonts/medleydisplayfonts/MODERN10-MRR.MEDLEYDISPLAYFONT differ
diff --git a/fonts/medleydisplayfonts/MODERN12-BIR.MEDLEYDISPLAYFONT b/fonts/medleydisplayfonts/MODERN12-BIR.MEDLEYDISPLAYFONT
new file mode 100644
index 000000000..a203b4dc1
Binary files /dev/null and b/fonts/medleydisplayfonts/MODERN12-BIR.MEDLEYDISPLAYFONT differ
diff --git a/fonts/medleydisplayfonts/MODERN12-BRR.MEDLEYDISPLAYFONT b/fonts/medleydisplayfonts/MODERN12-BRR.MEDLEYDISPLAYFONT
new file mode 100644
index 000000000..ec037e6ad
Binary files /dev/null and b/fonts/medleydisplayfonts/MODERN12-BRR.MEDLEYDISPLAYFONT differ
diff --git a/fonts/medleydisplayfonts/MODERN12-MIR.MEDLEYDISPLAYFONT b/fonts/medleydisplayfonts/MODERN12-MIR.MEDLEYDISPLAYFONT
new file mode 100644
index 000000000..2da2adec7
Binary files /dev/null and b/fonts/medleydisplayfonts/MODERN12-MIR.MEDLEYDISPLAYFONT differ
diff --git a/fonts/medleydisplayfonts/MODERN12-MRR.MEDLEYDISPLAYFONT b/fonts/medleydisplayfonts/MODERN12-MRR.MEDLEYDISPLAYFONT
new file mode 100644
index 000000000..4024b5c7e
Binary files /dev/null and b/fonts/medleydisplayfonts/MODERN12-MRR.MEDLEYDISPLAYFONT differ
diff --git a/fonts/medleydisplayfonts/MODERN14-BIR.MEDLEYDISPLAYFONT b/fonts/medleydisplayfonts/MODERN14-BIR.MEDLEYDISPLAYFONT
new file mode 100644
index 000000000..acf6dfee7
Binary files /dev/null and b/fonts/medleydisplayfonts/MODERN14-BIR.MEDLEYDISPLAYFONT differ
diff --git a/fonts/medleydisplayfonts/MODERN14-BRR.MEDLEYDISPLAYFONT b/fonts/medleydisplayfonts/MODERN14-BRR.MEDLEYDISPLAYFONT
new file mode 100644
index 000000000..31caeadad
Binary files /dev/null and b/fonts/medleydisplayfonts/MODERN14-BRR.MEDLEYDISPLAYFONT differ
diff --git a/fonts/medleydisplayfonts/MODERN14-MIR.MEDLEYDISPLAYFONT b/fonts/medleydisplayfonts/MODERN14-MIR.MEDLEYDISPLAYFONT
new file mode 100644
index 000000000..b6c03d6dc
Binary files /dev/null and b/fonts/medleydisplayfonts/MODERN14-MIR.MEDLEYDISPLAYFONT differ
diff --git a/fonts/medleydisplayfonts/MODERN14-MRR.MEDLEYDISPLAYFONT b/fonts/medleydisplayfonts/MODERN14-MRR.MEDLEYDISPLAYFONT
new file mode 100644
index 000000000..227a575ad
Binary files /dev/null and b/fonts/medleydisplayfonts/MODERN14-MRR.MEDLEYDISPLAYFONT differ
diff --git a/fonts/medleydisplayfonts/MODERN18-BIR.MEDLEYDISPLAYFONT b/fonts/medleydisplayfonts/MODERN18-BIR.MEDLEYDISPLAYFONT
new file mode 100644
index 000000000..683a48a42
Binary files /dev/null and b/fonts/medleydisplayfonts/MODERN18-BIR.MEDLEYDISPLAYFONT differ
diff --git a/fonts/medleydisplayfonts/MODERN18-BRR.MEDLEYDISPLAYFONT b/fonts/medleydisplayfonts/MODERN18-BRR.MEDLEYDISPLAYFONT
new file mode 100644
index 000000000..23247993a
Binary files /dev/null and b/fonts/medleydisplayfonts/MODERN18-BRR.MEDLEYDISPLAYFONT differ
diff --git a/fonts/medleydisplayfonts/MODERN18-MIR.MEDLEYDISPLAYFONT b/fonts/medleydisplayfonts/MODERN18-MIR.MEDLEYDISPLAYFONT
new file mode 100644
index 000000000..7b3b444f1
Binary files /dev/null and b/fonts/medleydisplayfonts/MODERN18-MIR.MEDLEYDISPLAYFONT differ
diff --git a/fonts/medleydisplayfonts/MODERN18-MRR.MEDLEYDISPLAYFONT b/fonts/medleydisplayfonts/MODERN18-MRR.MEDLEYDISPLAYFONT
new file mode 100644
index 000000000..3297fff33
Binary files /dev/null and b/fonts/medleydisplayfonts/MODERN18-MRR.MEDLEYDISPLAYFONT differ
diff --git a/fonts/medleydisplayfonts/MODERN24-BIR.MEDLEYDISPLAYFONT b/fonts/medleydisplayfonts/MODERN24-BIR.MEDLEYDISPLAYFONT
new file mode 100644
index 000000000..23bb41462
Binary files /dev/null and b/fonts/medleydisplayfonts/MODERN24-BIR.MEDLEYDISPLAYFONT differ
diff --git a/fonts/medleydisplayfonts/MODERN24-BRR.MEDLEYDISPLAYFONT b/fonts/medleydisplayfonts/MODERN24-BRR.MEDLEYDISPLAYFONT
new file mode 100644
index 000000000..14c5e2710
Binary files /dev/null and b/fonts/medleydisplayfonts/MODERN24-BRR.MEDLEYDISPLAYFONT differ
diff --git a/fonts/medleydisplayfonts/MODERN24-MIR.MEDLEYDISPLAYFONT b/fonts/medleydisplayfonts/MODERN24-MIR.MEDLEYDISPLAYFONT
new file mode 100644
index 000000000..14f75684a
Binary files /dev/null and b/fonts/medleydisplayfonts/MODERN24-MIR.MEDLEYDISPLAYFONT differ
diff --git a/fonts/medleydisplayfonts/MODERN24-MRR.MEDLEYDISPLAYFONT b/fonts/medleydisplayfonts/MODERN24-MRR.MEDLEYDISPLAYFONT
new file mode 100644
index 000000000..32cad1a95
Binary files /dev/null and b/fonts/medleydisplayfonts/MODERN24-MRR.MEDLEYDISPLAYFONT differ
diff --git a/fonts/medleydisplayfonts/MODERN30-BIR.MEDLEYDISPLAYFONT b/fonts/medleydisplayfonts/MODERN30-BIR.MEDLEYDISPLAYFONT
new file mode 100644
index 000000000..17515bca8
Binary files /dev/null and b/fonts/medleydisplayfonts/MODERN30-BIR.MEDLEYDISPLAYFONT differ
diff --git a/fonts/medleydisplayfonts/MODERN30-BRR.MEDLEYDISPLAYFONT b/fonts/medleydisplayfonts/MODERN30-BRR.MEDLEYDISPLAYFONT
new file mode 100644
index 000000000..3df06e8c0
Binary files /dev/null and b/fonts/medleydisplayfonts/MODERN30-BRR.MEDLEYDISPLAYFONT differ
diff --git a/fonts/medleydisplayfonts/MODERN30-MIR.MEDLEYDISPLAYFONT b/fonts/medleydisplayfonts/MODERN30-MIR.MEDLEYDISPLAYFONT
new file mode 100644
index 000000000..fd8f923f2
Binary files /dev/null and b/fonts/medleydisplayfonts/MODERN30-MIR.MEDLEYDISPLAYFONT differ
diff --git a/fonts/medleydisplayfonts/MODERN30-MRR.MEDLEYDISPLAYFONT b/fonts/medleydisplayfonts/MODERN30-MRR.MEDLEYDISPLAYFONT
new file mode 100644
index 000000000..322652883
Binary files /dev/null and b/fonts/medleydisplayfonts/MODERN30-MRR.MEDLEYDISPLAYFONT differ
diff --git a/fonts/medleydisplayfonts/MODERN36-BIR.MEDLEYDISPLAYFONT b/fonts/medleydisplayfonts/MODERN36-BIR.MEDLEYDISPLAYFONT
new file mode 100644
index 000000000..29bbf4031
Binary files /dev/null and b/fonts/medleydisplayfonts/MODERN36-BIR.MEDLEYDISPLAYFONT differ
diff --git a/fonts/medleydisplayfonts/MODERN36-BRR.MEDLEYDISPLAYFONT b/fonts/medleydisplayfonts/MODERN36-BRR.MEDLEYDISPLAYFONT
new file mode 100644
index 000000000..fa6cdb7ff
Binary files /dev/null and b/fonts/medleydisplayfonts/MODERN36-BRR.MEDLEYDISPLAYFONT differ
diff --git a/fonts/medleydisplayfonts/MODERN36-MIR.MEDLEYDISPLAYFONT b/fonts/medleydisplayfonts/MODERN36-MIR.MEDLEYDISPLAYFONT
new file mode 100644
index 000000000..eba69c236
Binary files /dev/null and b/fonts/medleydisplayfonts/MODERN36-MIR.MEDLEYDISPLAYFONT differ
diff --git a/fonts/medleydisplayfonts/MODERN36-MRR.MEDLEYDISPLAYFONT b/fonts/medleydisplayfonts/MODERN36-MRR.MEDLEYDISPLAYFONT
new file mode 100644
index 000000000..4c2271889
Binary files /dev/null and b/fonts/medleydisplayfonts/MODERN36-MRR.MEDLEYDISPLAYFONT differ
diff --git a/fonts/medleydisplayfonts/MODERN48-BRR.MEDLEYDISPLAYFONT b/fonts/medleydisplayfonts/MODERN48-BRR.MEDLEYDISPLAYFONT
new file mode 100644
index 000000000..0fbf0029c
Binary files /dev/null and b/fonts/medleydisplayfonts/MODERN48-BRR.MEDLEYDISPLAYFONT differ
diff --git a/fonts/medleydisplayfonts/MODERN48-MIR.MEDLEYDISPLAYFONT b/fonts/medleydisplayfonts/MODERN48-MIR.MEDLEYDISPLAYFONT
new file mode 100644
index 000000000..eb5237a8b
Binary files /dev/null and b/fonts/medleydisplayfonts/MODERN48-MIR.MEDLEYDISPLAYFONT differ
diff --git a/fonts/medleydisplayfonts/MODERN48-MRR.MEDLEYDISPLAYFONT b/fonts/medleydisplayfonts/MODERN48-MRR.MEDLEYDISPLAYFONT
new file mode 100644
index 000000000..fe01c5c1f
Binary files /dev/null and b/fonts/medleydisplayfonts/MODERN48-MRR.MEDLEYDISPLAYFONT differ
diff --git a/fonts/medleydisplayfonts/MODERN72-BIR.MEDLEYDISPLAYFONT b/fonts/medleydisplayfonts/MODERN72-BIR.MEDLEYDISPLAYFONT
new file mode 100644
index 000000000..6614fad98
Binary files /dev/null and b/fonts/medleydisplayfonts/MODERN72-BIR.MEDLEYDISPLAYFONT differ
diff --git a/fonts/medleydisplayfonts/MODERN72-BRR.MEDLEYDISPLAYFONT b/fonts/medleydisplayfonts/MODERN72-BRR.MEDLEYDISPLAYFONT
new file mode 100644
index 000000000..db20313df
Binary files /dev/null and b/fonts/medleydisplayfonts/MODERN72-BRR.MEDLEYDISPLAYFONT differ
diff --git a/fonts/medleydisplayfonts/MODERN72-MIR.MEDLEYDISPLAYFONT b/fonts/medleydisplayfonts/MODERN72-MIR.MEDLEYDISPLAYFONT
new file mode 100644
index 000000000..2ffbde843
Binary files /dev/null and b/fonts/medleydisplayfonts/MODERN72-MIR.MEDLEYDISPLAYFONT differ
diff --git a/fonts/medleydisplayfonts/MODERN72-MRR.MEDLEYDISPLAYFONT b/fonts/medleydisplayfonts/MODERN72-MRR.MEDLEYDISPLAYFONT
new file mode 100644
index 000000000..30ce68e1f
Binary files /dev/null and b/fonts/medleydisplayfonts/MODERN72-MRR.MEDLEYDISPLAYFONT differ
diff --git a/fonts/medleydisplayfonts/MUSIC08-MRR.MEDLEYDISPLAYFONT b/fonts/medleydisplayfonts/MUSIC08-MRR.MEDLEYDISPLAYFONT
new file mode 100644
index 000000000..2081f3c9d
Binary files /dev/null and b/fonts/medleydisplayfonts/MUSIC08-MRR.MEDLEYDISPLAYFONT differ
diff --git a/fonts/medleydisplayfonts/MUSIC09-MRR.MEDLEYDISPLAYFONT b/fonts/medleydisplayfonts/MUSIC09-MRR.MEDLEYDISPLAYFONT
new file mode 100644
index 000000000..0d2092eea
Binary files /dev/null and b/fonts/medleydisplayfonts/MUSIC09-MRR.MEDLEYDISPLAYFONT differ
diff --git a/fonts/medleydisplayfonts/MUSIC10-MRR.MEDLEYDISPLAYFONT b/fonts/medleydisplayfonts/MUSIC10-MRR.MEDLEYDISPLAYFONT
new file mode 100644
index 000000000..e103896e0
Binary files /dev/null and b/fonts/medleydisplayfonts/MUSIC10-MRR.MEDLEYDISPLAYFONT differ
diff --git a/fonts/medleydisplayfonts/MUSIC12-MRR.MEDLEYDISPLAYFONT b/fonts/medleydisplayfonts/MUSIC12-MRR.MEDLEYDISPLAYFONT
new file mode 100644
index 000000000..4c5ce497d
Binary files /dev/null and b/fonts/medleydisplayfonts/MUSIC12-MRR.MEDLEYDISPLAYFONT differ
diff --git a/fonts/medleydisplayfonts/MUSIC14-MRR.MEDLEYDISPLAYFONT b/fonts/medleydisplayfonts/MUSIC14-MRR.MEDLEYDISPLAYFONT
new file mode 100644
index 000000000..02f2655c9
Binary files /dev/null and b/fonts/medleydisplayfonts/MUSIC14-MRR.MEDLEYDISPLAYFONT differ
diff --git a/fonts/medleydisplayfonts/MUSICFONT10-MRR.MEDLEYDISPLAYFONT b/fonts/medleydisplayfonts/MUSICFONT10-MRR.MEDLEYDISPLAYFONT
new file mode 100644
index 000000000..89143a4bf
Binary files /dev/null and b/fonts/medleydisplayfonts/MUSICFONT10-MRR.MEDLEYDISPLAYFONT differ
diff --git a/fonts/medleydisplayfonts/OLDENGLISH10-MRR.MEDLEYDISPLAYFONT b/fonts/medleydisplayfonts/OLDENGLISH10-MRR.MEDLEYDISPLAYFONT
new file mode 100644
index 000000000..6d380404b
Binary files /dev/null and b/fonts/medleydisplayfonts/OLDENGLISH10-MRR.MEDLEYDISPLAYFONT differ
diff --git a/fonts/medleydisplayfonts/OLDENGLISH18-MRR.MEDLEYDISPLAYFONT b/fonts/medleydisplayfonts/OLDENGLISH18-MRR.MEDLEYDISPLAYFONT
new file mode 100644
index 000000000..976e8574a
Binary files /dev/null and b/fonts/medleydisplayfonts/OLDENGLISH18-MRR.MEDLEYDISPLAYFONT differ
diff --git a/fonts/medleydisplayfonts/OPTIMA06-BIR.MEDLEYDISPLAYFONT b/fonts/medleydisplayfonts/OPTIMA06-BIR.MEDLEYDISPLAYFONT
new file mode 100644
index 000000000..371aa6400
Binary files /dev/null and b/fonts/medleydisplayfonts/OPTIMA06-BIR.MEDLEYDISPLAYFONT differ
diff --git a/fonts/medleydisplayfonts/OPTIMA06-BRR.MEDLEYDISPLAYFONT b/fonts/medleydisplayfonts/OPTIMA06-BRR.MEDLEYDISPLAYFONT
new file mode 100644
index 000000000..109dc7a22
Binary files /dev/null and b/fonts/medleydisplayfonts/OPTIMA06-BRR.MEDLEYDISPLAYFONT differ
diff --git a/fonts/medleydisplayfonts/OPTIMA06-MIR.MEDLEYDISPLAYFONT b/fonts/medleydisplayfonts/OPTIMA06-MIR.MEDLEYDISPLAYFONT
new file mode 100644
index 000000000..bac61e3b0
Binary files /dev/null and b/fonts/medleydisplayfonts/OPTIMA06-MIR.MEDLEYDISPLAYFONT differ
diff --git a/fonts/medleydisplayfonts/OPTIMA06-MRR.MEDLEYDISPLAYFONT b/fonts/medleydisplayfonts/OPTIMA06-MRR.MEDLEYDISPLAYFONT
new file mode 100644
index 000000000..62ce71063
Binary files /dev/null and b/fonts/medleydisplayfonts/OPTIMA06-MRR.MEDLEYDISPLAYFONT differ
diff --git a/fonts/medleydisplayfonts/OPTIMA07-BIR.MEDLEYDISPLAYFONT b/fonts/medleydisplayfonts/OPTIMA07-BIR.MEDLEYDISPLAYFONT
new file mode 100644
index 000000000..5dce481b5
Binary files /dev/null and b/fonts/medleydisplayfonts/OPTIMA07-BIR.MEDLEYDISPLAYFONT differ
diff --git a/fonts/medleydisplayfonts/OPTIMA07-BRR.MEDLEYDISPLAYFONT b/fonts/medleydisplayfonts/OPTIMA07-BRR.MEDLEYDISPLAYFONT
new file mode 100644
index 000000000..2da9f7062
Binary files /dev/null and b/fonts/medleydisplayfonts/OPTIMA07-BRR.MEDLEYDISPLAYFONT differ
diff --git a/fonts/medleydisplayfonts/OPTIMA07-MIR.MEDLEYDISPLAYFONT b/fonts/medleydisplayfonts/OPTIMA07-MIR.MEDLEYDISPLAYFONT
new file mode 100644
index 000000000..cdb26c38f
Binary files /dev/null and b/fonts/medleydisplayfonts/OPTIMA07-MIR.MEDLEYDISPLAYFONT differ
diff --git a/fonts/medleydisplayfonts/OPTIMA07-MRR.MEDLEYDISPLAYFONT b/fonts/medleydisplayfonts/OPTIMA07-MRR.MEDLEYDISPLAYFONT
new file mode 100644
index 000000000..9e2be3b36
Binary files /dev/null and b/fonts/medleydisplayfonts/OPTIMA07-MRR.MEDLEYDISPLAYFONT differ
diff --git a/fonts/medleydisplayfonts/OPTIMA08-BIR.MEDLEYDISPLAYFONT b/fonts/medleydisplayfonts/OPTIMA08-BIR.MEDLEYDISPLAYFONT
new file mode 100644
index 000000000..f2595ad4f
Binary files /dev/null and b/fonts/medleydisplayfonts/OPTIMA08-BIR.MEDLEYDISPLAYFONT differ
diff --git a/fonts/medleydisplayfonts/OPTIMA08-BRR.MEDLEYDISPLAYFONT b/fonts/medleydisplayfonts/OPTIMA08-BRR.MEDLEYDISPLAYFONT
new file mode 100644
index 000000000..ca7bbf79e
Binary files /dev/null and b/fonts/medleydisplayfonts/OPTIMA08-BRR.MEDLEYDISPLAYFONT differ
diff --git a/fonts/medleydisplayfonts/OPTIMA08-MIR.MEDLEYDISPLAYFONT b/fonts/medleydisplayfonts/OPTIMA08-MIR.MEDLEYDISPLAYFONT
new file mode 100644
index 000000000..72649022a
Binary files /dev/null and b/fonts/medleydisplayfonts/OPTIMA08-MIR.MEDLEYDISPLAYFONT differ
diff --git a/fonts/medleydisplayfonts/OPTIMA08-MRR.MEDLEYDISPLAYFONT b/fonts/medleydisplayfonts/OPTIMA08-MRR.MEDLEYDISPLAYFONT
new file mode 100644
index 000000000..6ccaaa1bb
Binary files /dev/null and b/fonts/medleydisplayfonts/OPTIMA08-MRR.MEDLEYDISPLAYFONT differ
diff --git a/fonts/medleydisplayfonts/OPTIMA09-BIR.MEDLEYDISPLAYFONT b/fonts/medleydisplayfonts/OPTIMA09-BIR.MEDLEYDISPLAYFONT
new file mode 100644
index 000000000..879d8f98c
Binary files /dev/null and b/fonts/medleydisplayfonts/OPTIMA09-BIR.MEDLEYDISPLAYFONT differ
diff --git a/fonts/medleydisplayfonts/OPTIMA09-BRR.MEDLEYDISPLAYFONT b/fonts/medleydisplayfonts/OPTIMA09-BRR.MEDLEYDISPLAYFONT
new file mode 100644
index 000000000..e40b3317e
Binary files /dev/null and b/fonts/medleydisplayfonts/OPTIMA09-BRR.MEDLEYDISPLAYFONT differ
diff --git a/fonts/medleydisplayfonts/OPTIMA09-MIR.MEDLEYDISPLAYFONT b/fonts/medleydisplayfonts/OPTIMA09-MIR.MEDLEYDISPLAYFONT
new file mode 100644
index 000000000..668b67edc
Binary files /dev/null and b/fonts/medleydisplayfonts/OPTIMA09-MIR.MEDLEYDISPLAYFONT differ
diff --git a/fonts/medleydisplayfonts/OPTIMA09-MRR.MEDLEYDISPLAYFONT b/fonts/medleydisplayfonts/OPTIMA09-MRR.MEDLEYDISPLAYFONT
new file mode 100644
index 000000000..8a37a21e4
Binary files /dev/null and b/fonts/medleydisplayfonts/OPTIMA09-MRR.MEDLEYDISPLAYFONT differ
diff --git a/fonts/medleydisplayfonts/OPTIMA10-BIR.MEDLEYDISPLAYFONT b/fonts/medleydisplayfonts/OPTIMA10-BIR.MEDLEYDISPLAYFONT
new file mode 100644
index 000000000..813319ef9
Binary files /dev/null and b/fonts/medleydisplayfonts/OPTIMA10-BIR.MEDLEYDISPLAYFONT differ
diff --git a/fonts/medleydisplayfonts/OPTIMA10-BRR.MEDLEYDISPLAYFONT b/fonts/medleydisplayfonts/OPTIMA10-BRR.MEDLEYDISPLAYFONT
new file mode 100644
index 000000000..5344b4624
Binary files /dev/null and b/fonts/medleydisplayfonts/OPTIMA10-BRR.MEDLEYDISPLAYFONT differ
diff --git a/fonts/medleydisplayfonts/OPTIMA10-MIR.MEDLEYDISPLAYFONT b/fonts/medleydisplayfonts/OPTIMA10-MIR.MEDLEYDISPLAYFONT
new file mode 100644
index 000000000..35cc99386
Binary files /dev/null and b/fonts/medleydisplayfonts/OPTIMA10-MIR.MEDLEYDISPLAYFONT differ
diff --git a/fonts/medleydisplayfonts/OPTIMA10-MRR.MEDLEYDISPLAYFONT b/fonts/medleydisplayfonts/OPTIMA10-MRR.MEDLEYDISPLAYFONT
new file mode 100644
index 000000000..7bd96de2e
Binary files /dev/null and b/fonts/medleydisplayfonts/OPTIMA10-MRR.MEDLEYDISPLAYFONT differ
diff --git a/fonts/medleydisplayfonts/OPTIMA11-BIR.MEDLEYDISPLAYFONT b/fonts/medleydisplayfonts/OPTIMA11-BIR.MEDLEYDISPLAYFONT
new file mode 100644
index 000000000..55557abac
Binary files /dev/null and b/fonts/medleydisplayfonts/OPTIMA11-BIR.MEDLEYDISPLAYFONT differ
diff --git a/fonts/medleydisplayfonts/OPTIMA11-BRR.MEDLEYDISPLAYFONT b/fonts/medleydisplayfonts/OPTIMA11-BRR.MEDLEYDISPLAYFONT
new file mode 100644
index 000000000..52e9d680d
Binary files /dev/null and b/fonts/medleydisplayfonts/OPTIMA11-BRR.MEDLEYDISPLAYFONT differ
diff --git a/fonts/medleydisplayfonts/OPTIMA11-MIR.MEDLEYDISPLAYFONT b/fonts/medleydisplayfonts/OPTIMA11-MIR.MEDLEYDISPLAYFONT
new file mode 100644
index 000000000..c29eb4b25
Binary files /dev/null and b/fonts/medleydisplayfonts/OPTIMA11-MIR.MEDLEYDISPLAYFONT differ
diff --git a/fonts/medleydisplayfonts/OPTIMA11-MRR.MEDLEYDISPLAYFONT b/fonts/medleydisplayfonts/OPTIMA11-MRR.MEDLEYDISPLAYFONT
new file mode 100644
index 000000000..2e38763bb
Binary files /dev/null and b/fonts/medleydisplayfonts/OPTIMA11-MRR.MEDLEYDISPLAYFONT differ
diff --git a/fonts/medleydisplayfonts/OPTIMA12-BIR.MEDLEYDISPLAYFONT b/fonts/medleydisplayfonts/OPTIMA12-BIR.MEDLEYDISPLAYFONT
new file mode 100644
index 000000000..6a821f07a
Binary files /dev/null and b/fonts/medleydisplayfonts/OPTIMA12-BIR.MEDLEYDISPLAYFONT differ
diff --git a/fonts/medleydisplayfonts/OPTIMA12-BRR.MEDLEYDISPLAYFONT b/fonts/medleydisplayfonts/OPTIMA12-BRR.MEDLEYDISPLAYFONT
new file mode 100644
index 000000000..057ef5a42
Binary files /dev/null and b/fonts/medleydisplayfonts/OPTIMA12-BRR.MEDLEYDISPLAYFONT differ
diff --git a/fonts/medleydisplayfonts/OPTIMA12-MIR.MEDLEYDISPLAYFONT b/fonts/medleydisplayfonts/OPTIMA12-MIR.MEDLEYDISPLAYFONT
new file mode 100644
index 000000000..0bf777893
Binary files /dev/null and b/fonts/medleydisplayfonts/OPTIMA12-MIR.MEDLEYDISPLAYFONT differ
diff --git a/fonts/medleydisplayfonts/OPTIMA12-MRR.MEDLEYDISPLAYFONT b/fonts/medleydisplayfonts/OPTIMA12-MRR.MEDLEYDISPLAYFONT
new file mode 100644
index 000000000..4333fee41
Binary files /dev/null and b/fonts/medleydisplayfonts/OPTIMA12-MRR.MEDLEYDISPLAYFONT differ
diff --git a/fonts/medleydisplayfonts/OPTIMA14-BIR.MEDLEYDISPLAYFONT b/fonts/medleydisplayfonts/OPTIMA14-BIR.MEDLEYDISPLAYFONT
new file mode 100644
index 000000000..982cf4947
Binary files /dev/null and b/fonts/medleydisplayfonts/OPTIMA14-BIR.MEDLEYDISPLAYFONT differ
diff --git a/fonts/medleydisplayfonts/OPTIMA14-BRR.MEDLEYDISPLAYFONT b/fonts/medleydisplayfonts/OPTIMA14-BRR.MEDLEYDISPLAYFONT
new file mode 100644
index 000000000..b7dd890c3
Binary files /dev/null and b/fonts/medleydisplayfonts/OPTIMA14-BRR.MEDLEYDISPLAYFONT differ
diff --git a/fonts/medleydisplayfonts/OPTIMA14-MIR.MEDLEYDISPLAYFONT b/fonts/medleydisplayfonts/OPTIMA14-MIR.MEDLEYDISPLAYFONT
new file mode 100644
index 000000000..83c96acfa
Binary files /dev/null and b/fonts/medleydisplayfonts/OPTIMA14-MIR.MEDLEYDISPLAYFONT differ
diff --git a/fonts/medleydisplayfonts/OPTIMA14-MRR.MEDLEYDISPLAYFONT b/fonts/medleydisplayfonts/OPTIMA14-MRR.MEDLEYDISPLAYFONT
new file mode 100644
index 000000000..75fc5dcda
Binary files /dev/null and b/fonts/medleydisplayfonts/OPTIMA14-MRR.MEDLEYDISPLAYFONT differ
diff --git a/fonts/medleydisplayfonts/OPTIMA18-BIR.MEDLEYDISPLAYFONT b/fonts/medleydisplayfonts/OPTIMA18-BIR.MEDLEYDISPLAYFONT
new file mode 100644
index 000000000..738b40625
Binary files /dev/null and b/fonts/medleydisplayfonts/OPTIMA18-BIR.MEDLEYDISPLAYFONT differ
diff --git a/fonts/medleydisplayfonts/OPTIMA18-BRR.MEDLEYDISPLAYFONT b/fonts/medleydisplayfonts/OPTIMA18-BRR.MEDLEYDISPLAYFONT
new file mode 100644
index 000000000..a4c0a42a5
Binary files /dev/null and b/fonts/medleydisplayfonts/OPTIMA18-BRR.MEDLEYDISPLAYFONT differ
diff --git a/fonts/medleydisplayfonts/OPTIMA18-MIR.MEDLEYDISPLAYFONT b/fonts/medleydisplayfonts/OPTIMA18-MIR.MEDLEYDISPLAYFONT
new file mode 100644
index 000000000..44d840237
Binary files /dev/null and b/fonts/medleydisplayfonts/OPTIMA18-MIR.MEDLEYDISPLAYFONT differ
diff --git a/fonts/medleydisplayfonts/OPTIMA18-MRR.MEDLEYDISPLAYFONT b/fonts/medleydisplayfonts/OPTIMA18-MRR.MEDLEYDISPLAYFONT
new file mode 100644
index 000000000..68a8ddfea
Binary files /dev/null and b/fonts/medleydisplayfonts/OPTIMA18-MRR.MEDLEYDISPLAYFONT differ
diff --git a/fonts/medleydisplayfonts/OPTIMA24-BIR.MEDLEYDISPLAYFONT b/fonts/medleydisplayfonts/OPTIMA24-BIR.MEDLEYDISPLAYFONT
new file mode 100644
index 000000000..58bdacf36
Binary files /dev/null and b/fonts/medleydisplayfonts/OPTIMA24-BIR.MEDLEYDISPLAYFONT differ
diff --git a/fonts/medleydisplayfonts/OPTIMA24-BRR.MEDLEYDISPLAYFONT b/fonts/medleydisplayfonts/OPTIMA24-BRR.MEDLEYDISPLAYFONT
new file mode 100644
index 000000000..5e16f67a4
Binary files /dev/null and b/fonts/medleydisplayfonts/OPTIMA24-BRR.MEDLEYDISPLAYFONT differ
diff --git a/fonts/medleydisplayfonts/OPTIMA24-MIR.MEDLEYDISPLAYFONT b/fonts/medleydisplayfonts/OPTIMA24-MIR.MEDLEYDISPLAYFONT
new file mode 100644
index 000000000..2c97f591d
Binary files /dev/null and b/fonts/medleydisplayfonts/OPTIMA24-MIR.MEDLEYDISPLAYFONT differ
diff --git a/fonts/medleydisplayfonts/OPTIMA24-MRR.MEDLEYDISPLAYFONT b/fonts/medleydisplayfonts/OPTIMA24-MRR.MEDLEYDISPLAYFONT
new file mode 100644
index 000000000..08cf7bf55
Binary files /dev/null and b/fonts/medleydisplayfonts/OPTIMA24-MRR.MEDLEYDISPLAYFONT differ
diff --git a/fonts/medleydisplayfonts/PALATINO10-BIR.MEDLEYDISPLAYFONT b/fonts/medleydisplayfonts/PALATINO10-BIR.MEDLEYDISPLAYFONT
new file mode 100644
index 000000000..bcb48dfa3
Binary files /dev/null and b/fonts/medleydisplayfonts/PALATINO10-BIR.MEDLEYDISPLAYFONT differ
diff --git a/fonts/medleydisplayfonts/PALATINO10-BRR.MEDLEYDISPLAYFONT b/fonts/medleydisplayfonts/PALATINO10-BRR.MEDLEYDISPLAYFONT
new file mode 100644
index 000000000..bba53d34a
Binary files /dev/null and b/fonts/medleydisplayfonts/PALATINO10-BRR.MEDLEYDISPLAYFONT differ
diff --git a/fonts/medleydisplayfonts/PALATINO10-MIR.MEDLEYDISPLAYFONT b/fonts/medleydisplayfonts/PALATINO10-MIR.MEDLEYDISPLAYFONT
new file mode 100644
index 000000000..565b4ca51
Binary files /dev/null and b/fonts/medleydisplayfonts/PALATINO10-MIR.MEDLEYDISPLAYFONT differ
diff --git a/fonts/medleydisplayfonts/PALATINO10-MRR.MEDLEYDISPLAYFONT b/fonts/medleydisplayfonts/PALATINO10-MRR.MEDLEYDISPLAYFONT
new file mode 100644
index 000000000..112fda5b9
Binary files /dev/null and b/fonts/medleydisplayfonts/PALATINO10-MRR.MEDLEYDISPLAYFONT differ
diff --git a/fonts/medleydisplayfonts/PALATINO12-BIR.MEDLEYDISPLAYFONT b/fonts/medleydisplayfonts/PALATINO12-BIR.MEDLEYDISPLAYFONT
new file mode 100644
index 000000000..2791a46ec
Binary files /dev/null and b/fonts/medleydisplayfonts/PALATINO12-BIR.MEDLEYDISPLAYFONT differ
diff --git a/fonts/medleydisplayfonts/PALATINO12-BRR.MEDLEYDISPLAYFONT b/fonts/medleydisplayfonts/PALATINO12-BRR.MEDLEYDISPLAYFONT
new file mode 100644
index 000000000..4161e3cca
Binary files /dev/null and b/fonts/medleydisplayfonts/PALATINO12-BRR.MEDLEYDISPLAYFONT differ
diff --git a/fonts/medleydisplayfonts/PALATINO12-MIR.MEDLEYDISPLAYFONT b/fonts/medleydisplayfonts/PALATINO12-MIR.MEDLEYDISPLAYFONT
new file mode 100644
index 000000000..7882febd6
Binary files /dev/null and b/fonts/medleydisplayfonts/PALATINO12-MIR.MEDLEYDISPLAYFONT differ
diff --git a/fonts/medleydisplayfonts/PALATINO12-MRR.MEDLEYDISPLAYFONT b/fonts/medleydisplayfonts/PALATINO12-MRR.MEDLEYDISPLAYFONT
new file mode 100644
index 000000000..bdc564a5c
Binary files /dev/null and b/fonts/medleydisplayfonts/PALATINO12-MRR.MEDLEYDISPLAYFONT differ
diff --git a/fonts/medleydisplayfonts/PALATINO14-BIR.MEDLEYDISPLAYFONT b/fonts/medleydisplayfonts/PALATINO14-BIR.MEDLEYDISPLAYFONT
new file mode 100644
index 000000000..140cd7f33
Binary files /dev/null and b/fonts/medleydisplayfonts/PALATINO14-BIR.MEDLEYDISPLAYFONT differ
diff --git a/fonts/medleydisplayfonts/PALATINO14-BRR.MEDLEYDISPLAYFONT b/fonts/medleydisplayfonts/PALATINO14-BRR.MEDLEYDISPLAYFONT
new file mode 100644
index 000000000..5b3c4b283
Binary files /dev/null and b/fonts/medleydisplayfonts/PALATINO14-BRR.MEDLEYDISPLAYFONT differ
diff --git a/fonts/medleydisplayfonts/PALATINO14-MIR.MEDLEYDISPLAYFONT b/fonts/medleydisplayfonts/PALATINO14-MIR.MEDLEYDISPLAYFONT
new file mode 100644
index 000000000..9e92e11bc
Binary files /dev/null and b/fonts/medleydisplayfonts/PALATINO14-MIR.MEDLEYDISPLAYFONT differ
diff --git a/fonts/medleydisplayfonts/PALATINO14-MRR.MEDLEYDISPLAYFONT b/fonts/medleydisplayfonts/PALATINO14-MRR.MEDLEYDISPLAYFONT
new file mode 100644
index 000000000..54939d69b
Binary files /dev/null and b/fonts/medleydisplayfonts/PALATINO14-MRR.MEDLEYDISPLAYFONT differ
diff --git a/fonts/medleydisplayfonts/PALATINO18-BIR.MEDLEYDISPLAYFONT b/fonts/medleydisplayfonts/PALATINO18-BIR.MEDLEYDISPLAYFONT
new file mode 100644
index 000000000..bd5bb2df9
Binary files /dev/null and b/fonts/medleydisplayfonts/PALATINO18-BIR.MEDLEYDISPLAYFONT differ
diff --git a/fonts/medleydisplayfonts/PALATINO18-BRR.MEDLEYDISPLAYFONT b/fonts/medleydisplayfonts/PALATINO18-BRR.MEDLEYDISPLAYFONT
new file mode 100644
index 000000000..2a34f2dcb
Binary files /dev/null and b/fonts/medleydisplayfonts/PALATINO18-BRR.MEDLEYDISPLAYFONT differ
diff --git a/fonts/medleydisplayfonts/PALATINO18-MIR.MEDLEYDISPLAYFONT b/fonts/medleydisplayfonts/PALATINO18-MIR.MEDLEYDISPLAYFONT
new file mode 100644
index 000000000..80fa3524e
Binary files /dev/null and b/fonts/medleydisplayfonts/PALATINO18-MIR.MEDLEYDISPLAYFONT differ
diff --git a/fonts/medleydisplayfonts/PALATINO18-MRR.MEDLEYDISPLAYFONT b/fonts/medleydisplayfonts/PALATINO18-MRR.MEDLEYDISPLAYFONT
new file mode 100644
index 000000000..fc7ef9856
Binary files /dev/null and b/fonts/medleydisplayfonts/PALATINO18-MRR.MEDLEYDISPLAYFONT differ
diff --git a/fonts/medleydisplayfonts/PALATINO24-BIR.MEDLEYDISPLAYFONT b/fonts/medleydisplayfonts/PALATINO24-BIR.MEDLEYDISPLAYFONT
new file mode 100644
index 000000000..b32bc3874
Binary files /dev/null and b/fonts/medleydisplayfonts/PALATINO24-BIR.MEDLEYDISPLAYFONT differ
diff --git a/fonts/medleydisplayfonts/PALATINO24-BRR.MEDLEYDISPLAYFONT b/fonts/medleydisplayfonts/PALATINO24-BRR.MEDLEYDISPLAYFONT
new file mode 100644
index 000000000..b6a021883
Binary files /dev/null and b/fonts/medleydisplayfonts/PALATINO24-BRR.MEDLEYDISPLAYFONT differ
diff --git a/fonts/medleydisplayfonts/PALATINO24-MIR.MEDLEYDISPLAYFONT b/fonts/medleydisplayfonts/PALATINO24-MIR.MEDLEYDISPLAYFONT
new file mode 100644
index 000000000..5a5a47dc6
Binary files /dev/null and b/fonts/medleydisplayfonts/PALATINO24-MIR.MEDLEYDISPLAYFONT differ
diff --git a/fonts/medleydisplayfonts/PALATINO24-MRR.MEDLEYDISPLAYFONT b/fonts/medleydisplayfonts/PALATINO24-MRR.MEDLEYDISPLAYFONT
new file mode 100644
index 000000000..80811492a
Binary files /dev/null and b/fonts/medleydisplayfonts/PALATINO24-MRR.MEDLEYDISPLAYFONT differ
diff --git a/fonts/medleydisplayfonts/PCTERMINAL12-BRR.MEDLEYDISPLAYFONT b/fonts/medleydisplayfonts/PCTERMINAL12-BRR.MEDLEYDISPLAYFONT
new file mode 100644
index 000000000..f7cb41ae2
Binary files /dev/null and b/fonts/medleydisplayfonts/PCTERMINAL12-BRR.MEDLEYDISPLAYFONT differ
diff --git a/fonts/medleydisplayfonts/PCTERMINAL12-MRR.MEDLEYDISPLAYFONT b/fonts/medleydisplayfonts/PCTERMINAL12-MRR.MEDLEYDISPLAYFONT
new file mode 100644
index 000000000..3057311b7
Binary files /dev/null and b/fonts/medleydisplayfonts/PCTERMINAL12-MRR.MEDLEYDISPLAYFONT differ
diff --git a/fonts/medleydisplayfonts/PCTERMINAL14-BRR.MEDLEYDISPLAYFONT b/fonts/medleydisplayfonts/PCTERMINAL14-BRR.MEDLEYDISPLAYFONT
new file mode 100644
index 000000000..59f7d5b16
Binary files /dev/null and b/fonts/medleydisplayfonts/PCTERMINAL14-BRR.MEDLEYDISPLAYFONT differ
diff --git a/fonts/medleydisplayfonts/PCTERMINAL14-MRR.MEDLEYDISPLAYFONT b/fonts/medleydisplayfonts/PCTERMINAL14-MRR.MEDLEYDISPLAYFONT
new file mode 100644
index 000000000..809ce5259
Binary files /dev/null and b/fonts/medleydisplayfonts/PCTERMINAL14-MRR.MEDLEYDISPLAYFONT differ
diff --git a/fonts/medleydisplayfonts/PHONETICTR12-MRR.MEDLEYDISPLAYFONT b/fonts/medleydisplayfonts/PHONETICTR12-MRR.MEDLEYDISPLAYFONT
new file mode 100644
index 000000000..e3c75b95b
Binary files /dev/null and b/fonts/medleydisplayfonts/PHONETICTR12-MRR.MEDLEYDISPLAYFONT differ
diff --git a/fonts/medleydisplayfonts/ROMANPS10-MRR.MEDLEYDISPLAYFONT b/fonts/medleydisplayfonts/ROMANPS10-MRR.MEDLEYDISPLAYFONT
new file mode 100644
index 000000000..9f3a1c338
Binary files /dev/null and b/fonts/medleydisplayfonts/ROMANPS10-MRR.MEDLEYDISPLAYFONT differ
diff --git a/fonts/medleydisplayfonts/ROMANPS12-MRR.MEDLEYDISPLAYFONT b/fonts/medleydisplayfonts/ROMANPS12-MRR.MEDLEYDISPLAYFONT
new file mode 100644
index 000000000..f65434d88
Binary files /dev/null and b/fonts/medleydisplayfonts/ROMANPS12-MRR.MEDLEYDISPLAYFONT differ
diff --git a/fonts/medleydisplayfonts/SAIL10-BRR.MEDLEYDISPLAYFONT b/fonts/medleydisplayfonts/SAIL10-BRR.MEDLEYDISPLAYFONT
new file mode 100644
index 000000000..7fc4a6505
Binary files /dev/null and b/fonts/medleydisplayfonts/SAIL10-BRR.MEDLEYDISPLAYFONT differ
diff --git a/fonts/medleydisplayfonts/SAIL10-MRR.MEDLEYDISPLAYFONT b/fonts/medleydisplayfonts/SAIL10-MRR.MEDLEYDISPLAYFONT
new file mode 100644
index 000000000..965f0fbb9
Binary files /dev/null and b/fonts/medleydisplayfonts/SAIL10-MRR.MEDLEYDISPLAYFONT differ
diff --git a/fonts/medleydisplayfonts/SAIL12-MRR.MEDLEYDISPLAYFONT b/fonts/medleydisplayfonts/SAIL12-MRR.MEDLEYDISPLAYFONT
new file mode 100644
index 000000000..b8cf422ea
Binary files /dev/null and b/fonts/medleydisplayfonts/SAIL12-MRR.MEDLEYDISPLAYFONT differ
diff --git a/fonts/medleydisplayfonts/SIGMA20-MRR.MEDLEYDISPLAYFONT b/fonts/medleydisplayfonts/SIGMA20-MRR.MEDLEYDISPLAYFONT
new file mode 100644
index 000000000..37e610388
Binary files /dev/null and b/fonts/medleydisplayfonts/SIGMA20-MRR.MEDLEYDISPLAYFONT differ
diff --git a/fonts/medleydisplayfonts/SMALLTALK10-MRR.MEDLEYDISPLAYFONT b/fonts/medleydisplayfonts/SMALLTALK10-MRR.MEDLEYDISPLAYFONT
new file mode 100644
index 000000000..81116f3a8
Binary files /dev/null and b/fonts/medleydisplayfonts/SMALLTALK10-MRR.MEDLEYDISPLAYFONT differ
diff --git a/fonts/medleydisplayfonts/SNAIL10-BRR.MEDLEYDISPLAYFONT b/fonts/medleydisplayfonts/SNAIL10-BRR.MEDLEYDISPLAYFONT
new file mode 100644
index 000000000..139ab7c0e
Binary files /dev/null and b/fonts/medleydisplayfonts/SNAIL10-BRR.MEDLEYDISPLAYFONT differ
diff --git a/fonts/medleydisplayfonts/SNAIL10-MRR.MEDLEYDISPLAYFONT b/fonts/medleydisplayfonts/SNAIL10-MRR.MEDLEYDISPLAYFONT
new file mode 100644
index 000000000..94621017a
Binary files /dev/null and b/fonts/medleydisplayfonts/SNAIL10-MRR.MEDLEYDISPLAYFONT differ
diff --git a/fonts/medleydisplayfonts/SNAIL12-MRR.MEDLEYDISPLAYFONT b/fonts/medleydisplayfonts/SNAIL12-MRR.MEDLEYDISPLAYFONT
new file mode 100644
index 000000000..76b369172
Binary files /dev/null and b/fonts/medleydisplayfonts/SNAIL12-MRR.MEDLEYDISPLAYFONT differ
diff --git a/fonts/medleydisplayfonts/SYMBOL10-MRR.MEDLEYDISPLAYFONT b/fonts/medleydisplayfonts/SYMBOL10-MRR.MEDLEYDISPLAYFONT
new file mode 100644
index 000000000..3bb4f000c
Binary files /dev/null and b/fonts/medleydisplayfonts/SYMBOL10-MRR.MEDLEYDISPLAYFONT differ
diff --git a/fonts/medleydisplayfonts/TEMPLATE10-MRR.MEDLEYDISPLAYFONT b/fonts/medleydisplayfonts/TEMPLATE10-MRR.MEDLEYDISPLAYFONT
new file mode 100644
index 000000000..5fb575fba
Binary files /dev/null and b/fonts/medleydisplayfonts/TEMPLATE10-MRR.MEDLEYDISPLAYFONT differ
diff --git a/fonts/medleydisplayfonts/TEMPLATE64-MRR.MEDLEYDISPLAYFONT b/fonts/medleydisplayfonts/TEMPLATE64-MRR.MEDLEYDISPLAYFONT
new file mode 100644
index 000000000..f69385b54
Binary files /dev/null and b/fonts/medleydisplayfonts/TEMPLATE64-MRR.MEDLEYDISPLAYFONT differ
diff --git a/fonts/medleydisplayfonts/TERMINAL06-BRR.MEDLEYDISPLAYFONT b/fonts/medleydisplayfonts/TERMINAL06-BRR.MEDLEYDISPLAYFONT
new file mode 100644
index 000000000..361fd9be9
Binary files /dev/null and b/fonts/medleydisplayfonts/TERMINAL06-BRR.MEDLEYDISPLAYFONT differ
diff --git a/fonts/medleydisplayfonts/TERMINAL06-MRR.MEDLEYDISPLAYFONT b/fonts/medleydisplayfonts/TERMINAL06-MRR.MEDLEYDISPLAYFONT
new file mode 100644
index 000000000..158a95898
Binary files /dev/null and b/fonts/medleydisplayfonts/TERMINAL06-MRR.MEDLEYDISPLAYFONT differ
diff --git a/fonts/medleydisplayfonts/TERMINAL08-BRR.MEDLEYDISPLAYFONT b/fonts/medleydisplayfonts/TERMINAL08-BRR.MEDLEYDISPLAYFONT
new file mode 100644
index 000000000..0eb8291ea
Binary files /dev/null and b/fonts/medleydisplayfonts/TERMINAL08-BRR.MEDLEYDISPLAYFONT differ
diff --git a/fonts/medleydisplayfonts/TERMINAL08-MRR.MEDLEYDISPLAYFONT b/fonts/medleydisplayfonts/TERMINAL08-MRR.MEDLEYDISPLAYFONT
new file mode 100644
index 000000000..da1593970
Binary files /dev/null and b/fonts/medleydisplayfonts/TERMINAL08-MRR.MEDLEYDISPLAYFONT differ
diff --git a/fonts/medleydisplayfonts/TERMINAL10-BRR.MEDLEYDISPLAYFONT b/fonts/medleydisplayfonts/TERMINAL10-BRR.MEDLEYDISPLAYFONT
new file mode 100644
index 000000000..804d9253f
Binary files /dev/null and b/fonts/medleydisplayfonts/TERMINAL10-BRR.MEDLEYDISPLAYFONT differ
diff --git a/fonts/medleydisplayfonts/TERMINAL10-MRR.MEDLEYDISPLAYFONT b/fonts/medleydisplayfonts/TERMINAL10-MRR.MEDLEYDISPLAYFONT
new file mode 100644
index 000000000..44ce64f44
Binary files /dev/null and b/fonts/medleydisplayfonts/TERMINAL10-MRR.MEDLEYDISPLAYFONT differ
diff --git a/fonts/medleydisplayfonts/TERMINAL12-BRR.MEDLEYDISPLAYFONT b/fonts/medleydisplayfonts/TERMINAL12-BRR.MEDLEYDISPLAYFONT
new file mode 100644
index 000000000..a8838eb56
Binary files /dev/null and b/fonts/medleydisplayfonts/TERMINAL12-BRR.MEDLEYDISPLAYFONT differ
diff --git a/fonts/medleydisplayfonts/TERMINAL12-MRR.MEDLEYDISPLAYFONT b/fonts/medleydisplayfonts/TERMINAL12-MRR.MEDLEYDISPLAYFONT
new file mode 100644
index 000000000..1433f6d4c
Binary files /dev/null and b/fonts/medleydisplayfonts/TERMINAL12-MRR.MEDLEYDISPLAYFONT differ
diff --git a/fonts/medleydisplayfonts/TESTFONT12-MRR.MEDLEYDISPLAYFONT b/fonts/medleydisplayfonts/TESTFONT12-MRR.MEDLEYDISPLAYFONT
new file mode 100644
index 000000000..906f6164b
Binary files /dev/null and b/fonts/medleydisplayfonts/TESTFONT12-MRR.MEDLEYDISPLAYFONT differ
diff --git a/fonts/medleydisplayfonts/TIMESROMAN06-MRR.MEDLEYDISPLAYFONT b/fonts/medleydisplayfonts/TIMESROMAN06-MRR.MEDLEYDISPLAYFONT
new file mode 100644
index 000000000..c0f9260e1
Binary files /dev/null and b/fonts/medleydisplayfonts/TIMESROMAN06-MRR.MEDLEYDISPLAYFONT differ
diff --git a/fonts/medleydisplayfonts/TIMESROMAN08-BRR.MEDLEYDISPLAYFONT b/fonts/medleydisplayfonts/TIMESROMAN08-BRR.MEDLEYDISPLAYFONT
new file mode 100644
index 000000000..56621117b
Binary files /dev/null and b/fonts/medleydisplayfonts/TIMESROMAN08-BRR.MEDLEYDISPLAYFONT differ
diff --git a/fonts/medleydisplayfonts/TIMESROMAN08-MIR.MEDLEYDISPLAYFONT b/fonts/medleydisplayfonts/TIMESROMAN08-MIR.MEDLEYDISPLAYFONT
new file mode 100644
index 000000000..984f1eb14
Binary files /dev/null and b/fonts/medleydisplayfonts/TIMESROMAN08-MIR.MEDLEYDISPLAYFONT differ
diff --git a/fonts/medleydisplayfonts/TIMESROMAN08-MRC.MEDLEYDISPLAYFONT b/fonts/medleydisplayfonts/TIMESROMAN08-MRC.MEDLEYDISPLAYFONT
new file mode 100644
index 000000000..c50de7301
Binary files /dev/null and b/fonts/medleydisplayfonts/TIMESROMAN08-MRC.MEDLEYDISPLAYFONT differ
diff --git a/fonts/medleydisplayfonts/TIMESROMAN08-MRR.MEDLEYDISPLAYFONT b/fonts/medleydisplayfonts/TIMESROMAN08-MRR.MEDLEYDISPLAYFONT
new file mode 100644
index 000000000..841213b40
Binary files /dev/null and b/fonts/medleydisplayfonts/TIMESROMAN08-MRR.MEDLEYDISPLAYFONT differ
diff --git a/fonts/medleydisplayfonts/TIMESROMAN09-MRC.MEDLEYDISPLAYFONT b/fonts/medleydisplayfonts/TIMESROMAN09-MRC.MEDLEYDISPLAYFONT
new file mode 100644
index 000000000..eb0d3a4c7
Binary files /dev/null and b/fonts/medleydisplayfonts/TIMESROMAN09-MRC.MEDLEYDISPLAYFONT differ
diff --git a/fonts/medleydisplayfonts/TIMESROMAN09-MRR.MEDLEYDISPLAYFONT b/fonts/medleydisplayfonts/TIMESROMAN09-MRR.MEDLEYDISPLAYFONT
new file mode 100644
index 000000000..c2f6e2042
Binary files /dev/null and b/fonts/medleydisplayfonts/TIMESROMAN09-MRR.MEDLEYDISPLAYFONT differ
diff --git a/fonts/medleydisplayfonts/TIMESROMAN10-BRR.MEDLEYDISPLAYFONT b/fonts/medleydisplayfonts/TIMESROMAN10-BRR.MEDLEYDISPLAYFONT
new file mode 100644
index 000000000..286dd6635
Binary files /dev/null and b/fonts/medleydisplayfonts/TIMESROMAN10-BRR.MEDLEYDISPLAYFONT differ
diff --git a/fonts/medleydisplayfonts/TIMESROMAN10-MIR.MEDLEYDISPLAYFONT b/fonts/medleydisplayfonts/TIMESROMAN10-MIR.MEDLEYDISPLAYFONT
new file mode 100644
index 000000000..fe30c7038
Binary files /dev/null and b/fonts/medleydisplayfonts/TIMESROMAN10-MIR.MEDLEYDISPLAYFONT differ
diff --git a/fonts/medleydisplayfonts/TIMESROMAN10-MRC.MEDLEYDISPLAYFONT b/fonts/medleydisplayfonts/TIMESROMAN10-MRC.MEDLEYDISPLAYFONT
new file mode 100644
index 000000000..db5f35a01
Binary files /dev/null and b/fonts/medleydisplayfonts/TIMESROMAN10-MRC.MEDLEYDISPLAYFONT differ
diff --git a/fonts/medleydisplayfonts/TIMESROMAN10-MRR.MEDLEYDISPLAYFONT b/fonts/medleydisplayfonts/TIMESROMAN10-MRR.MEDLEYDISPLAYFONT
new file mode 100644
index 000000000..2dec349b6
Binary files /dev/null and b/fonts/medleydisplayfonts/TIMESROMAN10-MRR.MEDLEYDISPLAYFONT differ
diff --git a/fonts/medleydisplayfonts/TIMESROMAN11-MRR.MEDLEYDISPLAYFONT b/fonts/medleydisplayfonts/TIMESROMAN11-MRR.MEDLEYDISPLAYFONT
new file mode 100644
index 000000000..373882868
Binary files /dev/null and b/fonts/medleydisplayfonts/TIMESROMAN11-MRR.MEDLEYDISPLAYFONT differ
diff --git a/fonts/medleydisplayfonts/TIMESROMAN12-BRR.MEDLEYDISPLAYFONT b/fonts/medleydisplayfonts/TIMESROMAN12-BRR.MEDLEYDISPLAYFONT
new file mode 100644
index 000000000..108249f2d
Binary files /dev/null and b/fonts/medleydisplayfonts/TIMESROMAN12-BRR.MEDLEYDISPLAYFONT differ
diff --git a/fonts/medleydisplayfonts/TIMESROMAN12-MIR.MEDLEYDISPLAYFONT b/fonts/medleydisplayfonts/TIMESROMAN12-MIR.MEDLEYDISPLAYFONT
new file mode 100644
index 000000000..fa0d85dfd
Binary files /dev/null and b/fonts/medleydisplayfonts/TIMESROMAN12-MIR.MEDLEYDISPLAYFONT differ
diff --git a/fonts/medleydisplayfonts/TIMESROMAN12-MRC.MEDLEYDISPLAYFONT b/fonts/medleydisplayfonts/TIMESROMAN12-MRC.MEDLEYDISPLAYFONT
new file mode 100644
index 000000000..d344204ef
Binary files /dev/null and b/fonts/medleydisplayfonts/TIMESROMAN12-MRC.MEDLEYDISPLAYFONT differ
diff --git a/fonts/medleydisplayfonts/TIMESROMAN12-MRR.MEDLEYDISPLAYFONT b/fonts/medleydisplayfonts/TIMESROMAN12-MRR.MEDLEYDISPLAYFONT
new file mode 100644
index 000000000..f3b676602
Binary files /dev/null and b/fonts/medleydisplayfonts/TIMESROMAN12-MRR.MEDLEYDISPLAYFONT differ
diff --git a/fonts/medleydisplayfonts/TIMESROMAN13-MRR.MEDLEYDISPLAYFONT b/fonts/medleydisplayfonts/TIMESROMAN13-MRR.MEDLEYDISPLAYFONT
new file mode 100644
index 000000000..04dc1c2fd
Binary files /dev/null and b/fonts/medleydisplayfonts/TIMESROMAN13-MRR.MEDLEYDISPLAYFONT differ
diff --git a/fonts/medleydisplayfonts/TIMESROMAN14-MRC.MEDLEYDISPLAYFONT b/fonts/medleydisplayfonts/TIMESROMAN14-MRC.MEDLEYDISPLAYFONT
new file mode 100644
index 000000000..e90385806
Binary files /dev/null and b/fonts/medleydisplayfonts/TIMESROMAN14-MRC.MEDLEYDISPLAYFONT differ
diff --git a/fonts/medleydisplayfonts/TIMESROMAN14-MRR.MEDLEYDISPLAYFONT b/fonts/medleydisplayfonts/TIMESROMAN14-MRR.MEDLEYDISPLAYFONT
new file mode 100644
index 000000000..57afd0a72
Binary files /dev/null and b/fonts/medleydisplayfonts/TIMESROMAN14-MRR.MEDLEYDISPLAYFONT differ
diff --git a/fonts/medleydisplayfonts/TIMESROMAN16-MRR.MEDLEYDISPLAYFONT b/fonts/medleydisplayfonts/TIMESROMAN16-MRR.MEDLEYDISPLAYFONT
new file mode 100644
index 000000000..63fc17aeb
Binary files /dev/null and b/fonts/medleydisplayfonts/TIMESROMAN16-MRR.MEDLEYDISPLAYFONT differ
diff --git a/fonts/medleydisplayfonts/TIMESROMAN18-MRC.MEDLEYDISPLAYFONT b/fonts/medleydisplayfonts/TIMESROMAN18-MRC.MEDLEYDISPLAYFONT
new file mode 100644
index 000000000..4f227a002
Binary files /dev/null and b/fonts/medleydisplayfonts/TIMESROMAN18-MRC.MEDLEYDISPLAYFONT differ
diff --git a/fonts/medleydisplayfonts/TIMESROMAN18-MRR.MEDLEYDISPLAYFONT b/fonts/medleydisplayfonts/TIMESROMAN18-MRR.MEDLEYDISPLAYFONT
new file mode 100644
index 000000000..1b69a883f
Binary files /dev/null and b/fonts/medleydisplayfonts/TIMESROMAN18-MRR.MEDLEYDISPLAYFONT differ
diff --git a/fonts/medleydisplayfonts/TIMESROMAN36-MRR.MEDLEYDISPLAYFONT b/fonts/medleydisplayfonts/TIMESROMAN36-MRR.MEDLEYDISPLAYFONT
new file mode 100644
index 000000000..f3f398bf2
Binary files /dev/null and b/fonts/medleydisplayfonts/TIMESROMAN36-MRR.MEDLEYDISPLAYFONT differ
diff --git a/fonts/medleydisplayfonts/TIMESROMAND24-MRR.MEDLEYDISPLAYFONT b/fonts/medleydisplayfonts/TIMESROMAND24-MRR.MEDLEYDISPLAYFONT
new file mode 100644
index 000000000..cce654309
Binary files /dev/null and b/fonts/medleydisplayfonts/TIMESROMAND24-MRR.MEDLEYDISPLAYFONT differ
diff --git a/fonts/medleydisplayfonts/TIMESROMAND30-MRR.MEDLEYDISPLAYFONT b/fonts/medleydisplayfonts/TIMESROMAND30-MRR.MEDLEYDISPLAYFONT
new file mode 100644
index 000000000..9e1ac57c6
Binary files /dev/null and b/fonts/medleydisplayfonts/TIMESROMAND30-MRR.MEDLEYDISPLAYFONT differ
diff --git a/fonts/medleydisplayfonts/TIMESROMAND36-MRR.MEDLEYDISPLAYFONT b/fonts/medleydisplayfonts/TIMESROMAND36-MRR.MEDLEYDISPLAYFONT
new file mode 100644
index 000000000..4753c5071
Binary files /dev/null and b/fonts/medleydisplayfonts/TIMESROMAND36-MRR.MEDLEYDISPLAYFONT differ
diff --git a/fonts/medleydisplayfonts/TIMESROMAND72-MRR.MEDLEYDISPLAYFONT b/fonts/medleydisplayfonts/TIMESROMAND72-MRR.MEDLEYDISPLAYFONT
new file mode 100644
index 000000000..1a3abf24e
Binary files /dev/null and b/fonts/medleydisplayfonts/TIMESROMAND72-MRR.MEDLEYDISPLAYFONT differ
diff --git a/fonts/medleydisplayfonts/TITAN10-BIR.MEDLEYDISPLAYFONT b/fonts/medleydisplayfonts/TITAN10-BIR.MEDLEYDISPLAYFONT
new file mode 100644
index 000000000..5682c241b
Binary files /dev/null and b/fonts/medleydisplayfonts/TITAN10-BIR.MEDLEYDISPLAYFONT differ
diff --git a/fonts/medleydisplayfonts/TITAN10-BRR.MEDLEYDISPLAYFONT b/fonts/medleydisplayfonts/TITAN10-BRR.MEDLEYDISPLAYFONT
new file mode 100644
index 000000000..396235c10
Binary files /dev/null and b/fonts/medleydisplayfonts/TITAN10-BRR.MEDLEYDISPLAYFONT differ
diff --git a/fonts/medleydisplayfonts/TITAN10-MIR.MEDLEYDISPLAYFONT b/fonts/medleydisplayfonts/TITAN10-MIR.MEDLEYDISPLAYFONT
new file mode 100644
index 000000000..2609a0210
Binary files /dev/null and b/fonts/medleydisplayfonts/TITAN10-MIR.MEDLEYDISPLAYFONT differ
diff --git a/fonts/medleydisplayfonts/TITAN10-MRR.MEDLEYDISPLAYFONT b/fonts/medleydisplayfonts/TITAN10-MRR.MEDLEYDISPLAYFONT
new file mode 100644
index 000000000..8f83544c5
Binary files /dev/null and b/fonts/medleydisplayfonts/TITAN10-MRR.MEDLEYDISPLAYFONT differ
diff --git a/fonts/medleydisplayfonts/TITAN12-BRR.MEDLEYDISPLAYFONT b/fonts/medleydisplayfonts/TITAN12-BRR.MEDLEYDISPLAYFONT
new file mode 100644
index 000000000..398648709
Binary files /dev/null and b/fonts/medleydisplayfonts/TITAN12-BRR.MEDLEYDISPLAYFONT differ
diff --git a/fonts/medleydisplayfonts/TITAN12-MRR.MEDLEYDISPLAYFONT b/fonts/medleydisplayfonts/TITAN12-MRR.MEDLEYDISPLAYFONT
new file mode 100644
index 000000000..cf3ab299c
Binary files /dev/null and b/fonts/medleydisplayfonts/TITAN12-MRR.MEDLEYDISPLAYFONT differ
diff --git a/fonts/medleydisplayfonts/TITAN14-MRR.MEDLEYDISPLAYFONT b/fonts/medleydisplayfonts/TITAN14-MRR.MEDLEYDISPLAYFONT
new file mode 100644
index 000000000..083436687
Binary files /dev/null and b/fonts/medleydisplayfonts/TITAN14-MRR.MEDLEYDISPLAYFONT differ
diff --git a/fonts/medleydisplayfonts/TITANLEGAL12-MRR.MEDLEYDISPLAYFONT b/fonts/medleydisplayfonts/TITANLEGAL12-MRR.MEDLEYDISPLAYFONT
new file mode 100644
index 000000000..631932c1f
Binary files /dev/null and b/fonts/medleydisplayfonts/TITANLEGAL12-MRR.MEDLEYDISPLAYFONT differ
diff --git a/fonts/medleydisplayfonts/TITANLEGAL14-MRR.MEDLEYDISPLAYFONT b/fonts/medleydisplayfonts/TITANLEGAL14-MRR.MEDLEYDISPLAYFONT
new file mode 100644
index 000000000..7fb98080c
Binary files /dev/null and b/fonts/medleydisplayfonts/TITANLEGAL14-MRR.MEDLEYDISPLAYFONT differ
diff --git a/fonts/medleydisplayfonts/TONTO14-MRR.MEDLEYDISPLAYFONT b/fonts/medleydisplayfonts/TONTO14-MRR.MEDLEYDISPLAYFONT
new file mode 100644
index 000000000..8455c3946
Binary files /dev/null and b/fonts/medleydisplayfonts/TONTO14-MRR.MEDLEYDISPLAYFONT differ
diff --git a/fonts/medleydisplayfonts/VISIBLE10-MRR.MEDLEYDISPLAYFONT b/fonts/medleydisplayfonts/VISIBLE10-MRR.MEDLEYDISPLAYFONT
new file mode 100644
index 000000000..c5227622d
Binary files /dev/null and b/fonts/medleydisplayfonts/VISIBLE10-MRR.MEDLEYDISPLAYFONT differ
diff --git a/fonts/medleydisplayfonts/XEROXBOOK12-MRR.MEDLEYDISPLAYFONT b/fonts/medleydisplayfonts/XEROXBOOK12-MRR.MEDLEYDISPLAYFONT
new file mode 100644
index 000000000..cf847707d
Binary files /dev/null and b/fonts/medleydisplayfonts/XEROXBOOK12-MRR.MEDLEYDISPLAYFONT differ
diff --git a/fonts/medleydisplayfonts/XEROXLOGO48-MRR.MEDLEYDISPLAYFONT b/fonts/medleydisplayfonts/XEROXLOGO48-MRR.MEDLEYDISPLAYFONT
new file mode 100644
index 000000000..107951a5c
Binary files /dev/null and b/fonts/medleydisplayfonts/XEROXLOGO48-MRR.MEDLEYDISPLAYFONT differ
diff --git a/internal/FONT-DEBUG b/internal/FONT-DEBUG
index 52587e8ab..b002a1ac7 100644
--- a/internal/FONT-DEBUG
+++ b/internal/FONT-DEBUG
@@ -1,23 +1,25 @@
 (DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
 
-
(FILECREATED "19-Jul-2025 16:43:34" {WMEDLEY}<internal>FONT-DEBUG.;46
 19345  
+
(FILECREATED " 7-Oct-2025 14:52:20" {WMEDLEY}<internal>FONT-DEBUG.;68
 23618  
 
       :EDIT-BY rmk
 
-      :CHANGES-TO (FNS CSBMSIZE FONTSIZE CSSIZE EQCHARBM)
-                  (VARS FONT-DEBUGCOMS)
+      :CHANGES-TO (FNS LEGACYFONTCREATE)
 
-      :PREVIOUS-DATE "19-Jul-2025 12:36:48" {WMEDLEY}<internal>FONT-DEBUG.;41)
+      :PREVIOUS-DATE " 7-Oct-2025 08:58:03" {WMEDLEY}<internal>FONT-DEBUG.;67)
 
 
 (PRETTYCOMPRINT FONT-DEBUGCOMS)
 
-(RPAQQ FONT-DEBUGCOMS
 (
-                       (* ;; "Little tools to help in debugging display fonts")

+(RPAQQ FONT-DEBUGCOMS

+       (
+        (* ;; "Little tools to help in debugging display fonts")

 
-                       (FNS DEBUGCHARSET IBM ICS SHOWCACHE SHOWCSBITMAP EQCSBM EQCHARBM CHARSETCHARS
-                            CHARBMDIFFS SHOWCSCHAR CSCOMPARE SHOWBMS SHOWCHARBITMAPS CANDS)
-                       (FNS FONTSIZE CSSIZE CSBMSIZE)))
+        (FNS DEBUGCHARSET IBM ICS SHOWCACHE SHOWCSBITMAP EQCSBM EQCHARBM CHARSETCHARS CHARBMDIFFS 
+             SHOWCSCHAR CSCOMPARE SHOWBMS SHOWCHARBITMAPS CANDS LEGACYFONTCREATE)
+        (FNS FONTSIZE CSSIZE CSBMSIZE)
+        (FNS FONTCOMPARE)
+        (MACROS TRUEFONT)))
 
 
 
@@ -26,7 +28,8 @@
 (DEFINEQ
 
 (DEBUGCHARSET

-  [LAMBDA (FONTSPEC CHARSET INCLUDEMEDLEYFONT)
               (* ; "Edited  9-Jul-2025 16:26 by rmk")


+  [LAMBDA (FONTSPEC CHARSET INCLUDEMEDLEYFONT)
               (* ; "Edited 27-Aug-2025 17:19 by rmk")


+                                                             (* ; "Edited  9-Jul-2025 16:26 by rmk")


                                                              (* ; "Edited  6-Jul-2025 22:33 by rmk")


                                                              (* ; "Edited  2-Jul-2025 16:50 by rmk")


                                                              (* ; "Edited 30-Jun-2025 09:27 by rmk")


@@ -43,46 +46,41 @@
                (CL:UNLESS INCLUDEMEDLEYFONT
                    (RESETSAVE DISPLAYFONTEXTENSIONS (REMOVE 'MEDLEYDISPLAYFONT DISPLAYFONTEXTENSIONS)
                           ))
-               [if
 (OR (LITATOM FONTSPEC)
+               (if
 (OR (LITATOM FONTSPEC)
                        (STRINGP FONTSPEC))
                    then
 (CL:UNLESS CHARSET (SETQ CHARSET 0))
                         (LET (STRM)
                              [RESETSAVE (SETQ STRM (OPENSTREAM FONTSPEC 'INPUT))
                                     `(PROGN (CLOSEF? OLDVALUE]
-                             (for
 FNS CSINFO (FI _ (\FONTINFOFROMFILENAME FONTSPEC 'DISPLAY))
+                             (for
 FNS CSINFO (FI _ (FONTSPECFROMFILENAME FONTSPEC 'DISPLAY))
                                 in
 DISPLAYCHARSETFNS
                                 do
 (CL:WHEN (CAR (NLSETQ (APPLY* (CADR FNS)
                                                                 STRM)))
                                        (SETQ CSINFO (APPLY* (CADDR FNS)
-                                                           STRM
-                                                           (CAR FI)
-                                                           (CADR FI)
-                                                           (CADDR FI)
-                                                           (CADDDR FI)
-                                                           (CAR (CDDDDR FI))
-                                                           CHARSET))
+                                                           STRM CHARSET))
                                        (PUTMULTI (fetch
 (CHARSETINFO CSINFOPROPS) of
 CSINFO)
                                               'FILE
                                               (PSEUDOFILENAME FONTSPEC))
                                        (RETURN CSINFO))
                                    (CLOSEF? STRM)))
-                 else
 (LET ((CS CHARSET))
-                           (CL:MULTIPLE-VALUE-BIND (FAMILY SIZE FACE ROTATION DEVICE CHARSET)
-                                  (\FONT.CHECKARGS FONTSPEC)
-                                  (CL:WHEN CS (SETQ CHARSET CS))
-                                  (\READCHARSET FAMILY SIZE FACE ROTATION 'DISPLAY CHARSET])])
+                 else
 (\READCHARSET (\FONT.CHECKARGS FONTSPEC)
+                             CHARSET)))])
 
 (IBM

-  [LAMBDA (FONT CHARSET)
                                     (* ; "Edited 29-Jun-2025 17:05 by rmk")


+  [LAMBDA (FONT CHARSET)
                                     (* ; "Edited 27-Aug-2025 17:29 by rmk")


+                                                             (* ; "Edited 25-Aug-2025 08:58 by rmk")


+                                                             (* ; "Edited 29-Jun-2025 17:05 by rmk")


                                                              (* ; "Edited 20-Jun-2025 16:35 by rmk")


                                                              (* ; "Edited 18-Jun-2025 14:09 by rmk")

 
     (* ;; "Inspects the character set bitmap for CHARSET in FONT, which may also be a charset info.  If necessary, builds the font (unlike ICS).")

 
+    (SETQ CHARSET (CHARSET.DECODE CHARSET))
     (SHOWCSBITMAP
 (if
 (type?
 CHARSETINFO FONT)
                       then
 FONT
-                    else
 (\XGETCHARSETINFO (SETQ FONT (FONTCREATE FONT))
-                                (OR CHARSET 0])
+                    elseif
 FONT
+                      then
 (\XGETCHARSETINFO (FONTCREATE FONT)
+                                  (OR CHARSET 0])
 
 (ICS

   [LAMBDA (FONT CHARSET INCLUDEMEDLEYFONT)
                   (* ; "Edited  7-Jul-2025 23:12 by rmk")


@@ -114,7 +112,8 @@
     (DV \FONTEXISTS?-CACHE])
 
 (SHOWCSBITMAP

-  [LAMBDA (CSINFO)
                                           (* ; "Edited 29-Jun-2025 17:07 by rmk")


+  [LAMBDA (CSINFO)
                                           (* ; "Edited 17-Aug-2025 12:36 by rmk")


+                                                             (* ; "Edited 29-Jun-2025 17:07 by rmk")


                                                              (* ; "Edited 20-Jun-2025 16:38 by rmk")

 
     (* ;; "Given a charsetinfo, shows the whole bitmap using EDITBM.  Unfortunately, that runs in a separate process, so we can't directly get the window to put something useful in the title.  If EDITBM is called directly, it doen't return until you quit...in which case it's gone.  We'd really like just the displayer.")

@@ -129,7 +128,7 @@
                        (IGREATERP (BITMAPHEIGHT BM)
                               0))
              then
 (EVAL.AS.PROCESS (LIST 'EDITBM BM))
-           else
 "EMPTY BITMAP")
+           else
 (PRINTOUT T "EMPTY BITMAP" T))
          CSINFO])
 
 (EQCSBM

@@ -277,11 +276,28 @@
     (LET ((CINFOS (CSCOMPARE
 CS1 CS2 CHARSET INCLUDEMEDLEYFONT)))
          (SHOWCHARBITMAPS
 NIL CINFOS CHARSET INCLUDEMEDLEYFONT T)
          CINFOS])
+
+(LEGACYFONTCREATE

+  [LAMBDA (FAMILY SIZE FACE ROTATION DEVICE NOERRORFLG CHARSET)

+                                                             (* ; "Edited  7-Oct-2025 14:50 by rmk")


+                                                             (* ; "Edited  2-Sep-2025 13:46 by rmk")


+                                                             (* ; "Edited 29-Aug-2025 22:38 by rmk")


+                                                             (* ; "Edited 17-Aug-2025 15:47 by rmk")


+                                                             (* ; "Edited 31-Jul-2025 10:10 by rmk")


+                                                             (* ; "Edited 25-Jul-2025 13:43 by rmk")

+
+    (* ;; "New font, no coercions, no MEDLEYFORMAT")

+
+    (LEGACYFONTS (FONTCREATE FAMILY SIZE FACE ROTATION DEVICE NOERRORFLG CHARSET])
 )
 (DEFINEQ
 
 (FONTSIZE

-  [LAMBDA (FONT CHARSETS FILETOO NOERROR)
                    (* ; "Edited 19-Jul-2025 16:42 by rmk")

+  [LAMBDA (FONT CHARSETS FILETOO NOERROR)
                    (* ; "Edited 16-Aug-2025 23:34 by rmk")


+                                                             (* ; "Edited 19-Jul-2025 16:42 by rmk")

+
+    (* ;; "Estimates the amount of storage occupied by FONT")

+
     (SETQ FONT (FONTCREATE FONT NIL NIL NIL 'DISPLAY NOERROR))
     (CL:UNLESS CHARSETS
         (SETQ CHARSETS (for
 CS CSINFO BM from
 0 to
 255 when
 (SETQ CSINFO (\XGETCHARSETINFO FONT CS))
@@ -343,10 +359,72 @@
                                                           8) finally
 (PRINTOUT T T))
       else
 0])
 )
+(DEFINEQ
+
+(FONTCOMPARE

+  [LAMBDA (ARGS VIRGIN SHOWFONT)
                             (* ; "Edited  5-Aug-2025 13:14 by rmk")

+
+    (* ;; "Prints a line of characters in different fonts, for shape/size comparison.  Each argument is a list of the form (FONT CHAR1 CHAR2...) or (FONT CHAR1 - CHARN) (hyphen).  Characters can be codes or names.")

+
+    (* ;; "If CHARS are not specfied, uses the chars from the previous arg.")

+
+    (RESETLST
+        (RESETSAVE (DSPFONT NIL T))
+        (CL:WHEN VIRGIN
+            (RESETSAVE \FONTSINCORE NIL)
+            (RESETSAVE \DISPLAYCHARSETCOERCIONS NIL)
+            (RESETSAVE \DISPLAYFONTCOERCIONS NIL)
+            (RESETSAVE \FONTEXISTS?-CACHE NIL)
+            (RESETSAVE DISPLAYFONTEXTENSIONS '(DISPLAYFONT)))
+        (TERPRI T)
+        (for
 A CHARS FONT SIZEPOS in
 ARGS
+           do
 (CL:WHEN (CADR A)
+                  (SETQ CHARS (CDR A))
+                  [SETQ CHARS (if
 (EQ '- (CADR CHARS))
+                                  then
 (for
 C from
 (CL:IF (CHARCODEP (CAR CHARS))
+                                                       (CAR CHARS)
+                                                       (CHARCODE.DECODE (CAR CHARS)))
+                                          to
 (CL:IF (CHARCODEP (CADDR CHARS))
+                                                 (CADDR CHARS)
+                                                 (CHARCODE.DECODE (CADDR CHARS))) collect
 C)
+                                else
 (for
 C in
 CHARS collect
 (CL:IF (CHARCODEP C)
+                                                                 C
+                                                                 (CHARCODE.DECODE C))])
+              (SETQ FONT (FONTCREATE (CAR A)))
+              (if
 SHOWFONT
+                  then
 (SETQ SIZEPOS (IDIFFERENCE (STRPOS "-" FONT)
+                                            2))
+                       (PRINTOUT T .FONT '(GACHA 8)
+                              " ["
+                              (SUBSTRING FONT 2 3)
+                              (SUBSTRING FONT SIZEPOS (ADD1 SIZEPOS))
+                              "]")
+                else
 (PRINTOUT T .FONT '(GACHA 8)
+                            "/"))
+              (DSPFONT FONT T)
+              (for
 C in
 CHARS do
 (PRIN1 (CHARACTER C)
+                                        T)))
+        (TERPRI T))])
+)
+(DECLARE%: EVAL@COMPILE 
+
+(PUTPROPS TRUEFONT
 MACRO
 ((FORM)                             (* ; 
+
                                           "Execute FORM in a non-medleyfont displayfont environment")

+                          (RESETVARS (\FONTSINCORE \FONTEXISTS?-CACHE DISPLAYFONTCOERCIONS 
+                                            DISPLAYCHARCOERCIONS (DISPLAYFONTEXTENSIONS '(DISPLAYFONT
+                                                                                          ))
+                                            (DISPLAYFONTDIRECTORIES (MEDLEYDIR "fonts>displayfonts>")
+                                                   )
+                                            (DISPLAYCHARSETFNS (REMOVE (ASSOC 'MEDLEYFONT 
+                                                                              DISPLAYCHARSETFNS)
+                                                                      DISPLAYCHARSETFNS)))
+                                     (RETURN FORM))))
+)
 (DECLARE%: DONTCOPY
-  (FILEMAP (NIL (818 15839 (DEBUGCHARSET 828 . 4007) (IBM 4009 . 4717) (ICS 4719 . 6013) (SHOWCACHE 6015
- . 6362) (SHOWCSBITMAP 6364 . 7478) (EQCSBM 7480 . 8366) (EQCHARBM 8368 . 9129) (CHARSETCHARS 9131 . 
-9797) (CHARBMDIFFS 9799 . 10675) (SHOWCSCHAR 10677 . 11112) (CSCOMPARE 11114 . 13706) (SHOWBMS 13708
- . 13886) (SHOWCHARBITMAPS 13888 . 15479) (CANDS 15481 . 15837)) (15840 19322 (FONTSIZE 15850 . 16535)
- (CSSIZE 16537 . 17946) (CSBMSIZE 17948 . 19320)))))
+  (FILEMAP (NIL (778 16538 (DEBUGCHARSET 788 . 3409) (IBM 3411 . 4409) (ICS 4411 . 5705) (SHOWCACHE 5707
+ . 6054) (SHOWCSBITMAP 6056 . 7294) (EQCSBM 7296 . 8182) (EQCHARBM 8184 . 8945) (CHARSETCHARS 8947 . 
+9613) (CHARBMDIFFS 9615 . 10491) (SHOWCSCHAR 10493 . 10928) (CSCOMPARE 10930 . 13522) (SHOWBMS 13524
+ . 13702) (SHOWCHARBITMAPS 13704 . 15295) (CANDS 15297 . 15653) (LEGACYFONTCREATE 15655 . 16536)) (
+16539 20198 (FONTSIZE 16549 . 17411) (CSSIZE 17413 . 18822) (CSBMSIZE 18824 . 20196)) (20199 22606 (
+FONTCOMPARE 20209 . 22604)))))
 STOP
diff --git a/internal/FONT-DEBUG.LCOM b/internal/FONT-DEBUG.LCOM
index 301a5ac24..1c59ea018 100644
Binary files a/internal/FONT-DEBUG.LCOM and b/internal/FONT-DEBUG.LCOM differ
diff --git a/internal/loadups/LOADUP-FULL b/internal/loadups/LOADUP-FULL
index ed1583f58..cdeba4e46 100644
--- a/internal/loadups/LOADUP-FULL
+++ b/internal/loadups/LOADUP-FULL
@@ -1,12 +1,12 @@
 (DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
 
-
(FILECREATED " 1-Sep-2025 11:59:41" {WMEDLEY}<internal>loadups>LOADUP-FULL.;31
 5430   
+
(FILECREATED "20-Sep-2025 14:18:19" {WMEDLEY}<internal>loadups>LOADUP-FULL.;34
 5662   
 
       :EDIT-BY rmk
 
-      :CHANGES-TO (FNS LOADUP-FULL)
+      :CHANGES-TO (FNS LOADFULLFONTS)
 
-      :PREVIOUS-DATE "18-Aug-2025 12:09:49" {WMEDLEY}<internal>loadups>LOADUP-FULL.;29)
+      :PREVIOUS-DATE " 2-Sep-2025 20:07:20" {WMEDLEY}<internal>loadups>LOADUP-FULL.;33)
 
 
 (PRETTYCOMPRINT LOADUP-FULLCOMS)
@@ -16,7 +16,9 @@
 (DEFINEQ
 
 (LOADFULLFONTS

-  [LAMBDA NIL
                                                (* ; "Edited 13-Jul-2025 11:40 by rmk")


+  [LAMBDA NIL
                                                (* ; "Edited 20-Sep-2025 14:17 by rmk")


+                                                             (* ; "Edited  2-Sep-2025 20:06 by rmk")


+                                                             (* ; "Edited 13-Jul-2025 11:40 by rmk")


                                                              (* ; "Edited 30-Jun-2025 00:04 by rmk")


                                                              (* ; "Edited 20-Jun-2025 11:16 by rmk")


                                                              (* ; "Edited 16-Jun-2025 15:34 by rmk")


@@ -36,7 +38,7 @@
              do
 (PRINTOUT T SIZE " ")
                 (for
 FACE in
 '(MRR BRR MIR)
                    do
 (FONTCREATE FAMILY SIZE FACE 0 'DISPLAY NIL 0)
-                      (for
 CSET in
 '(33 34 35 238 239 241)
+                      (for
 CSET in
 '("41" "42" "43" "356" "357" "361")
                          do
 (NLSETQ (FONTCREATE FAMILY SIZE FACE 0 'DISPLAY NIL CSET]
           (PRINTOUT T T))
     (PRINTOUT T "  Loading postscript fonts" T)
@@ -98,5 +100,5 @@
 
 (FIXMETA
)
 (DECLARE%: DONTCOPY
-  (FILEMAP (NIL (456 5392 (LOADFULLFONTS 466 . 2371) (LOADUP-FULL 2373 . 5142) (FIXMETA 5144 . 5390)))))
+  (FILEMAP (NIL (458 5624 (LOADFULLFONTS 468 . 2603) (LOADUP-FULL 2605 . 5374) (FIXMETA 5376 . 5622)))))
 STOP
diff --git a/internal/loadups/LOADUP-FULL.LCOM b/internal/loadups/LOADUP-FULL.LCOM
index e28b50b43..d5a7e96d2 100644
Binary files a/internal/loadups/LOADUP-FULL.LCOM and b/internal/loadups/LOADUP-FULL.LCOM differ
diff --git a/library/CHAT b/library/CHAT
index 6f7ef8e55..33ac7270d 100644
--- a/library/CHAT
+++ b/library/CHAT
@@ -1,18 +1,17 @@
 (DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
-
(FILECREATED "20-Jan-93 13:46:52" {DSK}<python>lde>lispcore>library>CHAT.;3
 54346  
 
-      changes to%:  (RECORDS EMACSCOMMANDS)
+
(FILECREATED "11-Oct-2025 10:32:05" {WMEDLEY}<library>CHAT.;3
 59585  
 
-      previous date%: "21-Dec-92 10:50:12" {DSK}<python>lde>lispcore>library>CHAT.;2)
+      :EDIT-BY rmk
 
+      :CHANGES-TO (FNS CHAT.TYPEIN CHAT.TYPEOUT CHAT.INIT)
+
+      :PREVIOUS-DATE "20-Jan-93 13:46:52" {WMEDLEY}<library>CHAT.;1)
 
-(* ; "
-Copyright (c) 1982, 1983, 1984, 1985, 1986, 1987, 1988, 1989, 1990, 1992, 1993 by Venue & Xerox Corporation.  All rights reserved.
-")
 
 (PRETTYCOMPRINT CHATCOMS)
 
-(RPAQQ CHATCOMS
 
+(RPAQQ CHATCOMS

        [(COMS                                                (* ; "CHAT typein")

               (FNS CHAT CHAT.STARTUP CHAT.PROMPT.FOR.INPUT CHAT.CHOOSE.EMULATOR CHAT.SET.EMULATOR 
                    CHAT.INIT FIND.CHAT.PROTOCOL CHAT.TYPEIN CHAT.BIN CHAT.CLOSE 
@@ -73,7 +72,7 @@ Copyright (c) 1982, 1983, 1984, 1985, 1986, 1987, 1988, 1989, 1990, 1992, 1993 b
                      (P (SETQ BackgroundMenu))
                      (FILES DMCHAT)
                                                              (* ; 
-
                                                      "need DMCHAT since it's the default emulator")

+
                                                        "need DMCHAT since it's the default emulator")

                      (INITRECORDS CHAT.STATE])
 
 
@@ -231,7 +230,8 @@ Host: " NIL "Enter name of host to chat to, or <cr> to abort" NIL NIL (QUOTE TTY
 )
 
 (CHAT.INIT

-  [LAMBDA (STREAMS WINDOW HOST DISPLAYTYPE)
             (* ; "Edited 11-Jun-90 14:37 by mitani")

+  [LAMBDA (STREAMS WINDOW HOST DISPLAYTYPE)
                  (* ; "Edited 10-Oct-2025 12:01 by rmk")


+                                                            (* ; "Edited 11-Jun-90 14:37 by mitani")

     (LET* [(INSTREAM (CAR STREAMS))
            (OUTSTREAM (CDR STREAMS))
            (DPYNAME (fetch
 (CHATDISPLAYTYPE DPYNAME) of
 DISPLAYTYPE))
@@ -245,10 +245,8 @@ Host: " NIL "Enter name of host to chat to, or <cr> to abort" NIL NIL (QUOTE TTY
           (WINDOWPROP WINDOW 'CHATSTATE STATE)
           (COND
              [(EQ DPYNAME 'TEDIT)
-              (replace
 (CHAT.STATE TEXTSTREAM) of
 STATE with

-                                                                (TEDITSTREAM.INIT
-                                                                 WINDOW
-                                                                 (FUNCTION TEDITCHAT.MENUFN]
+              (replace
 (CHAT.STATE TEXTSTREAM) of
 STATE with
 (TEDITSTREAM.INIT WINDOW
+                                                                    (FUNCTION TEDITCHAT.MENUFN]
              (T (WINDOWPROP WINDOW 'CURSORMOVEDFN NIL)
                 (WINDOWPROP WINDOW 'RESHAPEFN (FUNCTION CHAT.RESHAPEWINDOW))
                 (WINDOWPROP WINDOW 'BUTTONEVENTFN (FUNCTION CHAT.BUTTONFN))
@@ -257,7 +255,8 @@ Host: " NIL "Enter name of host to chat to, or <cr> to abort" NIL NIL (QUOTE TTY
                 (WINDOWPROP WINDOW 'WINDOWENTRYFN 'GIVE.TTY.PROCESS)
                 (WINDOWPROP WINDOW 'RIGHTBUTTONFN NIL)
                 (WINDOWPROP WINDOW 'CURSOROUTFN NIL)
-                (WINDOWPROP WINDOW 'SCROLLFN NIL)))
+                (WINDOWPROP WINDOW 'SCROLLFN NIL)
+                (MODERNWINDOW WINDOW)))
           (WINDOWADDPROP WINDOW 'CLOSEFN (FUNCTION CHAT.CLOSEFN))
           (WINDOWPROP WINDOW 'ICONWINDOW NIL)
           (WINDOWPROP WINDOW 'ICONFN (FUNCTION CHAT.ICONFN))
@@ -270,8 +269,97 @@ Host: " NIL "Enter name of host to chat to, or <cr> to abort" NIL NIL (QUOTE TTY
 )
 
 (CHAT.TYPEIN

-(LAMBDA (HOST WINDOW LOGOPTION INITSTREAM) (* ; "Edited 15-Feb-90 12:18 by bvm") (DECLARE (SPECVARS STREAM)) (* ; "so that menu can change it") (PROG* ((THISPROC (THIS.PROCESS)) (DEFAULTSTREAM T) (STATE (WINDOWPROP WINDOW (QUOTE CHATSTATE))) (CHATSTREAM (fetch (CHAT.STATE OUTSTREAM) of STATE)) (INSTREAM (fetch (CHAT.STATE INSTREAM) of STATE)) STREAM CH CHATPROMPTWINDOW LOCALECHOSTREAM) (RESETSAVE NIL (LIST (FUNCTION (LAMBDA (WINDOW) (AND RESETSTATE (NEQ RESETSTATE (QUOTE HARDRESET)) (CHAT.CLOSE WINDOW T)))) WINDOW)) (* ; "If an error occurs, or process is killed, this will flush the connection etc") (IF (NEQ LOGOPTION (QUOTE HARDRESET)) THEN (* ; "Only do this the first time") (LET ((DISPLAYTYPE (STREAMPROP INSTREAM (QUOTE DISPLAYTYPE))) DISPLAYNAME) (COND (DISPLAYTYPE (CHAT.SETDISPLAYTYPE INSTREAM (fetch (CHATDISPLAYTYPE DPYCODE) of DISPLAYTYPE) (SETQ DISPLAYNAME (fetch (CHATDISPLAYTYPE DPYNAME) of DISPLAYTYPE))))) (CHAT.SCREENPARAMS STATE INSTREAM WINDOW) (replace (CHAT.STATE TYPEOUTPROC) of STATE with (ADD.PROCESS (BQUOTE (CHAT.TYPEOUT (\, WINDOW) (QUOTE (\, DISPLAYNAME)) (QUOTE (\, STATE)))) (QUOTE NAME) (QUOTE CHAT.TYPEOUT) (QUOTE RESTARTABLE) (QUOTE HARDRESET))) (AND (NEQ LOGOPTION (QUOTE NONE)) (CHAT.LOGIN HOST LOGOPTION WINDOW STATE)) (COND (INITSTREAM (NLSETQ (SETQ STREAM (COND ((STRINGP INITSTREAM) (OPENSTRINGSTREAM INITSTREAM)) (T (OPENSTREAM INITSTREAM (QUOTE INPUT)))))))))) (TTYDISPLAYSTREAM WINDOW) (* ; "So that \TTYBACKGROUND flashes the caret where we expect") (bind OUTPUTSTREAM while (EQ (fetch (CHAT.STATE RUNNING?) of STATE) T) do (COND ((NULL STREAM) (SETQ STREAM DEFAULTSTREAM))) (SETQ OUTPUTSTREAM (if (fetch (CHAT.STATE LOCALECHO) of STATE) then (OR LOCALECHOSTREAM (SETQ LOCALECHOSTREAM (CL:MAKE-BROADCAST-STREAM CHATSTREAM (GETSTREAM WINDOW (QUOTE OUTPUT))))) else CHATSTREAM)) (COND ((EQ STREAM T) (* ;; "Handle terminal specially") (OR (TTY.PROCESSP) (\WAIT.FOR.TTY)) (COND ((\SYSBUFP) (do (SETQ CH (\GETKEY)) (COND ((<= CH \MAXTHINCHAR) (BOUT OUTPUTSTREAM CH)) ((EQ (LRSH CH 8) 1) (* ; "META char set => ascii meta") (BOUT OUTPUTSTREAM (LOGOR 128 (LOGAND CH 127)))) (T (* ; "Not in charset zero, not a meta.  Most hosts don't understand.(PRINTCCODE CH CHATSTREAM) (CHARSET CHATSTREAM 0)") (FLASHWINDOW WINDOW))) repeatwhile (\SYSBUFP)) (FORCEOUTPUT CHATSTREAM)))) (T (until (EOFP STREAM) do (BOUT OUTPUTSTREAM (\BIN STREAM))) (FORCEOUTPUT CHATSTREAM) (CLOSEF STREAM) (SETQ STREAM) (COND ((SETQ CHATPROMPTWINDOW (GETPROMPTWINDOW WINDOW NIL NIL T)) (* ; "Indicate completion of Input if came from menu command") (CLEARW CHATPROMPTWINDOW))))) (\TTYBACKGROUND)) (* ;; "Get here if we close connection.") (SELECTQ (fetch (CHAT.STATE RUNNING?) of STATE) (CLOSE (CHAT.CLOSE WINDOW)) (ABORT (CHAT.CLOSE WINDOW T)) (NIL (* ; "Already dead.")) (SHOULDNT (CONCAT "Unknown state in CHAT: " (fetch (CHAT.STATE RUNNING?) of STATE)))) (BLOCK)))
-)
+  [LAMBDA (HOST WINDOW LOGOPTION INITSTREAM)
                 (* ; "Edited 11-Oct-2025 10:30 by rmk")


+                                                             (* ; "Edited 15-Feb-90 12:18 by bvm")

+    (DECLARE
 (SPECVARS STREAM))                              (* ; "so that menu can change it")

+    (PROG* ((THISPROC (THIS.PROCESS))
+            (DEFAULTSTREAM T)
+            (STATE (WINDOWPROP WINDOW 'CHATSTATE))
+            (CHATSTREAM (fetch
 (CHAT.STATE OUTSTREAM) of
 STATE))
+            (INSTREAM (fetch
 (CHAT.STATE INSTREAM) of
 STATE))
+            STREAM CH CHATPROMPTWINDOW LOCALECHOSTREAM)
+           (RESETSAVE NIL (LIST [FUNCTION (LAMBDA (WINDOW)
+                                            (AND RESETSTATE (NEQ RESETSTATE 'HARDRESET)
+                                                 (CHAT.CLOSE
 WINDOW T]
+                                WINDOW))                     (* ; 
+
                       "If an error occurs, or process is killed, this will flush the connection etc")

+           [IF
 (NEQ LOGOPTION 'HARDRESET)
+               THEN
                                          (* ; "Only do this the first time")

+                    (LET ((DISPLAYTYPE (STREAMPROP INSTREAM 'DISPLAYTYPE))
+                          DISPLAYNAME)
+                         [COND
+                            (DISPLAYTYPE (CHAT.SETDISPLAYTYPE
 INSTREAM (fetch
 (CHATDISPLAYTYPE 
+                                                                                     DPYCODE)
+                                                                          of
 DISPLAYTYPE)
+                                                (SETQ DISPLAYNAME (fetch
 (CHATDISPLAYTYPE DPYNAME)
+                                                                     of
 DISPLAYTYPE]
+                         (CHAT.SCREENPARAMS
 STATE INSTREAM WINDOW)
+                         (replace
 (CHAT.STATE TYPEOUTPROC) of
 STATE
+                            with
 (ADD.PROCESS `(CHAT.TYPEOUT
 ,WINDOW ',DISPLAYNAME
+                                                      ',STATE)
+                                        'NAME
+                                        'CHAT.TYPEOUT
+                                        'RESTARTABLE
+                                        'HARDRESET))
+                         (AND (NEQ LOGOPTION 'NONE)
+                              (CHAT.LOGIN
 HOST LOGOPTION WINDOW STATE))
+                         (COND
+                            (INITSTREAM (NLSETQ (SETQ STREAM (COND
+                                                                ((STRINGP INITSTREAM)
+                                                                 (OPENSTRINGSTREAM INITSTREAM))
+                                                                (T (OPENSTREAM INITSTREAM
+                                                                          'INPUT]
+           (TTYDISPLAYSTREAM WINDOW)                         (* ; 
+
                                           "So that \TTYBACKGROUND flashes the caret where we expect")

+           (bind
 OUTPUTSTREAM while
 (EQ (fetch
 (CHAT.STATE RUNNING?) of
 STATE)
+                                        T)
+              do
 (COND
+                    ((NULL STREAM)
+                     (SETQ STREAM DEFAULTSTREAM)))
+                 (SETQ OUTPUTSTREAM (if
 (fetch
 (CHAT.STATE LOCALECHO) of
 STATE)
+                                        then
 [OR LOCALECHOSTREAM (SETQ LOCALECHOSTREAM
+                                                                  (CL:MAKE-BROADCAST-STREAM
+                                                                   CHATSTREAM
+                                                                   (GETSTREAM WINDOW 'OUTPUT]
+                                      else
 CHATSTREAM))
+                 [COND
+                    [(EQ STREAM T)
+
+                     (* ;; "Handle terminal specially")

+
+                     (OR (TTY.PROCESSP)
+                         (\WAIT.FOR.TTY))
+                     (COND
+                        ((\SYSBUFP)
+                         (do
 (SETQ CH (MTOUCODE (\GETKEY)))
+                             (COND
+                                ((<= CH \MAXTHINCHAR)
+                                 (BOUT OUTPUTSTREAM CH))
+                                [(EQ (LRSH CH 8)
+                                     1)                      (* ; "META char set => ascii meta")

+                                 (BOUT OUTPUTSTREAM (LOGOR 128 (LOGAND CH 127]
+                                (T                           (* ; "Not in charset zero, not a meta.  Most hosts don't understand.(PRINTCCODE CH CHATSTREAM) (CHARSET CHATSTREAM 0)")

+                                   (FLASHWINDOW WINDOW))) repeatwhile
 (\SYSBUFP))
+                         (FORCEOUTPUT CHATSTREAM]
+                    (T (until
 (EOFP STREAM) do
 (BOUT OUTPUTSTREAM (\BIN STREAM)))
+                       (FORCEOUTPUT CHATSTREAM)
+                       (CLOSEF STREAM)
+                       (SETQ STREAM)
+                       (COND
+                          ((SETQ CHATPROMPTWINDOW (GETPROMPTWINDOW WINDOW NIL NIL T))
+                                                             (* ; 
+
                                             "Indicate completion of Input if came from menu command")

+                           (CLEARW CHATPROMPTWINDOW]
+                 (\TTYBACKGROUND))
+
+     (* ;; "Get here if we close connection.")

+
+           [SELECTQ (fetch
 (CHAT.STATE RUNNING?) of
 STATE)
+               (CLOSE (CHAT.CLOSE
 WINDOW))
+               (ABORT (CHAT.CLOSE
 WINDOW T))
+               (NIL                                          (* ; "Already dead.")
)
+               (SHOULDNT (CONCAT "Unknown state in CHAT: " (fetch
 (CHAT.STATE RUNNING?) of
 STATE]
+           (BLOCK])
 
 (CHAT.BIN

 (LAMBDA (OUTSTREAM STATE) (* rda%: "20-Aug-84 23:09") (until (\SYSBUFP) bind (FIRSTTIME _ T) do (COND (FIRSTTIME (FORCEOUTPUT OUTSTREAM) (SETQ FIRSTTIME NIL))) (\TTYBACKGROUND)) (\GETKEY))
@@ -308,11 +396,10 @@ Host: " NIL "Enter name of host to chat to, or <cr> to abort" NIL NIL (QUOTE TTY
 (DEFGLOBALVAR CHAT.HOSTINFO
 NIL
    "A-list of (host . proplist) for Chat.  Only recognized prop for now is :KEYACTIONS.")
 
-(DEFGLOBALVAR CHAT.OSTYPES
 '([UNIX :KEYACTIONS ((BS (127 127]
-                                                             (* ; 
-
                                              "make the BS key send DEL when talking to UNIX hosts")

-                                 )
-                               "A-list of (host . proplist).  Only recognized prop is :KEYACTIONS.")
+(DEFGLOBALVAR CHAT.OSTYPES
 '([UNIX :KEYACTIONS ((BS (127 127](* ; 
+
                                                "make the BS key send DEL when talking to UNIX hosts")

+                             )
+                           "A-list of (host . proplist).  Only recognized prop is :KEYACTIONS.")
 
 (DEFGLOBALVAR CHAT.PROTOCOL.ABBREVS
 NIL
    "A-list of (abbrev . protocol) for use in the host/x syntax.")
@@ -321,7 +408,7 @@ Host: " NIL "Enter name of host to chat to, or <cr> to abort" NIL NIL (QUOTE TTY
    "List of hosts to Chat to (clear CHAT.HOSTMENU if you change this).")
 
 (CL:DEFVAR CHAT.DISPLAYTYPES
 '((NIL 10 DM2500))
-                                 "List of triples (host code driver) telling the preferred driver (a symbol) for host.  Code is numeric value for use with PupChat.  Host = NIL gives default preference."
+                             "List of triples (host code driver) telling the preferred driver (a symbol) for host.  Code is numeric value for use with PupChat.  Host = NIL gives default preference."
 )
 
 (DEFGLOBALVAR CHAT.FONT
 NIL
@@ -381,15 +468,15 @@ Host: " NIL "Enter name of host to chat to, or <cr> to abort" NIL NIL (QUOTE TTY
    "A-list of (ostype . loginfo), where loginfo is a plist specifying what to send for different logging commands: LOGIN, ATTACH, or WHERE.  Each property value is a list of strings mixed with the symbols USERNAME, PASSWORD, WAIT, CR, LF."
 )
 
-(PUTPROPS CHAT.OSTYPES VARTYPE
 ALIST)
+(PUTPROPS CHAT.OSTYPES
 VARTYPE
 ALIST)
 
-(PUTPROPS CHAT.HOSTINFO VARTYPE
 ALIST)
+(PUTPROPS CHAT.HOSTINFO
 VARTYPE
 ALIST)
 
-(PUTPROPS NETWORKLOGINFO VARTYPE
 ALIST)
+(PUTPROPS NETWORKLOGINFO
 VARTYPE
 ALIST)
 
-(PUTPROPS CHAT.PROTOCOL.ABBREVS VARTYPE
 ALIST)
+(PUTPROPS CHAT.PROTOCOL.ABBREVS
 VARTYPE
 ALIST)
 
-(PUTPROPS CHAT.PROTOCOLTYPES VARTYPE
 ALIST)
+(PUTPROPS CHAT.PROTOCOLTYPES
 VARTYPE
 ALIST)
 
 
 
@@ -438,8 +525,77 @@ Host: " NIL "Enter name of host to chat to, or <cr> to abort" NIL NIL (QUOTE TTY
 (DEFINEQ
 
 (CHAT.TYPEOUT

-(LAMBDA (WINDOW DPYNAME CHAT.STATE) (* ; "Edited 12-Aug-88 10:35 by drc:") (bind (CNT _ 1) (HANDLECHARFN _ (CADR (FASSOC DPYNAME CHAT.DRIVERTYPES))) (INSTREAM _ (fetch (CHAT.STATE INSTREAM) of CHAT.STATE)) (TERM.STATE _ (FETCH (CHAT.STATE TERM.STATE) of CHAT.STATE)) (TYPEIN.PROCESS _ (WINDOWPROP WINDOW (QUOTE PROCESS))) (OUTSTREAM _ (COND ((EQ DPYNAME (QUOTE TEDIT)) (WINDOWPROP WINDOW (QUOTE TEXTSTREAM))) (T (WINDOWPROP WINDOW (QUOTE DSP))))) TYPESCRIPTSTREAM CRPENDING MSG CH first (IF (NOT TERM.STATE) THEN (* ; "First time, ask terminal to get itself set up") (replace (CHAT.STATE TERM.STATE) of CHAT.STATE with (SETQ TERM.STATE (CL:FUNCALL (CADDR (FASSOC DPYNAME CHAT.DRIVERTYPES)) CHAT.STATE)))) (* ; "TERM.HOME CHAT.STATE") while (IGEQ (SETQ CH (BIN INSTREAM)) 0) do (while (fetch (CHAT.STATE HELD) of CHAT.STATE) do (BLOCK)) (\CHECKCARET OUTSTREAM) (COND ((SETQ MSG (GETSTREAMPROP INSTREAM (QUOTE MESSAGE))) (PRIN1 MSG OUTSTREAM) (PUTSTREAMPROP INSTREAM (QUOTE MESSAGE) NIL))) (* ; "Print any protocol related msgs that might have come along while we where asleep") (SPREADAPPLY* HANDLECHARFN (SETQ CH (LOGAND CH (MASK.1'S 0 7))) CHAT.STATE TERM.STATE) (COND ((SETQ TYPESCRIPTSTREAM (fetch (CHAT.STATE TYPESCRIPTSTREAM) of CHAT.STATE)) (COND ((SELCHARQ CH (CR (PROG1 CRPENDING (SETQ CRPENDING T))) (LF (COND (CRPENDING (\OUTCHAR TYPESCRIPTSTREAM (CHARCODE EOL)) (* ; "Have the typescript turn crlf into whatever it likes for eol") (SETQ CRPENDING NIL)) (T T))) (PROGN (COND (CRPENDING (\BOUT TYPESCRIPTSTREAM (CHARCODE CR)) (SETQ CRPENDING NIL))) T)) (\BOUT TYPESCRIPTSTREAM CH))))) (COND (CHATDEBUGFLG (COND ((OR (EQ CHATDEBUGFLG T) (IGREATERP (add CNT 1) CHATDEBUGFLG)) (BLOCK) (SETQ CNT 1))))) (COND ((AND (TTY.PROCESSP TYPEIN.PROCESS) (OR \LONGSYSBUF (NEQ 0 (fetch (RING READ) of \SYSBUFFER)))) (* ;; "block if there's any type ahead to make sure we see keyboard input in case the output stream never blocks.") (BLOCK))) finally (SELECTQ CH (-1 (CHAT.TYPEOUT.CLOSE WINDOW OUTSTREAM CHAT.STATE (QUOTE CLOSE) "closed")) (-2 (CHAT.TYPEOUT.CLOSE WINDOW OUTSTREAM CHAT.STATE (QUOTE ABORT) "aborted")) (CHAT.TYPEOUT.CLOSE WINDOW OUTSTREAM CHAT.STATE (QUOTE CLOSE) "closed somehow")) (COND ((NOT (OPENWP WINDOW)) (DEL.PROCESS (WINDOWPROP WINDOW (QUOTE PROCESS)))))))
-)
+  [LAMBDA (WINDOW DPYNAME CHAT.STATE)
                        (* ; "Edited 10-Oct-2025 22:38 by rmk")


+                                                             (* ; "Edited 12-Aug-88 10:35 by drc:")

+    (bind
 (CNT _ 1)
+          (HANDLECHARFN _ (CADR (FASSOC DPYNAME CHAT.DRIVERTYPES)))
+          (INSTREAM _ (fetch
 (CHAT.STATE INSTREAM) of
 CHAT.STATE))
+          (TERM.STATE _ (FETCH
 (CHAT.STATE TERM.STATE) of
 CHAT.STATE))
+          (TYPEIN.PROCESS _ (WINDOWPROP WINDOW 'PROCESS))
+          [OUTSTREAM _ (COND
+                          ((EQ DPYNAME 'TEDIT)
+                           (WINDOWPROP WINDOW 'TEXTSTREAM))
+                          (T (WINDOWPROP WINDOW 'DSP]
+          TYPESCRIPTSTREAM CRPENDING MSG CH
+       first
 [IF
 (NOT TERM.STATE)
+                 THEN
                                        (* ; 
+
                                                      "First time, ask terminal to get itself set up")

+                      (replace
 (CHAT.STATE TERM.STATE) of
 CHAT.STATE
+                         with
 (SETQ TERM.STATE (CL:FUNCALL (CADDR (FASSOC DPYNAME CHAT.DRIVERTYPES))
+                                                      CHAT.STATE] 
+                                                             (* ; "TERM.HOME CHAT.STATE")

+       while
 (IGEQ (SETQ CH (BIN INSTREAM))
+                   0) do
 (while
 (fetch
 (CHAT.STATE HELD) of
 CHAT.STATE) do
 (BLOCK))
+                         (\CHECKCARET OUTSTREAM)
+                         (COND
+                            ((SETQ MSG (GETSTREAMPROP INSTREAM 'MESSAGE))
+                             (PRIN1 MSG OUTSTREAM)
+                             (PUTSTREAMPROP INSTREAM 'MESSAGE NIL))) 
+                                                             (* ; 
+
                   "Print any protocol related msgs that might have come along while we where asleep")

+                         (SPREADAPPLY* HANDLECHARFN (SETQ CH (LOGAND CH (MASK.1'S 0 7)))
+                                CHAT.STATE TERM.STATE)
+                         [COND
+                            ((SETQ TYPESCRIPTSTREAM (fetch
 (CHAT.STATE TYPESCRIPTSTREAM) of
 
+                                                                                           CHAT.STATE
+                                                           ))
+                             (COND
+                                ((SELCHARQ CH
+                                      (CR (PROG1 CRPENDING (SETQ CRPENDING T)))
+                                      (LF (COND
+                                             (CRPENDING (\OUTCHAR TYPESCRIPTSTREAM (CHARCODE EOL))
+                                                             (* ; 
+
                                       "Have the typescript turn crlf into whatever it likes for eol")

+                                                    (SETQ CRPENDING NIL))
+                                             (T T)))
+                                      (PROGN (COND
+                                                (CRPENDING (\BOUT TYPESCRIPTSTREAM (CHARCODE CR))
+                                                       (SETQ CRPENDING NIL)))
+                                             T))
+                                 (\BOUT TYPESCRIPTSTREAM (UTOMCODE CH]
+                         [COND
+                            (CHATDEBUGFLG (COND
+                                             ((OR (EQ CHATDEBUGFLG T)
+                                                  (IGREATERP (add
 CNT 1)
+                                                         CHATDEBUGFLG))
+                                              (BLOCK)
+                                              (SETQ CNT 1]
+                         (COND
+                            ([AND (TTY.PROCESSP TYPEIN.PROCESS)
+                                  (OR \LONGSYSBUF (NEQ 0 (fetch
 (RING READ) of
 \SYSBUFFER]
+
+                             (* ;; "block if there's any type ahead to make sure we see keyboard input in case the output stream never blocks.")

+
+                             (BLOCK))) finally
 (SELECTQ CH
+                                                   (-1 (CHAT.TYPEOUT.CLOSE
 WINDOW OUTSTREAM 
+                                                              CHAT.STATE 'CLOSE "closed"))
+                                                   (-2 (CHAT.TYPEOUT.CLOSE
 WINDOW OUTSTREAM 
+                                                              CHAT.STATE 'ABORT "aborted"))
+                                                   (CHAT.TYPEOUT.CLOSE
 WINDOW OUTSTREAM CHAT.STATE
+                                                          'CLOSE "closed somehow"))
+                                             (COND
+                                                ((NOT (OPENWP WINDOW))
+                                                 (DEL.PROCESS (WINDOWPROP WINDOW 'PROCESS])
 
 (CHAT.TYPEOUT.CLOSE

 (LAMBDA (WINDOW OUTSTREAM CHAT.STATE NEWSTATE MSG) (* ; "Edited  9-Nov-89 14:55 by bvm") (COND ((OPENWP WINDOW) (printout OUTSTREAM T "[Connection " MSG " by remote host]" T))) (replace (CHAT.STATE RUNNING?) of CHAT.STATE with NEWSTATE) (LET ((CHATPROC (WINDOWPROP WINDOW (QUOTE PROCESS)))) (if (AND CHATPROC (NOT (TTY.PROCESSP CHATPROC))) then (* ;; "Ordinarily, typein process notices that we've closed and will gracefully clean up, but currently it's hung waiting for tty.  I could give it the tty explicitly, but that might disrupt the user's typing to some other process right now, especially if (tty.process t) chooses not to give it back to the same place.  So we'll just explicitly kill it (it does have a cleanup form to handle closing the window, etc).") (DEL.PROCESS CHATPROC))))
@@ -551,7 +707,7 @@ Host: " NIL "Enter name of host to chat to, or <cr> to abort" NIL NIL (QUOTE TTY
 )
 
 (DEFGLOBALVAR CHAT.EMACSCOMMANDS
 '(21 16 14 6 1)
-                                     "List of 5 character codes that perform Emacs functions Arg, Up 1 Line, Down 1 Line, Forward Character, Beginning of Line"
+                                 "List of 5 character codes that perform Emacs functions Arg, Up 1 Line, Down 1 Line, Forward Character, Beginning of Line"
 )
 (DEFINEQ
 
@@ -614,11 +770,9 @@ Host: " NIL "Enter name of host to chat to, or <cr> to abort" NIL NIL (QUOTE TTY
 (DECLARE%: DONTEVAL@LOAD DOCOPY 
 
 (ADDTOVAR BackgroundMenuCommands
 ("Chat" '(\SPAWN.CHAT)
-                                            "Runs a new CHAT process; prompts for host"
-                                            (SUBITEMS ("No Login" '(\SPAWN.CHAT 'NONE)
-                                                             
-                                                            "Runs CHAT without doing automatic login"
-                                                             ))))
+                                        "Runs a new CHAT process; prompts for host"
+                                        (SUBITEMS ("No Login" '(\SPAWN.CHAT 'NONE)
+                                                         "Runs CHAT without doing automatic login"))))
 
 
 (SETQ BackgroundMenu)
@@ -668,24 +822,22 @@ Host: " NIL "Enter name of host to chat to, or <cr> to abort" NIL NIL (QUOTE TTY
          (CHAT.STATE 44 POINTER))
        '46)
 )
-(PUTPROPS CHAT COPYRIGHT ("Venue & Xerox Corporation" 1982 1983 1984 1985 1986 1987 1988 1989 1990 
-1992 1993))
 (DECLARE%: DONTCOPY
-  (FILEMAP (NIL (4424 27453 (CHAT 4434 . 6212) (CHAT.STARTUP 6214 . 14801) (CHAT.PROMPT.FOR.INPUT 14803
- . 15726) (CHAT.CHOOSE.EMULATOR 15728 . 16259) (CHAT.SET.EMULATOR 16261 . 17240) (CHAT.INIT 17242 . 
-19217) (FIND.CHAT.PROTOCOL 19219 . 19577) (CHAT.TYPEIN 19579 . 22480) (CHAT.BIN 22482 . 22686) (
-CHAT.CLOSE 22688 . 24999) (CHAT.DEACTIVATE.WINDOW 25001 . 25353) (CHAT.CLOSEFN 25355 . 25558) (
-CHAT.CLOSE.CONNECTION 25560 . 25799) (CHAT.LOGIN 25801 . 27451)) (31396 33372 (ADD.CHAT.MESSAGE 31406
- . 31572) (CHAT.LOGINFO 31574 . 31808) (CHAT.SENDSCREENPARAMS 31810 . 32083) (CHAT.SETDISPLAYTYPE 
-32085 . 32410) (CHAT.FLUSH&WAIT 32412 . 32632) (CHAT.ENDOFSTREAMOP 32634 . 33074) (CHAT.OPTIONMENU 
-33076 . 33370)) (33402 37669 (CHAT.TYPEOUT 33412 . 35706) (CHAT.TYPEOUT.CLOSE 35708 . 36524) (
-CHAT.DID.RESHAPE 36526 . 36809) (CHAT.SCREENPARAMS 36811 . 37667)) (37699 45838 (GETCHATWINDOW 37709
- . 38663) (CHAT.BUTTONFN 38665 . 39113) (CHAT.HOLD 39115 . 39490) (CHAT.MENU 39492 . 41589) (
-CHAT.CLEAR.FROM.MENU 41591 . 41747) (CHAT.TAKE.INPUT 41749 . 41917) (CHAT.TAKE.INPUT1 41919 . 42548) (
-DO.CHAT.OPTION 42550 . 42846) (CHAT.RECONNECT 42848 . 43524) (CHAT.RECONNECT.OFF 43526 . 43815) (
-CHAT.RESHAPEWINDOW 43817 . 44594) (CHAT.TTYENTRYFN 44596 . 44843) (CHAT.TTYEXITFN 44845 . 44925) (
-CHAT.TYPESCRIPT 44927 . 45128) (CHAT.TYPESCRIPT1 45130 . 45836)) (45868 46637 (
-CHAT.CHOOSE.PHONE.NUMBER 45878 . 46635)) (46742 48495 (CHAT.EMACS.MOVE 46752 . 48174) (
-CHAT.SWITCH.EMACS 48176 . 48493)) (48712 49215 (CHAT.ICONFN 48722 . 49213)) (51928 52142 (\SPAWN.CHAT 
-51938 . 52140)))))
+  (FILEMAP (NIL (4288 30348 (CHAT 4298 . 6076) (CHAT.STARTUP 6078 . 14665) (CHAT.PROMPT.FOR.INPUT 14667
+ . 15590) (CHAT.CHOOSE.EMULATOR 15592 . 16123) (CHAT.SET.EMULATOR 16125 . 17104) (CHAT.INIT 17106 . 
+19106) (FIND.CHAT.PROTOCOL 19108 . 19466) (CHAT.TYPEIN 19468 . 25375) (CHAT.BIN 25377 . 25581) (
+CHAT.CLOSE 25583 . 27894) (CHAT.DEACTIVATE.WINDOW 27896 . 28248) (CHAT.CLOSEFN 28250 . 28453) (
+CHAT.CLOSE.CONNECTION 28455 . 28694) (CHAT.LOGIN 28696 . 30346)) (34239 36215 (ADD.CHAT.MESSAGE 34249
+ . 34415) (CHAT.LOGINFO 34417 . 34651) (CHAT.SENDSCREENPARAMS 34653 . 34926) (CHAT.SETDISPLAYTYPE 
+34928 . 35253) (CHAT.FLUSH&WAIT 35255 . 35475) (CHAT.ENDOFSTREAMOP 35477 . 35917) (CHAT.OPTIONMENU 
+35919 . 36213)) (36245 43159 (CHAT.TYPEOUT 36255 . 41196) (CHAT.TYPEOUT.CLOSE 41198 . 42014) (
+CHAT.DID.RESHAPE 42016 . 42299) (CHAT.SCREENPARAMS 42301 . 43157)) (43189 51328 (GETCHATWINDOW 43199
+ . 44153) (CHAT.BUTTONFN 44155 . 44603) (CHAT.HOLD 44605 . 44980) (CHAT.MENU 44982 . 47079) (
+CHAT.CLEAR.FROM.MENU 47081 . 47237) (CHAT.TAKE.INPUT 47239 . 47407) (CHAT.TAKE.INPUT1 47409 . 48038) (
+DO.CHAT.OPTION 48040 . 48336) (CHAT.RECONNECT 48338 . 49014) (CHAT.RECONNECT.OFF 49016 . 49305) (
+CHAT.RESHAPEWINDOW 49307 . 50084) (CHAT.TTYENTRYFN 50086 . 50333) (CHAT.TTYEXITFN 50335 . 50415) (
+CHAT.TYPESCRIPT 50417 . 50618) (CHAT.TYPESCRIPT1 50620 . 51326)) (51358 52127 (
+CHAT.CHOOSE.PHONE.NUMBER 51368 . 52125)) (52232 53985 (CHAT.EMACS.MOVE 52242 . 53664) (
+CHAT.SWITCH.EMACS 53666 . 53983)) (54198 54701 (CHAT.ICONFN 54208 . 54699)) (57414 57628 (\SPAWN.CHAT 
+57424 . 57626)))))
 STOP
diff --git a/library/CHAT.LCOM b/library/CHAT.LCOM
index 3c443781b..86c25c430 100644
Binary files a/library/CHAT.LCOM and b/library/CHAT.LCOM differ
diff --git a/library/CHATTERMINAL b/library/CHATTERMINAL
index 011512ecd..a08f6bd4d 100644
--- a/library/CHATTERMINAL
+++ b/library/CHATTERMINAL
@@ -1,14 +1,13 @@
 (DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
-
(FILECREATED " 4-Jul-90 02:21:01" |{PELE:MV:ENVOS}<LISPCORE>LIBRARY>CHATTERMINAL.;3|
 20832  
 
-      changes to%:  (VARS CHATTERMINALCOMS)
+
(FILECREATED "11-Oct-2025 10:28:04" {WMEDLEY}<library>CHATTERMINAL.;2
 22325  
 
-      previous date%: "14-Jun-90 15:57:05" {DSK}<users>sybalsky>bane>chatterminal.;1)
+      :EDIT-BY rmk
 
+      :CHANGES-TO (FNS TERM.PRINTCHAR)
+
+      :PREVIOUS-DATE " 4-Jul-90 02:21:01" {WMEDLEY}<library>CHATTERMINAL.;1)
 
-(* ; "
-Copyright (c) 1984, 1985, 1986, 1987, 1988, 1990 by VENUE & Xerox Corporation.  All rights reserved.
-")
 
 (PRETTYCOMPRINT CHATTERMINALCOMS)
 
@@ -93,8 +92,63 @@ Copyright (c) 1984, 1985, 1986, 1987, 1988, 1990 by VENUE & Xerox Corporation.
 )
 
 (TERM.PRINTCHAR

-(LAMBDA (CHAT.STATE CHAR WRAPFN) (* ; "Edited  2-Sep-88 10:35 by jds") (* ;;; "Print a character.  If this char fills the last position on the line, then the next action is determined by WRAPFN: if it is given, we call it with CHAT.STATE as arg.  Otherwise, if WRAPMODE is on in the state, we perform an explict newline, else we peg at the right margin.") (LET* ((DSP (ffetch (CHAT.STATE DSP) of (\DTEST CHAT.STATE (QUOTE CHAT.STATE)))) (DISPLAYDATA (fetch (STREAM IMAGEDATA) of DSP)) (XPOS (ffetch (CHAT.STATE XPOS) of CHAT.STATE)) IMAGEWIDTH CHARWIDTH) (if (NEQ (ffetch (\DISPLAYDATA DDCHARSET) of DISPLAYDATA) (\CHARSET CHAR)) then (* ;; "The display stream's caches are invalid.  Fix them up for the new character set (this also cleans up after font changes, etc, and at initial window opening)") (\CHANGECHARSET.DISPLAY DISPLAYDATA (\CHARSET CHAR))) (* ;; "These two SETQs can't be in the LET* because the charset change may need to happen first:") (SETQ IMAGEWIDTH (\DSPGETCHARIMAGEWIDTH CHAR DISPLAYDATA)) (SETQ CHARWIDTH (\DSPGETCHARWIDTH CHAR DISPLAYDATA)) (if (NEQ IMAGEWIDTH CHARWIDTH) then (* ;; "Take care of the case where the character's image isn't the same as its escapement, by filling in the background properly for the intervening space.  We wouldn't have to worry about this nonsense if ns fonts did their character bitmaps properly.") (\BLTSHADE.DISPLAY (CASE (fetch DDSOURCETYPE of DISPLAYDATA) (INVERT BLACKSHADE) (T WHITESHADE)) DSP (+ XPOS IMAGEWIDTH) (- (ffetch (CHAT.STATE YPOS) of CHAT.STATE) (ffetch (CHAT.STATE FONTDESCENT) of CHAT.STATE)) (- CHARWIDTH IMAGEWIDTH) (ffetch (CHAT.STATE FONTHEIGHT) of CHAT.STATE))) (\BLTCHAR CHAR DSP DISPLAYDATA) (if (ffetch (CHAT.STATE UNDERLINEMODE) of CHAT.STATE) then (* ; "Underline what we just drew") (\BLTSHADE.DISPLAY BLACKSHADE DSP XPOS (- (ffetch (CHAT.STATE YPOS) of CHAT.STATE) CHAT.UNDERLINE.DESCENT) CHARWIDTH 1 (QUOTE INVERT))) (if (>= (freplace (CHAT.STATE XPOS) of CHAT.STATE with (+ XPOS (ffetch (CHAT.STATE FONTWIDTH) of CHAT.STATE))) (ffetch (CHAT.STATE TTYWIDTH) of CHAT.STATE)) then (* ; "Have reached right margin, so wrap around") (if WRAPFN then (* ; "Terminal-specific wrap handler") (CL:FUNCALL WRAPFN CHAT.STATE) elseif (ffetch (CHAT.STATE WRAPMODE) of CHAT.STATE) then (TERM.NEWLINE CHAT.STATE) else (* ; "No, don't wrap--stay on the last character") (MOVETO (freplace (CHAT.STATE XPOS) of CHAT.STATE with XPOS) (ffetch (CHAT.STATE YPOS) of CHAT.STATE) DSP)))))
-)
+  [LAMBDA (CHAT.STATE CHAR WRAPFN)
                           (* ; "Edited 10-Oct-2025 22:37 by rmk")


+                                                             (* ; "Edited  2-Sep-88 10:35 by jds")

+
+(* ;;; "Print a character.  If this char fills the last position on the line, then the next action is determined by WRAPFN: if it is given, we call it with CHAT.STATE as arg.  Otherwise, if WRAPMODE is on in the state, we perform an explict newline, else we peg at the right margin.")

+
+    (SETQ CHAR (UTOMCODE CHAR))
+    (LET* ([DSP (ffetch
 (CHAT.STATE DSP) of
 (\DTEST CHAT.STATE 'CHAT.STATE]
+           (DISPLAYDATA (fetch
 (STREAM IMAGEDATA) of
 DSP))
+           (XPOS (ffetch
 (CHAT.STATE XPOS) of
 CHAT.STATE))
+           IMAGEWIDTH CHARWIDTH)
+          (if
 (NEQ (ffetch
 (\DISPLAYDATA DDCHARSET) of
 DISPLAYDATA)
+                   (\CHARSET CHAR))
+              then
 
+                   (* ;; "The display stream's caches are invalid.  Fix them up for the new character set (this also cleans up after font changes, etc, and at initial window opening)")

+
+                   (\CHANGECHARSET.DISPLAY DISPLAYDATA (\CHARSET CHAR)))
+
+          (* ;; 
+
          "These two SETQs can't be in the LET* because the charset change may need to happen first:")

+
+          (SETQ IMAGEWIDTH (\DSPGETCHARIMAGEWIDTH CHAR DISPLAYDATA))
+          (SETQ CHARWIDTH (\DSPGETCHARWIDTH CHAR DISPLAYDATA))
+          (if
 (NEQ IMAGEWIDTH CHARWIDTH)
+              then
 
+                   (* ;; "Take care of the case where the character's image isn't the same as its escapement, by filling in the background properly for the intervening space.  We wouldn't have to worry about this nonsense if ns fonts did their character bitmaps properly.")

+
+                   (\BLTSHADE.DISPLAY (CASE (fetch
 DDSOURCETYPE of
 DISPLAYDATA)
+                                          (INVERT BLACKSHADE)
+                                          (T WHITESHADE))
+                          DSP
+                          (+ XPOS IMAGEWIDTH)
+                          (- (ffetch
 (CHAT.STATE YPOS) of
 CHAT.STATE)
+                             (ffetch
 (CHAT.STATE FONTDESCENT) of
 CHAT.STATE))
+                          (- CHARWIDTH IMAGEWIDTH)
+                          (ffetch
 (CHAT.STATE FONTHEIGHT) of
 CHAT.STATE)))
+          (\BLTCHAR CHAR DSP DISPLAYDATA)
+          (if
 (ffetch
 (CHAT.STATE UNDERLINEMODE) of
 CHAT.STATE)
+              then
                                           (* ; "Underline what we just drew")

+                   (\BLTSHADE.DISPLAY BLACKSHADE DSP XPOS (- (ffetch
 (CHAT.STATE YPOS) of
 CHAT.STATE)
+                                                             CHAT.UNDERLINE.DESCENT)
+                          CHARWIDTH 1 'INVERT))
+          (if
 (>= (freplace
 (CHAT.STATE XPOS) of
 CHAT.STATE with
 (+ XPOS (ffetch
 (CHAT.STATE 
+                                                                                        FONTWIDTH)
+                                                                            of
 CHAT.STATE)))
+                  (ffetch
 (CHAT.STATE TTYWIDTH) of
 CHAT.STATE))
+              then
                                           (* ; 
+
                                                          "Have reached right margin, so wrap around")

+                   (if
 WRAPFN
+                       then
                                  (* ; "Terminal-specific wrap handler")

+                            (CL:FUNCALL WRAPFN CHAT.STATE)
+                     elseif
 (ffetch
 (CHAT.STATE WRAPMODE) of
 CHAT.STATE)
+                       then
 (TERM.NEWLINE
 CHAT.STATE)
+                     else
                                    (* ; 
+
                                                         "No, don't wrap--stay on the last character")

+                          (MOVETO (freplace
 (CHAT.STATE XPOS) of
 CHAT.STATE with
 XPOS)
+                                 (ffetch
 (CHAT.STATE YPOS) of
 CHAT.STATE)
+                                 DSP])
 
 (TERM.RESET.DISPLAY.PARMS

 (LAMBDA (CHAT.STATE) (* ; "Edited 21-May-90 00:00 by jrb:") (* ;; "Reset state, assuming window coords are as if CLEARW was just called.") (LET* ((WINDOW (ffetch (CHAT.STATE WINDOW) of (\DTEST CHAT.STATE (QUOTE CHAT.STATE)))) (DSP (ffetch (CHAT.STATE DSP) of CHAT.STATE)) (FONT (PROGN (DSPFONT (OR CHAT.FONT (DEFAULTFONT (QUOTE DISPLAY))) DSP) (* ; "Reset default font, and read it back after display has coerced it as necessary") (DSPFONT NIL DSP))) (FONTDESCENT (FONTPROP FONT (QUOTE DESCENT))) (FONTWIDTH (CHARWIDTH (CHARCODE A) FONT)) (FONTHEIGHT (FONTPROP FONT (QUOTE HEIGHT))) (CLEARMODEFN (ffetch (CHAT.STATE CLEARMODEFN) of CHAT.STATE)) TERM.STATE) (freplace (CHAT.STATE PLAINFONT) of CHAT.STATE with (freplace (CHAT.STATE FONT) of CHAT.STATE with FONT)) (freplace (CHAT.STATE CHATBOLDFONT) of CHAT.STATE with (freplace (CHAT.STATE ITALICFONT) of CHAT.STATE with NIL)) (freplace (CHAT.STATE FONTHEIGHT) of CHAT.STATE with FONTHEIGHT) (freplace (CHAT.STATE FONTWIDTH) of CHAT.STATE with FONTWIDTH) (freplace (CHAT.STATE FONTDESCENT) of CHAT.STATE with FONTDESCENT) (* ;; "We use just the part of window that is even multiple of the font width and height") (LET ((TTYHEIGHT (+ (ITIMES (IQUOTIENT (WINDOWPROP WINDOW (QUOTE HEIGHT)) FONTHEIGHT) FONTHEIGHT) FONTDESCENT))) (freplace (CHAT.STATE TTYHEIGHT) of CHAT.STATE with (freplace (CHAT.STATE TOPMARGIN) of CHAT.STATE with TTYHEIGHT)) (* ;; "JRB Just guessing that nobody sets BOTTOMMARGIN, or that somebody is clobbering it...") (freplace (CHAT.STATE BOTTOMMARGIN) of CHAT.STATE with 0) (freplace (CHAT.STATE HOMEPOS) of CHAT.STATE with (- TTYHEIGHT FONTHEIGHT)) (freplace (CHAT.STATE TTYWIDTH) of CHAT.STATE with (ITIMES (IQUOTIENT (WINDOWPROP WINDOW (QUOTE WIDTH)) FONTWIDTH) FONTWIDTH))) (if (AND CLEARMODEFN (SETQ TERM.STATE (ffetch (CHAT.STATE TERM.STATE) of CHAT.STATE))) then (* ;; "Clear any funny mode the terminal might have gotten into.  Test for TERM.STATE is because when we are called at startup, TERM.STATE might not be filled in yet (what a crock).") (CL:FUNCALL CLEARMODEFN CHAT.STATE TERM.STATE))))
@@ -144,15 +198,14 @@ Copyright (c) 1984, 1985, 1986, 1987, 1988, 1990 by VENUE & Xerox Corporation.
 (LOCALVARS . T)
 )
 )
-(PUTPROPS CHATTERMINAL COPYRIGHT ("VENUE & Xerox Corporation" 1984 1985 1986 1987 1988 1990))
 (DECLARE%: DONTCOPY
-  (FILEMAP (NIL (1149 20319 (TERM.ADDCHAR 1159 . 1955) (TERM.ADDLINE 1957 . 2559) (TERM.CLEAR.TAB 2561
- . 2817) (TERM.DELCHAR 2819 . 3649) (TERM.DELETELINE 3651 . 4370) (TERM.DOWN 4372 . 5400) (
-TERM.ERASE.IN.DISPLAY 5402 . 6364) (TERM.ERASE.IN.LINE 6366 . 6945) (TERM.ERASE.TO.EOL 6947 . 7332) (
-TERM.ERASEBITS 7334 . 7597) (TERM.GODOWN 7599 . 8188) (TERM.HOME 8190 . 8486) (TERM.IDENTIFY.SELF 8488
- . 8708) (TERM.LEFT 8710 . 9187) (TERM.MODIFY.ATTRIBUTES 9189 . 10814) (TERM.MOVETO 10816 . 11413) (
-TERM.NEWLINE 11415 . 11694) (TERM.PRINTCHAR 11696 . 14173) (TERM.RESET.DISPLAY.PARMS 14175 . 16281) (
-TERM.RIGHT 16283 . 16867) (TERM.SCROLLDOWN 16869 . 17588) (TERM.SET.TAB 17590 . 17971) (
-TERM.SETMARGINS 17973 . 18562) (TERM.SMOOTHSCROLL 18564 . 19180) (TERM.TAB 19182 . 19795) (TERM.UP 
-19797 . 20317)))))
+  (FILEMAP (NIL (1029 21906 (TERM.ADDCHAR 1039 . 1835) (TERM.ADDLINE 1837 . 2439) (TERM.CLEAR.TAB 2441
+ . 2697) (TERM.DELCHAR 2699 . 3529) (TERM.DELETELINE 3531 . 4250) (TERM.DOWN 4252 . 5280) (
+TERM.ERASE.IN.DISPLAY 5282 . 6244) (TERM.ERASE.IN.LINE 6246 . 6825) (TERM.ERASE.TO.EOL 6827 . 7212) (
+TERM.ERASEBITS 7214 . 7477) (TERM.GODOWN 7479 . 8068) (TERM.HOME 8070 . 8366) (TERM.IDENTIFY.SELF 8368
+ . 8588) (TERM.LEFT 8590 . 9067) (TERM.MODIFY.ATTRIBUTES 9069 . 10694) (TERM.MOVETO 10696 . 11293) (
+TERM.NEWLINE 11295 . 11574) (TERM.PRINTCHAR 11576 . 15760) (TERM.RESET.DISPLAY.PARMS 15762 . 17868) (
+TERM.RIGHT 17870 . 18454) (TERM.SCROLLDOWN 18456 . 19175) (TERM.SET.TAB 19177 . 19558) (
+TERM.SETMARGINS 19560 . 20149) (TERM.SMOOTHSCROLL 20151 . 20767) (TERM.TAB 20769 . 21382) (TERM.UP 
+21384 . 21904)))))
 STOP
diff --git a/library/CHATTERMINAL.LCOM b/library/CHATTERMINAL.LCOM
index df13904ee..42c7fa768 100644
Binary files a/library/CHATTERMINAL.LCOM and b/library/CHATTERMINAL.LCOM differ
diff --git a/library/MULTI-ALIST b/library/MULTI-ALIST
index f8676caf5..64b650d72 100644
--- a/library/MULTI-ALIST
+++ b/library/MULTI-ALIST
@@ -1,39 +1,40 @@
 (DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
 
-
(FILECREATED "15-Aug-2025 23:02:22" {WMEDLEY}<library>MULTI-ALIST.;23
 15006  
+
(FILECREATED "25-Sep-2025 18:41:59" {WMEDLEY}<library>MULTI-ALIST.;30
 15648  
 
       :EDIT-BY rmk
 
-      :CHANGES-TO (VARS MULTI-ALISTCOMS)
+      :CHANGES-TO (FNS EXTENDMULTI-PAIR FETCHMULTI-PAIR)
                   (MACROS FETCHMULTI)
 
-      :PREVIOUS-DATE "15-Aug-2025 08:31:28" {WMEDLEY}<library>MULTI-ALIST.;22)
+      :PREVIOUS-DATE "25-Sep-2025 11:35:45" 
+{DSK}<Users>kaplan>Local>medley3.5>working-medley>library>MULTI-ALIST.;28)
 
 
 (PRETTYCOMPRINT MULTI-ALISTCOMS)
 
 (RPAQQ MULTI-ALISTCOMS

-       ((MACROS PUSHMULTI PUTMULTI PUSHMULTI-NEW FPUSHMULTI FPUTMULTI FPUSHMULTI-NEW STOREMULTI)
-        (MACROS GETMULTI GETMULTI-PAIR FGETMULTI FGETMULTI-PAIR FETCHMULTI)
+       ((MACROS PUTMULTI PUSHMULTI PUSHMULTI-NEW SPUTMULTI SPUSHMULTI SPUSHMULTI-NEW STOREMULTI)
+        (MACROS GETMULTI GETMULTI-PAIR SGETMULTI SGETMULTI-PAIR FETCHMULTI)
         (MACROS REMOVEMULTI REMOVEMULTI-ALL)
         (FNS MAPMULTI MAPMULTI1 COLLECTMULTI FETCHMULTI-PAIR EXTENDMULTI-PAIR)
         (FNS GETMULTI-PAIR.EXPAND PUTMULTI.EXPAND)
-        (PROP ARGNAMES PUSHMULTI PUTMULTI PUSHMULTI-NEW REMOVEMULTI FPUSHMULTI FPUTMULTI 
-              FPUSHMULTI-NEW STOREMULTI)
+        (PROP ARGNAMES PUTMULTI PUSHMULTI PUSHMULTI-NEW SPUTMULTI SPUSHMULTI SPUSHMULTI-NEW GETMULTI
+              GETMULTI-PAIR SGETMULTI SGETMULTI-PAIR STOREMULTI REMOVEMULTI)
         (LOCALVARS . T)))
 (DECLARE%: EVAL@COMPILE 
 
-(PUTPROPS PUSHMULTI
 MACRO
 (ARGS (PUTMULTI.EXPAND
 ARGS 'SASSOC 'PUSH)))
+(PUTPROPS PUTMULTI
 MACRO
 (ARGS (PUTMULTI.EXPAND
 ARGS 'ASSOC 'PUT)))
 
-(PUTPROPS PUTMULTI
 MACRO
 (ARGS (PUTMULTI.EXPAND
 ARGS 'SASSOC 'PUT)))
+(PUTPROPS PUSHMULTI
 MACRO
 (ARGS (PUTMULTI.EXPAND
 ARGS 'ASSOC 'PUSH)))
 
-(PUTPROPS PUSHMULTI-NEW
 MACRO
 (ARGS (PUTMULTI.EXPAND
 ARGS 'SASSOC 'PUSHNEW)))
+(PUTPROPS PUSHMULTI-NEW
 MACRO
 (ARGS (PUTMULTI.EXPAND
 ARGS 'ASSOC 'PUSHNEW)))
 
-(PUTPROPS FPUSHMULTI
 MACRO
 (ARGS (PUTMULTI.EXPAND
 ARGS 'ASSOC 'PUSH)))
+(PUTPROPS SPUTMULTI
 MACRO
 (ARGS (PUTMULTI.EXPAND
 ARGS 'SASSOC 'PUT)))
 
-(PUTPROPS FPUTMULTI
 MACRO
 (ARGS (PUTMULTI.EXPAND
 ARGS 'ASSOC 'PUT)))
+(PUTPROPS SPUSHMULTI
 MACRO
 (ARGS (PUTMULTI.EXPAND
 ARGS 'SASSOC 'PUSH)))
 
-(PUTPROPS FPUSHMULTI-NEW
 MACRO
 (ARGS (PUTMULTI.EXPAND
 ARGS 'ASSOC 'PUSHNEW)))
+(PUTPROPS SPUSHMULTI-NEW
 MACRO
 (ARGS (PUTMULTI.EXPAND
 ARGS 'SASSOC 'PUSHNEW)))
 
 (PUTPROPS STOREMULTI
 MACRO

           [ARGS (LET ((PLACE (CAR ARGS))
@@ -57,27 +58,27 @@
 (PUTPROPS GETMULTI
 MACRO
 ((MULTIALIST . KEYS)
                           (CDR (GETMULTI-PAIR MULTIALIST . KEYS))))
 
-(PUTPROPS GETMULTI-PAIR
 MACRO
 (ARGS (GETMULTI-PAIR.EXPAND
 'SASSOC (CAR ARGS)
+(PUTPROPS GETMULTI-PAIR
 MACRO
 (ARGS (GETMULTI-PAIR.EXPAND
 'ASSOC (CAR ARGS)
                                            (CDR ARGS))))
 
-(PUTPROPS FGETMULTI
 MACRO
 ((MULTIALIST . KEYS)
-                           (CDR (FGETMULTI-PAIR MULTIALIST . KEYS))))
+(PUTPROPS SGETMULTI
 MACRO
 ((MULTIALIST . KEYS)
+                           (CDR (GETMULTI-PAIR MULTIALIST . KEYS))))
 
-(PUTPROPS FGETMULTI-PAIR
 MACRO
 (ARGS (GETMULTI-PAIR.EXPAND
 'ASSOC (CAR ARGS)
+(PUTPROPS SGETMULTI-PAIR
 MACRO
 (ARGS (GETMULTI-PAIR.EXPAND
 'SASSOC (CAR ARGS)
                                             (CDR ARGS))))
 
-(PUTPROPS FETCHMULTI
 MACRO
 ((MULTIALIST KEYS FAST)
-                            (CDR (FETCHMULTI-PAIR
 MULTIALIST KEYS FAST))))
+(PUTPROPS FETCHMULTI
 MACRO
 ((MULTIALIST KEYS SASSOC)
+                            (CDR (FETCHMULTI-PAIR
 MULTIALIST KEYS SASSOC))))
 )
 (DECLARE%: EVAL@COMPILE 
 
-(PUTPROPS REMOVEMULTI
 MACRO
 [ARGS `(CHANGE
 [GETMULTI ,@(for
 ATAIL on
 ARGS while
 (CDR ATAIL)
-                                                          collect
 (CAR ATAIL]
+(PUTPROPS REMOVEMULTI
 MACRO
 [ARGS `(CHANGE
 [SGETMULTI ,@(for
 ATAIL on
 ARGS while
 (CDR ATAIL)
+                                                           collect
 (CAR ATAIL]
                                           (REMOVE ,(CAR (LAST ARGS))
                                                  DATUM])
 
 (PUTPROPS REMOVEMULTI-ALL
 MACRO
 ((MULTIALIST . KEYS)
-                                 (RPLACD (GETMULTI-PAIR MULTIALIST . KEYS)
+                                 (RPLACD (SGETMULTI-PAIR MULTIALIST . KEYS)
                                         NIL)))
 )
 (DEFINEQ
@@ -124,26 +125,28 @@
          $$COLLECT])
 
 (FETCHMULTI-PAIR

-  [LAMBDA (MULTIALIST KEYS FAST)
                             (* ; "Edited 15-Aug-2025 08:08 by rmk")


+  [LAMBDA (MULTIALIST KEYS SASSOC)
                           (* ; "Edited 25-Sep-2025 17:06 by rmk")


+                                                             (* ; "Edited 15-Aug-2025 08:08 by rmk")


                                                              (* ; "Edited 13-Aug-2025 13:30 by rmk")

 
     (* ;; "Parallel to GETMULTI-PAIR but with the keys in a computed list. ")

 
     (CL:UNLESS (LISTP KEYS)
         (ERROR (ERROR "FETCHMULTI-PAIR requires at least 1 key" KEYS)))
-    (for
 KTAIL (LASTPAIR _ (CL:IF FAST
-                               (ASSOC (CAR KEYS)
-                                      MULTIALIST)
+    (for
 KTAIL (LASTPAIR _ (CL:IF SASSOC
                                (SASSOC (CAR KEYS)
+                                      MULTIALIST)
+                               (ASSOC (CAR KEYS)
                                       MULTIALIST))) on
 (CDR KEYS)
-       do
 (SETQ LASTPAIR (CL:IF FAST
-                             (ASSOC (CAR KTAIL)
-                                    LASTPAIR)
+       do
 (SETQ LASTPAIR (CL:IF SASSOC
                              (SASSOC (CAR KTAIL)
+                                    LASTPAIR)
+                             (ASSOC (CAR KTAIL)
                                     LASTPAIR))) finally
 (RETURN LASTPAIR])
 
 (EXTENDMULTI-PAIR

-  [LAMBDA (MULTIALIST KEYS VAL OPTIONS)
                      (* ; "Edited 15-Aug-2025 08:08 by rmk")


+  [LAMBDA (MULTIALIST KEYS VAL OPTIONS)
                      (* ; "Edited 25-Sep-2025 18:37 by rmk")


+                                                             (* ; "Edited 15-Aug-2025 08:08 by rmk")


                                                              (* ; "Edited 13-Aug-2025 14:39 by rmk")


                                                              (* ; "Edited 22-Jan-2025 23:47 by rmk")


                                                             (* ; "Edited 17-Aug-2020 15:05 by rmk:")

@@ -156,19 +159,20 @@
            (ERROR MULTIALIST "is not a MULTI-ALIST"))
     (CL:UNLESS (LISTP KEYS)
            (ERROR "EXTENDMULTI-PAIR requires at least 1 key" KEYS))
-    (for
 K LASTPAIR (FAST _ (EQMEMB 'FAST OPTIONS)) in
 (CDR KEYS)
-       first
 [SETQ LASTPAIR (OR (CL:IF FAST
-                                    (ASSOC (CAR KEYS)
-                                           MULTIALIST)
+    (for
 K LASTPAIR (SASSOC _ (OR (EQ OPTIONS T)
+                                  (EQMEMB 'SASSOC OPTIONS))) in
 (CDR KEYS)
+       first
 [SETQ LASTPAIR (OR (CL:IF SASSOC
                                     (SASSOC (CAR KEYS)
+                                           MULTIALIST)
+                                    (ASSOC (CAR KEYS)
                                            MULTIALIST))
                                 (CAR (ATTACH (CONS (CAR KEYS))
                                             MULTIALIST] 
 
              (* ;; "We have insured a pair headed by (CAR KEYS) at the top level of MULTIALIST.")

- do
 [SETQ LASTPAIR (OR (CL:IF FAST
-                           (ASSOC K (CDR LASTPAIR))
-                           (SASSOC K (CDR LASTPAIR)))
+ do
 [SETQ LASTPAIR (OR (CL:IF SASSOC
+                           (SASSOC K (CDR LASTPAIR))
+                           (ASSOC K (CDR LASTPAIR)))
                        (CAR (PUSH
 (CDR LASTPAIR)
                                   (CONS K] finally
 (CL:UNLESS (LISTP LASTPAIR)
                                                        (ERROR "INVALID MULTI-ALIST" (LIST LASTPAIR 
@@ -185,7 +189,8 @@
 (DEFINEQ
 
 (GETMULTI-PAIR.EXPAND

-  [LAMBDA (ASSOCFN PLACE KEYS)
                               (* ; "Edited 11-Aug-2025 09:56 by rmk")


+  [LAMBDA (ASSOCFN PLACE KEYS)
                               (* ; "Edited 21-Sep-2025 10:31 by rmk")


+                                                             (* ; "Edited 11-Aug-2025 09:56 by rmk")


                                                              (* ; "Edited  8-Aug-2025 12:55 by rmk")


                                                              (* ; "Edited 14-Jun-2025 09:47 by rmk")


                                                              (* ; "Edited 16-Jan-2025 10:27 by rmk")


@@ -193,18 +198,14 @@
                                                             (* ; "Edited 22-Mar-2020 13:21 by rmk:")


                                                             (* ; "Edited 27-Feb-2020 13:44 by rmk:")

 
-    (* ;; 
-
    "This returns the last (key . rest) cell (like ASSOC), NIL if no keys and place is not a list")

-
-    (if
 KEYS
-        then
 `[LET (($$PAIR$$ ,PLACE))
-                   (DECLARE
 (LOCALVARS $$PAIR$$))
-                   ,@(for
 KTAIL on
 KEYS
-                        collect
 (if
 (CDR KTAIL)
-                                    then
 `(SETQ $$PAIR$$ (CDR (,ASSOCFN ,(CAR KTAIL)
-                                                                     $$PAIR$$)))
-                                  else
 `(,ASSOCFN ,(CAR KTAIL)
-                                               $$PAIR$$]
+    (* ;; "This returns the last (key . rest) cell (like ASSOC), error here if no keys, runtime error if place is not a list")

+
+    (if
 (LISTP KEYS)
+        then
 (for
 KTAIL (FORM _ PLACE) on
 KEYS do
 [SETQ FORM `(,ASSOCFN ,(CAR KTAIL)
+                                                                     ,FORM]
+                                                  (CL:WHEN (CDR KTAIL)
+                                                      [SETQ FORM `(CDR ,FORM])
+                finally
 (RETURN FORM))
       else
 (ERROR "GETMULTI requires at least 1 key" (CONS PLACE KEYS])
 
 (PUTMULTI.EXPAND

@@ -253,27 +254,35 @@
       else
 (ERROR "PUTMULTI requires at least 1 key" ARGS])
 )
 
-(PUTPROPS PUSHMULTI
 ARGNAMES
 (PLACE KEY1...KEYN VAL))
-
 (PUTPROPS PUTMULTI
 ARGNAMES
 (PLACE KEY1...KEYN VAL))
 
+(PUTPROPS PUSHMULTI
 ARGNAMES
 (PLACE KEY1...KEYN VAL))
+
 (PUTPROPS PUSHMULTI-NEW
 ARGNAMES
 (PLACE KEY1...KEYN VAL))
 
-(PUTPROPS REMOVEMULTI
 ARGNAMES
 (MULTIALIST KEY1...KEYN VAL))
+(PUTPROPS SPUTMULTI
 ARGNAMES
 (PLACE KEY1...KEYN VAL))
 
-(PUTPROPS FPUSHMULTI
 ARGNAMES
 (PLACE KEY1...KEYN VAL))
+(PUTPROPS SPUSHMULTI
 ARGNAMES
 (PLACE KEY1...KEYN VAL))
 
-(PUTPROPS FPUTMULTI
 ARGNAMES
 (PLACE KEY1...KEYN VAL))
+(PUTPROPS SPUSHMULTI-NEW
 ARGNAMES
 (PLACE KEY1...KEYN VAL))
 
-(PUTPROPS FPUSHMULTI-NEW
 ARGNAMES
 (PLACE KEY1...KEYN VAL))
+(PUTPROPS GETMULTI
 ARGNAMES
 (PLACE KEY1...KEYN))
+
+(PUTPROPS GETMULTI-PAIR
 ARGNAMES
 (PLACE KEY1...KEYN))
+
+(PUTPROPS SGETMULTI
 ARGNAMES
 (PLACE KEY1...KEYN))
+
+(PUTPROPS SGETMULTI-PAIR
 ARGNAMES
 (PLACE KEY1...KEYN))
 
 (PUTPROPS STOREMULTI
 ARGNAMES
 (PLACE KEYS VAL OPTIONS))
+
+(PUTPROPS REMOVEMULTI
 ARGNAMES
 (MULTIALIST KEY1...KEYN VAL))
 (DECLARE%: DOEVAL@COMPILE DONTCOPY
 
 (LOCALVARS . T)
 )
 (DECLARE%: DONTCOPY
-  (FILEMAP (NIL (3610 10036 (MAPMULTI 3620 . 4766) (MAPMULTI1 4768 . 5825) (COLLECTMULTI 5827 . 6298) (
-FETCHMULTI-PAIR 6300 . 7247) (EXTENDMULTI-PAIR 7249 . 10034)) (10037 14407 (GETMULTI-PAIR.EXPAND 10047
- . 11544) (PUTMULTI.EXPAND 11546 . 14405)))))
+  (FILEMAP (NIL (3720 10430 (MAPMULTI 3730 . 4876) (MAPMULTI1 4878 . 5935) (COLLECTMULTI 5937 . 6408) (
+FETCHMULTI-PAIR 6410 . 7470) (EXTENDMULTI-PAIR 7472 . 10428)) (10431 14805 (GETMULTI-PAIR.EXPAND 10441
+ . 11942) (PUTMULTI.EXPAND 11944 . 14803)))))
 STOP
diff --git a/library/MULTI-ALIST.LCOM b/library/MULTI-ALIST.LCOM
index ff593cc5d..d4c087988 100644
Binary files a/library/MULTI-ALIST.LCOM and b/library/MULTI-ALIST.LCOM differ
diff --git a/library/MULTI-ALIST.TEDIT b/library/MULTI-ALIST.TEDIT
index 810a72266..25c9ad8de 100644
Binary files a/library/MULTI-ALIST.TEDIT and b/library/MULTI-ALIST.TEDIT differ
diff --git a/library/PDFSTREAM b/library/PDFSTREAM
index 49a6393c0..bde1d1e29 100644
--- a/library/PDFSTREAM
+++ b/library/PDFSTREAM
@@ -1,14 +1,12 @@
 (DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
 
-
(FILECREATED "30-Jul-2025 18:01:04" 
-{DSK}<Users>kaplan>Local>medley3.5>working-medley>library>PDFSTREAM.;68
 15635  
+
(FILECREATED "23-Aug-2025 10:53:33" {WMEDLEY}<library>PDFSTREAM.;70
 15659  
 
       :EDIT-BY rmk
 
-      :CHANGES-TO (FNS SEE-PDF)
+      :CHANGES-TO (FNS PDF.FONTSAVAILABLE)
 
-      :PREVIOUS-DATE "16-Jun-2025 00:52:44" 
-{DSK}<Users>kaplan>Local>medley3.5>working-medley>library>PDFSTREAM.;67)
+      :PREVIOUS-DATE "30-Jul-2025 18:01:04" {WMEDLEY}<library>PDFSTREAM.;68)
 
 
 (PRETTYCOMPRINT PDFSTREAMCOMS)
@@ -129,12 +127,11 @@
          (CLOSEF TSTREAM])
 
 (PDF.FONTSAVAILABLE

-  [LAMBDA (FAMILY SIZE FACE ROTATION DEVICE)
                 (* ; "Edited 16-Jun-2025 00:46 by rmk")


-                                                      (* ; "Edited 12-Jan-88 13:04 by Matt Heffron")

-
-    (* ;; "")

-
-    (POSTSCRIPT.FONTSAVAILABLE FAMILY SIZE FACE ROTATION 'PDF])
+  [LAMBDA (FONTSPEC)
                                         (* ; "Edited 23-Aug-2025 10:53 by rmk")


+                                                             (* ; "Edited 16-Jun-2025 00:46 by rmk")

+    (LET ((FA (FONTSAVAILABLE FONTSPEC NIL NIL NIL 'POSTSCRIPT T)))
+         (for
 FS in
 FA do
 (replace
 (FONTSPEC FSDEVICE) of
 FS with
 'PDF))
+         FA])
 )
 
 (FONTPROFILE.ADDDEVICE 'PDF 'POSTSCRIPT)
@@ -308,8 +305,8 @@
                                    thereis
 (ShellWhich (CAR TEMPLATE])
 )
 (DECLARE%: DONTCOPY
-  (FILEMAP (NIL (3492 6433 (PDFFILEP 3502 . 4416) (PDF.HARDCOPYW 4418 . 5016) (PDF.TEXT 5018 . 5735) (
-PDF.TEDIT 5737 . 6104) (PDF.FONTSAVAILABLE 6106 . 6431)) (6873 14518 (OPEN-PDF-STREAM 6883 . 9604) (
-CLOSE-PDF-STREAM 9606 . 10893) (PS-TO-PDF 10895 . 14516)) (14519 15277 (SEE-PDF 14529 . 15275)) (15328
- 15612 (PDFCONVERTER 15338 . 15610)))))
+  (FILEMAP (NIL (3421 6457 (PDFFILEP 3431 . 4345) (PDF.HARDCOPYW 4347 . 4945) (PDF.TEXT 4947 . 5664) (
+PDF.TEDIT 5666 . 6033) (PDF.FONTSAVAILABLE 6035 . 6455)) (6897 14542 (OPEN-PDF-STREAM 6907 . 9628) (
+CLOSE-PDF-STREAM 9630 . 10917) (PS-TO-PDF 10919 . 14540)) (14543 15301 (SEE-PDF 14553 . 15299)) (15352
+ 15636 (PDFCONVERTER 15362 . 15634)))))
 STOP
diff --git a/library/PDFSTREAM.LCOM b/library/PDFSTREAM.LCOM
index 7c6ef662f..ed13f5a97 100644
Binary files a/library/PDFSTREAM.LCOM and b/library/PDFSTREAM.LCOM differ
diff --git a/library/POSTSCRIPTSTREAM b/library/POSTSCRIPTSTREAM
index 3b96c4ae3..f088d9fe8 100644
--- a/library/POSTSCRIPTSTREAM
+++ b/library/POSTSCRIPTSTREAM
@@ -1,12 +1,12 @@
 (DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
 
-
(FILECREATED "14-Jul-2025 22:21:34" {WMEDLEY}<library>POSTSCRIPTSTREAM.;24
 258986 
+
(FILECREATED "13-Oct-2025 18:05:08" {WMEDLEY}<library>POSTSCRIPTSTREAM.;55
 260304 
 
       :EDIT-BY rmk
 
-      :CHANGES-TO (FNS \DSPFONT.PSC)
+      :CHANGES-TO (FNS POSTSCRIPT.FONTCREATE)
 
-      :PREVIOUS-DATE "16-Jun-2025 00:04:32" {WMEDLEY}<library>POSTSCRIPTSTREAM.;23)
+      :PREVIOUS-DATE " 9-Oct-2025 21:16:27" {WMEDLEY}<library>POSTSCRIPTSTREAM.;53)
 
 
 (PRETTYCOMPRINT POSTSCRIPTSTREAMCOMS)
@@ -43,10 +43,6 @@
              PSCFONTFROMCACHE.COERCEFILE PSCFONT.WRITEFONT READ-AFM-FILE CONVERT-AFM-FILES 
              POSTSCRIPT.GETFONTID POSTSCRIPT.FONTCREATE \POSTSCRIPT.SPECIALFONT.SCALEDWIDTHS 
              POSTSCRIPT.FONTSAVAILABLE POSTSCRIPT.FONTEXISTS?)
-        (COMS 
-              (* ;; "Until macro in FONT is exported")

-
-              (MACROS \FSETCHARWIDTH))
         (FNS OPENPOSTSCRIPTSTREAM CLOSEPOSTSCRIPTSTREAM)
         (INITVARS (*POSTSCRIPT-FILE-TYPE* 'BINARY))
         (FNS POSTSCRIPT.HARDCOPYW POSTSCRIPT.TEDIT POSTSCRIPT.TEXT POSTSCRIPTFILEP MAKEEPSFILE)
@@ -131,6 +127,7 @@
         (CONSTANTS (GOLDEN.RATIO 1.618034)
                (\PS.SCALE0 100)
                (\PS.TEMPARRAYLEN 20))
+        (GLOBALVARS POSTSCRIPTFONTEXTENSIONS POSTSCRIPTFONTDIRECTORIES)
         (INITVARS (POSTSCRIPT.BITMAP.SCALE 1)
                (POSTSCRIPT.EOL 'CR)
                (POSTSCRIPT.IMAGESIZEFACTOR 1)
@@ -142,6 +139,21 @@
                                                            'MAIKO)
                                                        "{dsk}/USR/LOCAL/LDE/FONTS/POSTSCRIPT/")
                                                       (T "{DSK}<LISPFILES>POSTSCRIPT>"]
+               (POSTSCRIPTFONTEXTENSIONS '(PSCFONT PF PSC))
+               [POSTSCRIPTFONTCOERCIONS '((HELVETICA (HELVETICA 1))
+                                          (HELVETICAD (HELVETICA 1))
+                                          (TIMESROMAN (TIMES 1))
+                                          (TIMESROMAND (TIMES 1))
+                                          (COURIER (COURIER 1))
+                                          (GACHA (COURIER 1))
+                                          (CLASSIC (NEWCENTURYSCHLBK 1))
+                                          (MODERN (HELVETICA 1))
+                                          (CREAM (HELVETICA 1))
+                                          (TERMINAL (COURIER 1))
+                                          (LOGO (HELVETICA 1))
+                                          (OPTIMA (PALATINO 1))
+                                          (TITAN (COURIER 1))
+                                          (* (* 1]
                (\POSTSCRIPT.MAX.WILD.FONTSIZE 72))
         [COMS (FNS POSTSCRIPTSEND)
               (ADDVARS (PRINTERTYPES ((POSTSCRIPT)
@@ -167,7 +179,7 @@
                         (TITAN . COURIER))
                [PRINTFILETYPES (POSTSCRIPT (TEST POSTSCRIPTFILEP)
                                       (EXTENSION (PS PSC PSF))
-                                      (CONVERSION (TEXT POSTSCRIPT.TEXT TEDIT POSTSCRIPT.TEDIT]
+                                      (CONVERSION (TEXT POSTSCRIPT.TEXT TEDIT TEDIT.TO.IMAGEFILE]
                (IMAGESTREAMTYPES (POSTSCRIPT (OPENSTREAM OPENPOSTSCRIPTSTREAM)
                                         (FONTCREATE POSTSCRIPT.FONTCREATE)
                                         (FONTSAVAILABLE POSTSCRIPT.FONTSAVAILABLE)
@@ -377,7 +389,9 @@
 (DEFINEQ
 
 (POSTSCRIPT.INIT

-  [LAMBDA NIL
                                           (* ; "Edited 14-May-2018 10:48 by rmk:")


+  [LAMBDA NIL
                                                (* ; "Edited  9-Sep-2025 21:57 by rmk")


+                                                             (* ; "Edited 22-Aug-2025 21:34 by rmk")


+                                                            (* ; "Edited 14-May-2018 10:48 by rmk:")


                                                              (* ; "Edited  4-Feb-93 21:08 by jds")

     (DECLARE
 (GLOBALVARS \POSTSCRIPT.CHARTYPE))
 
@@ -385,9 +399,8 @@
 
     [MAPC
      [CL:REMOVE-DUPLICATES (NCONC (for
 FD in
 FONTDEFS
-                                     join
 (for
 FP in
 (CDR (ASSOC 'FONTPROFILE
-                                                                             (CDR FD)))
-                                                 collect
 (CAR FP)))
+                                     join
 (for
 FP in
 (CDR (ASSOC 'FONTPROFILE (CDR FD)))
+                                             collect
 (CAR FP)))
                                   '(FONT7 FONT6 FONT5 FONT4 FONT3 FONT2 FONT1 BOLDFONT LITTLEFONT 
                                           BIGFONT PRETTYCOMFONT COMMENTFONT USERFONT SYSTEMFONT 
                                           CLISPFONT LAMBDAFONT CHANGEFONT DEFAULTFONT]
@@ -395,41 +408,35 @@
                  (LET
                   (COPYFD OLDPSCFD)
                   (if
 (BOUNDP CLASS)
-                      then

-                      (SETQ CLASS (EVALV CLASS))
-                      (if
 (TYPEP CLASS 'FONTCLASS)
-                          then
 (SETQ COPYFD (OR (fetch
 (FONTCLASS INTERPRESSFD) of
 CLASS)
-                                                    (fetch
 (FONTCLASS PRESSFD) of
 CLASS)
-                                                    (fetch
 (FONTCLASS DISPLAYFD) of
 CLASS)))
-                                (if
 (SETQ OLDPSCFD (ASSOC 'POSTSCRIPT (fetch
 (FONTCLASS
-                                                                                      OTHERFDS)
+                      then
 (SETQ CLASS (EVALV CLASS))
+                           (if
 (TYPEP CLASS 'FONTCLASS)
+                               then
 (SETQ COPYFD (OR (fetch
 (FONTCLASS INTERPRESSFD) of
 CLASS)
+                                                     (fetch
 (FONTCLASS DISPLAYFD) of
 CLASS)))
+                                    (if
 (SETQ OLDPSCFD (ASSOC 'POSTSCRIPT (fetch
 (FONTCLASS OTHERFDS)
                                                                              of
 CLASS)))
-                                    then
 [if
 (NOT (CDR OLDPSCFD))
+                                        then
 [if
 (NOT (CDR OLDPSCFD))
                                                  then
 (RPLACD OLDPSCFD (if
 (LISTP COPYFD)
-                                                                               then
 COPYFD
-                                                                             else
 (FONTUNPARSE
-                                                                                       COPYFD]
-                                  else
 (push
 (fetch
 (FONTCLASS OTHERFDS) of
 CLASS)
-                                                  (CONS 'POSTSCRIPT (if
 (LISTP COPYFD)
-                                                                        then
 COPYFD
-                                                                      else
 (FONTUNPARSE COPYFD]
+                                                                           then
 COPYFD
+                                                                         else
 (FONTUNPARSE COPYFD]
+                                      else
 (push
 (fetch
 (FONTCLASS OTHERFDS) of
 CLASS)
+                                                 (CONS 'POSTSCRIPT (if
 (LISTP COPYFD)
+                                                                       then
 COPYFD
+                                                                     else
 (FONTUNPARSE COPYFD]
     [FOR
 FD IN
 FONTDEFS
        DO
 (FOR
 FP IN
 (CDR (ASSOC 'FONTPROFILE (CDR FD)))
-                 DO
 (COND
-                           ((ASSOC 'POSTSCRIPT (CL:NTHCDR 5 FP))
+             DO
 (COND
+                   ((ASSOC 'POSTSCRIPT (CL:NTHCDR 5 FP))
 
-                            (* ;; "There's already a postscript spec, so leave it be.")

+                    (* ;; "There's already a postscript spec, so leave it be.")

 
-                            )
-                           (T (NCONC1 FP `(POSTSCRIPT ,(OR (CL:FIFTH FP)
-                                                           (CL:FOURTH FP)
-                                                           (CL:THIRD FP]
+                    )
+                   (T (NCONC1 FP `(POSTSCRIPT ,(OR (CL:FIFTH FP)
+                                                   (CL:FOURTH FP)
+                                                   (CL:THIRD FP]
 
     (* ;; "Eliminate any existing postscript fonts, to start with a clean slate if reinitializing.")

 
-    (FOR
 FD IN
 (FONTSAVAILABLE '* '* '* '* 'POSTSCRIPT)
-       DO
 (APPLY (FUNCTION SETFONTDESCRIPTOR)
-                     FD))
+    (FLUSHFONTSINCORE '* '* '* '* 'POSTSCRIPT)
     (SETQ POSTSCRIPTFONTCACHE NIL)
     (SETQ \POSTSCRIPT.CHARTYPE (CL:MAKE-ARRAY 256 :INITIAL-ELEMENT T))
 
@@ -437,7 +444,7 @@
 
     (for
 x from
 (CHARCODE SP) to
 126 unless
 (FMEMB x (CHARCODE (%( %) \)))
        do
 (CL:SETF (CL:AREF \POSTSCRIPT.CHARTYPE x)
-                     NIL))
+                 NIL))
 
     (* ;; "RMK:  Maybe the following is equivalent to alot of the stuff above??")

 
@@ -616,7 +623,8 @@
          PF])
 
 (PSCFONT.SPELLFILE

-  [LAMBDA (FAMILY SIZE FACE ROTATION DEVICE)
                 (* ; "Edited 15-Jun-2025 23:31 by rmk")


+  [LAMBDA (FAMILY SIZE FACE ROTATION DEVICE)
                 (* ; "Edited 16-Aug-2025 23:50 by rmk")


+                                                             (* ; "Edited 15-Jun-2025 23:31 by rmk")


                                                              (* ; "Edited  5-Oct-93 22:15 by rmk:")


                                                              (* ; "Edited  5-Oct-92 15:23 by jds")

 
@@ -626,7 +634,7 @@
     (CL:WHEN POSTSCRIPTFONTDIRECTORIES
         (\FINDFONTFILE (OR (CDR (FASSOC FAMILY POSTSCRIPT.FONT.ALIST))
                            FAMILY)
-               SIZE FACE 0 DEVICE 0 POSTSCRIPTFONTDIRECTORIES '(PSCFONT PF PSC)))])
+               SIZE FACE 0 DEVICE 0 POSTSCRIPTFONTDIRECTORIES POSTSCRIPTFONTEXTENSIONS))])
 
 (PSCFONT.COERCEFILE

   [LAMBDA (FAMILY SIZE WEIGHT SLOPE EXPANSION ROTATION DEVICE)

@@ -881,13 +889,19 @@
          FONTID])
 
 (POSTSCRIPT.FONTCREATE

-  [LAMBDA (FAMILY SIZE FACE ROTATION DEVICE)
                 (* ; "Edited 15-Jun-2025 23:40 by rmk")


+  [LAMBDA (FONTSPEC)
                                         (* ; "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")


+                                                             (* ; "Edited 15-Jun-2025 23:40 by rmk")


                                                              (* ; "Edited 29-Oct-93 16:39 by rmk:")


                                                              (* ; "Edited  3-Feb-93 17:22 by jds")

     (LET (UNITFONT FULLNAME SCALEFONTP PSCFD ASCENT DESCENT FIXPWIDTHS PSCWIDTHSBLOCK WIDTHSBLOCK FD
-                FACECHANGED (WEIGHT (CAR FACE))
-                (SLOPE (CADR FACE))
-                (EXPANSION (CADDR FACE)))
+                FACECHANGED FAMILY SIZE FACE ROTATION DEVICE WEIGHT SLOPE EXPANSION)
+         (SPREADFONTSPEC FONTSPEC)
+         (SETQ WEIGHT (fetch
 (FONTFACE WEIGHT) of
 FACE))
+         (SETQ SLOPE (fetch
 (FONTFACE SLOPE) of
 FACE))
+         (SETQ EXPANSION (fetch
 (FONTFACE EXPANSION) of
 FACE))
 
          (* ;; 
 
    "Ignore rotations, it is **MUCH** easier to rotate the Postscript stream user space coordinates.")

@@ -970,8 +984,10 @@
                            ROTATION _ 0
                            \SFHeight _ (IPLUS ASCENT DESCENT)
                            \SFAscent _ ASCENT
-                           \SFDescent _ DESCENT))
-                   (SETQ WIDTHSBLOCK (fetch
 (CHARSETINFO WIDTHS) of
 (\GETCHARSETINFO 0 FD)))
+                           \SFDescent _ DESCENT
+                           FONTTOMCCSFN _ (MCCSMAPFN FONTSPEC)))
+                   (FONTPROP FD 'CHARENCODING)
+                   (SETQ WIDTHSBLOCK (fetch
 (CHARSETINFO WIDTHS) of
 (\INSURECHARSETINFO FD 0)))
                    (SETQ FIXPWIDTHS (fetch
 (PSCFONT WIDTHS) of
 PSCFD))
                    [COND
                       [SCALEFONTP (for
 CH from
 0 to
 255
@@ -986,7 +1002,7 @@
                    (for
 CH from
 0 to
 255 do
 (\FSETWIDTH PSCWIDTHSBLOCK CH (\FGETWIDTH WIDTHSBLOCK CH)
                                                    ))
                    [LET [(TMP (COND
-                                 (FULLNAME (\FONTINFOFROMFILENAME FULLNAME DEVICE))
+                                 (FULLNAME (FONTSPECFROMFILENAME FULLNAME DEVICE))
                                  (UNITFONT (fetch
 FONTDEVICESPEC of
 UNITFONT]
 
                         (* ;; "If face got coerced (possibly in recursive call for unit font) then set FONTDEVICESPEC to describe what we really got")

@@ -1111,66 +1127,46 @@
              NEWWIDTHS)])
 
 (POSTSCRIPT.FONTSAVAILABLE

-  [LAMBDA (FAMILY SIZE FACE ROTATION DEVICE)
      (* ; "Edited 12-Jan-88 13:04 by Matt Heffron")

-
-    (* ;; "the filtering code was borrowed from Richard Burton's \SEARCHINTERPRESSFONTS.  Note that without it [HELVETICA * (MEDIUM REGULAR REGULAR)]  would pick up [HELVETICA-NARROW * (MEDIUM REGULAR REGULAR)] as well.")

-
-    (LET
-     ((PATTERN (\FONTFILENAME (OR (CDR (ASSOC FAMILY POSTSCRIPT.FONT.ALIST))
-                                  FAMILY)
-                      SIZE FACE 'PSCFONT))
-      [INVERSE.ALIST (for
 PAIR in
 POSTSCRIPT.FONT.ALIST collect
 (CONS (CDR PAIR)
-                                                                                  (CAR PAIR]
-      FONTSAVAILABLE)
-     (SETQ FONTSAVAILABLE
-      (for
 FD in
 [for
 DIRECTORY in
 POSTSCRIPTFONTDIRECTORIES
-                            join
 (for
 FILE in
 (DIRECTORY (CONCAT DIRECTORY PATTERN))
-                                        collect
 (LET* ((RAWFD (\FONTINFOFROMFILENAME FILE DEVICE)
-                                                                  )
-                                                           (RAWNAME (CAR RAWFD)))
-                                                          (RPLACA RAWFD
-                                                                 (OR (CDR (ASSOC RAWNAME 
-                                                                                 INVERSE.ALIST))
-                                                                     RAWNAME]
-         when
 (AND (OR (EQ FAMILY '*)
-                           (EQ FAMILY (CAR FD)))
-                       (OR (EQ SIZE '*)
-                           (EQ SIZE (CADR FD))
-                           (EQ (CADR FD)
-                               1))
-                       (OR (EQ FACE '*)
-                           (EQUAL FACE (CADDR FD))
-                           (EQUAL [CDR (ASSOC FACE '((MRR MEDIUM REGULAR REGULAR)
-                                                     (STANDARD MEDIUM REGULAR REGULAR)
-                                                     (MIR MEDIUM ITALIC REGULAR)
-                                                     (ITALIC MEDIUM ITALIC REGULAR)
-                                                     (BRR BOLD REGULAR REGULAR)
-                                                     (BOLD BOLD REGULAR REGULAR)
-                                                     (BIR BOLD ITALIC REGULAR)
-                                                     (BOLDITALIC BOLD ITALIC REGULAR]
-                                  (CADDR FD)))
-                       (NOT (MEMBER FD $$VAL))) collect
 FD))
-     (if
 (EQ SIZE '*)
-         then

-
-(* ;;; "If SIZE was wildcarded, then provide list of pointsizes for Postscript scaled fonts (those with a 1 point descriptor file)")

-
-         (for
 FD in
 FONTSAVAILABLE
-            join
 (if
 (EQ 1 (CADR FD))
-                         then
 (CONS FD (for
 NF
-                                              in
 (for
 S from
 2 to
 
-                                                                        \POSTSCRIPT.MAX.WILD.FONTSIZE
-                                                        collect
 (LET ((NFD (COPY FD)))
-                                                                         (RPLACA (CDR NFD)
-                                                                                S)
-                                                                         NFD))
-                                              unless
 (MEMBER NF FONTSAVAILABLE) collect

-                                                                                    NF))
-                       else
 (LIST FD)))
-       else
 FONTSAVAILABLE])
+  [LAMBDA (FONTSPEC)
                                         (* ; "Edited 25-Aug-2025 13:09 by rmk")


+                                                             (* ; "Edited 23-Aug-2025 08:19 by rmk")

+
+    (* ;; "Postscript only has font files of size 1, and only files for %"raw%" postscript families that Medley font families are mapped to by POSTSCRIPTFONTCOERCIONS.  Therefore the search doesn't care about the given family, just looks at the corresponding raw files that exist in the directory. ")

+
+    (LET [(SIZE (fetch
 (FONTSPEC FSSIZE) of
 FONTSPEC))
+          (FONTSAVAILABLE (\SEARCHFONTFILES (CAR (COERCEFONTSPEC FONTSPEC]
+
+         (* ;; "Switch from postscript family names back to the corresponding Medley names.")

+
+         (for
 FS in
 FONTSAVAILABLE
+            do
 (change
 (fetch
 (FONTSPEC FSFAMILY) of
 FS)
+                      (OR [CAR (find
 C in
 (FONTDEVICEPROP FONTSPEC 'FONTCOERCIONS)
+                                  suchthat
 
+
+                                        (* ;; "C is (medley (ps 1))--match ps return medley")

+
+                                        (EQ DATUM (CAR (CADR C]
+                          DATUM)))
+         (if
 (EQ SIZE '*)
+             then
 
+                  (* ;; "If SIZE was wildcarded, then provide list of pointsizes for the Postscript scaled fonts (those with a 1 point descriptor file)")

+
+                  (* ;; 
+
             "RMK:  Maybe just provide the sizes that exist for all the corresponding display fonts?")

+
+                  (for
 FS in
 FONTSAVAILABLE
+                     do
 (for
 S NFS from
 2 to
 \POSTSCRIPT.MAX.WILD.FONTSIZE
+                           eachtime
 (SETQ NFS (create
 FONTSPEC using
 FS FSSIZE _ S))
+                           unless
 (MEMBER NFS FONTSAVAILABLE) do
 (push
 FONTSAVAILABLE NFS)))
+           else
 
+                (* ;; "Otherwise, replace the 1 with the requested SIZE.")

+
+                (for
 FS in
 FONTSAVAILABLE do
 (replace
 (FONTSPEC FSSIZE) of
 FS with
 SIZE)))
+         FONTSAVAILABLE])
 
 (POSTSCRIPT.FONTEXISTS?

-  [LAMBDA (FAMILY SIZE FACE ROTATION DEVICE)
                 (* ; "Edited 16-Jun-2025 00:04 by rmk")


+  [LAMBDA (FONTSPEC)
                                         (* ; "Edited  3-Sep-2025 23:12 by rmk")


+                                                             (* ; "Edited 18-Aug-2025 09:44 by rmk")


+                                                             (* ; "Edited 16-Jun-2025 00:04 by rmk")


                                                              (* ; "Edited 29-Oct-93 16:39 by rmk:")


                                                              (* ; "Edited  3-Feb-93 17:22 by jds")

 
@@ -1178,40 +1174,34 @@
 
     (* ;; "Since a 1 point font is ridiculously small, and it is the standard size for Postscript font info, size 1 is presumed to be the base for all postscript fonts.")

 
-    (LET ((WEIGHT (fetch
 (FONTFACE WEIGHT) of
 FACE))
-          (SLOPE (fetch
 (FONTFACE SLOPE) of
 FACE))
-          (EXPANSION (fetch
 (FONTFACE EXPANSION) of
 FACE)))
+    (LET (FAMILY SIZE FACE ROTATION DEVICE WEIGHT SLOPE EXPANSION)
+         (SPREADFONTSPEC FONTSPEC)
+         (SETQ WEIGHT (fetch
 (FONTFACE WEIGHT) of
 FACE))
+         (SETQ SLOPE (fetch
 (FONTFACE SLOPE) of
 FACE))
+         (SETQ EXPANSION (fetch
 (FONTFACE EXPANSION) of
 FACE))
          (OR (PSCFONT.SPELLFILE
 FAMILY 1 FACE ROTATION DEVICE)
              (PSCFONTFROMCACHE.COERCEFILE
 FAMILY 1 WEIGHT SLOPE EXPANSION ROTATION DEVICE)
              (PSCFONT.COERCEFILE
 FAMILY 1 WEIGHT SLOPE EXPANSION ROTATION DEVICE])
 )
-
-
-
-(* ;; "Until macro in FONT is exported")

-
-(DECLARE%: EVAL@COMPILE 
-
-(PUTPROPS \FSETCHARWIDTH
 MACRO
 (OPENLAMBDA (FONTDESC CHARCODE WIDTH)
-                                 (\FSETWIDTH (ffetch
 (CHARSETINFO WIDTHS) of
 (\GETCHARSETINFO
-                                                                              (\CHARSET CHARCODE)
-                                                                              FONTDESC))
-                                        (\CHAR8CODE CHARCODE)
-                                        WIDTH)))
-)
 (DEFINEQ
 
 (OPENPOSTSCRIPTSTREAM

-  [LAMBDA (FILE OPTIONS)
                                    (* ; "Edited 12-Jun-2021 19:14 by rmk:")

+  [LAMBDA (FILE OPTIONS)
                                     (* ; "Edited 19-Sep-2025 16:02 by rmk")


+                                                             (* ; "Edited 14-Sep-2025 12:50 by rmk")


+                                                            (* ; "Edited 12-Jun-2021 19:14 by rmk:")

                                                              (* ; 
 
                                                        "Edited 31-May-93 12:42 by sybalsky:mv:envos")

                                                              (* ; "Edited 23-Dec-92 01:17 by jds")

 
     (* ;; "RMK:  Note:  At open, this does a lot of printing using generic functions which invoke the generic \OUTCHARFN of the stream.  We set that up as BOUT.  But after the stream is open, we install the \POSTSCRIPT.OUTCHARFN, below.  We also have to make sure that other internal printing that may want to use generic functions (PRIN1, PRIN3...) for convenience, doesn't cycle through the postscript outcharfn.")

 
-    (LET [[STREAM (OPENSTREAM (PACKFILENAME 'BODY FILE 'EXTENSION 'PS)
-                         'OUTPUT NIL `((TYPE ,*POSTSCRIPT-FILE-TYPE*)
-                                       (SEQUENTIAL T]
+    (LET [[STREAM (CL:IF (\GETSTREAM FILE 'OUTPUT T)
+                      FILE
+                      [OPENSTREAM (CL:IF (EQ 'LPT (FILENAMEFIELD FILE 'HOST))
+                                      FILE
+                                      (PACKFILENAME 'BODY FILE 'EXTENSION 'PS))
+                             'OUTPUT NIL `((TYPE ,*POSTSCRIPT-FILE-TYPE*)
+                                           (SEQUENTIAL T])]
           (IMAGEDATA (create
 \POSTSCRIPTDATA))
           PAPER IMAGESIZEFACTOR CLIP REG (BBOX (LISTGET OPTIONS 'BOUNDINGBOX]
          (replace
 (STREAM IMAGEDATA) of
 STREAM with
 IMAGEDATA)
@@ -1401,36 +1391,38 @@
           (FULLNAME STREAM])
 
 (POSTSCRIPT.TEDIT

-  [LAMBDA (FILE PFILE)
                                       (* ; "Edited 18-Sep-91 18:16 by jds")

+  [LAMBDA (FILE IMAGESTREAM)
                                 (* ; "Edited 13-Sep-2025 20:21 by rmk")


+                                                             (* ; "Edited 12-Sep-2025 13:40 by rmk")


+                                                             (* ; "Edited 18-Sep-91 18:16 by jds")

 
-    (* ;; "Make a PS file from a TEdit document.  If FILE is a string, make it into a symbol for the file-name.  If it's a STREAM, use that stream.")

+    (* ;; "IMAGESTREAM must be a postscript stream  ")

 
-    [COND
-       ((STRINGP FILE)
-        (SETQ FILE (MKATOM FILE]
-    (SETQ FILE (OPENTEXTSTREAM FILE))
-    (TEDIT.FORMAT.HARDCOPY FILE PFILE T NIL NIL NIL 'POSTSCRIPT)
-    (CLOSEF? FILE)
-    PFILE])
+    (TEDIT.TO.IMAGESTREAM FILE IMAGESTREAM])
 
 (POSTSCRIPT.TEXT

-  [LAMBDA (FILE PSCFILE FONTS HEADING TABS)
              (* ; "Edited 23-Apr-89 11:31 by TAL")

-    (TEXTTOIMAGEFILE FILE PSCFILE 'POSTSCRIPT FONTS HEADING TABS
-           `(REGION ,POSTSCRIPT.DEFAULT.PAGEREGION ROTATION ,(NOT (NOT POSTSCRIPT.TEXTFILE.LANDSCAPE])
+  [LAMBDA (FILE IMAGEFILE IMAGETYPE OPTIONS)
                 (* ; "Edited 17-Sep-2025 23:21 by rmk")


+                                                             (* ; "Edited 23-Apr-89 11:31 by TAL")

+    (TEXTTOIMAGEFILE FILE IMAGEFILE IMAGETYPE `(,@OPTIONS REGION ,POSTSCRIPT.DEFAULT.PAGEREGION 
+                                                      ROTATION ,(NOT (NOT 
+                                                                        POSTSCRIPT.TEXTFILE.LANDSCAPE
+                                                                          ])
 
 (POSTSCRIPTFILEP

-  [LAMBDA (FILE)
                                             (* ; "Edited 21-Nov-2023 17:04 by rmk")


+  [LAMBDA (FILE)
                                             (* ; "Edited  9-Oct-2025 21:16 by rmk")


+                                                             (* ; "Edited 18-Sep-2025 09:35 by rmk")


+                                                             (* ; "Edited 13-Sep-2025 23:23 by rmk")


+                                                             (* ; "Edited 10-Sep-2025 14:51 by rmk")


+                                                             (* ; "Edited 21-Nov-2023 17:04 by rmk")


                                                              (* ; "Edited  5-Mar-93 21:40 by rmk:")


                                                              (* ; "Edited 14-Jan-93 10:56 by jds")

-    (OR (CL:MEMBER (UNPACKFILENAME.STRING FILE 'EXTENSION)
-               [CADR (ASSOC 'EXTENSION (CDR (ASSOC 'POSTSCRIPT PRINTFILETYPES]
+    (OR (MEMBER (U-CASE (FILENAMEFIELD FILE 'EXTENSION))
+               (EXTENSIONS.FOR.IMAGEFILETYPE 'POSTSCRIPT)
                :TEST
                (FUNCTION STRING-EQUAL))
         (RESETLST
             [LET (STRM)
                  [if
 (SETQ STRM (\GETSTREAM FILE 'INPUT T))
-                     then
 (RESETSAVE (GETFILEPTR STRM)
-                                 `(SETFILEPTR ,STRM OLDVALUE))
+                     then
 [RESETSAVE NIL `(PROGN (SETFILEPTR ,STRM ,(GETFILEPTR STRM]
                           (SETFILEPTR STRM 0)
                    else
 (RESETSAVE (SETQ STRM (OPENSTREAM FILE 'INPUT))
                                `(PROGN (CLOSEF OLDVALUE]
@@ -1440,24 +1432,26 @@
                           (CHARCODE !])])
 
 (MAKEEPSFILE

-  [LAMBDA (IMAGEOBJ FILENAME)
                            (* ; "Edited  7-Apr-94 14:48 by rmk:")

-
-    (* ;; "Puts IMAGEOBJ on a 1-page encapsulated postscript file.  The lower-left corner of the image box will be at 0,0 on the page.")

-
-    (LET* [(STREAM (OPENIMAGESTREAM `{NODIRCORE}SCRATCH 'POSTSCRIPT))
-           (IMAGEBOX (APPLY* (IMAGEOBJPROP IMAGEOBJ 'IMAGEBOXFN)
-                            IMAGEOBJ STREAM))
-           (BOUNDINGBOX (LIST 0 0 (FETCH
 XSIZE OF
 IMAGEBOX)
-                              (FETCH
 YSIZE OF
 IMAGEBOX]
-          [SETQ STREAM (OPENIMAGESTREAM FILENAME 'POSTSCRIPT
-                              `(BOUNDINGBOX (0 0 ,(FETCH
 XSIZE OF
 IMAGEBOX)
-                                               ,(FETCH
 YSIZE OF
 IMAGEBOX]
-          (MOVETO (FETCH
 XKERN OF
 IMAGEBOX)
-                 (FETCH
 YDESC OF
 IMAGEBOX)
-                 STREAM)
-          (APPLY* (IMAGEOBJPROP IMAGEOBJ 'DISPLAYFN)
-                 IMAGEOBJ STREAM)
-          (CLOSEF STREAM])
+  [LAMBDA (IMAGEOBJ FILENAME)
                                (* ; "Edited 16-Sep-2025 00:29 by rmk")


+                                                             (* ; "Edited  7-Apr-94 14:48 by rmk:")

+
+    (* ;; "Puts IMAGEOBJ on a 1-page encapsulated postscript file.  The lower-left corner of the image box will be at 0,0 on the page.")

+
+    (* ;; "This opens a scratch stream to get the postscript imagebox of the object, then opens the true stream with that object.")

+
+    (LET ([IMAGEBOX (APPLY* (IMAGEOBJPROP IMAGEOBJ 'IMAGEBOXFN)
+                           IMAGEOBJ
+                           (OPENIMAGESTREAM `{NODIRCORE}SCRATCH 'POSTSCRIPT]
+          STREAM)
+         [SETQ STREAM (OPENIMAGESTREAM FILENAME 'POSTSCRIPT
+                             `(BOUNDINGBOX (0 0 ,(FETCH
 XSIZE OF
 IMAGEBOX)
+                                              ,(FETCH
 YSIZE OF
 IMAGEBOX]
+         (MOVETO (FETCH
 XKERN OF
 IMAGEBOX)
+                (FETCH
 YDESC OF
 IMAGEBOX)
+                STREAM)
+         (APPLY* (IMAGEOBJPROP IMAGEOBJ 'DISPLAYFN)
+                IMAGEOBJ STREAM)
+         (CLOSEF STREAM])
 )
 (DEFINEQ
 
@@ -2304,29 +2298,23 @@
                CHARCODE])
 
 (\CREATECHARSET.PSC

-  [LAMBDA (FAMILY SIZE FACE ROTATION DEVICE CHARSET FONTDESC NOSLUG?)

-                                                             (* ; "Edited  8-May-93 22:55 by rmk:")

-    (LET* ((CSINFO (CREATE
 CHARSETINFO
+  [LAMBDA (FONTSPEC FONT CHARSET)
                            (* ; "Edited  3-Sep-2025 23:11 by rmk")


+                                                             (* ; "Edited  8-May-93 22:55 by rmk:")

+    (LET* ((CSINFO (create
 CHARSETINFO
                           OFFSETS _ NIL))
-           (WIDTHS (FETCH
 (CHARSETINFO WIDTHS) OF
 CSINFO)))
-          (REPLACE
 (CHARSETINFO IMAGEWIDTHS) OF
 CSINFO WITH
 WIDTHS)
+           (WIDTHS (fetch
 (CHARSETINFO WIDTHS) of
 CSINFO)))
+          (replace
 (CHARSETINFO IMAGEWIDTHS) of
 CSINFO with
 WIDTHS)
 
-          (* ;; "Make imagewidths point to widths.  Shouldn't matter to anyone, since imagewidths really has to do with bitmaps etc.  But...")

+          (* ;; "Make imagewidths point to widths.  Shouldn't matter to anyone, since imagewidths really has to do with bitmaps etc.  But...")

 
           (CL:UNLESS (EQ CHARSET 0)
 
-              (* ;; "For all charsets other than 0, initialize widths with width of black box=average char width.  We know that the AVGCHARWIDTH field of the FONTDESC will eventually be the width of A, but that might not be filled in when this is executed inside POSTSCRIPT.FONTCREATE--it's only after the return to FONTCREATE itself that this gets filled in.  However, we do know that charset 0 is all set up before any other characters are dealt with.")

-
-              (FOR
 I (AVGCHARWIDTH _ (CHARWIDTH (CHARCODE A)
-                                                FONTDESC)) FROM
 0 TO
 255
-                 FIRST
 (CL:WHEN (EQ 0 AVGCHARWIDTH)
+              (* ;; "For all charsets other than 0, initialize widths with width of black box=average char width.  We know that the AVGCHARWIDTH field of the FONT will eventually be the width of A, but that might not be filled in when this is executed inside POSTSCRIPT.FONTCREATE--it's only after the return to FONTCREATE itself that this gets filled in.  However, we do know that charset 0 is all set up before any other characters are dealt with.")

 
-                               (* ;; 
-
  "This is what \AVGCHARWIDTH in FONT does, but we don't have it here.  Just to be extremely safe.")

+              (* ;; "RMK:  Should it use the FONTSLUGWIDTH")

 
-                               [SETQ AVGCHARWIDTH (MAX 1 (FIXR (FTIMES 0.6 (FONTPROP FONTDESC
-                                                                                  'HEIGHT])
-                 DO
 (\FSETWIDTH WIDTHS I AVGCHARWIDTH)))
+              (for
 I (AVGCHARWIDTH _ (\AVGCHARWIDTH FONT)) from
 0 to
 \MAXTHINCHAR
+                 do
 (\FSETWIDTH WIDTHS I AVGCHARWIDTH)))
           CSINFO])
 
 (\DRAWARC.PSC

@@ -3125,22 +3113,21 @@
 (DEFINEQ
 
 (\POSTSCRIPT.CHANGECHARSET

-  [LAMBDA (PSDATA CHARSET)
                                   (* ; "Edited 29-Apr-93 13:51 by rmk:")

+  [LAMBDA (PSDATA CHARSET)
                                   (* ; "Edited 30-Aug-2025 23:24 by rmk")


+                                                             (* ; "Edited 29-Apr-93 13:51 by rmk:")

 
     (* ;; 
 
 "Called when the character set information cached in a display stream doesn't correspond to CHARSET")

 
     (PROG* ((FONT (ffetch
 POSTSCRIPTFONT of
 PSDATA))
-            (CSINFO (\GETCHARSETINFO CHARSET FONT)))
-
-     (* ;; "since the call to \getcharsetinfo has NOSLUG?  = NIL, we know that we will get a reasonable character set back")

-
+            (CSINFO (\INSURECHARSETINFO FONT CHARSET)))
            (UNINTERRUPTABLY
                (freplace
 POSTSCRIPTWIDTHS of
 PSDATA with
 (ffetch
 (CHARSETINFO WIDTHS) of
 CSINFO))
                (freplace
 POSTSCRIPTNSCHARSET of
 PSDATA with
 CHARSET))])
 
 (\POSTSCRIPT.OUTCHARFN

-  [LAMBDA (STREAM CHAR)
                                      (* ; "Edited 23-May-93 12:00 by rmk:")


+  [LAMBDA (STREAM CHAR)
                                      (* ; "Edited  8-Sep-2025 09:50 by rmk")


+                                                             (* ; "Edited 23-May-93 12:00 by rmk:")


                                                              (* ; "Edited  4-May-93 02:20 by jds")


                                                              (* ; "Edited  3-Feb-93 00:45 by jds")

 
@@ -3152,6 +3139,7 @@
 
     (DECLARE
 (GLOBALVARS \POSTSCRIPT.CHARTYPE)
            (LOCALVARS . T))
+    (SETQ CHAR (MTOX$CODE CHAR))
     (LET* ((IMAGEDATA (fetch
 (STREAM IMAGEDATA) of
 STREAM))
            (XPOS (fetch
 (\POSTSCRIPTDATA POSTSCRIPTX) of
 IMAGEDATA))
            (FONT (ffetch
 (\POSTSCRIPTDATA POSTSCRIPTFONT) of
 IMAGEDATA))
@@ -4305,6 +4293,10 @@
        (\PS.SCALE0 100)
        (\PS.TEMPARRAYLEN 20))
 )
+(DECLARE%: DOEVAL@COMPILE DONTCOPY
+
+(GLOBALVARS POSTSCRIPTFONTEXTENSIONS POSTSCRIPTFONTDIRECTORIES)
+)
 
 (RPAQ? POSTSCRIPT.BITMAP.SCALE
 1)
 
@@ -4325,6 +4317,24 @@
                                               "{dsk}/USR/LOCAL/LDE/FONTS/POSTSCRIPT/")
                                              (T "{DSK}<LISPFILES>POSTSCRIPT>"))))
 
+(RPAQ? POSTSCRIPTFONTEXTENSIONS
 '(PSCFONT PF PSC))
+
+(RPAQ? POSTSCRIPTFONTCOERCIONS

+       '((HELVETICA (HELVETICA 1))
+         (HELVETICAD (HELVETICA 1))
+         (TIMESROMAN (TIMES 1))
+         (TIMESROMAND (TIMES 1))
+         (COURIER (COURIER 1))
+         (GACHA (COURIER 1))
+         (CLASSIC (NEWCENTURYSCHLBK 1))
+         (MODERN (HELVETICA 1))
+         (CREAM (HELVETICA 1))
+         (TERMINAL (COURIER 1))
+         (LOGO (HELVETICA 1))
+         (OPTIMA (PALATINO 1))
+         (TITAN (COURIER 1))
+         (* (* 1))))
+
 (RPAQ? \POSTSCRIPT.MAX.WILD.FONTSIZE
 72)
 (DEFINEQ
 
@@ -4364,7 +4374,7 @@
 
 (ADDTOVAR PRINTFILETYPES
 (POSTSCRIPT (TEST POSTSCRIPTFILEP)
                                 (EXTENSION (PS PSC PSF))
-                                (CONVERSION (TEXT POSTSCRIPT.TEXT TEDIT POSTSCRIPT.TEDIT))))
+                                (CONVERSION (TEXT POSTSCRIPT.TEXT TEDIT TEDIT.TO.IMAGEFILE))))
 
 (ADDTOVAR IMAGESTREAMTYPES
 (POSTSCRIPT (OPENSTREAM OPENPOSTSCRIPTSTREAM)
                                   (FONTCREATE POSTSCRIPT.FONTCREATE)
@@ -4414,39 +4424,39 @@
 (ADDTOVAR LAMA
 POSTSCRIPT.PUTCOMMAND)
 )
 (DECLARE%: DONTCOPY
-  (FILEMAP (NIL (22458 32954 (POSTSCRIPT.INIT 22468 . 29560) (POSTSCRIPT.PUTRGBCOLOR 29562 . 30584) (
-\PSC.COLOR.TO.RGB 30586 . 32952)) (33940 69653 (PSCFONT.READFONT 33950 . 35858) (PSCFONT.SPELLFILE 
-35860 . 36557) (PSCFONT.COERCEFILE 36559 . 38131) (PSCFONTFROMCACHE.SPELLFILE 38133 . 39118) (
-PSCFONTFROMCACHE.COERCEFILE 39120 . 40772) (PSCFONT.WRITEFONT 40774 . 41789) (READ-AFM-FILE 41791 . 
-47662) (CONVERT-AFM-FILES 47664 . 48876) (POSTSCRIPT.GETFONTID 48878 . 50273) (POSTSCRIPT.FONTCREATE 
-50275 . 62428) (\POSTSCRIPT.SPECIALFONT.SCALEDWIDTHS 62430 . 64827) (POSTSCRIPT.FONTSAVAILABLE 64829
- . 68595) (POSTSCRIPT.FONTEXISTS? 68597 . 69651)) (70208 79493 (OPENPOSTSCRIPTSTREAM 70218 . 79159) (
-CLOSEPOSTSCRIPTSTREAM 79161 . 79491)) (79538 85592 (POSTSCRIPT.HARDCOPYW 79548 . 82655) (
-POSTSCRIPT.TEDIT 82657 . 83141) (POSTSCRIPT.TEXT 83143 . 83434) (POSTSCRIPTFILEP 83436 . 84543) (
-MAKEEPSFILE 84545 . 85590)) (85593 129167 (POSTSCRIPT.BITMAPSCALE 85603 . 88059) (
-POSTSCRIPT.CLOSESTRING 88061 . 88614) (POSTSCRIPT.ENDPAGE 88616 . 89507) (POSTSCRIPT.OUTSTR 89509 . 
-90726) (POSTSCRIPT.PUTBITMAPBYTES 90728 . 99199) (POSTSCRIPT.PUTCOMMAND 99201 . 100190) (
-POSTSCRIPT.SET-FAKE-LANDSCAPE 100192 . 104712) (POSTSCRIPT.SHOWACCUM 104714 . 106869) (
-POSTSCRIPT.STARTPAGE 106871 . 109403) (\POSTSCRIPTTAB 109405 . 110202) (\PS.BOUTFIXP 110204 . 111484) 
-(\PS.SCALEHACK 111486 . 114129) (\PS.SCALEREGION 114131 . 114691) (\SCALEDBITBLT.PSC 114693 . 119003) 
-(\SETPOS.PSC 119005 . 119486) (\SETXFORM.PSC 119488 . 122072) (\STRINGWIDTH.PSC 122074 . 122547) (
-\SWITCHFONTS.PSC 122549 . 128041) (\TERPRI.PSC 128043 . 129165)) (129202 183400 (\BITBLT.PSC 129212 . 
-129764) (\BLTSHADE.PSC 129766 . 134427) (\CHARWIDTH.PSC 134429 . 134936) (\CREATECHARSET.PSC 134938 . 
-136636) (\DRAWARC.PSC 136638 . 139016) (\DRAWCIRCLE.PSC 139018 . 141269) (\DRAWCURVE.PSC 141271 . 
-145115) (\DRAWELLIPSE.PSC 145117 . 147481) (\DRAWLINE.PSC 147483 . 150223) (\DRAWPOINT.PSC 150225 . 
-150801) (\DRAWPOLYGON.PSC 150803 . 153932) (\DSPBOTTOMMARGIN.PSC 153934 . 154621) (
-\DSPCLIPPINGREGION.PSC 154623 . 155998) (\DSPCOLOR.PSC 156000 . 156931) (\DSPFONT.PSC 156933 . 160570)
- (\DSPLEFTMARGIN.PSC 160572 . 161258) (\DSPLINEFEED.PSC 161260 . 161850) (\DSPPUSHSTATE.PSC 161852 . 
-163312) (\DSPPOPSTATE.PSC 163314 . 166799) (\DSPRESET.PSC 166801 . 167466) (\DSPRIGHTMARGIN.PSC 167468
- . 168157) (\DSPROTATE.PSC 168159 . 169158) (\DSPSCALE.PSC 169160 . 170112) (\DSPSCALE2.PSC 170114 . 
-170954) (\DSPSPACEFACTOR.PSC 170956 . 171877) (\DSPTOPMARGIN.PSC 171879 . 172450) (\DSPTRANSLATE.PSC 
-172452 . 174483) (\DSPXPOSITION.PSC 174485 . 175049) (\DSPYPOSITION.PSC 175051 . 175642) (
-\FILLCIRCLE.PSC 175644 . 177869) (\FILLPOLYGON.PSC 177871 . 181108) (\FIXLINELENGTH.PSC 181110 . 
-182429) (\MOVETO.PSC 182431 . 183201) (\NEWPAGE.PSC 183203 . 183398)) (183456 205479 (
-\POSTSCRIPT.CHANGECHARSET 183466 . 184203) (\POSTSCRIPT.OUTCHARFN 184205 . 196333) (
-\POSTSCRIPT.PRINTSLUG 196335 . 198059) (\POSTSCRIPT.SPECIALOUTCHARFN 198061 . 200412) (\UPDATE.PSC 
-200414 . 201660) (\POSTSCRIPT.ACCENTFN 201662 . 202604) (\POSTSCRIPT.ACCENTPAIR 202606 . 205477)) (
-205577 207222 (\PSC.SPACEDISP 205587 . 205866) (\PSC.SPACEWID 205868 . 206487) (\PSC.SYMBOLS 206489 . 
-207220)) (207331 210322 (\POSTSCRIPT.NSHASH 207341 . 210320)) (255096 255802 (POSTSCRIPTSEND 255106 . 
-255800)))))
+  (FILEMAP (NIL (23388 33596 (POSTSCRIPT.INIT 23398 . 30202) (POSTSCRIPT.PUTRGBCOLOR 30204 . 31226) (
+\PSC.COLOR.TO.RGB 31228 . 33594)) (34582 69900 (PSCFONT.READFONT 34592 . 36500) (PSCFONT.SPELLFILE 
+36502 . 37315) (PSCFONT.COERCEFILE 37317 . 38889) (PSCFONTFROMCACHE.SPELLFILE 38891 . 39876) (
+PSCFONTFROMCACHE.COERCEFILE 39878 . 41530) (PSCFONT.WRITEFONT 41532 . 42547) (READ-AFM-FILE 42549 . 
+48420) (CONVERT-AFM-FILES 48422 . 49634) (POSTSCRIPT.GETFONTID 49636 . 51031) (POSTSCRIPT.FONTCREATE 
+51033 . 63927) (\POSTSCRIPT.SPECIALFONT.SCALEDWIDTHS 63929 . 66326) (POSTSCRIPT.FONTSAVAILABLE 66328
+ . 68511) (POSTSCRIPT.FONTEXISTS? 68513 . 69898)) (69901 79624 (OPENPOSTSCRIPTSTREAM 69911 . 79290) (
+CLOSEPOSTSCRIPTSTREAM 79292 . 79622)) (79669 86491 (POSTSCRIPT.HARDCOPYW 79679 . 82786) (
+POSTSCRIPT.TEDIT 82788 . 83240) (POSTSCRIPT.TEXT 83242 . 83829) (POSTSCRIPTFILEP 83831 . 85319) (
+MAKEEPSFILE 85321 . 86489)) (86492 130066 (POSTSCRIPT.BITMAPSCALE 86502 . 88958) (
+POSTSCRIPT.CLOSESTRING 88960 . 89513) (POSTSCRIPT.ENDPAGE 89515 . 90406) (POSTSCRIPT.OUTSTR 90408 . 
+91625) (POSTSCRIPT.PUTBITMAPBYTES 91627 . 100098) (POSTSCRIPT.PUTCOMMAND 100100 . 101089) (
+POSTSCRIPT.SET-FAKE-LANDSCAPE 101091 . 105611) (POSTSCRIPT.SHOWACCUM 105613 . 107768) (
+POSTSCRIPT.STARTPAGE 107770 . 110302) (\POSTSCRIPTTAB 110304 . 111101) (\PS.BOUTFIXP 111103 . 112383) 
+(\PS.SCALEHACK 112385 . 115028) (\PS.SCALEREGION 115030 . 115590) (\SCALEDBITBLT.PSC 115592 . 119902) 
+(\SETPOS.PSC 119904 . 120385) (\SETXFORM.PSC 120387 . 122971) (\STRINGWIDTH.PSC 122973 . 123446) (
+\SWITCHFONTS.PSC 123448 . 128940) (\TERPRI.PSC 128942 . 130064)) (130101 183957 (\BITBLT.PSC 130111 . 
+130663) (\BLTSHADE.PSC 130665 . 135326) (\CHARWIDTH.PSC 135328 . 135835) (\CREATECHARSET.PSC 135837 . 
+137193) (\DRAWARC.PSC 137195 . 139573) (\DRAWCIRCLE.PSC 139575 . 141826) (\DRAWCURVE.PSC 141828 . 
+145672) (\DRAWELLIPSE.PSC 145674 . 148038) (\DRAWLINE.PSC 148040 . 150780) (\DRAWPOINT.PSC 150782 . 
+151358) (\DRAWPOLYGON.PSC 151360 . 154489) (\DSPBOTTOMMARGIN.PSC 154491 . 155178) (
+\DSPCLIPPINGREGION.PSC 155180 . 156555) (\DSPCOLOR.PSC 156557 . 157488) (\DSPFONT.PSC 157490 . 161127)
+ (\DSPLEFTMARGIN.PSC 161129 . 161815) (\DSPLINEFEED.PSC 161817 . 162407) (\DSPPUSHSTATE.PSC 162409 . 
+163869) (\DSPPOPSTATE.PSC 163871 . 167356) (\DSPRESET.PSC 167358 . 168023) (\DSPRIGHTMARGIN.PSC 168025
+ . 168714) (\DSPROTATE.PSC 168716 . 169715) (\DSPSCALE.PSC 169717 . 170669) (\DSPSCALE2.PSC 170671 . 
+171511) (\DSPSPACEFACTOR.PSC 171513 . 172434) (\DSPTOPMARGIN.PSC 172436 . 173007) (\DSPTRANSLATE.PSC 
+173009 . 175040) (\DSPXPOSITION.PSC 175042 . 175606) (\DSPYPOSITION.PSC 175608 . 176199) (
+\FILLCIRCLE.PSC 176201 . 178426) (\FILLPOLYGON.PSC 178428 . 181665) (\FIXLINELENGTH.PSC 181667 . 
+182986) (\MOVETO.PSC 182988 . 183758) (\NEWPAGE.PSC 183760 . 183955)) (184013 206159 (
+\POSTSCRIPT.CHANGECHARSET 184023 . 184741) (\POSTSCRIPT.OUTCHARFN 184743 . 197013) (
+\POSTSCRIPT.PRINTSLUG 197015 . 198739) (\POSTSCRIPT.SPECIALOUTCHARFN 198741 . 201092) (\UPDATE.PSC 
+201094 . 202340) (\POSTSCRIPT.ACCENTFN 202342 . 203284) (\POSTSCRIPT.ACCENTPAIR 203286 . 206157)) (
+206257 207902 (\PSC.SPACEDISP 206267 . 206546) (\PSC.SPACEWID 206548 . 207167) (\PSC.SYMBOLS 207169 . 
+207900)) (208011 211002 (\POSTSCRIPT.NSHASH 208021 . 211000)) (256412 257118 (POSTSCRIPTSEND 256422 . 
+257116)))))
 STOP
diff --git a/library/POSTSCRIPTSTREAM.LCOM b/library/POSTSCRIPTSTREAM.LCOM
index b96019038..c29c0a4f8 100644
Binary files a/library/POSTSCRIPTSTREAM.LCOM and b/library/POSTSCRIPTSTREAM.LCOM differ
diff --git a/library/UNICODE b/library/UNICODE
index 3c917000f..f091f2894 100644
--- a/library/UNICODE
+++ b/library/UNICODE
@@ -1,13 +1,14 @@
 (DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
 
-
(FILECREATED "31-Jan-2025 17:47:03" {WMEDLEY}<library>UNICODE.;128
 98991  
+
(FILECREATED "11-Oct-2025 13:01:09" {WMEDLEY}<library>UNICODE.;179
 113928 
 
       :EDIT-BY rmk
 
-      :CHANGES-TO (FNS READ-UNICODE-MAPPING MERGE-UNICODE-TRANSLATION-TABLES 
-                       MAKE-UNICODE-TRANSLATION-TABLES ALL-UNICODE-MAPPINGS)
+      :CHANGES-TO (VARS UNICODECOMS)
+                  (FNS XCCSTOMCCS-MAPPING READ-UNICODE-MAPPING MAKE-UNICODE-TRANSLATION-TABLES 
+                       MERGE-UNICODE-TRANSLATION-TABLES UNICODE-EXTEND-TRANSLATION?)
 
-      :PREVIOUS-DATE "27-Jan-2025 16:46:36" {WMEDLEY}<library>UNICODE.;127)
+      :PREVIOUS-DATE " 5-Oct-2025 17:44:17" {WMEDLEY}<library>UNICODE.;174)
 
 
 (PRETTYCOMPRINT UNICODECOMS)
@@ -24,10 +25,11 @@
               (P (MAKE-UNICODE-FORMATS EXTERNALEOL))
               (ADDVARS (*DEFAULT-EXTERNALFORMATS* (UNIX :UTF-8)))
               (FNS UTF8.BINCODE \UTF8.FETCHCODE)
-              (FNS UTF8.VALIDATE UTF8-SIZE-FROM-BYTE1 NUTF8-BYTE1-BYTES NUTF8-CODE-BYTES 
-                   NUTF8-STRING-BYTES)
+              (FNS UTF8.VALIDATE NUTF8-BYTE1-BYTES NUTF8-CODE-BYTES NUTF8-STRING-BYTES N-MCHARS)
               (DECLARE%: EVAL@COMPILE DONTCOPY (MACROS UNICODE.TRANSLATE \UTF8.GETBASEBYTE))
-              (FNS XTOUCODE UTOXCODE XTOUCODE? UTOXCODE?))
+              (FNS MTOUCODE UTOMCODE MTOUCODE? UTOMCODE? MTOUSTRING UTOMSTRING MTOUTF8STRING 
+                   UTF8TOMSTRING)
+              (FNS XTOUCODE UTOXCODE XTOUCODE? UTOXCODE? XTOUSTRING UTOXSTRING XTOUTF8STRING))
         
         (* ;; "")

 
@@ -37,23 +39,23 @@
               (FNS READ-UNICODE-MAPPING-FILENAMES READ-UNICODE-MAPPING))
         [COMS                                                (* ; 
 
                                                  "Make translation tables for  UTF external formats")

-              (FNS MAKE-UNICODE-TRANSLATION-TABLES MERGE-UNICODE-TRANSLATION-TABLES UNICODE.UNMAPPED
-                   UNICODE-EXTEND-TRANSLATION?)
-              (FNS ALL-UNICODE-MAPPINGS)
-              (INITVARS (*XCCSTOUNICODE*)
-                     (*UNICODETOXCCS*)
-                     (*XCCS-LOADED-CHARSETS*)
+              (FNS MAKE-UNICODE-TRANSLATION-TABLES XCCSTOMCCS-MAPPING 
+                   MERGE-UNICODE-TRANSLATION-TABLES UNICODE.UNMAPPED UNICODE-EXTEND-TRANSLATION?)
+              (FNS ALL-UNICODE-MAPPINGS XCCSJAPANESECHARSETS)
+              (INITVARS (*MCCSTOUNICODE*)
+                     (*UNICODETOMCCS*)
+                     (*MCCS-LOADED-CHARSETS*)
                      (*UNICODE-LOADED-CHARSETS*))
-              (GLOBALVARS *XCCSTOUNICODE* *UNICODETOXCCS* *NEXT-PRIVATE-UNICODE* 
-                     *NEXT-PRIVATE-XCCSCODE* *XCCS-LOADED-CHARSETS* *UNICODE-LOADED-CHARSETS*)
+              (GLOBALVARS *MCCSTOUNICODE* *UNICODETOMCCS* *NEXT-PRIVATE-UNICODE* 
+                     *NEXT-PRIVATE-MCCSCODE* *MCCS-LOADED-CHARSETS* *UNICODE-LOADED-CHARSETS*)
               (DECLARE%: EVAL@COMPILE DONTCOPY 
 
                      (* ;; "There are 6400 private Unicodes in 25 256-code charsets. For XCCS we map to a contiguous region of unused/reserved--private isn't big enough.")

 
                      (CONSTANTS (FIRST-PRIVATE-UNICODE (HEXNUM? "E000"))
                             (LAST-PRIVATE-UNICODE (HEXNUM? "F8FF"))
-                            (FIRST-PRIVATE-XCCSCODE (CHARCODE "200,0"))
-                            (LAST-PRIVATE-XCCSCODE (CHARCODE "230,377")))
+                            (FIRST-PRIVATE-MCCSCODE (CHARCODE "200,0"))
+                            (LAST-PRIVATE-MCCSCODE (CHARCODE "230,377")))
                      (MACROS TRUECODEP))
               (DECLARE%: DONTEVAL@LOAD DOCOPY (P (MAKE-UNICODE-TRANSLATION-TABLES 'ALL]
         
@@ -61,7 +63,7 @@
 
         (COMS                                                (* ; "Write Unicode mapping files")

               (FNS WRITE-UNICODE-MAPPING WRITE-UNICODE-INCLUDED WRITE-UNICODE-MAPPING-HEADER 
-                   WRITE-UNICODE-MAPPING-FILENAME HEXSTRING)
+                   WRITE-UNICODE-MAPPING-FILENAME)
               (FNS XCCS-UTF8-AFTER-OPEN)
               
               (* ;; "Automate dumping of a documentation prefix")

@@ -71,7 +73,7 @@
                                                       (UNDEFINEDCODE (CL:PARSE-INTEGER "FFFF" :RADIX
                                                                             16]
               (VARS UNICODE-MAPPING-HEADER))
-        (FNS UTF8HEXSTRING XTOUSTRING XCCSSTRING)
+        (FNS UTF8HEXSTRING)
         (COMS                                                (* ; "debugging")

               (FNS SHOWCHARS)
               (DECLARE%: DOEVAL@LOAD DONTCOPY (MACROS HEXCHAR OCTALCHAR)))
@@ -87,7 +89,8 @@
 (DEFINEQ
 
 (UTF8.OUTCHARFN

-  [LAMBDA (STREAM CHARCODE RAW)
                              (* ; "Edited 20-Jan-2025 20:45 by rmk")


+  [LAMBDA (STREAM CHARCODE RAW)
                              (* ; "Edited 24-Apr-2025 15:43 by rmk")


+                                                             (* ; "Edited 20-Jan-2025 20:45 by rmk")


                                                              (* ; "Edited 31-Jan-2024 00:32 by rmk")


                                                             (* ; "Edited  8-Aug-2021 13:02 by rmk:")


                                                             (* ; "Edited 17-Aug-2020 08:45 by rmk:")


@@ -95,7 +98,7 @@
 
     (* ;; "Perhaps the translation table should already do the mapping for EOL to LF, but that seems to be a separate property of the stream. Also, CRLF=2 bytes.")

 
-    (* ;; "Print UTF8 sequence for CHARCODE.  Do not do XCCS to Unicode translation if RAW.")

+    (* ;; "Print UTF8 sequence for CHARCODE.  Do not do MCCS to Unicode translation if RAW.")

 
     (IF
 (EQ CHARCODE (CHARCODE EOL))
         THEN
 (FREPLACE
 (STREAM CHARPOSITION) OF
 STREAM WITH
 0)
@@ -104,7 +107,7 @@
                   (IPLUS16 1 DATUM))
            (FOR
 C INSIDE
 (CL:IF RAW
                              CHARCODE
-                             (UNICODE.TRANSLATE CHARCODE *XCCSTOUNICODE*))
+                             (UNICODE.TRANSLATE CHARCODE *MCCSTOUNICODE*))
               DO
 (IF
 (ILESSP C 128)
                      THEN
 (\BOUT STREAM C)
                    ELSEIF
 (ILESSP C 2048)
@@ -134,10 +137,11 @@
                    ELSE
 (ERROR "CHARCODE too big for UTF8" C])
 
 (UTF8.SLUG.OUTCHARFN

-  [LAMBDA (STREAM CODE RAW)
                                  (* ; "Edited 21-Jan-2025 18:37 by rmk")


+  [LAMBDA (STREAM CODE RAW)
                                  (* ; "Edited 24-Apr-2025 15:43 by rmk")


+                                                             (* ; "Edited 21-Jan-2025 18:37 by rmk")


                                                              (* ; "Edited 14-Jan-2025 12:39 by rmk")

 
-    (* ;; "Produces Unicode Representative FFFD as a slug for XCCS unmapped characters")

+    (* ;; "Produces Unicode Representative FFFD as a slug for MCCS unmapped characters")

 
     (UTF8.OUTCHARFN
 STREAM (OR (CL:IF RAW
                                    CODE
@@ -146,12 +150,13 @@
            T])
 
 (UTF8.INCCODEFN

-  [LAMBDA (STREAM COUNTP RAW)
                                (* ; "Edited  2-Feb-2024 11:44 by rmk")


+  [LAMBDA (STREAM COUNTP RAW)
                                (* ; "Edited 24-Apr-2025 15:44 by rmk")


+                                                             (* ; "Edited  2-Feb-2024 11:44 by rmk")


                                                              (* ; "Edited 30-Jan-2024 22:56 by rmk")


                                                             (* ; "Edited  6-Aug-2021 16:02 by rmk:")


                                                             (* ; "Edited  6-Aug-2020 17:13 by rmk:")

 
-    (* ;; "Do not do UNICODE to XCSS translation if RAW.")

+    (* ;; "Do not do UNICODE to MCSS translation if RAW.")

 
     (* ;; "Test for smallp because the stream's End-of-file operation may suppress the error")

 
@@ -231,19 +236,20 @@
                                             6)
                                       (LOADBYTE BYTE4 0 6])
          (CL:UNLESS (OR RAW (NOT (SMALLP CODE)))
-             (SETQ CODE (UNICODE.TRANSLATE CODE *UNICODETOXCCS*)))
+             (SETQ CODE (UNICODE.TRANSLATE CODE *UNICODETOMCCS*)))
          (CL:WHEN COUNTP (SETQ *BYTECOUNTER* COUNT))
          CODE])
 
 (UTF8.PEEKCCODEFN

-  [LAMBDA (STREAM NOERROR RAW)
                               (* ; "Edited  2-Feb-2024 11:48 by rmk")


+  [LAMBDA (STREAM NOERROR RAW)
                               (* ; "Edited 24-Apr-2025 15:44 by rmk")


+                                                             (* ; "Edited  2-Feb-2024 11:48 by rmk")


                                                             (* ; "Edited 14-Jun-2021 22:53 by rmk:")

 
     (* ;; "Modeled this after \EUCPEEK on LLREAD.  In the multi-byte (non-ASCII) case, backs the file pointer to the beginning by the proper number of \BACKFILEPTRs, and returns a count of 0.  Returns NIL if NOERROR and either invalid UTF8 or end of file.")

 
     (* ;; "Could be that the caller takes care of backing up the file position if the number of binned-bytes is returned.")

 
-    (* ;; "Do not do UNICODE to XCCS translation if RAW")

+    (* ;; "Do not do UNICODE to MCCS translation if RAW")

 
     (PROG (BYTE1 BYTE2 BYTE3 BYTE4 CODE)
           (SETQ BYTE1 (\PEEKBIN STREAM NOERROR))
@@ -318,7 +324,7 @@
                    elseif
 NOERROR
                    else
 (ERROR "INVALID UTF8 SEQUENCE" (LIST BYTE1 BYTE2 BYTE3 BYTE4]
           (CL:WHEN (AND CODE (NOT RAW))
-              (SETQ CODE (UNICODE.TRANSLATE CODE *UNICODETOXCCS*)))
+              (SETQ CODE (UNICODE.TRANSLATE CODE *UNICODETOMCCS*)))
           (RETURN CODE])
 
 (\UTF8.BACKCCODEFN

@@ -340,11 +346,12 @@
 (DEFINEQ
 
 (UTF16BE.OUTCHARFN

-  [LAMBDA (STREAM CHARCODE RAW)
                              (* ; "Edited 31-Jan-2024 00:32 by rmk")


+  [LAMBDA (STREAM CHARCODE RAW)
                              (* ; "Edited 24-Apr-2025 15:44 by rmk")


+                                                             (* ; "Edited 31-Jan-2024 00:32 by rmk")


                                                             (* ; "Edited  8-Aug-2021 13:09 by rmk:")


                                                             (* ; "Edited 30-Jan-2020 23:08 by rmk:")

 
-    (* ;; "PRINT UTF16 sequence for CHARCODE.  Do not do XCCS to UNICODE translation if RAW.")

+    (* ;; "PRINT UTF16 sequence for CHARCODE.  Do not do MCCS to UNICODE translation if RAW.")

 
     (* ;; "Not sure about EOL conversion if truly %"raw%"")

 
@@ -354,14 +361,15 @@
                   (IPLUS16 1 DATUM)))
     (FOR
 C INSIDE
 (CL:IF RAW
                       CHARCODE
-                      (UNICODE.TRANSLATE CHARCODE *XCCSTOUNICODE*)) DO
 (\WOUT STREAM C])
+                      (UNICODE.TRANSLATE CHARCODE *MCCSTOUNICODE*)) DO
 (\WOUT STREAM C])
 
 (UTF16BE.INCCODEFN

-  [LAMBDA (STREAM COUNTP RAW)
                                (* ; "Edited 10-Mar-2024 12:00 by rmk")


+  [LAMBDA (STREAM COUNTP RAW)
                                (* ; "Edited 24-Apr-2025 15:45 by rmk")


+                                                             (* ; "Edited 10-Mar-2024 12:00 by rmk")


                                                             (* ; "Edited  6-Aug-2021 16:05 by rmk:")

 
     (* ;; 
-
    "Do not do UNICODE to XCCS translation if RAW.  Test for SMALLPin case of funky EOF behavior")

+
    "Do not do UNICODE to MCCS translation if RAW.  Test for SMALLPin case of funky EOF behavior")

 
     (DECLARE
 (USEDFREE *BYTECOUNTER*))
     (LET (CODE BYTE1 BYTE2 COUNT)
@@ -372,18 +380,19 @@
                                     HIBYTE _ (\BIN STREAM)
                                     LOBYTE _ (\BIN STREAM)))
                   (CL:UNLESS RAW
-                      (SETQ CODE (UNICODE.TRANSLATE CODE *UNICODETOXCCS*)))
+                      (SETQ CODE (UNICODE.TRANSLATE CODE *UNICODETOMCCS*)))
                   (CL:WHEN COUNTP (SETQ *BYTECOUNTER* COUNT))
                   CODE
            ELSE
 (ERROR "ODD NUMBER OF BYTES IN UTF16 FILE" STREAM])
 
 (UTF16BE.PEEKCCODEFN

-  [LAMBDA (STREAM NOERROR RAW)
                               (* ; "Edited 10-Mar-2024 12:01 by rmk")


+  [LAMBDA (STREAM NOERROR RAW)
                               (* ; "Edited 24-Apr-2025 15:45 by rmk")


+                                                             (* ; "Edited 10-Mar-2024 12:01 by rmk")


                                                             (* ; "Edited 14-Jun-2021 22:58 by rmk:")

 
     (* ;; "Could be that the caller takes care of backing up the file position if the number of binned-bytes is returned.")

 
-    (* ;; "Do not do UNICODE to XCCS translation if RAW")

+    (* ;; "Do not do UNICODE to MCCS translation if RAW")

 
     (LET (BYTE1 BYTE2 CODE)
          (SETQ BYTE1 (\PEEKBIN STREAM NOERROR))
@@ -397,7 +406,7 @@
                                              LOBYTE _ BYTE2))
                            (CL:IF RAW
                                CODE
-                               (UNICODE.TRANSLATE CODE *UNICODETOXCCS*))
+                               (UNICODE.TRANSLATE CODE *UNICODETOMCCS*))
                     ELSEIF
 NOERROR
                       THEN
 NIL)
            ELSEIF
 NOERROR
@@ -405,7 +414,8 @@
            ELSE
 (ERROR "INVALID UTF16 CHARACTER" (LIST BYTE1 BYTE2])
 
 (\UTF16BE.BACKCCODEFN

-  [LAMBDA (STREAM COUNTP RAW)
                                (* ; "Edited 10-Mar-2024 12:02 by rmk")


+  [LAMBDA (STREAM COUNTP RAW)
                                (* ; "Edited 24-Apr-2025 15:28 by rmk")


+                                                             (* ; "Edited 10-Mar-2024 12:02 by rmk")


                                                              (* ; "Edited 19-Jul-2022 15:14 by rmk")


                                                             (* ; "Edited  6-Aug-2021 16:07 by rmk:")

 
@@ -421,7 +431,7 @@
                                         LOBYTE _ BYTE2))
                       (CL:IF RAW
                           CODE
-                          (UNICODE.TRANSLATE CODE *UNICODETOXCCS*))
+                          (UNICODE.TRANSLATE CODE *UNICODETOMCCS*))
                ELSEIF
 COUNTP
                  THEN
 (SETQ *BYTECOUNTER* -1)
                       NIL)))])
@@ -429,11 +439,12 @@
 (DEFINEQ
 
 (UTF16LE.OUTCHARFN

-  [LAMBDA (STREAM CHARCODE RAW)
                              (* ; "Edited 10-Mar-2024 11:58 by rmk")


+  [LAMBDA (STREAM CHARCODE RAW)
                              (* ; "Edited 24-Apr-2025 15:45 by rmk")


+                                                             (* ; "Edited 10-Mar-2024 11:58 by rmk")


                                                             (* ; "Edited  8-Aug-2021 13:09 by rmk:")


                                                             (* ; "Edited 30-Jan-2020 23:08 by rmk:")

 
-    (* ;; "PRINT UTF16 sequence for CHARCODE.  Do not do XCCS to UNICODE translation if RAW.")

+    (* ;; "PRINT UTF16 sequence for CHARCODE.  Do not do MCCS to UNICODE translation if RAW.")

 
     (* ;; "Not sure about EOL conversion if truly %"raw%"")

 
@@ -443,16 +454,17 @@
                   (IPLUS16 1 DATUM)))
     (FOR
 C INSIDE
 (CL:IF RAW
                       CHARCODE
-                      (UNICODE.TRANSLATE CHARCODE *XCCSTOUNICODE*))
+                      (UNICODE.TRANSLATE CHARCODE *MCCSTOUNICODE*))
        DO
 (BOUT STREAM (fetch
 LOBYTE of
 CHARCODE))
           (BOUT STREAM (fetch
 HIBYTE of
 CHARCODE])
 
 (UTF16LE.INCCODEFN

-  [LAMBDA (STREAM COUNTP RAW)
                                (* ; "Edited 10-Mar-2024 12:03 by rmk")


+  [LAMBDA (STREAM COUNTP RAW)
                                (* ; "Edited 24-Apr-2025 15:45 by rmk")


+                                                             (* ; "Edited 10-Mar-2024 12:03 by rmk")


                                                             (* ; "Edited  6-Aug-2021 16:05 by rmk:")

 
     (* ;; 
-
    "Do not do UNICODE to XCCS translation if RAW.  Test for SMALLPin case of funky EOF behavior")

+
    "Do not do UNICODE to MCCS translation if RAW.  Test for SMALLPin case of funky EOF behavior")

 
     (DECLARE
 (USEDFREE *BYTECOUNTER*))
     (LET (CODE BYTE1 BYTE2 COUNT)
@@ -463,18 +475,19 @@
                                     LOBYTE _ (\BIN STREAM)
                                     HIBYTE _ (\BIN STREAM)))
                   (CL:UNLESS RAW
-                      (SETQ CODE (UNICODE.TRANSLATE CODE *UNICODETOXCCS*)))
+                      (SETQ CODE (UNICODE.TRANSLATE CODE *UNICODETOMCCS*)))
                   (CL:WHEN COUNTP (SETQ *BYTECOUNTER* COUNT))
                   CODE
            ELSE
 (ERROR "ODD NUMBER OF BYTES IN UTF16 FILE" STREAM])
 
 (UTF16LE.PEEKCCODEFN

-  [LAMBDA (STREAM NOERROR RAW)
                               (* ; "Edited 10-Mar-2024 11:43 by rmk")


+  [LAMBDA (STREAM NOERROR RAW)
                               (* ; "Edited 24-Apr-2025 15:46 by rmk")


+                                                             (* ; "Edited 10-Mar-2024 11:43 by rmk")


                                                             (* ; "Edited 14-Jun-2021 22:58 by rmk:")

 
     (* ;; "Could be that the caller takes care of backing up the file position if the number of binned-bytes is returned.")

 
-    (* ;; "Do not do UNICODE to XCCS translation if RAW")

+    (* ;; "Do not do UNICODE to MCCS translation if RAW")

 
     (LET (BYTE1 BYTE2 CODE)
          (SETQ BYTE1 (\PEEKBIN STREAM NOERROR))
@@ -487,7 +500,7 @@
                                              BYTE1))
                            (CL:IF RAW
                                CODE
-                               (UNICODE.TRANSLATE CODE *UNICODETOXCCS*))
+                               (UNICODE.TRANSLATE CODE *UNICODETOMCCS*))
                     ELSEIF
 NOERROR
                       THEN
 NIL)
            ELSEIF
 NOERROR
@@ -495,7 +508,8 @@
            ELSE
 (ERROR "INVALID UTF16 CHARACTER" (LIST BYTE1 BYTE2])
 
 (\UTF16LE.BACKCCODEFN

-  [LAMBDA (STREAM COUNTP RAW)
                                (* ; "Edited 10-Mar-2024 12:04 by rmk")


+  [LAMBDA (STREAM COUNTP RAW)
                                (* ; "Edited 24-Apr-2025 15:28 by rmk")


+                                                             (* ; "Edited 10-Mar-2024 12:04 by rmk")


                                                              (* ; "Edited 19-Jul-2022 15:14 by rmk")


                                                             (* ; "Edited  6-Aug-2021 16:07 by rmk:")

 
@@ -511,7 +525,7 @@
                                         LOBYTE _ (\PEEKBIN STREAM)))
                       (CL:IF RAW
                           CODE
-                          (UNICODE.TRANSLATE CODE *UNICODETOXCCS*))
+                          (UNICODE.TRANSLATE CODE *UNICODETOMCCS*))
                ELSEIF
 COUNTP
                  THEN
 (SETQ *BYTECOUNTER* -1)
                       NIL)))])
@@ -647,7 +661,8 @@
 (DEFINEQ
 
 (UTF8.BINCODE

-  [LAMBDA (STREAM RAW)
                                       (* ; "Edited  4-Feb-2024 01:06 by rmk")


+  [LAMBDA (STREAM RAW)
                                       (* ; "Edited 24-Apr-2025 15:28 by rmk")


+                                                             (* ; "Edited  4-Feb-2024 01:06 by rmk")


                                                              (* ; "Edited  1-Feb-2024 11:21 by rmk")


                                                              (* ; "Edited 28-Dec-2023 13:32 by rmk")


                                                             (* ; "Edited  6-Aug-2021 16:02 by rmk:")


@@ -691,7 +706,7 @@
                                          0 6]
          (CL:IF RAW
              CODE
-             (UNICODE.TRANSLATE CODE *UNICODETOXCCS*))])
+             (UNICODE.TRANSLATE CODE *UNICODETOMCCS*))])
 
 (\UTF8.FETCHCODE

   [LAMBDA (CODESIZE BUFFER BYTEOFFSET)
                       (* ; "Edited 28-Dec-2023 13:32 by rmk")


@@ -775,19 +790,6 @@
                                   (ILESSP BYTE 128)))
                       4)))])
 
-(UTF8-SIZE-FROM-BYTE1

-  [LAMBDA (BYTE1)
                                            (* ; "Edited  2-Feb-2024 11:50 by rmk")

-
-    (* ;; "Returns the number of bytes of a UTF-8 code, given that BYTE1 is the first (header) byte of the sequence.")

-
-    (if
 (ILEQ BYTE1 127)
-        then
 1
-      elseif
 (ILEQ BYTE1 223)
-        then
 2
-      elseif
 (ILEQ BYTE1 239)
-        then
 3
-      else
 4])
-
 (NUTF8-BYTE1-BYTES

   [LAMBDA (BYTE1)
                                            (* ; "Edited  3-Feb-2024 15:00 by rmk")


                                                              (* ; "Edited  8-Jan-2024 10:57 by rmk")


@@ -826,14 +828,23 @@
       ELSE
 (ERROR "INVALID UTF-8 CODE"])
 
 (NUTF8-STRING-BYTES

-  [LAMBDA (STRING RAW)
                                       (* ; "Edited  3-Feb-2024 21:32 by rmk")


+  [LAMBDA (STRING RAW)
                                       (* ; "Edited  2-Sep-2025 10:40 by rmk")


+                                                             (* ; "Edited 24-Apr-2025 15:37 by rmk")


+                                                             (* ; "Edited  3-Feb-2024 21:32 by rmk")


                                                             (* ; "Edited 10-Aug-2020 09:06 by rmk:")

 
-    (* ;; "Returns the number of bytes it would take to represent STRING in UTF8, assuming it is an XCCS string unless RAWFLG. ")

+    (* ;; "Returns the number of bytes it would take to represent STRING in UTF8, assuming it is an MCCS string unless RAWFLG. ")

 
-    (FOR
 I C FROM
 1 WHILE
 (SETQ C (NTHCHARCODE STRING I)) SUM
 (NUTF8-CODE-BYTES
 (CL:IF RAW
+    (for
 I C from
 1 while
 (SETQ C (NTHCHARCODE STRING I)) sum
 (NUTF8-CODE-BYTES
 (CL:IF RAW
                                                                                     C
-                                                                                    (XTOUCODE
 C))])
+                                                                                    (MTOUCODE
 C))])
+
+(N-MCHARS

+  [LAMBDA (UTF8STRING)
                                       (* ; "Edited  9-Sep-2025 08:35 by rmk")

+
+    (* ;; "Returns the number of MCCS characters coded in UTF8STRING")

+
+    (for
 I B from
 1 while
 (SETQ B (NTHCHARCODE UTF8STRING I)) by
 (NUTF8-BYTE1-BYTES
 B) count
 T])
 )
 (DECLARE%: EVAL@COMPILE DONTCOPY 
 (DECLARE%: EVAL@COMPILE 
@@ -865,17 +876,168 @@
 )
 (DEFINEQ
 
+(MTOUCODE

+  [LAMBDA (MCODE)
                                            (* ; "Edited  4-Sep-2025 15:10 by rmk")


+                                                             (* ; "Edited 24-Apr-2025 10:19 by rmk")


+                                                            (* ; "Edited  9-Aug-2020 09:04 by rmk:")

+    (UNICODE.TRANSLATE MCODE *MCCSTOUNICODE*])
+
+(UTOMCODE

+  [LAMBDA (UNNICODE)
                                         (* ; "Edited 24-Apr-2025 10:17 by rmk")


+                                                             (* ; "Edited 16-Jan-2025 23:46 by rmk")


+                                                            (* ; "Edited  9-Aug-2020 09:04 by rmk:")

+    (UNICODE.TRANSLATE UNNICODE *UNICODETOMCCS*])
+
+(MTOUCODE?

+  [LAMBDA (MCODE)
                                            (* ; "Edited  4-Sep-2025 15:09 by rmk")


+                                                             (* ; "Edited 24-Apr-2025 10:18 by rmk")


+                                                             (* ; "Edited 20-Jan-2025 20:38 by rmk")


+                                                             (* ; "Edited 18-Jan-2025 11:44 by rmk")


+                                                             (* ; "Edited 15-Jan-2025 19:51 by rmk")


+                                                             (* ; "Edited 14-Jan-2025 13:14 by rmk")


+                                                            (* ; "Edited  9-Aug-2020 09:04 by rmk:")

+
+    (* ;; "Returns the Unix range-code(s) corresponding to MCODE if there are true mapppings, otherwise NIL.  Alternative codes are returned in a list, the code itself is returned for a singleton.")

+
+    (UNICODE.TRANSLATE MCODE *MCCSTOUNICODE* T T])
+
+(UTOMCODE?

+  [LAMBDA (UNICODE)
                                          (* ; "Edited 24-Apr-2025 10:18 by rmk")


+                                                             (* ; "Edited 19-Jan-2025 21:14 by rmk")


+                                                             (* ; "Edited 18-Jan-2025 11:46 by rmk")


+                                                             (* ; "Edited 15-Jan-2025 19:51 by rmk")


+                                                             (* ; "Edited 14-Jan-2025 13:14 by rmk")


+                                                            (* ; "Edited  9-Aug-2020 09:04 by rmk:")

+
+    (* ;; "Returns the MCCS range-code(s) corresponding to UNICODE if there are true mapppings, otherwise NIL.  ")

+
+    (* ;; 
+
    " NOTE:  Alternative codes are returned in a list, the code itself is returned for a singleton.")

+
+    (UNICODE.TRANSLATE UNICODE *UNICODETOMCCS* T T])
+
+(MTOUSTRING

+  [LAMBDA (MSTRING DESTRUCTIVE)
                              (* ; "Edited  2-Sep-2025 12:19 by rmk")


+                                                             (* ; "Edited 29-Apr-2025 12:01 by rmk")

+
+    (* ;; "Converts MCCS codes in MSTRING to Unicodes.")

+
+    (for
 I MCODE (USTRING _ (CL:IF DESTRUCTIVE
+                                MSTRING
+                                (CONCAT MSTRING))) from
 1 while
 (SETQ MCODE (NTHCHARCODE MSTRING I))
+       do
 (RPLCHARCODE USTRING I (MTOUCODE
 MCODE)) finally
 (RETURN USTRING])
+
+(UTOMSTRING

+  [LAMBDA (USTRING DESTRUCTIVE)
                              (* ; "Edited  2-Sep-2025 12:18 by rmk")


+                                                             (* ; "Edited 29-Apr-2025 12:00 by rmk")

+
+    (* ;; "Converts Unicodes to MCCS codes in USTRING.")

+
+    (for
 I UCODE (MSTRING _ (CL:IF DESTRUCTIVE
+                                USTRING
+                                (CONCAT USTRING))) from
 1 while
 (SETQ UCODE (NTHCHARCODE USTRING I))
+       do
 (RPLCHARCODE MSTRING I (UTOMCODE
 UCODE)) finally
 (RETURN MSTRING])
+
+(MTOUTF8STRING

+  [LAMBDA (MSTRING)
                                          (* ; "Edited  9-Sep-2025 07:51 by rmk")


+                                                             (* ; "Edited  4-Sep-2025 15:13 by rmk")


+                                                             (* ; "Edited  2-Sep-2025 11:12 by rmk")


+                                                             (* ; "Edited 24-Apr-2025 15:37 by rmk")


+                                                             (* ; "Edited  3-Feb-2024 14:55 by rmk")


+                                                            (* ; "Edited 10-Aug-2020 21:42 by rmk:")

+
+    (* ;; 
+
    "Produces a string that contains the UTF8 bytes that represent the characters in MSTRING.  ")

+
+    (* ;; "The resulting string will not be directly interpretable inside Medley.")

+
+    (if
 (if
 (STRINGP MSTRING)
+            then
 (OR (ffetch
 (STRINGP FATSTRINGP) of
 MSTRING)
+                     (thereis
 C instring
 MSTRING suchthat
 (IGEQ C 128)))
+          elseif
 (LITATOM MSTRING)
+            then
 (OR (ffetch
 (LITATOM FATPNAMEP) of
 MSTRING)
+                     (thereis
 C inatom
 MSTRING suchthat
 (IGEQ C 128)))
+          else
 T)
+        then
 (LET [(USTR (ALLOCSTRING (NUTF8-STRING-BYTES
 MSTRING]
+                  (for
 I UCODE MCODE (SINDEX _ 0) from
 1 while
 (SETQ MCODE (NTHCHARCODE MSTRING I))
+                     do
 (SETQ UCODE (MTOUCODE
 MCODE))
+                        (if
 (ILESSP UCODE 128)
+                            then
 (RPLCHARCODE USTR (ADD
 SINDEX 1)
+                                        UCODE)
+                          elseif
 (ILESSP UCODE 2048)
+                            then
                             (* ; "x800")

+                                 (RPLCHARCODE USTR (ADD
 SINDEX 1)
+                                        (LOGOR (LLSH 3 6)
+                                               (LRSH UCODE 6)))
+                                 (RPLCHARCODE USTR (ADD
 SINDEX 1)
+                                        (LOGOR (LLSH 2 6)
+                                               (LOADBYTE UCODE 0 6)))
+                          elseif
 (ILESSP UCODE 65536)
+                            then
                             (* ; "x10000")

+                                 (RPLCHARCODE USTR (ADD
 SINDEX 1)
+                                        (LOGOR (LLSH 7 5)
+                                               (LRSH UCODE 12)))
+                                 (RPLCHARCODE USTR (ADD
 SINDEX 1)
+                                        (LOGOR (LLSH 2 6)
+                                               (LOADBYTE UCODE 6 6)))
+                                 (RPLCHARCODE USTR (ADD
 SINDEX 1)
+                                        (LOGOR (LLSH 2 6)
+                                               (LOADBYTE UCODE 0 6)))
+                          elseif
 (ILESSP UCODE 2097152)
+                            then
                             (* ; "x200000")

+                                 (RPLCHARCODE USTR (ADD
 SINDEX 1)
+                                        (LOGOR (LLSH 15 4)
+                                               (LRSH UCODE 18)))
+                                 (RPLCHARCODE USTR (ADD
 SINDEX 1)
+                                        (LOGOR (LLSH 2 6)
+                                               (LOADBYTE UCODE 12 6)))
+                                 (RPLCHARCODE USTR (ADD
 SINDEX 1)
+                                        (LOGOR (LLSH 2 6)
+                                               (LOADBYTE UCODE 6 6)))
+                                 (RPLCHARCODE USTR (ADD
 SINDEX 1)
+                                        (LOGOR (LLSH 2 6)
+                                               (LOADBYTE UCODE 0 6)))
+                          else
 (SHOULDNT)))
+                  USTR)
+      else
 MSTRING])
+
+(UTF8TOMSTRING

+  [LAMBDA (UTF8STRING)
                                       (* ; "Edited  9-Sep-2025 08:59 by rmk")

+    (CL:UNLESS (OR (STRINGP UTF8STRING)
+                   (LITATOM UTF8STRING))
+        (SETQ UTF8STRING (MKSTRING UTF8STRING)))
+    (CL:WHEN (ffetch
 (STRINGP FATSTRINGP) of
 UTF8STRING)
+           (\ILLEGAL.ARG UTF8STRING))
+    (LET* ((NMCHARS (N-MCHARS
 UTF8STRING))
+           (MSTRING (ALLOCSTRING NMCHARS)))
+          [for
 M NBYTES BYTE1 (BASE _ (ffetch
 (STRINGP BASE) of
 UTF8STRING)) from
 1 to
 NMCHARS
+             as
 OFFSET from
 (fetch
 (STRINGP OFFST) of
 MSTRING) by
 NBYTES
+             do
 (SETQ BYTE1 (\GETBASEBYTE BASE OFFSET))
+                (SETQ NBYTES (NUTF8-BYTE1-BYTES
 BYTE1))
+                (RPLCHARCODE MSTRING M (UTOMCODE
 (\UTF8.FETCHCODE
 NBYTES BASE OFFSET]
+          MSTRING])
+)
+(DEFINEQ
+
 (XTOUCODE

-  [LAMBDA (XCCSCODE)
                                        (* ; "Edited  9-Aug-2020 09:04 by rmk:")

-    (UNICODE.TRANSLATE XCCSCODE *XCCSTOUNICODE*])
+  [LAMBDA (XCODE)
                                            (* ; "Edited  4-Sep-2025 15:09 by rmk")


+                                                             (* ; "Edited 24-May-2025 23:16 by rmk")


+                                                             (* ; "Edited 24-Apr-2025 15:27 by rmk")


+                                                            (* ; "Edited  9-Aug-2020 09:04 by rmk:")

+    (UNICODE.TRANSLATE (XTOMCODE XCODE)
+           *MCCSTOUNICODE*])
 
 (UTOXCODE

-  [LAMBDA (UNNICODE)
                                         (* ; "Edited 16-Jan-2025 23:46 by rmk")


+  [LAMBDA (UNICODE)
                                          (* ; "Edited 24-May-2025 23:17 by rmk")


+                                                             (* ; "Edited 24-Apr-2025 15:28 by rmk")


+                                                             (* ; "Edited 16-Jan-2025 23:46 by rmk")


                                                             (* ; "Edited  9-Aug-2020 09:04 by rmk:")

-    (UNICODE.TRANSLATE UNNICODE *UNICODETOXCCS*])
+    (MTOXCODE (UNICODE.TRANSLATE UNICODE *UNICODETOMCCS*])
 
 (XTOUCODE?

-  [LAMBDA (XCCSCODE)
                                         (* ; "Edited 20-Jan-2025 20:38 by rmk")


+  [LAMBDA (XCCSCODE)
                                         (* ; "Edited 24-May-2025 23:18 by rmk")


+                                                             (* ; "Edited 24-Apr-2025 15:27 by rmk")


+                                                             (* ; "Edited 20-Jan-2025 20:38 by rmk")


                                                              (* ; "Edited 18-Jan-2025 11:44 by rmk")


                                                              (* ; "Edited 15-Jan-2025 19:51 by rmk")


                                                              (* ; "Edited 14-Jan-2025 13:14 by rmk")


@@ -883,10 +1045,13 @@
 
     (* ;; "Returns the Unix range-code(s) corresponding to XCCSCODE if there are true mapppings, otherwise NIL.  Alternative codes are returned in a list, the code itself is returned for a singleton.")

 
-    (UNICODE.TRANSLATE XCCSCODE *XCCSTOUNICODE* T T])
+    (UNICODE.TRANSLATE (XTOMCODE XCCSCODE)
+           *MCCSTOUNICODE* T T])
 
 (UTOXCODE?

-  [LAMBDA (UNICODE)
                                          (* ; "Edited 19-Jan-2025 21:14 by rmk")


+  [LAMBDA (UNICODE)
                                          (* ; "Edited 24-May-2025 23:19 by rmk")


+                                                             (* ; "Edited 24-Apr-2025 15:28 by rmk")


+                                                             (* ; "Edited 19-Jan-2025 21:14 by rmk")


                                                              (* ; "Edited 18-Jan-2025 11:46 by rmk")


                                                              (* ; "Edited 15-Jan-2025 19:51 by rmk")


                                                              (* ; "Edited 14-Jan-2025 13:14 by rmk")


@@ -897,7 +1062,47 @@
     (* ;; 
 
    " NOTE:  Alternative codes are returned in a list, the code itself is returned for a singleton.")

 
-    (UNICODE.TRANSLATE UNICODE *UNICODETOXCCS* T T])
+    (MTOXCODE (UNICODE.TRANSLATE UNICODE *UNICODETOMCCS* T T])
+
+(XTOUSTRING

+  [LAMBDA (XSTRING DESTRUCTIVE)
                              (* ; "Edited  2-Sep-2025 12:00 by rmk")


+                                                             (* ; "Edited 29-Apr-2025 12:01 by rmk")

+
+    (* ;; "Converts XCCS codes in XSTRING to Unicodes.")

+
+    (for
 I UCODE XCODE (USTRING _ (CL:IF DESTRUCTIVE
+                                      XSTRING
+                                      (CONCAT XSTRING))) from
 1 while
 (SETQ XCODE (NTHCHARCODE 
+                                                                                         XSTRING I))
+       do
 (RPLCHARCODE USTRING I (XTOUCODE
 XCODE)) finally
 (RETURN USTRING])
+
+(UTOXSTRING

+  [LAMBDA (USTRING DESTRUCTIVE)
                              (* ; "Edited  2-Sep-2025 11:54 by rmk")


+                                                             (* ; "Edited 29-Apr-2025 12:00 by rmk")

+
+    (* ;; "Converts Unicodes in USTRING to XCCS codes.")

+
+    (for
 I XCODE UCODE (XSTRING _ (CL:IF DESTRUCTIVE
+                                      USTRING
+                                      (CONCAT USTRING))) from
 1 while
 (SETQ UCODE (NTHCHARCODE 
+                                                                                         USTRING I))
+       unless
 (EQ UCODE (SETQ XCODE (UTOXCODE
 UCODE))) do
 (RPLCHARCODE XSTRING I XCODE)
+       finally
 (RETURN XSTRING])
+
+(XTOUTF8STRING

+  [LAMBDA (XSTRING)
                                          (* ; "Edited  4-Sep-2025 18:37 by rmk")


+                                                             (* ; "Edited  2-Sep-2025 11:37 by rmk")


+                                                             (* ; "Edited 29-Apr-2025 12:53 by rmk")


+                                                             (* ; "Edited 24-Apr-2025 15:42 by rmk")


+                                                             (* ; "Edited  3-Feb-2024 14:55 by rmk")


+                                                            (* ; "Edited 10-Aug-2020 21:42 by rmk:")

+
+    (* ;; "Produces a string that contains the UTF8 bytes that represent the characters in XSTRING.  Applies the ")

+
+    (* ;; "The resulting string will not be interpretable inside Medley.")

+
+    (for
 I C (MSTRING _ (CONCAT XSTRING)) from
 1 while
 (SETQ C (NTHCHARCODE XSTRING I))
+       do
 (RPLCHARCODE MSTRING I (XTOMCODE C)) finally
 (RETURN (MTOUTF8STRING
 MSTRING])
 )
 
 
@@ -954,7 +1159,8 @@
 (DEFINEQ
 
 (READ-UNICODE-MAPPING-FILENAMES

-  [LAMBDA (FILESPEC)
                                         (* ; "Edited 27-Jan-2025 16:46 by rmk")


+  [LAMBDA (FILESPEC)
                                         (* ; "Edited  4-Sep-2025 00:11 by rmk")


+                                                             (* ; "Edited 27-Jan-2025 16:46 by rmk")


                                                              (* ; "Edited 21-Jan-2025 22:51 by rmk")


                                                              (* ; "Edited 19-Jan-2025 12:21 by rmk")


                                                              (* ; "Edited  3-Feb-2024 11:00 by rmk")


@@ -1005,7 +1211,10 @@
      (FUNCTION STRING.EQUAL])
 
 (READ-UNICODE-MAPPING

-  [LAMBDA (FILESPEC PRINT NOERROR)
                           (* ; "Edited 31-Jan-2025 17:43 by rmk")


+  [LAMBDA (FILESPEC PRINT NOERROR)
                           (* ; "Edited 11-Oct-2025 12:08 by rmk")


+                                                             (* ; "Edited  4-Sep-2025 00:17 by rmk")


+                                                             (* ; "Edited 24-Apr-2025 15:32 by rmk")


+                                                             (* ; "Edited 31-Jan-2025 17:43 by rmk")


                                                              (* ; "Edited 17-Jan-2025 16:41 by rmk")


                                                              (* ; "Edited  3-Feb-2024 00:21 by rmk")


                                                              (* ; "Edited  5-Jan-2024 12:26 by rmk")


@@ -1013,7 +1222,7 @@
 
     (* ;; "Combines the char-mapping tables from FILES coded in the Uncode-CDROM format.  Comments prefixed by # and")

 
-    (* ;; "               Column 1:  Input hex code in the format 0xXXXX")

+    (* ;; "               Column 1:  XCCS input hex code in the format 0xXXXX")

 
     (* ;; "               Column 2:  Corresponding Unicode code-sequence in the format")

 
@@ -1025,15 +1234,15 @@
 
     (* ;; "")

 
-    (* ;; "Result is a list of (fromcode tocode1 ... tocoden) integer lists (almost always with only a single tocode")

+    (* ;; "Result is a list of (fromcode tocode1 ... tocoden) integer lists (almost always with only a single tocode, where fromcode is an XCCS code and the tocodes are corresponding Unicodes.")

 
-    (FOR
 FILE [SEPBITTABLE _ (MAKEBITTABLE (CHARCODE (TAB SPACE] IN
 (READ-UNICODE-MAPPING-FILENAMES

+    (for
 FILE [SEPBITTABLE _ (MAKEBITTABLE (CHARCODE (TAB SPACE] in
 (READ-UNICODE-MAPPING-FILENAMES

                                                                      FILESPEC)
-       JOIN
 
+       join
 
             (* ;; "External format  :THROUGH means read as bytes, so the Unicode UTF-8 comments cannot cause reading problems.")

 
             (CL:WITH-OPEN-FILE (STREAM FILE :DIRECTION :INPUT :EXTERNAL-FORMAT `(:THROUGH LF))
-                   (bind
 LINE NAME CHARSET START
+                   (bind
 LINE NAME CHARSET START MAP
                       first
 (CL:UNLESS (FILEPOS "Name:" STREAM NIL NIL NIL T)
                                 (ERROR "NOT A UNICODE MAPPING FILE" (FULLNAME STREAM)))
                             (SETQ NAME (CL:STRING-TRIM " " (CL:READ-LINE STREAM NIL NIL)))
@@ -1047,16 +1256,20 @@
                       when
 (SETQ START (STRPOSL SEPBITTABLE LINE 1 T))
                       unless
 (EQ (CHARCODE %#)
                                  (NTHCHARCODE LINE START))
-                      collect
 (bind
 END CODES while
 [SETQ END (OR (STRPOSL SEPBITTABLE LINE START)
-                                                                  (ADD1 (NCHARS LINE]
-                                 collect
 [CHARCODE.DECODE (SUBSTRING LINE START (SUB1 END)
-                                                                 (CONSTANT (CONCAT]
-                                 repeatwhile
 (AND (SETQ START (STRPOSL SEPBITTABLE LINE END T))
-                                                  (NEQ (CHARCODE %#)
-                                                       (NTHCHARCODE LINE START)))
-                                 finally
 (CL:WHEN (CDDR $$VAL)
+                      collect
 [SETQ MAP (bind
 END CODES while
 [SETQ END (OR (STRPOSL SEPBITTABLE LINE
+                                                                                   START)
+                                                                            (ADD1 (NCHARS LINE]
+                                           collect
 [CHARCODE.DECODE (SUBSTRING LINE START
+                                                                           (SUB1 END)
+                                                                           (CONSTANT (CONCAT]
+                                           repeatwhile
 (AND (SETQ START (STRPOSL SEPBITTABLE LINE END
+                                                                               T))
+                                                            (NEQ (CHARCODE %#)
+                                                                 (NTHCHARCODE LINE START)))
+                                           finally
 (CL:WHEN (CDDR $$VAL)
                                                              (* ; "Combiners go into a CADR list")

-                                             (RPLACD $$VAL (CONS (CDR $$VAL))))])
+                                                       (RPLACD $$VAL (CONS (CDR $$VAL))))]
+                            MAP])
 )
 
 
@@ -1066,15 +1279,20 @@
 (DEFINEQ
 
 (MAKE-UNICODE-TRANSLATION-TABLES

-  [LAMBDA (MAPPING REINSTALL)
                                (* ; "Edited 31-Jan-2025 17:46 by rmk")


+  [LAMBDA (MAPPING REINSTALL)
                                (* ; "Edited 11-Oct-2025 11:54 by rmk")


+                                                             (* ; "Edited  4-Sep-2025 00:30 by rmk")


+                                                             (* ; "Edited 24-Apr-2025 15:47 by rmk")


+                                                             (* ; "Edited 31-Jan-2025 17:46 by rmk")


                                                              (* ; "Edited 26-Jan-2025 19:36 by rmk")


                                                              (* ; "Edited 22-Jan-2025 14:22 by rmk")


                                                              (* ; "Edited 19-Jan-2025 15:08 by rmk")


                                                              (* ; "Edited 18-Jan-2025 11:52 by rmk")


                                                              (* ; "Edited  3-Feb-2024 00:24 by rmk")


                                                              (* ; "Edited 30-Jan-2024 09:54 by rmk")


-                                                            (* ; "Edited 21-Aug-2021 13:12 by rmk:")


-                                                            (* ; "Edited 17-Aug-2020 08:46 by rmk:")

+                                                            (* ; "Edited 21-Aug-2021 13:12 by rmk:")

+
+    (* ;; "MAPPING is the list of numeric code correspondence pairs constructed by applying READ-UNICODE-MAPPING to XCCS-to-Unicode mapping files. This applies the XCCS-to-MCCS translations, and then updates or produces two recoding arrays, one maps left-side codes into right-side codes (e.g. MCCS or ISO8859-1 to Unicode), for printing, the other maps right-side (Unicode) codes to corresponding right-side codes (e.g. MCCS).")

+
                                                            (* ; "Edited 17-Aug-2020 08:46 by rmk:")

     (CL:UNLESS [AND (LISTP MAPPING)
                     (FOR
 PAIR R IN
 MAPPING AS
 I TO
 10
                        ALWAYS
 (AND (LISTP PAIR)
@@ -1085,8 +1303,7 @@
         (* ;; "Seems like the argument is not already a list of mapping pairs (perhaps with a combiner), presumably a list of charsets to be read.")

 
         (SETQ MAPPING (READ-UNICODE-MAPPING
 MAPPING)))
-
-    (* ;; "MAPPING is the list of numeric code correspondence pairs constructed by applying READ-UNICODE-MAPPING to Unicode mapping files.")

+    (SETQ MAPPING (XCCSTOMCCS-MAPPING MAPPING))
 
     (* ;; "This updates or produces two recoding arrays, one maps left-side codes into right-side codes (e.g. XCCS or ISO8859-1 to Unicode), for printing, the other maps right-side (Unicode) codes to corresponding right-side codes (e.g. XCCS).")

 
@@ -1097,22 +1314,47 @@
     (* ;; "")

 
     (if
 REINSTALL
-        then
 (SETQ *XCCS-LOADED-CHARSETS* (SETQ *UNICODE-LOADED-CHARSETS* NIL))
-             (SETQ *NEXT-PRIVATE-XCCSCODE* FIRST-PRIVATE-XCCSCODE)
+        then
 (SETQ *MCCS-LOADED-CHARSETS* (SETQ *UNICODE-LOADED-CHARSETS* NIL))
+             (SETQ *NEXT-PRIVATE-MCCSCODE* FIRST-PRIVATE-MCCSCODE)
              (SETQ *NEXT-PRIVATE-UNICODE* FIRST-PRIVATE-UNICODE)
              (LET [(TABLE (HASHARRAY (LENGTH MAPPING)))
                    (INVERSETABLE (HASHARRAY (LENGTH MAPPING]
                   (MERGE-UNICODE-TRANSLATION-TABLES
 NIL MAPPING TABLE INVERSETABLE)
-                  (SETQ *XCCSTOUNICODE* TABLE)
-                  (SETQ *UNICODETOXCCS* INVERSETABLE)
-                  (LIST *XCCSTOUNICODE* *UNICODETOXCCS*))
-      else
 (CL:UNLESS (BOUNDP '*NEXT-PRIVATE-XCCSCODE*)
-               (SETQ *NEXT-PRIVATE-XCCSCODE* FIRST-PRIVATE-XCCSCODE)
+                  (SETQ *MCCSTOUNICODE* TABLE)
+                  (SETQ *UNICODETOMCCS* INVERSETABLE)
+                  (LIST *MCCSTOUNICODE* *UNICODETOMCCS*))
+      else
 (CL:UNLESS (BOUNDP '*NEXT-PRIVATE-MCCSCODE*)
+               (SETQ *NEXT-PRIVATE-MCCSCODE* FIRST-PRIVATE-MCCSCODE)
                (SETQ *NEXT-PRIVATE-UNICODE* FIRST-PRIVATE-UNICODE))
            (MERGE-UNICODE-TRANSLATION-TABLES
 NIL MAPPING])
 
+(XCCSTOMCCS-MAPPING

+  [LAMBDA (XTOUMAPPING)
                                      (* ; "Edited 11-Oct-2025 12:57 by rmk")

+
+    (* ;; 
+
    "This translates the pairs that map XCCS to Unicode into pairs that translate MCCS to Unicode.")

+
+    (* ;; 
+
   "We grab the affected pairs before we make any changes so that we don't get into ordering issues.")

+
+    (LET* ([XTOMCODES (CHARCODE ((Currency Dollar)
+                                 (Dollar Currency)
+                                 (Uparrow Circumflex)
+                                 (Circumflex Uparrow)
+                                 (Leftarrow Lowline)
+                                 (Lowline Leftarrow]
+           (AFFECTED (for
 MP in
 XTOUMAPPING when
 (thereis
 XP in
 XTOMCODES
+                                                    suchthat
 (EQ (CAR MP)
+                                                                 (CAR XP))) collect
 MP)))
+          (for
 AP in
 AFFECTED do
 (RPLACA AP (CADR (ASSOC (CAR AP)
+                                                         XTOMCODES)))
+             finally
 (push
 XTOUMAPPING (CHARCODE (DEL DEL)))
+                   (RETURN XTOUMAPPING])
+
 (MERGE-UNICODE-TRANSLATION-TABLES

-  [LAMBDA (INVERSE MAPPING TABLE INVERSETABLE)
               (* ; "Edited 31-Jan-2025 17:45 by rmk")


+  [LAMBDA (INVERSE MAPPING TABLE INVERSETABLE)
               (* ; "Edited 11-Oct-2025 10:24 by rmk")


+                                                             (* ; "Edited 24-Apr-2025 15:28 by rmk")


+                                                             (* ; "Edited  1-Feb-2025 21:42 by rmk")


                                                              (* ; "Edited 26-Jan-2025 12:58 by rmk")


                                                              (* ; "Edited 22-Jan-2025 08:20 by rmk")


                                                              (* ; "Edited 19-Jan-2025 15:58 by rmk")


@@ -1121,36 +1363,35 @@
                                                              (* ; "Edited  3-Feb-2024 12:46 by rmk")


                                                              (* ; "Edited 31-Jan-2024 10:06 by rmk")

 
-    (* ;; "MAPPINGS is a list of pairs that map domain codes to range codes.  TABLE and INVERSETABLE default to *XCCSTOUNICODE* *UNICODETOXCCS* respectively.   ")

+    (* ;; "MAPPINGS is a list of pairs that map domain codes to range codes.  TABLE and INVERSETABLE default to *MCCSTOUNICODE* *UNICODETOMCCS* respectively.   ")

 
     (CL:UNLESS TABLE
-        [SETQ TABLE (OR *XCCSTOUNICODE* (SETQ *XCCSTOUNICODE* (HASHARRAY (LENGTH MAPPING])
+        [SETQ TABLE (OR *MCCSTOUNICODE* (SETQ *MCCSTOUNICODE* (HASHARRAY (LENGTH MAPPING])
     (CL:UNLESS INVERSETABLE
-        [SETQ INVERSETABLE (OR *UNICODETOXCCS* (SETQ *UNICODETOXCCS* (HASHARRAY (LENGTH MAPPING])
+        [SETQ INVERSETABLE (OR *UNICODETOMCCS* (SETQ *UNICODETOMCCS* (HASHARRAY (LENGTH MAPPING])
     (for
 M D R OLDR in
 MAPPING first
 (CL:IF INVERSE (swap
 TABLE INVERSETABLE))
        eachtime
 (SETQ D (CAR M))
              (SETQ R (CADR M)) 
 
-             (* ;; "We don't do combiners and we don't go outside of SMALLP's")

+             (* ;; "We don't do combiners, but we are allowing non-SMALLP's")

  unless
 (OR (LISTP D)
-            (LISTP R)) when
 (AND (SMALLP D)
-                                 (SMALLP R)) do
 
-
-                                 (* ;; "The (CONS R OLDR) deals with alternatives:  (U X1) (U X2) => (U (X1 X2)), lowest code first.  Those are only possible in the U-to-X direction when the tables contain (X1 U) and (X2 U). There are no duplicates/alternative table entries in the X-to-U direction.")

-
-                                                (SETQ OLDR (GETHASH D TABLE))
-                                                (CL:UNLESS (MEMB R OLDR)
-                                                    (PUTHASH D (SORT (CONS R OLDR))
-                                                           TABLE))
-                                                (swap
 D R)
-                                                (SETQ OLDR (GETHASH D INVERSETABLE))
-                                                (CL:UNLESS (MEMB R OLDR)
-                                                    (PUTHASH D (SORT (CONS R OLDR))
-                                                           INVERSETABLE)))
+            (LISTP R)) do
 
+                          (* ;; "The (CONS R OLDR) deals with alternatives:  (U X1) (U X2) => (U (X1 X2)), lowest code first.  Those are only possible in the U-to-X direction when the tables contain (X1 U) and (X2 U). There are no duplicates/alternative table entries in the X-to-U direction.")

+
+                          (SETQ OLDR (GETHASH D TABLE))
+                          (CL:UNLESS (MEMB R OLDR)
+                              (PUTHASH D (SORT (CONS R OLDR))
+                                     TABLE))
+                          (swap
 D R)
+                          (SETQ OLDR (GETHASH D INVERSETABLE))
+                          (CL:UNLESS (MEMB R OLDR)
+                              (PUTHASH D (SORT (CONS R OLDR))
+                                     INVERSETABLE)))
     (LIST TABLE INVERSETABLE])
 
 (UNICODE.UNMAPPED

-  [LAMBDA (CODE TABLE DONTFAKE)
                              (* ; "Edited 22-Jan-2025 08:19 by rmk")


+  [LAMBDA (CODE TABLE DONTFAKE)
                              (* ; "Edited 24-Apr-2025 15:48 by rmk")


+                                                             (* ; "Edited 22-Jan-2025 08:19 by rmk")


                                                              (* ; "Edited 19-Jan-2025 22:02 by rmk")


                                                              (* ; "Edited 18-Jan-2025 12:02 by rmk")


                                                              (* ; "Edited  2-Feb-2024 23:52 by rmk")


@@ -1165,7 +1406,7 @@
 
     (* ;; "")

 
-    (PROG ((INVERSE (EQ TABLE *UNICODETOXCCS*))
+    (PROG ((INVERSE (EQ TABLE *UNICODETOMCCS*))
            RANGE HASH)
 
      (* ;; "If we already looked up CODE's character set in a file, then we have already filled in its information in the translation table.  If it didn't have a code for a particular character, then we fake it here.  Faked codes are negative, so we can detect them easily, and interpret them with IABS.")

@@ -1183,15 +1424,15 @@
 
               (* ;; "Our attempt at extending the known tables did not provide a mapping for CODE.  So we fake it up with the next unused private code in the code space.  ")

 
-              (* ;; "The number of possible faked mappings is determined by the number of private-use Unicodes, since the XCCS character space is pretty sparse.  The codes don't have to come from the same part of the code space, and the NEXTCODEs are saved in global variables.  The last available codes are constants.")

+              (* ;; "The number of possible faked mappings is determined by the number of private-use Unicodes, since the MCCS character space is pretty sparse.  The codes don't have to come from the same part of the code space, and the NEXTCODEs are saved in global variables.  The last available codes are constants.")

 
-              (CL:WHEN (IEQP *NEXT-PRIVATE-XCCSCODE* LAST-PRIVATE-XCCSCODE)
+              (CL:WHEN (IEQP *NEXT-PRIVATE-MCCSCODE* LAST-PRIVATE-MCCSCODE)
                                                              (* ; 
 
                                                           "Same number of available codes both ways")

                   (ERROR "EXHAUSTED RANGE FOR UNMAPPED CODES"))
               (if
 INVERSE
-                  then
 (SETQ RANGE *NEXT-PRIVATE-XCCSCODE*)
-                       (add
 *NEXT-PRIVATE-XCCSCODE* 1)
+                  then
 (SETQ RANGE *NEXT-PRIVATE-MCCSCODE*)
+                       (add
 *NEXT-PRIVATE-MCCSCODE* 1)
                 else
 (SETQ RANGE *NEXT-PRIVATE-UNICODE*)
                      (add
 *NEXT-PRIVATE-UNICODE* 1))
               (MERGE-UNICODE-TRANSLATION-TABLES
 INVERSE (CONS (LIST CODE RANGE)))
@@ -1201,7 +1442,11 @@
               (RETURN (CONS RANGE)))])
 
 (UNICODE-EXTEND-TRANSLATION?

-  [LAMBDA (CODE TABLE)
                                       (* ; "Edited 26-Jan-2025 11:26 by rmk")


+  [LAMBDA (CODE TABLE)
                                       (* ; "Edited 11-Oct-2025 09:49 by rmk")


+                                                             (* ; "Edited  4-Sep-2025 00:34 by rmk")


+                                                             (* ; "Edited 29-Jun-2025 16:44 by rmk")


+                                                             (* ; "Edited 24-Apr-2025 15:49 by rmk")


+                                                             (* ; "Edited 26-Jan-2025 11:26 by rmk")


                                                              (* ; "Edited 21-Jan-2025 22:31 by rmk")


                                                              (* ; "Edited 18-Jan-2025 12:40 by rmk")


                                                              (* ; "Edited 13-Jan-2025 23:50 by rmk")


@@ -1210,28 +1455,28 @@
                                                              (* ; "Edited  5-Feb-2024 13:48 by rmk")


                                                              (* ; "Edited  3-Feb-2024 12:40 by rmk")

 
-    (* ;; "There is currently no mapping for CODE in TABLE, hopefully just because the relevant character-set mapping has not been installed. We infer from TABLE whether CODE is an XCCS or UNICODE code and look for the proper mapping table (forward or inverted) for its character set. ")

+    (* ;; "There is currently no mapping for CODE in TABLE, hopefully just because the relevant character-set mapping has not been installed. We infer from TABLE whether CODE is an MCCS or UNICODE code and look for the proper mapping table (forward or inverted) for its character set. ")

 
     (* ;; "We record which character sets we have already expanded so we don't do them again.")

 
     (LET ((CHARSET (\CHARSET CODE))
-          (INVERSE (EQ TABLE *UNICODETOXCCS*))
+          (INVERSE (EQ TABLE *UNICODETOMCCS*))
           MAPPING FILE)
 
          (* ;; "If we already looked for CHARSET in the file and found anything, it has already been merged. Otherwise, it would just fail again")

 
          (CL:UNLESS (MEMB CHARSET (CL:IF INVERSE
                                       *UNICODE-LOADED-CHARSETS*
-                                      *XCCS-LOADED-CHARSETS*))
+                                      *MCCS-LOADED-CHARSETS*))
 
              (* ;; "Don't try this charset again.")

 
              (CL:IF INVERSE
                  (push
 *UNICODE-LOADED-CHARSETS* CHARSET)
-                 (push
 *XCCS-LOADED-CHARSETS* CHARSET))
+                 (push
 *MCCS-LOADED-CHARSETS* CHARSET))
              (SETQ FILE (FINDFILE (CL:IF INVERSE
-                                      'INVERTED-UNICODE-MAPPINGS.TXT
-                                      'UNICODE-MAPPINGS.TXT)
+                                      'UNICODE-TO-MCCS-MAPPINGS
+                                      'MCCS-TO-UNICODE-MAPPINGS)
                                T UNICODEDIRECTORIES))
 
              (* ;; "The mappings files are indexed by CHARSET.")

@@ -1250,7 +1495,8 @@
 (DEFINEQ
 
 (ALL-UNICODE-MAPPINGS

-  [LAMBDA (INVERTED FILE)
                                    (* ; "Edited 31-Jan-2025 17:46 by rmk")


+  [LAMBDA (INVERTED FILE)
                                    (* ; "Edited 24-Apr-2025 15:51 by rmk")


+                                                             (* ; "Edited 31-Jan-2025 17:46 by rmk")


                                                              (* ; "Edited 26-Jan-2025 13:40 by rmk")


                                                              (* ; "Edited 22-Jan-2025 14:07 by rmk")


                                                              (* ; "Edited 19-Jan-2025 12:20 by rmk")


@@ -1260,16 +1506,16 @@
                                                              (* ; "Edited  5-Feb-2024 13:14 by rmk")


                                                              (* ; "Edited  3-Feb-2024 09:16 by rmk")

 
-    (* ;; "Reads all the XCCS-to-UNICODE mapping files that we know about, and produces a 2-level index that maps between XCCS codes and UNICODE codes, depending on INVERTED.")

+    (* ;; "Reads all the XCCS-to-UNICODE mapping files that we know about, and produces a 2-level index that maps between MCCS codes and UNICODE codes, depending on INVERTED.")

 
     (* ;; "The first index level segments all the domain codes according to their character sets.  The segments are sorted by character set, the pairs within each segment are sorted by their domain codes.  ")

 
     (* ;; 
 
    "E.g. if INVERTED=NIL and given a XCCS code, the lookup for the corresponding Unicode(s) is")

 
-    (* ;; "    (CADR (ASSOC XCCSCODE (\CHARSET XCCSCODE) INDEX)))).")

+    (* ;; "    (CADR (ASSOC MCCSCODE (\CHARSET MCCSCODE) INDEX)))).")

 
-    (* ;; "If FILE is not NIL, the result is written to a file. If FILE is T, the file is either UNICODE-MAPPINGS.TXT or INVERTED-UNICODED-MAPPINGS.TXT, depending on INVERTED.")

+    (* ;; "If FILE is not NIL, the result is written to a file. If FILE is T, the file is either MCCS-TO-UNICODE-MAPPINGS.TXT or UNICODE-TO-MCCS-MAPPINGS.TXT, depending on INVERTED.")

 
     (LET (INDEX)
          (for
 PAIR DOMAIN RANGE CHARSET in
 (READ-UNICODE-MAPPING
 'ALL) eachtime
 (SETQ DOMAIN
@@ -1287,7 +1533,7 @@
                                                   INDEX)
                                            (CAR (push
 INDEX (CONS (\CHARSET DOMAIN] 
 
-                         (* ;; "For alternative mappings (in the U-to-X direction) we end up with  (D R1 R2 ...).  (CADR is the first (and almost always) the only one.")

+                         (* ;; "For alternative mappings (in the U-to-M direction) we end up with  (D R1 R2 ...).  (CADR is the first (and almost always) the only one.")

 
                          (pushnew
 [CDR (OR (ASSOC DOMAIN (CDR CHARSET))
                                            (CAR (push
 (CDR CHARSET)
@@ -1312,8 +1558,8 @@
              then
 (SETQ FILE (PACKFILENAME 'BODY (if
 (NEQ FILE T)
                                                      then
 FILE
                                                    elseif
 INVERTED
-                                                     then
 'INVERTED-UNICODE-MAPPINGS
-                                                   else
 'UNICODE-MAPPINGS)
+                                                     then
 'UNICODE-TO-MCCS-MAPPINGS
+                                                   else
 'MCCS-TO-UNICODE-MAPPINGS)
                                     'DIRECTORY
                                     (CAR (MKLIST UNICODEDIRECTORIES))
                                     'EXTENSION
@@ -1330,19 +1576,43 @@
                          (PRINTOUT STREAM "STOP" T)
                          (FULLNAME STREAM))
            else
 INDEX])
+
+(XCCSJAPANESECHARSETS

+  [LAMBDA (OCTAL FILE)
                                       (* ; "Edited 11-Jun-2025 23:00 by rmk")

+
+    (* ;; "Returns the list of numbers for the Japanese character sets.")

+
+    (for
 F POS CS in
 (READ-UNICODE-MAPPING-FILENAMES
 "JIS")
+       when
 (SETQ POS (STRPOS "XCCS-" F 1 NIL NIL T))
+       collect
 [SETQ CS (SUBSTRING F POS (SUB1 (STRPOS '=JIS F POS]
+             (CL:IF OCTAL
+                 CS
+                 (MKATOM (CONCAT CS "Q")))
+       finally
 (SORT $$VAL)
+             (CL:WHEN FILE
+                 (RETURN (CL:WITH-OPEN-FILE (STREAM (PACKFILENAME 'BODY (CL:IF (EQ FILE T)
+                                                                            "JAPANESECHARSETS"
+                                                                            FILE)
+                                                           'DIRECTORY
+                                                           (CAR (MKLIST UNICODEDIRECTORIES))
+                                                           'EXTENSION
+                                                           'TXT)
+                                                   :DIRECTION :OUTPUT :IF-EXISTS :NEW-VERSION)
+                                (PRINT $$VAL STREAM)
+                                (FULLNAME STREAM))))])
 )
 
-(RPAQ? *XCCSTOUNICODE*
 )
+(RPAQ? *MCCSTOUNICODE*
 )
 
-(RPAQ? *UNICODETOXCCS*
 )
+(RPAQ? *UNICODETOMCCS*
 )
 
-(RPAQ? *XCCS-LOADED-CHARSETS*
 )
+(RPAQ? *MCCS-LOADED-CHARSETS*
 )
 
 (RPAQ? *UNICODE-LOADED-CHARSETS*
 )
 (DECLARE%: DOEVAL@COMPILE DONTCOPY
 
-(GLOBALVARS *XCCSTOUNICODE* *UNICODETOXCCS* *NEXT-PRIVATE-UNICODE* *NEXT-PRIVATE-XCCSCODE* 
-       *XCCS-LOADED-CHARSETS* *UNICODE-LOADED-CHARSETS*)
+(GLOBALVARS *MCCSTOUNICODE* *UNICODETOMCCS* *NEXT-PRIVATE-UNICODE* *NEXT-PRIVATE-MCCSCODE* 
+       *MCCS-LOADED-CHARSETS* *UNICODE-LOADED-CHARSETS*)
 )
 (DECLARE%: EVAL@COMPILE DONTCOPY 
 (DECLARE%: EVAL@COMPILE 
@@ -1351,15 +1621,15 @@
 
 (RPAQ LAST-PRIVATE-UNICODE
 (HEXNUM? "F8FF"))
 
-(RPAQ FIRST-PRIVATE-XCCSCODE
 (CHARCODE "200,0"))
+(RPAQ FIRST-PRIVATE-MCCSCODE
 (CHARCODE "200,0"))
 
-(RPAQ LAST-PRIVATE-XCCSCODE
 (CHARCODE "230,377"))
+(RPAQ LAST-PRIVATE-MCCSCODE
 (CHARCODE "230,377"))
 
 
 (CONSTANTS (FIRST-PRIVATE-UNICODE (HEXNUM? "E000"))
        (LAST-PRIVATE-UNICODE (HEXNUM? "F8FF"))
-       (FIRST-PRIVATE-XCCSCODE (CHARCODE "200,0"))
-       (LAST-PRIVATE-XCCSCODE (CHARCODE "230,377")))
+       (FIRST-PRIVATE-MCCSCODE (CHARCODE "200,0"))
+       (LAST-PRIVATE-MCCSCODE (CHARCODE "230,377")))
 )
 
 (DECLARE%: EVAL@COMPILE 
@@ -1368,11 +1638,11 @@
 
                             (* ;; "Return NIL if RANGE is a fake range in TABLE, otherwise RANGE.")

 
-                            (CL:UNLESS (CL:IF (EQ TABLE *XCCSTOUNICODE*)
+                            (CL:UNLESS (CL:IF (EQ TABLE *MCCSTOUNICODE*)
                                            (AND (IGEQ RANGE FIRST-PRIVATE-UNICODE)
                                                 (ILEQ RANGE LAST-PRIVATE-UNICODE))
-                                           (AND (IGEQ RANGE FIRST-PRIVATE-XCCSCODE)
-                                                (ILEQ RANGE LAST-PRIVATE-XCCSCODE)))
+                                           (AND (IGEQ RANGE FIRST-PRIVATE-MCCSCODE)
+                                                (ILEQ RANGE LAST-PRIVATE-MCCSCODE)))
                                    RANGE)))
 )
 )
@@ -1581,29 +1851,6 @@
            (CAR UNICODEDIRECTORIES)
            'EXTENSION
            'TXT])
-
-(HEXSTRING

-  [LAMBDA (N WIDTH)
                                     (* ; "Edited 23-Jul-2020 08:28 by rmk:")


-                                                             (* ; "Edited 20-Dec-93 17:51 by rmk:")

-
-    (* ;; 
-
  "Converts positive numbers to Hex strings, padding on the right with 0 up to WIDTH if given.")

-
-    (CL:UNLESS (FIXP N)
-        (SETQ N (CHARCODE.DECODE N)))
-    (LET [CHAR (STR (ALLOCSTRING [IMAX (OR WIDTH 0)
-                                       (FOR
 I (LEFT _ N) FROM
 0 UNTIL
 (EQ LEFT 0)
-                                          DO
 (SETQ LEFT (LRSH LEFT 4))
-                                          FINALLY
 (RETURN (MAX I 1]
-                           (CHARCODE 0]
-         (FOR
 I FROM
 -1 BY
 -1 UNTIL
 (EQ N 0)
-            DO
 (SETQ CHAR (LOGAND N 15))
-                  [RPLCHARCODE STR I (IF
 (ILESSP CHAR 10)
-                                         THEN
 (+ CHAR (CHARCODE 0))
-                                       ELSE
 (+ (- CHAR 10)
-                                                   (CHARCODE A]
-                  (SETQ N (LRSH N 4)))
-         STR])
 )
 (DEFINEQ
 
@@ -1705,68 +1952,6 @@
                                     (LOGOR (LLSH 2 6)
                                            (LOADBYTE CHARCODE 0 6)))
                      ELSE
 (ERROR "CHARCODE too big for UTF8" CHARCODE])
-
-(XTOUSTRING

-  [LAMBDA (XCCSSTRING
 RAWFLG)
                                (* ; "Edited  3-Feb-2024 14:55 by rmk")


-                                                            (* ; "Edited 10-Aug-2020 21:42 by rmk:")

-
-    (* ;; "Produces a string that contains the UTF8 bytes that represent the characters in XCCSSTRING.  Applies the XCCSTOUNICODE translation unless RAWFLG.  ")

-
-    (* ;; "The resulting string will not be readable inside Medley.")

-
-    (LET [(USTR (ALLOCSTRING (NUTF8-STRING-BYTES
 XCCSSTRING RAWFLG]
-         (FOR
 I CHARCODE (SINDEX _ 0) FROM
 1 WHILE
 (SETQ CHARCODE (NTHCHARCODE XCCSSTRING I))
-            DO
 (CL:UNLESS RAWFLG
-                   (SETQ CHARCODE (XTOUCODE
 CHARCODE)))
-               (IF
 (ILESSP CHARCODE 128)
-                   THEN
 (RPLCHARCODE USTR (ADD
 SINDEX 1)
-                               CHARCODE)
-                 ELSEIF
 (ILESSP CHARCODE 2048)
-                   THEN
                                      (* ; "x800")

-                        (RPLCHARCODE USTR (ADD
 SINDEX 1)
-                               (LOGOR (LLSH 3 6)
-                                      (LRSH CHARCODE 6)))
-                        (RPLCHARCODE USTR (ADD
 SINDEX 1)
-                               (LOGOR (LLSH 2 6)
-                                      (LOADBYTE CHARCODE 0 6)))
-                 ELSEIF
 (ILESSP CHARCODE 65536)
-                   THEN
                                      (* ; "x10000")

-                        (RPLCHARCODE USTR (ADD
 SINDEX 1)
-                               (LOGOR (LLSH 7 5)
-                                      (LRSH CHARCODE 12)))
-                        (RPLCHARCODE USTR (ADD
 SINDEX 1)
-                               (LOGOR (LLSH 2 6)
-                                      (LOADBYTE CHARCODE 6 6)))
-                        (RPLCHARCODE USTR (ADD
 SINDEX 1)
-                               (LOGOR (LLSH 2 6)
-                                      (LOADBYTE CHARCODE 0 6)))
-                 ELSEIF
 (ILESSP CHARCODE 2097152)
-                   THEN
                                      (* ; "x200000")

-                        (RPLCHARCODE USTR (ADD
 SINDEX 1)
-                               (LOGOR (LLSH 15 4)
-                                      (LRSH CHARCODE 18)))
-                        (RPLCHARCODE USTR (ADD
 SINDEX 1)
-                               (LOGOR (LLSH 2 6)
-                                      (LOADBYTE CHARCODE 12 6)))
-                        (RPLCHARCODE USTR (ADD
 SINDEX 1)
-                               (LOGOR (LLSH 2 6)
-                                      (LOADBYTE CHARCODE 6 6)))
-                        (RPLCHARCODE USTR (ADD
 SINDEX 1)
-                               (LOGOR (LLSH 2 6)
-                                      (LOADBYTE CHARCODE 0 6)))
-                 ELSE
 (SHOULDNT)))
-         USTR])
-
-(XCCSSTRING

-  [LAMBDA (CODE)
                                        (* ; "Edited 13-Aug-2020 12:16 by rmk:")

-
-    (* ;; "Returns XCCS character representation of string %"cset,char%"")

-
-    (CL:UNLESS (FIXP CODE)
-        (SETQ CODE (CHCON1 CODE)))
-    (CONCAT (OCTALSTRING (LRSH CODE 8))
-           ","
-           (OCTALSTRING (LOGAND CODE 255])
 )
 
 
@@ -1776,40 +1961,41 @@
 (DEFINEQ
 
 (SHOWCHARS

-  [LAMBDA (FROMCHAR TOCHAR FONT)
                             (* ; "Edited 26-Jan-2024 14:18 by mth")


+  [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:")

-    (RESETFORM (DSPFONT (OR FONT '(CLASSIC 12))
-                      T)
-           (CL:WHEN (AND (SMALLP FROMCHAR)
-                         (NOT TOCHAR))
-
-               (* ;; 
-
      "If a small number, assume it's an octal (in decimal) character set, no need for string quotes")

-
-               (SETQ TOCHAR (CONCAT FROMCHAR "," 376))
-               (SETQ FROMCHAR (CONCAT FROMCHAR "," 41)))
-           (CL:UNLESS (SMALLP FROMCHAR)
-               (SETQ FROMCHAR (CHARCODE.DECODE FROMCHAR)))
-           (CL:UNLESS (SMALLP TOCHAR)
-               (SETQ TOCHAR (CL:IF TOCHAR
-                                (CHARCODE.DECODE TOCHAR)
-                                FROMCHAR)))
-           (for
 C from
 FROMCHAR to
 TOCHAR unless
 (AND (IGEQ (LOGAND C 255)
-                                                            127)
-                                                      (ILEQ (LOGAND C 255)
-                                                            (PLUS 128 33)))
-              do
 (PRINTOUT T .P2 (CONCAT (OCTALSTRING (LRSH C 8))
-                                        ","
-                                        (OCTALSTRING (LOGAND C 255)))
-                        10
-                        (CHARACTER C)
-                        T])
+    [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])
 )
 (DECLARE%: DOEVAL@LOAD DONTCOPY 
 (DECLARE%: EVAL@COMPILE 
 
 (PUTPROPS HEXCHAR
 MACRO
 ((CODE)
-                         (HEXSTRING
 CODE)))
+                         (HEXSTRING CODE)))
 
 (PUTPROPS OCTALCHAR
 MACRO
 [(CODE)
                            (CONCAT (OCTALSTRING (\CHARSET CODE))
@@ -1825,23 +2011,25 @@
 
 (PUTPROPS UNICODE
 FILETYPE
 :TCOMPL)
 (DECLARE%: DONTCOPY
-  (FILEMAP (NIL (4369 19181 (UTF8.OUTCHARFN 4379 . 7286) (UTF8.SLUG.OUTCHARFN 7288 . 7843) (
-UTF8.INCCODEFN 7845 . 13457) (UTF8.PEEKCCODEFN 13459 . 18199) (\UTF8.BACKCCODEFN 18201 . 19179)) (
-19182 23436 (UTF16BE.OUTCHARFN 19192 . 20102) (UTF16BE.INCCODEFN 20104 . 21120) (UTF16BE.PEEKCCODEFN 
-21122 . 22353) (\UTF16BE.BACKCCODEFN 22355 . 23434)) (23437 27724 (UTF16LE.OUTCHARFN 23447 . 24454) (
-UTF16LE.INCCODEFN 24456 . 25472) (UTF16LE.PEEKCCODEFN 25474 . 26641) (\UTF16LE.BACKCCODEFN 26643 . 
-27722)) (27725 30772 (READBOM 27735 . 29804) (WRITEBOM 29806 . 30770)) (30802 34367 (
-MAKE-UNICODE-FORMATS 30812 . 34365)) (34464 38849 (UTF8.BINCODE 34474 . 37053) (\UTF8.FETCHCODE 37055
- . 38847)) (38850 44371 (UTF8.VALIDATE 38860 . 41457) (UTF8-SIZE-FROM-BYTE1 41459 . 41891) (
-NUTF8-BYTE1-BYTES 41893 . 42630) (NUTF8-CODE-BYTES 42632 . 43689) (NUTF8-STRING-BYTES 43691 . 44369)) 
-(46099 48246 (XTOUCODE 46109 . 46281) (UTOXCODE 46283 . 46564) (XTOUCODE? 46566 . 47387) (UTOXCODE? 
-47389 . 48244)) (49483 56904 (READ-UNICODE-MAPPING-FILENAMES 49493 . 53181) (READ-UNICODE-MAPPING 
-53183 . 56902)) (56971 68830 (MAKE-UNICODE-TRANSLATION-TABLES 56981 . 60073) (
-MERGE-UNICODE-TRANSLATION-TABLES 60075 . 62788) (UNICODE.UNMAPPED 62790 . 66005) (
-UNICODE-EXTEND-TRANSLATION? 66007 . 68828)) (68831 74210 (ALL-UNICODE-MAPPINGS 68841 . 74208)) (75801 
-88232 (WRITE-UNICODE-MAPPING 75811 . 79561) (WRITE-UNICODE-INCLUDED 79563 . 84285) (
-WRITE-UNICODE-MAPPING-HEADER 84287 . 85535) (WRITE-UNICODE-MAPPING-FILENAME 85537 . 87067) (HEXSTRING 
-87069 . 88230)) (88233 88909 (XCCS-UTF8-AFTER-OPEN 88243 . 88907)) (91434 96936 (UTF8HEXSTRING 91444
- . 93649) (XTOUSTRING 93651 . 96571) (XCCSSTRING 96573 . 96934)) (96963 98473 (SHOWCHARS 96973 . 98471
-)))))
+  (FILEMAP (NIL (4573 19821 (UTF8.OUTCHARFN 4583 . 7599) (UTF8.SLUG.OUTCHARFN 7601 . 8265) (
+UTF8.INCCODEFN 8267 . 13988) (UTF8.PEEKCCODEFN 13990 . 18839) (\UTF8.BACKCCODEFN 18841 . 19819)) (
+19822 24512 (UTF16BE.OUTCHARFN 19832 . 20851) (UTF16BE.INCCODEFN 20853 . 21978) (UTF16BE.PEEKCCODEFN 
+21980 . 23320) (\UTF16BE.BACKCCODEFN 23322 . 24510)) (24513 29236 (UTF16LE.OUTCHARFN 24523 . 25639) (
+UTF16LE.INCCODEFN 25641 . 26766) (UTF16LE.PEEKCCODEFN 26768 . 28044) (\UTF16LE.BACKCCODEFN 28046 . 
+29234)) (29237 32284 (READBOM 29247 . 31316) (WRITEBOM 31318 . 32282)) (32314 35879 (
+MAKE-UNICODE-FORMATS 32324 . 35877)) (35976 40470 (UTF8.BINCODE 35986 . 38674) (\UTF8.FETCHCODE 38676
+ . 40468)) (40471 46098 (UTF8.VALIDATE 40481 . 43078) (NUTF8-BYTE1-BYTES 43080 . 43817) (
+NUTF8-CODE-BYTES 43819 . 44876) (NUTF8-STRING-BYTES 44878 . 45774) (N-MCHARS 45776 . 46096)) (47826 
+56695 (MTOUCODE 47836 . 48223) (UTOMCODE 48225 . 48615) (MTOUCODE? 48617 . 49650) (UTOMCODE? 49652 . 
+50616) (MTOUSTRING 50618 . 51203) (UTOMSTRING 51205 . 51790) (MTOUTF8STRING 51792 . 55798) (
+UTF8TOMSTRING 55800 . 56693)) (56696 62398 (XTOUCODE 56706 . 57224) (UTOXCODE 57226 . 57734) (
+XTOUCODE? 57736 . 58797) (UTOXCODE? 58799 . 59882) (XTOUSTRING 59884 . 60577) (UTOXSTRING 60579 . 
+61320) (XTOUTF8STRING 61322 . 62396)) (63635 71937 (READ-UNICODE-MAPPING-FILENAMES 63645 . 67442) (
+READ-UNICODE-MAPPING 67444 . 71935)) (72004 86230 (MAKE-UNICODE-TRANSLATION-TABLES 72014 . 75770) (
+XCCSTOMCCS-MAPPING 75772 . 76989) (MERGE-UNICODE-TRANSLATION-TABLES 76991 . 79644) (UNICODE.UNMAPPED 
+79646 . 82970) (UNICODE-EXTEND-TRANSLATION? 82972 . 86228)) (86231 93067 (ALL-UNICODE-MAPPINGS 86241
+ . 91730) (XCCSJAPANESECHARSETS 91732 . 93065)) (94658 105926 (WRITE-UNICODE-MAPPING 94668 . 98418) (
+WRITE-UNICODE-INCLUDED 98420 . 103142) (WRITE-UNICODE-MAPPING-HEADER 103144 . 104392) (
+WRITE-UNICODE-MAPPING-FILENAME 104394 . 105924)) (105927 106603 (XCCS-UTF8-AFTER-OPEN 105937 . 106601)
+) (109128 111345 (UTF8HEXSTRING 109138 . 111343)) (111372 113414 (SHOWCHARS 111382 . 113412)))))
 STOP
diff --git a/library/UNICODE.LCOM b/library/UNICODE.LCOM
index b081f6240..32d12b9ed 100644
Binary files a/library/UNICODE.LCOM and b/library/UNICODE.LCOM differ
diff --git a/library/UNICODE.TEDIT b/library/UNICODE.TEDIT
index 24b030a6d..907f510f4 100644
Binary files a/library/UNICODE.TEDIT and b/library/UNICODE.TEDIT differ
diff --git a/library/UNIXCOMM b/library/UNIXCOMM
index a21d84584..02c27436d 100644
--- a/library/UNIXCOMM
+++ b/library/UNIXCOMM
@@ -1,16 +1,15 @@
 (DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
 
-
(FILECREATED "18-Dec-2022 11:55:01" {WMEDLEY}<library>UNIXCOMM.;11
 14599  
+
(FILECREATED " 2-Sep-2025 12:06:52" 
+{DSK}<Users>kaplan>Local>medley3.5>working-medley>library>UNIXCOMM.;14
 14825  
 
-      :CHANGES-TO (FNS INITIALIZE-SHELL-DEVICE UNIX-BACKFILEPTR UNIX-STREAM-EOFP)
-                  (VARS UNIXCOMMCOMS)
+      :EDIT-BY rmk
 
-      :PREVIOUS-DATE "25-Oct-2022 21:56:00" {WMEDLEY}<library>UNIXCOMM.;9)
+      :CHANGES-TO (FNS FORK-UNIX)
 
+      :PREVIOUS-DATE "29-Apr-2025 22:45:47" 
+{DSK}<Users>kaplan>Local>medley3.5>working-medley>library>UNIXCOMM.;13)
 
-(* ; "
-Copyright (c) 1988-1990, 2018, 2022 by Venue & Xerox Corporation.
-")
 
 (PRETTYCOMPRINT UNIXCOMMCOMS)
 
@@ -75,8 +74,13 @@ Copyright (c) 1988-1990, 2018, 2022 by Venue & Xerox Corporation.
       else
 (SUBRCALL UNIX-HANDLECOMM 4])
 
 (FORK-UNIX

-  [LAMBDA (STR)                                              (* ; "Edited 25-May-88 15:47 by drc:")

-    (SUBRCALL UNIX-HANDLECOMM 0 (\DTEST STR 'ONED-ARRAY])
+  [LAMBDA (STR)
                                              (* ; "Edited  2-Sep-2025 12:03 by rmk")


+                                                             (* ; "Edited 29-Apr-2025 22:45 by rmk")


+                                                             (* ; "Edited 25-May-88 15:47 by drc:")

+
+    (* ;; "MTOUBYTES converts MCCS codes to Unicodes, and then lays out the bytes of the UTF-8 encoding of those characters. ")

+
+    (SUBRCALL UNIX-HANDLECOMM 0 (MTOUTF8STRING (\DTEST STR 'ONED-ARRAY])
 
 (UNIX-KILL

   [LAMBDA (CONN)                                             (* ; "Edited 25-May-88 16:04 by drc:")

@@ -316,12 +320,11 @@ Copyright (c) 1988-1990, 2018, 2022 by Venue & Xerox Corporation.
 )
 
 (PUTPROPS UNIXCOMM
 FILETYPE
 COMPILE-FILE)
-(PUTPROPS UNIXCOMM COPYRIGHT ("Venue & Xerox Corporation" 1988 1989 1990 2018 2022))
 (DECLARE%: DONTCOPY
-  (FILEMAP (NIL (1963 7028 (FORK-SHELL 1973 . 3170) (FORK-UNIX 3172 . 3348) (UNIX-KILL 3350 . 3539) (
-UNIX-WRITE 3541 . 4252) (CREATE-SHELL-STREAM 4254 . 5138) (CREATE-PROCESS-STREAM 5140 . 5979) (
-UNIXCOMM-AROUNDEXITFN 5981 . 7026)) (7076 12267 (INITIALIZE-SHELL-DEVICE 7086 . 8514) (
-UNIX-GET-NEXT-BUFFER 8516 . 10716) (UNIX-BACKFILEPTR 10718 . 11130) (UNIX-STREAM-EOFP 11132 . 11613) (
-UNIX-STREAM-OUT 11615 . 11871) (UNIX-STREAM-CLOSE 11873 . 12265)) (12515 14221 (
-CREATE-UNIX-SOCKET-STREAM 12525 . 13331) (ACCEPT-UNIX-SOCKET-STREAM 13333 . 14219)))))
+  (FILEMAP (NIL (1903 7339 (FORK-SHELL 1913 . 3110) (FORK-UNIX 3112 . 3659) (UNIX-KILL 3661 . 3850) (
+UNIX-WRITE 3852 . 4563) (CREATE-SHELL-STREAM 4565 . 5449) (CREATE-PROCESS-STREAM 5451 . 6290) (
+UNIXCOMM-AROUNDEXITFN 6292 . 7337)) (7387 12578 (INITIALIZE-SHELL-DEVICE 7397 . 8825) (
+UNIX-GET-NEXT-BUFFER 8827 . 11027) (UNIX-BACKFILEPTR 11029 . 11441) (UNIX-STREAM-EOFP 11443 . 11924) (
+UNIX-STREAM-OUT 11926 . 12182) (UNIX-STREAM-CLOSE 12184 . 12576)) (12826 14532 (
+CREATE-UNIX-SOCKET-STREAM 12836 . 13642) (ACCEPT-UNIX-SOCKET-STREAM 13644 . 14530)))))
 STOP
diff --git a/library/UNIXCOMM.LCOM b/library/UNIXCOMM.LCOM
index 0e9e8dfa6..22c08221e 100644
Binary files a/library/UNIXCOMM.LCOM and b/library/UNIXCOMM.LCOM differ
diff --git a/library/tedit/TEDIT-ABBREV b/library/tedit/TEDIT-ABBREV
index c385e5a6d..d56df6b10 100644
--- a/library/tedit/TEDIT-ABBREV
+++ b/library/tedit/TEDIT-ABBREV
@@ -1,12 +1,14 @@
 (DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
 
-
(FILECREATED "11-Aug-2025 14:40:45" {WMEDLEY}<library>tedit>TEDIT-ABBREV.;25
 16417  
+
(FILECREATED " 5-Sep-2025 18:50:19" 
+{DSK}<Users>kaplan>Local>medley3.5>working-medley>library>tedit>TEDIT-ABBREV.;29
 17935  
 
       :EDIT-BY rmk
 
-      :CHANGES-TO (FNS \TEDIT.ABBREV.PARSE)
+      :CHANGES-TO (VARS TEDIT-ABBREVCOMS)
 
-      :PREVIOUS-DATE " 7-Aug-2025 12:50:55" {WMEDLEY}<library>tedit>TEDIT-ABBREV.;24)
+      :PREVIOUS-DATE " 5-Sep-2025 12:24:55" 
+{DSK}<Users>kaplan>Local>medley3.5>working-medley>library>tedit>TEDIT-ABBREV.;28)
 
 
 (PRETTYCOMPRINT TEDIT-ABBREVCOMS)
@@ -14,52 +16,60 @@
 (RPAQQ TEDIT-ABBREVCOMS

        [(FNS \TEDIT.ABBREV.EXPAND \TEDIT.ABBREV.PARSE \TEDIT.EXPAND.DATE \TEDIT.TRY.ABBREV)
         (GLOBALVARS TEDIT.ABBREVS)
-        (INITVARS (TEDIT.ABBREVS '(("b" . "357,146")
-                                   ("n" . "357,44")
-                                   ("m" . "357,45")
-                                   ("T" . "357,57")
-                                   ("d" . "357,60")
-                                   ("D" . "357,61")
-                                   ("s" . "0,247")
-                                   ("'" . "0,271")
-                                   ("`" . "0,251")
-                                   ("%"" . "0,252")
-                                   ("~" . "0,272")
-                                   ("1/4" . "0,274")
-                                   ("1/2" . "0,275")
-                                   ("3/4" . "0,276")
-                                   ("1/3" . "357,375")
-                                   ("2/3" . "357,376")
-                                   ("c" . "0,323")
-                                   ("c/o" . "357,100")
-                                   ("%%" . "357,100")
-                                   ("->" . "0,256")
-                                   ("ra" . "0,256")
-                                   ("|" . "0,257")
-                                   ("da" . "0,257")
-                                   ("^" . "0,255")
-                                   ("ua" . "0,255")
-                                   ("<-" . "0,254")
-                                   ("la" . "0,254")
-                                   ("_" . "0,254")
-                                   ("L" . "0,243")
-                                   ("o" . "0,260")
-                                   ("Y" . "0,245")
-                                   ("+" . "0,261")
-                                   ("x" . "0,264")
-                                   ("/" . "0,270")
-                                   ("=" . "357,121")
-                                   ("p" . "0,266")
-                                   ("r" . "0,322")
-                                   ("t" . "0,324")
-                                   ("tm" . "0,324")
-                                   ("box" . "42,42")
-                                   ("cbox" . "42,61")
-                                   ("-" . "357,43")
-                                   ("=" . "357,42")
-                                   (" " . "357,41")
-                                   ("DATE" . \TEDIT.EXPAND.DATE)
-                                   (">>DATE<<" . \TEDIT.EXPAND.DATE])
+        (INITVARS (TEDIT.ABBREVS '(("b" "357,146" Bullet)
+                                   ("n" "357,44" Endash)
+                                   ("--" "357,44" Endash)
+                                   ("m" EMDASH)
+                                   ("---" EMDASH)
+                                   ("T" THINSPACE)
+                                   ("d" "357,60" Dagger)
+                                   ("D" "357,61" DoubleDagger)
+                                   ("s" "0,247" Section)
+                                   ("'" "0,271" RSQ)
+                                   ("`" "0,251" LSQ)
+                                   ("%"" LEFT-DOUBLEQUOTE)
+                                   ("~" RIGHT-DOUBLEQUOTE)
+                                   ("1/4" "0,274")
+                                   ("1/2" "0,275")
+                                   ("3/4" "0,276")
+                                   ("1/3" "357,375")
+                                   ("2/3" "357,376")
+                                   ("c" "0,323" Copyright)
+                                   ("c/o" "357,100" c/o)
+                                   ("%%" "357,100" c/o)
+                                   ("->" "0,256" Rightarrow)
+                                   ("ra" "0,256" Rightarrow)
+                                   ("|" "0,257" Downarrow)
+                                   ("da" "0,257" Downarrow)
+                                   ("L" "0,243" English-pound)
+                                   ("o" "0,260" Degree)
+                                   ("Y" "0,245" Yen)
+                                   ("+" "0,261" PlusMinus)
+                                   ("x" "0,264" Times)
+                                   ("/" "0,270" Divide)
+                                   ("=" "357,121")
+                                   ("p" "0,266" Paragraph)
+                                   ("r" "0,322" Register)
+                                   ("t" "0,324" Trademark)
+                                   ("tm" "0,324" Trademark)
+                                   ("bbox" "42,43" Blackbox)
+                                   ("wbox" "43,42" Whitebox)
+                                   ("-" SOFT-HYPHEN)
+                                   ("=" NONBREAKING-HYPHEN)
+                                   (" " NONBREAKING-SPACE)
+                                   ("un" "357,127")
+                                   ("int" "357,126")
+                                   ("subset" "357,131")
+                                   ("superset" "357,130")
+                                   ("&" "357,266")
+                                   ("or" "357,267")
+                                   ("not" "357,152")
+                                   ("all" "357,265")
+                                   ("exist" "357,264")
+                                   ("def" "357,162")
+                                   ("compose" "357,147")
+                                   ("DATE" \TEDIT.EXPAND.DATE)
+                                   (">>DATE<<" \TEDIT.EXPAND.DATE])
 (DEFINEQ
 
 (\TEDIT.ABBREV.EXPAND

@@ -224,38 +234,46 @@
                           " " DAY ", " YEAR])
 
 (\TEDIT.TRY.ABBREV

-  [LAMBDA (KEY TSTREAM)
                                      (* ; "Edited 20-Mar-2025 21:52 by rmk")


+  [LAMBDA (KEY TSTREAM)
                                      (* ; "Edited  5-Sep-2025 12:24 by rmk")


+                                                             (* ; "Edited 20-Mar-2025 21:52 by rmk")


                                                             (* ; "Edited  6-Aug-2020 14:41 by rmk:")

                                                              (* jds "11-Jul-85 12:46")

 
     (* ;; "Decode the expansion. A string may be a character name, otherwise itself.  A litatom is a function to be applied, anything else is evaled. ")

 
-    (LET ((ABBREV (SASSOC KEY TEDIT.ABBREVS)))
+    (LET [(ABBREV (CDR (SASSOC KEY TEDIT.ABBREVS]
+         (CL:WHEN (LISTP ABBREV)                             (* ; "Originally stored in the CDR")

+             (SETQ ABBREV (CAR ABBREV)))
          (if
 (NULL ABBREV)
              then
 (CL:WHEN (CHARCODE.DECODE KEY T)
                       (CHARACTER (CHARCODE.DECODE KEY T)))
-           elseif
 (STRINGP (CDR ABBREV))
+           elseif
 (STRINGP ABBREV)
              then
 
                   (* ;; "Could be a character code")

 
-                  (LET ((CH (CHARCODE.DECODE (CDR ABBREV)
-                                   T)))
+                  (LET ((CH (CHARCODE.DECODE ABBREV T)))
                        (CL:IF CH
                            (CHARACTER CH)
-                           (CDR ABBREV)))
-           elseif
 (SMALLP (CDR ABBREV))
+                           ABBREV))
+           elseif
 (SMALLP ABBREV)
              then
 
                   (* ;; "Treat a number as a character code.")

 
-                  (CHARACTER (CDR ABBREV))
-           elseif
 (AND (LITATOM (CDR ABBREV))
-                       (GETD (CDR ABBREV)))
-             then
                                            (* ; "It's a function to be called.")

-                  (APPLY* (CDR ABBREV)
-                         TSTREAM
-                         (CAR ABBREV))
-           else
                                              (* ; "Anything else is a form to EVAL.")

-                (EVAL (CDR ABBREV])
+                  (CHARACTER ABBREV)
+           elseif
 (AND (LITATOM ABBREV)
+                       (GETD ABBREV))
+             then
                                            (* ; " A function to be applied.")

+                  (APPLY* ABBREV TSTREAM KEY)
+           elseif
 (LISTP ABBREV)
+             then
                                            (* ; "Form in the CADR, now")

+                  (EVAL ABBREV)
+           elseif
 (AND (SETQ ABBREV (CDR (SASSOC KEY TEDIT.ABBREVS)))
+                       (LITATOM (CAR ABBREV))
+                       (GETD (CAR ABBREV)))
+             then
 
+                  (* ;; "Form in the CDR, originally")

+
+                  (EVAL ABBREV])
 )
 (DECLARE%: DOEVAL@COMPILE DONTCOPY
 
@@ -263,53 +281,61 @@
 )
 
 (RPAQ? TEDIT.ABBREVS

-       '(("b" . "357,146")
-         ("n" . "357,44")
-         ("m" . "357,45")
-         ("T" . "357,57")
-         ("d" . "357,60")
-         ("D" . "357,61")
-         ("s" . "0,247")
-         ("'" . "0,271")
-         ("`" . "0,251")
-         ("%"" . "0,252")
-         ("~" . "0,272")
-         ("1/4" . "0,274")
-         ("1/2" . "0,275")
-         ("3/4" . "0,276")
-         ("1/3" . "357,375")
-         ("2/3" . "357,376")
-         ("c" . "0,323")
-         ("c/o" . "357,100")
-         ("%%" . "357,100")
-         ("->" . "0,256")
-         ("ra" . "0,256")
-         ("|" . "0,257")
-         ("da" . "0,257")
-         ("^" . "0,255")
-         ("ua" . "0,255")
-         ("<-" . "0,254")
-         ("la" . "0,254")
-         ("_" . "0,254")
-         ("L" . "0,243")
-         ("o" . "0,260")
-         ("Y" . "0,245")
-         ("+" . "0,261")
-         ("x" . "0,264")
-         ("/" . "0,270")
-         ("=" . "357,121")
-         ("p" . "0,266")
-         ("r" . "0,322")
-         ("t" . "0,324")
-         ("tm" . "0,324")
-         ("box" . "42,42")
-         ("cbox" . "42,61")
-         ("-" . "357,43")
-         ("=" . "357,42")
-         (" " . "357,41")
-         ("DATE" . \TEDIT.EXPAND.DATE)
-         (">>DATE<<" . \TEDIT.EXPAND.DATE)))
+       '(("b" "357,146" Bullet)
+         ("n" "357,44" Endash)
+         ("--" "357,44" Endash)
+         ("m" EMDASH)
+         ("---" EMDASH)
+         ("T" THINSPACE)
+         ("d" "357,60" Dagger)
+         ("D" "357,61" DoubleDagger)
+         ("s" "0,247" Section)
+         ("'" "0,271" RSQ)
+         ("`" "0,251" LSQ)
+         ("%"" LEFT-DOUBLEQUOTE)
+         ("~" RIGHT-DOUBLEQUOTE)
+         ("1/4" "0,274")
+         ("1/2" "0,275")
+         ("3/4" "0,276")
+         ("1/3" "357,375")
+         ("2/3" "357,376")
+         ("c" "0,323" Copyright)
+         ("c/o" "357,100" c/o)
+         ("%%" "357,100" c/o)
+         ("->" "0,256" Rightarrow)
+         ("ra" "0,256" Rightarrow)
+         ("|" "0,257" Downarrow)
+         ("da" "0,257" Downarrow)
+         ("L" "0,243" English-pound)
+         ("o" "0,260" Degree)
+         ("Y" "0,245" Yen)
+         ("+" "0,261" PlusMinus)
+         ("x" "0,264" Times)
+         ("/" "0,270" Divide)
+         ("=" "357,121")
+         ("p" "0,266" Paragraph)
+         ("r" "0,322" Register)
+         ("t" "0,324" Trademark)
+         ("tm" "0,324" Trademark)
+         ("bbox" "42,43" Blackbox)
+         ("wbox" "43,42" Whitebox)
+         ("-" SOFT-HYPHEN)
+         ("=" NONBREAKING-HYPHEN)
+         (" " NONBREAKING-SPACE)
+         ("un" "357,127")
+         ("int" "357,126")
+         ("subset" "357,131")
+         ("superset" "357,130")
+         ("&" "357,266")
+         ("or" "357,267")
+         ("not" "357,152")
+         ("all" "357,265")
+         ("exist" "357,264")
+         ("def" "357,162")
+         ("compose" "357,147")
+         ("DATE" \TEDIT.EXPAND.DATE)
+         (">>DATE<<" \TEDIT.EXPAND.DATE)))
 (DECLARE%: DONTCOPY
-  (FILEMAP (NIL (2933 15073 (\TEDIT.ABBREV.EXPAND 2943 . 5163) (\TEDIT.ABBREV.PARSE 5165 . 12775) (
-\TEDIT.EXPAND.DATE 12777 . 13410) (\TEDIT.TRY.ABBREV 13412 . 15071)))))
+  (FILEMAP (NIL (3630 16182 (\TEDIT.ABBREV.EXPAND 3640 . 5860) (\TEDIT.ABBREV.PARSE 5862 . 13472) (
+\TEDIT.EXPAND.DATE 13474 . 14107) (\TEDIT.TRY.ABBREV 14109 . 16180)))))
 STOP
diff --git a/library/tedit/TEDIT-ABBREV.LCOM b/library/tedit/TEDIT-ABBREV.LCOM
index 233c33254..be684734b 100644
Binary files a/library/tedit/TEDIT-ABBREV.LCOM and b/library/tedit/TEDIT-ABBREV.LCOM differ
diff --git a/library/tedit/TEDIT-FILE b/library/tedit/TEDIT-FILE
index 73ba463d5..7ac1a3fef 100644
--- a/library/tedit/TEDIT-FILE
+++ b/library/tedit/TEDIT-FILE
@@ -1,16 +1,14 @@
 (DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
 
-
(FILECREATED " 1-Aug-2025 14:53:19" 
-{DSK}<Users>kaplan>Local>medley3.5>working-medley>library>tedit>TEDIT-FILE.;645
 169238 
+
(FILECREATED "25-Sep-2025 21:32:46" 
+{DSK}<Users>kaplan>Local>medley3.5>working-medley>library>tedit>TEDIT-FILE.;655
 173148 
 
       :EDIT-BY rmk
 
-      :CHANGES-TO (FNS \TEDIT.GET.CHARLOOKS \TEDIT.FORMATTEDSTREAMP \TEDIT.GET.OBJECT 
-                       \TEDIT.PUT.PCTB.MERGEABLE \TEDIT.PUT.CHARLOOKS \TEDIT.GET.SINGLE.CHARLOOKS 
-                       \TEDIT.PUT.SINGLE.CHARLOOKS)
+      :CHANGES-TO (FNS \TEDIT.GET.FORMATTED.FILE \TEDIT.PUT.SINGLE.CHARLOOKS 
+                       \TEDIT.GET.SINGLE.CHARLOOKS)
 
-      :PREVIOUS-DATE "29-Jul-2025 09:30:44" 
-{DSK}<Users>kaplan>Local>medley3.5>working-medley>library>tedit>TEDIT-FILE.;642)
+      :PREVIOUS-DATE " 9-Sep-2025 21:49:43" {WMEDLEY}<library>tedit>TEDIT-FILE.;653)
 
 
 (PRETTYCOMPRINT TEDIT-FILECOMS)
@@ -25,7 +23,8 @@
                                                 (\PieceDescriptorSAFEOBJECT 6)
                                                 (\PieceDescriptorMETAINFO 7)
                                                 (\PieceDescriptorPROPERTIES 8))
-               (EXPORT (MACROS \SMALLPIN \SMALLPOUT)))
+               (EXPORT (MACROS \SMALLPIN \SMALLPOUT))
+               (RECORDS \TEDIT.FILETRAILER))
         (COMS 
               (* ;; "Public entries ")

 
@@ -39,7 +38,7 @@
 
  "Until CL:COMPILE-FILE and any others are updated, They should use the public TEDIT.FORMATTEDFILEP")

 
                     (P (MOVD? '\TEDIT.GET.TRAILER '\TEDIT.FORMATTEDP1]
-              (FNS \TEDIT.GET.PIECES3 \TEDIT.GET.IDATE3 \TEDIT.MAKE.STRINGPIECE)
+              (FNS \TEDIT.GET.PIECES3 \TEDIT.GET.PROPS3 \TEDIT.MAKE.STRINGPIECE)
               (FNS \TEDIT.GET.UNFORMATTED.FILE.MCCS \TEDIT.INTERPRET.MCCS.SHIFTS 
                    \TEDIT.CONVERT.XCCSTOMCCS)
                                                              (* ; "XCCS")

@@ -115,6 +114,11 @@
 
 (* "END EXPORTED DEFINITIONS")
 
+
+(DECLARE%: EVAL@COMPILE
+
+(RECORD \TEDIT.FILETRAILER
 (PIECESTART TRAILERSIZE VERSION PCCOUNT IDATE PROPS))
+)
 )
 
 
@@ -242,7 +246,8 @@
                  (\TEDIT.GET.TRAILER
 STREAM))))])
 
 (TEDIT.FILEDATE

-  [LAMBDA (FILE INTEGER)
                                     (* ; "Edited 26-Mar-2024 21:37 by rmk")


+  [LAMBDA (FILE INTEGER)
                                     (* ; "Edited  8-Sep-2025 18:26 by rmk")


+                                                             (* ; "Edited 26-Mar-2024 21:37 by rmk")


                                                              (* ; "Edited 18-Jan-2024 10:26 by rmk")


                                                              (* ; "Edited 13-Jan-2024 10:20 by rmk")


                                                              (* ; "Edited 19-Dec-2023 10:13 by rmk")


@@ -253,7 +258,8 @@
 
     (* ;; "FILE must be random access.  If not, then presumably we first have to fetch the last 5+4+8 bytes to someplace else.")

 
-    (LET [(IDATE (CAR (LAST (TEDIT.FORMATTEDFILEP
 FILE]
+    (LET [(IDATE (CAR (NTH (TEDIT.FORMATTEDFILEP
 FILE)
+                           5]
          (CL:WHEN IDATE
              (CL:IF INTEGER
                  IDATE
@@ -702,7 +708,10 @@
              (\TEDIT.INSERTPIECES PIECES NIL TEXTOBJ)))])
 
 (\TEDIT.GET.FORMATTED.FILE

-  [LAMBDA (TEXT TSTREAM START END PROPS)
                     (* ; "Edited 28-Mar-2025 14:15 by rmk")


+  [LAMBDA (TEXT TSTREAM START END PROPS)
                     (* ; "Edited 25-Sep-2025 21:27 by rmk")


+                                                             (* ; "Edited  9-Sep-2025 21:45 by rmk")


+                                                             (* ; "Edited  7-Sep-2025 12:14 by rmk")


+                                                             (* ; "Edited 28-Mar-2025 14:15 by rmk")


                                                              (* ; "Edited  7-Feb-2025 08:19 by rmk")


                                                              (* ; "Edited 28-Oct-2024 17:48 by rmk")


                                                              (* ; "Edited 21-Oct-2024 00:33 by rmk")


@@ -719,13 +728,14 @@
 
     (* ;; "Returns NIL if TSTREAM is not a formatted file, otherwise the ")

 
-    (LET ((TEXTOBJ (TEXTOBJ! (GETTSTR TSTREAM TEXTOBJ)))
+    (LET ((TEXTOBJ (FTEXTOBJ TSTREAM))
           (TRAILER (\TEDIT.GET.TRAILER
 TEXT END))
-          PCCOUNT IDATE PC)
+          PCCOUNT IDATE PROPS PC)
          (CL:WHEN TRAILER
              (SETTOBJ TEXTOBJ TXTPAGEFRAMES NIL)
-             (SETQ PCCOUNT (CADDDR TRAILER))
-             (SELECTQ (CADDR TRAILER)
+             (FSETTOBJ TEXTOBJ DOCPROPS (fetch
 (\TEDIT.FILETRAILER PROPS) of
 TRAILER))
+             (SETQ PCCOUNT (fetch
 (\TEDIT.FILETRAILER PCCOUNT) of
 TRAILER))
+             (SELECTQ (fetch
 (\TEDIT.FILETRAILER VERSION) of
 TRAILER)
                  (3                                          (* ; "Version 3")

                     (\TEDIT.INSERTPIECES (\TEDIT.GET.PIECES3
 TEXT TSTREAM PCCOUNT START END)
                            NIL TEXTOBJ))
@@ -740,7 +750,9 @@
                  (\TEDIT.THELP "File format version incompatible with this version of TEdit."))
              (CL:WHEN (SETQ PC (\TEDIT.LASTPIECE TEXTOBJ))
                     (FSETPC PC PPARALAST T))
-             (\TEDIT.TRANSLATE.ASCIICHARS TSTREAM NIL)
+             (CL:UNLESS (EQ 'MCCS (GETMULTI (FGETTOBJ TEXTOBJ DOCPROPS)
+                                         'CHARENCODING))
+                    (\TEDIT.MCCS.TRANSLATE TSTREAM))
              TEXTOBJ)])
 
 (\TEDIT.FORMATTEDSTREAMP

@@ -844,19 +856,20 @@
           (RETURN STR])
 
 (\TEDIT.GET.TRAILER

-  [LAMBDA (STREAM LEN)
                                       (* ; "Edited 26-Mar-2024 21:36 by rmk")


+  [LAMBDA (STREAM LEN)
                                       (* ; "Edited  9-Sep-2025 00:03 by rmk")


+                                                             (* ; "Edited 26-Mar-2024 21:36 by rmk")


                                                              (* ; "Edited 18-Jan-2024 10:22 by rmk")


                                                              (* ; "Edited 16-Jan-2024 22:39 by rmk")


                                                              (* ; "Edited 15-Jan-2024 17:38 by rmk")


                                                              (* ; "Edited 13-Jan-2024 21:49 by rmk")

 
-    (* ;; "For an open formatted stream, returns a list (VERSION PCCOUNT DESCPTR IDATE) where DESCPTR is the byte position of the first piece.  Returns NIL if it is not a formatted stream. Either way, the file is left at position 0 FWIW ")

+    (* ;; "For an open formatted stream, returns a list (PIECESTART TRAILERSIZE VERSION PCCOUNT IDATE PROPS) where PIECESTART is the byte position of the first piece.  Returns NIL if it is not a formatted stream. Either way, the file is left at position 0 FWIW ")

 
     (* ;; "If STREAM is the format-stream split of a complete Tedit file, then PIECESTART is the position in that larger file that this section was taken from, and 0 in STREAM corresponds to PIECESTART in that file.  TRAILERSIZE")

 
     (SETQ LEN (OR LEN (GETEOFPTR STREAM)))
     (CL:WHEN (IGREATERP LEN 8)
-        (LET (PIECESTART TRAILERSIZE PCCOUNT VERSION IDATE)
+        (LET (PIECESTART TRAILERSIZE PCCOUNT VERSION IDATE PROPS)
              (SETFILEPTR STREAM (IDIFFERENCE LEN 8))         (* ; 
 
                                                           "Move to start of FILEPTR to descriptions")

              (SETQ PIECESTART (\DWIN
 STREAM))                (* ; 
@@ -866,15 +879,21 @@
                                   31415))
              (PROG1 (SELECTQ VERSION
                         (3                                   (* ; "Current version")

-                           [SETQ IDATE (OR (\TEDIT.GET.IDATE3
 STREAM LEN)
-                                           (GETFILEINFO STREAM 'ICREATIONDATE]
-                           (SETQ TRAILERSIZE (IPLUS 8 (CL:IF IDATE
-                                                          (IPLUS (CONSTANT (NCHARS "DATE:"))
-                                                                 4)
-                                                          0)))
-                           (LIST PIECESTART TRAILERSIZE VERSION PCCOUNT IDATE))
+                           (CL:MULTIPLE-VALUE-SETQ (TRAILERSIZE IDATE PROPS)
+                                  (\TEDIT.GET.PROPS3
 STREAM LEN))
+                           (create
 \TEDIT.FILETRAILER
+                                  PIECESTART _ PIECESTART
+                                  TRAILERSIZE _ TRAILERSIZE
+                                  VERSION _ VERSION
+                                  PCCOUNT _ PCCOUNT
+                                  IDATE _ IDATE
+                                  PROPS _ PROPS))
                         ((2 1 0) 
-                             (LIST PIECESTART 8 VERSION PCCOUNT))
+                             (create
 \TEDIT.FILETRAILER
+                                    PIECESTART _ PIECESTART
+                                    TRAILERSIZE _ 8
+                                    VERSION _ VERSION
+                                    PCCOUNT _ PCCOUNT))
                         NIL)
                     (SETFILEPTR STREAM 0))))])
 
@@ -1065,32 +1084,62 @@
                                           NIL)
                                       (RETURN PC])
 
-(\TEDIT.GET.IDATE3

-  [LAMBDA (STREAM END)
                                       (* ; "Edited  6-Dec-2023 16:55 by rmk")

+(\TEDIT.GET.PROPS3

+  [LAMBDA (STREAM END)
                                       (* ; "Edited  9-Sep-2025 21:49 by rmk")


+                                                             (* ; "Edited  6-Dec-2023 16:55 by rmk")

+
+    (* ;; "Returns the integer IDATE for slightly updated version 3 files, the directory idate if there is no date in the file.  At exit resets to starting position (assumes an error wouldn't matter).")

 
-    (* ;; "Returns the integer IDATE for slightly updated version 3 files, otherwise NIL.  4 for the bytes of the IDATE, 8 for the header. Leaves resets to starting position (assumes an error wouldn't matter).")

+    (* ;; "Before the date there may also be a property list, unseen by pre MCCS code. This is headed by PROPS: followed by a pointer to the first byte of the property list, which can be READ.")

 
-    (CL:WHEN (IGREATERP END (IPLUS (CONSTANT (NCHARS "DATE:"))
-                                   4 8))
-        (LET ((FILEPTR (GETFILEPTR STREAM)))
-             (SETFILEPTR STREAM (IDIFFERENCE END (IPLUS (CONSTANT (NCHARS "DATE:"))
-                                                        4 8)))
+    (CL:WHEN (IGREATERP END (CONSTANT (IPLUS (NCHARS "DATE:")
+                                             4 8)))
+        (LET ((ORIGPTR (GETFILEPTR STREAM))
+              [DATEPTR (IDIFFERENCE END (CONSTANT (IPLUS (NCHARS "DATE:")
+                                                         4 8]
+              (TRAILERSIZE 8)
+              IDATE PROPSLEN PROPS)
+             (SETFILEPTR STREAM DATEPTR)
 
              (* ;; 
 
     "DATE: is the marker for this extension to version 3 (could be removed if version is update).  ")

 
-             (PROG1 (CL:WHEN (AND (EQ (CHARCODE D)
-                                      (BIN STREAM))
-                                  (EQ (CHARCODE A)
-                                      (BIN STREAM))
-                                  (EQ (CHARCODE T)
-                                      (BIN STREAM))
-                                  (EQ (CHARCODE E)
-                                      (BIN STREAM))
-                                  (EQ (CHARCODE %:)
-                                      (BIN STREAM)))
-                           (\DWIN
 STREAM))
-                    (SETFILEPTR STREAM FILEPTR))))])
+             (CL:WHEN (AND (EQ (CHARCODE D)
+                               (BIN STREAM))
+                           (EQ (CHARCODE A)
+                               (BIN STREAM))
+                           (EQ (CHARCODE T)
+                               (BIN STREAM))
+                           (EQ (CHARCODE E)
+                               (BIN STREAM))
+                           (EQ (CHARCODE %:)
+                               (BIN STREAM)))
+                 (SETQ IDATE (\DWIN
 STREAM))
+                 (add
 TRAILERSIZE (CONSTANT (IPLUS (NCHARS "DATE:")
+                                                   4)))
+                 (CL:WHEN [IGREATERP END (IPLUS TRAILERSIZE (CONSTANT (IPLUS (NCHARS "PROPS:")
+                                                                             4]
+                     [SETFILEPTR STREAM (IDIFFERENCE DATEPTR (CONSTANT (IPLUS (NCHARS "PROPS:")
+                                                                              4]
+                     (CL:WHEN (AND (EQ (CHARCODE P)
+                                       (BIN STREAM))
+                                   (EQ (CHARCODE R)
+                                       (BIN STREAM))
+                                   (EQ (CHARCODE O)
+                                       (BIN STREAM))
+                                   (EQ (CHARCODE P)
+                                       (BIN STREAM))
+                                   (EQ (CHARCODE S)
+                                       (BIN STREAM))
+                                   (EQ (CHARCODE %:)
+                                       (BIN STREAM)))
+                         (SETQ PROPSLEN (\DWIN
 STREAM))
+                         (SETFILEPTR STREAM (IDIFFERENCE DATEPTR PROPSLEN))
+                         (SETQ PROPS (CAR (READ STREAM *TEDIT-FILE-READTABLE*)))
+                         (add
 TRAILERSIZE PROPSLEN))))
+             (SETFILEPTR STREAM ORIGPTR)
+             (CL:VALUES TRAILERSIZE (OR IDATE (GETFILEINFO STREAM 'ICREATIONDATE))
+                    PROPS)))])
 
 (\TEDIT.MAKE.STRINGPIECE

   [LAMBDA (PC STRING)
                                        (* ; "Edited 23-Jan-2024 14:32 by rmk")


@@ -1456,7 +1505,9 @@
     (for
 I from
 1 to
 (\WIN FILE) collect
 (\TEDIT.GET.SINGLE.CHARLOOKS
 FILE TEXTOBJ])
 
 (\TEDIT.GET.SINGLE.CHARLOOKS

-  [LAMBDA (FILE TEXTOBJ)
                                     (* ; "Edited  1-Aug-2025 13:43 by rmk")


+  [LAMBDA (FILE TEXTOBJ)
                                     (* ; "Edited 25-Sep-2025 18:30 by rmk")


+                                                             (* ; "Edited  7-Sep-2025 11:04 by rmk")


+                                                             (* ; "Edited  1-Aug-2025 13:43 by rmk")


                                                              (* ; "Edited 26-Jul-2025 11:14 by rmk")


                                                              (* ; "Edited 21-Jul-2025 23:41 by rmk")


                                                              (* ; "Edited 20-Jul-2025 13:14 by rmk")


@@ -1554,7 +1605,6 @@
                                                               'R)
                                                           'R]
            (FSETCLOOKS LOOKS CLFONT FONT)
-           (FSETCLOOKS LOOKS CLNAME (FONTUNPARSE FONT))
            (SETFILEPTR FILE (IPLUS FILEPOS LOOKSLEN))
            (RETURN LOOKS])
 
@@ -1781,6 +1831,7 @@
 
 (\TEDIT.PUT.PCTB

   [LAMBDA (TEXTOBJ CHARSTREAM FORMATSTREAM CONTINUE KEEPSEPARATE)

+                                                             (* ; "Edited  9-Sep-2025 21:32 by rmk")


                                                              (* ; "Edited 26-Apr-2025 00:11 by rmk")


                                                              (* ; "Edited 21-Oct-2024 00:33 by rmk")


                                                              (* ; "Edited 15-May-2024 17:03 by rmk")


@@ -1908,7 +1959,7 @@
                                          (CL:UNLESS UNFORMATTED?
                                              (\TEDIT.PUT.TRAILER
 FORMATSTREAM (\GETFILEPTR CHARSTREAM
                                                                                      )
-                                                    PCCOUNT 3))
+                                                    PCCOUNT 3 (FGETTOBJ TEXTOBJ DOCPROPS)))
                                          (CL:UNLESS (OR UNFORMATTED? KEEPSEPARATE)
                                              (COPYBYTES FORMATSTREAM CHARSTREAM 0 (GETEOFPTR 
                                                                                          FORMATSTREAM
@@ -1968,16 +2019,24 @@
              (\TEDIT.THELP "OTHER PTYPES"])
 
 (\TEDIT.PUT.TRAILER

-  [LAMBDA (FORMATSTREAM PIECESTART PCCOUNT VERSION)
          (* ; "Edited 13-Jan-2024 10:13 by rmk")

+  [LAMBDA (FORMATSTREAM PIECESTART PCCOUNT VERSION PROPS)
    (* ; "Edited  9-Sep-2025 17:55 by rmk")


+                                                             (* ; "Edited 13-Jan-2024 10:13 by rmk")

 
     (* ;; "Finalize FORMATSTREAM.  We sneak in the date here--at the end of the looks, after the last look but before the final pointers, so that it doesn't interfere with anything.  TEDIT.FILEDATE pulls it out if it's there.")

 
-    (PRIN1 "DATE:" FORMATSTREAM)
-    (\DWOUT
 FORMATSTREAM (IDATE))
-    (\DWOUT
 FORMATSTREAM PIECESTART)                         (* ; "Position of the first piece")

-    (\WOUT FORMATSTREAM PCCOUNT)                             (* ; 
+    (LET ((PROPSPTR (GETFILEPTR FORMATSTREAM)))
+         (CL:WHEN PROPS                                      (* ; "CONS to protect an atom or number")

+             (PRIN2 (CONS PROPS)
+                    FORMATSTREAM *TEDIT-FILE-READTABLE*)
+             (PRIN1 "PROPS:" FORMATSTREAM)
+             (\DWOUT
 FORMATSTREAM (IPLUS 4 (IDIFFERENCE (GETFILEPTR FORMATSTREAM)
+                                                  PROPSPTR))))
+         (PRIN1 "DATE:" FORMATSTREAM)
+         (\DWOUT
 FORMATSTREAM (IDATE))
+         (\DWOUT
 FORMATSTREAM PIECESTART)                    (* ; "Position of the first piece")

+         (\WOUT FORMATSTREAM PCCOUNT)                        (* ; 
 
                                                          "Number of pieces followed by the password")

-    (\WOUT FORMATSTREAM (IPLUS 31415 VERSION])
+         (\WOUT FORMATSTREAM (IPLUS 31415 VERSION])
 
 (\TEDIT.PUT.PCTB.MERGEABLE

   [LAMBDA (PREVPC PC EDITSTENTATIVE EXTFORMAT TEXTOBJ)
       (* ; "Edited  1-Aug-2025 14:51 by rmk")


@@ -2272,7 +2331,8 @@
                                            (PUTHASH LOOKS I LOOKSHASH])
 
 (\TEDIT.PUT.SINGLE.CHARLOOKS

-  [LAMBDA (FORMATSTREAM LOOKS)
                               (* ; "Edited  1-Aug-2025 13:42 by rmk")


+  [LAMBDA (FORMATSTREAM LOOKS)
                               (* ; "Edited 25-Sep-2025 18:31 by rmk")


+                                                             (* ; "Edited  1-Aug-2025 13:42 by rmk")


                                                              (* ; "Edited 21-Jul-2025 23:32 by rmk")


                                                              (* ; "Edited 20-Jul-2025 13:17 by rmk")


                                                              (* ; "Edited 22-Apr-2025 14:50 by rmk")


@@ -2634,28 +2694,28 @@
 
 (RPAQ? *TEDIT-FILE-READTABLE*
 (COPYREADTABLE \ORIGREADTABLE))
 (DECLARE%: DONTCOPY
-  (FILEMAP (NIL (5423 35544 (TEDIT.GET 5433 . 11843) (TEDIT.FORMATTEDFILEP 11845 . 13161) (
-TEDIT.FILEDATE 13163 . 14334) (TEDIT.INCLUDE 14336 . 22365) (TEDIT.RAW.INCLUDE 22367 . 23175) (
-TEDIT.PUT 23177 . 31533) (TEDIT.PUT.STREAM 31535 . 35542)) (35545 55851 (\TEDIT.GET.FOREIGN.FILE 35555
- . 38980) (\TEDIT.GET.UNFORMATTED.FILE 38982 . 43288) (\TEDIT.GET.FORMATTED.FILE 43290 . 46317) (
-\TEDIT.FORMATTEDSTREAMP 46319 . 49450) (\ARBIN 49452 . 50172) (\ATMIN 50174 . 50711) (\DWIN 50713 . 
-51092) (\STRINGIN 51094 . 51802) (\TEDIT.GET.TRAILER 51804 . 54320) (\TEDIT.CACHEFILE 54322 . 55849)) 
-(56017 70228 (\TEDIT.GET.PIECES3 56027 . 66990) (\TEDIT.GET.IDATE3 66992 . 68387) (
-\TEDIT.MAKE.STRINGPIECE 68389 . 70226)) (70229 83655 (\TEDIT.GET.UNFORMATTED.FILE.MCCS 70239 . 76472) 
-(\TEDIT.INTERPRET.MCCS.SHIFTS 76474 . 82719) (\TEDIT.CONVERT.XCCSTOMCCS 82721 . 83653)) (83677 89816 (
-\TEDIT.GET.UNFORMATTED.FILE.UTF8 83687 . 89814)) (89839 101019 (\TEDIT.GET.CHARLOOKS.LIST 89849 . 
-90580) (\TEDIT.GET.SINGLE.CHARLOOKS 90582 . 97492) (\TEDIT.GET.CHARLOOKS 97494 . 99050) (
-\TEDIT.GET.PARALOOKS.INDEX 99052 . 99596) (\TEDIT.GET.CHARLOOKS.INDEX 99598 . 101017)) (101020 108677 
-(\TEDIT.GET.PARALOOKS.LIST 101030 . 101652) (\TEDIT.GET.SINGLE.PARALOOKS 101654 . 108675)) (108678 
-112511 (\TEDIT.GET.OBJECT 108688 . 112509)) (112576 145141 (\TEDIT.PUT.PCTB 112586 . 122356) (
-\TEDIT.PUT.PCTB.PIECEDATA 122358 . 125556) (\TEDIT.PUT.TRAILER 125558 . 126325) (
-\TEDIT.PUT.PCTB.MERGEABLE 126327 . 130100) (\TEDIT.PUT.UTF8.SPLITPIECES 130102 . 134804) (
-\TEDIT.PUT.PCTB.NEXTNEW 134806 . 139302) (\TEDIT.INSERT.NEWPIECES 139304 . 142739) (\TEDIT.PUTRESET 
-142741 . 142983) (\ARBOUT 142985 . 143709) (\ATMOUT 143711 . 144316) (\DWOUT 144318 . 144597) (
-\STRINGOUT 144599 . 145139)) (145142 157767 (\TEDIT.PUT.CHARLOOKS.LIST 145152 . 146824) (
-\TEDIT.PUT.SINGLE.CHARLOOKS 146826 . 152997) (\TEDIT.PUT.CHARLOOKS 152999 . 154338) (
-\TEDIT.PUT.CHARLOOKS1 154340 . 155391) (\TEDIT.PUT.OBJECT 155393 . 157765)) (157768 165407 (
-\TEDIT.PUT.PARALOOKS.LIST 157778 . 158680) (\TEDIT.PUT.SINGLE.PARALOOKS 158682 . 164266) (
-\TEDIT.PUT.PARALOOKS 164268 . 165405)) (165502 168931 (TEDITFROMLISPSOURCE 165512 . 168180) (
-SHELLSCRIPTP 168182 . 168411) (TEDITFROMSHELLSCRIPT 168413 . 168929)))))
+  (FILEMAP (NIL (5431 35690 (TEDIT.GET 5441 . 11851) (TEDIT.FORMATTEDFILEP 11853 . 13169) (
+TEDIT.FILEDATE 13171 . 14480) (TEDIT.INCLUDE 14482 . 22511) (TEDIT.RAW.INCLUDE 22513 . 23321) (
+TEDIT.PUT 23323 . 31679) (TEDIT.PUT.STREAM 31681 . 35688)) (35691 56965 (\TEDIT.GET.FOREIGN.FILE 35701
+ . 39126) (\TEDIT.GET.UNFORMATTED.FILE 39128 . 43434) (\TEDIT.GET.FORMATTED.FILE 43436 . 47079) (
+\TEDIT.FORMATTEDSTREAMP 47081 . 50212) (\ARBIN 50214 . 50934) (\ATMIN 50936 . 51473) (\DWIN 51475 . 
+51854) (\STRINGIN 51856 . 52564) (\TEDIT.GET.TRAILER 52566 . 55434) (\TEDIT.CACHEFILE 55436 . 56963)) 
+(57131 73169 (\TEDIT.GET.PIECES3 57141 . 68104) (\TEDIT.GET.PROPS3 68106 . 71328) (
+\TEDIT.MAKE.STRINGPIECE 71330 . 73167)) (73170 86596 (\TEDIT.GET.UNFORMATTED.FILE.MCCS 73180 . 79413) 
+(\TEDIT.INTERPRET.MCCS.SHIFTS 79415 . 85660) (\TEDIT.CONVERT.XCCSTOMCCS 85662 . 86594)) (86618 92757 (
+\TEDIT.GET.UNFORMATTED.FILE.UTF8 86628 . 92755)) (92780 104122 (\TEDIT.GET.CHARLOOKS.LIST 92790 . 
+93521) (\TEDIT.GET.SINGLE.CHARLOOKS 93523 . 100595) (\TEDIT.GET.CHARLOOKS 100597 . 102153) (
+\TEDIT.GET.PARALOOKS.INDEX 102155 . 102699) (\TEDIT.GET.CHARLOOKS.INDEX 102701 . 104120)) (104123 
+111780 (\TEDIT.GET.PARALOOKS.LIST 104133 . 104755) (\TEDIT.GET.SINGLE.PARALOOKS 104757 . 111778)) (
+111781 115614 (\TEDIT.GET.OBJECT 111791 . 115612)) (115679 148942 (\TEDIT.PUT.PCTB 115689 . 125596) (
+\TEDIT.PUT.PCTB.PIECEDATA 125598 . 128796) (\TEDIT.PUT.TRAILER 128798 . 130126) (
+\TEDIT.PUT.PCTB.MERGEABLE 130128 . 133901) (\TEDIT.PUT.UTF8.SPLITPIECES 133903 . 138605) (
+\TEDIT.PUT.PCTB.NEXTNEW 138607 . 143103) (\TEDIT.INSERT.NEWPIECES 143105 . 146540) (\TEDIT.PUTRESET 
+146542 . 146784) (\ARBOUT 146786 . 147510) (\ATMOUT 147512 . 148117) (\DWOUT 148119 . 148398) (
+\STRINGOUT 148400 . 148940)) (148943 161677 (\TEDIT.PUT.CHARLOOKS.LIST 148953 . 150625) (
+\TEDIT.PUT.SINGLE.CHARLOOKS 150627 . 156907) (\TEDIT.PUT.CHARLOOKS 156909 . 158248) (
+\TEDIT.PUT.CHARLOOKS1 158250 . 159301) (\TEDIT.PUT.OBJECT 159303 . 161675)) (161678 169317 (
+\TEDIT.PUT.PARALOOKS.LIST 161688 . 162590) (\TEDIT.PUT.SINGLE.PARALOOKS 162592 . 168176) (
+\TEDIT.PUT.PARALOOKS 168178 . 169315)) (169412 172841 (TEDITFROMLISPSOURCE 169422 . 172090) (
+SHELLSCRIPTP 172092 . 172321) (TEDITFROMSHELLSCRIPT 172323 . 172839)))))
 STOP
diff --git a/library/tedit/TEDIT-FILE.LCOM b/library/tedit/TEDIT-FILE.LCOM
index 99e23b3d7..b68ce1d0b 100644
Binary files a/library/tedit/TEDIT-FILE.LCOM and b/library/tedit/TEDIT-FILE.LCOM differ
diff --git a/library/tedit/TEDIT-HCPY b/library/tedit/TEDIT-HCPY
index 094b520cf..a112833e8 100644
--- a/library/tedit/TEDIT-HCPY
+++ b/library/tedit/TEDIT-HCPY
@@ -1,12 +1,12 @@
 (DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
 
-
(FILECREATED "21-Apr-2025 19:07:23" {WMEDLEY}<library>tedit>TEDIT-HCPY.;176
 32823  
+
(FILECREATED "10-Sep-2025 19:05:00" {WMEDLEY}<library>tedit>TEDIT-HCPY.;179
 30623  
 
       :EDIT-BY rmk
 
-      :CHANGES-TO (FNS \TEDIT.HARDCOPY.DISPLAYLINE)
+      :CHANGES-TO (VARS TEDIT-HCPYCOMS)
 
-      :PREVIOUS-DATE "17-Apr-2025 13:35:29" {WMEDLEY}<library>tedit>TEDIT-HCPY.;174)
+      :PREVIOUS-DATE " 9-Sep-2025 21:52:28" {WMEDLEY}<library>tedit>TEDIT-HCPY.;177)
 
 
 (PRETTYCOMPRINT TEDIT-HCPYCOMS)
@@ -22,27 +22,14 @@
               (* ;; "Functions for scaling regions as needed during hardcopy.")

 
               (FNS \TEDIT.SCALEREGION))
+        [COMS                                                (* ; 
+
                                                             "0.75 inches from bottom, 1 from top")

+              (INITVARS (TEDIT.DEFAULTPAGEREGION (\TEDIT.SCALEREGION MICASPERINCH
+                                                        (CREATEREGION 1.1 0.75 6.4 9.25]
         (COMS 
-              (* ;; "PRESS-specific code")

-
-              (VARS (TEDIT.DEFAULTPAGEREGION (CREATEREGION 2794 1905 16256 23495)))
-                                                             (* ; 
-
                                                             "0.75 inches from bottom, 1 from top")
)
-        [COMS 
               (* ;; "Support for the window-menu's HARDCOPY button, LISTFILES, etc.  THIS IS SCREWY")

 
-              (FNS TEDIT.HARDCOPYFN \TEDIT.HARDCOPYFILEFN \TEDIT.POSTSCRIPT.HARDCOPY 
-                   \TEDIT.PRESS.HARDCOPY)
-              [P (LET [(IPVALUES (ASSOC 'CONVERSION (ASSOC 'INTERPRESS PRINTFILETYPES]
-                      (CL:WHEN IPVALUES
-                                                             (* ; 
-
                                          "Only install INTERPRESS printing if INTERPRESS is loaded.")

-                          (LISTPUT IPVALUES 'TEDIT (FUNCTION \TEDIT.POSTSCRIPT.HARDCOPY)))]
-              (P (LET [(PRESSVALUES (ASSOC 'CONVERSION (ASSOC 'PRESS PRINTFILETYPES]
-                      (CL:WHEN PRESSVALUES
-                                                             (* ; 
-
                                                    "Only install PRESS printing if PRESS is loaded.")

-                          (LISTPUT PRESSVALUES 'TEDIT (FUNCTION \TEDIT.PRESS.HARDCOPY)))]
+              (FNS TEDIT.HARDCOPYFN \TEDIT.HARDCOPYFILEFN \TEDIT.POSTSCRIPT.HARDCOPY))
         [COMS 
               (* ;; "vars for Japanese Line Break")

 
@@ -421,16 +408,11 @@
 
 
 
-(* ;; "PRESS-specific code")

-
-
-(RPAQ TEDIT.DEFAULTPAGEREGION
 (CREATEREGION 2794 1905 16256 23495))
-
-
-
 (* ; "0.75 inches from bottom, 1 from top")

 
 
+(RPAQ? TEDIT.DEFAULTPAGEREGION
 (\TEDIT.SCALEREGION MICASPERINCH (CREATEREGION 1.1 0.75 6.4 9.25)))
+
 
 
 (* ;; "Support for the window-menu's HARDCOPY button, LISTFILES, etc.  THIS IS SCREWY")

@@ -486,33 +468,8 @@
                (replace
 (TEXTOBJ EDITOPACTIVE) of
 (TEXTOBJ TEXT-STREAM) with
 'Hardcopy)
                (TEDIT.FORMAT.HARDCOPY TEXT-STREAM PFILE T NIL NIL NIL 'POSTSCRIPT)
                PFILE)])
-
-(\TEDIT.PRESS.HARDCOPY

-  [LAMBDA (FILE PFILE)
                                      (* ; "Edited 12-Jun-90 18:36 by mitani")

-                                                             (* Send the text to the printer.)

-    [SETQ FILE (OPENTEXTSTREAM (COND
-                                  ((STRINGP FILE)
-                                   (MKATOM FILE))
-                                  (T FILE]
-    (RESETLST
-        [RESETSAVE (\TEDIT.MARKACTIVE (TEXTOBJ FILE))
-               '(AND (\TEDIT.MARKINACTIVE OLDVALUE]
-        (replace
 (TEXTOBJ EDITOPACTIVE) of
 (TEXTOBJ FILE) with
 'Hardcopy)
-        (TEDIT.FORMAT.HARDCOPY FILE PFILE T NIL NIL NIL 'PRESS)
-        (CLOSEF? PFILE)
-        PFILE)])
 )
 
-[LET [(IPVALUES (ASSOC 'CONVERSION (ASSOC 'INTERPRESS PRINTFILETYPES]
-     (CL:WHEN IPVALUES                                       (* ; 
-
                                          "Only install INTERPRESS printing if INTERPRESS is loaded.")

-         (LISTPUT IPVALUES 'TEDIT (FUNCTION \TEDIT.POSTSCRIPT.HARDCOPY)))]
-
-[LET [(PRESSVALUES (ASSOC 'CONVERSION (ASSOC 'PRESS PRINTFILETYPES]
-     (CL:WHEN PRESSVALUES                                    (* ; 
-
                                                    "Only install PRESS printing if PRESS is loaded.")

-         (LISTPUT PRESSVALUES 'TEDIT (FUNCTION \TEDIT.PRESS.HARDCOPY)))]
-
 
 
 (* ;; "vars for Japanese Line Break")

@@ -548,11 +505,11 @@
          (CLOSEF DOC])
 )
 (DECLARE%: DONTCOPY
-  (FILEMAP (NIL (3475 26032 (TEDIT.HARDCOPY 3485 . 4618) (\TEDIT.PRINT.MENU 4620 . 5586) (TEDIT.HCPYFILE
- 5588 . 7762) (\TEDIT.HARDCOPY.DISPLAYLINE 7764 . 16987) (\TEDIT.HARDCOPY.FORMATLINE.HEADINGS 16989 . 
-18718) (\TEDIT.HARDCOPY.MODIFYLOOKS 18720 . 20901) (\TEDIT.HCPYFMTSPEC 20903 . 24361) (
-\TEDIT.INTEGER.IMAGEBOX 24363 . 25034) (\TEDIT.DISPLAY.DIACRITIC 25036 . 26030)) (26107 26937 (
-\TEDIT.SCALEREGION 26117 . 26935)) (27196 30736 (TEDIT.HARDCOPYFN 27206 . 28511) (
-\TEDIT.HARDCOPYFILEFN 28513 . 29074) (\TEDIT.POSTSCRIPT.HARDCOPY 29076 . 30007) (\TEDIT.PRESS.HARDCOPY
- 30009 . 30734)) (31999 32800 (TEDIT-BOOK 32009 . 32798)))))
+  (FILEMAP (NIL (2652 25209 (TEDIT.HARDCOPY 2662 . 3795) (\TEDIT.PRINT.MENU 3797 . 4763) (TEDIT.HCPYFILE
+ 4765 . 6939) (\TEDIT.HARDCOPY.DISPLAYLINE 6941 . 16164) (\TEDIT.HARDCOPY.FORMATLINE.HEADINGS 16166 . 
+17895) (\TEDIT.HARDCOPY.MODIFYLOOKS 17897 . 20078) (\TEDIT.HCPYFMTSPEC 20080 . 23538) (
+\TEDIT.INTEGER.IMAGEBOX 23540 . 24211) (\TEDIT.DISPLAY.DIACRITIC 24213 . 25207)) (25284 26114 (
+\TEDIT.SCALEREGION 25294 . 26112)) (26367 29180 (TEDIT.HARDCOPYFN 26377 . 27682) (
+\TEDIT.HARDCOPYFILEFN 27684 . 28245) (\TEDIT.POSTSCRIPT.HARDCOPY 28247 . 29178)) (29799 30600 (
+TEDIT-BOOK 29809 . 30598)))))
 STOP
diff --git a/library/tedit/TEDIT-HCPY.LCOM b/library/tedit/TEDIT-HCPY.LCOM
index 7d6c71eaa..9c76df198 100644
Binary files a/library/tedit/TEDIT-HCPY.LCOM and b/library/tedit/TEDIT-HCPY.LCOM differ
diff --git a/library/tedit/TEDIT-LOOKS b/library/tedit/TEDIT-LOOKS
index 512bee84a..426d99ab0 100644
--- a/library/tedit/TEDIT-LOOKS
+++ b/library/tedit/TEDIT-LOOKS
@@ -1,16 +1,12 @@
 (DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
 
-
(FILECREATED " 1-Aug-2025 13:43:51" 
-{DSK}<Users>kaplan>Local>medley3.5>working-medley>library>tedit>TEDIT-LOOKS.;443
 160489 
+
(FILECREATED " 6-Oct-2025 20:50:59" {WMEDLEY}<library>TEDIT>TEDIT-LOOKS.;459
 155349 
 
       :EDIT-BY rmk
 
-      :CHANGES-TO (RECORDS CHARLOOKS)
-                  (FNS \TEDIT.EQCLOOKS \TEDIT.TRANSLATE.ASCIICHARS \TEDIT.UNIQUIFY.ALL 
-                       \TEDIT.FLUSH.UNUSED.LOOKS TEDIT.GET.LOOKS TEDIT.SUBLOOKS TEDIT.FINDLOOKS 
-                       \TEDIT.CHANGE.CHARLOOKS)
+      :CHANGES-TO (FNS \TEDIT.MCCS.TRANSLATE)
 
-      :PREVIOUS-DATE "29-Jul-2025 09:30:33" {WMEDLEY}<library>tedit>TEDIT-LOOKS.;435)
+      :PREVIOUS-DATE " 5-Oct-2025 10:57:43" {WMEDLEY}<library>TEDIT>TEDIT-LOOKS.;457)
 
 
 (PRETTYCOMPRINT TEDIT-LOOKSCOMS)
@@ -56,15 +52,15 @@
                    TEDIT.COPY.LOOKS \TEDIT.UNPARSE.CHARLOOKS.LIST \TEDIT.MODIFYLOOKS TEDIT.NEW.FONT 
                    \TEDIT.CARETLOOKS.VERIFY \TEDIT.CARETPIECE \TEDIT.GET.INSERT.CHARLOOKS 
                    \TEDIT.GET.TERMSA.WIDTHS \TEDIT.PARSE.CHARLOOKS.LIST)
-              (COMS (FNS \TEDIT.TRANSLATE.ASCIICHARS \TEDIT.CONVERT.TO.FORMATTED)
-                    (MACROS \TEDIT.TRANSLATE.ASCII.CHARLOOKS))
+              (COMS (FNS \TEDIT.MCCS.TRANSLATE \TEDIT.CONVERT.TO.FORMATTED)
+                    (MACROS \TEDIT.MCCS.TRANSLATE.CHARLOOKS))
               (FNS \TEDIT.UNIQUIFY.CHARLOOKS \TEDIT.UNIQUIFY.PARALOOKS \TEDIT.UNIQUIFY.ALL 
                    \TEDIT.FLUSH.UNUSED.LOOKS)
               
               (* ;; "Public entries")

 
               (FNS TEDIT.LOOKS TEDIT.GET.LOOKS TEDIT.SUBLOOKS TEDIT.FINDLOOKS)
-              [INITVARS (TEDIT.FONTCLASSES '(DISPLAY PDF POSTSCRIPT INTERPRESS PRESS]
+              [INITVARS (TEDIT.FONTCLASSES '(DISPLAY PDF POSTSCRIPT INTERPRESS]
               (FNS \TEDIT.CHANGE.CHARLOOKS \TEDIT.CHANGE.CHARLOOKS.NEW \TEDIT.CHARLOOKS.CHANGE.FONT 
                    \TEDIT.FONT.NEXTSIZE \TEDIT.LOOKS \TEDIT.FONTCOPY \TEDIT.COERCE.FONTCLASS 
                    \TEDIT.FONTCLASS.TO.FONT))
@@ -153,9 +149,7 @@
                     CLOFFSET _ 0 CLCOLOR _ 'BLACK (INIT (DEFPRINT 'CHARLOOKS (FUNCTION 
                                                                             \TEDIT.CHARLOOKS.DEFPRINT
                                                                               )))
-                    (ASSOCRECORD CLPROPS (CLUSERINFO CLCHARENCODING))
-                    [ACCESSFNS ((CLNAME (fetch
 (CHARLOOKS CLFONTUNPARSE) of
 DATUM)
-                                       (replace
 (CHARLOOKS CLFONTUNPARSE) of
 DATUM with
 NEWVALUE])
+                    (ASSOCRECORD CLPROPS (CLUSERINFO CLCHARENCODING)))
 
 (DATATYPE PARALOOKS
 (
                      (* ;; "Describe the paragraph formatting for a paragraph in a TEdit document.")

@@ -544,7 +538,8 @@
 (DEFINEQ
 
 (\TEDIT.CHARLOOKS.FROM.FONT

-  [LAMBDA (FONT NOERROR)
                                     (* ; "Edited 19-Mar-2025 12:47 by rmk")


+  [LAMBDA (FONT NOERROR)
                                     (* ; "Edited  7-Sep-2025 11:02 by rmk")


+                                                             (* ; "Edited 19-Mar-2025 12:47 by rmk")


                                                              (* ; "Edited  2-Jan-2025 10:21 by rmk")


                                                              (* ; "Edited 31-Dec-2024 23:33 by rmk")


                                                              (* ; "Edited 28-Dec-2024 12:28 by rmk")


@@ -567,11 +562,11 @@
     (CL:WHEN (type?
 FONTCLASS FONT)
         (SETQ FONT (\TEDIT.COERCE.FONTCLASS
 FONT)))
     (create
 CHARLOOKS
-           CLFONT _ FONT
-           CLNAME _ (FONTUNPARSE FONT])
+           CLFONT _ FONT])
 
 (\TEDIT.EQCLOOKS

-  [LAMBDA (CLOOK1 CLOOK2)
                                    (* ; "Edited  1-Aug-2025 11:43 by rmk")


+  [LAMBDA (CLOOK1 CLOOK2)
                                    (* ; "Edited  7-Sep-2025 10:59 by rmk")


+                                                             (* ; "Edited  1-Aug-2025 11:43 by rmk")


                                                              (* ; "Edited 21-Jul-2025 23:43 by rmk")


                                                              (* ; "Edited 15-Apr-2025 16:45 by rmk")


                                                              (* ; "Edited  2-Jan-2025 21:01 by rmk")


@@ -587,10 +582,8 @@
     (* ;; "Given two sets of CHARLOOKS, are they effectively the same?")

 
     (OR (EQ CLOOK1 CLOOK2)
-        (AND (OR (EQ (FGETCLOOKS CLOOK1 CLFONT)
-                     (FGETCLOOKS CLOOK2 CLFONT))
-                 (EQUAL (FGETCLOOKS CLOOK1 CLNAME)
-                        (FGETCLOOKS CLOOK2 CLNAME)))
+        (AND (EQ (FGETCLOOKS CLOOK1 CLFONT)
+                 (FGETCLOOKS CLOOK2 CLFONT))
              (EQ (FGETCLOOKS CLOOK1 CLPROTECTED)
                  (FGETCLOOKS CLOOK2 CLPROTECTED))
              (EQ (FGETCLOOKS CLOOK1 CLINVISIBLE)
@@ -931,147 +924,84 @@
 )
 (DEFINEQ
 
-(\TEDIT.TRANSLATE.ASCIICHARS

-  [LAMBDA (TSTREAM NOASCIIFONTS)
                             (* ; "Edited 31-Jul-2025 09:56 by rmk")


+(\TEDIT.MCCS.TRANSLATE

+  [LAMBDA (TSTREAM)
                                          (* ; "Edited  6-Oct-2025 20:50 by rmk")


+                                                             (* ; "Edited  5-Oct-2025 10:57 by rmk")


+                                                             (* ; "Edited 25-Sep-2025 21:30 by rmk")


+                                                             (* ; "Edited  9-Sep-2025 21:48 by rmk")


+                                                             (* ; "Edited  7-Sep-2025 22:42 by rmk")


+                                                             (* ; "Edited 31-Jul-2025 09:56 by rmk")


                                                              (* ; "Edited 28-Jul-2025 23:35 by rmk")


-                                                             (* ; "Edited 24-Apr-2025 23:47 by rmk")


-                                                             (* ; "Edited 30-Mar-2025 22:00 by rmk")


-                                                             (* ; "Edited 28-Mar-2025 14:24 by rmk")


-                                                             (* ; "Edited  2-Jan-2025 23:30 by rmk")


-                                                             (* ; "Edited 30-Dec-2024 21:30 by rmk")


-                                                             (* ; "Edited 22-Dec-2024 11:42 by rmk")


-                                                             (* ; "Edited 20-Dec-2024 13:34 by rmk")


-                                                             (* ; "Edited 23-Sep-2024 00:50 by rmk")


-                                                             (* ; "Edited 17-Mar-2024 00:25 by rmk")


-                                                             (* ; "Edited  1-Dec-2023 22:28 by rmk")


-                                                             (* ; "Edited 27-Nov-2023 16:13 by rmk")


                                                              (* ; "Edited 26-Nov-2023 11:19 by rmk")


                                                              (* ; "Edited 14-Nov-2023 19:21 by rmk")


                                                              (* ; "Edited  9-Nov-2023 23:56 by rmk")

 
-    (* ;; "Converts characters in Alto/Ascii font pieces to their MCCS character and font (more or less) equivalents.  The affected characters are put in their own string pieces with their new CHARLOOKS.  Asciifont pieces are completely replaced if NOASCIIFONTS, otherwise untranslated characters remain in their Asciifonts.")

-
-    (* ;; "ASCIITONSTRANSLATIONS and the mapping arrays are from INTERPRESS.")

-
-    (* ;; "\ASCII2MCCS is the default translation array, for Gacha, Timesroman.  HIPPO, MATH ... have their own.")

-
-    (DECLARE
 (GLOBALVARS ASCIITONSTRANSLATIONS \ASCII2MCCS))
-    (LET
-     ((TEXTOBJ (TEXTOBJ TSTREAM)))
-     (CL:WHEN (thereis
 CL FAMILY in
 (FGETTOBJ TEXTOBJ TXTCHARLOOKSLIST)
-                 unless
 [EQ 'CLASSIC (SETQ FAMILY (FONTPROP (GETCLOOKS CL CLFONT)
-                                                         'FAMILY] suchthat
 
-
-                                           (* ;; "CLASSIC is in the list presumably to provide a coercion to MODERN for Interpress. We don't want to translate it.")

-
-                                                                        (ASSOC FAMILY 
-                                                                               ASCIITONSTRANSLATIONS)
-                     )
-         (for
 CHNO CLOOKS TRANS MAPARRAY NEWFONTNAME STRING FAT CLOOKSLIST FAMILY TARRAYLAST
-            from
 1 by
 (PLEN PC) as
 PC inpieces
 (\TEDIT.FIRSTPIECE TEXTOBJ)
-            eachtime
 (SETQ CLOOKS (PCHARLOOKS PC))
-                  (SETQ FAMILY (FONTPROP (GETCLOOKS CLOOKS CLFONT)
-                                      'FAMILY)) unless
 (OR (EQ OBJECT.PTYPE (PTYPE PC))
-                                                           (EQ FAMILY 'CLASSIC))
-            when
 (SETQ TRANS (ASSOC FAMILY ASCIITONSTRANSLATIONS))
-            do
 
-               (* ;; "PC needs some work.")

-
-               (SETQ MAPARRAY (CADR TRANS))
-               (SETQ NEWFONTNAME (CADDR TRANS))
-               (CL:WHEN MAPARRAY                             (* ; 
-
                                                             "Idiosyncratic fonts (MATH, CYRILLIC). ")

-                   (SETQ MAPARRAY (GETATOMVAL MAPARRAY))     (* ; "Global value")

-                   (CL:WHEN (AND NOASCIIFONTS (PREVPIECE PC))
-
-                       (* ;; " Look backward for NEWFONTNAME, since that piece has already been coerced.  The idea is to get Cyrillic to continue the previous looks (serif, san-serif)")

-
-                       (SETQ NEWFONTNAME (FONTPROP (GETCLOOKS (PCHARLOOKS (PREVPIECE PC))
-                                                          CLFONT)
-                                                'FAMILY))))
-               (if
 (OR MAPARRAY NOASCIIFONTS)
-                   then
 
-                        (* ;; "Translate all characters in idiosyncratic fonts, flush everything and change the looks even for Helvetica etc. if NO ALTOFONTS")

-
-                        (CL:UNLESS MAPARRAY (SETQ MAPARRAY \ASCII2MCCS))
-                        (SETQ TARRAYLAST (SUB1 (ARRAYSIZE MAPARRAY))) 
-
-                        (* ;; "Create a string with the translated codes, then convert the existing piece to a string piece holding that string.")

-
-                        (SETQ STRING (ALLOCSTRING (PLEN PC)))
-                        (for
 OFFSET OLDCODE NEWCODE from
 1 to
 (PLEN PC)
-                           do
 
-                              (* ;; 
-
                        "Out-of-range alone and zero newcodes alone (some arrays are not filled in).")

-
-                              (SETQ OLDCODE (\TEDIT.PIECE.NTHCHARCODE PC OFFSET))
-                              (RPLCHARCODE STRING OFFSET
-                                     (if
 [OR (IGREATERP OLDCODE TARRAYLAST)
-                                             (ZEROP (SETQ NEWCODE (ELT MAPARRAY OLDCODE]
-                                         then
 OLDCODE
-                                       else
 NEWCODE)))
-                        (SETQ FAT (ffetch
 (STRINGP FATSTRINGP) of
 STRING))
-                        (FSETPC PC PTYPE (CL:IF FAT
-                                             FATSTRING.PTYPE
-                                             THINSTRING.PTYPE))
-                        (FSETPC PC PCONTENTS STRING)
-                        (FSETPC PC PFPOS NIL)
-                        (FSETPC PC PBINABLE (NOT FAT))
-                        (FSETPC PC PBYTESPERCHAR (CL:IF FAT
-                                                     2
-                                                     1))
-                        (FSETPC PC PBYTELEN (CL:IF FAT
-                                                (UNFOLD (PLEN PC)
-                                                       2)
-                                                (PLEN PC)))
-                        (FSETPC PC PCHARLOOKS (\TEDIT.TRANSLATE.ASCII.CHARLOOKS TEXTOBJ CLOOKS 
-                                                     NEWFONTNAME))
-                 else
 
-                      (* ;; "Must be a text font (GACHA, TIMESROMAN, HELVETICA)  \ASCIITONS is the translation array, mostly identities.  ")

-
-                      (* ;; "Find the first change quickly, in piece coordinates.  Then change whatever else needs it, slowly, in document coordinates. It would be more complicated to do the replacements in piece coordinates, because the pieces would get split on the fly. ")

-
-                      (for
 OFFSET OLDCODE NEWLOOKS from
 1 to
 (PLEN PC)
-                         eachtime
 (SETQ OLDCODE (\TEDIT.PIECE.NTHCHARCODE PC OFFSET))
-                         when
 (ILEQ OLDCODE 255) unless
 (EQ OLDCODE (ELT \ASCII2MCCS OLDCODE))
-                         do
 
-                            (* ;; "First hit, scan/change the rest of PC")

-
-                            (SETQ NEWLOOKS (\TEDIT.TRANSLATE.ASCII.CHARLOOKS TEXTOBJ CLOOKS 
-                                                  NEWFONTNAME))
-                            (for
 I NEWCODE from
 (IPLUS CHNO (SUB1 OFFSET))
-                               to
 (SUB1 (IPLUS CHNO (PLEN PC))) eachtime
 (SETQ OLDCODE
-                                                                          (\TEDIT.NTHCHARCODE TSTREAM
-                                                                                 I))
-                               when
 (ILEQ OLDCODE 255) unless
 (EQ OLDCODE (SETQ NEWCODE
-                                                                           (ELT \ASCII2MCCS OLDCODE))
-                                                                  )
-                               do
 (\TEDIT.RPLCHARCODE TSTREAM I NEWCODE NEWLOOKS))
-                            (RETURN))) finally
 
-
-                                 (* ;; "Here we change the caret looks.  Perhaps this should be done only if NOASCIIFONTS.  But there is a risk that Ascii fonts and characters would slip in by future editing.  ")

-
-                                             (CL:WHEN NOASCIIFONTS
-                                                 (SETQ CLOOKS (FGETTOBJ TEXTOBJ DEFAULTCHARLOOKS))
-                                                 (SETQ FAMILY (FONTPROP (GETCLOOKS CLOOKS CLFONT)
-                                                                     'FAMILY))
-                                                 (SETQ CLOOKS (FGETTOBJ TEXTOBJ CARETLOOKS))
-                                                 (SETQ FAMILY (FONTPROP (GETCLOOKS CLOOKS CLFONT)
-                                                                     'FAMILY))
-                                                 (CL:WHEN (AND (NEQ FAMILY 'CLASSIC)
-                                                               (SETQ TRANS (ASSOC FAMILY 
-                                                                                ASCIITONSTRANSLATIONS
-                                                                                  )))
-                                                     (FSETTOBJ TEXTOBJ CARETLOOKS (
-                                                                     \TEDIT.TRANSLATE.ASCII.CHARLOOKS
-                                                                                   TEXTOBJ CLOOKS
-                                                                                   (CADDR TRANS)))))
-                                             (CL:WHEN CLOOKSLIST
-
-                                                 (* ;; 
-
                                             "Something happened, get rid of any lingering old looks")

-
-                                                 (\TEDIT.UNIQUIFY.ALL
 TEXTOBJ))))])
+    (* ;; "Nothing to do if all non-MCCScharacters in TSTREAM have already been converted to their MCCS equivalents.  Otherwise, the characters in each piece are converted by the MCCS conversion function of its font.  We know that all characters outside of charset-0 are already MCCS, no need to work on those.")

+
+    (* ;; "If the font charencoding is not MCCS (e.g. HIPPO), then the font itself must be changed (e.g. to Classic).")

+
+    (* ;; "If every piece has a translation function, do the translations and return T.  Otherwise return NIL. ")

+
+    (* ;; "   ")

+
+    (LET ((TEXTOBJ (FTEXTOBJ TSTREAM)))
+         (CL:WHEN (find
 PC inpieces
 (\TEDIT.FIRSTPIECE TEXTOBJ) unless
 (EQ OBJECT.PTYPE (PTYPE PC))
+                     suchthat
 (fetch
 (FONTDESCRIPTOR FONTTOMCCSFN) of
 (FGETCLOOKS (PCHARLOOKS PC)
+                                                                             CLFONT)))
+             (for
 PC CLOOKS CLFONT TOMCCSFN CLOOKSLIST inpieces
 (\TEDIT.FIRSTPIECE TEXTOBJ)
+                unless
 (EQ OBJECT.PTYPE (PTYPE PC)) when
 [SETQ TOMCCSFN
+                                                          (fetch
 (FONTDESCRIPTOR FONTTOMCCSFN)
+                                                             of
 (SETQ CLFONT (FGETCLOOKS
+                                                                              (SETQ CLOOKS
+                                                                               (PCHARLOOKS PC))
+                                                                              CLFONT]
+                do
 (for
 OFFSET OLDCODE STRING FAT from
 1 to
 (PLEN PC) eachtime
 (SETQ OLDCODE
+                                                                                (
+                                                                             \TEDIT.PIECE.NTHCHARCODE
+                                                                                 PC OFFSET))
+                      unless
 (EQ OLDCODE (APPLY* TOMCCSFN OLDCODE))
+                      do
 
+                         (* ;; "This piece has recoded character.   Start over to convert it to a string piece with necessary code conversions.   (The logic to split the original piece at just the changes while still preserving the iteration would be very complicated).")

+
+                         (SETQ STRING (ALLOCSTRING (PLEN PC)))
+                         [for
 OFFSET from
 1 to
 (PLEN PC) do
 (RPLCHARCODE STRING OFFSET
+                                                                   (APPLY* TOMCCSFN (
+                                                                             \TEDIT.PIECE.NTHCHARCODE
+                                                                                     PC OFFSET]
+                         (SETQ FAT (ffetch
 (STRINGP FATSTRINGP) of
 STRING))
+                         (FSETPC PC PTYPE (CL:IF FAT
+                                              FATSTRING.PTYPE
+                                              THINSTRING.PTYPE))
+                         (FSETPC PC PCONTENTS STRING)
+                         (FSETPC PC PFPOS NIL)
+                         (FSETPC PC PBINABLE (NOT FAT))
+                         (FSETPC PC PBYTESPERCHAR (CL:IF FAT
+                                                      2
+                                                      1))
+                         (FSETPC PC PBYTELEN (CL:IF FAT
+                                                 (UNFOLD (PLEN PC)
+                                                        2)
+                                                 (PLEN PC)))
+                         (CL:UNLESS (EQ 'MCCS (fetch
 (FONTDESCRIPTOR FONTCHARENCODING) of
 CLFONT))
+
+                             (* ;; 
+
            "Can't stay with this font (SYMBOL), find the coercion that was used for its characters.")

+
+                             (FSETPC PC PCHARLOOKS (\TEDIT.MCCS.TRANSLATE.CHARLOOKS TEXTOBJ CLOOKS 
+                                                          CLFONT)))
+                         (RETURN)) finally
 
+
+                                 (* ;; "CLOOKSLIST maps any old charlooks to the new ones that we might have created for them, because of font coercion for non-MCCS fonts.  The stream must know about the changes.  ")

+
+                                         (CL:WHEN CLOOKSLIST
+
+                                             (* ;; 
+
                                             "Discard orphan old looks and uniquify what's left.")

+
+                                             (\TEDIT.UNIQUIFY.ALL
 TEXTOBJ))))
+         (PUTMULTI (FGETTOBJ TEXTOBJ DOCPROPS)
+                'CHARENCODING
+                'MCCS])
 
 (\TEDIT.CONVERT.TO.FORMATTED

   [LAMBDA (TSTREAM START END)
                                (* ; "Edited 20-Apr-2025 13:25 by rmk")


@@ -1156,21 +1086,19 @@
 )
 (DECLARE%: EVAL@COMPILE 
 
-(PUTPROPS \TEDIT.TRANSLATE.ASCII.CHARLOOKS
 MACRO

-          [OPENLAMBDA (TEXTOBJ CLOOKS NEWFONTNAME)
+(PUTPROPS \TEDIT.MCCS.TRANSLATE.CHARLOOKS
 MACRO

+          [OPENLAMBDA (TEXTOBJ CLOOKS CLFONT)
 
             (* ;; "Macro because CLOOKSLIST is set.  The alist avoids creating and then uniquifying each time we want to make the same translation.")

 
-            (CDR (OR (ASSOC CLOOKS CLOOKSLIST)
-                     (CAR (PUSH
 CLOOKSLIST
-                                (CONS CLOOKS
-                                      (\TEDIT.UNIQUIFY.CHARLOOKS

-                                       (LET ((NEWFONT (\TEDIT.FONTCOPY
 (GETCLOOKS CLOOKS CLFONT)
-                                                             (LIST 'FAMILY NEWFONTNAME)
-                                                             TEXTOBJ)))
-                                            (create
 CHARLOOKS using
 CLOOKS CLFONT _ NEWFONT CLNAME _
-                                                                    (FONTUNPARSE NEWFONT)))
-                                       TEXTOBJ])
+            (OR (GETMULTI CLOOKSLIST CLOOKS)
+                (PUTMULTI CLOOKSLIST CLOOKS (\TEDIT.UNIQUIFY.CHARLOOKS

+                                             [create
 CHARLOOKS
+                                                using
 CLOOKS CLFONT _
+                                                      (CAR (\COERCECHARSET (FONTPROP CLFONT
+                                                                                  'SPEC)
+                                                                  0 NIL 'CHARCOERCIONS]
+                                             TEXTOBJ])
 )
 (DEFINEQ
 
@@ -1448,7 +1376,7 @@
                    (RETURN (\TEDIT.COPYSEL (FGETTOBJ TEXTOBJ SEL])])
 )
 
-(RPAQ? TEDIT.FONTCLASSES
 '(DISPLAY PDF POSTSCRIPT INTERPRESS PRESS))
+(RPAQ? TEDIT.FONTCLASSES
 '(DISPLAY PDF POSTSCRIPT INTERPRESS))
 (DEFINEQ
 
 (\TEDIT.CHANGE.CHARLOOKS

@@ -1577,7 +1505,8 @@
           (RETURN DIRTY])
 
 (\TEDIT.CHANGE.CHARLOOKS.NEW

-  [LAMBDA (NEWLOOKS OLDCHARLOOKS TEXTOBJ)
                    (* ; "Edited 15-Apr-2025 16:47 by rmk")


+  [LAMBDA (NEWLOOKS OLDCHARLOOKS TEXTOBJ)
                    (* ; "Edited  7-Sep-2025 11:03 by rmk")


+                                                             (* ; "Edited 15-Apr-2025 16:47 by rmk")


                                                              (* ; "Edited  2-Jan-2025 15:49 by rmk")


                                                              (* ; "Edited  1-Jan-2025 09:04 by rmk")


                                                              (* ; "Edited  2-Dec-2024 23:52 by rmk")


@@ -1588,7 +1517,7 @@
 
     (* ;; "Make a new CHARLOOKS reflecting the properties in NEWLOOKS, with defaults taken from OLDCHARLOOKS, if given, or the DEFAULTCHARLOOKS of TEXTOBJ, if given,;")

 
-    (* ;; "OLDCHARLOOKS is also used as the base for increments.�")

+    (* ;; "OLDCHARLOOKS is also used as the base for increments.")

 
     (CL:UNLESS OLDCHARLOOKS
         (SETQ OLDCHARLOOKS (OR (AND TEXTOBJ (GETTOBJ TEXTOBJ DEFAULTCHARLOOKS))
@@ -1600,8 +1529,7 @@
              (CL:UNLESS (SETQ NEWFONT (\TEDIT.CHARLOOKS.CHANGE.FONT
 NEWLOOKS OLDCHARLOOKS TEXTOBJ))
                                                              (* ; "Bad font specification")

                  (RETURN NIL))
-             (SETQ NEWCHARLOOKS (create
 CHARLOOKS using
 OLDCHARLOOKS CLFONT _ NEWFONT CLNAME _
-                                                        (FONTUNPARSE NEWFONT)))
+             (SETQ NEWCHARLOOKS (create
 CHARLOOKS using
 OLDCHARLOOKS CLFONT _ NEWFONT))
        do
 (SETQ VAL (CADR NLTAIL))
           (CL:WHEN (MEMB VAL '(NEUTRAL OFF))                 (* ; "Off and NEUTRAL both turn off")

               (SETQ VAL NIL)) 
@@ -2533,26 +2461,26 @@
 (ADDTOVAR LAMA
 )
 )
 (DECLARE%: DONTCOPY
-  (FILEMAP (NIL (22579 24521 (\TEDIT.CHARLOOKS.DEFPRINT 22589 . 23725) (\TEDIT.PARALOOKS.DEFPRINT 23727
- . 24519)) (24625 25011 (\TEDIT.CREATE.FACE.MENU 24635 . 24807) (\TEDIT.CREATE.SIZE.MENU 24809 . 25009
-)) (26015 27904 (\TEDIT.CHARLOOKS.FEATURE.CHECK 26025 . 27902)) (28176 53365 (
-\TEDIT.CHARLOOKS.FROM.FONT 28186 . 30399) (\TEDIT.EQCLOOKS 30401 . 33435) (\TEDIT.SAMECLOOKS 33437 . 
-36608) (TEDIT.CARETLOOKS 36610 . 38156) (TEDIT.COPY.LOOKS 38158 . 41441) (
-\TEDIT.UNPARSE.CHARLOOKS.LIST 41443 . 44937) (\TEDIT.MODIFYLOOKS 44939 . 47099) (TEDIT.NEW.FONT 47101
- . 47548) (\TEDIT.CARETLOOKS.VERIFY 47550 . 48387) (\TEDIT.CARETPIECE 48389 . 48694) (
-\TEDIT.GET.INSERT.CHARLOOKS 48696 . 51743) (\TEDIT.GET.TERMSA.WIDTHS 51745 . 52161) (
-\TEDIT.PARSE.CHARLOOKS.LIST 52163 . 53363)) (53366 70096 (\TEDIT.TRANSLATE.ASCIICHARS 53376 . 63832) (
-\TEDIT.CONVERT.TO.FORMATTED 63834 . 70094)) (71108 78445 (\TEDIT.UNIQUIFY.CHARLOOKS 71118 . 72778) (
-\TEDIT.UNIQUIFY.PARALOOKS 72780 . 74047) (\TEDIT.UNIQUIFY.ALL 74049 . 76137) (
-\TEDIT.FLUSH.UNUSED.LOOKS 76139 . 78443)) (78478 90436 (TEDIT.LOOKS 78488 . 80877) (TEDIT.GET.LOOKS 
-80879 . 83214) (TEDIT.SUBLOOKS 83216 . 87596) (TEDIT.FINDLOOKS 87598 . 90434)) (90511 120140 (
-\TEDIT.CHANGE.CHARLOOKS 90521 . 99299) (\TEDIT.CHANGE.CHARLOOKS.NEW 99301 . 103095) (
-\TEDIT.CHARLOOKS.CHANGE.FONT 103097 . 111404) (\TEDIT.FONT.NEXTSIZE 111406 . 113027) (\TEDIT.LOOKS 
-113029 . 116358) (\TEDIT.FONTCOPY 116360 . 117861) (\TEDIT.COERCE.FONTCLASS 117863 . 119014) (
-\TEDIT.FONTCLASS.TO.FONT 119016 . 120138)) (120183 151831 (\TEDIT.EQFMTSPEC 120193 . 123408) (
-TEDIT.GET.PARALOOKS 123410 . 127457) (\TEDIT.PARSE.PARALOOKS.LIST 127459 . 135492) (TEDIT.PARALOOKS 
-135494 . 136534) (\TEDIT.CHANGE.PARALOOKS 136536 . 143504) (\TEDIT.CHANGE.PARALOOKS.NEW 143506 . 
-147489) (TEDIT.COPY.PARALOOKS 147491 . 150165) (\TEDIT.PARABOUNDS 150167 . 151829)) (151891 159607 (
-TEDIT.SUBPARALOOKS 151901 . 156003) (SAMEPARALOOKS 156005 . 159605)) (159608 160295 (
-\TEDIT.MARK.REVISION 159618 . 160293)))))
+  (FILEMAP (NIL (22099 24041 (\TEDIT.CHARLOOKS.DEFPRINT 22109 . 23245) (\TEDIT.PARALOOKS.DEFPRINT 23247
+ . 24039)) (24145 24531 (\TEDIT.CREATE.FACE.MENU 24155 . 24327) (\TEDIT.CREATE.SIZE.MENU 24329 . 24529
+)) (25535 27424 (\TEDIT.CHARLOOKS.FEATURE.CHECK 25545 . 27422)) (27696 52953 (
+\TEDIT.CHARLOOKS.FROM.FONT 27706 . 29990) (\TEDIT.EQCLOOKS 29992 . 33023) (\TEDIT.SAMECLOOKS 33025 . 
+36196) (TEDIT.CARETLOOKS 36198 . 37744) (TEDIT.COPY.LOOKS 37746 . 41029) (
+\TEDIT.UNPARSE.CHARLOOKS.LIST 41031 . 44525) (\TEDIT.MODIFYLOOKS 44527 . 46687) (TEDIT.NEW.FONT 46689
+ . 47136) (\TEDIT.CARETLOOKS.VERIFY 47138 . 47975) (\TEDIT.CARETPIECE 47977 . 48282) (
+\TEDIT.GET.INSERT.CHARLOOKS 48284 . 51331) (\TEDIT.GET.TERMSA.WIDTHS 51333 . 51749) (
+\TEDIT.PARSE.CHARLOOKS.LIST 51751 . 52951)) (52954 65081 (\TEDIT.MCCS.TRANSLATE 52964 . 58817) (
+\TEDIT.CONVERT.TO.FORMATTED 58819 . 65079)) (65953 73290 (\TEDIT.UNIQUIFY.CHARLOOKS 65963 . 67623) (
+\TEDIT.UNIQUIFY.PARALOOKS 67625 . 68892) (\TEDIT.UNIQUIFY.ALL 68894 . 70982) (
+\TEDIT.FLUSH.UNUSED.LOOKS 70984 . 73288)) (73323 85281 (TEDIT.LOOKS 73333 . 75722) (TEDIT.GET.LOOKS 
+75724 . 78059) (TEDIT.SUBLOOKS 78061 . 82441) (TEDIT.FINDLOOKS 82443 . 85279)) (85350 115000 (
+\TEDIT.CHANGE.CHARLOOKS 85360 . 94138) (\TEDIT.CHANGE.CHARLOOKS.NEW 94140 . 97955) (
+\TEDIT.CHARLOOKS.CHANGE.FONT 97957 . 106264) (\TEDIT.FONT.NEXTSIZE 106266 . 107887) (\TEDIT.LOOKS 
+107889 . 111218) (\TEDIT.FONTCOPY 111220 . 112721) (\TEDIT.COERCE.FONTCLASS 112723 . 113874) (
+\TEDIT.FONTCLASS.TO.FONT 113876 . 114998)) (115043 146691 (\TEDIT.EQFMTSPEC 115053 . 118268) (
+TEDIT.GET.PARALOOKS 118270 . 122317) (\TEDIT.PARSE.PARALOOKS.LIST 122319 . 130352) (TEDIT.PARALOOKS 
+130354 . 131394) (\TEDIT.CHANGE.PARALOOKS 131396 . 138364) (\TEDIT.CHANGE.PARALOOKS.NEW 138366 . 
+142349) (TEDIT.COPY.PARALOOKS 142351 . 145025) (\TEDIT.PARABOUNDS 145027 . 146689)) (146751 154467 (
+TEDIT.SUBPARALOOKS 146761 . 150863) (SAMEPARALOOKS 150865 . 154465)) (154468 155155 (
+\TEDIT.MARK.REVISION 154478 . 155153)))))
 STOP
diff --git a/library/tedit/TEDIT-LOOKS.LCOM b/library/tedit/TEDIT-LOOKS.LCOM
index 2eba0287f..802c0d03f 100644
Binary files a/library/tedit/TEDIT-LOOKS.LCOM and b/library/tedit/TEDIT-LOOKS.LCOM differ
diff --git a/library/tedit/TEDIT-MENU b/library/tedit/TEDIT-MENU
index b2288656b..f6075e5d5 100644
--- a/library/tedit/TEDIT-MENU
+++ b/library/tedit/TEDIT-MENU
@@ -1,13 +1,12 @@
 (DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
 
-
(FILECREATED "28-Jul-2025 23:26:01" 
-{DSK}<Users>kaplan>Local>medley3.5>working-medley>library>tedit>TEDIT-MENU.;491
 179623 
+
(FILECREATED "10-Sep-2025 17:08:43" {WMEDLEY}<library>TEDIT>TEDIT-MENU.;492
 178438 
 
       :EDIT-BY rmk
 
-      :CHANGES-TO (FNS \TEDIT.SHOW.PARALOOKS \TEDIT.SHOW.CHARLOOKS)
+      :CHANGES-TO (VARS TEDIT-MENUCOMS)
 
-      :PREVIOUS-DATE "13-Jul-2025 22:35:15" {WMEDLEY}<library>TEDIT>TEDIT-MENU.;488)
+      :PREVIOUS-DATE "28-Jul-2025 23:26:01" {WMEDLEY}<library>TEDIT>TEDIT-MENU.;491)
 
 
 (PRETTYCOMPRINT TEDIT-MENUCOMS)
@@ -16,17 +15,7 @@
        [
         (* ;; "TEdit-specific menus and support")

 
-        [DECLARE%: DOEVAL@COMPILE DONTCOPY (RECORDS MARGINBAR)
-               (EXPORT (CONSTANTS (PTSPERPICA 12)
-                              (PTSPERINCH 72)
-                              (PICASPERINCH 6)
-                              (MICASPERINCH 2540)
-                              (PTSPERCM (FQUOTIENT PTSPERINCH 2.54))
-                              (PTSPERMICA (FQUOTIENT PTSPERINCH MICASPERINCH))
-                              (MICASPERPOINT (FQUOTIENT MICASPERINCH PTSPERINCH]
-        
-        (* ;; "")

-
+        (DECLARE%: DOEVAL@COMPILE DONTCOPY (RECORDS MARGINBAR))
                                                              (* ; "Middle button in title")

         [COMS                                                (* ; "Menu interfacing")

               (FNS TEDIT.ADD.MENUITEM TEDIT.DEFAULT.MENUFN TEDIT.REMOVE.MENUITEM \TEDIT.CREATEMENU 
@@ -111,44 +100,10 @@
                               (EQ (IMAGEOBJPROP DATUM 'DISPLAYFN)
                                   'MB.MARGINBAR.DISPLAYFN])
 )
-
-(* "FOLLOWING DEFINITIONS EXPORTED")(DECLARE%: EVAL@COMPILE 
-
-(RPAQQ PTSPERPICA
 12)
-
-(RPAQQ PTSPERINCH
 72)
-
-(RPAQQ PICASPERINCH
 6)
-
-(RPAQQ MICASPERINCH
 2540)
-
-(RPAQ PTSPERCM
 (FQUOTIENT PTSPERINCH 2.54))
-
-(RPAQ PTSPERMICA
 (FQUOTIENT PTSPERINCH MICASPERINCH))
-
-(RPAQ MICASPERPOINT
 (FQUOTIENT MICASPERINCH PTSPERINCH))
-
-
-(CONSTANTS (PTSPERPICA 12)
-       (PTSPERINCH 72)
-       (PICASPERINCH 6)
-       (MICASPERINCH 2540)
-       (PTSPERCM (FQUOTIENT PTSPERINCH 2.54))
-       (PTSPERMICA (FQUOTIENT PTSPERINCH MICASPERINCH))
-       (MICASPERPOINT (FQUOTIENT MICASPERINCH PTSPERINCH)))
-)
-
-(* "END EXPORTED DEFINITIONS")
-
 )
 
 
 
-(* ;; "")

-
-
-
-
 (* ; "Middle button in title")

 
 
@@ -2912,32 +2867,32 @@
 (ADDTOVAR LAMA
 )
 )
 (DECLARE%: DONTCOPY
-  (FILEMAP (NIL (6087 17725 (TEDIT.ADD.MENUITEM 6097 . 8214) (TEDIT.DEFAULT.MENUFN 8216 . 14937) (
-TEDIT.REMOVE.MENUITEM 14939 . 15936) (\TEDIT.CREATEMENU 15938 . 16503) (\TEDIT.MENU.WHENHELDFN 16505
- . 17410) (\TEDIT.MENU.WHENSELECTEDFN 17412 . 17723)) (18539 65182 (DRAWMARGINSCALE 18549 . 22008) (
-MARGINBAR 22010 . 29135) (MARGINBAR.CREATE 29137 . 32556) (MB.MARGINBAR.BUTTONEVENTINFN 32558 . 40360)
- (MB.MARGINBAR.SELFN.TABS 40362 . 45602) (MB.MARGINBAR.SELFN.TABS.KIND 45604 . 46539) (
-MARGINBAR.GETSTATEFN 46541 . 50528) (MARGINBAR.SETSTATEFN 50530 . 50740) (MARGINBAR.NEUTRALIZE 50742
- . 51155) (MARGINBAR.LOOKS 51157 . 54263) (MB.MARGINBAR.SIZEFN 54265 . 54868) (MB.MARGINBAR.DISPLAYFN 
-54870 . 57931) (MDESCALE 57933 . 58473) (MSCALE 58475 . 58805) (MB.MARGINBAR.SHOWTAB 58807 . 61130) (
-MB.MARGINBAR.TABTRACK 61132 . 62517) (MARGINBAR.INIT 62519 . 63912) (\TEDIT.PARALOOKS.TO.MARBAR 63914
- . 65180)) (66007 73289 (TEDIT.MENUSTREAM 66017 . 67017) (TEDITMENUP 67019 . 67988) (\TEDIT.MENU.START
- 67990 . 72337) (\TEDIT.MENU.OPEN? 72339 . 72713) (\TEDIT.MENU.BUTTONEVENTFN 72715 . 73287)) (73608 
-81530 (\TEDIT.MENU.CREATE 73618 . 75429) (\TEDIT.MENU.PARSE 75431 . 79120) (\TEDIT.MENU.NEUTRALIZE 
-79122 . 81193) (\TEDITMENU.RECORD.UNFORMATTED 81195 . 81528)) (81596 101377 (
-\TEDIT.EXPANDEDMENU.CREATE 81606 . 87073) (\TEDIT.EXPANDEDMENU.START 87075 . 88699) (
-\TEDIT.EXPANDEDMENU.FN 88701 . 91956) (\TEDIT.EXPANDEDMENU.ACTIONFN 91958 . 101375)) (101439 117496 (
-\TEDIT.PARAMENU.CREATE 101449 . 107843) (\TEDIT.PARAMENU.START 107845 . 108970) (
-\TEDIT.APPLY.PARALOOKS 108972 . 110024) (\TEDIT.SHOW.PARALOOKS 110026 . 112743) (
-\TEDIT.PARAMENU.FILLIN 112745 . 117494)) (117701 144543 (\TEDIT.CHARMENU.CREATE 117711 . 120315) (
-\TEDIT.CHARMENU.START 120317 . 121607) (\TEDIT.CHARMENU.SPEC 121609 . 126292) (\TEDIT.CHARMENU.PARSE 
-126294 . 129462) (\TEDIT.CHARMENU.FILLIN 129464 . 134094) (\TEDIT.SHOW.CHARLOOKS 134096 . 137641) (
-\TEDIT.APPLY.CHARLOOKS 137643 . 138804) (\TEDIT.OFFSETTYPE.STATEFN 138806 . 140769) (
-\TEDIT.OTHER.STATECHANGEFN 140771 . 142416) (\TEDIT.OTHER.SELECTFN 142418 . 144541)) (144605 173663 (
-\TEDIT.PAGEMENU.CREATE 144615 . 153127) (\TEDIT.PAGEMENU.START 153129 . 153480) (\TEDIT.SHOW.PAGELOOKS
- 153482 . 155368) (\TEDIT.PAGEMENU.FILLIN 155370 . 156920) (\TEDIT.PAGEREGION.UNPARSE 156922 . 166321)
- (\TEDIT.APPLY.PAGELOOKS 166323 . 168250) (\TEDIT.CHANGE.PAGELOOKS 168252 . 172819) (
-\TEDIT.PAGEMENU.CHARLOOKS.STATEFN 172821 . 173661)) (173664 179467 (\TEDIT.PAGEMENU.CREATE.HEADINGS 
-173674 . 176486) (\TEDIT.PAGEMENU.HEADINGS.SETSTATEFN 176488 . 177913) (
-\TEDIT.PAGEMENU.HEADINGS.STATEFN 177915 . 179465)))))
+  (FILEMAP (NIL (4902 16540 (TEDIT.ADD.MENUITEM 4912 . 7029) (TEDIT.DEFAULT.MENUFN 7031 . 13752) (
+TEDIT.REMOVE.MENUITEM 13754 . 14751) (\TEDIT.CREATEMENU 14753 . 15318) (\TEDIT.MENU.WHENHELDFN 15320
+ . 16225) (\TEDIT.MENU.WHENSELECTEDFN 16227 . 16538)) (17354 63997 (DRAWMARGINSCALE 17364 . 20823) (
+MARGINBAR 20825 . 27950) (MARGINBAR.CREATE 27952 . 31371) (MB.MARGINBAR.BUTTONEVENTINFN 31373 . 39175)
+ (MB.MARGINBAR.SELFN.TABS 39177 . 44417) (MB.MARGINBAR.SELFN.TABS.KIND 44419 . 45354) (
+MARGINBAR.GETSTATEFN 45356 . 49343) (MARGINBAR.SETSTATEFN 49345 . 49555) (MARGINBAR.NEUTRALIZE 49557
+ . 49970) (MARGINBAR.LOOKS 49972 . 53078) (MB.MARGINBAR.SIZEFN 53080 . 53683) (MB.MARGINBAR.DISPLAYFN 
+53685 . 56746) (MDESCALE 56748 . 57288) (MSCALE 57290 . 57620) (MB.MARGINBAR.SHOWTAB 57622 . 59945) (
+MB.MARGINBAR.TABTRACK 59947 . 61332) (MARGINBAR.INIT 61334 . 62727) (\TEDIT.PARALOOKS.TO.MARBAR 62729
+ . 63995)) (64822 72104 (TEDIT.MENUSTREAM 64832 . 65832) (TEDITMENUP 65834 . 66803) (\TEDIT.MENU.START
+ 66805 . 71152) (\TEDIT.MENU.OPEN? 71154 . 71528) (\TEDIT.MENU.BUTTONEVENTFN 71530 . 72102)) (72423 
+80345 (\TEDIT.MENU.CREATE 72433 . 74244) (\TEDIT.MENU.PARSE 74246 . 77935) (\TEDIT.MENU.NEUTRALIZE 
+77937 . 80008) (\TEDITMENU.RECORD.UNFORMATTED 80010 . 80343)) (80411 100192 (
+\TEDIT.EXPANDEDMENU.CREATE 80421 . 85888) (\TEDIT.EXPANDEDMENU.START 85890 . 87514) (
+\TEDIT.EXPANDEDMENU.FN 87516 . 90771) (\TEDIT.EXPANDEDMENU.ACTIONFN 90773 . 100190)) (100254 116311 (
+\TEDIT.PARAMENU.CREATE 100264 . 106658) (\TEDIT.PARAMENU.START 106660 . 107785) (
+\TEDIT.APPLY.PARALOOKS 107787 . 108839) (\TEDIT.SHOW.PARALOOKS 108841 . 111558) (
+\TEDIT.PARAMENU.FILLIN 111560 . 116309)) (116516 143358 (\TEDIT.CHARMENU.CREATE 116526 . 119130) (
+\TEDIT.CHARMENU.START 119132 . 120422) (\TEDIT.CHARMENU.SPEC 120424 . 125107) (\TEDIT.CHARMENU.PARSE 
+125109 . 128277) (\TEDIT.CHARMENU.FILLIN 128279 . 132909) (\TEDIT.SHOW.CHARLOOKS 132911 . 136456) (
+\TEDIT.APPLY.CHARLOOKS 136458 . 137619) (\TEDIT.OFFSETTYPE.STATEFN 137621 . 139584) (
+\TEDIT.OTHER.STATECHANGEFN 139586 . 141231) (\TEDIT.OTHER.SELECTFN 141233 . 143356)) (143420 172478 (
+\TEDIT.PAGEMENU.CREATE 143430 . 151942) (\TEDIT.PAGEMENU.START 151944 . 152295) (\TEDIT.SHOW.PAGELOOKS
+ 152297 . 154183) (\TEDIT.PAGEMENU.FILLIN 154185 . 155735) (\TEDIT.PAGEREGION.UNPARSE 155737 . 165136)
+ (\TEDIT.APPLY.PAGELOOKS 165138 . 167065) (\TEDIT.CHANGE.PAGELOOKS 167067 . 171634) (
+\TEDIT.PAGEMENU.CHARLOOKS.STATEFN 171636 . 172476)) (172479 178282 (\TEDIT.PAGEMENU.CREATE.HEADINGS 
+172489 . 175301) (\TEDIT.PAGEMENU.HEADINGS.SETSTATEFN 175303 . 176728) (
+\TEDIT.PAGEMENU.HEADINGS.STATEFN 176730 . 178280)))))
 STOP
diff --git a/library/tedit/TEDIT-MENU.LCOM b/library/tedit/TEDIT-MENU.LCOM
index d7a85ffb1..80237952a 100644
Binary files a/library/tedit/TEDIT-MENU.LCOM and b/library/tedit/TEDIT-MENU.LCOM differ
diff --git a/library/tedit/TEDIT-STREAM b/library/tedit/TEDIT-STREAM
index e9b16d3f9..c9360e8af 100644
--- a/library/tedit/TEDIT-STREAM
+++ b/library/tedit/TEDIT-STREAM
@@ -1,12 +1,12 @@
 (DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
 
-
(FILECREATED " 8-Sep-2025 22:10:32" {WMEDLEY}<library>TEDIT>TEDIT-STREAM.;913
 190947 
+
(FILECREATED "23-Sep-2025 08:19:29" {MEDLEY}<library>tedit>TEDIT-STREAM.;15
 192029 
 
       :EDIT-BY rmk
 
-      :CHANGES-TO (FNS \TEDIT.OPENTEXTSTREAM.PIECES \TEDIT.OPENTEXTFILE)
+      :CHANGES-TO (FNS \TEDIT.TEXTINIT)
 
-      :PREVIOUS-DATE "29-Jul-2025 11:58:01" {WMEDLEY}<library>TEDIT>TEDIT-STREAM.;912)
+      :PREVIOUS-DATE "20-Sep-2025 08:49:36" {MEDLEY}<library>tedit>TEDIT-STREAM.;14)
 
 
 (PRETTYCOMPRINT TEDIT-STREAMCOMS)
@@ -234,7 +234,7 @@
                    TXTRAWINCLUDESTREAM                       (* ; 
 
                       "NODIRCORE stream used to cache RAW includes (and maybe later, all includes?)")

                    DOCPROPS                                  (* ; 
-
                               "Document properties that are stored with the document (not used yet)")

+
                      "Document properties that are stored with the document. Not used before 9/2025")

                    TXTSTYLESHEET                             (* ; 
 
                      "Style sheet local to this document.  Not currently saved as part of the file.")

                    )
@@ -284,14 +284,14 @@
                           ACCESS _ 'BOTH
                           USERCLOSEABLE _ T
                           USERVISIBLE _ T
-                          DEVICE _ \TEXTFDEV
+                          DEVICE _ \TEDITFDEV
                           F1 _ NIL
                           F2 _ 0
                           F3 _ NIL
                           F4 _ NIL
                           F5 _ NIL
                           MAXBUFFERS _ 10
-                          IMAGEOPS _ \TEXTIMAGEOPS
+                          IMAGEOPS _ \TEDITIMAGEOPS
                           IMAGEDATA _ NIL)))
 )
 
@@ -1232,6 +1232,8 @@
 (OPENTEXTSTREAM

   [LAMBDA (TEXT WINDOW START/PROPS END PROPS)
 
+    (* ;; "Edited  9-Sep-2025 22:07 by rmk")

+
     (* ;; "Edited 17-Feb-2025 08:57 by rmk")

 
     (* ;; "Edited 30-Jan-2025 11:15 by rmk")

@@ -1244,32 +1246,14 @@
 
     (* ;; "Edited 30-Jun-2024 16:17 by rmk")

 
-    (* ;; "Edited 25-Jun-2024 11:59 by rmk")

-
     (* ;; "Edited 10-May-2024 22:42 by rmk")

 
-    (* ;; "Edited  6-May-2024 12:38 by rmk")

-
     (* ;; "Edited 31-Mar-2024 11:43 by rmk")

 
-    (* ;; "Edited 17-Mar-2024 12:05 by rmk")

-
-    (* ;; "Edited 15-Mar-2024 14:23 by rmk")

-
-    (* ;; "Edited 10-Mar-2024 22:10 by rmk")

-
     (* ;; "Edited 21-Jan-2024 10:31 by rmk")

 
     (* ;; "Edited 20-Dec-2023 10:47 by rmk")

 
-    (* ;; "Edited 11-Dec-2023 09:50 by rmk")

-
-    (* ;; "Edited 26-Oct-2023 10:59 by rmk")

-
-    (* ;; "Edited 23-Oct-2023 22:14 by rmk")

-
-    (* ;; "Edited 21-Oct-2023 12:21 by rmk")

-
     (* ;; "Edited 12-Oct-2023 23:44 by rmk")

 
     (* ;; "Edited 31-Jan-2022 17:25 by rmk: A string TEXT is converted here to a stream")

@@ -1330,10 +1314,17 @@
                                      else
 (\TEDIT.WINDOW.CREATE WINDOW TSTREAM PROPS)))
                else
 (SETQ TSTREAM (\TEDIT.CREATE.TEXTSTREAM
 PROPS))
                     (SETQ TEXTOBJ (FGETTSTR TSTREAM TEXTOBJ))
-                    (CL:WHEN TEXT                            (* ; 
+                    (if
 TEXT
+                        then
                                 (* ; 
 
                                                             "Verify/open the file before the window")

-                        (SETQ TEXT (\TEDIT.OPENTEXTFILE
 TEXT PROPS))
-                        (FSETTOBJ TEXTOBJ TXTFILE TEXT)) 
+                             (SETQ TEXT (\TEDIT.OPENTEXTFILE
 TEXT PROPS))
+                             (FSETTOBJ TEXTOBJ TXTFILE TEXT)
+                      else
 
+                           (* ;; "An empty document starts in an MCCS environment")

+
+                           (FPUTMULTI (FGETTOBJ TEXTOBJ DOCPROPS)
+                                  'CHARENCODING
+                                  'MCCS)) 
 
                     (* ;; "If we swap the window before the pieces, the local promptwindow is availabe for messages and queries. Otherwise, those show up in the system prompt.  But if we do it in the opposite order, we don't know how to estimate the width for the window region.")

 
@@ -1666,7 +1657,8 @@
          (SETTOBJ TEXTOBJ DEFAULTPARALOOKS PARALOOKS])
 
 (\TEDIT.OPENTEXTFILE

-  [LAMBDA (TEXT PROPS)
                                       (* ; "Edited  8-Sep-2025 21:52 by rmk")


+  [LAMBDA (TEXT PROPS)
                                       (* ; "Edited 16-Sep-2025 00:28 by rmk")


+                                                             (* ; "Edited  8-Sep-2025 21:52 by rmk")


                                                              (* ; "Edited 21-Nov-2024 11:38 by rmk")


                                                              (* ; "Edited 20-Dec-2023 10:49 by rmk")


                                                              (* ; "Edited 28-Oct-2023 10:33 by rmk")


@@ -1675,24 +1667,26 @@
                                                              (* ; "Edited 18-Sep-2023 22:40 by rmk")


                                                              (* ; "Edited 17-Sep-2023 21:29 by rmk")

     (CL:WHEN TEXT
-        (if
 (OR (LITATOM TEXT)
-                (STRINGP TEXT)
-                (CL:PATHNAMEP TEXT))
+        (if
 (\GETSTREAM TEXT 'INPUT T)
+          elseif
 (OR (LITATOM TEXT)
+                     (STRINGP TEXT)
+                     (CL:PATHNAMEP TEXT)
+                     (STREAMP TEXT))
             then
                                             (* ; "String detects empty extension")

-                 [RESETSAVE [SETQ TEXT (OPENSTREAM (OR (if
 (OR (CL:PATHNAMEP TEXT)
-                                                               (FILENAMEFIELD.STRING TEXT
-                                                                      'EXTENSION))
-                                                           then
 (FINDFILE TEXT T)
-                                                         elseif
 (FINDFILE-WITH-EXTENSIONS TEXT NIL 
-                                                                       *TEDIT-EXTENSIONS*))
-                                                       TEXT)
+                 [RESETSAVE [SETQ TEXT (OPENSTREAM (if
 (STREAMP TEXT)
+                                                     elseif
 (OR (CL:PATHNAMEP TEXT)
+                                                                (FILENAMEFIELD.STRING TEXT
+                                                                       'EXTENSION))
+                                                       then
 (FINDFILE TEXT T)
+                                                     elseif
 (FINDFILE-WITH-EXTENSIONS TEXT NIL 
+                                                                   *TEDIT-EXTENSIONS*)
+                                                     else
 TEXT)
                                               'INPUT
                                               'OLD
                                               `((TYPE TEXT)
                                                 (FORMAT ,(LISTGET PROPS 'FORMAT]
                         '(PROGN (AND RESETSTATE (CLOSEF? OLDVALUE]
                  TEXT
-          elseif
 (\GETSTREAM TEXT 'INPUT T)
           else
 
                (* ;; "Don't know what it is")

 
@@ -1757,7 +1751,10 @@
                 NEWSTREAM])
 
 (\TEDIT.TEXTINIT

-  [LAMBDA NIL
                                                (* ; "Edited 10-Jul-2025 11:28 by rmk")


+  [LAMBDA NIL
                                                (* ; "Edited 23-Sep-2025 08:19 by rmk")


+                                                             (* ; "Edited 20-Sep-2025 08:48 by rmk")


+                                                             (* ; "Edited 18-Sep-2025 14:52 by rmk")


+                                                             (* ; "Edited 10-Jul-2025 11:28 by rmk")


                                                              (* ; "Edited 15-Apr-2025 23:10 by rmk")


                                                              (* ; "Edited  4-Sep-2024 22:05 by rmk")


                                                              (* ; "Edited 22-May-2024 14:53 by rmk")


@@ -1771,11 +1768,11 @@
                                                              (* ; "Edited  5-May-2022 15:12 by rmk")


                                                             (* ; "Edited  7-Oct-2021 08:40 by rmk:")

                                                              (* ; 
-
                                            "Create the FDEV and STREAM prototypes for TEXT streams.")

+
                                           "Create the FDEV and STREAM prototypes for TEDIT streams.")

 
-    (* ;; "TEXT streams make use of the following STREAM fields:")

+    (* ;; "TEDIT streams make use of the following STREAM fields:")

 
-    (* ;; "(DEVICE (* FDEV of this guy -- The TEXT device)")

+    (* ;; "(DEVICE (* FDEV of this guy -- The TEDIT device)")

 
     (* ;; "F1 Number of characters to the end of the current piece")

 
@@ -1793,24 +1790,28 @@
 
     (* ;; "(FW8 WORD)")

 
-    (SETQ \TEXTIMAGEOPS (create
 IMAGEOPS
-                               IMAGETYPE _ 'TEXT
-                               IMXPOSITION _ (FUNCTION \TEDIT.TEXTDSPXPOSITION)
-                               IMYPOSITION _ (FUNCTION \TEDIT.TEXTDSPYPOSITION)
-                               IMLEFTMARGIN _ (FUNCTION \TEDIT.TEXTLEFTMARGIN)
-                               IMRIGHTMARGIN _ (FUNCTION \TEDIT.TEXTRIGHTMARGIN)
-                               IMFONT _ (FUNCTION \TEDIT.TEXTDSPFONT)
-                               IMCLOSEFN _ (FUNCTION NILL)
-                               IMFONTCREATE _ 'DISPLAY
-                               IMLINEFEED _ (FUNCTION \TEDIT.TEXTDSPLINEFEED)
-                               IMCHARWIDTH _ (FUNCTION \TEDIT.TEXTDSPCHARWIDTH)
-                               IMSTRINGWIDTH _ (FUNCTION \TEDIT.TEXTDSPSTRINGWIDTH)
-                               IMSCALE _ [FUNCTION (LAMBDA NIL 1]
-                               IMCOLOR _ (FUNCTION \TEDIT.TEXTCOLOR)))
+    (SETQ \TEDITIMAGEOPS (create
 IMAGEOPS
+                                IMAGETYPE _ 'TEXT
+                                IMXPOSITION _ (FUNCTION \TEDIT.TEXTDSPXPOSITION)
+                                IMYPOSITION _ (FUNCTION \TEDIT.TEXTDSPYPOSITION)
+                                IMLEFTMARGIN _ (FUNCTION \TEDIT.TEXTLEFTMARGIN)
+                                IMRIGHTMARGIN _ (FUNCTION \TEDIT.TEXTRIGHTMARGIN)
+                                IMFONT _ (FUNCTION \TEDIT.TEXTDSPFONT)
+                                IMCLOSEFN _ (FUNCTION NILL)
+                                IMFONTCREATE _ 'DISPLAY
+                                IMLINEFEED _ (FUNCTION \TEDIT.TEXTDSPLINEFEED)
+                                IMCHARWIDTH _ (FUNCTION \TEDIT.TEXTDSPCHARWIDTH)
+                                IMSTRINGWIDTH _ (FUNCTION \TEDIT.TEXTDSPSTRINGWIDTH)
+                                IMSCALE _ [FUNCTION (LAMBDA NIL 1]
+                                IMCOLOR _ (FUNCTION \TEDIT.TEXTCOLOR)))
+
+    (* ;; "Do we need TEXT here?")

+
     (FONTPROFILE.ADDDEVICE 'TEXT 'DISPLAY)
     (ADDTOVAR IMAGESTREAMTYPES
 (TEXT (FONTCREATE \CREATEDISPLAYFONT)
-                                     (FONTSAVAILABLE \SEARCHFONTFILES)
                                      (CREATECHARSET \CREATECHARSET.DISPLAY)))
+    (ADDTOVAR IMAGESTREAMTYPES
 (TEDIT (FONTCREATE \CREATEDISPLAYFONT)
+                                      (CREATECHARSET \CREATECHARSET.DISPLAY)))
 
     (* ;; "Maybe more functions later. The INCODE and BACK functions possibly need to count.  If \TEXTBACKFILEPTR takes a count variable, the extra level wouldn't be needed.  But INCCODE wants to go through the BIN opcode")

 
@@ -1820,41 +1821,41 @@
            (FUNCTION \TEDIT.TEXTOUTCHARFN)
            (FUNCTION \TEDIT.TEXTFORMATBYTESTREAM)
            'CR NIL (FUNCTION \TEDIT.TEXTFORMATBYTESTRING))
-    (SETQ \TEXTFDEV (create
 FDEV
-                           DEVICENAME _ 'TEXT
-                           RESETABLE _ T
-                           RANDOMACCESSP _ T
-                           PAGEMAPPED _ NIL
-                           GETFILENAME _ (FUNCTION NILL)
-                           BIN _ (FUNCTION \TEDIT.TEXTBIN)
-                           BOUT _ (FUNCTION \TEDIT.TEXTBOUT)
-                           CLOSEFILE _ (FUNCTION \TEDIT.TEXTCLOSEF)
-                           OPENFILE _ (FUNCTION \TEDIT.TEXTOPENF)
-                           DELETEFILE _ (FUNCTION NILL)
-                           DIRECTORYNAMEP _ (FUNCTION NILL)
-                           EVENTFN _ (FUNCTION NILL)
-                           GENERATEFILES _ (FUNCTION \GENERATENOFILES)
-                           GETFILEINFO _ (FUNCTION NILL)
-                           HOSTNAMEP _ (FUNCTION NILL)
-                           READPAGES _ (FUNCTION NILL)
-                           REOPENFILE _ [FUNCTION (LAMBDA (FILE ACCESS RECOG OTHERINFO FDEV STREAM)
-                                                    (replace
 (STREAM ACCESS) of
 STREAM
-                                                       with
 'BOTH)
-                                                    STREAM]
-                           SETFILEINFO _ (FUNCTION \TEDIT.TEXTSETFILEINFO)
-                           BACKFILEPTR _ (FUNCTION \TEDIT.TEXTBACKFILEPTR)
-                           SETFILEPTR _ (FUNCTION \TEDIT.TEXTSETFILEPTR)
-                           PEEKBIN _ (FUNCTION \TEDIT.TEXTPEEKBIN)
-                           GETEOFPTR _ (FUNCTION \TEDIT.TEXTGETEOFPTR)
-                           SETEOFPTR _ (FUNCTION \TEDIT.TEXTSETEOFPTR)
-                           GETFILEPTR _ (FUNCTION \TEDIT.TEXTGETFILEPTR)
-                           EOFP _ (FUNCTION \TEDIT.TEXTEOFP)
-                           FDBINABLE _ T
-                           FDBOUTABLE _ NIL
-                           FDEXTENDABLE _ NIL
-                           TRUNCATEFILE _ (FUNCTION NILL)
-                           WRITEPAGES _ (FUNCTION NILL)
-                           DEFAULTEXTERNALFORMAT _ :TEXTSTREAM))
+    (SETQ \TEDITFDEV (create
 FDEV
+                            DEVICENAME _ 'TEDIT
+                            RESETABLE _ T
+                            RANDOMACCESSP _ T
+                            PAGEMAPPED _ NIL
+                            GETFILENAME _ (FUNCTION NILL)
+                            BIN _ (FUNCTION \TEDIT.TEXTBIN)
+                            BOUT _ (FUNCTION \TEDIT.TEXTBOUT)
+                            CLOSEFILE _ (FUNCTION \TEDIT.TEXTCLOSEF)
+                            OPENFILE _ (FUNCTION \TEDIT.TEXTOPENF)
+                            DELETEFILE _ (FUNCTION NILL)
+                            DIRECTORYNAMEP _ (FUNCTION NILL)
+                            EVENTFN _ (FUNCTION NILL)
+                            GENERATEFILES _ (FUNCTION \GENERATENOFILES)
+                            GETFILEINFO _ (FUNCTION NILL)
+                            HOSTNAMEP _ (FUNCTION NILL)
+                            READPAGES _ (FUNCTION NILL)
+                            REOPENFILE _ [FUNCTION (LAMBDA (FILE ACCESS RECOG OTHERINFO FDEV STREAM)
+                                                     (replace
 (STREAM ACCESS) of
 STREAM
+                                                        with
 'BOTH)
+                                                     STREAM]
+                            SETFILEINFO _ (FUNCTION \TEDIT.TEXTSETFILEINFO)
+                            BACKFILEPTR _ (FUNCTION \TEDIT.TEXTBACKFILEPTR)
+                            SETFILEPTR _ (FUNCTION \TEDIT.TEXTSETFILEPTR)
+                            PEEKBIN _ (FUNCTION \TEDIT.TEXTPEEKBIN)
+                            GETEOFPTR _ (FUNCTION \TEDIT.TEXTGETEOFPTR)
+                            SETEOFPTR _ (FUNCTION \TEDIT.TEXTSETEOFPTR)
+                            GETFILEPTR _ (FUNCTION \TEDIT.TEXTGETFILEPTR)
+                            EOFP _ (FUNCTION \TEDIT.TEXTEOFP)
+                            FDBINABLE _ T
+                            FDBOUTABLE _ NIL
+                            FDEXTENDABLE _ NIL
+                            TRUNCATEFILE _ (FUNCTION NILL)
+                            WRITEPAGES _ (FUNCTION NILL)
+                            DEFAULTEXTERNALFORMAT _ :TEXTSTREAM))
     (CL:SETF (CONDITION-HANDLER 'XCL:STREAM-NOT-OPEN)
            (FUNCTION (LAMBDA (CONDITION)
                        (LET ((STREAM (STREAM-ERROR-STREAM CONDITION)))
@@ -2099,7 +2100,8 @@
              (\TEDIT.INSTALL.PIECE
 TSTREAM PC (- CH# START-OF-PIECE)))])
 
 (\TEDIT.TEXTDSPXPOSITION

-  [LAMBDA (TSTREAM XPOSITION)
                                (* ; "Edited 25-Jun-2024 11:59 by rmk")


+  [LAMBDA (TSTREAM XPOSITION)
                                (* ; "Edited 20-Sep-2025 08:30 by rmk")


+                                                             (* ; "Edited 25-Jun-2024 11:59 by rmk")


                                                              (* ; "Edited 17-Mar-2024 12:15 by rmk")


                                                             (* ; "Edited  3-Jan-2001 17:27 by rmk:")


                                                   (* ; 
@@ -2108,13 +2110,18 @@
     (* ;; 
 
  "Simply returns the XPOSITION of the primary window's display stream, this is a read-only function")

 
-    (LET ((WINDOW (\TEDIT.PRIMARYPANE TSTREAM)))             (* ; 
+    (LET ((WINDOW (\TEDIT.PRIMARYPANE TSTREAM))
+          SPACEWIDTH)                                        (* ; 
 
                                            "If there is no window, estimate from character position")

-         (CL:IF WINDOW
-             (DSPXPOSITION NIL WINDOW)
-             (TIMES (CHARWIDTH (CHARCODE SPACE)
-                           TSTREAM)
-                    (POSITION TSTREAM)))])
+         (if
 WINDOW
+             then
 (DSPXPOSITION XPOSITION WINDOW)
+           else
 (SETQ SPACEWIDTH (CHARWIDTH (CHARCODE SPACE)
+                                        TSTREAM))
+                (PROG1 (TIMES SPACEWIDTH (POSITION TSTREAM))
+                    (CL:WHEN (AND XPOSITION (IGEQ XPOSITION 0))
+                        (SPACES (IDIFFERENCE (QUOTIENT XPOSITION SPACEWIDTH)
+                                       (POSITION TSTREAM))
+                               TSTREAM)))])
 
 (\TEDIT.TEXTDSPYPOSITION

   [LAMBDA (TSTREAM YPOSITION)
                                (* ; "Edited 25-Jun-2024 11:59 by rmk")


@@ -3128,34 +3135,34 @@
 (ADDTOVAR LAMA
 TEXTPROP)
 )
 (DECLARE%: DONTCOPY
-  (FILEMAP (NIL (36922 67738 (\TEDIT.TEXTBIN 36932 . 47682) (\TEDIT.TEXTPEEKBIN 47684 . 53234) (
-\TEDIT.TEXTBACKFILEPTR 53236 . 58909) (\TEDIT.TEXTBOUT 58911 . 63528) (\TEDIT.INSTALL.FILEBUFFER 63530
- . 67736)) (68636 72927 (\TEDIT.TEXTOUTCHARFN 68646 . 70202) (\TEDIT.TEXTINCCODEFN 70204 . 70943) (
-\TEDIT.TEXTBACKCCODEFN 70945 . 71537) (\TEDIT.TEXTFORMATBYTESTREAM 71539 . 72376) (
-\TEDIT.TEXTFORMATBYTESTRING 72378 . 72925)) (72974 84615 (OPENTEXTSTREAM 72984 . 79936) (
-COPYTEXTSTREAM 79938 . 83838) (TEDIT.STREAMCHANGEDP 83840 . 84142) (TXTFILE 84144 . 84613)) (84616 
-115130 (\TEDIT.REOPENTEXTSTREAM 84626 . 85978) (\TEDIT.OPENTEXTSTREAM.PIECES 85980 . 90908) (
-\TEDIT.OPENTEXTSTREAM.PROPS 90910 . 92012) (\TEDIT.OPENTEXTSTREAM.SETUP.SEL 92014 . 97255) (
-\TEDIT.OPENTEXTSTREAM.WINDOW 97257 . 100048) (\TEDIT.OPENTEXTSTREAM.DEFAULTLOOKS 100050 . 101989) (
-\TEDIT.OPENTEXTFILE 101991 . 104242) (\TEDIT.CREATE.TEXTSTREAM 104244 . 105391) (\TEDIT.REOPEN.STREAM 
-105393 . 107729) (\TEDIT.TEXTINIT 107731 . 115128)) (115168 116356 (\TEDIT.TTYBOUT 115178 . 116354)) (
-116474 136471 (\TEDIT.TEXTCLOSEF 116484 . 117808) (\TEDIT.TEXTDSPFONT 117810 . 119008) (
-\TEDIT.TEXTEOFP 119010 . 120765) (\TEDIT.TEXTGETEOFPTR 120767 . 121090) (\TEDIT.TEXTSETEOFPTR 121092
- . 122379) (\TEDIT.TEXTGETFILEPTR 122381 . 125216) (\TEDIT.TEXTSETFILEINFO 125218 . 125726) (
-\TEDIT.TEXTOPENF 125728 . 126659) (\TEDIT.TEXTSETEOF 126661 . 127277) (\TEDIT.TEXTSETFILEPTR 127279 . 
-129389) (\TEDIT.TEXTDSPXPOSITION 129391 . 130408) (\TEDIT.TEXTDSPYPOSITION 130410 . 131151) (
-\TEDIT.TEXTLEFTMARGIN 131153 . 131744) (\TEDIT.TEXTCOLOR 131746 . 132329) (\TEDIT.TEXTRIGHTMARGIN 
-132331 . 135620) (\TEDIT.TEXTDSPCHARWIDTH 135622 . 135926) (\TEDIT.TEXTDSPSTRINGWIDTH 135928 . 136234)
- (\TEDIT.TEXTDSPLINEFEED 136236 . 136469)) (136509 149122 (\TEDIT.NTHCHARCODE 136519 . 137970) (
-\TEDIT.PIECE.NTHCHARCODE 137972 . 141882) (\TEDIT.RPLCHARCODE 141884 . 143342) (
-\TEDIT.PIECE.RPLCHARCODE 143344 . 148767) (\TEDIT.NTHCHARLOOKS 148769 . 149120)) (150169 171263 (
-\TEDIT.DELETE.SELPIECES 150179 . 153804) (\TEDIT.INSERTCH 153806 . 161845) (\TEDIT.INSERTCH.HISTORY 
-161847 . 165311) (\TEDIT.INSERTEOL 165313 . 167138) (\TEDIT.INSERTCH.INSERTION 167140 . 169977) (
-\TEDIT.INSERTCH.EXTEND 169979 . 171261)) (171264 172768 (\TEDIT.NEXTCHANGEABLE.CHNO 171274 . 171989) (
-\TEDIT.LASTCHANGEABLE.CHNO 171991 . 172766)) (172769 174473 (\SETUPGETCH 172779 . 174471)) (174531 
-178989 (\TEDIT.INSTALL.PIECE 174541 . 178987)) (179027 188128 (TEXTPROP 179037 . 179384) (GETTEXTPROP 
-179386 . 179630) (PUTTEXTPROP 179632 . 179889) (GETTEXTPROPS 179891 . 180335) (PUTTEXTPROPS 180337 . 
-181241) (TEXTPROP.ADD 181243 . 181506) (\TEDIT.TEXTPROP 181508 . 188126)) (188129 190199 (
-\TEDIT.TEXTOBJ.PROPNAMES 188139 . 189091) (\TEDIT.TEXTOBJ.PROPFETCHFN 189093 . 189609) (
-\TEDIT.TEXTOBJ.PROPSTOREFN 189611 . 190197)))))
+  (FILEMAP (NIL (36887 67703 (\TEDIT.TEXTBIN 36897 . 47647) (\TEDIT.TEXTPEEKBIN 47649 . 53199) (
+\TEDIT.TEXTBACKFILEPTR 53201 . 58874) (\TEDIT.TEXTBOUT 58876 . 63493) (\TEDIT.INSTALL.FILEBUFFER 63495
+ . 67701)) (68601 72892 (\TEDIT.TEXTOUTCHARFN 68611 . 70167) (\TEDIT.TEXTINCCODEFN 70169 . 70908) (
+\TEDIT.TEXTBACKCCODEFN 70910 . 71502) (\TEDIT.TEXTFORMATBYTESTREAM 71504 . 72341) (
+\TEDIT.TEXTFORMATBYTESTRING 72343 . 72890)) (72939 84503 (OPENTEXTSTREAM 72949 . 79824) (
+COPYTEXTSTREAM 79826 . 83726) (TEDIT.STREAMCHANGEDP 83728 . 84030) (TXTFILE 84032 . 84501)) (84504 
+115746 (\TEDIT.REOPENTEXTSTREAM 84514 . 85866) (\TEDIT.OPENTEXTSTREAM.PIECES 85868 . 90796) (
+\TEDIT.OPENTEXTSTREAM.PROPS 90798 . 91900) (\TEDIT.OPENTEXTSTREAM.SETUP.SEL 91902 . 97143) (
+\TEDIT.OPENTEXTSTREAM.WINDOW 97145 . 99936) (\TEDIT.OPENTEXTSTREAM.DEFAULTLOOKS 99938 . 101877) (
+\TEDIT.OPENTEXTFILE 101879 . 104356) (\TEDIT.CREATE.TEXTSTREAM 104358 . 105505) (\TEDIT.REOPEN.STREAM 
+105507 . 107843) (\TEDIT.TEXTINIT 107845 . 115744)) (115784 116972 (\TEDIT.TTYBOUT 115794 . 116970)) (
+117090 137553 (\TEDIT.TEXTCLOSEF 117100 . 118424) (\TEDIT.TEXTDSPFONT 118426 . 119624) (
+\TEDIT.TEXTEOFP 119626 . 121381) (\TEDIT.TEXTGETEOFPTR 121383 . 121706) (\TEDIT.TEXTSETEOFPTR 121708
+ . 122995) (\TEDIT.TEXTGETFILEPTR 122997 . 125832) (\TEDIT.TEXTSETFILEINFO 125834 . 126342) (
+\TEDIT.TEXTOPENF 126344 . 127275) (\TEDIT.TEXTSETEOF 127277 . 127893) (\TEDIT.TEXTSETFILEPTR 127895 . 
+130005) (\TEDIT.TEXTDSPXPOSITION 130007 . 131490) (\TEDIT.TEXTDSPYPOSITION 131492 . 132233) (
+\TEDIT.TEXTLEFTMARGIN 132235 . 132826) (\TEDIT.TEXTCOLOR 132828 . 133411) (\TEDIT.TEXTRIGHTMARGIN 
+133413 . 136702) (\TEDIT.TEXTDSPCHARWIDTH 136704 . 137008) (\TEDIT.TEXTDSPSTRINGWIDTH 137010 . 137316)
+ (\TEDIT.TEXTDSPLINEFEED 137318 . 137551)) (137591 150204 (\TEDIT.NTHCHARCODE 137601 . 139052) (
+\TEDIT.PIECE.NTHCHARCODE 139054 . 142964) (\TEDIT.RPLCHARCODE 142966 . 144424) (
+\TEDIT.PIECE.RPLCHARCODE 144426 . 149849) (\TEDIT.NTHCHARLOOKS 149851 . 150202)) (151251 172345 (
+\TEDIT.DELETE.SELPIECES 151261 . 154886) (\TEDIT.INSERTCH 154888 . 162927) (\TEDIT.INSERTCH.HISTORY 
+162929 . 166393) (\TEDIT.INSERTEOL 166395 . 168220) (\TEDIT.INSERTCH.INSERTION 168222 . 171059) (
+\TEDIT.INSERTCH.EXTEND 171061 . 172343)) (172346 173850 (\TEDIT.NEXTCHANGEABLE.CHNO 172356 . 173071) (
+\TEDIT.LASTCHANGEABLE.CHNO 173073 . 173848)) (173851 175555 (\SETUPGETCH 173861 . 175553)) (175613 
+180071 (\TEDIT.INSTALL.PIECE 175623 . 180069)) (180109 189210 (TEXTPROP 180119 . 180466) (GETTEXTPROP 
+180468 . 180712) (PUTTEXTPROP 180714 . 180971) (GETTEXTPROPS 180973 . 181417) (PUTTEXTPROPS 181419 . 
+182323) (TEXTPROP.ADD 182325 . 182588) (\TEDIT.TEXTPROP 182590 . 189208)) (189211 191281 (
+\TEDIT.TEXTOBJ.PROPNAMES 189221 . 190173) (\TEDIT.TEXTOBJ.PROPFETCHFN 190175 . 190691) (
+\TEDIT.TEXTOBJ.PROPSTOREFN 190693 . 191279)))))
 STOP
diff --git a/library/tedit/TEDIT-STREAM.LCOM b/library/tedit/TEDIT-STREAM.LCOM
index 913a2bc88..42aceda27 100644
Binary files a/library/tedit/TEDIT-STREAM.LCOM and b/library/tedit/TEDIT-STREAM.LCOM differ
diff --git a/library/tedit/TEDIT-TFBRAVO b/library/tedit/TEDIT-TFBRAVO
index 9e2b9b10b..68f723837 100644
--- a/library/tedit/TEDIT-TFBRAVO
+++ b/library/tedit/TEDIT-TFBRAVO
@@ -1,13 +1,13 @@
 (DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
 
-
(FILECREATED "28-Jul-2025 23:34:14" 
-{DSK}<Users>kaplan>Local>medley3.5>working-medley>library>tedit>TEDIT-TFBRAVO.;185
 97353  
+
(FILECREATED " 7-Sep-2025 11:11:43" 
+{DSK}<Users>kaplan>Local>medley3.5>working-medley>library>tedit>TEDIT-TFBRAVO.;187
 97463  
 
       :EDIT-BY rmk
 
-      :CHANGES-TO (FNS \TFBRAVO.INSERT.RUN \TFBRAVO.INIT.PARALOOKS)
+      :CHANGES-TO (FNS TEDITFROMBRAVO \TFBRAVO.FONT.FROM.CHARLOOKS)
 
-      :PREVIOUS-DATE "10-May-2025 12:53:24" {WMEDLEY}<library>TEDIT>TEDIT-TFBRAVO.;183)
+      :PREVIOUS-DATE "28-Jul-2025 23:34:14" {WMEDLEY}<library>TEDIT>TEDIT-TFBRAVO.;185)
 
 
 (PRETTYCOMPRINT TEDIT-TFBRAVOCOMS)
@@ -186,7 +186,8 @@
           (RETURN T])
 
 (TEDITFROMBRAVO

-  [LAMBDA (BFILE TSTREAM PROPS USER.CM)
                      (* ; "Edited  9-May-2025 09:18 by rmk")


+  [LAMBDA (BFILE TSTREAM PROPS USER.CM)
                      (* ; "Edited  7-Sep-2025 11:09 by rmk")


+                                                             (* ; "Edited  9-May-2025 09:18 by rmk")


                                                              (* ; "Edited 28-Mar-2025 14:16 by rmk")


                                                              (* ; "Edited 19-Feb-2025 12:13 by rmk")


                                                              (* ; "Edited  8-Feb-2025 23:03 by rmk")


@@ -248,7 +249,7 @@
                  (for
 CHARLOOKS in
 (GETTOBJ TEXTOBJ TXTCHARLOOKSLIST)
                     do
 (SETCLOOKS CHARLOOKS CLUSERINFO NIL))
                  (\TEDIT.UNIQUIFY.ALL TEXTOBJ)               (* ; "Lists are complete and unique")

-                 (\TEDIT.TRANSLATE.ASCIICHARS TSTREAM)
+                 (\TEDIT.MCCS.TRANSLATE TSTREAM)
                  (TEDIT.SETSEL TEXTOBJ 1 0 'LEFT)
                  (RETURN TSTREAM)))])
 )
@@ -783,11 +784,12 @@
                             RUNLAST _ LAST])
 
 (\TFBRAVO.FONT.FROM.CHARLOOKS

-  [LAMBDA (CHARLOOKS FAMILY SIZE BOLD ITALIC)
                (* ; "Edited  2-Jan-2025 23:43 by rmk")


+  [LAMBDA (CHARLOOKS FAMILY SIZE BOLD ITALIC)
                (* ; "Edited  7-Sep-2025 11:02 by rmk")


+                                                             (* ; "Edited  2-Jan-2025 23:43 by rmk")


                                                              (* ; "Edited  1-Aug-2023 13:21 by rmk")


                                                              (* ; "Edited 31-May-91 15:26 by jds")

 
-    (* ;; "Takes a TEDIT CHARLOOKS with fields filled in (CLNAME = family name) and creates the font to fill it.")

+    (* ;; "Takes a TEDIT CHARLOOKS with fields filled in and creates the font to fill it.")

 
     [LET ((OLDFONT (GETCLOOKS CHARLOOKS CLFONT)))
          (CL:WHEN (EQ FAMILY 'OFF)
@@ -798,14 +800,13 @@
              [SETQ BOLD (EQ 'BOLD (FONTPROP OLDFONT 'WEIGHT])
          (CL:WHEN (EQ ITALIC 'OFF)
              [SETQ ITALIC (EQ 'ITALIC (FONTPROP OLDFONT 'SLOPE])
-         [SETCLOOKS CHARLOOKS CLFONT (FONTCREATE FAMILY SIZE (LIST (CL:IF BOLD
+         (SETCLOOKS CHARLOOKS CLFONT (FONTCREATE FAMILY SIZE (LIST (CL:IF BOLD
                                                                        'BOLD
                                                                        'MEDIUM)
                                                                    (CL:IF ITALIC
                                                                        'ITALIC
                                                                        'REGULAR)
                                                                    'REGULAR]
-         (SETCLOOKS CHARLOOKS CLNAME (FONTUNPARSE (GETCLOOKS CHARLOOKS CLFONT]
     CHARLOOKS])
 
 (\TFBRAVO.READNUM?

@@ -1555,18 +1556,18 @@
 (AND NIL (\TEDIT.NAMEDTAB.INIT
))
 )
 (DECLARE%: DONTCOPY
-  (FILEMAP (NIL (7665 14656 (TEDIT.BRAVOFILE? 7675 . 9405) (TEDITFROMBRAVO 9407 . 14654)) (14767 31183 (
-\TFBRAVO.GET.USER.CM 14777 . 17957) (\TFBRAVO.USER.CM.LOOKS 17959 . 19452) (\TFBRAVO.READ.USER.CM 
-19454 . 24077) (\TFBRAVO.INIT.PARALOOKS 24079 . 26296) (\TFBRAVO.INIT.PAGEFORMAT 26298 . 27178) (
-\TFBRAVO.GETPARAMS 27180 . 30034) (\TFBRAVO.FIND.LAST.TRAILER 30036 . 31181)) (31225 51923 (
-\TFBRAVO.PARSE.PARA 31235 . 35162) (\TFBRAVO.READ.PARALOOKS 35164 . 42054) (\TFBRAVO.CREATE.RUNS 42056
- . 43444) (\TFBRAVO.READ.CHARLOOKS 43446 . 48475) (\TFBRAVO.FONT.FROM.CHARLOOKS 48477 . 50024) (
-\TFBRAVO.READNUM? 50026 . 51921)) (51960 63001 (\TFBRAVO.HANDLE.HEADING 51970 . 54697) (
-\TFBRAVO.PARSE.PROFILE.PARA 54699 . 62999)) (63044 85378 (\TFBRAVO.INSERT.PARA 63054 . 63895) (
-\TFBRAVO.INSERT.RUN 63897 . 67388) (\TFBRAVO.SPLIT.PARA 67390 . 74814) (\TFBRAVO.RUN.TABSPEC 74816 . 
-79683) (\TFBRAVO.INSTALL.PAGEFORMAT 79685 . 85376)) (85379 89522 (\TFBRAVO.ASSERT 85389 . 85919) (
-\TEST.CHARACTER.LOOKS 85921 . 87807) (\TEST.PARAGRAPH.LOOKS 87809 . 89520)) (90532 97187 (
-\TFBRAVO.ADD.NAMEDTAB 90542 . 94145) (\TFBRAVO.COPY.NAMEDTAB 94147 . 94595) (\TFBRAVO.PUT.NAMEDTAB 
-94597 . 94877) (\TFBRAVO.GET.NAMEDTAB 94879 . 95256) (\NAMEDTABNYET 95258 . 95418) (\NAMEDTABSIZE 
-95420 . 95935) (\NAMEDTABPREPRINT 95937 . 96135) (\TEDIT.NAMEDTAB.INIT 96137 . 97185)))))
+  (FILEMAP (NIL (7665 14759 (TEDIT.BRAVOFILE? 7675 . 9405) (TEDITFROMBRAVO 9407 . 14757)) (14870 31286 (
+\TFBRAVO.GET.USER.CM 14880 . 18060) (\TFBRAVO.USER.CM.LOOKS 18062 . 19555) (\TFBRAVO.READ.USER.CM 
+19557 . 24180) (\TFBRAVO.INIT.PARALOOKS 24182 . 26399) (\TFBRAVO.INIT.PAGEFORMAT 26401 . 27281) (
+\TFBRAVO.GETPARAMS 27283 . 30137) (\TFBRAVO.FIND.LAST.TRAILER 30139 . 31284)) (31328 52033 (
+\TFBRAVO.PARSE.PARA 31338 . 35265) (\TFBRAVO.READ.PARALOOKS 35267 . 42157) (\TFBRAVO.CREATE.RUNS 42159
+ . 43547) (\TFBRAVO.READ.CHARLOOKS 43549 . 48578) (\TFBRAVO.FONT.FROM.CHARLOOKS 48580 . 50134) (
+\TFBRAVO.READNUM? 50136 . 52031)) (52070 63111 (\TFBRAVO.HANDLE.HEADING 52080 . 54807) (
+\TFBRAVO.PARSE.PROFILE.PARA 54809 . 63109)) (63154 85488 (\TFBRAVO.INSERT.PARA 63164 . 64005) (
+\TFBRAVO.INSERT.RUN 64007 . 67498) (\TFBRAVO.SPLIT.PARA 67500 . 74924) (\TFBRAVO.RUN.TABSPEC 74926 . 
+79793) (\TFBRAVO.INSTALL.PAGEFORMAT 79795 . 85486)) (85489 89632 (\TFBRAVO.ASSERT 85499 . 86029) (
+\TEST.CHARACTER.LOOKS 86031 . 87917) (\TEST.PARAGRAPH.LOOKS 87919 . 89630)) (90642 97297 (
+\TFBRAVO.ADD.NAMEDTAB 90652 . 94255) (\TFBRAVO.COPY.NAMEDTAB 94257 . 94705) (\TFBRAVO.PUT.NAMEDTAB 
+94707 . 94987) (\TFBRAVO.GET.NAMEDTAB 94989 . 95366) (\NAMEDTABNYET 95368 . 95528) (\NAMEDTABSIZE 
+95530 . 96045) (\NAMEDTABPREPRINT 96047 . 96245) (\TEDIT.NAMEDTAB.INIT 96247 . 97295)))))
 STOP
diff --git a/library/tedit/TEDIT-TFBRAVO.LCOM b/library/tedit/TEDIT-TFBRAVO.LCOM
index b6b5aa027..70a477eb3 100644
Binary files a/library/tedit/TEDIT-TFBRAVO.LCOM and b/library/tedit/TEDIT-TFBRAVO.LCOM differ
diff --git a/library/tedit/TEDIT-WINDOW b/library/tedit/TEDIT-WINDOW
index bed792bca..f1dfb7d32 100644
--- a/library/tedit/TEDIT-WINDOW
+++ b/library/tedit/TEDIT-WINDOW
@@ -1,12 +1,12 @@
 (DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
 
-
(FILECREATED "11-Aug-2025 21:22:37" {WMEDLEY}<library>tedit>TEDIT-WINDOW.;863
 229545 
+
(FILECREATED " 5-Oct-2025 10:56:19" {WMEDLEY}<library>TEDIT>TEDIT-WINDOW.;867
 229880 
 
       :EDIT-BY rmk
 
-      :CHANGES-TO (FNS \TEDIT.LIKELY.FILENAME)
+      :CHANGES-TO (FNS \TEDIT.SPLITW)
 
-      :PREVIOUS-DATE "26-Jul-2025 15:45:59" {WMEDLEY}<library>tedit>TEDIT-WINDOW.;862)
+      :PREVIOUS-DATE "18-Sep-2025 23:09:24" {WMEDLEY}<library>TEDIT>TEDIT-WINDOW.;864)
 
 
 (PRETTYCOMPRINT TEDIT-WINDOWCOMS)
@@ -1670,7 +1670,8 @@
         T)])
 
 (\TEDIT.SPLITW

-  [LAMBDA (OLDPANE Y)
                                        (* ; "Edited  9-May-2025 23:55 by rmk")


+  [LAMBDA (OLDPANE Y)
                                        (* ; "Edited  5-Oct-2025 10:56 by rmk")


+                                                             (* ; "Edited  9-May-2025 23:55 by rmk")


                                                              (* ; "Edited  5-May-2025 23:22 by rmk")


                                                              (* ; "Edited 21-Apr-2025 20:20 by rmk")


                                                              (* ; "Edited 20-Apr-2025 15:20 by rmk")


@@ -1747,7 +1748,10 @@
          (* ;; "Not sure if same PROPS as for OLDPANE (which this would inherit from primary window)")

 
                [SETQ PROPS (APPEND '(NOTITLE T PROMPTWINDOW DON'T TITLEMENUFN NILL)
-                                  (COPY (FGETTOBJ TEXTOBJ EDITPROPS]
+                                  (COPY (FGETTOBJ TEXTOBJ EDITPROPS))
+                                  (for
 DP in
 (FGETTOBJ TEXTOBJ DOCPROPS)
+                                     collect
 (LIST (CAR DP)
+                                                   (COPY (CDR DP]
                (\TEDIT.LINKPANES
 OLDPANE (\TEDIT.MINIMAL.WINDOW.SETUP
 NEWPANE TSTREAM PROPS OLDPANE))
 
          (* ;; "Insert L1 and LN cells for NEWPANEafter OLDPANE's cells in each selection.  The selections were created when the original textsteam was opened.")

@@ -2055,34 +2059,33 @@
            else
 (PROMPTPRINT MSG])
 
 (TEDIT.PROMPTCLEAR

-  [LAMBDA (TEXTSTREAM FONT)
                                  (* ; "Edited 14-Mar-98 12:52 by rmk:")


+  [LAMBDA (TSTREAM FONT)
                                     (* ; "Edited 18-Sep-2025 23:08 by rmk")


+                                                             (* ; "Edited 14-Mar-98 12:52 by rmk:")


                                                              (* ; "Edited 14-Oct-87 15:35 by bvm:")

 
-    (* ;; "Clears the promptwindow attached to TEXTSTREAM and shrinks it back to a single line in font FONT (or TEDIT.PROMPT.FONT) if it has grown.  TEXTSTREAM could actually be a stream on the promptwindow itself.")

-
-    (LET [MW (PW (IF
 (CAR (NLSETQ (GETPROMPTWINDOW (\TEDIT.MAINW
 TEXTSTREAM)
-                                         NIL NIL T)))
-                   ELSEIF
 (WINDOWPROP (WFROMDS TEXTSTREAM)
-                                 'TEDIT.PROMPTWINDOW)
-                     THEN
 (WFROMDS TEXTSTREAM]
-         (CL:WHEN PW
-             (WINDOWPROP PW 'TEDIT.NLINES 1)
-             (CL:WHEN [AND (SETQ MW (WINDOWPROP PW 'MAINWINDOW))
-                           (SETQ MW (LISTP (WINDOWPROP MW 'PROMPTWINDOW]
-                    (RPLACD MW 1))
-             (LET [PROP [HEIGHT (HEIGHTIFWINDOW (FONTPROP (OR FONT TEDIT.PROMPT.FONT)
-                                                       'HEIGHT]
-                        (REG (WINDOWPROP PW 'REGION]
-                  (CL:UNLESS (EQ HEIGHT (FETCH
 HEIGHT OF
 REG))
-                      (WINDOWPROP PW 'MINSIZE (CONS 0 HEIGHT))
+    (* ;; "Clears the promptwindow attached to TSTREAM and shrinks it back to a single line in font FONT (or TEDIT.PROMPT.FONT) if it has grown.  [TSTREAM could actually be a stream on the promptwindow itself.--is that true, does this code need to deal with that?]")

+
+    (LET* [(MW (\TEDIT.MAINW
 TSTREAM))
+           (PW (AND MW (WINDOWPROP (\TEDIT.MAINW
 TSTREAM)
+                              'TEDIT.PROMPTWINDOW]
+          (CL:WHEN PW
+              (WINDOWPROP PW 'TEDIT.NLINES 1)
+              (CL:WHEN [AND (SETQ MW (WINDOWPROP PW 'MAINWINDOW))
+                            (SETQ MW (LISTP (WINDOWPROP MW 'PROMPTWINDOW]
+                     (RPLACD MW 1))
+              (LET [PROP [HEIGHT (HEIGHTIFWINDOW (FONTPROP (OR FONT TEDIT.PROMPT.FONT)
+                                                        'HEIGHT]
+                         (REG (WINDOWPROP PW 'REGION]
+                   (CL:UNLESS (EQ HEIGHT (FETCH
 HEIGHT OF
 REG))
+                       (WINDOWPROP PW 'MINSIZE (CONS 0 HEIGHT))
 
-                      (* ;; 
+                       (* ;; 
 
        "Have to adjust the fixed size of the window before shaping, since SHAPEW obeys the minimum.")

 
-                      (WINDOWPROP PW 'MAXSIZE (CONS 64000 HEIGHT))
-                      (SHAPEW PW (CREATE
 REGION USING
 REG HEIGHT _ HEIGHT)))
-                  (CL:WHEN (OPENWP PW)
-                         (CLEARW PW))))])
+                       (WINDOWPROP PW 'MAXSIZE (CONS 64000 HEIGHT))
+                       (SHAPEW PW (CREATE
 REGION USING
 REG HEIGHT _ HEIGHT)))
+                   (CL:WHEN (OPENWP PW)
+                          (CLEARW PW))))])
 
 (TEDIT.PROMPTFLASH

   [LAMBDA (TSTREAM)
                                          (* ; "Edited 25-Apr-2025 17:58 by rmk")


@@ -3621,36 +3624,36 @@
 (RPAQ? TEDIT.TITLED.ICON.TEMPLATE
 (create TITLEDICON ICON _ TEDITICON MASK _ TEDITMASK TITLEREG _ 
                                          TEDIT.ICON.TITLE.REGION))
 (DECLARE%: DONTCOPY
-  (FILEMAP (NIL (17102 17998 (TEDIT.DEFER.UPDATES 17112 . 17996)) (17999 43944 (\TEDIT.WINDOW.CREATE 
-18009 . 25339) (\TEDIT.WINDOW.GETREGION 25341 . 28831) (\TEDIT.WINDOW.SETUP 28833 . 33163) (
-\TEDIT.MINIMAL.WINDOW.SETUP 33165 . 40576) (\TEDIT.CLEARPANE 40578 . 41295) (\TEDIT.FILL.PANES 41297
- . 43942)) (43945 67646 (\TEDIT.CURSORMOVEDFN 43955 . 49565) (\TEDIT.CURSOROUTFN 49567 . 50255) (
-\TEDIT.ACTIVE.WINDOWP 50257 . 51327) (\TEDIT.EXPANDFN 51329 . 51892) (\TEDIT.MAINW 51894 . 53174) (
-\TEDIT.MAINSTREAM 53176 . 53510) (\TEDIT.PRIMARYPANE 53512 . 54282) (\TEDIT.PANELIST 54284 . 54780) (
-\TEDIT.NEWREGIONFN 54782 . 57298) (\TEDIT.SET.WINDOW.EXTENT 57300 . 62282) (\TEDIT.SHRINK.ICONCREATE 
-62284 . 65017) (\TEDIT.SHRINKFN 65019 . 65428) (\TEDIT.PANEREGION 65430 . 67644)) (67678 100724 (
-\TEDIT.BUTTONEVENTFN 67688 . 80661) (\TEDIT.BUTTONEVENTFN.DOOPERATION 80663 . 87926) (
-\TEDIT.BUTTONEVENTFN.GETOPERATION 87928 . 89770) (\TEDIT.BUTTONEVENTFN.CURSEL.INIT 89772 . 93442) (
-\TEDIT.BUTTONEVENTFN.INACTIVE 93444 . 95874) (\TEDIT.BUTTONEVENTFN.INTITLE 95876 . 97711) (
-\TEDIT.COPYINSERTFN 97713 . 98845) (\TEDIT.FOREIGN.COPY 98847 . 100722)) (100725 117967 (
-\TEDIT.PANE.SPLIT 100735 . 104683) (\TEDIT.SPLITW 104685 . 112423) (\TEDIT.UNSPLITW 112425 . 116624) (
-\TEDIT.LINKPANES 116626 . 117389) (\TEDIT.UNLINKPANE 117391 . 117965)) (119401 120292 (TEDITWINDOWP 
-119411 . 120290)) (120329 123432 (TEDIT.GETINPUT 120339 . 122782) (\TEDIT.MAKEFILENAME 122784 . 123430
-)) (123481 131108 (TEDIT.PROMPTWINDOW 123491 . 123805) (TEDIT.PROMPTPRINT 123807 . 126434) (
-TEDIT.PROMPTCLEAR 126436 . 128155) (TEDIT.PROMPTFLASH 128157 . 129415) (\TEDIT.PROMPT.PAGEFULLFN 
-129417 . 131106)) (131346 141924 (\TEDIT.FILENAME 131356 . 132128) (\TEDIT.DEFAULT.TITLE 132130 . 
-134509) (\TEDIT.WINDOW.TITLE 134511 . 136680) (\TEDIT.LIKELY.FILENAME 136682 . 139406) (
-\TEDIT.UPDATE.TITLE 139408 . 141922)) (141967 154451 (TEDIT.DEACTIVATE.WINDOW 141977 . 147550) (
-\TEDIT.RESHAPEFN 147552 . 149637) (\TEDIT.REPAINTFN 149639 . 149863) (\TEDIT.CLOSESPLITS 149865 . 
-152310) (\TEDIT.CLOSEPANE 152312 . 154449)) (154452 197251 (\TEDIT.SCROLLFN 154462 . 156693) (
-\TEDIT.SCROLLCH.TOP 156695 . 158806) (\TEDIT.SCROLLCH.BOTTOM 158808 . 163138) (\TEDIT.SCROLLUP 163140
- . 168866) (\TEDIT.TOPLINE.YTOP 168868 . 170537) (\TEDIT.SCROLLDOWN 170539 . 177578) (
-\TEDIT.SCROLL.CARET 177580 . 180418) (\TEDIT.VISIBLECARETP 180420 . 182714) (\TEDIT.VISIBLECHARP 
-182716 . 183807) (\TEDIT.BITMAPLINES 183809 . 187729) (\TEDIT.SETPANE.TOPLINE 187731 . 188343) (
-\TEDIT.SHIFTLINES 188345 . 197249)) (197252 208121 (\TEDIT.ONSCREEN? 197262 . 201813) (
-\TEDIT.ONSCREEN.REGION 201815 . 205466) (\TEDIT.AFTERMOVEFN 205468 . 206365) (OFFSCREENP 206367 . 
-208119)) (208163 210977 (\TEDIT.PROCIDLEFN 208173 . 209833) (\TEDIT.PROCENTRYFN 209835 . 210280) (
-\TEDIT.PROCEXITFN 210282 . 210975)) (211056 224281 (\TEDIT.DOWNCARET 211066 . 211859) (
-\TEDIT.FLASHCARET 211861 . 213972) (\TEDIT.UPCARET 213974 . 215078) (TEDIT.NORMALIZECARET 215080 . 
-218298) (\TEDIT.SETCARET 218300 . 223651) (\TEDIT.CARET 223653 . 224279)))))
+  (FILEMAP (NIL (17093 17989 (TEDIT.DEFER.UPDATES 17103 . 17987)) (17990 43935 (\TEDIT.WINDOW.CREATE 
+18000 . 25330) (\TEDIT.WINDOW.GETREGION 25332 . 28822) (\TEDIT.WINDOW.SETUP 28824 . 33154) (
+\TEDIT.MINIMAL.WINDOW.SETUP 33156 . 40567) (\TEDIT.CLEARPANE 40569 . 41286) (\TEDIT.FILL.PANES 41288
+ . 43933)) (43936 67637 (\TEDIT.CURSORMOVEDFN 43946 . 49556) (\TEDIT.CURSOROUTFN 49558 . 50246) (
+\TEDIT.ACTIVE.WINDOWP 50248 . 51318) (\TEDIT.EXPANDFN 51320 . 51883) (\TEDIT.MAINW 51885 . 53165) (
+\TEDIT.MAINSTREAM 53167 . 53501) (\TEDIT.PRIMARYPANE 53503 . 54273) (\TEDIT.PANELIST 54275 . 54771) (
+\TEDIT.NEWREGIONFN 54773 . 57289) (\TEDIT.SET.WINDOW.EXTENT 57291 . 62273) (\TEDIT.SHRINK.ICONCREATE 
+62275 . 65008) (\TEDIT.SHRINKFN 65010 . 65419) (\TEDIT.PANEREGION 65421 . 67635)) (67669 100715 (
+\TEDIT.BUTTONEVENTFN 67679 . 80652) (\TEDIT.BUTTONEVENTFN.DOOPERATION 80654 . 87917) (
+\TEDIT.BUTTONEVENTFN.GETOPERATION 87919 . 89761) (\TEDIT.BUTTONEVENTFN.CURSEL.INIT 89763 . 93433) (
+\TEDIT.BUTTONEVENTFN.INACTIVE 93435 . 95865) (\TEDIT.BUTTONEVENTFN.INTITLE 95867 . 97702) (
+\TEDIT.COPYINSERTFN 97704 . 98836) (\TEDIT.FOREIGN.COPY 98838 . 100713)) (100716 118279 (
+\TEDIT.PANE.SPLIT 100726 . 104674) (\TEDIT.SPLITW 104676 . 112735) (\TEDIT.UNSPLITW 112737 . 116936) (
+\TEDIT.LINKPANES 116938 . 117701) (\TEDIT.UNLINKPANE 117703 . 118277)) (119713 120604 (TEDITWINDOWP 
+119723 . 120602)) (120641 123744 (TEDIT.GETINPUT 120651 . 123094) (\TEDIT.MAKEFILENAME 123096 . 123742
+)) (123793 131443 (TEDIT.PROMPTWINDOW 123803 . 124117) (TEDIT.PROMPTPRINT 124119 . 126746) (
+TEDIT.PROMPTCLEAR 126748 . 128490) (TEDIT.PROMPTFLASH 128492 . 129750) (\TEDIT.PROMPT.PAGEFULLFN 
+129752 . 131441)) (131681 142259 (\TEDIT.FILENAME 131691 . 132463) (\TEDIT.DEFAULT.TITLE 132465 . 
+134844) (\TEDIT.WINDOW.TITLE 134846 . 137015) (\TEDIT.LIKELY.FILENAME 137017 . 139741) (
+\TEDIT.UPDATE.TITLE 139743 . 142257)) (142302 154786 (TEDIT.DEACTIVATE.WINDOW 142312 . 147885) (
+\TEDIT.RESHAPEFN 147887 . 149972) (\TEDIT.REPAINTFN 149974 . 150198) (\TEDIT.CLOSESPLITS 150200 . 
+152645) (\TEDIT.CLOSEPANE 152647 . 154784)) (154787 197586 (\TEDIT.SCROLLFN 154797 . 157028) (
+\TEDIT.SCROLLCH.TOP 157030 . 159141) (\TEDIT.SCROLLCH.BOTTOM 159143 . 163473) (\TEDIT.SCROLLUP 163475
+ . 169201) (\TEDIT.TOPLINE.YTOP 169203 . 170872) (\TEDIT.SCROLLDOWN 170874 . 177913) (
+\TEDIT.SCROLL.CARET 177915 . 180753) (\TEDIT.VISIBLECARETP 180755 . 183049) (\TEDIT.VISIBLECHARP 
+183051 . 184142) (\TEDIT.BITMAPLINES 184144 . 188064) (\TEDIT.SETPANE.TOPLINE 188066 . 188678) (
+\TEDIT.SHIFTLINES 188680 . 197584)) (197587 208456 (\TEDIT.ONSCREEN? 197597 . 202148) (
+\TEDIT.ONSCREEN.REGION 202150 . 205801) (\TEDIT.AFTERMOVEFN 205803 . 206700) (OFFSCREENP 206702 . 
+208454)) (208498 211312 (\TEDIT.PROCIDLEFN 208508 . 210168) (\TEDIT.PROCENTRYFN 210170 . 210615) (
+\TEDIT.PROCEXITFN 210617 . 211310)) (211391 224616 (\TEDIT.DOWNCARET 211401 . 212194) (
+\TEDIT.FLASHCARET 212196 . 214307) (\TEDIT.UPCARET 214309 . 215413) (TEDIT.NORMALIZECARET 215415 . 
+218633) (\TEDIT.SETCARET 218635 . 223986) (\TEDIT.CARET 223988 . 224614)))))
 STOP
diff --git a/library/tedit/TEDIT-WINDOW.LCOM b/library/tedit/TEDIT-WINDOW.LCOM
index f3846c1f4..e1030af50 100644
Binary files a/library/tedit/TEDIT-WINDOW.LCOM and b/library/tedit/TEDIT-WINDOW.LCOM differ
diff --git a/library/tedit/tedit-exports.all b/library/tedit/tedit-exports.all
index 51f7ba461..7ad44b835 100644
--- a/library/tedit/tedit-exports.all
+++ b/library/tedit/tedit-exports.all
@@ -1,12 +1,9 @@
 (DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
 
-
(FILECREATED " 1-Aug-2025 14:59:31" 
-{DSK}<Users>kaplan>Local>medley3.5>working-medley>library>tedit>tedit-exports.all;239
 53083  
+
(FILECREATED "20-Sep-2025 11:04:51" 
+{DSK}<Users>kaplan>Local>medley3.5>working-medley>library>tedit>tedit-exports.all;242
 52344  
 
-      :EDIT-BY rmk
-
-      :PREVIOUS-DATE "28-Jul-2025 23:52:50" 
-{DSK}<Users>kaplan>Local>medley3.5>working-medley>library>tedit>tedit-exports.all;238)
+      :EDIT-BY rmk)
 
 
 (PRETTYCOMPRINT ((E (MAPC (MKLIST FROMFILES) (FUNCTION (LAMBDA (F) (MAPC (IMPORTFILE F FLG) (FUNCTION 
@@ -18,7 +15,7 @@ PRINT))))))))
 (PUTPROPS FTEXTOBJ MACRO ((X) (TEXTOBJ! (CL:IF (type? TEXTOBJ X) X (GETTSTR X TEXTOBJ)))))
 (GLOBALVARS CHECK-TEDIT-ASSERTIONS)
 (RPAQ? CHECK-TEDIT-ASSERTIONS T)
-(PUTPROP (QUOTE TEDIT) (QUOTE IMPORTDATE) (IDATE " 1-Aug-2025 14:50:15"))
+(PUTPROP (QUOTE TEDIT) (QUOTE IMPORTDATE) (IDATE " 8-Sep-2025 22:10:20"))
 (RPAQQ \BTREEWORDSPERSLOT 4)
 (RPAQQ \BTREEMAXCOUNT 8)
 (CONSTANTS (\BTREEWORDSPERSLOT 4) (\BTREEMAXCOUNT 8))
@@ -209,8 +206,8 @@ ITEM collect (FIXR (FTIMES SCALE ITEM))) (FIXR (FTIMES SCALE ITEM)))))
 (PUTPROPS SCALEDOWN MACRO (OPENLAMBDA (SCALE ITEM) (* ; "List = region?") (CL:IF (LISTP ITEM) (for I 
 in ITEM collect (FIXR (FQUOTIENT I SCALE))) (FIXR (FQUOTIENT ITEM SCALE)))))
 (GLOBALVARS TEDIT.DONT.BREAK.CHARS TEDIT.DONT.LAST.CHARS)
-(ADDTOVAR CHARACTERNAMES (EM-DASH "357,045") (SOFT-HYPHEN "357,043") (NONBREAKING-HYPHEN "357,042") (
-NONBREAKING-SPACE "357,041"))
+(ADDTOVAR CHARACTERNAMES (SOFT-HYPHEN "357,043") (NONBREAKING-HYPHEN "357,042") (NONBREAKING-SPACE 
+"357,041"))
 (PUTPROPS DIACRITICP MACRO (OPENLAMBDA (CHAR) (* ;; "An XCCS diacritic") (AND (SMALLP CHAR) (IGEQ CHAR
  192) (ILEQ CHAR 207))))
 (PUTPROPS \TEDIT.LINE.TALLP MACRO ((LINE HEIGHT) (OR (IGREATERP (FGETLD LINE LHEIGHT) 50) (IGREATERP (
@@ -261,7 +258,7 @@ NEXTAVAILABLECHARSLOT) of THISLINE))) (T $$STARTSLOT))) (SETQ $$CHARSLOTLIMIT (F
 ) by (PREVCHARSLOT I.V.) eachtime (SETQ CHAR (fetch (CHARSLOT CHAR) of I.V.)) (SETQ CHARW (fetch (
 CHARSLOT CHARW) of I.V.)) (SETQ CHARCL (fetch (CHARSLOT CHARCL) of I.V.)) repeatuntil (EQ I.V. 
 $$CHARSLOTLIMIT))))) T)
-(PUTPROP (QUOTE TEDIT-SCREEN) (QUOTE IMPORTDATE) (IDATE "28-Jul-2025 23:23:33"))
+(PUTPROP (QUOTE TEDIT-SCREEN) (QUOTE IMPORTDATE) (IDATE " 7-Aug-2025 12:51:00"))
 (DATATYPE PIECE ((* ; 
 "The piece describes either a string or part of a file.  , or a generalized OBJECT.") PCONTENTS (* ; 
 "The background source of data for this piece (stream, string, block, object, depending on the PTYPE)."
@@ -345,7 +342,7 @@ TXTAPPENDONLY FLAG) (* ;
 "T if we're holding off on screen updates until later.  Used, e.g., by the menu-SHOW code so that you don't get piecemeal updates, but only one at the end of the SHOW."
 ) TXTRAWINCLUDESTREAM (* ; 
 "NODIRCORE stream used to cache RAW includes (and maybe later, all includes?)") DOCPROPS (* ; 
-"Document properties that are stored with the document (not used yet)") TXTSTYLESHEET (* ; 
+"Document properties that are stored with the document. Not used before 9/2025") TXTSTYLESHEET (* ; 
 "Style sheet local to this document.  Not currently saved as part of the file.")) (ACCESSFNS TEXTOBJ (
 (\DIRTY (ffetch (TEXTOBJ \XDIRTY) of DATUM) (PROGN (FSETTOBJ DATUM LASTARROWX NIL) (CL:UNLESS (EQ 
 NEWVALUE (ffetch (TEXTOBJ \XDIRTY) of DATUM)) (\TEDIT.WINDOW.TITLE DATUM NEWVALUE) (freplace \XDIRTY 
@@ -368,7 +365,7 @@ NEWVALUE)) (* ;
 ) (STARTINGCOFFSET (fetch (STREAM F2) of DATUM) (replace (STREAM F2) of DATUM with NEWVALUE))) (TYPE? 
 (AND (type? STREAM DATUM) (type? TEXTOBJ (fetch (TEXTSTREAM TEXTOBJ) of DATUM)))) (CREATE (create 
 STREAM BINABLE _ NIL BOUTABLE _ NIL ACCESS _ (QUOTE BOTH) USERCLOSEABLE _ T USERVISIBLE _ T DEVICE _ 
-\TEXTFDEV F1 _ NIL F2 _ 0 F3 _ NIL F4 _ NIL F5 _ NIL MAXBUFFERS _ 10 IMAGEOPS _ \TEXTIMAGEOPS 
+\TEDITFDEV F1 _ NIL F2 _ 0 F3 _ NIL F4 _ NIL F5 _ NIL MAXBUFFERS _ 10 IMAGEOPS _ \TEDITIMAGEOPS 
 IMAGEDATA _ NIL)))
 (PUTPROPS NEXTPIECE MACRO ((PC) (ffetch (PIECE NEXTPIECE) of PC)))
 (PUTPROPS PREVPIECE MACRO ((PC) (ffetch (PIECE PREVPIECE) of PC)))
@@ -441,7 +438,7 @@ UTF8.PTYPE UTF16BE.PTYPE UTF16LE.PTYPE)) (STRING.PTYPES (LIST THINSTRING.PTYPE F
 BINABLE.PTYPES (LIST THINFILE.PTYPE THINSTRING.PTYPE)) (THIN.PTYPES (LIST THINFILE.PTYPE 
 THINSTRING.PTYPE)) (FAT.PTYPES (LIST FATFILE2.PTYPE FATSTRING.PTYPE FATFILE1.PTYPE)))
 (GLOBALVARS \TEXTIMAGEOPS \TEXTFDEV)
-(PUTPROP (QUOTE TEDIT-STREAM) (QUOTE IMPORTDATE) (IDATE "29-Jul-2025 11:58:01"))
+(PUTPROP (QUOTE TEDIT-STREAM) (QUOTE IMPORTDATE) (IDATE "20-Sep-2025 08:49:36"))
 (PUTPROPS \TEDIT.MOUSESTATE MACRO (BUTTON (* ;; 
 "Test to see if only the specified mouse button is down.  DOES NOT call GETMOUSESTATE, so the mouse-button info is the same as the last time it was called."
 ) (SELECTQ (CAR BUTTON) (LEFT (QUOTE (EQ LASTMOUSEBUTTONS 4))) (MIDDLE (QUOTE (EQ LASTMOUSEBUTTONS 1))
@@ -455,8 +452,8 @@ I in ARGS as J on ARGS when (NOT (STRINGP I)) collect (LIST (QUOTE OR) I (LIST (
 \BIN STREAM)) BITSPERWORD)))
 (PUTPROPS \SMALLPOUT MACRO (OPENLAMBDA (STREAM W) (* ; "Signed smallp, unlike \WOUT") (\BOUT STREAM (
 LOGAND 255 (LRSH W 8))) (\BOUT STREAM (LOGAND W 255))))
-(PUTPROP (QUOTE TEDIT-FILE) (QUOTE IMPORTDATE) (IDATE " 1-Aug-2025 14:53:19"))
-(PUTPROP (QUOTE TEDIT-OLDFILE) (QUOTE IMPORTDATE) (IDATE " 1-Aug-2025 14:58:21"))
+(PUTPROP (QUOTE TEDIT-FILE) (QUOTE IMPORTDATE) (IDATE " 9-Sep-2025 21:49:43"))
+(PUTPROP (QUOTE TEDIT-OLDFILE) (QUOTE IMPORTDATE) (IDATE " 8-Sep-2025 22:10:10"))
 (DATATYPE CHARLOOKS ((* ;; "Describes the appearance (%"Looks%") of characters in a TEdit document.") 
 (* ;; "NOTE:  If fields change EQCLOOKS should change too.") CLFONT (* ; 
 "The font descriptor for these characters") CLFONTUNPARSE (* ;; 
@@ -484,9 +481,7 @@ LOGAND 255 (LRSH W 8))) (\BOUT STREAM (LOGAND W 255))))
 "Used for a mark-&-sweep of looks at PUT time -- T means this set of looks really IS in use in the document"
 ) (CLSELBEFORE FLAG) (* ; "T if TEDIT can put selection before this char (for menu fields).") CLCOLOR)
  CLOFFSET _ 0 CLCOLOR _ (QUOTE BLACK) (INIT (DEFPRINT (QUOTE CHARLOOKS) (FUNCTION 
-\TEDIT.CHARLOOKS.DEFPRINT))) (ASSOCRECORD CLPROPS (CLUSERINFO CLCHARENCODING)) (ACCESSFNS ((CLNAME (
-fetch (CHARLOOKS CLFONTUNPARSE) of DATUM) (replace (CHARLOOKS CLFONTUNPARSE) of DATUM with NEWVALUE)))
-))
+\TEDIT.CHARLOOKS.DEFPRINT))) (ASSOCRECORD CLPROPS (CLUSERINFO CLCHARENCODING)))
 (DATATYPE PARALOOKS ((* ;; "Describe the paragraph formatting for a paragraph in a TEdit document.") 
 1STLEFTMAR (* ; "Left margin of the first line of the paragraph") LEFTMAR (* ; 
 "Left margin of the rest of the lines in the paragraph") RIGHTMAR (* ; 
@@ -540,7 +535,7 @@ LINELEAD _ 0)
 (PUTPROPS FSETPLOOKS MACRO ((PLOOKS FIELD NEWVALUE) (freplace (PARALOOKS FIELD) of PLOOKS with 
 NEWVALUE)))
 (PUTPROPS PARALOOKS! MACRO ((PL) (\DTEST PL (QUOTE PARALOOKS))))
-(PUTPROP (QUOTE TEDIT-LOOKS) (QUOTE IMPORTDATE) (IDATE " 1-Aug-2025 13:43:51"))
+(PUTPROP (QUOTE TEDIT-LOOKS) (QUOTE IMPORTDATE) (IDATE " 9-Sep-2025 21:55:31"))
 (PUTPROP (QUOTE TEDIT-STYLES) (QUOTE IMPORTDATE) (IDATE "28-Jul-2025 23:25:43"))
 (DATATYPE TEDITCARET (TCNOWTIME (* Used to hold the current time, when checking to see if a transition
  is due) TCTHENTIME (* Time when the next transition is to take place) TCFORCEDDOWN (* TCFORCEDOWN = T
@@ -603,27 +598,17 @@ OR (CL:IF (TYPENAMEP $$BODY (QUOTE TEXTOBJ)) (FGETTOBJ $$BODY PRIMARYPANE) $$BOD
 GETPANEPROP (PANEPROPS P) NEXTPANE))) (GO $$OUT))) by (OR (GETPANEPROP (PANEPROPS I.V.) PREVPANE) (GO 
 $$OUT)))))
 (PUTPROPS ALLBUTTONSUP MACRO (NIL (ZEROP (LOGAND 7 LASTMOUSEBUTTONS))))
-(PUTPROP (QUOTE TEDIT-WINDOW) (QUOTE IMPORTDATE) (IDATE "26-Jul-2025 15:45:59"))
+(PUTPROP (QUOTE TEDIT-WINDOW) (QUOTE IMPORTDATE) (IDATE "18-Sep-2025 23:09:24"))
 (PUTPROP (QUOTE TEDIT-BUTTONS) (QUOTE IMPORTDATE) (IDATE "30-Apr-2025 14:09:18"))
-(RPAQQ PTSPERPICA 12)
-(RPAQQ PTSPERINCH 72)
-(RPAQQ PICASPERINCH 6)
-(RPAQQ MICASPERINCH 2540)
-(RPAQ PTSPERCM (FQUOTIENT PTSPERINCH 2.54))
-(RPAQ PTSPERMICA (FQUOTIENT PTSPERINCH MICASPERINCH))
-(RPAQ MICASPERPOINT (FQUOTIENT MICASPERINCH PTSPERINCH))
-(CONSTANTS (PTSPERPICA 12) (PTSPERINCH 72) (PICASPERINCH 6) (MICASPERINCH 2540) (PTSPERCM (FQUOTIENT 
-PTSPERINCH 2.54)) (PTSPERMICA (FQUOTIENT PTSPERINCH MICASPERINCH)) (MICASPERPOINT (FQUOTIENT 
-MICASPERINCH PTSPERINCH)))
-(PUTPROP (QUOTE TEDIT-MENU) (QUOTE IMPORTDATE) (IDATE "28-Jul-2025 23:26:01"))
+(PUTPROP (QUOTE TEDIT-MENU) (QUOTE IMPORTDATE) (IDATE "10-Sep-2025 17:08:43"))
 (PUTPROP (QUOTE TEDIT-FIND) (QUOTE IMPORTDATE) (IDATE "21-Apr-2025 22:42:57"))
 (RPAQQ \TEDIT.TTCCODES ((NONE 0) (CHARDELETE 1) (WORDDELETE 2) (DELETE 3) (FUNCTIONCALL 4) (REDO 5) (
 UNDO 6) (CMD 7) (NEXT 8) (EXPAND 9) (CHARDELETE.FORWARD 10) (WORDDELETE.FORWARD 11) (PUNCT 20) (TEXT 
 21) (WHITESPACE 22)))
 (CONSTANTS \TEDIT.TTCCODES)
 (PUTPROPS \TEDIT.TTC MACRO ((CLASS) (CONSTANT (CADR (ASSOC (QUOTE CLASS) \TEDIT.TTCCODES)))))
-(PUTPROP (QUOTE TEDIT-FNKEYS) (QUOTE IMPORTDATE) (IDATE "29-May-2025 16:20:30"))
-(PUTPROP (QUOTE TEDIT-HCPY) (QUOTE IMPORTDATE) (IDATE "21-Apr-2025 19:07:23"))
+(PUTPROP (QUOTE TEDIT-FNKEYS) (QUOTE IMPORTDATE) (IDATE " 7-Aug-2025 15:00:51"))
+(PUTPROP (QUOTE TEDIT-HCPY) (QUOTE IMPORTDATE) (IDATE "19-Sep-2025 17:08:05"))
 (DATATYPE TEDITHISTORYEVENT ((* ;; "Describes one event on the TEdit edit history list.") THACTION (* 
 ; "A keyword specifying what the event was") THPOINT (* ; "Was the selection to the left or right?") 
 THLEN (* ; "The # of chars involved") THCH# (* ; "The starting ch#") THFIRSTPIECE (* ; 
@@ -672,9 +657,9 @@ REGIONPARENT FULLXPOINTER) (* ; "The parent node for this box, for sub-boxes") R
 $$VALUES)) (PROG1 (CAR $$VALUES) (\,@ (FOR V IN (CAR ARGS) collect (COND (V (BQUOTE (SETQ (\, V) (POP 
 $$VALUES)))) (T (BQUOTE (SETQ $$VALUES (CDR $$VALUES))))))))))))
 (PUTPROPS TEDIT.VALUES MACRO (ARGS (BQUOTE (LIST (\,@ ARGS)))))
-(PUTPROP (QUOTE TEDIT-PAGE) (QUOTE IMPORTDATE) (IDATE " 5-Jun-2025 08:24:12"))
-(PUTPROP (QUOTE TEDIT-ABBREV) (QUOTE IMPORTDATE) (IDATE "24-Apr-2025 23:45:12"))
-(PUTPROP (QUOTE TEDIT-TFBRAVO) (QUOTE IMPORTDATE) (IDATE "28-Jul-2025 23:34:14"))
+(PUTPROP (QUOTE TEDIT-PAGE) (QUOTE IMPORTDATE) (IDATE "19-Sep-2025 22:09:03"))
+(PUTPROP (QUOTE TEDIT-ABBREV) (QUOTE IMPORTDATE) (IDATE " 6-Sep-2025 00:10:45"))
+(PUTPROP (QUOTE TEDIT-TFBRAVO) (QUOTE IMPORTDATE) (IDATE " 7-Sep-2025 11:11:43"))
 (DECLARE%: DONTCOPY
   (FILEMAP (NIL)))
 STOP
diff --git a/library/virtualkeyboards/KEYBOARDCONFIGS b/library/virtualkeyboards/KEYBOARDCONFIGS
index aae4e82ff..e572a178d 100644
--- a/library/virtualkeyboards/KEYBOARDCONFIGS
+++ b/library/virtualkeyboards/KEYBOARDCONFIGS
@@ -1,17 +1,11 @@
 (DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
 
-
(FILECREATED " 6-Jul-2023 13:18:46" {WMEDLEY}<library>virtualkeyboards>KEYBOARDCONFIGS.;3
 59739  
+
(FILECREATED "13-Oct-2025 13:44:47" {WMEDLEY}<library>virtualkeyboards>KEYBOARDCONFIGS.;5
 59521  
 
       :EDIT-BY rmk
 
-      :CHANGES-TO (VARS KEYBOARDCONFIGSCOMS)
+      :PREVIOUS-DATE "13-Oct-2025 12:03:23" {WMEDLEY}<library>virtualkeyboards>KEYBOARDCONFIGS.;4)
 
-      :PREVIOUS-DATE " 7-Feb-97 12:13:28" {WMEDLEY}<library>virtualkeyboards>KEYBOARDCONFIGS.;1)
-
-
-(* ; "
-Copyright (c) 1996-1997 by Xerox Corporation.
-")
 
 (PRETTYCOMPRINT KEYBOARDCONFIGSCOMS)
 
@@ -63,11 +57,11 @@ Copyright (c) 1996-1997 by Xerox Corporation.
         (F3 (F3 ITALIC))
         (F4 (F4 UCASE))
         (F5 (F5 STRIKE))
-        (F6 (F6 UNDER))
+        (F6 (F6 "­"))
         (F7 (F7 SUBSCR))
         (F8 (F8 SMALL))
         (F9 (F9 MARGIN))
-        (F10 (F10 LOOKS))
+        (F10 (F10 "¬"))
         (F11 (F11 ""))
         (F12 (F12 ""))
         (LOCK ("CAPS" "LOCK"))
@@ -280,11 +274,11 @@ Copyright (c) 1996-1997 by Xerox Corporation.
               (F3 (ITALIC NOTITALIC NLS))
               (F4 (UCASE LCASE NLS))
               (F5 (STRIKEOUT NOTSTRIKEOUT NLS))
-              (F6 (UNDERLINE NOTUNDERLINE NLS))
+              (F6 ("­" "­" NLS))
               (F7 (SUBSCRIPT SUPERSCRIPT NLS))
               (F8 (SMALLER LARGER NLS))
               (F9 (MARGINS NOTMARGINS NLS))
-              (F10 (LOOKS NOTLOOKS NLS))
+              (F10 ("¬" "¬" NLS))
               (F11 (F11 NOTF11 NLS))
               (F12 (F12 NOTF12 NLS)))
              ((%` 45 B)
@@ -1270,11 +1264,11 @@ Copyright (c) 1996-1997 by Xerox Corporation.
                   (F3 (ITALIC NOTITALIC NLS))
                   (F4 (UCASE LCASE NLS))
                   (F5 (STRIKEOUT NOTSTRIKEOUT NLS))
-                  (F6 (UNDERLINE NOTUNDERLINE NLS))
+                  (F6 ("­" "­" NLS))
                   (F7 (SUBSCRIPT SUPERSCRIPT NLS))
                   (F8 (SMALLER LARGER NLS))
                   (F9 (MARGINS NOTMARGINS NLS))
-                  (F10 (LOOKS NOTLOOKS NLS))
+                  (F10 ("¬" "¬" NLS))
                   (F11 (F11 NOTF11 NLS))
                   (F12 (F12 NOTF12 NLS)))
                  ((%' 28 B)
@@ -1803,7 +1797,6 @@ Copyright (c) 1996-1997 by Xerox Corporation.
                  23130
                  (CLASSIC 10)
                  NIL))
-(PUTPROPS KEYBOARDCONFIGS COPYRIGHT ("Xerox Corporation" 1996 1997))
 (DECLARE%: DONTCOPY
   (FILEMAP (NIL)))
 STOP
diff --git a/lispusers/EDITFONT b/lispusers/EDITFONT
index 8c4eb47ed..517fc5c3a 100644
--- a/lispusers/EDITFONT
+++ b/lispusers/EDITFONT
@@ -1,12 +1,13 @@
 (DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
 
-
(FILECREATED "29-Aug-2025 22:34:31" {WMEDLEY}<lispusers>EDITFONT.;33
 24939  
+
(FILECREATED " 7-Oct-2025 14:56:00" {WMEDLEY}<lispusers>EDITFONT.;40
 26223  
 
       :EDIT-BY rmk
 
-      :CHANGES-TO (FNS EDITFONT EF.EDITBM EF.CHARITEMS EF.SAVE)
+      :CHANGES-TO (RECORDS CHARITEM)
+                  (FNS EDITFONT)
 
-      :PREVIOUS-DATE "27-Aug-2025 22:50:51" {WMEDLEY}<lispusers>EDITFONT.;30)
+      :PREVIOUS-DATE " 6-Oct-2025 15:58:41" {WMEDLEY}<lispusers>EDITFONT.;39)
 
 
 (PRETTYCOMPRINT EDITFONTCOMS)
@@ -80,7 +81,8 @@
           (WINDOWPROP WINDOW 'MENU NIL])
 
 (EF.CHARITEMS

-  [LAMBDA (FONT CHARSET)
                                     (* ; "Edited 29-Aug-2025 11:34 by rmk")


+  [LAMBDA (FONT CHARSET ROWMAJOR)
                            (* ; "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")


                                                              (* ; "Edited 25-Jul-2025 10:06 by rmk")

@@ -88,14 +90,20 @@
 
     (* ;; "Get CHARITEMS for CHARSET in FONT.  Sort them in column-major order to build an array that corresponds to the tables in Unicode and XCCS.")

 
-    (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)
-                                                                   ROW)))
-                                        (create
 CHARITEM
-                                               BITMAP _ (GETCHARBITMAP CODE FONT)
-                                               CHARCODE _ CODE
-                                               SLUGCHARP _ (SLUGCHARP.DISPLAY CODE FONT])
+    (if
 ROWMAJOR
+        then
 (for
 C8 from
 0 to
 \MAXTHINCHAR as
 C from
 (LLSH CHARSET 8)
+                collect
 (create
 CHARITEM
+                               BITMAP _ (GETCHARBITMAP C FONT)
+                               CHARCODE _ C8
+                               SLUGCHARP _ (SLUGCHARP.DISPLAY 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)
+                                                                          ROW)))
+                                               (create
 CHARITEM
+                                                      BITMAP _ (GETCHARBITMAP CODE FONT)
+                                                      CHARCODE _ CODE
+                                                      SLUGCHARP _ (SLUGCHARP.DISPLAY CODE FONT])
 
 (EF.BUTTONEVENTFN

   [LAMBDA (WINDOW)                                           (* kbr%: "16-Oct-85 22:19")

@@ -179,15 +187,16 @@
           (REDISPLAYW (WFROMMENU MENU])
 
 (EF.DELETE

-  [LAMBDA (CHARITEM MENU)
                                    (* ; "Edited  4-Aug-2025 13:14 by rmk")

+  [LAMBDA (CHARITEM MENU)
                                    (* ; "Edited  2-Sep-2025 23:03 by rmk")


+                                                             (* ; "Edited  4-Aug-2025 13:14 by rmk")

                                                              (* kbr%: "15-Dec-84 15:20")

                                                              (* ; 
 
                                                             "Turn CHARITEM into a slug charitem.")

     (LET ((WINDOW (WFROMMENU MENU))
           SLUGBITMAP)
-         [SETQ SLUGBITMAP (\GETCHARBITMAP.CSINFO SLUGCHARINDEX (\XGETCHARSETINFO (WINDOWPROP
-                                                                                  WINDOW
-                                                                                  'FONT)
+         [SETQ SLUGBITMAP (\GETCHARBITMAP.CSINFO SLUGCHARINDEX (\GETCHARSETINFO (WINDOWPROP
+                                                                                 WINDOW
+                                                                                 'FONT)
                                                                       (WINDOWPROP WINDOW 'CHARSET]
          (UNINTERRUPTABLY
              (replace
 (CHARITEM BITMAP) of
 CHARITEM with
 SLUGBITMAP)
@@ -233,7 +242,8 @@
              (T (LISPERROR "ILLEGAL ARG" BITMAP])
 
 (EF.SAVE

-  [LAMBDA (WINDOW)
                                           (* ; "Edited 29-Aug-2025 11:35 by rmk")


+  [LAMBDA (WINDOW)
                                           (* ; "Edited  2-Sep-2025 23:03 by rmk")


+                                                             (* ; "Edited 29-Aug-2025 11:35 by rmk")


                                                              (* ; "Edited  4-Aug-2025 09:22 by rmk")


                                                              (* ; "Edited  2-Aug-2025 08:47 by rmk")

                                                              (* kbr%: "21-Oct-85 15:39")

@@ -255,12 +265,12 @@
 
          (* ;; "We'll install the slugbm at the end, include its dimensions")

 
-         (SETQ SLUGBM (\GETCHARBITMAP.CSINFO SLUGCHARINDEX (\XGETCHARSETINFO FONT CHARSET)))
+         (SETQ SLUGBM (\GETCHARBITMAP.CSINFO SLUGCHARINDEX (\GETCHARSETINFO FONT CHARSET)))
          (SETQ SLUGWIDTH (fetch
 (BITMAP BITMAPWIDTH) of
 SLUGBM))
          (add
 CBWIDTH SLUGWIDTH)
          (SETQ CBHEIGHT (IMAX CBHEIGHT (fetch
 (BITMAP BITMAPHEIGHT) of
 SLUGBM)))
          (SETQ CB (BITMAPCREATE CBWIDTH CBHEIGHT))
-         (SETQ CSINFO (create
 CHARSETINFO copying
 (\XGETCHARSETINFO FONT CHARSET)
+         (SETQ CSINFO (create
 CHARSETINFO copying
 (\GETCHARSETINFO FONT CHARSET)
                                                 CHARSETBITMAP _ CB))
          (SETQ OFFSETS (fetch
 (CHARSETINFO OFFSETS) of
 CSINFO))
          (SETQ WIDTHS (fetch
 (CHARSETINFO WIDTHS) of
 CSINFO))(* ; "Store new info in allocations")

@@ -325,6 +335,7 @@
 
 (BLANKCHARSETCREATE

   [LAMBDA (FAMILY SIZE FACE CHARSET FIRSTCHAR LASTCHAR ASCENT DESCENT WIDTH)

+                                                             (* ; "Edited  2-Sep-2025 23:03 by rmk")


                                                              (* ; "Edited  4-Aug-2025 13:29 by rmk")

                                                              (* mjs "27-Mar-85 14:48")

                                                              (* ; "Edited  3-Aug-2025 17:53 by rmk")

@@ -343,7 +354,7 @@
     (PROG (ROTATION DEVICE FONT CSINFO SLUGWIDTH OFFSETS WIDTHS SLUGOFFSET CB CBWIDTH CBHEIGHT)
           (SETQ FONT (\FONT.CHECKARGS FAMILY SIZE FACE 0 'DISPLAY CHARSET))
           [if
 (type?
 FONTDESCRIPTOR FONT)
-              then
 (CL:WHEN (SETQ CSINFO (\XGETCHARSETINFO FONT CHARSET))
+              then
 (CL:WHEN (SETQ CSINFO (\GETCHARSETINFO FONT CHARSET))
                           (RETURN FONT))
             else
 (SPREADFONTSPEC FONT)
                  (SETQ FONT
@@ -418,7 +429,10 @@
           (RETURN FONT])
 
 (EDITFONT

-  [LAMBDA (FONT CHARSET)
                                     (* ; "Edited 29-Aug-2025 22:34 by rmk")


+  [LAMBDA (FONT CHARSET ROWMAJOR NCOLUMNS TITLETAG)
          (* ; "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")

@@ -429,20 +443,23 @@
     (SETQ CHARSET (OR (CHARSET.DECODE CHARSET)
                       0))
     (LET (CHARITEMS MENU TITLE HEIGHT WIDTH REGION POS WINDOW)
-         (SETQ CHARITEMS (EF.CHARITEMS
 FONT CHARSET))
+         (SETQ CHARITEMS (EF.CHARITEMS
 FONT CHARSET ROWMAJOR))
          (SETQ MENU (create
 MENU
                            MENUFONT _ FONT
                            CENTERFLG _ T
-                           MENUCOLUMNS _ 16
+                           MENUCOLUMNS _ (OR NCOLUMNS 16)
                            ITEMS _ CHARITEMS
                            WHENSELECTEDFN _ (FUNCTION EF.WHENSELECTEDFN)))
          (SETQ TITLE (PACK* (FONTPROP FONT 'FAMILY)
                             " "
                             (FONTPROP FONT 'SIZE)
                             " "
-                            (PACKC (for
 ATOM in
 (FONTPROP FONT 'FACE) collect
 (CHCON1 ATOM)))
+                            (FONTFACETOATOM (FONTPROP FONT 'FACE))
                             " "
-                            (OCTALSTRING CHARSET)))
+                            (OCTALSTRING CHARSET)
+                            (CL:IF TITLETAG
+                                (CONCAT " " TITLETAG)
+                                "")))
          (PUTMENUPROP MENU 'EDITFONTTITLE TITLE)
          (SETQ HEIGHT (HEIGHTIFWINDOW (fetch
 (MENU IMAGEHEIGHT) of
 MENU)
                              T))
@@ -462,7 +479,7 @@
                                      YCOORD _ 0))
          (WINDOWPROP WINDOW 'BUTTONEVENTFN (FUNCTION EF.BUTTONEVENTFN))
          (MODERNWINDOW WINDOW)
-         WINDOW])
+         FONT])
 )
 (DECLARE%: EVAL@COMPILE DONTCOPY 
 (DECLARE%: EVAL@COMPILE
@@ -477,10 +494,10 @@
 
 (EF.INIT
)
 (DECLARE%: DONTCOPY
-  (FILEMAP (NIL (1141 16132 (EF.INIT 1151 . 1785) (EF.PROMPT 1787 . 2369) (EF.MESSAGE 2371 . 2583) (
-EF.CLOSEFN 2585 . 3112) (EF.CHARITEMS 3114 . 4436) (EF.BUTTONEVENTFN 4438 . 4850) (EF.WHENSELECTEDFN 
-4852 . 5256) (EF.EDITBM 5258 . 6752) (EF.MIDDLEBUTTONFN 6754 . 6999) (EF.CHANGESIZE 7001 . 8330) (
-EF.DELETE 8332 . 9407) (EF.ENTER 9409 . 10350) (EF.REPLACE 10352 . 11325) (EF.SAVE 11327 . 15424) (
-COPYFONT 15426 . 15701) (READSTRIKEFONTFILE 15703 . 16130)) (16133 24751 (BLANKCHARSETCREATE 16143 . 
-22120) (EDITFONT 22122 . 24749)))))
+  (FILEMAP (NIL (1147 16865 (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 . 16157) (
+COPYFONT 16159 . 16434) (READSTRIKEFONTFILE 16436 . 16863)) (16866 26035 (BLANKCHARSETCREATE 16876 . 
+22961) (EDITFONT 22963 . 26033)))))
 STOP
diff --git a/lispusers/EDITFONT.LCOM b/lispusers/EDITFONT.LCOM
index 7c0e333a3..ce03d863f 100644
Binary files a/lispusers/EDITFONT.LCOM and b/lispusers/EDITFONT.LCOM differ
diff --git a/lispusers/GITFNS b/lispusers/GITFNS
index b6ef04295..aed605330 100644
--- a/lispusers/GITFNS
+++ b/lispusers/GITFNS
@@ -1,29 +1,28 @@
 (DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
 
-(FILECREATED "29-Apr-2025 15:17:37" {WMEDLEY}<lispusers>GITFNS.;541 134267 
+
(FILECREATED "23-Sep-2025 21:43:21" {WMEDLEY}<lispusers>GITFNS.;551
 134847 
 
       :EDIT-BY rmk
 
-      :CHANGES-TO (VARS GITFNSCOMS)
-                  (FNS GIT-WORKING-COMPARE-DIRECTORIES)
+      :CHANGES-TO (FNS GIT-GET-DIFFERENT-FILES)
 
-      :PREVIOUS-DATE "31-Mar-2025 21:25:00" {WMEDLEY}<lispusers>GITFNS.;539)
+      :PREVIOUS-DATE "22-Sep-2025 12:52:41" {WMEDLEY}<lispusers>GITFNS.;550)
 
 
 (PRETTYCOMPRINT GITFNSCOMS)
 
-(RPAQQ GITFNSCOMS
+(RPAQQ GITFNSCOMS

        (
-        (* ;; "Set up")
+        (* ;; "Set up")

 
         (FILES (SYSLOAD FROM LISPUSERS)
                COMPAREDIRECTORIES COMPARESOURCES COMPARETEXT PSEUDOHOSTS JSON UNIXUTILS REGIONMANAGER
                )
         
-        (* ;; "")
+        (* ;; "")

 
         
-        (* ;; "GIT projects")
+        (* ;; "GIT projects")

 
         (COMS (FNS GIT-CLONEP GIT-INIT GIT-MAKE-PROJECT GIT-GET-PROJECT GIT-PUT-PROJECT-FIELD 
                    GIT-PROJECT-PATH FIND-ANCESTOR-DIRECTORY GIT-FIND-CLONE GIT-MAINBRANCH 
@@ -44,94 +43,94 @@
         (P (GIT-INIT))
         (ADDVARS (AROUNDEXITFNS GIT-INIT))
         
-        (* ;; "")
+        (* ;; "")

 
         
-        (* ;; "Lisp exec commands")
+        (* ;; "Lisp exec commands")

 
         (INITVARS (GIT-MERGE-COMPARES T)
                (GIT-CDBROWSER-SEPARATE-DIRECTIONS T))
         (COMMANDS gwc bbc prc cob b? cdg cdw)
         (FNS PRC-COMMAND)
         
-        (* ;; "")
+        (* ;; "")

 
         
-        (* ;; "File correspondents")
+        (* ;; "File correspondents")

 
         (FNS ALLSUBDIRS MEDLEYSUBDIRS GITSUBDIRS)
         (FNS TOGIT FROMGIT GIT-DELETE-FILE MYMEDLEY-DELETE-FILES)
         (FNS MYMEDLEYSUBDIR GITSUBDIR STRIPDIR STRIPHOST STRIPNAME STRIPWHERE)
         (FNS GFILE4MFILE MFILE4GFILE GIT-REPO-FILENAME)
         
-        (* ;; "")
+        (* ;; "")

 
         
-        (* ;; "Git commands")
+        (* ;; "Git commands")

 
         (FNS GIT-COMMIT GIT-PUSH GIT-PULL GIT-APPROVAL GIT-GET-FILE GIT-FILE-EXISTS? 
              GIT-REMOTE-UPDATE GIT-REMOTE-ADD GIT-FILE-DATE GIT-FILE-HISTORY GIT-PRINT-FILE-HISTORY 
              GIT-FETCH)
         
-        (* ;; "Differences")
+        (* ;; "Differences")

 
         (FNS GIT-BRANCH-DIFF GIT-COMMIT-DIFFS GIT-BRANCH-RELATIONS)
         
-        (* ;; "")
+        (* ;; "")

 
         
-        (* ;; "Branches")
+        (* ;; "Branches")

 
         (FNS GIT-BRANCH-NUM GIT-CHECKOUT GIT-WHICH-BRANCH GIT-MAKE-BRANCH GIT-BRANCHES 
              GIT-BRANCH-EXISTS? GIT-PICK-BRANCH GIT-BRANCH-MENU GIT-BRANCH-WHENSELECTEDFN 
              GIT-PULL-REQUESTS GIT-SHORT-BRANCH-NAME GIT-LONG-NAME GIT-PRC-BRANCHES)
         
-        (* ;; "My branches")
+        (* ;; "My branches")

 
         (FNS GIT-MY-CURRENT-BRANCH GIT-MY-BRANCHP GIT-MY-NEXT-BRANCH GIT-MY-BRANCHES)
         
-        (* ;; "")
+        (* ;; "")

 
         
-        (* ;; "Worktrees")
+        (* ;; "Worktrees")

 
         (FNS GIT-ADD-WORKTREE GIT-REMOVE-WORKTREE GIT-LIST-WORKTREES WORKTREEDIR)
         
-        (* ;; "")
+        (* ;; "")

 
         
-        (* ;; "Comparisons")
+        (* ;; "Comparisons")

 
         (FNS GIT-GET-DIFFERENT-FILES GIT-BRANCHES-COMPARE-DIRECTORIES GIT-WORKING-COMPARE-DIRECTORIES
              GIT-COMPARE-WORKTREE GITCDOBJBUTTONFN GIT-CD-LABELFN GIT-CD-MENUFN 
              GIT-WORKING-COMPARE-FILES GIT-BRANCHES-COMPARE-FILES GIT-PR-COMPARE)
         (INITVARS (FROMGITN 0))
         
-        (* ;; "")
+        (* ;; "")

 
         
-        (* ;; "Utilities")
+        (* ;; "Utilities")

 
         (FNS CDGITDIR GIT-COMMAND GITORIGIN GIT-INITIALS GIT-COMMAND-TO-FILE GIT-RESULT-TO-LINES 
              STRIPLOCAL)
-        (PROPS (GITFNS FILETYPE))))
+        (PROPS (GITFNS FILETYPE))))
 
 
 
-(* ;; "Set up")
+(* ;; "Set up")

 
 
-(
FILESLOAD (SYSLOAD FROM LISPUSERS)
+(FILESLOAD (SYSLOAD FROM LISPUSERS)
        COMPAREDIRECTORIES COMPARESOURCES COMPARETEXT PSEUDOHOSTS JSON UNIXUTILS REGIONMANAGER)
 
 
 
-(* ;; "")
+(* ;; "")

 
 
 
 
-(* ;; "GIT projects")
+(* ;; "GIT projects")

 
 (DEFINEQ
 
@@ -402,15 +401,15 @@
 (DECLARE%: EVAL@COMPILE DONTCOPY 
 (DECLARE%: EVAL@COMPILE
 
-(TYPERECORD GIT-PROJECT (PROJECTNAME GITHOST WHOST EXCLUSIONS DEFAULTSUBDIRS CLONEPATH MAINBRANCH))
+(TYPERECORD GIT-PROJECT
 (PROJECTNAME GITHOST WHOST EXCLUSIONS DEFAULTSUBDIRS CLONEPATH MAINBRANCH))
 
-(RECORD PULLREQUEST (PRNUMBER PRDESCRIPTION PRNAME PRSTATUS PRPROJECT PRURL PRLOGIN))
+(RECORD PULLREQUEST
 (PRNUMBER PRDESCRIPTION PRNAME PRSTATUS PRPROJECT PRURL PRLOGIN))
 )
 )
 
-(RPAQ? GIT-DEFAULT-PROJECT 'MEDLEY)
+(RPAQ? GIT-DEFAULT-PROJECT
 'MEDLEY)
 
-(RPAQ? GIT-DEFAULT-PROJECTS
+(RPAQ? GIT-DEFAULT-PROJECTS

        '((MEDLEY NIL NIL (EXPORTS.ALL RDSYS RDSYS.LCOM loadups/ patches/ tmp/ fontsold/ clos/ cltl2/)
                 (greetfiles scripts sources library lispusers internal doctools rooms))
          (NOTECARDS)
@@ -418,120 +417,120 @@
          (TEST)
          (MAIKO)))
 
-(RPAQ? GIT-PROJECTS NIL)
+(RPAQ? GIT-PROJECTS
 NIL)
 
-(RPAQ? GIT-PRC-MENUS NIL)
+(RPAQ? GIT-PRC-MENUS
 NIL)
 
-(GIT-INIT)
+(GIT-INIT
)
 
-(ADDTOVAR AROUNDEXITFNS GIT-INIT)
+(ADDTOVAR AROUNDEXITFNS
 GIT-INIT)
 
 
 
-(* ;; "")
+(* ;; "")

 
 
 
 
-(* ;; "Lisp exec commands")
+(* ;; "Lisp exec commands")

 
 
-(RPAQ? GIT-MERGE-COMPARES T)
+(RPAQ? GIT-MERGE-COMPARES
 T)
 
-(RPAQ? GIT-CDBROWSER-SEPARATE-DIRECTIONS T)
+(RPAQ? GIT-CDBROWSER-SEPARATE-DIRECTIONS
 T)
 
 (DEFCOMMAND gwc (SUBDIR . OTHERS)
 
-   (* ;; "Compares the specified local git-medley subdirectories against my working Medley.  The SUBDIRS are the arguments up to one that looks like a project")
+   (* ;; "Compares the specified local git-medley subdirectories against my working Medley.  The SUBDIRS are the arguments up to one that looks like a project")

 
-    (
LET ((SUBDIRS (
AND SUBDIR (
CONS SUBDIR OTHERS)))
+    (LET ((SUBDIRS (AND SUBDIR (CONS SUBDIR OTHERS)))
           PROJECT)
-         (
SETQ SUBDIRS (FOR STAIL ON SUBDIRS COLLECT (IF (GIT-GET-PROJECT (
CAR STAIL)
+         (SETQ SUBDIRS (FOR
 STAIL ON
 SUBDIRS COLLECT
 (IF
 (GIT-GET-PROJECT
 (CAR STAIL)
                                                                 NIL T)
-                                                         THEN (
SETQ PROJECT (
CAR STAIL))
-                                                              (
GO $$OUT))
-                                                   (
CAR STAIL)))
-         (GIT-WORKING-COMPARE-DIRECTORIES SUBDIRS NIL NIL NIL T PROJECT)))
+                                                         THEN
 (SETQ PROJECT (CAR STAIL))
+                                                              (GO $$OUT))
+                                                   (CAR STAIL)))
+         (GIT-WORKING-COMPARE-DIRECTORIES
 SUBDIRS NIL NIL NIL T PROJECT)))
 
 (DEFCOMMAND bbc (BRANCH1 BRANCH2 LOCAL PROJECT)
 
-   (* ;; "Compares 2 git branches.  Defaults to local/ if LOCAL, otherwise defaults to origin/.  BRANCH2 defaults to the main branch (origin/ or local/ depending on LOCAL)")
+   (* ;; "Compares 2 git branches.  Defaults to local/ if LOCAL, otherwise defaults to origin/.  BRANCH2 defaults to the main branch (origin/ or local/ depending on LOCAL)")

 
-    (
SETQ PROJECT (GIT-GET-PROJECT PROJECT))
-   (GIT-FETCH PROJECT)
-   (
SETQ BRANCH1 (
SELECTQ (
U-CASE BRANCH1)
+    (SETQ PROJECT (GIT-GET-PROJECT
 PROJECT))
+   (GIT-FETCH
 PROJECT)
+   (SETQ BRANCH1 (SELECTQ (U-CASE BRANCH1)
                      ((NIL T) 
-                          (GIT-MY-CURRENT-BRANCH PROJECT))
+                          (GIT-MY-CURRENT-BRANCH
 PROJECT))
                      ((LOCAL REMOTE ORIGIN) 
-                          (GIT-PICK-BRANCH (GIT-BRANCHES BRANCH1 PROJECT T)))
-                     (
OR (GIT-LONG-NAME BRANCH1 NIL PROJECT)
+                          (GIT-PICK-BRANCH
 (GIT-BRANCHES
 BRANCH1 PROJECT T)))
+                     (OR (GIT-LONG-NAME
 BRANCH1 NIL PROJECT)
                          BRANCH1)))
-   (
SETQ BRANCH2 (
SELECTQ (
U-CASE BRANCH2)
+   (SETQ BRANCH2 (SELECTQ (U-CASE BRANCH2)
                      ((NIL T) 
-                          (GIT-MAINBRANCH PROJECT LOCAL))
+                          (GIT-MAINBRANCH
 PROJECT LOCAL))
                      ((LOCAL REMOTE ORIGIN) 
-                          (GIT-PICK-BRANCH (GIT-BRANCHES BRANCH2 PROJECT T)))
-                     (
OR (GIT-LONG-NAME BRANCH2 NIL PROJECT)
+                          (GIT-PICK-BRANCH
 (GIT-BRANCHES
 BRANCH2 PROJECT T)))
+                     (OR (GIT-LONG-NAME
 BRANCH2 NIL PROJECT)
                          BRANCH2)))
-   (GIT-BRANCHES-COMPARE-DIRECTORIES BRANCH1 (
OR BRANCH2 (GIT-MAINBRANCH PROJECT LOCAL))
+   (GIT-BRANCHES-COMPARE-DIRECTORIES
 BRANCH1 (OR BRANCH2 (GIT-MAINBRANCH
 PROJECT LOCAL))
           LOCAL PROJECT))
 
 (DEFCOMMAND prc (REMOTEBRANCH DRAFTS PROJECT)
 
-   (* ;; "Compares REMOTEBRANCH against the main orign branch, for pull-request assessment")
+   (* ;; "Compares REMOTEBRANCH against the main orign branch, for pull-request assessment")

 
-    (PRC-COMMAND REMOTEBRANCH DRAFTS PROJECT))
+    (PRC-COMMAND
 REMOTEBRANCH DRAFTS PROJECT))
 
 (DEFCOMMAND cob (BRANCH NEXTTITLESTRING PROJECT)
 
-   (* ;; "Switches to BRANCH. T means my current branch, NEW/NEXT means my next branch (under wherever we are now), and NEXTTITLESTRING if given will be attached to the branch-name.  Default is to bring up a menu of locally available branches.")
+   (* ;; "Switches to BRANCH. T means my current branch, NEW/NEXT means my next branch (under wherever we are now), and NEXTTITLESTRING if given will be attached to the branch-name.  Default is to bring up a menu of locally available branches.")

 
-    (CL:UNLESS (
STRINGP NEXTTITLESTRING)
-           (
SETQ PROJECT NEXTTITLESTRING))
+    (CL:UNLESS (STRINGP NEXTTITLESTRING)
+           (SETQ PROJECT NEXTTITLESTRING))
    (CL:UNLESS PROJECT
-       (CL:WHEN (GIT-GET-PROJECT BRANCH NIL T)
-           (
SETQ PROJECT BRANCH)
-           (
SETQ BRANCH NIL)))
-   (
SETQ PROJECT (GIT-GET-PROJECT PROJECT))
-   (GIT-FETCH PROJECT)
-   (
SELECTQ (
U-CASE BRANCH)
-       (T (GIT-CHECKOUT (GIT-MY-CURRENT-BRANCH PROJECT)
+       (CL:WHEN (GIT-GET-PROJECT
 BRANCH NIL T)
+           (SETQ PROJECT BRANCH)
+           (SETQ BRANCH NIL)))
+   (SETQ PROJECT (GIT-GET-PROJECT
 PROJECT))
+   (GIT-FETCH
 PROJECT)
+   (SELECTQ (U-CASE BRANCH)
+       (T (GIT-CHECKOUT
 (GIT-MY-CURRENT-BRANCH
 PROJECT)
                  PROJECT))
        ((NEW NEXT) 
-            (GIT-MAKE-BRANCH NIL NEXTTITLESTRING PROJECT))
-       (CL:WHEN [
SETQ BRANCH (IF BRANCH
-                                 THEN (GIT-LONG-NAME BRANCH NIL PROJECT)
-                               ELSE (GIT-PICK-BRANCH (GIT-BRANCHES 'LOCAL PROJECT T)
-                                           (
CONCAT (
L-CASE (GIT-GET-PROJECT PROJECT 'PROJECTNAME)
+            (GIT-MAKE-BRANCH
 NIL NEXTTITLESTRING PROJECT))
+       (CL:WHEN [SETQ BRANCH (IF
 BRANCH
+                                 THEN
 (GIT-LONG-NAME
 BRANCH NIL PROJECT)
+                               ELSE
 (GIT-PICK-BRANCH
 (GIT-BRANCHES
 'LOCAL PROJECT T)
+                                           (CONCAT (L-CASE (GIT-GET-PROJECT
 PROJECT 'PROJECTNAME)
                                                           T)
                                                   " branches"]
-              (GIT-CHECKOUT BRANCH PROJECT))))
+              (GIT-CHECKOUT
 BRANCH PROJECT))))
 
-(DEFCOMMAND b? (PROJECT) (
SETQ PROJECT (GIT-GET-PROJECT PROJECT))
-   (GIT-FETCH PROJECT)
-   (
CONCAT (
L-CASE (GIT-GET-PROJECT PROJECT 'PROJECTNAME)
+(DEFCOMMAND b? (PROJECT) (SETQ PROJECT (GIT-GET-PROJECT
 PROJECT))
+   (GIT-FETCH
 PROJECT)
+   (CONCAT (L-CASE (GIT-GET-PROJECT
 PROJECT 'PROJECTNAME)
                   T)
           " "
-          (GIT-WHICH-BRANCH PROJECT)))
-
-(DEFCOMMAND cdg (PROJECT SUBDIR) (CL:UNLESS (GIT-GET-PROJECT PROJECT NIL T)
-                                     (
SETQ SUBDIR PROJECT)
-                                     (
SETQ PROJECT GIT-DEFAULT-PROJECT))
-   (CL:WHEN [
AND SUBDIR (
NOT (
MEMB (
CHCON1 SUBDIR))
-                             (
CHARCODE (
> /]
-       (
SETQ SUBDIR (
CONCAT SUBDIR "/")))
-   (
SLASHIT (
/CNDIR (
CONCAT (GIT-GET-PROJECT PROJECT 'GITHOST)
-                           (
OR SUBDIR "")))
+          (GIT-WHICH-BRANCH
 PROJECT)))
+
+(DEFCOMMAND cdg (PROJECT SUBDIR) (CL:UNLESS (GIT-GET-PROJECT
 PROJECT NIL T)
+                                     (SETQ SUBDIR PROJECT)
+                                     (SETQ PROJECT GIT-DEFAULT-PROJECT))
+   (CL:WHEN [AND SUBDIR (NOT (MEMB (CHCON1 SUBDIR))
+                             (CHARCODE (> /]
+       (SETQ SUBDIR (CONCAT SUBDIR "/")))
+   (SLASHIT (/CNDIR (CONCAT (GIT-GET-PROJECT
 PROJECT 'GITHOST)
+                           (OR SUBDIR "")))
           T))
 
-(DEFCOMMAND cdw (PROJECT SUBDIR) (CL:UNLESS (GIT-GET-PROJECT PROJECT NIL T)
-                                     (
SETQ SUBDIR PROJECT)
-                                     (
SETQ PROJECT GIT-DEFAULT-PROJECT))
-   (CL:WHEN [
AND SUBDIR (
NOT (
MEMB (
CHCON1 SUBDIR))
-                             (
CHARCODE (
> /]
-       (
SETQ SUBDIR (
CONCAT SUBDIR "/")))
-   (
SLASHIT (
/CNDIR (
CONCAT (GIT-GET-PROJECT PROJECT 'WHOST)
-                           (
OR SUBDIR "")))
+(DEFCOMMAND cdw (PROJECT SUBDIR) (CL:UNLESS (GIT-GET-PROJECT
 PROJECT NIL T)
+                                     (SETQ SUBDIR PROJECT)
+                                     (SETQ PROJECT GIT-DEFAULT-PROJECT))
+   (CL:WHEN [AND SUBDIR (NOT (MEMB (CHCON1 SUBDIR))
+                             (CHARCODE (> /]
+       (SETQ SUBDIR (CONCAT SUBDIR "/")))
+   (SLASHIT (/CNDIR (CONCAT (GIT-GET-PROJECT
 PROJECT 'WHOST)
+                           (OR SUBDIR "")))
           T))
 (DEFINEQ
 
@@ -617,12 +616,12 @@
 
 
 
-(* ;; "")
+(* ;; "")

 
 
 
 
-(* ;; "File correspondents")
+(* ;; "File correspondents")

 
 (DEFINEQ
 
@@ -865,12 +864,12 @@
 
 
 
-(* ;; "")
+(* ;; "")

 
 
 
 
-(* ;; "Git commands")
+(* ;; "Git commands")

 
 (DEFINEQ
 
@@ -1074,7 +1073,7 @@
 
 
 
-(* ;; "Differences")
+(* ;; "Differences")

 
 (DEFINEQ
 
@@ -1187,14 +1186,16 @@
                         T])
 
 (GIT-COMMIT-DIFFS

-  [LAMBDA (BRANCH1 BUTNOTBRANCH2 PROJECT)
                    (* ; "Edited  2-May-2024 11:24 by mth")


+  [LAMBDA (BRANCH1 BUTNOTBRANCH2 PROJECT)
                    (* ; "Edited  5-May-2025 21:59 by rmk")


+                                                             (* ; "Edited 29-Apr-2025 22:08 by rmk")


+                                                             (* ; "Edited  2-May-2024 11:24 by mth")


                                                              (* ; "Edited 26-Jun-2022 13:32 by rmk")


                                                              (* ; "Edited  7-May-2022 23:48 by rmk")


                                                              (* ; "Edited  2-May-2022 13:45 by rmk")

 
     (* ;; "Returns the identifiers for commits in BRANCH1 but not in BUTNOTBRANCH2")

 
-    (GIT-COMMAND
 (CONCAT "git log --format=%"%%h%" %"" BRANCH1 "%" %"^" BUTNOTBRANCH2 "%"")
+    (GIT-COMMAND
 (CONCAT "git log --format=%"%%h%" %"" BRANCH1 "%" %"­" BUTNOTBRANCH2 "%"")
            NIL NIL PROJECT])
 
 (GIT-BRANCH-RELATIONS

@@ -1262,12 +1263,12 @@
 
 
 
-(* ;; "")
+(* ;; "")

 
 
 
 
-(* ;; "Branches")
+(* ;; "Branches")

 
 (DEFINEQ
 
@@ -1466,7 +1467,8 @@
                                    '(PROGN (DSPFONT OLDVALUE T])])
 
 (GIT-PULL-REQUESTS

-  [LAMBDA (INCLUDEDRAFTS PROJECT)
                            (* ; "Edited 20-May-2024 22:12 by rmk")


+  [LAMBDA (INCLUDEDRAFTS PROJECT)
                            (* ; "Edited  9-May-2025 11:39 by rmk")


+                                                             (* ; "Edited 20-May-2024 22:12 by rmk")


                                                              (* ; "Edited 13-May-2024 18:59 by rmk")


                                                              (* ; "Edited 11-May-2024 10:51 by rmk")


                                                              (* ; "Edited  1-May-2024 09:23 by rmk")


@@ -1493,7 +1495,7 @@
                                     PRDESCRIPTION _ (JSON-GET JSOBJ 'title)
                                     PRSTATUS _ (CL:IF DRAFT
                                                    'D
-                                                   (CL:IF (STREQUAL "REVIEW_REQUIRED"
+                                                   (CL:IF (STREQUAL "REVIEW¬REQUIRED"
                                                                  (JSON-GET JSOBJ 'reviewDecision))
                                                        " "
                                                        'A))
@@ -1575,7 +1577,7 @@
 
 
 
-(* ;; "My branches")
+(* ;; "My branches")

 
 (DEFINEQ
 
@@ -1642,12 +1644,12 @@
 
 
 
-(* ;; "")
+(* ;; "")

 
 
 
 
-(* ;; "Worktrees")
+(* ;; "Worktrees")

 
 (DEFINEQ
 
@@ -1718,12 +1720,12 @@
 
 
 
-(* ;; "")
+(* ;; "")

 
 
 
 
-(* ;; "Comparisons")
+(* ;; "Comparisons")

 
 (DEFINEQ
 
@@ -1731,6 +1733,10 @@
   [LAMBDA (BRANCH1 BRANCH2 DIR1 DIR2 PROJECT)
     (DECLARE
 (USEDFREE FROMGITN))
 
+    (* ;; "Edited 23-Sep-2025 21:42 by rmk")

+
+    (* ;; "Edited 22-Sep-2025 12:48 by rmk")

+
     (* ;; "Edited 12-Sep-2022 14:58 by rmk")

 
     (* ;; "Edited 21-May-2022 23:38 by rmk")

@@ -1742,97 +1748,98 @@
     (SETQ PROJECT (GIT-GET-PROJECT
 PROJECT))
     (SETQ BRANCH1 (GIT-BRANCH-EXISTS?
 BRANCH1 NIL PROJECT))
     (SETQ BRANCH2 (GIT-BRANCH-EXISTS?
 BRANCH2 NIL PROJECT))
-    (LET
-     (MAPPINGS FROMGIT (DIFFS (GIT-BRANCH-DIFF
 BRANCH1 BRANCH2 PROJECT)))
-     (CL:WHEN DIFFS
-         (SETQ FROMGIT (PACK* '{FROMGIT (add
 FROMGITN 1)
-                              '}))
-         (PSEUDOHOST FROMGIT (CONCAT "{CORE}<" (fetch
 PROJECTNAME of
 PROJECT)
-                                    ">"
-                                    (DATE)
-                                    ">"))
-
-         (* ;; "UNSLASHIT because CORE doesn't know about slash")

-
-         (CL:UNLESS DIR1
-             (SETQ DIR1 (CONCAT FROMGIT "<" (UNSLASHIT BRANCH1)
-                               ">")))
-         (CL:UNLESS DIR2
-             (SETQ DIR2 (CONCAT FROMGIT "<" (UNSLASHIT BRANCH2)
-                               ">")))
-         (for
 D in
 DIFFS
-            do
 (SELECTQ (CAR D)
-                   (ADDED                                    (* ; 
+    (LET (MAPPINGS FROMGIT FROMGITDIR PRNAME (DIFFS (GIT-BRANCH-DIFF
 BRANCH1 BRANCH2 PROJECT)))
+         (CL:WHEN DIFFS
+             (SETQ FROMGIT (PACK* "{FROMGIT" (add
 FROMGITN 1)
+                                  "}"))
+
+             (* ;; "If both origin/, strip it out of subdirectories")

+
+             (SETQ PRNAME (MTOUSTRING (CL:IF (AND (STRPOS "origin/" BRANCH1 NIL T)
+                                                  (STRPOS "origin/" BRANCH2 NIL T))
+                                          (SUBSTRING BRANCH2 (CONSTANT (NCHARS "origin/ ")))
+                                          BRANCH2)))
+             (PSEUDOHOST FROMGIT (CONCAT "{DSK}<tmp>" (fetch
 PROJECTNAME of
 PROJECT)
+                                        "-PR--" PRNAME "--" (DATE)
+                                        ">"))
+             (CL:UNLESS DIR1
+                 (SETQ DIR1 (CONCAT FROMGIT "<master>")))
+             (CL:UNLESS DIR2
+                 (SETQ DIR2 (CONCAT FROMGIT "<pr>")))
+             (for
 D in
 DIFFS
+                do

+                (SELECTQ (CAR D)
+                    (ADDED                                   (* ; 
 
     "Shouldn't exist in BRANCH2, should exist in BRANCH1, but maybe ADDED and DELETED are mixed up?")

-                          (SETQ D (CADR D))
-                          (OR (GIT-GET-FILE
 BRANCH1 D (CONCAT DIR1 D)
-                                     T PROJECT)
-                              (GIT-GET-FILE
 BRANCH2 D (CONCAT DIR2 D)
-                                     T PROJECT)))
-                   (DELETED 
-                            (* ;; "Shouldn't exist in BRANCH1, should exist in BRANCH2.  But maybe git is just confused in marking a file that exists in the wrong place as a delete instead of an add, or maybe it may think of a file that doesn't exist at all as having been deleted.  Try for both, but don't cause an error.")

-
-                            (SETQ D (CADR D))
-                            (OR (GIT-GET-FILE
 BRANCH2 D (CONCAT DIR2 D)
-                                       T PROJECT)
-                                (GIT-GET-FILE
 BRANCH1 D (CONCAT DIR1 D)
-                                       T PROJECT)))
-                   (CHANGED                                  (* ; "Should exist in both branches")

-                            (SETQ D (CADR D))
-                            (GIT-GET-FILE
 BRANCH1 D (CONCAT DIR1 D)
-                                   T PROJECT)
-                            (GIT-GET-FILE
 BRANCH2 D (CONCAT DIR2 D)
-                                   T PROJECT))
-                   ((RENAMED COPIED) 
+                           (SETQ D (CADR D))
+                           (OR (GIT-GET-FILE
 BRANCH1 D (CONCAT DIR1 D)
+                                      T PROJECT)
+                               (GIT-GET-FILE
 BRANCH2 D (CONCAT DIR2 D)
+                                      T PROJECT)))
+                    (DELETED 
+                             (* ;; "Shouldn't exist in BRANCH1, should exist in BRANCH2.  But maybe git is just confused in marking a file that exists in the wrong place as a delete instead of an add, or maybe it may think of a file that doesn't exist at all as having been deleted.  Try for both, but don't cause an error.")

+
+                             (SETQ D (CADR D))
+                             (OR (GIT-GET-FILE
 BRANCH2 D (CONCAT DIR2 D)
+                                        T PROJECT)
+                                 (GIT-GET-FILE
 BRANCH1 D (CONCAT DIR1 D)
+                                        T PROJECT)))
+                    (CHANGED                                 (* ; "Should exist in both branches")

+                             (SETQ D (CADR D))
+                             (GIT-GET-FILE
 BRANCH1 D (CONCAT DIR1 D)
+                                    T PROJECT)
+                             (GIT-GET-FILE
 BRANCH2 D (CONCAT DIR2 D)
+                                    T PROJECT))
+                    ((RENAMED COPIED) 
 
                                  (* ;; "These entries are from-to filename pairs.  If (CADDR) is 100, only need to fetch one, because it presumably has disappeared in BRANCH2 and reappeared in BRANCH1. MAPPINGS is returned so the connection can be reestablished higher up.  ")

 
-                        
-                        (* ;; "If renamed and then changed, for now treat as unrelated adds and deletes:  put both files in the fromgit directory.  Perhaps the mapping should still figure out how to relate them.")

+                         
+                         (* ;; "If renamed and then changed, for now treat as unrelated adds and deletes:  put both files in the fromgit directory.  Perhaps the mapping should still figure out how to relate them.")

 
-                        (* ;; "For copied files, presumably 2 files are exactly the same.  But we hope we can show them on the same line, by virtue of the mapping.")

+                         (* ;; "For copied files, presumably 2 files are exactly the same.  But we hope we can show them on the same line, by virtue of the mapping.")

 
-                        [LET ((GFILE (CDR D))
-                              F1 F1)
+                         [LET ((GFILE (CDR D))
+                               F1 F2)
 
-                             (* ;; "GFILE is a triple (F2 F1 N )")

+                          (* ;; "GFILE is a triple (F2 F1 N )")

 
-                             (* ;; "F1 is the file in branch 1, if any, F2 is in branch 2")

+                          (* ;; "F1 is the file in branch 1, if any, F2 is in branch 2")

 
-                             (SETQ F1 (GIT-GET-FILE
 BRANCH1 (CADR GFILE)
-                                             (CONCAT DIR1 (CADR GFILE))
-                                             T PROJECT))
-                             (SETQ F2 (GIT-GET-FILE
 BRANCH2 (CADR GFILE)
-                                             (CONCAT DIR2 (CADR GFILE))
-                                             T PROJECT))
+                              (SETQ F1 (GIT-GET-FILE
 BRANCH1 (CADR GFILE)
+                                              (CONCAT DIR1 (CADR GFILE))
+                                              T PROJECT))
+                              (SETQ F2 (GIT-GET-FILE
 BRANCH2 (CADR GFILE)
+                                              (CONCAT DIR2 (CADR GFILE))
+                                              T PROJECT))
 
-                             (* ;; "Let the directories figure it out")

+                          (* ;; "Let the directories figure it out")

 
-                             (AND NIL (if
 (EQ (CADDR GFILE)
-                                              100)
-                                          then
 
+                              (AND NIL (if
 (EQ (CADDR GFILE)
+                                               100)
+                                           then
 
 
                                  (* ;; "A little tricky to figure out what corresponds to the real file in the mapping, which directory it belongs to.  Maybe the first one should always be one that exists, the second may just be a useful name.  But we have to know whether to match against INFO1 or INFO2")

 
-                                               (HELP GFILE 100)
-                                               (push
 MAPPINGS
-                                                     (LIST (LIST)
-                                                           (FULLNAME F1)
-                                                           (SLASHIT (U-CASE (CONCAT DIR2 (CAR GFILE))
-                                                                           )
-                                                                  T)
-                                                           (NTHCHAR (CAR D)
-                                                                  1)
-                                                           100))
-                                        else
 
-                                             (* ;; 
+                                                (HELP GFILE 100)
+                                                (push
 MAPPINGS
+                                                      (LIST (LIST)
+                                                            (FULLNAME F1)
+                                                            (SLASHIT (U-CASE (CONCAT DIR2
+                                                                                    (CAR GFILE)))
+                                                                   T)
+                                                            (NTHCHAR (CAR D)
+                                                                   1)
+                                                            100))
+                                         else
 
+                                              (* ;; 
 
                                    "If not a perfect match, then the directory should figure it out")

 
-                                             (GIT-GET-FILE
 BRANCH2 (CAR GFILE)
-                                                    (CONCAT DIR2 (CAR GFILE))
-                                                    T PROJECT])
-                   (HELP "UNKNOWN GIT-DIFF TAG" D)))
-         (LIST DIR1 DIR2 MAPPINGS))])
+                                              (GIT-GET-FILE
 BRANCH2 (CAR GFILE)
+                                                     (CONCAT DIR2 (CAR GFILE))
+                                                     T PROJECT])
+                    (HELP "UNKNOWN GIT-DIFF TAG" D)))
+             (LIST DIR1 DIR2 MAPPINGS))])
 
 (GIT-BRANCHES-COMPARE-DIRECTORIES

   [LAMBDA (BRANCH1 BRANCH2 LOCAL PROJECT)
                    (* ; "Edited 12-Jun-2024 22:52 by mth")


@@ -2273,16 +2280,16 @@
            RB NIL PROJECT])
 )
 
-(RPAQ? FROMGITN 0)
+(RPAQ? FROMGITN
 0)
 
 
 
-(* ;; "")
+(* ;; "")

 
 
 
 
-(* ;; "Utilities")
+(* ;; "Utilities")

 
 (DEFINEQ
 
@@ -2430,35 +2437,35 @@
     STRING])
 )
 
-(PUTPROPS GITFNS FILETYPE :TCOMPL)
+(PUTPROPS GITFNS
 FILETYPE
 :TCOMPL)
 (DECLARE%: DONTCOPY
-  (FILEMAP (NIL (4225 20804 (GIT-CLONEP 4235 . 5563) (GIT-INIT 5565 . 6195) (GIT-MAKE-PROJECT 6197 . 
-13862) (GIT-GET-PROJECT 13864 . 15789) (GIT-PUT-PROJECT-FIELD 15791 . 17432) (GIT-PROJECT-PATH 17434
- . 18478) (FIND-ANCESTOR-DIRECTORY 18480 . 18829) (GIT-FIND-CLONE 18831 . 19912) (GIT-MAINBRANCH 19914
- . 20309) (GIT-MAINBRANCH? 20311 . 20802)) (26471 31400 (PRC-COMMAND 26481 . 31398)) (31448 34236 (
-ALLSUBDIRS 31458 . 32744) (MEDLEYSUBDIRS 32746 . 33439) (GITSUBDIRS 33441 . 34234)) (34237 39027 (
-TOGIT 34247 . 35653) (FROMGIT 35655 . 36636) (GIT-DELETE-FILE 36638 . 37484) (MYMEDLEY-DELETE-FILES 
-37486 . 39025)) (39028 42031 (MYMEDLEYSUBDIR 39038 . 39494) (GITSUBDIR 39496 . 39939) (STRIPDIR 39941
- . 40312) (STRIPHOST 40314 . 40554) (STRIPNAME 40556 . 41309) (STRIPWHERE 41311 . 42029)) (42032 43934
- (GFILE4MFILE 42042 . 42405) (MFILE4GFILE 42407 . 42976) (GIT-REPO-FILENAME 42978 . 43932)) (43975 
-54230 (GIT-COMMIT 43985 . 44811) (GIT-PUSH 44813 . 45573) (GIT-PULL 45575 . 46327) (GIT-APPROVAL 46329
- . 46678) (GIT-GET-FILE 46680 . 48595) (GIT-FILE-EXISTS? 48597 . 48871) (GIT-REMOTE-UPDATE 48873 . 
-49708) (GIT-REMOTE-ADD 49710 . 50017) (GIT-FILE-DATE 50019 . 51066) (GIT-FILE-HISTORY 51068 . 53002) (
-GIT-PRINT-FILE-HISTORY 53004 . 54054) (GIT-FETCH 54056 . 54228)) (54256 65376 (GIT-BRANCH-DIFF 54266
- . 61013) (GIT-COMMIT-DIFFS 61015 . 61688) (GIT-BRANCH-RELATIONS 61690 . 65374)) (65413 84799 (
-GIT-BRANCH-NUM 65423 . 65996) (GIT-CHECKOUT 65998 . 67284) (GIT-WHICH-BRANCH 67286 . 67693) (
-GIT-MAKE-BRANCH 67695 . 70274) (GIT-BRANCHES 70276 . 72871) (GIT-BRANCH-EXISTS? 72873 . 73744) (
-GIT-PICK-BRANCH 73746 . 74236) (GIT-BRANCH-MENU 74238 . 75119) (GIT-BRANCH-WHENSELECTEDFN 75121 . 
-77660) (GIT-PULL-REQUESTS 77662 . 81180) (GIT-SHORT-BRANCH-NAME 81182 . 81473) (GIT-LONG-NAME 81475 . 
-81792) (GIT-PRC-BRANCHES 81794 . 84797)) (84825 88273 (GIT-MY-CURRENT-BRANCH 84835 . 85205) (
-GIT-MY-BRANCHP 85207 . 85825) (GIT-MY-NEXT-BRANCH 85827 . 86321) (GIT-MY-BRANCHES 86323 . 88271)) (
-88311 92386 (GIT-ADD-WORKTREE 88321 . 89928) (GIT-REMOVE-WORKTREE 89930 . 90860) (GIT-LIST-WORKTREES 
-90862 . 91666) (WORKTREEDIR 91668 . 92384)) (92426 125819 (GIT-GET-DIFFERENT-FILES 92436 . 98860) (
-GIT-BRANCHES-COMPARE-DIRECTORIES 98862 . 106093) (GIT-WORKING-COMPARE-DIRECTORIES 106095 . 111802) (
-GIT-COMPARE-WORKTREE 111804 . 115782) (GITCDOBJBUTTONFN 115784 . 120274) (GIT-CD-LABELFN 120276 . 
-121358) (GIT-CD-MENUFN 121360 . 123800) (GIT-WORKING-COMPARE-FILES 123802 . 124422) (
-GIT-BRANCHES-COMPARE-FILES 124424 . 125588) (GIT-PR-COMPARE 125590 . 125817)) (125881 134204 (CDGITDIR
- 125891 . 126578) (GIT-COMMAND 126580 . 128138) (GITORIGIN 128140 . 128837) (GIT-INITIALS 128839 . 
-129143) (GIT-COMMAND-TO-FILE 129145 . 132630) (GIT-RESULT-TO-LINES 132632 . 133537) (STRIPLOCAL 133539
- . 134202)))))
+  (FILEMAP (NIL (4193 20772 (GIT-CLONEP 4203 . 5531) (GIT-INIT 5533 . 6163) (GIT-MAKE-PROJECT 6165 . 
+13830) (GIT-GET-PROJECT 13832 . 15757) (GIT-PUT-PROJECT-FIELD 15759 . 17400) (GIT-PROJECT-PATH 17402
+ . 18446) (FIND-ANCESTOR-DIRECTORY 18448 . 18797) (GIT-FIND-CLONE 18799 . 19880) (GIT-MAINBRANCH 19882
+ . 20277) (GIT-MAINBRANCH? 20279 . 20770)) (26235 31164 (PRC-COMMAND 26245 . 31162)) (31220 34008 (
+ALLSUBDIRS 31230 . 32516) (MEDLEYSUBDIRS 32518 . 33211) (GITSUBDIRS 33213 . 34006)) (34009 38799 (
+TOGIT 34019 . 35425) (FROMGIT 35427 . 36408) (GIT-DELETE-FILE 36410 . 37256) (MYMEDLEY-DELETE-FILES 
+37258 . 38797)) (38800 41803 (MYMEDLEYSUBDIR 38810 . 39266) (GITSUBDIR 39268 . 39711) (STRIPDIR 39713
+ . 40084) (STRIPHOST 40086 . 40326) (STRIPNAME 40328 . 41081) (STRIPWHERE 41083 . 41801)) (41804 43706
+ (GFILE4MFILE 41814 . 42177) (MFILE4GFILE 42179 . 42748) (GIT-REPO-FILENAME 42750 . 43704)) (43755 
+54010 (GIT-COMMIT 43765 . 44591) (GIT-PUSH 44593 . 45353) (GIT-PULL 45355 . 46107) (GIT-APPROVAL 46109
+ . 46458) (GIT-GET-FILE 46460 . 48375) (GIT-FILE-EXISTS? 48377 . 48651) (GIT-REMOTE-UPDATE 48653 . 
+49488) (GIT-REMOTE-ADD 49490 . 49797) (GIT-FILE-DATE 49799 . 50846) (GIT-FILE-HISTORY 50848 . 52782) (
+GIT-PRINT-FILE-HISTORY 52784 . 53834) (GIT-FETCH 53836 . 54008)) (54040 65378 (GIT-BRANCH-DIFF 54050
+ . 60797) (GIT-COMMIT-DIFFS 60799 . 61690) (GIT-BRANCH-RELATIONS 61692 . 65376)) (65423 84918 (
+GIT-BRANCH-NUM 65433 . 66006) (GIT-CHECKOUT 66008 . 67294) (GIT-WHICH-BRANCH 67296 . 67703) (
+GIT-MAKE-BRANCH 67705 . 70284) (GIT-BRANCHES 70286 . 72881) (GIT-BRANCH-EXISTS? 72883 . 73754) (
+GIT-PICK-BRANCH 73756 . 74246) (GIT-BRANCH-MENU 74248 . 75129) (GIT-BRANCH-WHENSELECTEDFN 75131 . 
+77670) (GIT-PULL-REQUESTS 77672 . 81299) (GIT-SHORT-BRANCH-NAME 81301 . 81592) (GIT-LONG-NAME 81594 . 
+81911) (GIT-PRC-BRANCHES 81913 . 84916)) (84948 88396 (GIT-MY-CURRENT-BRANCH 84958 . 85328) (
+GIT-MY-BRANCHP 85330 . 85948) (GIT-MY-NEXT-BRANCH 85950 . 86444) (GIT-MY-BRANCHES 86446 . 88394)) (
+88442 92517 (GIT-ADD-WORKTREE 88452 . 90059) (GIT-REMOVE-WORKTREE 90061 . 90991) (GIT-LIST-WORKTREES 
+90993 . 91797) (WORKTREEDIR 91799 . 92515)) (92565 126387 (GIT-GET-DIFFERENT-FILES 92575 . 99428) (
+GIT-BRANCHES-COMPARE-DIRECTORIES 99430 . 106661) (GIT-WORKING-COMPARE-DIRECTORIES 106663 . 112370) (
+GIT-COMPARE-WORKTREE 112372 . 116350) (GITCDOBJBUTTONFN 116352 . 120842) (GIT-CD-LABELFN 120844 . 
+121926) (GIT-CD-MENUFN 121928 . 124368) (GIT-WORKING-COMPARE-FILES 124370 . 124990) (
+GIT-BRANCHES-COMPARE-FILES 124992 . 126156) (GIT-PR-COMPARE 126158 . 126385)) (126457 134780 (CDGITDIR
+ 126467 . 127154) (GIT-COMMAND 127156 . 128714) (GITORIGIN 128716 . 129413) (GIT-INITIALS 129415 . 
+129719) (GIT-COMMAND-TO-FILE 129721 . 133206) (GIT-RESULT-TO-LINES 133208 . 134113) (STRIPLOCAL 134115
+ . 134778)))))
 STOP
diff --git a/lispusers/GITFNS.LCOM b/lispusers/GITFNS.LCOM
index 41362e266..c37122464 100644
Binary files a/lispusers/GITFNS.LCOM and b/lispusers/GITFNS.LCOM differ
diff --git a/lispusers/GITFNS.TEDIT b/lispusers/GITFNS.TEDIT
index 2e1a9c12b..0aa747b42 100644
Binary files a/lispusers/GITFNS.TEDIT and b/lispusers/GITFNS.TEDIT differ
diff --git a/lispusers/HELPSYS b/lispusers/HELPSYS
index f51a86fe8..4ff064d9e 100644
--- a/lispusers/HELPSYS
+++ b/lispusers/HELPSYS
@@ -1,13 +1,12 @@
 (DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
 
-
(FILECREATED "11-Nov-2023 09:31:38" {DSK}<home>larry>il>medley>lispusers>HELPSYS.;2
 87772  
+
(FILECREATED " 5-May-2025 22:04:32" {WMEDLEY}<lispusers>HELPSYS.;15
 87966  
 
-      :EDIT-BY "lmm"
+      :EDIT-BY rmk
 
-      :CHANGES-TO (VARS HELPSYSCOMS)
-                  (FNS CLHS.LOOKUP)
+      :CHANGES-TO (FNS CLHS.INDEX)
 
-      :PREVIOUS-DATE "16-Jun-2023 14:38:33" {DSK}<home>larry>il>medley>lispusers>HELPSYS.;1)
+      :PREVIOUS-DATE " 4-May-2025 13:30:47" {WMEDLEY}<lispusers>HELPSYS.;12)
 
 
 (PRETTYCOMPRINT HELPSYSCOMS)
@@ -230,7 +229,9 @@
 (DEFINEQ
 
 (CLHS.INDEX

-  [LAMBDA (ENTRY)
                                            (* ; "Edited  9-Oct-2022 16:34 by lmm")


+  [LAMBDA (ENTRY)
                                            (* ; "Edited  5-May-2025 22:04 by rmk")


+                                                             (* ; "Edited  4-May-2025 13:30 by rmk")


+                                                             (* ; "Edited  9-Oct-2022 16:34 by lmm")


                                                              (* ; "Edited 16-Aug-2022 09:34 by lmm")


                                                              (* ; "Edited 14-Aug-2022 15:54 by lmm")

     (OR CLHS.INDEX
@@ -240,8 +241,9 @@
                       (PROGN (PRINTOUT PROMPTWINDOW "Fetching Hyperspec Index from web" T)
                              (ShellCommand (CONCAT "cd $MEDLEYDIR && " " mkdir -p tmp/clhs && " 
                                                   "curl --output tmp/clhs/clindex.html -s " 
-                                                  CLHS.ROOT.URL "Front/X_AllSym.htm")))
-                      (MEDLEYDIR "tmp/clhs" "clindex.html")))
+                                                  CLHS.ROOT.URL "Front/X¬AllSym.htm"))
+                             (MEDLEYDIR "tmp/clhs" "clindex.html")))
+                 :EXTERNAL-FORMAT :UTF-8)
           (LET (LINE POSLINK POSFRAG POSENDLINK POSENDTERM POSTERM LINK)
                (while
 (SETQ LINE (CL:READ-LINE STREAM NIL))
                   when
 [AND (SETQ POSLINK (STRPOS "<LI><A REL=DEFINITION HREF=%"../Body/" LINE 1 NIL
@@ -343,992 +345,992 @@
 )
 
 (RPAQQ CLHS.INDEX

-       (("&allow-other-keys" "03_da.htm" "AMallow-other-keys")
-        ("&aux" "03_da.htm" "AMaux")
-        ("&body" "03_dd.htm" "AMbody")
-        ("&environment" "03_dd.htm" "AMenvironment")
-        ("&key" "03_da.htm" "AMkey")
-        ("&optional" "03_da.htm" "AMoptional")
-        ("&rest" "03_da.htm" "AMrest")
-        ("&whole" "03_dd.htm" "AMwhole")
-        ("*" "a_st.htm" "ST")
-        ("**" "v__stst_.htm" "STST")
-        ("***" "v__stst_.htm" "STSTST")
-        ("*break-on-signals*" "v_break_.htm" "STbreak-on-signalsST")
-        ("*compile-file-pathname*" "v_cmp_fi.htm" "STcompile-file-pathnameST")
-        ("*compile-file-truename*" "v_cmp_fi.htm" "STcompile-file-truenameST")
-        ("*compile-print*" "v_cmp_pr.htm" "STcompile-printST")
-        ("*compile-verbose*" "v_cmp_pr.htm" "STcompile-verboseST")
-        ("*debug-io*" "v_debug_.htm" "STdebug-ioST")
-        ("*debugger-hook*" "v_debugg.htm" "STdebugger-hookST")
-        ("*default-pathname-defaults*" "v_defaul.htm" "STdefault-pathname-defaultsST")
-        ("*error-output*" "v_debug_.htm" "STerror-outputST")
-        ("*features*" "v_featur.htm" "STfeaturesST")
-        ("*gensym-counter*" "v_gensym.htm" "STgensym-counterST")
-        ("*load-pathname*" "v_ld_pns.htm" "STload-pathnameST")
-        ("*load-print*" "v_ld_prs.htm" "STload-printST")
-        ("*load-truename*" "v_ld_pns.htm" "STload-truenameST")
-        ("*load-verbose*" "v_ld_prs.htm" "STload-verboseST")
-        ("*macroexpand-hook*" "v_mexp_h.htm" "STmacroexpand-hookST")
-        ("*modules*" "v_module.htm" "STmodulesST")
-        ("*package*" "v_pkg.htm" "STpackageST")
-        ("*print-array*" "v_pr_ar.htm" "STprint-arrayST")
-        ("*print-base*" "v_pr_bas.htm" "STprint-baseST")
-        ("*print-case*" "v_pr_cas.htm" "STprint-caseST")
-        ("*print-circle*" "v_pr_cir.htm" "STprint-circleST")
-        ("*print-escape*" "v_pr_esc.htm" "STprint-escapeST")
-        ("*print-gensym*" "v_pr_gen.htm" "STprint-gensymST")
-        ("*print-length*" "v_pr_lev.htm" "STprint-lengthST")
-        ("*print-level*" "v_pr_lev.htm" "STprint-levelST")
-        ("*print-lines*" "v_pr_lin.htm" "STprint-linesST")
-        ("*print-miser-width*" "v_pr_mis.htm" "STprint-miser-widthST")
-        ("*print-pprint-dispatch*" "v_pr_ppr.htm" "STprint-pprint-dispatchST")
-        ("*print-pretty*" "v_pr_pre.htm" "STprint-prettyST")
-        ("*print-radix*" "v_pr_bas.htm" "STprint-radixST")
-        ("*print-readably*" "v_pr_rda.htm" "STprint-readablyST")
-        ("*print-right-margin*" "v_pr_rig.htm" "STprint-right-marginST")
-        ("*query-io*" "v_debug_.htm" "STquery-ioST")
-        ("*random-state*" "v_rnd_st.htm" "STrandom-stateST")
-        ("*read-base*" "v_rd_bas.htm" "STread-baseST")
-        ("*read-default-float-format*" "v_rd_def.htm" "STread-default-float-formatST")
-        ("*read-eval*" "v_rd_eva.htm" "STread-evalST")
-        ("*read-suppress*" "v_rd_sup.htm" "STread-suppressST")
-        ("*readtable*" "v_rdtabl.htm" "STreadtableST")
-        ("*standard-input*" "v_debug_.htm" "STstandard-inputST")
-        ("*standard-output*" "v_debug_.htm" "STstandard-outputST")
-        ("*terminal-io*" "v_termin.htm" "STterminal-ioST")
-        ("*trace-output*" "v_debug_.htm" "STtrace-outputST")
-        ("+" "a_pl.htm" "PL")
-        ("++" "v_pl_plp.htm" "PLPL")
-        ("+++" "v_pl_plp.htm" "PLPLPL")
-        ("-" "a__.htm" "-")
-        ("/" "a_sl.htm" "SL")
-        ("//" "v_sl_sls.htm" "SLSL")
-        ("///" "v_sl_sls.htm" "SLSLSL")
-        ("/=" "f_eq_sle.htm" "SLEQ")
-        ("1+" "f_1pl_1_.htm" "1PL")
-        ("1-" "f_1pl_1_.htm" "1-")
-        ("&lt;" "f_eq_sle.htm" "LT")
-        ("&lt;=" "f_eq_sle.htm" "LTEQ")
-        ("=" "f_eq_sle.htm" "EQ")
-        ("&gt;" "f_eq_sle.htm" "GT")
-        ("&gt;=" "f_eq_sle.htm" "GTEQ")
-        ("abort" "a_abort.htm" "abort")
-        ("abs" "f_abs.htm" "abs")
-        ("acons" "f_acons.htm" "acons")
-        ("acos" "f_asin_.htm" "acos")
-        ("acosh" "f_sinh_.htm" "acosh")
-        ("add-method" "f_add_me.htm" "add-method")
-        ("adjoin" "f_adjoin.htm" "adjoin")
-        ("adjust-array" "f_adjust.htm" "adjust-array")
-        ("adjustable-array-p" "f_adju_1.htm" "adjustable-array-p")
-        ("allocate-instance" "f_alloca.htm" "allocate-instance")
-        ("alpha-char-p" "f_alpha_.htm" "alpha-char-p")
-        ("alphanumericp" "f_alphan.htm" "alphanumericp")
-        ("and" "a_and.htm" "and")
-        ("append" "f_append.htm" "append")
-        ("apply" "f_apply.htm" "apply")
-        ("apropos" "f_apropo.htm" "apropos")
-        ("apropos-list" "f_apropo.htm" "apropos-list")
-        ("aref" "f_aref.htm" "aref")
-        ("arithmetic-error" "e_arithm.htm" "arithmetic-error")
-        ("arithmetic-error-operands" "f_arithm.htm" "arithmetic-error-operands")
-        ("arithmetic-error-operation" "f_arithm.htm" "arithmetic-error-operation")
-        ("array" "t_array.htm" "array")
-        ("array-dimension" "f_ar_dim.htm" "array-dimension")
-        ("array-dimension-limit" "v_ar_dim.htm" "array-dimension-limit")
-        ("array-dimensions" "f_ar_d_1.htm" "array-dimensions")
-        ("array-displacement" "f_ar_dis.htm" "array-displacement")
-        ("array-element-type" "f_ar_ele.htm" "array-element-type")
-        ("array-has-fill-pointer-p" "f_ar_has.htm" "array-has-fill-pointer-p")
-        ("array-in-bounds-p" "f_ar_in_.htm" "array-in-bounds-p")
-        ("array-rank" "f_ar_ran.htm" "array-rank")
-        ("array-rank-limit" "v_ar_ran.htm" "array-rank-limit")
-        ("array-row-major-index" "f_ar_row.htm" "array-row-major-index")
-        ("array-total-size" "f_ar_tot.htm" "array-total-size")
-        ("array-total-size-limit" "v_ar_tot.htm" "array-total-size-limit")
-        ("arrayp" "f_arrayp.htm" "arrayp")
-        ("ash" "f_ash.htm" "ash")
-        ("asin" "f_asin_.htm" "asin")
-        ("asinh" "f_sinh_.htm" "asinh")
-        ("assert" "m_assert.htm" "assert")
-        ("assoc" "f_assocc.htm" "assoc")
-        ("assoc-if" "f_assocc.htm" "assoc-if")
-        ("assoc-if-not" "f_assocc.htm" "assoc-if-not")
-        ("atan" "f_asin_.htm" "atan")
-        ("atanh" "f_sinh_.htm" "atanh")
-        ("atom" "a_atom.htm" "atom")
-        ("base-char" "t_base_c.htm" "base-char")
-        ("base-string" "t_base_s.htm" "base-string")
-        ("bignum" "t_bignum.htm" "bignum")
-        ("bit" "a_bit.htm" "bit")
-        ("bit-and" "f_bt_and.htm" "bit-and")
-        ("bit-andc1" "f_bt_and.htm" "bit-andc1")
-        ("bit-andc2" "f_bt_and.htm" "bit-andc2")
-        ("bit-eqv" "f_bt_and.htm" "bit-eqv")
-        ("bit-ior" "f_bt_and.htm" "bit-ior")
-        ("bit-nand" "f_bt_and.htm" "bit-nand")
-        ("bit-nor" "f_bt_and.htm" "bit-nor")
-        ("bit-not" "f_bt_and.htm" "bit-not")
-        ("bit-orc1" "f_bt_and.htm" "bit-orc1")
-        ("bit-orc2" "f_bt_and.htm" "bit-orc2")
-        ("bit-vector" "t_bt_vec.htm" "bit-vector")
-        ("bit-vector-p" "f_bt_vec.htm" "bit-vector-p")
-        ("bit-xor" "f_bt_and.htm" "bit-xor")
-        ("block" "s_block.htm" "block")
-        ("boole" "f_boole.htm" "boole")
-        ("boole-1" "v_b_1_b.htm" "boole-1")
-        ("boole-2" "v_b_1_b.htm" "boole-2")
-        ("boole-and" "v_b_1_b.htm" "boole-and")
-        ("boole-andc1" "v_b_1_b.htm" "boole-andc1")
-        ("boole-andc2" "v_b_1_b.htm" "boole-andc2")
-        ("boole-c1" "v_b_1_b.htm" "boole-c1")
-        ("boole-c2" "v_b_1_b.htm" "boole-c2")
-        ("boole-clr" "v_b_1_b.htm" "boole-clr")
-        ("boole-eqv" "v_b_1_b.htm" "boole-eqv")
-        ("boole-ior" "v_b_1_b.htm" "boole-ior")
-        ("boole-nand" "v_b_1_b.htm" "boole-nand")
-        ("boole-nor" "v_b_1_b.htm" "boole-nor")
-        ("boole-orc1" "v_b_1_b.htm" "boole-orc1")
-        ("boole-orc2" "v_b_1_b.htm" "boole-orc2")
-        ("boole-set" "v_b_1_b.htm" "boole-set")
-        ("boole-xor" "v_b_1_b.htm" "boole-xor")
-        ("boolean" "t_ban.htm" "boolean")
-        ("both-case-p" "f_upper_.htm" "both-case-p")
-        ("boundp" "f_boundp.htm" "boundp")
-        ("break" "f_break.htm" "break")
-        ("broadcast-stream" "t_broadc.htm" "broadcast-stream")
-        ("broadcast-stream-streams" "f_broadc.htm" "broadcast-stream-streams")
-        ("built-in-class" "t_built_.htm" "built-in-class")
-        ("butlast" "f_butlas.htm" "butlast")
-        ("byte" "f_by_by.htm" "byte")
-        ("byte-position" "f_by_by.htm" "byte-position")
-        ("byte-size" "f_by_by.htm" "byte-size")
-        ("caaaar" "f_car_c.htm" "caaaar")
-        ("caaadr" "f_car_c.htm" "caaadr")
-        ("caaar" "f_car_c.htm" "caaar")
-        ("caadar" "f_car_c.htm" "caadar")
-        ("caaddr" "f_car_c.htm" "caaddr")
-        ("caadr" "f_car_c.htm" "caadr")
-        ("caar" "f_car_c.htm" "caar")
-        ("cadaar" "f_car_c.htm" "cadaar")
-        ("cadadr" "f_car_c.htm" "cadadr")
-        ("cadar" "f_car_c.htm" "cadar")
-        ("caddar" "f_car_c.htm" "caddar")
-        ("cadddr" "f_car_c.htm" "cadddr")
-        ("caddr" "f_car_c.htm" "caddr")
-        ("cadr" "f_car_c.htm" "cadr")
-        ("call-arguments-limit" "v_call_a.htm" "call-arguments-limit")
-        ("call-method" "m_call_m.htm" "call-method")
-        ("call-next-method" "f_call_n.htm" "call-next-method")
-        ("car" "f_car_c.htm" "car")
-        ("case" "m_case_.htm" "case")
-        ("catch" "s_catch.htm" "catch")
-        ("ccase" "m_case_.htm" "ccase")
-        ("cdaaar" "f_car_c.htm" "cdaaar")
-        ("cdaadr" "f_car_c.htm" "cdaadr")
-        ("cdaar" "f_car_c.htm" "cdaar")
-        ("cdadar" "f_car_c.htm" "cdadar")
-        ("cdaddr" "f_car_c.htm" "cdaddr")
-        ("cdadr" "f_car_c.htm" "cdadr")
-        ("cdar" "f_car_c.htm" "cdar")
-        ("cddaar" "f_car_c.htm" "cddaar")
-        ("cddadr" "f_car_c.htm" "cddadr")
-        ("cddar" "f_car_c.htm" "cddar")
-        ("cdddar" "f_car_c.htm" "cdddar")
-        ("cddddr" "f_car_c.htm" "cddddr")
-        ("cdddr" "f_car_c.htm" "cdddr")
-        ("cddr" "f_car_c.htm" "cddr")
-        ("cdr" "f_car_c.htm" "cdr")
-        ("ceiling" "f_floorc.htm" "ceiling")
-        ("cell-error" "e_cell_e.htm" "cell-error")
-        ("cell-error-name" "f_cell_e.htm" "cell-error-name")
-        ("cerror" "f_cerror.htm" "cerror")
-        ("change-class" "f_chg_cl.htm" "change-class")
-        ("char" "f_char_.htm" "char")
-        ("char-code" "f_char_c.htm" "char-code")
-        ("char-code-limit" "v_char_c.htm" "char-code-limit")
-        ("char-downcase" "f_char_u.htm" "char-downcase")
-        ("char-equal" "f_chareq.htm" "char-equal")
-        ("char-greaterp" "f_chareq.htm" "char-greaterp")
-        ("char-int" "f_char_i.htm" "char-int")
-        ("char-lessp" "f_chareq.htm" "char-lessp")
-        ("char-name" "f_char_n.htm" "char-name")
-        ("char-not-equal" "f_chareq.htm" "char-not-equal")
-        ("char-not-greaterp" "f_chareq.htm" "char-not-greaterp")
-        ("char-not-lessp" "f_chareq.htm" "char-not-lessp")
-        ("char-upcase" "f_char_u.htm" "char-upcase")
-        ("char/=" "f_chareq.htm" "charSLEQ")
-        ("char&lt;" "f_chareq.htm" "charLT")
-        ("char&lt;=" "f_chareq.htm" "charLTEQ")
-        ("char=" "f_chareq.htm" "charEQ")
-        ("char&gt;" "f_chareq.htm" "charGT")
-        ("char&gt;=" "f_chareq.htm" "charGTEQ")
-        ("character" "a_ch.htm" "character")
-        ("characterp" "f_chp.htm" "characterp")
-        ("check-type" "m_check_.htm" "check-type")
-        ("cis" "f_cis.htm" "cis")
-        ("class" "t_class.htm" "class")
-        ("class-name" "f_class_.htm" "class-name")
-        ("class-of" "f_clas_1.htm" "class-of")
-        ("clear-input" "f_clear_.htm" "clear-input")
-        ("clear-output" "f_finish.htm" "clear-output")
-        ("close" "f_close.htm" "close")
-        ("clrhash" "f_clrhas.htm" "clrhash")
-        ("code-char" "f_code_c.htm" "code-char")
-        ("coerce" "f_coerce.htm" "coerce")
-        ("compilation-speed" "d_optimi.htm" "compilation-speed")
-        ("compile" "f_cmp.htm" "compile")
-        ("compile-file" "f_cmp_fi.htm" "compile-file")
-        ("compile-file-pathname" "f_cmp__1.htm" "compile-file-pathname")
-        ("compiled-function" "t_cmpd_f.htm" "compiled-function")
-        ("compiled-function-p" "f_cmpd_f.htm" "compiled-function-p")
-        ("compiler-macro" "f_docume.htm" "compiler-macro")
-        ("compiler-macro-function" "f_cmp_ma.htm" "compiler-macro-function")
-        ("complement" "f_comple.htm" "complement")
-        ("complex" "a_comple.htm" "complex")
-        ("complexp" "f_comp_3.htm" "complexp")
-        ("compute-applicable-methods" "f_comput.htm" "compute-applicable-methods")
-        ("compute-restarts" "f_comp_1.htm" "compute-restarts")
-        ("concatenate" "f_concat.htm" "concatenate")
-        ("concatenated-stream" "t_concat.htm" "concatenated-stream")
-        ("concatenated-stream-streams" "f_conc_1.htm" "concatenated-stream-streams")
-        ("cond" "m_cond.htm" "cond")
-        ("condition" "e_cnd.htm" "condition")
-        ("conjugate" "f_conjug.htm" "conjugate")
-        ("cons" "a_cons.htm" "cons")
-        ("consp" "f_consp.htm" "consp")
-        ("constantly" "f_cons_1.htm" "constantly")
-        ("constantp" "f_consta.htm" "constantp")
-        ("continue" "a_contin.htm" "continue")
-        ("control-error" "e_contro.htm" "control-error")
-        ("copy-alist" "f_cp_ali.htm" "copy-alist")
-        ("copy-list" "f_cp_lis.htm" "copy-list")
-        ("copy-pprint-dispatch" "f_cp_ppr.htm" "copy-pprint-dispatch")
-        ("copy-readtable" "f_cp_rdt.htm" "copy-readtable")
-        ("copy-seq" "f_cp_seq.htm" "copy-seq")
-        ("copy-structure" "f_cp_stu.htm" "copy-structure")
-        ("copy-symbol" "f_cp_sym.htm" "copy-symbol")
-        ("copy-tree" "f_cp_tre.htm" "copy-tree")
-        ("cos" "f_sin_c.htm" "cos")
-        ("cosh" "f_sinh_.htm" "cosh")
-        ("count" "f_countc.htm" "count")
-        ("count-if" "f_countc.htm" "count-if")
-        ("count-if-not" "f_countc.htm" "count-if-not")
-        ("ctypecase" "m_tpcase.htm" "ctypecase")
-        ("debug" "d_optimi.htm" "debug")
-        ("decf" "m_incf_.htm" "decf")
-        ("declaim" "m_declai.htm" "declaim")
-        ("declaration" "d_declar.htm" "declaration")
-        ("declare" "s_declar.htm" "declare")
-        ("decode-float" "f_dec_fl.htm" "decode-float")
-        ("decode-universal-time" "f_dec_un.htm" "decode-universal-time")
-        ("defclass" "m_defcla.htm" "defclass")
-        ("defconstant" "m_defcon.htm" "defconstant")
-        ("defgeneric" "m_defgen.htm" "defgeneric")
-        ("define-compiler-macro" "m_define.htm" "define-compiler-macro")
-        ("define-condition" "m_defi_5.htm" "define-condition")
-        ("define-method-combination" "m_defi_4.htm" "define-method-combination")
-        ("define-modify-macro" "m_defi_2.htm" "define-modify-macro")
-        ("define-setf-expander" "m_defi_3.htm" "define-setf-expander")
-        ("define-symbol-macro" "m_defi_1.htm" "define-symbol-macro")
-        ("defmacro" "m_defmac.htm" "defmacro")
-        ("defmethod" "m_defmet.htm" "defmethod")
-        ("defpackage" "m_defpkg.htm" "defpackage")
-        ("defparameter" "m_defpar.htm" "defparameter")
-        ("defsetf" "m_defset.htm" "defsetf")
-        ("defstruct" "m_defstr.htm" "defstruct")
-        ("deftype" "m_deftp.htm" "deftype")
-        ("defun" "m_defun.htm" "defun")
-        ("defvar" "m_defpar.htm" "defvar")
-        ("delete" "f_rm_rm.htm" "delete")
-        ("delete-duplicates" "f_rm_dup.htm" "delete-duplicates")
-        ("delete-file" "f_del_fi.htm" "delete-file")
-        ("delete-if" "f_rm_rm.htm" "delete-if")
-        ("delete-if-not" "f_rm_rm.htm" "delete-if-not")
-        ("delete-package" "f_del_pk.htm" "delete-package")
-        ("denominator" "f_numera.htm" "denominator")
-        ("deposit-field" "f_deposi.htm" "deposit-field")
-        ("describe" "f_descri.htm" "describe")
-        ("describe-object" "f_desc_1.htm" "describe-object")
-        ("destructuring-bind" "m_destru.htm" "destructuring-bind")
-        ("digit-char" "f_digit_.htm" "digit-char")
-        ("digit-char-p" "f_digi_1.htm" "digit-char-p")
-        ("directory" "f_dir.htm" "directory")
-        ("directory-namestring" "f_namest.htm" "directory-namestring")
-        ("disassemble" "f_disass.htm" "disassemble")
-        ("division-by-zero" "e_divisi.htm" "division-by-zero")
-        ("do" "m_do_do.htm" "do")
-        ("do*" "m_do_do.htm" "doST")
-        ("do-all-symbols" "m_do_sym.htm" "do-all-symbols")
-        ("do-external-symbols" "m_do_sym.htm" "do-external-symbols")
-        ("do-symbols" "m_do_sym.htm" "do-symbols")
-        ("documentation" "f_docume.htm" "documentation")
-        ("dolist" "m_dolist.htm" "dolist")
-        ("dotimes" "m_dotime.htm" "dotimes")
-        ("double-float" "t_short_.htm" "double-float")
-        ("double-float-epsilon" "v_short_.htm" "double-float-epsilon")
-        ("double-float-negative-epsilon" "v_short_.htm" "double-float-negative-epsilon")
-        ("dpb" "f_dpb.htm" "dpb")
-        ("dribble" "f_dribbl.htm" "dribble")
-        ("dynamic-extent" "d_dynami.htm" "dynamic-extent")
-        ("ecase" "m_case_.htm" "ecase")
-        ("echo-stream" "t_echo_s.htm" "echo-stream")
-        ("echo-stream-input-stream" "f_echo_s.htm" "echo-stream-input-stream")
-        ("echo-stream-output-stream" "f_echo_s.htm" "echo-stream-output-stream")
-        ("ed" "f_ed.htm" "ed")
-        ("eighth" "f_firstc.htm" "eighth")
-        ("elt" "f_elt.htm" "elt")
-        ("encode-universal-time" "f_encode.htm" "encode-universal-time")
-        ("end-of-file" "e_end_of.htm" "end-of-file")
-        ("endp" "f_endp.htm" "endp")
-        ("enough-namestring" "f_namest.htm" "enough-namestring")
-        ("ensure-directories-exist" "f_ensu_1.htm" "ensure-directories-exist")
-        ("ensure-generic-function" "f_ensure.htm" "ensure-generic-function")
-        ("eq" "f_eq.htm" "eq")
-        ("eql" "a_eql.htm" "eql")
-        ("equal" "f_equal.htm" "equal")
-        ("equalp" "f_equalp.htm" "equalp")
-        ("error" "a_error.htm" "error")
-        ("etypecase" "m_tpcase.htm" "etypecase")
-        ("eval" "f_eval.htm" "eval")
-        ("eval-when" "s_eval_w.htm" "eval-when")
-        ("evenp" "f_evenpc.htm" "evenp")
-        ("every" "f_everyc.htm" "every")
-        ("exp" "f_exp_e.htm" "exp")
-        ("export" "f_export.htm" "export")
-        ("expt" "f_exp_e.htm" "expt")
-        ("extended-char" "t_extend.htm" "extended-char")
-        ("fboundp" "f_fbound.htm" "fboundp")
-        ("fceiling" "f_floorc.htm" "fceiling")
-        ("fdefinition" "f_fdefin.htm" "fdefinition")
-        ("ffloor" "f_floorc.htm" "ffloor")
-        ("fifth" "f_firstc.htm" "fifth")
-        ("file-author" "f_file_a.htm" "file-author")
-        ("file-error" "e_file_e.htm" "file-error")
-        ("file-error-pathname" "f_file_e.htm" "file-error-pathname")
-        ("file-length" "f_file_l.htm" "file-length")
-        ("file-namestring" "f_namest.htm" "file-namestring")
-        ("file-position" "f_file_p.htm" "file-position")
-        ("file-stream" "t_file_s.htm" "file-stream")
-        ("file-string-length" "f_file_s.htm" "file-string-length")
-        ("file-write-date" "f_file_w.htm" "file-write-date")
-        ("fill" "f_fill.htm" "fill")
-        ("fill-pointer" "f_fill_p.htm" "fill-pointer")
-        ("find" "f_find_.htm" "find")
-        ("find-all-symbols" "f_find_a.htm" "find-all-symbols")
-        ("find-class" "f_find_c.htm" "find-class")
-        ("find-if" "f_find_.htm" "find-if")
-        ("find-if-not" "f_find_.htm" "find-if-not")
-        ("find-method" "f_find_m.htm" "find-method")
-        ("find-package" "f_find_p.htm" "find-package")
-        ("find-restart" "f_find_r.htm" "find-restart")
-        ("find-symbol" "f_find_s.htm" "find-symbol")
-        ("finish-output" "f_finish.htm" "finish-output")
-        ("first" "f_firstc.htm" "first")
-        ("fixnum" "t_fixnum.htm" "fixnum")
-        ("flet" "s_flet_.htm" "flet")
-        ("float" "a_float.htm" "float")
-        ("float-digits" "f_dec_fl.htm" "float-digits")
-        ("float-precision" "f_dec_fl.htm" "float-precision")
-        ("float-radix" "f_dec_fl.htm" "float-radix")
-        ("float-sign" "f_dec_fl.htm" "float-sign")
-        ("floating-point-inexact" "e_floa_1.htm" "floating-point-inexact")
-        ("floating-point-invalid-operation" "e_floati.htm" "floating-point-invalid-operation")
-        ("floating-point-overflow" "e_floa_2.htm" "floating-point-overflow")
-        ("floating-point-underflow" "e_floa_3.htm" "floating-point-underflow")
-        ("floatp" "f_floatp.htm" "floatp")
-        ("floor" "f_floorc.htm" "floor")
-        ("fmakunbound" "f_fmakun.htm" "fmakunbound")
-        ("force-output" "f_finish.htm" "force-output")
-        ("format" "f_format.htm" "format")
-        ("formatter" "m_format.htm" "formatter")
-        ("fourth" "f_firstc.htm" "fourth")
-        ("fresh-line" "f_terpri.htm" "fresh-line")
-        ("fround" "f_floorc.htm" "fround")
-        ("ftruncate" "f_floorc.htm" "ftruncate")
-        ("ftype" "d_ftype.htm" "ftype")
-        ("funcall" "f_funcal.htm" "funcall")
-        ("function" "a_fn.htm" "function")
-        ("function-keywords" "f_fn_kwd.htm" "function-keywords")
-        ("function-lambda-expression" "f_fn_lam.htm" "function-lambda-expression")
-        ("functionp" "f_fnp.htm" "functionp")
-        ("gcd" "f_gcd.htm" "gcd")
-        ("generic-function" "t_generi.htm" "generic-function")
-        ("gensym" "f_gensym.htm" "gensym")
-        ("gentemp" "f_gentem.htm" "gentemp")
-        ("get" "f_get.htm" "get")
-        ("get-decoded-time" "f_get_un.htm" "get-decoded-time")
-        ("get-dispatch-macro-character" "f_set__1.htm" "get-dispatch-macro-character")
-        ("get-internal-real-time" "f_get_in.htm" "get-internal-real-time")
-        ("get-internal-run-time" "f_get__1.htm" "get-internal-run-time")
-        ("get-macro-character" "f_set_ma.htm" "get-macro-character")
-        ("get-output-stream-string" "f_get_ou.htm" "get-output-stream-string")
-        ("get-properties" "f_get_pr.htm" "get-properties")
-        ("get-setf-expansion" "f_get_se.htm" "get-setf-expansion")
-        ("get-universal-time" "f_get_un.htm" "get-universal-time")
-        ("getf" "f_getf.htm" "getf")
-        ("gethash" "f_gethas.htm" "gethash")
-        ("go" "s_go.htm" "go")
-        ("graphic-char-p" "f_graphi.htm" "graphic-char-p")
-        ("handler-bind" "m_handle.htm" "handler-bind")
-        ("handler-case" "m_hand_1.htm" "handler-case")
-        ("hash-table" "t_hash_t.htm" "hash-table")
-        ("hash-table-count" "f_hash_1.htm" "hash-table-count")
-        ("hash-table-p" "f_hash_t.htm" "hash-table-p")
-        ("hash-table-rehash-size" "f_hash_2.htm" "hash-table-rehash-size")
-        ("hash-table-rehash-threshold" "f_hash_3.htm" "hash-table-rehash-threshold")
-        ("hash-table-size" "f_hash_4.htm" "hash-table-size")
-        ("hash-table-test" "f_hash_5.htm" "hash-table-test")
-        ("host-namestring" "f_namest.htm" "host-namestring")
-        ("identity" "f_identi.htm" "identity")
-        ("if" "s_if.htm" "if")
-        ("ignorable" "d_ignore.htm" "ignorable")
-        ("ignore" "d_ignore.htm" "ignore")
-        ("ignore-errors" "m_ignore.htm" "ignore-errors")
-        ("imagpart" "f_realpa.htm" "imagpart")
-        ("import" "f_import.htm" "import")
-        ("in-package" "m_in_pkg.htm" "in-package")
-        ("incf" "m_incf_.htm" "incf")
-        ("initialize-instance" "f_init_i.htm" "initialize-instance")
-        ("inline" "d_inline.htm" "inline")
-        ("input-stream-p" "f_in_stm.htm" "input-stream-p")
-        ("inspect" "f_inspec.htm" "inspect")
-        ("integer" "t_intege.htm" "integer")
-        ("integer-decode-float" "f_dec_fl.htm" "integer-decode-float")
-        ("integer-length" "f_intege.htm" "integer-length")
-        ("integerp" "f_inte_1.htm" "integerp")
-        ("interactive-stream-p" "f_intera.htm" "interactive-stream-p")
-        ("intern" "f_intern.htm" "intern")
-        ("internal-time-units-per-second" "v_intern.htm" "internal-time-units-per-second")
-        ("intersection" "f_isec_.htm" "intersection")
-        ("invalid-method-error" "f_invali.htm" "invalid-method-error")
-        ("invoke-debugger" "f_invoke.htm" "invoke-debugger")
-        ("invoke-restart" "f_invo_1.htm" "invoke-restart")
-        ("invoke-restart-interactively" "f_invo_2.htm" "invoke-restart-interactively")
-        ("isqrt" "f_sqrt_.htm" "isqrt")
-        ("keyword" "t_kwd.htm" "keyword")
-        ("keywordp" "f_kwdp.htm" "keywordp")
-        ("labels" "s_flet_.htm" "labels")
-        ("lambda" "a_lambda.htm" "lambda")
-        ("lambda-list-keywords" "v_lambda.htm" "lambda-list-keywords")
-        ("lambda-parameters-limit" "v_lamb_1.htm" "lambda-parameters-limit")
-        ("last" "f_last.htm" "last")
-        ("lcm" "f_lcm.htm" "lcm")
-        ("ldb" "f_ldb.htm" "ldb")
-        ("ldb-test" "f_ldb_te.htm" "ldb-test")
-        ("ldiff" "f_ldiffc.htm" "ldiff")
-        ("least-negative-double-float" "v_most_1.htm" "least-negative-double-float")
-        ("least-negative-long-float" "v_most_1.htm" "least-negative-long-float")
-        ("least-negative-normalized-double-float" "v_most_1.htm" 
+       (("&allow-other-keys" "03¬da.htm" "AMallow-other-keys")
+        ("&aux" "03¬da.htm" "AMaux")
+        ("&body" "03¬dd.htm" "AMbody")
+        ("&environment" "03¬dd.htm" "AMenvironment")
+        ("&key" "03¬da.htm" "AMkey")
+        ("&optional" "03¬da.htm" "AMoptional")
+        ("&rest" "03¬da.htm" "AMrest")
+        ("&whole" "03¬dd.htm" "AMwhole")
+        ("*" "a¬st.htm" "ST")
+        ("**" "v¬¬stst¬.htm" "STST")
+        ("***" "v¬¬stst¬.htm" "STSTST")
+        ("*break-on-signals*" "v¬break¬.htm" "STbreak-on-signalsST")
+        ("*compile-file-pathname*" "v¬cmp¬fi.htm" "STcompile-file-pathnameST")
+        ("*compile-file-truename*" "v¬cmp¬fi.htm" "STcompile-file-truenameST")
+        ("*compile-print*" "v¬cmp¬pr.htm" "STcompile-printST")
+        ("*compile-verbose*" "v¬cmp¬pr.htm" "STcompile-verboseST")
+        ("*debug-io*" "v¬debug¬.htm" "STdebug-ioST")
+        ("*debugger-hook*" "v¬debugg.htm" "STdebugger-hookST")
+        ("*default-pathname-defaults*" "v¬defaul.htm" "STdefault-pathname-defaultsST")
+        ("*error-output*" "v¬debug¬.htm" "STerror-outputST")
+        ("*features*" "v¬featur.htm" "STfeaturesST")
+        ("*gensym-counter*" "v¬gensym.htm" "STgensym-counterST")
+        ("*load-pathname*" "v¬ld¬pns.htm" "STload-pathnameST")
+        ("*load-print*" "v¬ld¬prs.htm" "STload-printST")
+        ("*load-truename*" "v¬ld¬pns.htm" "STload-truenameST")
+        ("*load-verbose*" "v¬ld¬prs.htm" "STload-verboseST")
+        ("*macroexpand-hook*" "v¬mexp¬h.htm" "STmacroexpand-hookST")
+        ("*modules*" "v¬module.htm" "STmodulesST")
+        ("*package*" "v¬pkg.htm" "STpackageST")
+        ("*print-array*" "v¬pr¬ar.htm" "STprint-arrayST")
+        ("*print-base*" "v¬pr¬bas.htm" "STprint-baseST")
+        ("*print-case*" "v¬pr¬cas.htm" "STprint-caseST")
+        ("*print-circle*" "v¬pr¬cir.htm" "STprint-circleST")
+        ("*print-escape*" "v¬pr¬esc.htm" "STprint-escapeST")
+        ("*print-gensym*" "v¬pr¬gen.htm" "STprint-gensymST")
+        ("*print-length*" "v¬pr¬lev.htm" "STprint-lengthST")
+        ("*print-level*" "v¬pr¬lev.htm" "STprint-levelST")
+        ("*print-lines*" "v¬pr¬lin.htm" "STprint-linesST")
+        ("*print-miser-width*" "v¬pr¬mis.htm" "STprint-miser-widthST")
+        ("*print-pprint-dispatch*" "v¬pr¬ppr.htm" "STprint-pprint-dispatchST")
+        ("*print-pretty*" "v¬pr¬pre.htm" "STprint-prettyST")
+        ("*print-radix*" "v¬pr¬bas.htm" "STprint-radixST")
+        ("*print-readably*" "v¬pr¬rda.htm" "STprint-readablyST")
+        ("*print-right-margin*" "v¬pr¬rig.htm" "STprint-right-marginST")
+        ("*query-io*" "v¬debug¬.htm" "STquery-ioST")
+        ("*random-state*" "v¬rnd¬st.htm" "STrandom-stateST")
+        ("*read-base*" "v¬rd¬bas.htm" "STread-baseST")
+        ("*read-default-float-format*" "v¬rd¬def.htm" "STread-default-float-formatST")
+        ("*read-eval*" "v¬rd¬eva.htm" "STread-evalST")
+        ("*read-suppress*" "v¬rd¬sup.htm" "STread-suppressST")
+        ("*readtable*" "v¬rdtabl.htm" "STreadtableST")
+        ("*standard-input*" "v¬debug¬.htm" "STstandard-inputST")
+        ("*standard-output*" "v¬debug¬.htm" "STstandard-outputST")
+        ("*terminal-io*" "v¬termin.htm" "STterminal-ioST")
+        ("*trace-output*" "v¬debug¬.htm" "STtrace-outputST")
+        ("+" "a¬pl.htm" "PL")
+        ("++" "v¬pl¬plp.htm" "PLPL")
+        ("+++" "v¬pl¬plp.htm" "PLPLPL")
+        ("-" "a¬¬.htm" "-")
+        ("/" "a¬sl.htm" "SL")
+        ("//" "v¬sl¬sls.htm" "SLSL")
+        ("///" "v¬sl¬sls.htm" "SLSLSL")
+        ("/=" "f¬eq¬sle.htm" "SLEQ")
+        ("1+" "f¬1pl¬1¬.htm" "1PL")
+        ("1-" "f¬1pl¬1¬.htm" "1-")
+        ("&lt;" "f¬eq¬sle.htm" "LT")
+        ("&lt;=" "f¬eq¬sle.htm" "LTEQ")
+        ("=" "f¬eq¬sle.htm" "EQ")
+        ("&gt;" "f¬eq¬sle.htm" "GT")
+        ("&gt;=" "f¬eq¬sle.htm" "GTEQ")
+        ("abort" "a¬abort.htm" "abort")
+        ("abs" "f¬abs.htm" "abs")
+        ("acons" "f¬acons.htm" "acons")
+        ("acos" "f¬asin¬.htm" "acos")
+        ("acosh" "f¬sinh¬.htm" "acosh")
+        ("add-method" "f¬add¬me.htm" "add-method")
+        ("adjoin" "f¬adjoin.htm" "adjoin")
+        ("adjust-array" "f¬adjust.htm" "adjust-array")
+        ("adjustable-array-p" "f¬adju¬1.htm" "adjustable-array-p")
+        ("allocate-instance" "f¬alloca.htm" "allocate-instance")
+        ("alpha-char-p" "f¬alpha¬.htm" "alpha-char-p")
+        ("alphanumericp" "f¬alphan.htm" "alphanumericp")
+        ("and" "a¬and.htm" "and")
+        ("append" "f¬append.htm" "append")
+        ("apply" "f¬apply.htm" "apply")
+        ("apropos" "f¬apropo.htm" "apropos")
+        ("apropos-list" "f¬apropo.htm" "apropos-list")
+        ("aref" "f¬aref.htm" "aref")
+        ("arithmetic-error" "e¬arithm.htm" "arithmetic-error")
+        ("arithmetic-error-operands" "f¬arithm.htm" "arithmetic-error-operands")
+        ("arithmetic-error-operation" "f¬arithm.htm" "arithmetic-error-operation")
+        ("array" "t¬array.htm" "array")
+        ("array-dimension" "f¬ar¬dim.htm" "array-dimension")
+        ("array-dimension-limit" "v¬ar¬dim.htm" "array-dimension-limit")
+        ("array-dimensions" "f¬ar¬d¬1.htm" "array-dimensions")
+        ("array-displacement" "f¬ar¬dis.htm" "array-displacement")
+        ("array-element-type" "f¬ar¬ele.htm" "array-element-type")
+        ("array-has-fill-pointer-p" "f¬ar¬has.htm" "array-has-fill-pointer-p")
+        ("array-in-bounds-p" "f¬ar¬in¬.htm" "array-in-bounds-p")
+        ("array-rank" "f¬ar¬ran.htm" "array-rank")
+        ("array-rank-limit" "v¬ar¬ran.htm" "array-rank-limit")
+        ("array-row-major-index" "f¬ar¬row.htm" "array-row-major-index")
+        ("array-total-size" "f¬ar¬tot.htm" "array-total-size")
+        ("array-total-size-limit" "v¬ar¬tot.htm" "array-total-size-limit")
+        ("arrayp" "f¬arrayp.htm" "arrayp")
+        ("ash" "f¬ash.htm" "ash")
+        ("asin" "f¬asin¬.htm" "asin")
+        ("asinh" "f¬sinh¬.htm" "asinh")
+        ("assert" "m¬assert.htm" "assert")
+        ("assoc" "f¬assocc.htm" "assoc")
+        ("assoc-if" "f¬assocc.htm" "assoc-if")
+        ("assoc-if-not" "f¬assocc.htm" "assoc-if-not")
+        ("atan" "f¬asin¬.htm" "atan")
+        ("atanh" "f¬sinh¬.htm" "atanh")
+        ("atom" "a¬atom.htm" "atom")
+        ("base-char" "t¬base¬c.htm" "base-char")
+        ("base-string" "t¬base¬s.htm" "base-string")
+        ("bignum" "t¬bignum.htm" "bignum")
+        ("bit" "a¬bit.htm" "bit")
+        ("bit-and" "f¬bt¬and.htm" "bit-and")
+        ("bit-andc1" "f¬bt¬and.htm" "bit-andc1")
+        ("bit-andc2" "f¬bt¬and.htm" "bit-andc2")
+        ("bit-eqv" "f¬bt¬and.htm" "bit-eqv")
+        ("bit-ior" "f¬bt¬and.htm" "bit-ior")
+        ("bit-nand" "f¬bt¬and.htm" "bit-nand")
+        ("bit-nor" "f¬bt¬and.htm" "bit-nor")
+        ("bit-not" "f¬bt¬and.htm" "bit-not")
+        ("bit-orc1" "f¬bt¬and.htm" "bit-orc1")
+        ("bit-orc2" "f¬bt¬and.htm" "bit-orc2")
+        ("bit-vector" "t¬bt¬vec.htm" "bit-vector")
+        ("bit-vector-p" "f¬bt¬vec.htm" "bit-vector-p")
+        ("bit-xor" "f¬bt¬and.htm" "bit-xor")
+        ("block" "s¬block.htm" "block")
+        ("boole" "f¬boole.htm" "boole")
+        ("boole-1" "v¬b¬1¬b.htm" "boole-1")
+        ("boole-2" "v¬b¬1¬b.htm" "boole-2")
+        ("boole-and" "v¬b¬1¬b.htm" "boole-and")
+        ("boole-andc1" "v¬b¬1¬b.htm" "boole-andc1")
+        ("boole-andc2" "v¬b¬1¬b.htm" "boole-andc2")
+        ("boole-c1" "v¬b¬1¬b.htm" "boole-c1")
+        ("boole-c2" "v¬b¬1¬b.htm" "boole-c2")
+        ("boole-clr" "v¬b¬1¬b.htm" "boole-clr")
+        ("boole-eqv" "v¬b¬1¬b.htm" "boole-eqv")
+        ("boole-ior" "v¬b¬1¬b.htm" "boole-ior")
+        ("boole-nand" "v¬b¬1¬b.htm" "boole-nand")
+        ("boole-nor" "v¬b¬1¬b.htm" "boole-nor")
+        ("boole-orc1" "v¬b¬1¬b.htm" "boole-orc1")
+        ("boole-orc2" "v¬b¬1¬b.htm" "boole-orc2")
+        ("boole-set" "v¬b¬1¬b.htm" "boole-set")
+        ("boole-xor" "v¬b¬1¬b.htm" "boole-xor")
+        ("boolean" "t¬ban.htm" "boolean")
+        ("both-case-p" "f¬upper¬.htm" "both-case-p")
+        ("boundp" "f¬boundp.htm" "boundp")
+        ("break" "f¬break.htm" "break")
+        ("broadcast-stream" "t¬broadc.htm" "broadcast-stream")
+        ("broadcast-stream-streams" "f¬broadc.htm" "broadcast-stream-streams")
+        ("built-in-class" "t¬built¬.htm" "built-in-class")
+        ("butlast" "f¬butlas.htm" "butlast")
+        ("byte" "f¬by¬by.htm" "byte")
+        ("byte-position" "f¬by¬by.htm" "byte-position")
+        ("byte-size" "f¬by¬by.htm" "byte-size")
+        ("caaaar" "f¬car¬c.htm" "caaaar")
+        ("caaadr" "f¬car¬c.htm" "caaadr")
+        ("caaar" "f¬car¬c.htm" "caaar")
+        ("caadar" "f¬car¬c.htm" "caadar")
+        ("caaddr" "f¬car¬c.htm" "caaddr")
+        ("caadr" "f¬car¬c.htm" "caadr")
+        ("caar" "f¬car¬c.htm" "caar")
+        ("cadaar" "f¬car¬c.htm" "cadaar")
+        ("cadadr" "f¬car¬c.htm" "cadadr")
+        ("cadar" "f¬car¬c.htm" "cadar")
+        ("caddar" "f¬car¬c.htm" "caddar")
+        ("cadddr" "f¬car¬c.htm" "cadddr")
+        ("caddr" "f¬car¬c.htm" "caddr")
+        ("cadr" "f¬car¬c.htm" "cadr")
+        ("call-arguments-limit" "v¬call¬a.htm" "call-arguments-limit")
+        ("call-method" "m¬call¬m.htm" "call-method")
+        ("call-next-method" "f¬call¬n.htm" "call-next-method")
+        ("car" "f¬car¬c.htm" "car")
+        ("case" "m¬case¬.htm" "case")
+        ("catch" "s¬catch.htm" "catch")
+        ("ccase" "m¬case¬.htm" "ccase")
+        ("cdaaar" "f¬car¬c.htm" "cdaaar")
+        ("cdaadr" "f¬car¬c.htm" "cdaadr")
+        ("cdaar" "f¬car¬c.htm" "cdaar")
+        ("cdadar" "f¬car¬c.htm" "cdadar")
+        ("cdaddr" "f¬car¬c.htm" "cdaddr")
+        ("cdadr" "f¬car¬c.htm" "cdadr")
+        ("cdar" "f¬car¬c.htm" "cdar")
+        ("cddaar" "f¬car¬c.htm" "cddaar")
+        ("cddadr" "f¬car¬c.htm" "cddadr")
+        ("cddar" "f¬car¬c.htm" "cddar")
+        ("cdddar" "f¬car¬c.htm" "cdddar")
+        ("cddddr" "f¬car¬c.htm" "cddddr")
+        ("cdddr" "f¬car¬c.htm" "cdddr")
+        ("cddr" "f¬car¬c.htm" "cddr")
+        ("cdr" "f¬car¬c.htm" "cdr")
+        ("ceiling" "f¬floorc.htm" "ceiling")
+        ("cell-error" "e¬cell¬e.htm" "cell-error")
+        ("cell-error-name" "f¬cell¬e.htm" "cell-error-name")
+        ("cerror" "f¬cerror.htm" "cerror")
+        ("change-class" "f¬chg¬cl.htm" "change-class")
+        ("char" "f¬char¬.htm" "char")
+        ("char-code" "f¬char¬c.htm" "char-code")
+        ("char-code-limit" "v¬char¬c.htm" "char-code-limit")
+        ("char-downcase" "f¬char¬u.htm" "char-downcase")
+        ("char-equal" "f¬chareq.htm" "char-equal")
+        ("char-greaterp" "f¬chareq.htm" "char-greaterp")
+        ("char-int" "f¬char¬i.htm" "char-int")
+        ("char-lessp" "f¬chareq.htm" "char-lessp")
+        ("char-name" "f¬char¬n.htm" "char-name")
+        ("char-not-equal" "f¬chareq.htm" "char-not-equal")
+        ("char-not-greaterp" "f¬chareq.htm" "char-not-greaterp")
+        ("char-not-lessp" "f¬chareq.htm" "char-not-lessp")
+        ("char-upcase" "f¬char¬u.htm" "char-upcase")
+        ("char/=" "f¬chareq.htm" "charSLEQ")
+        ("char&lt;" "f¬chareq.htm" "charLT")
+        ("char&lt;=" "f¬chareq.htm" "charLTEQ")
+        ("char=" "f¬chareq.htm" "charEQ")
+        ("char&gt;" "f¬chareq.htm" "charGT")
+        ("char&gt;=" "f¬chareq.htm" "charGTEQ")
+        ("character" "a¬ch.htm" "character")
+        ("characterp" "f¬chp.htm" "characterp")
+        ("check-type" "m¬check¬.htm" "check-type")
+        ("cis" "f¬cis.htm" "cis")
+        ("class" "t¬class.htm" "class")
+        ("class-name" "f¬class¬.htm" "class-name")
+        ("class-of" "f¬clas¬1.htm" "class-of")
+        ("clear-input" "f¬clear¬.htm" "clear-input")
+        ("clear-output" "f¬finish.htm" "clear-output")
+        ("close" "f¬close.htm" "close")
+        ("clrhash" "f¬clrhas.htm" "clrhash")
+        ("code-char" "f¬code¬c.htm" "code-char")
+        ("coerce" "f¬coerce.htm" "coerce")
+        ("compilation-speed" "d¬optimi.htm" "compilation-speed")
+        ("compile" "f¬cmp.htm" "compile")
+        ("compile-file" "f¬cmp¬fi.htm" "compile-file")
+        ("compile-file-pathname" "f¬cmp¬¬1.htm" "compile-file-pathname")
+        ("compiled-function" "t¬cmpd¬f.htm" "compiled-function")
+        ("compiled-function-p" "f¬cmpd¬f.htm" "compiled-function-p")
+        ("compiler-macro" "f¬docume.htm" "compiler-macro")
+        ("compiler-macro-function" "f¬cmp¬ma.htm" "compiler-macro-function")
+        ("complement" "f¬comple.htm" "complement")
+        ("complex" "a¬comple.htm" "complex")
+        ("complexp" "f¬comp¬3.htm" "complexp")
+        ("compute-applicable-methods" "f¬comput.htm" "compute-applicable-methods")
+        ("compute-restarts" "f¬comp¬1.htm" "compute-restarts")
+        ("concatenate" "f¬concat.htm" "concatenate")
+        ("concatenated-stream" "t¬concat.htm" "concatenated-stream")
+        ("concatenated-stream-streams" "f¬conc¬1.htm" "concatenated-stream-streams")
+        ("cond" "m¬cond.htm" "cond")
+        ("condition" "e¬cnd.htm" "condition")
+        ("conjugate" "f¬conjug.htm" "conjugate")
+        ("cons" "a¬cons.htm" "cons")
+        ("consp" "f¬consp.htm" "consp")
+        ("constantly" "f¬cons¬1.htm" "constantly")
+        ("constantp" "f¬consta.htm" "constantp")
+        ("continue" "a¬contin.htm" "continue")
+        ("control-error" "e¬contro.htm" "control-error")
+        ("copy-alist" "f¬cp¬ali.htm" "copy-alist")
+        ("copy-list" "f¬cp¬lis.htm" "copy-list")
+        ("copy-pprint-dispatch" "f¬cp¬ppr.htm" "copy-pprint-dispatch")
+        ("copy-readtable" "f¬cp¬rdt.htm" "copy-readtable")
+        ("copy-seq" "f¬cp¬seq.htm" "copy-seq")
+        ("copy-structure" "f¬cp¬stu.htm" "copy-structure")
+        ("copy-symbol" "f¬cp¬sym.htm" "copy-symbol")
+        ("copy-tree" "f¬cp¬tre.htm" "copy-tree")
+        ("cos" "f¬sin¬c.htm" "cos")
+        ("cosh" "f¬sinh¬.htm" "cosh")
+        ("count" "f¬countc.htm" "count")
+        ("count-if" "f¬countc.htm" "count-if")
+        ("count-if-not" "f¬countc.htm" "count-if-not")
+        ("ctypecase" "m¬tpcase.htm" "ctypecase")
+        ("debug" "d¬optimi.htm" "debug")
+        ("decf" "m¬incf¬.htm" "decf")
+        ("declaim" "m¬declai.htm" "declaim")
+        ("declaration" "d¬declar.htm" "declaration")
+        ("declare" "s¬declar.htm" "declare")
+        ("decode-float" "f¬dec¬fl.htm" "decode-float")
+        ("decode-universal-time" "f¬dec¬un.htm" "decode-universal-time")
+        ("defclass" "m¬defcla.htm" "defclass")
+        ("defconstant" "m¬defcon.htm" "defconstant")
+        ("defgeneric" "m¬defgen.htm" "defgeneric")
+        ("define-compiler-macro" "m¬define.htm" "define-compiler-macro")
+        ("define-condition" "m¬defi¬5.htm" "define-condition")
+        ("define-method-combination" "m¬defi¬4.htm" "define-method-combination")
+        ("define-modify-macro" "m¬defi¬2.htm" "define-modify-macro")
+        ("define-setf-expander" "m¬defi¬3.htm" "define-setf-expander")
+        ("define-symbol-macro" "m¬defi¬1.htm" "define-symbol-macro")
+        ("defmacro" "m¬defmac.htm" "defmacro")
+        ("defmethod" "m¬defmet.htm" "defmethod")
+        ("defpackage" "m¬defpkg.htm" "defpackage")
+        ("defparameter" "m¬defpar.htm" "defparameter")
+        ("defsetf" "m¬defset.htm" "defsetf")
+        ("defstruct" "m¬defstr.htm" "defstruct")
+        ("deftype" "m¬deftp.htm" "deftype")
+        ("defun" "m¬defun.htm" "defun")
+        ("defvar" "m¬defpar.htm" "defvar")
+        ("delete" "f¬rm¬rm.htm" "delete")
+        ("delete-duplicates" "f¬rm¬dup.htm" "delete-duplicates")
+        ("delete-file" "f¬del¬fi.htm" "delete-file")
+        ("delete-if" "f¬rm¬rm.htm" "delete-if")
+        ("delete-if-not" "f¬rm¬rm.htm" "delete-if-not")
+        ("delete-package" "f¬del¬pk.htm" "delete-package")
+        ("denominator" "f¬numera.htm" "denominator")
+        ("deposit-field" "f¬deposi.htm" "deposit-field")
+        ("describe" "f¬descri.htm" "describe")
+        ("describe-object" "f¬desc¬1.htm" "describe-object")
+        ("destructuring-bind" "m¬destru.htm" "destructuring-bind")
+        ("digit-char" "f¬digit¬.htm" "digit-char")
+        ("digit-char-p" "f¬digi¬1.htm" "digit-char-p")
+        ("directory" "f¬dir.htm" "directory")
+        ("directory-namestring" "f¬namest.htm" "directory-namestring")
+        ("disassemble" "f¬disass.htm" "disassemble")
+        ("division-by-zero" "e¬divisi.htm" "division-by-zero")
+        ("do" "m¬do¬do.htm" "do")
+        ("do*" "m¬do¬do.htm" "doST")
+        ("do-all-symbols" "m¬do¬sym.htm" "do-all-symbols")
+        ("do-external-symbols" "m¬do¬sym.htm" "do-external-symbols")
+        ("do-symbols" "m¬do¬sym.htm" "do-symbols")
+        ("documentation" "f¬docume.htm" "documentation")
+        ("dolist" "m¬dolist.htm" "dolist")
+        ("dotimes" "m¬dotime.htm" "dotimes")
+        ("double-float" "t¬short¬.htm" "double-float")
+        ("double-float-epsilon" "v¬short¬.htm" "double-float-epsilon")
+        ("double-float-negative-epsilon" "v¬short¬.htm" "double-float-negative-epsilon")
+        ("dpb" "f¬dpb.htm" "dpb")
+        ("dribble" "f¬dribbl.htm" "dribble")
+        ("dynamic-extent" "d¬dynami.htm" "dynamic-extent")
+        ("ecase" "m¬case¬.htm" "ecase")
+        ("echo-stream" "t¬echo¬s.htm" "echo-stream")
+        ("echo-stream-input-stream" "f¬echo¬s.htm" "echo-stream-input-stream")
+        ("echo-stream-output-stream" "f¬echo¬s.htm" "echo-stream-output-stream")
+        ("ed" "f¬ed.htm" "ed")
+        ("eighth" "f¬firstc.htm" "eighth")
+        ("elt" "f¬elt.htm" "elt")
+        ("encode-universal-time" "f¬encode.htm" "encode-universal-time")
+        ("end-of-file" "e¬end¬of.htm" "end-of-file")
+        ("endp" "f¬endp.htm" "endp")
+        ("enough-namestring" "f¬namest.htm" "enough-namestring")
+        ("ensure-directories-exist" "f¬ensu¬1.htm" "ensure-directories-exist")
+        ("ensure-generic-function" "f¬ensure.htm" "ensure-generic-function")
+        ("eq" "f¬eq.htm" "eq")
+        ("eql" "a¬eql.htm" "eql")
+        ("equal" "f¬equal.htm" "equal")
+        ("equalp" "f¬equalp.htm" "equalp")
+        ("error" "a¬error.htm" "error")
+        ("etypecase" "m¬tpcase.htm" "etypecase")
+        ("eval" "f¬eval.htm" "eval")
+        ("eval-when" "s¬eval¬w.htm" "eval-when")
+        ("evenp" "f¬evenpc.htm" "evenp")
+        ("every" "f¬everyc.htm" "every")
+        ("exp" "f¬exp¬e.htm" "exp")
+        ("export" "f¬export.htm" "export")
+        ("expt" "f¬exp¬e.htm" "expt")
+        ("extended-char" "t¬extend.htm" "extended-char")
+        ("fboundp" "f¬fbound.htm" "fboundp")
+        ("fceiling" "f¬floorc.htm" "fceiling")
+        ("fdefinition" "f¬fdefin.htm" "fdefinition")
+        ("ffloor" "f¬floorc.htm" "ffloor")
+        ("fifth" "f¬firstc.htm" "fifth")
+        ("file-author" "f¬file¬a.htm" "file-author")
+        ("file-error" "e¬file¬e.htm" "file-error")
+        ("file-error-pathname" "f¬file¬e.htm" "file-error-pathname")
+        ("file-length" "f¬file¬l.htm" "file-length")
+        ("file-namestring" "f¬namest.htm" "file-namestring")
+        ("file-position" "f¬file¬p.htm" "file-position")
+        ("file-stream" "t¬file¬s.htm" "file-stream")
+        ("file-string-length" "f¬file¬s.htm" "file-string-length")
+        ("file-write-date" "f¬file¬w.htm" "file-write-date")
+        ("fill" "f¬fill.htm" "fill")
+        ("fill-pointer" "f¬fill¬p.htm" "fill-pointer")
+        ("find" "f¬find¬.htm" "find")
+        ("find-all-symbols" "f¬find¬a.htm" "find-all-symbols")
+        ("find-class" "f¬find¬c.htm" "find-class")
+        ("find-if" "f¬find¬.htm" "find-if")
+        ("find-if-not" "f¬find¬.htm" "find-if-not")
+        ("find-method" "f¬find¬m.htm" "find-method")
+        ("find-package" "f¬find¬p.htm" "find-package")
+        ("find-restart" "f¬find¬r.htm" "find-restart")
+        ("find-symbol" "f¬find¬s.htm" "find-symbol")
+        ("finish-output" "f¬finish.htm" "finish-output")
+        ("first" "f¬firstc.htm" "first")
+        ("fixnum" "t¬fixnum.htm" "fixnum")
+        ("flet" "s¬flet¬.htm" "flet")
+        ("float" "a¬float.htm" "float")
+        ("float-digits" "f¬dec¬fl.htm" "float-digits")
+        ("float-precision" "f¬dec¬fl.htm" "float-precision")
+        ("float-radix" "f¬dec¬fl.htm" "float-radix")
+        ("float-sign" "f¬dec¬fl.htm" "float-sign")
+        ("floating-point-inexact" "e¬floa¬1.htm" "floating-point-inexact")
+        ("floating-point-invalid-operation" "e¬floati.htm" "floating-point-invalid-operation")
+        ("floating-point-overflow" "e¬floa¬2.htm" "floating-point-overflow")
+        ("floating-point-underflow" "e¬floa¬3.htm" "floating-point-underflow")
+        ("floatp" "f¬floatp.htm" "floatp")
+        ("floor" "f¬floorc.htm" "floor")
+        ("fmakunbound" "f¬fmakun.htm" "fmakunbound")
+        ("force-output" "f¬finish.htm" "force-output")
+        ("format" "f¬format.htm" "format")
+        ("formatter" "m¬format.htm" "formatter")
+        ("fourth" "f¬firstc.htm" "fourth")
+        ("fresh-line" "f¬terpri.htm" "fresh-line")
+        ("fround" "f¬floorc.htm" "fround")
+        ("ftruncate" "f¬floorc.htm" "ftruncate")
+        ("ftype" "d¬ftype.htm" "ftype")
+        ("funcall" "f¬funcal.htm" "funcall")
+        ("function" "a¬fn.htm" "function")
+        ("function-keywords" "f¬fn¬kwd.htm" "function-keywords")
+        ("function-lambda-expression" "f¬fn¬lam.htm" "function-lambda-expression")
+        ("functionp" "f¬fnp.htm" "functionp")
+        ("gcd" "f¬gcd.htm" "gcd")
+        ("generic-function" "t¬generi.htm" "generic-function")
+        ("gensym" "f¬gensym.htm" "gensym")
+        ("gentemp" "f¬gentem.htm" "gentemp")
+        ("get" "f¬get.htm" "get")
+        ("get-decoded-time" "f¬get¬un.htm" "get-decoded-time")
+        ("get-dispatch-macro-character" "f¬set¬¬1.htm" "get-dispatch-macro-character")
+        ("get-internal-real-time" "f¬get¬in.htm" "get-internal-real-time")
+        ("get-internal-run-time" "f¬get¬¬1.htm" "get-internal-run-time")
+        ("get-macro-character" "f¬set¬ma.htm" "get-macro-character")
+        ("get-output-stream-string" "f¬get¬ou.htm" "get-output-stream-string")
+        ("get-properties" "f¬get¬pr.htm" "get-properties")
+        ("get-setf-expansion" "f¬get¬se.htm" "get-setf-expansion")
+        ("get-universal-time" "f¬get¬un.htm" "get-universal-time")
+        ("getf" "f¬getf.htm" "getf")
+        ("gethash" "f¬gethas.htm" "gethash")
+        ("go" "s¬go.htm" "go")
+        ("graphic-char-p" "f¬graphi.htm" "graphic-char-p")
+        ("handler-bind" "m¬handle.htm" "handler-bind")
+        ("handler-case" "m¬hand¬1.htm" "handler-case")
+        ("hash-table" "t¬hash¬t.htm" "hash-table")
+        ("hash-table-count" "f¬hash¬1.htm" "hash-table-count")
+        ("hash-table-p" "f¬hash¬t.htm" "hash-table-p")
+        ("hash-table-rehash-size" "f¬hash¬2.htm" "hash-table-rehash-size")
+        ("hash-table-rehash-threshold" "f¬hash¬3.htm" "hash-table-rehash-threshold")
+        ("hash-table-size" "f¬hash¬4.htm" "hash-table-size")
+        ("hash-table-test" "f¬hash¬5.htm" "hash-table-test")
+        ("host-namestring" "f¬namest.htm" "host-namestring")
+        ("identity" "f¬identi.htm" "identity")
+        ("if" "s¬if.htm" "if")
+        ("ignorable" "d¬ignore.htm" "ignorable")
+        ("ignore" "d¬ignore.htm" "ignore")
+        ("ignore-errors" "m¬ignore.htm" "ignore-errors")
+        ("imagpart" "f¬realpa.htm" "imagpart")
+        ("import" "f¬import.htm" "import")
+        ("in-package" "m¬in¬pkg.htm" "in-package")
+        ("incf" "m¬incf¬.htm" "incf")
+        ("initialize-instance" "f¬init¬i.htm" "initialize-instance")
+        ("inline" "d¬inline.htm" "inline")
+        ("input-stream-p" "f¬in¬stm.htm" "input-stream-p")
+        ("inspect" "f¬inspec.htm" "inspect")
+        ("integer" "t¬intege.htm" "integer")
+        ("integer-decode-float" "f¬dec¬fl.htm" "integer-decode-float")
+        ("integer-length" "f¬intege.htm" "integer-length")
+        ("integerp" "f¬inte¬1.htm" "integerp")
+        ("interactive-stream-p" "f¬intera.htm" "interactive-stream-p")
+        ("intern" "f¬intern.htm" "intern")
+        ("internal-time-units-per-second" "v¬intern.htm" "internal-time-units-per-second")
+        ("intersection" "f¬isec¬.htm" "intersection")
+        ("invalid-method-error" "f¬invali.htm" "invalid-method-error")
+        ("invoke-debugger" "f¬invoke.htm" "invoke-debugger")
+        ("invoke-restart" "f¬invo¬1.htm" "invoke-restart")
+        ("invoke-restart-interactively" "f¬invo¬2.htm" "invoke-restart-interactively")
+        ("isqrt" "f¬sqrt¬.htm" "isqrt")
+        ("keyword" "t¬kwd.htm" "keyword")
+        ("keywordp" "f¬kwdp.htm" "keywordp")
+        ("labels" "s¬flet¬.htm" "labels")
+        ("lambda" "a¬lambda.htm" "lambda")
+        ("lambda-list-keywords" "v¬lambda.htm" "lambda-list-keywords")
+        ("lambda-parameters-limit" "v¬lamb¬1.htm" "lambda-parameters-limit")
+        ("last" "f¬last.htm" "last")
+        ("lcm" "f¬lcm.htm" "lcm")
+        ("ldb" "f¬ldb.htm" "ldb")
+        ("ldb-test" "f¬ldb¬te.htm" "ldb-test")
+        ("ldiff" "f¬ldiffc.htm" "ldiff")
+        ("least-negative-double-float" "v¬most¬1.htm" "least-negative-double-float")
+        ("least-negative-long-float" "v¬most¬1.htm" "least-negative-long-float")
+        ("least-negative-normalized-double-float" "v¬most¬1.htm" 
                "least-negative-normalized-double-float")
-        ("least-negative-normalized-long-float" "v_most_1.htm" "least-negative-normalized-long-float"
+        ("least-negative-normalized-long-float" "v¬most¬1.htm" "least-negative-normalized-long-float"
                )
-        ("least-negative-normalized-short-float" "v_most_1.htm" 
+        ("least-negative-normalized-short-float" "v¬most¬1.htm" 
                "least-negative-normalized-short-float")
-        ("least-negative-normalized-single-float" "v_most_1.htm" 
+        ("least-negative-normalized-single-float" "v¬most¬1.htm" 
                "least-negative-normalized-single-float")
-        ("least-negative-short-float" "v_most_1.htm" "least-negative-short-float")
-        ("least-negative-single-float" "v_most_1.htm" "least-negative-single-float")
-        ("least-positive-double-float" "v_most_1.htm" "least-positive-double-float")
-        ("least-positive-long-float" "v_most_1.htm" "least-positive-long-float")
-        ("least-positive-normalized-double-float" "v_most_1.htm" 
+        ("least-negative-short-float" "v¬most¬1.htm" "least-negative-short-float")
+        ("least-negative-single-float" "v¬most¬1.htm" "least-negative-single-float")
+        ("least-positive-double-float" "v¬most¬1.htm" "least-positive-double-float")
+        ("least-positive-long-float" "v¬most¬1.htm" "least-positive-long-float")
+        ("least-positive-normalized-double-float" "v¬most¬1.htm" 
                "least-positive-normalized-double-float")
-        ("least-positive-normalized-long-float" "v_most_1.htm" "least-positive-normalized-long-float"
+        ("least-positive-normalized-long-float" "v¬most¬1.htm" "least-positive-normalized-long-float"
                )
-        ("least-positive-normalized-short-float" "v_most_1.htm" 
+        ("least-positive-normalized-short-float" "v¬most¬1.htm" 
                "least-positive-normalized-short-float")
-        ("least-positive-normalized-single-float" "v_most_1.htm" 
+        ("least-positive-normalized-single-float" "v¬most¬1.htm" 
                "least-positive-normalized-single-float")
-        ("least-positive-short-float" "v_most_1.htm" "least-positive-short-float")
-        ("least-positive-single-float" "v_most_1.htm" "least-positive-single-float")
-        ("length" "f_length.htm" "length")
-        ("let" "s_let_l.htm" "let")
-        ("let*" "s_let_l.htm" "letST")
-        ("lisp-implementation-type" "f_lisp_i.htm" "lisp-implementation-type")
-        ("lisp-implementation-version" "f_lisp_i.htm" "lisp-implementation-version")
-        ("list" "a_list.htm" "list")
-        ("list*" "f_list_.htm" "listST")
-        ("list-all-packages" "f_list_a.htm" "list-all-packages")
-        ("list-length" "f_list_l.htm" "list-length")
-        ("listen" "f_listen.htm" "listen")
-        ("listp" "f_listp.htm" "listp")
-        ("load" "f_load.htm" "load")
-        ("load-logical-pathname-translations" "f_ld_log.htm" "load-logical-pathname-translations")
-        ("load-time-value" "s_ld_tim.htm" "load-time-value")
-        ("locally" "s_locall.htm" "locally")
-        ("log" "f_log.htm" "log")
-        ("logand" "f_logand.htm" "logand")
-        ("logandc1" "f_logand.htm" "logandc1")
-        ("logandc2" "f_logand.htm" "logandc2")
-        ("logbitp" "f_logbtp.htm" "logbitp")
-        ("logcount" "f_logcou.htm" "logcount")
-        ("logeqv" "f_logand.htm" "logeqv")
-        ("logical-pathname" "a_logica.htm" "logical-pathname")
-        ("logical-pathname-translations" "f_logica.htm" "logical-pathname-translations")
-        ("logior" "f_logand.htm" "logior")
-        ("lognand" "f_logand.htm" "lognand")
-        ("lognor" "f_logand.htm" "lognor")
-        ("lognot" "f_logand.htm" "lognot")
-        ("logorc1" "f_logand.htm" "logorc1")
-        ("logorc2" "f_logand.htm" "logorc2")
-        ("logtest" "f_logtes.htm" "logtest")
-        ("logxor" "f_logand.htm" "logxor")
-        ("long-float" "t_short_.htm" "long-float")
-        ("long-float-epsilon" "v_short_.htm" "long-float-epsilon")
-        ("long-float-negative-epsilon" "v_short_.htm" "long-float-negative-epsilon")
-        ("long-site-name" "f_short_.htm" "long-site-name")
-        ("loop" "m_loop.htm" "loop")
-        ("loop-finish" "m_loop_f.htm" "loop-finish")
-        ("lower-case-p" "f_upper_.htm" "lower-case-p")
-        ("machine-instance" "f_mach_i.htm" "machine-instance")
-        ("machine-type" "f_mach_t.htm" "machine-type")
-        ("machine-version" "f_mach_v.htm" "machine-version")
-        ("macro-function" "f_macro_.htm" "macro-function")
-        ("macroexpand" "f_mexp_.htm" "macroexpand")
-        ("macroexpand-1" "f_mexp_.htm" "macroexpand-1")
-        ("macrolet" "s_flet_.htm" "macrolet")
-        ("make-array" "f_mk_ar.htm" "make-array")
-        ("make-broadcast-stream" "f_mk_bro.htm" "make-broadcast-stream")
-        ("make-concatenated-stream" "f_mk_con.htm" "make-concatenated-stream")
-        ("make-condition" "f_mk_cnd.htm" "make-condition")
-        ("make-dispatch-macro-character" "f_mk_dis.htm" "make-dispatch-macro-character")
-        ("make-echo-stream" "f_mk_ech.htm" "make-echo-stream")
-        ("make-hash-table" "f_mk_has.htm" "make-hash-table")
-        ("make-instance" "f_mk_ins.htm" "make-instance")
-        ("make-instances-obsolete" "f_mk_i_1.htm" "make-instances-obsolete")
-        ("make-list" "f_mk_lis.htm" "make-list")
-        ("make-load-form" "f_mk_ld_.htm" "make-load-form")
-        ("make-load-form-saving-slots" "f_mk_l_1.htm" "make-load-form-saving-slots")
-        ("make-method" "m_call_m.htm" "make-method")
-        ("make-package" "f_mk_pkg.htm" "make-package")
-        ("make-pathname" "f_mk_pn.htm" "make-pathname")
-        ("make-random-state" "f_mk_rnd.htm" "make-random-state")
-        ("make-sequence" "f_mk_seq.htm" "make-sequence")
-        ("make-string" "f_mk_stg.htm" "make-string")
-        ("make-string-input-stream" "f_mk_s_1.htm" "make-string-input-stream")
-        ("make-string-output-stream" "f_mk_s_2.htm" "make-string-output-stream")
-        ("make-symbol" "f_mk_sym.htm" "make-symbol")
-        ("make-synonym-stream" "f_mk_syn.htm" "make-synonym-stream")
-        ("make-two-way-stream" "f_mk_two.htm" "make-two-way-stream")
-        ("makunbound" "f_makunb.htm" "makunbound")
-        ("map" "f_map.htm" "map")
-        ("map-into" "f_map_in.htm" "map-into")
-        ("mapc" "f_mapc_.htm" "mapc")
-        ("mapcan" "f_mapc_.htm" "mapcan")
-        ("mapcar" "f_mapc_.htm" "mapcar")
-        ("mapcon" "f_mapc_.htm" "mapcon")
-        ("maphash" "f_maphas.htm" "maphash")
-        ("mapl" "f_mapc_.htm" "mapl")
-        ("maplist" "f_mapc_.htm" "maplist")
-        ("mask-field" "f_mask_f.htm" "mask-field")
-        ("max" "f_max_m.htm" "max")
-        ("member" "a_member.htm" "member")
-        ("member-if" "f_mem_m.htm" "member-if")
-        ("member-if-not" "f_mem_m.htm" "member-if-not")
-        ("merge" "f_merge.htm" "merge")
-        ("merge-pathnames" "f_merge_.htm" "merge-pathnames")
-        ("method" "t_method.htm" "method")
-        ("method-combination" "a_method.htm" "method-combination")
-        ("method-combination-error" "f_meth_1.htm" "method-combination-error")
-        ("method-qualifiers" "f_method.htm" "method-qualifiers")
-        ("min" "f_max_m.htm" "min")
-        ("minusp" "f_minusp.htm" "minusp")
-        ("mismatch" "f_mismat.htm" "mismatch")
-        ("mod" "a_mod.htm" "mod")
-        ("most-negative-double-float" "v_most_1.htm" "most-negative-double-float")
-        ("most-negative-fixnum" "v_most_p.htm" "most-negative-fixnum")
-        ("most-negative-long-float" "v_most_1.htm" "most-negative-long-float")
-        ("most-negative-short-float" "v_most_1.htm" "most-negative-short-float")
-        ("most-negative-single-float" "v_most_1.htm" "most-negative-single-float")
-        ("most-positive-double-float" "v_most_1.htm" "most-positive-double-float")
-        ("most-positive-fixnum" "v_most_p.htm" "most-positive-fixnum")
-        ("most-positive-long-float" "v_most_1.htm" "most-positive-long-float")
-        ("most-positive-short-float" "v_most_1.htm" "most-positive-short-float")
-        ("most-positive-single-float" "v_most_1.htm" "most-positive-single-float")
-        ("muffle-warning" "a_muffle.htm" "muffle-warning")
-        ("multiple-value-bind" "m_multip.htm" "multiple-value-bind")
-        ("multiple-value-call" "s_multip.htm" "multiple-value-call")
-        ("multiple-value-list" "m_mult_1.htm" "multiple-value-list")
-        ("multiple-value-prog1" "s_mult_1.htm" "multiple-value-prog1")
-        ("multiple-value-setq" "m_mult_2.htm" "multiple-value-setq")
-        ("multiple-values-limit" "v_multip.htm" "multiple-values-limit")
-        ("name-char" "f_name_c.htm" "name-char")
-        ("namestring" "f_namest.htm" "namestring")
-        ("nbutlast" "f_butlas.htm" "nbutlast")
-        ("nconc" "f_nconc.htm" "nconc")
-        ("next-method-p" "f_next_m.htm" "next-method-p")
-        ("nil" "a_nil.htm" "nil")
-        ("nintersection" "f_isec_.htm" "nintersection")
-        ("ninth" "f_firstc.htm" "ninth")
-        ("no-applicable-method" "f_no_app.htm" "no-applicable-method")
-        ("no-next-method" "f_no_nex.htm" "no-next-method")
-        ("not" "a_not.htm" "not")
-        ("notany" "f_everyc.htm" "notany")
-        ("notevery" "f_everyc.htm" "notevery")
-        ("notinline" "d_inline.htm" "notinline")
-        ("nreconc" "f_revapp.htm" "nreconc")
-        ("nreverse" "f_revers.htm" "nreverse")
-        ("nset-difference" "f_set_di.htm" "nset-difference")
-        ("nset-exclusive-or" "f_set_ex.htm" "nset-exclusive-or")
-        ("nstring-capitalize" "f_stg_up.htm" "nstring-capitalize")
-        ("nstring-downcase" "f_stg_up.htm" "nstring-downcase")
-        ("nstring-upcase" "f_stg_up.htm" "nstring-upcase")
-        ("nsublis" "f_sublis.htm" "nsublis")
-        ("nsubst" "f_substc.htm" "nsubst")
-        ("nsubst-if" "f_substc.htm" "nsubst-if")
-        ("nsubst-if-not" "f_substc.htm" "nsubst-if-not")
-        ("nsubstitute" "f_sbs_s.htm" "nsubstitute")
-        ("nsubstitute-if" "f_sbs_s.htm" "nsubstitute-if")
-        ("nsubstitute-if-not" "f_sbs_s.htm" "nsubstitute-if-not")
-        ("nth" "f_nth.htm" "nth")
-        ("nth-value" "m_nth_va.htm" "nth-value")
-        ("nthcdr" "f_nthcdr.htm" "nthcdr")
-        ("null" "a_null.htm" "null")
-        ("number" "t_number.htm" "number")
-        ("numberp" "f_nump.htm" "numberp")
-        ("numerator" "f_numera.htm" "numerator")
-        ("nunion" "f_unionc.htm" "nunion")
-        ("oddp" "f_evenpc.htm" "oddp")
-        ("open" "f_open.htm" "open")
-        ("open-stream-p" "f_open_s.htm" "open-stream-p")
-        ("optimize" "d_optimi.htm" "optimize")
-        ("or" "a_or.htm" "or")
-        ("otherwise" "m_case_.htm" "otherwise")
-        ("output-stream-p" "f_in_stm.htm" "output-stream-p")
-        ("package" "t_pkg.htm" "package")
-        ("package-error" "e_pkg_er.htm" "package-error")
-        ("package-error-package" "f_pkg_er.htm" "package-error-package")
-        ("package-name" "f_pkg_na.htm" "package-name")
-        ("package-nicknames" "f_pkg_ni.htm" "package-nicknames")
-        ("package-shadowing-symbols" "f_pkg_sh.htm" "package-shadowing-symbols")
-        ("package-use-list" "f_pkg_us.htm" "package-use-list")
-        ("package-used-by-list" "f_pkg__1.htm" "package-used-by-list")
-        ("packagep" "f_pkgp.htm" "packagep")
-        ("pairlis" "f_pairli.htm" "pairlis")
-        ("parse-error" "e_parse_.htm" "parse-error")
-        ("parse-integer" "f_parse_.htm" "parse-integer")
-        ("parse-namestring" "f_pars_1.htm" "parse-namestring")
-        ("pathname" "a_pn.htm" "pathname")
-        ("pathname-device" "f_pn_hos.htm" "pathname-device")
-        ("pathname-directory" "f_pn_hos.htm" "pathname-directory")
-        ("pathname-host" "f_pn_hos.htm" "pathname-host")
-        ("pathname-match-p" "f_pn_mat.htm" "pathname-match-p")
-        ("pathname-name" "f_pn_hos.htm" "pathname-name")
-        ("pathname-type" "f_pn_hos.htm" "pathname-type")
-        ("pathname-version" "f_pn_hos.htm" "pathname-version")
-        ("pathnamep" "f_pnp.htm" "pathnamep")
-        ("peek-char" "f_peek_c.htm" "peek-char")
-        ("phase" "f_phase.htm" "phase")
-        ("pi" "v_pi.htm" "pi")
-        ("plusp" "f_minusp.htm" "plusp")
-        ("pop" "m_pop.htm" "pop")
-        ("position" "f_pos_p.htm" "position")
-        ("position-if" "f_pos_p.htm" "position-if")
-        ("position-if-not" "f_pos_p.htm" "position-if-not")
-        ("pprint" "f_wr_pr.htm" "pprint")
-        ("pprint-dispatch" "f_ppr_di.htm" "pprint-dispatch")
-        ("pprint-exit-if-list-exhausted" "m_ppr_ex.htm" "pprint-exit-if-list-exhausted")
-        ("pprint-fill" "f_ppr_fi.htm" "pprint-fill")
-        ("pprint-indent" "f_ppr_in.htm" "pprint-indent")
-        ("pprint-linear" "f_ppr_fi.htm" "pprint-linear")
-        ("pprint-logical-block" "m_ppr_lo.htm" "pprint-logical-block")
-        ("pprint-newline" "f_ppr_nl.htm" "pprint-newline")
-        ("pprint-pop" "m_ppr_po.htm" "pprint-pop")
-        ("pprint-tab" "f_ppr_ta.htm" "pprint-tab")
-        ("pprint-tabular" "f_ppr_fi.htm" "pprint-tabular")
-        ("prin1" "f_wr_pr.htm" "prin1")
-        ("prin1-to-string" "f_wr_to_.htm" "prin1-to-string")
-        ("princ" "f_wr_pr.htm" "princ")
-        ("princ-to-string" "f_wr_to_.htm" "princ-to-string")
-        ("print" "f_wr_pr.htm" "print")
-        ("print-not-readable" "e_pr_not.htm" "print-not-readable")
-        ("print-not-readable-object" "f_pr_not.htm" "print-not-readable-object")
-        ("print-object" "f_pr_obj.htm" "print-object")
-        ("print-unreadable-object" "m_pr_unr.htm" "print-unreadable-object")
-        ("probe-file" "f_probe_.htm" "probe-file")
-        ("proclaim" "f_procla.htm" "proclaim")
-        ("prog" "m_prog_.htm" "prog")
-        ("prog*" "m_prog_.htm" "progST")
-        ("prog1" "m_prog1c.htm" "prog1")
-        ("prog2" "m_prog1c.htm" "prog2")
-        ("progn" "s_progn.htm" "progn")
-        ("program-error" "e_progra.htm" "program-error")
-        ("progv" "s_progv.htm" "progv")
-        ("provide" "f_provid.htm" "provide")
-        ("psetf" "m_setf_.htm" "psetf")
-        ("psetq" "m_psetq.htm" "psetq")
-        ("push" "m_push.htm" "push")
-        ("pushnew" "m_pshnew.htm" "pushnew")
-        ("quote" "s_quote.htm" "quote")
-        ("random" "f_random.htm" "random")
-        ("random-state" "t_rnd_st.htm" "random-state")
-        ("random-state-p" "f_rnd_st.htm" "random-state-p")
-        ("rassoc" "f_rassoc.htm" "rassoc")
-        ("rassoc-if" "f_rassoc.htm" "rassoc-if")
-        ("rassoc-if-not" "f_rassoc.htm" "rassoc-if-not")
-        ("ratio" "t_ratio.htm" "ratio")
-        ("rational" "a_ration.htm" "rational")
-        ("rationalize" "f_ration.htm" "rationalize")
-        ("rationalp" "f_rati_1.htm" "rationalp")
-        ("read" "f_rd_rd.htm" "read")
-        ("read-byte" "f_rd_by.htm" "read-byte")
-        ("read-char" "f_rd_cha.htm" "read-char")
-        ("read-char-no-hang" "f_rd_c_1.htm" "read-char-no-hang")
-        ("read-delimited-list" "f_rd_del.htm" "read-delimited-list")
-        ("read-from-string" "f_rd_fro.htm" "read-from-string")
-        ("read-line" "f_rd_lin.htm" "read-line")
-        ("read-preserving-whitespace" "f_rd_rd.htm" "read-preserving-whitespace")
-        ("read-sequence" "f_rd_seq.htm" "read-sequence")
-        ("reader-error" "e_rder_e.htm" "reader-error")
-        ("readtable" "t_rdtabl.htm" "readtable")
-        ("readtable-case" "f_rdtabl.htm" "readtable-case")
-        ("readtablep" "f_rdta_1.htm" "readtablep")
-        ("real" "t_real.htm" "real")
-        ("realp" "f_realp.htm" "realp")
-        ("realpart" "f_realpa.htm" "realpart")
-        ("reduce" "f_reduce.htm" "reduce")
-        ("reinitialize-instance" "f_reinit.htm" "reinitialize-instance")
-        ("rem" "f_mod_r.htm" "rem")
-        ("remf" "m_remf.htm" "remf")
-        ("remhash" "f_remhas.htm" "remhash")
-        ("remove" "f_rm_rm.htm" "remove")
-        ("remove-duplicates" "f_rm_dup.htm" "remove-duplicates")
-        ("remove-if" "f_rm_rm.htm" "remove-if")
-        ("remove-if-not" "f_rm_rm.htm" "remove-if-not")
-        ("remove-method" "f_rm_met.htm" "remove-method")
-        ("remprop" "f_rempro.htm" "remprop")
-        ("rename-file" "f_rn_fil.htm" "rename-file")
-        ("rename-package" "f_rn_pkg.htm" "rename-package")
-        ("replace" "f_replac.htm" "replace")
-        ("require" "f_provid.htm" "require")
-        ("rest" "f_rest.htm" "rest")
-        ("restart" "t_rst.htm" "restart")
-        ("restart-bind" "m_rst_bi.htm" "restart-bind")
-        ("restart-case" "m_rst_ca.htm" "restart-case")
-        ("restart-name" "f_rst_na.htm" "restart-name")
-        ("return" "m_return.htm" "return")
-        ("return-from" "s_ret_fr.htm" "return-from")
-        ("revappend" "f_revapp.htm" "revappend")
-        ("reverse" "f_revers.htm" "reverse")
-        ("room" "f_room.htm" "room")
-        ("rotatef" "m_rotate.htm" "rotatef")
-        ("round" "f_floorc.htm" "round")
-        ("row-major-aref" "f_row_ma.htm" "row-major-aref")
-        ("rplaca" "f_rplaca.htm" "rplaca")
-        ("rplacd" "f_rplaca.htm" "rplacd")
-        ("safety" "d_optimi.htm" "safety")
-        ("satisfies" "t_satisf.htm" "satisfies")
-        ("sbit" "f_bt_sb.htm" "sbit")
-        ("scale-float" "f_dec_fl.htm" "scale-float")
-        ("schar" "f_char_.htm" "schar")
-        ("search" "f_search.htm" "search")
-        ("second" "f_firstc.htm" "second")
-        ("sequence" "t_seq.htm" "sequence")
-        ("serious-condition" "e_seriou.htm" "serious-condition")
-        ("set" "f_set.htm" "set")
-        ("set-difference" "f_set_di.htm" "set-difference")
-        ("set-dispatch-macro-character" "f_set__1.htm" "set-dispatch-macro-character")
-        ("set-exclusive-or" "f_set_ex.htm" "set-exclusive-or")
-        ("set-macro-character" "f_set_ma.htm" "set-macro-character")
-        ("set-pprint-dispatch" "f_set_pp.htm" "set-pprint-dispatch")
-        ("set-syntax-from-char" "f_set_sy.htm" "set-syntax-from-char")
-        ("setf" "a_setf.htm" "setf")
-        ("setq" "s_setq.htm" "setq")
-        ("seventh" "f_firstc.htm" "seventh")
-        ("shadow" "f_shadow.htm" "shadow")
-        ("shadowing-import" "f_shdw_i.htm" "shadowing-import")
-        ("shared-initialize" "f_shared.htm" "shared-initialize")
-        ("shiftf" "m_shiftf.htm" "shiftf")
-        ("short-float" "t_short_.htm" "short-float")
-        ("short-float-epsilon" "v_short_.htm" "short-float-epsilon")
-        ("short-float-negative-epsilon" "v_short_.htm" "short-float-negative-epsilon")
-        ("short-site-name" "f_short_.htm" "short-site-name")
-        ("signal" "f_signal.htm" "signal")
-        ("signed-byte" "t_sgn_by.htm" "signed-byte")
-        ("signum" "f_signum.htm" "signum")
-        ("simple-array" "t_smp_ar.htm" "simple-array")
-        ("simple-base-string" "t_smp_ba.htm" "simple-base-string")
-        ("simple-bit-vector" "t_smp_bt.htm" "simple-bit-vector")
-        ("simple-bit-vector-p" "f_smp_bt.htm" "simple-bit-vector-p")
-        ("simple-condition" "e_smp_cn.htm" "simple-condition")
-        ("simple-condition-format-arguments" "f_smp_cn.htm" "simple-condition-format-arguments")
-        ("simple-condition-format-control" "f_smp_cn.htm" "simple-condition-format-control")
-        ("simple-error" "e_smp_er.htm" "simple-error")
-        ("simple-string" "t_smp_st.htm" "simple-string")
-        ("simple-string-p" "f_smp_st.htm" "simple-string-p")
-        ("simple-type-error" "e_smp_tp.htm" "simple-type-error")
-        ("simple-vector" "t_smp_ve.htm" "simple-vector")
-        ("simple-vector-p" "f_smp_ve.htm" "simple-vector-p")
-        ("simple-warning" "e_smp_wa.htm" "simple-warning")
-        ("sin" "f_sin_c.htm" "sin")
-        ("single-float" "t_short_.htm" "single-float")
-        ("single-float-epsilon" "v_short_.htm" "single-float-epsilon")
-        ("single-float-negative-epsilon" "v_short_.htm" "single-float-negative-epsilon")
-        ("sinh" "f_sinh_.htm" "sinh")
-        ("sixth" "f_firstc.htm" "sixth")
-        ("sleep" "f_sleep.htm" "sleep")
-        ("slot-boundp" "f_slt_bo.htm" "slot-boundp")
-        ("slot-exists-p" "f_slt_ex.htm" "slot-exists-p")
-        ("slot-makunbound" "f_slt_ma.htm" "slot-makunbound")
-        ("slot-missing" "f_slt_mi.htm" "slot-missing")
-        ("slot-unbound" "f_slt_un.htm" "slot-unbound")
-        ("slot-value" "f_slt_va.htm" "slot-value")
-        ("software-type" "f_sw_tpc.htm" "software-type")
-        ("software-version" "f_sw_tpc.htm" "software-version")
-        ("some" "f_everyc.htm" "some")
-        ("sort" "f_sort_.htm" "sort")
-        ("space" "d_optimi.htm" "space")
-        ("special" "d_specia.htm" "special")
-        ("special-operator-p" "f_specia.htm" "special-operator-p")
-        ("speed" "d_optimi.htm" "speed")
-        ("sqrt" "f_sqrt_.htm" "sqrt")
-        ("stable-sort" "f_sort_.htm" "stable-sort")
-        ("standard" "07_ffb.htm" "standard")
-        ("standard-char" "t_std_ch.htm" "standard-char")
-        ("standard-char-p" "f_std_ch.htm" "standard-char-p")
-        ("standard-class" "t_std_cl.htm" "standard-class")
-        ("standard-generic-function" "t_std_ge.htm" "standard-generic-function")
-        ("standard-method" "t_std_me.htm" "standard-method")
-        ("standard-object" "t_std_ob.htm" "standard-object")
-        ("step" "m_step.htm" "step")
-        ("storage-condition" "e_storag.htm" "storage-condition")
-        ("store-value" "a_store_.htm" "store-value")
-        ("stream" "t_stream.htm" "stream")
-        ("stream-element-type" "f_stm_el.htm" "stream-element-type")
-        ("stream-error" "e_stm_er.htm" "stream-error")
-        ("stream-error-stream" "f_stm_er.htm" "stream-error-stream")
-        ("stream-external-format" "f_stm_ex.htm" "stream-external-format")
-        ("streamp" "f_stmp.htm" "streamp")
-        ("string" "a_string.htm" "string")
-        ("string-capitalize" "f_stg_up.htm" "string-capitalize")
-        ("string-downcase" "f_stg_up.htm" "string-downcase")
-        ("string-equal" "f_stgeq_.htm" "string-equal")
-        ("string-greaterp" "f_stgeq_.htm" "string-greaterp")
-        ("string-left-trim" "f_stg_tr.htm" "string-left-trim")
-        ("string-lessp" "f_stgeq_.htm" "string-lessp")
-        ("string-not-equal" "f_stgeq_.htm" "string-not-equal")
-        ("string-not-greaterp" "f_stgeq_.htm" "string-not-greaterp")
-        ("string-not-lessp" "f_stgeq_.htm" "string-not-lessp")
-        ("string-right-trim" "f_stg_tr.htm" "string-right-trim")
-        ("string-stream" "t_stg_st.htm" "string-stream")
-        ("string-trim" "f_stg_tr.htm" "string-trim")
-        ("string-upcase" "f_stg_up.htm" "string-upcase")
-        ("string/=" "f_stgeq_.htm" "stringSLEQ")
-        ("string&lt;" "f_stgeq_.htm" "stringLT")
-        ("string&lt;=" "f_stgeq_.htm" "stringLTEQ")
-        ("string=" "f_stgeq_.htm" "stringEQ")
-        ("string&gt;" "f_stgeq_.htm" "stringGT")
-        ("string&gt;=" "f_stgeq_.htm" "stringGTEQ")
-        ("stringp" "f_stgp.htm" "stringp")
-        ("structure" "f_docume.htm" "structure")
-        ("structure-class" "t_stu_cl.htm" "structure-class")
-        ("structure-object" "t_stu_ob.htm" "structure-object")
-        ("style-warning" "e_style_.htm" "style-warning")
-        ("sublis" "f_sublis.htm" "sublis")
-        ("subseq" "f_subseq.htm" "subseq")
-        ("subsetp" "f_subset.htm" "subsetp")
-        ("subst" "f_substc.htm" "subst")
-        ("subst-if" "f_substc.htm" "subst-if")
-        ("subst-if-not" "f_substc.htm" "subst-if-not")
-        ("substitute" "f_sbs_s.htm" "substitute")
-        ("substitute-if" "f_sbs_s.htm" "substitute-if")
-        ("substitute-if-not" "f_sbs_s.htm" "substitute-if-not")
-        ("subtypep" "f_subtpp.htm" "subtypep")
-        ("svref" "f_svref.htm" "svref")
-        ("sxhash" "f_sxhash.htm" "sxhash")
-        ("symbol" "t_symbol.htm" "symbol")
-        ("symbol-function" "f_symb_1.htm" "symbol-function")
-        ("symbol-macrolet" "s_symbol.htm" "symbol-macrolet")
-        ("symbol-name" "f_symb_2.htm" "symbol-name")
-        ("symbol-package" "f_symb_3.htm" "symbol-package")
-        ("symbol-plist" "f_symb_4.htm" "symbol-plist")
-        ("symbol-value" "f_symb_5.htm" "symbol-value")
-        ("symbolp" "f_symbol.htm" "symbolp")
-        ("synonym-stream" "t_syn_st.htm" "synonym-stream")
-        ("synonym-stream-symbol" "f_syn_st.htm" "synonym-stream-symbol")
-        ("t" "a_t.htm" "t")
-        ("tagbody" "s_tagbod.htm" "tagbody")
-        ("tailp" "f_ldiffc.htm" "tailp")
-        ("tan" "f_sin_c.htm" "tan")
-        ("tanh" "f_sinh_.htm" "tanh")
-        ("tenth" "f_firstc.htm" "tenth")
-        ("terpri" "f_terpri.htm" "terpri")
-        ("the" "s_the.htm" "the")
-        ("third" "f_firstc.htm" "third")
-        ("throw" "s_throw.htm" "throw")
-        ("time" "m_time.htm" "time")
-        ("trace" "m_tracec.htm" "trace")
-        ("translate-logical-pathname" "f_tr_log.htm" "translate-logical-pathname")
-        ("translate-pathname" "f_tr_pn.htm" "translate-pathname")
-        ("tree-equal" "f_tree_e.htm" "tree-equal")
-        ("truename" "f_tn.htm" "truename")
-        ("truncate" "f_floorc.htm" "truncate")
-        ("two-way-stream" "t_two_wa.htm" "two-way-stream")
-        ("two-way-stream-input-stream" "f_two_wa.htm" "two-way-stream-input-stream")
-        ("two-way-stream-output-stream" "f_two_wa.htm" "two-way-stream-output-stream")
-        ("type" "a_type.htm" "type")
-        ("type-error" "e_tp_err.htm" "type-error")
-        ("type-error-datum" "f_tp_err.htm" "type-error-datum")
-        ("type-error-expected-type" "f_tp_err.htm" "type-error-expected-type")
-        ("type-of" "f_tp_of.htm" "type-of")
-        ("typecase" "m_tpcase.htm" "typecase")
-        ("typep" "f_typep.htm" "typep")
-        ("unbound-slot" "e_unboun.htm" "unbound-slot")
-        ("unbound-slot-instance" "f_unboun.htm" "unbound-slot-instance")
-        ("unbound-variable" "e_unbo_1.htm" "unbound-variable")
-        ("undefined-function" "e_undefi.htm" "undefined-function")
-        ("unexport" "f_unexpo.htm" "unexport")
-        ("unintern" "f_uninte.htm" "unintern")
-        ("union" "f_unionc.htm" "union")
-        ("unless" "m_when_.htm" "unless")
-        ("unread-char" "f_unrd_c.htm" "unread-char")
-        ("unsigned-byte" "t_unsgn_.htm" "unsigned-byte")
-        ("untrace" "m_tracec.htm" "untrace")
-        ("unuse-package" "f_unuse_.htm" "unuse-package")
-        ("unwind-protect" "s_unwind.htm" "unwind-protect")
-        ("update-instance-for-different-class" "f_update.htm" "update-instance-for-different-class")
-        ("update-instance-for-redefined-class" "f_upda_1.htm" "update-instance-for-redefined-class")
-        ("upgraded-array-element-type" "f_upgr_1.htm" "upgraded-array-element-type")
-        ("upgraded-complex-part-type" "f_upgrad.htm" "upgraded-complex-part-type")
-        ("upper-case-p" "f_upper_.htm" "upper-case-p")
-        ("use-package" "f_use_pk.htm" "use-package")
-        ("use-value" "a_use_va.htm" "use-value")
-        ("user-homedir-pathname" "f_user_h.htm" "user-homedir-pathname")
-        ("values" "a_values.htm" "values")
-        ("values-list" "f_vals_l.htm" "values-list")
-        ("variable" "f_docume.htm" "variable")
-        ("vector" "a_vector.htm" "vector")
-        ("vector-pop" "f_vec_po.htm" "vector-pop")
-        ("vector-push" "f_vec_ps.htm" "vector-push")
-        ("vector-push-extend" "f_vec_ps.htm" "vector-push-extend")
-        ("vectorp" "f_vecp.htm" "vectorp")
-        ("warn" "f_warn.htm" "warn")
-        ("warning" "e_warnin.htm" "warning")
-        ("when" "m_when_.htm" "when")
-        ("wild-pathname-p" "f_wild_p.htm" "wild-pathname-p")
-        ("with-accessors" "m_w_acce.htm" "with-accessors")
-        ("with-compilation-unit" "m_w_comp.htm" "with-compilation-unit")
-        ("with-condition-restarts" "m_w_cnd_.htm" "with-condition-restarts")
-        ("with-hash-table-iterator" "m_w_hash.htm" "with-hash-table-iterator")
-        ("with-input-from-string" "m_w_in_f.htm" "with-input-from-string")
-        ("with-open-file" "m_w_open.htm" "with-open-file")
-        ("with-open-stream" "m_w_op_1.htm" "with-open-stream")
-        ("with-output-to-string" "m_w_out_.htm" "with-output-to-string")
-        ("with-package-iterator" "m_w_pkg_.htm" "with-package-iterator")
-        ("with-simple-restart" "m_w_smp_.htm" "with-simple-restart")
-        ("with-slots" "m_w_slts.htm" "with-slots")
-        ("with-standard-io-syntax" "m_w_std_.htm" "with-standard-io-syntax")
-        ("write" "f_wr_pr.htm" "write")
-        ("write-byte" "f_wr_by.htm" "write-byte")
-        ("write-char" "f_wr_cha.htm" "write-char")
-        ("write-line" "f_wr_stg.htm" "write-line")
-        ("write-sequence" "f_wr_seq.htm" "write-sequence")
-        ("write-string" "f_wr_stg.htm" "write-string")
-        ("write-to-string" "f_wr_to_.htm" "write-to-string")
-        ("y-or-n-p" "f_y_or_n.htm" "y-or-n-p")
-        ("yes-or-no-p" "f_y_or_n.htm" "yes-or-no-p")
-        ("zerop" "f_zerop.htm" "zerop")))
+        ("least-positive-short-float" "v¬most¬1.htm" "least-positive-short-float")
+        ("least-positive-single-float" "v¬most¬1.htm" "least-positive-single-float")
+        ("length" "f¬length.htm" "length")
+        ("let" "s¬let¬l.htm" "let")
+        ("let*" "s¬let¬l.htm" "letST")
+        ("lisp-implementation-type" "f¬lisp¬i.htm" "lisp-implementation-type")
+        ("lisp-implementation-version" "f¬lisp¬i.htm" "lisp-implementation-version")
+        ("list" "a¬list.htm" "list")
+        ("list*" "f¬list¬.htm" "listST")
+        ("list-all-packages" "f¬list¬a.htm" "list-all-packages")
+        ("list-length" "f¬list¬l.htm" "list-length")
+        ("listen" "f¬listen.htm" "listen")
+        ("listp" "f¬listp.htm" "listp")
+        ("load" "f¬load.htm" "load")
+        ("load-logical-pathname-translations" "f¬ld¬log.htm" "load-logical-pathname-translations")
+        ("load-time-value" "s¬ld¬tim.htm" "load-time-value")
+        ("locally" "s¬locall.htm" "locally")
+        ("log" "f¬log.htm" "log")
+        ("logand" "f¬logand.htm" "logand")
+        ("logandc1" "f¬logand.htm" "logandc1")
+        ("logandc2" "f¬logand.htm" "logandc2")
+        ("logbitp" "f¬logbtp.htm" "logbitp")
+        ("logcount" "f¬logcou.htm" "logcount")
+        ("logeqv" "f¬logand.htm" "logeqv")
+        ("logical-pathname" "a¬logica.htm" "logical-pathname")
+        ("logical-pathname-translations" "f¬logica.htm" "logical-pathname-translations")
+        ("logior" "f¬logand.htm" "logior")
+        ("lognand" "f¬logand.htm" "lognand")
+        ("lognor" "f¬logand.htm" "lognor")
+        ("lognot" "f¬logand.htm" "lognot")
+        ("logorc1" "f¬logand.htm" "logorc1")
+        ("logorc2" "f¬logand.htm" "logorc2")
+        ("logtest" "f¬logtes.htm" "logtest")
+        ("logxor" "f¬logand.htm" "logxor")
+        ("long-float" "t¬short¬.htm" "long-float")
+        ("long-float-epsilon" "v¬short¬.htm" "long-float-epsilon")
+        ("long-float-negative-epsilon" "v¬short¬.htm" "long-float-negative-epsilon")
+        ("long-site-name" "f¬short¬.htm" "long-site-name")
+        ("loop" "m¬loop.htm" "loop")
+        ("loop-finish" "m¬loop¬f.htm" "loop-finish")
+        ("lower-case-p" "f¬upper¬.htm" "lower-case-p")
+        ("machine-instance" "f¬mach¬i.htm" "machine-instance")
+        ("machine-type" "f¬mach¬t.htm" "machine-type")
+        ("machine-version" "f¬mach¬v.htm" "machine-version")
+        ("macro-function" "f¬macro¬.htm" "macro-function")
+        ("macroexpand" "f¬mexp¬.htm" "macroexpand")
+        ("macroexpand-1" "f¬mexp¬.htm" "macroexpand-1")
+        ("macrolet" "s¬flet¬.htm" "macrolet")
+        ("make-array" "f¬mk¬ar.htm" "make-array")
+        ("make-broadcast-stream" "f¬mk¬bro.htm" "make-broadcast-stream")
+        ("make-concatenated-stream" "f¬mk¬con.htm" "make-concatenated-stream")
+        ("make-condition" "f¬mk¬cnd.htm" "make-condition")
+        ("make-dispatch-macro-character" "f¬mk¬dis.htm" "make-dispatch-macro-character")
+        ("make-echo-stream" "f¬mk¬ech.htm" "make-echo-stream")
+        ("make-hash-table" "f¬mk¬has.htm" "make-hash-table")
+        ("make-instance" "f¬mk¬ins.htm" "make-instance")
+        ("make-instances-obsolete" "f¬mk¬i¬1.htm" "make-instances-obsolete")
+        ("make-list" "f¬mk¬lis.htm" "make-list")
+        ("make-load-form" "f¬mk¬ld¬.htm" "make-load-form")
+        ("make-load-form-saving-slots" "f¬mk¬l¬1.htm" "make-load-form-saving-slots")
+        ("make-method" "m¬call¬m.htm" "make-method")
+        ("make-package" "f¬mk¬pkg.htm" "make-package")
+        ("make-pathname" "f¬mk¬pn.htm" "make-pathname")
+        ("make-random-state" "f¬mk¬rnd.htm" "make-random-state")
+        ("make-sequence" "f¬mk¬seq.htm" "make-sequence")
+        ("make-string" "f¬mk¬stg.htm" "make-string")
+        ("make-string-input-stream" "f¬mk¬s¬1.htm" "make-string-input-stream")
+        ("make-string-output-stream" "f¬mk¬s¬2.htm" "make-string-output-stream")
+        ("make-symbol" "f¬mk¬sym.htm" "make-symbol")
+        ("make-synonym-stream" "f¬mk¬syn.htm" "make-synonym-stream")
+        ("make-two-way-stream" "f¬mk¬two.htm" "make-two-way-stream")
+        ("makunbound" "f¬makunb.htm" "makunbound")
+        ("map" "f¬map.htm" "map")
+        ("map-into" "f¬map¬in.htm" "map-into")
+        ("mapc" "f¬mapc¬.htm" "mapc")
+        ("mapcan" "f¬mapc¬.htm" "mapcan")
+        ("mapcar" "f¬mapc¬.htm" "mapcar")
+        ("mapcon" "f¬mapc¬.htm" "mapcon")
+        ("maphash" "f¬maphas.htm" "maphash")
+        ("mapl" "f¬mapc¬.htm" "mapl")
+        ("maplist" "f¬mapc¬.htm" "maplist")
+        ("mask-field" "f¬mask¬f.htm" "mask-field")
+        ("max" "f¬max¬m.htm" "max")
+        ("member" "a¬member.htm" "member")
+        ("member-if" "f¬mem¬m.htm" "member-if")
+        ("member-if-not" "f¬mem¬m.htm" "member-if-not")
+        ("merge" "f¬merge.htm" "merge")
+        ("merge-pathnames" "f¬merge¬.htm" "merge-pathnames")
+        ("method" "t¬method.htm" "method")
+        ("method-combination" "a¬method.htm" "method-combination")
+        ("method-combination-error" "f¬meth¬1.htm" "method-combination-error")
+        ("method-qualifiers" "f¬method.htm" "method-qualifiers")
+        ("min" "f¬max¬m.htm" "min")
+        ("minusp" "f¬minusp.htm" "minusp")
+        ("mismatch" "f¬mismat.htm" "mismatch")
+        ("mod" "a¬mod.htm" "mod")
+        ("most-negative-double-float" "v¬most¬1.htm" "most-negative-double-float")
+        ("most-negative-fixnum" "v¬most¬p.htm" "most-negative-fixnum")
+        ("most-negative-long-float" "v¬most¬1.htm" "most-negative-long-float")
+        ("most-negative-short-float" "v¬most¬1.htm" "most-negative-short-float")
+        ("most-negative-single-float" "v¬most¬1.htm" "most-negative-single-float")
+        ("most-positive-double-float" "v¬most¬1.htm" "most-positive-double-float")
+        ("most-positive-fixnum" "v¬most¬p.htm" "most-positive-fixnum")
+        ("most-positive-long-float" "v¬most¬1.htm" "most-positive-long-float")
+        ("most-positive-short-float" "v¬most¬1.htm" "most-positive-short-float")
+        ("most-positive-single-float" "v¬most¬1.htm" "most-positive-single-float")
+        ("muffle-warning" "a¬muffle.htm" "muffle-warning")
+        ("multiple-value-bind" "m¬multip.htm" "multiple-value-bind")
+        ("multiple-value-call" "s¬multip.htm" "multiple-value-call")
+        ("multiple-value-list" "m¬mult¬1.htm" "multiple-value-list")
+        ("multiple-value-prog1" "s¬mult¬1.htm" "multiple-value-prog1")
+        ("multiple-value-setq" "m¬mult¬2.htm" "multiple-value-setq")
+        ("multiple-values-limit" "v¬multip.htm" "multiple-values-limit")
+        ("name-char" "f¬name¬c.htm" "name-char")
+        ("namestring" "f¬namest.htm" "namestring")
+        ("nbutlast" "f¬butlas.htm" "nbutlast")
+        ("nconc" "f¬nconc.htm" "nconc")
+        ("next-method-p" "f¬next¬m.htm" "next-method-p")
+        ("nil" "a¬nil.htm" "nil")
+        ("nintersection" "f¬isec¬.htm" "nintersection")
+        ("ninth" "f¬firstc.htm" "ninth")
+        ("no-applicable-method" "f¬no¬app.htm" "no-applicable-method")
+        ("no-next-method" "f¬no¬nex.htm" "no-next-method")
+        ("not" "a¬not.htm" "not")
+        ("notany" "f¬everyc.htm" "notany")
+        ("notevery" "f¬everyc.htm" "notevery")
+        ("notinline" "d¬inline.htm" "notinline")
+        ("nreconc" "f¬revapp.htm" "nreconc")
+        ("nreverse" "f¬revers.htm" "nreverse")
+        ("nset-difference" "f¬set¬di.htm" "nset-difference")
+        ("nset-exclusive-or" "f¬set¬ex.htm" "nset-exclusive-or")
+        ("nstring-capitalize" "f¬stg¬up.htm" "nstring-capitalize")
+        ("nstring-downcase" "f¬stg¬up.htm" "nstring-downcase")
+        ("nstring-upcase" "f¬stg¬up.htm" "nstring-upcase")
+        ("nsublis" "f¬sublis.htm" "nsublis")
+        ("nsubst" "f¬substc.htm" "nsubst")
+        ("nsubst-if" "f¬substc.htm" "nsubst-if")
+        ("nsubst-if-not" "f¬substc.htm" "nsubst-if-not")
+        ("nsubstitute" "f¬sbs¬s.htm" "nsubstitute")
+        ("nsubstitute-if" "f¬sbs¬s.htm" "nsubstitute-if")
+        ("nsubstitute-if-not" "f¬sbs¬s.htm" "nsubstitute-if-not")
+        ("nth" "f¬nth.htm" "nth")
+        ("nth-value" "m¬nth¬va.htm" "nth-value")
+        ("nthcdr" "f¬nthcdr.htm" "nthcdr")
+        ("null" "a¬null.htm" "null")
+        ("number" "t¬number.htm" "number")
+        ("numberp" "f¬nump.htm" "numberp")
+        ("numerator" "f¬numera.htm" "numerator")
+        ("nunion" "f¬unionc.htm" "nunion")
+        ("oddp" "f¬evenpc.htm" "oddp")
+        ("open" "f¬open.htm" "open")
+        ("open-stream-p" "f¬open¬s.htm" "open-stream-p")
+        ("optimize" "d¬optimi.htm" "optimize")
+        ("or" "a¬or.htm" "or")
+        ("otherwise" "m¬case¬.htm" "otherwise")
+        ("output-stream-p" "f¬in¬stm.htm" "output-stream-p")
+        ("package" "t¬pkg.htm" "package")
+        ("package-error" "e¬pkg¬er.htm" "package-error")
+        ("package-error-package" "f¬pkg¬er.htm" "package-error-package")
+        ("package-name" "f¬pkg¬na.htm" "package-name")
+        ("package-nicknames" "f¬pkg¬ni.htm" "package-nicknames")
+        ("package-shadowing-symbols" "f¬pkg¬sh.htm" "package-shadowing-symbols")
+        ("package-use-list" "f¬pkg¬us.htm" "package-use-list")
+        ("package-used-by-list" "f¬pkg¬¬1.htm" "package-used-by-list")
+        ("packagep" "f¬pkgp.htm" "packagep")
+        ("pairlis" "f¬pairli.htm" "pairlis")
+        ("parse-error" "e¬parse¬.htm" "parse-error")
+        ("parse-integer" "f¬parse¬.htm" "parse-integer")
+        ("parse-namestring" "f¬pars¬1.htm" "parse-namestring")
+        ("pathname" "a¬pn.htm" "pathname")
+        ("pathname-device" "f¬pn¬hos.htm" "pathname-device")
+        ("pathname-directory" "f¬pn¬hos.htm" "pathname-directory")
+        ("pathname-host" "f¬pn¬hos.htm" "pathname-host")
+        ("pathname-match-p" "f¬pn¬mat.htm" "pathname-match-p")
+        ("pathname-name" "f¬pn¬hos.htm" "pathname-name")
+        ("pathname-type" "f¬pn¬hos.htm" "pathname-type")
+        ("pathname-version" "f¬pn¬hos.htm" "pathname-version")
+        ("pathnamep" "f¬pnp.htm" "pathnamep")
+        ("peek-char" "f¬peek¬c.htm" "peek-char")
+        ("phase" "f¬phase.htm" "phase")
+        ("pi" "v¬pi.htm" "pi")
+        ("plusp" "f¬minusp.htm" "plusp")
+        ("pop" "m¬pop.htm" "pop")
+        ("position" "f¬pos¬p.htm" "position")
+        ("position-if" "f¬pos¬p.htm" "position-if")
+        ("position-if-not" "f¬pos¬p.htm" "position-if-not")
+        ("pprint" "f¬wr¬pr.htm" "pprint")
+        ("pprint-dispatch" "f¬ppr¬di.htm" "pprint-dispatch")
+        ("pprint-exit-if-list-exhausted" "m¬ppr¬ex.htm" "pprint-exit-if-list-exhausted")
+        ("pprint-fill" "f¬ppr¬fi.htm" "pprint-fill")
+        ("pprint-indent" "f¬ppr¬in.htm" "pprint-indent")
+        ("pprint-linear" "f¬ppr¬fi.htm" "pprint-linear")
+        ("pprint-logical-block" "m¬ppr¬lo.htm" "pprint-logical-block")
+        ("pprint-newline" "f¬ppr¬nl.htm" "pprint-newline")
+        ("pprint-pop" "m¬ppr¬po.htm" "pprint-pop")
+        ("pprint-tab" "f¬ppr¬ta.htm" "pprint-tab")
+        ("pprint-tabular" "f¬ppr¬fi.htm" "pprint-tabular")
+        ("prin1" "f¬wr¬pr.htm" "prin1")
+        ("prin1-to-string" "f¬wr¬to¬.htm" "prin1-to-string")
+        ("princ" "f¬wr¬pr.htm" "princ")
+        ("princ-to-string" "f¬wr¬to¬.htm" "princ-to-string")
+        ("print" "f¬wr¬pr.htm" "print")
+        ("print-not-readable" "e¬pr¬not.htm" "print-not-readable")
+        ("print-not-readable-object" "f¬pr¬not.htm" "print-not-readable-object")
+        ("print-object" "f¬pr¬obj.htm" "print-object")
+        ("print-unreadable-object" "m¬pr¬unr.htm" "print-unreadable-object")
+        ("probe-file" "f¬probe¬.htm" "probe-file")
+        ("proclaim" "f¬procla.htm" "proclaim")
+        ("prog" "m¬prog¬.htm" "prog")
+        ("prog*" "m¬prog¬.htm" "progST")
+        ("prog1" "m¬prog1c.htm" "prog1")
+        ("prog2" "m¬prog1c.htm" "prog2")
+        ("progn" "s¬progn.htm" "progn")
+        ("program-error" "e¬progra.htm" "program-error")
+        ("progv" "s¬progv.htm" "progv")
+        ("provide" "f¬provid.htm" "provide")
+        ("psetf" "m¬setf¬.htm" "psetf")
+        ("psetq" "m¬psetq.htm" "psetq")
+        ("push" "m¬push.htm" "push")
+        ("pushnew" "m¬pshnew.htm" "pushnew")
+        ("quote" "s¬quote.htm" "quote")
+        ("random" "f¬random.htm" "random")
+        ("random-state" "t¬rnd¬st.htm" "random-state")
+        ("random-state-p" "f¬rnd¬st.htm" "random-state-p")
+        ("rassoc" "f¬rassoc.htm" "rassoc")
+        ("rassoc-if" "f¬rassoc.htm" "rassoc-if")
+        ("rassoc-if-not" "f¬rassoc.htm" "rassoc-if-not")
+        ("ratio" "t¬ratio.htm" "ratio")
+        ("rational" "a¬ration.htm" "rational")
+        ("rationalize" "f¬ration.htm" "rationalize")
+        ("rationalp" "f¬rati¬1.htm" "rationalp")
+        ("read" "f¬rd¬rd.htm" "read")
+        ("read-byte" "f¬rd¬by.htm" "read-byte")
+        ("read-char" "f¬rd¬cha.htm" "read-char")
+        ("read-char-no-hang" "f¬rd¬c¬1.htm" "read-char-no-hang")
+        ("read-delimited-list" "f¬rd¬del.htm" "read-delimited-list")
+        ("read-from-string" "f¬rd¬fro.htm" "read-from-string")
+        ("read-line" "f¬rd¬lin.htm" "read-line")
+        ("read-preserving-whitespace" "f¬rd¬rd.htm" "read-preserving-whitespace")
+        ("read-sequence" "f¬rd¬seq.htm" "read-sequence")
+        ("reader-error" "e¬rder¬e.htm" "reader-error")
+        ("readtable" "t¬rdtabl.htm" "readtable")
+        ("readtable-case" "f¬rdtabl.htm" "readtable-case")
+        ("readtablep" "f¬rdta¬1.htm" "readtablep")
+        ("real" "t¬real.htm" "real")
+        ("realp" "f¬realp.htm" "realp")
+        ("realpart" "f¬realpa.htm" "realpart")
+        ("reduce" "f¬reduce.htm" "reduce")
+        ("reinitialize-instance" "f¬reinit.htm" "reinitialize-instance")
+        ("rem" "f¬mod¬r.htm" "rem")
+        ("remf" "m¬remf.htm" "remf")
+        ("remhash" "f¬remhas.htm" "remhash")
+        ("remove" "f¬rm¬rm.htm" "remove")
+        ("remove-duplicates" "f¬rm¬dup.htm" "remove-duplicates")
+        ("remove-if" "f¬rm¬rm.htm" "remove-if")
+        ("remove-if-not" "f¬rm¬rm.htm" "remove-if-not")
+        ("remove-method" "f¬rm¬met.htm" "remove-method")
+        ("remprop" "f¬rempro.htm" "remprop")
+        ("rename-file" "f¬rn¬fil.htm" "rename-file")
+        ("rename-package" "f¬rn¬pkg.htm" "rename-package")
+        ("replace" "f¬replac.htm" "replace")
+        ("require" "f¬provid.htm" "require")
+        ("rest" "f¬rest.htm" "rest")
+        ("restart" "t¬rst.htm" "restart")
+        ("restart-bind" "m¬rst¬bi.htm" "restart-bind")
+        ("restart-case" "m¬rst¬ca.htm" "restart-case")
+        ("restart-name" "f¬rst¬na.htm" "restart-name")
+        ("return" "m¬return.htm" "return")
+        ("return-from" "s¬ret¬fr.htm" "return-from")
+        ("revappend" "f¬revapp.htm" "revappend")
+        ("reverse" "f¬revers.htm" "reverse")
+        ("room" "f¬room.htm" "room")
+        ("rotatef" "m¬rotate.htm" "rotatef")
+        ("round" "f¬floorc.htm" "round")
+        ("row-major-aref" "f¬row¬ma.htm" "row-major-aref")
+        ("rplaca" "f¬rplaca.htm" "rplaca")
+        ("rplacd" "f¬rplaca.htm" "rplacd")
+        ("safety" "d¬optimi.htm" "safety")
+        ("satisfies" "t¬satisf.htm" "satisfies")
+        ("sbit" "f¬bt¬sb.htm" "sbit")
+        ("scale-float" "f¬dec¬fl.htm" "scale-float")
+        ("schar" "f¬char¬.htm" "schar")
+        ("search" "f¬search.htm" "search")
+        ("second" "f¬firstc.htm" "second")
+        ("sequence" "t¬seq.htm" "sequence")
+        ("serious-condition" "e¬seriou.htm" "serious-condition")
+        ("set" "f¬set.htm" "set")
+        ("set-difference" "f¬set¬di.htm" "set-difference")
+        ("set-dispatch-macro-character" "f¬set¬¬1.htm" "set-dispatch-macro-character")
+        ("set-exclusive-or" "f¬set¬ex.htm" "set-exclusive-or")
+        ("set-macro-character" "f¬set¬ma.htm" "set-macro-character")
+        ("set-pprint-dispatch" "f¬set¬pp.htm" "set-pprint-dispatch")
+        ("set-syntax-from-char" "f¬set¬sy.htm" "set-syntax-from-char")
+        ("setf" "a¬setf.htm" "setf")
+        ("setq" "s¬setq.htm" "setq")
+        ("seventh" "f¬firstc.htm" "seventh")
+        ("shadow" "f¬shadow.htm" "shadow")
+        ("shadowing-import" "f¬shdw¬i.htm" "shadowing-import")
+        ("shared-initialize" "f¬shared.htm" "shared-initialize")
+        ("shiftf" "m¬shiftf.htm" "shiftf")
+        ("short-float" "t¬short¬.htm" "short-float")
+        ("short-float-epsilon" "v¬short¬.htm" "short-float-epsilon")
+        ("short-float-negative-epsilon" "v¬short¬.htm" "short-float-negative-epsilon")
+        ("short-site-name" "f¬short¬.htm" "short-site-name")
+        ("signal" "f¬signal.htm" "signal")
+        ("signed-byte" "t¬sgn¬by.htm" "signed-byte")
+        ("signum" "f¬signum.htm" "signum")
+        ("simple-array" "t¬smp¬ar.htm" "simple-array")
+        ("simple-base-string" "t¬smp¬ba.htm" "simple-base-string")
+        ("simple-bit-vector" "t¬smp¬bt.htm" "simple-bit-vector")
+        ("simple-bit-vector-p" "f¬smp¬bt.htm" "simple-bit-vector-p")
+        ("simple-condition" "e¬smp¬cn.htm" "simple-condition")
+        ("simple-condition-format-arguments" "f¬smp¬cn.htm" "simple-condition-format-arguments")
+        ("simple-condition-format-control" "f¬smp¬cn.htm" "simple-condition-format-control")
+        ("simple-error" "e¬smp¬er.htm" "simple-error")
+        ("simple-string" "t¬smp¬st.htm" "simple-string")
+        ("simple-string-p" "f¬smp¬st.htm" "simple-string-p")
+        ("simple-type-error" "e¬smp¬tp.htm" "simple-type-error")
+        ("simple-vector" "t¬smp¬ve.htm" "simple-vector")
+        ("simple-vector-p" "f¬smp¬ve.htm" "simple-vector-p")
+        ("simple-warning" "e¬smp¬wa.htm" "simple-warning")
+        ("sin" "f¬sin¬c.htm" "sin")
+        ("single-float" "t¬short¬.htm" "single-float")
+        ("single-float-epsilon" "v¬short¬.htm" "single-float-epsilon")
+        ("single-float-negative-epsilon" "v¬short¬.htm" "single-float-negative-epsilon")
+        ("sinh" "f¬sinh¬.htm" "sinh")
+        ("sixth" "f¬firstc.htm" "sixth")
+        ("sleep" "f¬sleep.htm" "sleep")
+        ("slot-boundp" "f¬slt¬bo.htm" "slot-boundp")
+        ("slot-exists-p" "f¬slt¬ex.htm" "slot-exists-p")
+        ("slot-makunbound" "f¬slt¬ma.htm" "slot-makunbound")
+        ("slot-missing" "f¬slt¬mi.htm" "slot-missing")
+        ("slot-unbound" "f¬slt¬un.htm" "slot-unbound")
+        ("slot-value" "f¬slt¬va.htm" "slot-value")
+        ("software-type" "f¬sw¬tpc.htm" "software-type")
+        ("software-version" "f¬sw¬tpc.htm" "software-version")
+        ("some" "f¬everyc.htm" "some")
+        ("sort" "f¬sort¬.htm" "sort")
+        ("space" "d¬optimi.htm" "space")
+        ("special" "d¬specia.htm" "special")
+        ("special-operator-p" "f¬specia.htm" "special-operator-p")
+        ("speed" "d¬optimi.htm" "speed")
+        ("sqrt" "f¬sqrt¬.htm" "sqrt")
+        ("stable-sort" "f¬sort¬.htm" "stable-sort")
+        ("standard" "07¬ffb.htm" "standard")
+        ("standard-char" "t¬std¬ch.htm" "standard-char")
+        ("standard-char-p" "f¬std¬ch.htm" "standard-char-p")
+        ("standard-class" "t¬std¬cl.htm" "standard-class")
+        ("standard-generic-function" "t¬std¬ge.htm" "standard-generic-function")
+        ("standard-method" "t¬std¬me.htm" "standard-method")
+        ("standard-object" "t¬std¬ob.htm" "standard-object")
+        ("step" "m¬step.htm" "step")
+        ("storage-condition" "e¬storag.htm" "storage-condition")
+        ("store-value" "a¬store¬.htm" "store-value")
+        ("stream" "t¬stream.htm" "stream")
+        ("stream-element-type" "f¬stm¬el.htm" "stream-element-type")
+        ("stream-error" "e¬stm¬er.htm" "stream-error")
+        ("stream-error-stream" "f¬stm¬er.htm" "stream-error-stream")
+        ("stream-external-format" "f¬stm¬ex.htm" "stream-external-format")
+        ("streamp" "f¬stmp.htm" "streamp")
+        ("string" "a¬string.htm" "string")
+        ("string-capitalize" "f¬stg¬up.htm" "string-capitalize")
+        ("string-downcase" "f¬stg¬up.htm" "string-downcase")
+        ("string-equal" "f¬stgeq¬.htm" "string-equal")
+        ("string-greaterp" "f¬stgeq¬.htm" "string-greaterp")
+        ("string-left-trim" "f¬stg¬tr.htm" "string-left-trim")
+        ("string-lessp" "f¬stgeq¬.htm" "string-lessp")
+        ("string-not-equal" "f¬stgeq¬.htm" "string-not-equal")
+        ("string-not-greaterp" "f¬stgeq¬.htm" "string-not-greaterp")
+        ("string-not-lessp" "f¬stgeq¬.htm" "string-not-lessp")
+        ("string-right-trim" "f¬stg¬tr.htm" "string-right-trim")
+        ("string-stream" "t¬stg¬st.htm" "string-stream")
+        ("string-trim" "f¬stg¬tr.htm" "string-trim")
+        ("string-upcase" "f¬stg¬up.htm" "string-upcase")
+        ("string/=" "f¬stgeq¬.htm" "stringSLEQ")
+        ("string&lt;" "f¬stgeq¬.htm" "stringLT")
+        ("string&lt;=" "f¬stgeq¬.htm" "stringLTEQ")
+        ("string=" "f¬stgeq¬.htm" "stringEQ")
+        ("string&gt;" "f¬stgeq¬.htm" "stringGT")
+        ("string&gt;=" "f¬stgeq¬.htm" "stringGTEQ")
+        ("stringp" "f¬stgp.htm" "stringp")
+        ("structure" "f¬docume.htm" "structure")
+        ("structure-class" "t¬stu¬cl.htm" "structure-class")
+        ("structure-object" "t¬stu¬ob.htm" "structure-object")
+        ("style-warning" "e¬style¬.htm" "style-warning")
+        ("sublis" "f¬sublis.htm" "sublis")
+        ("subseq" "f¬subseq.htm" "subseq")
+        ("subsetp" "f¬subset.htm" "subsetp")
+        ("subst" "f¬substc.htm" "subst")
+        ("subst-if" "f¬substc.htm" "subst-if")
+        ("subst-if-not" "f¬substc.htm" "subst-if-not")
+        ("substitute" "f¬sbs¬s.htm" "substitute")
+        ("substitute-if" "f¬sbs¬s.htm" "substitute-if")
+        ("substitute-if-not" "f¬sbs¬s.htm" "substitute-if-not")
+        ("subtypep" "f¬subtpp.htm" "subtypep")
+        ("svref" "f¬svref.htm" "svref")
+        ("sxhash" "f¬sxhash.htm" "sxhash")
+        ("symbol" "t¬symbol.htm" "symbol")
+        ("symbol-function" "f¬symb¬1.htm" "symbol-function")
+        ("symbol-macrolet" "s¬symbol.htm" "symbol-macrolet")
+        ("symbol-name" "f¬symb¬2.htm" "symbol-name")
+        ("symbol-package" "f¬symb¬3.htm" "symbol-package")
+        ("symbol-plist" "f¬symb¬4.htm" "symbol-plist")
+        ("symbol-value" "f¬symb¬5.htm" "symbol-value")
+        ("symbolp" "f¬symbol.htm" "symbolp")
+        ("synonym-stream" "t¬syn¬st.htm" "synonym-stream")
+        ("synonym-stream-symbol" "f¬syn¬st.htm" "synonym-stream-symbol")
+        ("t" "a¬t.htm" "t")
+        ("tagbody" "s¬tagbod.htm" "tagbody")
+        ("tailp" "f¬ldiffc.htm" "tailp")
+        ("tan" "f¬sin¬c.htm" "tan")
+        ("tanh" "f¬sinh¬.htm" "tanh")
+        ("tenth" "f¬firstc.htm" "tenth")
+        ("terpri" "f¬terpri.htm" "terpri")
+        ("the" "s¬the.htm" "the")
+        ("third" "f¬firstc.htm" "third")
+        ("throw" "s¬throw.htm" "throw")
+        ("time" "m¬time.htm" "time")
+        ("trace" "m¬tracec.htm" "trace")
+        ("translate-logical-pathname" "f¬tr¬log.htm" "translate-logical-pathname")
+        ("translate-pathname" "f¬tr¬pn.htm" "translate-pathname")
+        ("tree-equal" "f¬tree¬e.htm" "tree-equal")
+        ("truename" "f¬tn.htm" "truename")
+        ("truncate" "f¬floorc.htm" "truncate")
+        ("two-way-stream" "t¬two¬wa.htm" "two-way-stream")
+        ("two-way-stream-input-stream" "f¬two¬wa.htm" "two-way-stream-input-stream")
+        ("two-way-stream-output-stream" "f¬two¬wa.htm" "two-way-stream-output-stream")
+        ("type" "a¬type.htm" "type")
+        ("type-error" "e¬tp¬err.htm" "type-error")
+        ("type-error-datum" "f¬tp¬err.htm" "type-error-datum")
+        ("type-error-expected-type" "f¬tp¬err.htm" "type-error-expected-type")
+        ("type-of" "f¬tp¬of.htm" "type-of")
+        ("typecase" "m¬tpcase.htm" "typecase")
+        ("typep" "f¬typep.htm" "typep")
+        ("unbound-slot" "e¬unboun.htm" "unbound-slot")
+        ("unbound-slot-instance" "f¬unboun.htm" "unbound-slot-instance")
+        ("unbound-variable" "e¬unbo¬1.htm" "unbound-variable")
+        ("undefined-function" "e¬undefi.htm" "undefined-function")
+        ("unexport" "f¬unexpo.htm" "unexport")
+        ("unintern" "f¬uninte.htm" "unintern")
+        ("union" "f¬unionc.htm" "union")
+        ("unless" "m¬when¬.htm" "unless")
+        ("unread-char" "f¬unrd¬c.htm" "unread-char")
+        ("unsigned-byte" "t¬unsgn¬.htm" "unsigned-byte")
+        ("untrace" "m¬tracec.htm" "untrace")
+        ("unuse-package" "f¬unuse¬.htm" "unuse-package")
+        ("unwind-protect" "s¬unwind.htm" "unwind-protect")
+        ("update-instance-for-different-class" "f¬update.htm" "update-instance-for-different-class")
+        ("update-instance-for-redefined-class" "f¬upda¬1.htm" "update-instance-for-redefined-class")
+        ("upgraded-array-element-type" "f¬upgr¬1.htm" "upgraded-array-element-type")
+        ("upgraded-complex-part-type" "f¬upgrad.htm" "upgraded-complex-part-type")
+        ("upper-case-p" "f¬upper¬.htm" "upper-case-p")
+        ("use-package" "f¬use¬pk.htm" "use-package")
+        ("use-value" "a¬use¬va.htm" "use-value")
+        ("user-homedir-pathname" "f¬user¬h.htm" "user-homedir-pathname")
+        ("values" "a¬values.htm" "values")
+        ("values-list" "f¬vals¬l.htm" "values-list")
+        ("variable" "f¬docume.htm" "variable")
+        ("vector" "a¬vector.htm" "vector")
+        ("vector-pop" "f¬vec¬po.htm" "vector-pop")
+        ("vector-push" "f¬vec¬ps.htm" "vector-push")
+        ("vector-push-extend" "f¬vec¬ps.htm" "vector-push-extend")
+        ("vectorp" "f¬vecp.htm" "vectorp")
+        ("warn" "f¬warn.htm" "warn")
+        ("warning" "e¬warnin.htm" "warning")
+        ("when" "m¬when¬.htm" "when")
+        ("wild-pathname-p" "f¬wild¬p.htm" "wild-pathname-p")
+        ("with-accessors" "m¬w¬acce.htm" "with-accessors")
+        ("with-compilation-unit" "m¬w¬comp.htm" "with-compilation-unit")
+        ("with-condition-restarts" "m¬w¬cnd¬.htm" "with-condition-restarts")
+        ("with-hash-table-iterator" "m¬w¬hash.htm" "with-hash-table-iterator")
+        ("with-input-from-string" "m¬w¬in¬f.htm" "with-input-from-string")
+        ("with-open-file" "m¬w¬open.htm" "with-open-file")
+        ("with-open-stream" "m¬w¬op¬1.htm" "with-open-stream")
+        ("with-output-to-string" "m¬w¬out¬.htm" "with-output-to-string")
+        ("with-package-iterator" "m¬w¬pkg¬.htm" "with-package-iterator")
+        ("with-simple-restart" "m¬w¬smp¬.htm" "with-simple-restart")
+        ("with-slots" "m¬w¬slts.htm" "with-slots")
+        ("with-standard-io-syntax" "m¬w¬std¬.htm" "with-standard-io-syntax")
+        ("write" "f¬wr¬pr.htm" "write")
+        ("write-byte" "f¬wr¬by.htm" "write-byte")
+        ("write-char" "f¬wr¬cha.htm" "write-char")
+        ("write-line" "f¬wr¬stg.htm" "write-line")
+        ("write-sequence" "f¬wr¬seq.htm" "write-sequence")
+        ("write-string" "f¬wr¬stg.htm" "write-string")
+        ("write-to-string" "f¬wr¬to¬.htm" "write-to-string")
+        ("y-or-n-p" "f¬y¬or¬n.htm" "y-or-n-p")
+        ("yes-or-no-p" "f¬y¬or¬n.htm" "yes-or-no-p")
+        ("zerop" "f¬zerop.htm" "zerop")))
 
 (RPAQ? CLHS.ROOT.URL
 "https://interlisp.org/clhs/")
 
@@ -1701,14 +1703,14 @@
 
 (PUTPROPS HELPSYS
 FILETYPE
 :FAKE-COMPILE-FILE)
 (DECLARE%: DONTCOPY
-  (FILEMAP (NIL (4643 10376 (HELPSYS 4653 . 6494) (IRM.LOOKUP 6496 . 8134) (GENERIC.MAN.LOOKUP 8136 . 
-9805) (IRM.SMART.LOOKUP 9807 . 9963) (IRM.RESET 9965 . 10374)) (10633 17686 (CLHS.INDEX 10643 . 13341)
- (CLHS.LOOKUP 13343 . 15349) (CLHS.OPENER 15351 . 16674) (REPO.LOOKUP 16676 . 17684)) (70781 72299 (
-IRM.GET.DINFOGRAPH 70791 . 71666) (IRM.DISPLAY.REF 71668 . 72297)) (72301 72663 (IRM.LOAD-GRAPH 72301
- . 72663)) (72988 78492 (IRM.DISPLAY.CREF 72998 . 74712) (IRM.CREF.BOX 74714 . 75541) (IRM.PUT.CREF 
-75543 . 75768) (IRM.GET.CREF 75770 . 76141) (IRM.CREF.BUTTONEVENTFN 76143 . 78490)) (79047 87353 (
-\IRM.GET.REF 79057 . 80388) (\IRM.SMART.REF 80390 . 82317) (\IRM.CHOOSE.REF 82319 . 83570) (
-\IRM.WILD.REF 83572 . 84827) (\IRM.WILDCARD 84829 . 85195) (\IRM.WILD.MATCH 85197 . 86427) (
-\IRM.GET.HASHFILE 86429 . 86892) (\IRM.GET.KEYWORDS 86894 . 87351)) (87490 87646 (\IRM.AROUND-EXIT 
-87490 . 87646)))))
+  (FILEMAP (NIL (4571 10304 (HELPSYS 4581 . 6422) (IRM.LOOKUP 6424 . 8062) (GENERIC.MAN.LOOKUP 8064 . 
+9733) (IRM.SMART.LOOKUP 9735 . 9891) (IRM.RESET 9893 . 10302)) (10561 17880 (CLHS.INDEX 10571 . 13535)
+ (CLHS.LOOKUP 13537 . 15543) (CLHS.OPENER 15545 . 16868) (REPO.LOOKUP 16870 . 17878)) (70975 72493 (
+IRM.GET.DINFOGRAPH 70985 . 71860) (IRM.DISPLAY.REF 71862 . 72491)) (72495 72857 (IRM.LOAD-GRAPH 72495
+ . 72857)) (73182 78686 (IRM.DISPLAY.CREF 73192 . 74906) (IRM.CREF.BOX 74908 . 75735) (IRM.PUT.CREF 
+75737 . 75962) (IRM.GET.CREF 75964 . 76335) (IRM.CREF.BUTTONEVENTFN 76337 . 78684)) (79241 87547 (
+\IRM.GET.REF 79251 . 80582) (\IRM.SMART.REF 80584 . 82511) (\IRM.CHOOSE.REF 82513 . 83764) (
+\IRM.WILD.REF 83766 . 85021) (\IRM.WILDCARD 85023 . 85389) (\IRM.WILD.MATCH 85391 . 86621) (
+\IRM.GET.HASHFILE 86623 . 87086) (\IRM.GET.KEYWORDS 87088 . 87545)) (87684 87840 (\IRM.AROUND-EXIT 
+87684 . 87840)))))
 STOP
diff --git a/lispusers/HELPSYS.LCOM b/lispusers/HELPSYS.LCOM
index c4e9a2cff..d7b729ab6 100644
Binary files a/lispusers/HELPSYS.LCOM and b/lispusers/HELPSYS.LCOM differ
diff --git a/lispusers/PRETTYFILEINDEX b/lispusers/PRETTYFILEINDEX
index f9854b86b..eb21bf0b6 100644
--- a/lispusers/PRETTYFILEINDEX
+++ b/lispusers/PRETTYFILEINDEX
@@ -1,13 +1,14 @@
 (DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
 
-
(FILECREATED "10-May-2023 09:12:17" {DSK}<home>larry>il>medley>lispusers>PRETTYFILEINDEX.;12
 101009 
+
(FILECREATED "21-Sep-2025 09:50:47" 
+{DSK}<Users>kaplan>Local>medley3.5>working-medley>lispusers>PRETTYFILEINDEX.;13
 100936 
 
-      :EDIT-BY "lmm"
+      :EDIT-BY rmk
 
-      :CHANGES-TO (FNS PFI.PRINT.FILECREATED)
+      :CHANGES-TO (VARS PRETTYFILEINDEXCOMS)
 
-      :PREVIOUS-DATE " 3-Jul-2022 15:28:08" {DSK}<home>larry>il>medley>lispusers>PRETTYFILEINDEX.;11
-)
+      :PREVIOUS-DATE "10-May-2023 09:12:17" 
+{DSK}<Users>kaplan>Local>medley3.5>working-medley>lispusers>PRETTYFILEINDEX.;12)
 
 
 (PRETTYCOMPRINT PRETTYFILEINDEXCOMS)
@@ -47,8 +48,7 @@
         (INITVARS [*PFI-PRINTOPTIONS* '(REGION (72 54 504 702]
                (*PFI-DONT-SPAWN*)
                (*PFI-MAX-WASTED-LINES* 12)
-               [*PFI-CHARACTER-TRANSLATIONS* '((INTERPRESS (95 172)
-                                                      (96 169 FAMILY CLASSIC)
+               [*PFI-CHARACTER-TRANSLATIONS* '((INTERPRESS (96 169 FAMILY CLASSIC)
                                                       (39 185 FAMILY CLASSIC]
                (*PFI-INDEX-ORDER* '(FUNCTIONS))
                [*PFI-DEFINER-PROPS* (LET ((*PACKAGE* (if (EQ MAKESYSNAME :LYRIC)
@@ -1023,8 +1023,7 @@
 
 (RPAQ? *PFI-MAX-WASTED-LINES*
 12)
 
-(RPAQ? *PFI-CHARACTER-TRANSLATIONS*
 '((INTERPRESS (95 172)
-                                             (96 169 FAMILY CLASSIC)
+(RPAQ? *PFI-CHARACTER-TRANSLATIONS*
 '((INTERPRESS (96 169 FAMILY CLASSIC)
                                              (39 185 FAMILY CLASSIC))))
 
 (RPAQ? *PFI-INDEX-ORDER*
 '(FUNCTIONS))
@@ -1194,28 +1193,28 @@
        'NON.PFI.PRINT.BITMAP NIL T)
 )
 (DECLARE%: DONTCOPY
-  (FILEMAP (NIL (9974 12209 (PFI.NEW.LISTFILES1 9984 . 10478) (PFI.ENQUEUE 10480 . 11104) (
-\PFI.DO.HARDCOPY 11106 . 11692) (MAYBE.PRETTYFILEINDEX 11694 . 12207)) (12210 34725 (PRETTYFILEINDEX 
-12220 . 26253) (PFI.MAKE.LPT.STREAM 26255 . 29306) (PFI.SETUP.TRANSLATIONS 29308 . 30822) (
-PFI.OUTCHARFN 30824 . 32798) (PFI.COLLECT.DEFINERS 32800 . 33612) (PFI.AFTER.NEW.PAGE 33614 . 34723)) 
-(34726 41240 (PFI.PRINT.FILECREATED 34736 . 39427) (PFI.PRINT.TO.TAB 39429 . 39874) (
-PFI.PRINT.ENVIRONMENT 39876 . 41238)) (41241 48756 (PFI.PROCESS.FILE 41251 . 42481) (PFI.PASS.COMMENT 
-42483 . 43453) (PFI.HANDLE.EXPR 43455 . 44122) (PFI.DEFAULT.HANDLER 44124 . 46177) (PFI.PRETTYPRINT 
-46179 . 46514) (PFI.LINES.REMAINING 46516 . 46843) (PFI.MAYBE.NEW.PAGE 46845 . 47679) (
-PFI.ESTIMATE.SIZE 47681 . 48212) (PFI.ESTIMATE.SIZE1 48214 . 48754)) (48793 59002 (PFI.HANDLE.RPAQQ 
-48803 . 50211) (PFI.HANDLE.DECLARE 50213 . 51152) (PFI.HANDLE.EVAL-WHEN 51154 . 51637) (
-PFI.HANDLE.DEFDEFINER 51639 . 52929) (PFI.HANDLE.DEFINEQ 52931 . 53175) (PFI.PRINT.LAMBDA 53177 . 
-53515) (PFI.PRINT.LAMBDA.BODY 53517 . 53852) (PFI.HANDLE.PUTDEF 53854 . 54351) (PFI.HANDLE.PUTPROPS 
-54353 . 54968) (PFI.HANDLE./DECLAREDATATYPE 54970 . 55517) (PFI.HANDLE.* 55519 . 56781) (
-PFI.PRINT.COMMENTS 56783 . 58405) (PFI.HANDLE.FILEMAP 58407 . 58695) (PFI.HANDLE.PACKAGE 58697 . 59000
-)) (59030 60022 (PFI.PREVIEW.DECLARE 59040 . 59702) (PFI.PREVIEW.DEFINEQ 59704 . 60020)) (60058 71046 
-(PFI.PRINT.INDEX 60068 . 60919) (PFI.CONDENSE.INDEX 60921 . 62728) (PFI.SORT.INDICES 62730 . 63869) (
-PFI.COMPUTE.INDEX.SHAPE 63871 . 65335) (PFI.PRINT.INDICES 65337 . 69879) (PFI.CENTER.PRINT 69881 . 
-70451) (PFI.INDEX.BREAK 70453 . 70911) (PFI.LOOKUP.NAME 70913 . 71044)) (71047 72278 (PFI.ADD.TO.INDEX
- 71057 . 71567) (PFI.VARNAME 71569 . 71979) (PFI.CONSTANTNAMES 71981 . 72276)) (72313 80626 (
-MULTIFILEINDEX 72323 . 73119) (MULTIFILEINDEX1 73121 . 74577) (PFI.PRINT.MULTI.INDEX 74579 . 79682) (
-PFI.CHOOSE.BEST 79684 . 79911) (PFI.MERGE.INDICES 79913 . 80624)) (80683 83752 (PFI.MAYBE.SEE.PRETTY 
-80693 . 82476) (PFI.MAYBE.PP.DEFINITION 82478 . 83750)) (83822 91932 (PFI.PRINT.BITMAP 83832 . 91930))
- (94701 97815 (PUTPROPS.PRETTYPRINT 94711 . 96122) (RPAQX.PRETTYPRINT 96124 . 96849) (
-COURIERPROGRAM.PRETTYPRINT 96851 . 97551) (MAYBE.PRETTYPRINT.BOLD 97553 . 97813)))))
+  (FILEMAP (NIL (9955 12190 (PFI.NEW.LISTFILES1 9965 . 10459) (PFI.ENQUEUE 10461 . 11085) (
+\PFI.DO.HARDCOPY 11087 . 11673) (MAYBE.PRETTYFILEINDEX 11675 . 12188)) (12191 34706 (PRETTYFILEINDEX 
+12201 . 26234) (PFI.MAKE.LPT.STREAM 26236 . 29287) (PFI.SETUP.TRANSLATIONS 29289 . 30803) (
+PFI.OUTCHARFN 30805 . 32779) (PFI.COLLECT.DEFINERS 32781 . 33593) (PFI.AFTER.NEW.PAGE 33595 . 34704)) 
+(34707 41221 (PFI.PRINT.FILECREATED 34717 . 39408) (PFI.PRINT.TO.TAB 39410 . 39855) (
+PFI.PRINT.ENVIRONMENT 39857 . 41219)) (41222 48737 (PFI.PROCESS.FILE 41232 . 42462) (PFI.PASS.COMMENT 
+42464 . 43434) (PFI.HANDLE.EXPR 43436 . 44103) (PFI.DEFAULT.HANDLER 44105 . 46158) (PFI.PRETTYPRINT 
+46160 . 46495) (PFI.LINES.REMAINING 46497 . 46824) (PFI.MAYBE.NEW.PAGE 46826 . 47660) (
+PFI.ESTIMATE.SIZE 47662 . 48193) (PFI.ESTIMATE.SIZE1 48195 . 48735)) (48774 58983 (PFI.HANDLE.RPAQQ 
+48784 . 50192) (PFI.HANDLE.DECLARE 50194 . 51133) (PFI.HANDLE.EVAL-WHEN 51135 . 51618) (
+PFI.HANDLE.DEFDEFINER 51620 . 52910) (PFI.HANDLE.DEFINEQ 52912 . 53156) (PFI.PRINT.LAMBDA 53158 . 
+53496) (PFI.PRINT.LAMBDA.BODY 53498 . 53833) (PFI.HANDLE.PUTDEF 53835 . 54332) (PFI.HANDLE.PUTPROPS 
+54334 . 54949) (PFI.HANDLE./DECLAREDATATYPE 54951 . 55498) (PFI.HANDLE.* 55500 . 56762) (
+PFI.PRINT.COMMENTS 56764 . 58386) (PFI.HANDLE.FILEMAP 58388 . 58676) (PFI.HANDLE.PACKAGE 58678 . 58981
+)) (59011 60003 (PFI.PREVIEW.DECLARE 59021 . 59683) (PFI.PREVIEW.DEFINEQ 59685 . 60001)) (60039 71027 
+(PFI.PRINT.INDEX 60049 . 60900) (PFI.CONDENSE.INDEX 60902 . 62709) (PFI.SORT.INDICES 62711 . 63850) (
+PFI.COMPUTE.INDEX.SHAPE 63852 . 65316) (PFI.PRINT.INDICES 65318 . 69860) (PFI.CENTER.PRINT 69862 . 
+70432) (PFI.INDEX.BREAK 70434 . 70892) (PFI.LOOKUP.NAME 70894 . 71025)) (71028 72259 (PFI.ADD.TO.INDEX
+ 71038 . 71548) (PFI.VARNAME 71550 . 71960) (PFI.CONSTANTNAMES 71962 . 72257)) (72294 80607 (
+MULTIFILEINDEX 72304 . 73100) (MULTIFILEINDEX1 73102 . 74558) (PFI.PRINT.MULTI.INDEX 74560 . 79663) (
+PFI.CHOOSE.BEST 79665 . 79892) (PFI.MERGE.INDICES 79894 . 80605)) (80664 83733 (PFI.MAYBE.SEE.PRETTY 
+80674 . 82457) (PFI.MAYBE.PP.DEFINITION 82459 . 83731)) (83803 91913 (PFI.PRINT.BITMAP 83813 . 91911))
+ (94628 97742 (PUTPROPS.PRETTYPRINT 94638 . 96049) (RPAQX.PRETTYPRINT 96051 . 96776) (
+COURIERPROGRAM.PRETTYPRINT 96778 . 97478) (MAYBE.PRETTYPRINT.BOLD 97480 . 97740)))))
 STOP
diff --git a/lispusers/PRETTYFILEINDEX.LCOM b/lispusers/PRETTYFILEINDEX.LCOM
index 0c4bee12a..51479acfa 100644
Binary files a/lispusers/PRETTYFILEINDEX.LCOM and b/lispusers/PRETTYFILEINDEX.LCOM differ
diff --git a/lispusers/PRETTYFILEINDEX.TEDIT b/lispusers/PRETTYFILEINDEX.TEDIT
index b0609345a..2d2f7e737 100644
--- a/lispusers/PRETTYFILEINDEX.TEDIT
+++ b/lispusers/PRETTYFILEINDEX.TEDIT
@@ -1,22 +1,139 @@
-en·vÅos	PRETTYFILEINDEX
2

4

1

PRETTYFILEINDEX
1

4

By:  Bill van Melle (vanMelle.PA@Xerox.com)
INTRODUCTION
PRETTYFILEINDEX is a program for generating indexed listings for Lisp source files.  PRETTYFILEINDEX operates by reading expressions from the file and reprettyprinting them to the output image stream, building up an index of the objects as it goes.  The index is partitioned by type (e.g. FUNCTIONS, VARIABLES, MACROS, etc.); within each type, the objects are listed alphabetically by name along with the page number(s) on which their definitions appear in the listing.  
PRETTYFILEINDEX also modifies the Exec's and the FileBrowser's SEE command to prettyprint the file being viewed, if it is a Lisp source file.  It also modifies the PF and PF* commands to prettyprint the requested function body.  Together, these features mean you can use the NEW & FAST options to MAKEFILE to speed up file creation without sacrificing the ability to get pretty listings or see the files prettily inside Lisp.
PRETTYFILEINDEX performs some additional niceties in the listing: it prints bitmaps by "displaying" them, rather than dumping their bits; it translates underscore to left arrow (for the benefit of Interlisp listings); it prints quote and backquote in a font in which they are clearly distinguishable; and it suppresses some of the "noise" in source files, such as the filemap.
The module also contains a function MULTIFILEINDEX that can be used to generate a merged index of items from a whole set of files being listed.
PRETTYFILEINDEX subsumes, and is incompatible with, the modules SINGLEFILEINDEX and PP-CODE-FILE.  You can, however, load PRETTYFILEINDEX on top of either one, and it will successfully wrest control of LISTFILES from them.  PRETTYFILEINDEX has several advantages over SINGLEFILEINDEX: the prettyprinter has fine control over positioning of the output stream, so things that are supposed to line up do, despite font changes and variable-width fonts; the entire page is used, rather than sacrificing the bottom quarter or so due to lack of control over page breaks; and the use of an image stream allows bitmaps to be rendered directly.
USING PRETTYFILEINDEX
For ordinary use, just load PRETTYFILEINDEX.LCOM.  This redefines LISTFILES1 so that calling LISTFILES or using the File Browser's Hardcopy command invokes PRETTYFILEINDEX if the file is a Lisp source file.  The listing is created by default in a single background process that handles all LISTFILES requests.  The file being indexed needn't be loaded, or even noticed (in the File Manager sense) as long as the file's commands don't require customized prettyprinting defined by the file itself.  The index is printed at the end of the listing;  you are expected to manually transpose the index to the front of the collection of paper that emerges from the printer.
PRETTYFILEINDEX normally assumes that you are printing one-sided listings.  However, if your global default is for two-sided (currently this means that EMPRESS#SIDES = 2) or you specified two-sided in the options you passed to LISTFILES, it will prepare the output as if for two-sided listing.  For example, from an Interlisp exec,
(LISTFILES (SERVER "Perfector:" %#SIDES 2) FOOBAR)
causes the file FOOBAR to be listed two-sided on the print server Perfector: (the % is the Interlisp reader's escape character, needed to quote the special character #; in an XCL exec the escape character is \, and from other packages you also have to qualify the symbols LISTFILES, SERVER and #SIDES with the package prefix IL:).
For two-sided listings, the margins are symmetric, instead of being shifted a bit to the right, page numbers appear on the outside edge of the page, and a blank page is inserted at the end of the listing if necessary to ensure that the index starts on an odd page (and hence is transposable to the front).
PRETTYFILEINDEX prettyprints the file's contents and prints indexed names using the package and read table specified in the file's reader environment, which appears at the beginning of the file.  It assumes, as does most of the file manager, that the reader environment is sufficient to read any expression on the file.  If you have violated this assumption, for example, by referring in the file to a symbol in another package that is defined on a file that is indirectly loaded by the file somewhere in its coms, you will probably need to LOADFROM the file before you can list it.
INDEXING MULTIPLE FILES
Ordinarily, you list files and get one index per file.  If a module is made up of several files, you may want a master index of the whole set of files, so that you don't have to remember which file contains a function, macro, etc. that you are looking up.  This job is handled by MULTIFILEINDEX:
(MULTIFILEINDEX files printoptions)	[Function]
This function lists each of the files in the list files using PRETTYFILEINDEX and then produces a master index by merging all the individual indices.  The master index is appended to the output of the last file listed.  The argument files can be a list of file names and/or file patterns, such as "{FS:}<Carstairs>RED*", or a single such pattern.  In the pattern, unless explicitly specified, the extension defaults to null and the version to "highest".  The argument printoptions is a property-list of options, the same as the printoptions argument to SEND.FILE.TO.PRINTER or PRETTYFILEINDEX, with the addition of some options recognized by MULTIFILEINDEX, described further below. 
As each file is listed, its pages are numbered with an ordinal file number plus the page number within the file; e.g., in the first file the pages are numbered 1-1, 1-2, ..., in the second file 2-1, 2-2, etc.  The master index then refers to page numbers in this form, although each individual file's own index shows only the file-relative page numbers.  Alternatively, you can tell MULTIFILEINDEX to number all the pages consecutively, rather than using "part numbers", by giving the option :CONSECUTIVE, value T in printoptions. 
In the event that some files in the set have different reader environments, the master index is printed in the environment used by the majority of the files.  More specifically, MULTIFILEINDEX independently chooses the package used by the majority of the files and the readtable used by the majority; in the case of a tie, the file later in the set wins.  If this default is not adequate, you can specify the environment yourself by giving the :ENVIRONMENT option.  The value should either be a reader environment object, such as produced by MAKE-READER-ENVIRONMENT, or a property list of the form used by the MAKEFILE-ENVIRONMENT property.
For example,
(MULTIFILEINDEX "<Barney>Rub*"
        '(:CONSECUTIVE T
          :ENVIRONMENT (:PACKAGE "JABBA" :READTABLE "XCL")))
would list each of the files matching "<Barney>Rub*.;", numbering the pages consecutively from the first file through the last, and printing the master index with respect to the package JABBA and read table XCL.
INCREMENTALLY REPRINTING MULTIPLE FILES
If you have used MULTIFILEINDEX to list a group of files, and later one of the files changes, or maybe the printer just ate part of your listing, you might want to update your listing without reprinting the entire set of files.  You have two options.
(1)  You can have PRETTYFILEINDEX reprint the one file that changed (or was eaten).  Specify the print option :PART n to have it treat the single file as the nth part of a multiple listing, or the option :FIRSTPAGE n to have it start numbering the pages at n instead of 1 (for the case where you used the :CONSECUTIVE option to MULTFILEINDEX).  For example,
(LISTFILES (:PART 3) "<Barney>Rubric")
would reprint <Barney>Rubric as the third file in a group.  Of course, this doesn't reprint the master index, but it only has to process the one file, which may be adequate for your needs if things didn't move around too much.
(2)  You can have MULTIFILEINDEX process the entire set of files again, but only print some of them.  You specify this by parenthesizing the files you don't want printed.  That is, each element of the files argument to MULTIFILEINDEX is a file name or a list of file name(s); those files inside sublists are processed but not printed.  You cannot specify patterns.  The master index is listed after the last file, as usual, except that if the last file was in a sublist, and hence not printed, the master index will appear as a separate listing.  Calling MULTIFILEINDEX in this manner is nearly as computationally expensive as calling it to list the whole set for real (it omits only the transportation to the printer), but it does save paper and printer time.
LISTING COMMON LISP FILES
Ordinarily, PRETTYFILEINDEX only processes files produced by the Lisp File Manager; it passes all others off to the default hardcopy routines.  However, you can tell it to process a plain Common Lisp text file by passing the print option :COMMON; e.g.,
(LISTFILES (:COMMON T) "conjugate.lisp")
PRETTYFILEINDEX still processes the file by reading and prettyprinting, just as for Lisp files.  It starts in the default Common Lisp reading environment (package USER and read table LISP), and evaluates top-level package expressions, such as in-package and import, in order to continue reading correctly.  The index is printed in whatever the environment was at the end of the file.
Of course, this is of fairly limited utility, as all read-time conditional syntax is lost: comments, #+, #o, etc.  The one exception is that top-level semi-colon comments are preservedÿÿï%ÿthey are copied to the output directly, rather than being read.
Customizing PRETTYFILEINDEX
The remainder of this document describes various ways in which PRETTYFILEINDEX can be customized.
HOW TO SPECIFY INDEXING TYPES
Initially, PRETTYFILEINDEX knows about most of the standard file manager types.  In addition, it handles all the types defined by DEFDEFINER.  For definers with a :NAME option, it assumes that the function is free of side effects.  PRETTYFILEINDEX also notices (but does not evaluate) DEFDEFINERs that appear on the file it is currently indexing, which should appear before any instances of the type so defined in order for correct indexing to occur.  Of course, it can't know about definer types that are defined on some other file unless you load it.
You can augment the set of indexing types, or override the default handling of definers, by adding elements to the following variable:
*PFI-TYPES*	[Variable]
A list of entries describing types to be indexed and a way of testing whether an expression on the file is of the desired type.  Each entry is a list of up to 4 elements of the form (type dumpfn namefn ambiguous), the first two of which are required:
	type	The name of the type, e.g., MACRO.  This name will appear as the name of the index for this type, e.g., "MACRO INDEX".  type is usually the name of a file package type, though it need not be.  It must be a symbol.
	dumpfn	The name of the function that appears as the CAR of the form that defines objects of type type on the file, or a list of such names.  E.g., for type TEMPLATE it is SETTEMPLATE; for type VARIABLES it is (RPAQ RPAQQ RPAQ? ADDTOVAR).
	namefn	A function that tests whether the expression that starts with dumpfn really is of the desired type, and returns the name of the object defined in the expression.  The function takes as arguments (expr entry), where expr is the expression whose CAR matched the entry.  The testfn should return one of the following:
	NIL	the expression is not of the desired type.
	name	the expression defines a single object of this name and of the type given in the entry.
	a list	the value is either a single list or a list of lists, each of the form (type  .  names), meaning that the expression defines each of the names as having the specified type.
If the namefn is NIL or omitted, the name of the object is obtained from the second element of the expression.  If that element is a list, the name is taken to be its CAR, or its CADR if the element is a quoted atom.
	ambiguous	True if the expression is ambiguous, in the sense that even if namefn returns a non-NIL value, it is possible for this expression to also satisfy other entries in *PFI-TYPES*.  E.g., the expression (RPAQ --) is ambiguous, because it could define either a variable or a constant.  If ambiguous is true, you usually want a corresponding entry on *PFI-FILTERS* (below).
*PFI-PROPERTIES*	[Variable]
A list used by the default handler for the PUTPROPS form.  It associates property names with a type (something more specific than the type PROPERTY) under which objects having this property should be indexed.  Each element is of the form (propname type).  If type is NIL or omitted, then objects having this property are ignored.  In addition, the default PUTPROPS handler treats all elements of the list MACROPROPS as implying type MACRO.
The initial value of *PFI-PROPERTIES* is
((COPYRIGHT)
 (READVICE ADVICE)),
meaning that the COPYRIGHT property should be ignored, and the READVICE property implies that the object should be indexed as type ADVICE.
*PFI-FILTERS*	[Variable]
A list describing potential index entries that should be filtered out of the final index.  Each element of *PFI-FILTERS* is a list (type filterfn), where type is one of the types in *PFI-TYPES* and filterfn is a function of one argument, an index entry.  If filterfn returns true, then the index entry is discarded.  An index entry is of the form (name  .  pagenumbers).  For convenience, an element of *PFI-FILTERS* can also take the form (type  .  subtype), meaning that if an object is already indexed as a subtype then it should not also be indexed as a type.
The initial value of *PFI-FILTERS* is
((VARIABLES . CONSTANTS)),
meaning that "variables" that successfully index as constants should not also be listed in the VARIABLES index.  This extra pass is needed because the CONSTANTS File Manager command causes expressions of the form (RPAQ var value) to be dumped on the file, and at the time this expression is read, it is not known whether there will later on appear a CONSTANTS form for the same variable.
Filter functions may want to call the following function:
(PFI.LOOKUP.NAME name type)	[Function]
Looks up name in the index being built for type type.  If it finds an entry, it returns it.  Index entries are of the form (name  .  pagenumbers).  It is permissible for a filter function as a side effect to destructively change another index entry by adding page numbers to it.  You might want to do so, for example, in the case where there is a kind of object that dumps two expressions on a file, each of which is a different type (according to *PFI-TYPES*), but you want both occurrences indexed as a single type. 
MORE EXPLICIT EXPRESSION HANDLING
The functions and variables described below allow you to completely control how certain expressions in the input file are handled.  You can use these hooks to perform custom prettyprinting, to suppress the printing of some expressions, or to perform indexing more complex than that supported by *PFI-TYPES*.
*PFI-HANDLERS*	[Variable]
An association list specifying explicit "handlers" for expressions that appear on the input file.  Each element is a pair (car-of-form  .  handler), where handler is a function of one argument, an expression read from the file whose first element is car-of-form.   The handler is completely in charge of indexing the expression and/or printing it to *STANDARD-OUTPUT*.  Unless the handler chooses to suppress the printing altogether, it is expected to print at least one blank line first, so that expressions are attractively separated in the listing (see PFI.MAYBE.NEW.PAGE). 
*PFI-PREVIEWERS*	[Variable]
This list is used when PRETTYFILEINDEX is used by the SEE command.  During the SEE command, real-time performance is important, so it is undesirable to have long delays while reading a very large expression.  For example, all the functions in an Interlisp FNS command appear on the file inside a single DEFINEQ expression.  If handled in the obvious way, the user would have to wait for the entire expression to be read before any output appeared.  A previewer has the opportunity to read the expression in pieces and prettyprint it as it goes.
Each element of *PFI-PREVIEWERS* is a pair (car-of-form  .  previewer), where previewer is a function of one argument, the car-of-form.  The previewer is called when PRETTYFILEINDEX encounters an expression of the form "(car-of-form " on the file.  Its job is to read expressions from *STANDARD-INPUT* (currently positioned after the car of form) until it encounters the closing right parenthesis, which it should consume, and prettyprint the elements appropriately to *STANDARD-OUTPUT*.  *PFI-PREVIEWERS* is used only from the SEE command, so indexing is not necessary (but also not harmful, other than to waste some time).
If an expression does not have a previewer, PRETTYFILEINDEX reads the reset of the expression itself and handles it normally, i.e., performs (PFI.HANDLE.EXPR (CONS car-of-form (CL:READ-DELIMITED-LIST #\)).
(PFI.DEFAULT.HANDLER expr)	[Function]
This is the function PRETTYFILEINDEX uses to process expressions that have no explicit handler.  It indexes the expression according to *PFI-TYPES* and then prettyprints the expression.  You can call this function from your handler if you decide you have an expression you didn't want to handle specially. 
(PFI.HANDLE.EXPR expr)	[Function]
Performs PRETTYFILEINDEX's normal handling of the expression expr, including looking on *PFI-HANDLERS*.  Handlers and previewers of forms that encapsulate arbitrary expressions, such as DECLARE:, typically call this to process subexpressions. 
(PFI.ADD.TO.INDEX name type/entry)	[Function]
Adds an entry to the index for type/entry specifying that name occurs on the current page.  type/entry is either a type or an entry from *PFI-TYPES* from which the type will be extracted. 
(PFI.PRETTYPRINT expr name formflg)	[Function]
Prettyprints expr.  Optional name is the name of the object being printed; if a page crossing occurs in the middle of the prettyprinting, this name will be displayed in the page header.  If formflg is true, print the expression as code; otherwise as data. 
(PFI.MAYBE.NEW.PAGE expr minlines)	[Function]
Starts a new page if the listing is currently near the bottom of the page and expr won't fit, else performs a single (TERPRI).  If minlines is specified, it is an explicit estimate of how much space the expression will require, in which case expr can be NIL; otherwise, the function estimates the size.   Handlers should call this before calling PFI.ADD.TO.INDEX, so that the page number in the index is correct.  The typical handler calls PFI.MAYBE.NEW.PAGE, then PFI.ADD.TO.INDEX, then prints the expression, possibly via PFI.PRETTYPRINT.
OTHER VARIABLES
*PFI-INDEX-ORDER*	[Variable]
A list of types (as in *PFI-TYPES*) in the order in which the various types should appear in the index.  Types not in this list are printed in an order of the program's choosing, currently a "best fit" algorithm (print the largest type index that will fit on the page).  The initial value is (FUNCTIONS), meaning that the function index will appear first, with no constraints on the order of other types.
*PFI-PRINTOPTIONS*	[Variable]
A plist of print options that PRETTYFILEINDEX appends to the list of print options passed to LISTFILES, thus supplying some printing defaults.  The initial value is (REGION (72 54 504 702)), which on standard letter size paper in portrait mode results in left, bottom, top, and right margins of 1", ¾", ½" and ½", respectively.  If the print options passed to LISTFILES call for a two-sided listing, the default region is shifted ¼" to the left.  If the print options specify LANDSCAPE mode, the default region is ignored.  Any REGION option specified in *PFI-PRINTOPTIONS* must be in points; it is scaled appropriately to the actual hardcopy device being used.
*PFI-MAX-WASTED-LINES*	[Variable]
If an expression looks like it won't fit on the current page and there are no more than this many lines remaining on the page, PRETTYFILEINDEX starts a new page before printing the expression.  A floating-point value indicates a fraction of the page; an integer indicates an absolute number of lines.  The initial value is 12.  
*PFI-CHARACTER-TRANSLATIONS*	[Variable]
A list specifying how certain characters should be rendered on the output stream.  This is used to get around the poor rendering of certain characters in the default font.  Each element is of the form (imagetype  .  charpairs), where imagetype is the type of image stream being printed to and each element of charpairs is an alist whose elements are of the form (sourcecode destcode  .  looks-plist), specifying the character code to use on the destination image stream for a specified character code in the input stream.  If looks-plist is non-NIL, destcode is printed in a font obtained by applying FONTCOPY to the current font and looks-plist.
The initial value is
((INTERPRESS (95 172)
             (96 169 FAMILY CLASSIC)
             (39 185 FAMILY CLASSIC)))
meaning if the output stream is an Interpress stream the lister should turn character 95 (underscore) into 172 (left arrow), backquote into left single quote in the Classic font (of the same size and weight), and single quote into right single quote in Classic.
*PRINT-PRETTY-FROM-FILES*	[Variable]
If true, the SEE (in the Exec and Filebrowser), PF and PF* commands attempt to prettyprint to the display, rather than copying the file as it is currently formatted.  The initial value is T.
*PRINT-PRETTY-BITMAPS*	[Variable]
If true, then when *PRINT-ARRAY* is true and a bitmap is to be printed to an image stream, the bitmap itself is displayed as an image on the stream, rather than as the machine-readable representation of its bits (of the form #*(16 16)H@@@L...).  This variable has no effect on printing to files, such as in MAKEFILE, nor on PRETTYFILEINDEX, which binds it true; thus, changing the value mainly affects the display.  The initial value is T.
*PFI-DONT-SPAWN*	[Variable]
If NIL, LISTFILES arranges for a separate process to do the hardcopying (whether using PRETTYFILEINDEX or not) and returns immediately; if T, it makes the listing directly, not returning until it is finished.  The initial value is NIL.
LISTING ELSEWHERE THAN THE PRINTER
Ordinarily, you call LISTFILES (or uses the File Browser) to create listings.  However, you can also call PRETTYFILEINDEX directly if you want to direct the output elsewhere, such as to an Interpress file:
(PRETTYFILEINDEX  filename printoptions outstream dontindex)	[Function]
Lists filename, the name of a Lisp source file or a stream open for input on such a  file, printing it and its index to outstream.  outstream is either an open image stream, or NIL, in which case the output goes to (OPENIMAGESTREAM) and the stream is closed afterwards, which results in it being sent to the default printer.  If filename or outstream is open on entry, it is left open on exit.  printoptions is a plist of options of interest to either LISTFILES or OPENIMAGESTREAM.  If dontindex is true, no index is produced; this argument is used by the SEE command.
If the file is not a File manager file, PRETTYFILEINDEX takes no action and returns NIL; otherwise, it returns the full file name.  However, if filename is an open stream, then PRETTYFILEINDEX copies the remainder of the stream to outstream (which must be given) using PFCOPYBYTES, and returns the full file name.  This is so that the stream does not need to be backed up after discovering that the file is not a File Manager file, an operation not possible for a sequential-access stream.
LIMITATIONS
PRETTYFILEINDEX assumes that the default font, which is used to print the index, is fixed-width. 
PRETTYFILEINDEX uses the regular Interlisp prettyprinter.  This means that if you have File Manager commands that produce their output in a customized way, e.g., by printing inside the E command, then the output will look different between MAKEFILE and PRETTYFILEINDEX.  You can usually remedy this by supplying PRETTYPRINTMACROS for the types of expressions your command dumps (which may also let you replace the E with a simpler P command), or by defining handlers for the expressions (see *PFI-HANDLERS*).  PRETTYFILEINDEX already supplies PRETTYPRINTMACROS for most of the customized printing done by the current File Manager: RPAQ, RPAQQ, RPAQ?, ADDTOVAR, PUTPROPS and COURIERPROGRAM. 
With the exception of noticing the reader environment and DEFDEFINER expressions, PRETTYFILEINDEX does not interpret the contents of the file.  If your file depends on itself for proper prettyprinting or indexing, you need to LOAD (or possibly just LOADFROM) the file first.(LIST ((PAGE NIL (PAPERSIZE LETTER FOLIOINFO (ARABIC "" "") STARTINGPAGE# 206) (0 0 612 792) ((FOLIO NIL (PARALOOKS (QUAD CENTERED) CHARLOOKS (SUPERSCRIPT 0 INVISIBLE OFF SELECTPOINT OFF PROTECTED OFF SIZE 10 FAMILY MODERN OVERLINE OFF STRIKEOUT OFF UNDERLINE OFF EXPANSION REGULAR SLOPE REGULAR WEIGHT MEDIUM INVERTED OFF USERINFO NIL STYLE NIL) FORMATINFO (ARABIC "" "")) (174 36 288 36) NIL) (HEADING NIL (HEADINGTYPE RUNNINGHEAD) (84 744 528 36) NIL) (TEXT NIL NIL (84 96 456 600) NIL))) (PAGE NIL (PAPERSIZE LETTER FOLIOINFO (ARABIC "" "")) (0 0 612 792) ((FOLIO NIL (PARALOOKS (QUAD CENTERED) CHARLOOKS (SUPERSCRIPT 0 INVISIBLE OFF SELECTPOINT OFF PROTECTED OFF SIZE 10 FAMILY MODERN OVERLINE OFF STRIKEOUT OFF UNDERLINE OFF EXPANSION REGULAR SLOPE REGULAR WEIGHT MEDIUM INVERTED OFF USERINFO NIL STYLE NIL) FORMATINFO (ARABIC "" "")) (174 36 288 36) NIL) (HEADING NIL (HEADINGTYPE RUNNINGHEAD) (84 744 528 36) NIL) (TEXT NIL NIL (84 72 456 624) NIL))) (PAGE NIL (PAPERSIZE LETTER FOLIOINFO (ARABIC "" "")) (0 0 612 792) ((FOLIO NIL (PARALOOKS (QUAD CENTERED) CHARLOOKS (SUPERSCRIPT 0 INVISIBLE OFF SELECTPOINT OFF PROTECTED OFF SIZE 10 FAMILY MODERN OVERLINE OFF STRIKEOUT OFF UNDERLINE OFF EXPANSION REGULAR SLOPE REGULAR WEIGHT MEDIUM INVERTED OFF USERINFO NIL STYLE NIL) FORMATINFO (ARABIC "" "")) (174 36 288 36) NIL) (HEADING NIL (HEADINGTYPE RUNNINGHEAD) (84 744 528 36) NIL) (TEXT NIL NIL (84 72 456 624) NIL)))))0$$
T0HH
T0$$
È
T2
È


È
6


Â
T3
È


È

T2
È

È
5ll
È`
l5´
Ȩ
´5l
È`
l/$$
È2
È


È
2
È


È
H
È

È
PAGEHEADINGRUNNINGHEAD,ŠŠ
8,ŠŠ
8,
È/HHCLASSIC
-
CLASSIC
-CLASSIC
-CLASSICCLASSICGACHA
-MODERNMODERN


HRULE.GETFN
CLASSIC
-

HRULE.GETFN
CLASSIC
-

HRULE.GETFN
CLASSIC
-

HRULE.GETFN
MODERN

HRULE.GETFN
MODERN
,


Ø
ª
y�{
š
L2
R
S
)
?	
2G

(





2
²
æ
0
�
ì


¼V-

t
Ô'
ûn


)

-
-


)

/)'ÇÉ
+
î)ó
-x¸Bb)‡·





	
(
-
W
Z
-
[
7	
-
?
€


	
5
%	,	

Y	

I
W
Å
-
-
@
^	L	
4

-+X\



V)
- 	%<
k



	

4
R
#

5
)


_	m




y	:



	
#
H

0<"
'{
	
X
Y½!
		
$
W
5¨xŽ


ˆ 

=
T2


-


-


-
#)








�
<



N
#
g
U
	N+

fx
Ù»Ê
		
B	
-
-


€


+

b
¿
ÁÉì"
jU




	

	


j	
	
¼
	
-
O	
J(Y
'	
ú
b
8£%G:
-ÎaEƒzº
\ No newline at end of file
+en·vÅos	PRETTYFILEINDEX
+2
+
+4
+
+1
+
+PRETTYFILEINDEX
+1
+
+4
+
+By:  Bill van Melle (vanMelle.PA@Xerox.com)
+INTRODUCTION
+PRETTYFILEINDEX is a program for generating indexed listings for Lisp source files.  PRETTYFILEINDEX operates by reading expressions from the file and reprettyprinting them to the output image stream, building up an index of the objects as it goes.  The index is partitioned by type (e.g. FUNCTIONS, VARIABLES, MACROS, etc.); within each type, the objects are listed alphabetically by name along with the page number(s) on which their definitions appear in the listing.  
+PRETTYFILEINDEX also modifies the Exec's and the FileBrowser's SEE command to prettyprint the file being viewed, if it is a Lisp source file.  It also modifies the PF and PF* commands to prettyprint the requested function body.  Together, these features mean you can use the NEW & FAST options to MAKEFILE to speed up file creation without sacrificing the ability to get pretty listings or see the files prettily inside Lisp.
+PRETTYFILEINDEX performs some additional niceties in the listing: it prints bitmaps by "displaying" them, rather than dumping their bits; it translates underscore to left arrow (for the benefit of Interlisp listings); it prints quote and backquote in a font in which they are clearly distinguishable; and it suppresses some of the "noise" in source files, such as the filemap.
+The module also contains a function MULTIFILEINDEX that can be used to generate a merged index of items from a whole set of files being listed.
+PRETTYFILEINDEX subsumes, and is incompatible with, the modules SINGLEFILEINDEX and PP-CODE-FILE.  You can, however, load PRETTYFILEINDEX on top of either one, and it will successfully wrest control of LISTFILES from them.  PRETTYFILEINDEX has several advantages over SINGLEFILEINDEX: the prettyprinter has fine control over positioning of the output stream, so things that are supposed to line up do, despite font changes and variable-width fonts; the entire page is used, rather than sacrificing the bottom quarter or so due to lack of control over page breaks; and the use of an image stream allows bitmaps to be rendered directly.
+USING PRETTYFILEINDEX
+For ordinary use, just load PRETTYFILEINDEX.LCOM.  This redefines LISTFILES1 so that calling LISTFILES or using the File Browser's Hardcopy command invokes PRETTYFILEINDEX if the file is a Lisp source file.  The listing is created by default in a single background process that handles all LISTFILES requests.  The file being indexed needn't be loaded, or even noticed (in the File Manager sense) as long as the file's commands don't require customized prettyprinting defined by the file itself.  The index is printed at the end of the listing;  you are expected to manually transpose the index to the front of the collection of paper that emerges from the printer.
+PRETTYFILEINDEX normally assumes that you are printing one-sided listings.  However, if your global default is for two-sided (currently this means that EMPRESS#SIDES = 2) or you specified two-sided in the options you passed to LISTFILES, it will prepare the output as if for two-sided listing.  For example, from an Interlisp exec,
+(LISTFILES (SERVER "Perfector:" %#SIDES 2) FOOBAR)
+causes the file FOOBAR to be listed two-sided on the print server Perfector: (the % is the Interlisp reader's escape character, needed to quote the special character #; in an XCL exec the escape character is \, and from other packages you also have to qualify the symbols LISTFILES, SERVER and #SIDES with the package prefix IL:).
+For two-sided listings, the margins are symmetric, instead of being shifted a bit to the right, page numbers appear on the outside edge of the page, and a blank page is inserted at the end of the listing if necessary to ensure that the index starts on an odd page (and hence is transposable to the front).
+PRETTYFILEINDEX prettyprints the file's contents and prints indexed names using the package and read table specified in the file's reader environment, which appears at the beginning of the file.  It assumes, as does most of the file manager, that the reader environment is sufficient to read any expression on the file.  If you have violated this assumption, for example, by referring in the file to a symbol in another package that is defined on a file that is indirectly loaded by the file somewhere in its coms, you will probably need to LOADFROM the file before you can list it.
+INDEXING MULTIPLE FILES
+Ordinarily, you list files and get one index per file.  If a module is made up of several files, you may want a master index of the whole set of files, so that you don't have to remember which file contains a function, macro, etc. that you are looking up.  This job is handled by MULTIFILEINDEX:
+(MULTIFILEINDEX files printoptions)	[Function]
+This function lists each of the files in the list files using PRETTYFILEINDEX and then produces a master index by merging all the individual indices.  The master index is appended to the output of the last file listed.  The argument files can be a list of file names and/or file patterns, such as "{FS:}<Carstairs>RED*", or a single such pattern.  In the pattern, unless explicitly specified, the extension defaults to null and the version to "highest".  The argument printoptions is a property-list of options, the same as the printoptions argument to SEND.FILE.TO.PRINTER or PRETTYFILEINDEX, with the addition of some options recognized by MULTIFILEINDEX, described further below. 
+As each file is listed, its pages are numbered with an ordinal file number plus the page number within the file; e.g., in the first file the pages are numbered 1-1, 1-2, ..., in the second file 2-1, 2-2, etc.  The master index then refers to page numbers in this form, although each individual file's own index shows only the file-relative page numbers.  Alternatively, you can tell MULTIFILEINDEX to number all the pages consecutively, rather than using "part numbers", by giving the option :CONSECUTIVE, value T in printoptions. 
+In the event that some files in the set have different reader environments, the master index is printed in the environment used by the majority of the files.  More specifically, MULTIFILEINDEX independently chooses the package used by the majority of the files and the readtable used by the majority; in the case of a tie, the file later in the set wins.  If this default is not adequate, you can specify the environment yourself by giving the :ENVIRONMENT option.  The value should either be a reader environment object, such as produced by MAKE-READER-ENVIRONMENT, or a property list of the form used by the MAKEFILE-ENVIRONMENT property.
+For example,
+(MULTIFILEINDEX "<Barney>Rub*"
+        '(:CONSECUTIVE T
+          :ENVIRONMENT (:PACKAGE "JABBA" :READTABLE "XCL")))
+would list each of the files matching "<Barney>Rub*.;", numbering the pages consecutively from the first file through the last, and printing the master index with respect to the package JABBA and read table XCL.
+INCREMENTALLY REPRINTING MULTIPLE FILES
+If you have used MULTIFILEINDEX to list a group of files, and later one of the files changes, or maybe the printer just ate part of your listing, you might want to update your listing without reprinting the entire set of files.  You have two options.
+(1)  You can have PRETTYFILEINDEX reprint the one file that changed (or was eaten).  Specify the print option :PART n to have it treat the single file as the nth part of a multiple listing, or the option :FIRSTPAGE n to have it start numbering the pages at n instead of 1 (for the case where you used the :CONSECUTIVE option to MULTFILEINDEX).  For example,
+(LISTFILES (:PART 3) "<Barney>Rubric")
+would reprint <Barney>Rubric as the third file in a group.  Of course, this doesn't reprint the master index, but it only has to process the one file, which may be adequate for your needs if things didn't move around too much.
+(2)  You can have MULTIFILEINDEX process the entire set of files again, but only print some of them.  You specify this by parenthesizing the files you don't want printed.  That is, each element of the files argument to MULTIFILEINDEX is a file name or a list of file name(s); those files inside sublists are processed but not printed.  You cannot specify patterns.  The master index is listed after the last file, as usual, except that if the last file was in a sublist, and hence not printed, the master index will appear as a separate listing.  Calling MULTIFILEINDEX in this manner is nearly as computationally expensive as calling it to list the whole set for real (it omits only the transportation to the printer), but it does save paper and printer time.
+LISTING COMMON LISP FILES
+Ordinarily, PRETTYFILEINDEX only processes files produced by the Lisp File Manager; it passes all others off to the default hardcopy routines.  However, you can tell it to process a plain Common Lisp text file by passing the print option :COMMON; e.g.,
+(LISTFILES (:COMMON T) "conjugate.lisp")
+PRETTYFILEINDEX still processes the file by reading and prettyprinting, just as for Lisp files.  It starts in the default Common Lisp reading environment (package USER and read table LISP), and evaluates top-level package expressions, such as in-package and import, in order to continue reading correctly.  The index is printed in whatever the environment was at the end of the file.
+Of course, this is of fairly limited utility, as all read-time conditional syntax is lost: comments, #+, #o, etc.  The one exception is that top-level semi-colon comments are preservedÿÿï%ÿthey are copied to the output directly, rather than being read.
+Customizing PRETTYFILEINDEX
+The remainder of this document describes various ways in which PRETTYFILEINDEX can be customized.
+HOW TO SPECIFY INDEXING TYPES
+Initially, PRETTYFILEINDEX knows about most of the standard file manager types.  In addition, it handles all the types defined by DEFDEFINER.  For definers with a :NAME option, it assumes that the function is free of side effects.  PRETTYFILEINDEX also notices (but does not evaluate) DEFDEFINERs that appear on the file it is currently indexing, which should appear before any instances of the type so defined in order for correct indexing to occur.  Of course, it can't know about definer types that are defined on some other file unless you load it.
+You can augment the set of indexing types, or override the default handling of definers, by adding elements to the following variable:
+*PFI-TYPES*	[Variable]
+A list of entries describing types to be indexed and a way of testing whether an expression on the file is of the desired type.  Each entry is a list of up to 4 elements of the form (type dumpfn namefn ambiguous), the first two of which are required:
+	type	The name of the type, e.g., MACRO.  This name will appear as the name of the index for this type, e.g., "MACRO INDEX".  type is usually the name of a file package type, though it need not be.  It must be a symbol.
+	dumpfn	The name of the function that appears as the CAR of the form that defines objects of type type on the file, or a list of such names.  E.g., for type TEMPLATE it is SETTEMPLATE; for type VARIABLES it is (RPAQ RPAQQ RPAQ? ADDTOVAR).
+	namefn	A function that tests whether the expression that starts with dumpfn really is of the desired type, and returns the name of the object defined in the expression.  The function takes as arguments (expr entry), where expr is the expression whose CAR matched the entry.  The testfn should return one of the following:
+	NIL	the expression is not of the desired type.
+	name	the expression defines a single object of this name and of the type given in the entry.
+	a list	the value is either a single list or a list of lists, each of the form (type  .  names), meaning that the expression defines each of the names as having the specified type.
+If the namefn is NIL or omitted, the name of the object is obtained from the second element of the expression.  If that element is a list, the name is taken to be its CAR, or its CADR if the element is a quoted atom.
+	ambiguous	True if the expression is ambiguous, in the sense that even if namefn returns a non-NIL value, it is possible for this expression to also satisfy other entries in *PFI-TYPES*.  E.g., the expression (RPAQ --) is ambiguous, because it could define either a variable or a constant.  If ambiguous is true, you usually want a corresponding entry on *PFI-FILTERS* (below).
+*PFI-PROPERTIES*	[Variable]
+A list used by the default handler for the PUTPROPS form.  It associates property names with a type (something more specific than the type PROPERTY) under which objects having this property should be indexed.  Each element is of the form (propname type).  If type is NIL or omitted, then objects having this property are ignored.  In addition, the default PUTPROPS handler treats all elements of the list MACROPROPS as implying type MACRO.
+The initial value of *PFI-PROPERTIES* is
+((COPYRIGHT)
+ (READVICE ADVICE)),
+meaning that the COPYRIGHT property should be ignored, and the READVICE property implies that the object should be indexed as type ADVICE.
+*PFI-FILTERS*	[Variable]
+A list describing potential index entries that should be filtered out of the final index.  Each element of *PFI-FILTERS* is a list (type filterfn), where type is one of the types in *PFI-TYPES* and filterfn is a function of one argument, an index entry.  If filterfn returns true, then the index entry is discarded.  An index entry is of the form (name  .  pagenumbers).  For convenience, an element of *PFI-FILTERS* can also take the form (type  .  subtype), meaning that if an object is already indexed as a subtype then it should not also be indexed as a type.
+The initial value of *PFI-FILTERS* is
+((VARIABLES . CONSTANTS)),
+meaning that "variables" that successfully index as constants should not also be listed in the VARIABLES index.  This extra pass is needed because the CONSTANTS File Manager command causes expressions of the form (RPAQ var value) to be dumped on the file, and at the time this expression is read, it is not known whether there will later on appear a CONSTANTS form for the same variable.
+Filter functions may want to call the following function:
+(PFI.LOOKUP.NAME name type)	[Function]
+Looks up name in the index being built for type type.  If it finds an entry, it returns it.  Index entries are of the form (name  .  pagenumbers).  It is permissible for a filter function as a side effect to destructively change another index entry by adding page numbers to it.  You might want to do so, for example, in the case where there is a kind of object that dumps two expressions on a file, each of which is a different type (according to *PFI-TYPES*), but you want both occurrences indexed as a single type. 
+MORE EXPLICIT EXPRESSION HANDLING
+The functions and variables described below allow you to completely control how certain expressions in the input file are handled.  You can use these hooks to perform custom prettyprinting, to suppress the printing of some expressions, or to perform indexing more complex than that supported by *PFI-TYPES*.
+*PFI-HANDLERS*	[Variable]
+An association list specifying explicit "handlers" for expressions that appear on the input file.  Each element is a pair (car-of-form  .  handler), where handler is a function of one argument, an expression read from the file whose first element is car-of-form.   The handler is completely in charge of indexing the expression and/or printing it to *STANDARD-OUTPUT*.  Unless the handler chooses to suppress the printing altogether, it is expected to print at least one blank line first, so that expressions are attractively separated in the listing (see PFI.MAYBE.NEW.PAGE). 
+*PFI-PREVIEWERS*	[Variable]
+This list is used when PRETTYFILEINDEX is used by the SEE command.  During the SEE command, real-time performance is important, so it is undesirable to have long delays while reading a very large expression.  For example, all the functions in an Interlisp FNS command appear on the file inside a single DEFINEQ expression.  If handled in the obvious way, the user would have to wait for the entire expression to be read before any output appeared.  A previewer has the opportunity to read the expression in pieces and prettyprint it as it goes.
+Each element of *PFI-PREVIEWERS* is a pair (car-of-form  .  previewer), where previewer is a function of one argument, the car-of-form.  The previewer is called when PRETTYFILEINDEX encounters an expression of the form "(car-of-form " on the file.  Its job is to read expressions from *STANDARD-INPUT* (currently positioned after the car of form) until it encounters the closing right parenthesis, which it should consume, and prettyprint the elements appropriately to *STANDARD-OUTPUT*.  *PFI-PREVIEWERS* is used only from the SEE command, so indexing is not necessary (but also not harmful, other than to waste some time).
+If an expression does not have a previewer, PRETTYFILEINDEX reads the reset of the expression itself and handles it normally, i.e., performs (PFI.HANDLE.EXPR (CONS car-of-form (CL:READ-DELIMITED-LIST #\)).
+(PFI.DEFAULT.HANDLER expr)	[Function]
+This is the function PRETTYFILEINDEX uses to process expressions that have no explicit handler.  It indexes the expression according to *PFI-TYPES* and then prettyprints the expression.  You can call this function from your handler if you decide you have an expression you didn't want to handle specially. 
+(PFI.HANDLE.EXPR expr)	[Function]
+Performs PRETTYFILEINDEX's normal handling of the expression expr, including looking on *PFI-HANDLERS*.  Handlers and previewers of forms that encapsulate arbitrary expressions, such as DECLARE:, typically call this to process subexpressions. 
+(PFI.ADD.TO.INDEX name type/entry)	[Function]
+Adds an entry to the index for type/entry specifying that name occurs on the current page.  type/entry is either a type or an entry from *PFI-TYPES* from which the type will be extracted. 
+(PFI.PRETTYPRINT expr name formflg)	[Function]
+Prettyprints expr.  Optional name is the name of the object being printed; if a page crossing occurs in the middle of the prettyprinting, this name will be displayed in the page header.  If formflg is true, print the expression as code; otherwise as data. 
+(PFI.MAYBE.NEW.PAGE expr minlines)	[Function]
+Starts a new page if the listing is currently near the bottom of the page and expr won't fit, else performs a single (TERPRI).  If minlines is specified, it is an explicit estimate of how much space the expression will require, in which case expr can be NIL; otherwise, the function estimates the size.   Handlers should call this before calling PFI.ADD.TO.INDEX, so that the page number in the index is correct.  The typical handler calls PFI.MAYBE.NEW.PAGE, then PFI.ADD.TO.INDEX, then prints the expression, possibly via PFI.PRETTYPRINT.
+OTHER VARIABLES
+*PFI-INDEX-ORDER*	[Variable]
+A list of types (as in *PFI-TYPES*) in the order in which the various types should appear in the index.  Types not in this list are printed in an order of the program's choosing, currently a "best fit" algorithm (print the largest type index that will fit on the page).  The initial value is (FUNCTIONS), meaning that the function index will appear first, with no constraints on the order of other types.
+*PFI-PRINTOPTIONS*	[Variable]
+A plist of print options that PRETTYFILEINDEX appends to the list of print options passed to LISTFILES, thus supplying some printing defaults.  The initial value is (REGION (72 54 504 702)), which on standard letter size paper in portrait mode results in left, bottom, top, and right margins of 1", ¾", ½" and ½", respectively.  If the print options passed to LISTFILES call for a two-sided listing, the default region is shifted ¼" to the left.  If the print options specify LANDSCAPE mode, the default region is ignored.  Any REGION option specified in *PFI-PRINTOPTIONS* must be in points; it is scaled appropriately to the actual hardcopy device being used.
+*PFI-MAX-WASTED-LINES*	[Variable]
+If an expression looks like it won't fit on the current page and there are no more than this many lines remaining on the page, PRETTYFILEINDEX starts a new page before printing the expression.  A floating-point value indicates a fraction of the page; an integer indicates an absolute number of lines.  The initial value is 12.  
+*PFI-CHARACTER-TRANSLATIONS*	[Variable]
+A list specifying how certain characters should be rendered on the output stream.  This is used to get around the poor rendering of certain characters in the default font.  Each element is of the form (imagetype  .  charpairs), where imagetype is the type of image stream being printed to and each element of charpairs is an alist whose elements are of the form (sourcecode destcode  .  looks-plist), specifying the character code to use on the destination image stream for a specified character code in the input stream.  If looks-plist is non-NIL, destcode is printed in a font obtained by applying FONTCOPY to the current font and looks-plist.
+The initial value is
+((INTERPRESS (96 169 FAMILY CLASSIC)
+             (39 185 FAMILY CLASSIC)))
+meaning if the output stream is an Interpress stream the lister should turn backquote into left single quote in the Classic font (of the same size and weight) and single quote into right single quote in Classic.
+*PRINT-PRETTY-FROM-FILES*	[Variable]
+If true, the SEE (in the Exec and Filebrowser), PF and PF* commands attempt to prettyprint to the display, rather than copying the file as it is currently formatted.  The initial value is T.
+*PRINT-PRETTY-BITMAPS*	[Variable]
+If true, then when *PRINT-ARRAY* is true and a bitmap is to be printed to an image stream, the bitmap itself is displayed as an image on the stream, rather than as the machine-readable representation of its bits (of the form #*(16 16)H@@@L...).  This variable has no effect on printing to files, such as in MAKEFILE, nor on PRETTYFILEINDEX, which binds it true; thus, changing the value mainly affects the display.  The initial value is T.
+*PFI-DONT-SPAWN*	[Variable]
+If NIL, LISTFILES arranges for a separate process to do the hardcopying (whether using PRETTYFILEINDEX or not) and returns immediately; if T, it makes the listing directly, not returning until it is finished.  The initial value is NIL.
+LISTING ELSEWHERE THAN THE PRINTER
+Ordinarily, you call LISTFILES (or uses the File Browser) to create listings.  However, you can also call PRETTYFILEINDEX directly if you want to direct the output elsewhere, such as to an Interpress file:
+(PRETTYFILEINDEX  filename printoptions outstream dontindex)	[Function]
+Lists filename, the name of a Lisp source file or a stream open for input on such a  file, printing it and its index to outstream.  outstream is either an open image stream, or NIL, in which case the output goes to (OPENIMAGESTREAM) and the stream is closed afterwards, which results in it being sent to the default printer.  If filename or outstream is open on entry, it is left open on exit.  printoptions is a plist of options of interest to either LISTFILES or OPENIMAGESTREAM.  If dontindex is true, no index is produced; this argument is used by the SEE command.
+If the file is not a File manager file, PRETTYFILEINDEX takes no action and returns NIL; otherwise, it returns the full file name.  However, if filename is an open stream, then PRETTYFILEINDEX copies the remainder of the stream to outstream (which must be given) using PFCOPYBYTES, and returns the full file name.  This is so that the stream does not need to be backed up after discovering that the file is not a File Manager file, an operation not possible for a sequential-access stream.
+LIMITATIONS
+PRETTYFILEINDEX assumes that the default font, which is used to print the index, is fixed-width. 
+PRETTYFILEINDEX uses the regular Interlisp prettyprinter.  This means that if you have File Manager commands that produce their output in a customized way, e.g., by printing inside the E command, then the output will look different between MAKEFILE and PRETTYFILEINDEX.  You can usually remedy this by supplying PRETTYPRINTMACROS for the types of expressions your command dumps (which may also let you replace the E with a simpler P command), or by defining handlers for the expressions (see *PFI-HANDLERS*).  PRETTYFILEINDEX already supplies PRETTYPRINTMACROS for most of the customized printing done by the current File Manager: RPAQ, RPAQQ, RPAQ?, ADDTOVAR, PUTPROPS and COURIERPROGRAM. 
+With the exception of noticing the reader environment and DEFDEFINER expressions, PRETTYFILEINDEX does not interpret the contents of the file.  If your file depends on itself for proper prettyprinting or indexing, you need to LOAD (or possibly just LOADFROM) the file first.(SEQUENCE NIL NIL (0 0 0 0) ((PAGE NIL (PAPERSIZE LETTER FOLIOINFO (ARABIC "" "") STARTINGPAGE# 206) (0 0 612 792) ((FOLIO NIL (PARALOOKS (QUAD CENTERED) CHARLOOKS (SUPERSCRIPT 0 INVISIBLE OFF SELECTPOINT OFF PROTECTED OFF SIZE 10 FAMILY MODERN OVERLINE OFF STRIKEOUT OFF UNDERLINE OFF EXPANSION REGULAR SLOPE REGULAR WEIGHT MEDIUM INVERTED OFF USERINFO NIL STYLE NIL) FORMATINFO (ARABIC "" "")) (174 36 288 36) NIL) (HEADING NIL (HEADINGTYPE RUNNINGHEAD) (84 744 528 36) NIL) (TEXT NIL NIL (84 96 456 600) NIL))) (ALTERNATE NIL NIL (0 0 0 0) ((PAGE NIL (PAPERSIZE LETTER FOLIOINFO (ARABIC "" "")) (0 0 612 792) ((FOLIO NIL (PARALOOKS (QUAD CENTERED) CHARLOOKS (SUPERSCRIPT 0 INVISIBLE OFF SELECTPOINT OFF PROTECTED OFF SIZE 10 FAMILY MODERN OVERLINE OFF STRIKEOUT OFF UNDERLINE OFF EXPANSION REGULAR SLOPE REGULAR WEIGHT MEDIUM INVERTED OFF USERINFO NIL STYLE NIL) FORMATINFO (ARABIC "" "")) (174 36 288 36) NIL) (HEADING NIL (HEADINGTYPE RUNNINGHEAD) (84 744 528 36) NIL) (TEXT NIL NIL (84 72 456 624) NIL))) (PAGE NIL (PAPERSIZE LETTER FOLIOINFO (ARABIC "" "")) (0 0 612 792) ((FOLIO NIL (PARALOOKS (QUAD CENTERED) CHARLOOKS (SUPERSCRIPT 0 INVISIBLE OFF SELECTPOINT OFF PROTECTED OFF SIZE 10 FAMILY MODERN OVERLINE OFF STRIKEOUT OFF UNDERLINE OFF EXPANSION REGULAR SLOPE REGULAR WEIGHT MEDIUM INVERTED OFF USERINFO NIL STYLE NIL) FORMATINFO (ARABIC "" "")) (174 36 288 36) NIL) (HEADING NIL (HEADINGTYPE RUNNINGHEAD) (84 744 528 36) NIL) (TEXT NIL NIL (84 72 456 624) NIL)))))))1
$4
È$

È
5
È
$

È

T1$$
È1HH2$$
T2HH
T2$$
È
T7l
È`
l7ll
È`
l7´
Ȩ
´4
È
$

È
4
È
$

È
8


Â
T4
È
$

È
1
È$1ŠŠ
8$1ŠŠ
8$J
È$

È
PAGEHEADINGRUNNINGHEAD	0CLASSIC
+(CHARPROPS (COLOR . BLACK))0CLASSIC
+(CHARPROPS (COLOR . BLACK)).GACHA
+(CHARPROPS (COLOR . BLACK))0CLASSIC
+(CHARPROPS (COLOR . BLACK))0CLASSIC
+(CHARPROPS (COLOR . BLACK))
/MODERN(CHARPROPS (COLOR . BLACK))/MODERN(CHARPROPS (COLOR . BLACK))0CLASSIC(CHARPROPS (COLOR . BLACK))0CLASSIC(CHARPROPS (COLOR . BLACK))	



HRULE.GETFN


HRULE.GETFN


HRULE.GETFN


HRULE.GETFN

HRULE.GETFN
,



Ø

ª

y
�
{


š

L

2

R

S

)

?
	




2
G



(






2
²
æ
0
�

ì





¼
V
-



t

Ô
'

û
n



)

-

+


)

/
)

'
Ç
É
+


î


)ó

+
x
¸

B
b
)
‡

·






	(
	
W
Z
	[
7


	

	?
€


	
5
%
,


Y


I
W

+

Å
	
+@
^

	L
	4


+

+
X
\




V
)

+



 

	%
<



k




	


4
R
#


5
)





_
	m





y
	
:



	
#
H

0
<
"
'


{
	
X
Y
½


!


	
	$
W
5
¨

x
Ž



ˆ
 


=

T
2


+



+


+#
)







�
<



N
#

g
U
	
N

+







f


x

Ù


»

Ê
	
	B
	-

+
€


+



LÔ

¿



Á
É

ì
"

j
U




	
	


j
	
	¼

	-
O
	J
(
Y

'
	ú


b

8
£
%
G






:

+Î
(((CHARENCODING . MCCS)))PROPS:#DATE:j™x `ýƒzº
\ No newline at end of file
diff --git a/sources/AFONT b/sources/AFONT
index e62df98e4..96e8e6d9f 100644
--- a/sources/AFONT
+++ b/sources/AFONT
@@ -1,33 +1,31 @@
 (DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
 
-
(FILECREATED "14-Jul-2025 19:53:00" {WMEDLEY}<sources>AFONT.;13
 43176  
+
(FILECREATED "22-Jul-2025 23:20:06" 
+{DSK}<Users>kaplan>Local>medley3.5>working-medley>sources>AFONT.;15
 27510  
 
       :EDIT-BY rmk
 
-      :CHANGES-TO (FNS ACFONT.GETCHARSET \READACFONTFILE)
+      :CHANGES-TO (VARS AFONTCOMS)
 
-      :PREVIOUS-DATE " 8-Jul-2025 22:09:41" {WMEDLEY}<sources>AFONT.;12)
+      :PREVIOUS-DATE "21-Jul-2025 00:14:04" 
+{DSK}<Users>kaplan>Local>medley3.5>working-medley>sources>AFONT.;14)
 
 
 (PRETTYCOMPRINT AFONTCOMS)
 
 (RPAQQ AFONTCOMS

-       (
-        (* ;; "AC and Interpress font file support.  ACFILEP is on FONT")

+       [
+        (* ;; "AC font file support.  ACFONT.FILEP is on FONT")

 
         (XCL:FILE-ENVIRONMENTS "AFONT")
-        (DECLARE%: EVAL@COMPILE DONTCOPY (RECORDS BOUNDINGBOX FONTBOUNDINGBOX)
-               (CONSTANTS noInfoCode))
-        (FNS ACFONT.FILEP ACFONT.GETCHARSET \CREATESTARFONT \READACFONTBOXES \READACFONTFILE 
-             \ACCHARIMAGELIST \ACCHARWIDTHLIST \GETFBB \ACCHARPOSLIST \ACROTATECHAR \READFONTWDFILE 
-             \FACECODE \FAMILYCODE \FINDFONT)
-        (ADDVARS (DISPLAYCHARSETFNS (AC ACFONT.FILEP ACFONT.GETCHARSET)))
-        (INITVARS (INTERPRESSFONTDIRECTORIES))
-        (MACROS \POSITIONFONTFILE)))
+        (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])
 
 
 
-(* ;; "AC and Interpress font file support.  ACFILEP is on FONT")

+(* ;; "AC font file support.  ACFONT.FILEP is on FONT")

 
 
 (XCL:DEFINE-FILE-ENVIRONMENT "AFONT"
 :PACKAGE "IL"
@@ -58,14 +56,6 @@
 
 (RECORD FONTBOUNDINGBOX
 (FBBBDX FBBBDY FBBBOX FBBBOY))
 )
-
-(DECLARE%: EVAL@COMPILE 
-
-(RPAQQ noInfoCode
 32768)
-
-
-(CONSTANTS noInfoCode)
-)
 )
 (DEFINEQ
 
@@ -96,35 +86,6 @@
 
     (\READACFONTFILE
 STRM])
 
-(\CREATESTARFONT

-  [LAMBDA (FAMILY PSIZE FACE ROTATION DEVICE CHARSET)
        (* ; "Edited 22-May-2025 09:59 by rmk")


-                                                             (* ; "Edited 18-May-2025 21:37 by rmk")

-                                                             (* gbn " 1-Oct-85 18:29")

-
-    (* ;; "the Build font descriptor for an Interpress NS font.  If we can't find widths info for that font, return NIL")

-
-    (* ;; "Widths array is fully allocated, with zeroes for characters with no information.  An array is not allocated for fixed WidthsY.  DEVICE is PRESS or INTERPRESS")

-
-    (DECLARE
 (GLOBALVARS INTERPRESSFONTDIRECTORIES \ASCIITONS))
-    (RESETLST                                                (* ; 
-
                                                     "RESETLST to make sure the fontfiles get closed")

-        (LET [(FD (create
 FONTDESCRIPTOR
-                         FONTDEVICE _ DEVICE
-                         FONTFAMILY _ FAMILY
-                         FONTSIZE _ PSIZE
-                         FONTFACE _ FACE
-                         \SFFACECODE _ (\FACECODE
 FACE)
-                         ROTATION _ ROTATION
-                         OTHERDEVICEFONTPROPS _ \ASCIITONS
-                         FONTSCALE _ (CONSTANT (FQUOTIENT 2540 72]
-             (CL:UNLESS (fetch
 (CHARSETINFO CSSLUGP) of
 (\INSURECHARSETINFO (OR CHARSET 
-                                                                                \DEFAULTCHARSET)
-                                                               FD))
-
-                 (* ;; "return NIL for slug, let FONTCREATE decide whether or not to cause an error")

-
-                 FD)))])
-
 (\READACFONTBOXES

   [LAMBDA (FILE STARTCHAR ENDCHAR)
                           (* jds "15-Jun-85 11:48")

                                                              (* ; 
@@ -448,93 +409,6 @@
 
     (ROTATE-BITMAP-LEFT BITMAP])
 
-(\READFONTWDFILE

-  [LAMBDA (FILE FD WIDTHS SCALE)
                             (* jds " 2-Jan-86 12:34")

-          
-          (* ;; "Widths array is fully allocated, with zeroes for characters with no information.  An array is not allocated for fixed WidthsY.  DEVICE is PRESS or INTERPRESS")

-
-    (DECLARE
 (GLOBALVARS FONTWIDTHSFILES))                   (* (RESETLST (* ; 
-
                                                     "RESETLST to make sure the fontfiles get closed")
-
                                                             (PROG (FIXEDFLAGS FIRSTCHAR LASTCHAR 
-
                                                             TEM WIDTHSY) (SETFILEPTR FILE
-
                                                             (LLSH (\FIXPIN FILE) 1))
-
                                                             (* ; "Locate the segment")
-
                                                             (replace (FONTDESCRIPTOR FBBOX) of FD 
-
                                                             with (SIGNED (\WIN FILE) BITSPERWORD))
-
                                                             (replace \SFDescent of FD with
-
                                                             (IMINUS (SIGNED (\WIN FILE) 
-
                                                             BITSPERWORD))) (* ; "Descent is -FBBOY")
-
                                                             (replace (FONTDESCRIPTOR FBBDX) of FD 
-
                                                             with (SIGNED (\WIN FILE) BITSPERWORD))
-
                                                             (replace \SFHeight of FD with
-
                                                             (SIGNED (\WIN FILE) BITSPERWORD))
-
                                                             (* ; "Height is FBBDY")
-
                                                             (replace \SFWidths of FD with WIDTHS)
-
                                                             (SETQ FIRSTCHAR (fetch FIRSTCHAR of FD))
-
                                                             (* ; 
-
                                                       "First and last 'real' characters in the font")
-
                                                             (SETQ LASTCHAR (fetch LASTCHAR of FD))
-
                                                             (COND (SCALE (* ; 
-
                                                            "Dimensions are relative, must be scaled")
-
                                                             (replace (FONTDESCRIPTOR FBBOX) of FD 
-
                                                             with (IQUOTIENT (ITIMES
-
                                                             (fetch (FONTDESCRIPTOR FBBOX) of FD) 
-
                                                             SCALE) 1000)) (replace \SFDescent of 
-
                                                             FD with (IQUOTIENT (ITIMES
-
                                                             (fetch \SFDescent of FD) SCALE) 1000))
-
                                                             (replace (FONTDESCRIPTOR FBBDX) of FD 
-
                                                             with (IQUOTIENT (ITIMES
-
                                                             (fetch (FONTDESCRIPTOR FBBDX) of FD) 
-
                                                             SCALE) 1000)) (replace \SFHeight of FD 
-
                                                             with (IQUOTIENT (ITIMES
-
                                                             (fetch \SFHeight of FD) SCALE) 1000))))
-
                                                             (replace \SFAscent of FD with
-
                                                             (IDIFFERENCE (fetch \SFHeight of FD)
-
                                                             (fetch \SFDescent of FD)))
-
                                                             (SETQ FIXEDFLAGS (LRSH
-
                                                             (\BIN FILE) 6)) (* ;
-
                                                             "The fixed flags") (\BIN FILE)
-
                                                             (* ; "Skip the spares")
-
                                                             (COND ((EQ 2 (LOGAND FIXEDFLAGS 2))
-
                                                             (SETQ TEM (\WIN FILE))
-
                                                             (* ; "The fixed width for this font")
-
                                                             (COND ((AND SCALE (NOT
-
                                                             (ZEROP TEM))) (SETQ TEM
-
                                                             (IQUOTIENT (ITIMES TEM SCALE) 1000))))
-
                                                             (for I from FIRSTCHAR to LASTCHAR do
-
                                                             (SETA WIDTHS I TEM)))
-
                                                             (T (AIN WIDTHS FIRSTCHAR
-
                                                             (ADD1 (IDIFFERENCE LASTCHAR FIRSTCHAR)) 
-
                                                             FILE) (for I from FIRSTCHAR to 
-
                                                             LASTCHAR when (EQ noInfoCode
-
                                                             (ELT WIDTHS I)) do (SETA WIDTHS I 0))
-
                                                             (COND (SCALE (for I from FIRSTCHAR to 
-
                                                             LASTCHAR do (SETA WIDTHS I
-
                                                             (IQUOTIENT (ITIMES (ELT WIDTHS I) 
-
                                                             SCALE) 1000))))))) (COND
-
                                                             ((EQ 1 (LOGAND FIXEDFLAGS 1))
-
                                                             (SETQ WIDTHSY (\WIN FILE))
-
                                                             (* ; 
-
                  "The fixed width-Y for this font;  the width-Y field is a single integer in the FD")
-
                                                             (replace \SFWidthsY of FD with
-
                                                             (COND ((AND SCALE (NOT
-
                                                             (ZEROP WIDTHSY))) (IQUOTIENT
-
                                                             (ITIMES WIDTHSY SCALE) 1000))
-
                                                             (T WIDTHSY)))) (T (replace \SFWidthsY 
-
                                                             of FD with (SETQ WIDTHSY
-
                                                             (ARRAY (ADD1 \MAXCHAR)
-
                                                             (QUOTE SMALLPOSP) 0 0)))
-
                                                             (AIN WIDTHSY FIRSTCHAR
-
                                                             (ADD1 (IDIFFERENCE LASTCHAR FIRSTCHAR)) 
-
                                                             FILE) (for I from FIRSTCHAR to 
-
                                                             LASTCHAR when (EQ noInfoCode
-
                                                             (ELT WIDTHSY I)) do (SETA WIDTHSY I 0))
-
                                                             (COND (SCALE (for I from FIRSTCHAR to 
-
                                                             LASTCHAR do (SETA WIDTHSY I
-
                                                             (IQUOTIENT (ITIMES (ELT WIDTHSY I) 
-
                                                             SCALE) 1000))))))))))

-    (HELP])
-
 (\FACECODE

   [LAMBDA (FACE)
                                             (* rmk%: "27-FEB-81 12:16")

     (IPLUS (SELECTQ (fetch
 (FONTFACE EXPANSION) of
 FACE)
@@ -578,90 +452,12 @@
                      (RETURN CODE))))
               (0 (RETURN NIL))
               NIL])
-
-(\FINDFONT

-  [LAMBDA (FD WSTRM PRESSMICASIZE NSMICASIZE DONTCHECK)
      (* ; "Edited  2-Apr-87 14:39 by bvm:")

-          
-          (* ;; "Finds the widths information for the specified FAMILY, FACECODE, MSIZE, and ROTATION.  The FIRSTCHAR and LASTCHAR of the font are filled in, since we have to read past those to check the size.  If successful, returns the size found in the widths file, with zero indicating that dimensions in the widths file are relative, leaving the file pointing just after the Rotation word of the font.  --- If DONTCHECK, then assumes that this file contains exactly the right face and family, without checking --- Returns NIL if the font is not found")

-                                                             (* (bind TYPE LENGTH SIZE FAMILYCODE
-
                                                             (ROTATION _ (fetch ROTATION of FD))
-
                                                             (FACECODE _ (\FACECODE
-
                                                             (fetch FONTFACE of FD)))
-
                                                             (NEXT _ 0) (FUZZ _ (PROG1 0.02
-
                                                             (* ; 
-
                                             "percentile difference acceptable as the same font size"))) 
-
                                                             first (OR (SETQ FAMILYCODE
-
                                                             (\FAMILYCODE (OR DONTCHECK
-
                                                             (fetch FONTFAMILY of FD)) WSTRM))
-
                                                             (RETURN NIL)) do (SETQ TYPE
-
                                                             (\BIN WSTRM)) (SETQ LENGTH
-
                                                             (\BIN WSTRM)) (add NEXT
-
                                                             (LLSH (IPLUS LENGTH (LLSH
-
                                                             (LOGAND TYPE 15) 8)) 1))
-
                                                             (SELECTQ (LRSH TYPE 4)
-
                                                             (4 (COND ((OR (AND (EQ FAMILYCODE
-
                                                             (\BIN WSTRM)) (EQ FACECODE
-
                                                             (\BIN WSTRM))) DONTCHECK)
-
                                                             (* ; 
-
              "This is the right family/face (DONTCHECK must come last, so the file reads get done.)")
-
                                                             (replace FIRSTCHAR of FD with
-
                                                             (\BIN WSTRM)) (replace LASTCHAR of FD 
-
                                                             with (\BIN WSTRM)) (COND
-
                                                             ((AND (OR (ZEROP (SETQ SIZE
-
                                                             (\WIN WSTRM))) (LESSP
-
                                                             (ABS (FQUOTIENT (IDIFFERENCE
-
                                                             (OR PRESSMICASIZE NSMICASIZE) SIZE) 
-
                                                             PRESSMICASIZE)) FUZZ))
-
                                                             (EQ ROTATION (\WIN WSTRM)))
-
                                                             (replace \SFFACECODE of FD with 
-
                                                             FACECODE) (RETURN SIZE))))))
-
                                                             (0 (RETURN NIL)) NIL)
-
                                                             (SETFILEPTR WSTRM NEXT)))

-    (HELP])
 )
 
 (ADDTOVAR DISPLAYCHARSETFNS
 (AC ACFONT.FILEP ACFONT.GETCHARSET))
-
-(RPAQ? INTERPRESSFONTDIRECTORIES
 )
-(DECLARE%: EVAL@COMPILE 
-
-(PUTPROPS \POSITIONFONTFILE
 MACRO

-          ((WSTRM NSMICASIZE FIRSTCHAR LASTCHAR FAMILY FACECODE)
-                                                             (* gbn "25-Jul-85 02:15")

-           (bind
 TYPE LENGTH SIZE FAMCODE FILEFAM FILEFACE (NEXT _ 0)
-              first
 (OR (SETQ FAMCODE (\FAMILYCODE
 (OR FAMILY T)
-                                             WSTRM))
-                        (RETURN NIL))
-              do
 (SETQ TYPE (\BIN WSTRM))
-                 (SETQ LENGTH (\BIN WSTRM))
-                 (add
 NEXT (LLSH (IPLUS LENGTH (LLSH (LOGAND TYPE 15)
-                                                     8))
-                                 1))
-                 (SELECTQ (LRSH TYPE 4)
-                     (4 (SETQ FILEFAM (\BIN WSTRM))
-                        (SETQ FILEFACE (\BIN WSTRM))
-                        [COND
-                           ((OR (EQ FAMILY T)
-                                (EQ FAMILY NIL)
-                                (AND (IEQP FILEFAM FAMCODE)
-                                     (IEQP FILEFACE FACECODE)))
-                            (SETQ FIRSTCHAR (\BIN WSTRM))
-                            (SETQ LASTCHAR (\BIN WSTRM))
-                            (COND
-                               ((AND (OR (ZEROP (SETQ SIZE (\WIN WSTRM)))
-                                         (LESSP (ABS (FQUOTIENT (IDIFFERENCE NSMICASIZE SIZE)
-                                                            NSMICASIZE))
-                                                0.02))
-                                     (ZEROP (\WIN WSTRM)))
-                                (RETURN SIZE])
-                     (0 (RETURN NIL))
-                     NIL)
-                 (SETFILEPTR WSTRM NEXT))))
-)
 (DECLARE%: DONTCOPY
-  (FILEMAP (NIL (2849 41269 (ACFONT.FILEP 2859 . 3743) (ACFONT.GETCHARSET 3745 . 4137) (\CREATESTARFONT 
-4139 . 5862) (\READACFONTBOXES 5864 . 8091) (\READACFONTFILE 8093 . 20934) (\ACCHARIMAGELIST 20936 . 
-21293) (\ACCHARWIDTHLIST 21295 . 22561) (\GETFBB 22563 . 25843) (\ACCHARPOSLIST 25845 . 26895) (
-\ACROTATECHAR 26897 . 27461) (\READFONTWDFILE 27463 . 35496) (\FACECODE 35498 . 36092) (\FAMILYCODE 
-36094 . 37398) (\FINDFONT 37400 . 41267)))))
+  (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)))))
 STOP
diff --git a/sources/AFONT.DFASL b/sources/AFONT.DFASL
index 3a69ea175..9338e3cfc 100644
Binary files a/sources/AFONT.DFASL and b/sources/AFONT.DFASL differ
diff --git a/sources/BOOTSTRAP b/sources/BOOTSTRAP
index c81fa6554..6dc3543d1 100644
--- a/sources/BOOTSTRAP
+++ b/sources/BOOTSTRAP
@@ -1,16 +1,13 @@
 (DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
-
(FILECREATED "27-Sep-2021 10:25:31" 
-{DSK}<Users>kaplan>Local>medley3.5>git-medley>sources>BOOTSTRAP.;60
 47698  
 
-      changes to%:  (FNS PRINT-READER-ENVIRONMENT READ-READER-ENVIRONMENT)
+
(FILECREATED "23-Apr-2025 23:39:10" {WMEDLEY}<sources>BOOTSTRAP.;61
 47417  
 
-      previous date%: "17-Aug-2021 00:08:39" 
-{DSK}<Users>kaplan>Local>medley3.5>git-medley>sources>BOOTSTRAP.;58)
+      :EDIT-BY rmk
 
+      :CHANGES-TO (FNS PRINT-READER-ENVIRONMENT \DO-DEFINE-FILE-INFO)
+
+      :PREVIOUS-DATE "27-Sep-2021 10:25:31" {WMEDLEY}<sources>BOOTSTRAP.;59)
 
-(* ; "
-Copyright (c) 1983-1990, 1992, 2021 by Venue & Xerox Corporation.
-")
 
 (PRETTYCOMPRINT BOOTSTRAPCOMS)
 
@@ -19,7 +16,7 @@ Copyright (c) 1983-1990, 1992, 2021 by Venue & Xerox Corporation.
               (FNS GETPROP SETATOMVAL RPAQQ RPAQ RPAQ? MOVD MOVD? SELECTQ SELECTQ1 NCONC1 PUTPROP 
                    PROPNAMES ADDPROP REMPROP MEMB CLOSEF?))
         (COMS                                                (* ; 
-
                                          "Need these in order to load even compiled files SYSLOAD")

+
                                            "Need these in order to load even compiled files SYSLOAD")

               (FNS LOAD \LOAD-STREAM FILECREATED FILECREATED1 PRETTYCOMPRINT BOOTSTRAP-NAMEFIELD 
                    PUTPROPS DECLARE%: DECLARE%:1 ROOTFILENAME))
         [COMS                                                (* ; "For DEFINE-FILE-INFO")

@@ -714,66 +711,64 @@ Copyright (c) 1983-1990, 1992, 2021 by Venue & Xerox Corporation.
     (SET-READER-ENVIRONMENT (\DO-DEFINE-FILE-INFO
 NIL ARGS])
 
 (\DO-DEFINE-FILE-INFO

-  [LAMBDA (STREAM ARGS)
                                 (* ; "Edited 17-Aug-2021 00:05 by rmk:")

+  [LAMBDA (STREAM ARGS)
                                      (* ; "Edited 23-Apr-2025 23:12 by rmk")


+                                                            (* ; "Edited 17-Aug-2021 00:05 by rmk:")

 
-(* ;;; "Processes the (DEFINE-FILE-INFO . ARGS) at the front of STREAM.  This converts the ARGS list to a READER-ENVIRONMENT, and also imposes the external format on STREAM, if non-NIL.")

+(* ;;; "Processes the (DEFINE-FILE-INFO . ARGS) at the front of STREAM.  This converts the ARGS list to a READER-ENVIRONMENT, and also imposes the external format on STREAM, if non-NIL.")

 
-    (* ;; "Include the :PACKAGE... for bootstrapping before in sysouts without an updated version of \LOAD-STREAM")

+    (* ;; "Include the :PACKAGE... for bootstrapping before in sysouts without an updated version of \LOAD-STREAM")

 
-(* ;;; "")

+(* ;;; "")

 
-(* ;;; "The LISTP forms for package and readtable are to allow for those to be created if they don't already exist.  If they do exist, the forms should not make any incompatiblel changes--those should be in a file command somewhere.")

+(* ;;; "The LISTP forms for package and readtable are to allow for those to be created if they don't already exist.  If they do exist, the forms should not make any incompatiblel changes--those should be in a file command somewhere.")

 
-(* ;;; "It doesn't make sense to produce an a new number base by evaluation in a particular runtime environment.  I'm leaving this in for reading, for backward compatibility. Presumably future writing will instantiate to the particular number.")

+(* ;;; "It doesn't make sense to produce an a new number base by evaluation in a particular runtime environment.  I'm leaving this in for reading, for backward compatibility. Presumably future writing will instantiate to the particular number.")

 
     (LET (PACKAGE READTABLE BASE FORMAT VALUE PACKAGEFORM READTABLEFORM)
          [for
 TAIL on
 ARGS by
 (CDDR TAIL)
             do
 (SETQ VALUE (CADR TAIL))
-                  (SELECTQ
 (CAR TAIL)
-                        ((:PACKAGE %:PACKAGE) 
-                               (SETQ PACKAGE (if
 (LISTP VALUE)
-                                                 then
 (SETQ PACKAGEFORM VALUE)
-                                                       (EVAL VALUE)
-                                               ELSE
 VALUE))
-                               (IF
 (TYPEP PACKAGE 'PACKAGE)
-                                 ELSEIF
 (SETQ PACKAGE (CL:FIND-PACKAGE PACKAGE))
-                                 ELSE
 
-
-                                       (* ;; "Better message than just \DTEST")

-
-                                       (ERROR 
-                                         "Can't find package for DEFINE-FILE-INFO reader environment"
-                                              VALUE)))
-                        ((:READTABLE %:READTABLE) 
-                               (SETQ READTABLE (if
 (LISTP VALUE)
-                                                   then
 (SETQ READTABLEFORM VALUE)
-                                                         (EVAL VALUE)
-                                                 ELSE
 VALUE))
-                               (IF
 (TYPEP READTABLE 'READTABLEP)
-                                 ELSEIF
 (SETQ READTABLE (FIND-READTABLE READTABLE))
-                                 ELSE
 
-
-                                       (* ;; "Better message than just \DTEST")

-
-                                       (ERROR 
-                                      "Can't find read table for DEFINE-FILE-INFO reader environment"
-                                              VALUE)))
-                        ((:BASE %:BASE)                      (* ; 
-
                                                        "RMK:  An EVAL form here makes no sense.  ")

-                               (SETQ BASE (OR (\CHECKRADIX (if
 (LISTP VALUE)
-                                                               then
 (EVAL VALUE)
-                                                             else
 VALUE))
-                                              (ERROR 
-                                              "Bad read base for DEFINE-FILE-INFO reader environment"
-                                                     VALUE))))
-                        ((:FORMAT FORMAT %:FORMAT) 
-                               (SETQ FORMAT (FETCH
 (EXTERNALFORMAT NAME) OF
 (FIND-FORMAT
-                                                                                     VALUE))))
-                        (ERROR "Unrecognized file info key" (CAR TAIL]
-
-         (* ;; "Set the defaults.  Is this essentially ignoring the *DEFAULT-MAKEFILE-ENVIRONMENT*?  Maybe the defaults should be take from there?")

-
-         (CL:UNLESS FORMAT (SETQ FORMAT :XCCS))
+               (SELECTQ
 (CAR TAIL)
+                   ((:PACKAGE %:PACKAGE) 
+                        (SETQ PACKAGE (if
 (LISTP VALUE)
+                                          then
 (SETQ PACKAGEFORM VALUE)
+                                               (EVAL VALUE)
+                                        ELSE
 VALUE))
+                        (IF
 (TYPEP PACKAGE 'PACKAGE)
+                          ELSEIF
 (SETQ PACKAGE (CL:FIND-PACKAGE PACKAGE))
+                          ELSE
 
+                               (* ;; "Better message than just \DTEST")

+
+                               (ERROR "Can't find package for DEFINE-FILE-INFO reader environment" 
+                                      VALUE)))
+                   ((:READTABLE %:READTABLE) 
+                        (SETQ READTABLE (if
 (LISTP VALUE)
+                                            then
 (SETQ READTABLEFORM VALUE)
+                                                 (EVAL VALUE)
+                                          ELSE
 VALUE))
+                        (IF
 (TYPEP READTABLE 'READTABLEP)
+                          ELSEIF
 (SETQ READTABLE (FIND-READTABLE READTABLE))
+                          ELSE
 
+                               (* ;; "Better message than just \DTEST")

+
+                               (ERROR "Can't find read table for DEFINE-FILE-INFO reader environment"
+                                      VALUE)))
+                   ((:BASE %:BASE)                           (* ; 
+
                                                          "RMK:  An EVAL form here makes no sense.  ")

+                        (SETQ BASE (OR (\CHECKRADIX (if
 (LISTP VALUE)
+                                                        then
 (EVAL VALUE)
+                                                      else
 VALUE))
+                                       (ERROR "Bad read base for DEFINE-FILE-INFO reader environment"
+                                              VALUE))))
+                   ((:FORMAT FORMAT %:FORMAT) 
+                        (SETQ FORMAT (FETCH
 (EXTERNALFORMAT NAME) OF
 (FIND-FORMAT VALUE))))
+                   (ERROR "Unrecognized file info key" (CAR TAIL]
+
+         (* ;; "Set the defaults.  Is this essentially ignoring the *DEFAULT-MAKEFILE-ENVIRONMENT*?  Maybe the defaults should be take from there?")

+
+         (CL:UNLESS FORMAT
+             (SETQ FORMAT (CL:IF (FIND-FORMAT :MCCS T)
+                              :MCCS
+                              :XCCS)))
          (CL:WHEN STREAM (\EXTERNALFORMAT STREAM FORMAT))
          (create
 READER-ENVIRONMENT
                 REPACKAGE _ (OR PACKAGE *INTERLISP-PACKAGE*)
@@ -784,7 +779,8 @@ Copyright (c) 1983-1990, 1992, 2021 by Venue & Xerox Corporation.
                 REREADTABLEFORM _ READTABLEFORM])
 
 (PRINT-READER-ENVIRONMENT

-  [LAMBDA (ENV STREAM)
                                  (* ; "Edited 27-Sep-2021 10:24 by rmk:")

+  [LAMBDA (ENV STREAM)
                                       (* ; "Edited 23-Apr-2025 23:38 by rmk")


+                                                            (* ; "Edited 27-Sep-2021 10:24 by rmk:")

 
 (* ;;; "If ENV is not the old default interlisp reader environment, writes a DEFINE-FILE-INFO expression on STREAM that will produce this environment when the file is loaded.")

 
@@ -798,13 +794,14 @@ Copyright (c) 1983-1990, 1992, 2021 by Venue & Xerox Corporation.
              [SETQ RDTBL (IF
 (FETCH
 REREADTABLEFORM OF
 ENV)
                            ELSEIF
 (fetch
 REREADTABLE of
 ENV)
                              THEN
 (READTABLEPROP (fetch
 REREADTABLE of
 ENV)
-                                             'NAME]
+                                         'NAME]
              (PRINT [CONS 'DEFINE-FILE-INFO
                           `(,@[AND PKG `(:PACKAGE ,PKG]
                             ,@[AND RDTBL `(:READTABLE ,RDTBL]
                             :BASE
                             ,(fetch
 REBASE of
 ENV)
-                            ,@(CL:UNLESS (EQ :XCCS (FETCH
 REFORMAT OF
 ENV))
+                            ,@(CL:UNLESS (EQMEMB (FETCH
 REFORMAT OF
 ENV)
+                                                '(:MCCS :XCCS))
                                   `(:FORMAT ,(FETCH
 REFORMAT OF
 ENV)))]
                     STREAM
                     (FETCH
 (READER-ENVIRONMENT REREADTABLE) OF
 *DEFINE-FILE-INFO-ENV*))
@@ -953,8 +950,8 @@ Copyright (c) 1983-1990, 1992, 2021 by Venue & Xerox Corporation.
       (FUNCTION (LAMBDA (X)
                   (OR (CCODEP (CDR X))
                       (MOVD
 (CAR X)
-                             (CDR X)
-                             NIL T]
+                            (CDR X)
+                            NIL T]
 
 (AND (CCODEP 'BOOTSTRAP-NAMEFIELD)
      (PUTD 'BOOTSTRAP-NAMEFIELD))
@@ -979,16 +976,14 @@ Copyright (c) 1983-1990, 1992, 2021 by Venue & Xerox Corporation.
 
 (ADDTOVAR LAMA
 )
 )
-(PUTPROPS BOOTSTRAP COPYRIGHT ("Venue & Xerox Corporation" 1983 1984 1985 1986 1987 1988 1989 1990 
-1992 2021))
 (DECLARE%: DONTCOPY
-  (FILEMAP (NIL (4751 14423 (GETPROP 4761 . 5333) (SETATOMVAL 5335 . 5464) (RPAQQ 5466 . 5519) (RPAQ 
-5521 . 5833) (RPAQ? 5835 . 6205) (MOVD 6207 . 8071) (MOVD? 8073 . 8503) (SELECTQ 8505 . 8692) (
-SELECTQ1 8694 . 9036) (NCONC1 9038 . 9234) (PUTPROP 9236 . 10720) (PROPNAMES 10722 . 10913) (ADDPROP 
-10915 . 12978) (REMPROP 12980 . 13834) (MEMB 13836 . 14095) (CLOSEF? 14097 . 14421)) (14496 35060 (
-LOAD 14506 . 15675) (\LOAD-STREAM 15677 . 28751) (FILECREATED 28753 . 30171) (FILECREATED1 30173 . 
-31281) (PRETTYCOMPRINT 31283 . 31768) (BOOTSTRAP-NAMEFIELD 31770 . 32730) (PUTPROPS 32732 . 33100) (
-DECLARE%: 33102 . 33234) (DECLARE%:1 33236 . 34108) (ROOTFILENAME 34110 . 35058)) (35098 45530 (
-DEFINE-FILE-INFO 35108 . 35543) (\DO-DEFINE-FILE-INFO 35545 . 39891) (PRINT-READER-ENVIRONMENT 39893
- . 41475) (READ-READER-ENVIRONMENT 41477 . 44252) (MAKE-DEFINE-FILE-INFO-ENV 44254 . 45528)))))
+  (FILEMAP (NIL (4617 14289 (GETPROP 4627 . 5199) (SETATOMVAL 5201 . 5330) (RPAQQ 5332 . 5385) (RPAQ 
+5387 . 5699) (RPAQ? 5701 . 6071) (MOVD 6073 . 7937) (MOVD? 7939 . 8369) (SELECTQ 8371 . 8558) (
+SELECTQ1 8560 . 8902) (NCONC1 8904 . 9100) (PUTPROP 9102 . 10586) (PROPNAMES 10588 . 10779) (ADDPROP 
+10781 . 12844) (REMPROP 12846 . 13700) (MEMB 13702 . 13961) (CLOSEF? 13963 . 14287)) (14362 34926 (
+LOAD 14372 . 15541) (\LOAD-STREAM 15543 . 28617) (FILECREATED 28619 . 30037) (FILECREATED1 30039 . 
+31147) (PRETTYCOMPRINT 31149 . 31634) (BOOTSTRAP-NAMEFIELD 31636 . 32596) (PUTPROPS 32598 . 32966) (
+DECLARE%: 32968 . 33100) (DECLARE%:1 33102 . 33974) (ROOTFILENAME 33976 . 34924)) (34964 45363 (
+DEFINE-FILE-INFO 34974 . 35409) (\DO-DEFINE-FILE-INFO 35411 . 39554) (PRINT-READER-ENVIRONMENT 39556
+ . 41308) (READ-READER-ENVIRONMENT 41310 . 44085) (MAKE-DEFINE-FILE-INFO-ENV 44087 . 45361)))))
 STOP
diff --git a/sources/BOOTSTRAP.LCOM b/sources/BOOTSTRAP.LCOM
index a431b0c73..ea5f87950 100644
Binary files a/sources/BOOTSTRAP.LCOM and b/sources/BOOTSTRAP.LCOM differ
diff --git a/sources/CMLREAD b/sources/CMLREAD
index 7217d725b..2542b14f4 100644
--- a/sources/CMLREAD
+++ b/sources/CMLREAD
@@ -1,12 +1,12 @@
 (DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
 
-
(FILECREATED "23-Sep-2024 11:55:33" {DSK}<home>matt>Interlisp>medley>sources>CMLREAD.;4
 12882  
+
(FILECREATED "24-Apr-2025 21:59:48" {WMEDLEY}<sources>CMLREAD.;17
 12829  
 
-      :EDIT-BY "mth"
+      :EDIT-BY rmk
 
-      :CHANGES-TO (FNS CL:READ-FROM-STRING)
+      :CHANGES-TO (VARS CMLREADCOMS)
 
-      :PREVIOUS-DATE "16-Sep-2024 12:26:09" {DSK}<home>matt>Interlisp>medley>sources>CMLREAD.;3)
+      :PREVIOUS-DATE "23-Sep-2024 11:55:33" {WMEDLEY}<sources>CMLREAD.;16)
 
 
 (PRETTYCOMPRINT CMLREADCOMS)
@@ -37,7 +37,7 @@
               (INITVARS (*COMMON-LISP-READ-ENVIRONMENT* (create READER-ENVIRONMENT REPACKAGE _
                                                                (CL:FIND-PACKAGE "USER")
                                                                REREADTABLE _ CMLRDTBL REBASE _ 10 
-                                                               REFORMAT _ :XCCS]
+                                                               REFORMAT _ :MCCS]
         (PROP FILETYPE CMLREAD)
         (DECLARE%: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY COMPILERVARS
                (ADDVARS (NLAMA)
@@ -274,7 +274,7 @@
 )
 
 (RPAQ? *COMMON-LISP-READ-ENVIRONMENT*
 (create READER-ENVIRONMENT REPACKAGE _ (CL:FIND-PACKAGE "USER")
-                                             REREADTABLE _ CMLRDTBL REBASE _ 10 REFORMAT _ :XCCS))
+                                             REREADTABLE _ CMLRDTBL REBASE _ 10 REFORMAT _ :MCCS))
 
 (PUTPROPS CMLREAD
 FILETYPE
 CL:COMPILE-FILE)
 (DECLARE%: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY COMPILERVARS 
@@ -287,9 +287,9 @@
                      CL:UNREAD-CHAR CL:READ-CHAR CL:READ-LINE CL:COPY-READTABLE)
 )
 (DECLARE%: DONTCOPY
-  (FILEMAP (NIL (2433 3418 (CL:COPY-READTABLE 2443 . 3416)) (3419 10627 (CL:READ-LINE 3429 . 4301) (
-CL:READ-CHAR 4303 . 4853) (CL:UNREAD-CHAR 4855 . 5316) (CL:PEEK-CHAR 5318 . 7612) (CL:LISTEN 7614 . 
-7879) (CL:READ-CHAR-NO-HANG 7881 . 8653) (CL:CLEAR-INPUT 8655 . 8892) (CL:READ-FROM-STRING 8894 . 9914
-) (CL:READ-BYTE 9916 . 10369) (CL:WRITE-BYTE 10371 . 10625)) (11621 12094 (WITH-READER-ENVIRONMENT 
-11621 . 12094)))))
+  (FILEMAP (NIL (2380 3365 (CL:COPY-READTABLE 2390 . 3363)) (3366 10574 (CL:READ-LINE 3376 . 4248) (
+CL:READ-CHAR 4250 . 4800) (CL:UNREAD-CHAR 4802 . 5263) (CL:PEEK-CHAR 5265 . 7559) (CL:LISTEN 7561 . 
+7826) (CL:READ-CHAR-NO-HANG 7828 . 8600) (CL:CLEAR-INPUT 8602 . 8839) (CL:READ-FROM-STRING 8841 . 9861
+) (CL:READ-BYTE 9863 . 10316) (CL:WRITE-BYTE 10318 . 10572)) (11568 12041 (WITH-READER-ENVIRONMENT 
+11568 . 12041)))))
 STOP
diff --git a/sources/CMLREAD.LCOM b/sources/CMLREAD.LCOM
index 1a0db1409..d2e4be960 100644
Binary files a/sources/CMLREAD.LCOM and b/sources/CMLREAD.LCOM differ
diff --git a/sources/COMPILE b/sources/COMPILE
index d87ed2bbd..7b2a941c6 100644
--- a/sources/COMPILE
+++ b/sources/COMPILE
@@ -1,23 +1,14 @@
 (DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
 
-
(FILECREATED "24-Sep-2023 13:59:34" {WMEDLEY}<sources>COMPILE.;5
 77344  
+
(FILECREATED "24-Apr-2025 22:04:20" {WMEDLEY}<sources>COMPILE.;6
 76628  
 
       :EDIT-BY rmk
 
-      :CHANGES-TO (VARS COMPILECOMS)
-                  (FNS COMPSET)
+      :CHANGES-TO (FNS BCOMPL.BODY BRECOMPILE)
 
-      :PREVIOUS-DATE " 5-Jul-2021 13:46:39" {WMEDLEY}<sources>COMPILE.;4)
+      :PREVIOUS-DATE "24-Sep-2023 13:59:34" {WMEDLEY}<sources>COMPILE.;5)
 
 
-(* ; "
-Copyright (c) 1984-1990, 2021 by Venue & Xerox Corporation.
-The following program was created in 1984 but has not been published
-within the meaning of the copyright law, is furnished under license,
-and may not be used, copied and/or disclosed except in accordance
-with the terms of said license.
-")
-
 (PRETTYCOMPRINT COMPILECOMS)
 
 (RPAQQ COMPILECOMS

@@ -113,101 +104,102 @@ with the terms of said license.
                     CFILE NOBLOCKSFLG OPTIONSSET)))])
 
 (BCOMPL.BODY

-  [LAMBDA (STREAMS CFILE NOBLOCKSFLG OPTIONSSET)
        (* ; "Edited  5-Jul-2021 13:46 by rmk:")

+  [LAMBDA (STREAMS CFILE NOBLOCKSFLG OPTIONSSET)
             (* ; "Edited 24-Apr-2025 22:03 by rmk")


+                                                            (* ; "Edited  5-Jul-2021 13:46 by rmk:")

 
-(* ;;; "STREAMS is a list of streams.  Compile everything on them, dumping to CFILE (default first stream.dcom).  NOBLOCKSFLG means TCOMPL instead of BCOMPL.  OPTIONSSET is true if the Listing? question has already been asked.")

+(* ;;; "STREAMS is a list of streams.  Compile everything on them, dumping to CFILE (default first stream.dcom).  NOBLOCKSFLG means TCOMPL instead of BCOMPL.  OPTIONSSET is true if the Listing? question has already been asked.")

 
-(* ;;; "RMK:  Apply each input streams \EXTERNALFORMAT")

+(* ;;; "RMK:  Apply each input streams \EXTERNALFORMAT")

 
     (DECLARE
 (SPECVARS
 CFILE))
     (PROG ((SPECVARS
 T)
            (LOCALVARS
 SYSLOCALVARS)
            DEFS CHANGES OTHERS FIRST BLOCKS BLKFNS FILEROOT TEM SCRATCHFILE DESTINATIONENV UNPACKFILE
            )
-          (DECLARE
 (SPECVARS
 SPECVARS LOCALVARS CHANGES OTHERS FIRST BLOCKS BLKFNS 
-                              DESTINATIONENV DEFS))
+          (DECLARE
 (SPECVARS
 SPECVARS LOCALVARS CHANGES OTHERS FIRST BLOCKS BLKFNS DESTINATIONENV 
+                          DEFS))
           [OR OPTIONSSET (COMPSET
 NIL '(F %
-]                                                            (* ; 
-
"OPTIONSSET is T on calls from TCOMPL.  In this case, the first COMPSET has already been performed.")

+]                                                            (* ; 
+
 "OPTIONSSET is T on calls from TCOMPL.  In this case, the first COMPSET has already been performed.")

           (COMPSET
 (OR CFILE (PACKFILENAME 'HOST [CADR (FMEMB 'HOST (SETQ UNPACKFILE
-                                                                         (UNPACKFILENAME (CAR STREAMS
-                                                                                              ]
-                                        'DIRECTORY
-                                        (CADR (FMEMB 'DIRECTORY UNPACKFILE))
-                                        'NAME
-                                        (SETQ FILEROOT (CADR (FMEMB 'NAME UNPACKFILE)))
-                                        'EXTENSION COMPILE.EXT)))
+                                                                     (UNPACKFILENAME (CAR STREAMS]
+                                    'DIRECTORY
+                                    (CADR (FMEMB 'DIRECTORY UNPACKFILE))
+                                    'NAME
+                                    (SETQ FILEROOT (CADR (FMEMB 'NAME UNPACKFILE)))
+                                    'EXTENSION COMPILE.EXT)))
 
-     (* ;; "Edited by TT(8-June-90 : for Fix AR#2999)")

+     (* ;; "Edited by TT(8-June-90 : for Fix AR#2999)")

 
           [COND
              (LCFIL (SETQ SCRATCHFILE (OPENSTREAM BCOMPL.SCRATCH 'BOTH 'NEW]
           (RESETSAVE NIL (LIST 'BCOMPL3 NIL STREAMS SCRATCHFILE))
 
-     (* ;; "BCOMPL3 will close and if necessary delete all the appropriate files when bcompl finishes, or control-d or control-e occurs.")

+     (* ;; "BCOMPL3 will close and if necessary delete all the appropriate files when bcompl finishes, or control-d or control-e occurs.")

 
           [LET (DFNFLG)
 
-               (* ;; "if top level value of DFNFLG is PROP, still want to evaluate expressions in declarations etc as though it were T.  i.e. make BCOMPL1A equivalent to doing a LOADCOMP")

+               (* ;; "if top level value of DFNFLG is PROP, still want to evaluate expressions in declarations etc as though it were T.  i.e. make BCOMPL1A equivalent to doing a LOADCOMP")

 
                (for
 STREAM in
 STREAMS
                   do
 (RESETLST
-                             (RESETSAVE NIL (LIST 'CLOSEF STREAM))
-                             (RESETSAVE (INPUT STREAM))      (* ; 
-
                            "Needs to be primary input for some of the filepkg expressions to work")

-                             (WITH-READER-ENVIRONMENT *OLD-INTERLISP-READ-ENVIRONMENT*
-                                 (until
 (OR (NULL (SETQ TEM (READ STREAM)))
-                                                (EQ TEM 'STOP))
-                                    do
 (CL:WHEN (EQ (CAR (LISTP TEM))
-                                                        'DEFINE-FILE-INFO)
-                                               (\EXTERNALFORMAT STREAM (OR (LISTGET (CDR TEM)
-                                                                                  :FORMAT)
-                                                                           :XCCS)))
-                                          (BCOMPL1A
 TEM 'DEFAULT 'DEFAULT 'DEFAULT STREAM))))]
+                         (RESETSAVE NIL (LIST 'CLOSEF STREAM))
+                         (RESETSAVE (INPUT STREAM))          (* ; 
+
                              "Needs to be primary input for some of the filepkg expressions to work")

+                         (WITH-READER-ENVIRONMENT *OLD-INTERLISP-READ-ENVIRONMENT*
+                             (until
 (OR (NULL (SETQ TEM (READ STREAM)))
+                                        (EQ TEM 'STOP))
+                                do
 (CL:WHEN (EQ (CAR (LISTP TEM))
+                                                'DEFINE-FILE-INFO)
+                                       (\EXTERNALFORMAT STREAM (OR (LISTGET (CDR TEM)
+                                                                          :FORMAT)
+                                                                   :MCCS)))
+                                   (BCOMPL1A
 TEM 'DEFAULT 'DEFAULT 'DEFAULT STREAM))))]
           (SETQ NOFIXFNSLST (APPEND NLAMA NLAML LAMS (NCONC [MAPCAR DEFS (FUNCTION (LAMBDA (X)
                                                                                      (RCOMP3

                                                                                       (CAR X)
                                                                                       (CADR X]
                                                             NOFIXFNSLST)))
 
-     (* ;; "The BCOMPL1 reads in FILES.  It returns a list of variables set in the files.  The RCOMP3 adds function to NLAMA, LAMS, etc., and returns a list of functions.  NOFIXFNLST is reset in case there is any dwimifying to be done.")

+     (* ;; "The BCOMPL1 reads in FILES.  It returns a list of variables set in the files.  The RCOMP3 adds function to NLAMA, LAMS, etc., and returns a list of functions.  NOFIXFNLST is reset in case there is any dwimifying to be done.")

 
           (WITH-READER-ENVIRONMENT (OR DESTINATIONENV (SETQ DESTINATIONENV 
                                                        *OLD-INTERLISP-READ-ENVIRONMENT*))
               (COND
-                 (LCFIL (\EXTERNALFORMAT LCFIL (OR (FETCH
 (READER-ENVIRONMENT REFORMAT)
-                                                      OF
 DESTINATIONENV)
-                                                   :XCCS))
+                 (LCFIL (\EXTERNALFORMAT LCFIL (OR (FETCH
 (READER-ENVIRONMENT REFORMAT) OF
 
+                                                                                       DESTINATIONENV
+                                                          )
+                                                   :MCSS))
                         (PRINT-COMPILE-HEADER
 STREAMS [LIST (COND
-                                                                   (NOBLOCKSFLG 'tcompl'd)
-                                                                   (T 'bcompl'd]
+                                                               (NOBLOCKSFLG 'tcompl'd)
+                                                               (T 'bcompl'd]
                                DESTINATIONENV)))
               (COND
                  (SCRATCHFILE 
 
-                        (* ;; "writes others on a scratchfile so space can be freed up.  will be copied onto lcfil aftr compilation.")

+                        (* ;; "writes others on a scratchfile so space can be freed up.  will be copied onto lcfil aftr compilation.")

 
                         (\EXTERNALFORMAT SCRATCHFILE (\EXTERNALFORMAT LCFIL))
                         (for
 X in
 OTHERS do
 (PRINT X SCRATCHFILE))
                         (PRINT NIL SCRATCHFILE)
                         (SETQ OTHERS NIL)))
               [OR DWIMIFYCOMPFLG (SETQ DWIMIFYCOMPFLG (EQMEMB 'CLISP (GETPROP FILEROOT 'FILETYPE]
-                                                             (* ; 
-
                                     "The FILETYPE may have been set during the course of BCOMPL1.")

+                                                             (* ; 
+
                                       "The FILETYPE may have been set during the course of BCOMPL1.")

               [MAPC FIRST (FUNCTION (LAMBDA (X)
                                       (PRINT X LCFIL]
               [PROG (LISPXHIST)
                     (DECLARE
 (SPECVARS
 LISPXHIST))
 
-               (* ;; "compile blocks MAPC not used because BCOMPL2 checks BLOCKS.  lispxhist rebound bcause no need to save information when compiling from file")

+               (* ;; "compile blocks MAPC not used because BCOMPL2 checks BLOCKS.  lispxhist rebound bcause no need to save information when compiling from file")

 
                     (AND NOBLOCKSFLG (GO NOBLOCKLP))
                 BLOCKLP
                     (COND
                        (BLOCKS (BCOMPL2
 (CAR BLOCKS))
                               (SETQ BLOCKS (CDR BLOCKS))
-                              (GO BLOCKLP)))                 (* ; 
-
  "COMPILE other functions.  done this way instead of MAPC to release the defs as soon aspossible.")

+                              (GO BLOCKLP)))                 (* ; 
+
    "COMPILE other functions.  done this way instead of MAPC to release the defs as soon aspossible.")

                 NOBLOCKLP
                     (COND
                        (DEFS (AND (NOT (FMEMB (CAAR DEFS)
@@ -499,17 +491,18 @@ with the terms of said license.
     (SETQ BLOCKS (NCONC1 BLOCKS X))))
 
 (BRECOMPILE

-  [LAMBDA (FILES CFILE FNS NOBLOCKSFLG)
                 (* ; "Edited  5-Jul-2021 09:28 by rmk:")

+  [LAMBDA (FILES CFILE FNS NOBLOCKSFLG)
                      (* ; "Edited 24-Apr-2025 22:04 by rmk")


+                                                            (* ; "Edited  5-Jul-2021 09:28 by rmk:")

 
-(* ;;; "FNS is a list of functions to be recompiled.  The object is to make a file that looks exactly like that produced by BCOMPL except to greatly reduce the work by copying from CFILE the compiled definitions those functions not being recompiled.")

+(* ;;; "FNS is a list of functions to be recompiled.  The object is to make a file that looks exactly like that produced by BCOMPL except to greatly reduce the work by copying from CFILE the compiled definitions those functions not being recompiled.")

 
-(* ;;; "BRECOMPILE is driven by the source file(s).  The algorithm is whenever a DEFINEQ is encountered, process all of the functions in the DEFINEQ as follows: COMPILE the definition of the function if it is on the list FNS, or if FNS is EXPRS and the function is currently defined as an EXPR.  Otherwise copy its compiled definition from CFILE.  Note that functions with compiled definitions in CFILE that do not appear in PFILE are NOT copied.  This corresponds to the case where functions have been deleted from the source file.")

+(* ;;; "BRECOMPILE is driven by the source file(s).  The algorithm is whenever a DEFINEQ is encountered, process all of the functions in the DEFINEQ as follows: COMPILE the definition of the function if it is on the list FNS, or if FNS is EXPRS and the function is currently defined as an EXPR.  Otherwise copy its compiled definition from CFILE.  Note that functions with compiled definitions in CFILE that do not appear in PFILE are NOT copied.  This corresponds to the case where functions have been deleted from the source file.")

 
-(* ;;; "The value FNS = CHANGES means recompile anything marked changed in the file header.")

+(* ;;; "The value FNS = CHANGES means recompile anything marked changed in the file header.")

 
-(* ;;; "(RECOMPILE file cfile fns) is equivalent to (BRECOMPILE file cfile fns T).")

+(* ;;; "(RECOMPILE file cfile fns) is equivalent to (BRECOMPILE file cfile fns T).")

 
-(* ;;; "Note that CFILE=NIL is interpreted as meaning file.dcom even when FNS supplied.")

+(* ;;; "Note that CFILE=NIL is interpreted as meaning file.dcom even when FNS supplied.")

 
     (RESETLST
         (PROG ((*PRINT-ARRAY* T)
@@ -529,10 +522,10 @@ with the terms of said license.
                (AUXFILECOM T)
                CHANGES OTHERS FIRST FILEMAPLST FNLST BLKFNS BLOCKS FILE FILE.COM TEM ADRLST 
                SCRATCHFILE COREOK DESTINATIONENV MSG)
-              (DECLARE
 (SPECVARS
 *PRINT-ARRAY* *PRINT-LENGTH* *PRINT-LEVEL* NLAMA NLAML LAMS
-                                  LAMA DWIMIFYCOMPFLG EXPRSLST NOFIXFNSLST NOFIXVARSLST BUILDMAPFLG 
-                                  SPECVARS LOCALVARS CHANGES OTHERS FIRST BLKFNS BLOCKS 
-                                  DESTINATIONENV ADRLST FILEMAPLST CFILE FNS FILE))
+              (DECLARE
 (SPECVARS
 *PRINT-ARRAY* *PRINT-LENGTH* *PRINT-LEVEL* NLAMA NLAML LAMS LAMA 
+                              DWIMIFYCOMPFLG EXPRSLST NOFIXFNSLST NOFIXVARSLST BUILDMAPFLG SPECVARS 
+                              LOCALVARS CHANGES OTHERS FIRST BLKFNS BLOCKS DESTINATIONENV ADRLST 
+                              FILEMAPLST CFILE FNS FILE))
               (COND
                  ((AND (NULL CFILE)
                        (NULL FNS))
@@ -551,7 +544,7 @@ with the terms of said license.
                                     (SETQ FILE (CADR (FMEMB 'NAME FILE)))
                                     'EXTENSION COMPILE.EXT))
 
-         (* ;; "Edited by TT (8-June-90 : for fix AR#2999)")

+         (* ;; "Edited by TT (8-June-90 : for fix AR#2999)")

 
               (COND
                  ((EQ FNS 'ALL)
@@ -572,7 +565,7 @@ with the terms of said license.
                                     ((OR (NULL ENV)
                                          (NOT (EQUAL-READER-ENVIRONMENT ENV DESTINATIONENV)))
                                      T)
-                                    (T                       (* "Position cfile back to start")

+                                    (T                       (* "Position cfile back to start")

                                        (SETFILEPTR CFILE START)
                                        NIL]
                       (SETQ TEM (CLOSEF CFILE))
@@ -587,14 +580,14 @@ with the terms of said license.
                                                      "not found;" " compile all functions on "
                                                      (FULLNAME (CAR FILES))
                                                      '"instead"))
-                          'Y))                               (* ; 
-
                                                        "Edited by TT(8-June-90 : for Fix AR#8017)")

+                          'Y))                               (* ; 
+
                                                          "Edited by TT(8-June-90 : for Fix AR#8017)")

                   (GO BRECALL))
                  ((EQ [ASKUSER DWIMWAIT 'Y (CONS '"Just forget about compiling"
                                                  (MAPCAR FILES (FUNCTION FULLNAME]
                       'Y)
                   (SELECTQ (CAR READBUF)
-                      ((ST F STF)                            (* "E.g. From CLEANUP.")

+                      ((ST F STF)                            (* "E.g. From CLEANUP.")

                            (SETQ READBUF (CDR READBUF)))
                       NIL)
                   (RETFROM 'BRECOMPILE))
@@ -613,117 +606,109 @@ with the terms of said license.
               (SETQ SCRATCHFILE (OPENSTREAM BCOMPL.SCRATCH 'BOTH 'NEW))
               (RESETSAVE NIL (LIST 'BCOMPL3 CFILE FILES SCRATCHFILE))
 
-         (* ;; "BCOMPL3 will close and if necessary delete all the appropriate files when brecompile finishes, or control-d or control-e occurs.  Note that this call differs from the call for bcompl in that cfile is also specified.  this corresponds to the fact that recompile has an extra file open.")

+         (* ;; "BCOMPL3 will close and if necessary delete all the appropriate files when brecompile finishes, or control-d or control-e occurs.  Note that this call differs from the call for bcompl in that cfile is also specified.  this corresponds to the fact that recompile has an extra file open.")

 
-              [SETQ COREOK (for
 X in
 FILES
-                              always
 (AND (EQ (CDAR (GETPROP (SETQ TEM (ROOTFILENAME X))
-                                                               'FILEDATES))
-                                                  X)
-                                              (FMEMB (CDAR (GETPROP TEM 'FILE))
-                                                     '(LOADFNS T]
+              [SETQ COREOK (for
 X in
 FILES always
 (AND (EQ (CDAR (GETPROP (SETQ TEM (ROOTFILENAME
+                                                                                     X))
+                                                                        'FILEDATES))
+                                                           X)
+                                                       (FMEMB (CDAR (GETPROP TEM 'FILE))
+                                                              '(LOADFNS T]
               [SETQ FILEMAPLST
                (for
 STREAM in
 FILES
                   collect
 (LET ((LDFLG 'EXPRESSIONS)
-                                    (VARLST 'COMPILING)
-                                    DONELST FNLST)
-                                   (DECLARE
 (SPECVARS
 LDFLG VARLST DONELST FNLST))
-                                                             (* ; 
-
                                                           "FNLST etc are used free in LOADFNSCAN")

-                                   (SETFILEPTR STREAM 0)
-                                   (INPUT STREAM)
-
-                                 (* ;; "LOADFNSCAN scans the file, building a map if one not already there.  Value is the map.  In addition, sets DONELST to a list of all non-defineq expressions.")

-
-                                   (CL:MULTIPLE-VALUE-BIND (ENV MAP FILECREATEDLOC)
-                                          (GET-ENVIRONMENT-AND-FILEMAP STREAM)
-                                          (DECLARE
 (CL:SPECIAL FILECREATEDLOC))
-                                                             (* ; " used by LOADFNSCAN")

-                                          (WITH-READER-ENVIRONMENT ENV
-                                              (create
 COMPFILEDESCR
-                                                     COMPFILESTREAM _ STREAM
-                                                     COMPFILEENV _ ENV
-                                                     COMPFILEMAP _ (LOADFNSCAN MAP)
-                                                     COMPFILEXPRS _ (DREVERSE DONELST)))]
+                                (VARLST 'COMPILING)
+                                DONELST FNLST)
+                               (DECLARE
 (SPECVARS
 LDFLG VARLST DONELST FNLST))
+                                                             (* ; 
+
                                                             "FNLST etc are used free in LOADFNSCAN")

+                               (SETFILEPTR STREAM 0)
+                               (INPUT STREAM)
+
+                               (* ;; "LOADFNSCAN scans the file, building a map if one not already there.  Value is the map.  In addition, sets DONELST to a list of all non-defineq expressions.")

+
+                               (CL:MULTIPLE-VALUE-BIND (ENV MAP FILECREATEDLOC)
+                                      (GET-ENVIRONMENT-AND-FILEMAP STREAM)
+                                      (DECLARE
 (CL:SPECIAL FILECREATEDLOC))
+                                                             (* ; " used by LOADFNSCAN")

+                                      (WITH-READER-ENVIRONMENT ENV
+                                          (create
 COMPFILEDESCR
+                                                 COMPFILESTREAM _ STREAM
+                                                 COMPFILEENV _ ENV
+                                                 COMPFILEMAP _ (LOADFNSCAN MAP)
+                                                 COMPFILEXPRS _ (DREVERSE DONELST)))]
               [SETQ FNLST (for
 DESCR in
 FILEMAPLST
                              join
 (for
 DEFQ in
 (CDR (fetch
 COMPFILEMAP of
 DESCR))
-                                         join
 (for
 X in
 (CDDR DEFQ)
-                                                     collect
 (CAR X]
+                                     join
 (for
 X in
 (CDDR DEFQ) collect
 (CAR X]
 
-         (* ;; "FILEMAPLST is a list of information about each file, including its name, filemap and non-defineq expressions. The first entry on the filemap is NIL.  We start mapping down CDR of the filemap, and each element therein corresponds to a single DEFINEQ, in the form (start stop . fnEntries).  fnEntries is a list of (FN start . stop), so the inner MAPCAR gathers up the names of the functions.  The reason for not asking LOADFNS to do this is in most cases the map will already have been built, so LOADFNS won't even go inside of the defineq.")

+         (* ;; "FILEMAPLST is a list of information about each file, including its name, filemap and non-defineq expressions. The first entry on the filemap is NIL.  We start mapping down CDR of the filemap, and each element therein corresponds to a single DEFINEQ, in the form (start stop . fnEntries).  fnEntries is a list of (FN start . stop), so the inner MAPCAR gathers up the names of the functions.  The reason for not asking LOADFNS to do this is in most cases the map will already have been built, so LOADFNS won't even go inside of the defineq.")

 
-              [for
 DESCR in
 FILEMAPLST do
 (for
 FORM
-                                                         in
 (fetch
 COMPFILEXPRS of
 DESCR)
-                                                         do
 (BCOMPL1A
 FORM 'DEFAULT
-                                                                       'DEFAULT
-                                                                       'DEFAULT]
+              [for
 DESCR in
 FILEMAPLST do
 (for
 FORM in
 (fetch
 COMPFILEXPRS of
 DESCR)
+                                             do
 (BCOMPL1A
 FORM 'DEFAULT 'DEFAULT 'DEFAULT]
 
-         (* ;; "BCOMPL1A adds VARS set in the files to NOFIXVARSLST.  NOFIXFNLST and NOFIXVARSLST are reset in case there is any dwimifying to be done BCOMPL1 also sets free variable OTHERS to list of expressions to be printed on compiled file when all is done.")

+         (* ;; "BCOMPL1A adds VARS set in the files to NOFIXVARSLST.  NOFIXFNLST and NOFIXVARSLST are reset in case there is any dwimifying to be done BCOMPL1 also sets free variable OTHERS to list of expressions to be printed on compiled file when all is done.")

 
               (SETQ NOFIXFNSLST (APPEND NLAMA NLAML LAMS FNLST NOFIXFNSLST))
-              (WITH-READER-ENVIRONMENT (SETQ DESTINATIONENV (fetch
 COMPFILEENV
-                                                               of
 (CAR FILEMAPLST)))
-                                                             (* ; 
-
"Start writing the compiled file.  Use environment of one of the source files--usually the only one")

+              (WITH-READER-ENVIRONMENT (SETQ DESTINATIONENV (fetch
 COMPFILEENV of
 (CAR FILEMAPLST)))
+                                                             (* ; 
+
 "Start writing the compiled file.  Use environment of one of the source files--usually the only one")

                   (if
 LCFIL
                       then
 (\EXTERNALFORMAT LCFIL (OR (LISTGET DESTINATIONENV :FORMAT)
-                                                          :XCCS))
-                            (PRINT-COMPILE-HEADER

-                             FILES
-                             [CONS (if
 NOBLOCKSFLG
-                                       then
 'recompiled
-                                     else
 'brecompiled)
-                                   (if
 (EQ FNS 'ALL)
-                                       then
 (LIST 'ALL)
-                                     else
 (CONS (SELECTQ FNS
-                                                        (CHANGES 'changes%:)
-                                                        ((EXPRS T) 
-                                                             'exprs%:)
-                                                        'explicitly%:)
-                                                    (OR [SUBSET FNLST (FUNCTION (LAMBDA (X)
-                                                                                  (RECOMP?
 X FNS]
-                                                        (LIST 'nothing]
-                             DESTINATIONENV))
+                                                      :MCCS))
+                           (PRINT-COMPILE-HEADER

+                            FILES
+                            [CONS (if
 NOBLOCKSFLG
+                                      then
 'recompiled
+                                    else
 'brecompiled)
+                                  (if
 (EQ FNS 'ALL)
+                                      then
 (LIST 'ALL)
+                                    else
 (CONS (SELECTQ FNS
+                                                   (CHANGES 'changes%:)
+                                                   ((EXPRS T) 
+                                                        'exprs%:)
+                                                   'explicitly%:)
+                                               (OR [SUBSET FNLST (FUNCTION (LAMBDA (X)
+                                                                             (RECOMP?
 X FNS]
+                                                   (LIST 'nothing]
+                            DESTINATIONENV))
                   [MAPC FNLST (FUNCTION (LAMBDA (X)
                                           (RCOMP3
 X (VIRGINFN X]
                   (if
 SCRATCHFILE
                       then
 
+                           (* ;; "writes others on a scratchfile so space can be freed up.  will be copied onto lcfil aftr compilation.")

 
-                            (* ;; "writes others on a scratchfile so space can be freed up.  will be copied onto lcfil aftr compilation.")

-
-                            (\EXTERNALFORMAT SCRATCHFILE (\EXTERNALFORMAT LCFIL))
-                            (for
 X in
 OTHERS do
 (PRINT X SCRATCHFILE))
-                            (PRINT NIL SCRATCHFILE)
-                            (SETQ OTHERS NIL))
+                           (\EXTERNALFORMAT SCRATCHFILE (\EXTERNALFORMAT LCFIL))
+                           (for
 X in
 OTHERS do
 (PRINT X SCRATCHFILE))
+                           (PRINT NIL SCRATCHFILE)
+                           (SETQ OTHERS NIL))
                   (for
 X in
 (PROGN FIRST) do
 (PRINT X LCFIL))
                   [OR DWIMIFYCOMPFLG (SETQ DWIMIFYCOMPFLG (EQMEMB 'CLISP (GETPROP FILE 'FILETYPE]
                   (OR (EQ FNS 'ALL)
                       (INPUT CFILE))
                   [if
 (NOT NOBLOCKSFLG)
                       then
 (for
 BLOCK in
 BLOCKS
-                                  do
 (if
 (NULL (CAR BLOCK))
-                                             then
 (BCOMPL2
 BLOCK FILEMAPLST)
-                                           elseif
 (for
 X in
 BLOCK
-                                                         thereis
 (AND (LITATOM X)
-                                                                          (RECOMP?
 X FNS)))
-                                             then
        (* ; 
-
            "If any function in the BLOCK is to be recompiled, the whole BLOCK must be recompiled.")

-                                                   (BCOMPL2
 BLOCK FILEMAPLST COREOK)
-                                           else
 (BRECOMPILE1
 BLOCK]
-
-                  (* ;; "NOBLOCKSFLG is T for calls from RECOMPILE.  In this case, even if there were any blocks, ignore them.")

-                                                             (* ; "Now COMPILE rest of functions.")

-                  (for
 X in
 FNLST
-                     do
 (if
 (OR (FMEMB X BLKFNS)
-                                        (FMEMB X DONTCOMPILEFNS))
-                              elseif
 (RECOMP?
 X FNS)
-                                then
 
-
-                                 (* ;; "The HELP is bcause if X is on FNS, then it follows X is in the file map, and brecompile3 should be able to produce its definition.")

-
-                                      (COMPILE1
 X (CADR (SETQ TEM (BRECOMPILE3
 X FILEMAPLST 
-                                                                             COREOK)))
-                                             (CADDR TEM))
-                              else
 (BRECOMPILE1
 X T))))
+                              do
 (if
 (NULL (CAR BLOCK))
+                                     then
 (BCOMPL2
 BLOCK FILEMAPLST)
+                                   elseif
 (for
 X in
 BLOCK thereis
 (AND (LITATOM X)
+                                                                       (RECOMP?
 X FNS)))
+                                     then
                    (* ; 
+
              "If any function in the BLOCK is to be recompiled, the whole BLOCK must be recompiled.")

+                                          (BCOMPL2
 BLOCK FILEMAPLST COREOK)
+                                   else
 (BRECOMPILE1
 BLOCK]
+
+                  (* ;; "NOBLOCKSFLG is T for calls from RECOMPILE.  In this case, even if there were any blocks, ignore them.")

+                                                             (* ; "Now COMPILE rest of functions.")

+                  (for
 X in
 FNLST do
 (if
 (OR (FMEMB X BLKFNS)
+                                             (FMEMB X DONTCOMPILEFNS))
+                                       elseif
 (RECOMP?
 X FNS)
+                                         then
 
+
+                                 (* ;; "The HELP is bcause if X is on FNS, then it follows X is in the file map, and brecompile3 should be able to produce its definition.")

+
+                                              (COMPILE1
 X (CADR (SETQ TEM (BRECOMPILE3
 X FILEMAPLST 
+                                                                                 COREOK)))
+                                                     (CADDR TEM))
+                                       else
 (BRECOMPILE1
 X T))))
               (RETURN (FULLNAME LCFIL))
           NONRAND
               (SETQ MSG " is not RANDACCESSP")
@@ -1532,16 +1517,15 @@ with the terms of said license.
 
 (ADDTOVAR LAMA
 )
 )
-(PUTPROPS COMPILE COPYRIGHT ("Venue & Xerox Corporation" T 1984 1985 1986 1987 1988 1989 1990 2021))
 (DECLARE%: DONTCOPY
-  (FILEMAP (NIL (3708 73744 (BCOMPL 3718 . 5368) (BCOMPL.BODY 5370 . 11949) (PRINT-COMPILE-HEADER 11951
- . 13014) (RESETOPENFILES 13016 . 13369) (BCOMPL1A 13371 . 19384) (BCOMPL2 19386 . 26201) (BCOMPL3 
-26203 . 27552) (BLOCK%: 27554 . 28186) (BRECOMPILE 28188 . 43177) (BRECOMPILE1 43179 . 49031) (
-BRECOMPILE2 49033 . 49835) (BRECOMPILE3 49837 . 51213) (BLOCKCOMPILE 51215 . 53075) (BLOCKCOMPILE1 
-53077 . 58162) (COMPSET 58164 . 60861) (COMPSETREAD 60863 . 62174) (COMPSETY 62176 . 62300) (COMPSETF 
-62302 . 62468) (RCOMP3 62470 . 64177) (TCOMPL 64179 . 64478) (RECOMPILE 64480 . 64563) (RECOMP? 64565
- . 65025) (COMPILE 65027 . 67016) (COMPILE1 67018 . 67606) (COMPILE1A 67608 . 69255) (
-SHOULD-BE-DWIMIFIED? 69257 . 69946) (COMPEM 69948 . 70672) (GETCFILE 70674 . 72405) (SPECVARS 72407 . 
-72962) (LOCALVARS 72964 . 73538) (GLOBALVARS 73540 . 73742)) (76094 77043 (COMPILEMODE 76104 . 77041))
+  (FILEMAP (NIL (3379 73129 (BCOMPL 3389 . 5039) (BCOMPL.BODY 5041 . 11639) (PRINT-COMPILE-HEADER 11641
+ . 12704) (RESETOPENFILES 12706 . 13059) (BCOMPL1A 13061 . 19074) (BCOMPL2 19076 . 25891) (BCOMPL3 
+25893 . 27242) (BLOCK%: 27244 . 27876) (BRECOMPILE 27878 . 42562) (BRECOMPILE1 42564 . 48416) (
+BRECOMPILE2 48418 . 49220) (BRECOMPILE3 49222 . 50598) (BLOCKCOMPILE 50600 . 52460) (BLOCKCOMPILE1 
+52462 . 57547) (COMPSET 57549 . 60246) (COMPSETREAD 60248 . 61559) (COMPSETY 61561 . 61685) (COMPSETF 
+61687 . 61853) (RCOMP3 61855 . 63562) (TCOMPL 63564 . 63863) (RECOMPILE 63865 . 63948) (RECOMP? 63950
+ . 64410) (COMPILE 64412 . 66401) (COMPILE1 66403 . 66991) (COMPILE1A 66993 . 68640) (
+SHOULD-BE-DWIMIFIED? 68642 . 69331) (COMPEM 69333 . 70057) (GETCFILE 70059 . 71790) (SPECVARS 71792 . 
+72347) (LOCALVARS 72349 . 72923) (GLOBALVARS 72925 . 73127)) (75479 76428 (COMPILEMODE 75489 . 76426))
 )))
 STOP
diff --git a/sources/COMPILE.LCOM b/sources/COMPILE.LCOM
index 7bcb18ddf..ecab83895 100644
Binary files a/sources/COMPILE.LCOM and b/sources/COMPILE.LCOM differ
diff --git a/sources/COREIO b/sources/COREIO
index 480027788..72ff5f565 100644
--- a/sources/COREIO
+++ b/sources/COREIO
@@ -1,17 +1,13 @@
 (DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
 
-
(FILECREATED " 5-Jun-2022 00:14:07" 
-{DSK}<users>kaplan>local>medley3.5>working-medley>sources>COREIO.;17
 57355  
+
(FILECREATED "11-Sep-2025 16:49:07" {WMEDLEY}<sources>COREIO.;18
 56903  
 
-      :CHANGES-TO (FNS \CORE.OPENFILE)
+      :EDIT-BY rmk
 
-      :PREVIOUS-DATE " 4-Jun-2022 16:30:20" 
-{DSK}<users>kaplan>local>medley3.5>working-medley>sources>COREIO.;16)
+      :CHANGES-TO (FNS \CORE.DIRECTORYNAMEP)
 
+      :PREVIOUS-DATE " 5-Jun-2022 00:14:07" {WMEDLEY}<sources>COREIO.;17)
 
-(* ; "
-Copyright (c) 1981-1988, 1990, 1993, 1999, 2018 by Venue & Xerox Corporation.
-")
 
 (PRETTYCOMPRINT COREIOCOMS)
 
@@ -91,8 +87,13 @@ Copyright (c) 1981-1988, 1990, 1993, 1999, 2018 by Venue & Xerox Corporation.
           (RETURN (fetch
 IOFILEFULLNAME of
 INFOBLOCK])
 
 (\CORE.DIRECTORYNAMEP

-  [LAMBDA (DIRNAME DEV)                                      (* ; "Edited 18-Jan-2022 11:17 by rmk")

-                                                             (* ; "Edited 10-Jan-2022 22:33 by rmk")

+  [LAMBDA (DIRNAME DEV)
+
+    (* ;; "Edited 11-Sep-2025 16:48 by rmk")

+
+    (* ;; "Edited 18-Jan-2022 11:17 by rmk")

+
+    (* ;; "Edited 10-Jan-2022 22:33 by rmk")

 
     (* ;; 
 
 "Edited  9-Jan-2022 12:42 by rmk: Using the new FILEDIRCASEARRAY so that slashes and brackets match")

@@ -103,22 +104,20 @@ Copyright (c) 1981-1988, 1990, 1993, 1999, 2018 by Venue & Xerox Corporation.
 
     (CL:WHEN DIRNAME
 
-        (* ;; "The DIRNAME could be just {CORE}, which always is OK, or {CORE}xxx.  If the latter, then we want it to be a directory and not a file  (assuming that xxx and xxx> can't both exist.")

+        (* ;; "Returns NIL for a DIRNAME of just {CORE},  or {CORE}xxx.  If the latter, then we want it to be a directory and not a file  (assuming that xxx and xxx> can't both exist.")

 
-        (IF
 (EQ (CHARCODE })
-                (NTHCHARCODE DIRNAME -1))
-          ELSE
 (CL:UNLESS (MEMB (NTHCHARCODE DIRNAME -1)
-                                (CHARCODE (> /)))
-                   (SETQ DIRNAME (CONCAT DIRNAME ">"))) 
+        [LET [(DIR (FILENAMEFIELD DIRNAME 'DIRECTORY]
+             (CL:WHEN DIR
+                 (SETQ DIR (CONCAT DIR ">"))
 
-               (* ;; "DIRPOS because caller may not have stripped off the device. This will match the first < or / (or >)")

+                 (* ;; "DIRPOS because caller may not have stripped off the device. This will match the first < or / (or >)")

 
-               (FOR
 ENTRY (DIRPOS _ (STRPOS "<" DIRNAME 1 NIL NIL NIL FILEDIRCASEARRAY))
-                  FIRST
 (CL:UNLESS (EQ DIRPOS 1)
-                            (SETQ DIRNAME (SUBSTRING DIRNAME DIRPOS)))
-                  IN
 (CDR (FETCH
 COREDIRECTORY OF
 DEV)) WHEN
 (STRPOS DIRNAME (CAR ENTRY)
-                                                                    1 NIL T NIL FILEDIRCASEARRAY)
-                  DO
 (RETURN T))))])
+                 (FOR
 ENTRY (DIRPOS _ (STRPOS "<" DIRNAME 1 NIL NIL NIL FILEDIRCASEARRAY))
+                    FIRST
 (CL:UNLESS (EQ DIRPOS 1)
+                              (SETQ DIRNAME (SUBSTRING DIRNAME DIRPOS)))
+                    IN
 (CDR (FETCH
 COREDIRECTORY OF
 DEV))
+                    WHEN
 (STRPOS DIRNAME (CAR ENTRY)
+                                1 NIL T NIL FILEDIRCASEARRAY) DO
 (RETURN T)))])])
 
 (\CORE.FINDPAGE

   [LAMBDA (STREAM PN)
                                    (* bvm%: "20-Apr-85 13:32")

@@ -997,19 +996,17 @@ Copyright (c) 1981-1988, 1990, 1993, 1999, 2018 by Venue & Xerox Corporation.
 (LOCALVARS . T)
 )
 )
-(PUTPROPS COREIO COPYRIGHT ("Venue & Xerox Corporation" 1981 1982 1983 1984 1985 1986 1987 1988 1990 
-1993 1999 2018))
 (DECLARE%: DONTCOPY
-  (FILEMAP (NIL (1717 46448 (\CORE.CLOSEFILE 1727 . 2500) (\CORE.DELETEFILE 2502 . 4488) (
-\CORE.DIRECTORYNAMEP 4490 . 6171) (\CORE.FINDPAGE 6173 . 9402) (\CORE.GENERATEFILES 9404 . 11991) (
-\CORE.NEXTFILEFN 11993 . 12492) (\CORE.FILEINFOFN 12494 . 12723) (\CORE.GETFILEHANDLE 12725 . 14879) (
-\CORE.GETFILEINFO 14881 . 15844) (\CORE.GETFILEINFO.FROM.INFOBLOCK 15846 . 17383) (\CORE.GETFILENAME 
-17385 . 19674) (\CORE.GETINFOBLOCK 19676 . 22299) (\CORE.NAMESCAN 22301 . 23848) (\CORE.NAMESEGMENT 
-23850 . 24287) (\CORE.OPENFILE 24289 . 27681) (\COREFILE.SETPARAMETERS 27683 . 29864) (
-\CORE.PACKFILENAME 29866 . 30261) (\CORE.RELEASEPAGES 30263 . 30864) (\CORE.SETFILEPTR 30866 . 31965) 
-(\CORE.UPDATEOF 31967 . 33596) (\CORE.BACKFILEPTR 33598 . 35806) (\CORE.SETEOFPTR 35808 . 37677) (
-\CORE.SETACCESSTIME 37679 . 38304) (\CORE.SETFILEINFO 38306 . 40608) (\CORE.GETNEXTBUFFER 40610 . 
-44566) (\CORE.UNPACKFILENAME 44568 . 46446)) (46449 50082 (COREDEVICE 46459 . 46630) (
-\CREATECOREDEVICE 46632 . 50080)) (50083 52497 (\NODIRCOREFDEV 50093 . 50690) (\NODIRCORE.OPENFILE 
-50692 . 52495)))))
+  (FILEMAP (NIL (1572 46115 (\CORE.CLOSEFILE 1582 . 2355) (\CORE.DELETEFILE 2357 . 4343) (
+\CORE.DIRECTORYNAMEP 4345 . 5838) (\CORE.FINDPAGE 5840 . 9069) (\CORE.GENERATEFILES 9071 . 11658) (
+\CORE.NEXTFILEFN 11660 . 12159) (\CORE.FILEINFOFN 12161 . 12390) (\CORE.GETFILEHANDLE 12392 . 14546) (
+\CORE.GETFILEINFO 14548 . 15511) (\CORE.GETFILEINFO.FROM.INFOBLOCK 15513 . 17050) (\CORE.GETFILENAME 
+17052 . 19341) (\CORE.GETINFOBLOCK 19343 . 21966) (\CORE.NAMESCAN 21968 . 23515) (\CORE.NAMESEGMENT 
+23517 . 23954) (\CORE.OPENFILE 23956 . 27348) (\COREFILE.SETPARAMETERS 27350 . 29531) (
+\CORE.PACKFILENAME 29533 . 29928) (\CORE.RELEASEPAGES 29930 . 30531) (\CORE.SETFILEPTR 30533 . 31632) 
+(\CORE.UPDATEOF 31634 . 33263) (\CORE.BACKFILEPTR 33265 . 35473) (\CORE.SETEOFPTR 35475 . 37344) (
+\CORE.SETACCESSTIME 37346 . 37971) (\CORE.SETFILEINFO 37973 . 40275) (\CORE.GETNEXTBUFFER 40277 . 
+44233) (\CORE.UNPACKFILENAME 44235 . 46113)) (46116 49749 (COREDEVICE 46126 . 46297) (
+\CREATECOREDEVICE 46299 . 49747)) (49750 52164 (\NODIRCOREFDEV 49760 . 50357) (\NODIRCORE.OPENFILE 
+50359 . 52162)))))
 STOP
diff --git a/sources/COREIO.LCOM b/sources/COREIO.LCOM
index 8b866251f..f011a7be1 100644
Binary files a/sources/COREIO.LCOM and b/sources/COREIO.LCOM differ
diff --git a/sources/EXTERNALFORMAT b/sources/EXTERNALFORMAT
index 4efd98db8..1b1889194 100644
--- a/sources/EXTERNALFORMAT
+++ b/sources/EXTERNALFORMAT
@@ -1,12 +1,12 @@
 (DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
 
-
(FILECREATED "19-Mar-2024 18:24:39" {WMEDLEY}<sources>EXTERNALFORMAT.;88
 38921  
+
(FILECREATED "24-Apr-2025 08:43:01" {WMEDLEY}<sources>EXTERNALFORMAT.;91
 38905  
 
       :EDIT-BY rmk
 
-      :CHANGES-TO (FNS \FORMATBYTESTRING \FORMATBYTESTREAM)
+      :CHANGES-TO (VARS EXTERNALFORMATCOMS)
 
-      :PREVIOUS-DATE "12-Jan-2024 10:59:18" {WMEDLEY}<sources>EXTERNALFORMAT.;86)
+      :PREVIOUS-DATE "19-Mar-2024 18:24:39" {WMEDLEY}<sources>EXTERNALFORMAT.;90)
 
 
 (PRETTYCOMPRINT EXTERNALFORMATCOMS)
@@ -22,7 +22,7 @@
               (FNS SYSTEM-EXTERNALFORMAT)
               (GLOBALVARS *EXTERNALFORMATS* *DEFAULT-EXTERNALFORMAT*)
               (INITVARS (*EXTERNALFORMATS* NIL)
-                     (*DEFAULT-EXTERNALFORMAT* :XCCS))
+                     (*DEFAULT-EXTERNALFORMAT* :MCCS))
               (DECLARE%: DONTEVAL@LOAD DOCOPY (P (DEFPRINT 'EXTERNALFORMAT (FUNCTION 
                                                                              \EXTERNALFORMAT.DEFPRINT
                                                                                   ]
@@ -311,7 +311,7 @@
 
 (RPAQ? *EXTERNALFORMATS*
 NIL)
 
-(RPAQ? *DEFAULT-EXTERNALFORMAT*
 :XCCS)
+(RPAQ? *DEFAULT-EXTERNALFORMAT*
 :MCCS)
 (DECLARE%: DONTEVAL@LOAD DOCOPY 
 
 (DEFPRINT 'EXTERNALFORMAT (FUNCTION \EXTERNALFORMAT.DEFPRINT))
@@ -737,13 +737,13 @@
 (\CREATE.THROUGH.EXTERNALFORMAT
)
 )
 (DECLARE%: DONTCOPY
-  (FILEMAP (NIL (6726 13559 (\EXTERNALFORMAT 6736 . 10514) (MAKE-EXTERNALFORMAT 10516 . 13086) (
-\EXTERNALFORMAT.DEFPRINT 13088 . 13557)) (13560 16601 (\INSTALL.EXTERNALFORMAT 13570 . 15019) (
-\REMOVE.EXTERNALFORMAT 15021 . 15852) (FIND-FORMAT 15854 . 16599)) (16602 17014 (SYSTEM-EXTERNALFORMAT
- 16612 . 17012)) (17363 33340 (\OUTCHAR 17373 . 18590) (\INCCODE 18592 . 19745) (\BACKCCODE 19747 . 
-21426) (\BACKCCODE.EOLC 21428 . 23618) (\PEEKCCODE 23620 . 23945) (\PEEKCCODE.EOLC 23947 . 24326) (
-\INCCODE.EOLC 24328 . 26127) (\FORMATBYTESTREAM 26129 . 28573) (\FORMATBYTESTRING 28575 . 30275) (
-\CHECKEOLC.CRLF 30277 . 33338)) (34622 36858 (\NULLDEVICE 34632 . 36534) (\NULL.OPENFILE 36536 . 36856
-)) (36998 38825 (\CREATE.THROUGH.EXTERNALFORMAT 37008 . 37794) (\THROUGHIN 37796 . 38216) (
-\THROUGHBACKCCODE 38218 . 38485) (\THROUGHOUTCHARFN 38487 . 38823)))))
+  (FILEMAP (NIL (6710 13543 (\EXTERNALFORMAT 6720 . 10498) (MAKE-EXTERNALFORMAT 10500 . 13070) (
+\EXTERNALFORMAT.DEFPRINT 13072 . 13541)) (13544 16585 (\INSTALL.EXTERNALFORMAT 13554 . 15003) (
+\REMOVE.EXTERNALFORMAT 15005 . 15836) (FIND-FORMAT 15838 . 16583)) (16586 16998 (SYSTEM-EXTERNALFORMAT
+ 16596 . 16996)) (17347 33324 (\OUTCHAR 17357 . 18574) (\INCCODE 18576 . 19729) (\BACKCCODE 19731 . 
+21410) (\BACKCCODE.EOLC 21412 . 23602) (\PEEKCCODE 23604 . 23929) (\PEEKCCODE.EOLC 23931 . 24310) (
+\INCCODE.EOLC 24312 . 26111) (\FORMATBYTESTREAM 26113 . 28557) (\FORMATBYTESTRING 28559 . 30259) (
+\CHECKEOLC.CRLF 30261 . 33322)) (34606 36842 (\NULLDEVICE 34616 . 36518) (\NULL.OPENFILE 36520 . 36840
+)) (36982 38809 (\CREATE.THROUGH.EXTERNALFORMAT 36992 . 37778) (\THROUGHIN 37780 . 38200) (
+\THROUGHBACKCCODE 38202 . 38469) (\THROUGHOUTCHARFN 38471 . 38807)))))
 STOP
diff --git a/sources/EXTERNALFORMAT.LCOM b/sources/EXTERNALFORMAT.LCOM
index 4e3d2dc4b..3b4777b2c 100644
Binary files a/sources/EXTERNALFORMAT.LCOM and b/sources/EXTERNALFORMAT.LCOM differ
diff --git a/sources/FILEIO b/sources/FILEIO
index 244a1fcf7..2c5fb1ede 100644
--- a/sources/FILEIO
+++ b/sources/FILEIO
@@ -1,12 +1,13 @@
 (DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
 
-
(FILECREATED "25-Dec-2024 10:56:37" {WMEDLEY}<sources>FILEIO.;138
 166550 
+
(FILECREATED "12-Sep-2025 08:19:06" {WMEDLEY}<sources>FILEIO.;141
 166968 
 
       :EDIT-BY rmk
 
-      :CHANGES-TO (FNS SETFILEINFO \DO.PARAMS.AT.OPEN \RENAMEFILE)
+      :CHANGES-TO (FNS COPYFILE COPYCHARS)
 
-      :PREVIOUS-DATE "18-Dec-2024 21:08:09" {WMEDLEY}<sources>FILEIO.;135)
+      :PREVIOUS-DATE "24-Apr-2025 22:16:47" 
+{DSK}<Users>kaplan>Local>medley3.5>working-medley>sources>FILEIO.;139)
 
 
 (PRETTYCOMPRINT FILEIOCOMS)
@@ -2223,31 +2224,32 @@ update the map")

       ])
 
 (COPYCHARS

-  [LAMBDA (SRCFIL DSTFIL START END)
                     (* ; "Edited 13-Aug-2021 18:39 by rmk:")


-                                                            (* ; "Edited 14-Jun-2021 22:08 by rmk:")


-                                                             (* ; "Edited  8-Dec-95 16:38 by rmk:")


-                                                             (* ; "Edited 26-Mar-99 12:13 by rmk:")

+  [LAMBDA (SRCFIL DSTFIL START END)
                          (* ; "Edited 11-Sep-2025 20:47 by rmk")


+                                                            (* ; "Edited 13-Aug-2021 18:39 by rmk:")


+                                                            (* ; "Edited 14-Jun-2021 22:08 by rmk:")


+                                                             (* ; "Edited  8-Dec-95 16:38 by rmk:")


+                                                             (* ; "Edited 26-Mar-99 12:13 by rmk:")

 
-    (* ;; "This is similar to COPYBYTES except that conversion is done between the EOL convention and externalformat of the input and the EOL convention/external format of the output")

+    (* ;; "This is similar to COPYBYTES except that conversion is done between the EOL convention and externalformat of the input and the EOL convention/external format of the output.  This assumes that an ANY.EOLC source file is actually the same as the destination.")

 
     [PROG ((SRCSTRM (\GETSTREAM SRCFIL))
            (DSTSTRM (\GETSTREAM DSTFIL))
            (ACTUALSTART 0)
            RAP ACTUALEND EOF SRCEOLC DSTEOLC CH)
-          (CL:WHEN (AND (EQ (SETQ SRCEOLC (fetch
 EOLCONVENTION of
 SRCSTRM))
-                            (SETQ DSTEOLC (fetch
 EOLCONVENTION of
 DSTSTRM)))
+          (CL:WHEN (AND (OR (EQ (SETQ SRCEOLC (fetch
 EOLCONVENTION of
 SRCSTRM))
+                                (SETQ DSTEOLC (fetch
 EOLCONVENTION of
 DSTSTRM)))
+                            (EQ ANY.EOLC (fetch
 EOLCONVENTION of
 SRCSTRM)))
                         (EQ (FETCH
 EXTERNALFORMAT OF
 SRCSTRM)
                             (FETCH
 EXTERNALFORMAT OF
 DSTSTRM)))
               (RETURN (COPYBYTES
 SRCSTRM DSTSTRM START END)))
 
-     (* ;; "Format or EOL convention are different.  So first decode the START END specification")

+     (* ;; "Format or EOL convention are different.  So first decode the START END specification")

 
           [COND
              ((SETQ RAP (fetch
 RANDOMACCESSP of
 (fetch
 DEVICE of
 SRCSTRM)))
               (SETQ EOF (\GETEOFPTR
 SRCSTRM]
           (COND
-             [END (OR RAP (ERROR "COPYCHARS: Source file is not random access" (fetch
 
-                                                                                      FULLFILENAME
+             [END (OR RAP (ERROR "COPYCHARS: Source file is not random access" (fetch
 FULLFILENAME
                                                                                   of
 SRCSTRM)))
                   (OR (type?
 BYTEPTR (SETQ ACTUALSTART (FIX START)))
                       (LISPERROR "ILLEGAL ARG" START))
@@ -2265,26 +2267,27 @@ update the map")

              (RAP (SETQ ACTUALSTART (\GETFILEPTR SRCSTRM))
                   (SETQ ACTUALEND EOF))
              (T 
-                (* ;; 
-
 "Not random access and START and END are both NIL, just copy to the end of file,no need to count.")

+                (* ;; 
+
   "Not random access and START and END are both NIL, just copy to the end of file,no need to count.")

 
                 (until
 (\EOFP SRCSTRM) do
 (\OUTCHAR DSTSTRM (\INCCODE.EOLC SRCSTRM SRCEOLC)))
                 (RETURN)))
           (CL:UNLESS (IGEQ ACTUALEND ACTUALSTART)
               (ERROR "Negative number of bytes to copy" (IDIFFERENCE ACTUALEND ACTUALSTART)))
 
-     (* ;; "We now know which bytes we need to copy, in the case that there is an EOL/format mismatch.  If we assume that this is fairly unusual and that we don't want to assume here that we know how the CR and LF are byte-coded, we don't try to optimize for an EOL-only change.  We just go generic.")

+     (* ;; "We now know which bytes we need to copy, in the case that there is an EOL/format mismatch.  If we assume that this is fairly unusual and that we don't want to assume here that we know how the CR and LF are byte-coded, we don't try to optimize for an EOL-only change.  We just go generic.")

 
-     (* ;; "The \INCCODE.EOLC and \OUTCHAR handle all format and EOL issues.")

+     (* ;; "The \INCCODE.EOLC and \OUTCHAR handle all format and EOL issues.")

 
           (BIND
 (CNT _ (IDIFFERENCE ACTUALEND ACTUALSTART)) DECLARE
 (SPECVARS CNT)
-             WHILE
 (IGREATERP CNT 0) DO
 (\OUTCHAR DSTSTRM (\INCCODE.EOLC SRCSTRM NIL
-                                                                         'CNT CNT]
+             WHILE
 (IGREATERP CNT 0) DO
 (\OUTCHAR DSTSTRM (\INCCODE.EOLC SRCSTRM NIL 'CNT CNT]
     T])
 
 (COPYFILE

   [LAMBDA (FROMFILE TOFILE)
 
+    (* ;; "Edited 12-Sep-2025 08:18 by rmk")

+
     (* ;; "Edited 18-Dec-2024 21:07 by rmk")

 
     (* ;; "Edited  8-Jul-2022 10:41 by rmk")

@@ -2304,7 +2307,7 @@ update the map")

                                               `((SEQUENTIAL T)
                                                 (DON'TCACHE T)
                                                 (CREATIONDATE ,(GETFILEINFO
 FROMSTREAM 'CREATIONDATE]
-                    '(AND RESETSTATE (SETQ OLDVALUE (CLOSEF OLDVALUE))
+                    '(AND RESETSTATE (SETQ OLDVALUE (CLOSEF? OLDVALUE))
                           (DELFILE OLDVALUE]
              (COPYBYTES
 FROMSTREAM TOSTREAM)
              (CLOSEF FROMSTREAM)
@@ -2440,10 +2443,11 @@ update the map")

          OLDVAL])
 
 (ACCESS-CHARSET

-  [LAMBDA (STREAM NEWVALUE DONTMARKFILE)
                     (* ; "Edited  8-Dec-2023 15:05 by rmk")


+  [LAMBDA (STREAM NEWVALUE DONTMARKFILE)
                     (* ; "Edited 24-Apr-2025 22:15 by rmk")


+                                                             (* ; "Edited  8-Dec-2023 15:05 by rmk")


                                                              (* ; "Edited 11-Sep-87 15:46 by bvm:")

 
-    (* ;; "Unless DONTMARKSTREAM, if STREAM is open for output, the external format function may modify the backing file as well as the stream, e.g. put in XCCS shifting bytes.")

+    (* ;; "Unless DONTMARKSTREAM, if STREAM is open for output, the external format function may modify the backing file as well as the stream, e.g. put in MCCS shifting bytes.")

 
     (FDEVOP 'CHARSETFN (fetch
 (STREAM DEVICE) of
 STREAM)
            STREAM NEWVALUE DONTMARKFILE])
@@ -2715,10 +2719,11 @@ update the map")

                                      (\BACKCCODE.EOLC STRM)))])])
 
 (\GENERIC.CHARSET

-  [LAMBDA (STREAM NEWVALUE DONTMARKSTREAM)
                   (* ; "Edited  8-Dec-2023 15:17 by rmk")


+  [LAMBDA (STREAM NEWVALUE DONTMARKSTREAM)
                   (* ; "Edited 24-Apr-2025 22:16 by rmk")


+                                                             (* ; "Edited  8-Dec-2023 15:17 by rmk")


                                                              (* ; "Edited 11-Sep-87 16:20 by bvm:")

 
-(* ;;; "sets or returns the current numeric character set for this stream.  This applies the stream's FORMATCHARSETFN if it has one, and (if MARKSTREAM) that may change an output backing stream in some way (e.g. write XCCS charset shift bytes).  Otherwise, this just sets the charset stream parameter to influence subsequent reading and writing behavior.  Charset doesn't exist in some formats (e.g. UTF-8), the format function would be a noop in that case.")

+(* ;;; "sets or returns the current numeric character set for this stream.  This applies the stream's FORMATCHARSETFN if it has one, and (if MARKSTREAM) that may change an output backing stream in some way (e.g. write MCCS charset shift bytes).  Otherwise, this just sets the charset stream parameter to influence subsequent reading and writing behavior.  Charset doesn't exist in some formats (e.g. UTF-8), the format function would be a noop in that case.")

 
     (\DTEST STREAM 'STREAM)
     (LET ((EFORMAT (ffetch
 (STREAM EXTERNALFORMAT) of
 STREAM))
@@ -3162,39 +3167,39 @@ update the map")

 (ADDTOVAR LAMA
 \IS.NOT.RANDACCESSP \ILLEGAL.DEVICEOP STREAMPROP)
 )
 (DECLARE%: DONTCOPY
-  (FILEMAP (NIL (27735 31851 (STREAMPROP 27745 . 28179) (GETSTREAMPROP 28181 . 28930) (PUTSTREAMPROP 
-28932 . 31699) (STREAMP 31701 . 31849)) (31894 35273 (\DEFPRINT.BY.NAME 31904 . 33056) (
-\STREAM.DEFPRINT 33058 . 34966) (\FDEV.DEFPRINT 34968 . 35271)) (35531 40572 (\GETACCESS 35541 . 35995
-) (\SETACCESS 35997 . 40570)) (60798 66767 (\DEFINEDEVICE 60808 . 63124) (\GETDEVICEFROMNAME 63126 . 
-63599) (\GETDEVICEFROMHOSTNAME 63601 . 64645) (\REMOVEDEVICE 64647 . 65770) (\REMOVEDEVICE.NAMES 65772
- . 66765)) (66807 94538 (\CLOSEFILE 66817 . 67642) (\DELETEFILE 67644 . 67938) (\DEVICEEVENT 67940 . 
-69710) (\GENERATEFILES 69712 . 70659) (\GENERATENEXTFILE 70661 . 71312) (\GENERATEFILEINFO 71314 . 
-71775) (\GETFILENAME 71777 . 72166) (\GENERIC.OUTFILEP 72168 . 72638) (\OPENFILE 72640 . 75218) (
-\DO.PARAMS.AT.OPEN 75220 . 79416) (\RENAMEFILE 79418 . 80374) (\REVALIDATEFILE 80376 . 82978) (
-\PAGED.REVALIDATEFILELST 82980 . 84538) (\PAGED.REVALIDATEFILES 84540 . 86259) (\PAGED.REVALIDATEFILE 
-86261 . 88544) (\BUFFERED.REVALIDATEFILE 88546 . 90832) (\BUFFERED.REVALIDATEFILELST 90834 . 92018) (
-\PRINT-REVALIDATION-RESULT 92020 . 92862) (\TRUNCATEFILE 92864 . 93255) (\FILE-CONFLICT 93257 . 94536)
-) (94574 99237 (\GENERATENOFILES 94584 . 96680) (\NULLFILEGENERATOR 96682 . 96926) (\NOFILESNEXTFILEFN
- 96928 . 98919) (\NOFILESINFOFN 98921 . 99235)) (99356 101264 (\FILE.NOT.OPEN 99366 . 99879) (
-\FILE.WONT.OPEN 99881 . 100209) (\ILLEGAL.DEVICEOP 100211 . 100493) (\IS.NOT.RANDACCESSP 100495 . 
-100941) (\STREAM.NOT.OPEN 100943 . 101262)) (101399 103697 (\FDEVINSTANCE 101409 . 103695)) (104899 
-112273 (CNDIR 104909 . 106214) (DIRECTORYNAME 106216 . 110399) (DIRECTORYNAMEP 110401 . 111017) (
-HOSTNAMEP 111019 . 111826) (\ADD.CONNECTED.DIR 111828 . 112271)) (112318 140973 (\BACKFILEPTR 112328
- . 112516) (\BACKPEEKBIN 112518 . 112879) (\BACKBIN 112881 . 113232) (BIN 113234 . 113451) (\BIN 
-113453 . 113730) (\BINS 113732 . 114018) (BOUT 114020 . 114382) (\BOUT 114384 . 114699) (\BOUTS 114701
- . 115012) (COPYBYTES 115014 . 118346) (COPYCHARS 118348 . 122014) (COPYFILE 122016 . 123325) (
-\COPYOPENFILE 123327 . 126526) (\INFER.FILE.TYPE 126528 . 127482) (EOFP 127484 . 127781) (FORCEOUTPUT 
-127783 . 128030) (\FLUSH.OPEN.STREAMS 128032 . 128388) (CHARSET 128390 . 129749) (ACCESS-CHARSET 
-129751 . 130279) (GETEOFPTR 130281 . 130531) (GETFILEINFO 130533 . 133726) (\TYPE.FROM.FILETYPE 133728
- . 134198) (\FILETYPE.FROM.TYPE 134200 . 134379) (GETFILEPTR 134381 . 134633) (SETFILEINFO 134635 . 
-138872) (SETFILEPTR 138874 . 140593) (BOUT16 140595 . 140780) (BIN16 140782 . 140971)) (141076 148147 
-(\GENERIC.BINS 141086 . 141366) (\GENERIC.BOUTS 141368 . 141633) (\GENERIC.RENAMEFILE 141635 . 143883)
- (\GENERIC.OPENP 143885 . 145200) (\GENERIC.READP 145202 . 146354) (\GENERIC.CHARSET 146356 . 148145))
- (148148 148487 (\MAP-OPEN-STREAMS 148158 . 148485)) (150342 152422 (\EOF.ACTION 150352 . 150603) (
-\EOSERROR 150605 . 150798) (\GETEOFPTR 150800 . 150982) (\INCFILEPTR 150984 . 151334) (\PEEKBIN 151336
- . 151527) (\SETCLOSEDFILELENGTH 151529 . 151863) (\SETEOFPTR 151865 . 152053) (\SETFILEPTR 152055 . 
-152420)) (152423 152965 (\FIXPOUT 152433 . 152733) (\FIXPIN 152735 . 152963)) (152966 153532 (\BOUTEOL
- 152976 . 153530)) (156428 166292 (\BUFFERED.BIN 156438 . 157290) (\BUFFERED.PEEKBIN 157292 . 158074) 
-(\BUFFERED.BOUT 158076 . 158936) (\BUFFERED.BINS 158938 . 162623) (\BUFFERED.BOUTS 162625 . 164426) (
-\BUFFERED.COPYBYTES 164428 . 166290)))))
+  (FILEMAP (NIL (27752 31868 (STREAMPROP 27762 . 28196) (GETSTREAMPROP 28198 . 28947) (PUTSTREAMPROP 
+28949 . 31716) (STREAMP 31718 . 31866)) (31911 35290 (\DEFPRINT.BY.NAME 31921 . 33073) (
+\STREAM.DEFPRINT 33075 . 34983) (\FDEV.DEFPRINT 34985 . 35288)) (35548 40589 (\GETACCESS 35558 . 36012
+) (\SETACCESS 36014 . 40587)) (60815 66784 (\DEFINEDEVICE 60825 . 63141) (\GETDEVICEFROMNAME 63143 . 
+63616) (\GETDEVICEFROMHOSTNAME 63618 . 64662) (\REMOVEDEVICE 64664 . 65787) (\REMOVEDEVICE.NAMES 65789
+ . 66782)) (66824 94555 (\CLOSEFILE 66834 . 67659) (\DELETEFILE 67661 . 67955) (\DEVICEEVENT 67957 . 
+69727) (\GENERATEFILES 69729 . 70676) (\GENERATENEXTFILE 70678 . 71329) (\GENERATEFILEINFO 71331 . 
+71792) (\GETFILENAME 71794 . 72183) (\GENERIC.OUTFILEP 72185 . 72655) (\OPENFILE 72657 . 75235) (
+\DO.PARAMS.AT.OPEN 75237 . 79433) (\RENAMEFILE 79435 . 80391) (\REVALIDATEFILE 80393 . 82995) (
+\PAGED.REVALIDATEFILELST 82997 . 84555) (\PAGED.REVALIDATEFILES 84557 . 86276) (\PAGED.REVALIDATEFILE 
+86278 . 88561) (\BUFFERED.REVALIDATEFILE 88563 . 90849) (\BUFFERED.REVALIDATEFILELST 90851 . 92035) (
+\PRINT-REVALIDATION-RESULT 92037 . 92879) (\TRUNCATEFILE 92881 . 93272) (\FILE-CONFLICT 93274 . 94553)
+) (94591 99254 (\GENERATENOFILES 94601 . 96697) (\NULLFILEGENERATOR 96699 . 96943) (\NOFILESNEXTFILEFN
+ 96945 . 98936) (\NOFILESINFOFN 98938 . 99252)) (99373 101281 (\FILE.NOT.OPEN 99383 . 99896) (
+\FILE.WONT.OPEN 99898 . 100226) (\ILLEGAL.DEVICEOP 100228 . 100510) (\IS.NOT.RANDACCESSP 100512 . 
+100958) (\STREAM.NOT.OPEN 100960 . 101279)) (101416 103714 (\FDEVINSTANCE 101426 . 103712)) (104916 
+112290 (CNDIR 104926 . 106231) (DIRECTORYNAME 106233 . 110416) (DIRECTORYNAMEP 110418 . 111034) (
+HOSTNAMEP 111036 . 111843) (\ADD.CONNECTED.DIR 111845 . 112288)) (112335 141282 (\BACKFILEPTR 112345
+ . 112533) (\BACKPEEKBIN 112535 . 112896) (\BACKBIN 112898 . 113249) (BIN 113251 . 113468) (\BIN 
+113470 . 113747) (\BINS 113749 . 114035) (BOUT 114037 . 114399) (\BOUT 114401 . 114716) (\BOUTS 114718
+ . 115029) (COPYBYTES 115031 . 118363) (COPYCHARS 118365 . 122163) (COPYFILE 122165 . 123525) (
+\COPYOPENFILE 123527 . 126726) (\INFER.FILE.TYPE 126728 . 127682) (EOFP 127684 . 127981) (FORCEOUTPUT 
+127983 . 128230) (\FLUSH.OPEN.STREAMS 128232 . 128588) (CHARSET 128590 . 129949) (ACCESS-CHARSET 
+129951 . 130588) (GETEOFPTR 130590 . 130840) (GETFILEINFO 130842 . 134035) (\TYPE.FROM.FILETYPE 134037
+ . 134507) (\FILETYPE.FROM.TYPE 134509 . 134688) (GETFILEPTR 134690 . 134942) (SETFILEINFO 134944 . 
+139181) (SETFILEPTR 139183 . 140902) (BOUT16 140904 . 141089) (BIN16 141091 . 141280)) (141385 148565 
+(\GENERIC.BINS 141395 . 141675) (\GENERIC.BOUTS 141677 . 141942) (\GENERIC.RENAMEFILE 141944 . 144192)
+ (\GENERIC.OPENP 144194 . 145509) (\GENERIC.READP 145511 . 146663) (\GENERIC.CHARSET 146665 . 148563))
+ (148566 148905 (\MAP-OPEN-STREAMS 148576 . 148903)) (150760 152840 (\EOF.ACTION 150770 . 151021) (
+\EOSERROR 151023 . 151216) (\GETEOFPTR 151218 . 151400) (\INCFILEPTR 151402 . 151752) (\PEEKBIN 151754
+ . 151945) (\SETCLOSEDFILELENGTH 151947 . 152281) (\SETEOFPTR 152283 . 152471) (\SETFILEPTR 152473 . 
+152838)) (152841 153383 (\FIXPOUT 152851 . 153151) (\FIXPIN 153153 . 153381)) (153384 153950 (\BOUTEOL
+ 153394 . 153948)) (156846 166710 (\BUFFERED.BIN 156856 . 157708) (\BUFFERED.PEEKBIN 157710 . 158492) 
+(\BUFFERED.BOUT 158494 . 159354) (\BUFFERED.BINS 159356 . 163041) (\BUFFERED.BOUTS 163043 . 164844) (
+\BUFFERED.COPYBYTES 164846 . 166708)))))
 STOP
diff --git a/sources/FILEIO.LCOM b/sources/FILEIO.LCOM
index 2e96bcf11..2b24260f3 100644
Binary files a/sources/FILEIO.LCOM and b/sources/FILEIO.LCOM differ
diff --git a/sources/FILESETS b/sources/FILESETS
index ca9d76041..0cc75efbc 100644
--- a/sources/FILESETS
+++ b/sources/FILESETS
@@ -1,12 +1,12 @@
 (DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
 
-
(FILECREATED "13-Aug-2025 16:22:29" {MEDLEY}<sources>FILESETS.;2
 6206   
+
(FILECREATED " 7-Aug-2025 10:11:01" {WMEDLEY}<sources>FILESETS.;24
 6210   
 
       :EDIT-BY rmk
 
       :CHANGES-TO (VARS 0LISPSET)
 
-      :PREVIOUS-DATE "17-Jul-2025 12:07:14" {MEDLEY}<sources>FILESETS.;1)
+      :PREVIOUS-DATE "10-Jun-2025 18:00:09" {WMEDLEY}<sources>FILESETS.;23)
 
 
 (PRETTYCOMPRINT FILESETSCOMS)
@@ -50,7 +50,7 @@
 
 (RPAQQ 0LISPSET
 (PACKAGE-CONVERSION-TABLE LLFAULT LLSUBRS LLBFS LLNEW FILEIO EXTERNALFORMAT IMAGEIO 
                        LLBASIC LLGC LLARRAYELT LLINTERP LLMVS DEFSTRUCT-RUN-TIME SETF-RUNTIME 
-                       CMLSEQBASICS LLARITH LLFLOAT LLBIGNUM LLREAD IOCHAR XCCS LLCHAR LLSTK 
+                       CMLSEQBASICS LLARITH LLFLOAT LLBIGNUM LLREAD IOCHAR MCCS LLCHAR LLSTK 
                        LLDATATYPE LLKEY LLTIMER))
 
 (RPAQQ 1LISPSET

@@ -68,7 +68,7 @@
        (IOCHAR MODARITH LLPARAMS LLCODE AERROR AOFD APRINT ATERM LLARRAYELT LLDATATYPE LLNEW LLBASIC
               LLCHAR LLSTK PMAP LLGC ATBL FILEIO EXTERNALFORMAT LLARITH LLFLOAT FONT LLKEY LLDISPLAY
               ADISPLAY AINTERRUPT RENAMEMACROS HLDISPLAY WINDOW MACROAUX ADDARITH LLFAULT LLTIMER 
-              IMAGEIO PROC XCCS PASSWORDS INTERPRESS HARDCOPY CMLARRAY LLSUBRS LLETHER PUP UFS 
+              IMAGEIO PROC MCCS PASSWORDS INTERPRESS HARDCOPY CMLARRAY LLSUBRS LLETHER PUP UFS 
               DTDECLARE))
 
 (RPAQQ MAKEINITFILES
 (MAKEINIT MEM I-NEW))
diff --git a/sources/FONT b/sources/FONT
index 39591da8e..d3db7f6f3 100644
--- a/sources/FONT
+++ b/sources/FONT
@@ -1,14 +1,14 @@
 (DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
 
-
(FILECREATED "27-Jul-2025 13:39:57" 
-{DSK}<Users>kaplan>Local>medley3.5>working-medley>sources>FONT.;375
 239724 
+
(FILECREATED " 7-Oct-2025 17:51:13" {WMEDLEY}<sources>FONT.;617
 284869 
 
       :EDIT-BY rmk
 
-      :CHANGES-TO (FNS \FONT.CHECKARGS \FONT.CHECKARGS1 \COERCEFONTDESC)
-                  (MACROS FONTASCENT FONTDESCENT FONTHEIGHT)
+      :CHANGES-TO (FNS \CREATECHARSET.DISPLAY COMPLETE.FONT \COERCECHARSET)
+                  (MACROS LEGACYFONTS LEGACYFONT)
+                  (VARS FONTCOMS)
 
-      :PREVIOUS-DATE "25-Jul-2025 21:38:56" {WMEDLEY}<sources>FONT.;372)
+      :PREVIOUS-DATE " 7-Oct-2025 12:43:05" {WMEDLEY}<sources>FONT.;614)
 
 
 (PRETTYCOMPRINT FONTCOMS)
@@ -31,38 +31,74 @@
               (* ;; "Creation: ")

 
               (FNS FONTCREATE FONTCREATE1 FONTCREATE.SLUGFD \FONT.CHECKARGS \FONT.CHECKARGS1 
-                   \FONTCREATE1.NOFN FONTFILEP \READCHARSET \COERCEFONTSPEC)
-              (FNS \COERCEFONTDESC)
+                   \FONTCREATE1.NOFN FONTFILEP \READCHARSET)
+              (FNS \FONT.CHECKARGS \CHARSET.CHECK)
+              (FNS COERCEFONTSPEC)
+              (DECLARE%: EVAL@COMPILE DONTCOPY (MACROS COERCEFONTSPEC.MATCH COERCEFONTSPEC.TARGET))
               (MACROS SPREADFONTSPEC)
-              (FNS COMPLETE.FONT COMPLETEFONTP COMPLETE.CHARSET PRUNEFONTSLUGS))
+              (FNS MAKEFONTSPEC)
+              (FNS COMPLETE.FONT COMPLETEFONTP COMPLETE.CHARSET PRUNESLUGCSINFOS))
         (COMS 
               (* ;; "Property extraction:")

 
-              (FNS FONTASCENT FONTDESCENT FONTHEIGHT FONTPROP \AVGCHARWIDTH))
-        (COMS 
-              (* ;; "Moving character information")

-
+              (FNS FONTASCENT FONTDESCENT FONTHEIGHT FONTPROP \AVGCHARWIDTH)
+              (EXPORT (OPTIMIZERS FONTPROP))
+              (FNS FONTDEVICEPROP))
+        (COMS                                                (* ; "Moving character information")

               (FNS EDITCHAR)
                                                              (* ; "Should this be on EDITFONT ?")

               (FNS GETCHARBITMAP PUTCHARBITMAP \GETCHARBITMAP.CSINFO \PUTCHARBITMAP.CSINFO)
-              (FNS MOVECHARBITMAP MOVEFONTCHARS \MOVEFONTCHAR SLUGCHARP.DISPLAY \GETCHARINFO)
+              (FNS MOVECHARBITMAP MOVEFONTCHARS \MOVEFONTCHAR \MOVEFONTCHARS.SOURCEDATA \MAKESLUGCHAR
+                   SLUGCHARP.DISPLAY)
               (MACROS UPDATEINFOELEMENT))
         (COMS 
               (* ;; "\FINDFONTFILE \FONTFILENAME \SEARCHFONTFILES \FONTINFOFROMFILENAME are redefined to deal with character-set directories.  That behavior is conditioned on the setting of the global variable *USEOLDFONTDIRECTORIES*, T at PARC, maybe NIL most other places.  ")

 
               (FNS FONTFILES \FINDFONTFILE \FONTFILENAMES \FONTFILENAME \FONTFILENAME.OLD 
-                   \FONTFILENAME.NEW \FONTINFOFROMFILENAME \FONTINFOFROMFILENAME.OLD)
+                   \FONTFILENAME.NEW FONTSPECFROMFILENAME \FONTINFOFROMFILENAME.OLD)
               (*                                             (* ; "Do we still want old fonts?")

                  (ADDVARS (*OLD-FONT-EXTENSIONS* STRIKE)))
               (INITVARS (*OLD-FONT-EXTENSIONS* NIL))
               (INITVARS (*USEOLDFONTDIRECTORIES* NIL))
               (GLOBALVARS *OLD-FONT-EXTENSIONS* *USEOLDFONTDIRECTORIES*))
-        (FNS FONTCOPY FONTP FONTUNPARSE SETFONTDESCRIPTOR \STREAMCHARWIDTH \UNITWIDTHSVECTOR 
-             \COERCECHARSET \BUILDSLUGCSINFO \FONTSYMBOL \DEVICESYMBOL \FONTFACE \FONTFACE.COLOR 
-             SETFONTCHARENCODING)
-        (FNS FONTSAVAILABLE FONTEXISTS? \FONTSAVAILABLE.INCORE \SEARCHFONTFILES FLUSHFONTSINCORE 
-             MATCHFONTFACE FINDFONTFILES)
-        (INITVARS \FONTEXISTS?-CACHE)
+        (FNS FONTCOPY FONTP FONTUNPARSE SETFONTDESCRIPTOR \STREAMCHARWIDTH \COERCECHARSET 
+             \BUILDSLUGCSINFO \FONTSYMBOL \DEVICESYMBOL \FONTFACE \FONTFACE.COLOR SETFONTCHARENCODING
+             )
+        (FNS FONTSAVAILABLE FONTEXISTS? \SEARCHFONTFILES FLUSHFONTSINCORE FINDFONTFILES SORTFONTSPECS
+             )
+        (FNS MATCHFONTFACE MAKEFONTFACE FONTFACETOATOM)
+        (INITVARS \FONTSINCORE \FONTEXISTS?-CACHE \DEFAULTDEVICEFONTS)
+        [COMS (GLOBALVARS \DEFAULTDEVICEFONTS \UNITWIDTHSVECTOR)
+              (INITVARS \UNITWIDTHSVECTOR)
+              (FNS \UNITWIDTHSVECTOR)
+              (DECLARE%: DONTEVAL@LOAD DOCOPY (P (\UNITWIDTHSVECTOR]
+        (DECLARE%: DONTCOPY (EXPORT (RECORDS FONTCLASS FONTDESCRIPTOR FONTFACE CHARSETINFO FONTSPEC)
+                                   (MACROS FONTASCENT FONTDESCENT FONTHEIGHT \FGETOFFSET \FSETOFFSET
+                                          \FGETWIDTH \FSETWIDTH \FGETCHARWIDTH \FSETCHARWIDTH 
+                                          \FGETIMAGEWIDTH \FSETIMAGEWIDTH)
+                                   (MACROS \GETCHARSETINFO \SETCHARSETINFO \INSURECHARSETINFO 
+                                          \CREATECSINFOELEMENT \CREATEFONTCHARSETVECTOR CHARSETPROP)
+                                   (PROP ARGNAMES CHARSETPROP)
+                                   (CONSTANTS (SLUGCHARINDEX (ADD1 \MAXTHINCHAR))
+                                          (SLUGCHARSET (ADD1 \MAXCHARSET)))
+                                   (MACROS LEGACYFONTS))
+               (MACROS INDIRECTCHARSETP))
+        (FNS FONTDESCRIPTOR.DEFPRINT FONTCLASS.DEFPRINT)
+        (INITRECORDS FONTCLASS FONTDESCRIPTOR CHARSETINFO)
+        (SYSRECORDS FONTCLASS FONTDESCRIPTOR CHARSETINFO)
+        (FNS \CREATEKERNELEMENT \FSETLEFTKERN \FGETLEFTKERN)
+        (FNS \CREATEFONT \CREATECHARSET \INSTALLCHARSETINFO \INSTALLCHARSETINFO.CHARENCODING)
+        (DECLARE%: DONTCOPY (MACROS FIRSTCHARSETCODE LASTCHARSETCODE))
+        (FNS \FONTRESETCHARWIDTHS)
+        (MACROS \FGETCHARIMAGEWIDTH)
+        (LOCALVARS . T)
+        (PROP FILETYPE FONT)
+        
+        (* ;; "")

+
+        
+        (* ;; "DISPLAY")

+
         (COMS                                                (* ; 
 
                                                            "Functions for DISPLAY IMAGESTREAMTYPES ")

               (FNS \CREATEDISPLAYFONT \CREATECHARSET.DISPLAY \FONTEXISTS?.DISPLAY))
@@ -72,111 +108,101 @@
                    \SFMAKEITALIC)
               (FNS \SFMAKEROTATEDFONT \SFROTATECSINFO \SFROTATEFONTCHARACTERS \SFROTATECSINFOOFFSETS)
               (FNS \SFMAKECOLOR))
-        (FNS FONTDESCRIPTOR.DEFPRINT FONTCLASS.DEFPRINT)
-        (INITRECORDS FONTCLASS FONTDESCRIPTOR CHARSETINFO)
-        (SYSRECORDS FONTCLASS FONTDESCRIPTOR CHARSETINFO)
-        (INITVARS (\FONTSINCORE)
-               (\DEFAULTDEVICEFONTS)
-               (\UNITWIDTHSVECTOR))
-        (GLOBALVARS \DEFAULTDEVICEFONTS \UNITWIDTHSVECTOR)
-        (DECLARE%: DONTEVAL@LOAD DOCOPY (P (\UNITWIDTHSVECTOR)))
-        (EXPORT (OPTIMIZERS FONTPROP))
-        (DECLARE%: DONTCOPY (EXPORT (RECORDS FONTCLASS FONTDESCRIPTOR FONTFACE CHARSETINFO)
-                                   (MACROS FONTASCENT FONTDESCENT FONTHEIGHT \FGETOFFSET \FSETOFFSET
-                                          \FGETWIDTH \FSETWIDTH \FGETCHARWIDTH \FSETCHARWIDTH 
-                                          \FGETIMAGEWIDTH \FSETIMAGEWIDTH)
-                                   (MACROS \XGETCHARSETINFO \GETCHARSETINFO \INSURECHARSETINFO 
-                                          \CREATECSINFOELEMENT \CREATEFONTCHARSETVECTOR CHARSETPROP)
-                                   (CONSTANTS (\MAXNSCHAR 65535)))
-               (MACROS INDIRECTCHARSETP MAKECSSOURCE))
-        (FNS \CREATEKERNELEMENT \FSETLEFTKERN \FGETLEFTKERN)
-        [COMS (FNS \CREATEFONT \CREATECHARSET \INSTALLCHARSETINFO \INSTALLCHARSETINFO.CHARENCODING)
-              (EXPORT (GLOBALVARS DISPLAYFONTDIRECTORIES DISPLAYFONTEXTENSIONS DISPLAYGLYPHCOERCIONS
-                             DISPLAYFONTCOERCIONS))
-              
-              (* ;; "Removed ((CLASSIC 36) (CLASSIC 24)) so that TIMESROMAN 36 BOLD boldifies rather than coercing to CLASSIC 24 BOLD.")

-
-              (INITVARS [DISPLAYFONTCOERCIONS '(((HELVETICA 1)
-                                                 (HELVETICA 4))
-                                                ((HELVETICA 2)
-                                                 (HELVETICA 4))
-                                                ((MODERN 60)
-                                                 (MODERN 48))
-                                                ((MODERN 96)
-                                                 (MODERN 72))
-                                                ((MODERN 120)
-                                                 (MODERN 72))
-                                                ((PALATINO 9)
-                                                 (PALATINO 12))
-                                                ((PALATINO 8)
-                                                 (PALATINO 10))
-                                                ((PALATINO 6)
-                                                 (PALATINO 10))
-                                                ((TITAN 6)
-                                                 (TITAN 10))
-                                                ((TITAN 9 (TITAN 10)))
-                                                ((LPT)
-                                                 (AMTEX]
-                     [DISPLAYGLYPHCOERCIONS '(((GACHA)
-                                               (TERMINAL))
-                                              ((MODERN)
-                                               (CLASSIC))
-                                              ((TIMESROMAN)
-                                               (CLASSIC))
-                                              ((HELVETICA)
-                                               (MODERN))
-                                              ((TERMINAL)
-                                               (MODERN]
-                     [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]
-                     (\DEFAULTCHARSET 0))
-              (COMS                                          (* ; "MAPPING FOR DOS FILENAMES ")

-                    (INITVARS (*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]
-        (FNS \FONTRESETCHARWIDTHS)
-        (GLOBALVARS DISPLAYCHARSETFNS)
-        [DECLARE%: DONTEVAL@LOAD DOCOPY (INITVARS (DISPLAYFONTDIRECTORIES NIL))
-               (ADDVARS (DISPLAYCHARSETFNS (STRIKE STRIKEFONT.FILEP STRIKEFONT.GETCHARSET]
-        (DECLARE%: DONTEVAL@LOAD DOCOPY                      (* ; "The loadup might have fewer")

+        (EXPORT (GLOBALVARS DISPLAYFONTDIRECTORIES DISPLAYFONTEXTENSIONS DISPLAYCHARCOERCIONS 
+                       DISPLAYFONTCOERCIONS DISPLAYCHARSETFNS))
+        (DECLARE%: DONTEVAL@LOAD DOCOPY (INITVARS (DISPLAYFONTDIRECTORIES NIL))
+               (ADDVARS (DISPLAYCHARSETFNS (STRIKE STRIKEFONT.FILEP STRIKEFONT.GETCHARSET)))
+                                                             (* ; "The loadup might have fewer")

                (ADDVARS (DISPLAYFONTEXTENSIONS MEDLEYDISPLAYFONT DISPLAYFONT)))
-        (DECLARE%: EVAL@COMPILE DONTCOPY (CONSTANTS (MAXCODE 255)
-                                                (DUMMYINDEX 256)))
-        (MACROS \FGETCHARIMAGEWIDTH \SETCHARSETINFO)
-        (LOCALVARS . T)
-        (PROP FILETYPE FONT)
+        (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)
+                                       (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]
         (DECLARE%: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY COMPILERVARS (ADDVARS (NLAMA)
                                                                              (NLAML)
                                                                              (LAMA FONTCOPY])
@@ -209,7 +235,8 @@
                       CHARCODE])
 
 (CHARWIDTHY

-  [LAMBDA (CHARCODE FONT)
                                    (* ; "Edited 22-May-2025 09:47 by rmk")

+  [LAMBDA (CHARCODE FONT)
                                    (* ; "Edited  2-Sep-2025 13:25 by rmk")


+                                                             (* ; "Edited 22-May-2025 09:47 by rmk")

                                                              (* edited%: "18-Mar-86 19:30")

                                                              (* ; 
 
                                   "Gets the Y-component of the width of a character code in a font.")

@@ -218,8 +245,7 @@
     (LET (TEMP WY)
          (COND
             ((type?
 FONTDESCRIPTOR FONT)
-             (SETQ WY (ffetch
 (CHARSETINFO YWIDTHS) of
 (\INSURECHARSETINFO (\CHARSET CHARCODE)
-                                                              FONT)))
+             [SETQ WY (ffetch
 (CHARSETINFO YWIDTHS) of
 (\INSURECHARSETINFO FONT (\CHARSET CHARCODE]
              (COND
                 ((FIXP WY))
                 (WY (\FGETWIDTH WY (\CHAR8CODE CHARCODE)))
@@ -228,8 +254,8 @@
                                                              (* ; 
 
                                                       "NIL font goes thru here--primary output file")

              (IMAGEOP 'IMCHARWIDTHY TEMP TEMP CHARCODE))
-            (T [SETQ WY (ffetch
 (CHARSETINFO YWIDTHS) of
 (\INSURECHARSETINFO (\CHARSET CHARCODE)
-                                                                (FONTCREATE
 FONT]
+            (T [SETQ WY (ffetch
 (CHARSETINFO YWIDTHS) of
 (\INSURECHARSETINFO (FONTCREATE
 FONT)
+                                                                (\CHARSET CHARCODE]
                (COND
                   ((FIXP WY))
                   (WY (\FGETWIDTH WY (\CHAR8CODE CHARCODE)))
@@ -274,7 +300,10 @@
                 (ffetch
 DDSPACEWIDTH of
 DD])
 
 (\STRINGWIDTH.GENERIC

-  [LAMBDA (STR FONT RDTBL SPACEWIDTH)
                        (* ; "Edited 22-May-2025 09:51 by rmk")


+  [LAMBDA (STR FONT RDTBL SPACEWIDTH)
                        (* ; "Edited 10-Sep-2025 23:25 by rmk")


+                                                             (* ; "Edited  2-Sep-2025 22:59 by rmk")


+                                                             (* ; "Edited 30-Aug-2025 23:19 by rmk")


+                                                             (* ; "Edited 22-May-2025 09:51 by rmk")


                                                              (* ; "Edited  3-Apr-87 13:47 by jop")

 
     (* ;; "Returns the width of STR with SPACEWIDTH for the width of spaces.  RDTBL has already been coerced, so no FLG is needed ")

@@ -289,45 +318,39 @@
               (if
 RDTBL
                   then
 (GO SLOW)
                 else
 (RETURN (for
 C WIDTHSBASE CSET inatom
 STR
-                                sum
 [COND
-                                       ((NEQ CSET (\CHARSET C))
+                                sum
 (CL:UNLESS (EQ CSET (\CHARSET C))
                                         (SETQ CSET (\CHARSET C))
                                         (SETQ WIDTHSBASE (ffetch
 (CHARSETINFO WIDTHS)
-                                                            of
 (\INSURECHARSETINFO CSET FONT]
-                                    (COND
-                                       ((EQ C (CHARCODE SPACE))
-                                        SPACEWIDTH)
-                                       (T (\FGETWIDTH WIDTHSBASE (\CHAR8CODE C]
+                                                            of
 (\INSURECHARSETINFO FONT CSET))))
+                                    (CL:IF (EQ C (CHARCODE SPACE))
+                                        SPACEWIDTH
+                                        (\FGETWIDTH WIDTHSBASE (\CHAR8CODE C)))]
              ((STRINGP STR)
-              (RETURN
-               (LET ((TOTAL 0)
-                     ESC ESCWIDTH WIDTHSBASE CSET)
-                    [COND
-                       (RDTBL                                (* ; 
+              (RETURN (LET ((TOTAL 0)
+                            ESC ESCWIDTH WIDTHSBASE CSET)
+                           (CL:WHEN RDTBL                    (* ; 
 
                                                       "Count delimiting quotes and internal escapes")

-                              (SETQ TOTAL (UNFOLD (\FGETCHARWIDTH FONT (CHARCODE %"))
-                                                 2))
-                              (SETQ ESC (fetch
 (READTABLEP ESCAPECHAR) of
 RDTBL))
-                              (SETQ ESCWIDTH (\FGETCHARWIDTH FONT ESC]
-                    [for
 C instring
 STR
-                       do
 [COND
-                             ((NEQ (\CHARSET C)
-                                   CSET)                     (* ; 
+                               (SETQ TOTAL (UNFOLD (\FGETCHARWIDTH FONT (CHARCODE %"))
+                                                  2))
+                               (SETQ ESC (fetch
 (READTABLEP ESCAPECHAR) of
 RDTBL))
+                               (SETQ ESCWIDTH (\FGETCHARWIDTH FONT ESC)))
+                           [for
 C instring
 STR
+                              do
 (CL:UNLESS (EQ (\CHARSET C)
+                                                CSET)        (* ; 
 
                                                       "Get the widths vector for this character set")

-                              (SETQ CSET (\CHARSET C))
-                              (SETQ WIDTHSBASE (ffetch
 (CHARSETINFO WIDTHS) of
 (\INSURECHARSETINFO
-                                                                                CSET FONT]
-                          (add
 TOTAL (COND
-                                        ((EQ C (CHARCODE SPACE))
-                                         SPACEWIDTH)
-                                        (T (IPLUS (\FGETWIDTH WIDTHSBASE (\CHAR8CODE C))
-                                                  (COND
-                                                     ((AND RDTBL (OR (EQ C (CHARCODE %"))
-                                                                     (EQ C ESC)))
+                                     (SETQ CSET (\CHARSET C))
+                                     (SETQ WIDTHSBASE (ffetch
 (CHARSETINFO WIDTHS)
+                                                         of
 (\INSURECHARSETINFO FONT CSET))))
+                                 (add
 TOTAL (CL:IF (EQ C (CHARCODE SPACE))
+                                                SPACEWIDTH
+                                                (IPLUS (\FGETWIDTH WIDTHSBASE (\CHAR8CODE C))
+                                                       (COND
+                                                          ((AND RDTBL (OR (EQ C (CHARCODE %"))
+                                                                          (EQ C ESC)))
                                                              (* ; "String char must be escaped")

-                                                      ESCWIDTH)
-                                                     (T 0]
-                    TOTAL]
+                                                           ESCWIDTH)
+                                                          (T 0))))]
+                           TOTAL]
       SLOW
                                                              (* ; "Do the general case here")

           (RETURN (LET ((TOTALWIDTH 0)
@@ -344,8 +367,8 @@
                                                                  (T (SETQ CSET (\CHARSET CC))
                                                                     (SETQ WIDTHSBASE
                                                                      (ffetch
 (CHARSETINFO WIDTHS)
-                                                                        of
 (\INSURECHARSETINFO CSET 
-                                                                                  FONT)))
+                                                                        of
 (\INSURECHARSETINFO FONT 
+                                                                                  CSET)))
                                                                     (\FGETWIDTH WIDTHSBASE
                                                                            (\CHAR8CODE CC]
                               STR RDTBL RDTBL *PRINT-LEVEL* *PRINT-LENGTH*)
@@ -463,7 +486,6 @@
                                          (SELECTQ DEVICE
                                              (DISPLAY (fetch
 (FONTCLASS
 DISPLAYFD) of
 FCLASS))
                                              (INTERPRESS (fetch
 (FONTCLASS
 INTERPRESSFD) of
 FCLASS))
-                                             (PRESS (fetch
 (FONTCLASS
 PRESSFD) of
 FCLASS))
                                              (GETMULTI (fetch
 (FONTCLASS
 OTHERFDS) of
 FCLASS)
                                                     DEVICE))))
 
@@ -481,7 +503,8 @@
 
 (RPAQQ NSFONTFAMILIES
 (CLASSIC MODERN TERMINAL OPTIMA TITAN BOLDPS PCTERMINAL))
 
-(RPAQQ ALTOFONTFAMILIES
 (GACHA TIMESROMAN TIMESROMAND HELVETICA OLDENGLISH SNAIL TONTO))
+(RPAQQ ALTOFONTFAMILIES
 (TIMESROMAN TIMESROMAND HELVETICA HELVETICAD CLARITY BRAVOX TONTO CREAM 
+                               OLDENGLISH))
 
 
 
@@ -491,6 +514,9 @@
 
 (FONTCREATE

   [LAMBDA (FAMILY SIZE FACE ROTATION DEVICE NOERRORFLG CHARSET)

+                                                             (* ; "Edited 28-Aug-2025 14:39 by rmk")


+                                                             (* ; "Edited 15-Aug-2025 23:48 by rmk")


+                                                             (* ; "Edited 12-Aug-2025 21:02 by rmk")


                                                              (* ; "Edited 21-Jul-2025 09:11 by rmk")


                                                              (* ; "Edited 11-Jul-2025 10:23 by rmk")


                                                              (* ; "Edited  4-Jul-2025 12:10 by rmk")


@@ -501,7 +527,7 @@
                                                              (* ; "Edited 28-Jul-88 14:43 by rmk:")


                                                              (* ; "Edited 10-Nov-87 18:08 by FS")

 
-    (* ;; "Returns the requested font descriptor.  If NOERRORFLG, return NIL if the requested  font or CHARSET doesn't exist;  otherwise cause an error.  And always cause an error if any argument is bogus.")

+    (* ;; "Returns the requested font descriptor.  If NOERRORFLG, return NIL if the requested  font doesn't exist;  otherwise cause an error.  And always cause an error if any argument is bogus.")

 
     (* ;; "A font exists if it has at least one charset, even if the optionally desired CHARSET doesn't exist.  There is no difference between all the characters in a missing charset and particular missing characters in an existing charset:  they will show up as slugs. ")

 
@@ -510,22 +536,36 @@
     (PROG (FONTSPEC)
       RETRY
                                                              (* ; "Back to here if ERROR returns")

-          (SETQ FONTSPEC (\FONT.CHECKARGS
 FAMILY SIZE FACE ROTATION DEVICE CHARSET))
+          (SETQ CHARSET (\CHARSET.CHECK
 CHARSET))
+          (SETQ FONTSPEC (if
 (AND (type?
 FONTDESCRIPTOR FAMILY)
+                                  (NULL SIZE)
+                                  (NULL FACE)
+                                  (NULL ROTATION)
+                                  (NULL DEVICE))
+                             then
 
+                                  (* ;; "Pretest for a fontdescriptor with no modification--makes it possible to break/trace/change \FONT.CHECKARGS")

+
+                                  FAMILY
+                           else
 (\FONT.CHECKARGS
 FAMILY SIZE FACE ROTATION DEVICE)))
 
      (* ;; "If FONTSPEC is a fontdescriptor, it's what we want")

 
           (RETURN (if
 (type?
 FONTDESCRIPTOR FONTSPEC)
                       then
 FONTSPEC
-                    else
 (SPREADFONTSPEC FONTSPEC)
-                         (if
 (FONTCREATE1
 FAMILY SIZE FACE ROTATION DEVICE (OR CHARSET 
-                                                                               \DEFAULTCHARSET))
-                           elseif
 NOERRORFLG
-                             then
 NIL
-                           else
 (ERROR "FONT NOT FOUND" FONTSPEC)
-                                (GO RETRY])
+                    elseif
 (FONTCREATE1
 FONTSPEC CHARSET)
+                    elseif
 NOERRORFLG
+                      then
 NIL
+                    else
 (ERROR "FONT NOT FOUND" FONTSPEC)
+                         (GO RETRY])
 
 (FONTCREATE1

-  [LAMBDA (FAMILY SIZE FACE ROTATION DEVICE CHARSET)
         (* ; "Edited 24-Jul-2025 19:52 by rmk")


+  [LAMBDA (FONTSPEC CHARSET)
                                 (* ; "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")


+                                                             (* ; "Edited 16-Aug-2025 18:55 by rmk")


+                                                             (* ; "Edited  8-Aug-2025 10:05 by rmk")


+                                                             (* ; "Edited 24-Jul-2025 19:52 by rmk")


                                                              (* ; "Edited 23-Jul-2025 10:01 by rmk")


                                                              (* ; "Edited 17-Jul-2025 23:48 by rmk")


                                                              (* ; "Edited 10-Jul-2025 12:38 by rmk")


@@ -536,21 +576,28 @@
                                                              (* ; "Edited 14-Jun-2025 20:53 by rmk")


                                                              (* ; "Edited 10-Jun-2025 23:54 by rmk")

 
-    (* ;; "Causes an error only if the arguments are bogus, otherwise returns NIL if font or character set not found. Error happens at FONTCREATE")

+    (* ;; "Returns NIL if font not found. Error happens at FONTCREATE.  ")

 
-    (DECLARE
 (GLOBALVARS IMAGESTREAMTYPES \FONTSINCORE))
-    (LET (FONTX)
-         (CL:WHEN (if
 (SETQ FONTX (GETMULTI \FONTSINCORE FAMILY SIZE FACE ROTATION DEVICE))
-                      then
 (\INSURECHARSETINFO CHARSET FONTX)
-                    elseif
 (AND (FONTEXISTS?
 FAMILY SIZE FACE ROTATION DEVICE CHARSET)
-                                (SETQ FONTX (\CREATEFONT
 FAMILY SIZE FACE ROTATION DEVICE CHARSET))
-                                (\INSURECHARSETINFO CHARSET FONTX))
-                      then
 (PUTMULTI \FONTSINCORE FAMILY SIZE FACE ROTATION DEVICE FONTX))
-             (replace
 (FONTDESCRIPTOR FONTAVGCHARWIDTH) of
 FONTX with
 (\AVGCHARWIDTH
 FONTX))
-             FONTX)])
+    (DECLARE
 (GLOBALVARS \FONTSINCORE))
+    (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)))
+                      then
 
+                           (* ;; "Storing stops internal charset recursions")

+
+                           (STOREMULTI \FONTSINCORE FONTSPEC FONT T))
+
+             (* ;; "Even the cached font may not have had the requested charset.")

+
+             (\INSURECHARSETINFO FONT CHARSET)
+             (replace
 (FONTDESCRIPTOR FONTAVGCHARWIDTH) of
 FONT with
 (\AVGCHARWIDTH
 FONT))
+             FONT)])
 
 (FONTCREATE.SLUGFD

-  [LAMBDA (FAMILY SIZE FACE ROTATION DEVICE CHARSET)
         (* ; "Edited 14-Jun-2025 23:25 by rmk")


+  [LAMBDA (FAMILY SIZE FACE ROTATION DEVICE CHARSET)
         (* ; "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")

 
@@ -570,15 +617,18 @@
                             FONTAVGCHARWIDTH _ (FIXR (FTIMES SIZE 0.75]
            (SLUGCSINFO (\BUILDSLUGCSINFO
 FONTDESC)))
           (if
 CHARSET
-              then
 (\SETCHARSETINFO (ffetch
 FONTCHARSETVECTOR of
 FONTDESC)
-                          CHARSET SLUGCSINFO)
-            else
 (for
 CS from
 0 to
 (ADD1 \MAXCHARSET) do
 (\SETCHARSETINFO (ffetch
 FONTCHARSETVECTOR
-                                                                             of
 FONTDESC)
-                                                                CS SLUGCSINFO)))
+              then
 (\SETCHARSETINFO FONTDESC CHARSET SLUGCSINFO)
+            else
 (for
 CS from
 0 to
 (ADD1 \MAXCHARSET) do
 (\SETCHARSETINFO FONTDESC CS SLUGCSINFO)))
           FONTDESC])
 
 (\FONT.CHECKARGS

-  [LAMBDA (FAMILY SIZE FACE ROTATION DEVICE CHARSET)
         (* ; "Edited 27-Jul-2025 13:30 by rmk")


+  [LAMBDA (FAMILY SIZE FACE ROTATION DEVICE)
                 (* ; "Edited 28-Aug-2025 14:46 by rmk")


+                                                             (* ; "Edited 23-Aug-2025 11:54 by rmk")


+                                                             (* ; "Edited 17-Aug-2025 19:15 by rmk")


+                                                             (* ; "Edited 12-Aug-2025 22:36 by rmk")


+                                                             (* ; "Edited 10-Aug-2025 12:06 by rmk")


+                                                             (* ; "Edited  8-Aug-2025 09:57 by rmk")


+                                                             (* ; "Edited 27-Jul-2025 13:30 by rmk")


                                                              (* ; "Edited 22-Jul-2025 23:07 by rmk")


                                                              (* ; "Edited 21-Jul-2025 09:22 by rmk")


                                                              (* ; "Edited 14-Jul-2025 20:09 by rmk")


@@ -588,23 +638,14 @@
                                                              (* ; "Edited 27-Jun-2025 10:42 by rmk")


                                                              (* ; "Edited 15-Jun-2025 00:25 by rmk")

 
+    (* ;; "DON'T BREAK, TRACE, OR UNSAVE THIS UNLESS ALL SYSTEM FONTS HAVE ALREADY BEEN INSTANTIATED")

+
     (* ;; "Decodes and checks the various ways of specifying the arguments to font lookup functions.")

 
-    (* ;; "If FAMILY can be coerced to a font descriptor and none of its properties are overwritten by the other aguments, then that font descriptor is returned.  Otherwise the value is the coerce fontspec (family size face rotation device).  CHARSET is checked for validity but not coerced.")

+    (* ;; "If FAMILY can be coerced to a font descriptor and none of its properties are overwritten by the other aguments, then that font descriptor is returned.  Otherwise the value is the coerced fontspec (family size face rotation device).")

 
     (LET (FONTX)
-         (SETQ DEVICE (if
 (NULL DEVICE)
-                          then
 (CL:IF (type?
 FONTDESCRIPTOR FAMILY)
-                                   (fetch
 (FONTDESCRIPTOR FONTDEVICE) of
 FAMILY)
-                                   'DISPLAY)
-                        elseif
 (OR (AND (LITATOM DEVICE)
-                                        (NEQ DEVICE T))
-                                   (STRINGP DEVICE))
-                          then
 (\DEVICESYMBOL
 DEVICE)
-                        elseif
 [AND (SETQ DEVICE (\GETSTREAM DEVICE 'OUTPUT T))
-                                    (CAR (MKLIST (IMAGESTREAMTYPE DEVICE]
-                        else
 (\ILLEGAL.ARG DEVICE)))
-         (CL:WHEN (AND (EQ 'CLASS (CAR FAMILY))
+         (CL:WHEN (AND (EQ 'CLASS (CAR (LISTP FAMILY)))
                        (LITATOM (CADR FAMILY)))
 
              (* ;; "This used to be at the entry to FONTCREATE, and it returned the FONTCLASS.  That seemed wrong--FONTCREATE should always return a fontdescriptor.  So here we build a throwaway fontclass, coerce it to its device font, and fall through.")

@@ -618,19 +659,17 @@
              (* ;; "FAMILY T or NIL produces an error below")

 
              [if
 (LISTP FAMILY)
-                 then
 (SETQ FONTX (CL:IF (EQ 'FONT (CAR FAMILY))
+                 then
 
+                      (* ;; "Presumably a FONTSPEC.  The variables here override the FONTX properties, as with the fontdescriptor below ")

+
+                      (SETQ FONTX (CL:IF (EQ 'FONT (CAR FAMILY))
                                       (CDR FAMILY)
                                       FAMILY))
-                      (SETQ FAMILY (pop
 FONTX))
-                      (SETQ SIZE (OR (pop
 FONTX)
-                                     SIZE))
-                      (SETQ FACE (OR (pop
 FONTX)
-                                     FACE))
-                      (SETQ ROTATION (OR (pop
 FONTX)
-                                         ROTATION))
-                      (SETQ DEVICE (OR (pop
 FONTX)
-                                       DEVICE))
-                      (SETQ CHARSET (pop
 FONTX))
+                      (SETQ FAMILY (fetch
 (FONTSPEC FSFAMILY) of
 FONTX))
+                      (SETQ SIZE (OR SIZE (fetch
 (FONTSPEC FSSIZE) of
 FONTX)))
+                      (SETQ FACE (OR FACE (fetch
 (FONTSPEC FSFACE) of
 FONTX)))
+                      (SETQ ROTATION (OR ROTATION (fetch
 (FONTSPEC FSROTATION) of
 FONTX)))
+                      (SETQ DEVICE (OR DEVICE (fetch
 (FONTSPEC FSDEVICE) of
 FONTX)))
                       (SETQ FONTX NIL)
                elseif
 (SETQ FONTX (CL:IF (type?
 FONTDESCRIPTOR FAMILY)
                                       FAMILY
@@ -649,8 +688,17 @@
                       (CL:UNLESS DEVICE
                           (SETQ DEVICE (fetch
 (FONTDESCRIPTOR FONTDEVICE) of
 FONTX)))])
 
-         (* ;; "The arguments are now coerced, validate them.")

+         (* ;; "We have decoded the arguments, fill in defaults and validate")

 
+         (SETQ DEVICE (if
 (NULL DEVICE)
+                          then
 'DISPLAY
+                        elseif
 (OR (AND (LITATOM DEVICE)
+                                        (NEQ DEVICE T))
+                                   (STRINGP DEVICE))
+                          then
 (\DEVICESYMBOL
 DEVICE)
+                        elseif
 [AND (SETQ DEVICE (\GETSTREAM DEVICE 'OUTPUT T))
+                                    (CAR (MKLIST (IMAGESTREAMTYPE DEVICE]
+                        else
 (\ILLEGAL.ARG DEVICE)))
          (CL:UNLESS (AND FAMILY (LITATOM FAMILY)
                          (NEQ FAMILY T))
                 (ERROR "Illegal font family" FAMILY))
@@ -667,9 +715,6 @@
                        (IGEQ ROTATION 0))
            elseif
 (EQ ROTATION '*)
            else
 (\ILLEGAL.ARG ROTATION))
-         (CL:WHEN CHARSET
-             (CL:UNLESS (<= 0 CHARSET \MAXCHARSET)
-                    (\ILLEGAL.ARG CHARSET)))
          (CL:WHEN FONTX
 
              (* ;; "Return FONTX only if no fields were overwritten")

@@ -679,7 +724,7 @@
                              (EQ ROTATION (fetch
 (FONTDESCRIPTOR ROTATION) of
 FONTX))
                              (EQ DEVICE (fetch
 (FONTDESCRIPTOR FONTDEVICE) of
 FONTX)))
                     (SETQ FONTX NIL)))
-         (OR FONTX (LIST FAMILY SIZE FACE ROTATION DEVICE])
+         (OR FONTX (MAKEFONTSPEC
 FAMILY SIZE FACE ROTATION DEVICE])
 
 (\FONT.CHECKARGS1

   [LAMBDA (SPEC STREAM NOERRORFLG)
                           (* ; "Edited 22-Jul-2025 18:47 by rmk")


@@ -761,13 +806,14 @@
     (ERROR (CONCAT "FONTCREATE function is not specified for image-type " DEVICE])
 
 (FONTFILEP

-  [LAMBDA (FILE DEVICE)
                                      (* ; "Edited 13-Jul-2025 13:41 by rmk")


+  [LAMBDA (FILE DEVICE)
                                      (* ; "Edited 25-Aug-2025 10:22 by rmk")


+                                                             (* ; "Edited 13-Jul-2025 13:41 by rmk")


                                                              (* ; "Edited 27-Jun-2025 22:54 by rmk")

     (CL:UNLESS DEVICE
         (SETQ DEVICE 'DISPLAY))
     (RESETLST
         (if
 (EQ DEVICE 'DISPLAY)
-            then
 (for
 FNS STRM in
 (GETATOMVAL (PACK* DEVICE 'CHARSETFNS))
+            then
 (for
 FNS STRM in
 (FONTDEVICEPROP
 DEVICE 'CHARSETFNS)
                     first
 [RESETSAVE (SETQ STRM (OPENSTREAM FILE 'INPUT))
                                  `(PROGN (CLOSEF? OLDVALUE]
                     do
 (CL:WHEN (CAR (NLSETQ (APPLY* (CADR FNS)
@@ -776,7 +822,11 @@
                        (CLOSEF? STRM))))])
 
 (\READCHARSET

-  [LAMBDA (FAMILY SIZE FACE ROTATION DEVICE CHARSET)
         (* ; "Edited 21-Jul-2025 18:35 by rmk")


+  [LAMBDA (FONTSPEC CHARSET FONT)
                            (* ; "Edited  2-Sep-2025 23:57 by rmk")


+                                                             (* ; "Edited 28-Aug-2025 23:17 by rmk")


+                                                             (* ; "Edited 25-Aug-2025 12:03 by rmk")


+                                                             (* ; "Edited 16-Aug-2025 18:00 by rmk")


+                                                             (* ; "Edited 21-Jul-2025 18:35 by rmk")


                                                              (* ; "Edited 14-Jul-2025 19:51 by rmk")


                                                              (* ; "Edited 12-Jul-2025 13:20 by rmk")


                                                              (* ; "Edited 10-Jul-2025 12:38 by rmk")


@@ -784,13 +834,13 @@
 
     (* ;; "This finds the first file in the directories/extensions order that contains information about charset, determines its format, and reads it in.  The assumption is that the first such existing file is the one we want. ")

 
-    (CL:WHEN (EQ ROTATION 0)
+    (CL:WHEN (EQ 0 (fetch
 (FONTSPEC FSROTATION) of
 FONTSPEC))
         (RESETLST
-            (for
 FILE STRM CSINFO in
 (FONTFILES
 FAMILY SIZE FACE ROTATION DEVICE CHARSET)
+            (for
 FILE STRM CSINFO in
 (FONTFILES
 FONTSPEC CHARSET)
                do
 
                   (* ;; "We know that FILE exists and is the best source of information about charset--maybe none. We assume FILE is one of the valid formats, we open it separately for each format-type, and ensure it is closed on exit.  We can't used CL:WITHOPEN-FILE because that doesn't exist in the loadup when the first font is created.")

 
-                  (for
 FNS in
 (GETATOMVAL (PACK* DEVICE 'CHARSETFNS))
+                  (for
 FNS FAMILY in
 (FONTDEVICEPROP
 FONTSPEC 'CHARSETFNS)
                      do
 [RESETSAVE (SETQ STRM (OPENSTREAM FILE 'INPUT))
                                `(PROGN (CLOSEF? OLDVALUE]
                         (CL:WHEN (CAR (NLSETQ (APPLY* (CADR FNS)
@@ -799,12 +849,13 @@
                             (* ;; "Assume that predicate leaves stream (open or closed) in proper state for its retrieval function.  The FILE may be of the right type, but it may not contain this CHARSET (e.g. a complete MEDLEYFONTFILE but CHARSET doesn't exist anywhere).")

 
                             (SETQ CSINFO (APPLY* (CADDR FNS)
-                                                STRM CHARSET FAMILY SIZE FACE ROTATION DEVICE))
+                                                STRM CHARSET FONT))
                             (CL:WHEN (type?
 CHARSETINFO CSINFO)
                                 (CL:UNLESS (CHARSETPROP CSINFO 'CSCHARENCODING)
 
                                     (* ;; "The file didn't know its own encoding")

 
+                                    (SETQ FAMILY (fetch
 (FONTSPEC FSFAMILY) of
 FONTSPEC))
                                     (CHARSETPROP CSINFO 'CSCHARENCODING (if
 (NEQ CHARSET 0)
                                                                             then
 'MCCS
                                                                           elseif
 (MEMB FAMILY 
@@ -821,81 +872,247 @@
 
                                 (CHARSETPROP CSINFO 'FILE (MKSTRING (PSEUDOFILENAME FILE)))
                                 (CL:UNLESS (CHARSETPROP CSINFO 'SOURCE)
-                                    (CHARSETPROP CSINFO 'SOURCE (MAKECSSOURCE FAMILY SIZE FACE 
-                                                                       ROTATION DEVICE CHARSET)))
+                                    (CHARSETPROP CSINFO 'SOURCE (create
 FONTSPEC using
 FONTSPEC)))
+                                (replace
 (CHARSETINFO CHARSETNO) of
 CSINFO with
 CHARSET)
                                 (RETURN))) 
 
                         (* ;; "Prepare for next format-type")

 
                         (CLOSEF? STRM))
                   (CL:WHEN CSINFO (RETURN CSINFO)))))])
+)
+(DEFINEQ
 
-(\COERCEFONTSPEC

-  [LAMBDA (COERCIONS FAMILY SIZE FACE ROTATION DEVICE CHARSET)

-                                                             (* ; "Edited 23-Jul-2025 15:39 by rmk")

+(\FONT.CHECKARGS

+  [LAMBDA (FAMILY SIZE FACE ROTATION DEVICE)
                 (* ; "Edited 28-Aug-2025 14:46 by rmk")


+                                                             (* ; "Edited 23-Aug-2025 11:54 by rmk")


+                                                             (* ; "Edited 17-Aug-2025 19:15 by rmk")


+                                                             (* ; "Edited 12-Aug-2025 22:36 by rmk")


+                                                             (* ; "Edited 10-Aug-2025 12:06 by rmk")


+                                                             (* ; "Edited  8-Aug-2025 09:57 by rmk")


+                                                             (* ; "Edited 27-Jul-2025 13:30 by rmk")


+                                                             (* ; "Edited 22-Jul-2025 23:07 by rmk")


+                                                             (* ; "Edited 21-Jul-2025 09:22 by rmk")


+                                                             (* ; "Edited 14-Jul-2025 20:09 by rmk")


+                                                             (* ; "Edited 11-Jul-2025 10:15 by rmk")


+                                                             (* ; "Edited  5-Jul-2025 13:37 by rmk")


+                                                             (* ; "Edited  2-Jul-2025 16:50 by rmk")


+                                                             (* ; "Edited 27-Jun-2025 10:42 by rmk")


+                                                             (* ; "Edited 15-Jun-2025 00:25 by rmk")

 
-    (* ;; "Produces a list of coerced fontspecs, one for each coercion whose right side matches the given parameters.")

-
-    (* ;; "If MFAMILY is NIL, use FAMILY--default when nothing else matches.")

-
-    (for
 C MATCH TARGET MFAMILY MSIZE TFAMILY TSIZE COERCED in
 COERCIONS
-       eachtime
 (SETQ MATCH (CAR C))
-             (if
 (LISTP MATCH)
-                 then
 (SETQ MFAMILY (OR (CAR MATCH)
-                                        FAMILY))
-                      (SETQ MSIZE (OR (CADR MATCH)
-                                      SIZE))
-               else
 (SETQ MFAMILY (OR MATCH FAMILY))
-                    (SETQ MSIZE SIZE)) when
 [AND (EQ FAMILY MFAMILY)
-                                                 (EQ SIZE MSIZE)
-                                                 (PROGN (SETQ TARGET (CADR C))
-                                                             (* ; 
-
                                "Don't include the input in the output, if the coercions have a loop")

-                                                        (if
 (LISTP TARGET)
-                                                            then
 (SETQ TFAMILY (OR (CAR TARGET)
-                                                                                   FAMILY))
-                                                                 (SETQ TSIZE (OR (CADR TARGET)
-                                                                                 SIZE))
-                                                          else
 (SETQ TFAMILY TARGET)
-                                                               (SETQ TSIZE SIZE))
-                                                        (NOT (AND (EQ FAMILY TFAMILY)
-                                                                  (EQ SIZE TSIZE]
-       unless
 (MEMBER (SETQ COERCED (LIST TFAMILY TSIZE FACE ROTATION DEVICE CHARSET))
-                     $$VAL) collect
 COERCED])
+    (* ;; "DON'T BREAK, TRACE, OR UNSAVE THIS UNLESS ALL SYSTEM FONTS HAVE ALREADY BEEN INSTANTIATED")

+
+    (* ;; "Decodes and checks the various ways of specifying the arguments to font lookup functions.")

+
+    (* ;; "If FAMILY can be coerced to a font descriptor and none of its properties are overwritten by the other aguments, then that font descriptor is returned.  Otherwise the value is the coerced fontspec (family size face rotation device).")

+
+    (LET (FONTX)
+         (CL:WHEN (AND (EQ 'CLASS (CAR (LISTP FAMILY)))
+                       (LITATOM (CADR FAMILY)))
+
+             (* ;; "This used to be at the entry to FONTCREATE, and it returned the FONTCLASS.  That seemed wrong--FONTCREATE should always return a fontdescriptor.  So here we build a throwaway fontclass, coerce it to its device font, and fall through.")

+
+             (SETQ FAMILY (\FONT.CHECKARGS1
 (FONTCLASS
 (CADR FAMILY)
+                                                   (CDDR FAMILY))
+                                 DEVICE)))
+         (CL:UNLESS (AND FAMILY (LITATOM FAMILY)
+                         (NEQ FAMILY T))
+
+             (* ;; "FAMILY T or NIL produces an error below")

+
+             [if
 (LISTP FAMILY)
+                 then
 
+                      (* ;; "Presumably a FONTSPEC.  The variables here override the FONTX properties, as with the fontdescriptor below ")

+
+                      (SETQ FONTX (CL:IF (EQ 'FONT (CAR FAMILY))
+                                      (CDR FAMILY)
+                                      FAMILY))
+                      (SETQ FAMILY (fetch
 (FONTSPEC FSFAMILY) of
 FONTX))
+                      (SETQ SIZE (OR SIZE (fetch
 (FONTSPEC FSSIZE) of
 FONTX)))
+                      (SETQ FACE (OR FACE (fetch
 (FONTSPEC FSFACE) of
 FONTX)))
+                      (SETQ ROTATION (OR ROTATION (fetch
 (FONTSPEC FSROTATION) of
 FONTX)))
+                      (SETQ DEVICE (OR DEVICE (fetch
 (FONTSPEC FSDEVICE) of
 FONTX)))
+                      (SETQ FONTX NIL)
+               elseif
 (SETQ FONTX (CL:IF (type?
 FONTDESCRIPTOR FAMILY)
+                                      FAMILY
+                                      (\FONT.CHECKARGS1
 FAMILY DEVICE T)))
+                 then
 
+                      (* ;; 
+
                    "FAMILY was a spec for a font descriptor. Are any of its properties overwritten?")

+
+                      (SETQ FAMILY (fetch
 (FONTDESCRIPTOR FONTFAMILY) of
 FONTX))
+                      (CL:UNLESS SIZE
+                          (SETQ SIZE (fetch
 (FONTDESCRIPTOR FONTSIZE) of
 FONTX)))
+                      (CL:UNLESS FACE
+                          (SETQ FACE (fetch
 (FONTDESCRIPTOR FONTFACE) of
 FONTX)))
+                      (CL:UNLESS ROTATION
+                          (SETQ ROTATION (fetch
 (FONTDESCRIPTOR ROTATION) of
 FONTX)))
+                      (CL:UNLESS DEVICE
+                          (SETQ DEVICE (fetch
 (FONTDESCRIPTOR FONTDEVICE) of
 FONTX)))])
+
+         (* ;; "We have decoded the arguments, fill in defaults and validate")

+
+         (SETQ DEVICE (if
 (NULL DEVICE)
+                          then
 'DISPLAY
+                        elseif
 (OR (AND (LITATOM DEVICE)
+                                        (NEQ DEVICE T))
+                                   (STRINGP DEVICE))
+                          then
 (\DEVICESYMBOL
 DEVICE)
+                        elseif
 [AND (SETQ DEVICE (\GETSTREAM DEVICE 'OUTPUT T))
+                                    (CAR (MKLIST (IMAGESTREAMTYPE DEVICE]
+                        else
 (\ILLEGAL.ARG DEVICE)))
+         (CL:UNLESS (AND FAMILY (LITATOM FAMILY)
+                         (NEQ FAMILY T))
+                (ERROR "Illegal font family" FAMILY))
+         (SETQ FAMILY (U-CASE FAMILY))
+         (CL:UNLESS (OR (AND (FIXP SIZE)
+                             (IGREATERP SIZE 0))
+                        (EQ SIZE '*))
+                (ERROR "Illegal font size" SIZE))
+         (CL:UNLESS (EQ FACE '*)
+             (SETQ FACE (\FONTFACE
 FACE NIL DEVICE)))
+         (if
 (NULL ROTATION)
+             then
 (SETQ ROTATION 0)
+           elseif
 (AND (FIXP ROTATION)
+                       (IGEQ ROTATION 0))
+           elseif
 (EQ ROTATION '*)
+           else
 (\ILLEGAL.ARG ROTATION))
+         (CL:WHEN FONTX
+
+             (* ;; "Return FONTX only if no fields were overwritten")

+
+             (CL:UNLESS (AND (EQ SIZE (fetch
 (FONTDESCRIPTOR FONTSIZE) of
 FONTX))
+                             (EQUAL FACE (fetch
 (FONTDESCRIPTOR FONTFACE) of
 FONTX))
+                             (EQ ROTATION (fetch
 (FONTDESCRIPTOR ROTATION) of
 FONTX))
+                             (EQ DEVICE (fetch
 (FONTDESCRIPTOR FONTDEVICE) of
 FONTX)))
+                    (SETQ FONTX NIL)))
+         (OR FONTX (MAKEFONTSPEC
 FAMILY SIZE FACE ROTATION DEVICE])
+
+(\CHARSET.CHECK

+  [LAMBDA (CHARSET)
                                          (* ; "Edited 28-Aug-2025 14:35 by rmk")

+    (if
 CHARSET
+        then
 (CHARSET.DECODE (CL:IF (LISTP CHARSET)
+                                 (CAR CHARSET)
+                                 CHARSET))
+      else
 0])
 )
 (DEFINEQ
 
-(\COERCEFONTDESC

-  [LAMBDA (SPEC STREAM NOERRORFLG)
                           (* ; "Edited 27-Jul-2025 13:38 by rmk")


-                                                             (* ; "Edited 22-Jul-2025 18:47 by rmk")


-                                                             (* ; "Edited 14-Jul-2025 19:40 by rmk")


-                                                             (* ; "Edited  5-Jul-2025 14:16 by rmk")


-                                                             (* ; "Edited 29-Aug-91 12:19 by jds")

+(COERCEFONTSPEC

+  [LAMBDA (FONTSPEC COERCIONS)
                               (* ; "Edited  5-Oct-2025 09:41 by rmk")


+                                                             (* ; "Edited 28-Aug-2025 14:41 by rmk")


+                                                             (* ; "Edited 25-Aug-2025 10:22 by rmk")


+                                                             (* ; "Edited 17-Aug-2025 19:15 by rmk")


+                                                             (* ; "Edited 16-Aug-2025 17:47 by rmk")


+                                                             (* ; "Edited 12-Aug-2025 12:30 by rmk")


+                                                             (* ; "Edited 10-Aug-2025 12:03 by rmk")


+                                                             (* ; "Edited  5-Aug-2025 17:27 by rmk")


+                                                             (* ; "Edited 23-Jul-2025 15:39 by rmk")

+
+    (* ;; "Produces a list of coerced fontspecs, one for each coercion whose right side matches the given FONTSPEC parameters.")

+
+    (* ;; "Doesn't make sense to coerce the device, DEVICE and also CHARSET are just carried along.")

+
+    (* ;; "A NIL match component matches everything, and a NIL target component denotes the corresponding argument.")

+
+    (for
 C MATCH TARGET MFAMILY MSIZE MFACE MROTATION TFAMILY TSIZE TFACE TROTATION COERCED FAMILY 
+         SIZE FACE ROTATION DEVICE in
 (OR COERCIONS (FONTDEVICEPROP
 FONTSPEC 'FONTCOERCIONS))
+       first
 (SPREADFONTSPEC FONTSPEC) eachtime
 (SETQ MATCH (MKLIST (CAR C)))
+       when
 [AND (COERCEFONTSPEC.MATCH (pop
 MATCH)
+                        FAMILY)
+                 (COERCEFONTSPEC.MATCH (pop
 MATCH)
+                        SIZE)
+                 (MATCHFONTFACE
 (\FONTFACE
 (OR (pop
 MATCH)
+                                               '*))
+                        FACE)
+                 (COERCEFONTSPEC.MATCH (CAR MATCH)
+                        ROTATION)
+                 (PROGN (SETQ TARGET (MKLIST (CADR C)))
+                        (SETQ TFAMILY (COERCEFONTSPEC.TARGET (pop
 TARGET)
+                                             FAMILY))
+                        (SETQ TSIZE (COERCEFONTSPEC.TARGET (pop
 TARGET)
+                                           SIZE))
+                        (SETQ TFACE (COERCEFONTSPEC.TARGET (pop
 TARGET)
+                                           FACE))
+                        (SETQ TROTATION (COERCEFONTSPEC.TARGET ROTATION (pop
 TARGET)))
+
+                        (* ;; "Don't include the input in the output, if the coercions have a loop")

+
+                        (NOT (AND (EQ FAMILY TFAMILY)
+                                  (EQ SIZE TSIZE)
+                                  (EQUAL FACE TFACE)
+                                  (EQ ROTATION TROTATION]
+       unless
 (MEMBER (SETQ COERCED (MAKEFONTSPEC
 TFAMILY TSIZE TFACE TROTATION DEVICE))
+                     $$VAL) collect
 COERCED])
+)
+(DECLARE%: EVAL@COMPILE DONTCOPY 
+(DECLARE%: EVAL@COMPILE 
 
-    (* ;; "It was intended to remove this function in favor of FONTCREATE as FONT was cleaned up to avoid stack overflows in certain situations.  The calls in system code have been replaced, but the macros for FONTASCENT, FONTDESCENT, and FONTHEIGHT were putting out calls.  So there may be calls in user code that still has compiled references.")

+(PUTPROPS COERCEFONTSPEC.MATCH
 MACRO
 [(M F)                  (* ; "* can't be car--comment")

+                                      (LET ((MM M)
+                                            *
)
+                                           (DECLARE
 (LOCALVARS MM)
+                                                  (SPECVARS *
))
+                                           (SETQ *
 F)
+                                           (OR (EQ *
 MM)
+                                               (MEMB MM '(NIL *
))
+                                               (AND (LISTP MM)
+                                                    (EVAL MM])
+
+(PUTPROPS COERCEFONTSPEC.TARGET
 MACRO

+          (OPENLAMBDA (TG F)
+            (if
 (MEMB TG '(NIL *
))
+                then
 F
+              elseif
 (AND (LISTP TG)
+                          (LET (VAL *
)
+                               (DECLARE
 (LOCALVARS VAL)
+                                      (SPECVARS *
))          (* ; "* Can't be car--comment")

+                               (SETQ *
 F)
+                               (SETQ VAL (EVAL TG))
+                               (CL:IF (MEMB VAL '(NIL *
))
+                                   F
+                                   VAL)))
+              else
 TG)))
+)
+)
+(DECLARE%: EVAL@COMPILE 
 
-    (* ;; "Those macro calls all had NIL for STREAM and NOERRORFLG. So here we give a dummy definition that just calls FONTCREATE")

+(PUTPROPS SPREADFONTSPEC
 MACRO
 [(FONTSPEC)
+                                (LET ((FS FONTSPEC))
 
-    (* ;; "We probably should put out a macro to compile \COERCEFONTDESC away.")

+                                     (* ;; "Unwrap a FONTSPEC sequentially")

 
-    (FONTCREATE
 SPEC])
+                                     (CL:WHEN (type?
 FONTDESCRIPTOR FS)
+                                         (SETQ FS (FONTPROP
 FS 'SPEC)))
+                                     (SETQ FAMILY (pop
 FS))
+                                     (SETQ SIZE (pop
 FS))
+                                     (SETQ FACE (pop
 FS))
+                                     (SETQ ROTATION (pop
 FS))
+                                     (SETQ DEVICE (pop
 FS])
 )
-(DECLARE%: EVAL@COMPILE 
+(DEFINEQ
+
+(MAKEFONTSPEC

+  [LAMBDA (FAMILY SIZE FACE ROTATION DEVICE)
                 (* ; "Edited 28-Aug-2025 14:32 by rmk")


+                                                             (* ; "Edited 17-Aug-2025 20:44 by rmk")

 
-(PUTPROPS SPREADFONTSPEC
 MACRO
 (OPENLAMBDA (FONTSPEC)
-                                 (CL:WHEN (type?
 FONTDESCRIPTOR FONTSPEC)
-                                     (SETQ FONTSPEC (FONTPROP
 FONTSPEC 'SPEC)))
-                                 (SETQ SIZE (CADR FONTSPEC))
-                                 (SETQ FACE (CADDR FONTSPEC))
-                                 (SETQ ROTATION (CADDDR FONTSPEC))
-                                 (SETQ DEVICE (CAR (CDDDDR FONTSPEC)))
-                                 (SETQ CHARSET (CADR (CDDDDR FONTSPEC)))
-                                 (SETQ FAMILY (CAR FONTSPEC))))
+    (* ;; "This is a function, not a macro, so that it can be used in the loadup sequence to create the FONTSPEC for the \GUARANTEEDDISPLAYFONT.  That font is created by \CREATEFONT and therefore is not dependent on \FONT.CHECKARGS or on the multi-alist multi-key indexing functions.  The strategy might change if MULTI-ALIST is moved earlier in the loadup sequence.")

+
+    (create
 FONTSPEC
+           FSFAMILY _ FAMILY
+           FSSIZE _ SIZE
+           FSFACE _ FACE
+           FSROTATION _ ROTATION
+           FSDEVICE _ DEVICE])
 )
 (DEFINEQ
 
 (COMPLETE.FONT

-  [LAMBDA (FONTSPEC EVENIFCOMPLETE)
                          (* ; "Edited 21-Jun-2025 11:37 by rmk")


+  [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")


+                                                             (* ; "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")


@@ -906,29 +1123,35 @@
 
     (* ;; "This returns a FONTDESCRIPTOR for FONTSPEC that is complete with respect to all known character sources.  A caller that wants to insure that only files sources are considered should reset \FONTSINCORE and \FONTEXISTS?-CACHE. If reset, we still get the benefit of previous completions/coercions in this run if medleyfont files have been created for them.")

 
-    (LET ((FONT (FONTCREATE
 FONTSPEC)))                      (* ; 
-
                                               "This will pick up FAMILY/SIZE...properties from FONT")

+    (LET ((FONT (FONTCREATE
 FONTSPEC)))
+         (SETQ FONTSPEC (FONTPROP
 FONT 'SPEC))               (* ; "Normalized version")

          (CL:WHEN (OR EVENIFCOMPLETE (NOT (fetch
 (FONTDESCRIPTOR FONTCOMPLETEP) of
 FONT)))
-             (for
 CS from
 0 to
 \MAXCHARSET do
 
-                                              (* ;; 
-
       "Skips existing charsets--they already have as much information as they are ever going to get")

-
-                                              (\INSURECHARSETINFO CS 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))
-         (PRUNEFONTSLUGS
 FONT)
+         (PRUNESLUGCSINFOS
 FONT)
          FONT])
 
 (COMPLETEFONTP

-  [LAMBDA (FONT)
                                             (* ; "Edited 24-May-2025 20:55 by rmk")


+  [LAMBDA (FONT)
                                             (* ; "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
 (\XGETCHARSETINFO FONT CS])
+    (for
 CS from
 0 to
 \MAXCHARSET always
 (\GETCHARSETINFO FONT CS])
 
 (COMPLETE.CHARSET

-  [LAMBDA (CSINFO FAMILY SIZE FACE ROTATION DEVICE CHARSET COERCIONS FONTDESC)

+  [LAMBDA (CSINFO FONTSPEC CHARSET FONT)
                     (* ; "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")


+                                                             (* ; "Edited 17-Aug-2025 11:47 by rmk")


                                                              (* ; "Edited 12-Jul-2025 13:15 by rmk")


                                                              (* ; "Edited 10-Jul-2025 12:38 by rmk")


                                                              (* ; "Edited  9-Jul-2025 09:12 by rmk")


@@ -937,29 +1160,35 @@
                                                              (* ; "Edited  8-Jun-2025 20:20 by rmk")


                                                              (* ; "Edited  7-Jun-2025 13:52 by rmk")

 
-    (* ;; "CSINFO 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 CHARSET in the font described by FAMILY SIZE...  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.")

+    (* ;; "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.")

 
+    (\SETCHARSETINFO FONT CHARSET CSINFO)
     (CL:UNLESS (fetch
 (CHARSETINFO CSCOMPLETEP) of
 CSINFO)
-        [for
 THINCODE SOURCECSINFO GLYPHADDED from
 0 to
 \MAXTHINCHAR
-           when
 (AND (SLUGCHARP.DISPLAY
 THINCODE CSINFO)
-                     (SETQ SOURCECSINFO (\COERCECHARSET
 FAMILY SIZE FACE ROTATION DEVICE CHARSET 
-                                               COERCIONS THINCODE)))
-           do
 (\MOVEFONTCHAR
 SOURCECSINFO CSINFO THINCODE THINCODE FONTDESC)
-              (SETQ GLYPHADDED T) finally
 (CL:WHEN GLYPHADDED(* ; "The source is now here")

-                                              (CHARSETPROP CSINFO 'SOURCE
-                                                     (MAKECSSOURCE FAMILY SIZE FACE ROTATION DEVICE 
-                                                            CHARSET)))]
-        (replace
 (CHARSETINFO CSCOMPLETEP) of
 CSINFO with
 T))
+        (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)        (* ; 
+
                                                             "Maybe coercions are just being delayed")

+            (replace
 (CHARSETINFO CSCOMPLETEP) of
 CSINFO with
 T)))
     CSINFO])
 
-(PRUNEFONTSLUGS

-  [LAMBDA (FONT)
                                             (* ; "Edited  9-Jun-2025 15:02 by rmk")


+(PRUNESLUGCSINFOS

+  [LAMBDA (FONT)
                                             (* ; "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")

+
     (SETQ FONT (FONTCREATE
 FONT))
-    (for
 CS CSINFO from
 0 to
 \MAXCHARSET when
 (AND (SETQ CSINFO (\XGETCHARSETINFO FONT CS))
+    (for
 CS CSINFO from
 0 to
 \MAXCHARSET when
 (AND (SETQ CSINFO (\GETCHARSETINFO FONT CS))
                                                    (fetch
 (CHARSETINFO CSSLUGP) of
 CSINFO))
-       do
 (\SETCHARSETINFO (fetch
 (FONTDESCRIPTOR FONTCHARSETVECTOR) of
 FONT)
-                 CS NIL))
+       do
 (\SETCHARSETINFO FONT CS NIL))
     FONT])
 )
 
@@ -989,7 +1218,10 @@
     (fetch
 (FONTDESCRIPTOR \SFHeight) of
 (FONTCREATE
 FONTSPEC])
 
 (FONTPROP

-  [LAMBDA (FONT PROP)
                                        (* ; "Edited 23-Jul-2025 17:01 by rmk")


+  [LAMBDA (FONT PROP)
                                        (* ; "Edited  2-Sep-2025 22:21 by rmk")


+                                                             (* ; "Edited 12-Aug-2025 21:10 by rmk")


+                                                             (* ; "Edited 10-Aug-2025 13:28 by rmk")


+                                                             (* ; "Edited 23-Jul-2025 17:01 by rmk")


                                                              (* ; "Edited 13-Jul-2025 22:44 by rmk")


                                                              (* ; "Edited  8-Jun-2025 20:42 by rmk")


                                                              (* ; "Edited 24-May-2025 07:40 by rmk")


@@ -1015,56 +1247,51 @@
         (DEVICE (ffetch
 FONTDEVICE of
 FONT))
         (CHARENCODING [OR (ffetch
 FONTCHARENCODING of
 FONT)
                           (freplace
 FONTCHARENCODING of
 FONT
-                             with
 (if
 (NEQ CHARSET 0)
-                                      then
 'MCCS
-                                    elseif
 (MEMB (fetch
 (FONTDESCRIPTOR FONTFAMILY) of
 FONT)
-                                                 NSFONTFAMILIES)
+                             with
 (if
 (MEMB (fetch
 (FONTDESCRIPTOR FONTFAMILY) of
 FONT)
+                                            NSFONTFAMILIES)
                                       then
 'XCCS$
                                     elseif
 (MEMB (fetch
 (FONTDESCRIPTOR FONTFAMILY) of
 FONT)
                                                  ALTOFONTFAMILIES)
                                       then
 'ALTOTEXT
                                     else
 (fetch
 (FONTDESCRIPTOR FONTFAMILY) of
 FONT])
-        (SPEC (LIST (ffetch
 FONTFAMILY of
 FONT)
-                    (ffetch
 FONTSIZE of
 FONT)
-                    (COPY (ffetch
 FONTFACE of
 FONT))
-                    (ffetch
 ROTATION of
 FONT)
-                    (ffetch
 FONTDEVICE of
 FONT)))
+        (SPEC (create
 FONTSPEC
+                     FSFAMILY _ (ffetch
 FONTFAMILY of
 FONT)
+                     FSSIZE _ (ffetch
 FONTSIZE of
 FONT)
+                     FSFACE _ (COPY (ffetch
 FONTFACE of
 FONT))
+                     FSROTATION _ (ffetch
 ROTATION of
 FONT)
+                     FSDEVICE _ (ffetch
 FONTDEVICE of
 FONT)))
         (DEVICESPEC                                          (* ; 
 
                    "DEVICE fields are for communicating coercions to the particular printing device")

-                    [COND
-                       ((ffetch
 FONTDEVICESPEC of
 FONT)
-                        (COPY (ffetch
 FONTDEVICESPEC of
 FONT)))
-                       (T (FONTPROP
 FONT 'SPEC])
-        (DEVICEFACE [COPY (COND
-                             ((ffetch
 FONTDEVICESPEC of
 FONT)
-                              (CADDR (ffetch
 FONTDEVICESPEC of
 FONT)))
-                             (T (ffetch
 FONTFACE of
 FONT])
-        (DEVICESLOPE [fetch
 SLOPE of
 (COND
-                                        ((ffetch
 FONTDEVICESPEC of
 FONT)
-                                         (CADDR (ffetch
 FONTDEVICESPEC of
 FONT)))
-                                        (T (ffetch
 FONTFACE of
 FONT])
-        (DEVICEWEIGHT [fetch
 WEIGHT of
 (COND
-                                          ((ffetch
 FONTDEVICESPEC of
 FONT)
-                                           (CADDR (ffetch
 FONTDEVICESPEC of
 FONT)))
-                                          (T (ffetch
 FONTFACE of
 FONT])
+                    (CL:IF (ffetch
 FONTDEVICESPEC of
 FONT)
+                        (COPY (ffetch
 FONTDEVICESPEC of
 FONT))
+                        (FONTPROP
 FONT 'SPEC)))
+        (DEVICEFAMILY (CL:IF (ffetch
 FONTDEVICESPEC of
 FONT)
+                          (fetch
 (FONTSPEC FSFAMILY) of
 (ffetch
 FONTDEVICESPEC of
 FONT))
+                          (ffetch
 FONTFAMILY of
 FONT)))
+        (DEVICESIZE (CL:IF (ffetch
 FONTDEVICESPEC of
 FONT)
+                        (fetch
 (FONTSPEC FSSIZE) of
 (ffetch
 FONTDEVICESPEC of
 FONT))
+                        (ffetch
 FONTSIZE of
 FONT)))
+        (DEVICEFACE (COPY (CL:IF (ffetch
 FONTDEVICESPEC of
 FONT)
+                              (fetch
 (FONTSPEC FSFACE) of
 (ffetch
 FONTDEVICESPEC of
 FONT))
+                              (ffetch
 FONTFACE of
 FONT))))
+        (DEVICESLOPE (fetch
 SLOPE of
 (CL:IF (ffetch
 FONTDEVICESPEC of
 FONT)
+                                         (fetch
 (FONTSPEC FSFACE) of
 (ffetch
 FONTDEVICESPEC
+                                                                        of
 FONT))
+                                         (ffetch
 FONTFACE of
 FONT))))
+        (DEVICEWEIGHT (fetch
 WEIGHT of
 (CL:IF (ffetch
 FONTDEVICESPEC of
 FONT)
+                                           (fetch
 (FONTSPEC FSFACE) of
 (ffetch
 FONTDEVICESPEC
+                                                                          of
 FONT))
+                                           (ffetch
 FONTFACE of
 FONT))))
         (DEVICEEXPANSION 
-             [fetch
 EXPANSION of
 (COND
-                                    ((ffetch
 FONTDEVICESPEC of
 FONT)
-                                     (CADDR (ffetch
 FONTDEVICESPEC of
 FONT)))
-                                    (T (ffetch
 FONTFACE of
 FONT])
-        (DEVICESIZE (COND
-                       ((ffetch
 FONTDEVICESPEC of
 FONT)
-                        (CADR (ffetch
 FONTDEVICESPEC of
 FONT)))
-                       (T (ffetch
 FONTSIZE of
 FONT))))
-        (DEVICEFAMILY (COND
-                         ((ffetch
 FONTDEVICESPEC of
 FONT)
-                          (CAR (ffetch
 FONTDEVICESPEC of
 FONT)))
-                         (T (ffetch
 FONTFAMILY of
 FONT))))
+             (fetch
 EXPANSION of
 (CL:IF (ffetch
 FONTDEVICESPEC of
 FONT)
+                                     (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))
+        (FONTTOMCCSFN (ffetch
 FONTTOMCCSFN of
 FONT))
         (\ILLEGAL.ARG PROP])
 
 (\AVGCHARWIDTH

@@ -1082,19 +1309,55 @@
              then
 W
            else
 1])
 )
+(* "FOLLOWING DEFINITIONS EXPORTED")
+(DEFOPTIMIZER FONTPROP
 (&REST ARGS)
+                       (SELECTQ (AND (EQ (CAADR ARGS)
+                                         'QUOTE)
+                                     (CADADR ARGS))
+                           (ASCENT `(FONTASCENT
 ,(CAR ARGS)))
+                           (DESCENT `(FONTDESCENT
 ,(CAR ARGS)))
+                           (HEIGHT `(FONTHEIGHT
 ,(CAR ARGS)))
+                           (FONTTOMCCSFN `(fetch
 (FONTDESCRIPTOR FONTTOMCCSFN)
+                                             of
 ,(CAR ARGS)))
+                           'IGNOREMACRO))
+
+(* "END EXPORTED DEFINITIONS")
+
+(DEFINEQ
+
+(FONTDEVICEPROP

+  [LAMBDA (FONTDEVICE PROP)
                                  (* ; "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])
+)
 
 
 
-(* ;; "Moving character information")

+(* ; "Moving character information")

 
 (DEFINEQ
 
 (EDITCHAR

-  [LAMBDA (CHARCODE FONT)
                                    (* ; "Edited 14-Jul-2025 22:54 by rmk")


+  [LAMBDA (CHARCODE FONT)
                                    (* ; "Edited 28-Aug-2025 23:50 by rmk")


+                                                             (* ; "Edited 14-Jul-2025 22:54 by rmk")


                                                              (* ; "Edited  5-Jul-2025 18:47 by rmk")

                                                              (* rrb "24-MAR-82 12:22")

                                                              (* ; 
 
                                                   "calls the bitmap editor on a character of a font")

+    (SETQ CHARCODE (OR (CHARCODEP CHARCODE)
+                       (CHARCODE.DECODE CHARCODE)))
     (LET ((FONTDESC (FONTCREATE
 FONT)))
          (PUTCHARBITMAP
 CHARCODE FONTDESC (EDITBM (GETCHARBITMAP
 CHARCODE FONTDESC])
 )
@@ -1106,19 +1369,24 @@
 (DEFINEQ
 
 (GETCHARBITMAP

-  [LAMBDA (CHARCODE FONT)
                                    (* ; "Edited  7-Jun-2025 09:55 by rmk")


+  [LAMBDA (CHARCODE FONT)
                                    (* ; "Edited 30-Aug-2025 23:19 by rmk")


+                                                             (* ; "Edited  3-Aug-2025 13:28 by rmk")


+                                                             (* ; "Edited  7-Jun-2025 09:55 by rmk")


                                                              (* ; "Edited 22-May-2025 09:52 by rmk")


                                                              (* ; "Edited 25-Apr-2025 11:21 by rmk")


                                                              (* ; "Edited 26-Apr-89 21:49 by atm")

                                                              (* ; 
 
                      "returns a bitmap of the character CHARCODE from the font descriptor FONTDESC.")

-    (SETQ CHARCODE (CHARCODE.DECODE CHARCODE))
+    (SETQ CHARCODE (CL:IF (CHARCODEP CHARCODE)
+                       CHARCODE
+                       (CHARCODE.DECODE CHARCODE)))
     (\GETCHARBITMAP.CSINFO
 (\CHAR8CODE CHARCODE)
-           (\INSURECHARSETINFO (\CHARSET CHARCODE)
-                  (FONTCREATE
 FONT])
+           (\INSURECHARSETINFO (FONTCREATE
 FONT)
+                  (\CHARSET CHARCODE])
 
 (PUTCHARBITMAP

-  [LAMBDA (CHARCODE FONT NEWCHARBITMAP NEWCHARDESCENT)
       (* ; "Edited  7-Jun-2025 10:16 by rmk")


+  [LAMBDA (CHARCODE FONT NEWCHARBITMAP NEWCHARDESCENT)
       (* ; "Edited 30-Aug-2025 23:20 by rmk")


+                                                             (* ; "Edited  7-Jun-2025 10:16 by rmk")


                                                              (* ; "Edited 25-May-2025 15:10 by rmk")


                                                              (* ; "Edited 22-May-2025 09:56 by rmk")


                                                              (* ; "Edited  1-May-2025 13:21 by rmk")


@@ -1131,8 +1399,7 @@
            (\ILLEGAL.ARG NEWCHARBITMAP))
     (SETQ CHARCODE (CHARCODE.DECODE CHARCODE))
     (SETQ FONT (FONTCREATE
 FONT))
-    (LET ((CSINFO (\INSURECHARSETINFO (\CHARSET CHARCODE)
-                         FONT)))
+    (LET [(CSINFO (\INSURECHARSETINFO FONT (\CHARSET CHARCODE]
          (UNINTERRUPTABLY
              (CL:WHEN (\PUTCHARBITMAP.CSINFO
 (\CHAR8CODE CHARCODE)
                              CSINFO NEWCHARBITMAP NEWCHARDESCENT)
@@ -1149,7 +1416,8 @@
          NIL NEWCHARBITMAP])
 
 (\GETCHARBITMAP.CSINFO

-  [LAMBDA (CODE CSINFO)
                                      (* ; "Edited  7-Jun-2025 09:56 by rmk")


+  [LAMBDA (CODE CSINFO)
                                      (* ; "Edited  3-Aug-2025 20:59 by rmk")


+                                                             (* ; "Edited  7-Jun-2025 09:56 by rmk")


                                                              (* ; "Edited 22-May-2025 09:52 by rmk")


                                                              (* ; "Edited 25-Apr-2025 11:21 by rmk")


                                                              (* ; "Edited 26-Apr-89 21:49 by atm")

@@ -1177,7 +1445,8 @@
          CBM])
 
 (\PUTCHARBITMAP.CSINFO

-  [LAMBDA (CODE CSINFO NEWCHARBITMAP NEWCHARDESCENT)
         (* ; "Edited  7-Jun-2025 10:15 by rmk")


+  [LAMBDA (THINCODE CSINFO NEWCHARBITMAP NEWCHARDESCENT)
     (* ; "Edited 24-Aug-2025 09:56 by rmk")


+                                                             (* ; "Edited  7-Jun-2025 10:15 by rmk")


                                                              (* ; "Edited 25-May-2025 15:10 by rmk")


                                                              (* ; "Edited 22-May-2025 09:56 by rmk")


                                                              (* ; "Edited  1-May-2025 13:21 by rmk")


@@ -1192,8 +1461,8 @@
            (OFFSETS (fetch
 (CHARSETINFO OFFSETS) of
 CSINFO))
            (WIDTHS (fetch
 (CHARSETINFO WIDTHS) of
 CSINFO))
            (IMWIDTHS (fetch
 (CHARSETINFO IMAGEWIDTHS) of
 CSINFO))
-           (CIMWIDTH (AND IMWIDTHS (\FGETIMAGEWIDTH IMWIDTHS CODE)))
-           (CWIDTH (OR CIMWIDTH (\FGETWIDTH WIDTHS CODE)))
+           (CIMWIDTH (AND IMWIDTHS (\FGETIMAGEWIDTH IMWIDTHS THINCODE)))
+           (CWIDTH (OR CIMWIDTH (\FGETWIDTH WIDTHS THINCODE)))
            (FONTBITMAP (fetch
 (CHARSETINFO CHARSETBITMAP) of
 CSINFO))
            (OFWIDTH (fetch
 (BITMAP BITMAPWIDTH) of
 FONTBITMAP))
            TEMPBITMAP BWIDTH DW BHEIGHT BASCENT BDESCENT NDESCENT NASCENT NHEIGHT CHAROFFSET
@@ -1208,11 +1477,11 @@
           (SETQ NDESCENT (IMAX BDESCENT CDESCENT))
           (SETQ NASCENT (IMAX BASCENT CASCENT))
           (SETQ NHEIGHT (IPLUS NDESCENT NASCENT))
-          (SETQ CHAROFFSET (\FGETOFFSET OFFSETS CODE))
+          (SETQ CHAROFFSET (\FGETOFFSET OFFSETS THINCODE))
 
           (* ;; "set up a new target bitmap if any of the parameters have changed.")

 
-          (if
 (EQ CHAROFFSET (\FGETOFFSET OFFSETS \MAXTHINCHAR))
+          (if
 (EQ CHAROFFSET (\FGETOFFSET OFFSETS SLUGCHARINDEX))
               then
 
                    (* ;; "changing the bitmap for a character which formerly pointed at the slug character.  Allocate a new bitmap character bitmap for this.")

 
@@ -1262,14 +1531,14 @@
               (UNINTERRUPTABLY
                                                              (* ; 
 
                                                      "update the parameters for this character set.")

-                  (\FSETWIDTH WIDTHS CODE BWIDTH)            (* ; "The new character's correct width")

+                  (\FSETWIDTH WIDTHS THINCODE BWIDTH)        (* ; "The new character's correct width")

                                                              (* ; 
 
                                                          "Make sure that we update imagewidths also")

-                  (CL:WHEN IMWIDTHS (\FSETIMAGEWIDTH IMWIDTHS CODE BWIDTH))
-                  (\FSETOFFSET OFFSETS CODE CHAROFFSET)
+                  (CL:WHEN IMWIDTHS (\FSETIMAGEWIDTH IMWIDTHS THINCODE BWIDTH))
+                  (\FSETOFFSET OFFSETS THINCODE CHAROFFSET)
                   (CL:WHEN DW
-                      (for
 I from
 0 to
 \MAXTHINCHAR when
 (IGREATERP (\FGETOFFSET OFFSETS I)
-                                                                CHAROFFSET)
+                      (for
 I from
 0 to
 SLUGCHARINDEX when
 (IGREATERP (\FGETOFFSET OFFSETS I)
+                                                                 CHAROFFSET)
                          do
 
                             (* ;; 
 
         "If the imagewidth has changed, offsets after the modified character have to be adjusted.  ")

@@ -1318,7 +1587,11 @@
                  NEWDESCENT])
 
 (MOVEFONTCHARS

-  [LAMBDA (PAIRS DESTFONT DEFAULTSOURCEFONT)
                 (* ; "Edited 24-Jul-2025 21:05 by rmk")


+  [LAMBDA (PAIRS DESTFONT DEFAULTSOURCEFONT)
                 (* ; "Edited  4-Sep-2025 11:07 by rmk")


+                                                             (* ; "Edited 30-Aug-2025 23:20 by rmk")


+                                                             (* ; "Edited 26-Aug-2025 23:10 by rmk")


+                                                             (* ; "Edited 25-Aug-2025 09:12 by rmk")


+                                                             (* ; "Edited 24-Jul-2025 21:05 by rmk")


                                                              (* ; "Edited  9-Jul-2025 09:13 by rmk")


                                                              (* ; "Edited 17-Jun-2025 19:53 by rmk")


                                                              (* ; "Edited  7-Jun-2025 00:06 by rmk")


@@ -1337,83 +1610,58 @@
 
     (CL:WHEN PAIRS
         (SETQ DESTFONT (FONTCREATE
 DESTFONT))
-        (LET ((DEVICE (FONTPROP
 DESTFONT 'DEVICE))
-              PAIRINFO)
-             (SETQ DEFAULTSOURCEFONT (CL:IF DEFAULTSOURCEFONT
-                                         (FONTCREATE
 DEFAULTSOURCEFONT NIL NIL NIL DEVICE)
-                                         DESTFONT))
+        (SETQ DEFAULTSOURCEFONT (CL:IF DEFAULTSOURCEFONT
+                                    (FONTCREATE
 DEFAULTSOURCEFONT NIL NIL NIL (FONTPROP
 DESTFONT
+                                                                                     'DEVICE))
+                                    DESTFONT))
+        (LET (PAIRINFO)
 
              (* ;; "Fix/check arguments, and expand out the information for all the source characters, so there is no toe-stepping if there are overlaps.")

 
-             (SETQ PAIRINFO (for
 P S SCODE SFONT DCODE SCSINFO DCSINFO in
 PAIRS
-                               collect
 (CL:WHEN (SMALLP P)
-                                           (SETQ P (LIST P P)))
-                                     (SETQ S (CAR P))
-                                     (SETQ DCODE (CADR P))
-                                     (CL:UNLESS (CHARCODEP DCODE)
-                                         (SETQ DCODE (CHARCODE.DECODE DCODE)))
-                                     (CL:UNLESS (\INSURECHARSETINFO (\CHARSET DCODE)
-                                                       DESTFONT))
-                                     (SETQ SCODE (CL:IF (LISTP S)
-                                                     (CAR S)
-                                                     S))
-                                     (CL:UNLESS (CHARCODEP SCODE)
-                                         (SETQ SCODE (CHARCODE.DECODE SCODE)))
-                                     (SETQ SFONT (CL:IF (LISTP S)
-                                                     (FONTCREATE
 (CADR S)
-                                                            NIL NIL NIL DEVICE)
-                                                     DEFAULTSOURCEFONT))
-                                     (CL:UNLESS (SETQ SCSINFO (\INSURECHARSETINFO (\CHARSET SCODE)
-                                                                     SFONT)))
-                                     (CL:UNLESS (SETQ DCSINFO (\INSURECHARSETINFO (\CHARSET DCODE)
-                                                                     DESTFONT))
-
-                                         (* ;; 
-
   "If the destination csinfo doesn't exist, initialize with a copy of the source character's csinfo")

-
-                                         (\SETCHARSETINFO (ffetch
 FONTCHARSETVECTOR of
 DESTFONT)
-                                                (\CHARSET DCODE)
-                                                (COPYALL SCSINFO)))
-                                     (LIST (LIST SCODE (\GETCHARINFO
 SCSINFO (\CHAR8CODE SCODE)))
-                                           DCODE)))
+             (SETQ PAIRINFO (for
 P S DCODE in
 PAIRS collect
 (CL:WHEN (SMALLP P)
+                                                                (SETQ P (LIST P P)))
+                                                          (SETQ DCODE (CADR P))
+                                                          (CL:UNLESS (CHARCODEP DCODE)
+                                                              (SETQ DCODE (CHARCODE.DECODE DCODE)))
+                                                          (\INSURECHARSETINFO DESTFONT (\CHARSET
+                                                                                        DCODE))
+                                                          (LIST (\MOVEFONTCHARS.SOURCEDATA

+                                                                 (CAR P)
+                                                                 DEFAULTSOURCEFONT)
+                                                                DCODE)))
 
              (* ;; "Install source character information into the destination font.  ")

 
-             (for
 P DCHARCODE DCSINFO ASCENT DESCENT in
 PAIRINFO
-                do
 (SETQ DCHARCODE (CADR P))
-                   (SETQ DCSINFO (\XGETCHARSETINFO DESTFONT (\CHARSET DCHARCODE)))
-                   (CL:WHEN (fetch
 (CHARSETINFO CSSLUGP) of
 DCSINFO)
-                                                             (* ; "Break the slug-sharing")

-                       (SETQ DCSINFO (create
 CHARSETINFO copying
 DCSINFO CSSLUGP _ NIL))
-                       (\SETCHARSETINFO (fetch
 (FONTDESCRIPTOR FONTCHARSETVECTOR))
-                              (\CHARSET DCHARCODE)
-                              DCSINFO))
-                   (\MOVEFONTCHAR
 (CADAR P)
-                          DCSINFO
-                          (\CHAR8CODE (CAAR P))
-                          (\CHAR8CODE DCHARCODE)
-                          DESTFONT))))
+             (for
 P in
 PAIRINFO do
 (\MOVEFONTCHAR
 (CAR P)
+                                          (CADR P)
+                                          DESTFONT))))
     DESTFONT])
 
 (\MOVEFONTCHAR

-  [LAMBDA (SCHARINFO DCSINFO SCODE DCODE DFONT)
              (* ; "Edited 24-Jul-2025 10:47 by rmk")


+  [LAMBDA (SOURCEDATA DCODE DFONT)
                           (* ; "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")


+                                                             (* ; "Edited 26-Aug-2025 22:25 by rmk")


+                                                             (* ; "Edited 25-Aug-2025 09:13 by rmk")


+                                                             (* ; "Edited 24-Jul-2025 10:47 by rmk")


                                                              (* ; "Edited 22-Jul-2025 13:18 by rmk")


                                                              (* ; "Edited  8-Jul-2025 22:23 by rmk")


                                                              (* ; "Edited 17-Jun-2025 19:53 by rmk")


                                                              (* ; "Edited  7-Jun-2025 14:43 by rmk")

 
-    (* ;; "Internal CSINFO-level function to move the information for (thinchar) SCODE in the source CSINFO to (thinchar) DCODE) in the destination CSINFO.")

+    (* ;; "Internal CSINFO-level function to move the information for STHINCODE in the source CSINFO to DTHINCODE) in the destination CSINFO.")

 
-    (* ;; "The caller (MOVEFONTCHARS) may have provided the source character information as an alist structure to avoid stepping on toes.  If SCHARINFO is a CSINFO, the alist is extracted here.")

+    (* ;; "The caller (MOVEFONTCHARS) may have provided the source character information as an alist structure to avoid stepping on toes.  If SOURCEDATA is a CSINFO, the alist is extracted here.")

 
-    (* ;; "If DFONT is provided, its ascent and descent may be adjusted to reflect SCHARINFO.")

+    (* ;; "If DFONT is provided, its ascent and descent may be adjusted to reflect SOURCEDATA.")

 
-    (CL:WHEN (type?
 CHARSETINFO SCHARINFO)
-        (SETQ SCHARINFO (\GETCHARINFO
 SCHARINFO SCODE)))
-    (LET (DESCENT ASCENT TEMP)
-         (CL:WHEN [AND (FGETMULTI SCHARINFO 'IMAGEWIDTHS)
-                       (NEQ (FGETMULTI SCHARINFO 'WIDTHS)
-                            (FGETMULTI SCHARINFO 'IMAGEWIDTHS))
+    (LET ((DCSINFO (\INSURECHARSETINFO DFONT (\CHARSET DCODE)))
+          (DTHINCODE (\CHAR8CODE DCODE))
+          DESCENT ASCENT TEMP)
+         (CL:WHEN [AND (GETMULTI SOURCEDATA 'IMAGEWIDTHS)
+                       (NEQ (GETMULTI SOURCEDATA 'WIDTHS)
+                            (GETMULTI SOURCEDATA 'IMAGEWIDTHS))
                        (OR (EQ (ffetch
 (CHARSETINFO WIDTHS) of
 DCSINFO)
                                (ffetch
 (CHARSETINFO IMAGEWIDTHS) of
 DCSINFO))
                            (NULL (ffetch
 (CHARSETINFO IMAGEWIDTHS) of
 DCSINFO]
@@ -1423,20 +1671,29 @@
              (replace
 (CHARSETINFO IMAGEWIDTHS) of
 DCSINFO with
 (\COPYARRAYBLOCK (ffetch
 (CHARSETINFO
                                                                                           WIDTHS)
                                                                                     of
 DCSINFO))))
-         (CL:WHEN (SETQ TEMP (FGETMULTI SCHARINFO 'BITMAP))
-             (\PUTCHARBITMAP.CSINFO
 DCODE DCSINFO TEMP (FGETMULTI SCHARINFO 'DESCENT)))
-         (UPDATEINFOELEMENT WIDTHS)
-         (UPDATEINFOELEMENT IMAGEWIDTHS)
-         (UPDATEINFOELEMENT YWIDTHS)
-         (CL:WHEN (FGETMULTI SCHARINFO 'LEFTKERN)
-             (\FSETLEFTKERN
 DCSINFO DCODE (FGETMULTI SCHARINFO 'LEFTKERN)))
-         (SETQ DESCENT (IMAX (FGETMULTI SCHARINFO 'DESCENT)
+         [if
 (GETMULTI SOURCEDATA 'SLUG)
+             then
 (\MAKESLUGCHAR
 DTHINCODE DCSINFO)
+           else
 (CL:WHEN (fetch
 (CHARSETINFO CSSLUGP) of
 DCSINFO)
+                                                             (* ; "No longer a slug csinfo")

+                    (SETQ DCSINFO (create
 CHARSETINFO copying
 DCSINFO CSSLUGP _ NIL CSCOMPLETEP _ NIL
+                                         ))
+                    (\SETCHARSETINFO DFONT (\CHARSET DCODE)
+                           DCSINFO))
+                (CL:WHEN (SETQ TEMP (GETMULTI SOURCEDATA 'BITMAP))
+                    (\PUTCHARBITMAP.CSINFO
 DTHINCODE DCSINFO TEMP (GETMULTI SOURCEDATA 'DESCENT))
+                    (UPDATEINFOELEMENT WIDTHS)
+                    (UPDATEINFOELEMENT IMAGEWIDTHS)
+                    (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)))
-         (SETQ ASCENT (IMAX (FGETMULTI SCHARINFO 'ASCENT)
+         (SETQ ASCENT (IMAX (GETMULTI SOURCEDATA 'ASCENT)
                             (fetch
 (CHARSETINFO CHARSETASCENT) of
 DCSINFO)))
          (replace
 (CHARSETINFO CHARSETDESCENT) of
 DCSINFO with
 DESCENT)
          (replace
 (CHARSETINFO CHARSETASCENT) of
 DCSINFO with
 ASCENT)
-         (replace
 (CHARSETINFO CSSLUGP) of
 DCSINFO with
 NIL)
          (CL:WHEN DFONT
              (SETQ DESCENT (IMAX DESCENT (fetch
 (FONTDESCRIPTOR \SFDescent) of
 DFONT)))
              (SETQ ASCENT (IMAX ASCENT (fetch
 (FONTDESCRIPTOR \SFAscent) of
 DFONT)))
@@ -1445,29 +1702,74 @@
              (replace
 (FONTDESCRIPTOR \SFHeight) of
 DFONT with
 (IPLUS DESCENT ASCENT)))
          DCSINFO])
 
-(SLUGCHARP.DISPLAY

-  [LAMBDA (CODE FONT/CHARSETINFO)
                            (* ; "Edited  6-Jun-2025 10:24 by rmk")


-                                                             (* ; "Edited 31-May-2025 23:44 by rmk")

-
-    (* ;; "True if CODE is currently a slug in FONT or the particular CHARSETINFO.  If we are given a CSINFO, CODE is alread charset-relative.")

-
-    (LET [(CSINFO (CL:IF (type?
 CHARSETINFO FONT/CHARSETINFO)
-                      FONT/CHARSETINFO
-                      (\XGETCHARSETINFO FONT/CHARSETINFO (\CHARSET CODE)))]
-         (OR (NULL CSINFO)
-             (fetch
 (CHARSETINFO CSSLUGP) of
 CSINFO)
-             (EQ (\GETBASE (fetch
 (CHARSETINFO OFFSETS) of
 CSINFO)
-                        (\CHAR8CODE CODE))
-                 (\GETBASE (fetch
 (CHARSETINFO OFFSETS) of
 CSINFO)
-                        (ADD1 \MAXTHINCHAR])
-
-(\GETCHARINFO

-  [LAMBDA (CSINFO CHAR8CODE)
                                 (* ; "Edited 23-Jul-2025 15:59 by rmk")


+(\MOVEFONTCHARS.SOURCEDATA

+  [LAMBDA (SOURCE DEFAULTSOURCEFONT)
                         (* ; "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")


+                                                             (* ; "Edited 26-Aug-2025 20:23 by rmk")


+                                                             (* ; "Edited 25-Aug-2025 09:12 by rmk")


+                                                             (* ; "Edited 23-Aug-2025 23:45 by rmk")


+                                                             (* ; "Edited 23-Jul-2025 15:59 by rmk")


                                                              (* ; "Edited 22-Jul-2025 12:48 by rmk")


                                                              (* ; "Edited  8-Jul-2025 22:50 by rmk")


                                                              (* ; "Edited  7-Jun-2025 14:35 by rmk")

-    (LET (TEMP)
-         `((ASCENT \, (fetch
 (CHARSETINFO CHARSETASCENT) of
 CSINFO))
+
+    (* ;; "This decodes the source size of a MOVEFONTCHARS pair.  SOURCE can be")

+
+    (* ;; "     a character name or character code:  The source font is the DEFAULTSOURCEFONT")

+
+    (* ;; "     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).")

+
+    (LET (SCODE CHAR8CODE SFONT CSINFO TEMP)
+         (if
 (LISTP SOURCE)
+             then
 (SETQ SFONT (CADR SOURCE))
+                  (SETQ SCODE (CAR SOURCE))
+           else
 (SETQ SFONT DEFAULTSOURCEFONT)
+                (SETQ SCODE SOURCE))
+         (CL:UNLESS (type?
 FONTDESCRIPTOR SFONT)
+             (if
 SFONT
+                 then
 (SETQ SFONT (MKLIST SFONT))            (* ; 
+
                                                "Make it look like a fontspec, then fill in defaults")

+                      [SETQ SFONT (FONTCREATE
 (create
 FONTSPEC
+                                                     FSFAMILY _ (OR (fetch
 (FONTSPEC FSFAMILY)
+                                                                       of
 SFONT)
+                                                                    (FONTPROP
 DEFAULTSOURCEFONT
+                                                                           'FAMILY))
+                                                     FSSIZE _ (OR (fetch
 (FONTSPEC FSSIZE)
+                                                                     of
 SFONT)
+                                                                  (FONTPROP
 DEFAULTSOURCEFONT
+                                                                         'SIZE))
+                                                     FSFACE _ (OR (fetch
 (FONTSPEC FSFACE)
+                                                                     of
 SFONT)
+                                                                  (FONTPROP
 DEFAULTSOURCEFONT
+                                                                         'FACE))
+                                                     FSROTATION _ (OR (fetch
 (FONTSPEC FSROTATION)
+                                                                         of
 SFONT)
+                                                                      (FONTPROP
 DEFAULTSOURCEFONT
+                                                                             'ROTATION))
+                                                     FSDEVICE _ (OR (fetch
 (FONTSPEC FSDEVICE)
+                                                                       of
 SFONT)
+                                                                    (FONTPROP
 DEFAULTSOURCEFONT
+                                                                           'DEVICE]
+               else
 (SETQ SFONT DEFAULTSOURCEFONT)))
+         (CL:UNLESS (CHARCODEP SCODE)
+             (SETQ SCODE (CHARCODE.DECODE SCODE)))
+         (CL:WHEN (AND SCODE (SLUGCHARP.DISPLAY
 SCODE SFONT))
+                (SETQ SCODE NIL))
+         (if
 SCODE
+             then
 (SETQ CSINFO (\INSURECHARSETINFO SFONT (\CHARSET SCODE)))
+                  (SETQ CHAR8CODE (\CHAR8CODE SCODE))
+           else
 
+                (* ;; "NIL SCODE means replace with slug. We calculate the source-slug information, but that should be ignored later in favor of the slug information from the destination's character set. ")

+
+                (SETQ CSINFO (\INSURECHARSETINFO SFONT 0))
+                (SETQ CHAR8CODE SLUGCHARINDEX))
+
+         (* ;; "Use (plural) vector field names for UPDATEINFOELEMENT.  Don't know if the CHAR8CODE is useful, but...")

+
+         `((CHAR8CODE \, CHAR8CODE)
+           (ASCENT \, (fetch
 (CHARSETINFO CHARSETASCENT) of
 CSINFO))
            (DESCENT \, (fetch
 (CHARSETINFO CHARSETDESCENT) of
 CSINFO))
            (WIDTHS \, (CL:WHEN (SETQ TEMP (ffetch
 (CHARSETINFO WIDTHS) of
 CSINFO))
                              (\FGETWIDTH TEMP CHAR8CODE)))
@@ -1479,18 +1781,79 @@
                             (ELT (fetch
 (CHARSETINFO LEFTKERN) of
 CSINFO)
                                  CHAR8CODE)))
            (BITMAP \, (CL:WHEN (SETQ TEMP (fetch
 (CHARSETINFO CHARSETBITMAP) of
 CSINFO))
-                             (\GETCHARBITMAP.CSINFO
 CHAR8CODE CSINFO])
+                             (\GETCHARBITMAP.CSINFO
 CHAR8CODE CSINFO)))
+           (SLUG \, (NOT SCODE])
+
+(\MAKESLUGCHAR

+  [LAMBDA (CODE FONT/CSINFO)
                                 (* ; "Edited 30-Aug-2025 23:20 by rmk")


+                                                             (* ; "Edited 24-Aug-2025 09:55 by rmk")

+
+    (* ;; "Makes CODE be a slug character in FONT/CSINFO.  If give a FONT, CODE is a true character code, otherwise it is a thincode in the given character set.")

+
+    (LET (CSINFO THINCODE OFFSETS WIDTHS)
+         (if
 (type?
 FONTDESCRIPTOR FONT/CSINFO)
+             then
 (SETQ CSINFO (\INSURECHARSETINFO FONT/CSINFO (\CHARSET CODE)))
+                  (SETQ THINCODE (\CHAR8CODE CODE))
+           else
 (SETQ CSINFO FONT/CSINFO)
+                (SETQ THINCODE CODE))
+         (SETQ OFFSETS (fetch
 (CHARSETINFO OFFSETS) of
 CSINFO))
+         (CL:UNLESS (AND OFFSETS (EQ (\FGETOFFSET OFFSETS THINCODE)
+                                     (\FGETOFFSET OFFSETS SLUGCHARINDEX)))
+             (if
 OFFSETS
+                 then
 
+                      (* ;; "Must be a display. W e remove the character's current bitmap, then change the vectors to point to the existing slug. Otherwise we might end up with multiple slug bitmaps interspersed.")

+
+                      (\PUTCHARBITMAP.CSINFO
 THINCODE CSINFO (BITMAPCREATE 0 0))
+                      (\FSETOFFSET OFFSETS THINCODE (\FGETOFFSET OFFSETS SLUGCHARINDEX))
+               else
 (HELP "NONDISPLAY SLUG ?"))
+             (\FSETWIDTH (fetch
 (CHARSETINFO WIDTHS) of
 CSINFO)
+                    THINCODE
+                    (\FGETWIDTH (fetch
 (CHARSETINFO WIDTHS) of
 CSINFO)
+                           SLUGCHARINDEX))
+             (\FSETIMAGEWIDTH (fetch
 (CHARSETINFO IMAGEWIDTHS) of
 CSINFO)
+                    THINCODE
+                    (\FGETIMAGEWIDTH (fetch
 (CHARSETINFO IMAGEWIDTHS) of
 CSINFO)
+                           SLUGCHARINDEX))
+             (CL:WHEN (fetch
 (CHARSETINFO YWIDTHS) of
 CSINFO)
+                 (\FSETWIDTH (fetch
 (CHARSETINFO YWIDTHS) of
 CSINFO)
+                        THINCODE
+                        (\FGETWIDTH (fetch
 (CHARSETINFO YWIDTHS) of
 CSINFO)
+                               SLUGCHARINDEX)))
+             (CL:WHEN (fetch
 (CHARSETINFO LEFTKERN) of
 CSINFO)
+                 (SETA (fetch
 (CHARSETINFO LEFTKERN) of
 CSINFO)
+                       THINCODE
+                       (ELT (fetch
 (CHARSETINFO LEFTKERN) of
 CSINFO)
+                            SLUGCHARINDEX))))
+         CSINFO])
+
+(SLUGCHARP.DISPLAY

+  [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")


+                                                             (* ; "Edited 31-May-2025 23:44 by rmk")

+
+    (* ;; "True if CODE is currently a slug in FONT or the particular CHARSETINFO.  If we are given a CSINFO, CODE is alread charset-relative.")

+
+    (LET [(CSINFO (CL:IF (type?
 CHARSETINFO FONT/CHARSETINFO)
+                      FONT/CHARSETINFO
+                      (\GETCHARSETINFO FONT/CHARSETINFO (\CHARSET CODE)))]
+         (OR (NULL CSINFO)
+             (fetch
 (CHARSETINFO CSSLUGP) of
 CSINFO)
+             (EQ (\FGETOFFSET (fetch
 (CHARSETINFO OFFSETS) of
 CSINFO)
+                        (\CHAR8CODE CODE))
+                 (\FGETOFFSET (fetch
 (CHARSETINFO OFFSETS) of
 CSINFO)
+                        (ADD1 \MAXTHINCHAR])
 )
 (DECLARE%: EVAL@COMPILE 
 
 (PUTPROPS UPDATEINFOELEMENT
 MACRO
 [(FIELD)
                                    (LET [(DBLOCK (ffetch
 (CHARSETINFO FIELD) of
 DCSINFO))
-                                         (NEWVAL (FGETMULTI SCHARINFO 'FIELD]
+                                         (NEWVAL (GETMULTI SOURCEDATA 'FIELD]
                                         (CL:WHEN NEWVAL
                                             (CL:UNLESS DBLOCK
                                                 (SETQ DBLOCK (\CREATECSINFOELEMENT))
                                                 (freplace
 (CHARSETINFO FIELD) of
 DCSINFO with
 DBLOCK))
-                                            (\FSETWIDTH DBLOCK DCODE NEWVAL))])
+                                            (\FSETWIDTH DBLOCK DTHINCODE NEWVAL))])
 )
 
 
@@ -1502,7 +1865,9 @@
 (DEFINEQ
 
 (FONTFILES

-  [LAMBDA (FAMILY SIZE FACE ROTATION DEVICE CHARSET DIRLST EXTLST)

+  [LAMBDA (FONTSPEC CHARSET DIRLST EXTLST)
                   (* ; "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")


                                                              (* ; "Edited  6-Jul-2025 10:40 by rmk")


                                                              (* ; "Edited 19-Jun-2025 17:09 by rmk")


@@ -1513,11 +1878,13 @@
 
     (* ;; "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.")

 
-    [SETQ DIRLST (MKLIST (OR DIRLST (GETATOMVAL (PACK* DEVICE "FONTDIRECTORIES"]
-    [SETQ EXTLST (MKLIST (OR EXTLST (GETATOMVAL (PACK* 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])
+    (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])
 
 (\FINDFONTFILE

   [LAMBDA (FAMILY SIZE FACE ROTATION DEVICE CHARSET DIRLST EXTLST)

@@ -1541,12 +1908,13 @@
                                                                         (RETURN (CAR $$VAL)))])
 
 (\FONTFILENAMES

-  [LAMBDA (FAMILY SIZE FACE DEVICE EXTENSIONS)
               (* ; "Edited 17-May-2025 12:15 by rmk")

+  [LAMBDA (FAMILY SIZE FACE DEVICE EXTENSIONS)
               (* ; "Edited  7-Oct-2025 12:21 by rmk")


+                                                             (* ; "Edited 17-May-2025 12:15 by rmk")

     (APPEND [for
 EXT inside
 EXTENSIONS collect
 (IF
 (FMEMB EXT *OLD-FONT-EXTENSIONS*)
                                                    THEN
 (\FONTFILENAME.OLD
 FAMILY SIZE FACE EXT
-                                                               'ALL)
+                                                               'NOCHARSET)
                                                  ELSE
 (\FONTFILENAME
 FAMILY SIZE FACE EXT
-                                                             'ALL]
+                                                             'NOCHARSET]
            (for
 EXT inside
 EXTENSIONS collect
 (IF
 (FMEMB EXT *OLD-FONT-EXTENSIONS*)
                                                   THEN
 (\FONTFILENAME.OLD
 FAMILY SIZE FACE EXT 0)
                                                 ELSE
 (\FONTFILENAME
 FAMILY SIZE FACE EXT 0])
@@ -1700,8 +2068,13 @@
                                               (T "-C0")))
                 'EXTENSION EXTENSION])
 
-(\FONTINFOFROMFILENAME

-  [LAMBDA (FONTFILE DEVICE NOCHARSET)
                        (* ; "Edited 10-Jul-2025 09:42 by rmk")


+(FONTSPECFROMFILENAME

+  [LAMBDA (FONTFILE DEVICE)
                                  (* ; "Edited 30-Aug-2025 10:05 by rmk")


+                                                             (* ; "Edited 28-Aug-2025 14:28 by rmk")


+                                                             (* ; "Edited 25-Aug-2025 10:16 by rmk")


+                                                             (* ; "Edited 23-Aug-2025 10:42 by rmk")


+                                                             (* ; "Edited 17-Aug-2025 00:05 by rmk")


+                                                             (* ; "Edited 10-Jul-2025 09:42 by rmk")


                                                              (* ; "Edited 26-Jun-2025 23:03 by rmk")


                                                              (* ; "Edited 14-Sep-96 10:23 by rmk:")


                                                              (* ; "Edited  5-Oct-89 18:28 by bvm")

@@ -1709,7 +2082,7 @@
     (* ;; "returns a list of the family size face rotation device of the font stored in the file name FONTFILE.  Rotation is 0 always.  Parses both new & old format files.")

 
     (LET ((FILENAMELIST (UNPACKFILENAME.STRING FONTFILE))
-          CH SIZEBEG SIZEND NAME FAMILY SIZE FACE EXT CHARSET)
+          CH SIZEBEG SIZEEND NAME FAMILY SIZE FACE CHARSET)
          (SETQ NAME (LISTGET FILENAMELIST 'NAME))            (* ; 
 
           "find where the name and size are.  MUST check for ch nil below or possible infinite loop")

          (SETQ SIZEBEG (for
 CH# from
 1 when
 (OR (NUMBERP (SETQ CH (NTHCHAR NAME CH#)))
@@ -1721,50 +2094,50 @@
 
          (* ;; "Get Size")

 
-         [SETQ SIZEND (find
 CH# from
 SIZEBEG suchthat
 (NOT (NUMBERP (NTHCHAR NAME CH#]
-         [SETQ SIZE (MKATOM (SUBSTRING NAME SIZEBEG (SUB1 SIZEND]
-         (if
 (EQ (NTHCHAR NAME SIZEND)
+         [SETQ SIZEEND (find
 CH# from
 SIZEBEG suchthat
 (NOT (NUMBERP (NTHCHAR NAME CH#]
+         [SETQ SIZE (SMALLP (MKATOM (SUBSTRING NAME SIZEBEG (SUB1 SIZEEND]
+         (if
 (EQ (NTHCHAR NAME SIZEEND)
                  '-)
-             then
 (SETQ SIZEND (ADD1 SIZEND)))
+             then
 (SETQ SIZEEND (ADD1 SIZEEND)))
 
          (* ;; "Get Face")

 
-         (SETQ NAME (U-CASE NAME))                           (* ; 
+         (SETQ NAME (U-CASE NAME))
+         (SETQ FACE (SUBSTRING NAME SIZEEND))                (* ; 
 
                                                     "don't need name, but checks for lowercase face")

-         [SETQ FACE (LIST (COND
-                             ((STRPOS "B" NAME SIZEND NIL T NIL UPPERCASEARRAY)
-                              'BOLD)
-                             ((STRPOS "L" NAME SIZEND NIL T NIL UPPERCASEARRAY)
-                              'LIGHT)
-                             (T 'MEDIUM))
-                          (COND
-                             ((STRPOS "I" NAME SIZEND NIL NIL NIL UPPERCASEARRAY)
-                              'ITALIC)
-                             (T 'REGULAR))
-                          (COND
-                             ((STRPOS "E" NAME SIZEND NIL NIL NIL UPPERCASEARRAY)
-                              'EXPANDED)
-                             ((STRPOS "C-" NAME SIZEND NIL NIL NIL UPPERCASEARRAY)
-                              'COMPRESSED)
-                             (T 'REGULAR]
+         [SETQ FACE (LIST (SELCHARQ (NTHCHARCODE FACE 1)
+                               (B 'BOLD)
+                               (L 'LIGHT)
+                               'MEDIUM)
+                          (SELCHARQ (NTHCHARCODE FACE 2)
+                               (I 'ITALIC)
+                               'REGULAR)
+                          (SELCHARQ (NTHCHARCODE FACE 3)
+                               (C 'COMPRESSED)
+                               (E 'EXPANDED)
+                               'REGULAR]
          (CL:WHEN (SETQ CHARSET (STRPOS "-c" NAME NIL NIL NIL T UPPERCASEARRAY))
              [SETQ CHARSET (FIXP (MKATOM (CONCAT (SUBSTRING NAME CHARSET)
                                                 "Q"])
-         (LIST* FAMILY SIZE FACE 0 (COND
-                                      ((STREAMP DEVICE)
-                                       (IMAGESTREAMTYPE DEVICE))
-                                      ((NULL DEVICE)
-                                       [SETQ EXT (MKATOM (U-CASE (LISTGET FILENAMELIST 'EXTENSION]
-                                       (SELECTQ EXT
-                                           ((WD MEDLEYINTERPRESSFONT) 
-                                                'INTERPRESS)
-                                           ((STRIKE AC DISPLAYFONT MEDLEYDISPLAYFONT) 
-                                                'DISPLAY)
-                                           EXT))
-                                      ((LITATOM DEVICE)
-                                       (\FONTSYMBOL
 DEVICE))
-                                      (T DEVICE))
-                (CL:UNLESS NOCHARSET (CONS CHARSET])
+         (SETQ DEVICE (COND
+                         ((STREAMP DEVICE)
+                          (IMAGESTREAMTYPE DEVICE))
+                         [(NULL DEVICE)
+                          (CAR (find
 I DEXTS (EXT _ (LISTGET FILENAMELIST 'EXTENSION)) in
 
+                                                                                     IMAGESTREAMTYPES
+                                  suchthat
 (thereis
 E inside
 (FONTDEVICEPROP
 (CAR I)
+                                                                    'FONTEXTENSIONS)
+                                              suchthat
 (STRING.EQUAL EXT E]
+                         ((LITATOM DEVICE)
+                          (\FONTSYMBOL
 DEVICE))
+                         (T DEVICE)))
+         (CL:WHEN (AND FAMILY SIZE FACE DEVICE)
+                (create
 FONTSPEC
+                       FSFAMILY _ FAMILY
+                       FSSIZE _ SIZE
+                       FSFACE _ FACE
+                       FSROTATION _ 0
+                       FSDEVICE _ DEVICE])
 
 (\FONTINFOFROMFILENAME.OLD

   [LAMBDA (FONTFILE DEVICE)
                              (* ; "Edited  1-Jan-87 01:29 by FS")

@@ -1905,54 +2278,37 @@
         X])
 
 (FONTUNPARSE

-  [LAMBDA (FONT)
                                         (* kbr%: "25-Feb-86 19:40")

+  [LAMBDA (FONT)
                                             (* ; "Edited  7-Sep-2025 09:19 by rmk")


+                                                             (* ; "Edited 21-Aug-2025 18:15 by rmk")


+                                                             (* ; "Edited 18-Aug-2025 00:52 by rmk")

+                                                             (* kbr%: "25-Feb-86 19:40")

 
     (* ;; "Produces a minimal specification of the font or fontclass specification, for dumping by Tedit, imageobjects.")

 
-    (PROG (FACE SPEC)
-          (SETQ SPEC (COND
-                        ((type?
 FONTDESCRIPTOR FONT)
-                         (FONTPROP
 FONT 'SPEC))
-                        [(type?
 FONTCLASS FONT)
-                         (RETURN (CONS 'CLASS (FONTCLASSUNPARSE
 FONT]
-                        (T 
-                           (* ;; "Could be a non-instantiated specification in a fontclass, just use it as the spec without creating the font.")

-
-                           FONT)))
-          (OR SPEC (RETURN))
-          (SETQ FACE (CADDR SPEC))                           (* ; 
-
                        "FACE and rotation can be NIL for a non-fontdescriptor fontclass component")

-          [SETQ FACE (COND
-                        ([OR (NULL FACE)
-                             (EQUAL FACE '(MEDIUM REGULAR REGULAR]
-                         NIL)
-                        ((LITATOM FACE)
-                         FACE)
-                        [(LISTP FACE)
-                         (PACK (LIST* (NTHCHAR (fetch
 (FONTFACE WEIGHT) of
 FACE)
-                                             1)
-                                      (NTHCHAR (fetch
 (FONTFACE SLOPE) of
 FACE)
-                                             1)
-                                      (NTHCHAR (fetch
 (FONTFACE EXPANSION) of
 FACE)
-                                             1)
-                                      (COND
-                                         ((fetch
 (FONTFACE COLOR) of
 FACE)
-                                          (LIST "-" (fetch
 (FONTFACE BACKCOLOR) of
 FACE)
-                                                "-"
-                                                (fetch
 (FONTFACE FORECOLOR) of
 FACE]
-                        (T (SHOULDNT]                        (* ; 
-
                                                    "Don't return device, or any trailing defaults")

-          (RETURN (CONS (CAR SPEC)
-                        (CONS (CADR SPEC)
-                              (COND
-                                 ([AND (CADDDR SPEC)
-                                       (NOT (EQ 0 (CADDDR SPEC]
-                                  (LIST (OR FACE 'MRR)
-                                        (CADDDR SPEC)))
-                                 (FACE (CONS FACE])
+    (if
 (type?
 FONTCLASS FONT)
+        then
 (CONS 'CLASS (FONTCLASSUNPARSE
 FONT))
+      elseif
 (type?
 FONTDESCRIPTOR FONT)
+        then
 (LET ((SPEC (FONTPROP
 FONT 'SPEC))
+                   FACE)
+                  (SETQ FACE (FONTFACETOATOM
 (fetch
 (FONTSPEC FSFACE) of
 SPEC)
+                                    T))
+
+                  (* ;; "Original: Don't return device, or any trailing defaults. ")

+
+                  (* ;; "We still honor that even though it is more attractive to return the whole fontspec, perhaps with device NIL.")

+
+                  (* ;; "Seems harmless to include a 0 rotation--any caller would have expected that something might appear there.")

+                                                             (* (create FONTSPEC using SPEC FSFACE 
+
                                                             _ FACE FSDEVICE _ NIL))

+                  (LIST (fetch
 (FONTSPEC FSFAMILY) of
 SPEC)
+                        (fetch
 (FONTSPEC FSSIZE) of
 SPEC)
+                        FACE
+                        (fetch
 (FONTSPEC FSROTATION) of
 SPEC])
 
 (SETFONTDESCRIPTOR

-  [LAMBDA (FAMILY SIZE FACE ROTATION DEVICE FONT)
            (* ; "Edited 21-Jul-2025 08:55 by rmk")


+  [LAMBDA (FAMILY SIZE FACE ROTATION DEVICE FONT)
            (* ; "Edited 28-Aug-2025 14:43 by rmk")


+                                                             (* ; "Edited 12-Aug-2025 21:07 by rmk")


+                                                             (* ; "Edited 21-Jul-2025 08:55 by rmk")


                                                              (* ; "Edited 14-Jul-2025 22:37 by rmk")


                                                              (* ; "Edited 10-Jul-2025 12:38 by rmk")


                                                              (* ; "Edited 19-Jun-2025 21:21 by rmk")


@@ -2030,32 +2386,45 @@
            (IGNORE.CCE 0)
            (SHOULDNT])
 
-(\UNITWIDTHSVECTOR

-  [LAMBDA NIL
                                            (* JonL " 7-NOV-83 19:23")

-    (SETQ \UNITWIDTHSVECTOR (\ALLOCBLOCK (UNFOLD (IPLUS \MAXCHAR 3)
-                                                WORDSPERCELL)))
-    (for
 I from
 0 to
 (IPLUS \MAXCHAR 2) do
 (\PUTBASE \UNITWIDTHSVECTOR I 1))
-    \UNITWIDTHSVECTOR])
-
 (\COERCECHARSET

-  [LAMBDA (FAMILY SIZE FACE ROTATION DEVICE CHARSET COERCIONS THINCODE)

+  [LAMBDA (FONTSPEC CHARSET CODE COERCIONS FONT)
             (* ; "Edited  7-Oct-2025 17:25 by rmk")


+                                                             (* ; "Edited 31-Aug-2025 00:00 by rmk")


+                                                             (* ; "Edited 28-Aug-2025 23:07 by rmk")


+                                                             (* ; "Edited 27-Aug-2025 17:08 by rmk")


+                                                             (* ; "Edited 16-Aug-2025 17:48 by rmk")


+                                                             (* ; "Edited  5-Aug-2025 17:55 by rmk")


                                                              (* ; "Edited 24-Jul-2025 00:19 by rmk")


                                                              (* ; "Edited  8-Jul-2025 08:14 by rmk")


                                                              (* ; "Edited 11-Jun-2025 09:13 by rmk")


                                                              (* ; "Edited  7-Jun-2025 13:39 by rmk")


                                                              (* ; "Edited 21-May-2025 10:50 by rmk")

 
-    (* ;; "COERCIONS is a set of (oldspec newspec) pairs, where a spec is either just a font name or a font name with a size.  If oldspec matches the current requested characteristics, then that csinfo is returned.")

-                                                             (* ; "")

-    (for
 C CSINFO FONT in
 (\COERCEFONTSPEC
 COERCIONS FAMILY SIZE FACE ROTATION DEVICE CHARSET)
-       eachtime
 (SPREADFONTSPEC C) when
 [AND (SETQ FONT (FONTCREATE1
 FAMILY SIZE FACE ROTATION DEVICE
-                                                               CHARSET))
-                                             (SETQ CSINFO (\INSURECHARSETINFO CHARSET FONT))
-                                             (NOT (AND THINCODE (SLUGCHARP.DISPLAY
 THINCODE CSINFO]
-       do
 (RETURN CSINFO])
+    (* ;; "Returns the CHARSET's CSINFO from the first font that the requested font coerces to and that has a non-slug entry for THINCODE (if given). ")

+
+    (if
 (NULL COERCIONS)
+        then
 [SETQ COERCIONS (FONTDEVICEPROP
 FONTSPEC (CL:IF CODE
+                                                          'CHARCOERCIONS
+                                                          'FONTCOERCIONS)]
+      elseif
 (LITATOM COERCIONS)
+        then
 (SETQ COERCIONS (FONTDEVICEPROP
 FONTSPEC COERCIONS)))
+    (for
 CFS CFONT CSINFO in
 (COERCEFONTSPEC
 FONTSPEC COERCIONS)
+       when
 (AND (SETQ CFONT (FONTCREATE1
 CFS CHARSET))
+                 (SETQ CSINFO (\INSURECHARSETINFO CFONT CHARSET)))
+       unless
 (AND CODE (SLUGCHARP.DISPLAY
 CODE CFONT))
+       do
 (CL:WHEN FONT
+              (replace
 (FONTDESCRIPTOR FONTCHARENCODING) of
 FONT with
 (fetch
 (FONTDESCRIPTOR 
+                                                                                    FONTCHARENCODING)
+                                                                         of
 CFONT))
+              (replace
 (FONTDESCRIPTOR FONTTOMCCSFN) of
 FONT with
 (fetch
 (FONTDESCRIPTOR FONTTOMCCSFN
+                                                                                ) of
 CFONT)))
+          (RETURN (LIST CFONT CSINFO])
 
 (\BUILDSLUGCSINFO

-  [LAMBDA (WIDTH HEIGHT DESCENT DEVICE SCALE)
                (* ; "Edited 15-Jun-2025 12:42 by rmk")


+  [LAMBDA (FONT SLUGWIDTH)
                                   (* ; "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")


+                                                             (* ; "Edited 15-Jun-2025 12:42 by rmk")


                                                              (* ; "Edited 13-Jun-2025 22:55 by rmk")


                                                              (* ; "Edited 11-Jun-2025 10:56 by rmk")


                                                              (* ; "Edited 20-May-2025 14:50 by rmk")


@@ -2063,36 +2432,43 @@
                                                              (* ; "Edited 12-May-2025 21:09 by rmk")


                                                              (* ; "Edited  9-May-93 23:12 by rmk:")

 
-    (* ;; "builds a csinfo which contains only the slug (black rectangle) character.  Maybe there should only be a single FONTDESC argument")

-
-    (CL:WHEN (type?
 FONTDESCRIPTOR WIDTH)
-        (SETQ HEIGHT (OR HEIGHT (fetch
 (FONTDESCRIPTOR \SFHeight) of
 WIDTH)))
-        (SETQ DESCENT (OR DESCENT (fetch
 (FONTDESCRIPTOR \SFDescent) of
 WIDTH)))
-        (SETQ DEVICE (OR DEVICE (fetch
 (FONTDESCRIPTOR FONTDEVICE) of
 WIDTH)))
-
-        (* ;; "SCALE is only used for the display bitmap")

-
-        (SETQ SCALE (OR SCALE (fetch
 (FONTDESCRIPTOR FONTSCALE) of
 WIDTH)
-                        1))
-        (SETQ WIDTH (CL:IF (EQ 0 (fetch
 (FONTDESCRIPTOR FONTAVGCHARWIDTH) of
 WIDTH))
-                        (FIXR (FTIMES HEIGHT 0.6))
-                        (fetch
 (FONTDESCRIPTOR FONTAVGCHARWIDTH) of
 WIDTH))))
-    (LET ((CSINFO (create
 CHARSETINFO
-                         CHARSETASCENT _ (IDIFFERENCE HEIGHT DESCENT)
-                         CHARSETDESCENT _ DESCENT
-                         CSSLUGP _ T
-                         CSCOMPLETEP _ T))
-          WIDTHS OFFSETS BITMAP IMAGEWIDTHS)
+    (* ;; "\SF... values are scaled")

+
+    (LET ((SLUGHEIGHT (fetch
 (FONTDESCRIPTOR \SFHeight) of
 FONT))
+          (DESCENT (fetch
 (FONTDESCRIPTOR \SFDescent) of
 FONT))
+          (DEVICE (fetch
 (FONTDESCRIPTOR FONTDEVICE) of
 FONT))
+          CSINFO WIDTHS OFFSETS BITMAP)
+         (CL:WHEN (EQ SLUGHEIGHT 0)
+
+             (* ;; "First character set hasn't been read, so height isn't known.  But usually it is a bit bigger than the request fontsize.")

+
+             (* ;; "This could also be adjusted later.")

+
+             [SETQ SLUGHEIGHT (FIXR (FTIMES 1.2 (OR (fetch
 (FONTDESCRIPTOR FONTSCALE) of
 FONT)
+                                                    1)
+                                           (fetch
 (FONTDESCRIPTOR FONTSIZE) of
 FONT])
+         (CL:UNLESS SLUGWIDTH
+             (SETQ SLUGWIDTH (fetch
 (FONTDESCRIPTOR FONTSLUGWIDTH) of
 FONT)))
+         (CL:WHEN (ZEROP SLUGWIDTH)
+             (SETQ SLUGWIDTH (CL:IF (EQ 0 (fetch
 (FONTDESCRIPTOR FONTAVGCHARWIDTH) of
 FONT))
+                                 (FIXR (FTIMES SLUGHEIGHT 0.6))
+                                 (fetch
 (FONTDESCRIPTOR FONTAVGCHARWIDTH) of
 FONT)))
+             (replace
 (FONTDESCRIPTOR FONTSLUGWIDTH) of
 FONT with
 SLUGWIDTH))
+         (SETQ CSINFO (create
 CHARSETINFO
+                             CHARSETASCENT _ (IDIFFERENCE SLUGHEIGHT DESCENT)
+                             CHARSETDESCENT _ DESCENT
+                             CSSLUGP _ T
+                             CSCOMPLETEP _ T))
          (SETQ WIDTHS (fetch
 (CHARSETINFO WIDTHS) of
 CSINFO))
-         (for
 I from
 0 to
 \MAXTHINCHAR do
 (\FSETWIDTH WIDTHS I WIDTH))
+         (for
 I from
 0 to
 \MAXTHINCHAR do
 (\FSETWIDTH WIDTHS I SLUGWIDTH))
          (replace
 IMAGEWIDTHS OF
 CSINFO with
 WIDTHS)
-         (replace
 (CHARSETINFO OFFSETS) of
 CSINFO with
 (SETQ OFFSETS (\CREATECSINFOELEMENT)))
-         (for
 I from
 0 to
 \MAXTHINCHAR do
 (\FSETOFFSET OFFSETS I 0))
          (CL:WHEN (MEMB DEVICE \DISPLAYSTREAMTYPES)
-             (SETQ BITMAP (BITMAPCREATE (ROUND (QUOTIENT WIDTH SCALE))
-                                 (ROUND (QUOTIENT HEIGHT SCALE))
-                                 1))
-             [BLTSHADE BLACKSHADE BITMAP 1 NIL (SUB1 (ROUND (QUOTIENT WIDTH SCALE]
+             (SETQ OFFSETS (\CREATECSINFOELEMENT))
+             (replace
 (CHARSETINFO OFFSETS) of
 CSINFO with
 OFFSETS)
+             (for
 I from
 0 to
 \MAXTHINCHAR do
 (\FSETOFFSET OFFSETS I 0))
+                                                             (* ; "Slug is at offset 0 in the bitmap")

+             (SETQ BITMAP (BITMAPCREATE SLUGWIDTH SLUGHEIGHT 1))
+             (BLTSHADE BLACKSHADE BITMAP 1 NIL (SUB1 SLUGWIDTH))
              (replace
 (CHARSETINFO CHARSETBITMAP) of
 CSINFO with
 BITMAP))
          CSINFO])
 
@@ -2378,7 +2754,8 @@
              (T (\ILLEGAL.ARG FACE])
 
 (SETFONTCHARENCODING

-  [LAMBDA (FONT CHARENCODING)
                                (* ; "Edited 19-Jul-2025 23:28 by rmk")


+  [LAMBDA (FONT CHARENCODING)
                                (* ; "Edited  2-Sep-2025 22:59 by rmk")


+                                                             (* ; "Edited 19-Jul-2025 23:28 by rmk")


                                                              (* ; "Edited 12-Jul-2025 13:15 by rmk")


                                                              (* ; "Edited 10-Jul-2025 12:38 by rmk")


                                                              (* ; "Edited  6-Jul-2025 21:41 by rmk")


@@ -2389,140 +2766,230 @@
     (* ;; "The FONT charencoding is the same as its charset 0 encoding (e.g. ALTOTEXT).  But all higher charsets are MCCS")

 
     (replace
 (FONTDESCRIPTOR FONTCHARENCODING) of
 (FONTCREATE
 FONT) with
 CHARENCODING)
-    (CHARSETPROP (\XGETCHARSETINFO FONT 0)
+    (CHARSETPROP (\GETCHARSETINFO FONT 0)
            'CSCHARENCODING CHARENCODING])
 )
 (DEFINEQ
 
 (FONTSAVAILABLE

-  [LAMBDA (FAMILY SIZE FACE ROTATION DEVICE CHECKFILESTOO?)
  (* ; "Edited 21-Jul-2025 08:55 by rmk")


+  [LAMBDA (FAMILY SIZE FACE ROTATION DEVICE CHECKFILESTOO?)
  (* ; "Edited 25-Sep-2025 18:39 by rmk")


+                                                             (* ; "Edited 30-Aug-2025 13:55 by rmk")


+                                                             (* ; "Edited 28-Aug-2025 14:43 by rmk")


+                                                             (* ; "Edited 23-Aug-2025 10:51 by rmk")


+                                                             (* ; "Edited 15-Aug-2025 12:18 by rmk")


+                                                             (* ; "Edited 12-Aug-2025 12:27 by rmk")


+                                                             (* ; "Edited 30-Jul-2025 14:30 by rmk")


+                                                             (* ; "Edited 21-Jul-2025 08:55 by rmk")


                                                              (* ; "Edited 21-Jun-2025 15:41 by rmk")


                                                              (* ; "Edited 14-Jun-2025 11:06 by rmk")


                                                              (* ; "Edited 12-Jun-2025 10:48 by rmk")

                                                              (* rrb " 7-Nov-84 15:41")

 
-(* ;;; "returns a list of the fonts fitting a description that are available.  FAMILY SIZE FACE or ROTATION can be * which means get them all.  if CHECKFILESTOO? is NIL, only fonts in core will be considered. If ONLY, fonts in memory will be ignored.")

+(* ;;; "returns a list of the fonts fitting a description that are available.  FAMILY SIZE FACE or ROTATION can be * which means get them all.  if CHECKFILESTOO? is NIL, only fonts in core will be considered. If ONLY, fonts in memory will be ignored. ")

 
-    (SPREADFONTSPEC (\FONT.CHECKARGS
 FAMILY SIZE FACE ROTATION DEVICE))
-    (UNION (CL:UNLESS (EQ 'ONLY CHECKFILESTOO?)
-                  (\FONTSAVAILABLE.INCORE
 FAMILY SIZE FACE ROTATION DEVICE))
-           (CL:WHEN CHECKFILESTOO?
-               (if
 (EQ DEVICE '*)
-                   then
                                      (* ; 
-
                                                             "map thru all the imagestream devices")

-                        (for
 I in
 IMAGESTREAMTYPES
-                           join
 (APPLY* (OR (CADR (ASSOC 'FONTSAVAILABLE (CDR I)))
-                                            (FUNCTION NILL))
-                                       FAMILY SIZE FACE ROTATION (CAR I)))
-                 else
                                        (* ; 
+    (DECLARE
 (GLOBALVARS \FONTSINCORE))
+    (LET ((FONTSPEC (\FONT.CHECKARGS
 FAMILY SIZE FACE ROTATION DEVICE)))
+         (if
 (EQ '* (fetch
 (FONTSPEC FSDEVICE) of
 FONTSPEC))
+             then
 
+                  (* ;; 
+
 "The results for each device will be grouped together, because the sort happens in the clause below")

+
+                  (for
 I in
 IMAGESTREAMTYPES join
 (FONTSAVAILABLE
 FONTSPEC NIL NIL NIL (CAR I)
+                                                         CHECKFILESTOO?))
+           else
 (SPREADFONTSPEC FONTSPEC)                    (* ; "For easier matching code")

+                (SORTFONTSPECS
 (UNION (CL:UNLESS (EQ 'ONLY CHECKFILESTOO?)
+                                          [COLLECTMULTI \FONTSINCORE
+                                                 (FUNCTION (LAMBDA (FM S FC R D FONT)
+                                                             (DECLARE
 (USEDFREE $$COLLECT))
+                                                             (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 D)
+                                                                          (EQ DEVICE '*]
+                                                                 (push
 $$COLLECT
+                                                                       (create
 FONTSPEC
+                                                                              FSFAMILY _ FM
+                                                                              FSSIZE _ S
+                                                                              FSFACE _ FC
+                                                                              FSROTATION _ R
+                                                                              FSDEVICE _ D)))])
+                                      (CL:WHEN CHECKFILESTOO?(* ; 
 
                                                             "apply the device font lookup function.")

-                      (APPLY* (OR [CADR (ASSOC 'FONTSAVAILABLE (CDR (ASSOC DEVICE IMAGESTREAMTYPES]
-                                  (FUNCTION NILL))
-                             FAMILY SIZE FACE ROTATION DEVICE)))])
+                                          (LET [(FN (OR (CAR (GETMULTI IMAGESTREAMTYPES DEVICE
+                                                                    'FONTSAVAILABLE))
+                                                        (FUNCTION \SEARCHFONTFILES]
+
+                                               (* ;; "Until all the device functions take a FONTSPEC")

+
+                                               (CL:IF (EQ 1 (NARGS FN))
+                                                   (APPLY* FN FONTSPEC)
+                                                   (APPLY* FN FAMILY SIZE FACE ROTATION DEVICE))))])
 
 (FONTEXISTS?

-  [LAMBDA (FAMILY SIZE FACE ROTATION DEVICE CHARSET NOCOERCIONS)

-                                                             (* ; "Edited 25-Jul-2025 21:21 by rmk")


-                                                             (* ; "Edited 23-Jul-2025 13:02 by rmk")


-                                                             (* ; "Edited 21-Jul-2025 09:05 by rmk")


-                                                             (* ; "Edited 10-Jul-2025 12:38 by rmk")


-                                                             (* ; "Edited 27-Jun-2025 10:27 by rmk")


-                                                             (* ; "Edited 22-Jun-2025 09:02 by rmk")


-                                                             (* ; "Edited 20-Jun-2025 00:37 by rmk")


-                                                             (* ; "Edited 17-Jun-2025 23:06 by rmk")


-                                                             (* ; "Edited 16-Jun-2025 10:08 by rmk")

+  [LAMBDA (FAMILY SIZE FACE ROTATION DEVICE NOCOERCIONS)
     (* ; "Edited 26-Sep-2025 10:10 by rmk")


+                                                             (* ; "Edited 28-Aug-2025 22:16 by rmk")


+                                                             (* ; "Edited 23-Aug-2025 12:45 by rmk")


+                                                             (* ; "Edited 16-Aug-2025 17:49 by rmk")


+                                                             (* ; "Edited 12-Aug-2025 21:04 by rmk")


+                                                             (* ; "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?  If not NIL, value is either the font in memory or the file that contains information about the requested CHARSET.  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 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.")

 
     (DECLARE
 (GLOBALVARS \FONTSINCORE \FONTEXISTS?-CACHE IMAGESTREAMTYPES))
-    (LET ((FONTSPEC (\FONT.CHECKARGS
 FAMILY SIZE FACE ROTATION DEVICE CHARSET))
-          VAL)
+    (LET ((FONTSPEC (\FONT.CHECKARGS
 FAMILY SIZE FACE ROTATION DEVICE))
+          VAL DEVICE)
          (if
 (type?
 FONTDESCRIPTOR FONTSPEC)
              then
 
                   (* ;; 
 
                  "FAMILY was a font descriptor, unmodified by other args: record that it exists")

 
-                  (SPREADFONTSPEC (FONTPROP
 FONTSPEC 'SPEC))
-                  (PUTMULTI \FONTEXISTS?-CACHE FAMILY SIZE FACE ROTATION DEVICE CHARSET FONTSPEC)
-           else
 (SPREADFONTSPEC FONTSPEC)
-                (if
 (GETMULTI \FONTSINCORE FAMILY SIZE FACE ROTATION DEVICE CHARSET)
-                  elseif
 (SETQ VAL (GETMULTI \FONTEXISTS?-CACHE FAMILY SIZE FACE ROTATION DEVICE 
-                                          CHARSET))
+                  (STOREMULTI \FONTEXISTS?-CACHE FONTSPEC T)
+           else
 (if
 (FETCHMULTI \FONTSINCORE FONTSPEC T)
+                  elseif
 (SETQ VAL (FETCHMULTI \FONTEXISTS?-CACHE FONTSPEC T))
                     then
 (CL:UNLESS (EQ VAL 'NO)
                                 VAL)
-                  else
 (CL:WHEN (MEMB ROTATION '(0 90 270))  (* ; 
-
                                              "Only 0 really exists. We cache just the first file.  ")

-                           (SETQ VAL (OR (CAR (FONTFILES
 FAMILY SIZE FACE 0 DEVICE 0))
-                                         (AND CHARSET (NEQ CHARSET 0)
-                                              (FONTFILES
 FAMILY SIZE FACE 0 DEVICE CHARSET))
-                                         (APPLY* (OR [CADR (ASSOC 'FONTEXISTS?
-                                                                  (CDR (ASSOC DEVICE IMAGESTREAMTYPES
-                                                                              ]
-                                                     (FUNCTION NILL))
-                                                FAMILY SIZE FACE 0 DEVICE CHARSET))))
+                  else
                                       (* ; 
+
                                                   "Only 0 really exists.  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)
+                                                                  '(90 270))
+                                                         (create
 FONTSPEC using
 FONTSPEC FSROTATION _
+                                                                                0)
+                                                         FONTSPEC)))
+                                     (APPLY* (OR (CAR (GETMULTI IMAGESTREAMTYPES DEVICE 'FONTEXISTS?)
+                                                      )
+                                                 (CAR (GETMULTI IMAGESTREAMTYPES DEVICE 
+                                                             'FONTSAVAILABLE))
+                                                 (FUNCTION TRUE))
+                                            FONTSPEC)))
                        (if
 VAL
-                           then
 (PUTMULTI \FONTEXISTS?-CACHE FAMILY SIZE FACE ROTATION DEVICE CHARSET
-                                       VAL)
+                           then
 (STOREMULTI \FONTEXISTS?-CACHE FONTSPEC VAL T)
                          elseif
 [AND (NOT NOCOERCIONS)
-                                     (find
 FS in
 (\COERCEFONTSPEC
 (GETATOMVAL (PACK* DEVICE 
-                                                                                     "FONTCOERCIONS")
-                                                                         )
-                                                        FAMILY SIZE FACE ROTATION DEVICE CHARSET)
-                                        suchthat
 (SETQ VAL (FONTEXISTS?
 FS NIL NIL NIL DEVICE CHARSET
-                                                                  T]
-                           then
 (PUTMULTI \FONTEXISTS?-CACHE FAMILY SIZE FACE ROTATION DEVICE CHARSET
-                                       VAL)
-                         else
 (PUTMULTI \FONTEXISTS?-CACHE FAMILY SIZE FACE ROTATION DEVICE CHARSET
-                                     'NO)
+                                     (find
 FS in
 (COERCEFONTSPEC
 FONTSPEC (FONTDEVICEPROP

+                                                                           DEVICE
+                                                                           'FONTCOERCIONS))
+                                        suchthat
 (SETQ VAL (FONTEXISTS?
 FS NIL NIL NIL NIL T]
+                           then
 
+                                (* ;; "It's coerceable...but not yet coerced.")

+
+                                (STOREMULTI \FONTEXISTS?-CACHE FONTSPEC VAL T)
+                         else
 (STOREMULTI \FONTEXISTS?-CACHE FONTSPEC 'NO T)
                               NIL])
 
-(\FONTSAVAILABLE.INCORE

-  [LAMBDA (FAMILY SIZE FACE ROTATION DEVICE)
                 (* ; "Edited 21-Jul-2025 09:27 by rmk")


-                                                             (* ; "Edited 21-Jun-2025 11:17 by rmk")


-                                                             (* ; "Edited 25-Apr-93 13:07 by rmk:")

-                                                             (* rrb "25-Sep-84 12:10")

-
-    (* ;; "Returns a list of the fonts that are available in core.  * matches anything.  * can appear as a component of FACE")

-
-    (DECLARE
 (GLOBALVARS \FONTSINCORE))
-    (SPREADFONTSPEC (\FONT.CHECKARGS
 FAMILY SIZE FACE ROTATION DEVICE))
-    (COLLECTMULTI \FONTSINCORE (FUNCTION (LAMBDA (FM S FC R D FONT)
-                                           (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 D)
-                                                             (EQ DEVICE '*]
-                                               (push
 $$COLLECT (LIST FM S FC R D)))])
-
 (\SEARCHFONTFILES

-  [LAMBDA (FAMILY SIZE FACE ROTATION DEVICE DIRLST EXTLST)
   (* ; "Edited 21-Jul-2025 08:57 by rmk")


-                                                             (* ; "Edited 10-Jul-2025 11:19 by rmk")


+  [LAMBDA (FONTSPEC)
                                         (* ; "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")


                                                              (* ; "Edited 21-Jun-2025 12:00 by rmk")


-                                                             (* ; "Edited 13-Jun-2025 22:49 by rmk")


-                                                             (* ; "Edited 12-Jun-2025 08:49 by rmk")


                                                              (* ; "Edited 17-May-2025 14:09 by rmk")


-                                                             (* ; "Edited 15-May-2025 23:12 by rmk")


                                                              (* ; "Edited 14-Sep-96 10:54 by rmk:")


                                                              (* ; "Edited  6-Oct-89 12:34 by bvm")

 
     (* ;; "GENERIC FUNCTION")

 
-    (* ;; "returns a list of the fonts that can be read in for a device.  Rotation is ignored because it is assumed that all devices support 0 90 and 270.")

+    (* ;; "Returns a list of the fonts that can be read in for a device.  Rotation is ignored because it is assumed that all devices support 0 90 and 270.  The caller must do any desired coercions.")

+
+    (LET (FAMILY SIZE FACE ROTATION DEVICE)
+         (SPREADFONTSPEC FONTSPEC)
+         (for
 FILEPATTERN FILEDIR FONTSFOUND (FILING.ENUMERATION.DEPTH _ 1)
+            in
 [\FONTFILENAMES
 FAMILY SIZE FACE DEVICE (MKLIST (FONTDEVICEPROP
 DEVICE 
+                                                                      'FONTEXTENSIONS]
+            do
 (SETQ FILEDIR (FILENAMEFIELD FILEPATTERN 'DIRECTORY))
+               (SETQ FILEDIR (CL:IF FILEDIR
+                                 (CONCAT ">" FILEDIR ">")
+                                 ""))
+               (for
 DIR inside
 (FONTDEVICEPROP
 DEVICE 'FONTDIRECTORIES)
+                  eachtime
 
+
+                        (* ;; "The file pattern might have an extending subdirectory (C41>) that might not exist, but DIRECTORYNAMEP makes sure that it does.")

+
+                        (SETQ DIR (CONCAT DIR ">" (OR FILEDIR ""))) when
 (DIRECTORYNAMEP DIR)
+                  do
 (for
 FONTFILE THISFONT in
 (DIRECTORY DIR) eachtime
 (SETQ THISFONT
+                                                                         (FONTSPECFROMFILENAME
 
+                                                                                FONTFILE DEVICE)) 
+
+                                                                     (* ;; 
+
                                                 "make sure the face, size, and family really match.")

+ when
 (AND (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 
+                                                                                     FONTSFOUND)
+                        do
 (push
 FONTSFOUND THISFONT))) finally
 (RETURN (DREVERSE FONTSFOUND])
+
+(FLUSHFONTSINCORE

+  [LAMBDA (FAMILY SIZE FACE ROTATION DEVICE)
                 (* ; "Edited 26-Sep-2025 10:04 by rmk")


+                                                             (* ; "Edited  4-Sep-2025 10:14 by rmk")


+                                                             (* ; "Edited 28-Aug-2025 14:44 by rmk")


+                                                             (* ; "Edited 18-Aug-2025 00:33 by rmk")


+                                                             (* ; "Edited 12-Aug-2025 21:07 by rmk")


+                                                             (* ; "Edited 21-Jul-2025 08:59 by rmk")


+                                                             (* ; "Edited 21-Jun-2025 11:19 by rmk")

+    (DECLARE
 (SPECVARS . T)
+           (GLOBALVARS \FONTSINCORE \FONTEXISTS?-CACHE))
+    (SPREADFONTSPEC (\FONT.CHECKARGS
 FAMILY SIZE FACE ROTATION DEVICE))
+    (LET ((INCOREFLUSHED 0)
+          (EXISTSFLUSHED 0))
+         (DECLARE
 (SPECVARS INCOREFLUSHED EXISTSFLUSHED))
+         [MAPMULTI \FONTSINCORE (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
 INCOREFLUSHED 1)
+                                                (RPLACD DPAIR))]
+         [MAPMULTI \FONTEXISTS?-CACHE (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
 EXISTSFLUSHED 1)
+                                                      (RPLACD DPAIR))]
+         (LIST INCOREFLUSHED EXISTSFLUSHED])
+
+(FINDFONTFILES

+  [LAMBDA (FAMILY SIZE FACE ROTATION DEVICE DIRLST EXTLST)
   (* ; "Edited 28-Aug-2025 14:45 by rmk")


+                                                             (* ; "Edited 25-Aug-2025 10:23 by rmk")


+                                                             (* ; "Edited 21-Aug-2025 18:19 by rmk")


+                                                             (* ; "Edited 12-Aug-2025 21:06 by rmk")


+                                                             (* ; "Edited 21-Jul-2025 09:00 by rmk")


+                                                             (* ; "Edited 29-Jun-2025 09:08 by rmk")

+
+    (* ;; "GENERIC FUNCTION")

+
+    (* ;; "returns a list of the fontfiles that can be read in for a device.  Rotation is ignored because it is assumed that all devices support 0 90 and 270.")

 
-    (* ;; "Just in case the caller hasn't check the arguments:")

+    (* ;; "The same algorithm as \SEARCHFONTFILES except returns the file names.  This may return several files for the same specification")

 
     (SPREADFONTSPEC (\FONT.CHECKARGS
 FAMILY SIZE FACE ROTATION DEVICE))
     (CL:UNLESS DIRLST
-        [SETQ DIRLST (MKLIST (GETATOMVAL (PACK* DEVICE "FONTDIRECTORIES"])
+        [SETQ DIRLST (MKLIST (FONTDEVICEPROP
 DEVICE 'FONTDIRECTORIES])
     (CL:UNLESS EXTLST
-        [SETQ EXTLST (MKLIST (GETATOMVAL (PACK* DEVICE "FONTEXTENSIONS"])
+        [SETQ EXTLST (MKLIST (FONTDEVICEPROP
 DEVICE 'FONTEXTENSIONS])
     (for
 FILEPATTERN FILEDIR FONTSFOUND (FILING.ENUMERATION.DEPTH _ 1)
        IN
 (\FONTFILENAMES
 FAMILY SIZE FACE DEVICE EXTLST)
        do
 (SETQ FILEDIR (FILENAMEFIELD FILEPATTERN 'DIRECTORY))
@@ -2534,36 +3001,58 @@
                                    (* ;; "The file pattern might have an extending subdirectory (C41>) that might not exist, but DIRECTORYNAMEP makes sure that it does.")

 
                                        (SETQ DIR (CONCAT DIR ">" (OR FILEDIR "")))
-             when
 (DIRECTORYNAMEP DIR) do
 (for
 FONTFILE THISFONT in
 (DIRECTORY DIR)
-                                             eachtime
 (SETQ THISFONT (\FONTINFOFROMFILENAME
 FONTFILE
-                                                                            DEVICE T)) 
-
-                                                   (* ;; 
+             when
 (DIRECTORYNAMEP DIR)
+             do
 (for
 FONTFILE FONTSPEC THISFACE in
 (DIRECTORY DIR) eachtime
 (SETQ FONTSPEC
+                                                                             (FONTSPECFROMFILENAME

+                                                                              FONTFILE DEVICE))
+                                                                         (SETQ THISFACE (CADDR 
+                                                                                             FONTSPEC
+                                                                                               )) 
+
+                                                                         (* ;; 
 
                                                 "make sure the face, size, and family really match.")

- when
 (AND (OR (EQ FAMILY '*)
-               (EQ FAMILY (CAR THISFONT)))
+ when
 (AND (NOT (MEMBER FONTFILE FONTSFOUND))
+           (OR (EQ FAMILY '*)
+               (EQ FAMILY (fetch
 (FONTSPEC FSFAMILY) of
 FONTSPEC)))
            (OR (EQ SIZE '*)
-               (EQ SIZE (CADR THISFONT)))
-           (MATCHFONTFACE
 FACE (CADDR THISFONT))) unless
 (MEMBER THISFONT FONTSFOUND)
-                                             do
 (push
 FONTSFOUND THISFONT)))
-       finally
 (RETURN (DREVERSE FONTSFOUND])
+               (EQ SIZE (fetch
 (FONTSPEC FSSIZE) of
 FONTSPEC)))
+           (MATCHFONTFACE
 FACE (fetch
 (FONTSPEC FSFACE) of
 FONTSPEC))) do
 (push
 FONTSFOUND FONTFILE))
+               ) finally
 (RETURN (DREVERSE FONTSFOUND])
 
-(FLUSHFONTSINCORE

-  [LAMBDA (FAMILY SIZE FACE ROTATION DEVICE)
                 (* ; "Edited 21-Jul-2025 08:59 by rmk")


-                                                             (* ; "Edited 21-Jun-2025 11:19 by rmk")

-    (DECLARE
 (GLOBALVARS \FONTSINCORE))
-    (SPREADFONTSPEC (\FONT.CHECKARGS
 FAMILY SIZE FACE ROTATION DEVICE))
-    (MAPMULTI \FONTSINCORE (FUNCTION (LAMBDA (FM S FC R TAIL)
-                                       (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 TAIL))
-                                                         (EQ DEVICE '*]
-                                              (RPLACD TAIL])
+(SORTFONTSPECS

+  [LAMBDA (FONTSPECS)
                                        (* ; "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
+     (FUNCTION (LAMBDA (FS1 FS2)
+                 (SELECTQ (ALPHORDER (fetch
 (FONTSPEC FSDEVICE) of
 FS1)
+                                 (fetch
 (FONTSPEC FSDEVICE) of
 FS2))
+                     (EQUAL (SELECTQ (ALPHORDER (fetch
 (FONTSPEC FSFAMILY) of
 FS1)
+                                            (fetch
 (FONTSPEC FSFAMILY) of
 FS2))
+                                (EQUAL [OR (ILESSP (fetch
 (FONTSPEC FSSIZE) of
 FS1)
+                                                  (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)))
+                                                    (OR (EQUAL FACE1 FACE2)
+                                                        (AND (EQ 'MEDIUM (fetch
 (FONTFACE WEIGHT)
+                                                                            of
 FACE1))
+                                                             (NEQ 'MEDIUM (fetch
 (FONTFACE WEIGHT)
+                                                                             of
 FACE2)))
+                                                        (AND (EQ 'REGULAR (fetch
 (FONTFACE SLOPE)
+                                                                             of
 FACE1))
+                                                             (NEQ 'REGULAR (fetch
 (FONTFACE SLOPE)
+                                                                              of
 FACE2])])
+                                (LESSP T)
+                                NIL))
+                     (LESSP T)
+                     NIL])
+)
+(DEFINEQ
 
 (MATCHFONTFACE

   [LAMBDA (PATTERN FACE)
                                     (* ; "Edited 21-Jun-2025 11:57 by rmk")

@@ -2582,1284 +3071,1512 @@
                   (OR (EQ PEXPANSION (fetch
 (FONTFACE EXPANSION) of
 FACE))
                       (EQ PEXPANSION '*])
 
-(FINDFONTFILES

-  [LAMBDA (FAMILY SIZE FACE ROTATION DEVICE DIRLST EXTLST)
   (* ; "Edited 21-Jul-2025 09:00 by rmk")


-                                                             (* ; "Edited 29-Jun-2025 09:08 by rmk")

+(MAKEFONTFACE

+  [LAMBDA (WEIGHT SLOPE EXPANSION BASE COLOR)
                (* ; "Edited 30-Aug-2025 10:22 by rmk")

+    (CL:UNLESS WEIGHT
+        (SETQ WEIGHT (CL:IF BASE
+                         (fetch
 (FONTFACE WEIGHT) of
 BASE)
+                         'MEDIUM)))
+    (CL:UNLESS SLOPE
+        (SETQ SLOPE (CL:IF BASE
+                        (fetch
 (FONTFACE SLOPE) of
 BASE)
+                        'REGULAR)))
+    (CL:UNLESS EXPANSION
+        (SETQ EXPANSION (CL:IF BASE
+                            (fetch
 (FONTFACE EXPANSION) of
 BASE)
+                            'REGULAR)))
+    (CL:UNLESS COLOR
+        (SETQ COLOR (COPY (fetch
 (FONTFACE COLOR) of
 BASE))))
+    (create
 FONTFACE
+           WEIGHT _ WEIGHT
+           SLOPE _ SLOPE
+           EXPANSION _ EXPANSION
+           COLOR _ COLOR])
+
+(FONTFACETOATOM

+  [LAMBDA (FACE NOERROR)
                                     (* ; "Edited  7-Sep-2025 09:19 by rmk")


+                                                             (* ; "Edited  4-Sep-2025 08:45 by rmk")

+    (if
 (type?
 FONTFACE FACE)
+        then
 [PACK (LIST* (SELECTQ (fetch
 (FONTFACE WEIGHT) of
 FACE)
+                              (MEDIUM 'M)
+                              (BOLD 'B)
+                              (LIGHT 'L)
+                              (fetch
 (FONTFACE WEIGHT) of
 FACE))
+                          (SELECTQ (fetch
 (FONTFACE SLOPE) of
 FACE)
+                              (ITALIC 'I)
+                              (REGULAR 'R)
+                              (fetch
 (FONTFACE SLOPE) of
 FACE))
+                          (SELECTQ (fetch
 (FONTFACE EXPANSION) of
 FACE)
+                              (REGULAR 'R)
+                              (COMPRESSED 'C)
+                              (EXPANDED 'E)
+                              (fetch
 (FONTFACE EXPANSION) of
 FACE))
+                          (CL:WHEN (fetch
 (FONTFACE COLOR) of
 FACE)
+                              (LIST "-" (fetch
 (FONTFACE BACKCOLOR) of
 FACE)
+                                    "-"
+                                    (fetch
 (FONTFACE FORECOLOR) of
 FACE)))]
+      elseif
 (AND FACE (LITATOM FACE)
+                  (MEMB (NTHCHARCODE FACE 1)
+                        (CHARCODE M B L))
+                  (MEMB (NTHCHARCODE FACE 2)
+                        (CHARCODE I R))
+                  (MEMB (NTHCHARCODE FACE 3)
+                        (CHARCODE R C E)))
+        then
 FACE
+      elseif
 (NOT NOERROR)
+        then
 (\ILLEGAL.ARG FACE])
+)
 
-    (* ;; "GENERIC FUNCTION")

+(RPAQ? \FONTSINCORE
 NIL)
 
-    (* ;; "returns a list of the fontfiles that can be read in for a device.  Rotation is ignored because it is assumed that all devices support 0 90 and 270.")

+(RPAQ? \FONTEXISTS?-CACHE
 NIL)
 
-    (* ;; "The same algorithm as \SEARCHFONTFILES except returns the file names.  This may return several files for the same specification")

+(RPAQ? \DEFAULTDEVICEFONTS
 NIL)
+(DECLARE%: DOEVAL@COMPILE DONTCOPY
 
-    (SPREADFONTSPEC (\FONT.CHECKARGS
 FAMILY SIZE FACE ROTATION DEVICE))
-    (CL:UNLESS DIRLST
-        [SETQ DIRLST (MKLIST (GETATOMVAL (PACK* DEVICE "FONTDIRECTORIES"])
-    (CL:UNLESS EXTLST
-        [SETQ EXTLST (MKLIST (GETATOMVAL (PACK* DEVICE "FONTEXTENSIONS"])
-    (for
 FILEPATTERN FILEDIR FONTSFOUND (FILING.ENUMERATION.DEPTH _ 1)
-       IN
 (\FONTFILENAMES
 FAMILY SIZE FACE DEVICE EXTLST)
-       do
 (SETQ FILEDIR (FILENAMEFIELD FILEPATTERN 'DIRECTORY))
-          (SETQ FILEDIR (CL:IF FILEDIR
-                            (CONCAT ">" FILEDIR ">")
-                            ""))
-          (for
 DIR inside
 DIRLST eachtime
 
+(GLOBALVARS \DEFAULTDEVICEFONTS \UNITWIDTHSVECTOR)
+)
 
-                                   (* ;; "The file pattern might have an extending subdirectory (C41>) that might not exist, but DIRECTORYNAMEP makes sure that it does.")

+(RPAQ? \UNITWIDTHSVECTOR
 NIL)
+(DEFINEQ
 
-                                       (SETQ DIR (CONCAT DIR ">" (OR FILEDIR "")))
-             when
 (DIRECTORYNAMEP DIR) do
 (for
 FONTFILE FONTSPEC THISFACE in
 (DIRECTORY DIR)
-                                             eachtime
 (SETQ FONTSPEC (\FONTINFOFROMFILENAME
 FONTFILE
-                                                                            DEVICE))
-                                                   (SETQ THISFACE (CADDR FONTSPEC)) 
+(\UNITWIDTHSVECTOR

+  [LAMBDA NIL
                                                (* ; "Edited 24-Aug-2025 12:39 by rmk")

+                                                             (* JonL " 7-NOV-83 19:23")

+    (SETQ \UNITWIDTHSVECTOR (\ALLOCBLOCK (UNFOLD (IPLUS \MAXTHINCHAR 3)
+                                                WORDSPERCELL)))
+    (for
 I from
 0 to
 (IPLUS \MAXTHINCHAR 2) do
 (\PUTBASE \UNITWIDTHSVECTOR I 1))
+    \UNITWIDTHSVECTOR])
+)
+(DECLARE%: DONTEVAL@LOAD DOCOPY 
 
-                                                   (* ;; 
-
                                                 "make sure the face, size, and family really match.")

- when
 (AND (NOT (MEMBER FONTFILE FONTSFOUND))
-           (OR (EQ FAMILY '*)
-               (EQ FAMILY (CAR FONTSPEC)))
-           (OR (EQ SIZE '*)
-               (EQ SIZE (CADR FONTSPEC)))
-           (MATCHFONTFACE
 FACE THISFACE)) do
 (push
 FONTSFOUND FONTFILE)))
-       finally
 (RETURN (DREVERSE FONTSFOUND])
+(\UNITWIDTHSVECTOR
)
 )
+(DECLARE%: DONTCOPY 
+(* "FOLLOWING DEFINITIONS EXPORTED")(DECLARE%: EVAL@COMPILE
 
-(RPAQ? \FONTEXISTS?-CACHE
 NIL)
+(DATATYPE FONTCLASS
 ((PRETTYFONT# BYTE)
+                     DISPLAYFD PRESSFD INTERPRESSFD OTHERFDS FONTCLASSNAME)
+                    (INIT (DEFPRINT 'FONTCLASS (FUNCTION FONTCLASS.DEFPRINT))))
 
+(DATATYPE FONTDESCRIPTOR
 ((FONTDEVICE POINTER)
+                          (FONTCOMPLETEP FLAG)
+                          (FONTFAMILY POINTER)
+                          (FONTSIZE POINTER)
+                          (FONTFACE POINTER)
+                          (\SFAscent WORD)
+                          (\SFDescent WORD)
+                          (\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.")

+                          (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")

+                          (FONTDEVICESPEC POINTER)           (* ; 
+
        "Holds the spec by which the font is known to the printing device, if coercion has been done")

+                          (OTHERDEVICEFONTPROPS POINTER)     (* ; 
+
                                                 "For individual devices to hang special information")

+                          (FONTSCALE POINTER)
+                          (\SFFACECODE BITS 8)
+                          (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")

+                          (FONTHASLEFTKERNS FLAG)            (* ; 
+
                                        "T if at least one character set has an entry for left kerns")

+                          (FONTEXTRAFIELD2 POINTER))
+                         FONTCHARSETVECTOR _ (\CREATEFONTCHARSETVECTOR)
+                         (INIT (DEFPRINT 'FONTDESCRIPTOR (FUNCTION FONTDESCRIPTOR.DEFPRINT))))
 
+(RECORD FONTFACE
 (WEIGHT SLOPE EXPANSION)
+                 [ACCESSFNS ((COLOR (CDDDR DATUM)
+                                    (RPLACD (CDDR DATUM)
+                                           NEWVALUE))
+                             (BACKCOLOR [COND
+                                           ((CDDDR DATUM)
+                                            (CAR (CDDDR DATUM]
+                                    (PROGN [COND
+                                              ((NULL (CDDDR DATUM))
+                                               (RPLACD (CDDR DATUM)
+                                                      (LIST NIL NIL]
+                                           (RPLACA (CDDDR DATUM)
+                                                  NEWVALUE)))
+                             (FORECOLOR [COND
+                                           ((CDDDR DATUM)
+                                            (CADR (CDDDR DATUM]
+                                    (PROGN [COND
+                                              ((NULL (CDDDR DATUM))
+                                               (RPLACD (CDDR DATUM)
+                                                      (LIST NIL NIL]
+                                           (RPLACA (CDR (CDDDR DATUM))
+                                                  NEWVALUE]
+                 WEIGHT _ 'MEDIUM SLOPE _ 'REGULAR EXPANSION _ 'REGULAR (TYPE?
 LISTP))
 
-(* ; "Functions for DISPLAY IMAGESTREAMTYPES ")

+(DATATYPE CHARSETINFO
 (WIDTHS                                (* ; "The advance-width of each character, an array indexed by charcode.  Usually the same as the imagewidth, but can differ for accents, kerns kerns.  This is what should be used for stringwidth calculations.")

+                             (CSSLUGP FLAG)                  (* ; "True if this is a slug charset")

+                             (CSCOMPLETEP FLAG)              (* ; 
+
    "True if there is no further data to fill in any remaining slug-characters in a non-slug charset")

+                             OFFSETS                         (* ; 
+
                              "Offset of each character into the image bitmap;  X value of left edge")

+                             IMAGEWIDTHS                     (* ; "imagewidths is not automagically allocated since it is not always needed.  But at least some times the IMAGEWIDTHS and WIDTHS vectors are EQ in this case.")

+                             CHARSETBITMAP                   (* ; 
+
                                         "Bitmap containing the character images, indexed by OFFSETS")

+                             YWIDTHS
+                             (CHARSETASCENT WORD)            (* ; 
+
                                                      "Max ascent for all characters in this CHARSET")

+                             (CHARSETDESCENT WORD)           (* ; 
+
                                                     "Max descent for all characters in this CHARSET")

+                             LEFTKERN CSINFOPROPS            (* ; "Alist of extra properties")

+                             (CHARSETNO WORD))               (* ; 
+
                               "The number of this CSINFO in its font--MAX.SMALLP if not initialized")

+                      WIDTHS _ (\CREATECSINFOELEMENT)
+                      OFFSETS _ (\CREATECSINFOELEMENT)
+                      CHARSETNO _ MAX.SMALLP)
 
-(DEFINEQ
+(RECORD FONTSPEC
 (FSFAMILY FSSIZE FSFACE FSROTATION FSDEVICE))
+)
 
-(\CREATEDISPLAYFONT

-  [LAMBDA (FAMILY SIZE FACE ROTATION DEVICE CHARSET)
         (* ; "Edited 13-Jun-2025 22:58 by rmk")


-                                                             (* ; "Edited  9-Jun-2025 17:42 by rmk")


-                                                             (* ; "Edited  7-Jun-2025 15:11 by rmk")


-                                                             (* ; "Edited 23-May-2025 14:59 by rmk")


-                                                             (* ; "Edited 22-May-2025 09:52 by rmk")

+(/DECLAREDATATYPE 'FONTCLASS '(BYTE POINTER POINTER POINTER POINTER POINTER)
+       '((FONTCLASS
 0 (BITS . 7))
+         (FONTCLASS
 2 POINTER)
+         (FONTCLASS
 4 POINTER)
+         (FONTCLASS
 6 POINTER)
+         (FONTCLASS
 8 POINTER)
+         (FONTCLASS
 10 POINTER))
+       '12)
 
-    (* ;; "FONTCREATE1 has determined that there is at least one source file for this font, so the font exists in at least some character sets, although maybe not CHARSET.")

-
-    (* ;; "This would be the right place to do DISPLAYFONTCOERCIONS, but that doesn't work if the target font is only partially instantiated.  \GETCHARSETINFO has to know how to do the font coercion.")

-                                                             (* gbn%: "25-Jan-86 18:02")

-    (LET [(FONTDESC (create
 FONTDESCRIPTOR
-                           FONTDEVICE _ DEVICE
-                           FONTFAMILY _ FAMILY
-                           FONTSIZE _ SIZE
-                           FONTFACE _ FACE
-                           \SFAscent _ 0
-                           \SFDescent _ 0
-                           \SFHeight _ 0
-                           ROTATION _ ROTATION
-                           FONTDEVICESPEC _ (LIST FAMILY SIZE FACE ROTATION DEVICE]
-         (\CREATECHARSET
 CHARSET FONTDESC)
-         FONTDESC])
+(DEFPRINT 'FONTCLASS (FUNCTION FONTCLASS.DEFPRINT))
 
-(\CREATECHARSET.DISPLAY

-  [LAMBDA (FAMILY SIZE FACE ROTATION DEVICE CHARSET FONTDESC)
(* ; "Edited 22-Jul-2025 22:04 by rmk")


-                                                             (* ; "Edited 13-Jul-2025 11:44 by rmk")


-                                                             (* ; "Edited 11-Jul-2025 11:00 by rmk")


-                                                             (* ; "Edited  8-Jul-2025 08:14 by rmk")


-                                                             (* ; "Edited  6-Jul-2025 22:55 by rmk")


-                                                             (* ; "Edited  8-Jun-2025 19:57 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")

+(/DECLAREDATATYPE 'FONTDESCRIPTOR
+       '(POINTER FLAG POINTER POINTER POINTER WORD WORD WORD WORD WORD SIGNEDWORD SIGNEDWORD 
+               SIGNEDWORD POINTER POINTER POINTER POINTER POINTER (BITS 8)
+               WORD POINTER POINTER FLAG POINTER)
+       '((FONTDESCRIPTOR 0 POINTER)
+         (FONTDESCRIPTOR 0 (FLAGBITS . 0))
+         (FONTDESCRIPTOR 2 POINTER)
+         (FONTDESCRIPTOR 4 POINTER)
+         (FONTDESCRIPTOR 6 POINTER)
+         (FONTDESCRIPTOR 8 (BITS . 15))
+         (FONTDESCRIPTOR 9 (BITS . 15))
+         (FONTDESCRIPTOR 10 (BITS . 15))
+         (FONTDESCRIPTOR 11 (BITS . 15))
+         (FONTDESCRIPTOR 12 (BITS . 15))
+         (FONTDESCRIPTOR 13 (SIGNEDBITS . 15))
+         (FONTDESCRIPTOR 14 (SIGNEDBITS . 15))
+         (FONTDESCRIPTOR 15 (SIGNEDBITS . 15))
+         (FONTDESCRIPTOR 16 POINTER)
+         (FONTDESCRIPTOR 18 POINTER)
+         (FONTDESCRIPTOR 20 POINTER)
+         (FONTDESCRIPTOR 22 POINTER)
+         (FONTDESCRIPTOR 24 POINTER)
+         (FONTDESCRIPTOR 26 (BITS . 7))
+         (FONTDESCRIPTOR 27 (BITS . 15))
+         (FONTDESCRIPTOR 28 POINTER)
+         (FONTDESCRIPTOR 30 POINTER)
+         (FONTDESCRIPTOR 30 (FLAGBITS . 0))
+         (FONTDESCRIPTOR 32 POINTER))
+       '34)
 
-    (* ;; "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. ")

+(DEFPRINT 'FONTDESCRIPTOR (FUNCTION FONTDESCRIPTOR.DEFPRINT))
 
-    (* ;; "After that, it uses requested source files and/or DISPLAYGLYPHCOERCIONS to produce and complete the CHARSETINFO:")

+(/DECLAREDATATYPE 'CHARSETINFO '(POINTER FLAG FLAG POINTER POINTER POINTER POINTER WORD WORD POINTER
+                                       POINTER WORD)
+       '((CHARSETINFO 0 POINTER)
+         (CHARSETINFO 0 (FLAGBITS . 0))
+         (CHARSETINFO 0 (FLAGBITS . 16))
+         (CHARSETINFO 2 POINTER)
+         (CHARSETINFO 4 POINTER)
+         (CHARSETINFO 6 POINTER)
+         (CHARSETINFO 8 POINTER)
+         (CHARSETINFO 10 (BITS . 15))
+         (CHARSETINFO 11 (BITS . 15))
+         (CHARSETINFO 12 POINTER)
+         (CHARSETINFO 14 POINTER)
+         (CHARSETINFO 16 (BITS . 15)))
+       '18)
+(DECLARE%: EVAL@COMPILE 
 
-    (* ;; "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.")

+(PUTPROPS FONTASCENT
 MACRO
 ((FONTSPEC)
+                            (ffetch
 \SFAscent of
 (FONTCREATE
 FONTSPEC))))
 
-    (* ;; "If an exact match file cannot be found for a requested rotation, the rotation 0 charset is obtained and rotated.")

+(PUTPROPS FONTDESCENT
 MACRO
 ((FONTSPEC)
+                             (ffetch
 \SFDescent of
 (FONTCREATE
 FONTSPEC))))
 
-    (* ;; "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.")

+(PUTPROPS FONTHEIGHT
 MACRO
 ((FONTSPEC)
+                            (ffetch
 \SFHeight of
 (FONTCREATE
 FONTSPEC))))
 
-    (* ;; "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.")

+(PUTPROPS \FGETOFFSET
 DMACRO
 ((OFFSETSBLOCK CHAR8CODE)
+                              (\GETBASE OFFSETSBLOCK CHAR8CODE)))
 
-    (* ;; "If all else fails, it looks for the next charset in the coercion list, and fills that in with further coercions for missing characters.")

+(PUTPROPS \FSETOFFSET
 DMACRO
 ((OFFSETSBLOCK CHAR8CODE OFFSET)
+                              (\PUTBASE OFFSETSBLOCK CHAR8CODE OFFSET)))
 
-    (* ;; "")

+(PUTPROPS \FGETWIDTH
 DMACRO
 ((WIDTHSBLOCK CHAR8CODE)
+                             (\GETBASE WIDTHSBLOCK CHAR8CODE)))
 
-    (* ;; "Maybe nobody cares about Classic 36...let's remove that coercion and see what happens.")

+(PUTPROPS \FSETWIDTH
 DMACRO
 ((WIDTHSBLOCK CHAR8CODE VAL)
+                             (\PUTBASE WIDTHSBLOCK CHAR8CODE VAL)))
 
-    (* ;; "There is a strategy question about the priority of charset coercion with respect to the other transformations.  It might seem better to coerce to a real charset, if any, before apply the algorithmic bolding/italicizing.  But the glitch is that nonexistent MODERN 36 BOLD would first coerce to CLASSIC 36, which also doesn't exist.   But CLASSIC 36 has a font-substitution to CLASSIC 24, and the result would be the glyphs for CLASSIC 24-BRR, which  turns out to be much less attractive and appropriate than the boldified version of MODERN36-MRR.  So, to get MODERN36 bold, either the CHARSET coercion has to come after the bolding, the coercion of CLASSIC36 to CLASSIC24 has to be removed or refined, or the whole-font substitution should come after the charset coercion. ")

+(PUTPROPS \FGETCHARWIDTH
 MACRO
 (OPENLAMBDA (FONTDESC CHARCODE)
+                                 (\FGETWIDTH (ffetch
 (CHARSETINFO WIDTHS) of
 (\INSURECHARSETINFO
+                                                                              FONTDESC
+                                                                              (\CHARSET CHARCODE)))
+                                        (\CHAR8CODE CHARCODE))))
 
-    (DECLARE
 (GLOBALVARS DISPLAYFONTCOERCIONS DISPLAYGLYPHCOERCIONS))
-    (LET (CSINFO)
+(PUTPROPS \FSETCHARWIDTH
 MACRO
 (OPENLAMBDA (FONTDESC CHARCODE WIDTH)
+                                 (\FSETWIDTH (ffetch
 (CHARSETINFO WIDTHS) of
 (\INSURECHARSETINFO
+                                                                              FONTDESC
+                                                                              (\CHARSET CHARCODE)))
+                                        (\CHAR8CODE CHARCODE)
+                                        WIDTH)))
 
-         (* ;; "If no DISPLAYFONTCOERCIONS, skip that first \COERCECHARSET call--easier debugging of the other case.")

+(PUTPROPS \FGETIMAGEWIDTH
 MACRO
 ((IMAGEWIDTHSBLOCK CHAR8CODE)
+                                 (\GETBASE IMAGEWIDTHSBLOCK CHAR8CODE)))
 
-         (SETQ CSINFO (if
 (AND DISPLAYFONTCOERCIONS (\COERCECHARSET
 FAMILY SIZE FACE ROTATION DEVICE
-                                                           CHARSET DISPLAYFONTCOERCIONS))
-                        elseif
 (SETQ CSINFO (OR (\READCHARSET
 FAMILY SIZE FACE ROTATION DEVICE 
-                                                       CHARSET)
-                                                (\COERCECHARSET
 FAMILY SIZE FACE ROTATION DEVICE 
-                                                       CHARSET DISPLAYGLYPHCOERCIONS)))
-                          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.")

+(PUTPROPS \FSETIMAGEWIDTH
 DMACRO
 ((WIDTHSBLOCK INDEX WIDTH)
+                                  (\PUTBASE WIDTHSBLOCK INDEX WIDTH)))
+)
+(DECLARE%: EVAL@COMPILE 
 
-                               (COMPLETE.CHARSET
 CSINFO FAMILY SIZE FACE ROTATION DEVICE CHARSET 
-                                      DISPLAYGLYPHCOERCIONS FONTDESC)
-                        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
 FAMILY SIZE FACE 0 
-                                                            DEVICE CHARSET FONTDESC))
-                                      (\SFROTATECSINFO
 CSINFO ROTATION))
-                        elseif
 (OR (KANJICHARSETP CHARSET)
-                                   (CHINESECHARSETP CHARSET))
-                          then
 (CL:UNLESS (EQUAL FACE '(MEDIUM REGULAR REGULAR))
-                                   (\CREATECHARSET.DISPLAY
 FAMILY SIZE '(MEDIUM REGULAR REGULAR)
-                                          ROTATION DEVICE CHARSET FONTDESC))
-                        elseif
 (EQ 'BOLD (fetch
 (FONTFACE WEIGHT) of
 FACE))
-                          then
 (MAKEBOLD.CHARSET
 FAMILY SIZE FACE ROTATION DEVICE CHARSET 
-                                      DISPLAYGLYPHCOERCIONS)
-                        elseif
 (EQ 'ITALIC (fetch
 (FONTFACE SLOPE) of
 FACE))
-                          then
 (MAKEITALIC.CHARSET
 FAMILY SIZE FACE ROTATION DEVICE CHARSET 
-                                      DISPLAYGLYPHCOERCIONS)))
-         CSINFO])
+(PUTPROPS \GETCHARSETINFO
 MACRO
 ((FONTDESC CHARSET)
 
-(\FONTEXISTS?.DISPLAY

-  [LAMBDA (FAMILY SIZE FACE ROTATION DEVICE CHARSET)
         (* ; "Edited 25-Jul-2025 21:38 by rmk")


-                                                             (* ; "Edited 13-Jul-2025 11:45 by rmk")


-                                                             (* ; "Edited 22-Jun-2025 08:53 by rmk")

+                                 (* ;; 
+
                 "Temporary until other callers of \GETCHARSETINFO are changes to \INSURECHARSETINFO")

 
-    (* ;; "Order doesn't matter here, only need one to work")

+                                 (* ;; 
+
                          "Fetches the charsetinfo for charset CHARSET in fontdescriptor FONTDESC.  ")

 
-    (OR (AND (EQ 'BOLD (fetch
 (FONTFACE WEIGHT) of
 FACE))
-             (FONTEXISTS?
 FAMILY SIZE (create
 FONTFACE using
 FACE WEIGHT _ 'MEDIUM)
-                    ROTATION DEVICE CHARSET))
-        (AND (EQ 'ITALIC (fetch
 (FONTFACE SLOPE) of
 FACE))
-             (FONTEXISTS?
 FAMILY SIZE (create
 FONTFACE using
 FACE SLOPE _ 'REGULAR)
-                    ROTATION DEVICE CHARSET))
-        (for
 C VAL in
 (\COERCEFONTSPEC
 (APPEND DISPLAYFONTCOERCIONS DISPLAYGLYPHCOERCIONS)
-                             FAMILY SIZE FACE ROTATION DEVICE CHARSET) when
 (SETQ VAL (FONTEXISTS?

-                                                                                       C))
-           do
 (RETURN VAL])
-)
-(DEFINEQ
+                                 (* ;; 
+
       "NOTE Current \GETCHARSETINFO takes the vector, not the font, as does current \SETCHARSETINFO")

 
-(STRIKEFONT.FILEP

-  [LAMBDA (FILE)
                                             (* ; "Edited 15-May-2025 17:47 by rmk")

+                                 (\GETBASEPTR (ffetch
 FONTCHARSETVECTOR of
 FONTDESC)
+                                        (UNFOLD CHARSET 2))))
 
-    (* ;; "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")

+(PUTPROPS \SETCHARSETINFO
 MACRO
 ((FONTDESC CHARSET CSINFO)
+                                 (\RPLPTR (fetch
 (FONTDESCRIPTOR FONTCHARSETVECTOR) of
 FONTDESC)
+                                        (UNFOLD CHARSET 2)
+                                        CSINFO)))
 
-    (* ;; "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'")

+(PUTPROPS \INSURECHARSETINFO
 MACRO
 [OPENLAMBDA (FONTDESC CHARSET)
 
-    (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))])
+                                 (* ;; "fetches the charsetinfo for charset CHARSET in fontdescriptor FONTDESC.  If NIL, then creates and installs the required charset, maybe a slug (with CSSLUGP T).")

 
-(STRIKEFONT.GETCHARSET

-  [LAMBDA (STRM)
                                             (* ; "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")

+                                     (OR (\GETCHARSETINFO FONTDESC CHARSET)
+                                         (\SETCHARSETINFO FONTDESC CHARSET (\CREATECHARSET
 CHARSET 
+                                                                                  FONTDESC])
 
-    (* ;; "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 (IPLUS (IDIFFERENCE LASTCHAR FIRSTCHAR)
-                                    3))                      (* ; 
-
                                    "(SETQ OFFSETS (ARRAY (IPLUS \MAXCHAR 3) (QUOTE SMALLPOSP) 0 0))")

-             (SETQ OFFSETS (fetch
 (CHARSETINFO OFFSETS) of
 CSINFO))
-                                                             (* ; "initialise the offsets to 0")

-             (for
 I from
 0 to
 (IPLUS \MAXTHINCHAR 2) do
 (\FSETOFFSET OFFSETS I 0))
-                                                             (* ; 
-
                                                             "(AIN OFFSETS FIRSTCHAR NUMBCODES STRM)")

-             (for
 I from
 FIRSTCHAR as
 J from
 1 to
 NUMBCODES do
 (\FSETOFFSET OFFSETS I (\WIN STRM)))
-             (SETQ WIDTHS (fetch
 (CHARSETINFO WIDTHS) of
 CSINFO))
-             (for
 I from
 0 to
 (IPLUS \MAXTHINCHAR 2) do
 (\FSETWIDTH WIDTHS I 0))
-                                                             (* ; 
-
     "(replace WIDTHS of (CHARSETINFO CSINFO) with (ARRAY (IPLUS \MAXCHAR 3) (QUOTE SMALLPOSP) 0 0))")

-             (\FONTRESETCHARWIDTHS
 CSINFO FIRSTCHAR LASTCHAR)
-             (replace
 (CHARSETINFO IMAGEWIDTHS) of
 CSINFO with
 (fetch
 (CHARSETINFO WIDTHS)
-                                                                  of
 CSINFO))
-             CSINFO))])
+(PUTPROPS \CREATECSINFOELEMENT
 MACRO
 (NIL (\ALLOCBLOCK (FOLDHI (IPLUS \MAXTHINCHAR 3)
+                                                              WORDSPERCELL))))
 
-(WRITESTRIKEFONTFILE

-  [LAMBDA (FONT CHARSET FILE)
                                (* ; "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 DUMMYCHAR DUMMYOFFSET 
-                PREVIOUSOFFSET OFFSETS)
-         (SETQ CSINFO (\INSURECHARSETINFO CHARSET FONT T))
-         (CL:UNLESS CSINFO (ERROR "Couldn't find charset " CHARSET))
-         (SETQ WIDTHS (fetch
 (CHARSETINFO WIDTHS) of
 CSINFO))
-         (SETQ OFFSETS (fetch
 (CHARSETINFO OFFSETS) of
 CSINFO))
-         (SETQ DUMMYOFFSET (\FGETOFFSET OFFSETS DUMMYINDEX))
-         [SETQ FIRSTCHAR (for
 I from
 0 to
 MAXCODE thereis
 (NOT (EQ (\FGETOFFSET OFFSETS I)
-                                                                   DUMMYOFFSET]
-         [SETQ LASTCHAR (for
 I from
 MAXCODE to
 0 by
 -1 thereis
 (NOT (EQ (\FGETOFFSET OFFSETS I)
-                                                                        DUMMYOFFSET]
-         (SETQ DUMMYCHAR (ADD1 LASTCHAR))
-         [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
 DUMMYINDEX 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 WIDTH OFFSET (CODE _ 0) from
 FIRSTCHAR to
 DUMMYCHAR first
 (\WOUT STREAM CODE)
-            do
 (SETQ OFFSET (\FGETOFFSET OFFSETS I))
-               (SETQ WIDTH (\FGETWIDTH WIDTHS I))
-               (CL:UNLESS (AND (IEQP OFFSET DUMMYOFFSET)
-                               (NOT (IEQP I DUMMYCHAR)))
-                      (ADD
 CODE WIDTH))
-               (\WOUT STREAM CODE))
-         (CLOSEF STREAM])
+(PUTPROPS \CREATEFONTCHARSETVECTOR
 MACRO
 (NIL 
 
-(STRIKECSINFO

-  [LAMBDA (CSINFO)
                                       (* ; "Edited 27-Apr-89 13:39 by atm")

+                                            (* ;; "Allocates a block for the character set records, including one extra slot to hold the common slug charsetinfo")

 
-    (* ;; "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.")

+                                              (\ALLOCBLOCK (IPLUS 2 \MAXCHARSET)
+                                                     T)))
 
-    (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]
+(PUTPROPS CHARSETPROP
 MACRO
 [ARGS (if
 (CDDR ARGS)
+                                      then
 `(PUTMULTI (fetch
 (CHARSETINFO CSINFOPROPS)
+                                                         of
 ,(CAR ARGS))
+                                                   ,(CADR ARGS)
+                                                   ,(CADDR ARGS))
+                                    else
 `(GETMULTI (fetch
 (CHARSETINFO CSINFOPROPS)
+                                                       of
 ,(CAR ARGS))
+                                                 ,(CADR ARGS])
+)
 
-     (* ;; "")

+(PUTPROPS CHARSETPROP
 ARGNAMES
 (CSINFO PROP NEWVALUE))
+(DECLARE%: EVAL@COMPILE 
 
-     (* ;; "Initialize new offsets vector")

+(RPAQ SLUGCHARINDEX
 (ADD1 \MAXTHINCHAR))
 
-     (* ;; "")

+(RPAQ SLUGCHARSET
 (ADD1 \MAXCHARSET))
 
-          (SETQ NEWOFFSETS (\CREATECSINFOELEMENT))
-          (for
 I from
 0 to
 (IPLUS \MAXTHINCHAR 2) do
 (\FSETOFFSET NEWOFFSETS I 0))
-          (\FSETOFFSET NEWOFFSETS (ADD1 \MAXTHINCHAR)
-                 BMWIDTH)
 
-     (* ;; "")

+(CONSTANTS (SLUGCHARINDEX (ADD1 \MAXTHINCHAR))
+       (SLUGCHARSET (ADD1 \MAXCHARSET)))
+)
+(DECLARE%: EVAL@COMPILE 
 
-     (* ;; "Adjust bitmap with so width = imagewidth, fill offsets")

+(PUTPROPS LEGACYFONTS
 MACRO
 ((F . FORMS)                     (* ; 
+
                                                        "Execute FORMS in a  legacy font environment")

+                             (RESETLST
+                                 (RESETSAVE \FONTSINCORE NIL)
+                                 (RESETSAVE \FONTEXISTS?-CACHE)
+                                 (RESETSAVE DISPLAYFONTCOERCIONS)
+                                 (RESETSAVE DISPLAYCHARCOERCIONS)
+                                 (RESETSAVE DISPLAYFONTEXTENSIONS '(DISPLAYFONT))
+                                 (RESETSAVE DISPLAYFONTDIRECTORIES (MEDLEYDIR "fonts>displayfonts>"))
+                                 (PROGN F . FORMS))))
+)
 
-     (* ;; "")

+(* "END EXPORTED DEFINITIONS")
 
-          (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]
 
-     (* ;; "")

+(DECLARE%: EVAL@COMPILE 
 
-     (* ;; "Make new CSInfo record withs IMAGEWIDTHS, WIDTHS the same")

+(PUTPROPS INDIRECTCHARSETP
 MACRO
 [(CSINFO FONT)
 
-     (* ;; "")

+                                  (* ;; "An indirect points somewhere else")

 
-          (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])
+                                  (LET [(SOURCE (CL:UNLESS (fetch
 (CHARSETINFO CSSLUGP) of
 CSINFO)
+                                                    (CHARSETPROP CSINFO 'SOURCE))]
+                                       (CL:WHEN SOURCE
+                                           [NOT (EQUAL SOURCE (FONTPROP
 FONT 'DEVICESPEC])])
+)
 )
-
-
-
-(* ; "Bitmap faking")

-
 (DEFINEQ
 
-(MAKEBOLD.CHARSET

-  [LAMBDA (FAMILY SIZE FACE ROTATION DEVICE CHARSET COERCIONS)

-                                                             (* ; "Edited 21-Jun-2025 09:10 by rmk")

+(FONTDESCRIPTOR.DEFPRINT

+  [LAMBDA (FONT STREAM)
                                      (* ; "Edited 10-Jul-2025 09:32 by rmk")


+                                                             (* ; "Edited 14-Dec-2024 09:13 by rmk")

+    (LET ((LOC (LOC FONT))
+          (FACE (fetch
 (FONTDESCRIPTOR FONTFACE) of
 FONT)))
 
-    (* ;; "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.")

+         (* ;; "Could lowercase the family, but maybe too dangerous if a BREAK on L-CASE.")

 
-    (LET ((FONTX (FONTCREATE1
 FAMILY SIZE (create
 FONTFACE using
 FACE WEIGHT _ 'MEDIUM)
-                        0
-                        'DISPLAY CHARSET))
-          CSINFO SOURCECSINFO)
-         (CL:WHEN (AND FONTX (SETQ CSINFO (\XGETCHARSETINFO FONTX CHARSET))
-                       (NOT (fetch
 (CHARSETINFO CSSLUGP) of
 CSINFO)))
-             (SETQ CSINFO (create
 CHARSETINFO copying
 CSINFO))
-             (for
 THINCODE from
 0 to
 \MAXTHINCHAR
-                do
 (if
 (SLUGCHARP.DISPLAY
 THINCODE CSINFO)
-                       then
 
-                            (* ;; "Look for a bold glyph for THINCODE lurking somewhere down the chain, copy it up.  There may be different sources for different codes.")

+         (* ;; "Somehow flag the device too?")

 
-                            (CL:WHEN (SETQ SOURCECSINFO
-                                      (\COERCECHARSET
 FAMILY SIZE FACE ROTATION DEVICE CHARSET 
-                                             COERCIONS THINCODE))
-                                   (\MOVEFONTCHAR
 SOURCECSINFO CSINFO THINCODE THINCODE))
-                     else
 (MAKEBOLD.CHAR
 THINCODE CSINFO)))
-             (replace
 (CHARSETINFO CSCOMPLETEP) of
 CSINFO with
 T)
-             CSINFO)])
+         (CONS (CONCAT "{" (fetch
 (FONTDESCRIPTOR FONTFAMILY) of
 FONT)
+                      (fetch
 (FONTDESCRIPTOR FONTSIZE) of
 FONT)
+                      "-"
+                      (SELECTQ (fetch
 (FONTFACE WEIGHT) of
 FACE)
+                          (MEDIUM 'M)
+                          (BOLD 'B)
+                          (LIGHT 'L)
+                          (fetch
 (FONTFACE WEIGHT) of
 FACE))
+                      (SELECTQ (fetch
 (FONTFACE SLOPE) of
 FACE)
+                          (ITALIC 'I)
+                          (REGULAR 'R)
+                          (fetch
 (FONTFACE SLOPE) of
 FACE))
+                      (SELECTQ (fetch
 (FONTFACE EXPANSION) of
 FACE)
+                          (REGULAR 'R)
+                          (COMPRESSED 'C)
+                          (EXPANDED 'E)
+                          (fetch
 (FONTFACE EXPANSION) of
 FACE))
+                      "/"
+                      (OCTALSTRING (CAR LOC))
+                      ","
+                      (OCTALSTRING (CDR LOC))
+                      "}"])
 
-(MAKEBOLD.CHAR

-  [LAMBDA (THINCODE CSINFO)
                                  (* ; "Edited 17-Jun-2025 08:22 by rmk")

+(FONTCLASS.DEFPRINT

+  [LAMBDA (FONTCLASS
 STREAM)
                                 (* ; "Edited 14-Dec-2024 16:51 by rmk")

+    (LET ((LOC (LOC FONTCLASS)))
+         (CONS (CONCAT "{" (OR (fetch
 (FONTCLASS
 FONTCLASSNAME) of
 FONTCLASS)
+                               'FONTCLASS)
+                      "/"
+                      (OCTALSTRING (CAR LOC))
+                      ","
+                      (OCTALSTRING (CDR LOC))
+                      "}"])
+)
 
-    (* ;; "Replaces the bitmap for THINCODE in CSINFO 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.")

+(/DECLAREDATATYPE 'FONTCLASS '(BYTE POINTER POINTER POINTER POINTER POINTER)
+       '((FONTCLASS
 0 (BITS . 7))
+         (FONTCLASS
 2 POINTER)
+         (FONTCLASS
 4 POINTER)
+         (FONTCLASS
 6 POINTER)
+         (FONTCLASS
 8 POINTER)
+         (FONTCLASS
 10 POINTER))
+       '12)
 
-    (CL:UNLESS (SLUGCHARP.DISPLAY
 THINCODE CSINFO)
-        (LET* [(OLDCHARBITMAP (\GETCHARBITMAP.CSINFO
 THINCODE CSINFO))
-               (NEWCHARBITMAP (BITMAPCREATE (ADD1 (fetch
 BITMAPWIDTH of
 OLDCHARBITMAP))
-                                     (fetch
 BITMAPHEIGHT of
 OLDCHARBITMAP)))
-               (CWIDTH (\FGETWIDTH (fetch
 (CHARSETINFO WIDTHS) of
 CSINFO)
-                              THINCODE))
-               (HEIGHT (IPLUS (fetch
 (CHARSETINFO CHARSETASCENT) of
 CSINFO)
-                              (fetch
 (CHARSETINFO CHARSETDESCENT) of
 CSINFO]
+(DEFPRINT 'FONTCLASS (FUNCTION FONTCLASS.DEFPRINT))
 
-              (* ;; 
-
             "Paint in a shifted copy 1 bit over. The new bitmap is 1 bit wider, to keep the margin.")

+(/DECLAREDATATYPE 'FONTDESCRIPTOR
+       '(POINTER FLAG POINTER POINTER POINTER WORD WORD WORD WORD WORD SIGNEDWORD SIGNEDWORD 
+               SIGNEDWORD POINTER POINTER POINTER POINTER POINTER (BITS 8)
+               WORD POINTER POINTER FLAG POINTER)
+       '((FONTDESCRIPTOR 0 POINTER)
+         (FONTDESCRIPTOR 0 (FLAGBITS . 0))
+         (FONTDESCRIPTOR 2 POINTER)
+         (FONTDESCRIPTOR 4 POINTER)
+         (FONTDESCRIPTOR 6 POINTER)
+         (FONTDESCRIPTOR 8 (BITS . 15))
+         (FONTDESCRIPTOR 9 (BITS . 15))
+         (FONTDESCRIPTOR 10 (BITS . 15))
+         (FONTDESCRIPTOR 11 (BITS . 15))
+         (FONTDESCRIPTOR 12 (BITS . 15))
+         (FONTDESCRIPTOR 13 (SIGNEDBITS . 15))
+         (FONTDESCRIPTOR 14 (SIGNEDBITS . 15))
+         (FONTDESCRIPTOR 15 (SIGNEDBITS . 15))
+         (FONTDESCRIPTOR 16 POINTER)
+         (FONTDESCRIPTOR 18 POINTER)
+         (FONTDESCRIPTOR 20 POINTER)
+         (FONTDESCRIPTOR 22 POINTER)
+         (FONTDESCRIPTOR 24 POINTER)
+         (FONTDESCRIPTOR 26 (BITS . 7))
+         (FONTDESCRIPTOR 27 (BITS . 15))
+         (FONTDESCRIPTOR 28 POINTER)
+         (FONTDESCRIPTOR 30 POINTER)
+         (FONTDESCRIPTOR 30 (FLAGBITS . 0))
+         (FONTDESCRIPTOR 32 POINTER))
+       '34)
 
-              (BITBLT OLDCHARBITMAP 0 0 NEWCHARBITMAP 0 0 CWIDTH HEIGHT 'INPUT 'REPLACE)
-              (BITBLT OLDCHARBITMAP 0 0 NEWCHARBITMAP 1 0 CWIDTH HEIGHT 'INPUT 'PAINT)
-              (\PUTCHARBITMAP.CSINFO
 THINCODE CSINFO NEWCHARBITMAP)))])
+(DEFPRINT 'FONTDESCRIPTOR (FUNCTION FONTDESCRIPTOR.DEFPRINT))
 
-(MAKEITALIC.CHARSET

-  [LAMBDA (FAMILY SIZE FACE ROTATION DEVICE CHARSET COERCIONS)

-                                                             (* ; "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.")

+(/DECLAREDATATYPE 'CHARSETINFO '(POINTER FLAG FLAG POINTER POINTER POINTER POINTER WORD WORD POINTER
+                                       POINTER WORD)
+       '((CHARSETINFO 0 POINTER)
+         (CHARSETINFO 0 (FLAGBITS . 0))
+         (CHARSETINFO 0 (FLAGBITS . 16))
+         (CHARSETINFO 2 POINTER)
+         (CHARSETINFO 4 POINTER)
+         (CHARSETINFO 6 POINTER)
+         (CHARSETINFO 8 POINTER)
+         (CHARSETINFO 10 (BITS . 15))
+         (CHARSETINFO 11 (BITS . 15))
+         (CHARSETINFO 12 POINTER)
+         (CHARSETINFO 14 POINTER)
+         (CHARSETINFO 16 (BITS . 15)))
+       '18)
+(ADDTOVAR SYSTEMRECLST
 
-    (LET ((FONTX (FONTCREATE1
 FAMILY SIZE (create
 FONTFACE using
 FACE SLOPE _ 'REGULAR)
-                        0
-                        'DISPLAY CHARSET))
-          CSINFO SOURCECSINFO)
-         (CL:WHEN (AND FONTX (SETQ CSINFO (\XGETCHARSETINFO FONTX CHARSET))
-                       (NOT (fetch
 (CHARSETINFO CSSLUGP) of
 CSINFO)))
-             (SETQ CSINFO (create
 CHARSETINFO copying
 CSINFO))
-             (for
 THINCODE from
 0 to
 \MAXTHINCHAR
-                do
 (if
 (SLUGCHARP.DISPLAY
 THINCODE CSINFO)
-                       then
 
-                            (* ;; "Look for an italic glyph for THINCODE lurking somewhere down the chain, copy it up. There may be different sources for different codes.")

+(DATATYPE FONTCLASS
 ((PRETTYFONT# BYTE)
+                     DISPLAYFD PRESSFD INTERPRESSFD OTHERFDS FONTCLASSNAME))
 
-                            (CL:WHEN (SETQ SOURCECSINFO
-                                      (\COERCECHARSET
 FAMILY SIZE FACE ROTATION DEVICE CHARSET 
-                                             COERCIONS THINCODE))
-                                   (\MOVEFONTCHAR
 SOURCECSINFO CSINFO THINCODE THINCODE))
-                     else
 (MAKEITALIC.CHAR
 THINCODE CSINFO)))
-             (replace
 (CHARSETINFO CSCOMPLETEP) of
 CSINFO with
 T)
-             CSINFO)])
+(DATATYPE FONTDESCRIPTOR
 ((FONTDEVICE POINTER)
+                          (FONTCOMPLETEP FLAG)
+                          (FONTFAMILY POINTER)
+                          (FONTSIZE POINTER)
+                          (FONTFACE POINTER)
+                          (\SFAscent WORD)
+                          (\SFDescent WORD)
+                          (\SFHeight WORD)
+                          (ROTATION WORD)
+                          (FONTSLUGWIDTH WORD)
+                          (NIL SIGNEDWORD)
+                          (NIL SIGNEDWORD)
+                          (NIL SIGNEDWORD)
+                          (FONTTOMCCSFN POINTER)
+                          (NIL POINTER)
+                          (FONTDEVICESPEC POINTER)
+                          (OTHERDEVICEFONTPROPS POINTER)
+                          (FONTSCALE POINTER)
+                          (\SFFACECODE BITS 8)
+                          (FONTAVGCHARWIDTH WORD)
+                          (FONTCHARENCODING POINTER)
+                          (FONTCHARSETVECTOR POINTER)
+                          (FONTHASLEFTKERNS FLAG)
+                          (FONTEXTRAFIELD2 POINTER)))
 
-(MAKEITALIC.CHAR

-  [LAMBDA (THINCODE CSINFO)
                                  (* ; "Edited 18-Jun-2025 14:12 by rmk")


-                                                             (* ; "Edited 17-Jun-2025 09:54 by rmk")

+(DATATYPE CHARSETINFO
 (WIDTHS (CSSLUGP FLAG)
+                             (CSCOMPLETEP FLAG)
+                             OFFSETS IMAGEWIDTHS CHARSETBITMAP YWIDTHS (CHARSETASCENT WORD)
+                             (CHARSETDESCENT WORD)
+                             LEFTKERN CSINFOPROPS (CHARSETNO WORD)))
+)
+(DEFINEQ
 
-    (* ;; "Replaces the bitmap for THINCODE in CSINFO with a slanted one:  It shifts rows to the right as a function of their vertical position. ")

+(\CREATEKERNELEMENT

+  [LAMBDA NIL
                                                (* ; "Edited  8-Jul-2025 22:33 by rmk")


+                                                             (* ; "Edited 17-May-2025 09:36 by rmk")

 
-    (CL:UNLESS (SLUGCHARP.DISPLAY
 THINCODE CSINFO)
-        (LET* ((OLDBITMAP (\GETCHARBITMAP.CSINFO
 THINCODE CSINFO))
-               (NEWBITMAP (BITMAPCREATE (fetch
 BITMAPWIDTH of
 OLDBITMAP)
-                                 (fetch
 BITMAPHEIGHT of
 OLDBITMAP)))
-               (WIDTH (\FGETWIDTH (fetch
 (CHARSETINFO WIDTHS) of
 CSINFO)
-                             THINCODE))
-               (ASCENT (fetch
 (CHARSETINFO CHARSETASCENT) of
 CSINFO))
-               (DESCENT (fetch
 (CHARSETINFO CHARSETDESCENT) of
 CSINFO))
-               (HEIGHT (IPLUS ASCENT DESCENT)))
-              [for
 ROW XX XN YN YX from
 (IMINUS (IQUOTIENT (IPLUS DESCENT 3)
-                                                       4)) to
 (IQUOTIENT (IPLUS ASCENT 3)
-                                                                     4)
-                 do
 (SETQ XN (IMIN WIDTH (IMAX ROW 0)))
-                    (SETQ XX (IMIN WIDTH (IMAX (IPLUS WIDTH ROW)
-                                               0)))
-                    [SETQ YN (IMAX 0 (IPLUS DESCENT (ITIMES ROW 4]
-                    [SETQ YX (IMIN HEIGHT (IPLUS DESCENT (ITIMES (ADD1 ROW)
-                                                                4]
-                    (CL:WHEN (AND (IGREATERP XX XN)
-                                  (IGREATERP YX YN))
-                        (BITBLT OLDBITMAP 0 YN NEWBITMAP XN YN (IDIFFERENCE XX XN)
-                               (IDIFFERENCE YX YN)
-                               'INPUT
-                               'REPLACE))]
-              (\PUTCHARBITMAP.CSINFO
 THINCODE CSINFO NEWBITMAP)))])
+    (* ;; "ARRAY not CL:MAKE-ARRAY for MAKEINIT.")

 
-(\SFMAKEBOLD

-  [LAMBDA (CSINFO)
                                           (* ; "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 (ADD1 \MAXCHAR)))
-         (SETQ SLUGWIDTH (\FGETWIDTH WIDTHS (ADD1 \MAXCHAR)))
-         (for
 I from
 0 to
 \MAXCHAR 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])
+    (ARRAY (IPLUS \MAXTHINCHAR 3)
+           'POINTER 0 0])
 
-(\SFMAKEITALIC

-  [LAMBDA (CSINFO)
                                           (* ; "Edited 16-Jun-2025 23:20 by rmk")

-                                                             (* gbn "18-Sep-85 17:57")

-    (LET ((WIDTHS (fetch
 (CHARSETINFO WIDTHS) of
 CSINFO))
-          (OFFSETS (fetch
 (CHARSETINFO OFFSETS) of
 CSINFO))
-          (ASCENT (fetch
 (CHARSETINFO CHARSETASCENT) of
 CSINFO))
-          (DESCENT (fetch
 (CHARSETINFO CHARSETDESCENT) of
 CSINFO))
-          (OLDBITMAP (fetch
 (CHARSETINFO CHARSETBITMAP) of
 CSINFO))
-          HEIGHT OFFSET NEWBITMAP WIDTH SLUGOFFSET SLUGWIDTH N M R XN XX YN YX)
-         (SETQ HEIGHT (IPLUS ASCENT DESCENT))
-         (SETQ NEWBITMAP (BITMAPCREATE (fetch
 BITMAPWIDTH of
 OLDBITMAP)
-                                (fetch
 BITMAPHEIGHT of
 OLDBITMAP)))
-         (SETQ SLUGOFFSET (\FGETOFFSET OFFSETS (ADD1 \MAXTHINCHAR)))
-         (SETQ SLUGWIDTH (\FGETWIDTH WIDTHS (ADD1 \MAXTHINCHAR)))
-         (SETQ N (IDIFFERENCE 0 (IQUOTIENT (IPLUS DESCENT 3)
-                                       4)))
-         (SETQ M (IQUOTIENT (IPLUS ASCENT 3)
-                        4))
-         [for
 I from
 0 to
 \MAXTHINCHAR unless
 (EQ SLUGOFFSET (SETQ OFFSET (\FGETOFFSET OFFSETS I)))
-            do
 (SETQ WIDTH (\FGETWIDTH WIDTHS I))
-               (for
 J from
 N to
 M do
 (SETQ R (IPLUS OFFSET WIDTH))
-                                     (SETQ XN (IMIN R (IMAX (IPLUS OFFSET J)
-                                                            0)))
-                                     (SETQ XX (IMIN R (IMAX (IPLUS R J)
-                                                            0)))
-                                     [SETQ YN (IMAX 0 (IPLUS DESCENT (ITIMES J 4]
-                                     [SETQ YX (IMIN HEIGHT (IPLUS DESCENT (IPLUS (ITIMES J 4)
-                                                                                 4]
-                                     (CL:WHEN (AND (IGREATERP XX XN)
-                                                   (IGREATERP YX YN))
-                                         (BITBLT OLDBITMAP OFFSET YN NEWBITMAP XN YN (IDIFFERENCE
-                                                                                      XX XN)
-                                                (IDIFFERENCE YX YN)
-                                                'INPUT
-                                                'REPLACE))]
-         (BITBLT OLDBITMAP SLUGOFFSET 0 NEWBITMAP SLUGOFFSET 0 SLUGWIDTH HEIGHT 'INPUT 'REPLACE)
-         (create
 CHARSETINFO using
 CSINFO CHARSETBITMAP _ NEWBITMAP])
-)
-(DEFINEQ
+(\FSETLEFTKERN

+  [LAMBDA (CSINFO INDEX KERNVALUE)
                           (* ; "Edited  8-Jul-2025 22:50 by rmk")


+                                                             (* ; "Edited 17-May-2025 09:18 by rmk")

+    (CL:UNLESS (ARRAYP (ffetch
 (CHARSETINFO LEFTKERN) of
 CSINFO))
+        (replace
 (CHARSETINFO LEFTKERN) of
 CSINFO with
 (\CREATEKERNELEMENT
)))
+    (SETA (fetch
 (CHARSETINFO LEFTKERN) of
 CSINFO)
+          INDEX KERNVALUE])
 
-(\SFMAKEROTATEDFONT

-  [LAMBDA (FONTDESC ROTATION)
                            (* ; "Edited 30-Mar-87 20:35 by FS")

+(\FGETLEFTKERN

+  [LAMBDA (FONT PREVCHARCODE CHARCODE)
                       (* ; "Edited 25-Sep-2025 21:25 by rmk")


+                                                             (* ; "Edited 30-Aug-2025 23:29 by rmk")


+                                                             (* ; "Edited  8-Jul-2025 22:15 by rmk")


+                                                             (* ; "Edited 22-May-2025 09:53 by rmk")


+                                                             (* ; "Edited 18-May-2025 21:30 by rmk")


+                                                             (* ; "Edited  1-May-2025 11:08 by rmk")


+                                                             (* ; "Edited 19-Dec-2024 15:25 by rmk")

 
-    (* ;; "takes a fontdecriptor and rotates it.")

+    (* ;; "Returns the kern information for CHARCODE in FONT, given that it is an immediate successor of PREVCHARCODE.  Returns 0 if no PREVCHARCODE/CHARCODE kerning is specified.  For now, assume that the kerning information is sparse for characters within a character set, stored as a 2-level alist.  ")

 
-    (* ;; "1/5/86 JDS.  Masterscope claims nobody calls this.  Let's find out....")

+    (* ;; "If the kerning information for a character is already a FIXP, then it is an offset no matter what the preceding character might be.  This appears to be the way at least AC font files are set up.")

 
-    (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))))

+    (* ;; "ACFONTFILES STORE A SINGLE NUMBER.  LOGIC OF CODES IS UNCLEAR")

 
-    (* ;; "If you uncomment out the code above, remove this comment and the NIL below")

+    (LET [(KERN (AND (fetch
 (FONTDESCRIPTOR FONTHASLEFTKERNS) of
 FONT)
+                     (ELT (fetch
 (CHARSETINFO LEFTKERN) of
 (\INSURECHARSETINFO FONT (\CHARSET 
+                                                                                         PREVCHARCODE
+                                                                                           )))
+                          (\CHAR8CODE PREVCHARCODE]
+         (OR (FIXP KERN)
+             (GETMULTI (LISTP KERN)
+                    CHARCODE)
+             0])
+)
+(DEFINEQ
 
-    NIL])
+(\CREATEFONT

+  [LAMBDA (FONTSPEC)
                                         (* ; "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")

 
-(\SFROTATECSINFO

-  [LAMBDA (CSINFO ROTATION)
                              (* gbn "15-Sep-85 14:38")

+    (* ;; "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.  ")

 
-    (* ;; "takes a CHARSETINFO and rotates it and produces a rotated equivalent one.")

+    (* ;; "")

 
-    (create
 CHARSETINFO using
 CSINFO CHARSETBITMAP _ (\SFROTATEFONTCHARACTERS

-                                                              (fetch
 (CHARSETINFO CHARSETBITMAP)
-                                                                 of
 CSINFO)
-                                                              ROTATION)
-                                  OFFSETS _ (\SFROTATECSINFOOFFSETS
 CSINFO ROTATION])
+    (LET [(FN (CAR (GETMULTI IMAGESTREAMTYPES (fetch
 (FONTSPEC FSDEVICE) of
 FONTSPEC)
+                          'FONTCREATE]
+         (CL:WHEN FN
+             (if
 (EQ (NARGS FN)
+                     1)
+                 then
 (APPLY* FN FONTSPEC)
+               else
                                          (* ; "Old form: spreading FONTSPEC")

+                    (APPLY FN FONTSPEC)))])
 
-(\SFROTATEFONTCHARACTERS

-  [LAMBDA (CHARBITMAP ROTATION)
                          (* ; "Edited 22-Sep-87 10:38 by Snow")

+(\CREATECHARSET

+  [LAMBDA (CHARSET FONT)
                                     (* ; "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")

 
-(* ;;; "rotate a bitmap either 90 or 270 for fonts.")

+    (* ;; "Creates and returns the CHARSETINFO for charset CHARSET in fontdesc FONT, installing it in fonts FONTCHARSETVECTOR")

 
-    (CASE ROTATION
-        (0 CHARBITMAP)
-        (90 (ROTATE-BITMAP-LEFT CHARBITMAP))
-        (180 (ROTATE-BITMAP (ROTATE-BITMAP CHARBITMAP)))
-        (270 (ROTATE-BITMAP CHARBITMAP)))])
+    (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 \READCHARSET))
+                                (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])
 
-(\SFROTATECSINFOOFFSETS

-  [LAMBDA (CSINFO ROTATION)
                              (* gbn "15-Sep-85 14:36")

-                                                             (* ; 
-
                                     "adjusts offsets in case where rotation turned things around.")

-    (COND
-       ((EQ ROTATION 270)
-        (PROG ((OFFSETS (fetch
 (CHARSETINFO OFFSETS) of
 CSINFO))
-               (WIDTHS (fetch
 (CHARSETINFO WIDTHS) of
 CSINFO))
-               (BITMAPHEIGHT (BITMAPWIDTH (fetch
 (CHARSETINFO CHARSETBITMAP) of
 CSINFO)))
-               NEWOFFSETS)
-              (SETQ NEWOFFSETS (\CREATECSINFOELEMENT))
-              [for
 CHARCODE from
 0 to
 \MAXCHAR
-                 do
 (\FSETOFFSET NEWOFFSETS CHARCODE (IDIFFERENCE BITMAPHEIGHT
-                                                                (IPLUS (\FGETOFFSET OFFSETS CHARCODE)
-                                                                       (\FGETWIDTH WIDTHS CHARCODE]
+(\INSTALLCHARSETINFO

+  [LAMBDA (FONT CSINFO CHARSET)
                              (* ; "Edited 31-Aug-2025 14:36 by rmk")


+                                                             (* ; "Edited 25-Aug-2025 14:32 by rmk")


+                                                             (* ; "Edited 24-Aug-2025 11:29 by rmk")


+                                                             (* ; "Edited 25-May-2025 07:48 by rmk")


+                                                             (* ; "Edited 23-May-2025 14:44 by rmk")


+                                                             (* ; "Edited 12-Jul-2022 15:08 by rmk")

+    (replace
 \SFAscent of
 FONT with
 (IMAX (fetch
 \SFAscent of
 FONT)
+                                          (SIGNED (fetch
 CHARSETASCENT of
 CSINFO)
+                                                 16)))
+    (replace
 (FONTDESCRIPTOR \SFDescent) of
 FONT with
 (IMAX (fetch
 (FONTDESCRIPTOR \SFDescent)
+                                                               of
 FONT)
+                                                            (SIGNED (fetch
 (CHARSETINFO 
+                                                                                  CHARSETDESCENT)
+                                                                       of
 CSINFO)
+                                                                   16)))
                                                              (* ; 
-
                                         "may be some problem with dummy character representation.")

-              (RETURN NEWOFFSETS)))
-       (T (fetch
 (CHARSETINFO OFFSETS) of
 CSINFO])
-)
-(DEFINEQ
+
                                "jtm: height = ascent + descent, not (IMAX fontHeight charSetHeight)")

+    (replace
 (FONTDESCRIPTOR \SFHeight) of
 FONT with
 (IPLUS (fetch
 (FONTDESCRIPTOR \SFAscent)
+                                                               of
 FONT)
+                                                            (ffetch
 (FONTDESCRIPTOR \SFDescent)
+                                                               of
 FONT)))
+    (replace
 (CHARSETINFO CHARSETNO) of
 CSINFO with
 CHARSET) (* ; "In case the device didn't do it")

+    (\INSTALLCHARSETINFO.CHARENCODING
 FONT CSINFO CHARSET)
+    (\SETCHARSETINFO FONT CHARSET CSINFO)
 
-(\SFMAKECOLOR

-  [LAMBDA (BWCSINFO BACKCOLOR FORECOLOR BITSPERPIXEL)
    (* kbr%: " 6-Feb-86 18:17")

+    (* ;; "\AVGCHARWIDTH has to be confused after the CSINFO is stuck in.")

 
-    (* ;; "makes a csinfo that has a character bitmap that is colorized.")

+    (CL:WHEN (EQ 0 (fetch
 (FONTDESCRIPTOR FONTAVGCHARWIDTH) of
 FONT))
+        (replace
 (FONTDESCRIPTOR FONTAVGCHARWIDTH) of
 FONT with
 (\AVGCHARWIDTH
 FONT)))
+    (CL:WHEN (EQ 0 (fetch
 (FONTDESCRIPTOR FONTSLUGWIDTH) of
 FONT))
+                                                             (* ; "CSINFO is presumably charset 0")

+        (replace
 (FONTDESCRIPTOR FONTSLUGWIDTH) of
 FONT with
 (\FGETWIDTH (fetch
 (CHARSETINFO WIDTHS)
+                                                                            of
 CSINFO)
+                                                                    SLUGCHARINDEX)))
+    (CL:WHEN (EQ 0 (fetch
 (FONTDESCRIPTOR FONTSLUGWIDTH) of
 FONT))
+                                                             (* ; "Still 0: try for the average")

+        (replace
 (FONTDESCRIPTOR FONTSLUGWIDTH) of
 FONT with
 (fetch
 (FONTDESCRIPTOR FONTAVGCHARWIDTH)
+                                                                of
 FONT)))
+    CSINFO])
 
-    (PROG (CHARACTERBITMAP COLORCSINFO)
-          [COND
-             ((IMAGESTREAMP BITSPERPIXEL)
-              (OR BACKCOLOR (SETQ BACKCOLOR (DSPBACKCOLOR NIL BITSPERPIXEL)))
-              (OR FORECOLOR (SETQ FORECOLOR (DSPCOLOR NIL BITSPERPIXEL)))
-              (SETQ BITSPERPIXEL (IMAGESTREAMTYPE BITSPERPIXEL]
-          [SETQ BITSPERPIXEL (COND
-                                ((NUMBERP BITSPERPIXEL)
-                                 BITSPERPIXEL)
-                                (T (\DISPLAYSTREAMTYPEBPP BITSPERPIXEL]
-          (SETQ BACKCOLOR (COLORNUMBERP BACKCOLOR BITSPERPIXEL))
-          (SETQ FORECOLOR (COLORNUMBERP FORECOLOR BITSPERPIXEL))
-          (SETQ CHARACTERBITMAP (COLORIZEBITMAP (fetch
 (CHARSETINFO CHARSETBITMAP) of
 
-                                                                                             BWCSINFO
-                                                       )
-                                       BACKCOLOR FORECOLOR BITSPERPIXEL))
-          (SETQ COLORCSINFO (create
 CHARSETINFO using
 BWCSINFO CHARSETBITMAP _ 
-                                                          CHARACTERBITMAP))
-          (RETURN COLORCSINFO])
+(\INSTALLCHARSETINFO.CHARENCODING

+  [LAMBDA (FONT CSINFO CHARSET)
                              (* ; "Edited 12-Jul-2025 10:57 by rmk")


+                                                             (* ; "Edited  9-Jul-2025 09:38 by rmk")


+                                                             (* ; "Edited  6-Jul-2025 21:46 by rmk")


+                                                             (* ; "Edited 25-May-2025 23:05 by rmk")


+                                                             (* ; "Edited 24-May-2025 21:42 by rmk")

+
+    (* ;; "The font charencoding is its charset 0 encoding.  All higher charsets are MCCS.")

+
+    (CL:WHEN (AND (EQ CHARSET 0)
+                  (NOT (fetch
 (CHARSETINFO CSSLUGP) of
 CSINFO)))
+        (replace
 (FONTDESCRIPTOR FONTCHARENCODING) of
 FONT with
 (CHARSETPROP CSINFO 'CSCHARENCODING)))
+    ])
 )
-(DEFINEQ
+(DECLARE%: DONTCOPY 
+(DECLARE%: EVAL@COMPILE 
 
-(FONTDESCRIPTOR.DEFPRINT

-  [LAMBDA (FONT STREAM)
                                      (* ; "Edited 10-Jul-2025 09:32 by rmk")


-                                                             (* ; "Edited 14-Dec-2024 09:13 by rmk")

-    (LET ((LOC (LOC FONT))
-          (FACE (fetch
 (FONTDESCRIPTOR FONTFACE) of
 FONT)))
+(PUTPROPS FIRSTCHARSETCODE
 MACRO
 ((CHARSET)
+                                  (LLSH CHARSET 8)))
 
-         (* ;; "Could lowercase the family, but maybe too dangerous if a BREAK on L-CASE.")

+(PUTPROPS LASTCHARSETCODE
 MACRO
 ((CHARSET)
+                                 (LOGOR (LLSH CHARSET 8)
+                                        \MAXTHINCHAR)))
+)
+)
+(DEFINEQ
 
-         (* ;; "Somehow flag the device too?")

+(\FONTRESETCHARWIDTHS

+  [LAMBDA (CSINFO FIRSTCHAR LASTCHAR)
                        (* ; "Edited  3-Aug-2025 20:59 by rmk")


+                                                             (* ; "Edited  1-Aug-2025 23:50 by rmk")

+                                                             (* AJB " 6-Dec-85 14:42")

+    (for
 CHARCODE LEFT RIGHT SLUGCHAROFFSET SLUGCHARWIDTH (OFFSETS _ (fetch
 (CHARSETINFO OFFSETS)
+                                                                        of
 CSINFO))
+         (WIDTHS _ (fetch
 (CHARSETINFO WIDTHS) of
 CSINFO)) from
 0 to
 SLUGCHARINDEX
+       first
 (SETQ SLUGCHAROFFSET (\FGETOFFSET OFFSETS SLUGCHARINDEX))
+             (SETQ SLUGCHARWIDTH (IDIFFERENCE (\FGETOFFSET OFFSETS (ADD1 SLUGCHARINDEX))
+                                        SLUGCHAROFFSET))
+       do
 (SETQ LEFT (\FGETWIDTH OFFSETS CHARCODE))
+          (if
 (EQ SLUGCHAROFFSET LEFT)
+              then
 (\FSETWIDTH WIDTHS CHARCODE SLUGCHARWIDTH)
+            else
 (SETQ RIGHT (\FGETWIDTH OFFSETS (ADD1 CHARCODE)))
+                 (if
 (EQ LEFT RIGHT)
+                     then
 (\FSETOFFSET OFFSETS CHARCODE SLUGCHAROFFSET)
+                          (\FSETWIDTH WIDTHS CHARCODE SLUGCHARWIDTH)
+                   else
 (\FSETWIDTH WIDTHS CHARCODE (IDIFFERENCE RIGHT LEFT])
+)
+(DECLARE%: EVAL@COMPILE 
 
-         (CONS (CONCAT "{" (fetch
 (FONTDESCRIPTOR FONTFAMILY) of
 FONT)
-                      (fetch
 (FONTDESCRIPTOR FONTSIZE) of
 FONT)
-                      "-"
-                      (SELECTQ (fetch
 (FONTFACE WEIGHT) of
 FACE)
-                          (MEDIUM 'M)
-                          (BOLD 'B)
-                          (LIGHT 'L)
-                          (fetch
 (FONTFACE WEIGHT) of
 FACE))
-                      (SELECTQ (fetch
 (FONTFACE SLOPE) of
 FACE)
-                          (ITALIC 'I)
-                          (REGULAR 'R)
-                          (fetch
 (FONTFACE SLOPE) of
 FACE))
-                      (SELECTQ (fetch
 (FONTFACE EXPANSION) of
 FACE)
-                          (REGULAR 'R)
-                          (COMPRESSED 'C)
-                          (EXPANDED 'E)
-                          (fetch
 (FONTFACE EXPANSION) of
 FACE))
-                      "/"
-                      (OCTALSTRING (CAR LOC))
-                      ","
-                      (OCTALSTRING (CDR LOC))
-                      "}"])
+(PUTPROPS \FGETCHARIMAGEWIDTH
 MACRO
 (OPENLAMBDA (FONT CHARCODE)
+                                      (\FGETWIDTH (ffetch
 (CHARSETINFO IMAGEWIDTHS)
+                                                     of
 (\INSURECHARSETINFO FONT (\CHARSET CHARCODE))
+                                                         )
+                                             (\CHAR8CODE CHARCODE))))
+)
+(DECLARE%: DOEVAL@COMPILE DONTCOPY
 
-(FONTCLASS.DEFPRINT

-  [LAMBDA (FONTCLASS
 STREAM)
                                 (* ; "Edited 14-Dec-2024 16:51 by rmk")

-    (LET ((LOC (LOC FONTCLASS)))
-         (CONS (CONCAT "{" (OR (fetch
 (FONTCLASS
 FONTCLASSNAME) of
 FONTCLASS)
-                               'FONTCLASS)
-                      "/"
-                      (OCTALSTRING (CAR LOC))
-                      ","
-                      (OCTALSTRING (CDR LOC))
-                      "}"])
+(LOCALVARS . T)
 )
 
-(/DECLAREDATATYPE 'FONTCLASS '(BYTE POINTER POINTER POINTER POINTER POINTER)
-       '((FONTCLASS
 0 (BITS . 7))
-         (FONTCLASS
 2 POINTER)
-         (FONTCLASS
 4 POINTER)
-         (FONTCLASS
 6 POINTER)
-         (FONTCLASS
 8 POINTER)
-         (FONTCLASS
 10 POINTER))
-       '12)
+(PUTPROPS FONT
 FILETYPE
 :FAKE-COMPILE-FILE)
 
-(DEFPRINT 'FONTCLASS (FUNCTION FONTCLASS.DEFPRINT))
 
-(/DECLAREDATATYPE 'FONTDESCRIPTOR
-       '(POINTER FLAG POINTER POINTER POINTER WORD WORD WORD WORD SIGNEDWORD SIGNEDWORD SIGNEDWORD 
-               SIGNEDWORD POINTER POINTER POINTER POINTER POINTER (BITS 8)
-               WORD POINTER POINTER FLAG POINTER)
-       '((FONTDESCRIPTOR 0 POINTER)
-         (FONTDESCRIPTOR 0 (FLAGBITS . 0))
-         (FONTDESCRIPTOR 2 POINTER)
-         (FONTDESCRIPTOR 4 POINTER)
-         (FONTDESCRIPTOR 6 POINTER)
-         (FONTDESCRIPTOR 8 (BITS . 15))
-         (FONTDESCRIPTOR 9 (BITS . 15))
-         (FONTDESCRIPTOR 10 (BITS . 15))
-         (FONTDESCRIPTOR 11 (BITS . 15))
-         (FONTDESCRIPTOR 12 (SIGNEDBITS . 15))
-         (FONTDESCRIPTOR 13 (SIGNEDBITS . 15))
-         (FONTDESCRIPTOR 14 (SIGNEDBITS . 15))
-         (FONTDESCRIPTOR 15 (SIGNEDBITS . 15))
-         (FONTDESCRIPTOR 16 POINTER)
-         (FONTDESCRIPTOR 18 POINTER)
-         (FONTDESCRIPTOR 20 POINTER)
-         (FONTDESCRIPTOR 22 POINTER)
-         (FONTDESCRIPTOR 24 POINTER)
-         (FONTDESCRIPTOR 26 (BITS . 7))
-         (FONTDESCRIPTOR 27 (BITS . 15))
-         (FONTDESCRIPTOR 28 POINTER)
-         (FONTDESCRIPTOR 30 POINTER)
-         (FONTDESCRIPTOR 30 (FLAGBITS . 0))
-         (FONTDESCRIPTOR 32 POINTER))
-       '34)
 
-(DEFPRINT 'FONTDESCRIPTOR (FUNCTION FONTDESCRIPTOR.DEFPRINT))
+(* ;; "")

 
-(/DECLAREDATATYPE 'CHARSETINFO '(POINTER FLAG FLAG POINTER POINTER POINTER POINTER WORD WORD POINTER
-                                       POINTER)
-       '((CHARSETINFO 0 POINTER)
-         (CHARSETINFO 0 (FLAGBITS . 0))
-         (CHARSETINFO 0 (FLAGBITS . 16))
-         (CHARSETINFO 2 POINTER)
-         (CHARSETINFO 4 POINTER)
-         (CHARSETINFO 6 POINTER)
-         (CHARSETINFO 8 POINTER)
-         (CHARSETINFO 10 (BITS . 15))
-         (CHARSETINFO 11 (BITS . 15))
-         (CHARSETINFO 12 POINTER)
-         (CHARSETINFO 14 POINTER))
-       '16)
-(ADDTOVAR SYSTEMRECLST
 
-(DATATYPE FONTCLASS
 ((PRETTYFONT# BYTE)
-                     DISPLAYFD PRESSFD INTERPRESSFD OTHERFDS FONTCLASSNAME))
 
-(DATATYPE FONTDESCRIPTOR
 ((FONTDEVICE POINTER)
-                          (FONTCOMPLETEP FLAG)
-                          (FONTFAMILY POINTER)
-                          (FONTSIZE POINTER)
-                          (FONTFACE POINTER)
-                          (\SFAscent WORD)
-                          (\SFDescent WORD)
-                          (\SFHeight WORD)
-                          (ROTATION WORD)
-                          (NIL SIGNEDWORD)
-                          (NIL SIGNEDWORD)
-                          (NIL SIGNEDWORD)
-                          (NIL SIGNEDWORD)
-                          (NIL POINTER)
-                          (NIL POINTER)
-                          (FONTDEVICESPEC POINTER)
-                          (OTHERDEVICEFONTPROPS POINTER)
-                          (FONTSCALE POINTER)
-                          (\SFFACECODE BITS 8)
-                          (FONTAVGCHARWIDTH WORD)
-                          (FONTCHARENCODING POINTER)
-                          (FONTCHARSETVECTOR POINTER)
-                          (FONTHASLEFTKERNS FLAG)
-                          (FONTEXTRAFIELD2 POINTER)))
 
-(DATATYPE CHARSETINFO
 (WIDTHS (CSSLUGP FLAG)
-                             (CSCOMPLETEP FLAG)
-                             OFFSETS IMAGEWIDTHS CHARSETBITMAP YWIDTHS (CHARSETASCENT WORD)
-                             (CHARSETDESCENT WORD)
-                             LEFTKERN CSINFOPROPS))
-)
+(* ;; "DISPLAY")

 
-(RPAQ? \FONTSINCORE
 )
 
-(RPAQ? \DEFAULTDEVICEFONTS
 )
 
-(RPAQ? \UNITWIDTHSVECTOR
 )
-(DECLARE%: DOEVAL@COMPILE DONTCOPY
 
-(GLOBALVARS \DEFAULTDEVICEFONTS \UNITWIDTHSVECTOR)
-)
-(DECLARE%: DONTEVAL@LOAD DOCOPY 
+(* ; "Functions for DISPLAY IMAGESTREAMTYPES ")

 
-(\UNITWIDTHSVECTOR
)
-)
-(* "FOLLOWING DEFINITIONS EXPORTED")
-(DEFOPTIMIZER FONTPROP
 (&REST ARGS)
-                       (SELECTQ (AND (EQ (CAADR ARGS)
-                                         'QUOTE)
-                                     (CADADR ARGS))
-                           (ASCENT (LIST 'FONTASCENT (CAR ARGS)))
-                           (DESCENT (LIST 'FONTDESCENT (CAR ARGS)))
-                           (HEIGHT (LIST 'FONTHEIGHT (CAR ARGS)))
-                           'IGNOREMACRO))
+(DEFINEQ
 
-(* "END EXPORTED DEFINITIONS")
+(\CREATEDISPLAYFONT

+  [LAMBDA (FONTSPEC)
                                         (* ; "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")


+                                                             (* ; "Edited 13-Jun-2025 22:58 by rmk")


+                                                             (* ; "Edited  9-Jun-2025 17:42 by rmk")


+                                                             (* ; "Edited  7-Jun-2025 15:11 by rmk")


+                                                             (* ; "Edited 23-May-2025 14:59 by rmk")


+                                                             (* ; "Edited 22-May-2025 09:52 by rmk")

+                                                             (* ; "gbn: 25-Jan-86 18:02")

 
-(DECLARE%: DONTCOPY 
-(* "FOLLOWING DEFINITIONS EXPORTED")(DECLARE%: EVAL@COMPILE
+    (* ;; "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.")

 
-(DATATYPE FONTCLASS
 ((PRETTYFONT# BYTE)
-                     DISPLAYFD PRESSFD INTERPRESSFD OTHERFDS FONTCLASSNAME)
-                    (INIT (DEFPRINT 'FONTCLASS (FUNCTION FONTCLASS.DEFPRINT))))
+    (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])
 
-(DATATYPE FONTDESCRIPTOR
 ((FONTDEVICE POINTER)
-                          (FONTCOMPLETEP FLAG)
-                          (FONTFAMILY POINTER)
-                          (FONTSIZE POINTER)
-                          (FONTFACE POINTER)
-                          (\SFAscent WORD)
-                          (\SFDescent WORD)
-                          (\SFHeight WORD)
-                          (ROTATION WORD)
-                          (NIL SIGNEDWORD)
+(\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")


+                                                             (* ; "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")

 
-                          (* ;; "Was FBBOX.  The fields are NIL'ed out now because they became irrelevant when multiple charsets were introduced.  They remain as a place-holder in the layout pending a recompile of all referring functions.")

+    (* ;; "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. ")

 
-                          (NIL SIGNEDWORD)                   (* ; "Was FBBOY")

-                          (NIL SIGNEDWORD)                   (* ; "Was FBBDX")

-                          (NIL SIGNEDWORD)                   (* ; "Was FBBDY")

-                          (NIL POINTER)                      (* ; "Was \SFLKerns")

-                          (NIL POINTER)                      (* ; "Was \SFRWidths")

-                          (FONTDEVICESPEC POINTER)           (* ; 
-
        "Holds the spec by which the font is known to the printing device, if coercion has been done")

-                          (OTHERDEVICEFONTPROPS POINTER)     (* ; 
-
                                                 "For individual devices to hang special information")

-                          (FONTSCALE POINTER)
-                          (\SFFACECODE BITS 8)
-                          (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")

-                          (FONTHASLEFTKERNS FLAG)            (* ; 
-
                                        "T if at least one character set has an entry for left kerns")

-                          (FONTEXTRAFIELD2 POINTER))
-                         FONTCHARSETVECTOR _ (\CREATEFONTCHARSETVECTOR)
-                         (INIT (DEFPRINT 'FONTDESCRIPTOR (FUNCTION FONTDESCRIPTOR.DEFPRINT))))
+    (* ;; "After that, it uses requested source files and/or DISPLAYCHARCOERCIONS to produce and complete the CHARSETINFO:")

 
-(RECORD FONTFACE
 (WEIGHT SLOPE EXPANSION)
-                 [ACCESSFNS ((COLOR (CDDDR DATUM)
-                                    (RPLACD (CDDR DATUM)
-                                           NEWVALUE))
-                             (BACKCOLOR [COND
-                                           ((CDDDR DATUM)
-                                            (CAR (CDDDR DATUM]
-                                    (PROGN [COND
-                                              ((NULL (CDDDR DATUM))
-                                               (RPLACD (CDDR DATUM)
-                                                      (LIST NIL NIL]
-                                           (RPLACA (CDDDR DATUM)
-                                                  NEWVALUE)))
-                             (FORECOLOR [COND
-                                           ((CDDDR DATUM)
-                                            (CADR (CDDDR DATUM]
-                                    (PROGN [COND
-                                              ((NULL (CDDDR DATUM))
-                                               (RPLACD (CDDR DATUM)
-                                                      (LIST NIL NIL]
-                                           (RPLACA (CDR (CDDDR DATUM))
-                                                  NEWVALUE]
-                 WEIGHT _ 'MEDIUM SLOPE _ 'REGULAR EXPANSION _ 'REGULAR (TYPE?
 LISTP))
+    (* ;; "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.")

 
-(DATATYPE CHARSETINFO
 (WIDTHS                                (* ; "The advance-width of each character, an array indexed by charcode.  Usually the same as the imagewidth, but can differ for accents, kerns kerns.  This is what should be used for stringwidth calculations.")

-                             (CSSLUGP FLAG)                  (* ; "True if this is a slug charset")

-                             (CSCOMPLETEP FLAG)              (* ; 
-
    "True if there is no further data to fill in any remaining slug-characters in a non-slug charset")

-                             OFFSETS                         (* ; 
-
                              "Offset of each character into the image bitmap;  X value of left edge")

-                             IMAGEWIDTHS                     (* ; "imagewidths is not automagically allocated since it is not always needed.  But at least some times the IMAGEWIDTHS and WIDTHS vectors are EQ in this case.")

-                             CHARSETBITMAP                   (* ; 
-
                                         "Bitmap containing the character images, indexed by OFFSETS")

-                             YWIDTHS
-                             (CHARSETASCENT WORD)            (* ; 
-
                                                      "Max ascent for all characters in this CHARSET")

-                             (CHARSETDESCENT WORD)           (* ; 
-
                                                     "Max descent for all characters in this CHARSET")

-                             LEFTKERN CSINFOPROPS            (* ; "Alist of extra properties")
)
-                      WIDTHS _ (\CREATECSINFOELEMENT)
-                      OFFSETS _ (\CREATECSINFOELEMENT))
+    (* ;; "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.")

+
+    (* ;; "")

+
+    (LET ((ROTATION (fetch
 (FONTSPEC FSROTATION) of
 FONTSPEC))
+          (FACE (fetch
 (FONTSPEC FSFACE) of
 FONTSPEC))
+          CSINFO)
+
+         (* ;; 
+
         "If no COERCIONS, skip that first \COERCECHARSET call--easier debugging of the other cases.")

+
+         (SETQ CSINFO (if
 (AND (FONTDEVICEPROP
 'DISPLAY 'FONTCOERCIONS)
+                               (CADR (\COERCECHARSET
 FONTSPEC CHARSET NIL 'FONTCOERCIONS FONT)))
+                        elseif
 [SETQ CSINFO (OR (\READCHARSET
 FONTSPEC CHARSET FONT)
+                                                (CADR (\COERCECHARSET
 FONTSPEC CHARSET NIL
+                                                             'CHARCOERCIONS]
+                          then
 
+                               (* ;; "This completes CSINFO with glyphs for all codes from possibly different sources, even if just asking for a single THINCODE. We never return an incomplete CSINFO.")

+
+                               (COMPLETE.CHARSET
 CSINFO FONTSPEC CHARSET FONT)
+                        elseif
 (NEQ ROTATION 0)
+                          then
 (CL:UNLESS (MEMB ROTATION '(90 270))
+                                      (ERROR "Only implemented rotations are 0, 90 and 270." ROTATION
+                                             ))
+                               (CL:WHEN (SETQ CSINFO (\CREATECHARSET.DISPLAY
 (create
 FONTSPEC
+                                                                                using
 FONTSPEC 
+                                                                                      FSROTATION _ 0)
+                                                            FONT CHARSET))
+                                      (\SFROTATECSINFO
 CSINFO ROTATION))
+                        elseif
 (OR (KANJICHARSETP CHARSET)
+                                   (CHINESECHARSETP CHARSET))
+                          then
 (CL:UNLESS (EQUAL FACE '(MEDIUM REGULAR REGULAR))
+                                   (\CREATECHARSET.DISPLAY
 (create
 FONTSPEC
+                                                              using
 FONTSPEC FSFACE _
+                                                                    '(MEDIUM REGULAR REGULAR))
+                                          FONT CHARSET))
+                        elseif
 (EQ 'BOLD (fetch
 (FONTFACE WEIGHT) of
 FACE))
+                          then
 (MAKEBOLD.CHARSET
 FONTSPEC CHARSET FONT)
+                        elseif
 (EQ 'ITALIC (fetch
 (FONTFACE SLOPE) of
 FACE))
+                          then
 (MAKEITALIC.CHARSET
 FONTSPEC CHARSET FONT)
+                        elseif
 (EQ 'COMPRESSED (fetch
 (FONTFACE EXPANSION) of
 FACE))
+                          then
 (\CREATECHARSET.DISPLAY
 (create
 FONTSPEC
+                                                          using
 FONTSPEC FSFACE _
+                                                                '(MEDIUM REGULAR REGULAR))
+                                      FONT CHARSET)))
+         CSINFO])
+
+(\FONTEXISTS?.DISPLAY

+  [LAMBDA (FONTSPEC)
                                         (* ; "Edited 28-Aug-2025 22:12 by rmk")


+                                                             (* ; "Edited 25-Aug-2025 15:04 by rmk")


+                                                             (* ; "Edited 17-Aug-2025 09:56 by rmk")


+                                                             (* ; "Edited  8-Aug-2025 10:03 by rmk")


+                                                             (* ; "Edited  5-Aug-2025 17:55 by rmk")


+                                                             (* ; "Edited 29-Jul-2025 22:56 by rmk")


+                                                             (* ; "Edited 25-Jul-2025 21:38 by rmk")


+                                                             (* ; "Edited 13-Jul-2025 11:45 by rmk")


+                                                             (* ; "Edited 22-Jun-2025 08:53 by rmk")

+
+    (* ;; "Order doesn't matter here, only need one to work")

+
+    (LET ((FACE (fetch
 (FONTSPEC FSFACE) of
 FONTSPEC)))
+         (OR [AND (EQ 'BOLD (fetch
 (FONTFACE WEIGHT) of
 FACE))
+                  (FONTEXISTS?
 (create
 FONTSPEC using
 FONTSPEC FSFACE _
+                                                      (create
 FONTFACE using
 FACE WEIGHT _
+                                                                             'MEDIUM]
+             [AND (EQ 'ITALIC (fetch
 (FONTFACE SLOPE) of
 FACE))
+                  (FONTEXISTS?
 (create
 FONTSPEC using
 FONTSPEC FSFACE _
+                                                      (create
 FONTFACE using
 FACE SLOPE _
+                                                                             'REGULAR]
+             [AND (EQ 'COMPRESSED (fetch
 (FONTFACE EXPANSION) of
 FACE))
+                  (FONTEXISTS?
 (create
 FONTSPEC using
 FONTSPEC FSFACE _
+                                                      (create
 FONTFACE using
 FACE EXPANSION _
+                                                                             'REGULAR]
+             (for
 FS VAL in
 [COERCEFONTSPEC
 FONTSPEC (APPEND (FONTDEVICEPROP
 'DISPLAY 'FONTCOERCIONS)
+                                                            (FONTDEVICEPROP
 'DISPLAY 'CHARCOERCIONS]
+                when
 (SETQ VAL (FONTEXISTS?
 FS)) do
 (RETURN VAL])
 )
+(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")

 
-(/DECLAREDATATYPE 'FONTCLASS '(BYTE POINTER POINTER POINTER POINTER POINTER)
-       '((FONTCLASS
 0 (BITS . 7))
-         (FONTCLASS
 2 POINTER)
-         (FONTCLASS
 4 POINTER)
-         (FONTCLASS
 6 POINTER)
-         (FONTCLASS
 8 POINTER)
-         (FONTCLASS
 10 POINTER))
-       '12)
+         [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])
 
-(DEFPRINT 'FONTCLASS (FUNCTION FONTCLASS.DEFPRINT))
+(STRIKECSINFO

+  [LAMBDA (CSINFO)
                                       (* ; "Edited 27-Apr-89 13:39 by atm")

 
-(/DECLAREDATATYPE 'FONTDESCRIPTOR
-       '(POINTER FLAG POINTER POINTER POINTER WORD WORD WORD WORD SIGNEDWORD SIGNEDWORD SIGNEDWORD 
-               SIGNEDWORD POINTER POINTER POINTER POINTER POINTER (BITS 8)
-               WORD POINTER POINTER FLAG POINTER)
-       '((FONTDESCRIPTOR 0 POINTER)
-         (FONTDESCRIPTOR 0 (FLAGBITS . 0))
-         (FONTDESCRIPTOR 2 POINTER)
-         (FONTDESCRIPTOR 4 POINTER)
-         (FONTDESCRIPTOR 6 POINTER)
-         (FONTDESCRIPTOR 8 (BITS . 15))
-         (FONTDESCRIPTOR 9 (BITS . 15))
-         (FONTDESCRIPTOR 10 (BITS . 15))
-         (FONTDESCRIPTOR 11 (BITS . 15))
-         (FONTDESCRIPTOR 12 (SIGNEDBITS . 15))
-         (FONTDESCRIPTOR 13 (SIGNEDBITS . 15))
-         (FONTDESCRIPTOR 14 (SIGNEDBITS . 15))
-         (FONTDESCRIPTOR 15 (SIGNEDBITS . 15))
-         (FONTDESCRIPTOR 16 POINTER)
-         (FONTDESCRIPTOR 18 POINTER)
-         (FONTDESCRIPTOR 20 POINTER)
-         (FONTDESCRIPTOR 22 POINTER)
-         (FONTDESCRIPTOR 24 POINTER)
-         (FONTDESCRIPTOR 26 (BITS . 7))
-         (FONTDESCRIPTOR 27 (BITS . 15))
-         (FONTDESCRIPTOR 28 POINTER)
-         (FONTDESCRIPTOR 30 POINTER)
-         (FONTDESCRIPTOR 30 (FLAGBITS . 0))
-         (FONTDESCRIPTOR 32 POINTER))
-       '34)
+    (* ;; "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.")

 
-(DEFPRINT 'FONTDESCRIPTOR (FUNCTION FONTDESCRIPTOR.DEFPRINT))
+    (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]
 
-(/DECLAREDATATYPE 'CHARSETINFO '(POINTER FLAG FLAG POINTER POINTER POINTER POINTER WORD WORD POINTER
-                                       POINTER)
-       '((CHARSETINFO 0 POINTER)
-         (CHARSETINFO 0 (FLAGBITS . 0))
-         (CHARSETINFO 0 (FLAGBITS . 16))
-         (CHARSETINFO 2 POINTER)
-         (CHARSETINFO 4 POINTER)
-         (CHARSETINFO 6 POINTER)
-         (CHARSETINFO 8 POINTER)
-         (CHARSETINFO 10 (BITS . 15))
-         (CHARSETINFO 11 (BITS . 15))
-         (CHARSETINFO 12 POINTER)
-         (CHARSETINFO 14 POINTER))
-       '16)
-(DECLARE%: EVAL@COMPILE 
+     (* ;; "")

 
-(PUTPROPS FONTASCENT
 MACRO
 ((FONTSPEC)
-                            (ffetch
 \SFAscent of
 (FONTCREATE
 FONTSPEC))))
+     (* ;; "Initialize new offsets vector")

 
-(PUTPROPS FONTDESCENT
 MACRO
 ((FONTSPEC)
-                             (ffetch
 \SFDescent of
 (FONTCREATE
 FONTSPEC))))
+     (* ;; "")

 
-(PUTPROPS FONTHEIGHT
 MACRO
 ((FONTSPEC)
-                            (ffetch
 \SFHeight of
 (FONTCREATE
 FONTSPEC))))
+          (SETQ NEWOFFSETS (\CREATECSINFOELEMENT))
+          (for
 I from
 0 to
 (IPLUS \MAXTHINCHAR 2) do
 (\FSETOFFSET NEWOFFSETS I 0))
+          (\FSETOFFSET NEWOFFSETS (ADD1 \MAXTHINCHAR)
+                 BMWIDTH)
 
-(PUTPROPS \FGETOFFSET
 DMACRO
 ((OFFSETSBLOCK CHAR8CODE)
-                              (\GETBASE OFFSETSBLOCK CHAR8CODE)))
+     (* ;; "")

 
-(PUTPROPS \FSETOFFSET
 DMACRO
 ((OFFSETSBLOCK CHAR8CODE OFFSET)
-                              (\PUTBASE OFFSETSBLOCK CHAR8CODE OFFSET)))
+     (* ;; "Adjust bitmap with so width = imagewidth, fill offsets")

 
-(PUTPROPS \FGETWIDTH
 DMACRO
 ((WIDTHSBLOCK CHAR8CODE)
-                             (\GETBASE WIDTHSBLOCK CHAR8CODE)))
+     (* ;; "")

 
-(PUTPROPS \FSETWIDTH
 DMACRO
 ((WIDTHSBLOCK CHAR8CODE VAL)
-                             (\PUTBASE WIDTHSBLOCK CHAR8CODE VAL)))
+          (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]
 
-(PUTPROPS \FGETCHARWIDTH
 MACRO
 (OPENLAMBDA (FONTDESC CHARCODE)
-                                 (\FGETWIDTH (ffetch
 (CHARSETINFO WIDTHS) of
 (\INSURECHARSETINFO
-                                                                              (\CHARSET CHARCODE)
-                                                                              FONTDESC))
-                                        (\CHAR8CODE CHARCODE))))
+     (* ;; "")

 
-(PUTPROPS \FSETCHARWIDTH
 MACRO
 (OPENLAMBDA (FONTDESC CHARCODE WIDTH)
-                                 (\FSETWIDTH (ffetch
 (CHARSETINFO WIDTHS) of
 (\GETCHARSETINFO
-                                                                              (\CHARSET CHARCODE)
-                                                                              FONTDESC))
-                                        (\CHAR8CODE CHARCODE)
-                                        WIDTH)))
+     (* ;; "Make new CSInfo record withs IMAGEWIDTHS, WIDTHS the same")

 
-(PUTPROPS \FGETIMAGEWIDTH
 MACRO
 ((IMAGEWIDTHSBLOCK CHAR8CODE)
-                                 (\GETBASE IMAGEWIDTHSBLOCK CHAR8CODE)))
+     (* ;; "")

 
-(PUTPROPS \FSETIMAGEWIDTH
 DMACRO
 ((WIDTHSBLOCK INDEX WIDTH)
-                                  (\PUTBASE WIDTHSBLOCK INDEX WIDTH)))
+          (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])
 )
-(DECLARE%: EVAL@COMPILE 
 
-(PUTPROPS \XGETCHARSETINFO
 MACRO
 ((FONTDESC CHARSET)
 
-                                  (* ;; 
-
                 "Temporary until other callers of \GETCHARSETINFO are changes to \INSURECHARSETINFO")

 
-                                  (* ;; 
-
                          "Fetches the charsetinfo for charset CHARSET in fontdescriptor FONTDESC.  ")

+(* ; "Bitmap faking")

 
-                                  (* ;; 
-
       "NOTE Current \GETCHARSETINFO takes the vector, not the font, as does current \SETCHARSETINFO")

+(DEFINEQ
+
+(MAKEBOLD.CHARSET

+  [LAMBDA (FONTSPEC CHARSET FONT)
                            (* ; "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")

 
-                                  (\GETBASEPTR (ffetch
 FONTCHARSETVECTOR of
 FONTDESC)
-                                         (UNFOLD CHARSET 2))))
+    (* ;; "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.")

 
-(PUTPROPS \GETCHARSETINFO
 MACRO
 [(CHARSET FONTDESC)
+    (LET ([MFONT (FONTCREATE1
 (create
 FONTSPEC using
 FONTSPEC FSFACE _ (create
 FONTFACE
+                                                                          using
 (fetch
 (FONTSPEC
+                                                                                        FSFACE)
+                                                                                   of
 FONTSPEC)
+                                                                                WEIGHT _ 'MEDIUM]
+          CSINFO)
 
-                                 (* ;; "fetches the charsetinfo for charset CHARSET in fontdescriptor FONTDESC.  If NIL, then creates the required charset, maybe a slug (with CSSLUGP T).")

+         (* ;; "MFONT is the corresponding Medium font.")

 
-                                 (OR (\GETBASEPTR (ffetch
 FONTCHARSETVECTOR of
 FONTDESC)
-                                            (UNFOLD CHARSET 2))
-                                     (\SETCHARSETINFO (ffetch
 FONTCHARSETVECTOR of
 FONTDESC)
-                                            CHARSET
-                                            (\CREATECHARSET
 CHARSET FONTDESC])
+         (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.")

 
-(PUTPROPS \INSURECHARSETINFO
 MACRO
 [(CHARSET FONTDESC)
+                            (CL:WHEN (SETQ SOURCEFONT (CAR (\COERCECHARSET
 FONTSPEC CHARSET CODE)))
+                                (\MOVEFONTCHAR
 (\MOVEFONTCHARS.SOURCEDATA
 CODE SOURCEFONT)
+                                       CODE FONT))
+                     else
 
+                          (* ;; "There is Medium glyph, bold it")

 
-                                 (* ;; "fetches the charsetinfo for charset CHARSET in fontdescriptor FONTDESC.  If NIL, then creates the required charset, maybe a slug (with CSSLUGP T).")

+                          (MAKEBOLD.CHAR
 CODE FONT)))
+             (replace
 (CHARSETINFO CSCOMPLETEP) of
 CSINFO with
 T)
+             CSINFO)])
 
-                                    (OR (\GETBASEPTR (ffetch
 FONTCHARSETVECTOR of
 FONTDESC)
-                                               (UNFOLD CHARSET 2))
-                                        (\SETCHARSETINFO (ffetch
 FONTCHARSETVECTOR of
 FONTDESC)
-                                               CHARSET
-                                               (\CREATECHARSET
 CHARSET FONTDESC])
+(MAKEBOLD.CHAR

+  [LAMBDA (CODE FONT)
                                        (* ; "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")

 
-(PUTPROPS \CREATECSINFOELEMENT
 MACRO
 (NIL (\ALLOCBLOCK (FOLDHI (IPLUS \MAXTHINCHAR 3)
-                                                              WORDSPERCELL))))
+    (* ;; "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.")

 
-(PUTPROPS \CREATEFONTCHARSETVECTOR
 MACRO
 (NIL 
+    (CL:UNLESS (SLUGCHARP.DISPLAY
 CODE FONT)
+        (LET* [(THINCODE (\CHAR8CODE CODE))
+               (CSINFO (\GETCHARSETINFO FONT (\CHARSET CODE)))
+               (OLDCHARBITMAP (\GETCHARBITMAP.CSINFO
 THINCODE CSINFO))
+               (NEWCHARBITMAP (BITMAPCREATE (ADD1 (fetch
 BITMAPWIDTH of
 OLDCHARBITMAP))
+                                     (fetch
 BITMAPHEIGHT of
 OLDCHARBITMAP)))
+               (CWIDTH (\FGETWIDTH (fetch
 (CHARSETINFO WIDTHS) of
 CSINFO)
+                              THINCODE))
+               (HEIGHT (IPLUS (fetch
 (CHARSETINFO CHARSETASCENT) of
 CSINFO)
+                              (fetch
 (CHARSETINFO CHARSETDESCENT) of
 CSINFO]
 
-                                            (* ;; "Allocates a block for the character set records, including one extra slot to hold the common slug charsetinfo")

+              (* ;; 
+
             "Paint in a shifted copy 1 bit over. The new bitmap is 1 bit wider, to keep the margin.")

 
-                                              (\ALLOCBLOCK (IPLUS 2 \MAXCHARSET)
-                                                     T)))
+              (BITBLT OLDCHARBITMAP 0 0 NEWCHARBITMAP 0 0 CWIDTH HEIGHT 'INPUT 'REPLACE)
+              (BITBLT OLDCHARBITMAP 0 0 NEWCHARBITMAP 1 0 CWIDTH HEIGHT 'INPUT 'PAINT)
+              (\PUTCHARBITMAP.CSINFO
 THINCODE CSINFO NEWCHARBITMAP)))])
 
-(PUTPROPS CHARSETPROP
 MACRO
 [ARGS (if
 (CDDR ARGS)
-                                      then
 `(PUTMULTI (fetch
 (CHARSETINFO CSINFOPROPS)
-                                                         of
 ,(CAR ARGS))
-                                                   ,(CADR ARGS)
-                                                   ,(CADDR ARGS))
-                                    else
 `(GETMULTI (fetch
 (CHARSETINFO CSINFOPROPS)
-                                                       of
 ,(CAR ARGS))
-                                                 ,(CADR ARGS])
-)
-(DECLARE%: EVAL@COMPILE 
+(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")

 
-(RPAQQ \MAXNSCHAR
 65535)
+    (* ;; "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)
 
-(CONSTANTS (\MAXNSCHAR 65535))
-)
+         (* ;; "RFONT is the corresponding Regular font.")

 
-(* "END EXPORTED DEFINITIONS")
+         (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.")

 
-(DECLARE%: EVAL@COMPILE 
+                          (MAKEITALIC.CHAR
 CODE FONT)))
+             (replace
 (CHARSETINFO CSCOMPLETEP) of
 CSINFO with
 T)
+             CSINFO)])
 
-(PUTPROPS INDIRECTCHARSETP
 MACRO
 [(CSINFO FONT CHARSET)
+(MAKEITALIC.CHAR

+  [LAMBDA (CODE FONT)
                                        (* ; "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")

 
-                                  (* ;; "An indirect points somewhere else")

+    (* ;; "Replaces the bitmap for CODE in FONT with a slanted one:  It shifts rows to the right as a function of their vertical position. ")

 
-                                  (LET ([SOURCE (CL:UNLESS (fetch
 (CHARSETINFO CSSLUGP) of
 CSINFO)
-                                                    (CHARSETPROP CSINFO 'SOURCE))]
-                                        (FONTSPEC (fetch
 (FONTDESCRIPTOR FONTDEVICESPEC) of
 FONT)))
-                                       (NOT (AND SOURCE (EQ (pop
 SOURCE)
-                                                            (pop
 FONTSPEC))
-                                                 (EQ (pop
 SOURCE)
-                                                     (pop
 FONTSPEC))
-                                                 (EQUAL (pop
 SOURCE)
-                                                        (pop
 FONTSPEC))
-                                                 (EQ (pop
 SOURCE)
-                                                     (pop
 FONTSPEC))
-                                                 (EQ (pop
 SOURCE)
-                                                     (pop
 FONTSPEC))
-                                                 (EQ (pop
 SOURCE)
-                                                     CHARSET])
-
-(PUTPROPS MAKECSSOURCE
 MACRO
 ((FAMILY SIZE FACE ROTATION DEVICE CHARSET)
-                                                             (* ; 
-
                                                     "Corresponds to order of \READCHARSET arguments")

+    (CL:UNLESS (SLUGCHARP.DISPLAY
 CODE FONT)
+        (LET* ((THINCODE (\CHAR8CODE CODE))
+               (CSINFO (\GETCHARSETINFO FONT (\CHARSET CODE)))
+               (OLDBITMAP (\GETCHARBITMAP.CSINFO
 THINCODE CSINFO))
+               (NEWBITMAP (BITMAPCREATE (fetch
 BITMAPWIDTH of
 OLDBITMAP)
+                                 (fetch
 BITMAPHEIGHT of
 OLDBITMAP)))
+               (WIDTH (\FGETWIDTH (fetch
 (CHARSETINFO WIDTHS) of
 CSINFO)
+                             THINCODE))
+               (ASCENT (fetch
 (CHARSETINFO CHARSETASCENT) of
 CSINFO))
+               (DESCENT (fetch
 (CHARSETINFO CHARSETDESCENT) of
 CSINFO))
+               (HEIGHT (IPLUS ASCENT DESCENT)))
+              [for
 ROW XX XN YN YX from
 (IMINUS (IQUOTIENT (IPLUS DESCENT 3)
+                                                       4)) to
 (IQUOTIENT (IPLUS ASCENT 3)
+                                                                     4)
+                 do
 (SETQ XN (IMIN WIDTH (IMAX ROW 0)))
+                    (SETQ XX (IMIN WIDTH (IMAX (IPLUS WIDTH ROW)
+                                               0)))
+                    [SETQ YN (IMAX 0 (IPLUS DESCENT (ITIMES ROW 4]
+                    [SETQ YX (IMIN HEIGHT (IPLUS DESCENT (ITIMES (ADD1 ROW)
+                                                                4]
+                    (CL:WHEN (AND (IGREATERP XX XN)
+                                  (IGREATERP YX YN))
+                        (BITBLT OLDBITMAP 0 YN NEWBITMAP XN YN (IDIFFERENCE XX XN)
+                               (IDIFFERENCE YX YN)
+                               'INPUT
+                               'REPLACE))]
+              (\PUTCHARBITMAP.CSINFO
 THINCODE CSINFO NEWBITMAP)))])
 
-                              (* ;; 
-
                             "If FAMILY is a font, the uses its properties, and SIZE is the charset.")

+(\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])
 
-                              (CL:IF (type?
 FONTDESCRIPTOR FAMILY)
-                                  (APPEND (fetch
 (FONTDESCRIPTOR FONTDEVICESPEC) of
 FAMILY)
-                                         (CONS SIZE))
-                                  (LIST FAMILY SIZE FACE ROTATION DEVICE CHARSET))))
-)
+(\SFMAKEITALIC

+  [LAMBDA (CSINFO)
                                           (* ; "Edited 16-Jun-2025 23:20 by rmk")

+                                                             (* gbn "18-Sep-85 17:57")

+    (LET ((WIDTHS (fetch
 (CHARSETINFO WIDTHS) of
 CSINFO))
+          (OFFSETS (fetch
 (CHARSETINFO OFFSETS) of
 CSINFO))
+          (ASCENT (fetch
 (CHARSETINFO CHARSETASCENT) of
 CSINFO))
+          (DESCENT (fetch
 (CHARSETINFO CHARSETDESCENT) of
 CSINFO))
+          (OLDBITMAP (fetch
 (CHARSETINFO CHARSETBITMAP) of
 CSINFO))
+          HEIGHT OFFSET NEWBITMAP WIDTH SLUGOFFSET SLUGWIDTH N M R XN XX YN YX)
+         (SETQ HEIGHT (IPLUS ASCENT DESCENT))
+         (SETQ NEWBITMAP (BITMAPCREATE (fetch
 BITMAPWIDTH of
 OLDBITMAP)
+                                (fetch
 BITMAPHEIGHT of
 OLDBITMAP)))
+         (SETQ SLUGOFFSET (\FGETOFFSET OFFSETS (ADD1 \MAXTHINCHAR)))
+         (SETQ SLUGWIDTH (\FGETWIDTH WIDTHS (ADD1 \MAXTHINCHAR)))
+         (SETQ N (IDIFFERENCE 0 (IQUOTIENT (IPLUS DESCENT 3)
+                                       4)))
+         (SETQ M (IQUOTIENT (IPLUS ASCENT 3)
+                        4))
+         [for
 I from
 0 to
 \MAXTHINCHAR unless
 (EQ SLUGOFFSET (SETQ OFFSET (\FGETOFFSET OFFSETS I)))
+            do
 (SETQ WIDTH (\FGETWIDTH WIDTHS I))
+               (for
 J from
 N to
 M do
 (SETQ R (IPLUS OFFSET WIDTH))
+                                     (SETQ XN (IMIN R (IMAX (IPLUS OFFSET J)
+                                                            0)))
+                                     (SETQ XX (IMIN R (IMAX (IPLUS R J)
+                                                            0)))
+                                     [SETQ YN (IMAX 0 (IPLUS DESCENT (ITIMES J 4]
+                                     [SETQ YX (IMIN HEIGHT (IPLUS DESCENT (IPLUS (ITIMES J 4)
+                                                                                 4]
+                                     (CL:WHEN (AND (IGREATERP XX XN)
+                                                   (IGREATERP YX YN))
+                                         (BITBLT OLDBITMAP OFFSET YN NEWBITMAP XN YN (IDIFFERENCE
+                                                                                      XX XN)
+                                                (IDIFFERENCE YX YN)
+                                                'INPUT
+                                                'REPLACE))]
+         (BITBLT OLDBITMAP SLUGOFFSET 0 NEWBITMAP SLUGOFFSET 0 SLUGWIDTH HEIGHT 'INPUT 'REPLACE)
+         (create
 CHARSETINFO using
 CSINFO CHARSETBITMAP _ NEWBITMAP])
 )
 (DEFINEQ
 
-(\CREATEKERNELEMENT

-  [LAMBDA NIL
                                                (* ; "Edited  8-Jul-2025 22:33 by rmk")


-                                                             (* ; "Edited 17-May-2025 09:36 by rmk")

-
-    (* ;; "ARRAY not CL:MAKE-ARRAY for MAKEINIT.")

-
-    (ARRAY (IPLUS \MAXTHINCHAR 3)
-           'POINTER 0 0])
+(\SFMAKEROTATEDFONT

+  [LAMBDA (FONTDESC ROTATION)
                            (* ; "Edited 30-Mar-87 20:35 by FS")

 
-(\FSETLEFTKERN

-  [LAMBDA (CSINFO INDEX KERNVALUE)
                           (* ; "Edited  8-Jul-2025 22:50 by rmk")


-                                                             (* ; "Edited 17-May-2025 09:18 by rmk")

-    (CL:UNLESS (ARRAYP (ffetch
 (CHARSETINFO LEFTKERN) of
 CSINFO))
-        (replace
 (CHARSETINFO LEFTKERN) of
 CSINFO with
 (\CREATEKERNELEMENT
)))
-    (SETA (fetch
 (CHARSETINFO LEFTKERN) of
 CSINFO)
-          INDEX KERNVALUE])
+    (* ;; "takes a fontdecriptor and rotates it.")

 
-(\FGETLEFTKERN

-  [LAMBDA (FONT PREVCHARCODE CHARCODE)
                       (* ; "Edited  8-Jul-2025 22:15 by rmk")


-                                                             (* ; "Edited 22-May-2025 09:53 by rmk")


-                                                             (* ; "Edited 18-May-2025 21:30 by rmk")


-                                                             (* ; "Edited  1-May-2025 11:08 by rmk")


-                                                             (* ; "Edited 19-Dec-2024 15:25 by rmk")

+    (* ;; "1/5/86 JDS.  Masterscope claims nobody calls this.  Let's find out....")

 
-    (* ;; "Returns the kern information for CHARCODE in FONT, given that it is an immediate successor of PREVCHARCODE.  Returns 0 if no PREVCHARCODE/CHARCODE kerning is specified.  For now, assume that the kerning information is sparse for characters within a character set, stored as a 2-level alist.  ")

+    (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 the kerning information for a character is already a FIXP, then it is an offset no matter what the preceding character might be.  This appears to be the way at least AC font files are set up.")

+    (* ;; "If you uncomment out the code above, remove this comment and the NIL below")

 
-    (* ;; "ACFONTFILES STORE A SINGLE NUMBER.  LOGIC OF CODES IS UNCLEAR")

+    NIL])
 
-    (LET [(KERN (AND (fetch
 (FONTDESCRIPTOR FONTHASLEFTKERNS) of
 FONT)
-                     (ELT (fetch
 (CHARSETINFO LEFTKERN) of
 (\INSURECHARSETINFO (\CHARSET PREVCHARCODE
-                                                                                      )
-                                                                  FONT))
-                          (\CHAR8CODE PREVCHARCODE]
-         (OR (FIXP KERN)
-             (FGETMULTI (LISTP KERN)
-                    CHARCODE)
-             0])
-)
-(DEFINEQ
+(\SFROTATECSINFO

+  [LAMBDA (CSINFO ROTATION)
                              (* gbn "15-Sep-85 14:38")

 
-(\CREATEFONT

-  [LAMBDA (FAMILY SIZE FACE ROTATION DEVICE CHARSET)
         (* ; "Edited 24-Jul-2025 19:51 by rmk")


-                                                             (* ; "Edited 20-May-2025 21:10 by rmk")

+    (* ;; "takes a CHARSETINFO and rotates it and produces a rotated equivalent one.")

 
-    (* ;; "Generic font creation.  Uses fontcreate method from device, build a fontdescriptor but doesn't call SETFONTDESCRIPTOR to install it.")

+    (create
 CHARSETINFO using
 CSINFO CHARSETBITMAP _ (\SFROTATEFONTCHARACTERS

+                                                              (fetch
 (CHARSETINFO CHARSETBITMAP)
+                                                                 of
 CSINFO)
+                                                              ROTATION)
+                                  OFFSETS _ (\SFROTATECSINFOOFFSETS
 CSINFO ROTATION])
 
-    (* ;; "\DEFAULTCHARSET is kind of foolish, since \AVGCHARWIDTH wants the width of A=0,101 and therefore forces charset 0.   (A may be some random character in Symbol, Math, but...).")

+(\SFROTATEFONTCHARACTERS

+  [LAMBDA (CHARBITMAP ROTATION)
                          (* ; "Edited 22-Sep-87 10:38 by Snow")

 
-    (LET (FN FONT)
-         (CL:WHEN (AND [SETQ FN (CADR (ASSOC 'FONTCREATE (CDR (ASSOC DEVICE IMAGESTREAMTYPES]
-                       (SETQ FONT (APPLY* FN FAMILY SIZE FACE ROTATION DEVICE CHARSET)))
-             (replace
 (FONTDESCRIPTOR FONTAVGCHARWIDTH) of
 FONT with
 (\AVGCHARWIDTH
 FONT))
-             FONT)])
+(* ;;; "rotate a bitmap either 90 or 270 for fonts.")

 
-(\CREATECHARSET

-  [LAMBDA (CHARSET FONT NOSLUG?)
                             (* ; "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")

+    (CASE ROTATION
+        (0 CHARBITMAP)
+        (90 (ROTATE-BITMAP-LEFT CHARBITMAP))
+        (180 (ROTATE-BITMAP (ROTATE-BITMAP CHARBITMAP)))
+        (270 (ROTATE-BITMAP CHARBITMAP)))])
 
-    (* ;; "Creates and returns the CHARSETINFO for charset CHARSET in fontdesc FONT, installing it in fonts FONTCHARSETVECTOR")

+(\SFROTATECSINFOOFFSETS

+  [LAMBDA (CSINFO ROTATION)
                                  (* ; "Edited 28-Aug-2025 15:10 by rmk")


+                                                             (* ; "Edited 24-Aug-2025 11:42 by rmk")

+                                                             (* gbn "15-Sep-85 14:36")

                                                              (* ; 
-
    "NOSLUG?  means don't create an empty (slug) csinfo if the charset is not found, just return NIL")

-    (CL:UNLESS (<= 0 CHARSET \MAXCHARSET)
-           (\ILLEGAL.ARG CHARSET))
-    (LET [(CSINFO (if
 (fetch
 (FONTDESCRIPTOR FONTCOMPLETEP) of
 FONT)
-                      then
 (\XGETCHARSETINFO FONT CHARSET)
-                    else
 (APPLY [CADR (ASSOC 'CREATECHARSET (CDR (ASSOC (fetch
 (FONTDESCRIPTOR 
-                                                                                      FONTDEVICE)
-                                                                           of
 FONT)
-                                                                        IMAGESTREAMTYPES]
-                                (APPEND (FONTPROP
 FONT 'DEVICESPEC)
-                                       (LIST CHARSET FONT NOSLUG?]
-
-         (* ;; "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.  But we don't return a slug:  higher ups recognize NIL as a doesn't-exist error.  ")

-
-         (CL:WHEN CSINFO (\INSTALLCHARSETINFO
 FONT CSINFO CHARSET))
-         CSINFO])
-
-(\INSTALLCHARSETINFO

-  [LAMBDA (FONT CSINFO CHARSET)
                              (* ; "Edited 25-May-2025 07:48 by rmk")


-                                                             (* ; "Edited 23-May-2025 14:44 by rmk")


-                                                             (* ; "Edited 12-Jul-2022 15:08 by rmk")

-    (replace
 \SFAscent of
 FONT with
 (IMAX (fetch
 \SFAscent of
 FONT)
-                                          (SIGNED (fetch
 CHARSETASCENT of
 CSINFO)
-                                                 16)))
-    (replace
 (FONTDESCRIPTOR \SFDescent) of
 FONT with
 (IMAX (fetch
 (FONTDESCRIPTOR \SFDescent)
-                                                               of
 FONT)
-                                                            (SIGNED (fetch
 (CHARSETINFO 
-                                                                                  CHARSETDESCENT)
-                                                                       of
 CSINFO)
-                                                                   16)))
+
                                       "adjusts offsets in case where rotation turned things around.")

+    (COND
+       ((EQ ROTATION 270)
+        (PROG ((OFFSETS (fetch
 (CHARSETINFO OFFSETS) of
 CSINFO))
+               (WIDTHS (fetch
 (CHARSETINFO WIDTHS) of
 CSINFO))
+               (BITMAPHEIGHT (BITMAPWIDTH (fetch
 (CHARSETINFO CHARSETBITMAP) of
 CSINFO)))
+               NEWOFFSETS)
+              (SETQ NEWOFFSETS (\CREATECSINFOELEMENT))
+              [for
 CHARCODE from
 0 to
 \MAXTHINCHAR do
 (\FSETOFFSET NEWOFFSETS CHARCODE
+                                                             (IDIFFERENCE BITMAPHEIGHT
+                                                                    (IPLUS (\FGETOFFSET OFFSETS 
+                                                                                  CHARCODE)
+                                                                           (\FGETWIDTH WIDTHS 
+                                                                                  CHARCODE]
                                                              (* ; 
-
                                "jtm: height = ascent + descent, not (IMAX fontHeight charSetHeight)")

-    (replace
 (FONTDESCRIPTOR \SFHeight) of
 FONT with
 (IPLUS (fetch
 (FONTDESCRIPTOR \SFAscent)
-                                                               of
 FONT)
-                                                            (ffetch
 (FONTDESCRIPTOR \SFDescent)
-                                                               of
 FONT)))
-    (\SETCHARSETINFO (fetch
 (FONTDESCRIPTOR FONTCHARSETVECTOR) of
 FONT)
-           CHARSET CSINFO)
-
-    (* ;; "\AVGCHARWIDTH has to be confused after the CSINFO is stuck in.")

-
-    (replace
 (FONTDESCRIPTOR FONTAVGCHARWIDTH) of
 FONT with
 (\AVGCHARWIDTH
 FONT))
-    (\INSTALLCHARSETINFO.CHARENCODING
 FONT CSINFO CHARSET)
-    CSINFO])
+
                                           "may be some problem with dummy character representation.")

+              (RETURN NEWOFFSETS)))
+       (T (fetch
 (CHARSETINFO OFFSETS) of
 CSINFO])
+)
+(DEFINEQ
 
-(\INSTALLCHARSETINFO.CHARENCODING

-  [LAMBDA (FONT CSINFO CHARSET)
                              (* ; "Edited 12-Jul-2025 10:57 by rmk")


-                                                             (* ; "Edited  9-Jul-2025 09:38 by rmk")


-                                                             (* ; "Edited  6-Jul-2025 21:46 by rmk")


-                                                             (* ; "Edited 25-May-2025 23:05 by rmk")


-                                                             (* ; "Edited 24-May-2025 21:42 by rmk")

+(\SFMAKECOLOR

+  [LAMBDA (BWCSINFO BACKCOLOR FORECOLOR BITSPERPIXEL)
    (* kbr%: " 6-Feb-86 18:17")

 
-    (* ;; "The font charencoding is its charset 0 encoding.  All higher charsets are MCCS.")

+    (* ;; "makes a csinfo that has a character bitmap that is colorized.")

 
-    (CL:WHEN (AND (EQ CHARSET 0)
-                  (NOT (fetch
 (CHARSETINFO CSSLUGP) of
 CSINFO)))
-        (replace
 (FONTDESCRIPTOR FONTCHARENCODING) of
 FONT with
 (CHARSETPROP CSINFO 'CSCHARENCODING)))
-    ])
+    (PROG (CHARACTERBITMAP COLORCSINFO)
+          [COND
+             ((IMAGESTREAMP BITSPERPIXEL)
+              (OR BACKCOLOR (SETQ BACKCOLOR (DSPBACKCOLOR NIL BITSPERPIXEL)))
+              (OR FORECOLOR (SETQ FORECOLOR (DSPCOLOR NIL BITSPERPIXEL)))
+              (SETQ BITSPERPIXEL (IMAGESTREAMTYPE BITSPERPIXEL]
+          [SETQ BITSPERPIXEL (COND
+                                ((NUMBERP BITSPERPIXEL)
+                                 BITSPERPIXEL)
+                                (T (\DISPLAYSTREAMTYPEBPP BITSPERPIXEL]
+          (SETQ BACKCOLOR (COLORNUMBERP BACKCOLOR BITSPERPIXEL))
+          (SETQ FORECOLOR (COLORNUMBERP FORECOLOR BITSPERPIXEL))
+          (SETQ CHARACTERBITMAP (COLORIZEBITMAP (fetch
 (CHARSETINFO CHARSETBITMAP) of
 
+                                                                                             BWCSINFO
+                                                       )
+                                       BACKCOLOR FORECOLOR BITSPERPIXEL))
+          (SETQ COLORCSINFO (create
 CHARSETINFO using
 BWCSINFO CHARSETBITMAP _ 
+                                                          CHARACTERBITMAP))
+          (RETURN COLORCSINFO])
 )
 (* "FOLLOWING DEFINITIONS EXPORTED")(DECLARE%: DOEVAL@COMPILE DONTCOPY
 
-(GLOBALVARS DISPLAYFONTDIRECTORIES DISPLAYFONTEXTENSIONS DISPLAYGLYPHCOERCIONS DISPLAYFONTCOERCIONS)
+(GLOBALVARS DISPLAYFONTDIRECTORIES DISPLAYFONTEXTENSIONS DISPLAYCHARCOERCIONS DISPLAYFONTCOERCIONS 
+       DISPLAYCHARSETFNS)
 )
 
 (* "END EXPORTED DEFINITIONS")
 
+(DECLARE%: DONTEVAL@LOAD DOCOPY 
 
+(RPAQ? DISPLAYFONTDIRECTORIES
 NIL)
 
 
-(* ;; 
-"Removed ((CLASSIC 36) (CLASSIC 24)) so that TIMESROMAN 36 BOLD boldifies rather than coercing to CLASSIC 24 BOLD."
-)

+(ADDTOVAR DISPLAYCHARSETFNS
 (STRIKE STRIKEFONT.FILEP STRIKEFONT.GETCHARSET))
 
 
+(ADDTOVAR DISPLAYFONTEXTENSIONS
 MEDLEYDISPLAYFONT DISPLAYFONT)
+)
+
 (RPAQ? DISPLAYFONTCOERCIONS

-       '(((HELVETICA 1)
-          (HELVETICA 4))
-         ((HELVETICA 2)
+       '(((HELVETICA (<= * 2))
           (HELVETICA 4))
-         ((MODERN 60)
-          (MODERN 48))
-         ((MODERN 96)
-          (MODERN 72))
-         ((MODERN 120)
-          (MODERN 72))
+         ((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 (<= * 8))
           (PALATINO 10))
-         ((PALATINO 6)
-          (PALATINO 10))
-         ((TITAN 6)
+         ((TITAN (<= * 9)
+                 BOLD)
+          (MODERN 10))
+         ((TITAN (<= * 9)
+                 ITALIC)
+          (MODERN 10))
+         ((TITAN (<= * 9))
           (TITAN 10))
-         ((TITAN 9 (TITAN 10)))
-         ((LPT)
-          (AMTEX))))
-
-(RPAQ? DISPLAYGLYPHCOERCIONS
 '(((GACHA)
-                                (TERMINAL))
-                               ((MODERN)
-                                (CLASSIC))
-                               ((TIMESROMAN)
-                                (CLASSIC))
-                               ((HELVETICA)
-                                (MODERN))
-                               ((TERMINAL)
-                                (MODERN))))
+         (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)
+         (TITANLEGAL CLASSIC)))
+
+(RPAQ? \DEFAULTCHARSET
 0)
+
+
+
+(* ;; "")

+
+
+
+
+(* ;; "Defunct coercions? Mapping for DOS filenames, Adobe equivalences")

+
 
 (RPAQ? ADOBEDISPLAYFONTCOERCIONS

        '(((HELVETICABLACK 16)
@@ -3883,13 +4600,6 @@
          ((HELVETICA 24)
           (ADOBEHELVETICA 24))))
 
-(RPAQ? \DEFAULTCHARSET
 0)
-
-
-
-(* ; "MAPPING FOR DOS FILENAMES ")

-
-
 (RPAQ? *DISPLAY-FONT-NAME-MAP*

        '((TIMESROMAN . TR)
          (HELVETICA . HV)
@@ -3908,83 +4618,6 @@
          (MATH . MA)
          (OLDENGLISH . OE)
          (SYMBOL . SY)))
-(DEFINEQ
-
-(\FONTRESETCHARWIDTHS

-  [LAMBDA (CSINFO FIRSTCHAR LASTCHAR)
                    (* AJB " 6-Dec-85 14:42")

-                                                             (* ; 
-
                                                     "sets the widths array from the offsets array")

-    (PROG ((mincharcode FIRSTCHAR)
-           (maxcharcode LASTCHAR)
-           (offsets (fetch
 (CHARSETINFO OFFSETS) of
 CSINFO))
-           (widths (fetch
 (CHARSETINFO WIDTHS) of
 CSINFO))
-           left right charoffset dummycharoffset dummycharwidth)
-          (SETQ dummycharoffset (\FGETOFFSET offsets (ADD1 maxcharcode)))
-          (SETQ dummycharwidth (IDIFFERENCE (\FGETOFFSET offsets (IPLUS maxcharcode 2))
-                                      dummycharoffset))
-          [for
 charcode from
 0 to
 \MAXCHAR
-             do
 (COND
-                       ((OR (ILESSP charcode mincharcode)
-                            (IGREATERP charcode maxcharcode))
-                        (\FSETOFFSET offsets charcode dummycharoffset)
-                        (\FSETWIDTH widths charcode dummycharwidth))
-                       (T (SETQ left (\FGETWIDTH offsets charcode))
-                          (SETQ right (\FGETWIDTH offsets (ADD1 charcode)))
-                          (COND
-                             ((EQ left right)
-                              (\FSETOFFSET offsets charcode dummycharoffset)
-                              (\FSETWIDTH widths charcode dummycharwidth))
-                             (T (\FSETWIDTH widths charcode (IDIFFERENCE right left]
-          (\FSETWIDTH widths (ADD1 \MAXCHAR)
-                 dummycharwidth)
-          (\FSETOFFSET offsets (ADD1 \MAXCHAR)
-                 dummycharoffset])
-)
-(DECLARE%: DOEVAL@COMPILE DONTCOPY
-
-(GLOBALVARS DISPLAYCHARSETFNS)
-)
-(DECLARE%: DONTEVAL@LOAD DOCOPY 
-
-(RPAQ? DISPLAYFONTDIRECTORIES
 NIL)
-
-
-(ADDTOVAR DISPLAYCHARSETFNS
 (STRIKE STRIKEFONT.FILEP STRIKEFONT.GETCHARSET))
-)
-(DECLARE%: DONTEVAL@LOAD DOCOPY 
-
-(ADDTOVAR DISPLAYFONTEXTENSIONS
 MEDLEYDISPLAYFONT DISPLAYFONT)
-)
-(DECLARE%: EVAL@COMPILE DONTCOPY 
-(DECLARE%: EVAL@COMPILE 
-
-(RPAQQ MAXCODE
 255)
-
-(RPAQQ DUMMYINDEX
 256)
-
-
-(CONSTANTS (MAXCODE 255)
-       (DUMMYINDEX 256))
-)
-)
-(DECLARE%: EVAL@COMPILE 
-
-(PUTPROPS \FGETCHARIMAGEWIDTH
 MACRO
 (OPENLAMBDA (FONT CHARCODE)
-                                      (\FGETWIDTH (ffetch
 (CHARSETINFO IMAGEWIDTHS)
-                                                     of
 (\INSURECHARSETINFO (\CHARSET CHARCODE)
-                                                               FONT))
-                                             (\CHAR8CODE CHARCODE))))
-
-(PUTPROPS \SETCHARSETINFO
 MACRO
 ((CHARSETVECTOR CHARSET CSINFO)
-                                 (\RPLPTR CHARSETVECTOR (UNFOLD CHARSET 2)
-                                        CSINFO)))
-)
-(DECLARE%: DOEVAL@COMPILE DONTCOPY
-
-(LOCALVARS . T)
-)
-
-(PUTPROPS FONT
 FILETYPE
 :FAKE-COMPILE-FILE)
 (DECLARE%: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY COMPILERVARS 
 
 (ADDTOVAR NLAMA
 )
@@ -3994,41 +4627,43 @@
 (ADDTOVAR LAMA
 FONTCOPY)
 )
 (DECLARE%: DONTCOPY
-  (FILEMAP (NIL (11262 20708 (CHARWIDTH 11272 . 12057) (CHARWIDTHY 12059 . 13532) (STRINGWIDTH 13534 . 
-14627) (\CHARWIDTH.DISPLAY 14629 . 15042) (\STRINGWIDTH.DISPLAY 15044 . 15468) (\STRINGWIDTH.GENERIC 
-15470 . 20706)) (20709 27229 (DEFAULTFONT 20719 . 22004) (FONTCLASS 22006 . 24168) (FONTCLASSUNPARSE 
-24170 . 25069) (FONTCLASSCOMPONENT 25071 . 25659) (SETFONTCLASSCOMPONENT 25661 . 26103) (
-GETFONTCLASSCOMPONENT 26105 . 27227)) (28959 53120 (FONTCREATE 28969 . 31552) (FONTCREATE1 31554 . 
-33547) (FONTCREATE.SLUGFD 33549 . 35165) (\FONT.CHECKARGS 35167 . 41194) (\FONT.CHECKARGS1 41196 . 
-45719) (\FONTCREATE1.NOFN 45721 . 45935) (FONTFILEP 45937 . 46716) (\READCHARSET 46718 . 50970) (
-\COERCEFONTSPEC 50972 . 53118)) (53121 54300 (\COERCEFONTDESC 53131 . 54298)) (54951 60242 (
-COMPLETE.FONT 54961 . 56942) (COMPLETEFONTP 56944 . 57459) (COMPLETE.CHARSET 57461 . 59628) (
-PRUNEFONTSLUGS 59630 . 60240)) (60281 67749 (FONTASCENT 60291 . 60675) (FONTDESCENT 60677 . 61162) (
-FONTHEIGHT 61164 . 61566) (FONTPROP 61568 . 67026) (\AVGCHARWIDTH 67028 . 67747)) (67796 68445 (
-EDITCHAR 67806 . 68443)) (68491 80057 (GETCHARBITMAP 68501 . 69323) (PUTCHARBITMAP 69325 . 71402) (
-\GETCHARBITMAP.CSINFO 71404 . 73311) (\PUTCHARBITMAP.CSINFO 73313 . 80055)) (80058 93233 (
-MOVECHARBITMAP 80068 . 81962) (MOVEFONTCHARS 81964 . 87336) (\MOVEFONTCHAR 87338 . 90845) (
-SLUGCHARP.DISPLAY 90847 . 91745) (\GETCHARINFO 91747 . 93231)) (94162 113415 (FONTFILES 94172 . 95641)
- (\FINDFONTFILE 95643 . 97360) (\FONTFILENAMES 97362 . 98236) (\FONTFILENAME 98238 . 102221) (
-\FONTFILENAME.OLD 102223 . 105172) (\FONTFILENAME.NEW 105174 . 107431) (\FONTINFOFROMFILENAME 107433
- . 111134) (\FONTINFOFROMFILENAME.OLD 111136 . 113413)) (113682 148361 (FONTCOPY 113692 . 118755) (
-FONTP 118757 . 119056) (FONTUNPARSE 119058 . 121622) (SETFONTDESCRIPTOR 121624 . 122870) (
-\STREAMCHARWIDTH 122872 . 127036) (\UNITWIDTHSVECTOR 127038 . 127401) (\COERCECHARSET 127403 . 128857)
- (\BUILDSLUGCSINFO 128859 . 131615) (\FONTSYMBOL 131617 . 132267) (\DEVICESYMBOL 132269 . 133138) (
-\FONTFACE 133140 . 140330) (\FONTFACE.COLOR 140332 . 147252) (SETFONTCHARENCODING 147254 . 148359)) (
-148362 163750 (FONTSAVAILABLE 148372 . 150317) (FONTEXISTS? 150319 . 154810) (\FONTSAVAILABLE.INCORE 
-154812 . 156360) (\SEARCHFONTFILES 156362 . 159390) (FLUSHFONTSINCORE 159392 . 160540) (MATCHFONTFACE 
-160542 . 161357) (FINDFONTFILES 161359 . 163748)) (163843 172559 (\CREATEDISPLAYFONT 163853 . 165449) 
-(\CREATECHARSET.DISPLAY 165451 . 171385) (\FONTEXISTS?.DISPLAY 171387 . 172557)) (172560 185761 (
-STRIKEFONT.FILEP 172570 . 173458) (STRIKEFONT.GETCHARSET 173460 . 178295) (WRITESTRIKEFONTFILE 178297
- . 182301) (STRIKECSINFO 182303 . 185759)) (185792 197502 (MAKEBOLD.CHARSET 185802 . 187633) (
-MAKEBOLD.CHAR 187635 . 188965) (MAKEITALIC.CHARSET 188967 . 190804) (MAKEITALIC.CHAR 190806 . 192839) 
-(\SFMAKEBOLD 192841 . 194847) (\SFMAKEITALIC 194849 . 197500)) (197503 201208 (\SFMAKEROTATEDFONT 
-197513 . 198914) (\SFROTATECSINFO 198916 . 199553) (\SFROTATEFONTCHARACTERS 199555 . 199935) (
-\SFROTATECSINFOOFFSETS 199937 . 201206)) (201209 202590 (\SFMAKECOLOR 201219 . 202588)) (202591 204658
- (FONTDESCRIPTOR.DEFPRINT 202601 . 204180) (FONTCLASS.DEFPRINT 204182 . 204656)) (225140 227684 (
-\CREATEKERNELEMENT 225150 . 225508) (\FSETLEFTKERN 225510 . 226001) (\FGETLEFTKERN 226003 . 227682)) (
-227685 234183 (\CREATEFONT 227695 . 228604) (\CREATECHARSET 228606 . 231242) (\INSTALLCHARSETINFO 
-231244 . 233270) (\INSTALLCHARSETINFO.CHARENCODING 233272 . 234181)) (236577 238329 (
-\FONTRESETCHARWIDTHS 236587 . 238327)))))
+  (FILEMAP (NIL (12196 21909 (CHARWIDTH 12206 . 12991) (CHARWIDTHY 12993 . 14510) (STRINGWIDTH 14512 . 
+15605) (\CHARWIDTH.DISPLAY 15607 . 16020) (\STRINGWIDTH.DISPLAY 16022 . 16446) (\STRINGWIDTH.GENERIC 
+16448 . 21907)) (21910 28430 (DEFAULTFONT 21920 . 23205) (FONTCLASS 23207 . 25369) (FONTCLASSUNPARSE 
+25371 . 26270) (FONTCLASSCOMPONENT 26272 . 26860) (SETFONTCLASSCOMPONENT 26862 . 27304) (
+GETFONTCLASSCOMPONENT 27306 . 28428)) (30109 54490 (FONTCREATE 30119 . 33364) (FONTCREATE1 33366 . 
+35981) (FONTCREATE.SLUGFD 35983 . 37465) (\FONT.CHECKARGS 37467 . 44057) (\FONT.CHECKARGS1 44059 . 
+48582) (\FONTCREATE1.NOFN 48584 . 48798) (FONTFILEP 48800 . 49688) (\READCHARSET 49690 . 54488)) (
+54491 61408 (\FONT.CHECKARGS 54501 . 61091) (\CHARSET.CHECK 61093 . 61406)) (61409 64492 (
+COERCEFONTSPEC 61419 . 64490)) (66562 67352 (MAKEFONTSPEC 66572 . 67350)) (67353 74127 (COMPLETE.FONT 
+67363 . 69886) (COMPLETEFONTP 69888 . 70511) (COMPLETE.CHARSET 70513 . 73198) (PRUNESLUGCSINFOS 73200
+ . 74125)) (74166 82087 (FONTASCENT 74176 . 74560) (FONTDESCENT 74562 . 75047) (FONTHEIGHT 75049 . 
+75451) (FONTPROP 75453 . 81364) (\AVGCHARWIDTH 81366 . 82085)) (82744 83652 (FONTDEVICEPROP 82754 . 
+83650)) (83698 84552 (EDITCHAR 83708 . 84550)) (84598 96788 (GETCHARBITMAP 84608 . 85732) (
+PUTCHARBITMAP 85734 . 87892) (\GETCHARBITMAP.CSINFO 87894 . 89910) (\PUTCHARBITMAP.CSINFO 89912 . 
+96786)) (96789 117269 (MOVECHARBITMAP 96799 . 98693) (MOVEFONTCHARS 98695 . 102655) (\MOVEFONTCHAR 
+102657 . 107500) (\MOVEFONTCHARS.SOURCEDATA 107502 . 113607) (\MAKESLUGCHAR 113609 . 116144) (
+SLUGCHARP.DISPLAY 116146 . 117267)) (118202 138340 (FONTFILES 118212 . 120045) (\FINDFONTFILE 120047
+ . 121764) (\FONTFILENAMES 121766 . 122761) (\FONTFILENAME 122763 . 126746) (\FONTFILENAME.OLD 126748
+ . 129697) (\FONTFILENAME.NEW 129699 . 131956) (FONTSPECFROMFILENAME 131958 . 136059) (
+\FONTINFOFROMFILENAME.OLD 136061 . 138338)) (138607 174410 (FONTCOPY 138617 . 143680) (FONTP 143682 . 
+143981) (FONTUNPARSE 143983 . 145702) (SETFONTDESCRIPTOR 145704 . 147168) (\STREAMCHARWIDTH 147170 . 
+151334) (\COERCECHARSET 151336 . 153931) (\BUILDSLUGCSINFO 153933 . 157556) (\FONTSYMBOL 157558 . 
+158208) (\DEVICESYMBOL 158210 . 159079) (\FONTFACE 159081 . 166271) (\FONTFACE.COLOR 166273 . 173193) 
+(SETFONTCHARENCODING 173195 . 174408)) (174411 194962 (FONTSAVAILABLE 174421 . 179276) (FONTEXISTS? 
+179278 . 183256) (\SEARCHFONTFILES 183258 . 186343) (FLUSHFONTSINCORE 186345 . 189518) (FINDFONTFILES 
+189520 . 192734) (SORTFONTSPECS 192736 . 194960)) (194963 198386 (MATCHFONTFACE 194973 . 195788) (
+MAKEFONTFACE 195790 . 196630) (FONTFACETOATOM 196632 . 198384)) (198614 199106 (\UNITWIDTHSVECTOR 
+198624 . 199104)) (214449 216516 (FONTDESCRIPTOR.DEFPRINT 214459 . 216038) (FONTCLASS.DEFPRINT 216040
+ . 216514)) (220345 223135 (\CREATEKERNELEMENT 220355 . 220713) (\FSETLEFTKERN 220715 . 221206) (
+\FGETLEFTKERN 221208 . 223133)) (223136 232772 (\CREATEFONT 223146 . 224585) (\CREATECHARSET 224587 . 
+228523) (\INSTALLCHARSETINFO 228525 . 231859) (\INSTALLCHARSETINFO.CHARENCODING 231861 . 232770)) (
+233094 234458 (\FONTRESETCHARWIDTHS 233104 . 234456)) (235088 245135 (\CREATEDISPLAYFONT 235098 . 
+236947) (\CREATECHARSET.DISPLAY 236949 . 242658) (\FONTEXISTS?.DISPLAY 242660 . 245133)) (245136 
+260001 (STRIKEFONT.FILEP 245146 . 246034) (STRIKEFONT.GETCHARSET 246036 . 251628) (WRITESTRIKEFONTFILE
+ 251630 . 256541) (STRIKECSINFO 256543 . 259999)) (260032 276349 (MAKEBOLD.CHARSET 260042 . 263691) (
+MAKEBOLD.CHAR 263693 . 265445) (MAKEITALIC.CHARSET 265447 . 269120) (MAKEITALIC.CHAR 269122 . 271468) 
+(\SFMAKEBOLD 271470 . 273694) (\SFMAKEITALIC 273696 . 276347)) (276350 280499 (\SFMAKEROTATEDFONT 
+276360 . 277761) (\SFROTATECSINFO 277763 . 278400) (\SFROTATEFONTCHARACTERS 278402 . 278782) (
+\SFROTATECSINFOOFFSETS 278784 . 280497)) (280500 281881 (\SFMAKECOLOR 280510 . 281879)))))
 STOP
diff --git a/sources/FONT.LCOM b/sources/FONT.LCOM
index 30747eeb5..b3e2cb0d7 100644
Binary files a/sources/FONT.LCOM and b/sources/FONT.LCOM differ
diff --git a/sources/HARDCOPY b/sources/HARDCOPY
index 28bf7c316..4011c0022 100644
--- a/sources/HARDCOPY
+++ b/sources/HARDCOPY
@@ -1,18 +1,28 @@
 (DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
 
-
(FILECREATED "14-Jul-2025 23:00:56" {WMEDLEY}<sources>HARDCOPY.;20
 156777 
+
(FILECREATED "11-Sep-2025 17:08:34" {WMEDLEY}<sources>HARDCOPY.;47
 148569 
 
       :EDIT-BY rmk
 
-      :CHANGES-TO (FNS \DSPFONT.HCPYMODE)
+      :CHANGES-TO (FNS PRINTERDEVICE.OPENFN)
 
-      :PREVIOUS-DATE " 5-Jul-2025 18:52:09" {WMEDLEY}<sources>HARDCOPY.;19)
+      :PREVIOUS-DATE "11-Sep-2025 12:40:56" {WMEDLEY}<sources>HARDCOPY.;46)
 
 
 (PRETTYCOMPRINT HARDCOPYCOMS)
 
 (RPAQQ HARDCOPYCOMS

-       [(COMS                                                (* ; "exported functionality")

+       [[EXPORT (CONSTANTS (MICASPERINCH 2540)
+                       (PTSPERINCH 72)
+                       (MICASPERPT (FQUOTIENT MICASPERINCH PTSPERINCH))
+                       (IHALFMICASPERPT (FIX (FQUOTIENT MICASPERPT 2)))
+                       (IMICASPERPT (FIX MICASPERPT))
+                       (PTSPERCM (FQUOTIENT PTSPERINCH 2.54))
+                       (PTSPERMICA (FQUOTIENT PTSPERINCH MICASPERINCH))
+                       (PTSPERPICA 12)
+                       (PICASPERINCH (QUOTIENT PTSPERINCH PTSPERPICA))
+                       (DEFAULTTAB (IQUOTIENT PTSPERINCH 2]
+        (COMS                                                (* ; "exported functionality")

               (FNS HARDCOPY.SOMEHOW HARDCOPYIMAGEW HARDCOPYIMAGEW.TOFILE HARDCOPYIMAGEW.TOPRINTER 
                    HARDCOPYREGION.TOFILE HARDCOPYREGION.TOPRINTER COPY.WINDOW.TO.BITMAP)
                                                              (* ; "user interface jazz")

@@ -21,36 +31,32 @@
                    GetNewPrinterFromUser PopUpWindowAndGetAtom PopUpWindowAndGetList NewPrinter 
                    GetPrinterName GetImageFile FetchDefaultPrinter)
                                                              (* ; "filename diddlers")

-              (FNS ExtensionForPrintFileType PRINTFILETYPE.FROM.EXTENSION))
+              (FNS EXTENSIONS.FOR.PRINTFILETYPE PRINTFILETYPE.FROM.EXTENSION))
         (COMS                                                (* ; 
 
                                                             "Interface for PRINTERS and IMAGEFILES")

               (FNS DEFAULTPRINTER CAN.PRINT.DIRECTLY CONVERT.FILE.TO.TYPE.FOR.PRINTER EMPRESS 
                    HARDCOPYW LISTFILES1 PRINTER.BITMAPFILE PRINTER.BITMAPSCALE PRINTER.SCRATCH.FILE 
                    PRINTERPROP PRINTERSTATUS PRINTERTYPE PRINTERNAME PRINTFILEPROP PRINTFILETYPE 
                    \EXPECTED.FILE.TYPE SEND.FILE.TO.PRINTER)
-              (FNS PRINTERDEVICE)
+              (FNS PRINTERDEVICE PRINTERDEVICE.OPENFN PRINTERDEVICE.CLOSEFN)
               [DECLARE%: DONTEVAL@LOAD DOCOPY (P (PRINTERDEVICE 'LPT]
-              (P                                             (* ; "for backward compatibility")

-                 (MOVD? 'NILL 'PRINTERMODE))
               (INITVARS (DEFAULTPRINTINGHOST)
-                     (DEFAULTPRINTERTYPE 'INTERPRESS)
+                     (DEFAULTPRINTERTYPE 'PDF)
                      (EMPRESS.SCRATCH)
                      (EMPRESS#SIDES T)
                      (PRINTFILETYPES NIL))
               (GLOBALVARS DEFAULTPRINTINGHOST DEFAULTPRINTERTYPE EMPRESS#SIDES PRINTERTYPES 
                      PRINTFILETYPES))
+        (FNS SCALEREGION)
         (COMS                                                (* ; 
 
                                                             "Converting text files to imagestreams")

-              (INITVARS (TEXTDEFAULTTABS (LIST 20320))
-                     (TEXTDEFAULTPAGEREGION (CREATEREGION 2794 1905 18415 24765)))
-                                                             (* ; 
-
                              "TEXTDEFAULTTABS Hack, mica equivalent of 8 inches.  NOT USED ANYWHERE")

-              (GLOBALVARS TEXTDEFAULTTABS TEXTDEFAULTPAGEREGION)
+              [INITVARS (TEXTDEFAULTPAGEREGION (SCALEREGION MICASPERINCH (CREATEREGION 1.1 0.75 7.25
+                                                                                9.75]
+              (GLOBALVARS TEXTDEFAULTPAGEREGION)
               (FNS TEXTTOIMAGEFILE COPY.TEXT.TO.IMAGE))
-        (COMS (FNS \BLTSHADE.GENERICPRINTER)
-                                                             (* ; 
+        (COMS                                                (* ; 
 
                                                       "hack for printers that can't really BLTSHADE")

-              )
+              (FNS \BLTSHADE.GENERICPRINTER))
         [COMS                                                (* ; 
 
                                                  "stuff to support hardcopy streams on the display.")

               (FNS MAKEHARDCOPYSTREAM UNMAKEHARDCOPYSTREAM HARDCOPYSTREAMTYPE \CHARWIDTH.HDCPYDISPLAY
@@ -58,33 +64,58 @@
                    \DSPYPOSITION.HDCPYDISPLAY \STRINGWIDTH.HDCPYDISPLAY \STRINGWIDTH.HCPYDISPLAYAUX 
                    \HDCPYBLTCHAR \HDCPYDISPLAY.FIX.XPOS \HDCPYDISPLAY.FIX.YPOS \HDCPYDISPLAYINIT 
                    \HDCPYDSPPRINTCHAR \SLOWHDCPYBLTCHAR \CHANGECHARSET.HDCPYDISPLAY)
-              [DECLARE%: DONTCOPY DOEVAL@COMPILE (EXPORT (CONSTANTS (MICASPERPT (FQUOTIENT 2540 72))
-                                                                (IHALFMICASPERPT 17)
-                                                                (IMICASPERPT 35)
-                                                                (DEFAULTTAB 36]
-                                                             (* ; "screen-points:  1/2 inch")

-              (DECLARE%: DONTCOPY DOEVAL@COMPILE (EXPORT (FUNCTIONS \MICASTOPTS)))
-              (DECLARE%: DONTEVAL@LOAD DOCOPY (P (\HDCPYDISPLAYINIT]
-        [COMS                                                (* ; 
+              (DECLARE%: DONTCOPY DOEVAL@COMPILE (EXPORT (MACROS \MICASTOPTS]
+        (COMS                                                (* ; 
 
                                         "Stuff to support MICA-unit hardcopy streams on the display")

-              (FNS MAKEHARDCOPYMODESTREAM UNMAKEHARDCOPYMODESTREAM \BLTSHADE.HCPYMODE 
-                   \BITBLT.HCPYMODE \BRUSHCONVERT.HCPYMODE \CHANGECHARSET.HCPYMODE 
+              (FNS MAKEHARDCOPYMODESTREAM UNMAKEHARDCOPYMODESTREAM \HCPYDISPLAYIMAGEOPS 
+                   \BLTSHADE.HCPYMODE \BITBLT.HCPYMODE \BRUSHCONVERT.HCPYMODE \CHANGECHARSET.HCPYMODE
                    \DASHINGCONVERT.HCPYMODE \CHARWIDTH.HCPYMODE \DRAWLINE.HCPYMODE 
                    \DRAWCURVE.HCPYMODE \DRAWCIRCLE.HCPYMODE \DRAWELLIPSE.HCPYMODE \DSPFONT.HCPYMODE 
                    \DSPLEFTMARGIN.HCPYMODE \DSPLINEFEED.HCPYMODE \DSPRIGHTMARGIN.HCPYMODE 
                    \DSPSPACEFACTOR.HCPYMODE \DSPXPOSITION.HCPYMODE \DSPYPOSITION.HCPYMODE 
-                   \MOVETO.HCPYMODE \FONTCREATE.HCPYMODE.PRESS \CREATECHARSET.HCPYMODE.PRESS 
-                   \FONTCREATE.HCPYMODE.INTERPRESS \CREATECHARSET.HCPYMODE.INTERPRESS 
-                   \STRINGWIDTH.HCPYMODE \HCPYMODEBLTCHAR \HCPYMODEDISPLAYINIT \HCPYMODEDSPPRINTCHAR
-                   \SLOWHCPYMODEBLTCHAR \SFFixY.HCPYMODE)
-              [ADDVARS (IMAGESTREAMTYPES (PRESSDISPLAY (FONTCREATE \FONTCREATE.HCPYMODE.PRESS)
-                                                (CREATECHARSET \CREATECHARSET.HCPYMODE.PRESS))
-                              (INTERPRESSDISPLAY (FONTCREATE \FONTCREATE.HCPYMODE.INTERPRESS)
-                                     (CREATECHARSET \CREATECHARSET.HCPYMODE.INTERPRESS]
-              (DECLARE%: DONTEVAL@LOAD DOCOPY (P (\HCPYMODEDISPLAYINIT]
+                   \MOVETO.HCPYMODE \FONTCREATE.HCPYMODE \CREATECHARSET.HCPYMODE 
+                   \STRINGWIDTH.HCPYMODE \HCPYMODEBLTCHAR \HCPYMODEDSPPRINTCHAR \SLOWHCPYMODEBLTCHAR
+                   \SFFixY.HCPYMODE))
         (DECLARE%: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY COMPILERVARS (ADDVARS (NLAMA)
                                                                              (NLAML)
                                                                              (LAMA])
+(* "FOLLOWING DEFINITIONS EXPORTED")(DECLARE%: EVAL@COMPILE 
+
+(RPAQQ MICASPERINCH
 2540)
+
+(RPAQQ PTSPERINCH
 72)
+
+(RPAQ MICASPERPT
 (FQUOTIENT MICASPERINCH PTSPERINCH))
+
+(RPAQ IHALFMICASPERPT
 (FIX (FQUOTIENT MICASPERPT 2)))
+
+(RPAQ IMICASPERPT
 (FIX MICASPERPT))
+
+(RPAQ PTSPERCM
 (FQUOTIENT PTSPERINCH 2.54))
+
+(RPAQ PTSPERMICA
 (FQUOTIENT PTSPERINCH MICASPERINCH))
+
+(RPAQQ PTSPERPICA
 12)
+
+(RPAQ PICASPERINCH
 (QUOTIENT PTSPERINCH PTSPERPICA))
+
+(RPAQ DEFAULTTAB
 (IQUOTIENT PTSPERINCH 2))
+
+
+(CONSTANTS (MICASPERINCH 2540)
+       (PTSPERINCH 72)
+       (MICASPERPT (FQUOTIENT MICASPERINCH PTSPERINCH))
+       (IHALFMICASPERPT (FIX (FQUOTIENT MICASPERPT 2)))
+       (IMICASPERPT (FIX MICASPERPT))
+       (PTSPERCM (FQUOTIENT PTSPERINCH 2.54))
+       (PTSPERMICA (FQUOTIENT PTSPERINCH MICASPERINCH))
+       (PTSPERPICA 12)
+       (PICASPERINCH (QUOTIENT PTSPERINCH PTSPERPICA))
+       (DEFAULTTAB (IQUOTIENT PTSPERINCH 2)))
+)
+
+(* "END EXPORTED DEFINITIONS")
+
 
 
 
@@ -370,26 +401,25 @@
     (MENU (MakeMenuOfPrinters
 "Which printer?"])
 
 (GetImageFile

-  [LAMBDA (W)
                                                (* ; "Edited 27-Apr-98 16:44 by rmk:")

+  [LAMBDA (W)
                                                (* ; "Edited 10-Sep-2025 14:50 by rmk")


+                                                             (* ; "Edited 27-Apr-98 16:44 by rmk:")

                                                              (* ; "Edited 18-Jan-96 11:17 by ")

                                                              (* ; "Edited 17-Jan-96 10:42 by rmk")

     (PROG (FILE PRINTFILETYPE FILETYPEMENU)
 
      (* ;; "Strip candidate version so overwrites must be explicitly indicated each time.  Use previous file as candidate, and if no previous one, apply function associated with the window to the window and the extension associated with the defaultprinting host.  Such a function on a TEDIT window, for example, could suggest the image-type file named after the underlying TEDIT file.")

 
-          [SETQ FILE
-           (PopUpWindowAndGetAtom

-            "File name (Clear to abort): "
-            (OR [AND (WINDOWPROP W 'HARDCOPYFILE)
-                     (PACKFILENAME 'VERSION NIL 'BODY (WINDOWPROP W 'HARDCOPYFILE]
-                (AND (WINDOWPROP W 'HARDCOPYFILEFN)
-                     (APPLY* (WINDOWPROP W 'HARDCOPYFILEFN)
-                            W
-                            (CAR (MKLIST (CADR (ASSOC 'EXTENSION
-                                                      (CDR (ASSOC (OR (CADDR (LISTP (DEFAULTPRINTER
))
-                                                                             )
-                                                                      (PRINTERTYPE
))
-                                                                  PRINTFILETYPES]
+          [SETQ FILE (PopUpWindowAndGetAtom

+                      "File name (Clear to abort): "
+                      (OR [AND (WINDOWPROP W 'HARDCOPYFILE)
+                               (PACKFILENAME 'VERSION NIL 'BODY (WINDOWPROP W 'HARDCOPYFILE]
+                          (AND (WINDOWPROP W 'HARDCOPYFILEFN)
+                               (APPLY* (WINDOWPROP W 'HARDCOPYFILEFN)
+                                      W
+                                      (CAR (EXTENSIONS.FOR.PRINTFILETYPE
 (OR (CADDR (LISTP (
+
                                                                                       DEFAULTPRINTER

+                                                                                            )))
+                                                                             (PRINTERTYPE
]
           (CL:UNLESS (AND FILE (SETQ FILE (OUTFILEP FILE)))  (* ; "Keep directory etc for reuse")

               (RETURN))
           (WINDOWPROP W 'HARDCOPYFILE FILE)                  (* ; 
@@ -419,10 +449,11 @@
 
 (DEFINEQ
 
-(ExtensionForPrintFileType

-  [LAMBDA (TYPE)
                                             (* ; "Edited 26-Aug-87 14:11 by Snow")

+(EXTENSIONS.FOR.PRINTFILETYPE

+  [LAMBDA (TYPE)
                                             (* ; "Edited 10-Sep-2025 14:43 by rmk")


+                                                             (* ; "Edited 26-Aug-87 14:11 by Snow")

     (DECLARE
 (GLOBALVARS PRINTFILETYPES))
-    (CAADR (ASSOC 'EXTENSION (CDR (ASSOC TYPE PRINTFILETYPES])
+    (CAR (MKLIST (GETMULTI PRINTFILETYPES TYPE 'EXTENSION])
 
 (PRINTFILETYPE.FROM.EXTENSION

   [LAMBDA (FILE)
                                             (* ; "Edited 26-Aug-87 14:11 by Snow")

@@ -798,83 +829,82 @@
 (DEFINEQ
 
 (PRINTERDEVICE

-  [LAMBDA (NAME)
                                             (* ; "Edited  5-Dec-96 11:23 by rmk:")


+  [LAMBDA (NAME)
                                             (* ; "Edited 11-Sep-2025 12:40 by rmk")


+                                                             (* ; "Edited  5-Dec-96 11:23 by rmk:")


                                                              (* ; "Edited  4-Dec-86 16:32 by hdj")

 
-    (* ;; "This defines an LPT device.  An LPT file is a file that gets sent to printer and deleted when it is closed.  This must be defined on a CORE device only because we have no way of inheriting the previous CLOSEFILE function that this function is replacing but needs to call internally.  We have \CORE.CLOSEFILE explicit in this code.")

+    (* ;; "This defines an LPT device.  An LPT file is a file that gets sent to printer and deleted when it is closed.  This must be defined on a CORE device only because we have no way of inheriting the previous CLOSEFILE function that this function is replacing but needs to call internally.  PRINTERDEVICE.CLOSEFN  calls\CORE.CLOSEFILE explicitly.")

 
     (LET ((DEV (\CREATECOREDEVICE NAME)))
-         [replace
 (FDEV OPENFILE) of
 DEV
-            with
 (FUNCTION (LAMBDA (NAME ACCESS RECOG PARAMETERS FDEV OLDSTREAM)
-                             (LET ((STRM (\CORE.OPENFILE NAME ACCESS RECOG PARAMETERS FDEV OLDSTREAM)
-                                         ))
+         (replace
 (FDEV OPENFILE) of
 DEV with
 (FUNCTION PRINTERDEVICE.OPENFN))
+         (replace
 (FDEV CLOSEFILE) of
 DEV with
 (FUNCTION PRINTERDEVICE.CLOSEFN))
+         (\DEFINEDEVICE NAME DEV)
+         NAME])
 
-                                 (* ;; "Mark the original name of the printer on the stream.  Unless the user overrides this by changing the PRINTERNAME property, SEND.FILE.TO.PRINTER in the close function will get the user's original spelling, without any case conversions that might otherwise be done by \CORE.OPENFILE. ")

+(PRINTERDEVICE.OPENFN

+  [LAMBDA (NAME ACCESS RECOG PARAMETERS FDEV OLDSTREAM)
      (* ; "Edited 11-Sep-2025 17:03 by rmk")

+    (LET [(STRM (\CORE.OPENFILE NAME ACCESS RECOG PARAMETERS FDEV OLDSTREAM))
+          (PRINTERNAME
 (FILENAMEFIELD NAME 'NAME]
 
-                                  (STREAMPROP STRM 'PRINTERNAME (FILENAMEFIELD NAME 'NAME))
-                                  STRM]
-         [replace
 (FDEV CLOSEFILE) of
 DEV
-            with
 (FUNCTION (LAMBDA (STREAM)
-                             (LET [(SDEV (fetch
 (STREAM DEVICE) of
 STREAM))
-                                   (PRINTOPTIONS (STREAMPROP STREAM 'PRINTOPTIONS]
+         (* ;; "Mark the original name of the printer on the stream.  Unless the user overrides this by changing the PRINTERNAME property, SEND.FILE.TO.PRINTER in the close function will get the user's original spelling, without any case conversions that might otherwise be done by \CORE.OPENFILE. ")

 
-                                  (* ;; 
-
          "Get PRINTOPTIONS property before closing the stream, in case the closing throws them away")

+         (STREAMPROP STRM 'PRINTERNAME (CL:UNLESS (EQ PRINTERNAME '%.)
+                                              PRINTERNAME))
+         STRM])
 
-                                  (* ;; "")

+(PRINTERDEVICE.CLOSEFN

+  [LAMBDA (STREAM)
                                           (* ; "Edited 11-Sep-2025 12:37 by rmk")

+    (LET [(SDEV (fetch
 (STREAM DEVICE) of
 STREAM))
+          (PRINTOPTIONS (STREAMPROP STREAM 'PRINTOPTIONS]
 
-                                 (* ;; "If we could save away and get at the previous CLOSEFILE method (e.g.  by an FDEVPROP), this could be replaced by the generic (FDEVOP (QUOTE CLOSEFILE) SDEV STREAM)")

+         (* ;; 
+
         "Get PRINTOPTIONS property before closing the stream, in case the closing throws them away")

 
-                                  (COND
-                                     [(AND (NOT RESETSTATE)
-                                           (OPENP STREAM 'OUTPUT)
-                                           (IGREATERP (GETEOFPTR STREAM)
-                                                  0))
+         (* ;; "")

 
-                                 (* ;; "Close and send to printer only if open for output.  If open for input, then we must already have started printing.  Don't close until after getting EOF ptr.")

+         (* ;; "If we could save away and get at the previous CLOSEFILE method (e.g.  by an FDEVPROP), this could be replaced by the generic (FDEVOP (QUOTE CLOSEFILE) SDEV STREAM).  We know that SDEV is a CORE device, we call \CORE.CLOSEFILE directly")

 
-                                      (\CORE.CLOSEFILE STREAM)
-                                      (replace
 (STREAM ACCESS) of
 STREAM with
 NIL)
-                                                             (* ; 
+         (COND
+            [(AND (NOT RESETSTATE)
+                  (OPENP STREAM 'OUTPUT)
+                  (IGREATERP (GETEOFPTR STREAM)
+                         0))
+
+             (* ;; "Close and send to printer only if open for output.  If open for input, then we must already have started printing.  Don't close until after getting EOF ptr.")

+
+             (\CORE.CLOSEFILE STREAM)
+             (replace
 (STREAM ACCESS) of
 STREAM with
 NIL)    (* ; 
 
                                  "Hack, cause this is usually done later in the generic \CLOSEFILE.")

 
-                                 (* ;; "The PRINTERNAME might be marked explicitly on the stream.  Otherwise let SEND.FILE.TO.PRINTER choose the host if it is the generic printer LPT, or use the name in the devicename field.")

-
-                                      (SEND.FILE.TO.PRINTER

-                                       STREAM
-                                       [IF
 (STREAMPROP STREAM 'PRINTERNAME)
-                                         ELSEIF
 (NEQ 'LPT (fetch
 (FDEV DEVICENAME) of
 SDEV))
-                                           THEN
 (fetch
 (FDEV DEVICENAME) of
 SDEV)
-                                         ELSE
 (LET ((NAME (fetch
 (STREAM FULLNAME) of
 STREAM))
-                                                    POS POS2)
-                                                   (AND (SETQ POS (STRPOS "}" NAME))
-                                                        (SETQ POS2 (STRPOS "." NAME (ADD1 POS)))
-                                                        (SUBATOM NAME (ADD1 POS)
-                                                               (SUB1 POS2]
-                                       (APPEND '(DELETE T)
-                                              PRINTOPTIONS
-                                              '(HEADING T]
-                                     (T 
-
-                                 (* ;; "Error while creating the file, if the user had wrapped a RESETLST/CLOSEF around his code.  Presumably, he doesn't want the file printed")

-
-                                        (\CORE.CLOSEFILE STREAM)
-                                        (FDEVOP 'DELETEFILE SDEV STREAM SDEV T]
-         (\DEFINEDEVICE NAME DEV)
-         NAME])
+             (* ;; "The PRINTERNAME might be marked explicitly on the stream.  Otherwise let SEND.FILE.TO.PRINTER choose the host if it is the generic printer LPT, or use the name in the devicename field.")

+
+             (SEND.FILE.TO.PRINTER
 STREAM (IF
 (STREAMPROP STREAM 'PRINTERNAME)
+                                            ELSEIF
 (NEQ 'LPT (fetch
 (FDEV DEVICENAME) of
 SDEV))
+                                              THEN
 (fetch
 (FDEV DEVICENAME) of
 SDEV)
+                                            ELSE
 [LET ((NAME (fetch
 (STREAM FULLNAME) of
 STREAM))
+                                                       POS POS2)
+                                                      (AND (SETQ POS (STRPOS "}" NAME))
+                                                           (SETQ POS2 (STRPOS "." NAME (ADD1 POS)))
+                                                           (SUBATOM NAME (ADD1 POS)
+                                                                  (SUB1 POS2]
+                                                 NIL)
+                    (APPEND '(DELETE T)
+                           PRINTOPTIONS
+                           '(HEADING T]
+            (T 
+               (* ;; "Error while creating the file, if the user had wrapped a RESETLST/CLOSEF around his code.  Presumably, he doesn't want the file printed")

+
+               (\CORE.CLOSEFILE STREAM)
+               (FDEVOP 'DELETEFILE SDEV STREAM SDEV T])
 )
 (DECLARE%: DONTEVAL@LOAD DOCOPY 
 
 (PRINTERDEVICE
 'LPT)
 )
 
-                                                             (* ; "for backward compatibility")

-
-(MOVD? 'NILL 'PRINTERMODE)
-
 (RPAQ? DEFAULTPRINTINGHOST
 )
 
-(RPAQ? DEFAULTPRINTERTYPE
 'INTERPRESS)
+(RPAQ? DEFAULTPRINTERTYPE
 'PDF)
 
 (RPAQ? EMPRESS.SCRATCH
 )
 
@@ -885,23 +915,27 @@
 
 (GLOBALVARS DEFAULTPRINTINGHOST DEFAULTPRINTERTYPE EMPRESS#SIDES PRINTERTYPES PRINTFILETYPES)
 )
+(DEFINEQ
 
+(SCALEREGION

+  [LAMBDA (SCALE REGION)                                     (* rmk%: "21-JUL-82 13:06")

+                                                             (* ; "Scales a region")

+    (create
 REGION
+           LEFT _ (FIX (FTIMES SCALE (fetch
 (REGION LEFT) of
 REGION)))
+           BOTTOM _ (FIX (FTIMES SCALE (fetch
 (REGION BOTTOM) of
 REGION)))
+           WIDTH _ (FIX (FTIMES SCALE (fetch
 (REGION WIDTH) of
 REGION)))
+           HEIGHT _ (FIX (FTIMES SCALE (fetch
 (REGION HEIGHT) of
 REGION])
+)
 
 
-(* ; "Converting text files to imagestreams")

-
-
-(RPAQ? TEXTDEFAULTTABS
 (LIST 20320))
-
-(RPAQ? TEXTDEFAULTPAGEREGION
 (CREATEREGION 2794 1905 18415 24765))
-
 
+(* ; "Converting text files to imagestreams")

 
-(* ; "TEXTDEFAULTTABS Hack, mica equivalent of 8 inches.  NOT USED ANYWHERE")

 
+(RPAQ? TEXTDEFAULTPAGEREGION
 (SCALEREGION MICASPERINCH (CREATEREGION 1.1 0.75 7.25 9.75)))
 (DECLARE%: DOEVAL@COMPILE DONTCOPY
 
-(GLOBALVARS TEXTDEFAULTTABS TEXTDEFAULTPAGEREGION)
+(GLOBALVARS TEXTDEFAULTPAGEREGION)
 )
 (DEFINEQ
 
@@ -1031,6 +1065,11 @@
                  (\OUTCHAR IMAGESTREAM C]
      (SETFILEINFO INSTRM 'ENDOFSTREAMOP EOSP])
 )
+
+
+
+(* ; "hack for printers that can't really BLTSHADE")

+
 (DEFINEQ
 
 (\BLTSHADE.GENERICPRINTER

@@ -1064,19 +1103,16 @@
 
 
 
-(* ; "hack for printers that can't really BLTSHADE")

-
-
-
-
 (* ; "stuff to support hardcopy streams on the display.")

 
 (DEFINEQ
 
 (MAKEHARDCOPYSTREAM

-  [LAMBDA (DISPLAYSTREAM IMAGETYPE)
                          (* ; "Edited 26-Aug-87 14:23 by Snow")

+  [LAMBDA (DISPLAYSTREAM IMAGETYPE)
                          (* ; "Edited  9-Sep-2025 15:11 by rmk")


+                                                             (* ; "Edited 26-Aug-87 14:23 by Snow")

 
-(* ;;; "creates a hardcopy stream from a display stream.")

+(* ;;; 
+
"creates a hardcopy stream from a display stream. Seems to be called only from SK.SET.HARDCOPY.MODE")

 
     (DECLARE
 (GLOBALVARS \HDCPYDISPLAYIMAGEOPS))
     (PROG [(DS (COND
@@ -1124,26 +1160,30 @@
           (RETURN DS])
 
 (HARDCOPYSTREAMTYPE

-  [LAMBDA (IMAGESTREAM)
                                      (* ; "Edited 26-Aug-87 14:24 by Snow")

+  [LAMBDA (IMAGESTREAM)
                                      (* ; "Edited  9-Sep-2025 13:40 by rmk")


+                                                             (* ; "Edited 26-Aug-87 14:24 by Snow")

 
-(* ;;; "returns the type of a hard copy stream which is either PRESS or INTERPRESS.")

+(* ;;; "returns the type of a hard copy stream.")

 
     (LET ((STREAM (\OUTSTREAMARG IMAGESTREAM T)))
          (AND STREAM (STREAMPROP STREAM 'HARDCOPYIMAGETYPE])
 
 (\CHARWIDTH.HDCPYDISPLAY

-  [LAMBDA (STREAM CHARCODE)
                                  (* ; "Edited 26-Aug-87 14:24 by Snow")

+  [LAMBDA (STREAM CHARCODE)
                                  (* ; "Edited 10-Sep-2025 23:48 by rmk")


+                                                             (* ; "Edited 26-Aug-87 14:24 by Snow")

                                                              (* ; 
 
        "gets the width of a character code in a hardcopy stream.  Should be updated for spacefactor")

     (IQUOTIENT (IPLUS (\FGETCHARIMAGEWIDTH (FONTCREATE (ffetch
 (\DISPLAYDATA DDFONT)
                                                           of
 (ffetch
 IMAGEDATA of
 STREAM))
                                                   NIL NIL NIL (STREAMPROP STREAM 'HARDCOPYIMAGETYPE))
                              CHARCODE)
-                      (CONSTANT IHALFMICASPERPT))
-           (CONSTANT IMICASPERPT])
+                      IHALFMICASPERPT)
+           IMICASPERPT])
 
 (\DSPFONT.HDCPYDISPLAY

-  [LAMBDA (HDCPYDSTREAM FONT)
                                (* ; "Edited 12-Jan-88 16:18 by jds")

+  [LAMBDA (HDCPYDSTREAM FONT)
                                (* ; "Edited 10-Sep-2025 23:48 by rmk")


+                                                             (* ; "Edited  2-Sep-2025 22:34 by rmk")


+                                                             (* ; "Edited 12-Jan-88 16:18 by jds")

 
     (* ;; "changes the font of a hardcopy display stream.  Does what the display does then puts the hardcopy widths where they can be found {FOR NOW USE THE DDCHARIMAGEWIDTHS FIELD}")

 
@@ -1154,10 +1194,9 @@
 
                            "For now, use a streamprop instead of a special field in the dispay data")

                                                              (* ; "Scale widths to printer device units, so we don't have to fetch the constants to scale by for every char we print")

                            (replace
 DDCHARIMAGEWIDTHS of
 DD
-                              with
 (PROG (W OLDWIDTH (SCALE (FONTPROP FD 'SCALE))
-                                            (CSINFO (\GETCHARSETINFO (fetch
 (STREAM CHARSET)
-                                                                        of
 HDCPYDSTREAM)
-                                                           FD)))
+                              with
 (PROG [W OLDWIDTH (SCALE (FONTPROP FD 'SCALE))
+                                            (CSINFO (\INSURECHARSETINFO FD (fetch
 (STREAM CHARSET)
+                                                                              of
 HDCPYDSTREAM]
 
                                     (* ;; "set linefeed from scaled height.  This may be off by almost half a pixel per line but it is better than not doing so.")

 
@@ -1166,19 +1205,19 @@
                                                                             of
 FD)
                                                                       SCALE]
                                          [COND
-                                            ((EQP SCALE (CONSTANT MICASPERPT))
+                                            ((EQP SCALE MICASPERPT)
                                              (RETURN (fetch
 (CHARSETINFO WIDTHS) of
 CSINFO]
                                          (SETQ W (\CREATECSINFOELEMENT))
                                          (SETQ OLDWIDTH (fetch
 (CHARSETINFO WIDTHS) of
 CSINFO))
-                                         (SETQ SCALE (FQUOTIENT (CONSTANT MICASPERPT)
-                                                            SCALE))
+                                         (SETQ SCALE (FQUOTIENT MICASPERPT SCALE))
                                          [for
 I from
 0 to
 \MAXTHINCHAR
                                             do
 (\FSETWIDTH W I (FIXR (FTIMES (\FGETWIDTH OLDWIDTH I)
                                                                             SCALE]
                                          (RETURN W])])
 
 (\DSPRIGHTMARGIN.HDCPYDISPLAY

-  [LAMBDA (DISPLAYSTREAM XPOSITION)
                          (* ; "Edited 26-Aug-87 14:25 by Snow")

+  [LAMBDA (DISPLAYSTREAM XPOSITION)
                          (* ; "Edited 10-Sep-2025 23:49 by rmk")


+                                                             (* ; "Edited 26-Aug-87 14:25 by Snow")

 
 (* ;;; "Sets the right margin that determines when a cr is inserted by print for the hardcopy display stream.")

 
@@ -1187,7 +1226,7 @@
     (PROG1 (\DSPRIGHTMARGIN.DISPLAY DISPLAYSTREAM XPOSITION)
         [AND XPOSITION (replace
 (\DISPLAYDATA DDMICARIGHTMARGIN) of
 (fetch
 IMAGEDATA of
 DISPLAYSTREAM
                                                                            )
-                          with
 (FIX (FTIMES XPOSITION (CONSTANT MICASPERPT])])
+                          with
 (FIX (FTIMES XPOSITION MICASPERPT])])
 
 (\DSPXPOSITION.HDCPYDISPLAY

   [LAMBDA (HARDCOPYSTREAM XPOSITION)
                         (* ; "Edited 26-Aug-87 14:25 by Snow")

@@ -1202,7 +1241,8 @@
         (AND YPOSITION (\HDCPYDISPLAY.FIX.YPOS
 HARDCOPYSTREAM)))])
 
 (\STRINGWIDTH.HDCPYDISPLAY

-  [LAMBDA (STREAM STR RDTBL)
                                 (* ; "Edited 26-Aug-87 14:25 by Snow")

+  [LAMBDA (STREAM STR RDTBL)
                                 (* ; "Edited 10-Sep-2025 23:49 by rmk")


+                                                             (* ; "Edited 26-Aug-87 14:25 by Snow")

                                                              (* ; 
 
                   "Returns the width of for the current font/spacefactor in hardcopy stream STREAM.")

     (LET [(HARDCOPYFD (FONTCREATE (ffetch
 (\DISPLAYDATA DDFONT) of
 (ffetch
 IMAGEDATA of
 STREAM))
@@ -1210,11 +1250,12 @@
          (IQUOTIENT (IPLUS (\STRINGWIDTH.GENERIC STR HARDCOPYFD RDTBL (\FGETCHARIMAGEWIDTH
                                                                        HARDCOPYFD
                                                                        (CHARCODE SPACE)))
-                           (CONSTANT IHALFMICASPERPT))
-                (CONSTANT IMICASPERPT])
+                           IHALFMICASPERPT)
+                IMICASPERPT])
 
 (\STRINGWIDTH.HCPYDISPLAYAUX

-  [LAMBDA (STR FONT RDTBL SPACEWIDTH)
                        (* ; "Edited  3-Apr-87 13:48 by jop")

+  [LAMBDA (STR FONT RDTBL SPACEWIDTH)
                        (* ; "Edited  2-Sep-2025 22:35 by rmk")


+                                                             (* ; "Edited  3-Apr-87 13:48 by jop")

 
     (* ;; "Returns the width of STR with SPACEWIDTH for the width of spaces.  RDTBL has already been coerced, so no FLG is needed")

 
@@ -1232,7 +1273,7 @@
                                        ((NEQ CSET (\CHARSET C))
                                         (SETQ CSET (\CHARSET C))
                                         (SETQ WIDTHSBASE (ffetch
 (CHARSETINFO IMAGEWIDTHS)
-                                                            of
 (\GETCHARSETINFO CSET FONT]
+                                                            of
 (\INSURECHARSETINFO FONT CSET]
                                     (COND
                                        ((EQ C (CHARCODE SPACE))
                                         SPACEWIDTH)
@@ -1255,7 +1296,7 @@
 
                                                       "Get the widths vector for this character set")

                               (SETQ CSET (\CHARSET C))
                               (SETQ WIDTHSBASE (ffetch
 (CHARSETINFO IMAGEWIDTHS)
-                                                  of
 (\GETCHARSETINFO CSET FONT]
+                                                  of
 (\INSURECHARSETINFO FONT CSET]
                           (add
 TOTAL (COND
                                         ((EQ C (CHARCODE SPACE))
                                          SPACEWIDTH)
@@ -1284,15 +1325,16 @@
                                                                     (SETQ WIDTHSBASE
                                                                      (ffetch
 (CHARSETINFO IMAGEWIDTHS
                                                                                     )
-                                                                        of
 (\GETCHARSETINFO CSET FONT
-                                                                                  )))
+                                                                        of
 (\INSURECHARSETINFO FONT 
+                                                                                  CSET)))
                                                                     (\FGETIMAGEWIDTH WIDTHSBASE
                                                                            (\CHAR8CODE CC]
                               STR RDTBL RDTBL *PRINT-LEVEL* *PRINT-LENGTH*)
                        TOTALWIDTH])
 
 (\HDCPYBLTCHAR

-  [LAMBDA (CHARCODE DISPLAYSTREAM DISPLAYDATA)
               (* ; "Edited 26-Aug-87 14:26 by Snow")

+  [LAMBDA (CHARCODE DISPLAYSTREAM DISPLAYDATA)
               (* ; "Edited 10-Sep-2025 23:49 by rmk")


+                                                             (* ; "Edited 26-Aug-87 14:26 by Snow")

 
     (* ;; "puts a character on a hardcopy display stream.  Much of the information needed by the BitBlt microcode is prestored by the routines that change it.  This is kept in the BitBltTable.")

                                                              (* ; 
@@ -1330,12 +1372,10 @@
 
      (* ;; "update the display stream x position.  Make sure that there is at least one point width for each character.")

 
-          [freplace
 DDXPOSITION of
 DISPLAYDATA with
 (IMAX (ADD1 CURX)
-                                                          (IQUOTIENT (IPLUS MICARIGHT (CONSTANT
-                                                                                       
-                                                                                      IHALFMICASPERPT
-                                                                                       ))
-                                                                 (CONSTANT IMICASPERPT]
+          (freplace
 DDXPOSITION of
 DISPLAYDATA with
 (IMAX (ADD1 CURX)
+                                                          (IQUOTIENT (IPLUS MICARIGHT IHALFMICASPERPT
+                                                                            )
+                                                                 IMICASPERPT)))
                                                              (* ; 
 
                                        "transforms an x coordinate into the destination coordinate.")

           (SETQ CURX (IPLUS CURX (ffetch
 DDXOFFSET of
 DISPLAYDATA)))
@@ -1365,29 +1405,32 @@
                       T])
 
 (\HDCPYDISPLAY.FIX.XPOS

-  [LAMBDA (HARDCOPYSTREAM)
                                   (* ; "Edited 26-Aug-87 14:26 by Snow")

+  [LAMBDA (HARDCOPYSTREAM)
                                   (* ; "Edited 10-Sep-2025 23:49 by rmk")


+                                                             (* ; "Edited 26-Aug-87 14:26 by Snow")

 
 (* ;;; "updates the mica X position from the x position in the display stream.  This is called whenever the X position changes in a hardcopy stream.")

 
     (PROG ((DD (fetch
 IMAGEDATA of
 HARDCOPYSTREAM)))
           (replace
 (\DISPLAYDATA DDMICAXPOS) of
 DD with
 (FIX (FTIMES (fetch
 (\DISPLAYDATA DDXPOSITION
                                                                                    ) of
 DD)
-                                                                    (CONSTANT MICASPERPT])
+                                                                    MICASPERPT])
 
 (\HDCPYDISPLAY.FIX.YPOS

-  [LAMBDA (HARDCOPYSTREAM)
                                   (* ; "Edited 26-Aug-87 14:26 by Snow")

+  [LAMBDA (HARDCOPYSTREAM)
                                   (* ; "Edited 10-Sep-2025 23:49 by rmk")


+                                                             (* ; "Edited 26-Aug-87 14:26 by Snow")

 
 (* ;;; "updates the mica Y position from the Y position in the display stream.  This is called whenever the Y position changes in a hardcopy stream.")

 
-    (PROG ((DD (fetch
 IMAGEDATA of
 HARDCOPYSTREAM)))
-          (replace
 (\DISPLAYDATA DDMICAYPOS) of
 DD with
 (FIX (FTIMES (fetch
 (\DISPLAYDATA DDYPOSITION
-                                                                                   ) of
 DD)
-                                                                    (CONSTANT MICASPERPT])
+    (LET ((DD (fetch
 IMAGEDATA of
 HARDCOPYSTREAM)))
+         (replace
 (\DISPLAYDATA DDMICAYPOS) of
 DD with
 (FIX (FTIMES (fetch
 (\DISPLAYDATA DDYPOSITION)
+                                                                       of
 DD)
+                                                                   MICASPERPT])
 
 (\HDCPYDISPLAYINIT

-  [LAMBDA NIL
                                                (* ; "Edited 26-Aug-87 14:26 by Snow")

+  [LAMBDA NIL
                                                (* ; "Edited  9-Sep-2025 13:42 by rmk")


+                                                             (* ; "Edited 26-Aug-87 14:26 by Snow")

 
-(* ;;; "Initializes global variables for the hardcopy Display device.  This device appears to the user as an INTERPRESS or PRESS device meaning units in micas but outputs to the screen.  Much of this code was borrowed from the display case.")

+(* ;;; "Initializes global variables for the hardcopy Display device.  This device appears to the user as a hardcopy device meaning units in micas but outputs to the screen.  Much of this code was borrowed from the display case.")

 
     (DECLARE
 (GLOBALVARS \HDCPYDISPLAYIMAGEOPS))
     (SETQ \HDCPYDISPLAYIMAGEOPS (create
 IMAGEOPS using
 \DISPLAYIMAGEOPS IMAGETYPE _
@@ -1490,7 +1533,8 @@
                (SHOULDNT])
 
 (\SLOWHDCPYBLTCHAR

-  [LAMBDA (CHARCODE DISPLAYSTREAM)
                         (* ; "Edited  9-Nov-89 14:37 by gadener")

+  [LAMBDA (CHARCODE DISPLAYSTREAM)
                           (* ; "Edited  2-Sep-2025 22:35 by rmk")


+                                                           (* ; "Edited  9-Nov-89 14:37 by gadener")

 
 (* ;;; 
 
"IS THIS CODE JUST GOING TO DUPLICATE AND GET OUT OF SYNC WITH \SLOWBLTCHAR?  KBR 1-FEB-86.  *")

@@ -1554,8 +1598,8 @@
                 (PROG (YPOS HEIGHTMOVED CSINFO)
                       (SETQ YPOS (ffetch
 (\DISPLAYDATA DDYPOSITION) of
 DD))
                       (SETQ HEIGHTMOVED (\DSPGETCHARWIDTH CHAR8CODE DD))
-                      (SETQ CSINFO (\GETCHARSETINFO (\CHARSET CHARCODE)
-                                          (ffetch
 (\DISPLAYDATA DDFONT) of
 DD)))
+                      (SETQ CSINFO (\INSURECHARSETINFO (ffetch
 (\DISPLAYDATA DDFONT) of
 DD)
+                                          (\CHARSET CHARCODE)))
                       (COND
                          ((EQ ROTATION 90)                   (* ; "don't force CR for rotated fonts.")

                           (\DSPYPOSITION.DISPLAY DISPLAYSTREAM (IPLUS YPOS HEIGHTMOVED))
@@ -1586,7 +1630,9 @@
                          (T (ERROR "Not implemented to rotate by other than 0, 90 or 270"])
 
 (\CHANGECHARSET.HDCPYDISPLAY

-  [LAMBDA (DISPLAYDATA CHARSET HDCPYDSTREAM)
                 (* ; "Edited 26-Aug-87 14:27 by Snow")

+  [LAMBDA (DISPLAYDATA CHARSET HDCPYDSTREAM)
                 (* ; "Edited 10-Sep-2025 23:50 by rmk")


+                                                             (* ; "Edited  2-Sep-2025 22:35 by rmk")


+                                                             (* ; "Edited 26-Aug-87 14:27 by Snow")

 
     (* ;; "Called when the character set information cached in a display stream doesn't correspond to CHARSET Only sets those field that are different from the regular DISPLAY case and uses the regular display case to get the rest.")

 
@@ -1599,14 +1645,13 @@
 
 "Scale widths to micas, so we don't have to fetch the constants to scale by for every char we print")

           (replace
 DDCHARIMAGEWIDTHS of
 DISPLAYDATA
              with
 (PROG (W OLDWIDTH (SCALE (FONTPROP FD 'SCALE))
-                           (CSINFO (\GETCHARSETINFO CHARSET FD)))
+                           (CSINFO (\INSURECHARSETINFO FD CHARSET)))
                         (SETQ OLDWIDTH (fetch
 (CHARSETINFO WIDTHS) of
 CSINFO))
                         (COND
-                           ((EQP SCALE (CONSTANT MICASPERPT))
+                           ((EQP SCALE MICASPERPT)
                             (RETURN OLDWIDTH)))
                         (SETQ W (\CREATECSINFOELEMENT))
-                        (SETQ SCALE (FQUOTIENT (CONSTANT MICASPERPT)
-                                           SCALE))
+                        (SETQ SCALE (FQUOTIENT MICASPERPT SCALE))
                         [for
 I from
 0 to
 \MAXTHINCHAR
                            do
 (\FSETWIDTH W I (FIXR (FTIMES (\FGETWIDTH OLDWIDTH I)
                                                            SCALE]
@@ -1615,19 +1660,8 @@
 (DECLARE%: DONTCOPY DOEVAL@COMPILE 
 (* "FOLLOWING DEFINITIONS EXPORTED")(DECLARE%: EVAL@COMPILE 
 
-(RPAQ MICASPERPT
 (FQUOTIENT 2540 72))
-
-(RPAQQ IHALFMICASPERPT
 17)
-
-(RPAQQ IMICASPERPT
 35)
-
-(RPAQQ DEFAULTTAB
 36)
-
-
-(CONSTANTS (MICASPERPT (FQUOTIENT 2540 72))
-       (IHALFMICASPERPT 17)
-       (IMICASPERPT 35)
-       (DEFAULTTAB 36))
+(PUTPROPS \MICASTOPTS
 MACRO
 ((MICAS)
+                             (QUOTIENT MICAS MICASPERPT)))
 )
 
 (* "END EXPORTED DEFINITIONS")
@@ -1636,52 +1670,30 @@
 
 
 
-(* ; "screen-points:  1/2 inch")

-
-(DECLARE%: DONTCOPY DOEVAL@COMPILE 
-(* "FOLLOWING DEFINITIONS EXPORTED")
-(DEFMACRO \MICASTOPTS
 (MICAS)
-   [COND
-      ((NUMBERP MICAS)
-       (QUOTIENT MICAS MICASPERPT))
-      (T `(QUOTIENT ,MICAS MICASPERPT])
-
-(* "END EXPORTED DEFINITIONS")
-
-)
-(DECLARE%: DONTEVAL@LOAD DOCOPY 
-
-(\HDCPYDISPLAYINIT
)
-)
-
-
-
 (* ; "Stuff to support MICA-unit hardcopy streams on the display")

 
 (DEFINEQ
 
 (MAKEHARDCOPYMODESTREAM

-  [LAMBDA (DISPLAYSTREAM IMAGETYPE)
                          (* ; "Edited  1-Apr-88 11:25 by jds")

+  [LAMBDA (DISPLAYSTREAM IMAGETYPE)
                          (* ; "Edited  9-Sep-2025 13:33 by rmk")


+                                                             (* ; "Edited  1-Apr-88 11:25 by jds")

 
 (* ;;; "Creates a hardcopy-mode display stream from a normal one.  That stream operates in units of micas, but displays on the screen as usual.")

 
-    (DECLARE
 (GLOBALVARS \HCPYMODEDISPLAYIMAGEOPS.PRESS \HCPYMODEDISPLAYIMAGEOPS.INTERPRESS))
-    (PROG [(DS (COND
+    (CL:UNLESS IMAGETYPE
+        [SETQ IMAGETYPE (CAR (PRINTERPROP
 (PRINTERTYPE
)
+                                    'CANPRINT])
+    (LET* ([DS (COND
                   ((DISPLAYSTREAMP DISPLAYSTREAM))
                   ((WINDOWP DISPLAYSTREAM)
                    (WINDOWPROP DISPLAYSTREAM 'DSP))
                   ((NULL DISPLAYSTREAM)
                    (DSPCREATE))
                   (T (\ILLEGAL.ARG DISPLAYSTREAM]
-          (SELECTQ [OR IMAGETYPE (SETQ IMAGETYPE (CAR (PRINTERPROP
 (PRINTERTYPE
)
-                                                             'CANPRINT]
-              (PRESS                                         (* ; 
-
                      "Give the stream PRESS-style imageops, so it will deal with press fonts right.")

-                     (replace
 (STREAM IMAGEOPS) of
 DS with
 \HCPYMODEDISPLAYIMAGEOPS.PRESS))
-              (INTERPRESS                                    (* ; 
-
          "Give the stream INTERPRESS-style operations, so it will deal with Interpress fonts right.")

-                          (replace
 (STREAM IMAGEOPS) of
 DS with
 \HCPYMODEDISPLAYIMAGEOPS.INTERPRESS))
-              NIL)
+           (IMAGEOPSVAR (PACK* "\HCPYMODEDISPLAYIMAGEOPS." IMAGETYPE)))
+          (CL:UNLESS (type?
 IMAGEOPS (GETATOMVAL IMAGEOPSVAR))
+              (SETATOMVAL IMAGEOPSVAR (\HCPYDISPLAYIMAGEOPS
 IMAGETYPE)))
+          (replace
 (STREAM IMAGEOPS) of
 DS with
 (GETATOMVAL IMAGEOPSVAR))
           (STREAMPROP DS 'HARDCOPYIMAGETYPE IMAGETYPE)       (* ; 
 
               "set the bout fn to one that updates the mica fields and sets the position from them.")

           (replace
 (STREAM STRMBOUTFN) of
 DS with
 (FUNCTION \HCPYMODEDSPPRINTCHAR))
@@ -1704,38 +1716,75 @@
                                        MICASPERPT))
                  DS)                                         (* ; "And reuse the right margin")

           (DSPSPACEFACTOR 1 DS)
-          (RETURN DS])
+          DS])
 
 (UNMAKEHARDCOPYMODESTREAM

-  [LAMBDA (DISPLAYSTREAM)
                                    (* ; "Edited 26-Aug-87 14:28 by Snow")

+  [LAMBDA (DISPLAYSTREAM)
                                    (* ; "Edited  9-Sep-2025 13:29 by rmk")


+                                                             (* ; "Edited 26-Aug-87 14:28 by Snow")

 
 (* ;;; "returns a hardcopy stream to a display stream.")

 
     (DECLARE
 (GLOBALVARS \DISPLAYIMAGEOPS))
-    (PROG [(DS (COND
-                  ((DISPLAYSTREAMP DISPLAYSTREAM))
-                  ((WINDOWP DISPLAYSTREAM)
-                   (WINDOWPROP DISPLAYSTREAM 'DSP))
-                  (T (\ILLEGAL.ARG DISPLAYSTREAM]
-          (COND
-             ((FMEMB 'HARDCOPY (IMAGESTREAMTYPE DS))         (* ; 
-
                                            "Make sure the stream really WAS a hardcopy-mode stream.")

-              )
-             (T                                              (* ; 
-
                                          "It wasn't a hardcopy-mode stream.  Don't make any changes")

-                (RETURN DS)))
-          (replace
 (STREAM IMAGEOPS) of
 DS with
 \DISPLAYIMAGEOPS)
+    (LET [(DS (COND
+                 ((DISPLAYSTREAMP DISPLAYSTREAM))
+                 ((WINDOWP DISPLAYSTREAM)
+                  (WINDOWPROP DISPLAYSTREAM 'DSP))
+                 (T (\ILLEGAL.ARG DISPLAYSTREAM]
+         (CL:WHEN (FMEMB 'HARDCOPY (IMAGESTREAMTYPE DS))
+
+             (* ;; "Do nothing if it's not a hardcopy-mode stream")

+
+             (replace
 (STREAM IMAGEOPS) of
 DS with
 \DISPLAYIMAGEOPS)
                                                              (* ; "Give it back the usual operations")

-          (STREAMPROP DS 'HARDCOPYIMAGETYPE NIL)             (* ; "restore the bout fn")

-          (replace
 (STREAM STRMBOUTFN) of
 DS with
 (FUNCTION \DSPPRINTCHAR))
-          (replace
 (STREAM OUTCHARFN) of
 DS with
 (FUNCTION \DSPPRINTCHAR))
-          (DSPXPOSITION 0 DS)
-          (DSPYPOSITION 0 DS)
-          (DSPRIGHTMARGIN (OR (STREAMPROP DISPLAYSTREAM 'DSPRIGHTMARGIN)
-                              (fetch
 (REGION WIDTH) of
 (DSPCLIPPINGREGION NIL DS)))
-                 NIL DS)                                     (* ; 
+             (STREAMPROP DS 'HARDCOPYIMAGETYPE NIL)          (* ; "restore the bout fn")

+             (replace
 (STREAM STRMBOUTFN) of
 DS with
 (FUNCTION \DSPPRINTCHAR))
+             (replace
 (STREAM OUTCHARFN) of
 DS with
 (FUNCTION \DSPPRINTCHAR))
+             (DSPXPOSITION 0 DS)
+             (DSPYPOSITION 0 DS)
+             (DSPRIGHTMARGIN (OR (STREAMPROP DISPLAYSTREAM 'DSPRIGHTMARGIN)
+                                 (fetch
 (REGION WIDTH) of
 (DSPCLIPPINGREGION NIL DS)))
+                    NIL DS))                                 (* ; 
 
                                                             "Reset the right margin back to points")

-          (RETURN DS])
+         DS])
+
+(\HCPYDISPLAYIMAGEOPS

+  [LAMBDA (IMAGETYPE)
                                        (* ; "Edited  9-Sep-2025 15:13 by rmk")

+
+    (* ;; "Same code for all types, except for the IMFONTCREATE function (used only for this purpose, or SK.CHOOSE.TEXT.FONT.")

+
+    (* ;; "This assumes a canonical name \[IMAGETYPE]IMAGEOPS for the IMAGEOPS of IMAGETYPE, so that it can get the IMSCALE function.")

+
+    (create
 IMAGEOPS using
 \DISPLAYIMAGEOPS IMAGETYPE _ '(HARDCOPY DISPLAY)
+                           IMFONT _ (FUNCTION \DSPFONT.HCPYMODE)
+                           IMRIGHTMARGIN _ (FUNCTION \DSPRIGHTMARGIN.HCPYMODE)
+                           IMLEFTMARGIN _ (FUNCTION \DSPLEFTMARGIN.HCPYMODE)
+                           IMLINEFEED _ (FUNCTION \DSPLINEFEED.HCPYMODE)
+                           IMDRAWLINE _ (FUNCTION \DRAWLINE.HCPYMODE)
+                           IMDRAWCURVE _ (FUNCTION \DRAWCURVE.HCPYMODE)
+                           IMDRAWCIRCLE _ (FUNCTION \DRAWCIRCLE.HCPYMODE)
+                           IMDRAWELLIPSE _ (FUNCTION \DRAWELLIPSE.HCPYMODE)
+                           IMFILLCIRCLE _ (FUNCTION \FILLCIRCLE.HCPYMODE)
+                           IMBLTSHADE _ (FUNCTION \BLTSHADE.HCPYMODE)
+                           IMBITBLT _ (FUNCTION \BITBLT.HCPYMODE)
+                           IMXPOSITION _ (FUNCTION \DSPXPOSITION.HCPYMODE)
+                           IMYPOSITION _ (FUNCTION \DSPYPOSITION.HCPYMODE)
+                           IMMOVETO _ (FUNCTION \MOVETO.HCPYMODE)
+                           IMSTRINGWIDTH _ (FUNCTION \STRINGWIDTH.HCPYMODE)
+                           IMCHARWIDTH _ (FUNCTION \CHARWIDTH.HCPYMODE)
+                           IMFONTCREATE _ (PACK* IMAGETYPE 'DISPLAY)
+                           IMSCALE _ (fetch
 (IMAGEOPS IMSCALE) of
 (GETATOMVAL (PACK* "\" IMAGETYPE 
+                                                                                     "IMAGEOPS")))
+                           IMNEWPAGE _ [FUNCTION (LAMBDA (STREAM)
+                                                   (LET ((WINDOW (AND \WINDOWWORLD (WFROMDS STREAM)))
+                                                         WINDOWFN)
+                                                        (COND
+                                                           ([AND WINDOW (SETQ WINDOWFN
+                                                                         (WINDOWPROP WINDOW
+                                                                                'PAGEFULLFN]
+                                                            (APPLY* WINDOWFN STREAM))
+                                                           (T (PAGEFULLFN STREAM)))
+                                                        (CLEARW STREAM]
+                           IMSPACEFACTOR _ (FUNCTION \DSPSPACEFACTOR.HCPYMODE])
 
 (\BLTSHADE.HCPYMODE

   [LAMBDA (TEXTURE STREAM DESTINATIONLEFT DESTINATIONBOTTOM WIDTH HEIGHT OPERATION CLIPPINGREGION)

@@ -1772,14 +1821,17 @@
                                     (T BB])
 
 (\CHANGECHARSET.HCPYMODE

-  [LAMBDA (DISPLAYDATA CHARSET)
                              (* ; "Edited 26-Aug-87 14:29 by Snow")

+  [LAMBDA (DISPLAYDATA CHARSET)
                              (* ; "Edited  2-Sep-2025 22:36 by rmk")


+                                                             (* ; "Edited 26-Aug-87 14:29 by Snow")

                                                              (* ; 
 
 "Called when the character set information cached in a display stream doesn't correspond to CHARSET")

-    (PROG [BM (PBT (ffetch
 DDPILOTBBT of
 DISPLAYDATA))
-              (CSINFO (\GETCHARSETINFO CHARSET (ffetch
 DDFONT of
 DISPLAYDATA)))
-              (CSDINFO (\GETCHARSETINFO CHARSET (FONTCOPY (ffetch
 DDFONT of
 DISPLAYDATA)
-                                                       'DEVICE
-                                                       'DISPLAY]
+    (PROG (BM (PBT (ffetch
 DDPILOTBBT of
 DISPLAYDATA))
+              (CSINFO (\INSURECHARSETINFO (ffetch
 DDFONT of
 DISPLAYDATA)
+                             CHARSET))
+              (CSDINFO (\INSURECHARSETINFO (FONTCOPY (ffetch
 DDFONT of
 DISPLAYDATA)
+                                                  'DEVICE
+                                                  'DISPLAY)
+                              CHARSET)))
           (UNINTERRUPTABLY
               (freplace
 DDWIDTHSCACHE of
 DISPLAYDATA with
 (ffetch
 (CHARSETINFO WIDTHS) of
 CSINFO))
               (freplace
 DDOFFSETSCACHE of
 DISPLAYDATA with
 (ffetch
 (CHARSETINFO OFFSETS) of
 CSINFO))
@@ -1996,115 +2048,68 @@
     (\DSPXPOSITION.HCPYMODE
 STREAM X)
     (\DSPYPOSITION.HCPYMODE
 STREAM Y])
 
-(\FONTCREATE.HCPYMODE.PRESS

-  [LAMBDA (FAMILY SIZE FACE ROTATION DEVICE)
                 (* ; "Edited 26-Aug-87 14:36 by Snow")

-                                                             (* ; 
-
                     "Create a font descriptor for a display stream that is mimicing an PRESS device")

-    (PROG* ((DFONT (FONTCREATE FAMILY SIZE FACE ROTATION 'DISPLAY))
-            (HFONT (create
 FONTDESCRIPTOR using
 (FONTCREATE FAMILY SIZE FACE ROTATION 'PRESS)
-                                                FONTCHARSETVECTOR _ (\CREATEFONTCHARSETVECTOR)))
-            (CS0DINFO (\GETCHARSETINFO \DEFAULTCHARSET DFONT)))
-           (replace
 FONTDEVICE of
 HFONT with
 'PRESSDISPLAY)
-           [replace
 OTHERDEVICEFONTPROPS of
 HFONT with
 (LIST 'WIDTHS (fetch
 (CHARSETINFO WIDTHS)
-                                                                        of
 CS0DINFO)
-                                                             'ASCENT
-                                                             (fetch
 (CHARSETINFO CHARSETASCENT)
-                                                                of
 CS0DINFO)
-                                                             'DESCENT
-                                                             (fetch
 (CHARSETINFO CHARSETDESCENT)
-                                                                of
 CS0DINFO)
-                                                             'HEIGHT
-                                                             (IPLUS (fetch
 (CHARSETINFO CHARSETASCENT
-                                                                                  ) of
 CS0DINFO)
-                                                                    (fetch
 (CHARSETINFO 
-                                                                                  CHARSETDESCENT)
-                                                                       of
 CS0DINFO]
-
-     (* ;; "Cache the DISPLAY info, for the various X- and Y-position updating tasks that affect the display bitmap itself")

-
-           (RETURN HFONT])
-
-(\CREATECHARSET.HCPYMODE.PRESS

-  [LAMBDA (FAMILY SIZE FACE ROTATION DEVICE CHARSET FONTDESC)
(* ; "Edited 26-Aug-87 14:36 by Snow")

-                                                             (* ; 
-
                                                     "Build the CHARSETINFO for an PRESSDISPLAY font")

-    (PROG* ((DFONT (FONTCREATE FAMILY SIZE FACE ROTATION 'DISPLAY))
-            (HFONT (FONTCREATE FAMILY SIZE FACE ROTATION 'PRESS))
-            (CSDINFO (\GETCHARSETINFO CHARSET DFONT))
-            (CSHINFO (\GETCHARSETINFO CHARSET HFONT))
-            (CSINFO (CREATE
 CHARSETINFO USING
 CSHINFO)))
-           (replace
 (CHARSETINFO OFFSETS) of
 CSINFO with
 (fetch
 (CHARSETINFO OFFSETS) of
 CSDINFO))
+(\FONTCREATE.HCPYMODE

+  [LAMBDA (FONTSPEC)
                                         (* ; "Edited  2-Sep-2025 22:37 by rmk")


+                                                             (* ; "Edited 26-Aug-87 14:36 by Snow")

+
+(* ;;; "Create a font descriptor for a display stream that is mimicing a hardcopy device")

+
+    (LET* ((DFONT (FONTCREATE FONTSPEC NIL NIL NIL 'DISPLAY))
+           (HFONT (create
 FONTDESCRIPTOR using
 (FONTCREATE FONTSPEC)
+                                               FONTCHARSETVECTOR _ (\CREATEFONTCHARSETVECTOR)))
+           (CS0DINFO (\INSURECHARSETINFO DFONT \DEFAULTCHARSET)))
+          [replace
 OTHERDEVICEFONTPROPS of
 HFONT with
 (LIST 'WIDTHS (fetch
 (CHARSETINFO WIDTHS)
+                                                                       of
 CS0DINFO)
+                                                            'ASCENT
+                                                            (fetch
 (CHARSETINFO CHARSETASCENT)
+                                                               of
 CS0DINFO)
+                                                            'DESCENT
+                                                            (fetch
 (CHARSETINFO CHARSETDESCENT)
+                                                               of
 CS0DINFO)
+                                                            'HEIGHT
+                                                            (IPLUS (fetch
 (CHARSETINFO CHARSETASCENT)
+                                                                      of
 CS0DINFO)
+                                                                   (fetch
 (CHARSETINFO CHARSETDESCENT
+                                                                                 ) of
 CS0DINFO]
+
+          (* ;; "Cache the DISPLAY info, for the various X- and Y-position updating tasks that affect the display bitmap itself")

+
+          HFONT])
+
+(\CREATECHARSET.HCPYMODE

+  [LAMBDA (FONTSPEC FONT CHARSET)
                            (* ; "Edited  9-Sep-2025 15:26 by rmk")


+                                                             (* ; "Edited  2-Sep-2025 22:37 by rmk")


+                                                             (* ; "Edited 26-Aug-87 14:37 by Snow")

+
+(* ;;; "Build the CHARSETINFO for a hardcopy display font, corresponding to the FONTSPEC's FSDEVICE.")

+
+    (LET* ((DFONT (FONTCREATE FONTSPEC NIL NIL NIL 'DISPLAY))
+           (HFONT (FONTCREATE FONTSPEC))
+           (CSDINFO (\INSURECHARSETINFO DFONT CHARSET))
+           (CSHINFO (\INSURECHARSETINFO HFONT CHARSET))
+           (CSINFO (CREATE
 CHARSETINFO USING
 CSHINFO)))
+          (replace
 (CHARSETINFO OFFSETS) of
 CSINFO with
 (fetch
 (CHARSETINFO OFFSETS) of
 CSDINFO))
                                                              (* ; 
 
  "Fill in the right offsets from the display font--into the hcpy font, and its Charset-0 info block")

-           (replace
 (CHARSETINFO CHARSETBITMAP) of
 CSINFO with
 (fetch
 (CHARSETINFO CHARSETBITMAP)
-                                                                  of
 CSDINFO))
+          (replace
 (CHARSETINFO CHARSETBITMAP) of
 CSINFO with
 (fetch
 (CHARSETINFO CHARSETBITMAP)
+                                                                 of
 CSDINFO))
                                                              (* ; "Likewise the character rasters")

-           (replace
 (CHARSETINFO IMAGEWIDTHS) of
 CSINFO with
 (fetch
 (CHARSETINFO IMAGEWIDTHS)
-                                                                of
 CSDINFO))
+          (replace
 (CHARSETINFO IMAGEWIDTHS) of
 CSINFO with
 (fetch
 (CHARSETINFO IMAGEWIDTHS)
+                                                               of
 CSDINFO))
                                                              (* ; 
 
                                   "And the raster widths (as distinct from the nominal mica widths)")

-           (RETURN CSINFO])
-
-(\FONTCREATE.HCPYMODE.INTERPRESS

-  [LAMBDA (FAMILY SIZE FACE ROTATION DEVICE)
                 (* ; "Edited 26-Aug-87 14:36 by Snow")

-
-(* ;;; "Create a font descriptor for a display stream that is mimicing an INTERPRESS device")

-
-    (PROG* ((DFONT (FONTCREATE FAMILY SIZE FACE ROTATION 'DISPLAY))
-            (HFONT (create
 FONTDESCRIPTOR using
 (FONTCREATE FAMILY SIZE FACE ROTATION 'INTERPRESS)
-                                                FONTCHARSETVECTOR _ (\CREATEFONTCHARSETVECTOR)))
-            (CS0DINFO (\GETCHARSETINFO \DEFAULTCHARSET DFONT)))
-           (replace
 FONTDEVICE of
 HFONT with
 'INTERPRESSDISPLAY)
-           [replace
 OTHERDEVICEFONTPROPS of
 HFONT with
 (LIST 'WIDTHS (fetch
 (CHARSETINFO WIDTHS)
-                                                                        of
 CS0DINFO)
-                                                             'ASCENT
-                                                             (fetch
 (CHARSETINFO CHARSETASCENT)
-                                                                of
 CS0DINFO)
-                                                             'DESCENT
-                                                             (fetch
 (CHARSETINFO CHARSETDESCENT)
-                                                                of
 CS0DINFO)
-                                                             'HEIGHT
-                                                             (IPLUS (fetch
 (CHARSETINFO CHARSETASCENT
-                                                                                  ) of
 CS0DINFO)
-                                                                    (fetch
 (CHARSETINFO 
-                                                                                  CHARSETDESCENT)
-                                                                       of
 CS0DINFO]
-
-     (* ;; "Cache the DISPLAY info, for the various X- and Y-position updating tasks that affect the display bitmap itself")

-
-           (RETURN HFONT])
-
-(\CREATECHARSET.HCPYMODE.INTERPRESS

-  [LAMBDA (FAMILY SIZE FACE ROTATION DEVICE CHARSET FONTDESC)
(* ; "Edited 26-Aug-87 14:37 by Snow")

-
-(* ;;; "Build the CHARSETINFO for an INTERPRESSDISPLAY font")

-
-    (PROG* ((DFONT (FONTCREATE FAMILY SIZE FACE ROTATION 'DISPLAY))
-            (HFONT (FONTCREATE FAMILY SIZE FACE ROTATION 'INTERPRESS))
-            (CSDINFO (\GETCHARSETINFO CHARSET DFONT))
-            (CSHINFO (\GETCHARSETINFO CHARSET HFONT))
-            (CSINFO (CREATE
 CHARSETINFO USING
 CSHINFO)))
-           (replace
 (CHARSETINFO OFFSETS) of
 CSINFO with
 (fetch
 (CHARSETINFO OFFSETS) of
 CSDINFO))
-                                                             (* ; 
-
  "Fill in the right offsets from the display font--into the hcpy font, and its Charset-0 info block")

-           (replace
 (CHARSETINFO CHARSETBITMAP) of
 CSINFO with
 (fetch
 (CHARSETINFO CHARSETBITMAP)
-                                                                  of
 CSDINFO))
-                                                             (* ; "Likewise the character rasters")

-           (replace
 (CHARSETINFO IMAGEWIDTHS) of
 CSINFO with
 (fetch
 (CHARSETINFO IMAGEWIDTHS)
-                                                                of
 CSDINFO))
-                                                             (* ; 
-
                                   "And the raster widths (as distinct from the nominal mica widths)")

-           (RETURN CSINFO])
+          CSINFO])
 
 (\STRINGWIDTH.HCPYMODE

-  [LAMBDA (STREAM STR RDTBL)
                                 (* ; "Edited 26-Aug-87 14:38 by Snow")

+  [LAMBDA (STREAM STR RDTBL)
                                 (* ; "Edited 10-Sep-2025 23:50 by rmk")


+                                                             (* ; "Edited 26-Aug-87 14:38 by Snow")

                                                              (* ; 
 
                   "Returns the width of for the current font/spacefactor in hardcopy stream STREAM.")

     (LET [(WIDTHSBASE (ffetch
 (\DISPLAYDATA DDCHARIMAGEWIDTHS) of
 (ffetch
 IMAGEDATA of
 STREAM]
          (IQUOTIENT (IPLUS (\STRINGWIDTH.GENERIC STR WIDTHSBASE RDTBL (\FGETWIDTH WIDTHSBASE
                                                                              (CHARCODE SPACE)))
-                           (CONSTANT IHALFMICASPERPT))
-                (CONSTANT IMICASPERPT])
+                           IHALFMICASPERPT)
+                IMICASPERPT])
 
 (\HCPYMODEBLTCHAR

   [LAMBDA (CHARCODE DISPLAYSTREAM DISPLAYDATA)
               (* ; "Edited  1-Apr-88 11:35 by jds")

@@ -2187,98 +2192,6 @@
                              )
                       T])
 
-(\HCPYMODEDISPLAYINIT

-  [LAMBDA NIL
                                                (* ; "Edited  1-Apr-88 11:36 by jds")

-
-(* ;;; "Initializes global variables for the hardcopy Display device.  This device appears to the user as an INTERPRESS or PRESS device meaning units in micas but outputs to the screen.  Much of this code was borrowed from the display case.")

-
-    (DECLARE
 (GLOBALVARS \HCPYMODEDISPLAYIMAGEOPS.PRESS \HCPYMODEDISPLAYIMAGEOPS.INTERPRESS))
-    (SETQ \HCPYMODEDISPLAYIMAGEOPS.PRESS (create
 IMAGEOPS
-                                            using
 \DISPLAYIMAGEOPS IMAGETYPE _ '(HARDCOPY DISPLAY)
-                                                  IMFONT _ (FUNCTION \DSPFONT.HCPYMODE)
-                                                  IMRIGHTMARGIN _ (FUNCTION \DSPRIGHTMARGIN.HCPYMODE)
-                                                  IMLEFTMARGIN _ (FUNCTION \DSPLEFTMARGIN.HCPYMODE)
-                                                  IMLINEFEED _ (FUNCTION \DSPLINEFEED.HCPYMODE)
-                                                  IMDRAWLINE _ (FUNCTION \DRAWLINE.HCPYMODE)
-                                                  IMDRAWCURVE _ (FUNCTION \DRAWCURVE.HCPYMODE)
-                                                  IMDRAWCIRCLE _ (FUNCTION \DRAWCIRCLE.HCPYMODE)
-                                                  IMDRAWELLIPSE _ (FUNCTION \DRAWELLIPSE.HCPYMODE)
-                                                  IMFILLCIRCLE _ (FUNCTION \FILLCIRCLE.HCPYMODE)
-                                                  IMBLTSHADE _ (FUNCTION \BLTSHADE.HCPYMODE)
-                                                  IMBITBLT _ (FUNCTION \BITBLT.HCPYMODE)
-                                                  IMXPOSITION _ (FUNCTION \DSPXPOSITION.HCPYMODE)
-                                                  IMYPOSITION _ (FUNCTION \DSPYPOSITION.HCPYMODE)
-                                                  IMMOVETO _ (FUNCTION \MOVETO.HCPYMODE)
-                                                  IMSTRINGWIDTH _ (FUNCTION \STRINGWIDTH.HCPYMODE)
-                                                  IMCHARWIDTH _ (FUNCTION \CHARWIDTH.HCPYMODE)
-                                                  IMFONTCREATE _ (FUNCTION PRESSDISPLAY)
-                                                  IMSCALE _ [FUNCTION (LAMBDA NIL
-                                                                        (CONSTANT (FQUOTIENT 
-                                                                                         MICASPERINCH
-                                                                                         72]
-                                                  IMNEWPAGE _
-                                                  [FUNCTION (LAMBDA (STREAM)
-                                                              (LET ((WINDOW (AND \WINDOWWORLD
-                                                                                 (WFROMDS STREAM)))
-                                                                    WINDOWFN)
-                                                                   (COND
-                                                                      ([AND WINDOW
-                                                                            (SETQ WINDOWFN
-                                                                             (WINDOWPROP WINDOW
-                                                                                    'PAGEFULLFN]
-                                                                       (APPLY* WINDOWFN STREAM))
-                                                                      (T (PAGEFULLFN STREAM)))
-                                                                   (CLEARW STREAM]
-                                                  IMSPACEFACTOR _ (FUNCTION \DSPSPACEFACTOR.HCPYMODE)
-                                                ))
-    (SETQ \HCPYMODEDISPLAYIMAGEOPS.INTERPRESS (create
 IMAGEOPS
-                                                 using
 \DISPLAYIMAGEOPS IMAGETYPE _
-                                                       '(HARDCOPY DISPLAY)
-                                                       IMFONT _ (FUNCTION \DSPFONT.HCPYMODE)
-                                                       IMRIGHTMARGIN _ (FUNCTION 
-                                                                        \DSPRIGHTMARGIN.HCPYMODE)
-                                                       IMLEFTMARGIN _ (FUNCTION 
-                                                                       \DSPLEFTMARGIN.HCPYMODE)
-                                                       IMLINEFEED _ (FUNCTION \DSPLINEFEED.HCPYMODE)
-                                                       IMDRAWLINE _ (FUNCTION \DRAWLINE.HCPYMODE)
-                                                       IMDRAWCURVE _ (FUNCTION \DRAWCURVE.HCPYMODE)
-                                                       IMDRAWCIRCLE _ (FUNCTION \DRAWCIRCLE.HCPYMODE)
-                                                       IMDRAWELLIPSE _ (FUNCTION 
-                                                                        \DRAWELLIPSE.HCPYMODE)
-                                                       IMFILLCIRCLE _ (FUNCTION \FILLCIRCLE.HCPYMODE)
-                                                       IMBLTSHADE _ (FUNCTION \BLTSHADE.HCPYMODE)
-                                                       IMBITBLT _ (FUNCTION \BITBLT.HCPYMODE)
-                                                       IMXPOSITION _ (FUNCTION \DSPXPOSITION.HCPYMODE
-                                                                      )
-                                                       IMYPOSITION _ (FUNCTION \DSPYPOSITION.HCPYMODE
-                                                                      )
-                                                       IMMOVETO _ (FUNCTION \MOVETO.HCPYMODE)
-                                                       IMSTRINGWIDTH _ (FUNCTION 
-                                                                        \STRINGWIDTH.HCPYMODE)
-                                                       IMCHARWIDTH _ (FUNCTION \CHARWIDTH.HCPYMODE)
-                                                       IMFONTCREATE _ (FUNCTION INTERPRESSDISPLAY)
-                                                       IMSCALE _ [FUNCTION (LAMBDA NIL
-                                                                             (CONSTANT (FQUOTIENT
-                                                                                        MICASPERINCH
-                                                                                        72]
-                                                       IMNEWPAGE _
-                                                       [FUNCTION (LAMBDA (STREAM)
-                                                                   (LET
-                                                                    ((WINDOW (AND \WINDOWWORLD
-                                                                                  (WFROMDS STREAM)))
-                                                                     WINDOWFN)
-                                                                    (COND
-                                                                       ([AND WINDOW
-                                                                             (SETQ WINDOWFN
-                                                                              (WINDOWPROP
-                                                                               WINDOW
-                                                                               'PAGEFULLFN]
-                                                                        (APPLY* WINDOWFN STREAM))
-                                                                       (T (PAGEFULLFN STREAM)))
-                                                                    (CLEARW STREAM]
-                                                       IMSPACEFACTOR _ (FUNCTION 
-                                                                        \DSPSPACEFACTOR.HCPYMODE])
-
 (\HCPYMODEDSPPRINTCHAR

   [LAMBDA (STREAM CHARCODE)
                                  (* ; "Edited 26-Aug-87 14:39 by Snow")

 
@@ -2365,7 +2278,8 @@
                (SHOULDNT])
 
 (\SLOWHCPYMODEBLTCHAR

-  [LAMBDA (CHARCODE DISPLAYSTREAM)
                           (* ; "Edited 26-Aug-87 14:39 by Snow")

+  [LAMBDA (CHARCODE DISPLAYSTREAM)
                           (* ; "Edited  2-Sep-2025 22:37 by rmk")


+                                                             (* ; "Edited 26-Aug-87 14:39 by Snow")

 
 (* ;;; 
 
"IS THIS CODE JUST GOING TO DUPLICATE AND GET OUT OF SYNC WITH \SLOWBLTCHAR?  KBR 1-FEB-86.  *")

@@ -2429,8 +2343,8 @@
                 (PROG (YPOS HEIGHTMOVED CSINFO)
                       (SETQ YPOS (ffetch
 (\DISPLAYDATA DDYPOSITION) of
 DD))
                       (SETQ HEIGHTMOVED (\DSPGETCHARWIDTH CHAR8CODE DD))
-                      (SETQ CSINFO (\GETCHARSETINFO (\CHARSET CHARCODE)
-                                          (ffetch
 (\DISPLAYDATA DDFONT) of
 DD)))
+                      (SETQ CSINFO (\INSURECHARSETINFO (ffetch
 (\DISPLAYDATA DDFONT) of
 DD)
+                                          (\CHARSET CHARCODE)))
                       (COND
                          ((EQ ROTATION 90)                   (* ; "don't force CR for rotated fonts.")

                           (\DSPYPOSITION.DISPLAY DISPLAYSTREAM (IPLUS YPOS HEIGHTMOVED))
@@ -2501,15 +2415,6 @@
                                                (ffetch
 DDClippingBottom of
 DISPLAYDATA)))
                         0])
 )
-
-(ADDTOVAR IMAGESTREAMTYPES
 (PRESSDISPLAY (FONTCREATE \FONTCREATE.HCPYMODE.PRESS)
-                                  (CREATECHARSET \CREATECHARSET.HCPYMODE.PRESS))
-                           (INTERPRESSDISPLAY (FONTCREATE \FONTCREATE.HCPYMODE.INTERPRESS)
-                                  (CREATECHARSET \CREATECHARSET.HCPYMODE.INTERPRESS)))
-(DECLARE%: DONTEVAL@LOAD DOCOPY 
-
-(\HCPYMODEDISPLAYINIT
)
-)
 (DECLARE%: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY COMPILERVARS 
 
 (ADDTOVAR NLAMA
 )
@@ -2519,40 +2424,40 @@
 (ADDTOVAR LAMA
 )
 )
 (DECLARE%: DONTCOPY
-  (FILEMAP (NIL (6233 12071 (HARDCOPY.SOMEHOW 6243 . 7609) (HARDCOPYIMAGEW 7611 . 7832) (
-HARDCOPYIMAGEW.TOFILE 7834 . 8142) (HARDCOPYIMAGEW.TOPRINTER 8144 . 9391) (HARDCOPYREGION.TOFILE 9393
- . 9935) (HARDCOPYREGION.TOPRINTER 9937 . 11050) (COPY.WINDOW.TO.BITMAP 11052 . 12069)) (12143 23930 (
-MakeMenuOfPrinters 12153 . 13685) (PRINTERS.WHENSELECTEDFN 13687 . 15310) (MakeMenuOfImageTypes 15312
- . 16131) (GetNewPrinterFromUser 16133 . 16575) (PopUpWindowAndGetAtom 16577 . 18028) (
-PopUpWindowAndGetList 18030 . 19600) (NewPrinter 19602 . 21101) (GetPrinterName 21103 . 21391) (
-GetImageFile 21393 . 23678) (FetchDefaultPrinter 23680 . 23928)) (23965 24730 (
-ExtensionForPrintFileType 23975 . 24222) (PRINTFILETYPE.FROM.EXTENSION 24224 . 24728)) (24785 45169 (
-DEFAULTPRINTER 24795 . 25035) (CAN.PRINT.DIRECTLY 25037 . 25233) (CONVERT.FILE.TO.TYPE.FOR.PRINTER 
-25235 . 26972) (EMPRESS 26974 . 27549) (HARDCOPYW 27551 . 32553) (LISTFILES1 32555 . 32732) (
-PRINTER.BITMAPFILE 32734 . 33123) (PRINTER.BITMAPSCALE 33125 . 33609) (PRINTER.SCRATCH.FILE 33611 . 
-33781) (PRINTERPROP 33783 . 34033) (PRINTERSTATUS 34035 . 34310) (PRINTERTYPE 34312 . 36882) (
-PRINTERNAME 36884 . 37305) (PRINTFILEPROP 37307 . 37563) (PRINTFILETYPE 37565 . 39521) (
-\EXPECTED.FILE.TYPE 39523 . 40313) (SEND.FILE.TO.PRINTER 40315 . 45167)) (45170 49789 (PRINTERDEVICE 
-45180 . 49787)) (50624 58869 (TEXTTOIMAGEFILE 50634 . 52830) (COPY.TEXT.TO.IMAGE 52832 . 58867)) (
-58870 60613 (\BLTSHADE.GENERICPRINTER 58880 . 60611)) (60741 96742 (MAKEHARDCOPYSTREAM 60751 . 62303) 
-(UNMAKEHARDCOPYSTREAM 62305 . 63235) (HARDCOPYSTREAMTYPE 63237 . 63571) (\CHARWIDTH.HDCPYDISPLAY 63573
- . 64305) (\DSPFONT.HDCPYDISPLAY 64307 . 67019) (\DSPRIGHTMARGIN.HDCPYDISPLAY 67021 . 67777) (
-\DSPXPOSITION.HDCPYDISPLAY 67779 . 68154) (\DSPYPOSITION.HDCPYDISPLAY 68156 . 68531) (
-\STRINGWIDTH.HDCPYDISPLAY 68533 . 69400) (\STRINGWIDTH.HCPYDISPLAYAUX 69402 . 74624) (\HDCPYBLTCHAR 
-74626 . 79618) (\HDCPYDISPLAY.FIX.XPOS 79620 . 80278) (\HDCPYDISPLAY.FIX.YPOS 80280 . 80938) (
-\HDCPYDISPLAYINIT 80940 . 82533) (\HDCPYDSPPRINTCHAR 82535 . 88448) (\SLOWHDCPYBLTCHAR 88450 . 94954) 
-(\CHANGECHARSET.HDCPYDISPLAY 94956 . 96740)) (97243 97384 (\MICASTOPTS 97243 . 97384)) (97555 156213 (
-MAKEHARDCOPYMODESTREAM 97565 . 100598) (UNMAKEHARDCOPYMODESTREAM 100600 . 102361) (\BLTSHADE.HCPYMODE 
-102363 . 103029) (\BITBLT.HCPYMODE 103031 . 103779) (\BRUSHCONVERT.HCPYMODE 103781 . 104330) (
-\CHANGECHARSET.HCPYMODE 104332 . 107427) (\DASHINGCONVERT.HCPYMODE 107429 . 107770) (
-\CHARWIDTH.HCPYMODE 107772 . 108209) (\DRAWLINE.HCPYMODE 108211 . 108740) (\DRAWCURVE.HCPYMODE 108742
- . 109329) (\DRAWCIRCLE.HCPYMODE 109331 . 109816) (\DRAWELLIPSE.HCPYMODE 109818 . 110502) (
-\DSPFONT.HCPYMODE 110504 . 113188) (\DSPLEFTMARGIN.HCPYMODE 113190 . 113932) (\DSPLINEFEED.HCPYMODE 
-113934 . 114567) (\DSPRIGHTMARGIN.HCPYMODE 114569 . 115637) (\DSPSPACEFACTOR.HCPYMODE 115639 . 116414)
- (\DSPXPOSITION.HCPYMODE 116416 . 117434) (\DSPYPOSITION.HCPYMODE 117436 . 118086) (\MOVETO.HCPYMODE 
-118088 . 118302) (\FONTCREATE.HCPYMODE.PRESS 118304 . 120441) (\CREATECHARSET.HCPYMODE.PRESS 120443 . 
-122065) (\FONTCREATE.HCPYMODE.INTERPRESS 122067 . 124141) (\CREATECHARSET.HCPYMODE.INTERPRESS 124143
- . 125665) (\STRINGWIDTH.HCPYMODE 125667 . 126374) (\HCPYMODEBLTCHAR 126376 . 132126) (
-\HCPYMODEDISPLAYINIT 132128 . 140260) (\HCPYMODEDSPPRINTCHAR 140262 . 146196) (\SLOWHCPYMODEBLTCHAR 
-146198 . 152715) (\SFFixY.HCPYMODE 152717 . 156211)))))
+  (FILEMAP (NIL (6508 12346 (HARDCOPY.SOMEHOW 6518 . 7884) (HARDCOPYIMAGEW 7886 . 8107) (
+HARDCOPYIMAGEW.TOFILE 8109 . 8417) (HARDCOPYIMAGEW.TOPRINTER 8419 . 9666) (HARDCOPYREGION.TOFILE 9668
+ . 10210) (HARDCOPYREGION.TOPRINTER 10212 . 11325) (COPY.WINDOW.TO.BITMAP 11327 . 12344)) (12418 24340
+ (MakeMenuOfPrinters 12428 . 13960) (PRINTERS.WHENSELECTEDFN 13962 . 15585) (MakeMenuOfImageTypes 
+15587 . 16406) (GetNewPrinterFromUser 16408 . 16850) (PopUpWindowAndGetAtom 16852 . 18303) (
+PopUpWindowAndGetList 18305 . 19875) (NewPrinter 19877 . 21376) (GetPrinterName 21378 . 21666) (
+GetImageFile 21668 . 24088) (FetchDefaultPrinter 24090 . 24338)) (24375 25249 (
+EXTENSIONS.FOR.PRINTFILETYPE 24385 . 24741) (PRINTFILETYPE.FROM.EXTENSION 24743 . 25247)) (25304 45688
+ (DEFAULTPRINTER 25314 . 25554) (CAN.PRINT.DIRECTLY 25556 . 25752) (CONVERT.FILE.TO.TYPE.FOR.PRINTER 
+25754 . 27491) (EMPRESS 27493 . 28068) (HARDCOPYW 28070 . 33072) (LISTFILES1 33074 . 33251) (
+PRINTER.BITMAPFILE 33253 . 33642) (PRINTER.BITMAPSCALE 33644 . 34128) (PRINTER.SCRATCH.FILE 34130 . 
+34300) (PRINTERPROP 34302 . 34552) (PRINTERSTATUS 34554 . 34829) (PRINTERTYPE 34831 . 37401) (
+PRINTERNAME 37403 . 37824) (PRINTFILEPROP 37826 . 38082) (PRINTFILETYPE 38084 . 40040) (
+\EXPECTED.FILE.TYPE 40042 . 40832) (SEND.FILE.TO.PRINTER 40834 . 45686)) (45689 50126 (PRINTERDEVICE 
+45699 . 46676) (PRINTERDEVICE.OPENFN 46678 . 47398) (PRINTERDEVICE.CLOSEFN 47400 . 50124)) (50482 
+51040 (SCALEREGION 50492 . 51038)) (51264 59509 (TEXTTOIMAGEFILE 51274 . 53470) (COPY.TEXT.TO.IMAGE 
+53472 . 59507)) (59571 61314 (\BLTSHADE.GENERICPRINTER 59581 . 61312)) (61381 98547 (
+MAKEHARDCOPYSTREAM 61391 . 63107) (UNMAKEHARDCOPYSTREAM 63109 . 64039) (HARDCOPYSTREAMTYPE 64041 . 
+64448) (\CHARWIDTH.HDCPYDISPLAY 64450 . 65270) (\DSPFONT.HDCPYDISPLAY 65272 . 68067) (
+\DSPRIGHTMARGIN.HDCPYDISPLAY 68069 . 68924) (\DSPXPOSITION.HDCPYDISPLAY 68926 . 69301) (
+\DSPYPOSITION.HDCPYDISPLAY 69303 . 69678) (\STRINGWIDTH.HDCPYDISPLAY 69680 . 70635) (
+\STRINGWIDTH.HCPYDISPLAYAUX 70637 . 75977) (\HDCPYBLTCHAR 75979 . 80876) (\HDCPYDISPLAY.FIX.XPOS 80878
+ . 81635) (\HDCPYDISPLAY.FIX.YPOS 81637 . 82378) (\HDCPYDISPLAYINIT 82380 . 84070) (\HDCPYDSPPRINTCHAR
+ 84072 . 89985) (\SLOWHDCPYBLTCHAR 89987 . 96603) (\CHANGECHARSET.HDCPYDISPLAY 96605 . 98545)) (98862 
+148413 (MAKEHARDCOPYMODESTREAM 98872 . 101593) (UNMAKEHARDCOPYMODESTREAM 101595 . 103185) (
+\HCPYDISPLAYIMAGEOPS 103187 . 106007) (\BLTSHADE.HCPYMODE 106009 . 106675) (\BITBLT.HCPYMODE 106677 . 
+107425) (\BRUSHCONVERT.HCPYMODE 107427 . 107976) (\CHANGECHARSET.HCPYMODE 107978 . 111240) (
+\DASHINGCONVERT.HCPYMODE 111242 . 111583) (\CHARWIDTH.HCPYMODE 111585 . 112022) (\DRAWLINE.HCPYMODE 
+112024 . 112553) (\DRAWCURVE.HCPYMODE 112555 . 113142) (\DRAWCIRCLE.HCPYMODE 113144 . 113629) (
+\DRAWELLIPSE.HCPYMODE 113631 . 114315) (\DSPFONT.HCPYMODE 114317 . 117001) (\DSPLEFTMARGIN.HCPYMODE 
+117003 . 117745) (\DSPLINEFEED.HCPYMODE 117747 . 118380) (\DSPRIGHTMARGIN.HCPYMODE 118382 . 119450) (
+\DSPSPACEFACTOR.HCPYMODE 119452 . 120227) (\DSPXPOSITION.HCPYMODE 120229 . 121247) (
+\DSPYPOSITION.HCPYMODE 121249 . 121899) (\MOVETO.HCPYMODE 121901 . 122115) (\FONTCREATE.HCPYMODE 
+122117 . 124074) (\CREATECHARSET.HCPYMODE 124076 . 125799) (\STRINGWIDTH.HCPYMODE 125801 . 126596) (
+\HCPYMODEBLTCHAR 126598 . 132348) (\HCPYMODEDSPPRINTCHAR 132350 . 138284) (\SLOWHCPYMODEBLTCHAR 138286
+ . 144915) (\SFFixY.HCPYMODE 144917 . 148411)))))
 STOP
diff --git a/sources/HARDCOPY.LCOM b/sources/HARDCOPY.LCOM
index f8dc7103c..6880c316f 100644
Binary files a/sources/HARDCOPY.LCOM and b/sources/HARDCOPY.LCOM differ
diff --git a/sources/INTERPRESS b/sources/INTERPRESS
index 86f6a0d31..e722d7992 100644
--- a/sources/INTERPRESS
+++ b/sources/INTERPRESS
@@ -1,16 +1,13 @@
 (DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
 
-
(FILECREATED "14-Jul-2025 23:31:04" 
-{DSK}<Users>kaplan>Local>medley3.5>git-medley>sources>INTERPRESS.;11
 220765 
+
(FILECREATED "10-Sep-2025 16:59:11" 
+{DSK}<Users>kaplan>Local>medley3.5>working-medley>sources>INTERPRESS.;96
 215772 
 
       :EDIT-BY rmk
 
-      :CHANGES-TO (VARS INTERPRESSCOMS \SYMBOLTONSARRAY HIPPOTONSARRAY CYRILLICTONSARRAY 
-                        \MATHTONSARRAY)
-                  (FNS \DSPFONT.IP)
+      :CHANGES-TO (VARS INTERPRESSCOMS)
 
-      :PREVIOUS-DATE "13-Jul-2025 23:11:52" 
-{DSK}<Users>kaplan>Local>medley3.5>git-medley>sources>INTERPRESS.;10)
+      :PREVIOUS-DATE " 9-Sep-2025 13:19:12" {WMEDLEY}<sources>INTERPRESS.;94)
 
 
 (PRETTYCOMPRINT INTERPRESSCOMS)
@@ -23,7 +20,7 @@
                      (DEFAULTINTERPRESSMEDIUM '(PAPER (KNOWN.SIZE "US.LETTER"]
               (VARS KNOWN.MEDIA.SIZES)
               [COMS (DECLARE%: DONTCOPY EVAL@COMPILE (VARS * IPCONSTANTS)
-                           (FUNCTIONS \IPC)
+                           (MACROS \IPC)
                                                              (* ; "MICASPERINCH is used by HARDCOPY")

                            (EXPORT (CONSTANTS (MICASPERINCH 2540)
                                           (MICASPERMILLIMETER 100]
@@ -57,17 +54,16 @@
         (COMS                                                (* ; "image state")

               (FNS IP-TOS POP-IP-STACK PUSH-IP-STACK)
               (RECORDS IPSTATE))
-        (FNS \CREATECHARSET.IP \CHANGECHARSET.IP)
+        (FNS \CHANGECHARSET.IP)
         (FNS \INTERPRESSINIT)
-        (FNS SCALEREGION)
         (DECLARE%: DONTEVAL@LOAD DOCOPY (INITVARS (\SPLINESTEP.IP 16.0)))
         [DECLARE%: DONTEVAL@LOAD DOCOPY (INITVARS IPPAGEREGION.ROT180 IPPAGEREGION.ROT270
-                                               [DEFAULTPAGEREGION (SCALEREGION 2540
+                                               [DEFAULTPAGEREGION (SCALEREGION MICASPERINCH
                                                                          (CREATEREGION 1.1 0.75
                                                                                 (- 7.5 1.1)
                                                                                 (- 10.5 0.75]
                                                (DEFAULTLANDPAGEREGION (SCALEREGION
-                                                                       2540
+                                                                       MICASPERINCH
                                                                        (CREATEREGION 0.75 1.1
                                                                               (- 10.5 0.75)
                                                                               (- 7.5 1.1]
@@ -102,37 +98,37 @@
                (PRINTFILETYPES (INTERPRESS (TEST INTERPRESSFILEP)
                                       (EXTENSION (IP IPR INTERPRESS))
                                       (CONVERSION (TEXT MAKEINTERPRESS TEDIT \TEDIT.HARDCOPY]
+        [ADDVARS (IMAGESTREAMTYPES (INTERPRESSDISPLAY (FONTCREATE \FONTCREATE.HCPYMODE)
+                                          (CREATECHARSET \CREATECHARSET.HCPYMODE]
         (INITVARS (DEFAULT.INTERPRESS.BITMAP.ROTATION 90))
         (ALISTS (SYSTEMINITVARS INTERPRESSFONTDIRECTORIES))
-        [INITVARS (INTERPRESSFONTEXTENSIONS '(WD))
-               (INTERPRESSFONTDIRECTORIES '("{Erinyes}<Lyric>Fonts>"))
-               (INTERPRESSPRINTWHEELFAMILIES '(BOLDPS ELITE LETTERGOTHIC MASTER PICA PSBOLD 
-                                                     SCIENTIFIC SPOKESMAN TITAN TREND TRENDPS TROJAN
-                                                     VINTAGE))
-               (INTERPRESSFAMILYALIASES '(LOGO LOGOTYPES-XEROX]
-        [COMS                                                (* ; "NS Character Encoding")

-              (FNS \COERCEASCIITONSFONT \CREATEINTERPRESSFONT \SEARCHINTERPRESSFONTS)
-              (DECLARE%: EVAL@COMPILE DONTCOPY (CONSTANTS (noInfoCode 32768)))
-              (INITVARS (ASCIITONSTRANSLATIONS))
-              
-              (* ;; "These are in priority order:  if an early one doesn't find a font for a family, the later ones are tried (essentially going to MODERN as the default).")

-
-              (ADDVARS (ASCIITONSTRANSLATIONS (TIMESROMAN NIL CLASSIC)
-                              (GACHA NIL TERMINAL)
-                              (HELVETICA NIL MODERN)
-                              (CLASSIC NIL MODERN)
-                              (GACHA NIL MODERN)
-                              (TIMESROMAN NIL MODERN)
-                              (LOGO NIL LOGOTYPES)
-                              (HIPPO HIPPOTONSARRAY CLASSIC)
-                              (CYRILLIC CYRILLICTONSARRAY CLASSIC)
-                              (SYMBOL \SYMBOLTONSARRAY MODERN)
-                              (MATH \MATHTONSARRAY CLASSIC)))
-              (UGLYVARS \SYMBOLTONSARRAY HIPPOTONSARRAY CYRILLICTONSARRAY \MATHTONSARRAY)
-              (VARS \ASCII2XCCSMAP)
-              (FNS \ASCIIMAPARRAY)
-              (INITVARS (\ASCII2XCCS (\ASCIIMAPARRAY \ASCII2XCCSMAP))
-                     (\ASCII2MCCS (\ASCIIMAPARRAY \ASCII2XCCSMAP '("$" "-"]
+        (ADDVARS (INTERPRESSFONTEXTENSIONS MEDLEYINTERPRESSFONT WD))
+        [COMS                                                (* ; 
+
                                                         "Interpress fonts; but see MEDLEY-INIT-VARS")

+              [INITVARS (INTERPRESSFONTDIRECTORIES '(fonts>medleyinterpressfonts> fonts>ipfonts>))
+                     (INTERPRESSPRINTWHEELFAMILIES '(BOLDPS ELITE LETTERGOTHIC MASTER PICA PSBOLD 
+                                                           SCIENTIFIC SPOKESMAN TITAN TREND TRENDPS 
+                                                           TROJAN VINTAGE))
+                     (INTERPRESSFAMILYALIASES '(LOGO LOGOTYPES-XEROX]
+              (FNS \CREATEINTERPRESSFONT \CREATECHARSET.IP)
+              (FNS)
+              [COMS (FNS IPFONT.FILEP IPFONT.GETCHARSET \FACECODE \FAMILYCODE)
+                    (MACROS \POSITIONFONTFILE)
+                    (EXPORT (CONSTANTS (noInfoCode 32768]
+              (ADDVARS (INTERPRESSCHARSETFNS (INTERPRESS IPFONT.FILEP IPFONT.GETCHARSET)))
+              (INITVARS (INTERPRESSFONTCOERCIONS '((TIMESROMAN CLASSIC)
+                                                   (GACHA TERMINAL)
+                                                   (HELVETICA MODERN)
+                                                   (CLASSIC MODERN)
+                                                   (GACHA MODERN)
+                                                   (TIMESROMAN MODERN)
+                                                   (LOGO LOGOTYPES)
+                                                   (HIPPO CLASSIC)
+                                                   (CYRILLIC CLASSIC)
+                                                   (SYMBOL MODERN)
+                                                   (MATH CLASSIC)
+                                                   (SIGMA MODERN)
+                                                   (* MODERN]
         (DECLARE%: DONTEVAL@LOAD DOCOPY (P (\INTERPRESSINIT)))
         (DECLARE%: EVAL@COMPILE DONTCOPY (P (LOADDEF 'SYSTEMBRUSH 'RESOURCES 'IMAGEIO)
                                             (LOADDEF 'BRUSH 'RECORDS 'IMAGEIO])
@@ -386,18 +382,23 @@
                       (MAXLONGSEQUENCEBYTES (SUB1 (EXPT 2 16)))
                       (FILETYPE.INTERPRESS 4361)))
 
+(DECLARE%: EVAL@COMPILE 
+
+(PUTPROPS \IPC
 MACRO
 (ARGS [OR (AND (BOUNDP '\IPCONSTANTS)
+                                    (LISTP \IPCONSTANTS))
+                               (SETQ \IPCONSTANTS (FOR
 C IN
 IPCONSTANTS
+                                                     JOIN
 (FOR
 Y IN
 (EVAL C)
+                                                             COLLECT
 (CONS (CAR Y)
+                                                                           (CADR Y]
 
-(DEFMACRO \IPC
 (X)
-   (DECLARE
 (SPECIAL X))
                                     (* ; "Edited 27-Oct-2024 11:57 by lmm")


-                                                             (* ; "Edited  2-May-2023 08:33 by lmm")

-   [OR (AND (BOUNDP '\IPCONSTANTS)
-            (LISTP \IPCONSTANTS))
-       (SETQ \IPCONSTANTS (FOR
 X IN
 IPCONSTANTS JOIN
 (FOR
 Y IN
 (EVAL X)
-                                                        COLLECT
 (CONS (CAR Y)
-                                                                      (CADR Y]
-   (FOR
 I FROM
 1 TO
 10 DO
 (IF
 (EQUAL X (SETQ X (SUBLIS \IPCONSTANTS X)))
-                              THEN
 (RETURN (LIST 'CONSTANT X))) FINALLY
 (ERROR "too many \IPC levels"
-                                                                               X)))
+                           (* ;; "This tries recursively to replace all the constants in the expression X according to the values in \IPCONSTANTS.  When this was a DEFMACRO, RECOMPILE wouldn't work on INTERPRESS. ")

+
+                           (FOR
 I (Y _ (CAR ARGS)) FROM
 1 TO
 10
+                              DO
 (IF
 (EQUAL Y (SETQ Y (SUBLIS \IPCONSTANTS Y)))
+                                     THEN
 (RETURN (LIST 'CONSTANT Y))) FINALLY
 (ERROR 
+                                                                               "too many \IPC levels"
+                                                                                      X))))
+)
 
 (* "FOLLOWING DEFINITIONS EXPORTED")(DECLARE%: EVAL@COMPILE 
 
@@ -1365,10 +1366,10 @@
 (INTERPRESS.BITMAPSCALE

   [LAMBDA (WIDTH HEIGHT)
                                     (* ; "Edited  2-May-2023 08:37 by lmm")

                                                              (* lmm " 3-OCT-83 21:31")

-    (PROG [(RATIO (MIN (FQUOTIENT (\IPC
 (TIMES (\IPC
 POINTSPERINCH)
+    (PROG [(RATIO (MIN (FQUOTIENT (\IPC (TIMES (\IPC POINTSPERINCH)
                                                9.5))
                               WIDTH)
-                       (FQUOTIENT (\IPC
 (TIMES (\IPC
 POINTSPERINCH)
+                       (FQUOTIENT (\IPC (TIMES (\IPC POINTSPERINCH)
                                                7.5))
                               HEIGHT]
           (RETURN (COND
@@ -1381,77 +1382,78 @@
                      (T RATIO])
 
 (INTERPRESS.OUTCHARFN

-  [LAMBDA (IPSTREAM CHARCODE)
                            (* ; "Edited  6-Jan-89 23:03 by jds")

+  [LAMBDA (IPSTREAM CHARCODE)
                                (* ; "Edited  9-Sep-2025 09:59 by rmk")


+                                                             (* ; "Edited  7-Sep-2025 22:40 by rmk")


+                                                             (* ; "Edited 20-Jul-2025 16:27 by rmk")


+                                                             (* ; "Edited 24-Apr-2025 23:14 by rmk")


+                                                             (* ; "Edited  6-Jan-89 23:03 by jds")

+
+    (* ;; "Assumes that all CHARCODE's are MCCS, font-independent")

 
     (* ;; "The \OUTCHAR method for interpress streams.  Print a character, taking account of margins and visible region, and things like ^L.")

 
     (LET* ((IPDATA (ffetch
 IPDATA of
 IPSTREAM))
-           [NSCODE (COND
-                      ((\FATCHARCODEP CHARCODE)
-                       CHARCODE)
-                      (T (\GETBASE (ffetch
 NSTRANSTABLE of
 IPDATA)
-                                CHARCODE]
+           (XCODE (MTOXCODE CHARCODE))
            (OLD-CSET (ffetch
 NSCHARSET of
 IPDATA)))
-          [COND
-             ((NEQ (\CHARSET NSCODE)
-                   OLD-CSET)
+          (CL:UNLESS (EQ (\CHARSET XCODE)
+                         OLD-CSET)
 
               (* ;; "Switch character set so that we get the right char width, but DON'T write out the charset-shift sequence, in case the character gets clipped.")

 
-              (\CHANGECHARSET.IP
 IPDATA (\CHARSET NSCODE]
+              (\CHANGECHARSET.IP
 IPDATA (\CHARSET XCODE)))
 
           (* ;; "Select on NSCODE, since ^L etc might be graphic in some ascii fonts:")

 
-          (SELCHARQ NSCODE
+          (SELCHARQ XCODE
                (EOL (NEWLINE.IP
 IPSTREAM))
                (LF (\DSPXPOSITION.IP
 IPSTREAM (PROG1 (\DSPXPOSITION.IP
 IPSTREAM)
-                                                         (NEWLINE.IP
 IPSTREAM))))
+                                                     (NEWLINE.IP
 IPSTREAM))))
                (^L (DSPNEWPAGE IPSTREAM))
                (PROG (CHAR-WIDTH NEWXPOS)                    (* ; 
-
         "Have to switch charset before fetching width from cache, even though we might later clip")

+
           "Have to switch charset before fetching width from cache, even though we might later clip")

                      [SETQ CHAR-WIDTH (COND
-                                         ((EQ NSCODE (CHARCODE SPACE))
+                                         ((EQ XCODE (CHARCODE SPACE))
                                           (ffetch
 IPSPACEWIDTH of
 IPDATA))
                                          (T (\FGETWIDTH (ffetch
 IPWIDTHSCACHE of
 IPDATA)
-                                                   (\CHAR8CODE NSCODE]
+                                                   (\CHAR8CODE XCODE]
                      (SETQ NEWXPOS (+ (ffetch
 IPXPOS of
 IPDATA)
                                       CHAR-WIDTH))
                  RETRY
                                                              (* ; 
-
                                      "Return to here if we have to emit a newline before printing")

+
                                        "Return to here if we have to emit a newline before printing")

                      (COND
                         ((AND (fetch
 IPCHARVISIBLEP of
 IPDATA)
                               (<= NEWXPOS (fetch
 IPMINCHARRIGHT of
 IPDATA)))
 
                          (* ;; "Char vis means starting pos is inside the character clipping region.  Minright is the min of the right margin and clipping right, so we're OK if we end up left of that")

                                                              (* ; 
-
"This is the common case we've optimized for:  char starts and ends visible and before right margin")

+
 "This is the common case we've optimized for:  char starts and ends visible and before right margin")

                          (freplace
 IPXPOS of
 IPDATA with
 NEWXPOS)
                          [COND
-                            ((NEQ (\CHARSET NSCODE)
+                            ((NEQ (\CHARSET XCODE)
                                   OLD-CSET)
                              (\BOUT (ffetch
 IPSHOWSTREAM of
 IPDATA)
                                     NSCHARSETSHIFT)          (* ; "Switch character set")

                              (\BOUT (ffetch
 IPSHOWSTREAM of
 IPDATA)
-                                    (\CHARSET NSCODE))
+                                    (\CHARSET XCODE))
 
                              (* ;; 
-
                           "have to repeat this, since we may have done a CR before printing it.")

+
                             "have to repeat this, since we may have done a CR before printing it.")

 
-                             (\CHANGECHARSET.IP
 IPDATA (\CHARSET NSCODE]
+                             (\CHANGECHARSET.IP
 IPDATA (\CHARSET XCODE]
                          (\BOUT (ffetch
 IPSHOWSTREAM of
 IPDATA)
-                                (\CHAR8CODE NSCODE))
+                                (\CHAR8CODE XCODE))
                          (RETURN))
                         ((> NEWXPOS (ffetch
 IPRIGHT of
 IPDATA))
 
                          (* ;; 
-
   "Failed visible or micharright, if over right margin, do newline and try again, otherwise clip ")

+
     "Failed visible or micharright, if over right margin, do newline and try again, otherwise clip ")

 
-                         (NEWLINE.IP
 IPSTREAM)           (* ; 
-
                                                           "This will reset the IPCHARVISIBLEP")

+                         (NEWLINE.IP
 IPSTREAM)               (* ; 
+
                                                             "This will reset the IPCHARVISIBLEP")

                          (SETQ NEWXPOS (+ (ffetch
 IPXPOS of
 IPDATA)
                                           CHAR-WIDTH))       (* ; 
-
       "Retry to print if we ended up unclipped and within the margin, otherwise fall thru to clip")

+
         "Retry to print if we ended up unclipped and within the margin, otherwise fall thru to clip")

                          (AND (<= NEWXPOS (ffetch
 IPMINCHARRIGHT of
 IPDATA))
                               (GO RETRY)))
                         ((AND (ffetch
 IPCLIPINCLUSIVE of
 IPDATA)
@@ -1460,29 +1462,29 @@
                               (>= NEWXPOS (ffetch
 IPVISRIGHT of
 IPDATA)))
 
                          (* ;; 
-
               "We're clipping him, but he wants the straddling character left visible.  Print it.")

+
                 "We're clipping him, but he wants the straddling character left visible.  Print it.")

 
                          (freplace
 IPXPOS of
 IPDATA with
 NEWXPOS)
                          [COND
-                            ((NEQ (\CHARSET NSCODE)
+                            ((NEQ (\CHARSET XCODE)
                                   (ffetch
 NSCHARSET of
 IPDATA))
                              (\BOUT (ffetch
 IPSHOWSTREAM of
 IPDATA)
                                     NSCHARSETSHIFT)          (* ; "Switch character set")

                              (\BOUT (ffetch
 IPSHOWSTREAM of
 IPDATA)
-                                    (\CHARSET NSCODE))
+                                    (\CHARSET XCODE))
 
                              (* ;; 
-
                           "have to repeat this, since we may have done a CR before printing it.")

+
                             "have to repeat this, since we may have done a CR before printing it.")

 
-                             (\CHANGECHARSET.IP
 IPDATA (\CHARSET NSCODE]
+                             (\CHANGECHARSET.IP
 IPDATA (\CHARSET XCODE]
                          (\BOUT (ffetch
 IPSHOWSTREAM of
 IPDATA)
-                                (\CHAR8CODE NSCODE))
+                                (\CHAR8CODE XCODE))
                          (RETURN))
                         (T 
                            (* ;; "Nothing printed; have to reset the charset.")

 
                            (\CHANGECHARSET.IP
 IPDATA OLD-CSET)))
-                     (SHOW.IP
 IPSTREAM T)                (* ; "Either failed CHARVIS, or failed both VISRIGHT and IPRIGHT, so not in clipping region.  Just move X position")

+                     (SHOW.IP
 IPSTREAM T)                    (* ; "Either failed CHARVIS, or failed both VISRIGHT and IPRIGHT, so not in clipping region.  Just move X position")

                      (SETX.IP
 IPSTREAM NEWXPOS])
 
 (INTERPRESSFILEP

@@ -2621,8 +2623,10 @@
     ])
 
 (\DSPFONT.IP

-  [LAMBDA (IPSTREAM FONT)
                                    (* ; "Edited 14-Jul-2025 23:30 by rmk")


-                                                             (* ; "Edited 13-Jul-2025 23:10 by rmk")


+  [LAMBDA (IPSTREAM FONT)
                                    (* ; "Edited  6-Sep-2025 14:50 by rmk")


+                                                             (* ; "Edited 20-Jul-2025 14:26 by rmk")


+                                                             (* ; "Edited 14-Jul-2025 22:59 by rmk")


+                                                             (* ; "Edited  5-Jul-2025 18:49 by rmk")


                                                              (* ; "Edited  2-May-2023 08:38 by lmm")


                                                              (* ; "Edited 21-Aug-91 16:33 by jds")

 
@@ -2645,7 +2649,7 @@
                                                              (* ; 
 
                                                             "Get the font number to go in the file")

           (APPENDINTEGER.IP
 IPSTREAM FRAMEVAR)
-          (APPENDOP.IP
 IPSTREAM (\IPC
 SETFONT))
+          (APPENDOP.IP
 IPSTREAM (\IPC SETFONT))
           (freplace
 IPFONT of
 IPDATA with
 FONT)              (* ; "Remember the new font")

           (\CHANGECHARSET.IP
 IPDATA \DEFAULTCHARSET)
           [freplace
 IPSPACEWIDTH of
 IPDATA with
 (FIXR (TIMES (ffetch
 IPSPACEFACTOR of
 IPDATA)
@@ -2654,10 +2658,13 @@
                                                                     (CHARCODE SPACE]
                                                              (* ; 
 
                                "Set the linefeed distance to be one point more than the font height")

-          [freplace
 IPLINEFEED of
 IPDATA with
 (IDIFFERENCE (\IPC
 (IMINUS (IQUOTIENT MICASPERINCH 
+          [freplace
 IPLINEFEED of
 IPDATA with
 (IDIFFERENCE (\IPC (IMINUS (IQUOTIENT MICASPERINCH 
                                                                                 POINTSPERINCH)))
                                                      (FONTPROP FONT 'HEIGHT]
-          (freplace
 NSTRANSTABLE of
 IPDATA with
 (ffetch
 OTHERDEVICEFONTPROPS of
 FONT))
+          (CL:UNLESS (EQ 'MCCS (fetch
 (FONTDESCRIPTOR FONTCHARENCODING) of
 FONT))
+              (freplace
 (INTERPRESSDATA MCCSTRANSFN) of
 IPDATA with
 (ffetch
 (FONTDESCRIPTOR 
+                                                                                   FONTTOMCCSFN)
+                                                                       of
 FONT)))
           (\FIXLINELENGTH.IP
 IPSTREAM)
           (freplace
 IPMAXVISIBLEBASELINE of
 IPDATA with
 (- (ffetch
 IPVISTOP of
 IPDATA)
                                                            (ffetch
 (FONTDESCRIPTOR \SFAscent)
@@ -3100,190 +3107,21 @@
 )
 (DEFINEQ
 
-(\CREATECHARSET.IP

-  [LAMBDA (FAMILY PSIZE FACE ROTATION DEVICE CHARSET FONTDESC NOSLUG?)

-                                                             (* ; "Edited  8-Apr-88 09:54 by jds")

-
-(* ;;; "Build the CHARSETINFO for an Interpress NS font.  If we can't find widths info for that font, return NIL")

-
-(* ;;; "Widths array is fully allocated, with zeroes for characters with no information.  An array is not allocated for fixed WidthsY.  DEVICE is PRESS or INTERPRESS")

-
-    (DECLARE
 (GLOBALVARS INTERPRESSFONTDIRECTORIES \ASCIITONS))
-    (RESETLST                                                (* ; 
-
                                                   "RESETLST to make sure the fontfiles get closed")

-        (PROG (WFILE WSTRM FIXEDFLAGS RELFLAG FIRSTCHAR LASTCHAR TEM WIDTHS WIDTHSY FBBOX 
-                     CHARSETHEIGHT (NSMICASIZE (FIXR (FQUOTIENT (ITIMES PSIZE 2540)
-                                                            72)))
-                     (CSINFO (create
 CHARSETINFO)))
-              (SETQ WIDTHS (fetch
 (CHARSETINFO WIDTHS) of
 CSINFO))
-              [COND
-                 ((SETQ WFILE (\FINDFONTFILE FAMILY PSIZE FACE NIL NIL CHARSET 
-                                     INTERPRESSFONTDIRECTORIES INTERPRESSFONTEXTENSIONS))
-
-(* ;;; "Look thru INTERPRESSFONTDIRECTORIES for a file that describes the font requested.  Only continue if we can find one.")

-
-                  [RESETSAVE (SETQ WSTRM (OPENSTREAM WFILE 'INPUT 'OLD))
-                         '(PROGN (CLOSEF? OLDVALUE]
-                  [COND
-                     ((RANDACCESSP WSTRM)
-                      (SETFILEPTR WSTRM 0))
-                     (T (COPYBYTES WSTRM (SETQ WSTRM (OPENSTREAM '{NODIRCORE} 'BOTH 'NEW]
-                  (SETQ RELFLAG (\POSITIONFONTFILE WSTRM NSMICASIZE FIRSTCHAR LASTCHAR NIL))
-
-                  (* ;; "\POSITIONFONTFILE sets FIRSTCHAR LASTCHAR as well as positioning the font file at the beginning of the widths")

-
-                  (* ;; "Fill in the widths, and return a flag telling whether the widths are absolute, or are type-size relative.  0 => relative")

-
-                  )
-                 (T                                          (* ; 
-
                                                         "Can't find a file to describe this font;")

-                    (RETURN (COND
-                               (NOSLUG?                      (* ; 
-
                                  "the caller just wants NIL back to signal that nothing was found")

-                                      NIL)
-                               (T (\BUILDSLUGCSINFO (fetch
 (FONTDESCRIPTOR FONTAVGCHARWIDTH)
-                                                       of
 FONTDESC)
-                                         (FONTPROP FONTDESC 'ASCENT)
-                                         (FONTPROP FONTDESC 'DESCENT)
-                                         (FONTPROP FONTDESC 'DEVICE]
-              (SETQ RELFLAG (ZEROP RELFLAG))                 (* ; 
-
                                                           "Convert the flag to a logical value")

-              (SETFILEPTR WSTRM (UNFOLD (\FIXPIN WSTRM)
-                                       BYTESPERWORD))
-
-         (* ;; "Read the location of the WD segment for this font (we're in the directory part of the file now), and go there.")

-
-              (SETQ FBBOX (SIGNED (\WIN WSTRM)
-                                 BITSPERWORD))               (* ; 
-
                      "replace (FONTDESCRIPTOR FBBOX) of FD with (SIGNED (\WIN WSTRM) BITSPERWORD)")

-                                                             (* ; 
-
                                                          "Get the max bounding width for the font")

-              (replace
 (CHARSETINFO CHARSETDESCENT) of
 CSINFO
-                 with
 (IMINUS (SIGNED (\WIN WSTRM)
-                                         BITSPERWORD)))      (* ; "Descent is -FBBOY")

-              (\WIN WSTRM)                                   (* ; 
-
                      "replace (FONTDESCRIPTOR FBBDX) of FD with (SIGNED (\WIN WSTRM) BITSPERWORD)")

-                                                             (* ; "And the standard kern value (?)")

-              (SETQ CHARSETHEIGHT (SIGNED (\WIN WSTRM)
-                                         BITSPERWORD))       (* ; 
-
                                   "replace \SFHeight of FD with (SIGNED (\WIN WSTRM) BITSPERWORD)")

-                                                             (* ; "Height is FBBDY")

-              [COND
-                 (RELFLAG                                    (* ; 
-
                                                          "Dimensions are relative, must be scaled")

-
-                        (* ;; "replace (FONTDESCRIPTOR FBBOX) of FD with (IQUOTIENT (ITIMES (fetch (FONTDESCRIPTOR FBBOX) of FD) NSMICASIZE) 1000)")

-
-                        (replace
 (CHARSETINFO CHARSETDESCENT) of
 CSINFO
-                           with
 (IQUOTIENT (ITIMES (fetch
 (CHARSETINFO CHARSETDESCENT)
-                                                          of
 CSINFO)
-                                                      NSMICASIZE)
-                                           1000))
-
-                        (* ;; "replace (FONTDESCRIPTOR FBBDX) of FD with (IQUOTIENT (ITIMES (fetch (FONTDESCRIPTOR FBBDX) of FD) NSMICASIZE) 1000)")

-
-                        (SETQ CHARSETHEIGHT (IQUOTIENT (ITIMES CHARSETHEIGHT NSMICASIZE)
-                                                   1000]
-              (replace
 (CHARSETINFO CHARSETASCENT) of
 CSINFO
-                 with
 (IDIFFERENCE CHARSETHEIGHT (fetch
 CHARSETDESCENT of
 CSINFO)))
-              (SETQ FIXEDFLAGS (LRSH (\BIN WSTRM)
-                                     6))                     (* ; "The fixed flags")

-              (\BIN WSTRM)                                   (* ; "Skip the spares")

-              [COND
-                 ((EQ 2 (LOGAND FIXEDFLAGS 2))               (* ; "This font is fixed width.")

-                  (SETQ TEM (\WIN WSTRM))                    (* ; 
-
                                                           "Read the fixed width for this font")

-                  [COND
-                     ((AND RELFLAG (NOT (ZEROP TEM)))        (* ; 
-
                                                           "If it's size relative, scale it.")

-                      (SETQ TEM (IQUOTIENT (ITIMES TEM NSMICASIZE)
-                                       1000]
-                  (for
 I from
 FIRSTCHAR to
 LASTCHAR do
 
-                                                             (* ; 
-
                                                    "Fill in the char widths table with the width.")

-                                                                      (\FSETWIDTH WIDTHS I TEM)))
-                 (T                                          (* ; 
-
                                                  "Variable width font, so we have to read widths.")

-                                                             (* ; 
-
                               "AIN WIDTHS FIRSTCHAR (ADD1 (IDIFFERENCE LASTCHAR FIRSTCHAR)) WSTRM")

-                    (for
 I from
 FIRSTCHAR to
 LASTCHAR do
 (\FSETWIDTH WIDTHS I 
-                                                                                noInfoCode))
-                    [\BINS (\GETOFD WSTRM 'INPUT)
-                           WIDTHS
-                           (UNFOLD FIRSTCHAR BYTESPERWORD)
-                           (IMIN (UNFOLD (ADD1 (IDIFFERENCE LASTCHAR FIRSTCHAR))
-                                        BYTESPERWORD)
-                                 (IDIFFERENCE (GETFILEINFO WSTRM 'LENGTH)
-                                        (GETFILEPTR WSTRM]   (* ; "Read the X widths.")

-                    (for
 I from
 FIRSTCHAR to
 LASTCHAR
-                       when
 (EQ noInfoCode (\FGETWIDTH WIDTHS I))
-                       do
                                (* ; 
-
                                            "For chars that have no width info, let width be zero.")

-                             (\FSETWIDTH WIDTHS I 0))
-                    (COND
-                       (RELFLAG                              (* ; 
-
                                                     "If the widths are size-relative, scale them.")

-                              (for
 I from
 FIRSTCHAR to
 LASTCHAR
-                                 do
 (\FSETWIDTH WIDTHS I (IQUOTIENT (ITIMES (\FGETWIDTH WIDTHS I)
-                                                                               NSMICASIZE)
-                                                                    1000]
-              [COND
-                 [(EQ 1 (LOGAND FIXEDFLAGS 1))
-                  (COND
-                     ((ILESSP (GETFILEPTR WSTRM)
-                             (GETEOFPTR WSTRM))
-                      (SETQ WIDTHSY (\WIN WSTRM)))
-                     (T                                      (* ; 
-
                                                   "STAR FONT FILES LIKE TO LEAVE OFF THE Y WIDTH.")

-                        (SETQ WIDTHSY 0)))                   (* ; 
-
                "The fixed width-Y for this font;  the width-Y field is a single integer in the FD")

-                  (replace
 (CHARSETINFO YWIDTHS) of
 CSINFO
-                     with
 (COND
-                                 ((AND RELFLAG (NOT (ZEROP WIDTHSY)))
-                                  (IQUOTIENT (ITIMES WIDTHSY NSMICASIZE)
-                                         1000))
-                                 (T WIDTHSY]
-                 (T                                          (* ; 
-
                                                      "Variable Y-width font.  Fill it in as above")

-                    (SETQ WIDTHSY (replace
 (CHARSETINFO YWIDTHS) of
 CSINFO with
 (
-                                                                                 \CREATECSINFOELEMENT
-                                                                                             )))
-                    (for
 I from
 FIRSTCHAR to
 LASTCHAR do
 (\FSETWIDTH WIDTHSY I 
-                                                                                noInfoCode))
-                    (\BINS (\GETOFD WSTRM 'INPUT)
-                           WIDTHSY
-                           (UNFOLD FIRSTCHAR BYTESPERWORD)
-                           (UNFOLD (ADD1 (IDIFFERENCE LASTCHAR FIRSTCHAR))
-                                  BYTESPERWORD))             (* ; "Read the Y widths")

-                    (for
 I from
 FIRSTCHAR to
 LASTCHAR
-                       when
 (EQ noInfoCode (\FGETWIDTH WIDTHSY I))
-                       do
                                (* ; 
-
                                             "Let any characters with no width info be zero height")

-                             (\FSETWIDTH WIDTHSY I 0))
-                    (COND
-                       (RELFLAG                              (* ; 
-
                                                     "If the widths are size-relative, scale them.")

-                              (for
 I from
 FIRSTCHAR to
 LASTCHAR
-                                 do
 (\FSETWIDTH WIDTHSY I (IQUOTIENT (ITIMES (\FGETWIDTH WIDTHSY
-                                                                                        I)
-                                                                                NSMICASIZE)
-                                                                     1000]
-              (RETURN CSINFO)))])
-
 (\CHANGECHARSET.IP

-  [LAMBDA (IPDATA CHARSET)
                               (* gbn " 1-Oct-85 17:45")

+  [LAMBDA (IPDATA CHARSET)
                                   (* ; "Edited 30-Aug-2025 23:45 by rmk")


+                                                             (* ; "Edited 23-Jul-2025 09:59 by rmk")

+                                                             (* gbn " 1-Oct-85 17:45")

 
     (* ;; 
-
"Called when the character set information cached in a display stream doesn't correspond to CHARSET")

+
 "Called when the character set information cached in a display stream doesn't correspond to CHARSET")

 
     (PROG* ((FONT (ffetch
 IPFONT of
 IPDATA))
-            (CSINFO (\GETCHARSETINFO CHARSET FONT)))
+            (CSINFO (\INSURECHARSETINFO FONT CHARSET)))
 
      (* ;; "since the call to \getcharsetinfo has NOSLUG?  = NIL, we know that we will get a reasonable character set back")

 
            (UNINTERRUPTABLY
-               (freplace
 IPWIDTHSCACHE of
 IPDATA with
 (ffetch
 (CHARSETINFO WIDTHS)
-                                                                     of
 CSINFO))
+               (freplace
 IPWIDTHSCACHE of
 IPDATA with
 (ffetch
 (CHARSETINFO WIDTHS) of
 CSINFO))
                (freplace
 NSCHARSET of
 IPDATA with
 CHARSET))])
 )
 (DEFINEQ
@@ -3315,7 +3153,7 @@
                              IMMOVETO _ (FUNCTION \MOVETO.IP)
                              IMSCALE _ [FUNCTION (LAMBDA NIL (* ; 
 
                                                         "should this be a ratio instead of a float?")

-                                                   (\IPC
 (FQUOTIENT MICASPERINCH POINTSPERINCH]
+                                                   (\IPC (FQUOTIENT MICASPERINCH POINTSPERINCH]
                              IMTERPRI _ (FUNCTION NEWLINE.IP)
                              IMBOTTOMMARGIN _ (FUNCTION \DSPBOTTOMMARGIN.IP)
                              IMTOPMARGIN _ (FUNCTION \DSPTOPMARGIN.IP)
@@ -3340,17 +3178,6 @@
                              IMDRAWPOINT _ (FUNCTION \DRAWPOINT.IP)))
     NIL])
 )
-(DEFINEQ
-
-(SCALEREGION

-  [LAMBDA (SCALE REGION)
                                 (* rmk%: "21-JUL-82 13:06")

-                                                             (* ; "Scales a region")

-    (create
 REGION
-           LEFT _ (FIX (FTIMES SCALE (fetch
 (REGION LEFT) of
 REGION)))
-           BOTTOM _ (FIX (FTIMES SCALE (fetch
 (REGION BOTTOM) of
 REGION)))
-           WIDTH _ (FIX (FTIMES SCALE (fetch
 (REGION WIDTH) of
 REGION)))
-           HEIGHT _ (FIX (FTIMES SCALE (fetch
 (REGION HEIGHT) of
 REGION])
-)
 (DECLARE%: DONTEVAL@LOAD DOCOPY 
 
 (RPAQ? \SPLINESTEP.IP
 16.0)
@@ -3361,11 +3188,11 @@
 
 (RPAQ? IPPAGEREGION.ROT270
 NIL)
 
-(RPAQ? DEFAULTPAGEREGION
 (SCALEREGION 2540 (CREATEREGION 1.1 0.75 (- 7.5 1.1)
-                                                  (- 10.5 0.75))))
+(RPAQ? DEFAULTPAGEREGION
 (SCALEREGION MICASPERINCH (CREATEREGION 1.1 0.75 (- 7.5 1.1)
+                                                          (- 10.5 0.75))))
 
-(RPAQ? DEFAULTLANDPAGEREGION
 (SCALEREGION 2540 (CREATEREGION 0.75 1.1 (- 10.5 0.75)
-                                                      (- 7.5 1.1))))
+(RPAQ? DEFAULTLANDPAGEREGION
 (SCALEREGION MICASPERINCH (CREATEREGION 0.75 1.1 (- 10.5 0.75)
+                                                              (- 7.5 1.1))))
 )
 
 
@@ -3393,9 +3220,9 @@
                                   (ERROR "Invalid Interpress operator code:" OP)))
                               (COND
                                  ((CONSTANT (ILEQ OP 31))
-                                  (APPENDBYTE.IP
 STREAM (LOGOR (\IPC
 SHORTOP)
+                                  (APPENDBYTE.IP
 STREAM (LOGOR (\IPC SHORTOP)
                                                                OP)))
-                                 (T (APPENDBYTE.IP
 STREAM (LOGOR (\IPC
 LONGOP)
+                                 (T (APPENDBYTE.IP
 STREAM (LOGOR (\IPC LONGOP)
                                                                  (FOLDLO OP 256)))
                                     (APPENDBYTE.IP
 STREAM (MOD OP 256])
 
@@ -3419,7 +3246,7 @@
                                             (APPENDINT.IPMACRO STREAM (IPLUS N 4000)
                                                    2))
                                            (T (PROG ((LEN (BYTESININT.IP
 N)))
-                                                    (APPENDSEQUENCEDESCRIPTOR.IP
 STREAM (\IPC
 
+                                                    (APPENDSEQUENCEDESCRIPTOR.IP
 STREAM (\IPC 
                                                                                            SEQINTEGER
                                                                                               )
                                                            LEN)
@@ -3469,7 +3296,8 @@
                  (IPNEXTFRAMEVAR BYTE)
                  (IPHEADINGOPVAR BYTE)
                  (NSCHARSET BYTE)
-                 (NSTRANSTABLE POINTER)
+                 (MCCSTRANSFN POINTER)                       (* ; 
+
                                                             "Was NSTRANSFN, but now stops at MCCS")

                  (IPCORRECTSTARTX POINTER                    (* ; 
 
                         "Used with IPXPOS to compute width for CORRECTing char strings during SHOW.")

                         )
@@ -3659,7 +3487,7 @@
 
 (ADDTOVAR IMAGESTREAMTYPES
 (INTERPRESS (OPENSTREAM OPENIPSTREAM)
                                   (FONTCREATE \CREATEINTERPRESSFONT)
-                                  (FONTSAVAILABLE \SEARCHINTERPRESSFONTS)
+                                  (FONTSAVAILABLE \SEARCHFONTFILES)
                                   (CREATECHARSET \CREATECHARSET.IP)))
 
 
@@ -3691,212 +3519,307 @@
                                 (EXTENSION (IP IPR INTERPRESS))
                                 (CONVERSION (TEXT MAKEINTERPRESS TEDIT \TEDIT.HARDCOPY))))
 
+(ADDTOVAR IMAGESTREAMTYPES
 (INTERPRESSDISPLAY (FONTCREATE \FONTCREATE.HCPYMODE)
+                                  (CREATECHARSET \CREATECHARSET.HCPYMODE)))
+
 (RPAQ? DEFAULT.INTERPRESS.BITMAP.ROTATION
 90)
 
 (ADDTOVAR SYSTEMINITVARS
 (INTERPRESSFONTDIRECTORIES {DSK}))
 
-(RPAQ? INTERPRESSFONTEXTENSIONS
 '(WD))
+(ADDTOVAR INTERPRESSFONTEXTENSIONS
 MEDLEYINTERPRESSFONT WD)
+
+
+
+(* ; "Interpress fonts; but see MEDLEY-INIT-VARS")

 
-(RPAQ? INTERPRESSFONTDIRECTORIES
 '("{Erinyes}<Lyric>Fonts>"))
+
+(RPAQ? INTERPRESSFONTDIRECTORIES
 '(fonts>medleyinterpressfonts> fonts>ipfonts>))
 
 (RPAQ? INTERPRESSPRINTWHEELFAMILIES
 '(BOLDPS ELITE LETTERGOTHIC MASTER PICA PSBOLD SCIENTIFIC 
                                             SPOKESMAN TITAN TREND TRENDPS TROJAN VINTAGE))
 
 (RPAQ? INTERPRESSFAMILYALIASES
 '(LOGO LOGOTYPES-XEROX))
+(DEFINEQ
 
+(\CREATEINTERPRESSFONT

+  [LAMBDA (FONTSPEC)
                                         (* ; "Edited 31-Aug-2025 14:20 by rmk")


+                                                             (* ; "Edited 28-Aug-2025 16:00 by rmk")


+                                                             (* ; "Edited 16-Aug-2025 12:05 by rmk")


+                                                             (* ; "Edited 12-Aug-2025 23:06 by rmk")


+                                                             (* ; "Edited  5-Aug-2025 17:56 by rmk")


+                                                             (* ; "Edited 24-Jul-2025 22:39 by rmk")


+                                                             (* ; "Edited 20-Jul-2025 20:53 by rmk")


+                                                             (* ; "Edited 22-May-2025 09:59 by rmk")


+                                                             (* ; "Edited 18-May-2025 21:37 by rmk")

+                                                             (* gbn " 1-Oct-85 18:29")

+    (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)
+           FONTSCALE _ (CONSTANT (FQUOTIENT 2540 72))
+           FONTTOMCCSFN _ (MCCSMAPFN FONTSPEC])
 
-
-(* ; "NS Character Encoding")

-
+(\CREATECHARSET.IP

+  [LAMBDA (FONTSPEC FONT CHARSET)
                            (* ; "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])
+)
 (DEFINEQ
 
-(\COERCEASCIITONSFONT

-  [LAMBDA (ASCIITONSMAPARRAY ASCIIFAMILY NSFAMILY SIZE FONTFACE ROTATION DEVICE)

-                                                             (* ; "Edited 20-Dec-2024 13:37 by rmk")

-                                                             (* gbn "12-Sep-85 15:10")

-
-    (* ;; "Produces an ascii font with the proper widths for the ns-character correspondences defined by ASCIITONSMAPARRAY")

-
-    (PROG (CHARSETDIR [ASCIITONSMAP (fetch
 (ARRAYP BASE) of
 (\DTEST ASCIITONSMAPARRAY 'ARRAYP]
-                 (FD (\CREATESTARFONT NSFAMILY SIZE FONTFACE ROTATION DEVICE)))
-          (OR FD (RETURN NIL))
-          [SETQ CHARSETDIR (CONS (CONS 0 (\GETCHARSETINFO 0 FD]
-          [bind
 NSCODE CS for
 I from
 0 to
 255 unless
 (OR (EQ I (SETQ NSCODE (\GETBASE ASCIITONSMAP I)
-                                                                ))
-                                                         (ASSOC (SETQ CS (\CHARSET NSCODE))
-                                                                CHARSETDIR))
-             do
                                              (* ; 
-
    "Run thru the translate table looking for non-0 charsets.  Add their width info to the directory")

-                (push
 CHARSETDIR (CONS CS
-                                       (COND
-                                          ((\GETCHARSETINFO CS FD))
-                                          (T                 (* ; 
-
                              "There isn't any info for that character.  Warn the guy, but continue.")

-                                             (FRESHLINE PROMPTWINDOW)
-                                             (printout PROMPTWINDOW 
-                                                    "Warning:  Information about character set " 
-                                                    .I3.8 CS " missing from font " ASCIIFAMILY %, 
-                                                    SIZE ".")
-                                             NIL]            (* ; 
-
                                                       "Return if one of the fonts couldn't be found")

-          [bind
 CHARSETINFO NSCODE (WIDTHS _ (fetch
 (CHARSETINFO WIDTHS) of
 (\GETCHARSETINFO 0 FD)))
-             for
 I from
 0 to
 255 unless
 (EQ I (SETQ NSCODE (\GETBASE ASCIITONSMAP I)))
-             when
 (SETQ CHARSETINFO (CDR (ASSOC (\CHARSET NSCODE)
-                                                CHARSETDIR)))
-             do
                                              (* ; 
-
 "For each non-ASCII character, look for width info in the right NS place.  If none, use zero width.")

-                (\FSETWIDTH WIDTHS I (\FGETWIDTH (fetch
 (CHARSETINFO WIDTHS) of
 CHARSETINFO)
-                                            (\CHAR8CODE NSCODE]
-          [replace
 OTHERDEVICEFONTPROPS of
 FD with
 (fetch
 (ARRAYP BASE) of
 (\DTEST ASCIITONSMAPARRAY
-                                                                                  'ARRAYP]
-          [COND
-             ((NEQ NSFAMILY ASCIIFAMILY)
+(IPFONT.FILEP

+  [LAMBDA (STREAM)
                                           (* ; "Edited 21-Jul-2025 15:26 by rmk")

+    (STRING.EQUAL "wd" (FILENAMEFIELD STREAM 'EXTENSION])
+
+(IPFONT.GETCHARSET

+  [LAMBDA (FILE CHARSET FONT)
                                (* ; "Edited  7-Sep-2025 23:38 by rmk")


+                                                             (* ; "Edited 28-Aug-2025 23:18 by rmk")


+                                                             (* ; "Edited 22-Jul-2025 23:24 by rmk")


+                                                             (* ; "Edited 21-Jul-2025 18:32 by rmk")


+                                                             (* ; "Edited 12-Jun-2025 21:12 by rmk")


+                                                             (* ; "Edited 11-Jun-2025 10:55 by rmk")


+                                                             (* ; "Edited  8-Apr-88 09:54 by jds")

 
-              (* ;; "Update the font deacriptor so it looks like it's really for the family the guy wanted.  Also save the info we used to get here.")

+(* ;;; "Reads .wd files to build the CHARSETINFO for an Interpress  font, NI, returns NIL if it can't be constructed..  Caller has decided this this file is a good candidate fore the FONTSPEC parameters..  ")

 
-              (replace
 FONTFAMILY of
 FD with
 ASCIIFAMILY)
-              (replace
 FONTDEVICESPEC of
 FD with
 (LIST NSFAMILY SIZE FONTFACE ROTATION DEVICE]
-          (RETURN FD])
+(* ;;; "Widths array is fully allocated, with zeroes for characters with no information.  An array is not allocated for fixed WidthsY.  ")

 
-(\CREATEINTERPRESSFONT

-  [LAMBDA (FAMILY SIZE FONTFACE ROTATION DEVICE)
             (* ; "Edited 21-Dec-2024 16:26 by rmk")


-                                                             (* ; "Edited 20-Dec-2024 13:43 by rmk")


-                                                             (* ; "Edited 17-Feb-87 16:49 by FS")

-
-    (* ;; "Creates a font descriptor for an NS font for Interpress hardcopy.  Tries first on the assumption that he gave us the NS font name;")

-
-    (DECLARE
 (GLOBALVARS \ASCII2XCCS))
-    (if
 (\COERCEASCIITONSFONT
 \ASCII2XCCS FAMILY FAMILY SIZE FONTFACE ROTATION DEVICE)
-      elseif
 (for
 TRANSL in
 ASCIITONSTRANSLATIONS bind
 NEWFONT
-                when
 (AND (EQ FAMILY (CAR TRANSL))
-                          (SETQ NEWFONT (\COERCEASCIITONSFONT
 (COND
-                                                                 ((NULL (CADR TRANSL))
-                                                                  \ASCII2XCCS)
-                                                                 ((LITATOM (CADR TRANSL))
-                                                                  (EVAL (CADR TRANSL)))
-                                                                 (T (CADR TRANSL)))
-                                               FAMILY
-                                               (OR (CADDR TRANSL)
-                                                   'MODERN)
-                                               SIZE FONTFACE ROTATION DEVICE)))
-                do
 (RETURN NEWFONT])
-
-(\SEARCHINTERPRESSFONTS

-  [LAMBDA (FAMILY PSIZE FACE ROTATION)
                   (* ; "Edited  2-Jan-87 17:07 by FS")

-    (DECLARE
 (GLOBALVARS INTERPRESSFONTDIRECTORIES INTERPRESSFONTEXTENSIONS))
-    (\SEARCHFONTFILES FAMILY PSIZE FACE ROTATION 'INTERPRESS INTERPRESSFONTDIRECTORIES 
-           INTERPRESSFONTEXTENSIONS])
-)
-(DECLARE%: EVAL@COMPILE DONTCOPY 
-(DECLARE%: EVAL@COMPILE 
+    (RESETLST                                                (* ; 
+
                                                            "Make sure FILE get closed if we open it")

+        (PROG (WSTRM FIXEDFLAGS RELFLAG FIRSTCHAR LASTCHAR TEM WIDTHS WIDTHSY FBBOX CHARSETHEIGHT
+                     (NSMICASIZE (FIXR (FQUOTIENT (ITIMES (FONTPROP FONT 'SIZE)
+                                                         2540)
+                                              72)))
+                     (CSINFO (create
 CHARSETINFO
+                                    OFFSETS _ NIL)))
+              (CL:UNLESS (SETQ WSTRM (GETSTREAM FILE 'INPUT T))
+                  [RESETSAVE (SETQ WSTRM (OPENSTREAM FILE 'INPUT 'OLD))
+                         '(PROGN (CLOSEF? OLDVALUE])
+              (CL:UNLESS (RANDACCESSP WSTRM)
+                  [SETQ WSTRM (COPYBYTES WSTRM (SETQ WSTRM (OPENSTREAM '{NODIRCORE} 'BOTH
+                                                                  'NEW])
+              (CL:UNLESS (SETQ RELFLAG (\POSITIONFONTFILE WSTRM NSMICASIZE FIRSTCHAR LASTCHAR NIL))
 
-(RPAQQ noInfoCode
 32768)
+                  (* ;; "\POSITIONFONTFILE sets FIRSTCHAR LASTCHAR as well as positioning the font file at the beginning of the widths")

 
+                  (* ;; "Fill in the widths, and return a flag telling whether the widths are absolute, or are type-size relative.  0 => relative")

 
-(CONSTANTS (noInfoCode 32768))
-)
-)
+                  (RETURN NIL))
+              (SETQ WIDTHS (fetch
 (CHARSETINFO WIDTHS) of
 CSINFO))
+              (SETQ RELFLAG (ZEROP RELFLAG))                 (* ; 
+
                                                             "Convert the flag to a logical value")

+              (SETFILEPTR WSTRM (UNFOLD (\FIXPIN WSTRM)
+                                       BYTESPERWORD))
 
-(RPAQ? ASCIITONSTRANSLATIONS
 )
+         (* ;; "Read the location of the WD segment for this font (we're in the directory part of the file now), and go there.")

 
+              (SETQ FBBOX (SIGNED (\WIN WSTRM)
+                                 BITSPERWORD))               (* ; 
+
                                                            "Get the max bounding width for the font")

+              (replace
 (CHARSETINFO CHARSETDESCENT) of
 CSINFO with
 (IMINUS (SIGNED (\WIN WSTRM)
+                                                                                  BITSPERWORD)))
+              (\WIN WSTRM)                                   (* ; "RMK:  Not sure what this is")

+              (SETQ CHARSETHEIGHT (SIGNED (\WIN WSTRM)
+                                         BITSPERWORD))
+              (CL:WHEN RELFLAG                               (* ; 
+
                                                            "Dimensions are relative, must be scaled")

+                  (replace
 (CHARSETINFO CHARSETDESCENT) of
 CSINFO
+                     with
 (IQUOTIENT (ITIMES (fetch
 (CHARSETINFO CHARSETDESCENT) of
 CSINFO)
+                                            NSMICASIZE)
+                                 1000))
+                  (SETQ CHARSETHEIGHT (IQUOTIENT (ITIMES CHARSETHEIGHT NSMICASIZE)
+                                             1000)))
+              (replace
 (CHARSETINFO CHARSETASCENT) of
 CSINFO with
 (IDIFFERENCE CHARSETHEIGHT
+                                                                         (fetch
 CHARSETDESCENT
+                                                                            of
 CSINFO)))
+              (SETQ FIXEDFLAGS (LRSH (\BIN WSTRM)
+                                     6))                     (* ; "The fixed flags")

+              (\BIN WSTRM)                                   (* ; "Skip the spares")

+              [COND
+                 ((EQ 2 (LOGAND FIXEDFLAGS 2))               (* ; "This font is fixed width.")

+                  (SETQ TEM (\WIN WSTRM))                    (* ; 
+
                                                             "Read the fixed width for this font")

+                  [COND
+                     ((AND RELFLAG (NOT (ZEROP TEM)))        (* ; "If it's size relative, scale it.")

+                      (SETQ TEM (IQUOTIENT (ITIMES TEM NSMICASIZE)
+                                       1000]
+                  (for
 I from
 FIRSTCHAR to
 LASTCHAR do
       (* ; 
+
                                                      "Fill in the char widths table with the width.")

+                                                       (\FSETWIDTH WIDTHS I TEM)))
+                 (T                                          (* ; 
+
                                                    "Variable width font, so we have to read widths.")

+                                                             (* ; 
+
                                 "AIN WIDTHS FIRSTCHAR (ADD1 (IDIFFERENCE LASTCHAR FIRSTCHAR)) WSTRM")

+                    (for
 I from
 FIRSTCHAR to
 LASTCHAR do
 (\FSETWIDTH WIDTHS I noInfoCode))
+                    [\BINS (\GETOFD WSTRM 'INPUT)
+                           WIDTHS
+                           (UNFOLD FIRSTCHAR BYTESPERWORD)
+                           (IMIN (UNFOLD (ADD1 (IDIFFERENCE LASTCHAR FIRSTCHAR))
+                                        BYTESPERWORD)
+                                 (IDIFFERENCE (GETFILEINFO WSTRM 'LENGTH)
+                                        (GETFILEPTR WSTRM]   (* ; "Read the X widths.")

+                    (for
 I from
 FIRSTCHAR to
 LASTCHAR when
 (EQ noInfoCode (\FGETWIDTH WIDTHS I))
+                       do
                                    (* ; 
+
                                              "For chars that have no width info, let width be zero.")

+                          (\FSETWIDTH WIDTHS I 0))
+                    (CL:WHEN RELFLAG                         (* ; 
+
                                                       "If the widths are size-relative, scale them.")

+                        (for
 I from
 FIRSTCHAR to
 LASTCHAR
+                           do
 (\FSETWIDTH WIDTHS I (IQUOTIENT (ITIMES (\FGETWIDTH WIDTHS I)
+                                                                     NSMICASIZE)
+                                                          1000))))]
+              [COND
+                 ((EQ 1 (LOGAND FIXEDFLAGS 1))
+                  (COND
+                     ((ILESSP (GETFILEPTR WSTRM)
+                             (GETEOFPTR WSTRM))
+                      (SETQ WIDTHSY (\WIN WSTRM)))
+                     (T                                      (* ; 
+
                                                     "STAR FONT FILES LIKE TO LEAVE OFF THE Y WIDTH.")

+                        (SETQ WIDTHSY 0)))                   (* ; 
+
                  "The fixed width-Y for this font;  the width-Y field is a single integer in the FD")

+                  (replace
 (CHARSETINFO YWIDTHS) of
 CSINFO with
 (CL:IF (AND RELFLAG
+                                                                            (NOT (ZEROP WIDTHSY)))
+                                                                    (IQUOTIENT (ITIMES WIDTHSY 
+                                                                                      NSMICASIZE)
+                                                                           1000)
+                                                                    WIDTHSY)))
+                 (T                                          (* ; 
+
                                                        "Variable Y-width font.  Fill it in as above")

+                    (SETQ WIDTHSY (replace
 (CHARSETINFO YWIDTHS) of
 CSINFO with
 (\CREATECSINFOELEMENT
+                                                                                 )))
+                    (for
 I from
 FIRSTCHAR to
 LASTCHAR do
 (\FSETWIDTH WIDTHSY I noInfoCode))
+                    (\BINS WSTRM WIDTHSY (UNFOLD FIRSTCHAR BYTESPERWORD)
+                           (UNFOLD (ADD1 (IDIFFERENCE LASTCHAR FIRSTCHAR))
+                                  BYTESPERWORD))             (* ; "Read the Y widths")

+                    (for
 I from
 FIRSTCHAR to
 LASTCHAR when
 (EQ noInfoCode (\FGETWIDTH WIDTHSY I))
+                       do
                                    (* ; 
+
                                               "Let any characters with no width info be zero height")

+                          (\FSETWIDTH WIDTHSY I 0))
+                    (CL:WHEN RELFLAG                         (* ; 
+
                                                       "If the widths are size-relative, scale them.")

+                        (for
 I from
 FIRSTCHAR to
 LASTCHAR
+                           do
 (\FSETWIDTH WIDTHSY I (IQUOTIENT (ITIMES (\FGETWIDTH WIDTHSY I)
+                                                                      NSMICASIZE)
+                                                           1000))))]
+              (RETURN CSINFO)))])
 
+(\FACECODE

+  [LAMBDA (FACE)                                             (* rmk%: "27-FEB-81 12:16")

+    (IPLUS (SELECTQ (fetch
 (FONTFACE EXPANSION) of
 FACE)
+               (REGULAR 0)
+               (COMPRESSED 6)
+               (EXPANDED 12)
+               (SHOULDNT))
+           (SELECTQ (fetch
 (FONTFACE WEIGHT) of
 FACE)
+               (MEDIUM 0)
+               (BOLD 2)
+               (LIGHT 4)
+               (SHOULDNT))
+           (SELECTQ (fetch
 (FONTFACE SLOPE) of
 FACE)
+               (REGULAR 0)
+               (ITALIC 1)
+               (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.")

+
+    (SETFILEPTR WSTRM 0)
+    (bind
 TYPE CODE LENGTH (NCHARS _ (NCHARS FAMILY))
+          (NEXT _ 0)
+       do
 (SETFILEPTR WSTRM NEXT)
+          (SETQ TYPE (\BIN WSTRM))
+          (SETQ LENGTH (\BIN WSTRM))
+          (add
 NEXT (LLSH (IPLUS LENGTH (LLSH (LOGAND TYPE 15)
+                                              8))
+                          1))
+          (SELECTQ (LRSH TYPE 4)
+              (1 (SETQ CODE (\WIN WSTRM))
+                 (COND
+                    ([OR (EQ FAMILY T)
+                         (AND (EQ NCHARS (\BIN WSTRM))
+                              (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])
+)
+(DECLARE%: EVAL@COMPILE 
 
-(* ;; 
-"These are in priority order:  if an early one doesn't find a font for a family, the later ones are tried (essentially going to MODERN as the default)."
-)

+(PUTPROPS \POSITIONFONTFILE
 MACRO

+          ((WSTRM NSMICASIZE FIRSTCHAR LASTCHAR FAMILY FACECODE)
+
+           (* ;; "Some of the parameters are variable names to be set.  Value is either NIL or SIZE")

+
+           (bind
 TYPE LENGTH SIZE FAMCODE FILEFAM FILEFACE (NEXT _ 0)
+              first
 (OR (SETQ FAMCODE (\FAMILYCODE
 (OR FAMILY T)
+                                             WSTRM))
+                        (RETURN NIL))
+              do
 (SETQ TYPE (\BIN WSTRM))
+                 (SETQ LENGTH (\BIN WSTRM))
+                 (add
 NEXT (LLSH (IPLUS LENGTH (LLSH (LOGAND TYPE 15)
+                                                     8))
+                                 1))
+                 (SELECTQ (LRSH TYPE 4)
+                     (4 (SETQ FILEFAM (\BIN WSTRM))
+                        (SETQ FILEFACE (\BIN WSTRM))
+                        (CL:WHEN (OR (EQ FAMILY T)
+                                     (EQ FAMILY NIL)
+                                     (AND (IEQP FILEFAM FAMCODE)
+                                          (IEQP FILEFACE FACECODE)))
+                            (SETQ FIRSTCHAR (\BIN WSTRM))
+                            (SETQ LASTCHAR (\BIN WSTRM))
+                            (CL:WHEN (AND (OR (ZEROP (SETQ SIZE (\WIN WSTRM)))
+                                              (LESSP (ABS (FQUOTIENT (IDIFFERENCE NSMICASIZE SIZE)
+                                                                 NSMICASIZE))
+                                                     0.02))
+                                          (ZEROP (\WIN WSTRM)))
+                                   (RETURN SIZE))))
+                     (0 (RETURN NIL))
+                     NIL)
+                 (SETFILEPTR WSTRM NEXT))))
+)
+(* "FOLLOWING DEFINITIONS EXPORTED")(DECLARE%: EVAL@COMPILE 
 
+(RPAQQ noInfoCode
 32768)
 
-(ADDTOVAR ASCIITONSTRANSLATIONS

-          (TIMESROMAN NIL CLASSIC)
-          (GACHA NIL TERMINAL)
-          (HELVETICA NIL MODERN)
-          (CLASSIC NIL MODERN)
-          (GACHA NIL MODERN)
-          (TIMESROMAN NIL MODERN)
-          (LOGO NIL LOGOTYPES)
-          (HIPPO HIPPOTONSARRAY CLASSIC)
-          (CYRILLIC CYRILLICTONSARRAY CLASSIC)
-          (SYMBOL \SYMBOLTONSARRAY MODERN)
-          (MATH \MATHTONSARRAY CLASSIC))
-
-(READVARS-FROM-STRINGS '(\SYMBOLTONSARRAY HIPPOTONSARRAY CYRILLICTONSARRAY \MATHTONSARRAY)
-       "({Y256 SMALLPOSP 0 0 0 180 8546 0 8574 177 61309 61282 61283 61284 61285 0 184 0 0 61296 61298 61273 
-61272 8549 8550 0 0 61054 61305 61275 61274 8546 61299 0 0 0 174 173 175 61266 61250 61251 61303 61261
- 61263 0 0 61262 {R4 0} 8551 61258 61259 61281 0 61292 172 61365 61364 61290 61351 0 0 0 47 0 65 66 67
- 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 61271 61270 0 61366 61367 61238 
-61239 61362 61363 61360 61361 123 125 61234 61235 61052 8514 61243 61242 8740 8742 61308 8546 0 61301 
-{R4 0} 167 61232 61233 182 64 211 163 36 {R128 0} }  {Y256 SMALLPOSP 0 0 1 2 3 4 5 6 7 8 9 10 11 12 13
- 60973 61229 16 17 18 61221 20 21 61220 23 60973 61228 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41
- 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 9793 9794 9809 9797 9798 9818 
-9796 9802 9804 74 9805 9806 9807 9808 9810 9811 9803 9813 9814 9816 9817 86 9821 9819 9820 9801 91 92 
-93 173 172 96 9825 9826 9841 9829 9830 9850 9828 9834 9836 106 9837 9838 9839 9840 9842 9843 9835 9845
- 9846 9848 9849 118 9853 9851 9852 9833 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 
-138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 61220 61221 157 158 159 160 161 
-162 163 164 165 166 167 168 169 170 171 172 173 174 175 176 177 178 179 180 181 182 61286 184 185 186 
-187 188 189 190 191 192 193 194 195 196 197 198 199 200 201 202 203 204 205 206 207 208 209 210 211 
-212 213 214 215 216 217 218 219 220 221 222 223 224 225 226 227 228 229 230 231 232 233 234 235 236 
-237 238 239 240 241 242 243 244 245 246 247 248 249 250 251 252 253 254 255 }  {Y256 SMALLPOSP 0 0 1 2
- 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 10023 37 
-38 39 40 41 10041 43 44 8510 46 47 48 49 10095 51 10071 53 10088 55 10089 57 58 59 171 61 187 63 10047
- 10017 10018 10046 10021 10022 10038 10020 10049 10026 10027 10028 10029 10030 10031 10032 10033 10039
- 10034 10035 10036 10037 10019 10024 10045 10048 10025 10090 9984 10091 10044 10092 9984 10065 10066 
-10110 10069 10070 10086 10068 10097 10074 10075 10076 10077 10078 10079 10080 10081 10087 10082 10083 
-10084 10085 10067 10072 10093 10096 10073 10042 9984 10043 10040 9984 128 129 130 131 132 133 134 135 
-136 137 138 139 140 141 142 10094 144 145 146 147 148 149 150 151 152 153 154 61220 61221 157 158 159 
-160 161 162 163 164 165 166 167 168 169 170 171 172 173 174 175 176 177 178 179 180 181 182 61286 184 
-185 186 187 188 189 190 191 192 193 194 195 196 197 198 199 200 201 202 203 204 205 206 207 208 209 
-210 211 212 213 214 215 216 217 218 219 220 221 222 223 224 225 226 227 228 229 230 231 232 233 234 
-235 236 237 238 239 240 241 242 243 244 245 246 247 248 249 250 251 252 253 254 255 }  {Y256 SMALLPOSP
- 0 0 61307 61234 61235 0 163 61301 61302 0 0 0 182 0 0 0 61286 0 0 0 61306 0 0 61295 {R9 0} 32 61232 
-61287 8551 162 184 61366 61299 194 61308 199 177 61260 61309 8552 61285 61287 8738 8740 8574 61282 
-61283 61284 61292 8570 199 167 0 8549 8546 8550 191 61248 61365 61258 61356 61369 61364 61233 61275 
-61279 61273 61274 61278 61272 61629 61259 61281 61297 61265 61358 61305 61296 61271 61367 61298 180 
-61626 61368 0 0 0 175 174 0 61351 61267 211 61370 61303 61266 61263 61288 61360 61361 61362 61363 
-61256 61290 61287 61238 61240 210 61246 61244 61247 61245 61250 61251 61270 61239 188 189 190 61264 {R
-129 0} })
-")
-
-(RPAQQ \ASCII2XCCSMAP

-       (("$" "0,244" Currency to dollar)
-        ("-" "41,76" Hyphen to Japanese hyphen)
-        ("_" "0,254" Underscore to left arrow)
-        ("^" "0,255" Caret to Up arrow)
-        ("^K" "0,302" Acute)
-        ("^N" "0,305" Macron)
-        ("^S" "357,45" Em dash)
-        ("^V" "357,44" En dash)
-        ("^X" "0,55" Neutral hyphen)
-        ("^O" "357,55" Em quad)
-        ("^\" "357,54" En quad)
-        ("^Y" "357,56" Figure space)
-        ("^D" "0,310" Diaresis)
-        ("^G" "0,271" Left quote)
-        ("^H" "0,241" Inverted !)
-        ("^B" "0,277" Inverted ?)
-        ("`" "0,251" Back quote to left quote)
-        ("0,233" "357,44" En dash (again?))
-        ("0,234" "357,45" Em dash (again?))
-        ("^^" "0,270" Divide)))
-(DEFINEQ
 
-(\ASCIIMAPARRAY

-  [LAMBDA (MAP SKIP)
                                         (* ; "Edited 21-Dec-2024 18:57 by rmk")

-    (SETQ SKIP (CHARCODE.DECODE SKIP))
-    (LET ((TABLE (ARRAY 256 'WORD 0 0)))
-         (for
 I from
 0 to
 255 do
 (SETA TABLE I I))
-         [for
 X FROMCODE in
 MAP eachtime
 [SETQ FROMCODE (OR (FIXP (CAR X))
-                                                            (CHARCODE.DECODE (CAR X]
-            unless
 (MEMB FROMCODE SKIP) do
 (SETA TABLE FROMCODE (CL:IF (STRINGP (CADR X))
-                                                                    (CHARCODE.DECODE (CADR X))
-                                                                    (LOGOR (LLSH (CADR X)
-                                                                                 8)
-                                                                           (CADDR X)))]
-         TABLE])
+(CONSTANTS (noInfoCode 32768))
 )
 
-(RPAQ? \ASCII2XCCS
 (\ASCIIMAPARRAY \ASCII2XCCSMAP))
+(* "END EXPORTED DEFINITIONS")
+
 
-(RPAQ? \ASCII2MCCS
 (\ASCIIMAPARRAY \ASCII2XCCSMAP '("$" "-")))
+(ADDTOVAR INTERPRESSCHARSETFNS
 (INTERPRESS IPFONT.FILEP IPFONT.GETCHARSET))
+
+(RPAQ? INTERPRESSFONTCOERCIONS

+       '((TIMESROMAN CLASSIC)
+         (GACHA TERMINAL)
+         (HELVETICA MODERN)
+         (CLASSIC MODERN)
+         (GACHA MODERN)
+         (TIMESROMAN MODERN)
+         (LOGO LOGOTYPES)
+         (HIPPO CLASSIC)
+         (CYRILLIC CLASSIC)
+         (SYMBOL MODERN)
+         (MATH CLASSIC)
+         (SIGMA MODERN)
+         (* MODERN)))
 (DECLARE%: DONTEVAL@LOAD DOCOPY 
 
 (\INTERPRESSINIT
)
@@ -3908,45 +3831,44 @@
 (LOADDEF 'BRUSH 'RECORDS 'IMAGEIO)
 )
 (DECLARE%: DONTCOPY
-  (FILEMAP (NIL (15830 16683 (\IPC 15830 . 16683)) (16916 22568 (APPENDBYTE.IP 16926 . 17062) (
-APPENDIDENTIFIER.IP 17064 . 17586) (APPENDINT.IP 17588 . 18039) (APPENDINTEGER.IP 18041 . 18613) (
-APPENDLARGEVECTOR.IP 18615 . 19580) (APPENDNUMBER.IP 19582 . 20051) (APPENDOP.IP 20053 . 20699) (
-APPENDRATIONAL.IP 20701 . 21194) (APPENDSEQUENCEDESCRIPTOR.IP 21196 . 22391) (BYTESININT.IP 22393 . 
-22566)) (22604 62411 (ARCTO.IP 22614 . 23895) (BEGINMASTER.IP 23897 . 24170) (BEGINPAGE.IP 24172 . 
-24528) (BEGINPREAMBLE.IP 24530 . 24901) (CLIPRECTANGLE.IP 24903 . 25393) (CONCAT.IP 25395 . 25660) (
-CONCATT.IP 25662 . 25929) (ENDMASTER.IP 25931 . 26375) (ENDPAGE.IP 26377 . 26754) (ENDPREAMBLE.IP 
-26756 . 27555) (FGET.IP 27557 . 27860) (FILLRECTANGLE.IP 27862 . 30190) (FILLTRAJECTORY.IP 30192 . 
-30827) (FILLNGON.IP 30829 . 33106) (FSET.IP 33108 . 33411) (GETFRAMEVAR.IP 33413 . 33731) (
-INITIALIZEMASTER.IP 33733 . 34334) (INITIALIZECOLOR.IP 34336 . 35657) (ISET.IP 35659 . 36030) (
-GETCP.IP 36032 . 36341) (LINETO.IP 36343 . 36948) (MASKSTROKE.IP 36950 . 37223) (MOVETO.IP 37225 . 
-37562) (ROTATE.IP 37564 . 37866) (SCALE.IP 37868 . 38171) (SCALE2.IP 38173 . 38510) (SETCOLOR.IP 38512
- . 40741) (SETRGB.IP 40743 . 41799) (SETCOLORLV.IP 41801 . 46414) (SETCOLOR16.IP 46416 . 49522) (
-SETFONT.IP 49524 . 50345) (SETSPACE.IP 50347 . 50659) (SETXREL.IP 50661 . 51845) (SETX.IP 51847 . 
-53364) (SETXY.IP 53366 . 54538) (SETXYREL.IP 54540 . 55846) (SETY.IP 55848 . 57157) (SETYREL.IP 57159
- . 58059) (SHOW.IP 58061 . 61321) (TRAJECTORY.IP 61323 . 61721) (TRANS.IP 61723 . 62062) (TRANSLATE.IP
- 62064 . 62409)) (62442 68532 (\CHANGE-VISIBLE-REGION.IP 62452 . 66113) (\PAPERSIZE.IP 66115 . 66936) 
-(HEADINGOP.IP 66938 . 68530)) (68533 173771 (DEFINEFONT.IP 68543 . 69517) (FONTNAME.IP 69519 . 70449) 
-(INTERPRESS.BITMAPSCALE 70451 . 71260) (INTERPRESS.OUTCHARFN 71262 . 77434) (INTERPRESSFILEP 77436 . 
-78770) (MAKEINTERPRESS 78772 . 78956) (NEWLINE.IP 78958 . 79690) (NEWPAGE.IP 79692 . 84667) (
-NEWPAGE?.IP 84669 . 85148) (OPENIPSTREAM 85150 . 93501) (SETUPFONTS.IP 93503 . 94495) (SHOWBITMAP.IP 
-94497 . 99038) (\BITMAPSIZE.IP 99040 . 99817) (SHOWBITMAP1.IP 99819 . 104191) (SHOWSHADE.IP 104193 . 
-105146) (\BITBLT.IP 105148 . 109352) (\SCALEDBITBLT.IP 109354 . 112999) (\BLTSHADE.IP 113001 . 114459)
- (\CHARWIDTH.IP 114461 . 114911) (\CLOSEIPSTREAM 114913 . 115240) (\DRAWARC.IP 115242 . 115689) (
-\DRAWCURVE.IP 115691 . 118128) (\DRAWPOINT.IP 118130 . 119167) (\DSPCOLOR.IP 119169 . 120120) (
-ENSURE.RGB 120122 . 120786) (\IPCURVE2 120788 . 134042) (\CLIPCURVELINE.IP 134044 . 138742) (
-\DRAWLINE.IP 138744 . 142476) (\CLIPLINE 142478 . 147178) (\DSPBOTTOMMARGIN.IP 147180 . 147596) (
-\DSPFONT.IP 147598 . 151873) (\DSPLEFTMARGIN.IP 151875 . 152335) (\DSPLINEFEED.IP 152337 . 153004) (
-\DSPRIGHTMARGIN.IP 153006 . 153803) (\DSPSPACEFACTOR.IP 153805 . 154934) (\DSPTOPMARGIN.IP 154936 . 
-155372) (\DSPXPOSITION.IP 155374 . 156361) (\DSPROTATE.IP 156363 . 156541) (\PUSHSTATE.IP 156543 . 
-157435) (\POPSTATE.IP 157437 . 158072) (\DEFAULTSTATE.IP 158074 . 158426) (\DSPTRANSLATE.IP 158428 . 
-158609) (\DSPSCALE2.IP 158611 . 158786) (\DSPYPOSITION.IP 158788 . 159089) (FILLCIRCLE.IP 159091 . 
-160174) (\FILLPOLYGON.IP 160176 . 161507) (\DRAWPOLYGON.IP 161509 . 167639) (\FIXLINELENGTH.IP 167641
- . 168855) (\MOVETO.IP 168857 . 169221) (\SETBRUSH.IP 169223 . 171389) (\STRINGWIDTH.IP 171391 . 
-171794) (\DSPCLIPPINGREGION.IP 171796 . 172972) (\DSPOPERATION.IP 172974 . 173769)) (173962 174717 (
-IP-TOS 173972 . 174232) (POP-IP-STACK 174234 . 174529) (PUSH-IP-STACK 174531 . 174715)) (174778 187342
- (\CREATECHARSET.IP 174788 . 186579) (\CHANGECHARSET.IP 186581 . 187340)) (187343 190963 (
-\INTERPRESSINIT 187353 . 190961)) (190964 191522 (SCALEREGION 190974 . 191520)) (204450 206874 (
-INTERPRESSBITMAP 204460 . 206872)) (209082 214497 (\COERCEASCIITONSFONT 209092 . 212581) (
-\CREATEINTERPRESSFONT 212583 . 214156) (\SEARCHINTERPRESSFONTS 214158 . 214495)) (219512 220443 (
-\ASCIIMAPARRAY 219522 . 220441)))))
+  (FILEMAP (NIL (17251 22903 (APPENDBYTE.IP 17261 . 17397) (APPENDIDENTIFIER.IP 17399 . 17921) (
+APPENDINT.IP 17923 . 18374) (APPENDINTEGER.IP 18376 . 18948) (APPENDLARGEVECTOR.IP 18950 . 19915) (
+APPENDNUMBER.IP 19917 . 20386) (APPENDOP.IP 20388 . 21034) (APPENDRATIONAL.IP 21036 . 21529) (
+APPENDSEQUENCEDESCRIPTOR.IP 21531 . 22726) (BYTESININT.IP 22728 . 22901)) (22939 62746 (ARCTO.IP 22949
+ . 24230) (BEGINMASTER.IP 24232 . 24505) (BEGINPAGE.IP 24507 . 24863) (BEGINPREAMBLE.IP 24865 . 25236)
+ (CLIPRECTANGLE.IP 25238 . 25728) (CONCAT.IP 25730 . 25995) (CONCATT.IP 25997 . 26264) (ENDMASTER.IP 
+26266 . 26710) (ENDPAGE.IP 26712 . 27089) (ENDPREAMBLE.IP 27091 . 27890) (FGET.IP 27892 . 28195) (
+FILLRECTANGLE.IP 28197 . 30525) (FILLTRAJECTORY.IP 30527 . 31162) (FILLNGON.IP 31164 . 33441) (FSET.IP
+ 33443 . 33746) (GETFRAMEVAR.IP 33748 . 34066) (INITIALIZEMASTER.IP 34068 . 34669) (INITIALIZECOLOR.IP
+ 34671 . 35992) (ISET.IP 35994 . 36365) (GETCP.IP 36367 . 36676) (LINETO.IP 36678 . 37283) (
+MASKSTROKE.IP 37285 . 37558) (MOVETO.IP 37560 . 37897) (ROTATE.IP 37899 . 38201) (SCALE.IP 38203 . 
+38506) (SCALE2.IP 38508 . 38845) (SETCOLOR.IP 38847 . 41076) (SETRGB.IP 41078 . 42134) (SETCOLORLV.IP 
+42136 . 46749) (SETCOLOR16.IP 46751 . 49857) (SETFONT.IP 49859 . 50680) (SETSPACE.IP 50682 . 50994) (
+SETXREL.IP 50996 . 52180) (SETX.IP 52182 . 53699) (SETXY.IP 53701 . 54873) (SETXYREL.IP 54875 . 56181)
+ (SETY.IP 56183 . 57492) (SETYREL.IP 57494 . 58394) (SHOW.IP 58396 . 61656) (TRAJECTORY.IP 61658 . 
+62056) (TRANS.IP 62058 . 62397) (TRANSLATE.IP 62399 . 62744)) (62777 68867 (\CHANGE-VISIBLE-REGION.IP 
+62787 . 66448) (\PAPERSIZE.IP 66450 . 67271) (HEADINGOP.IP 67273 . 68865)) (68868 174910 (
+DEFINEFONT.IP 68878 . 69852) (FONTNAME.IP 69854 . 70784) (INTERPRESS.BITMAPSCALE 70786 . 71579) (
+INTERPRESS.OUTCHARFN 71581 . 78088) (INTERPRESSFILEP 78090 . 79424) (MAKEINTERPRESS 79426 . 79610) (
+NEWLINE.IP 79612 . 80344) (NEWPAGE.IP 80346 . 85321) (NEWPAGE?.IP 85323 . 85802) (OPENIPSTREAM 85804
+ . 94155) (SETUPFONTS.IP 94157 . 95149) (SHOWBITMAP.IP 95151 . 99692) (\BITMAPSIZE.IP 99694 . 100471) 
+(SHOWBITMAP1.IP 100473 . 104845) (SHOWSHADE.IP 104847 . 105800) (\BITBLT.IP 105802 . 110006) (
+\SCALEDBITBLT.IP 110008 . 113653) (\BLTSHADE.IP 113655 . 115113) (\CHARWIDTH.IP 115115 . 115565) (
+\CLOSEIPSTREAM 115567 . 115894) (\DRAWARC.IP 115896 . 116343) (\DRAWCURVE.IP 116345 . 118782) (
+\DRAWPOINT.IP 118784 . 119821) (\DSPCOLOR.IP 119823 . 120774) (ENSURE.RGB 120776 . 121440) (\IPCURVE2 
+121442 . 134696) (\CLIPCURVELINE.IP 134698 . 139396) (\DRAWLINE.IP 139398 . 143130) (\CLIPLINE 143132
+ . 147832) (\DSPBOTTOMMARGIN.IP 147834 . 148250) (\DSPFONT.IP 148252 . 153012) (\DSPLEFTMARGIN.IP 
+153014 . 153474) (\DSPLINEFEED.IP 153476 . 154143) (\DSPRIGHTMARGIN.IP 154145 . 154942) (
+\DSPSPACEFACTOR.IP 154944 . 156073) (\DSPTOPMARGIN.IP 156075 . 156511) (\DSPXPOSITION.IP 156513 . 
+157500) (\DSPROTATE.IP 157502 . 157680) (\PUSHSTATE.IP 157682 . 158574) (\POPSTATE.IP 158576 . 159211)
+ (\DEFAULTSTATE.IP 159213 . 159565) (\DSPTRANSLATE.IP 159567 . 159748) (\DSPSCALE2.IP 159750 . 159925)
+ (\DSPYPOSITION.IP 159927 . 160228) (FILLCIRCLE.IP 160230 . 161313) (\FILLPOLYGON.IP 161315 . 162646) 
+(\DRAWPOLYGON.IP 162648 . 168778) (\FIXLINELENGTH.IP 168780 . 169994) (\MOVETO.IP 169996 . 170360) (
+\SETBRUSH.IP 170362 . 172528) (\STRINGWIDTH.IP 172530 . 172933) (\DSPCLIPPINGREGION.IP 172935 . 174111
+) (\DSPOPERATION.IP 174113 . 174908)) (175101 175856 (IP-TOS 175111 . 175371) (POP-IP-STACK 175373 . 
+175668) (PUSH-IP-STACK 175670 . 175854)) (175917 176841 (\CHANGECHARSET.IP 175927 . 176839)) (176842 
+180458 (\INTERPRESSINIT 176852 . 180456)) (193542 195966 (INTERPRESSBITMAP 193552 . 195964)) (198390 
+201011 (\CREATEINTERPRESSFONT 198400 . 200128) (\CREATECHARSET.IP 200130 . 201009)) (201012 213185 (
+IPFONT.FILEP 201022 . 201206) (IPFONT.GETCHARSET 201208 . 211306) (\FACECODE 211308 . 211898) (
+\FAMILYCODE 211900 . 213183)))))
 STOP
diff --git a/sources/INTERPRESS.LCOM b/sources/INTERPRESS.LCOM
index cc4a8f51f..decfd60d0 100644
Binary files a/sources/INTERPRESS.LCOM and b/sources/INTERPRESS.LCOM differ
diff --git a/sources/IOCHAR b/sources/IOCHAR
index 6e50da453..ac4b8fe8e 100644
--- a/sources/IOCHAR
+++ b/sources/IOCHAR
@@ -1,15 +1,16 @@
 (DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
 
-
(FILECREATED "11-Sep-2022 20:07:43" {DSK}<home>larry>medley>sources>IOCHAR.;2
 100127 
+
(FILECREATED "24-Aug-2025 11:45:37" 
+{DSK}<Users>kaplan>Local>medley3.5>working-medley>sources>IOCHAR.;49
 100320 
 
-      :CHANGES-TO (VARS IOCHARCOMS)
+      :EDIT-BY rmk
 
-      :PREVIOUS-DATE "24-Jul-2022 14:56:20" {DSK}<home>larry>medley>sources>IOCHAR.;1)
+      :CHANGES-TO (RESOURCES \FFDELTA1)
+                  (FNS MAKEBITTABLE \SETUP.FFILEPOS)
 
+      :PREVIOUS-DATE "24-Apr-2025 22:08:18" 
+{DSK}<Users>kaplan>Local>medley3.5>working-medley>sources>IOCHAR.;48)
 
-(* ; "
-Copyright (c) 1981-1988, 1990-1991, 2018, 2020 by Venue & Xerox Corporation.
-")
 
 (PRETTYCOMPRINT IOCHARCOMS)
 
@@ -203,17 +204,18 @@ Copyright (c) 1981-1988, 1990-1991, 2018, 2020 by Venue & Xerox Corporation.
 )
 
 (MAKEBITTABLE

-  [LAMBDA (L NEG A)
                                      (* ; "Edited 29-Apr-91 23:02 by jds")

+  [LAMBDA (L NEG A)
                                          (* ; "Edited 24-Aug-2025 11:45 by rmk")


+                                                             (* ; "Edited 29-Apr-91 23:02 by jds")

     [COND
-       [(type?
 CHARTABLE A)                              (* ; "Clear it")

+       [(type?
 CHARTABLE A)                                  (* ; "Clear it")

         (\ZEROBYTES A 0 \MAXTHINCHAR)
         (if
 (fetch
 (CHARTABLE NSCHARHASH) of
 A)
             then
 (CLRHASH (fetch
 (CHARTABLE NSCHARHASH) of
 A]
        (T (SETQ A (create
 CHARTABLE]
     (for
 X in
 L do
 (\SETSYNCODE A (OR (SMALLP X)
-                                                  (CHCON1 X))
-                                      1))                    (* ; "Invert 1 and 0 if NEG")

-    [AND NEG (for
 I from
 0 to
 \MAXCHAR do
 (\SETSYNCODE A I (LOGXOR 1 (\SYNCODE A I]
+                                      (CHCON1 X))
+                          1))                                (* ; "Invert 1 and 0 if NEG")

+    [AND NEG (for
 I from
 0 to
 \MAXTHINCHAR do
 (\SETSYNCODE A I (LOGXOR 1 (\SYNCODE A I]
     A])
 )
 (DECLARE%: DONTCOPY 
@@ -258,13 +260,15 @@ DONTCOPY
 (FILEPOS

   [LAMBDA (PATTERN FILE START END SKIP TAIL CASEARRAY)
 
+    (* ;; "Edited 24-Apr-2025 22:08 by rmk")

+
     (* ;; "Edited 10-Jul-2022 16:51 by rmk")

 
     (* ;; "Edited  1-Jul-2022 11:55 by rmk")

 
     (* ;; "Edited 25-Jun-2022 22:51 by rmk: The original version was a byte-level searcher, this upgrades to character searching as determined by the external format of the stream. (It is also a bit faster than the original).")

 
-    (* ;; "This provides accurate results if the stream's external format is stable, wherein each character code has a unique byte representation.  If the stream's format is unstable (i.e. XCCS runcoding), then the result is accurate if the stream's initial charset (or other contextual information) is correct for the START byte position.")

+    (* ;; "This provides accurate results if the stream's external format is stable, wherein each character code has a unique byte representation.  If the stream's format is unstable (i.e. MCCS runcoding), then the result is accurate if the stream's initial charset (or other contextual information) is correct for the START byte position.")

 
     (* ;; "Otherwise, there may be some bad matches and some missing matches.  The slow case will be accurate in those cases (and a NIL return for the format's \FORMATBYTESTRING function will kick it into the slow case (about 10 times slower).  This always defers to the slow case if SKIP or CASEARRAY are non-NIL.")

 
@@ -382,7 +386,7 @@ DONTCOPY
 
      (* ;; "Getting the character set for the start of the match is a little trickier.  We know the character set at the byte that starts the beginning of the match (= character set of PATTERN's first character.  If we set the stream to that charset, then back up one character, that should get it right.  ")

 
-     (* ;; "This should  only be necessary for an unstable format, maybe don't bother if it isn't XCCS. There is another special case here for XCCS:  if the charset is 255 at the start (=2 byte encoding), then we assume that it didn't change, and nothing to worry about.")

+     (* ;; "This should  only be necessary for an unstable format, maybe don't bother if it isn't XCCS. There is another special case here for MCCS:  if the charset is 255 at the start (=2 byte encoding), then we assume that it didn't change, and nothing to worry about.")

 
           (RETURN (IF
 TAIL
                       THEN
 (CL:UNLESS (EQ NSCHARSETSHIFT (ffetch
 (STREAM CHARSET) of
 STREAM))
@@ -412,6 +416,8 @@ DONTCOPY
 (FFILEPOS

   [LAMBDA (PATTERN FILE START END SKIP TAIL CASEARRAY)
 
+    (* ;; "Edited 24-Apr-2025 22:07 by rmk")

+
     (* ;; "Edited 10-Jul-2022 10:17 by rmk")

 
     (* ;; "Edited  1-Jul-2022 11:55 by rmk")

@@ -420,7 +426,7 @@ DONTCOPY
 
     (* ;; "Edited 10-Aug-2020 21:44 by rmk:")

 
-    (* ;; "RMK:  Added coercion from internal XCCS string to UTF8 if searching a UTF8 file")

+    (* ;; "RMK:  Added coercion from internal MCCS string to UTF8 if searching a UTF8 file")

                                                              (* Pavel "12-Oct-86 15:20")

     (PROG ((STREAM (\GETSTREAM FILE 'INPUT))
            BYTEPATTERN BPATBASE BPATOFFSET BPATLEN ORGFILEPTR STARTBYTEPOS ENDBYTEPOS BIGENDOFFSET 
@@ -587,6 +593,8 @@ DONTCOPY
 (\SETUP.FFILEPOS

   [LAMBDA (PATBASE PATOFFSET PATLEN PATCHAR DELTA1 DELTA2)
 
+    (* ;; "Edited 24-Aug-2025 11:45 by rmk")

+
     (* ;; "Edited 24-Jun-2022 16:32 by rmk: Removing CASE argument.  That forces the \SLOWFILEPOS, because the the alternative stream matches can't be anticipated.")

                                                              (* jop%: "25-Sep-86 11:44")

 
@@ -596,7 +604,7 @@ DONTCOPY
                                  PATLEN))
            (MAXPATINDEX (SUB1 PATLEN))
            CHAR)
-          (for
 I from
 0 to
 (FOLDLO \MAXCHAR BYTESPERWORD) do
 (PUTBASE DELTA1 I PATLEN,PATLEN))
+          (for
 I from
 0 to
 (FOLDLO \MAXTHINCHAR BYTESPERWORD) do
 (PUTBASE DELTA1 I PATLEN,PATLEN))
 
      (* ;; "DELTA1 initially all PATLEN, the default for chars not in the pattern.  I assume array is word-aligned")

 
@@ -780,7 +788,7 @@ DONTCOPY
 (DECLARE%: EVAL@COMPILE DONTCOPY 
 (DECLARE%: EVAL@COMPILE 
 
-[PUTDEF '\FFDELTA1 'RESOURCES '(NEW (ARRAY (ADD1 \MAXCHAR)
+[PUTDEF '\FFDELTA1 'RESOURCES '(NEW (ARRAY (ADD1 \MAXTHINCHAR)
                                            'BYTE]
 
 [PUTDEF '\FFDELTA2 'RESOURCES '(NEW (ARRAY \MAX.PATTERN.SIZE 'BYTE]
@@ -1567,18 +1575,16 @@ DONTCOPY
 
 (ADDTOVAR LAMA
 PACK* CONCAT)
 )
-(PUTPROPS IOCHAR COPYRIGHT ("Venue & Xerox Corporation" 1981 1982 1983 1984 1985 1986 1987 1988 1990 
-1991 2018 2020))
 (DECLARE%: DONTCOPY
-  (FILEMAP (NIL (3456 7250 (CHCON 3466 . 4316) (UNPACK 4318 . 5212) (DCHCON 5214 . 6481) (DUNPACK 6483
- . 7248)) (7251 18766 (UALPHORDER 7261 . 7357) (ALPHORDER 7359 . 9162) (CONCAT 9164 . 9809) (
-CONCATCODES 9811 . 9997) (PACKC 9999 . 12602) (PACK 12604 . 13183) (PACK* 13185 . 14907) (\PACK.ITEM 
-14909 . 15364) (STRPOS 15366 . 18764)) (18768 19057 (XCL:PACK 18768 . 19057)) (19059 19309 (XCL:PACK* 
-19059 . 19309)) (20016 22407 (STRPOSL 20026 . 21652) (MAKEBITTABLE 21654 . 22405)) (22569 23046 (
-CASEARRAY 22579 . 22769) (UPPERCASEARRAY 22771 . 23044)) (23368 56745 (FILEPOS 23378 . 32619) (
-FFILEPOS 32621 . 44842) (\SETUP.FFILEPOS 44844 . 48627) (\SLOWFILEPOS 48629 . 56743)) (57533 98780 (
-DATE 57543 . 57629) (DATEFORMAT 57631 . 57723) (GDATE 57725 . 57836) (IDATE 57838 . 69509) (
-\IDATESCANTOKEN 69511 . 70790) (\IDATE-PARSE-MONTH 70792 . 74488) (\OUTDATE 74490 . 87238) (
-\OUTDATE-STRING 87240 . 87855) (\RPLRIGHT 87857 . 88095) (\UNPACKDATE 88097 . 93888) (\PACKDATE 93890
- . 97210) (\DTSCAN 97212 . 97354) (\ISDST? 97356 . 97863) (\CHECKDSTCHANGE 97865 . 98778)))))
+  (FILEMAP (NIL (3501 7295 (CHCON 3511 . 4361) (UNPACK 4363 . 5257) (DCHCON 5259 . 6526) (DUNPACK 6528
+ . 7293)) (7296 18811 (UALPHORDER 7306 . 7402) (ALPHORDER 7404 . 9207) (CONCAT 9209 . 9854) (
+CONCATCODES 9856 . 10042) (PACKC 10044 . 12647) (PACK 12649 . 13228) (PACK* 13230 . 14952) (\PACK.ITEM
+ 14954 . 15409) (STRPOS 15411 . 18809)) (18813 19102 (XCL:PACK 18813 . 19102)) (19104 19354 (XCL:PACK*
+ 19104 . 19354)) (20061 22561 (STRPOSL 20071 . 21697) (MAKEBITTABLE 21699 . 22559)) (22723 23200 (
+CASEARRAY 22733 . 22923) (UPPERCASEARRAY 22925 . 23198)) (23522 57053 (FILEPOS 23532 . 32823) (
+FFILEPOS 32825 . 45096) (\SETUP.FFILEPOS 45098 . 48935) (\SLOWFILEPOS 48937 . 57051)) (57845 99092 (
+DATE 57855 . 57941) (DATEFORMAT 57943 . 58035) (GDATE 58037 . 58148) (IDATE 58150 . 69821) (
+\IDATESCANTOKEN 69823 . 71102) (\IDATE-PARSE-MONTH 71104 . 74800) (\OUTDATE 74802 . 87550) (
+\OUTDATE-STRING 87552 . 88167) (\RPLRIGHT 88169 . 88407) (\UNPACKDATE 88409 . 94200) (\PACKDATE 94202
+ . 97522) (\DTSCAN 97524 . 97666) (\ISDST? 97668 . 98175) (\CHECKDSTCHANGE 98177 . 99090)))))
 STOP
diff --git a/sources/IOCHAR.LCOM b/sources/IOCHAR.LCOM
index 15b9981d7..ec92917b1 100644
Binary files a/sources/IOCHAR.LCOM and b/sources/IOCHAR.LCOM differ
diff --git a/sources/LLCHAR b/sources/LLCHAR
index eb9904a44..5959ed8d6 100644
--- a/sources/LLCHAR
+++ b/sources/LLCHAR
@@ -1,16 +1,15 @@
 (DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
 
-
(FILECREATED "28-Apr-2022 08:52:36" {DSK}<Users>kaplan>Local>medley3.5>my-medley>sources>LLCHAR.;13
 104756 
+
(FILECREATED "24-Aug-2025 11:50:57" 
+{DSK}<Users>kaplan>Local>medley3.5>working-medley>sources>LLCHAR.;14
 104478 
 
-      :CHANGES-TO (I.S.OPRS inpname)
+      :EDIT-BY rmk
 
-      :PREVIOUS-DATE "23-Apr-2022 17:19:02" 
-{DSK}<Users>kaplan>Local>medley3.5>my-medley>sources>LLCHAR.;12)
+      :CHANGES-TO (VARS LLCHARCOMS)
 
+      :PREVIOUS-DATE "28-Apr-2022 08:52:36" 
+{DSK}<Users>kaplan>Local>medley3.5>working-medley>sources>LLCHAR.;13)
 
-(* ; "
-Copyright (c) 1982-1988, 1990, 1994, 2018, 2021 by Venue & Xerox Corporation.
-")
 
 (PRETTYCOMPRINT LLCHARCOMS)
 
@@ -44,7 +43,6 @@ Copyright (c) 1982-1988, 1990, 1994, 2018, 2021 by Venue & Xerox Corporation.
                                    (MACROS \PUTBASECHAR \GETBASECHAR)
                                    (MACROS \CHARSET \CHAR8CODE)
                                    (CONSTANTS (\CHARMASK 255)
-                                          (\MAXCHAR 255)
                                           (\MAXTHINCHAR 255)
                                           (\MAXFATCHAR 65535)
                                           (\MAXCHARSET 255)
@@ -1728,8 +1726,6 @@ Copyright (c) 1982-1988, 1990, 1994, 2018, 2021 by Venue & Xerox Corporation.
 
 (RPAQQ \CHARMASK
 255)
 
-(RPAQQ \MAXCHAR
 255)
-
 (RPAQQ \MAXTHINCHAR
 255)
 
 (RPAQQ \MAXFATCHAR
 65535)
@@ -1740,7 +1736,6 @@ Copyright (c) 1982-1988, 1990, 1994, 2018, 2021 by Venue & Xerox Corporation.
 
 
 (CONSTANTS (\CHARMASK 255)
-       (\MAXCHAR 255)
        (\MAXTHINCHAR 255)
        (\MAXFATCHAR 65535)
        (\MAXCHARSET 255)
@@ -1848,19 +1843,17 @@ Copyright (c) 1982-1988, 1990, 1994, 2018, 2021 by Venue & Xerox Corporation.
 
 
 (PUTPROPS LLCHAR
 FILETYPE
 :FAKE-COMPILE-FILE)
-(PUTPROPS LLCHAR COPYRIGHT ("Venue & Xerox Corporation" 1982 1983 1984 1985 1986 1987 1988 1990 1994 
-2018 2021))
 (DECLARE%: DONTCOPY
-  (FILEMAP (NIL (4224 74410 (ALLOCSTRING 4234 . 6257) (MKATOM 6259 . 6894) (SUBATOM 6896 . 8766) (
-CHARACTER 8768 . 9772) (\PARSE.NUMBER 9774 . 25494) (\INVALID.DOTTED.SYMBOL 25496 . 25991) (
-\INVALID.INTEGER 25993 . 27445) (\MKINTEGER 27447 . 30154) (MKSTRING 30156 . 32299) (
-\PRINDATUM.TO.STRING 32301 . 38479) (BKSYSBUF 38481 . 40015) (NCHARS 40017 . 41717) (NTHCHARCODE 41719
- . 43765) (RPLCHARCODE 43767 . 44828) (\RPLCHARCODE 44830 . 46365) (NTHCHAR 46367 . 46560) (RPLSTRING 
-46562 . 49773) (SUBSTRING 49775 . 52698) (GNC 52700 . 52873) (GNCCODE 52875 . 53643) (GLC 53645 . 
-53818) (GLCCODE 53820 . 54585) (STREQUAL 54587 . 56701) (STRING.EQUAL 56703 . 61041) (STRINGP 61043 . 
-61194) (CHCON1 61196 . 61983) (U-CASE 61985 . 65212) (L-CASE 65214 . 69074) (U-CASEP 69076 . 69650) (
-\SMASHABLESTRING 69652 . 70114) (\MAKEWRITABLESTRING 70116 . 70552) (\SMASHSTRING 70554 . 74260) (
-\FATTENSTRING 74262 . 74408)) (74595 79757 (\GETBASESTRING 74605 . 75259) (\PUTBASESTRING 75261 . 
-78000) (\PUTBASESTRINGFAT 78002 . 78748) (GetBcplString 78750 . 79415) (SetBcplString 79417 . 79755)) 
-(101142 103956 (%%COPY-ONED-ARRAY 101152 . 103002) (%%COPY-STRING-TO-ARRAY 103004 . 103954)))))
+  (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)))))
 STOP
diff --git a/sources/LLCHAR.LCOM b/sources/LLCHAR.LCOM
index 386e40045..8fd7f2637 100644
Binary files a/sources/LLCHAR.LCOM and b/sources/LLCHAR.LCOM differ
diff --git a/sources/LLDATATYPE b/sources/LLDATATYPE
index 8da265882..3f6faba2f 100644
--- a/sources/LLDATATYPE
+++ b/sources/LLDATATYPE
@@ -1,19 +1,14 @@
 (DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
 
-
(FILECREATED "17-Apr-2023 08:04:06" {DSK}<home>larry>il>medley>sources>LLDATATYPE.;2
 94197  
+
(FILECREATED " 5-Aug-2025 09:18:50" {WMEDLEY}<sources>LLDATATYPE.;3
 93956  
 
-      :EDIT-BY "lmm"
+      :EDIT-BY rmk
 
-      :CHANGES-TO (VARS LLDATATYPECOMS)
-                  (FNS \SET.STORAGE.STATE \MAPMDS)
+      :CHANGES-TO (FNS \DTEST.UFN)
 
-      :PREVIOUS-DATE "28-Jun-99 16:57:50" {DSK}<home>larry>il>medley>sources>LLDATATYPE.;1)
+      :PREVIOUS-DATE "17-Apr-2023 08:04:06" {WMEDLEY}<sources>LLDATATYPE.;2)
 
 
-(* ; "
-Copyright (c) 1982-1995, 1999 by VENUE, Oakland, CA.
-")
-
 (PRETTYCOMPRINT LLDATATYPECOMS)
 
 (RPAQQ LLDATATYPECOMS

@@ -800,7 +795,8 @@ Copyright (c) 1982-1995, 1999 by VENUE, Oakland, CA.
     (\DTEST.UFN
 OBJ TYPE])
 
 (\DTEST.UFN

-  [LAMBDA (OBJ TYPEN)
                                    (* gbn " 3-Oct-86 10:49")

+  [LAMBDA (OBJ TYPEN)
                                        (* ; "Edited  5-Aug-2025 09:18 by rmk")

+                                                             (* gbn " 3-Oct-86 10:49")

 
     (* ;; "ufn for DTEST opcode  ")

 
@@ -809,15 +805,14 @@ Copyright (c) 1982-1995, 1999 by VENUE, Oakland, CA.
     (PROG ((N (NTYPX
 OBJ)))
       LP  (COND
              ((EQ (fetch
 DTDNAME of
 (\GETDTD N))
-                  TYPEN)                                     (* ; 
-
                                                           "should be happening in microcode")

+                  TYPEN)                                     (* ; "should be happening in microcode")

               (RETURN OBJ))
              ([NEQ 0 (SETQ N (fetch
 DTDSUPERTYPE of
 (\GETDTD N]
               (GO LP))
              (T (RETURN (SELECTQ (\INDEXATOMPNAME TYPEN)
                             (FLOATP (\FLOAT OBJ))
                             (STREAM                          (* ; 
-
                          "Should be able to get at the INPUT/OUTPUT flg--a second arg to \DTEST ?")

+
                            "Should be able to get at the INPUT/OUTPUT flg--a second arg to \DTEST ?")

                                     (\GETSTREAM OBJ (SELECTQ (STKNTHNAME -1 '\DTEST.UFN)
                                                         ((\BINS \BIN BIN) 
                                                              'INPUT)
@@ -836,7 +831,7 @@ Copyright (c) 1982-1995, 1999 by VENUE, Oakland, CA.
                                          (CAR OBJ))
                                         (T (LISPERROR "ARG NOT HARRAY" OBJ T))))
                             (FONTDESCRIPTOR 
-                                 (\COERCEFONTDESC OBJ))
+                                 (FONTCREATE OBJ))
                             (SMALLP [PROG (HI LO)
                                           (.UNBOX. OBJ HI LO)
                                           (RETURN (OR (SMALLP (\MAKENUMBER HI LO))
@@ -848,7 +843,7 @@ Copyright (c) 1982-1995, 1999 by VENUE, Oakland, CA.
                             (TERMTABLEP (LISPERROR "ILLEGAL TERMINAL TABLE" OBJ T))
                             (ARRAYP (LISPERROR "ARG NOT ARRAY" OBJ T))
                             (\DISPLAYDATA                    (* ; 
-
                                    "Should be able to get at the stream--a second arg to \DTEST ?")

+
                                      "Should be able to get at the stream--a second arg to \DTEST ?")

                                           (ERROR "ARG NOT DISPLAY STREAM" NIL))
                             (\LISPERROR OBJ (CONCAT "ARG NOT " (\INDEXATOMPNAME TYPEN))
                                    T])
@@ -1744,25 +1739,23 @@ EVAL@COMPILE
 (FILESLOAD (LOADCOMP)
        DTDECLARE)
 )
-(PUTPROPS LLDATATYPE COPYRIGHT ("VENUE, Oakland, CA" 1982 1983 1984 1985 1986 1987 1988 1989 1990 1991
- 1992 1993 1994 1995 1999))
 (DECLARE%: DONTCOPY
-  (FILEMAP (NIL (6524 37135 (NTYPX 6534 . 7011) (\TYPEMASK.UFN 7013 . 7537) (\TYPEP.UFN 7539 . 7708) (
-\ALLOCMDSPAGE 7710 . 9112) (\ALLOCPAGEBLOCK 9114 . 9820) (\ALLOCVIRTUALPAGEBLOCK 9822 . 12437) (
-\MAPMDS 12439 . 13626) (\CHECKFORSTORAGEFULL 13628 . 18774) (\DOSTORAGEFULLINTERRUPT 18776 . 19070) (
-\SET.STORAGE.STATE 19072 . 19484) (\SETTYPEMASK 19486 . 20433) (\ADVANCE.STORAGE.STATE 20435 . 20943) 
-(\NEW2PAGE 20945 . 21131) (\MAKEMDSENTRY 21133 . 21579) (\INITMDSPAGE 21581 . 23373) (\ASSIGNDATATYPE1
- 23375 . 33003) (\RESOLVE.TYPENUMBER 33005 . 33470) (\TYPENUMBERFROMNAME 33472 . 34012) (CREATECELL 
-34014 . 34147) (\CREATECELL 34149 . 37133)) (37627 59689 (FETCHFIELD 37637 . 40828) (REPLACEFIELD 
-40830 . 46456) (BOXCOUNT 46458 . 46959) (CONSCOUNT 46961 . 47095) (\DTEST 47097 . 47230) (\TYPECHECK 
-47232 . 47369) (\DTEST.UFN 47371 . 50626) (\INSTANCEP.UFN 50628 . 51856) (\INSTANCE-P 51858 . 52121) (
-\TYPECHECK.UFN 52123 . 52686) (GETDESCRIPTORS 52688 . 53206) (GETSUPERTYPE 53208 . 53722) (
-GETFIELDSPECS 53724 . 54361) (NCREATE 54363 . 54535) (NCREATE2 54537 . 55252) (REPLACEFIELDVAL 55254
- . 55518) (PUTBASEPTRX 55520 . 55999) (/REPLACEFIELD 56001 . 56266) (TYPENAME 56268 . 57110) (
-TYPENAMEP 57112 . 57336) (\TYPENAMEFROMNUMBER 57338 . 57568) (\BLOCKDATAP 57570 . 57890) (
-USERDATATYPES 57892 . 58024) (DATATYPEP 58026 . 59175) (DATATYPES 59177 . 59687)) (61931 77082 (
-STORAGE 61941 . 66362) (STORAGE.LEFT 66364 . 69905) (\STORAGE.TYPE 69907 . 73967) (\STLINP 73969 . 
-74155) (\STMDSTYPE 74157 . 75356) (\STMDS.APPROX 75358 . 75626) (\STORAGE.HUNKTYPE 75628 . 77080)) (
-83752 92451 (CREATEMDSTYPETABLE 83762 . 85551) (INITDATATYPES 85553 . 90398) (INITDATATYPENAMES 90400
- . 92449)))))
+  (FILEMAP (NIL (6370 36981 (NTYPX 6380 . 6857) (\TYPEMASK.UFN 6859 . 7383) (\TYPEP.UFN 7385 . 7554) (
+\ALLOCMDSPAGE 7556 . 8958) (\ALLOCPAGEBLOCK 8960 . 9666) (\ALLOCVIRTUALPAGEBLOCK 9668 . 12283) (
+\MAPMDS 12285 . 13472) (\CHECKFORSTORAGEFULL 13474 . 18620) (\DOSTORAGEFULLINTERRUPT 18622 . 18916) (
+\SET.STORAGE.STATE 18918 . 19330) (\SETTYPEMASK 19332 . 20279) (\ADVANCE.STORAGE.STATE 20281 . 20789) 
+(\NEW2PAGE 20791 . 20977) (\MAKEMDSENTRY 20979 . 21425) (\INITMDSPAGE 21427 . 23219) (\ASSIGNDATATYPE1
+ 23221 . 32849) (\RESOLVE.TYPENUMBER 32851 . 33316) (\TYPENUMBERFROMNAME 33318 . 33858) (CREATECELL 
+33860 . 33993) (\CREATECELL 33995 . 36979)) (37473 59579 (FETCHFIELD 37483 . 40674) (REPLACEFIELD 
+40676 . 46302) (BOXCOUNT 46304 . 46805) (CONSCOUNT 46807 . 46941) (\DTEST 46943 . 47076) (\TYPECHECK 
+47078 . 47215) (\DTEST.UFN 47217 . 50516) (\INSTANCEP.UFN 50518 . 51746) (\INSTANCE-P 51748 . 52011) (
+\TYPECHECK.UFN 52013 . 52576) (GETDESCRIPTORS 52578 . 53096) (GETSUPERTYPE 53098 . 53612) (
+GETFIELDSPECS 53614 . 54251) (NCREATE 54253 . 54425) (NCREATE2 54427 . 55142) (REPLACEFIELDVAL 55144
+ . 55408) (PUTBASEPTRX 55410 . 55889) (/REPLACEFIELD 55891 . 56156) (TYPENAME 56158 . 57000) (
+TYPENAMEP 57002 . 57226) (\TYPENAMEFROMNUMBER 57228 . 57458) (\BLOCKDATAP 57460 . 57780) (
+USERDATATYPES 57782 . 57914) (DATATYPEP 57916 . 59065) (DATATYPES 59067 . 59577)) (61821 76972 (
+STORAGE 61831 . 66252) (STORAGE.LEFT 66254 . 69795) (\STORAGE.TYPE 69797 . 73857) (\STLINP 73859 . 
+74045) (\STMDSTYPE 74047 . 75246) (\STMDS.APPROX 75248 . 75516) (\STORAGE.HUNKTYPE 75518 . 76970)) (
+83642 92341 (CREATEMDSTYPETABLE 83652 . 85441) (INITDATATYPES 85443 . 90288) (INITDATATYPENAMES 90290
+ . 92339)))))
 STOP
diff --git a/sources/LLDATATYPE.LCOM b/sources/LLDATATYPE.LCOM
index 7ad9d0a9e..3150d7685 100644
Binary files a/sources/LLDATATYPE.LCOM and b/sources/LLDATATYPE.LCOM differ
diff --git a/sources/LLDISPLAY b/sources/LLDISPLAY
index 30a34c5b9..6cafa80cb 100644
--- a/sources/LLDISPLAY
+++ b/sources/LLDISPLAY
@@ -1,14 +1,14 @@
 (DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
 
-
(FILECREATED "27-Jul-2025 20:25:24" 
-{DSK}<Users>kaplan>Local>medley3.5>working-medley>sources>LLDISPLAY.;25
 272767 
+
(FILECREATED " 2-Sep-2025 22:54:03" 
+{DSK}<Users>kaplan>Local>medley3.5>working-medley>sources>LLDISPLAY.;50
 272104 
 
       :EDIT-BY rmk
 
-      :CHANGES-TO (VARS LLDISPLAYCOMS)
+      :CHANGES-TO (FNS \SLOWBLTCHAR)
 
-      :PREVIOUS-DATE "14-Jul-2025 22:06:59" 
-{DSK}<Users>kaplan>Local>medley3.5>working-medley>sources>LLDISPLAY.;23)
+      :PREVIOUS-DATE " 2-Sep-2025 22:41:14" 
+{DSK}<Users>kaplan>Local>medley3.5>working-medley>sources>LLDISPLAY.;49)
 
 
 (PRETTYCOMPRINT LLDISPLAYCOMS)
@@ -1141,46 +1141,38 @@
                       T])
 
 (\CHANGECHARSET.DISPLAY

-  [LAMBDA (DISPLAYDATA CHARSET)
                          (* gbn "13-Sep-85 11:47")

+  [LAMBDA (DISPLAYDATA CHARSET)
                              (* ; "Edited  2-Sep-2025 22:40 by rmk")

+                                                             (* gbn "13-Sep-85 11:47")

 
     (* ;; 
-
"Called when the character set information cached in a display stream doesn't correspond to CHARSET")

+
 "Called when the character set information cached in a display stream doesn't correspond to CHARSET")

 
-    (PROG [BM (PBT (ffetch
 DDPILOTBBT of
 DISPLAYDATA))
-              (CSINFO (\GETCHARSETINFO CHARSET (ffetch
 DDFONT of
 DISPLAYDATA]
+    (PROG (BM (PBT (ffetch
 DDPILOTBBT of
 DISPLAYDATA))
+              (CSINFO (\INSURECHARSETINFO (ffetch
 DDFONT of
 DISPLAYDATA)
+                             CHARSET)))
 
-     (* ;; "Since we called \GETCHARSETINFO without the NOSLUG?  flag, we presume we will get back a CSINFO , even if it is a slug csinfo")

+     (* ;; "Since we will get back a CSINFO , even if it is a slug csinfo")

 
           (UNINTERRUPTABLY
-              (freplace
 DDWIDTHSCACHE of
 DISPLAYDATA with
 (ffetch
 (CHARSETINFO WIDTHS
-                                                                                         )
-                                                                         of
 CSINFO))
-              (freplace
 DDOFFSETSCACHE of
 DISPLAYDATA with
 (ffetch
 (CHARSETINFO
-                                                                                    OFFSETS)
-                                                                          of
 CSINFO))
-              (freplace
 DDCHARIMAGEWIDTHS of
 DISPLAYDATA with
 (ffetch
 (CHARSETINFO
-                                                                                       IMAGEWIDTHS)
-                                                                             of
 CSINFO))
+              (freplace
 DDWIDTHSCACHE of
 DISPLAYDATA with
 (ffetch
 (CHARSETINFO WIDTHS) of
 CSINFO))
+              (freplace
 DDOFFSETSCACHE of
 DISPLAYDATA with
 (ffetch
 (CHARSETINFO OFFSETS) of
 CSINFO))
+              (freplace
 DDCHARIMAGEWIDTHS of
 DISPLAYDATA with
 (ffetch
 (CHARSETINFO IMAGEWIDTHS)
+                                                                 of
 CSINFO))
               (freplace
 DDCHARSET of
 DISPLAYDATA with
 CHARSET)
               (SETQ BM (ffetch
 CHARSETBITMAP of
 CSINFO))
-              (freplace
 PBTSOURCEBPL of
 PBT with
 (UNFOLD (ffetch
 BITMAPRASTERWIDTH
-                                                                        of
 BM)
-                                                                    BITSPERWORD))
+              (freplace
 PBTSOURCEBPL of
 PBT with
 (UNFOLD (ffetch
 BITMAPRASTERWIDTH of
 BM)
+                                                        BITSPERWORD))
               [COND
                  ((OR (NEQ (ffetch
 DDCHARSETASCENT of
 DISPLAYDATA)
                            (ffetch
 CHARSETASCENT of
 CSINFO))
                       (NEQ (ffetch
 DDCHARSETDESCENT of
 DISPLAYDATA)
                            (ffetch
 CHARSETDESCENT of
 CSINFO)))
                   (\SFFixY
 DISPLAYDATA CSINFO))
-                 (T (freplace
 PBTSOURCE of
 PBT with
 (\ADDBASE (ffetch
 BITMAPBASE
-                                                                             of
 BM)
-                                                                       (ITIMES (ffetch
 
-                                                                                    BITMAPRASTERWIDTH
-                                                                                  of
 BM)
-                                                                              (ffetch
 
-                                                                                    DDCHARHEIGHTDELTA
-                                                                                 of
 DISPLAYDATA])
-     ])
+                 (T (freplace
 PBTSOURCE of
 PBT with
 (\ADDBASE (ffetch
 BITMAPBASE of
 BM)
+                                                           (ITIMES (ffetch
 BITMAPRASTERWIDTH
+                                                                      of
 BM)
+                                                                  (ffetch
 DDCHARHEIGHTDELTA
+                                                                     of
 DISPLAYDATA])])
 
 (\INDICATESTRING

   [LAMBDA (CHARCODE)
                                     (* jds " 3-Oct-85 16:50")

@@ -1208,16 +1200,16 @@
                  (CHARACTER CHARCODE])
 
 (\SLOWBLTCHAR

-  [LAMBDA (CHARCODE DISPLAYSTREAM)
                     (* ; "Edited  8-Nov-89 15:19 by gadener")

+  [LAMBDA (CHARCODE DISPLAYSTREAM)
                           (* ; "Edited  2-Sep-2025 22:52 by rmk")


+                                                           (* ; "Edited  8-Nov-89 15:19 by gadener")

 
     (* ;; "case of BLTCHAR where either font is rotated or destination is a color bitmap.  DISPLAYSTREAM is known to be a display stream, and its cache fields have been updated for CHARCODE's charset")

 
     (PROG (ROTATION CHAR8CODE DD)
           (SETQ CHAR8CODE (\CHAR8CODE CHARCODE))
           (SETQ DD (ffetch
 (STREAM IMAGEDATA) of
 DISPLAYSTREAM))
-          (SETQ ROTATION (ffetch
 (FONTDESCRIPTOR ROTATION) of
 (ffetch
 (\DISPLAYDATA
-                                                                                   DDFONT)
-                                                                         of
 DD)))
+          (SETQ ROTATION (ffetch
 (FONTDESCRIPTOR ROTATION) of
 (ffetch
 (\DISPLAYDATA DDFONT)
+                                                                 of
 DD)))
           (COND
              [(EQ 0 ROTATION)
               (PROG (NEWX LEFT RIGHT CURX PILOTBBT DESTBIT WIDTH SOURCEBIT)
@@ -1247,11 +1239,9 @@
                         (SETQ SOURCEBIT (IDIFFERENCE (IPLUS (\DSPGETCHAROFFSET CHAR8CODE DD)
                                                             LEFT)
                                                CURX))
-                        (SELECTQ (ffetch
 (BITMAP BITMAPBITSPERPIXEL) of
 (ffetch

-                                                                                 (\DISPLAYDATA 
-                                                                                        DDDestination
-                                                                                        )
-                                                                                   of
 DD))
+                        (SELECTQ (ffetch
 (BITMAP BITMAPBITSPERPIXEL) of
 (ffetch
 (\DISPLAYDATA 
+                                                                                       DDDestination)
+                                                                           of
 DD))
                             (1)
                             (4 (SETQ DESTBIT (LLSH DESTBIT 2))
                                (SETQ WIDTH (LLSH WIDTH 2))
@@ -1263,33 +1253,29 @@
                                 (SETQ WIDTH (ITIMES 24 WIDTH))
                                 (SETQ SOURCEBIT (ITIMES 24 SOURCEBIT)))
                             (SHOULDNT))
-                        (.WHILE.TOP.DS. DISPLAYSTREAM (freplace
 (PILOTBBT PBTDESTBIT)
-                                                         of
 PILOTBBT with
 DESTBIT)
+                        (.WHILE.TOP.DS. DISPLAYSTREAM (freplace
 (PILOTBBT PBTDESTBIT) of
 PILOTBBT
+                                                         with
 DESTBIT)
                                (freplace
 (PILOTBBT PBTWIDTH) of
 PILOTBBT with
 WIDTH)
-                               (freplace
 (PILOTBBT PBTSOURCEBIT) of
 PILOTBBT with
 
-                                                                                           SOURCEBIT)
+                               (freplace
 (PILOTBBT PBTSOURCEBIT) of
 PILOTBBT with
 SOURCEBIT)
                                (\PILOTBITBLT PILOTBBT 0))
                         T]
              (T                                              (* ; "handle rotated fonts")

                 (PROG (YPOS HEIGHTMOVED CSINFO)
                       (SETQ YPOS (ffetch
 (\DISPLAYDATA DDYPOSITION) of
 DD))
                       (SETQ HEIGHTMOVED (\DSPGETCHARWIDTH CHAR8CODE DD))
-                      (SETQ CSINFO (\GETCHARSETINFO (\CHARSET CHARCODE)
-                                          (ffetch
 (\DISPLAYDATA DDFONT) of
 DD)))
+                      (SETQ CSINFO (\INSURECHARSETINFO (ffetch
 (\DISPLAYDATA DDFONT) of
 DD)
+                                          (\CHARSET CHARCODE)))
                       (COND
-                         ((EQ ROTATION 90)                   (* ; 
-
                                                           "don't force CR for rotated fonts.")

+                         ((EQ ROTATION 90)                   (* ; "don't force CR for rotated fonts.")

                           (\DSPYPOSITION.DISPLAY
 DISPLAYSTREAM (IPLUS YPOS HEIGHTMOVED))
                                                              (* ; 
-
                                                           "update the display stream x position.")

+
                                                             "update the display stream x position.")

                           (BITBLT
 (ffetch
 (CHARSETINFO CHARSETBITMAP) of
 CSINFO)
                                  0
                                  (\DSPGETCHAROFFSET CHAR8CODE DD)
                                  DISPLAYSTREAM
-                                 (ADD1 (IDIFFERENCE (ffetch
 (\DISPLAYDATA DDXPOSITION)
-                                                       of
 DD)
-                                              (ffetch
 (CHARSETINFO CHARSETASCENT) of
 CSINFO))
-                                       )
+                                 (ADD1 (IDIFFERENCE (ffetch
 (\DISPLAYDATA DDXPOSITION) of
 DD)
+                                              (ffetch
 (CHARSETINFO CHARSETASCENT) of
 CSINFO)))
                                  YPOS
                                  (IPLUS (ffetch
 (CHARSETINFO CHARSETASCENT) of
 CSINFO)
                                         (ffetch
 (CHARSETINFO CHARSETDESCENT) of
 CSINFO))
@@ -4593,17 +4579,25 @@
 (DEFINEQ
 
 (INITIALIZEDISPLAYSTREAMS

-  [LAMBDA NIL
                                                (* ; "Edited  6-Jul-2025 12:57 by rmk")

+  [LAMBDA NIL
                                                (* ; "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))
     (SETQ \SYSPILOTBBT (create
 PILOTBBT))                    (* ; "For BITBLT")

     (SETQ \SYSBBTEXTURE (BITMAPCREATE
 16 16))                (* ; 
 
                                                             "For texture handling in \BITBLTSUB")

-                                                             (* ; 
-
    "A guaranteed display font is initialized here after pup, font, and bitmap code has been loaded.")

-    (SETQ \GUARANTEEDDISPLAYFONT (FONTCREATE 'GACHA 10 '(MEDIUM REGULAR REGULAR)
-                                        NIL
-                                        'DISPLAY))
+
+    (* ;; "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]
+
+    (* ;; 
+
  "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 
@@ -4628,44 +4622,44 @@
 (ADDTOVAR LAMA
 )
 )
 (DECLARE%: DONTCOPY
-  (FILEMAP (NIL (20615 23283 (\FBITMAPBIT 20625 . 21085) (\FBITMAPBIT.UFN 21087 . 22106) (
-\NEWPAGE.DISPLAY 22108 . 22243) (INITBITMASKS 22245 . 23281)) (25208 25717 (\CreateCursorBitMap 25218
- . 25715)) (25834 86764 (BITBLT 25844 . 36234) (BLTSHADE 36236 . 37014) (\BITBLTSUB 37016 . 47151) (
-\GETPILOTBBTSCRATCHBM 47153 . 47768) (BITMAPCOPY 47770 . 48346) (BITMAPCREATE 48348 . 49908) (
-BITMAPBIT 49910 . 58297) (BITMAPEQUAL 58299 . 59761) (BLTCHAR 59763 . 60379) (\BLTCHAR 60381 . 60883) 
-(\MEDW.BLTCHAR 60885 . 65763) (\CHANGECHARSET.DISPLAY 65765 . 68723) (\INDICATESTRING 68725 . 69921) (
-\SLOWBLTCHAR 69923 . 77019) (TEXTUREP 77021 . 77291) (INVERT.TEXTURE 77293 . 77567) (
-INVERT.TEXTURE.BITMAP 77569 . 79104) (BITMAPWIDTH 79106 . 79478) (BITMAPHEIGHT 79480 . 79856) (
-READBITMAP 79858 . 82368) (\INSUREBITSPERPIXEL 82370 . 82665) (MAXIMUMCOLOR 82667 . 82808) (
-OPPOSITECOLOR 82810 . 82989) (MAXIMUMSHADE 82991 . 83202) (OPPOSITESHADE 83204 . 83383) (\MEDW.BITBLT 
-83385 . 86762)) (86765 88194 (\READBINARYBITMAP 86775 . 87413) (\PRINTBINARYBITMAP 87415 . 88192)) (
-88196 93382 (FINISH-READING-BITMAP 88196 . 93382)) (94504 94985 (BITMAPBIT.EXPANDER 94514 . 94983)) (
-94986 143520 (\BITBLT.DISPLAY 94996 . 118235) (\BITBLT.BITMAP 118237 . 127336) (\BITBLT.MERGE 127338
- . 129591) (\BLTSHADE.DISPLAY 129593 . 136693) (\BLTSHADE.BITMAP 136695 . 143518)) (143521 152841 (
-\BITBLT.BITMAP.SLOW 143531 . 152839)) (152842 169223 (\PUNT.BLTSHADE.BITMAP 152852 . 159948) (
-\PUNT.BITBLT.BITMAP 159950 . 169221)) (169224 172664 (\SCALEDBITBLT.DISPLAY 169234 . 170867) (
-\BACKCOLOR.DISPLAY 170869 . 172662)) (176519 178792 (DISPLAYSTREAMP 176529 . 177137) (DSPSOURCETYPE 
-177139 . 178148) (DSPXOFFSET 178150 . 178469) (DSPYOFFSET 178471 . 178790)) (178793 192988 (
-DSPDESTINATION 178803 . 181906) (DSPTEXTURE 181908 . 182070) (\DISPLAYSTREAMINCRXPOSITION 182072 . 
-182359) (\SFFixDestination 182361 . 183539) (\SFFixClippingRegion 183541 . 185713) (\SFFixFont 185715
- . 186765) (\SFFIXLINELENGTH 186767 . 188263) (\UPDATE-SYNONYM-STREAM-LINELENGTH-FIELD 188265 . 190078
-) (\SFFixY 190080 . 192986)) (192989 196836 (\SIMPLE.DSPCREATE 192999 . 193549) (\COMMON.DSPCREATE 
-193551 . 196834)) (196937 199131 (\MEDW.XOFFSET 196947 . 198088) (\MEDW.YOFFSET 198090 . 199129)) (
-199132 207062 (\DSPCLIPPINGREGION.DISPLAY 199142 . 199888) (\DSPFONT.DISPLAY 199890 . 202264) (
-\DISPLAY.PILOTBITBLT 202266 . 202415) (\DSPLINEFEED.DISPLAY 202417 . 202988) (\DSPLEFTMARGIN.DISPLAY 
-202990 . 203721) (\DSPOPERATION.DISPLAY 203723 . 204747) (\DSPRIGHTMARGIN.DISPLAY 204749 . 205594) (
-\DSPXPOSITION.DISPLAY 205596 . 206453) (\DSPYPOSITION.DISPLAY 206455 . 207060)) (211250 216286 (
-TTYDISPLAYSTREAM 211260 . 216284)) (216589 217619 (DSPSCROLL 216599 . 217299) (PAGEHEIGHT 217301 . 
-217617)) (217664 220686 (\DSPRESET.DISPLAY 217674 . 220684)) (220722 221245 (\MAYBE-DRIBBLE-CHAR 
-220722 . 221245)) (221246 241884 (\DSPPRINTCHAR 221256 . 229094) (\DSPPRINTCR/LF 229096 . 241882)) (
-241885 242477 (\TTYBACKGROUND 241895 . 242475)) (242478 245765 (DSPBACKUP 242488 . 245763)) (245949 
-246205 (COLORDISPLAYP 245959 . 246203)) (246206 248277 (DISPLAYBEFOREEXIT 246216 . 247042) (
-DISPLAYAFTERENTRY 247044 . 248275)) (248649 253181 (\DSPCLIPTRANSFORMX 248659 . 249248) (
-\DSPCLIPTRANSFORMY 249250 . 249975) (\DSPTRANSFORMREGION 249977 . 250509) (\DSPUNTRANSFORMY 250511 . 
-250771) (\DSPUNTRANSFORMX 250773 . 251033) (\OFFSETCLIPPINGREGION 251035 . 253179)) (254495 257082 (
-UPDATESCREENDIMENSIONS 254505 . 255134) (\CreateScreenBitMap 255136 . 257080)) (257641 270800 (
-\CoerceToDisplayDevice 257651 . 258064) (\CREATEDISPLAY 258066 . 259906) (DISPLAYSTREAMINIT 259908 . 
-263052) (\STARTDISPLAY 263054 . 265965) (\MOVE.WINDOWS.ONTO.SCREEN 265967 . 268159) (
-\UPDATE.PBT.RASTERWIDTHS 268161 . 269943) (\STOPDISPLAY 269945 . 270437) (\DEFINEDISPLAYINFO 270439 . 
-270798)) (271408 272392 (INITIALIZEDISPLAYSTREAMS 271418 . 272390)))))
+  (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)))))
 STOP
diff --git a/sources/LLDISPLAY.LCOM b/sources/LLDISPLAY.LCOM
index 6a366d3ee..c1b38fe48 100644
--- a/sources/LLDISPLAY.LCOM
+++ b/sources/LLDISPLAY.LCOM
@@ -1,12 +1,12 @@
 (DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
 
-(FILECREATED "27-Jul-2025 20:25:50" ("compiled on " 
-{DSK}<Users>kaplan>Local>medley3.5>working-medley>sources>LLDISPLAY.;25) "27-Jul-2025 13:59:31" 
-"COMPILE-FILEd" in "FULL 27-Jul-2025 ..." dated "27-Jul-2025 13:59:38")
-(FILECREATED "27-Jul-2025 20:25:24" 
-{DSK}<Users>kaplan>Local>medley3.5>working-medley>sources>LLDISPLAY.;25 272767 :EDIT-BY rmk 
-:CHANGES-TO (VARS LLDISPLAYCOMS) :PREVIOUS-DATE "14-Jul-2025 22:06:59" 
-{DSK}<Users>kaplan>Local>medley3.5>working-medley>sources>LLDISPLAY.;23)
+(FILECREATED " 2-Sep-2025 22:54:03" ("compiled on " 
+{DSK}<Users>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}<Users>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}<Users>kaplan>Local>medley3.5>working-medley>sources>LLDISPLAY.;49)
 (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 +196,7 @@ BLTCHAR :D8
 (42 \DISPLAYDATA 35 STREAM 24 OUTPUT)
 ()
 \BLTCHAR :D8
-(P 0 A0169 I 2 DISPLAYDATA I 1 DISPLAYSTREAM I 0 CHARCODE) (
AghbÉ.ÉZ
@ABlH(11 \GETSTREAM)
+(P 0 A0152 I 2 DISPLAYDATA I 1 DISPLAYSTREAM I 0 CHARCODE) (
AghbÉ.ÉZ
@ABlH(11 \GETSTREAM)
 (25 IMAGEOPS 18 STREAM 5 OUTPUT)
 ()
 \MEDW.BLTCHAR :D8
@@ -209,11 +209,11 @@ BLTCHAR :D8
 (256 \EM.DISPINTERRUPT 191 \TOPWDS 175 \EM.DISPINTERRUPT 167 \EM.DISPINTERRUPT 132 PILOTBBT)
 ()
 \CHANGECHARSET.DISPLAY :D8
-(P 7 \INTERRUPTABLE P 5 BM P 4 CSINFO P 3 PBT I 1 CHARSET I 0 DISPLAYDATA) œ@É*@ÉÉAàÐɵ@ÉÉAàA@É
-HIÐJ¿J"@LÉ¿@LÉ¿@LÉ0¿@A>¿LɽKMÈàààànÿÿåÍ¿@È'LÈ
-ð—@È@LÈð©@L
-¿°#MÉMÈ@ÉBÚоKNÒÍ¿KNÓÍh(116 \SFFixY 30 \CREATECHARSET)
-(148 PILOTBBT 137 PILOTBBT)
+(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)
 ()
 \INDICATESTRINGA0001 :D8
 (NAME SI::*UNWIND-PROTECT* I 0 SI::*CLEANUP-FORMS* F 0 SI::*RESETFORMS* F 1 CHARCODE) H
gd	gi
@@ -225,18 +225,18 @@ BLTCHAR :D8
 (75 ^ 52 %# 16 SI::RESETUNWIND)
 ( 81 "" 58 "")
 \SLOWBLTCHAR :D8
-(P 16 CSINFO P 15 HEIGHTMOVED P 14 YPOS P 13 SOFTCURSORUP P 12 DISPINTERRUPT P 11 SOURCEBIT P 10 WIDTH P 9 DESTBIT P 8 PILOTBBT P 7 CURX P 6 RIGHT P 5 LEFT P 4 NEWX P 2 DD P 1 CHAR8CODE P 0 ROTATION I 1 DISPLAYSTREAM I 0 CHARCODE F 20 \SOFTCURSORP F 21 \SOFTCURSORUPP F 22 \CURSORDESTINATION F 23 \SCREENBITMAPS) b@@lÿåYAÉ0ZdÉÈXdjð¢±
~€JÉ_JÉIÐÈØ\JÉñ²l
A
-¿JÉ_JÉIÐÈؼJL¿OJÉØ_¿JÈ"dOñ¢¿O½JÈ#LJÉØ»dKñ‘¿K¾JÉ*_¿NMñ¢±
OÈ	jð’±

M_¿NMÙ_¿JÉIÐÈMØOÙ_¿JÉÈdkð³adlð²¿Oàà_¿Oàà_¿Oàà_°Ddlð²¿Oààà_¿Oààà_¿Oààà_°$lð²lOÚ_¿lOÚ_¿lOÚ_„¿ 
W(²-W*´hA
-W,ð_²`È_¿`jÍ¿¿A`ð³hA
-W.–A	¿OOÍ¿OOÍ¿OOÍ¿Ojv¿OŸ¿`OÍ¿±Î0JÉ_¿JÉIÐÈ_¿JÉÉ@ãàÐɵ$JÉÉ@ãà@ãJÉ
-O"O$ÐO&¿O&_ ¿HdlZð²;¿AOOØ
-¿O ÉjJÉIÐÈAJÉO È
-ÙkØOO È
-O ÈØO
°Hn
ð²8AOOÙ
-¿O ÉjJÉIÐÈAJÉO ÈÙJÉO È
-O ÈØO
‰o	h(606 ERROR 595 BKBITBLT 553 \DSPYPOSITION.DISPLAY 534 BKBITBLT 491 \DSPYPOSITION.DISPLAY 453 \CREATECHARSET 387 \SOFTCURSORUPCURRENT 352 \TOTOPWDS 342 DSPDESTINATION 325 \SOFTCURSORDOWN 294 DSPDESTINATION 275 SHOULDNT 55 \DSPPRINTCR/LF)
-(393 \EM.DISPINTERRUPT 332 \TOPWDS 316 \EM.DISPINTERRUPT 306 \EM.DISPINTERRUPT 111 \DISPLAYDATA 83 \DISPLAYDATA)
-( 601 "Not implemented to rotate by other than 0, 90 or 270")
+(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")
 TEXTUREP :D8
 (I 0 OBJECT) 
@d3 ³ô@Èkð´@NIL
 (18 BITMAP 10 BITMAP)
@@ -289,7 +289,7 @@ OPPOSITESHADE :D8
 NIL
 ()
 \MEDW.BITBLT :D8
-(P 9 A0172 P 8 A0171 P 7 SOURCEBOTTOMTRANSFORMED P 6 SOURCELEFTTRANSFORMED P 3 SRCWIN P 2 A0170 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 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) 
 
@	³C	ªo	¿@òZ@²WCi
 CghÉ0HÉ2ÉHºHÉ2@ABCDEFGGGGGABlJ±
–Cô‚±¯C´‚±¨@i
 !@ghÉ0

AIÉصA
BIÉصBKÉ2ÉJ_¿KÉ2IÉNOCDEFGGGGGNIÈ"¼dLñ¡¿LOIÈ$½dMñ¡¿MlO±Þ@
@@ -455,11 +455,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 A0186 I 1 DISPLAYSTREAM I 0 XOFFSET) '
AghbÉ.É\
@AlH(11 \GETSTREAM)
+(P 0 A0169 I 1 DISPLAYSTREAM I 0 XOFFSET) '
AghbÉ.É\
@AlH(11 \GETSTREAM)
 (25 IMAGEOPS 18 STREAM 5 OUTPUT)
 ()
 DSPYOFFSET :D8
-(P 0 A0187 I 1 DISPLAYSTREAM I 0 YOFFSET) '
AghbÉ.É^
@AlH(11 \GETSTREAM)
+(P 0 A0170 I 1 DISPLAYSTREAM I 0 YOFFSET) '
AghbÉ.É^
@AlH(11 \GETSTREAM)
 (25 IMAGEOPS 18 STREAM 5 OUTPUT)
 ()
 DSPDESTINATION :D8
@@ -544,12 +544,12 @@ 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²nAhdd@i
µJÉgiA
-µo	XIð³>JH¿JjHÈ
-Ù¿JHÉɵHÉjH
+(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
-(130 \SFFixFont 111 \CREATECHARSET 66 ERROR 54 FONTCOPY 35 FONTCREATE)
-(87 FONTDESCRIPTOR 45 NOERROR 17 \DISPLAYDATA 8 STREAM)
+(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")
 \DISPLAY.PILOTBITBLT :D8
 (I 1 N I 0 PILOTBBT) @AvNIL
@@ -790,11 +790,11 @@ Z`S
 (167 \LastTTYLines 155 SCREENHEIGHT 148 SCREENHEIGHT 133 SCREENWIDTH 115 SCREENWIDTH 76 SCREENHEIGHT 62 \LastTTYLines 52 \TopLevelTtyWindow 47 \DEFAULTTTYDISPLAYSTREAM 35 ScreenBitMap)
 ()
 \STARTDISPLAY :D8
-(P 2 \INTERRUPTABLE P 1 W P 0 OLDWINDOWS F 3 \MAINSCREEN F 4 \WINDOWWORLD F 5 \CURSORDESTINATION F 6 \CURSORDESTRASTERWIDTH F 7 \CURSORDESTWIDTH F 8 \CURSORDESTHEIGHT) 
@``ðœ``ð³AT²>	¸``ó«``ó–H	¿HŒd


I	µò``
+(P 2 \INTERRUPTABLE P 1 W P 0 OLDWINDOWS F 3 \MAINSCREEN F 4 \WINDOWWORLD F 5 \CURSORDESTINATION F 6 WINDOWBACKGROUNDSHADE F 7 \CURSORDESTWIDTH F 8 \CURSORDESTHEIGHT F 9 \CURSORDESTRASTERWIDTH) 
<``ðœ``ð³AT²>	¸``ó«``ó–H	¿HŒd


I	µò``
 É`È
-¿ijd``hSµ;`c
-`c`c`ÈcH²P`	¿H	°:`¿S`¿S`¿°žd


I	µò``h(291 \OPENW1 235 REVERSE 228 CHANGEBACKGROUND 142 SHOWDISPLAY 113 \CreateScreenBitMap 90 \CLOSEW1 76 \MOVE.WINDOWS.ONTO.SCREEN 45 REVERSE 40 OPENWINDOWS 7 UPDATESCREENDIMENSIONS)
-(316 \OLDSCREENWIDTH 311 SCREENWIDTH 306 \OLDSCREENHEIGHT 301 SCREENHEIGHT 275 SCREENHEIGHT 270 SCREEN 261 SCREENWIDTH 256 SCREEN 247 ScreenBitMap 242 SCREEN 223 WINDOWBACKGROUNDSHADE 211 BITMAP 206 ScreenBitMap 199 SCREENHEIGHT 192 SCREENWIDTH 185 ScreenBitMap 177 WHOLESCREEN 172 WHOLEDISPLAY 162 SCREENHEIGHT 157 SCREENWIDTH 149 \DisplayStarted 135 BITMAP 130 ScreenBitMap 123 BITMAP 118 ScreenBitMap 108 SCREENHEIGHT 103 SCREENWIDTH 68 SCREENHEIGHT 63 \OLDSCREENHEIGHT 56 SCREENWIDTH 51 \OLDSCREENWIDTH 29 \OLDSCREENHEIGHT 24 SCREENHEIGHT 17 \OLDSCREENWIDTH 12 SCREENWIDTH)
+¿ijd``hSµ7`c
+`c`c`ÈcH²LV	¿H	°:`¿S`¿S`¿°¢d


I	µò``h(287 \OPENW1 231 REVERSE 224 CHANGEBACKGROUND 142 SHOWDISPLAY 113 \CreateScreenBitMap 90 \CLOSEW1 76 \MOVE.WINDOWS.ONTO.SCREEN 45 REVERSE 40 OPENWINDOWS 7 UPDATESCREENDIMENSIONS)
+(312 \OLDSCREENWIDTH 307 SCREENWIDTH 302 \OLDSCREENHEIGHT 297 SCREENHEIGHT 271 SCREENHEIGHT 266 SCREEN 257 SCREENWIDTH 252 SCREEN 243 ScreenBitMap 238 SCREEN 211 BITMAP 206 ScreenBitMap 199 SCREENHEIGHT 192 SCREENWIDTH 185 ScreenBitMap 177 WHOLESCREEN 172 WHOLEDISPLAY 162 SCREENHEIGHT 157 SCREENWIDTH 149 \DisplayStarted 135 BITMAP 130 ScreenBitMap 123 BITMAP 118 ScreenBitMap 108 SCREENHEIGHT 103 SCREENWIDTH 68 SCREENHEIGHT 63 \OLDSCREENHEIGHT 56 SCREENWIDTH 51 \OLDSCREENWIDTH 29 \OLDSCREENHEIGHT 24 SCREENHEIGHT 17 \OLDSCREENWIDTH 12 SCREENWIDTH)
 ()
 \MOVE.WINDOWS.ONTO.SCREEN :D8
 (P 4 REG P 3 YFACTOR P 2 XFACTOR P 1 W I 0 WINDOWS) Ú
@
Hµ+h´&```ëZ``ë[@
HµAh
YÉ
L
L
ØmÿØ`óµL
L
ØmÿØ`ó•Iµ¥i°¢HX°™
Yd	ð²\Ii
@@ -815,11 +815,12 @@ NIL
 (PUTPROPS DISPLAYSTARTEDP MACRO (NIL \DisplayStarted))
 (ADDTOVAR GLOBALVARS WHOLESCREEN)
 INITIALIZEDISPLAYSTREAMS :D8
-(F 0 \GUARANTEEDDISPLAYFONT F 1 DEFAULTFONT) Yodnÿdh`ld
+(F 0 \GUARANTEEDDISPLAYFONT F 1 DEFAULTFONT) eodnÿdh`ld
 gl
-ohg
cgkPh
-c(84 FONTCLASS 67 FONTCREATE 38 BITMAPCREATE)
-(74 DEFAULTFONT 61 DISPLAY 48 GACHA 43 \SYSBBTEXTURE 30 \SYSPILOTBBT 24 |PILOTBBTTYPE#| 19 WHOLEDISPLAY)
+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)
 (RPAQQ \DisplayStarted NIL)
 (RPAQQ \LastTTYLines 12)
diff --git a/sources/LLKEY b/sources/LLKEY
index ad5216cfd..032f719b6 100644
--- a/sources/LLKEY
+++ b/sources/LLKEY
@@ -1,13 +1,12 @@
 (DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
 
-
(FILECREATED " 4-Apr-2025 17:10:10" {WMEDLEY}<sources>LLKEY.;11
 199518 
+
(FILECREATED " 5-May-2025 20:57:08" {WMEDLEY}<sources>LLKEY.;15
 199508 
 
       :EDIT-BY rmk
 
-      :CHANGES-TO (VARS LLKEYCOMS)
-                  (FNS \DECODETRANSITION)
+      :CHANGES-TO (VARS \MAIKOKEYACTIONS \KEYNAMES)
 
-      :PREVIOUS-DATE "13-Feb-2025 08:22:19" {WMEDLEY}<sources>LLKEY.;8)
+      :PREVIOUS-DATE " 4-Apr-2025 17:10:10" {WMEDLEY}<sources>LLKEY.;11)
 
 
 (PRETTYCOMPRINT LLKEYCOMS)
@@ -1522,7 +1521,7 @@
         (UTIL0 SUN-KEYPAD=)
         (UTIL1 SUN-KEYPAD/)
         (UTIL2 SUPER/SUB)
-        (UTIL3 CASE)
+        (UTIL3 CASE SUN-F4)
         (UTIL4 STRIKEOUT)
         (UTIL5 KEYPAD2 DOWNARROW)
         (UTIL6 KEYPAD3 PGDN)
@@ -1556,7 +1555,7 @@
         (K52 KEYPAD0 INS)
         (BOLD)
         (ITALICS)
-        (UNDERLINE)
+        (UNDERLINE SUN-F6)
         (SUPERSCRIPT)
         (SUBSCRIPT)
         (LARGER SMALLER)
@@ -1766,9 +1765,9 @@
         (97 ("Function,A" "Function,a" NOLOCKSHIFT))
         (99 ("Function,B" "Function,b" NOLOCKSHIFT))
         (100 ("Function,C" "Function,c" NOLOCKSHIFT))
-        (67 ("Function,D" "Function,d" NOLOCKSHIFT))
+        (67 ("0,244" "0,244"))
         (68 ("Function,E" "Function,e" NOLOCKSHIFT))
-        (101 ("Function,F" "Function,f" NOLOCKSHIFT))
+        (101 ("0,255" "0,255" NOLOCKSHIFT))
         (66 ("Function,G" "Function,g" NOLOCKSHIFT))
         (104 ("Function,H" "Function,h" NOLOCKSHIFT))
         (80 ("Function,I" "Function,i" NOLOCKSHIFT))
@@ -1784,7 +1783,8 @@
         (14 METADOWN . METAUP)
         (71 ("LF" "LF" NOLOCKSHIFT))
         (47 ("Function,^R" "Function,62" NOLOCKSHIFT))
-        (105 ("\" "|" NOLOCKSHIFT))))
+        (105 ("\" "|" NOLOCKSHIFT))
+        (106 ("0,254" "0,254"))))
 
 (RPAQQ \MAIKOKEYACTIONST4

        ((61 ("^E" "Bell" NOLOCKSHIFT))
@@ -3916,33 +3916,33 @@
 (ADDTOVAR LAMA
 CURSORPROP METASHIFT MOUSECHORDWAIT)
 )
 (DECLARE%: DONTCOPY
-  (FILEMAP (NIL (14626 21942 (BKSYSCHARCODE 14636 . 14985) (\CLEARSYSBUF 14987 . 15545) (\GETKEY 15547
- . 16722) (\NSYSBUFCHARS 16724 . 17466) (\SAVESYSBUF 17468 . 19077) (\SYSBUFP 19079 . 19383) (
-\GETSYSBUF 19385 . 19565) (\PUTSYSBUF 19567 . 20780) (\PEEKSYSBUF 20782 . 21940)) (23227 60785 (
-\KEYBOARDINIT 23237 . 24957) (\KEYBOARDEVENTFN 24959 . 29659) (\ALLOCLOCKED 29661 . 30251) (
-\SETIOPOINTERS 30253 . 34789) (\KEYBOARDOFF 34791 . 35205) (\KEYBOARDON 35207 . 35586) (\KEYHANDLER 
-35588 . 35719) (\KEYHANDLER1 35721 . 43167) (\RESETKEYBOARD 43169 . 44817) (\DOMOUSECHORDING 44819 . 
-48639) (\DOTRANSITIONS 48641 . 49318) (\DECODETRANSITION 49320 . 56733) (MOUSECHORDWAIT 56735 . 57399)
- (\TRACKCURSOR 57401 . 60783)) (95237 117110 (KEYACTION 95247 . 96100) (KEYACTIONTABLE 96102 . 97284) 
-(KEYBOARDTYPE 97286 . 98388) (RESETKEYACTION 98390 . 100149) (\KEYBOARD.MACHINE-SPECIFIC-KEYACTIONS 
-100151 . 102053) (\KEYACTION1 102055 . 112171) (KEYDOWNP 112173 . 112508) (KEYNUMBERP 112510 . 112708)
- (\KEYNAMETONUMBER 112710 . 113404) (\KEYNUMBERTONAME 113406 . 113596) (MODIFY.KEYACTIONS 113598 . 
-114459) (METASHIFT 114461 . 115405) (SHIFTDOWNP 115407 . 117108)) (117173 117469 (
-SETUP.OFFICE.KEYBOARD 117183 . 117467)) (120448 122160 (\INIT.KEYBOARD.STREAM 120458 . 122158)) (
-122425 138802 (\DOBUFFEREDTRANSITIONS 122435 . 137865) (\TIMER.INTERRUPTFRAME 137867 . 138592) (
-\PERIODIC.INTERRUPTFRAME 138594 . 138800)) (139056 143133 (\HARDCURSORUP 139066 . 140948) (
-\HARDCURSORPOSITION 140950 . 142986) (\HARDCURSORDOWN 142988 . 143131)) (143134 167194 (CURSOR.INIT 
-143144 . 146844) (\CURSORDESTINATION 146846 . 149164) (\SOFTCURSORUP 149166 . 154420) (
-\SOFTCURSORUPCURRENT 154422 . 161458) (\SOFTCURSORPOSITION 161460 . 162225) (\SOFTCURSORDOWN 162227 . 
-162935) (CURSORPROP 162937 . 163279) (GETCURSORPROP 163281 . 163469) (PUTCURSORPROP 163471 . 164626) (
-\CURSORBITSPERPIXEL 164628 . 166744) (\CURSORIMAGEPROPNAME 166746 . 166970) (\CURSORMASKPROPNAME 
-166972 . 167192)) (167195 185145 (CURSORCREATE 167205 . 169880) (CURSOR 169882 . 171694) (
-\CURSOR-VALID-P 171696 . 172783) (\CURSORUP 172785 . 174500) (\CURSORPOSITION 174502 . 177030) (
-\CURSORDOWN 177032 . 177265) (ADJUSTCURSORPOSITION 177267 . 177845) (CURSORPOSITION 177847 . 179389) (
-CURSORSCREEN 179391 . 180047) (CURSOREXIT 180049 . 181440) (FLIPCURSOR 181442 . 182568) (FLIPCURSORBAR
- 182570 . 183550) (LASTMOUSEX 183552 . 183806) (LASTMOUSEY 183808 . 184062) (CREATEPOSITION 184064 . 
-184270) (POSITIONP 184272 . 184556) (CURSORHOTSPOT 184558 . 185143)) (186383 187931 (GETMOUSESTATE 
-186393 . 187052) (\EVENTKEYS 187054 . 187929)) (194130 194926 (MACHINETYPE 194140 . 194540) (
-SETMAINTPANEL 194542 . 194924)) (194956 196095 (BEEPON 194966 . 195619) (BEEPOFF 195621 . 196093)) (
-196546 196809 (WITHOUT-INTERRUPTS 196556 . 196807)))))
+  (FILEMAP (NIL (14602 21918 (BKSYSCHARCODE 14612 . 14961) (\CLEARSYSBUF 14963 . 15521) (\GETKEY 15523
+ . 16698) (\NSYSBUFCHARS 16700 . 17442) (\SAVESYSBUF 17444 . 19053) (\SYSBUFP 19055 . 19359) (
+\GETSYSBUF 19361 . 19541) (\PUTSYSBUF 19543 . 20756) (\PEEKSYSBUF 20758 . 21916)) (23203 60761 (
+\KEYBOARDINIT 23213 . 24933) (\KEYBOARDEVENTFN 24935 . 29635) (\ALLOCLOCKED 29637 . 30227) (
+\SETIOPOINTERS 30229 . 34765) (\KEYBOARDOFF 34767 . 35181) (\KEYBOARDON 35183 . 35562) (\KEYHANDLER 
+35564 . 35695) (\KEYHANDLER1 35697 . 43143) (\RESETKEYBOARD 43145 . 44793) (\DOMOUSECHORDING 44795 . 
+48615) (\DOTRANSITIONS 48617 . 49294) (\DECODETRANSITION 49296 . 56709) (MOUSECHORDWAIT 56711 . 57375)
+ (\TRACKCURSOR 57377 . 60759)) (95227 117100 (KEYACTION 95237 . 96090) (KEYACTIONTABLE 96092 . 97274) 
+(KEYBOARDTYPE 97276 . 98378) (RESETKEYACTION 98380 . 100139) (\KEYBOARD.MACHINE-SPECIFIC-KEYACTIONS 
+100141 . 102043) (\KEYACTION1 102045 . 112161) (KEYDOWNP 112163 . 112498) (KEYNUMBERP 112500 . 112698)
+ (\KEYNAMETONUMBER 112700 . 113394) (\KEYNUMBERTONAME 113396 . 113586) (MODIFY.KEYACTIONS 113588 . 
+114449) (METASHIFT 114451 . 115395) (SHIFTDOWNP 115397 . 117098)) (117163 117459 (
+SETUP.OFFICE.KEYBOARD 117173 . 117457)) (120438 122150 (\INIT.KEYBOARD.STREAM 120448 . 122148)) (
+122415 138792 (\DOBUFFEREDTRANSITIONS 122425 . 137855) (\TIMER.INTERRUPTFRAME 137857 . 138582) (
+\PERIODIC.INTERRUPTFRAME 138584 . 138790)) (139046 143123 (\HARDCURSORUP 139056 . 140938) (
+\HARDCURSORPOSITION 140940 . 142976) (\HARDCURSORDOWN 142978 . 143121)) (143124 167184 (CURSOR.INIT 
+143134 . 146834) (\CURSORDESTINATION 146836 . 149154) (\SOFTCURSORUP 149156 . 154410) (
+\SOFTCURSORUPCURRENT 154412 . 161448) (\SOFTCURSORPOSITION 161450 . 162215) (\SOFTCURSORDOWN 162217 . 
+162925) (CURSORPROP 162927 . 163269) (GETCURSORPROP 163271 . 163459) (PUTCURSORPROP 163461 . 164616) (
+\CURSORBITSPERPIXEL 164618 . 166734) (\CURSORIMAGEPROPNAME 166736 . 166960) (\CURSORMASKPROPNAME 
+166962 . 167182)) (167185 185135 (CURSORCREATE 167195 . 169870) (CURSOR 169872 . 171684) (
+\CURSOR-VALID-P 171686 . 172773) (\CURSORUP 172775 . 174490) (\CURSORPOSITION 174492 . 177020) (
+\CURSORDOWN 177022 . 177255) (ADJUSTCURSORPOSITION 177257 . 177835) (CURSORPOSITION 177837 . 179379) (
+CURSORSCREEN 179381 . 180037) (CURSOREXIT 180039 . 181430) (FLIPCURSOR 181432 . 182558) (FLIPCURSORBAR
+ 182560 . 183540) (LASTMOUSEX 183542 . 183796) (LASTMOUSEY 183798 . 184052) (CREATEPOSITION 184054 . 
+184260) (POSITIONP 184262 . 184546) (CURSORHOTSPOT 184548 . 185133)) (186373 187921 (GETMOUSESTATE 
+186383 . 187042) (\EVENTKEYS 187044 . 187919)) (194120 194916 (MACHINETYPE 194130 . 194530) (
+SETMAINTPANEL 194532 . 194914)) (194946 196085 (BEEPON 194956 . 195609) (BEEPOFF 195611 . 196083)) (
+196536 196799 (WITHOUT-INTERRUPTS 196546 . 196797)))))
 STOP
diff --git a/sources/LLKEY.LCOM b/sources/LLKEY.LCOM
index 0fc5012ce..aba3cfe8d 100644
Binary files a/sources/LLKEY.LCOM and b/sources/LLKEY.LCOM differ
diff --git a/sources/LLREAD b/sources/LLREAD
index b852e1504..d3897704c 100644
--- a/sources/LLREAD
+++ b/sources/LLREAD
@@ -1,14 +1,13 @@
 (DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
 
-
(FILECREATED "13-Aug-2025 14:40:39" {WMEDLEY}<sources>LLREAD.;121
 102895 
+
(FILECREATED "20-Sep-2025 14:18:31" {WMEDLEY}<sources>LLREAD.;123
 99281  
 
       :EDIT-BY rmk
 
       :CHANGES-TO (VARS LLREADCOMS)
-                  (FNS CHARCODE.ENCODE CHARSET.DECODE)
+                  (FNS CHARSET.ENCODE)
 
-      :PREVIOUS-DATE " 8-Aug-2025 10:13:49" 
-{DSK}<Users>kaplan>Local>medley3.5>working-medley>sources>LLREAD.;118)
+      :PREVIOUS-DATE "24-Aug-2025 11:47:11" {WMEDLEY}<sources>LLREAD.;122)
 
 
 (PRETTYCOMPRINT LLREADCOMS)
@@ -35,7 +34,7 @@
                                                              (* ; "Reading characters with #\")

               (FNS CHARACTER.READ))
         (COMS                                                (* ; "Character names")

-              (FNS CHARCODE.DECODE CHARCODE.ENCODE CHARCODEP CHARSET.DECODE CHARCODE.ENCODE)
+              (FNS CHARCODE.DECODE CHARCODE.ENCODE CHARCODEP CHARSET.DECODE CHARSET.ENCODE)
               (FNS HEXNUM? OCTALNUM? HEXSTRING)
               (GLOBALVARS CHARACTERNAMES CHARACTERSETNAMES)
               (ALISTS (CHARACTERNAMES Page Form FF Rubout Del Null Escape Esc Bell Tab Backspace Bs 
@@ -1558,12 +1557,12 @@
                     (CONCAT CSETNAME "," CHARNAME))])
 
 (CHARCODEP

-  [LAMBDA (CHCODE)
                                           (* ; "Edited  8-Aug-2025 09:16 by rmk")

+  [LAMBDA (CHCODE)
                                           (* ; "Edited 24-Aug-2025 11:46 by rmk")


+                                                             (* ; "Edited  8-Aug-2025 09:16 by rmk")

                                                              (* gbn "22-Jul-85 16:35")

                                                              (* ; "is CHCODE a legal character code?")

     (CL:WHEN (AND (SMALLP CHCODE)
-                  (IGEQ CHCODE 0)
-                  (ILEQ CHCODE \MAXNSCHAR))
+                  (<= 0 CHCODE \MAXFATCHAR))
            CHCODE])
 
 (CHARSET.DECODE

@@ -1589,76 +1588,25 @@
         then
 NIL
       else
 (ERROR "BAD CHARACTER-SET SPECIFICATION" C])
 
-(CHARCODE.ENCODE

-  [LAMBDA (CODE OCTALCHARS NONCHARIDENTITY)
                  (* ; "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")


-                                                             (* ; "Edited 23-Mar-2025 14:57 by rmk")


-                                                             (* ; "Edited 18-Mar-2025 20:55 by rmk")


-                                                             (* ; "Edited  6-Dec-2023 20:30 by rmk")


-                                                            (* ; "Edited 20-Sep-2021 15:03 by rmk:")

-
-    (* ;; "If CODE correspond to a named character, that character is returned.")

-
-    (* ;; "Otherwise, if OCTALCHARS the result is of the form %"cset,octal-char%" where cset is a known name (Meta) or the octal string for an unknown character set.  Ascii codes show up with %"0,xx%"")

-
-    (* ;; "If not OCTALCHARS, the character-name part is constructed from the name of its Ascii equivalent, modified by ^ or #. %"0,%" is suppressed in front of the names for character-set 0.")

+(CHARSET.ENCODE

+  [LAMBDA (CSETCODE OCTAL)
                                   (* ; "Edited 20-Sep-2025 14:16 by rmk")

 
-    (* ;; "If NONCHARIDENTITY, returns CODE if it isn't something that can be interpreted as a character code.")

+    (* ;; "If CSETCODE correspond to a named character set and OCTAL is NIL, then name is returned. Otherwise the octal string is returned.")

 
-    (DECLARE
 (GLOBALVARS CHARACTERSETNAMES CHARACTERNAMES))
+    (DECLARE
 (GLOBALVARS CHARACTERSETNAMES))
 
     (* ;; "")

 
-    (if
 (LISTP CODE)
-        then
 (for
 C in
 CODE collect
 (CHARCODE.ENCODE
 C OCTALCHARS NONCHARIDENTITY))
-      elseif
 (CL:CHARACTERP CODE)
-        then
 (CHARCODE.ENCODE
 (CL:CHAR-CODE CODE)
-                    OCTALCHARS NONCHARIDENTITY)
-      elseif
 (NULL CODE)
+    (if
 (LISTP CSETCODE)
+        then
 (for
 CS in
 CSETCODE collect
 (CHARSET.ENCODE
 CS OCTAL))
+      elseif
 (NULL CSETCODE)
         then
 NIL
-      elseif
 (NOT (CHARCODEP
 CODE))
-        then
 (CL:IF NONCHARIDENTITY
-                 CODE
-                 (\ILLEGAL.ARG CODE))
-      elseif
 [CAR (find
 CN in
 CHARACTERNAMES suchthat
 (if
 (CHARCODEP
 (CADR CN))
-                                                          then
 (IEQP CODE (CADR CN))
-                                                        else
 (IEQP CODE (CHARCODE.DECODE
 (CADR CN]
-      else
 (LET ((CHARSET (LRSH CODE 8))
-                 (CHAR (LOGAND CODE 255))
-                 (ASCIICODE (LOGAND CODE 127))
-                 CSETNAME CHARNAME ASCIINAME)
-                (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]
-                (CL:WHEN (STREQUAL CHARNAME "Tenexeol")      (* ; 
-
                                                          "Put (%"^_%" Tenexeol) in CHARACTERNAMES ?")

-                    (SETQ CHARNAME "^_"))
-
-                (* ;; "Didn't find the special character name, let's find a corresponding Asciiname to prefix with ^ and/or #")

-
-                (CL:UNLESS CHARNAME
-                    [SETQ ASCIINAME (if
 [CAR (for
 CC in
 CHARACTERNAMES
-                                                when
 (EQ ASCIICODE (CADR CC))
-                                                smallest
 (NCHARS (CAR CC]
-                                      elseif
 (ILESSP ASCIICODE (CHARCODE SPACE))
-                                        then
 [CONCAT "^" (CHARACTER (IPLUS ASCIICODE (CHARCODE @]
-                                      else
 
-                                           (* ;; "Not named and not a control")

-
-                                           (CONCAT (CHARACTER ASCIICODE]
-                    (SETQ CHARNAME (CL:IF (IGEQ CHAR 128)
-                                       (CONCAT "#" ASCIINAME)
-                                       ASCIINAME)))
-                (CL:IF (AND (ZEROP CHARSET)
-                            (NOT OCTALCHARS))
-                    CHARNAME
-                    (CONCAT CSETNAME "," CHARNAME))])
+      elseif
 (NOT (<= 0 CSETCODE \MAXCHARSET))
+        then
 (\ILLEGAL.ARG CSETCODE)
+      elseif
 OCTAL
+        then
 (OCTALSTRING CSETCODE)
+      else
 (OR [CAR (find
 CSN in
 CHARACTERSETNAMES suchthat
 (EQ CSETCODE (CADR CSN]
+               (OCTALSTRING CSETCODE])
 )
 (DEFINEQ
 
@@ -1892,19 +1840,19 @@
 (ADDTOVAR LAMA
 CL:PARSE-INTEGER CL:READ-DELIMITED-LIST CL:READ-PRESERVING-WHITESPACE CL:READ)
 )
 (DECLARE%: DONTCOPY
-  (FILEMAP (NIL (3886 12330 (LASTC 3896 . 4202) (PEEKC 4204 . 4592) (PEEKCCODE 4594 . 5005) (RATOM 5007
- . 6088) (READ 6090 . 6650) (READC 6652 . 7293) (READCCODE 7295 . 8054) (READP 8056 . 8608) (
-SETREADMACROFLG 8610 . 8909) (SKIPSEPRCODES 8911 . 9991) (SKIPSEPRS 9993 . 10379) (SKREAD 10381 . 
-12328)) (12376 20985 (CL:READ 12386 . 12935) (CL:READ-PRESERVING-WHITESPACE 12937 . 13659) (
-CL:READ-DELIMITED-LIST 13661 . 14576) (CL:PARSE-INTEGER 14578 . 20983)) (21078 33555 (RSTRING 21088 . 
-21820) (READ-EXTENDED-TOKEN 21822 . 25694) (\RSTRING2 25696 . 33553)) (33591 64324 (\TOP-LEVEL-READ 
-33601 . 35584) (\SUBREAD 35586 . 60740) (\SUBREADCONCAT 60742 . 61365) (\ORIG-READ.SYMBOL 61367 . 
-62435) (\ORIG-INVALID.SYMBOL 62437 . 63336) (\APPLYREADMACRO 63338 . 63754) (INREADMACROP 63756 . 
-64322)) (64483 64658 (READQUOTE 64493 . 64656)) (64683 76587 (READVBAR 64693 . 66024) (READHASHMACRO 
-66026 . 71836) (DEFMACRO-LAMBDA-LIST-KEYWORD-P 71838 . 72058) (DIGITBASEP 72060 . 72794) (
-READNUMBERINBASE 72796 . 74682) (ESTIMATE-DIMENSIONALITY 74684 . 75009) (SKIP.HASH.COMMENT 75011 . 
-75979) (CMLREAD.FEATURE.PARSER 75981 . 76585)) (76631 77897 (CHARACTER.READ 76641 . 77895)) (77930 
-93404 (CHARCODE.DECODE 77940 . 83109) (CHARCODE.ENCODE 83111 . 87553) (CHARCODEP 87555 . 88008) (
-CHARSET.DECODE 88010 . 88958) (CHARCODE.ENCODE 88960 . 93402)) (93405 97901 (HEXNUM? 93415 . 95758) (
-OCTALNUM? 95760 . 96573) (HEXSTRING 96575 . 97899)))))
+  (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)))))
 STOP
diff --git a/sources/LLREAD.LCOM b/sources/LLREAD.LCOM
index 1f897e324..0a78b0a66 100644
Binary files a/sources/LLREAD.LCOM and b/sources/LLREAD.LCOM differ
diff --git a/sources/MCCS b/sources/MCCS
new file mode 100644
index 000000000..0a9fe5862
--- /dev/null
+++ b/sources/MCCS
@@ -0,0 +1,1511 @@
+(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
+
+
(FILECREATED " 7-Oct-2025 14:52:10" {WMEDLEY}<sources>MCCS.;152
 57023  
+
+      :EDIT-BY rmk
+
+      :CHANGES-TO (FNS MCCSMAPPAIRS)
+
+      :PREVIOUS-DATE " 6-Oct-2025 16:44:20" {WMEDLEY}<sources>MCCS.;149)
+
+
+(PRETTYCOMPRINT MCCSCOMS)
+
+(RPAQQ MCCSCOMS

+       [
+        (* ;; "Stringlet number encoding common to MCCS and XCCS")

+
+        (FNS \MCCSINCCODE \MCCSPEEKCCODE \MCCSOUTCHAR \MCCSBACKCCODE \MCCSFORMATBYTESTREAM 
+             \MCCSCHARSETFN)
+        (FNS \CREATE.MCCS.EXTERNALFORMAT)
+        (FNS \MCCS.24BITENCODING.ERROR)
+        (INITVARS (*SIGNAL-MCCS.24BITENCODING.ERROR*))
+        (DECLARE%: EVAL@COMPILE DONTCOPY (EXPORT (CONSTANTS (\NORUNCODE 255)
+                                                        (NSCHARSETSHIFT 255))
+                                                (MACROS \RUNCODED)))
+        (DECLARE%: DONTEVAL@LOAD DOCOPY (P (\CREATE.MCCS.EXTERNALFORMAT :MCCS)
+                                           (\CREATE.MCCS.EXTERNALFORMAT :XCCS)))
+        
+        (* ;; "")

+
+        
+        (* ;; "Assignment of MCCS characters")

+
+        (ALISTS (CHARACTERNAMES Lowline Circumflex Currency Leftarrow Uparrow Dollar Underline))
+        
+        (* ;; "Mapping between true XCCS and MCCS codes")

+
+        (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])
+
+
+
+(* ;; "Stringlet number encoding common to MCCS and XCCS")

+
+(DEFINEQ
+
+(\MCCSINCCODE

+  [LAMBDA (STREAM COUNTP)
                                    (* ; "Edited  9-Sep-2025 22:42 by rmk")


+                                                             (* ; "Edited  8-Dec-2023 15:28 by rmk")


+                                                            (* ; "Edited  6-Aug-2021 15:57 by rmk:")

+
+(* ;;; "Returns a 16 bit character code.  SHIFTEDCSET is STREAM's char set left shifted 8.")

+
+(* ;;; "If COUNTP is non-NIL, the variable *BYTECOUNTER* is set freely to the number of bytes read.")

+
+(* ;;; "This doesn't do  EOL conversion, \INCHAR does that")

+
+    (DECLARE
 (USEDFREE *BYTECOUNTER*))
+    (\DTEST STREAM 'STREAM)
+    (LET (NUMBYTES (CSET (ffetch
 (STREAM CHARSET) of
 STREAM))
+                (CHAR (\BIN STREAM)))                        (* ; 
+
                                             "Error on EOF unless ENDOFSTREAMOP does something else.")

+
+         (* ;; " NUMBYTES tracks the number of \BINs.  ")

+
+         (IF
 (EQ CHAR NSCHARSETSHIFT)
+             THEN
                                            (* ; 
+
                                                             "Shifting character sets, toss CHAR")

+                  (SETQ CSET (\BIN STREAM))
+                  (IF
 (NEQ NSCHARSETSHIFT CSET)
+                      THEN
                                   (* ; 
+
                                                             "Shift to new runcode CSET: SH CS CH")

+                           (SETQ CHAR (\BIN STREAM))
+                           (SETQ NUMBYTES 3)
+                           (freplace
 (STREAM CHARSET) of
 STREAM with
 CSET)
+                    ELSEIF
 (EQ 0 (\BIN STREAM))
+                      THEN
                                   (* ; "SH SH CSH  CS CH where CSH is 0")

+
+                           (* ;; 
+
    "The high-order character set byte must be 0, because we don't support obese characters (24 bit)")

+
+                           (SETQ CSET (\BIN STREAM))
+                           (SETQ CHAR (\BIN STREAM))         (* ; "To align with below")

+                           (SETQ NUMBYTES 5)
+                           (freplace
 (STREAM CHARSET) of
 STREAM with
 \NORUNCODE)
+                    ELSE
 (\MCCS.24BITENCODING.ERROR
 STREAM)) 
+
+                  (* ;; "The stream now knows the new character set, runcoded or not.")

+
+           ELSEIF
 (EQ CSET \NORUNCODE)
+             THEN
                                            (* ; "2-bytes")

+                  (SETQ CSET CHAR)
+                  (SETQ CHAR (\BIN STREAM))
+                  (SETQ NUMBYTES 2)
+           ELSE
 
+                (* ;; "Runcoded CSET and CHAR")

+
+                (SETQ NUMBYTES 1))
+         (CL:WHEN COUNTP (SETQ *BYTECOUNTER* NUMBYTES))
+         (CL:WHEN CHAR                                       (* ; 
+
                                                "Typically NIL if ENDOFSTREAMOP returned NIL at EOF ")

+             (LOGOR (UNFOLD CSET 256)
+                    CHAR))])
+
+(\MCCSPEEKCCODE

+  [LAMBDA (STREAM NOERROR)
                                   (* ; "Edited  9-Sep-2025 22:43 by rmk")


+                                                             (* ; "Edited 23-Apr-2025 14:16 by rmk")


+                                                             (* ; "Edited  8-Dec-2023 15:32 by rmk")


+                                                            (* ; "Edited 21-Jun-2021 23:44 by rmk:")

+
+    (* ;; 
+
   "Modeled on \MCCSINCCODE, but peeks at the last byte in the sequence, leaves the stream unchanged")

+
+    (\DTEST STREAM 'STREAM)
+    (LET ((CSET (ffetch
 (STREAM CHARSET) of
 STREAM))
+          (CHAR (\PEEKBIN STREAM NOERROR)))
+
+         (* ;; "Returns a 16 bit character code.  Doesn't do EOL conversion--\PEEKCCODE does that.  ")

+
+         (* ;; "We don't change the charset in the stream, put the file ptr back the way it was.")

+
+         (CL:WHEN CHAR
+             (IF
 (EQ CHAR NSCHARSETSHIFT)
+                 THEN
 (\BIN STREAM)                          (* ; "Read the peeked shifting byte")

+                      (SETQ CSET (\BIN STREAM))              (* ; "Consume the char shift byte")

+                      (IF
 (NEQ CSET NSCHARSETSHIFT)
+                          THEN
 
+                               (* ;; 
+
           "Shift to new runcode CSET: SH CS CH.  We have to BIN what we peeked, BIN, and peek again")

+
+                               (SETQ CHAR (\PEEKBIN STREAM NOERROR))
+                               (\BACKFILEPTR STREAM)
+                               (\BACKFILEPTR STREAM)
+                        ELSEIF
 (EQ 0 (\BIN STREAM))
+                          THEN
                               (* ; "SH SH CSH  CS CH where CSH is 0")

+
+                               (* ;; 
+
       "Note: no eof error check on this \BIN -- an eof in the middle of a charset shift is an error")

+
+                               (SETQ CSET (\BIN STREAM))
+                               (SETQ CHAR (\PEEKBIN STREAM NOERROR))
+                               (\BACKFILEPTR STREAM)
+                               (\BACKFILEPTR STREAM)
+                               (\BACKFILEPTR STREAM)
+                               (\BACKFILEPTR STREAM)
+                        ELSE
 (\MCCS.24BITENCODING.ERROR
 STREAM))
+               ELSEIF
 (EQ CSET \NORUNCODE)
+                 THEN
                                        (* ; "2 byte runs, BIN/PEEK/BACK")

+                      (SETQ CSET CHAR)
+                      (\BIN STREAM)
+                      (SETQ CHAR (\PEEKBIN STREAM NOERROR))  (* ; "One BACKFILEPTR seems OK")

+                      (\BACKFILEPTR STREAM))
+
+             (* ;; "No need to back up for the runcoded case")

+
+             (CL:WHEN CHAR
+                 (LOGOR (UNFOLD CSET 256)
+                        CHAR)))])
+
+(\MCCSOUTCHAR

+  [LAMBDA (STREAM CHARCODE)
                                  (* ; "Edited 23-Apr-2025 14:16 by rmk")


+                                                            (* ; "Edited 13-Aug-2021 10:24 by rmk:")

+
+    (* ;; "Closed function for the :MCCS external format")

+
+    (COND
+       ((EQ CHARCODE (CHARCODE EOL))
+        (FREPLACE
 (STREAM CHARPOSITION) OF
 STREAM WITH
 0)
+        [COND
+           [(NOT (\RUNCODED STREAM))                         (* ; 
+
                                           "Charset is a constant 0, we put out the high-order byte.")

+            (\BOUT STREAM (\CHARSET (CHARCODE EOL]
+           ((EQ (\CHARSET (CHARCODE EOL))
+                (ffetch
 (STREAM CHARSET) of
 STREAM)))
+           (T                                                (* ; 
+
                                        "We are runcoded, and not in character set 0, have to shift.")

+              (\BOUT STREAM NSCHARSETSHIFT)
+              (\BOUT STREAM (freplace
 (STREAM CHARSET) of
 STREAM with
 (\CHARSET (CHARCODE EOL]
+
+        (* ;; "We are now in the right charset (0) for the first EOL byte.  For CRLF, the CR is immediately followed by the LF byte, without the prefix 0 byte even if not runcoded, i.e. the 2 bytes are though of as a composite.  The stream is left in CSET0 (the freplace above), read for another shift according to the next shift in a runcoded file.")

+
+        (\BOUTEOL STREAM))
+       (T (CHANGE
 (FFETCH
 (STREAM CHARPOSITION) OF
 STREAM)
+                 (IPLUS16 1 DATUM))
+          (COND
+             ((NOT (\RUNCODED STREAM))
+              (\BOUT STREAM (\CHARSET CHARCODE))
+              (\BOUT STREAM (\CHAR8CODE CHARCODE)))
+             ((EQ (\CHARSET CHARCODE)
+                  (ffetch
 (STREAM CHARSET) of
 STREAM))
+              (\BOUT STREAM (\CHAR8CODE CHARCODE)))
+             (T (\BOUT STREAM NSCHARSETSHIFT)
+                (\BOUT STREAM (freplace
 (STREAM CHARSET) of
 STREAM with
 (\CHARSET CHARCODE)))
+                (\BOUT STREAM (\CHAR8CODE CHARCODE])
+
+(\MCCSBACKCCODE

+  [LAMBDA (STREAM COUNTP)
                                    (* ; "Edited  8-Dec-2023 15:34 by rmk")


+                                                             (* ; "Edited 19-Jul-2022 17:12 by rmk")


+                                                            (* ; "Edited 13-Aug-2021 14:08 by rmk:")

+    (DECLARE
 (USEDFREE *BYTECOUNTER*))
+    (LET ((BYTE (AND (\BACKFILEPTR STREAM)
+                     (\PEEKBIN STREAM)))
+          (CSET (fetch
 (STREAM CHARSET) of
 STREAM)))
+         (CL:WHEN BYTE
+
+             (* ;; "The immediately preceding byte must be a character byte. If it is a byte in a runcode, then we are done, even if the byte before is part of a shift sequence.")

+
+             (* ;; "But if we are currently in a nonruncoded file, we have to go back one more to get the character set byte.")

+
+             (* ;; "If we can't back up, we are already at the beginning.")

+
+             (IF
 (EQ \NORUNCODE CSET)
+                 THEN
 (IF
 (\BACKFILEPTR STREAM)
+                          THEN
 (CL:WHEN COUNTP (SETQ *BYTECOUNTER* -2))
+                               (LOGOR (UNFOLD (\PEEKBIN STREAM)
+                                             256)
+                                      BYTE)
+                        ELSE
 (CL:WHEN COUNTP (SETQ *BYTECOUNTER* -1))
+                             NIL)
+               ELSE
 (CL:WHEN COUNTP (SETQ *BYTECOUNTER* -1))
+                    (LOGOR (UNFOLD CSET 256)
+                           BYTE)))])
+
+(\MCCSFORMATBYTESTREAM

+  [LAMBDA (STREAM BYTESTREAM)
                                (* ; "Edited 27-May-2025 23:42 by rmk")


+                                                             (* ; "Edited 26-Mar-2024 11:00 by rmk")


+                                                             (* ; "Edited 19-Mar-2024 16:02 by rmk")

+    (\EXTERNALFORMAT BYTESTREAM (\EXTERNALFORMAT STREAM))
+
+    (* ;; "This stream may be read as a continuation of STREAM (TTYIN, LAFITE?), and we want to make sure that the bytes are encoded properly.  So let's assert (and possibly mark) that that's its current situation.")

+
+    (\MCCSCHARSETFN
 BYTESTREAM (fetch
 (STREAM CHARSET) of
 STREAM))
+    BYTESTREAM])
+
+(\MCCSCHARSETFN

+  [LAMBDA (STREAM CHARSET DONTMARKSTREAM)
                    (* ; "Edited  9-Dec-2023 11:18 by rmk")

+
+    (* ;; "This differs from  \GENERIC.CHARSET in that it actually writes the shifting bytes into an output stream, unless DONTMARKSTREAM.  It will do write the shifts, even if it just replicates the situation that is already there (presumably CHARSET = the old CHARSET).  The client should test and avoid calling if useless shifts are not desired.")

+
+    (LET [(CSET (ffetch
 (STREAM CHARSET) of
 (\DTEST STREAM 'STREAM]
+         (CL:WHEN CHARSET
+             (CL:WHEN (EQ CHARSET T)
+                    (SETQ CHARSET \NORUNCODE))
+             (CL:UNLESS (EQ CHARSET CSET)
+                 (freplace
 (STREAM CHARSET) of
 STREAM with
 CHARSET)
+                 (CL:UNLESS DONTMARKSTREAM
+                     (CL:WHEN (\IOMODEP STREAM 'OUTPUT T)
+                         (\BOUT STREAM NSCHARSETSHIFT)
+                         (if
 (EQ CHARSET \NORUNCODE)
+                             then
 (\BOUT STREAM \NORUNCODE)
+                                  (\BOUT STREAM 0)
+                           else
 (\BOUT STREAM CHARSET))))))
+         CSET])
+)
+(DEFINEQ
+
+(\CREATE.MCCS.EXTERNALFORMAT

+  [LAMBDA (NAME EOL)
                                         (* ; "Edited 23-Apr-2025 14:19 by rmk")


+                                                             (* ; "Edited  7-Dec-2023 23:03 by rmk")


+                                                             (* ; "Edited 30-Jun-2022 18:08 by rmk")


+                                                            (* ; "Edited 10-Sep-2021 19:49 by rmk:")

+
+(* ;;; "Create the :MCCS external format.  Stream's EOL overrides the (vacuous) default here")

+
+    (MAKE-EXTERNALFORMAT (OR NAME :MCCS)
+           (FUNCTION \MCCSINCCODE)
+           (FUNCTION \MCCSPEEKCCODE)
+           (FUNCTION \MCCSBACKCCODE)
+           (FUNCTION \MCCSOUTCHAR)
+           (FUNCTION \MCCSFORMATBYTESTREAM)
+           (OR EOL 'LF)
+           T NIL NIL (FUNCTION \MCCSCHARSETFN])
+)
+(DEFINEQ
+
+(\MCCS.24BITENCODING.ERROR

+  [LAMBDA (STREAM)
                                           (* ; "Edited  9-Sep-2025 22:41 by rmk")


+                                                             (* ; "Edited 23-Apr-2025 14:34 by rmk")

+                                                             (* bvm%: "12-Mar-86 15:35")

+    (DECLARE
 (USEDFREE *SIGNAL-MCCS.24BITENCODING.ERROR*))
+
+(* ;;; "Called if we see the sequence shift,shift on STREAM -- means shift to 24-bit character set, which we don't support.  Usually this just means we're erroneously reading a binary file as text.  If this function returns, its value is taken as a character set to shift to")

+
+    (CL:WHEN *SIGNAL-MCCS.24BITENCODING.ERROR*               (* ; 
+
                                                             "Only cause error if user/reader cares")

+        (ERROR "24-bit MCCS encoding not supported" STREAM)) (* ; "Return charset zero")

+    0])
+)
+
+(RPAQ? *SIGNAL-MCCS.24BITENCODING.ERROR*
 )
+(DECLARE%: EVAL@COMPILE DONTCOPY 
+(* "FOLLOWING DEFINITIONS EXPORTED")(DECLARE%: EVAL@COMPILE 
+
+(RPAQQ \NORUNCODE
 255)
+
+(RPAQQ NSCHARSETSHIFT
 255)
+
+
+(CONSTANTS (\NORUNCODE 255)
+       (NSCHARSETSHIFT 255))
+)
+(DECLARE%: EVAL@COMPILE 
+
+(PUTPROPS \RUNCODED
 MACRO
 (OPENLAMBDA (STREAM)
+
+                            (* ;; "returns NIL is the stream is not runcoded, that is, if the stream has 16 bit bytes explicitly represented")

+                                                             (* ; 
+
                                        "note that neq is ok since charsets are known to be SMALLP's")

+                            (NEQ (fetch
 CHARSET of
 STREAM)
+                                 \NORUNCODE)))
+)
+
+(* "END EXPORTED DEFINITIONS")
+
+)
+(DECLARE%: DONTEVAL@LOAD DOCOPY 
+
+(\CREATE.MCCS.EXTERNALFORMAT
 :MCCS)
+
+(\CREATE.MCCS.EXTERNALFORMAT
 :XCCS)
+)
+
+
+
+(* ;; "")

+
+
+
+
+(* ;; "Assignment of MCCS characters")

+
+
+(ADDTOVAR CHARACTERNAMES
 (Lowline "0,254")
+                         (Circumflex "0,255")
+                         (Currency "0,244")
+                         (Leftarrow "0,137")
+                         (Uparrow "0,136")
+                         (Dollar "0,44")
+                         (Underline Lowline))
+
+
+
+(* ;; "Mapping between true XCCS and MCCS codes")

+
+(DEFINEQ
+
+(MTOXCODE

+  [LAMBDA (MCODE)
                                            (* ; "Edited  7-Sep-2025 22:36 by rmk")


+                                                             (* ; "Edited 31-Aug-2025 14:24 by rmk")


+                                                             (* ; "Edited  1-May-2025 20:05 by rmk")


+                                                             (* ; "Edited 27-Apr-2025 13:42 by rmk")

+
+    (* ;; "Inverts XTOMCODE. Presumably for the \OUTCHAR function  of hardcopy devices (like Interpress) that want XCCS codes.")

+
+    (OR [CDR (ASSOC MCODE (CONSTANT (for
 X M from
 0 to
 \MAXTHINCHAR when
 (SETQ M (XTOMCODE
 X))
+                                       unless
 (EQ M X) collect
 (CONS M X]
+        MCODE])
+
+(XTOMCODE

+  [LAMBDA (XCODE)
                                            (* ; "Edited  7-Sep-2025 22:36 by rmk")


+                                                             (* ; "Edited  4-Sep-2025 00:25 by rmk")

+    (OR [CDR (ASSOC XCODE (CONSTANT (APPEND (CHARCODE ((Currency . Dollar)
+                                                       (Dollar . Currency)))
+                                           (for
 X M from
 0 to
 \MAXTHINCHAR
+                                              when
 (SETQ M (X$TOMCODE
 X))
+                                              unless
 (EQ X M) collect
 (CONS X M]
+        XCODE])
+
+(XTOMSTRING

+  [LAMBDA (XSTRING DESTRUCTIVE)
                              (* ; "Edited  2-Sep-2025 12:14 by rmk")


+                                                             (* ; "Edited 29-Apr-2025 13:08 by rmk")

+
+    (* ;; "Converts Unicodes to MCCS codes in XSTRING.")

+
+    (for
 I XCODE (MSTRING _ (CL:IF DESTRUCTIVE
+                                XSTRING
+                                (CONCAT XSTRING))) from
 1 while
 (SETQ XCODE (NTHCHARCODE XSTRING I))
+       do
 (RPLCHARCODE MSTRING I (XTOMCODE
 XCODE)) finally
 (RETURN MSTRING])
+
+(MTOXSTRING

+  [LAMBDA (MSTRING DESTRUCTIVE)
                              (* ; "Edited  2-Sep-2025 12:22 by rmk")


+                                                             (* ; "Edited 29-Apr-2025 13:08 by rmk")

+
+    (* ;; "Converts XCCS to MCCS codes in XSTRING.")

+
+    (for
 I MCODE (XSTRING _ (CL:IF DESTRUCTIVE
+                                MSTRING
+                                (CONCAT MSTRING))) from
 1 while
 (SETQ MCODE (NTHCHARCODE MSTRING I))
+       do
 (RPLCHARCODE XSTRING I (MTOXCODE
 MCODE)) finally
 (RETURN XSTRING])
+)
+(DEFINEQ
+
+(MTOX$CODE

+  [LAMBDA (MCODE)
                                            (* ; "Edited  7-Sep-2025 22:37 by rmk")


+                                                             (* ; "Edited 31-Aug-2025 14:23 by rmk")


+                                                             (* ; "Edited  7-Aug-2025 08:13 by rmk")


+                                                             (* ; "Edited 11-May-2025 16:54 by rmk")

+
+    (* ;; "Inverts X$TOMCODE.  Only worries about charset 0")

+
+    (OR [CDR (ASSOC MCODE (CONSTANT (for
 X M from
 0 to
 \MAXTHINCHAR when
 (SETQ M (X$TOMCODE
 X))
+                                       unless
 (EQ M X) collect
 (CONS X M]
+        MCODE])
+
+(X$TOMCODE

+  [LAMBDA (X$CODE)
                                           (* ; "Edited  7-Sep-2025 22:37 by rmk")


+                                                             (* ; "Edited  3-Sep-2025 17:26 by rmk")


+                                                             (* ; "Edited 31-Aug-2025 11:49 by rmk")


+                                                             (* ; "Edited  7-Aug-2025 08:14 by rmk")

+
+    (* ;; "Swaps arrows with lowline and cirumflex")

+
                                                             (* ; "Edited 11-May-2025 16:54 by rmk")

+    (OR [CAR (find
 PAIR in
 (CHARCODE ((Uparrow Circumflex)
+                                      (Circumflex Uparrow)
+                                      (Leftarrow Lowline)
+                                      (Lowline Leftarrow))) suchthat
 (EQ X$CODE (CADR PAIR]
+        X$CODE])
+)
+(DEFINEQ
+
+(KANJICHARSETP

+  [LAMBDA (CHARSET)
                                          (* ; "Edited 13-Jun-2025 16:33 by rmk")

+
+    (* ;; "Returns CHARSET if it is a charset with MCCS Kanji characters")

+
+    (AND (<= 48 CHARSET 118)
+         CHARSET])
+
+(CHINESECHARSETP

+  [LAMBDA (CHARSET)
                                          (* ; "Edited 18-Jun-2025 23:09 by rmk")


+                                                             (* ; "Edited 13-Jun-2025 16:33 by rmk")

+
+    (* ;; "Returns CHARSET if it is a charset with MCCS Chinese characters")

+
+    (AND (<= 161 CHARSET 212)
+         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)
                                              (* ; "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 ((TABLE (ARRAY (ADD1 \MAXTHINCHAR)
+                        'WORD 0 0)))
+         (for
 I from
 0 to
 \MAXTHINCHAR do
 (SETA TABLE I I))
+         [for
 PAIR FROMCODE in
 MAP when
 (LISTP PAIR) unless
 (EQ '* (CAR PAIR))
+            when
 (SETQ FROMCODE (CL:IF (CHARCODEP (CAR PAIR))
+                                    (CAR PAIR)
+                                    (CHARCODE.DECODE (CAR PAIR)
+                                           T))) do
 (SETA TABLE FROMCODE (CL:IF (CHARCODEP
+                                                                                (CADR PAIR))
+                                                                            (CADR PAIR)
+                                                                            (CHARCODE.DECODE
+                                                                             (CADR PAIR)))]
+         TABLE])
+)
+(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  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 ((FN (MCCSMAPFN
 FROMENCODING))
+          PAIRS KEEPCS0)
+         (CL:WHEN FN
+             [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)))
+                             (PALATINO (APPEND (XCCS.CS0.UNDEFINED
)
+                                              PALATINOTOMCCS))
+                             (PROGN (SETQ KEEPCS0 T)
+                                    (for
 C M from
 0 to
 \MAXTHINCHAR
+                                       when
 (SETQ M (APPLY* FN C NONIDENTITY))
+                                       collect
 (LIST C M]
+
+             (* ;; "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.")

+
+             [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])])
+
+(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])
+)
+(DECLARE%: DONTCOPY
+  (FILEMAP (NIL (2856 14427 (\MCCSINCCODE 2866 . 5954) (\MCCSPEEKCCODE 5956 . 8843) (\MCCSOUTCHAR 8845
+ . 10944) (\MCCSBACKCCODE 10946 . 12490) (\MCCSFORMATBYTESTREAM 12492 . 13222) (\MCCSCHARSETFN 13224
+ . 14425)) (14428 15310 (\CREATE.MCCS.EXTERNALFORMAT 14438 . 15308)) (15311 16288 (
+\MCCS.24BITENCODING.ERROR 15321 . 16286)) (17664 20302 (MTOXCODE 17674 . 18471) (XTOMCODE 18473 . 
+19130) (XTOMSTRING 19132 . 19717) (MTOXSTRING 19719 . 20300)) (20303 21963 (MTOX$CODE 20313 . 21045) (
+X$TOMCODE 21047 . 21961)) (21964 22604 (KANJICHARSETP 21974 . 22230) (CHINESECHARSETP 22232 . 22602)) 
+(43172 45046 (MCCSCODEMAPARRAY 43182 . 45044)) (45662 52143 (MCCSMAPFN 45672 . 47039) (MCCSMAPPAIRS 
+47041 . 51149) (XCCS.CS0.UNDEFINED 51151 . 51780) (XCCSUNDEFINEDPAIRS 51782 . 52141)) (52248 57000 (
+GACHATOMCODE 52258 . 52770) (SYMBOLTOMCODE 52772 . 53420) (SIGMATOMCODE 53422 . 54068) (ATOMCODE 54070
+ . 54602) (MATHTOMCODE 54604 . 55260) (HIPPOTOMCODE 55262 . 55799) (CYRILLICTOMCODE 55801 . 56235) (
+PALATINOTOMCODE 56237 . 56998)))))
+STOP
diff --git a/sources/MCCS.LCOM b/sources/MCCS.LCOM
new file mode 100644
index 000000000..e5ad6affc
Binary files /dev/null and b/sources/MCCS.LCOM differ
diff --git a/sources/MEDLEYFONTFORMAT b/sources/MEDLEYFONTFORMAT
index d7acd0bb4..90a42c30f 100644
--- a/sources/MEDLEYFONTFORMAT
+++ b/sources/MEDLEYFONTFORMAT
@@ -1,12 +1,12 @@
 (DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
 
-
(FILECREATED "27-Jul-2025 22:22:23" {WMEDLEY}<sources>MEDLEYFONTFORMAT.;218
 57699  
+
(FILECREATED " 9-Oct-2025 15:20:59" {WMEDLEY}<sources>MEDLEYFONTFORMAT.;242
 59604  
 
       :EDIT-BY rmk
 
-      :CHANGES-TO (FNS MEDLEYFONT.READ.ITEM)
+      :CHANGES-TO (FNS MEDLEYFONT.GETCHARSET)
 
-      :PREVIOUS-DATE "24-Jul-2025 22:07:35" {WMEDLEY}<sources>MEDLEYFONTFORMAT.;217)
+      :PREVIOUS-DATE " 7-Oct-2025 12:43:33" {WMEDLEY}<sources>MEDLEYFONTFORMAT.;241)
 
 
 (PRETTYCOMPRINT MEDLEYFONTFORMATCOMS)
@@ -59,7 +59,8 @@
 (DEFINEQ
 
 (MEDLEYFONT.WRITE.FONT

-  [LAMBDA (FONT FILE CHARSETNOS OTHERFONTPROPS NOINDIRECTS)
  (* ; "Edited 15-Jul-2025 16:43 by rmk")


+  [LAMBDA (FONT FILE CHARSETNOS OTHERFONTPROPS NOINDIRECTS)
  (* ; "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")


@@ -84,7 +85,7 @@
                 (SETQ FILECHARSETS (for
 CSNO CSINFO from
 0 to
 \MAXCHARSET
                                       when
 (OR (NULL CHARSETNOS)
                                                (MEMB CSNO CHARSETNOS))
-                                      when
 (SETQ CSINFO (\XGETCHARSETINFO FONT CSNO))
+                                      when
 (SETQ CSINFO (\GETCHARSETINFO FONT CSNO))
                                       unless
 (fetch
 (CHARSETINFO CSSLUGP) of
 CSINFO) collect
 CSNO))
                 (CL:UNLESS FILECHARSETS (ERROR "No character sets to write" FONT))
 
@@ -128,11 +129,13 @@
                 (FULLNAME STREAM])
 
 (MEDLEYFONT.GETCHARSET

-  [LAMBDA (STREAM CHARSET)
                                   (* ; "Edited 15-Jul-2025 17:09 by rmk")


+  [LAMBDA (STREAM CHARSET FONT)
                              (* ; "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")

+    (* ;; "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.")

 
     (CL:UNLESS (<= 0 CHARSET \MAXCHARSET)
            (\ILLEGAL.ARG CHARSET))
@@ -145,6 +148,27 @@
                 (ERROR "NOT A MEDLEYFONT FILE" (FULLNAME STREAM))))
         (LET ((CSVECTORLOC (\FIXPIN STREAM))
               CSLOC)
+             (if
 (thereis
 CS from
 0 to
 \MAXTHINCHAR suchthat
 (\GETCHARSETINFO FONT CS))
+                 then
 
+                      (* ;; "Font fields have been initialized, just update for this charset")

+
+                      (for
 P VAL in
 (MEDLEYFONT.READ.FONTPROPS
 STREAM)
+                         do
 (SETQ VAL (CADR P))
+                            (SELECTQ (CAR VAL)
+                                (\SFAscent (change
 (fetch
 (FONTDESCRIPTOR \SFAscent) of
 FONT)
+                                                  (IMAX VAL DATUM)))
+                                (\SFDescent (change
 (fetch
 (FONTDESCRIPTOR \SFDescent) of
 FONT)
+                                                   (IMAX VAL DATUM)))
+                                (\SFHeight (fetch
 (FONTDESCRIPTOR \SFHeight) of
 FONT))
+                                NIL))
+               else
 
+                    (* ;; "First charset, probably 0: establish the overall font properties. ")

+
+                    (MEDLEYFONT.READ.VERIFIEDFONT
 STREAM FONT))
+             (replace
 (FONTDESCRIPTOR FONTCOMPLETEP) of
 FONT with
 NIL)
+
+             (* ;; 
+
         "One charset doesn't %"complete%" a complete font--maybe that's only an incore property?   ")

 
              (* ;; "We know now that this file has information about the requested charset, including NIL entries for empty/slugglish ones in the middle of populated ones.  A file that would have contain a single empty/sluggish charset cannot be created--the caller would recognize the case of a missing file and provide either NIL or a slug-vector.")

 
@@ -186,7 +210,8 @@
                        CHARSET])
 
 (MEDLEYFONT.GETFILEPROP

-  [LAMBDA (FILE PROP)
                                        (* ; "Edited 15-Jul-2025 20:21 by rmk")


+  [LAMBDA (FILE PROP)
                                        (* ; "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")


@@ -194,9 +219,8 @@
                                                              (* ; "Edited 14-May-2025 17:46 by rmk")

     (CL:UNLESS (OR (LITATOM FILE)
                    (STRINGP FILE))
-        [SETQ FILE (CAR (APPLY (FUNCTION FONTFILES)
-                               (FONTPROP (FONTCREATE FILE)
-                                      'SPEC])
+        [SETQ FILE (CAR (FONTFILES (FONTPROP (FONTCREATE FILE)
+                                          'SPEC])
     (CL:WITH-OPEN-FILE (STREAM FILE :DIRECTION :INPUT)
            (LET (HEADERPROPS CSVECTORLOC)
                 (CL:UNLESS (SETQ HEADERPROPS (MEDLEYFONT.FILEP
 STREAM))
@@ -255,7 +279,8 @@
 (DEFINEQ
 
 (MEDLEYFONT.READ.FONT

-  [LAMBDA (FILE CHARSETNOS FONT)
                             (* ; "Edited 15-Jul-2025 20:20 by rmk")


+  [LAMBDA (FILE CHARSETNOS FONT)
                             (* ; "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")

     (CL:UNLESS FILE (SETQ FILE FONT))
@@ -267,14 +292,13 @@
            (CL:UNLESS (MEDLEYFONT.FILEP
 STREAM)
                (ERROR "NOT A MEDLEYFONT FILE" (FULLNAME STREAM)))
            (LET ((*READTABLE* (FIND-READTABLE "INTERLISP"))
-                 FONTCHARSETVECTOR CSVECTORLOC NOTFOUND SINGLECS)
+                 CSVECTORLOC NOTFOUND SINGLECSNO)
                 (SETQ CSVECTORLOC (\FIXPIN STREAM))          (* ; 
 
                                                       "Byte location of the charset dispatch vector")

 
                 (* ;; "We know now that this file has information about all requested charsets, including NIL entries for empty/slugglish ones in the middle of populated ones.  A file that would have contain a single empty/sluggish charset cannot be created--the caller would recognize the case of a missing file and provide either NIL or a slug-vector.")

 
                 (SETQ FONT (MEDLEYFONT.READ.VERIFIEDFONT
 STREAM FONT))
-                (SETQ FONTCHARSETVECTOR (fetch
 (FONTDESCRIPTOR FONTCHARSETVECTOR) of
 FONT))
                 (CL:UNLESS (EQ CSVECTORLOC 0)                (* ; "Not empty")

                     [if
 (ILESSP CSVECTORLOC 0)
                         then
 
@@ -284,15 +308,15 @@
                              (* ;; "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 SINGLECS (BIN STREAM))
+                             (SETQ SINGLECSNO (BIN STREAM))
                              (CL:WHEN CHARSETNOS
-                                 (CL:UNLESS (AND (EQ SINGLECS (CAR CHARSETNOS))
+                                 (CL:UNLESS (AND (EQ SINGLECSNO (CAR CHARSETNOS))
                                                  (NULL (CDR CHARSETNOS)))
                                      (ERROR (CONCAT FILE 
-                                                   " does not contain information for charsets ÿ4ÿ"
-                                                   (REMOVE SINGLECS CHARSETNOS)))))
-                             (\SETCHARSETINFO FONTCHARSETVECTOR SINGLECS (MEDLEYFONT.READ.CHARSET

-                                                                          STREAM SINGLECS))
+                                                   " 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")

@@ -311,13 +335,17 @@
                                                              (DREVERSE NOTFOUND))))
                                     (for
 X CS in
 $$VAL do
 (SETQ CSNO (CAR X))
                                                           (SETFILEPTR STREAM (CDR X))
-                                                          (\SETCHARSETINFO FONTCHARSETVECTOR CSNO
-                                                                 (MEDLEYFONT.READ.CHARSET
 STREAM CSNO
-                                                                        ])
+                                                          (\SETCHARSETINFO FONT CSNO (
+
                                                                              MEDLEYFONT.READ.CHARSET

+                                                                                      STREAM CSNO])
                 FONT])
 
 (MEDLEYFONT.READ.CHARSET

-  [LAMBDA (STREAM CHARSET)
                                   (* ; "Edited 15-Jul-2025 11:27 by rmk")


+  [LAMBDA (STREAM CHARSET)
                                   (* ; "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")


@@ -331,12 +359,12 @@
     (LET (CSNO INDIRECT)
          (CL:UNLESS [EQ CHARSET (SETQ CSNO (MEDLEYFONT.READ.ITEM
 STREAM 'CHARSET]
              (ERROR "Charset mismatch" (LIST CHARSET CSNO)))
-         (if
 [EQ 'INDIRECTCHARSET (CAR (SETQ INDIRECT (MEDLEYFONT.PEEK.ITEM
 STREAM]
-             then
                                            (* ; 
-
                                      "Read a complete charset from another file (e.g. shared Kanji)")

-                  (MEDLEYFONT.READ.ITEM
 STREAM 'INDIRECTCHARSET)
-                  (APPLY (FUNCTION \READCHARSET)
-                         (CADR INDIRECT))
+         (if
 (EQ 'INDIRECTCHARSET (CAR (MEDLEYFONT.PEEK.ITEM
 STREAM)))
+             then
 
+                  (* ;; "Read what we peeked and use it to create a complete charset from another file (e.g. shared Kanji). ")

+
+                  (SETQ INDIRECT (MEDLEYFONT.READ.ITEM
 STREAM 'INDIRECTCHARSET))
+                  (\READCHARSET INDIRECT CHARSET)
            else
 (bind
 PAIR LABEL ITEM (CSINFO _ (create
 CHARSETINFO
                                                        WIDTHS _ NIL
                                                        OFFSETS _ NIL)) eachtime
 (SETQ PAIR
@@ -366,10 +394,11 @@
                                                                  of
 CSINFO with
 ITEM))
                                                  (CSCOMPLETEP (replace
 (CHARSETINFO CSCOMPLETEP)
                                                                  of
 CSINFO with
 ITEM))
-                                                 (HELP "Unrecognized charsetinfo label'" LABEL))
+                                                 (HELP "Unrecognized charsetinfo label" LABEL))
                    finally
 (CL:UNLESS (fetch
 (CHARSETINFO IMAGEWIDTHS) of
 CSINFO)
                                (replace
 (CHARSETINFO IMAGEWIDTHS) of
 CSINFO
                                   with
 (fetch
 (CHARSETINFO WIDTHS) of
 CSINFO)))
+                         (replace
 (CHARSETINFO CHARSETNO) of
 CSINFO with
 CHARSET)
                          (RETURN CSINFO])
 
 (MEDLEYFONT.READ.ITEM

@@ -481,64 +510,65 @@
     (bind
 PAIR until
 [EQ 'STOP (CAR (SETQ PAIR (MEDLEYFONT.READ.ITEM
 STREAM] collect
 PAIR])
 
 (MEDLEYFONT.READ.VERIFIEDFONT

-  [LAMBDA (STREAM FONT)
                                      (* ; "Edited 10-Jun-2025 20:57 by rmk")


+  [LAMBDA (STREAM FONT)
                                      (* ; "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")

+    (CL:UNLESS FONT
+        (SETQ FONT (create
 FONTDESCRIPTOR)))
     (LET ((FONTPROPS (MEDLEYFONT.READ.FONTPROPS
 STREAM)))
-         [if
 FONT
-             then
                                            (* ; "compare/verify")

-                  (for
 P in
 FONTPROPS unless
 (EQUAL (CADR P)
-                                                    (RECORDACCESS (CAR P)
-                                                           FONT NIL 'FETCH))
-                     do
 (ERROR "Mismatching font property" P))
-           else
 (SETQ FONT (create
 FONTDESCRIPTOR))          (* ; "Construct")

-                (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))
-                                               (FONTFAMILY (replace
 (FONTDESCRIPTOR FONTFAMILY)
-                                                              of
 FONT with
 VAL))
-                                               (FONTSIZE (replace
 (FONTDESCRIPTOR FONTSIZE)
-                                                            of
 FONT with
 VAL))
-                                               (FONTFACE (replace
 (FONTDESCRIPTOR FONTFACE)
-                                                            of
 FONT with
 VAL))
-                                               (\SFAscent (replace
 (FONTDESCRIPTOR \SFAscent)
-                                                             of
 FONT with
 VAL))
-                                               (\SFDescent (replace
 (FONTDESCRIPTOR \SFDescent)
-                                                              of
 FONT with
 VAL))
-                                               (\SFHeight (replace
 (FONTDESCRIPTOR \SFHeight)
-                                                             of
 FONT with
 VAL))
-                                               (ROTATION (replace
 (FONTDESCRIPTOR ROTATION)
-                                                            of
 FONT with
 VAL))
-                                               (FONTDEVICESPEC 
-                                                    (replace
 (FONTDESCRIPTOR FONTDEVICESPEC)
-                                                       of
 FONT with
 VAL))
-                                               (OTHERDEVICEFONTPROPS 
-                                                    (replace
 (FONTDESCRIPTOR OTHERDEVICEFONTPROPS)
-                                                       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))
-                                               (HELP "UNKNOWN FONTDESCRIPTOR PROPERTY: P"]
+         (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))
+                                        (FONTFAMILY (replace
 (FONTDESCRIPTOR FONTFAMILY) of
 FONT
+                                                       with
 VAL))
+                                        (FONTSIZE (replace
 (FONTDESCRIPTOR FONTSIZE) of
 FONT
+                                                     with
 VAL))
+                                        (FONTFACE (replace
 (FONTDESCRIPTOR FONTFACE) of
 FONT
+                                                     with
 VAL))
+                                        (\SFAscent (replace
 (FONTDESCRIPTOR \SFAscent) of
 FONT
+                                                      with
 VAL))
+                                        (\SFDescent (replace
 (FONTDESCRIPTOR \SFDescent) of
 FONT
+                                                       with
 VAL))
+                                        (\SFHeight (replace
 (FONTDESCRIPTOR \SFHeight) of
 FONT
+                                                      with
 VAL))
+                                        (ROTATION (replace
 (FONTDESCRIPTOR ROTATION) of
 FONT
+                                                     with
 VAL))
+                                        (FONTSLUGWIDTH (replace
 (FONTDESCRIPTOR FONTSLUGWIDTH)
+                                                          of
 FONT with
 VAL))
+                                        (FONTTOMCCSFN (replace
 (FONTDESCRIPTOR FONTTOMCCSFN)
+                                                         of
 FONT with
 VAL))
+                                        (FONTDEVICESPEC 
+                                             (replace
 (FONTDESCRIPTOR FONTDEVICESPEC) of
 FONT
+                                                with
 VAL))
+                                        (OTHERDEVICEFONTPROPS 
+                                             (replace
 (FONTDESCRIPTOR OTHERDEVICEFONTPROPS)
+                                                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))
+                                        (HELP "UNKNOWN FONTDESCRIPTOR PROPERTY: P")))
          FONT])
 )
 
@@ -549,15 +579,15 @@
 (DEFINEQ
 
 (MEDLEYFONT.WRITE.CHARSET

-  [LAMBDA (FONT CHARSET STREAM NOINDIRECTS)
                  (* ; "Edited  9-Jul-2025 19:14 by rmk")


+  [LAMBDA (FONT CHARSET STREAM NOINDIRECTS)
                  (* ; "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")


                                                              (* ; "Edited 25-May-2025 20:49 by rmk")


                                                              (* ; "Edited 22-May-2025 09:58 by rmk")


                                                              (* ; "Edited 16-May-2025 20:18 by rmk")


                                                              (* ; "Edited 13-May-2025 23:26 by rmk")

-
-    (* ;; "This outputs the characterset info for CHARSET in FONT.")

-
-    (LET ((CSINFO (\INSURECHARSETINFO CHARSET FONT))
+    (LET ((CSINFO (\INSURECHARSETINFO FONT CHARSET))
           CSCHARENCODING)
          (MEDLEYFONT.WRITE.ITEM
 STREAM 'CHARSETSTRING (MKSTRING CHARSET))
                                                              (* ; "For human file-scan")

@@ -569,15 +599,12 @@
 
              (* ;; "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 CHARSET))
+             (if
 (CL:UNLESS NOINDIRECTS (INDIRECTCHARSETP CSINFO FONT))
                  then
 
                       (* ;; 
 
           "This charset is is taken entirely from on another file, no need to copy it to this file.")

 
-                      (MEDLEYFONT.WRITE.ITEM
 STREAM 'INDIRECTCHARSET (GETMULTI (fetch
 (CHARSETINFO
-                                                                                       CSINFOPROPS)
-                                                                                  of
 CSINFO)
-                                                                            'SOURCE)
+                      (MEDLEYFONT.WRITE.ITEM
 STREAM 'INDIRECTCHARSET (CHARSETPROP CSINFO 'SOURCE)
                              NIL
                              'PRINT)
                else
 (MEDLEYFONT.WRITE.ITEM
 STREAM 'CSINFOPROPS (fetch
 (CHARSETINFO CSINFOPROPS)
@@ -742,7 +769,8 @@
              (TERPRI STREAM))])
 
 (MEDLEYFONT.WRITE.FONTPROPS

-  [LAMBDA (STREAM FONT)
                                      (* ; "Edited 10-Jun-2025 20:50 by rmk")


+  [LAMBDA (STREAM FONT)
                                      (* ; "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")


                                                              (* ; "Edited 19-May-2025 10:42 by rmk")


@@ -774,6 +802,10 @@
            T)
     (MEDLEYFONT.WRITE.ITEM
 STREAM 'ROTATION (fetch
 (FONTDESCRIPTOR ROTATION) of
 FONT)
            T)
+    (MEDLEYFONT.WRITE.ITEM
 STREAM 'FONTSLUGWIDTH (fetch
 (FONTDESCRIPTOR FONTSLUGWIDTH) of
 FONT)
+           T)
+    (MEDLEYFONT.WRITE.ITEM
 STREAM 'FONTTOMCCSFN (fetch
 (FONTDESCRIPTOR FONTTOMCCSFN) of
 FONT)
+           T)
     (MEDLEYFONT.WRITE.ITEM
 STREAM 'FONTDEVICESPEC (fetch
 (FONTDESCRIPTOR FONTDEVICESPEC) of
 FONT)
            T)
     (MEDLEYFONT.WRITE.ITEM
 STREAM 'OTHERDEVICEFONTPROPS (fetch
 (FONTDESCRIPTOR OTHERDEVICEFONTPROPS)
@@ -810,50 +842,35 @@
 (DEFINEQ
 
 (MEDLEYFONT.FILENAME

-  [LAMBDA (FONT CHARSET EXTENSION FILE)
                      (* ; "Edited 10-Jun-2025 11:02 by rmk")


+  [LAMBDA (FONT CHARSET EXTENSION DIRECTORY)
                 (* ; "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")

 
     (* ;; "If EXTENSION and FILE are NIL, puts the file in the MEDLEYDIR fonts/medley[device]fonts/ directory with extension MEDLEY[device]FONT.  If CHARSET, goes in the CHARSET subdirectory.")

 
-    (CL:WHEN (AND (LISTP CHARSET)
-                  (NULL (CDR CHARSET)))
-        (SETQ CHARSET (CAR CHARSET)))
                        (* ; "Edited 14-May-2025 12:02 by rmk")

-    (LET (FAMILY SIZE FACE DEVICE FILENAME)
-         [if
 (LISTP FONT)
-             then
 (SETQ FAMILY (CAR FONT))
-                  (SETQ SIZE (CADR FONT))
-                  (SETQ FACE (OR (CADDR FONT)
-                                 'MRR))
-                  (SETQ DEVICE (OR (CADDDR FONT)
-                                   'DISPLAY))
-           elseif
 (type?
 FONTDESCRIPTOR FONT)
-             then
 (SETQ FAMILY (FONTPROP FONT 'FAMILY))
-                  (SETQ SIZE (FONTPROP FONT 'SIZE))
-                  (SETQ FACE (FONTPROP FONT 'FACE))
-                  (SETQ DEVICE (FONTPROP FONT 'DEVICE]
-         (CL:WHEN (LISTP FACE)
-             (SETQ FACE (CONCAT (NTHCHAR (CAR FACE)
-                                       1)
-                               (NTHCHAR (CADR FACE)
-                                      1)
-                               (NTHCHAR (CADDR FACE)
-                                      1))))
+    (LET (FAMILY SIZE FACE DEVICE ROTATION FILENAME)
+         (SPREADFONTSPEC (CL:IF (type?
 FONTDESCRIPTOR FONT)
+                             (FONTPROP FONT 'SPEC)
+                             (\FONT.CHECKARGS FONT)))
          (CL:UNLESS EXTENSION
              (SETQ EXTENSION (CONCAT "MEDLEY" (U-CASE DEVICE)
-                                    "FONT"))
-             (CL:UNLESS FILE
-                 [SETQ FILE (PSEUDOFILENAME (MEDLEYDIR (CONCAT "fonts/" (L-CASE EXTENSION)
-                                                              "s"]))
+                                    "FONT")))
+         (CL:UNLESS DIRECTORY
+             [SETQ DIRECTORY (PSEUDOFILENAME (CONCAT (MEDLEYDIR)
+                                                    (CONCAT "fonts/" (L-CASE EXTENSION)
+                                                           "s"])
          (SETQ FILENAME (PACK* FAMILY (CL:IF (ILEQ SIZE 9)
                                           "0"
                                           "")
-                               SIZE "-" FACE (CL:IF (SMALLP CHARSET)
-                                                 (CONCAT "-C" (OCTALSTRING CHARSET))
-                                                 "")
+                               SIZE "-" (FONTFACETOATOM FACE)
+                               (CL:IF (SMALLP CHARSET)
+                                   (CONCAT "-C" (OCTALSTRING CHARSET))
+                                   "")
                                "." EXTENSION))
-         (PACKFILENAME 'BODY FILE 'BODY FILENAME])
+         (CONCAT DIRECTORY ">" FILENAME])
 )
 
 (ADDTOVAR DISPLAYFONTEXTENSIONS
 MEDLEYDISPLAYFONT)
@@ -904,11 +921,11 @@
 )
 )
 (DECLARE%: DONTCOPY
-  (FILEMAP (NIL (2127 14772 (MEDLEYFONT.WRITE.FONT 2137 . 6995) (MEDLEYFONT.GETCHARSET 6997 . 9296) (
-MEDLEYFONT.CHARSET? 9298 . 10767) (MEDLEYFONT.GETFILEPROP 10769 . 12804) (MEDLEYFONT.FILEP 12806 . 
-14770)) (14798 36689 (MEDLEYFONT.READ.FONT 14808 . 19241) (MEDLEYFONT.READ.CHARSET 19243 . 24137) (
-MEDLEYFONT.READ.ITEM 24139 . 30288) (MEDLEYFONT.PEEK.ITEM 30290 . 31152) (MEDLEYFONT.READ.FONTPROPS 
-31154 . 31619) (MEDLEYFONT.READ.VERIFIEDFONT 31621 . 36687)) (36715 54244 (MEDLEYFONT.WRITE.CHARSET 
-36725 . 41330) (MEDLEYFONT.WRITE.ITEM 41332 . 50385) (MEDLEYFONT.WRITE.FONTPROPS 50387 . 53589) (
-MEDLEYFONT.WRITE.HEADER 53591 . 54242)) (54245 56814 (MEDLEYFONT.FILENAME 54255 . 56812)))))
+  (FILEMAP (NIL (2128 16674 (MEDLEYFONT.WRITE.FONT 2138 . 7104) (MEDLEYFONT.GETCHARSET 7106 . 11133) (
+MEDLEYFONT.CHARSET? 11135 . 12604) (MEDLEYFONT.GETFILEPROP 12606 . 14706) (MEDLEYFONT.FILEP 14708 . 
+16672)) (16700 38890 (MEDLEYFONT.READ.FONT 16710 . 21142) (MEDLEYFONT.READ.CHARSET 21144 . 26502) (
+MEDLEYFONT.READ.ITEM 26504 . 32653) (MEDLEYFONT.PEEK.ITEM 32655 . 33517) (MEDLEYFONT.READ.FONTPROPS 
+33519 . 33984) (MEDLEYFONT.READ.VERIFIEDFONT 33986 . 38888)) (38916 56753 (MEDLEYFONT.WRITE.CHARSET 
+38926 . 43488) (MEDLEYFONT.WRITE.ITEM 43490 . 52543) (MEDLEYFONT.WRITE.FONTPROPS 52545 . 56098) (
+MEDLEYFONT.WRITE.HEADER 56100 . 56751)) (56754 58719 (MEDLEYFONT.FILENAME 56764 . 58717)))))
 STOP
diff --git a/sources/MEDLEYFONTFORMAT.LCOM b/sources/MEDLEYFONTFORMAT.LCOM
index c6da31181..02ff141fb 100644
Binary files a/sources/MEDLEYFONTFORMAT.LCOM and b/sources/MEDLEYFONTFORMAT.LCOM differ
diff --git a/sources/PRETTY b/sources/PRETTY
index 2bc35acb3..abe945e92 100644
--- a/sources/PRETTY
+++ b/sources/PRETTY
@@ -1,22 +1,14 @@
 (DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
 
-
(FILECREATED " 8-Feb-2023 16:21:26" {DSK}<home>larry>il>medley>sources>PRETTY.;3
 65500  
+
(FILECREATED "24-Apr-2025 22:19:43" {WMEDLEY}<sources>PRETTY.;25
 65037  
 
-      :EDIT-BY "lmm"
+      :EDIT-BY rmk
 
-      :CHANGES-TO (FNS PRINTDATE1)
+      :CHANGES-TO (VARS PRETTYCOMS)
 
-      :PREVIOUS-DATE "19-Jan-2022 20:35:18" {DSK}<home>larry>il>medley>sources>PRETTY.;1)
+      :PREVIOUS-DATE " 8-Feb-2023 16:21:26" {WMEDLEY}<sources>PRETTY.;24)
 
 
-(* ; "
-Copyright (c) 1984-1990, 1999, 2018, 2023 by Venue & Xerox Corporation.
-The following program was created in 1984 but has not been published
-within the meaning of the copyright law, is furnished under license,
-and may not be used, copied and/or disclosed except in accordance
-with the terms of said license.
-")
-
 (PRETTYCOMPRINT PRETTYCOMS)
 
 (RPAQQ PRETTYCOMS

@@ -46,7 +38,7 @@ with the terms of said license.
 " EXPLAINSTRING "] - no copyright notice now" NOECHOFLG T RETURN NIL]
                      (COPYRIGHTSRESERVED T)
                      (*NEW-INTERLISP-MAKEFILE-ENVIRONMENT* '(:READTABLE "INTERLISP" :PACKAGE 
-                                                                   "INTERLISP" :FORMAT :XCCS))
+                                                                   "INTERLISP" :FORMAT :MCCS))
                      (*DEFAULT-MAKEFILE-ENVIRONMENT*))
               (GLOBALVARS COPYRIGHTOWNERS DEFAULTCOPYRIGHTKEYLST COPYRIGHTPRETTYFLG COMMENTFLG 
                      *DEFAULT-MAKEFILE-ENVIRONMENT* *NEW-INTERLISP-MAKEFILE-ENVIRONMENT*))
@@ -640,7 +632,7 @@ must replace the declare: by a nop addvars.") (SETQ PRTTYCOM (SUBPAIR (QUOTE (NL
 (RPAQ? COPYRIGHTSRESERVED
 T)
 
 (RPAQ? *NEW-INTERLISP-MAKEFILE-ENVIRONMENT*
 '(:READTABLE "INTERLISP" :PACKAGE "INTERLISP" :FORMAT 
-                                                    :XCCS))
+                                                    :MCCS))
 
 (RPAQ? *DEFAULT-MAKEFILE-ENVIRONMENT*
 )
 (DECLARE%: DOEVAL@COMPILE DONTCOPY
@@ -729,17 +721,15 @@ must replace the declare: by a nop addvars.") (SETQ PRTTYCOM (SUBPAIR (QUOTE (NL
 
 (ADDTOVAR LAMA
 )
 )
-(PUTPROPS PRETTY COPYRIGHT ("Venue & Xerox Corporation" T 1984 1985 1986 1987 1988 1989 1990 1999 2018
- 2023))
 (DECLARE%: DONTCOPY
-  (FILEMAP (NIL (5917 48569 (PRETTYDEF 5927 . 21600) (PRETTYDEFCOMS 21602 . 22284) (PRETTYDEF0 22286 . 
-22477) (PRETTYDEF1 22479 . 24242) (PRINTDATE 24244 . 25480) (PRINTDATE1 25482 . 27260) (PRINTFNS 27262
- . 27831) (PRETTYCOM 27833 . 34174) (PRETTYVAR 34176 . 35214) (PRETTYVAR1 35216 . 37434) (PRETTYCOM1 
-37436 . 38140) (ENDFILE 38142 . 38238) (MAKEDEFLIST 38240 . 38644) (PP 38646 . 38922) (PP* 38924 . 
-39237) (PPT 39239 . 39558) (PRETTYPRINT 39560 . 42712) (PRETTYPRINT1 42714 . 44600) (PRETTYPRINT2 
-44602 . 45918) (PRETTYPRINT3 45920 . 46875) (PRINTDEF1 46877 . 47813) (SUPERPRINTEQ 47815 . 47909) (
-SUPERPRINTGETPROP 47911 . 48055) (CHANGEFONT 48057 . 48567)) (48570 53916 (READARRAY 48580 . 49506) (
-PRINTARRAY 49508 . 51248) (READARRAY-FROM-LIST 51250 . 52355) (PRINTARRAY-TO-LIST 52357 . 53914)) (
-54043 61561 (PRINTCOPYRIGHT 54053 . 58130) (PRINTCOPYRIGHT1 58132 . 61256) (SAVECOPYRIGHT 61258 . 
-61559)))))
+  (FILEMAP (NIL (5565 48217 (PRETTYDEF 5575 . 21248) (PRETTYDEFCOMS 21250 . 21932) (PRETTYDEF0 21934 . 
+22125) (PRETTYDEF1 22127 . 23890) (PRINTDATE 23892 . 25128) (PRINTDATE1 25130 . 26908) (PRINTFNS 26910
+ . 27479) (PRETTYCOM 27481 . 33822) (PRETTYVAR 33824 . 34862) (PRETTYVAR1 34864 . 37082) (PRETTYCOM1 
+37084 . 37788) (ENDFILE 37790 . 37886) (MAKEDEFLIST 37888 . 38292) (PP 38294 . 38570) (PP* 38572 . 
+38885) (PPT 38887 . 39206) (PRETTYPRINT 39208 . 42360) (PRETTYPRINT1 42362 . 44248) (PRETTYPRINT2 
+44250 . 45566) (PRETTYPRINT3 45568 . 46523) (PRINTDEF1 46525 . 47461) (SUPERPRINTEQ 47463 . 47557) (
+SUPERPRINTGETPROP 47559 . 47703) (CHANGEFONT 47705 . 48215)) (48218 53564 (READARRAY 48228 . 49154) (
+PRINTARRAY 49156 . 50896) (READARRAY-FROM-LIST 50898 . 52003) (PRINTARRAY-TO-LIST 52005 . 53562)) (
+53691 61209 (PRINTCOPYRIGHT 53701 . 57778) (PRINTCOPYRIGHT1 57780 . 60904) (SAVECOPYRIGHT 60906 . 
+61207)))))
 STOP
diff --git a/sources/PRETTY.LCOM b/sources/PRETTY.LCOM
index 02e7d893a..e71a4c9cc 100644
Binary files a/sources/PRETTY.LCOM and b/sources/PRETTY.LCOM differ
diff --git a/sources/VANILLADISK b/sources/VANILLADISK
index 7cb24ae5d..fdce9a245 100644
--- a/sources/VANILLADISK
+++ b/sources/VANILLADISK
@@ -1,62 +1,68 @@
 (DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "XCL" BASE 10)
-
(FILECREATED "17-May-90 16:13:16" |{DSK}<usr>local>lde>lispcore>sources>VANILLADISK.;2|
 5292   
 
-      |changes| |to:|  (VARS VANILLADISKCOMS)
+
(FILECREATED "24-Aug-2025 11:50:09" 
+|{DSK}<Users>kaplan>Local>medley3.5>working-medley>sources>VANILLADISK.;3|
 5267   
 
-      |previous| |date:| " 7-Apr-88 17:53:38" |{DSK}<usr>local>lde>lispcore>sources>VANILLADISK.;1|
-)
+      :EDIT-BY |rmk|
+
+      :CHANGES-TO (FNS \\VANILLADISKINIT)
 
+      :PREVIOUS-DATE "17-May-90 16:13:16" 
+|{DSK}<Users>kaplan>Local>medley3.5>working-medley>sources>VANILLADISK.;2|)
 
-; Copyright (c) 1985, 1986, 1988, 1990 by Venue & Xerox Corporation.  All rights reserved.
 
 (PRETTYCOMPRINT VANILLADISKCOMS)
 
 (RPAQQ VANILLADISKCOMS
 ((FNS \\VANILLADISKINIT \\VANILLAHOSTNAMEP \\VANILLAEVENTFN)
-                            (INITVARS (\\PSEUDODSK))
-                            (GLOBALVARS \\PSEUDODSK \\DISKNAMECASEARRAY)
-                            (DECLARE\: DONTEVAL@LOAD (P (\\VANILLADISKINIT)))
-                            (LOCALVARS . T)))
+                        (INITVARS (\\PSEUDODSK))
+                        (GLOBALVARS \\PSEUDODSK \\DISKNAMECASEARRAY)
+                        (DECLARE\: DONTEVAL@LOAD (P (\\VANILLADISKINIT)))
+                        (LOCALVARS . T)))
 (DEFINEQ
 
-(\\vanilladiskinit

-  (lambda nil
                                            (* |bvm:| "30-Jan-85 21:43")

-    (prog ((arr (copyarray uppercasearray)))
-          (* * |Set| |up| |array| |that| |maps| |illegal| |filename| |chars| |to| 0 
-
        |and| |synonymous| |characters| |to| \a |canonical| |char|)

-          (|for|
 i |from|
 0 |to|
 (sub1 (charcode 0)) |do|
 (setcasearray arr i 0))
+(\\VANILLADISKINIT

+  (LAMBDA NIL
                                               (* \; "Edited 24-Aug-2025 11:49 by rmk")

+                                                             (* |bvm:| "30-Jan-85 21:43")

+    (PROG ((ARR (COPYARRAY UPPERCASEARRAY)))
+
+         (* * |Set| |up| |array| |that| |maps| |illegal| |filename| |chars| |to| 0 |and| 
+
         |synonymous| |characters| |to| \a |canonical| |char|)

+
+          (|for|
 I |from|
 0 |to|
 (SUB1 (CHARCODE 0)) |do|
 (SETCASEARRAY ARR I 0))
                                                              (* |Non-printing| |characters| 
-
                                                           |verboten|)

-          (|for|
 i |from|
 (add1 (charcode 9)) |to|
 (sub1 (charcode a))
-             |do|
 (setcasearray arr i 0))
-          (|for|
 i |from|
 (add1 (charcode z)) |to|
 (sub1 (charcode \a))
-             |do|
 (setcasearray arr i 0))
-          (|for|
 i |from|
 (add1 (charcode \z)) |to|
 \\maxchar
-             |do|
 (setcasearray arr i 0))
-          (setcasearray arr (charcode \;)
-                 (charcode \;))
-          (setcasearray arr (charcode !)
-                 (charcode \;))
-          (setcasearray arr (charcode *
)
-                 (charcode *
))
-          (setcasearray arr (charcode escape)
-                 (charcode *
))
-          (setcasearray arr (charcode ?)
-                 (charcode \#))
-          (setcasearray arr (charcode \.)
-                 (charcode \.))
-          (setcasearray arr (charcode -
)
-                 (charcode -
))
-          (setcasearray arr (charcode +)
-                 (charcode +))
-          (setcasearray arr (charcode $)
-                 (charcode $))
-          (setq \\disknamecasearray arr))
-          (* * |Define| \a |device| |whose| |sole| |purpose| |is| |to| |select| |the| 
-
        |appropriate| dsk |device| |depending| |on| |which| |machine| |you're| |on|)

-    (\\definedevice nil (|create|
 fdev
-                               devicename _ "VANILLADISK"
-                               eventfn _ (function nill)
-                               hostnamep _ (function \\vanillahostnamep)))))
+
                                                             |verboten|)

+          (|for|
 I |from|
 (ADD1 (CHARCODE 9)) |to|
 (SUB1 (CHARCODE A))
+             |do|
 (SETCASEARRAY ARR I 0))
+          (|for|
 I |from|
 (ADD1 (CHARCODE Z)) |to|
 (SUB1 (CHARCODE \a))
+             |do|
 (SETCASEARRAY ARR I 0))
+          (|for|
 I |from|
 (ADD1 (CHARCODE \z)) |to|
 \\MAXTHINCHAR |do|
 (SETCASEARRAY ARR I 0))
+          (SETCASEARRAY ARR (CHARCODE \;)
+                 (CHARCODE \;))
+          (SETCASEARRAY ARR (CHARCODE !)
+                 (CHARCODE \;))
+          (SETCASEARRAY ARR (CHARCODE *
)
+                 (CHARCODE *
))
+          (SETCASEARRAY ARR (CHARCODE ESCAPE)
+                 (CHARCODE *
))
+          (SETCASEARRAY ARR (CHARCODE ?)
+                 (CHARCODE \#))
+          (SETCASEARRAY ARR (CHARCODE \.)
+                 (CHARCODE \.))
+          (SETCASEARRAY ARR (CHARCODE -
)
+                 (CHARCODE -
))
+          (SETCASEARRAY ARR (CHARCODE +)
+                 (CHARCODE +))
+          (SETCASEARRAY ARR (CHARCODE $)
+                 (CHARCODE $))
+          (SETQ \\DISKNAMECASEARRAY ARR))
+
+         (* * |Define| \a |device| |whose| |sole| |purpose| |is| |to| |select| |the| 
+
         |appropriate| DSK |device| |depending| |on| |which| |machine| |you're| |on|)

+
+    (\\DEFINEDEVICE NIL (|create|
 FDEV
+                               DEVICENAME _ "VANILLADISK"
+                               EVENTFN _ (FUNCTION NILL)
+                               HOSTNAMEP _ (FUNCTION \\VANILLAHOSTNAMEP)))))
 
 (\\vanillahostnamep

   (lambda (name)
                                     (* \; "Edited  7-Apr-88 17:20 by masinter")


@@ -115,8 +121,7 @@
 
 (LOCALVARS . T)
 )
-(PUTPROPS VANILLADISK COPYRIGHT ("Venue & Xerox Corporation" 1985 1986 1988 1990))
 (DECLARE\: DONTCOPY
-  (FILEMAP (NIL (784 4970 (\\VANILLADISKINIT 794 . 2901) (\\VANILLAHOSTNAMEP 2903 . 4547) (
-\\VANILLAEVENTFN 4549 . 4968)))))
+  (FILEMAP (NIL (736 5028 (\\VANILLADISKINIT 746 . 2959) (\\VANILLAHOSTNAMEP 2961 . 4605) (
+\\VANILLAEVENTFN 4607 . 5026)))))
 STOP
diff --git a/sources/VANILLADISK.LCOM b/sources/VANILLADISK.LCOM
index 86a815e31..c5299515a 100644
Binary files a/sources/VANILLADISK.LCOM and b/sources/VANILLADISK.LCOM differ
diff --git a/unicode/xerox/UNICODE-MAPPINGS.TXT b/unicode/xerox/MCCS-TO-UNICODE-MAPPINGS.TXT
similarity index 99%
rename from unicode/xerox/UNICODE-MAPPINGS.TXT
rename to unicode/xerox/MCCS-TO-UNICODE-MAPPINGS.TXT
index dc63b6e58..2ed56e6f6 100644
--- a/unicode/xerox/UNICODE-MAPPINGS.TXT
+++ b/unicode/xerox/MCCS-TO-UNICODE-MAPPINGS.TXT
@@ -5,18 +5,18 @@
  (53 53) (54 54) (55 55) (56 56) (57 57) (58 58) (59 59) (60 60) (61 61) (62 62) (63 63) (64 64) (65 
 65) (66 66) (67 67) (68 68) (69 69) (70 70) (71 71) (72 72) (73 73) (74 74) (75 75) (76 76) (77 77) (
 78 78) (79 79) (80 80) (81 81) (82 82) (83 83) (84 84) (85 85) (86 86) (87 87) (88 88) (89 89) (90 90)
- (91 91) (92 92) (93 93) (94 94) (95 95) (96 96) (97 97) (98 98) (99 99) (100 100) (101 101) (102 102)
- (103 103) (104 104) (105 105) (106 106) (107 107) (108 108) (109 109) (110 110) (111 111) (112 112) (
-113 113) (114 114) (115 115) (116 116) (117 117) (118 118) (119 119) (120 120) (121 121) (122 122) (
-123 123) (124 124) (125 125) (126 126) (161 161) (162 162) (163 163) (164 36) (165 165) (167 167) (169
- 8216) (170 8220) (171 171) (172 8592) (173 8593) (174 8594) (175 8595) (176 176) (177 177) (178 178) 
-(179 179) (180 215) (181 181) (182 182) (183 183) (184 247) (185 8217) (186 8221) (187 187) (188 188) 
-(189 189) (190 190) (191 191) (193 768) (194 769) (195 770) (196 771) (197 772) (198 774) (199 775) (
-200 776) (202 778) (203 807) (204 818) (205 779) (206 808) (207 780) (208 8213) (209 185) (210 174) (
-211 169) (212 8482) (213 9834) (220 8539) (221 8540) (222 8541) (223 8542) (224 8486) (225 198) (226 
-208) (227 170) (228 294) (229 567) (230 306) (231 319) (232 321) (233 216) (234 338) (235 186) (236 
-222) (237 358) (238 330) (239 329) (240 312) (241 230) (242 273) (243 240) (244 295) (245 305) (246 
-307) (247 320) (248 322) (249 248) (250 339) (251 223) (252 254) (253 359) (254 331))]
+ (91 91) (92 92) (93 93) (94 8593) (95 8592) (96 96) (97 97) (98 98) (99 99) (100 100) (101 101) (102 
+102) (103 103) (104 104) (105 105) (106 106) (107 107) (108 108) (109 109) (110 110) (111 111) (112 
+112) (113 113) (114 114) (115 115) (116 116) (117 117) (118 118) (119 119) (120 120) (121 121) (122 
+122) (123 123) (124 124) (125 125) (126 126) (161 161) (162 162) (163 163) (164 164) (165 165) (167 
+167) (169 8216) (170 8220) (171 171) (172 95) (173 94) (174 8594) (175 8595) (176 176) (177 177) (178 
+178) (179 179) (180 215) (181 181) (182 182) (183 183) (184 247) (185 8217) (186 8221) (187 187) (188 
+188) (189 189) (190 190) (191 191) (193 768) (194 769) (195 770) (196 771) (197 772) (198 774) (199 
+775) (200 776) (202 778) (203 807) (204 818) (205 779) (206 808) (207 780) (208 8213) (209 185) (210 
+174) (211 169) (212 8482) (213 9834) (220 8539) (221 8540) (222 8541) (223 8542) (224 8486) (225 198) 
+(226 208) (227 170) (228 294) (229 567) (230 306) (231 319) (232 321) (233 216) (234 338) (235 186) (
+236 222) (237 358) (238 330) (239 329) (240 312) (241 230) (242 273) (243 240) (244 295) (245 305) (
+246 307) (247 320) (248 322) (249 248) (250 339) (251 223) (252 254) (253 359) (254 331))]
 
 [33 ((8481 12288) (8482 12289) (8483 12290) (8484 65292) (8485 65294) (8491 12441) (8492 12442) (8499 
 12541) (8500 12542) (8501 12445) (8502 12446) (8503 12291) (8504 20189) (8505 12293) (8506 12294) (
diff --git a/unicode/xerox/INVERTED-UNICODE-MAPPINGS.TXT b/unicode/xerox/UNICODE-TO-MCCS-MAPPINGS.TXT
similarity index 98%
rename from unicode/xerox/INVERTED-UNICODE-MAPPINGS.TXT
rename to unicode/xerox/UNICODE-TO-MCCS-MAPPINGS.TXT
index 60972a834..6e7a7cf3a 100644
--- a/unicode/xerox/INVERTED-UNICODE-MAPPINGS.TXT
+++ b/unicode/xerox/UNICODE-TO-MCCS-MAPPINGS.TXT
@@ -1,27 +1,28 @@
 [0 ((0 0) (1 1) (2 2) (3 3) (4 4) (5 5) (6 6) (7 7) (8 8) (9 9) (10 10) (11 11) (12 12) (13 13) (14 14
 ) (15 15) (16 16) (17 17) (18 18) (19 19) (20 20) (21 21) (22 22) (23 23) (24 24) (25 25) (26 26) (27 
-27) (28 28) (29 29) (30 30) (31 31) (32 32 58273) (33 33 60981) (34 34) (35 35) (36 36 164 61350) (37 
-37) (38 38) (39 39 8999 61223) (40 40) (41 41) (42 42 60464) (43 43) (44 44 57644) (45 45) (46 46) (47
- 47) (48 48) (49 49) (50 50) (51 51) (52 52) (53 53) (54 54) (55 55) (56 56) (57 57) (58 58) (59 59 
-57659) (60 60) (61 61) (62 62) (63 63) (64 64 60480 60496) (65 65) (66 66) (67 67) (68 68) (69 69) (70
- 70) (71 71) (72 72) (73 73) (74 74) (75 75) (76 76) (77 77) (78 78) (79 79) (80 80) (81 81) (82 82) (
-83 83) (84 84) (85 85) (86 86) (87 87) (88 88) (89 89) (90 90) (91 91) (92 92) (93 93) (94 94 8896) (
-95 95) (96 96 9056) (97 97 57947) (98 98 58019) (99 99 58072) (100 100 58033) (101 101 57942) (102 102
- 58028) (103 103) (104 104 58094) (105 105 57937) (106 106) (107 107 58078) (108 108 58045) (109 109 
+27) (28 28) (29 29) (30 30) (31 31) (32 32 58273) (33 33 60981) (34 34) (35 35) (36 36 61350) (37 37) 
+(38 38) (39 39 8999 61223) (40 40) (41 41) (42 42 60464) (43 43) (44 44 57644) (45 45) (46 46) (47 47)
+ (48 48) (49 49) (50 50) (51 51) (52 52) (53 53) (54 54) (55 55) (56 56) (57 57) (58 58) (59 59 57659)
+ (60 60) (61 61) (62 62) (63 63) (64 64 60480 60496) (65 65) (66 66) (67 67) (68 68) (69 69) (70 70) (
+71 71) (72 72) (73 73) (74 74) (75 75) (76 76) (77 77) (78 78) (79 79) (80 80) (81 81) (82 82) (83 83)
+ (84 84) (85 85) (86 86) (87 87) (88 88) (89 89) (90 90) (91 91) (92 92) (93 93) (94 173 8896) (95 172
+) (96 96 9056) (97 97 57947) (98 98 58019) (99 99 58072) (100 100 58033) (101 101 57942) (102 102 
+58028) (103 103) (104 104 58094) (105 105 57937) (106 106) (107 107 58078) (108 108 58045) (109 109 
 58017) (110 110 58031) (111 111 57961) (112 112 58018) (113 113 58086) (114 114 58048) (115 115 58038)
  (116 116 58032) (117 117 57957) (118 118 58029) (119 119 58024) (120 120 58080 64888) (121 121 57938)
  (122 122 58039) (123 123) (124 124 8615 61045) (125 125) (126 126) (160 59109 61217) (161 161) (162 
-162) (163 163) (165 165) (166 61291) (167 167) (168 8994) (169 211) (170 227) (171 171) (172 61290) (
-173 61219) (174 210) (175 8996) (176 176) (177 177) (178 178 64946) (179 179 64947) (180 8995) (181 
-181) (182 182) (183 183 9008 61692) (184 9004) (185 209 64945) (186 235) (187 187) (188 188 61552) (
-189 189 61553) (190 190 61554) (191 191) (192 61729) (193 61730) (194 61731) (195 61732) (196 61735) (
-197 61736) (198 225) (199 61741) (200 61744) (201 61745) (202 61746) (203 61749) (204 61758) (206 
-61760) (207 61764) (208 226) (209 61772) (210 61775) (211 61776) (212 61777) (213 61778) (214 61780) (
-215 180) (216 233) (217 61791) (218 61792) (219 61793) (220 61797) (221 61803) (222 236) (223 251) (
-224 61857) (225 61858) (226 61859) (227 61860) (228 61863) (229 61864) (230 241 57946) (231 58074 
-61869) (232 61872) (233 61873) (234 61874) (235 61877) (236 61886) (237 61887) (238 61888) (239 61892)
- (240 243 58035) (241 61900) (242 61903) (243 61904) (244 61905) (245 61906) (246 61908) (247 184) (
-248 249 57943) (249 61919) (250 61920) (251 61921) (252 61925) (253 61931) (254 252) (255 61933))]
+162) (163 163) (164 164) (165 165) (166 61291) (167 167) (168 8994) (169 211) (170 227) (171 171) (172
+ 61290) (173 61219) (174 210) (175 8996) (176 176) (177 177) (178 178 64946) (179 179 64947) (180 8995
+) (181 181) (182 182) (183 183 9008 61692) (184 9004) (185 209 64945) (186 235) (187 187) (188 188 
+61552) (189 189 61553) (190 190 61554) (191 191) (192 61729) (193 61730) (194 61731) (195 61732) (196 
+61735) (197 61736) (198 225) (199 61741) (200 61744) (201 61745) (202 61746) (203 61749) (204 61758) (
+206 61760) (207 61764) (208 226) (209 61772) (210 61775) (211 61776) (212 61777) (213 61778) (214 
+61780) (215 180) (216 233) (217 61791) (218 61792) (219 61793) (220 61797) (221 61803) (222 236) (223 
+251) (224 61857) (225 61858) (226 61859) (227 61860) (228 61863) (229 61864) (230 241 57946) (231 
+58074 61869) (232 61872) (233 61873) (234 61874) (235 61877) (236 61886) (237 61887) (238 61888) (239 
+61892) (240 243 58035) (241 61900) (242 61903) (243 61904) (244 61905) (245 61906) (246 61908) (247 
+184) (248 249 57943) (249 61919) (250 61920) (251 61921) (252 61925) (253 61931) (254 252) (255 61933)
+)]
 
 [1 ((256 61733) (257 61861) (258 61734) (259 61862) (260 61737) (261 61865) (262 61738) (263 61866) (
 264 61739) (265 61867) (266 61740) (267 61868) (268 61742) (269 61870) (270 61743) (271 61871) (273 
@@ -302,7 +303,7 @@
 (8534 60241) (8535 60242) (8536 60243) (8537 60244) (8538 60245) (8539 220 61557) (8540 221 61558) (
 8541 222 61559) (8542 223 61560) (8543 61561) (8544 61377) (8545 61378) (8546 61379) (8547 61380) (
 8548 61381) (8549 61382) (8550 61383) (8551 61384) (8552 61385) (8553 61386) (8554 60369) (8555 60370)
- (8592 172 61100 61628) (8593 173 61101) (8594 174 61102 61625) (8595 175 61103 61624) (8596 61266) (
+ (8592 95 61100 61628) (8593 94 61101) (8594 174 61102 61625) (8595 175 61103 61624) (8596 61266) (
 8597 61109) (8598 61244) (8599 61246) (8600 61245) (8601 61247) (8602 61175) (8603 61176) (8605 61267)
  (8606 8774) (8608 8775) (8609 61627) (8610 8780) (8611 8781) (8614 8811) (8616 61110) (8617 8795) (
 8618 8794) (8619 8782) (8620 8783) (8621 8786) (8622 61177) (8624 8784) (8625 8785) (8626 8942) (8627 
diff --git a/unicode/xerox/XCCS-0=LATIN.TXT b/unicode/xerox/XCCS-0=LATIN.TXT
index 7a6babe81..af4d15e03 100644
--- a/unicode/xerox/XCCS-0=LATIN.TXT
+++ b/unicode/xerox/XCCS-0=LATIN.TXT
@@ -43,20 +43,20 @@
 
 
 #   "0" LATIN
-0x0000	0x0000	#  ^@
+0x0000	0x0000	#  ^@ NULL
 0x0001	0x0001	#  ^A
 0x0002	0x0002	#  ^B
 0x0003	0x0003	#  ^C
 0x0004	0x0004	#  ^D
 0x0005	0x0005	#  ^E
 0x0006	0x0006	#  ^F
-0x0007	0x0007	#  ^G
-0x0008	0x0008	#  ^H
-0x0009	0x0009	#  ^I
-0x000A	0x000A	#  ^J
-0x000B	0x000B	#  ^K
-0x000C	0x000C	#  ^L
-0x000D	0x000D	#  ^M
+0x0007	0x0007	#  ^G BELL
+0x0008	0x0008	#  ^H BS
+0x0009	0x0009	#  ^I TAB
+0x000A	0x000A	#  ^J LF
+0x000B	0x000B	#  ^K VTAB
+0x000C	0x000C	#  ^L FORM
+0x000D	0x000D	#  ^M CR
 0x000E	0x000E	#  ^N
 0x000F	0x000F	#  ^O
 0x0010	0x0010	#  ^P
@@ -70,7 +70,7 @@
 0x0018	0x0018	#  ^X
 0x0019	0x0019	#  ^Y
 0x001A	0x001A	#  ^Z
-0x001B	0x001B	#  ^[
+0x001B	0x001B	#  ^[ ESCAPE
 0x001C	0x001C	#  ^\
 0x001D	0x001D	#  ^]
 0x001E	0x001E	#  ^^
@@ -79,8 +79,7 @@
 0x0021	0x0021	#  ! EXCLAMATION MARK
 0x0022	0x0022	#  " QUOTATION MARK
 0x0023	0x0023	#  # NUMBER SIGN
-#    0x0024	0x00A4	#  ¤ CURRENCY SIGN
-0x0024	0x0024	#  $ DOLLAR SIGN
+0x0024	0x00A4	#  ¤ CURRENCY SIGN
 0x0025	0x0025	#  % PERCENT SIGN
 0x0026	0x0026	#  & AMPERSAND
 0x0027	0x0027	#  ' APOSTROPHE