diff --git a/library/PDFSTREAM b/library/PDFSTREAM
index 49a6393c..bde1d1e2 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 7c6ef662..ed13f5a9 100644
Binary files a/library/PDFSTREAM.LCOM and b/library/PDFSTREAM.LCOM differ
diff --git a/library/POSTSCRIPTSTREAM b/library/POSTSCRIPTSTREAM
index 3b96c4ae..925b8b1a 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 "10-Sep-2025 14:51:53" {WMEDLEY}<library>POSTSCRIPTSTREAM.;42 258973 
 
       :EDIT-BY rmk
 
-      :CHANGES-TO (FNS \DSPFONT.PSC)
+      :CHANGES-TO (FNS POSTSCRIPTFILEP POSTSCRIPT.INIT)
 
-      :PREVIOUS-DATE "16-Jun-2025 00:04:32" {WMEDLEY}<library>POSTSCRIPTSTREAM.;23)
+      :PREVIOUS-DATE " 8-Sep-2025 09:51:34" {WMEDLEY}<library>POSTSCRIPTSTREAM.;39)
 
 
 (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)
@@ -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,198 +889,203 @@
          FONTID])
 
 (POSTSCRIPT.FONTCREATE
-  [LAMBDA (FAMILY SIZE FACE ROTATION DEVICE)                 (* ; "Edited 15-Jun-2025 23:40 by rmk")
+  [LAMBDA (FONTSPEC)                                         (* ; "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)))
+    (LET* (UNITFONT FULLNAME SCALEFONTP PSCFD ASCENT DESCENT FIXPWIDTHS PSCWIDTHSBLOCK WIDTHSBLOCK FD
+                 FACECHANGED FAMILY SIZE FACE ROTATION DEVICE (WEIGHT (CAR FACE))
+                 (SLOPE (CADR FACE))
+                 (EXPANSION (CADDR FACE)))
+          (SPREADFONTSPEC FONTSPEC)
 
-         (* ;; 
+          (* ;; 
     "Ignore rotations, it is **MUCH** easier to rotate the Postscript stream user space coordinates.")
 
-         [COND
-            [(EQ SIZE 1)
+          [COND
+             [(EQ SIZE 1)
 
-             (* ;; "Since a 1 point font is ridiculously small, and it is the standard size for Postscript font info, a 1 point font is presumed to be the unit size Postscript font info")
+              (* ;; "Since a 1 point font is ridiculously small, and it is the standard size for Postscript font info, a 1 point font is presumed to be the unit size Postscript font info")
 
-             (COND
-                ((SETQ PSCFD (PSCFONTFROMCACHE.SPELLFILE FAMILY SIZE FACE ROTATION DEVICE))
+              (COND
+                 ((SETQ PSCFD (PSCFONTFROMCACHE.SPELLFILE FAMILY SIZE FACE ROTATION DEVICE))
 
-                 (* ;; "Check in-core cache for exact match first")
+                  (* ;; "Check in-core cache for exact match first")
 
-                 (SETQ FACECHANGED NIL))
-                ((SETQ FULLNAME (PSCFONT.SPELLFILE FAMILY SIZE FACE ROTATION DEVICE))
+                  (SETQ FACECHANGED NIL))
+                 ((SETQ FULLNAME (PSCFONT.SPELLFILE FAMILY SIZE FACE ROTATION DEVICE))
 
-                 (* ;; "Check file for exact match next")
+                  (* ;; "Check file for exact match next")
 
-                 (SETQ PSCFD (PSCFONT.READFONT FULLNAME))
-                 (SETQ FACECHANGED NIL))
-                ((SETQ PSCFD (PSCFONTFROMCACHE.COERCEFILE FAMILY SIZE WEIGHT SLOPE EXPANSION ROTATION
-                                    DEVICE))
+                  (SETQ PSCFD (PSCFONT.READFONT FULLNAME))
+                  (SETQ FACECHANGED NIL))
+                 ((SETQ PSCFD (PSCFONTFROMCACHE.COERCEFILE FAMILY SIZE WEIGHT SLOPE EXPANSION 
+                                     ROTATION DEVICE))
 
-                 (* ;; "Then check cache for coerced match")
+                  (* ;; "Then check cache for coerced match")
 
-                 (SETQ FACECHANGED T))
-                ((SETQ FULLNAME (PSCFONT.COERCEFILE FAMILY SIZE WEIGHT SLOPE EXPANSION ROTATION 
-                                       DEVICE))
+                  (SETQ FACECHANGED T))
+                 ((SETQ FULLNAME (PSCFONT.COERCEFILE FAMILY SIZE WEIGHT SLOPE EXPANSION ROTATION 
+                                        DEVICE))
 
-                 (* ;; "Check file for coerced match")
+                  (* ;; "Check file for coerced match")
 
-                 (SETQ PSCFD (PSCFONT.READFONT FULLNAME))
-                 (SETQ FACECHANGED T)))
-             (COND
-                (PSCFD (SETQ ASCENT (FIXR (TIMES (fetch (PSCFONT ASCENT) of PSCFD)
-                                                 0.1)))
-                       (SETQ DESCENT (FIXR (TIMES (fetch (PSCFONT DESCENT) of PSCFD)
+                  (SETQ PSCFD (PSCFONT.READFONT FULLNAME))
+                  (SETQ FACECHANGED T)))
+              (COND
+                 (PSCFD (SETQ ASCENT (FIXR (TIMES (fetch (PSCFONT ASCENT) of PSCFD)
                                                   0.1)))
-                       (COND
-                          (FACECHANGED (replace (PSCFONT IL-FONTID) of PSCFD
-                                          with (POSTSCRIPT.GETFONTID (fetch (PSCFONT FID)
-                                                                        of PSCFD)
-                                                      WEIGHT SLOPE EXPANSION]
-            ((SETQ UNITFONT (FONTCREATE FAMILY 1 FACE ROTATION DEVICE T))
-             (SETQ PSCFD (LISTGET (fetch (FONTDESCRIPTOR OTHERDEVICEFONTPROPS) of UNITFONT)
-                                'PSCFONT))
-
-             (* ;; "Scale the ASCENT and DESCENT")
-
-             (SETQ ASCENT (FIXR (TIMES SIZE (fetch (PSCFONT ASCENT) of PSCFD)
-                                       0.1)))
-             (SETQ DESCENT (FIXR (TIMES SIZE (fetch (PSCFONT DESCENT) of PSCFD)
-                                        0.1)))
-             (SETQ SCALEFONTP T))
-            (T 
-               (* ;; "Here for fonts that only come in specific sizes.  Their info is not scaled like built-in Postscript fonts, it is already correct for this pointsize.")
-
-               (COND
-                  ([SETQ PSCFD (COND
-                                  ((PSCFONTFROMCACHE.SPELLFILE FAMILY SIZE FACE ROTATION DEVICE))
-                                  ((SETQ FULLNAME (PSCFONT.SPELLFILE FAMILY SIZE FACE ROTATION DEVICE
-                                                         ))
-                                   (PSCFONT.READFONT FULLNAME]
-                   (SETQ ASCENT (fetch (PSCFONT ASCENT) of PSCFD))
-                   (SETQ DESCENT (fetch (PSCFONT DESCENT) of PSCFD))
-                   (SETQ SCALEFONTP NIL]
-         (COND
-            (PSCFD 
-                   (* ;; "Set up the Charset descriptions and Widths vectors for character set 0:")
-
-                   (SETQ FD
-                    (create FONTDESCRIPTOR
-                           OTHERDEVICEFONTPROPS _ (LIST 'PSCFONT PSCFD)
-                           FONTSCALE _ 100
-                           FONTDEVICE _ DEVICE
-                           FONTFAMILY _ FAMILY
-                           FONTSIZE _ SIZE
-                           FONTFACE _ FACE
-                           ROTATION _ 0
-                           \SFHeight _ (IPLUS ASCENT DESCENT)
-                           \SFAscent _ ASCENT
-                           \SFDescent _ DESCENT))
-                   (SETQ WIDTHSBLOCK (fetch (CHARSETINFO WIDTHS) of (\GETCHARSETINFO 0 FD)))
-                   (SETQ FIXPWIDTHS (fetch (PSCFONT WIDTHS) of PSCFD))
-                   [COND
-                      [SCALEFONTP (for CH from 0 to 255
-                                     do (\FSETWIDTH WIDTHSBLOCK CH (FIXR (TIMES SIZE (ELT FIXPWIDTHS
-                                                                                          CH)
-                                                                                0.1]
-                      (T (for CH from 0 to 255 do (\FSETWIDTH WIDTHSBLOCK CH (ELT FIXPWIDTHS CH]
-                   (SETQ PSCWIDTHSBLOCK (\CREATECSINFOELEMENT))
-
-                   (* ;; "PSCWIDTHSBLOCK preserves the scaled widths from the original postscript metrics, not the NS mapping of them, which goes into WIDTHSBLOCK.")
-
-                   (for CH from 0 to 255 do (\FSETWIDTH PSCWIDTHSBLOCK CH (\FGETWIDTH WIDTHSBLOCK CH)
-                                                   ))
-                   [LET [(TMP (COND
-                                 (FULLNAME (\FONTINFOFROMFILENAME 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")
-
+                        (SETQ DESCENT (FIXR (TIMES (fetch (PSCFONT DESCENT) of PSCFD)
+                                                   0.1)))
                         (COND
-                           ((AND TMP (NEQ FAMILY (CAR TMP)))
-                            (replace FONTDEVICESPEC of FD with (LIST (CAR TMP)
-                                                                     SIZE
-                                                                     (COPY FACE)
-                                                                     0 DEVICE]
-                   [LET ((SYMWIDTHS (\POSTSCRIPT.SPECIALFONT.SCALEDWIDTHS 'SYMBOL FD ROTATION DEVICE)
-                                )
-                         (DINGWIDTHS (\POSTSCRIPT.SPECIALFONT.SCALEDWIDTHS 'ZAPFDINGBATS FD ROTATION
-                                            DEVICE)))
+                           (FACECHANGED (replace (PSCFONT IL-FONTID) of PSCFD
+                                           with (POSTSCRIPT.GETFONTID (fetch (PSCFONT FID)
+                                                                         of PSCFD)
+                                                       WEIGHT SLOPE EXPANSION]
+             ((SETQ UNITFONT (FONTCREATE FAMILY 1 FACE ROTATION DEVICE T))
+              (SETQ PSCFD (LISTGET (fetch (FONTDESCRIPTOR OTHERDEVICEFONTPROPS) of UNITFONT)
+                                 'PSCFONT))
 
-                        (* ;; 
+              (* ;; "Scale the ASCENT and DESCENT")
+
+              (SETQ ASCENT (FIXR (TIMES SIZE (fetch (PSCFONT ASCENT) of PSCFD)
+                                        0.1)))
+              (SETQ DESCENT (FIXR (TIMES SIZE (fetch (PSCFONT DESCENT) of PSCFD)
+                                         0.1)))
+              (SETQ SCALEFONTP T))
+             (T 
+                (* ;; "Here for fonts that only come in specific sizes.  Their info is not scaled like built-in Postscript fonts, it is already correct for this pointsize.")
+
+                (COND
+                   ([SETQ PSCFD (COND
+                                   ((PSCFONTFROMCACHE.SPELLFILE FAMILY SIZE FACE ROTATION DEVICE))
+                                   ((SETQ FULLNAME (PSCFONT.SPELLFILE FAMILY SIZE FACE ROTATION 
+                                                          DEVICE))
+                                    (PSCFONT.READFONT FULLNAME]
+                    (SETQ ASCENT (fetch (PSCFONT ASCENT) of PSCFD))
+                    (SETQ DESCENT (fetch (PSCFONT DESCENT) of PSCFD))
+                    (SETQ SCALEFONTP NIL]
+          (COND
+             (PSCFD 
+                    (* ;; "Set up the Charset descriptions and Widths vectors for character set 0:")
+
+                    (SETQ FD
+                     (create FONTDESCRIPTOR
+                            OTHERDEVICEFONTPROPS _ (LIST 'PSCFONT PSCFD)
+                            FONTSCALE _ 100
+                            FONTDEVICE _ DEVICE
+                            FONTFAMILY _ FAMILY
+                            FONTSIZE _ SIZE
+                            FONTFACE _ FACE
+                            ROTATION _ 0
+                            \SFHeight _ (IPLUS ASCENT DESCENT)
+                            \SFAscent _ ASCENT
+                            \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
+                                      do (\FSETWIDTH WIDTHSBLOCK CH (FIXR (TIMES SIZE
+                                                                                 (ELT FIXPWIDTHS CH)
+                                                                                 0.1]
+                       (T (for CH from 0 to 255 do (\FSETWIDTH WIDTHSBLOCK CH (ELT FIXPWIDTHS CH]
+                    (SETQ PSCWIDTHSBLOCK (\CREATECSINFOELEMENT))
+
+                    (* ;; "PSCWIDTHSBLOCK preserves the scaled widths from the original postscript metrics, not the NS mapping of them, which goes into WIDTHSBLOCK.")
+
+                    (for CH from 0 to 255 do (\FSETWIDTH PSCWIDTHSBLOCK CH (\FGETWIDTH WIDTHSBLOCK CH
+                                                                                  )))
+                    [LET [(TMP (COND
+                                  (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")
+
+                         (COND
+                            ((AND TMP (NEQ FAMILY (CAR TMP)))
+                             (replace FONTDEVICESPEC of FD with (LIST (CAR TMP)
+                                                                      SIZE
+                                                                      (COPY FACE)
+                                                                      0 DEVICE]
+                    [LET ((SYMWIDTHS (\POSTSCRIPT.SPECIALFONT.SCALEDWIDTHS 'SYMBOL FD ROTATION DEVICE
+                                            ))
+                          (DINGWIDTHS (\POSTSCRIPT.SPECIALFONT.SCALEDWIDTHS 'ZAPFDINGBATS FD ROTATION
+                                             DEVICE)))
+
+                         (* ;; 
          "Now run thru the mapping table, filling in the new font from whatever source is specified:")
 
-                        [MAPHASH *POSTSCRIPT-NS-HASH*
-                               (FUNCTION (LAMBDA (MAPPING CODE)
-                                           (DESTRUCTURING-BIND
-                                            (KIND CODE2 BASECHAR)
-                                            MAPPING
+                         [MAPHASH *POSTSCRIPT-NS-HASH*
+                                (FUNCTION (LAMBDA (MAPPING CODE)
+                                            (DESTRUCTURING-BIND
+                                             (KIND CODE2 BASECHAR)
+                                             MAPPING
 
-                                            (* ;; "Depending on what kind of item it is, process it:")
+                                             (* ;; 
+                                             "Depending on what kind of item it is, process it:")
 
-                                            (SELECTQ KIND
-                                                (NIL 
-                                                     (* ;; 
+                                             (SELECTQ KIND
+                                                 (NIL 
+                                                      (* ;; 
                                                  "Translating an NS character to a PSC char in CS 0.")
 
-                                                     (\FSETCHARWIDTH FD CODE (\FGETWIDTH 
-                                                                                    PSCWIDTHSBLOCK
-                                                                                    (\CHAR8CODE
-                                                                                     CODE2))))
-                                                (SYMBOL [AND SYMWIDTHS (\FSETCHARWIDTH
-                                                                        FD CODE (ELT SYMWIDTHS
-                                                                                     (\CHAR8CODE
-                                                                                      CODE2])
-                                                (DINGBAT [AND DINGWIDTHS (\FSETCHARWIDTH
-                                                                          FD CODE (ELT DINGWIDTHS
-                                                                                       (\CHAR8CODE
-                                                                                        CODE2])
-                                                (FUNCTION 
-                                                          (* ;; 
+                                                      (\FSETCHARWIDTH FD CODE (\FGETWIDTH
+                                                                               PSCWIDTHSBLOCK
+                                                                               (\CHAR8CODE CODE2))))
+                                                 (SYMBOL [AND SYMWIDTHS (\FSETCHARWIDTH
+                                                                         FD CODE (ELT SYMWIDTHS
+                                                                                      (\CHAR8CODE
+                                                                                       CODE2])
+                                                 (DINGBAT [AND DINGWIDTHS (\FSETCHARWIDTH
+                                                                           FD CODE
+                                                                           (ELT DINGWIDTHS
+                                                                                (\CHAR8CODE CODE2])
+                                                 (FUNCTION 
+                                                           (* ;; 
                                 "This is fake and only works for the fractions.  Need a better case.")
 
-                                                          [\FSETCHARWIDTH
-                                                           FD CODE
-                                                           (IPLUS (\FGETWIDTH PSCWIDTHSBLOCK 164)
-                                                                  (FIXR (FTIMES 1.3
-                                                                               (\FGETWIDTH
-                                                                                PSCWIDTHSBLOCK
-                                                                                (CHARCODE 1])
-                                                (ACCENT      (* ; 
+                                                           [\FSETCHARWIDTH
+                                                            FD CODE
+                                                            (IPLUS (\FGETWIDTH PSCWIDTHSBLOCK 164)
+                                                                   (FIXR (FTIMES 1.3
+                                                                                (\FGETWIDTH
+                                                                                 PSCWIDTHSBLOCK
+                                                                                 (CHARCODE 1])
+                                                 (ACCENT     (* ; 
                             "CODE2 is the rendering character but width comes from width of basechar")
-                                                        (\FSETCHARWIDTH FD CODE (\FGETWIDTH 
+                                                         (\FSETCHARWIDTH FD CODE (\FGETWIDTH 
                                                                                        PSCWIDTHSBLOCK
-                                                                                       BASECHAR)))
-                                                (ACCENTPAIR 
+                                                                                        BASECHAR)))
+                                                 (ACCENTPAIR 
 
                                               (* ;; "CODE2 and BASECHAR are overprinted, width is taken from CODE2 (the real character), basechar is the accent")
 
-                                                            (\FSETCHARWIDTH FD CODE (\FGETWIDTH
-                                                                                     PSCWIDTHSBLOCK 
-                                                                                     CODE2)))
-                                                (PROGN 
+                                                             (\FSETCHARWIDTH FD CODE (\FGETWIDTH
+                                                                                      PSCWIDTHSBLOCK
+                                                                                      CODE2)))
+                                                 (PROGN 
 
                                  (* ;; "Skip APPLY*'s on this pass, waiting until normal characters get set up, so that widths of other NS characters are available.  Also skip anything else")
 
-                                                       NIL]
+                                                        NIL]
 
-                        (* ;; "Now do APPLY*'s.  MAPPING is of the form ('APPLY* DATA PRINTFN WIDTHFN). WIDTHFN gets applied to FD and DATA (coerced by INITFN)")
+                         (* ;; "Now do APPLY*'s.  MAPPING is of the form ('APPLY* DATA PRINTFN WIDTHFN). WIDTHFN gets applied to FD and DATA (coerced by INITFN)")
 
-                        (MAPHASH *POSTSCRIPT-NS-HASH* (FUNCTION (LAMBDA (MAPPING CODE)
-                                                                  (CL:WHEN (EQ (CAR MAPPING)
-                                                                               'APPLY*)
-                                                                      (\FSETCHARWIDTH
-                                                                       FD CODE (APPLY* (CADDDR 
-                                                                                              MAPPING
-                                                                                              )
-                                                                                      FD
-                                                                                      (CADR MAPPING))
-                                                                       ))]
-                   FD)
-            (T NIL])
+                         (MAPHASH *POSTSCRIPT-NS-HASH* (FUNCTION (LAMBDA (MAPPING CODE)
+                                                                   (CL:WHEN (EQ (CAR MAPPING)
+                                                                                'APPLY*)
+                                                                       (\FSETCHARWIDTH
+                                                                        FD CODE (APPLY* (CADDDR
+                                                                                         MAPPING)
+                                                                                       FD
+                                                                                       (CADR MAPPING)
+                                                                                       )))]
+                    FD)
+             (T NIL])
 
 (\POSTSCRIPT.SPECIALFONT.SCALEDWIDTHS
   [LAMBDA (TYPE FD ROTATION DEVICE)                      (* ; "Edited  5-Oct-93 18:21 by rmk:")
@@ -1111,66 +1124,46 @@
              NEWWIDTHS)])
 
 (POSTSCRIPT.FONTSAVAILABLE
-  [LAMBDA (FAMILY SIZE FACE ROTATION DEVICE)      (* ; "Edited 12-Jan-88 13:04 by Matt Heffron")
+  [LAMBDA (FONTSPEC)                                         (* ; "Edited 25-Aug-2025 13:09 by rmk")
+                                                             (* ; "Edited 23-Aug-2025 08:19 by rmk")
 
-    (* ;; "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.")
+    (* ;; "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
-     ((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
+    (LET [(SIZE (fetch (FONTSPEC FSSIZE) of FONTSPEC))
+          (FONTSAVAILABLE (\SEARCHFONTFILES (CAR (COERCEFONTSPEC FONTSPEC]
 
-(* ;;; "If SIZE was wildcarded, then provide list of pointsizes for Postscript scaled fonts (those with a 1 point descriptor file)")
+         (* ;; "Switch from postscript family names back to the corresponding Medley names.")
 
-         (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])
+         (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,27 +1171,15 @@
 
     (* ;; "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
@@ -1419,11 +1400,12 @@
            `(REGION ,POSTSCRIPT.DEFAULT.PAGEREGION ROTATION ,(NOT (NOT POSTSCRIPT.TEXTFILE.LANDSCAPE])
 
 (POSTSCRIPTFILEP
-  [LAMBDA (FILE)                                             (* ; "Edited 21-Nov-2023 17:04 by rmk")
+  [LAMBDA (FILE)                                             (* ; "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 (CL:MEMBER (FILENAMEFIELD FILE 'EXTENSION)
+               (EXTENSIONS.FOR.PRINTFILETYPE 'POSTSCRIPT)
                :TEST
                (FUNCTION STRING-EQUAL))
         (RESETLST
@@ -2304,29 +2286,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 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.")
 
-              (FOR I (AVGCHARWIDTH _ (CHARWIDTH (CHARCODE A)
-                                                FONTDESC)) FROM 0 TO 255
-                 FIRST (CL:WHEN (EQ 0 AVGCHARWIDTH)
+              (* ;; "RMK:  Should it use the FONTSLUGWIDTH")
 
-                               (* ;; 
-  "This is what \AVGCHARWIDTH in FONT does, but we don't have it here.  Just to be extremely safe.")
-
-                               [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 +3101,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 +3127,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 +4281,10 @@
        (\PS.SCALE0 100)
        (\PS.TEMPARRAYLEN 20))
 )
+(DECLARE%: DOEVAL@COMPILE DONTCOPY
+
+(GLOBALVARS POSTSCRIPTFONTEXTENSIONS POSTSCRIPTFONTDIRECTORIES)
+)
 
 (RPAQ? POSTSCRIPT.BITMAP.SCALE 1)
 
@@ -4325,6 +4305,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
 
@@ -4414,39 +4412,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 (23396 33604 (POSTSCRIPT.INIT 23406 . 30210) (POSTSCRIPT.PUTRGBCOLOR 30212 . 31234) (
+\PSC.COLOR.TO.RGB 31236 . 33602)) (34590 69697 (PSCFONT.READFONT 34600 . 36508) (PSCFONT.SPELLFILE 
+36510 . 37323) (PSCFONT.COERCEFILE 37325 . 38897) (PSCFONTFROMCACHE.SPELLFILE 38899 . 39884) (
+PSCFONTFROMCACHE.COERCEFILE 39886 . 41538) (PSCFONT.WRITEFONT 41540 . 42555) (READ-AFM-FILE 42557 . 
+48428) (CONVERT-AFM-FILES 48430 . 49642) (POSTSCRIPT.GETFONTID 49644 . 51039) (POSTSCRIPT.FONTCREATE 
+51041 . 63724) (\POSTSCRIPT.SPECIALFONT.SCALEDWIDTHS 63726 . 66123) (POSTSCRIPT.FONTSAVAILABLE 66125
+ . 68308) (POSTSCRIPT.FONTEXISTS? 68310 . 69695)) (69698 78983 (OPENPOSTSCRIPTSTREAM 69708 . 78649) (
+CLOSEPOSTSCRIPTSTREAM 78651 . 78981)) (79028 85162 (POSTSCRIPT.HARDCOPYW 79038 . 82145) (
+POSTSCRIPT.TEDIT 82147 . 82631) (POSTSCRIPT.TEXT 82633 . 82924) (POSTSCRIPTFILEP 82926 . 84113) (
+MAKEEPSFILE 84115 . 85160)) (85163 128737 (POSTSCRIPT.BITMAPSCALE 85173 . 87629) (
+POSTSCRIPT.CLOSESTRING 87631 . 88184) (POSTSCRIPT.ENDPAGE 88186 . 89077) (POSTSCRIPT.OUTSTR 89079 . 
+90296) (POSTSCRIPT.PUTBITMAPBYTES 90298 . 98769) (POSTSCRIPT.PUTCOMMAND 98771 . 99760) (
+POSTSCRIPT.SET-FAKE-LANDSCAPE 99762 . 104282) (POSTSCRIPT.SHOWACCUM 104284 . 106439) (
+POSTSCRIPT.STARTPAGE 106441 . 108973) (\POSTSCRIPTTAB 108975 . 109772) (\PS.BOUTFIXP 109774 . 111054) 
+(\PS.SCALEHACK 111056 . 113699) (\PS.SCALEREGION 113701 . 114261) (\SCALEDBITBLT.PSC 114263 . 118573) 
+(\SETPOS.PSC 118575 . 119056) (\SETXFORM.PSC 119058 . 121642) (\STRINGWIDTH.PSC 121644 . 122117) (
+\SWITCHFONTS.PSC 122119 . 127611) (\TERPRI.PSC 127613 . 128735)) (128772 182628 (\BITBLT.PSC 128782 . 
+129334) (\BLTSHADE.PSC 129336 . 133997) (\CHARWIDTH.PSC 133999 . 134506) (\CREATECHARSET.PSC 134508 . 
+135864) (\DRAWARC.PSC 135866 . 138244) (\DRAWCIRCLE.PSC 138246 . 140497) (\DRAWCURVE.PSC 140499 . 
+144343) (\DRAWELLIPSE.PSC 144345 . 146709) (\DRAWLINE.PSC 146711 . 149451) (\DRAWPOINT.PSC 149453 . 
+150029) (\DRAWPOLYGON.PSC 150031 . 153160) (\DSPBOTTOMMARGIN.PSC 153162 . 153849) (
+\DSPCLIPPINGREGION.PSC 153851 . 155226) (\DSPCOLOR.PSC 155228 . 156159) (\DSPFONT.PSC 156161 . 159798)
+ (\DSPLEFTMARGIN.PSC 159800 . 160486) (\DSPLINEFEED.PSC 160488 . 161078) (\DSPPUSHSTATE.PSC 161080 . 
+162540) (\DSPPOPSTATE.PSC 162542 . 166027) (\DSPRESET.PSC 166029 . 166694) (\DSPRIGHTMARGIN.PSC 166696
+ . 167385) (\DSPROTATE.PSC 167387 . 168386) (\DSPSCALE.PSC 168388 . 169340) (\DSPSCALE2.PSC 169342 . 
+170182) (\DSPSPACEFACTOR.PSC 170184 . 171105) (\DSPTOPMARGIN.PSC 171107 . 171678) (\DSPTRANSLATE.PSC 
+171680 . 173711) (\DSPXPOSITION.PSC 173713 . 174277) (\DSPYPOSITION.PSC 174279 . 174870) (
+\FILLCIRCLE.PSC 174872 . 177097) (\FILLPOLYGON.PSC 177099 . 180336) (\FIXLINELENGTH.PSC 180338 . 
+181657) (\MOVETO.PSC 181659 . 182429) (\NEWPAGE.PSC 182431 . 182626)) (182684 204830 (
+\POSTSCRIPT.CHANGECHARSET 182694 . 183412) (\POSTSCRIPT.OUTCHARFN 183414 . 195684) (
+\POSTSCRIPT.PRINTSLUG 195686 . 197410) (\POSTSCRIPT.SPECIALOUTCHARFN 197412 . 199763) (\UPDATE.PSC 
+199765 . 201011) (\POSTSCRIPT.ACCENTFN 201013 . 201955) (\POSTSCRIPT.ACCENTPAIR 201957 . 204828)) (
+204928 206573 (\PSC.SPACEDISP 204938 . 205217) (\PSC.SPACEWID 205219 . 205838) (\PSC.SYMBOLS 205840 . 
+206571)) (206682 209673 (\POSTSCRIPT.NSHASH 206692 . 209671)) (255083 255789 (POSTSCRIPTSEND 255093 . 
+255787)))))
 STOP
diff --git a/library/POSTSCRIPTSTREAM.LCOM b/library/POSTSCRIPTSTREAM.LCOM
index b9601903..b8c89407 100644
Binary files a/library/POSTSCRIPTSTREAM.LCOM and b/library/POSTSCRIPTSTREAM.LCOM differ
diff --git a/sources/COREIO b/sources/COREIO
index 48002778..72ff5f56 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 8b866251..f011a7be 100644
Binary files a/sources/COREIO.LCOM and b/sources/COREIO.LCOM differ
diff --git a/sources/EXTERNALFORMAT.LCOM b/sources/EXTERNALFORMAT.LCOM
index 4e3d2dc4..3b4777b2 100644
Binary files a/sources/EXTERNALFORMAT.LCOM and b/sources/EXTERNALFORMAT.LCOM differ
diff --git a/sources/FILEIO b/sources/FILEIO
index 244a1fcf..189bad26 100644
--- a/sources/FILEIO
+++ b/sources/FILEIO
@@ -1,12 +1,14 @@
 (DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
 
-(FILECREATED "25-Dec-2024 10:56:37" {WMEDLEY}<sources>FILEIO.;138 166550 
+(FILECREATED "11-Sep-2025 20:49:24" 
+{DSK}<Users>kaplan>Local>medley3.5>working-medley>sources>FILEIO.;140 166949 
 
       :EDIT-BY rmk
 
-      :CHANGES-TO (FNS SETFILEINFO \DO.PARAMS.AT.OPEN \RENAMEFILE)
+      :CHANGES-TO (FNS 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 +2225,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,21 +2268,20 @@ 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
@@ -2440,10 +2442,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 +2718,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 +3166,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 (27784 31900 (STREAMPROP 27794 . 28228) (GETSTREAMPROP 28230 . 28979) (PUTSTREAMPROP 
+28981 . 31748) (STREAMP 31750 . 31898)) (31943 35322 (\DEFPRINT.BY.NAME 31953 . 33105) (
+\STREAM.DEFPRINT 33107 . 35015) (\FDEV.DEFPRINT 35017 . 35320)) (35580 40621 (\GETACCESS 35590 . 36044
+) (\SETACCESS 36046 . 40619)) (60847 66816 (\DEFINEDEVICE 60857 . 63173) (\GETDEVICEFROMNAME 63175 . 
+63648) (\GETDEVICEFROMHOSTNAME 63650 . 64694) (\REMOVEDEVICE 64696 . 65819) (\REMOVEDEVICE.NAMES 65821
+ . 66814)) (66856 94587 (\CLOSEFILE 66866 . 67691) (\DELETEFILE 67693 . 67987) (\DEVICEEVENT 67989 . 
+69759) (\GENERATEFILES 69761 . 70708) (\GENERATENEXTFILE 70710 . 71361) (\GENERATEFILEINFO 71363 . 
+71824) (\GETFILENAME 71826 . 72215) (\GENERIC.OUTFILEP 72217 . 72687) (\OPENFILE 72689 . 75267) (
+\DO.PARAMS.AT.OPEN 75269 . 79465) (\RENAMEFILE 79467 . 80423) (\REVALIDATEFILE 80425 . 83027) (
+\PAGED.REVALIDATEFILELST 83029 . 84587) (\PAGED.REVALIDATEFILES 84589 . 86308) (\PAGED.REVALIDATEFILE 
+86310 . 88593) (\BUFFERED.REVALIDATEFILE 88595 . 90881) (\BUFFERED.REVALIDATEFILELST 90883 . 92067) (
+\PRINT-REVALIDATION-RESULT 92069 . 92911) (\TRUNCATEFILE 92913 . 93304) (\FILE-CONFLICT 93306 . 94585)
+) (94623 99286 (\GENERATENOFILES 94633 . 96729) (\NULLFILEGENERATOR 96731 . 96975) (\NOFILESNEXTFILEFN
+ 96977 . 98968) (\NOFILESINFOFN 98970 . 99284)) (99405 101313 (\FILE.NOT.OPEN 99415 . 99928) (
+\FILE.WONT.OPEN 99930 . 100258) (\ILLEGAL.DEVICEOP 100260 . 100542) (\IS.NOT.RANDACCESSP 100544 . 
+100990) (\STREAM.NOT.OPEN 100992 . 101311)) (101448 103746 (\FDEVINSTANCE 101458 . 103744)) (104948 
+112322 (CNDIR 104958 . 106263) (DIRECTORYNAME 106265 . 110448) (DIRECTORYNAMEP 110450 . 111066) (
+HOSTNAMEP 111068 . 111875) (\ADD.CONNECTED.DIR 111877 . 112320)) (112367 141263 (\BACKFILEPTR 112377
+ . 112565) (\BACKPEEKBIN 112567 . 112928) (\BACKBIN 112930 . 113281) (BIN 113283 . 113500) (\BIN 
+113502 . 113779) (\BINS 113781 . 114067) (BOUT 114069 . 114431) (\BOUT 114433 . 114748) (\BOUTS 114750
+ . 115061) (COPYBYTES 115063 . 118395) (COPYCHARS 118397 . 122195) (COPYFILE 122197 . 123506) (
+\COPYOPENFILE 123508 . 126707) (\INFER.FILE.TYPE 126709 . 127663) (EOFP 127665 . 127962) (FORCEOUTPUT 
+127964 . 128211) (\FLUSH.OPEN.STREAMS 128213 . 128569) (CHARSET 128571 . 129930) (ACCESS-CHARSET 
+129932 . 130569) (GETEOFPTR 130571 . 130821) (GETFILEINFO 130823 . 134016) (\TYPE.FROM.FILETYPE 134018
+ . 134488) (\FILETYPE.FROM.TYPE 134490 . 134669) (GETFILEPTR 134671 . 134923) (SETFILEINFO 134925 . 
+139162) (SETFILEPTR 139164 . 140883) (BOUT16 140885 . 141070) (BIN16 141072 . 141261)) (141366 148546 
+(\GENERIC.BINS 141376 . 141656) (\GENERIC.BOUTS 141658 . 141923) (\GENERIC.RENAMEFILE 141925 . 144173)
+ (\GENERIC.OPENP 144175 . 145490) (\GENERIC.READP 145492 . 146644) (\GENERIC.CHARSET 146646 . 148544))
+ (148547 148886 (\MAP-OPEN-STREAMS 148557 . 148884)) (150741 152821 (\EOF.ACTION 150751 . 151002) (
+\EOSERROR 151004 . 151197) (\GETEOFPTR 151199 . 151381) (\INCFILEPTR 151383 . 151733) (\PEEKBIN 151735
+ . 151926) (\SETCLOSEDFILELENGTH 151928 . 152262) (\SETEOFPTR 152264 . 152452) (\SETFILEPTR 152454 . 
+152819)) (152822 153364 (\FIXPOUT 152832 . 153132) (\FIXPIN 153134 . 153362)) (153365 153931 (\BOUTEOL
+ 153375 . 153929)) (156827 166691 (\BUFFERED.BIN 156837 . 157689) (\BUFFERED.PEEKBIN 157691 . 158473) 
+(\BUFFERED.BOUT 158475 . 159335) (\BUFFERED.BINS 159337 . 163022) (\BUFFERED.BOUTS 163024 . 164825) (
+\BUFFERED.COPYBYTES 164827 . 166689)))))
 STOP
diff --git a/sources/FILEIO.LCOM b/sources/FILEIO.LCOM
index 2e96bcf1..a50f65aa 100644
Binary files a/sources/FILEIO.LCOM and b/sources/FILEIO.LCOM differ
diff --git a/sources/HARDCOPY b/sources/HARDCOPY
index 28bf7c31..4011c002 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)
-                                         ))
-
-                                 (* ;; "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. ")
-
-                                  (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]
-
-                                  (* ;; 
-          "Get PRINTOPTIONS property before closing the stream, in case the closing throws them away")
-
-                                  (* ;; "")
-
-                                 (* ;; "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)")
-
-                                  (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]
+         (replace (FDEV OPENFILE) of DEV with (FUNCTION PRINTERDEVICE.OPENFN))
+         (replace (FDEV CLOSEFILE) of DEV with (FUNCTION PRINTERDEVICE.CLOSEFN))
          (\DEFINEDEVICE NAME DEV)
          NAME])
+
+(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]
+
+         (* ;; "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. ")
+
+         (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]
+
+         (* ;; 
+         "Get PRINTOPTIONS property before closing the stream, in case the closing throws them away")
+
+         (* ;; "")
+
+         (* ;; "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")
+
+         (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]
+                                                 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))
-
-
-
-(* ; "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]
+(\FONTCREATE.HCPYMODE
+  [LAMBDA (FONTSPEC)                                         (* ; "Edited  2-Sep-2025 22:37 by rmk")
+                                                             (* ; "Edited 26-Aug-87 14:36 by Snow")
 
-     (* ;; "Cache the DISPLAY info, for the various X- and Y-position updating tasks that affect the display bitmap itself")
+(* ;;; "Create a font descriptor for a display stream that is mimicing a hardcopy device")
 
-           (RETURN HFONT])
+    (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]
 
-(\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))
+          (* ;; "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 f8dc7103..6880c316 100644
Binary files a/sources/HARDCOPY.LCOM and b/sources/HARDCOPY.LCOM differ
diff --git a/sources/INTERPRESS b/sources/INTERPRESS
index 86f6a0d3..e722d799 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 
 
-(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)))
+(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]
+
+                           (* ;; "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)
 
-(RPAQ? INTERPRESSFONTDIRECTORIES '("{Erinyes}<Lyric>Fonts>"))
+
+
+(* ; "Interpress fonts; but see MEDLEY-INIT-VARS")
+
+
+(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))
-
-
-
-(* ; "NS Character Encoding")
-
 (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)
-
-              (* ;; "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.")
-
-              (replace FONTFAMILY of FD with ASCIIFAMILY)
-              (replace FONTDEVICESPEC of FD with (LIST NSFAMILY SIZE FONTFACE ROTATION DEVICE]
-          (RETURN FD])
-
 (\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")
+  [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])
 
-    (* ;; "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])
+(\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
+
+(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")
+
+(* ;;; "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..  ")
+
+(* ;;; "Widths array is fully allocated, with zeroes for characters with no information.  An array is not allocated for fixed WidthsY.  ")
+
+    (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))
+
+                  (* ;; "\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")
+
+                  (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))
+
+         (* ;; "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 DONTCOPY 
 (DECLARE%: EVAL@COMPILE 
 
+(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)
 
 
 (CONSTANTS (noInfoCode 32768))
 )
-)
 
-(RPAQ? ASCIITONSTRANSLATIONS )
+(* "END EXPORTED DEFINITIONS")
 
 
+(ADDTOVAR INTERPRESSCHARSETFNS (INTERPRESS IPFONT.FILEP IPFONT.GETCHARSET))
 
-(* ;; 
-"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)."
-)
-
-
-(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])
-)
-
-(RPAQ? \ASCII2XCCS (\ASCIIMAPARRAY \ASCII2XCCSMAP))
-
-(RPAQ? \ASCII2MCCS (\ASCIIMAPARRAY \ASCII2XCCSMAP '("$" "-")))
+(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 cc4a8f51..decfd60d 100644
Binary files a/sources/INTERPRESS.LCOM and b/sources/INTERPRESS.LCOM differ
