diff --git a/lispusers/READ-BDF b/lispusers/READ-BDF
index afc91dd6..9173001d 100644
--- a/lispusers/READ-BDF
+++ b/lispusers/READ-BDF
@@ -5,25 +5,25 @@ BITMAPHEIGHT BITMAPWIDTH BLACKSHADE BLTSHADE BOLD CONDENSED CHARSETINFO DISPLAY
 FONTPROP INPUT ITALIC LIGHT LRSH MEDIUM REGULAR TCONC UTOXCODE UTOXCODE? WRITESTRIKEFONTFILE)) 
 READTABLE "XCL" BASE 10)
 
-(IL:FILECREATED " 5-Mar-2025 12:44:10" IL:|{DSK}<home>matt>Interlisp>medley>lispusers>READ-BDF.;39| 42641  
+(IL:FILECREATED "25-Apr-2025 10:10:08" IL:|{DSK}<home>matt>Interlisp>medley>lispusers>READ-BDF.;57| 47436  
 
       :EDIT-BY "mth"
 
-      :CHANGES-TO (IL:FUNCTIONS BDF-TO-CHARSETINFO READ-GLYPH)
+      :CHANGES-TO (IL:FUNCTIONS WRITE-BDF-TO-DISPLAYFONT-FILES READ-BDF BDF-TO-CHARSETINFO READ-GLYPH
+                         GET-FAMILY-FACE-SIZE-FROM-NAME SPLIT-FONT-NAME)
 
-      :PREVIOUS-DATE "26-Feb-2025 15:23:23" IL:|{DSK}<home>matt>Interlisp>medley>lispusers>READ-BDF.;37|
+      :PREVIOUS-DATE "23-Apr-2025 17:55:25" IL:|{DSK}<home>matt>Interlisp>medley>lispusers>READ-BDF.;54|
 )
 
 
 (IL:PRETTYCOMPRINT IL:READ-BDFCOMS)
 
 (IL:RPAQQ IL:READ-BDFCOMS
-          ((IL:STRUCTURES BDF-FONT GL-LIMITS GLYPH)
+          ((IL:STRUCTURES BDF-FONT GLYPH)
            (IL:VARIABLES MAXCHARSET MAXTHINCHAR NOMAPPINGCHARSET)
-           (IL:FUNCTIONS FIXUP-CHARSETINFO GET-FAMILY-FACE-SIZE-FROM-NAME PACKFILENAME.STRING 
-                  READ-BDF READ-DELIMITED-LIST-FROM-STRING READ-GLYPH)
-           (IL:FUNCTIONS BDF-TO-CHARSETINFO BDF-TO-FONTDESCRIPTOR GET-GLYPH-LIMITS GLYPHS-BY-CHARSET
-                  SPLIT-FONT-NAME WRITE-BDF-TO-DISPLAYFONT-FILES)
+           (IL:FUNCTIONS BDF-TO-CHARSETINFO BDF-TO-FONTDESCRIPTOR GET-FAMILY-FACE-SIZE-FROM-NAME 
+                  GLYPHS-BY-CHARSET PACKFILENAME.STRING READ-BDF READ-DELIMITED-LIST-FROM-STRING 
+                  READ-GLYPH SPLIT-FONT-NAME WRITE-BDF-TO-DISPLAYFONT-FILES)
            (IL:DECLARE\: IL:EVAL@COMPILE IL:DONTCOPY (IL:FILES (IL:LOADCOMP)
                                                             IL:FONT))
            (FILE-ENVIRONMENTS "READ-BDF")
@@ -31,90 +31,287 @@ FONTPROP INPUT ITALIC LIGHT LRSH MEDIUM REGULAR TCONC UTOXCODE UTOXCODE? WRITEST
                   IL:READ-BDF)))
 
 (DEFSTRUCT (BDF-FONT (:CONC-NAME "BF-"))
+   "Main structure to hold a parsed BDF font file"
    (NAME NIL :TYPE STRING)
    (SIZE NIL :TYPE LIST)
    (BOUNDINGBOX NIL :TYPE LIST)
    (METRICSSET 0 :TYPE (INTEGER 0 2))
    (PROPERTIES NIL :TYPE LIST)
-   SWIDTH DWIDTH SWIDTH1 DWIDTH1 VVECTOR (GLYPHS NIL :TYPE LIST))
+   SWIDTH DWIDTH SWIDTH1 DWIDTH1 VVECTOR (GLYPHS NIL :TYPE LIST)
+   (SLUG NIL :TYPE GLYPH))
 
-(DEFSTRUCT (GL-LIMITS (:CONC-NAME "GLIM-"))
+(DEFSTRUCT GLYPH
+   "This is an individual BDF glyph. Includes some values calculted for creating CHARSETINFO"
+   (NAME NIL :TYPE STRING)
+   ENCODING SWIDTH DWIDTH SWIDTH1 DWIDTH1 VVECTOR BBW BBH BBXOFF0 BBYOFF0 BITMAP
    (XCODE 0 :TYPE INTEGER)
-   (GLYPH NIL :TYPE GLYPH)
    (WIDTH 0 :TYPE INTEGER)
    (ASCENT 0 :TYPE INTEGER)
    (DESCENT 0 :TYPE INTEGER))
 
-(DEFSTRUCT GLYPH
-   (NAME NIL :TYPE STRING)
-   ENCODING SWIDTH DWIDTH SWIDTH1 DWIDTH1 VVECTOR BBW BBH BBXOFF0 BBYOFF0 BITMAP)
-
 (DEFCONSTANT MAXCHARSET 255)
 
 (DEFCONSTANT MAXTHINCHAR 255)
 
 (DEFCONSTANT NOMAPPINGCHARSET (1+ MAXCHARSET))
 
-(DEFUN FIXUP-CHARSETINFO (CSINFO ASCENT DESCENT SLUGWIDTH)
-                                                      (IL:* IL:\; "Edited  3-Feb-2025 19:19 by mth")
-   (LET* ((CSASCENT (IL:|fetch| (CHARSETINFO IL:CHARSETASCENT) IL:|of| CSINFO))
-          (CSDESCENT (IL:|fetch| (CHARSETINFO IL:CHARSETDESCENT) IL:|of| CSINFO))
-          (WIDTHS (IL:|fetch| (CHARSETINFO IL:WIDTHS) IL:|of| CSINFO))
-          (BMAP (IL:|fetch| (CHARSETINFO IL:CHARSETBITMAP) IL:|of| CSINFO))
-          (AMARGIN (- ASCENT CSASCENT))
-          (DMARGIN (- DESCENT CSDESCENT))
-          NEWBMAP)
-         (SETQ NEWBMAP (BITMAPCREATE (+ (BITMAPWIDTH BMAP)
-                                        SLUGWIDTH)
-                              (+ ASCENT DESCENT)
-                              1))
-         (BITBLT BMAP 0 0 NEWBMAP 0 DMARGIN (BITMAPWIDTH BMAP)
-                (BITMAPHEIGHT BMAP)
-                'INPUT
-                'IL:REPLACE)
-         (BLTSHADE BLACKSHADE NEWBMAP (1+ (BITMAPWIDTH BMAP))
-                0
-                (1- SLUGWIDTH)
-                (+ ASCENT DESCENT)
-                'IL:REPLACE)
-         (IL:|replace| (CHARSETINFO IL:CHARSETBITMAP) IL:|of| CSINFO IL:|with| NEWBMAP)
-         (IL:|replace| (CHARSETINFO IL:CHARSETASCENT) IL:|of| CSINFO IL:|with| ASCENT)
-         (IL:|replace| (CHARSETINFO IL:CHARSETDESCENT) IL:|of| CSINFO IL:|with| DESCENT)
-         (LOOP :FOR I :FROM 0 :TO (+ MAXTHINCHAR 2)
-               :WHEN
-               (ZEROP (\\FGETWIDTH WIDTHS I))
-               :DO
-               (\\FSETWIDTH WIDTHS I SLUGWIDTH))))
+(DEFUN BDF-TO-CHARSETINFO (FONT CSET SLUG-OR-WIDTH &OPTIONAL MAP-UNKNOWN-TO-PRIVATE)
+                                                      (IL:* IL:\; "Edited 23-Apr-2025 17:53 by mth")
+                                                      (IL:* IL:\; "Edited 21-Apr-2025 16:23 by mth")
+                                                      (IL:* IL:\; "Edited 30-Jan-2025 16:40 by mth")
+   (LET (GBCS CSGLYPHS CSLIMITS)
+        (UNLESS (AND (INTEGERP CSET)
+                     (<= 0 CSET MAXCHARSET))
+            (ERROR "Invalid Character set: ~S" CSET)
 
-(DEFUN GET-FAMILY-FACE-SIZE-FROM-NAME (BDFONT)        (IL:* IL:\; "Edited  5-Feb-2025 12:56 by mth")
+            (IL:* IL:|;;| "Can we get here? I think not!")
+
+            (SETQ CSET 0))
+        (SETQ GBCS (COND
+                      ((LISTP FONT)
+
+                       (IL:* IL:|;;| 
+              "Assuming that FONT is already the LIST of ALIST form of result from GLYPHS-BY-CHARSET")
+
+                       FONT)
+                      ((BDF-FONT-P FONT)
+
+                       (IL:* IL:|;;| 
+                       "If passed a BDF-FONT, look only at glyphs in the mapped charsets")
+
+                       (FIRST (GLYPHS-BY-CHARSET FONT MAP-UNKNOWN-TO-PRIVATE)))
+                      (T (ERROR "Invalid FONT: ~S" FONT))))
+        (WHEN (SETQ CSGLYPHS (SECOND (ASSOC CSET GBCS)))
+            (LET ((TOTAL-WIDTH 0)
+                  (ASCENT 0)
+                  (DESCENT 0)
+                  (FIRSTCHAR MOST-POSITIVE-FIXNUM)
+                  (LASTCHAR MOST-NEGATIVE-FIXNUM)
+                  (CSINFO (IL:|create| CHARSETINFO))
+                  (DLEFT 0)
+                  SLUG SLUGWIDTH GLYPHS-LIMITS BMAP OFFSETS HEIGHT WIDTHS)
+                 (COND
+                    ((GLYPH-P SLUG-OR-WIDTH)
+                     (SETQ SLUG SLUG-OR-WIDTH)
+                     (SETQ SLUGWIDTH (1+ (GLYPH-WIDTH SLUG)))
+                     (SETQ ASCENT (MAX ASCENT (GLYPH-ASCENT SLUG)))
+                     (SETQ DESCENT (MAX DESCENT (GLYPH-DESCENT SLUG))))
+                    ((INTEGERP SLUG-OR-WIDTH)
+                     (SETQ SLUGWIDTH SLUG-OR-WIDTH))
+                    (T (ERROR "Invalid SLUG-OR-WIDTH: ~S" SLUG-OR-WIDTH)))
+                 (SETQ CSGLYPHS (LOOP :FOR XGL :IN CSGLYPHS :COLLECT (LET* ((XCODE (CAR XGL))
+                                                                            (GL (CDR XGL))
+                                                                            (GWIDTH (GLYPH-WIDTH
+                                                                                     GL))
+                                                                            (ASC (GLYPH-ASCENT GL))
+                                                                            (DSC (GLYPH-DESCENT
+                                                                                  GL)))
+
+                                 (IL:* IL:|;;| "It's possible that ALL glyphs in the character set are above the baseline. In that case, the GLYPH-DESCENT calculated by READ-GLYPH will not give a useful value, since it is >= 0.  Investigate correcting this.")
+
+                                                                           (IL:* IL:|;;|
+                                                                           
+                                                              "Is the above statement actually true?")
+
+                                                                           (SETF (GLYPH-XCODE GL)
+                                                                                 XCODE)
+                                                                           (SETQ FIRSTCHAR
+                                                                                 (MIN FIRSTCHAR XCODE
+                                                                                      ))
+                                                                           (SETQ LASTCHAR
+                                                                                 (MAX LASTCHAR XCODE)
+                                                                                 )
+                                                                           (INCF TOTAL-WIDTH GWIDTH)
+                                                                           (SETQ ASCENT
+                                                                                 (MAX ASCENT ASC))
+                                                                           (SETQ DESCENT
+                                                                                 (MAX DESCENT DSC))
+                                                                           GL)))
+                 (IL:|replace| (CHARSETINFO IL:CHARSETASCENT) IL:|of| CSINFO IL:|with| ASCENT)
+                 (IL:|replace| (CHARSETINFO IL:CHARSETDESCENT) IL:|of| CSINFO IL:|with| DESCENT)
+                 (SETQ OFFSETS (IL:|fetch| (CHARSETINFO IL:OFFSETS) IL:|of| CSINFO))
+
+                 (IL:* IL:|;;| 
+               "Initialize the offsets to the TOTAL-WIDTH (without the SLUG. It will be added later)")
+
+                 (IL:|for| I IL:|from| 0 IL:|to| (+ MAXTHINCHAR 2) IL:|do| (\\FSETOFFSET OFFSETS I 
+                                                                                  TOTAL-WIDTH))
+                 (SETQ WIDTHS (IL:|fetch| (CHARSETINFO IL:WIDTHS) IL:|of| CSINFO))
+
+                 (IL:* IL:|;;| "Initialize the widths to SLUGWIDTH")
+
+                 (IL:|for| I IL:|from| 0 IL:|to| (+ MAXTHINCHAR 2) IL:|do| (\\FSETWIDTH WIDTHS I 
+                                                                                  SLUGWIDTH))
+                 (IL:|replace| (CHARSETINFO IL:IMAGEWIDTHS) IL:|of| CSINFO IL:|with| WIDTHS)
+
+                 (IL:* IL:|;;| "JDS 12/4/92:  Apparently, these fields can be signed values, if all chars, e.g., ride above the base line. ")
+
+                 (IL:* IL:|;;| " From \\READSTRIKEFONTFILE, so -ve DESCENT is possible?")
+
+                 (SETQ HEIGHT (+ ASCENT DESCENT))
+                 (SETQ BMAP (BITMAPCREATE (+ TOTAL-WIDTH SLUGWIDTH)
+                                   HEIGHT 1))
+                 (IL:|replace| (CHARSETINFO IL:CHARSETBITMAP) IL:|of| CSINFO IL:|with| BMAP)
+                 (LOOP :FOR GL :IN CSGLYPHS :WITH GLBM :WITH GLW :WITH XCODE :DO (SETQ GLBM
+                                                                                       (GLYPH-BITMAP
+                                                                                        GL))
+                       (SETQ GLW (GLYPH-WIDTH GL))
+                       (SETQ XCODE (GLYPH-XCODE GL))
+                       (BITBLT GLBM 0 0 BMAP (+ DLEFT (MAX 0 (GLYPH-BBXOFF0 GL)))
+                              (+ DESCENT (GLYPH-BBYOFF0 GL))
+                              (BITMAPWIDTH GLBM)
+                              (BITMAPHEIGHT GLBM)
+                              'INPUT
+                              'IL:REPLACE)
+                       (\\FSETOFFSET OFFSETS XCODE DLEFT)
+                       (\\FSETOFFSET WIDTHS XCODE GLW)
+                       (INCF DLEFT GLW))
+
+                 (IL:* IL:|;;| "Now insert the SLUG glyph into the BMAP, or make a slug (block)")
+
+                 (IF SLUG
+                     (LET ((GLBM (GLYPH-BITMAP SLUG)))
+                          (BITBLT GLBM 0 0 BMAP (+ TOTAL-WIDTH (MAX 0 (GLYPH-BBXOFF0 SLUG)))
+                                 (+ DESCENT (GLYPH-BBYOFF0 SLUG))
+                                 (BITMAPWIDTH GLBM)
+                                 (BITMAPHEIGHT GLBM)
+                                 'INPUT
+                                 'IL:REPLACE))
+                     (BLTSHADE BLACKSHADE BMAP (1+ TOTAL-WIDTH)
+                            0
+                            (1- SLUGWIDTH)
+                            (+ ASCENT DESCENT)
+                            'IL:REPLACE))
+                 CSINFO))))
+
+(DEFUN BDF-TO-FONTDESCRIPTOR (BDFONT FAMILY SIZE FACE ROTATION DEVICE &OPTIONAL 
+                                    MAP-UNKNOWN-TO-PRIVATE RAW-UNICODE-MAPPING)
+                                                      (IL:* IL:\; "Edited 21-Apr-2025 16:03 by mth")
+                                                      (IL:* IL:\; "Edited 30-Jan-2025 21:27 by mth")
+   (WHEN (AND (BDF-FONT-P BDFONT)
+              FAMILY)                                        (IL:* IL:\; "FAMILY Cannot be NIL")
+       (PROG* ((SLUG (BF-SLUG BDFONT))
+               (SLUGWIDTH (AND SLUG (GLYPH-WIDTH SLUG)))
+               FONTDESC DEV GBCSL CHARSETS)
+              (WHEN (FONTP FAMILY)
+                  (RETURN (BDF-TO-FONTDESCRIPTOR BDFONT (FONTPROP FAMILY 'IL:FAMILY)
+                                 (OR SIZE (FONTPROP FAMILY 'IL:SIZE))
+                                 (OR FACE (FONTPROP FAMILY 'IL:FACE))
+                                 (OR ROTATION (FONTPROP FAMILY 'IL:ROTATION))
+                                 (OR DEVICE (FONTPROP FAMILY 'IL:DEVICE))
+                                 MAP-UNKNOWN-TO-PRIVATE)))
+              (WHEN (LISTP FAMILY)
+                  (RETURN (BDF-TO-FONTDESCRIPTOR BDFONT (FIRST FAMILY)
+                                 (OR (SECOND FAMILY)
+                                     SIZE)
+                                 (OR (THIRD FAMILY)
+                                     FACE "MRR")
+                                 (OR (FOURTH FAMILY)
+                                     ROTATION 0)
+                                 (OR (FIFTH FAMILY)
+                                     DEVICE
+                                     'DISPLAY)
+                                 MAP-UNKNOWN-TO-PRIVATE)))
+              (SETQ FAMILY (\\FONTSYMBOL FAMILY))
+              (UNLESS (AND (INTEGERP SIZE)
+                           (PLUSP SIZE))
+                     (ERROR "Invalid SIZE: ~S~%" SIZE))
+              (COND
+                 ((NULL ROTATION)
+                  (SETQ ROTATION 0))
+                 ((NOT (AND (INTEGERP ROTATION)
+                            (>= ROTATION 0)))
+                  (IL:\\ILLEGAL.ARG ROTATION)))
+              (SETQ DEV DEVICE)
+              (SETQ DEV (COND
+                           ((NULL DEVICE)
+                            'DISPLAY)
+                           ((AND (SYMBOLP DEVICE)
+                                 (NOT (EQ DEVICE T)))
+
+                            (IL:* IL:|;;| 
+   "Maybe wrong case or package, but we bet it's OK and defer expensive coercion until we've failed.")
+
+                            DEVICE)
+                           ((STRINGP DEVICE)
+                            (INTERN (STRING-UPCASE DEVICE)
+                                   "IL"))
+                           (T (IL:\\ILLEGAL.ARG DEVICE))))
+              (SETQ FACE (\\FONTFACE FACE NIL DEV))
+              (SETQ GBCSL (GLYPHS-BY-CHARSET BDFONT MAP-UNKNOWN-TO-PRIVATE RAW-UNICODE-MAPPING))
+              (UNLESS SLUGWIDTH
+
+                  (IL:* IL:|;;| 
+              "If GLYPHS-BY-CHARSET didn't determine the SLUG width, use 60% of the SIZE, at least 1")
+
+                  (SETQ SLUGWIDTH (OR (THIRD GBCSL)
+                                      (MAX 1 (ROUND (* 0.6 SIZE))))))
+              (FLET ((GBCS-TO-FONTDESC
+                      (GBCS FAMILY)
+                      (LET (FONTDESC CHARSETS)
+                           (WHEN GBCS
+                               (SETQ FONTDESC
+                                     (IL:|create| FONTDESCRIPTOR
+                                            IL:FONTDEVICE IL:_ DEV
+                                            IL:FONTFAMILY IL:_ FAMILY
+                                            IL:FONTSIZE IL:_ SIZE
+                                            IL:FONTFACE IL:_ FACE
+                                            IL:|\\SFAscent| IL:_ 0
+                                            IL:|\\SFDescent| IL:_ 0
+                                            IL:|\\SFHeight| IL:_ 0
+                                            IL:ROTATION IL:_ ROTATION
+                                            IL:FONTDEVICESPEC IL:_ (LIST FAMILY SIZE FACE ROTATION 
+                                                                         DEV)))
+                               (SETQ CHARSETS (LOOP :FOR CS :IN GBCS :WITH CSET :WITH CSINFO :NCONC
+                                                    (WHEN (<= 0 (SETQ CSET (FIRST CS))
+                                                              MAXCHARSET)
+                                                        (SETQ CSINFO (BDF-TO-CHARSETINFO
+                                                                      GBCS CSET (OR SLUG (1+ 
+                                                                                            SLUGWIDTH
+                                                                                             ))))
+                                                        (\\INSTALLCHARSETINFO FONTDESC CSINFO CSET)
+                                                        (LIST CSET)))))
+                           (LIST FONTDESC CHARSETS))))
+                    (RETURN (VALUES-LIST (NCONC (GBCS-TO-FONTDESC (FIRST GBCSL)
+                                                       FAMILY)
+                                                (GBCS-TO-FONTDESC (SECOND GBCSL)
+                                                       (\\FONTSYMBOL (CONCATENATE 'STRING
+                                                                            (SYMBOL-NAME FAMILY)
+                                                                            "-UNMAPPED")))
+                                                (LIST (ASSOC NOMAPPINGCHARSET (FIRST GBCSL)
+                                                             :TEST
+                                                             #'EQL)))))))))
+
+(DEFUN GET-FAMILY-FACE-SIZE-FROM-NAME (BDFONT)        (IL:* IL:\; "Edited 23-Apr-2025 16:20 by mth")
+                                                      (IL:* IL:\; "Edited  5-Feb-2025 12:56 by mth")
    (UNLESS (TYPEP BDFONT 'BDF-FONT)
-          (ERROR "Not a BDF-FONT: ~S~%" BDFONT))
+          (ERROR "Not a  BDF-FONT: ~S~%" BDFONT))
    (DESTRUCTURING-BIND (FOUNDRY FAMILY WEIGHT SLANT EXPANSION ADD_STYLE_NAME
                               PIXEL-SIZE POINT-SIZE)
           (SPLIT-FONT-NAME (BF-NAME BDFONT))                 (IL:* IL:\; "Parse as XLFD format")
           (DECLARE (IGNORE FOUNDRY ADD_STYLE_NAME))          (IL:* IL:\; 
                                                              "Don't need FOUNDRY or ADD_STYLE_NAME")
           (SETQ FAMILY (REMOVE #\Space FAMILY :TEST #'CHAR=))
-          (SETQ WEIGHT (OR (CDR (ASSOC (CHAR-UPCASE (ELT WEIGHT 0))
-                                       '((#\R . MEDIUM)
-                                         (#\M . MEDIUM)
-                                         (#\N . MEDIUM)
-                                         (#\B . BOLD)
-                                         (#\D . BOLD)
-                                         (#\L . LIGHT))))
+          (SETQ WEIGHT (OR (AND WEIGHT (CDR (ASSOC (CHAR-UPCASE (ELT WEIGHT 0))
+                                                   '((#\R . MEDIUM)
+                                                     (#\M . MEDIUM)
+                                                     (#\N . MEDIUM)
+                                                     (#\B . BOLD)
+                                                     (#\D . BOLD)
+                                                     (#\L . LIGHT)))))
                            'MEDIUM))                         (IL:* IL:\; "DemiBold => BOLD")
-          (SETQ SLANT (OR (CDR (ASSOC (STRING-UPCASE SLANT)
-                                      '(("R" . REGULAR)
-                                        ("I" . ITALIC)
-                                        ("O" . ITALIC))))
+          (SETQ SLANT (OR (AND SLANT (CDR (ASSOC (STRING-UPCASE SLANT)
+                                                 '(("R" . REGULAR)
+                                                   ("I" . ITALIC)
+                                                   ("O" . ITALIC)))))
                           'REGULAR))                         (IL:* IL:\; "Oblique => ITALIC")
                                                              (IL:* IL:\; "Ignore others")
-          (SETQ EXPANSION (OR (CDR (ASSOC (CHAR-UPCASE (ELT EXPANSION 0))
-                                          '((#\R . REGULAR)
-                                            (#\N . REGULAR)
-                                            (#\B . BOLD)
-                                            (#\S . CONDENSED)
-                                            (#\C . CONDENSED))))
+          (SETQ EXPANSION (OR (AND EXPANSION (CDR (ASSOC (CHAR-UPCASE (ELT EXPANSION 0))
+                                                         '((#\R . REGULAR)
+                                                           (#\N . REGULAR)
+                                                           (#\B . BOLD)
+                                                           (#\S . CONDENSED)
+                                                           (#\C . CONDENSED)))))
                               'REGULAR))                     (IL:* IL:\; 
                                                  "S is for \"SemiCondensed\", Assuming \"Condensed\"")
 
@@ -137,6 +334,139 @@ FONTPROP INPUT ITALIC LIGHT LRSH MEDIUM REGULAR TCONC UTOXCODE UTOXCODE? WRITEST
                     POINT-SIZE
                     (FIRST (BF-SIZE BDFONT))))))
 
+(DEFUN GLYPHS-BY-CHARSET (FONT &OPTIONAL MAP-UNKNOWN-TO-PRIVATE RAW-UNICODE-MAPPING)
+                                                      (IL:* IL:\; "Edited 21-Apr-2025 15:48 by mth")
+                                                      (IL:* IL:\; "Edited  9-Jan-2025 11:23 by mth")
+   (LET* ((NCSETS (+ MAXCHARSET 2))
+          (CSETS (MAKE-ARRAY NCSETS :INITIAL-CONTENTS (LOOP :REPEAT NCSETS :COLLECT (CONS NIL))))
+          (UTOXFN (COND
+                     (RAW-UNICODE-MAPPING #'IDENTITY)
+                     (MAP-UNKNOWN-TO-PRIVATE #'UTOXCODE)
+                     (T #'UTOXCODE?)))
+          (SLUG (BF-SLUG FONT))
+          (SLUGWIDTH (AND SLUG (GLYPH-WIDTH SLUG)))
+          NOMAPPINGCSETS ENC XCODE XCS)
+         (UNLESS (OR MAP-UNKNOWN-TO-PRIVATE RAW-UNICODE-MAPPING)
+             (SETQ NOMAPPINGCSETS (MAKE-ARRAY NCSETS :INITIAL-CONTENTS (LOOP :REPEAT NCSETS :COLLECT
+                                                                             (CONS NIL)))))
+         (FLET ((PUT-GLYPH-IN-CHARSET-ARRAY (CODE GLYPH CSARRAY)
+                       (TCONC (AREF CSARRAY (LRSH CODE 8))
+                              (CONS (LOGAND CODE 255)
+                                    GLYPH))))
+               (LOOP :FOR GL :IN (BF-GLYPHS FONT)
+                     :UNLESS
+                     (EQ GL SLUG)
+                     :DO
+                     (SETQ XCS NIL)
+                     (SETQ ENC (GLYPH-ENCODING GL))
+                     (WHEN (LISTP ENC)
+
+                         (IL:* IL:|;;| 
+                         "Should happen only if -1 is first on ENCODING line in BDF file")
+
+                         (SETQ ENC (OR (SECOND ENC)
+                                       -1))
+
+                         (IL:* IL:|;;| 
+    "The -1 case of the (OR ...) shouldn't happen. The (EQ GL SLUG) test above should have caught it")
+
+                         )
+                     (SETQ XCODE (AND (INTEGERP ENC)
+                                      (PLUSP ENC)
+                                      (FUNCALL UTOXFN ENC)))
+                     (IF RAW-UNICODE-MAPPING
+                         (COND
+                            ((> ENC 65535)
+                             (WARN "~&Unicode encoding is beyond 16 bits: ~5X" ENC)
+                             (TCONC (AREF CSETS NOMAPPINGCHARSET)
+                                    (CONS ENC GL)))
+                            ((AND NIL (= 255 (LOGAND ENC 255)))
+
+                             (IL:* IL:|;;| 
+                             "Temporarily? disable this warning in RAW-UNICODE-MAPPING mode")
+
+                             (WARN 
+                       "~&Unicode encoding char byte (~2X,FF)=(~O,377) may not =FF in FONTDESCRIPTOR"
+                                   (LRSH ENC 8)
+                                   (LRSH ENC 8))
+                             (TCONC (AREF CSETS NOMAPPINGCHARSET)
+                                    (CONS ENC GL)))
+                            (T (PUT-GLYPH-IN-CHARSET-ARRAY ENC GL CSETS)))
+                         (COND
+                            ((NULL XCODE)
+
+                             (IL:* IL:|;;| "These assoc with the Unicode encoding")
+
+                             (COND
+                                ((OR (> ENC 65535)
+                                     (= 255 (LOGAND ENC 255)))
+
+                                 (IL:* IL:|;;| 
+            "Unicode encoding is > xFFFF, or encoding low byte is FF, put it in the NOMAPPINGCHARSET")
+
+                                 (TCONC (AREF CSETS NOMAPPINGCHARSET)
+                                        (CONS ENC GL)))
+                                (T (PUT-GLYPH-IN-CHARSET-ARRAY ENC GL NOMAPPINGCSETS))))
+                            ((AND (INTEGERP XCODE)
+                                  (<= 0 XCODE 65535))
+
+                             (IL:* IL:|;;| 
+                             "These assoc with the 8 bit character code within the charset")
+
+                             (PUT-GLYPH-IN-CHARSET-ARRAY XCODE GL CSETS)
+
+                             (IL:* IL:|;;| "Default SLUG width is width of A.")
+
+                             (WHEN (AND (NOT SLUGWIDTH)
+                                        (= ENC (CHAR-CODE #\A)))
+
+                                 (IL:* IL:|;;| "A is the same code in XCCS and UNICODE ")
+
+                                 (IL:* IL:|;;| 
+                                 "Comparing with ENC, not XCODE, to look only in charset 0")
+
+                                 (SETQ SLUGWIDTH (GLYPH-WIDTH GL))))
+                            ((LISTP XCODE)
+
+                             (IL:* IL:|;;| 
+                          "These assoc with the 8 bit character code within the charset (like above)")
+
+                             (LOOP :FOR XC :IN XCODE :WITH CS :UNLESS (MEMBER (SETQ CS
+                                                                                    (LRSH XC 8))
+                                                                             XCS)
+                                   :DO
+                                   (PUSH CS XCS)
+                                   (PUT-GLYPH-IN-CHARSET-ARRAY XC GL CSETS)))
+                            (T (ERROR "Invalid XCODE: ~A~%"))))))
+
+         (IL:* IL:|;;| "Extract the lists from the TCONC pointers")
+
+         (LOOP :FOR I :FROM 0 :TO NOMAPPINGCHARSET :DO (SETF (AREF CSETS I)
+                                                             (SORT (REMOVE-DUPLICATES
+                                                                    (CAR (AREF CSETS I))
+                                                                    :TEST
+                                                                    #'EQUAL)
+                                                                   #'< :KEY #'CAR)))
+         (SETQ CSETS (LOOP :FOR I :FROM 0 :TO NOMAPPINGCHARSET :NCONC
+                           (LET ((CS (AREF CSETS I)))
+                                (WHEN CS
+                                    (LIST (LIST I CS))))))
+
+         (IL:* IL:|;;| "Likewise for the NOMAPPINGCSETS, if any.")
+
+         (WHEN NOMAPPINGCSETS
+             (LOOP :FOR I :FROM 0 :TO NOMAPPINGCHARSET :DO
+                   (SETF (AREF NOMAPPINGCSETS I)
+                         (SORT (REMOVE-DUPLICATES (CAR (AREF NOMAPPINGCSETS I))
+                                      :TEST
+                                      #'EQUAL)
+                               #'< :KEY #'CAR)))
+             (SETQ NOMAPPINGCSETS (LOOP :FOR I :FROM 0 :TO NOMAPPINGCHARSET :NCONC
+                                        (LET ((CS (AREF NOMAPPINGCSETS I)))
+                                             (WHEN CS
+                                                 (LIST (LIST I CS)))))))
+         (LIST CSETS NOMAPPINGCSETS SLUGWIDTH)))
+
 (DEFMACRO PACKFILENAME.STRING (&WHOLE WHOLE)          (IL:* IL:\; "Edited  1-Feb-2025 23:17 by mth")
    `(IL:PACKFILENAME.STRING ,@(LOOP :FOR X :IN (CDR WHOLE)
                                     :BY
@@ -157,17 +487,21 @@ FONTPROP INPUT ITALIC LIGHT LRSH MEDIUM REGULAR TCONC UTOXCODE UTOXCODE? WRITEST
                                                               X))
                                                         Y))))
 
-(DEFUN READ-BDF (PATH)                                (IL:* IL:\; "Edited 26-Feb-2025 15:22 by mth")
-                                                      (IL:* IL:\; "Edited 23-Sep-2024 12:37 by mth")
-                                                      (IL:* IL:\; "Edited 22-Aug-2024 16:43 by mth")
-                                                      (IL:* IL:\; "Edited 17-Jul-2024 14:45 by mth")
+(DEFUN READ-BDF (PATH &OPTIONAL VERBOSE)              (IL:* IL:\; "Edited 24-Apr-2025 00:44 by mth")
+                                                      (IL:* IL:\; "Edited 17-Apr-2025 15:10 by mth")
                                                       (IL:* IL:\; "Edited 12-Jul-2024 23:02 by mth")
    (LET
-    (PROPS PROPS-COMPLETE CHARS-COUNT FONT-COMPLETE FONT POS KEY V VV LINE ITEMS (NGLYPHS 0)
+    (PROPS PROPS-COMPLETE CHARS-COUNT FONT-COMPLETE FONT POS KEY V VV LINE ITEMS GL (NGLYPHS 0)
            (*PACKAGE* (FIND-PACKAGE "BDF")))
     (WITH-OPEN-FILE
      (FILE-STREAM PATH :ELEMENT-TYPE 'CHARACTER :DIRECTION :INPUT)
-     (UNLESS (STRING-EQUAL "STARTFONT" (READ FILE-STREAM))
+     (LOOP :WHILE (STRING-EQUAL "COMMENT" (SETQ KEY (READ FILE-STREAM)))
+           :DO
+
+           (IL:* IL:|;;| "Ignore initial COMMENT lines.")
+
+           (READ-LINE FILE-STREAM))
+     (UNLESS (STRING-EQUAL "STARTFONT" KEY)
             (ERROR "Invalid BDF file - must begin with STARTFONT."))
 
      (IL:* IL:|;;| "ignore the file format version number")
@@ -252,8 +586,30 @@ FONTPROP INPUT ITALIC LIGHT LRSH MEDIUM REGULAR TCONC UTOXCODE UTOXCODE? WRITEST
                                 (ERROR "Invalid BDF file - CHARS count (~A) is invalid or missing." 
                                        NGLYPHS))
                          (SETF (BF-GLYPHS FONT)
-                               (LOOP :REPEAT NGLYPHS :COLLECT (READ-GLYPH FILE-STREAM FONT))))
+                               (LOOP :REPEAT NGLYPHS :COLLECT
+                                     (PROG1 (SETQ GL (READ-GLYPH FILE-STREAM FONT))
+
+                                         (IL:* IL:|;;| 
+           "Any GLYPH with ENCODING of -1 is taken as the SLUG glyph. If multiple, the last applies.")
+
+                                         (SETQ V (GLYPH-ENCODING GL))
+                                         (WHEN (AND (LISTP V)
+                                                    (EQ (FIRST V)
+                                                        -1))
+                                             (SETQ V (OR (SECOND V)
+                                                         -1)))
+                                         (WHEN (EQ V -1)
+                                             (SETF (BF-SLUG FONT)
+                                                   GL))))))
                       (ENDFONT (SETQ FONT-COMPLETE T))))))))
+     (WHEN VERBOSE
+         (DESTRUCTURING-BIND (FAMILY (WEIGHT SLANT EXPANSION)
+                                    SIZE)
+                (GET-FAMILY-FACE-SIZE-FROM-NAME FONT)
+                (FORMAT *STANDARD-OUTPUT* 
+                       "Name: ~A~%Family: ~A~%Size: ~A~%Weight: ~A~%Slant: ~A~%Expansion: ~A~%"
+                       (BF-NAME FONT)
+                       FAMILY SIZE WEIGHT SLANT EXPANSION)))
      FONT)))
 
 (DEFUN READ-DELIMITED-LIST-FROM-STRING (INPUT-STRING &OPTIONAL (DELIMIT #\]))
@@ -261,11 +617,10 @@ FONTPROP INPUT ITALIC LIGHT LRSH MEDIUM REGULAR TCONC UTOXCODE UTOXCODE? WRITEST
    (WITH-INPUT-FROM-STRING (SI (CONCATENATE 'STRING INPUT-STRING " " (STRING DELIMIT)))
           (READ-DELIMITED-LIST DELIMIT SI)))
 
-(DEFUN READ-GLYPH (FILE-STREAM FONT)                  (IL:* IL:\; "Edited  5-Mar-2025 12:20 by mth")
-                                                      (IL:* IL:\; "Edited 26-Feb-2025 15:23 by mth")
-                                                      (IL:* IL:\; "Edited  2-Feb-2025 20:29 by mth")
-                                                      (IL:* IL:\; "Edited 23-Sep-2024 12:38 by mth")
-                                                      (IL:* IL:\; "Edited 22-Aug-2024 20:53 by mth")
+(DEFUN READ-GLYPH (FILE-STREAM FONT)                  (IL:* IL:\; "Edited 23-Apr-2025 17:53 by mth")
+                                                      (IL:* IL:\; "Edited 21-Apr-2025 13:37 by mth")
+                                                      (IL:* IL:\; "Edited 19-Apr-2025 09:32 by mth")
+                                                      (IL:* IL:\; "Edited 17-Apr-2025 18:14 by mth")
                                                       (IL:* IL:\; "Edited 21-Aug-2024 01:10 by mth")
    (LET ((GLYPH (MAKE-GLYPH :SWIDTH (COPY-LIST (BF-SWIDTH FONT))
                        :DWIDTH
@@ -352,327 +707,63 @@ FONTPROP INPUT ITALIC LIGHT LRSH MEDIUM REGULAR TCONC UTOXCODE UTOXCODE? WRITEST
                                           (SETF (GLYPH-BITMAP GLYPH)
                                                 BM)))
                             (ENDCHAR (SETQ CHAR-COMPLETE T)))))))
+        (SETF (GLYPH-ASCENT GLYPH)
+              (+ (GLYPH-BBH GLYPH)
+                 (GLYPH-BBYOFF0 GLYPH)))
+        (SETF (GLYPH-DESCENT GLYPH)
+              (ABS (MIN 0 (GLYPH-BBYOFF0 GLYPH))))
+        (SETF (GLYPH-WIDTH GLYPH)
+              (MAX (+ (MAX 0 (GLYPH-BBXOFF0 GLYPH))
+                      (GLYPH-BBW GLYPH))
+                   (FIRST (GLYPH-DWIDTH GLYPH))))
         GLYPH))
 
-(DEFUN BDF-TO-CHARSETINFO (FONT CSET &OPTIONAL MAP-UNKNOWN-TO-PRIVATE)
-                                                      (IL:* IL:\; "Edited  5-Mar-2025 12:39 by mth")
-                                                      (IL:* IL:\; "Edited  3-Feb-2025 16:02 by mth")
-                                                      (IL:* IL:\; "Edited 30-Jan-2025 16:40 by mth")
-   (LET (GBCS CSGLYPHS CSLIMITS)
-        (UNLESS (AND (INTEGERP CSET)
-                     (<= 0 CSET MAXCHARSET))
-            (ERROR "Invalid Character set: ~S" CSET)
+(DEFUN SPLIT-FONT-NAME (NAME)                         (IL:* IL:\; "Edited 23-Apr-2025 16:22 by mth")
+                                                      (IL:* IL:\; "Edited 31-Jan-2025 22:20 by mth")
 
-            (IL:* IL:|;;| "Can we get here?")
+   (IL:* IL:|;;| "First, check if it COULD be in XLFD format")
 
-            (SETQ CSET 0))
-        (SETQ GBCS (COND
-                      ((TYPEP FONT 'BDF-FONT)
-                       (GLYPHS-BY-CHARSET FONT MAP-UNKNOWN-TO-PRIVATE))
-                      ((LISTP FONT)
+   (COND
+      ((POSITION #\- NAME :TEST #'CHAR=)
+       (LOOP :FOR I = (IF (CHAR= #\- (ELT NAME 0))
+                          1
+                          0)
+             THEN
+             (1+ J)
+             :AS J = (POSITION #\- NAME :START I :TEST #'CHAR=)
+             :COLLECT
+             (SUBSEQ NAME I J)
+             :WHILE J))
+      (T 
+         (IL:* IL:|;;| "Return the NAME as FAMILY with a NIL FOUNDRY")
 
-                       (IL:* IL:|;;| 
-                     "Assuming that FONT is already the A-LIST form of result from GLYPHS-BY-CHARSET")
+         (LIST NIL NAME))))
 
-                       FONT)
-                      (T (ERROR "Invalid FONT: ~S" FONT))))
-        (WHEN (SETQ CSGLYPHS (SECOND (ASSOC CSET GBCS)))
-            (LET ((TOTAL-WIDTH 0)
-                  (ASCENT 0)
-                  (DESCENT 0)
-                  (FIRSTCHAR MOST-POSITIVE-FIXNUM)
-                  (LASTCHAR MOST-NEGATIVE-FIXNUM)
-                  (CSINFO (IL:|create| CHARSETINFO))
-                  (DLEFT 0)
-                  GLYPHS-LIMITS BMAP OFFSETS HEIGHT WIDTHS)
-                 (SETQ GLYPHS-LIMITS (LOOP :FOR XGL :IN CSGLYPHS :COLLECT
-                                           (LET* ((XCODE (CAR XGL))
-                                                  (GL (CDR XGL))
-                                                  (GLIMITS (GET-GLYPH-LIMITS GL))
-                                                  (GWIDTH (GLIM-WIDTH GLIMITS))
-                                                  (ASC (GLIM-ASCENT GLIMITS))
-                                                  (DSC (GLIM-DESCENT GLIMITS)))
-
-                                 (IL:* IL:|;;| "It's possible that ALL glyphs in the character set are above the baseline. In that case, the GLIM-DESCENT calculated by GET-GLYPH-LIMITS will not give a useful value, since it is >= 0.  Investigate correcting this.")
-
-                                                 (SETF (GLIM-GLYPH GLIMITS)
-                                                       GL)
-                                                 (SETF (GLIM-XCODE GLIMITS)
-                                                       XCODE)
-                                                 (SETQ FIRSTCHAR (MIN FIRSTCHAR XCODE))
-                                                 (SETQ LASTCHAR (MAX LASTCHAR XCODE))
-                                                 (INCF TOTAL-WIDTH GWIDTH)
-                                                 (SETQ ASCENT (MAX ASCENT ASC))
-                                                 (SETQ DESCENT (MAX DESCENT DSC))
-                                                 GLIMITS)))
-                 (IL:|replace| (CHARSETINFO IL:CHARSETASCENT) IL:|of| CSINFO IL:|with| ASCENT)
-                 (IL:|replace| (CHARSETINFO IL:CHARSETDESCENT) IL:|of| CSINFO IL:|with| DESCENT)
-                 (SETQ OFFSETS (IL:|fetch| (CHARSETINFO IL:OFFSETS) IL:|of| CSINFO))
-
-                 (IL:* IL:|;;| 
-               "Initialize the offsets to the TOTAL-WIDTH (without the SLUG. It will be added later)")
-
-                 (IL:|for| I IL:|from| 0 IL:|to| (+ MAXTHINCHAR 2) IL:|do| (\\FSETOFFSET OFFSETS I 
-                                                                                  TOTAL-WIDTH))
-                 (SETQ WIDTHS (IL:|fetch| (CHARSETINFO IL:WIDTHS) IL:|of| CSINFO))
-
-                 (IL:* IL:|;;| 
-                 "Initialize the widths to 0, the width of the slug will be set in FIXUP-CHARSETINFO")
-
-                 (IL:|for| I IL:|from| 0 IL:|to| (+ MAXTHINCHAR 2) IL:|do| (\\FSETWIDTH WIDTHS I 0))
-                 (IL:|replace| (CHARSETINFO IL:IMAGEWIDTHS) IL:|of| CSINFO IL:|with| WIDTHS)
-
-                 (IL:* IL:|;;| "JDS 12/4/92:  Apparently, these fields can be signed values, if all chars, e.g., ride above the base line. ")
-
-                 (IL:* IL:|;;| " From \\READSTRIKEFONTFILE, so -ve DESCENT is possible?")
-
-                 (SETQ HEIGHT (+ ASCENT DESCENT))
-                 (SETQ BMAP (BITMAPCREATE TOTAL-WIDTH HEIGHT 1))
-                 (LOOP :FOR GLIM :IN GLYPHS-LIMITS :WITH GL :WITH GLBM :WITH GLW :WITH XCODE :DO
-                       (SETQ GL (GLIM-GLYPH GLIM))
-                       (SETQ GLBM (GLYPH-BITMAP GL))
-                       (SETQ GLW (GLIM-WIDTH GLIM))
-                       (SETQ XCODE (GLIM-XCODE GLIM))
-                       (BITBLT GLBM 0 0 BMAP (+ DLEFT (GLYPH-BBXOFF0 GL))
-                              (+ DESCENT (GLYPH-BBYOFF0 GL))
-                              (BITMAPWIDTH GLBM)
-                              (BITMAPHEIGHT GLBM)
-                              'INPUT
-                              'IL:REPLACE)
-                       (\\FSETOFFSET OFFSETS XCODE DLEFT)
-                       (\\FSETOFFSET WIDTHS XCODE GLW)
-                       (INCF DLEFT GLW))
-                 (IL:|replace| (CHARSETINFO IL:CHARSETBITMAP) IL:|of| CSINFO IL:|with| BMAP)
-                 CSINFO))))
-
-(DEFUN BDF-TO-FONTDESCRIPTOR (BDFONT FAMILY SIZE FACE ROTATION DEVICE &OPTIONAL 
-                                    MAP-UNKNOWN-TO-PRIVATE RAW-UNICODE-MAPPING)
-                                                      (IL:* IL:\; "Edited  5-Feb-2025 14:53 by mth")
-                                                      (IL:* IL:\; "Edited 30-Jan-2025 21:27 by mth")
-   (WHEN (AND (BDF-FONT-P BDFONT)
-              FAMILY)                                        (IL:* IL:\; "FAMILY Cannot be NIL")
-       (PROG (FONTDESC DEV GBCSL CHARSETS)
-             (WHEN (LISTP FAMILY)
-                 (RETURN (BDF-TO-FONTDESCRIPTOR BDFONT (FIRST FAMILY)
-                                (OR (SECOND FAMILY)
-                                    SIZE)
-                                (OR (THIRD FAMILY)
-                                    FACE "MRR")
-                                (OR (FOURTH FAMILY)
-                                    ROTATION 0)
-                                (OR (FIFTH FAMILY)
-                                    DEVICE
-                                    'DISPLAY)
-                                MAP-UNKNOWN-TO-PRIVATE)))
-             (WHEN (FONTP FAMILY)
-                 (RETURN (BDF-TO-FONTDESCRIPTOR BDFONT (FONTPROP FAMILY 'IL:FAMILY)
-                                (OR SIZE (FONTPROP FAMILY 'IL:SIZE))
-                                (OR FACE (FONTPROP FAMILY 'IL:FACE))
-                                (OR ROTATION (FONTPROP FAMILY 'IL:ROTATION))
-                                (OR DEVICE (FONTPROP FAMILY 'IL:DEVICE))
-                                MAP-UNKNOWN-TO-PRIVATE)))
-             (SETQ FAMILY (\\FONTSYMBOL FAMILY))
-             (UNLESS (AND (INTEGERP SIZE)
-                          (PLUSP SIZE))
-                    (ERROR "Invalid SIZE: ~S~%" SIZE))
-             (COND
-                ((NULL ROTATION)
-                 (SETQ ROTATION 0))
-                ((NOT (AND (INTEGERP ROTATION)
-                           (>= ROTATION 0)))
-                 (IL:\\ILLEGAL.ARG ROTATION)))
-             (SETQ DEV DEVICE)
-             (SETQ DEV (COND
-                          ((NULL DEVICE)
-                           'DISPLAY)
-                          ((AND (SYMBOLP DEVICE)
-                                (NOT (EQ DEVICE T)))         (IL:* IL:\; 
-   "Maybe wrong case or package, but we bet it's OK and defer expensive coercion until we've failed.")
-                           DEVICE)
-                          ((STRINGP DEVICE)
-                           (INTERN (STRING-UPCASE DEVICE)
-                                  "IL"))
-                          (T (IL:\\ILLEGAL.ARG DEVICE))))
-             (SETQ FACE (\\FONTFACE FACE NIL DEV))
-             (SETQ GBCSL (GLYPHS-BY-CHARSET BDFONT MAP-UNKNOWN-TO-PRIVATE RAW-UNICODE-MAPPING))
-             (FLET ((GBCS-TO-FONTDESC (GBCS FAMILY)
-                           (LET (FONTDESC CHARSETS)
-                                (WHEN GBCS
-                                    (SETQ FONTDESC
-                                          (IL:|create| FONTDESCRIPTOR
-                                                 IL:FONTDEVICE IL:_ DEV
-                                                 IL:FONTFAMILY IL:_ FAMILY
-                                                 IL:FONTSIZE IL:_ SIZE
-                                                 IL:FONTFACE IL:_ FACE
-                                                 IL:|\\SFAscent| IL:_ 0
-                                                 IL:|\\SFDescent| IL:_ 0
-                                                 IL:|\\SFHeight| IL:_ 0
-                                                 IL:ROTATION IL:_ ROTATION
-                                                 IL:FONTDEVICESPEC IL:_
-                                                 (LIST FAMILY SIZE FACE ROTATION DEV)))
-                                    (SETQ CHARSETS
-                                          (LOOP :FOR CS :IN GBCS :WITH CSET :WITH CSINFO :NCONC
-                                                (WHEN (<= 0 (SETQ CSET (FIRST CS))
-                                                          MAXCHARSET)
-                                                    (SETQ CSINFO (BDF-TO-CHARSETINFO GBCS CSET))
-                                                    (\\INSTALLCHARSETINFO FONTDESC CSINFO CSET)
-                                                    (LIST (CONS CSET CSINFO)))))
-                                    (SETQ CHARSETS (LOOP :FOR CSP :IN CHARSETS :WITH ASCENT =
-                                                         (FONTPROP FONTDESC 'IL:ASCENT)
-                                                         :WITH DESCENT = (FONTPROP FONTDESC
-                                                                                'IL:DESCENT)
-                                                         :WITH SLUGWIDTH = (1+ (\\AVGCHARWIDTH 
-                                                                                      FONTDESC))
-                                                         :COLLECT
-                                                         (PROGN (FIXUP-CHARSETINFO (CDR CSP)
-                                                                       ASCENT DESCENT SLUGWIDTH)
-                                                                (CAR CSP)))))
-                                (LIST FONTDESC CHARSETS))))
-                   (RETURN (VALUES-LIST (NCONC (GBCS-TO-FONTDESC (FIRST GBCSL)
-                                                      FAMILY)
-                                               (GBCS-TO-FONTDESC (SECOND GBCSL)
-                                                      (\\FONTSYMBOL (CONCATENATE 'STRING (SYMBOL-NAME
-                                                                                          FAMILY)
-                                                                           "-UNMAPPED")))
-                                               (LIST (ASSOC NOMAPPINGCHARSET (FIRST GBCSL)
-                                                            :TEST
-                                                            #'EQ)))))))))
-
-(DEFUN GET-GLYPH-LIMITS (GLYPH)                       (IL:* IL:\; "Edited  2-Feb-2025 21:07 by mth")
-                                                      (IL:* IL:\; "Edited 29-Jan-2025 16:28 by mth")
-   (LET* ((BBYOFF0 (GLYPH-BBYOFF0 GLYPH))
-          (ASCENT (+ (GLYPH-BBH GLYPH)
-                     BBYOFF0))
-          (DESCENT (ABS (MIN 0 BBYOFF0)))
-          (GWIDTH (MAX (+ (GLYPH-BBXOFF0 GLYPH)
-                          (GLYPH-BBW GLYPH))
-                       (FIRST (GLYPH-DWIDTH GLYPH)))))
-         (MAKE-GL-LIMITS :WIDTH GWIDTH :ASCENT ASCENT :DESCENT DESCENT)))
-
-(DEFUN GLYPHS-BY-CHARSET (FONT &OPTIONAL MAP-UNKNOWN-TO-PRIVATE RAW-UNICODE-MAPPING)
-                                                      (IL:* IL:\; "Edited  5-Feb-2025 12:53 by mth")
-                                                      (IL:* IL:\; "Edited  3-Feb-2025 23:00 by mth")
-                                                      (IL:* IL:\; "Edited  2-Feb-2025 20:29 by mth")
-                                                      (IL:* IL:\; "Edited 28-Jan-2025 23:09 by mth")
-                                                      (IL:* IL:\; "Edited 27-Jan-2025 17:22 by mth")
-                                                      (IL:* IL:\; "Edited 23-Jan-2025 17:58 by mth")
-                                                      (IL:* IL:\; "Edited  9-Jan-2025 11:23 by mth")
-   (LET* ((NCSETS (+ MAXCHARSET 2))
-          (CSETS (MAKE-ARRAY NCSETS :INITIAL-CONTENTS (LOOP :REPEAT NCSETS :COLLECT (CONS NIL))))
-          (UTOXFN (COND
-                     (RAW-UNICODE-MAPPING #'IDENTITY)
-                     (MAP-UNKNOWN-TO-PRIVATE #'UTOXCODE)
-                     (T #'UTOXCODE?)))
-          NOMAPPINGCSETS ENC XCODE CS XCS)
-         (UNLESS (OR MAP-UNKNOWN-TO-PRIVATE RAW-UNICODE-MAPPING)
-             (SETQ NOMAPPINGCSETS (MAKE-ARRAY NCSETS :INITIAL-CONTENTS (LOOP :REPEAT NCSETS :COLLECT
-                                                                             (CONS NIL)))))
-         (FLET ((PUT-GLYPH-IN-CHARSET-ARRAY (CODE GLYPH CSARRAY)
-                       (TCONC (AREF CSARRAY (LRSH CODE 8))
-                              (CONS (LOGAND CODE 255)
-                                    GLYPH))))
-               (LOOP :FOR GL :IN (BF-GLYPHS FONT)
-                     :DO
-                     (SETQ XCS NIL)
-                     (SETQ ENC (GLYPH-ENCODING GL))
-                     (SETQ XCODE (FUNCALL UTOXFN ENC))
-                     (IF RAW-UNICODE-MAPPING
-                         (COND
-                            ((> ENC 65535)
-                             (WARN "~&Unicode encoding is beyond 16 bits: ~5X" ENC)
-                             (TCONC (AREF CSETS NOMAPPINGCHARSET)
-                                    (CONS ENC GL)))
-                            ((AND NIL (= 255 (LOGAND ENC 255)))
-
-                             (IL:* IL:|;;| 
-                             "Temporarily? disable this warning in RAW-UNICODE-MAPPING mode")
-
-                             (WARN 
-                       "~&Unicode encoding char byte (~2X,FF)=(~O,377) may not =FF in FONTDESCRIPTOR"
-                                   (LRSH ENC 8)
-                                   (LRSH ENC 8))
-                             (TCONC (AREF CSETS NOMAPPINGCHARSET)
-                                    (CONS ENC GL)))
-                            (T (PUT-GLYPH-IN-CHARSET-ARRAY ENC GL CSETS)))
-                         (COND
-                            ((NULL XCODE)
-
-                             (IL:* IL:|;;| "These assoc with the Unicode encoding")
-
-                             (COND
-                                ((OR (> ENC 65535)
-                                     (= 255 (LOGAND ENC 255)))
-
-                                 (IL:* IL:|;;| 
-            "Unicode encoding is > xFFFF, or encoding low byte is FF, put it in the NOMAPPINGCHARSET")
-
-                                 (TCONC (AREF CSETS NOMAPPINGCHARSET)
-                                        (CONS ENC GL)))
-                                (T (PUT-GLYPH-IN-CHARSET-ARRAY ENC GL NOMAPPINGCSETS))))
-                            ((AND (INTEGERP XCODE)
-                                  (<= 0 XCODE 65535))
-
-                             (IL:* IL:|;;| 
-                             "These assoc with the 8 bit character code within the charset")
-
-                             (PUT-GLYPH-IN-CHARSET-ARRAY XCODE GL CSETS))
-                            ((LISTP XCODE)
-
-                             (IL:* IL:|;;| 
-                          "These assoc with the 8 bit character code within the charset (like above)")
-
-                             (LOOP :FOR XC :IN XCODE :UNLESS (MEMBER (SETQ CS (LRSH XC 8))
-                                                                    XCS)
-                                   :DO
-                                   (PUSH CS XCS)
-                                   (PUT-GLYPH-IN-CHARSET-ARRAY XC GL CSETS)))
-                            (T (ERROR "Invalid XCODE: ~A~%"))))))
-
-         (IL:* IL:|;;| "Extract the lists from the TCONC pointers")
-
-         (LOOP :FOR I :FROM 0 :TO NOMAPPINGCHARSET :DO (SETF (AREF CSETS I)
-                                                             (SORT (REMOVE-DUPLICATES
-                                                                    (CAR (AREF CSETS I))
-                                                                    :TEST
-                                                                    #'EQUAL)
-                                                                   #'< :KEY #'CAR)))
-         (SETQ CSETS (LOOP :FOR I :FROM 0 :TO NOMAPPINGCHARSET :NCONC
-                           (LET ((CS (AREF CSETS I)))
-                                (WHEN CS
-                                    (LIST (LIST I CS))))))
-
-         (IL:* IL:|;;| "Likewise for the NOMAPPINGCSETS, if any.")
-
-         (WHEN NOMAPPINGCSETS
-             (LOOP :FOR I :FROM 0 :TO NOMAPPINGCHARSET :DO
-                   (SETF (AREF NOMAPPINGCSETS I)
-                         (SORT (REMOVE-DUPLICATES (CAR (AREF NOMAPPINGCSETS I))
-                                      :TEST
-                                      #'EQUAL)
-                               #'< :KEY #'CAR)))
-             (SETQ NOMAPPINGCSETS (LOOP :FOR I :FROM 0 :TO NOMAPPINGCHARSET :NCONC
-                                        (LET ((CS (AREF NOMAPPINGCSETS I)))
-                                             (WHEN CS
-                                                 (LIST (LIST I CS)))))))
-         (LIST CSETS NOMAPPINGCSETS)))
-
-(DEFUN SPLIT-FONT-NAME (NAME)                         (IL:* IL:\; "Edited 31-Jan-2025 22:20 by mth")
-   (LOOP :FOR I = (IF (CHAR= #\- (ELT NAME 0))
-                      1
-                      0)
-         THEN
-         (1+ J)
-         :AS J = (POSITION #\- NAME :START I :TEST #'CHAR=)
-         :COLLECT
-         (SUBSEQ NAME I J)
-         :WHILE J))
-
-(DEFUN WRITE-BDF-TO-DISPLAYFONT-FILES (BDFONT DEST-DIR &OPTIONAL MAP-UNKNOWN-TO-PRIVATE 
-                                             RAW-UNICODE-MAPPING FAMILY SIZE FACE ROTATION DEVICE)
-                                                      (IL:* IL:\; "Edited  5-Feb-2025 15:05 by mth")
+(DEFUN WRITE-BDF-TO-DISPLAYFONT-FILES (BDFONT DEST-DIR &KEY FAMILY SIZE FACE ROTATION DEVICE
+                                             (CHAR-SETS T)
+                                             MAP-UNKNOWN-TO-PRIVATE WRITE-UNMAPPED 
+                                             RAW-UNICODE-MAPPING)
+                                                      (IL:* IL:\; "Edited 25-Apr-2025 10:08 by mth")
+                                                      (IL:* IL:\; "Edited 24-Apr-2025 00:09 by mth")
+                                                      (IL:* IL:\; "Edited 21-Apr-2025 16:03 by mth")
                                                       (IL:* IL:\; "Edited  3-Feb-2025 23:18 by mth")
    (UNLESS (TYPEP BDFONT 'BDF-FONT)
           (ERROR "Not a BDF-FONT: ~S~%" BDFONT))
+   (COND
+      ((EQ CHAR-SETS T)                                      (IL:* IL:\; "This means ALL charsets")
+       )
+      ((NULL CHAR-SETS)
+       (SETQ CHAR-SETS '(0))                                 (IL:* IL:\; "Only charset 0")
+       )
+      ((AND (INTEGERP CHAR-SETS)
+            (<= 0 CHAR-SETS MAXCHARSET))                     (IL:* IL:\; "A single integer charset")
+       (SETQ CHAR-SETS (LIST CHAR-SETS)))
+      ((AND (LISTP CHAR-SETS)
+            (EVERY #'(LAMBDA (CS)
+                            (AND (INTEGERP CS)
+                                 (<= 0 CS MAXCHARSET)))
+                   CHAR-SETS)))
+      (T (ERROR "Invalid specification of :CHAR-SETS ~S~%" CHAR-SETS)))
    (DESTRUCTURING-BIND (FN-FAMILY FN-FACE FN-SIZE)
           (GET-FAMILY-FACE-SIZE-FROM-NAME BDFONT)
           (SETQ FAMILY (OR FAMILY FN-FAMILY))
@@ -683,17 +774,29 @@ FONTPROP INPUT ITALIC LIGHT LRSH MEDIUM REGULAR TCONC UTOXCODE UTOXCODE? WRITEST
           (MULTIPLE-VALUE-BIND (FONTDESC CSETS UNMAPPED-FONTDESC UNICODE-CSETS UNMAPPEDGLYPHS)
                  (BDF-TO-FONTDESCRIPTOR BDFONT FAMILY SIZE FACE ROTATION DEVICE 
                         MAP-UNKNOWN-TO-PRIVATE RAW-UNICODE-MAPPING)
+                 (UNLESS (EQ CHAR-SETS T)
+                     (SETQ CSETS (INTERSECTION CHAR-SETS CSETS))
+                     (SETQ UNICODE-CSETS (INTERSECTION CHAR-SETS UNICODE-CSETS)))
                  (LOOP :FOR CS :IN CSETS :DO (WRITESTRIKEFONTFILE FONTDESC CS
                                                     (PACKFILENAME.STRING :BODY DEST-DIR :NAME
                                                            (\\FONTFILENAME FAMILY SIZE FACE 
                                                                   "DISPLAYFONT" CS))))
-                 (LOOP :FOR CS :IN UNICODE-CSETS :DO (WRITESTRIKEFONTFILE
-                                                      UNMAPPED-FONTDESC CS
-                                                      (PACKFILENAME.STRING :BODY DEST-DIR :NAME
-                                                             (\\FONTFILENAME (FONTPROP 
-                                                                                    UNMAPPED-FONTDESC
-                                                                                    'IL:FAMILY)
-                                                                    SIZE FACE "DISPLAYFONT" CS))))
+                 (IF WRITE-UNMAPPED
+                     (LOOP :FOR CS :IN UNICODE-CSETS :DO (WRITESTRIKEFONTFILE
+                                                          UNMAPPED-FONTDESC CS
+                                                          (PACKFILENAME.STRING
+                                                           :BODY DEST-DIR :NAME
+                                                           (\\FONTFILENAME (FONTPROP 
+                                                                                  UNMAPPED-FONTDESC
+                                                                                  'IL:FAMILY)
+                                                                  SIZE FACE "DISPLAYFONT" CS))))
+                     (SETQ UNICODE-CSETS NIL))
+
+                 (IL:* IL:|;;| "These correspond to the charsets ACTUALLY written.")
+
+                 (IL:* IL:|;;| 
+        "UNMAPPEDGLYPHS are never written. (Unicode encoding is > xFFFF, or encoding low byte is FF)")
+
                  (VALUES FONTDESC CSETS UNMAPPED-FONTDESC UNICODE-CSETS UNMAPPEDGLYPHS))))
 (IL:DECLARE\: IL:EVAL@COMPILE IL:DONTCOPY 
 
@@ -719,11 +822,10 @@ FONTPROP INPUT ITALIC LIGHT LRSH MEDIUM REGULAR TCONC UTOXCODE UTOXCODE? WRITEST
 
 (IL:PUTPROPS IL:READ-BDF IL:DATABASE IL:NO)
 (IL:DECLARE\: IL:DONTCOPY
-  (IL:FILEMAP (NIL (2291 3912 (FIXUP-CHARSETINFO 2291 . 3912)) (3914 6946 (
-GET-FAMILY-FACE-SIZE-FROM-NAME 3914 . 6946)) (6948 8373 (PACKFILENAME.STRING 6948 . 8373)) (8375 14009
- (READ-BDF 8375 . 14009)) (14011 14334 (READ-DELIMITED-LIST-FROM-STRING 14011 . 14334)) (14336 20558 (
-READ-GLYPH 14336 . 20558)) (20560 25963 (BDF-TO-CHARSETINFO 20560 . 25963)) (25965 32055 (
-BDF-TO-FONTDESCRIPTOR 25965 . 32055)) (32057 32654 (GET-GLYPH-LIMITS 32057 . 32654)) (32656 38670 (
-GLYPHS-BY-CHARSET 32656 . 38670)) (38672 39035 (SPLIT-FONT-NAME 38672 . 39035)) (39037 41216 (
-WRITE-BDF-TO-DISPLAYFONT-FILES 39037 . 41216)))))
+  (IL:FILEMAP (NIL (2427 10386 (BDF-TO-CHARSETINFO 2427 . 10386)) (10388 16258 (BDF-TO-FONTDESCRIPTOR 
+10388 . 16258)) (16260 19623 (GET-FAMILY-FACE-SIZE-FROM-NAME 16260 . 19623)) (19625 26436 (
+GLYPHS-BY-CHARSET 19625 . 26436)) (26438 27863 (PACKFILENAME.STRING 26438 . 27863)) (27865 34669 (
+READ-BDF 27865 . 34669)) (34671 34994 (READ-DELIMITED-LIST-FROM-STRING 34671 . 34994)) (34996 41484 (
+READ-GLYPH 34996 . 41484)) (41486 42227 (SPLIT-FONT-NAME 41486 . 42227)) (42229 46011 (
+WRITE-BDF-TO-DISPLAYFONT-FILES 42229 . 46011)))))
 IL:STOP
diff --git a/lispusers/READ-BDF.DFASL b/lispusers/READ-BDF.DFASL
index 87b9e207..63184416 100644
Binary files a/lispusers/READ-BDF.DFASL and b/lispusers/READ-BDF.DFASL differ
diff --git a/lispusers/READ-BDF.TEDIT b/lispusers/READ-BDF.TEDIT
index 50e3c235..8f6e2ec5 100644
Binary files a/lispusers/READ-BDF.TEDIT and b/lispusers/READ-BDF.TEDIT differ
