Rmk103 font and related code updates (#2216)

This PR contains a large number of changes in support of the implementation of the  Medley Dsplay Fon file format.

The changes are documented in the docs/internal/FONTCHANGES.TEDIT file.

internal/FONT-DEBUG

@@ -0,0 +1,352 @@
+(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
+
+
(FILECREATED "19-Jul-2025 16:43:34" {WMEDLEY}<internal>FONT-DEBUG.;46
 19345  
+
+      :EDIT-BY rmk
+
+      :CHANGES-TO (FNS CSBMSIZE FONTSIZE CSSIZE EQCHARBM)
+                  (VARS FONT-DEBUGCOMS)
+
+      :PREVIOUS-DATE "19-Jul-2025 12:36:48" {WMEDLEY}<internal>FONT-DEBUG.;41)
+
+
+(PRETTYCOMPRINT FONT-DEBUGCOMS)
+
+(RPAQQ FONT-DEBUGCOMS
 (
+                       (* ;; "Little tools to help in debugging display fonts")

+
+                       (FNS DEBUGCHARSET IBM ICS SHOWCACHE SHOWCSBITMAP EQCSBM EQCHARBM CHARSETCHARS
+                            CHARBMDIFFS SHOWCSCHAR CSCOMPARE SHOWBMS SHOWCHARBITMAPS CANDS)
+                       (FNS FONTSIZE CSSIZE CSBMSIZE)))
+
+
+
+(* ;; "Little tools to help in debugging display fonts")

+
+(DEFINEQ
+
+(DEBUGCHARSET

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


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


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


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


+                                                             (* ; "Edited 25-Jun-2025 19:25 by rmk")


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

+
+    (* ;; "Reads the CHARSETINFO for FONTSPEC and CHARSET, where FONTSPEC can be a (family size...) specification or the name of a fontfile (ac, strike, medleyfont format).  Avoids the MEDLEYFONT files if NOTMEDLEYFONT.")

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

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


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


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

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

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

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


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


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


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


+                                                             (* ; "Edited 21-Jun-2025 22:00 by rmk")


+                                                             (* ; "Edited 20-Jun-2025 17:10 by rmk")


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

+
+    (* ;; "Inspects the charset bitmap for CHARSET in FONT.  If FONT is a filename, gets the csinfo directly from the file, doesn't build the font.")

+
+    (LET ((CSINFO (DEBUGCHARSET
 FONT CHARSET INCLUDEMEDLEYFONT)))
+         (if
 CSINFO
+             then
 (INSPECT CSINFO)
+                  (SHOWCSBITMAP
 CSINFO)
+                  (LIST (GETMULTI (fetch
 (CHARSETINFO CSINFOPROPS) of
 CSINFO)
+                               'FILE)
+                        CSINFO)
+           else
 "NO CSINFO"])
+
+(SHOWCACHE

+  [LAMBDA NIL
                                                (* ; "Edited 29-Jun-2025 17:19 by rmk")


+                                                             (* ; "Edited 18-Jun-2025 22:50 by rmk")

+
+    (* ;; "Keyboard shortcut to show the current caches")

+
+    (DV \FONTSINCORE)
+    (DV \FONTEXISTS?-CACHE])
+
+(SHOWCSBITMAP

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


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

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

+
+    (* ;; "If we call the inspector, it asks for contents vs. fields, also a pain, and we still don't get the window.")

+
+    (LET (BM)
+         (if
 (NOT CSINFO)
+             then
 (PRINTOUT T "NO CSINFO" T)
+           elseif
 (AND (IGREATERP (BITMAPWIDTH (SETQ BM (fetch
 CHARSETBITMAP of
 CSINFO)))
+                              0)
+                       (IGREATERP (BITMAPHEIGHT BM)
+                              0))
+             then
 (EVAL.AS.PROCESS (LIST 'EDITBM BM))
+           else
 "EMPTY BITMAP")
+         CSINFO])
+
+(EQCSBM

+  [LAMBDA (CS1 CS2 CHARSET INCLUDEMEDLEYFONT)
                (* ; "Edited  6-Jul-2025 22:04 by rmk")


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


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


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

+
+    (* ;; "True if the two charsetinfos are equivalent in all respects.  If either of CS1 or CS2 is a fontdescriptor (not a charsetinfo), then coerces to CHARSET in that font.")

+
+    (SETQ CS1 (DEBUGCHARSET
 CS1 CHARSET INCLUDEMEDLEYFONT))
+    (SETQ CS2 (DEBUGCHARSET
 CS2 CHARSETINCLUDEMEDLEYFONT))
+    (EQUALALL (fetch
 (CHARSETINFO CHARSETBITMAP) of
 CS1)
+           (fetch
 (CHARSETINFO CHARSETBITMAP) of
 CS2])
+
+(EQCHARBM

+  [LAMBDA (CHAR1 CHAR2 CS1 CS2 EXCLUDEMEDLEYFONT)
            (* ; "Edited 19-Jul-2025 12:46 by rmk")

+
+    (* ;; 
+
    "True if the character bitmap for CHAR1 in CS1 is equivalent to the bitmap for CHAR2 in CS2.  ")

+
+    (CL:UNLESS (CHARCODEP CHAR1)
+        (SETQ CHAR1 (CHARCODE.DECODE CHAR1)))
+    (CL:UNLESS (CHARCODEP CHAR2)
+        (SETQ CHAR2 (CHARCODE.DECODE CHAR2)))
+    (SETQ CS1 (DEBUGCHARSET
 CS1 (\CHARSET CHAR1)
+                     (NOT EXCLUDEMEDLEYFONT)))
+    (SETQ CS2 (DEBUGCHARSET
 CS2 (\CHARSET CHAR2)
+                     (NOT EXCLUDEMEDLEYFONT)))
+    (EQUALALL (\GETCHARBITMAP.CSINFO (\CHAR8CODE CHAR1)
+                     CS1)
+           (\GETCHARBITMAP.CSINFO (\CHAR8CODE CHAR2)
+                  CS2])
+
+(CHARSETCHARS

+  [LAMBDA (CSINFO CHARSET INCLUDEMEDLEYFONT)
                 (* ; "Edited  6-Jul-2025 22:04 by rmk")


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


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

+
+    (* ;; "Returns a list of character codes that are instantiated in CSINFO (which may be specified as a font/charset combination).")

+
+    (SETQ CSINFO (DEBUGCHARSET
 CSINFO CHARSET INCLUDEMEDLEYFONT))
+    (for
 CODE from
 0 to
 \MAXTHINCHAR unless
 (SLUGCHARP.DISPLAY CODE CSINFO) collect
 CODE])
+
+(CHARBMDIFFS

+  [LAMBDA (CS1 CS2 CHARSET INCLUDEMEDLEYFONT)
                (* ; "Edited  6-Jul-2025 22:04 by rmk")


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


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

+
+    (* ;; 
+
    "Returns the codes whose bitmaps in CS1 and CS2 differ in some way.  Use EDITCHAR to view them.")

+
+    (SETQ CS1 (DEBUGCHARSET
 CS1 CHARSET INCLUDEMEDLEYFONT))
+    (SETQ CS2 (DEBUGCHARSET
 CS2 CHARSET INCLUDEMEDLEYFONT))
+    (for
 CODE in
 (INTERSECTION (CHARSETCHARS
 CS1)
+                        (CHARSETCHARS
 CS2)) unless
 (EQUALALL (\GETCHARBITMAP.CSINFO CODE CS1)
+                                                          (\GETCHARBITMAP.CSINFO CODE CS2))
+       collect
 CODE])
+
+(SHOWCSCHAR

+  [LAMBDA (CODE CSINFO CHARSET INCLUDEMEDLEYFONT)
            (* ; "Edited  6-Jul-2025 22:04 by rmk")


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


+                                                             (* ; "Edited 29-Jun-2025 18:01 by rmk")

+    (EDITBM (\GETCHARBITMAP.CSINFO CODE (DEBUGCHARSET
 CSINFO CHARSET INCLUDEMEDLEYFONT])
+
+(CSCOMPARE

+  [LAMBDA (CS1 CS2 CHARSET INCLUDEMEDLEYFONT)
                (* ; "Edited  6-Jul-2025 22:04 by rmk")


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


+                                                             (* ; "Edited 30-Jun-2025 14:02 by rmk")

+    (CL:UNLESS CS2
+        (CL:WHEN (OR (LITATOM CS1)
+                     (STRINGP CS1))
+            (SETQ CS2 (\FONTINFOFROMFILENAME CS1 'DISPLAY))
+            [if
 CHARSET
+                then
 (CL:UNLESS (EQ CHARSET (CAR (LAST CS2)))
+                            (ERROR "MISMATCHING CHARSETS"))
+              else
 (SETQ CHARSET (CAR (LAST CS2]))
+    (SETQ CS1 (OR (DEBUGCHARSET
 CS1 CHARSET INCLUDEMEDLEYFONT)
+                  (ERROR CS1 "not found")))
+    (SETQ CS2 (OR (DEBUGCHARSET
 CS2 CHARSET INCLUDEMEDLEYFONT)
+                  (ERROR CS2 "not found")))
+    (LET ((CS1CHARS (CHARSETCHARS
 CS1))
+          (CS2CHARS (CHARSETCHARS
 CS2))
+          (ASCENT1 (fetch
 (CHARSETINFO CHARSETASCENT) of
 CS1))
+          (ASCENT2 (fetch
 (CHARSETINFO CHARSETASCENT) of
 CS2))
+          (DESCENT1 (fetch
 (CHARSETINFO CHARSETDESCENT) of
 CS1))
+          (DESCENT2 (fetch
 (CHARSETINFO CHARSETDESCENT) of
 CS2))
+          DIFF)
+         (if
 (EQ ASCENT1 ASCENT2)
+             then
 (PRINTOUT T "Same ascent  = " .I2 ASCENT1 T)
+           else
 (PRINTOUT T " Ascent1 = " .I2 ASCENT1 "   Ascent2 = " .I2 ASCENT2 T))
+         (if
 (EQ DESCENT1 DESCENT2)
+             then
 (PRINTOUT T "Same descent = " .I2 DESCENT1 T)
+           else
 (PRINTOUT T "Descent1 = " .I2 DESCENT1 "  Descent2 = " .I2 DESCENT2 T))
+         (PRINTOUT T "Common chars:" 14 .PPV (SORT (INTERSECTION CS1CHARS CS2CHARS))
+                T)
+         (SETQ DIFF (SORT (CHARBMDIFFS
 CS1 CS2)))
+         (if
 (NULL DIFF)
+             then
 (PRINTOUT T 5 "All common chars have the SAME bitmaps" T)
+           elseif
 (EQUAL DIFF (SORT (INTERSECTION CS1CHARS CS2CHARS)))
+             then
 (PRINTOUT T 5 "All common chars have DIFFERENT bitmaps" T)
+           else
 (PRINTOUT T 5 "Common chars with different bitmaps:  " .PPV DIFF T))
+         (CL:WHEN (SETQ DIFF (LDIFFERENCE CS1CHARS CS2CHARS))
+             (PRINTOUT T "1 but not 2:" 14 .PPV (SORT (LDIFFERENCE CS1CHARS CS2CHARS))
+                    T))
+         (CL:WHEN (SETQ DIFF (LDIFFERENCE CS2CHARS CS1CHARS))
+             (PRINTOUT T "2 but not 1:" 14 .PPV (SORT (LDIFFERENCE CS2CHARS CS1CHARS))
+                    T))
+         (LIST CS1 CS2])
+
+(SHOWBMS

+  [LAMBDA (CHARSETINFOS)
                                     (* ; "Edited 30-Jun-2025 08:47 by rmk")

+    (for
 CS in
 CHARSETINFOS do
 (ICS
 CS])
+
+(SHOWCHARBITMAPS

+  [LAMBDA (CODE CSINFOS CHARSET INCLUDEMEDLEYFONT CLOSEPREVIOUS)

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


+                                                             (* ; "Edited  2-Jul-2025 11:48 by rmk")


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

+
+    (* ;; "Shows the bitmap for CODE in each of the CSINFOS")

+
+    (* ;; "If we call the inspector directly, it asks for contents vs. fields, also a pain, and we still don't get our hands on the window.")

+
+    [SETQ CSINFOS (for
 CS inside
 CSINFOS collect
 (OR (DEBUGCHARSET
 CS CHARSET INCLUDEMEDLEYFONT)
+                                                     (ERROR CS "not found"]
+    (CL:WHEN CLOSEPREVIOUS
+        (for
 W in
 (OPENWINDOWS) when
 (EQ 'EDITBMREPAINTFN (WINDOWPROP W 'REPAINTFN))
+           do
 (CLOSEW W)))
+    (if
 (CHARCODEP CODE)
+        then
 (for
 CS BM in
 CSINFOS do
 (SETQ BM (\GETCHARBITMAP.CSINFO CODE CS))
+                                      (if
 (AND (IGREATERP (BITMAPWIDTH BM)
+                                                      0)
+                                               (IGREATERP (BITMAPHEIGHT BM)
+                                                      0))
+                                          then
 (EVAL.AS.PROCESS (LIST 'EDITBM BM))
+                                        else
 "EMPTY BITMAP"))
+      else
 (for
 CS in
 CSINFOS do
 (SHOWCSBITMAP
 CS])
+
+(CANDS

+  [LAMBDA (CS1 CS2 CHARSET INCLUDEMEDLEYFONT)
                (* ; "Edited  2-Jul-2025 11:47 by rmk")

+
+    (* ;; "Wraps comparing and showing, closes previous bitmap windows")

+
+    (LET ((CINFOS (CSCOMPARE
 CS1 CS2 CHARSET INCLUDEMEDLEYFONT)))
+         (SHOWCHARBITMAPS
 NIL CINFOS CHARSET INCLUDEMEDLEYFONT T)
+         CINFOS])
+)
+(DEFINEQ
+
+(FONTSIZE

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

+    (SETQ FONT (FONTCREATE FONT NIL NIL NIL 'DISPLAY NOERROR))
+    (CL:UNLESS CHARSETS
+        (SETQ CHARSETS (for
 CS CSINFO BM from
 0 to
 255 when
 (SETQ CSINFO (\XGETCHARSETINFO FONT CS))
+                          unless
 (fetch
 (CHARSETINFO CSSLUGP) of
 CSINFO) collect
 CS)))
+    (PRINTOUT T "Charsets: ")
+    (for
 CS CSINFO inside
 CHARSETS sum
 (PRINTOUT T CS " ")
+                                       (CSSIZE
 (\XGETCHARSETINFO FONT CS)
+                                              T) finally
 (PRINTOUT T T])
+
+(CSSIZE

+  [LAMBDA (CSINFO INCLUDEBM)
                                 (* ; "Edited 19-Jul-2025 16:37 by rmk")

+
+    (* ;; "Returns")

+
+    (LET ((BLOCKSIZE (UNFOLD (IPLUS \MAXCHARSET 3)
+                            2))
+          BM)
+         (IPLUS (CL:IF (fetch
 (CHARSETINFO OFFSETS) of
 CSINFO)
+                    BLOCKSIZE
+                    0)
+                (CL:IF (fetch
 (CHARSETINFO WIDTHS) of
 CSINFO)
+                    BLOCKSIZE
+                    0)
+                (CL:IF (AND (NEQ (fetch
 (CHARSETINFO WIDTHS) of
 CSINFO)
+                                 (fetch
 (CHARSETINFO IMAGEWIDTHS) of
 CSINFO))
+                            (fetch
 (CHARSETINFO IMAGEWIDTHS) of
 CSINFO))
+                    BLOCKSIZE
+                    0)
+                (CL:IF (fetch
 (CHARSETINFO YWIDTHS) of
 CSINFO)
+                    BLOCKSIZE
+                    0)
+                (CL:IF (ARRAYP (fetch
 (CHARSETINFO LEFTKERN) of
 CSINFO))
+                    (UNFOLD (ARRAYSIZE (fetch
 (CHARSETINFO LEFTKERN) of
 CSINFO))
+                           4)
+                    0)
+                (CL:IF (AND INCLUDEBM (SETQ BM (fetch
 (CHARSETINFO CHARSETBITMAP) of
 CSINFO)))
+                    (IQUOTIENT (ITIMES (BITMAPWIDTH BM)
+                                      (BITMAPHEIGHT BM))
+                           8)
+                    0)])
+
+(CSBMSIZE

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


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

+
+    (* ;; "Returns the number of bytes in the CHARSET bitmap for FONT, what's in core unless FILETOO")

+
+    (if
 (SETQ FONT (FONTCREATE FONT NIL NIL NIL 'DISPLAY NOERROR))
+        then
 (CL:UNLESS CHARSETS
+                 (SETQ CHARSETS (for
 CS CSINFO BM from
 0 to
 255 when
 (SETQ CSINFO (\XGETCHARSETINFO
+                                                                                   FONT CS))
+                                   unless
 (fetch
 (CHARSETINFO CSSLUGP) of
 CSINFO) collect
 CS)))
+             (PRINTOUT T "Charsets: ")
+             (for
 CS CSINFO BM inside
 CHARSETS sum
 (PRINTOUT T CS " ")
+                                                   (SETQ BM (fetch
 (CHARSETINFO CHARSETBITMAP)
+                                                               of
 (\XGETCHARSETINFO FONT CS)))
+                                                   (IQUOTIENT (ITIMES (BITMAPWIDTH BM)
+                                                                     (BITMAPHEIGHT BM))
+                                                          8) finally
 (PRINTOUT T T))
+      else
 0])
+)
+(DECLARE%: DONTCOPY
+  (FILEMAP (NIL (818 15839 (DEBUGCHARSET 828 . 4007) (IBM 4009 . 4717) (ICS 4719 . 6013) (SHOWCACHE 6015
+ . 6362) (SHOWCSBITMAP 6364 . 7478) (EQCSBM 7480 . 8366) (EQCHARBM 8368 . 9129) (CHARSETCHARS 9131 . 
+9797) (CHARBMDIFFS 9799 . 10675) (SHOWCSCHAR 10677 . 11112) (CSCOMPARE 11114 . 13706) (SHOWBMS 13708
+ . 13886) (SHOWCHARBITMAPS 13888 . 15479) (CANDS 15481 . 15837)) (15840 19322 (FONTSIZE 15850 . 16535)
+ (CSSIZE 16537 . 17946) (CSBMSIZE 17948 . 19320)))))
+STOP

internal/loadups/LOADUP-FULL

@@ -1,13 +1,12 @@
 (DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
 
-
(FILECREATED "23-Apr-2025 05:14:27" {DSK}<home>larry>il>medley>internal>loadups>LOADUP-FULL.;2
 4662   
+
(FILECREATED "13-Jul-2025 11:41:03" {WMEDLEY}<internal>loadups>LOADUP-FULL.;28
 5184   
 
-      :EDIT-BY "lmm"
+      :EDIT-BY rmk
 
       :CHANGES-TO (FNS LOADFULLFONTS)
 
-      :PREVIOUS-DATE "31-Jul-2023 18:28:53" {DSK}<home>larry>il>medley>internal>loadups>LOADUP-FULL.;1
-)
+      :PREVIOUS-DATE "30-Jun-2025 00:04:34" {WMEDLEY}<internal>loadups>LOADUP-FULL.;27)
 
 
 (PRETTYCOMPRINT LOADUP-FULLCOMS)
@@ -17,32 +16,37 @@
 (DEFINEQ
 
 (LOADFULLFONTS

-  [LAMBDA NIL
                                                (* ; "Edited 23-Apr-2025 05:13 by lmm")


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


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


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


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


+                                                             (* ; "Edited 23-Apr-2025 05:13 by lmm")


                                                            (* ; "Edited 13-Feb-2021 22:51 by larry")

 
     (* ;; " Don't do Interpress. Do character set 0 and the symbol character sets 41Q, 42Q, 356Q, 357Q and extended and accented Latin 43Q and 361Q")

 
     (PRINTOUT T "Loading FULL fonts..." T)
-    (SETQ DISPLAYFONTEXTENSIONS '(DISPLAYFONT STRIKE))
     (SETQ *POSTSCRIPT-FILE-TYPE* 'TEXT)
-    (RESETVARS ((MISSINGDISPLAYFONTCOERCIONS NIL)
-                (MISSINGCHARSETDISPLAYFONTCOERCIONS NIL))    (* ; 
-
                    "Don't let the font loader substitute just because a server went catatonic on us")

-               (for
 FAMILY in
 '(CLASSIC MODERN TERMINAL)
-                  do
 (PRINTOUT T "  Loading " FAMILY " ")
-                     [for
 SIZE in
 '(8 10 12)
-                        do
 (PRINTOUT T SIZE " ")
-                           (for
 FACE in
 '(MRR BRR MIR)
-                              do
 (for
 CSET in
 '(0 33 34 35 238 239 241)
-                                    do
 (NLSETQ (FONTCREATE FAMILY SIZE FACE NIL 'DISPLAY NIL CSET]
-                     (PRINTOUT T T))
-               (PRINTOUT T "  Loading postscript fonts" T)
-               (for
 F in
 (FILDIR (CONCAT (CAR POSTSCRIPTFONTDIRECTORIES)
-                                        ">c0>*.PSCFONT")) do
 (PSCFONT.READFONT F))
-               (PRINTOUT T "FULL fonts loaded" T])
+
+    (* ;; "Previous code reset the coercion variables to NIL, which would have resulted in glyph-incomplete charsets. With Medley-formatted fonts, the completions have already been installed in the files and there is no need to deal with those variables.")

+
+    (for
 FAMILY in
 '(CLASSIC MODERN TERMINAL)
+       do
 (PRINTOUT T "  Loading " FAMILY " ")
+          [for
 SIZE in
 '(8 10 12)
+             do
 (PRINTOUT T SIZE " ")
+                (for
 FACE in
 '(MRR BRR MIR)
+                   do
 (FONTCREATE FAMILY SIZE FACE 0 'DISPLAY NIL 0)
+                      (for
 CSET in
 '(33 34 35 238 239 241)
+                         do
 (NLSETQ (FONTCREATE FAMILY SIZE FACE 0 'DISPLAY NIL CSET]
+          (PRINTOUT T T))
+    (PRINTOUT T "  Loading postscript fonts" T)
+    (for
 F in
 (FILDIR (CONCAT (CAR POSTSCRIPTFONTDIRECTORIES)
+                             ">c0>*.PSCFONT")) do
 (PSCFONT.READFONT F))
+    (PRINTOUT T "FULL fonts loaded" T])
 
 (LOADUP-FULL

-  [LAMBDA (DRIBBLEFILE)
                                      (* ; "Edited 18-Jan-2023 16:22 by FGH")


+  [LAMBDA (DRIBBLEFILE)
                                      (* ; "Edited 21-Jun-2025 23:33 by rmk")


+                                                             (* ; "Edited 18-Jan-2023 16:22 by FGH")


                                                              (* ; "Edited 12-Aug-2022 11:17 by lmm")


                                                              (* ; "Edited 14-Jul-2022 12:32 by rmk")


                                                              (* ; "Edited 12-Jul-2022 21:57 by rmk")


@@ -67,6 +71,7 @@
            " while connected to "
            (DIRECTORYNAME T)
            T T)
+    (LOADUP '(MULTI-ALIST))                                  (* ; "For FONTSAVAILABLE lookup")

     (LOADUP '(POSTSCRIPTSTREAM))                             (* ; " to get PSCFONT.READFONT")

     (LOADFULLFONTS
)
     (LISTPUT IDLE.PROFILE 'TIMEOUT 0)
@@ -89,5 +94,5 @@
 
 (FIXMETA
)
 (DECLARE%: DONTCOPY
-  (FILEMAP (NIL (493 4624 (LOADFULLFONTS 503 . 2059) (LOADUP-FULL 2061 . 4374) (FIXMETA 4376 . 4622)))))
+  (FILEMAP (NIL (458 5146 (LOADFULLFONTS 468 . 2373) (LOADUP-FULL 2375 . 4896) (FIXMETA 4898 . 5144)))))
 STOP

internal/loadups/LOADUP-LISP

@@ -1,13 +1,12 @@
 (DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "XCL" BASE 10)
 
-
(FILECREATED "21-Mar-2024 10:56:13" |{DSK}<home>larry>il>medley>internal>loadups>LOADUP-LISP.;4|
 5586   
+
(FILECREATED "15-Jun-2025 14:39:57" |{WMEDLEY}<internal>loadups>LOADUP-LISP.;20|
 6425   
 
-      :EDIT-BY "lmm"
+      :EDIT-BY |rmk|
 
       :CHANGES-TO (FNS LOADUP-LISP)
 
-      :PREVIOUS-DATE "14-Mar-2024 12:16:33" 
-|{DSK}<home>larry>il>medley>internal>loadups>LOADUP-LISP.;3|)
+      :PREVIOUS-DATE "24-May-2025 10:20:14" |{WMEDLEY}<internal>loadups>LOADUP-LISP.;14|)
 
 
 (PRETTYCOMPRINT LOADUP-LISPCOMS)
@@ -20,7 +19,12 @@
 (DEFINEQ
 
 (LOADUP-LISP

-  (LAMBDA (DRIBBLEFILE)
                                     (* \; "Edited 21-Mar-2024 10:55 by lmm")


+  (LAMBDA (DRIBBLEFILE)
                                     (* \; "Edited 15-Jun-2025 14:39 by rmk")


+                                                            (* \; "Edited 24-May-2025 10:20 by rmk")


+                                                            (* \; "Edited 21-May-2025 09:25 by rmk")


+                                                            (* \; "Edited  5-May-2025 21:25 by rmk")


+                                                            (* \; "Edited  2-May-2025 22:12 by rmk")


+                                                            (* \; "Edited 21-Mar-2024 10:55 by lmm")


                                                             (* \; "Edited 14-Mar-2024 12:16 by lmm")


                                                             (* \; "Edited 26-Feb-2023 12:17 by lmm")


                                                             (* \; "Edited 13-Jul-2022 14:09 by rmk")


@@ -61,8 +65,8 @@
 
     (LOADUP '(STACKFNS CMLMVS MACROS MACROAUX UNWINDMACROS))
     (LOADUP '(COMMON XCLC-RUNTIME CMLTYPES CL-ERROR))
-    (LOADUP '(AFONT EDIT WEDIT PRETTY DSPRINTDEF NEWPRINTDEF FONTPROFILE SPELLFILE PRINTFN LOADFNS 
-                    DMISC DIRECTORY SPELLFILE FILEPKG RESOURCE))
+    (LOADUP '(AFONT EDIT WEDIT PRETTY DSPRINTDEF NEWPRINTDEF SPELLFILE PRINTFN LOADFNS DMISC 
+                    DIRECTORY SPELLFILE FILEPKG RESOURCE))
 
     (* |;;| "needed for makesys")

 
@@ -79,9 +83,12 @@
                     CMLENVIRONMENT CMLLOAD CMLFLOAT CMLTIME CMLRAND CMLMODULES))
     (LOADUP '(PROFILE CMLEXEC EXEC-COMMANDS DEBUGGER IL-ERROR-STUFF DEBUGEDIT))
     (LOADUP '(ADDARITH))
-    (LOADUP '(UNICODE CMLPATHNAME HPRINT AARITH ADISPLAY HLDISPLAY MENU WINDOWOBJ WINDOWSCROLL WINDOW
-                    WINDOWICON PAINTW ATTACHEDWINDOW XXGEOM XXFILL DEXEC INSPECT DESCRIBE 
-                    CMLARRAYINSPECTOR EDITINTERFACE TTYIN))
+
+    (* |;;| "Before the MEDLEYFONT implementation, FONTPROFILE came after NEWPRINTDEF above, but the loadup failed for undiagnosed reasons.  After moving it around, it appears that it must come before MENU, because it creates thw WINDOWTITLEFONT, but after HLDISPLAY.  Not yet known what the HLDISPLAY dependency is.  ")

+
+    (LOADUP '(UNICODE CMLPATHNAME HPRINT AARITH ADISPLAY HLDISPLAY FONTPROFILE MENU WINDOWOBJ 
+                    WINDOWSCROLL WINDOW WINDOWICON PAINTW ATTACHEDWINDOW XXGEOM XXFILL DEXEC INSPECT
+                    DESCRIBE CMLARRAYINSPECTOR EDITINTERFACE TTYIN))
     (LOADUP '(BREAK-AND-TRACE))
     (LOADUP '(FASDUMP XCL-COMPILER ADVISE))
 
@@ -131,5 +138,5 @@
 (GLOBALVARS MAKESYSFILENAME MEDLEY-INIT-VARS MEDLEYDIR SYSTEMINITVARS USERRECLST)
 )
 (DECLARE\: DONTCOPY
-  (FILEMAP (NIL (673 5380 (LOADUP-LISP 683 . 5378)))))
+  (FILEMAP (NIL (640 6219 (LOADUP-LISP 650 . 6217)))))
 STOP

library/IMAGEOBJ

@@ -1,12 +1,12 @@
 (DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
 
-
(FILECREATED " 7-Dec-2024 19:44:25" {WMEDLEY}<library>IMAGEOBJ.;4
 34381  
+
(FILECREATED " 9-Jun-2025 20:33:49" {WMEDLEY}<library>IMAGEOBJ.;5
 32874  
 
       :EDIT-BY rmk
 
-      :CHANGES-TO (FNS GET.OBJ.FROM.USER)
+      :CHANGES-TO (VARS IMAGEOBJCOMS)
 
-      :PREVIOUS-DATE " 7-Jul-2024 21:04:16" {WMEDLEY}<library>IMAGEOBJ.;3)
+      :PREVIOUS-DATE " 7-Dec-2024 19:44:25" {WMEDLEY}<library>IMAGEOBJ.;4)
 
 
 (PRETTYCOMPRINT IMAGEOBJCOMS)
@@ -15,8 +15,7 @@
        ((COMS 
               (* ;; "Bit-map image objects")

 
-              (FNS BITMAPTEDITOBJ COERCETOBITMAP WINDOWTITLEFONT \PRINTBINARYBITMAP \READBINARYBITMAP
-                   )
+              (FNS BITMAPTEDITOBJ COERCETOBITMAP WINDOWTITLEFONT)
               
               (* ;; "fns for the bitmap tedit object.")

 
@@ -117,42 +116,6 @@
                                                              (* reset type of function that changes 
 
                                                             the title font)

     (DSPFONT FONT WindowTitleDisplayStream)))
-
-(\PRINTBINARYBITMAP

-  (LAMBDA (BITMAP STREAM)
                                    (* rrb "23-Jul-84 15:16")

-          
-          (* * prints the representation of a bitmap onto STREAM in a form that can be 
-
          read back by \READBINARYBITMAP.)

-
-    (PROG ((STREAM (GETSTREAM STREAM 'OUTPUT))
-           BMH)
-          (OR (BITMAPP BITMAP)
-              (\ILLEGAL.ARG BITMAP))
-          (\WOUT STREAM (BITMAPWIDTH BITMAP))
-          (\WOUT STREAM (SETQ BMH (BITMAPHEIGHT BITMAP)))
-          (\WOUT STREAM (BITSPERPIXEL BITMAP))
-          (\BOUTS STREAM (fetch
 (BITMAP BITMAPBASE) of
 BITMAP)
-                 0
-                 (ITIMES (fetch
 (BITMAP BITMAPRASTERWIDTH) of
 BITMAP)
-                        BMH BYTESPERWORD))
-          (RETURN BITMAP))))
-
-(\READBINARYBITMAP

-  (LAMBDA (STREAM)
                                           (* rrb "23-Jul-84 15:17")

-          
-          (* * reads a bitmap printed on STREAM by \PRINTBINARYBITMAP.)

-
-    (SETQ STREAM (GETSTREAM STREAM 'INPUT))
-    (PROG ((BMW (\WIN STREAM))
-           (BMH (\WIN STREAM))
-           (BPP (\WIN STREAM))
-           BITMAP)
-          (SETQ BITMAP (BITMAPCREATE BMW BMH BPP))
-          (\BINS STREAM (fetch
 (BITMAP BITMAPBASE) of
 BITMAP)
-                 0
-                 (ITIMES (fetch
 (BITMAP BITMAPRASTERWIDTH) of
 BITMAP)
-                        BMH BYTESPERWORD))
-          (RETURN BITMAP))))
 )
 
 
@@ -770,12 +733,11 @@
 
 (FILESLOAD EDITBITMAP)
 (DECLARE%: DONTCOPY
-  (FILEMAP (NIL (2975 7471 (BITMAPTEDITOBJ 2985 . 3628) (COERCETOBITMAP 3630 . 5674) (WINDOWTITLEFONT 
-5676 . 6023) (\PRINTBINARYBITMAP 6025 . 6816) (\READBINARYBITMAP 6818 . 7469)) (7522 23640 (
-BMOBJ.BUTTONEVENTINFN 7532 . 12078) (BMOBJ.COPYFN 12080 . 12706) (BMOBJ.DISPLAYFN 12708 . 16437) (
-BMOBJ.IMAGEBOXFN 16439 . 18854) (BMOBJ.PUTFN 18856 . 19788) (BMOBJ.INIT 19790 . 20829) (BMOBJ.GETFN5 
-20831 . 21421) (BMOBJ.CREATE.MENU 21423 . 23638)) (23730 27014 (SCALED.BITMAP.GETFN 23740 . 24166) (
-BMOBJ.GETFN 24168 . 24703) (BMOBJ.GETFN2 24705 . 25190) (BMOBJ.GETFN3 25192 . 25980) (BMOBJ.GETFN4 
-25982 . 27012)) (28949 34281 (GET.OBJ.FROM.USER 28959 . 30925) (BITMAPOBJ.SNAPW 30927 . 32053) (
-PROMPTFOREVALED 32055 . 34279)))))
+  (FILEMAP (NIL (2914 5964 (BITMAPTEDITOBJ 2924 . 3567) (COERCETOBITMAP 3569 . 5613) (WINDOWTITLEFONT 
+5615 . 5962)) (6015 22133 (BMOBJ.BUTTONEVENTINFN 6025 . 10571) (BMOBJ.COPYFN 10573 . 11199) (
+BMOBJ.DISPLAYFN 11201 . 14930) (BMOBJ.IMAGEBOXFN 14932 . 17347) (BMOBJ.PUTFN 17349 . 18281) (
+BMOBJ.INIT 18283 . 19322) (BMOBJ.GETFN5 19324 . 19914) (BMOBJ.CREATE.MENU 19916 . 22131)) (22223 25507
+ (SCALED.BITMAP.GETFN 22233 . 22659) (BMOBJ.GETFN 22661 . 23196) (BMOBJ.GETFN2 23198 . 23683) (
+BMOBJ.GETFN3 23685 . 24473) (BMOBJ.GETFN4 24475 . 25505)) (27442 32774 (GET.OBJ.FROM.USER 27452 . 
+29418) (BITMAPOBJ.SNAPW 29420 . 30546) (PROMPTFOREVALED 30548 . 32772)))))
 STOP

library/MULTI-ALIST

@@ -1,20 +1,20 @@
 (DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
 
-
(FILECREATED "29-Jan-2025 19:34:13" {WMEDLEY}<lispusers>MULTI-ALIST.;15
 12223  
+
(FILECREATED "10-Jul-2025 12:37:33" {WMEDLEY}<lispusers>MULTI-ALIST.;19
 12851  
 
       :EDIT-BY rmk
 
-      :CHANGES-TO (FNS MAPMULTI)
+      :CHANGES-TO (VARS MULTI-ALISTCOMS)
+                  (MACROS PUSHMULTI PUTMULTI PUSHMULTI-NEW FPUSHMULTI FPUSHMULTI-NEW)
 
-      :PREVIOUS-DATE "25-Jan-2025 15:04:13" {WMEDLEY}<lispusers>MULTI-ALIST.;14)
+      :PREVIOUS-DATE " 8-Jul-2025 12:54:37" {WMEDLEY}<lispusers>MULTI-ALIST.;18)
 
 
 (PRETTYCOMPRINT MULTI-ALISTCOMS)
 
 (RPAQQ MULTI-ALISTCOMS

-       ((MACROS GETMULTI PUTMULTI PUTMULTI-D PUTMULTI-NEW PUTMULTI-COUNT PUTMULTI-SUM REMOVEMULTI 
-               REMOVEMULTIALL)
-        (MACROS FGETMULTI FPUTMULTI FPUTMULTI-D FPUTMULTI-NEW)
+       ((MACROS GETMULTI PUSHMULTI PUTMULTI PUSHMULTI-NEW CHANGEMULTI REMOVEMULTI REMOVEMULTIALL)
+        (MACROS FGETMULTI FPUSHMULTI FPUTMULTI FPUSHMULTI-NEW FCHANGEMULTI)
         (FNS MAPMULTI MAPMULTI1 COLLECTMULTI)
         (FNS GETMULTI.EXPAND PUTMULTI.EXPAND REMOVEMULTI.EXPAND)
         (MACROS ADDTOMULTI)
@@ -24,16 +24,13 @@
 
 (PUTPROPS GETMULTI
 MACRO
 (ARGS (GETMULTI.EXPAND
 'SASSOC ARGS)))
 
-(PUTPROPS PUTMULTI
 MACRO
 (ARGS (PUTMULTI.EXPAND
 'SASSOC ARGS)))
+(PUTPROPS PUSHMULTI
 MACRO
 (ARGS (PUTMULTI.EXPAND
 'SASSOC ARGS)))
 
-(PUTPROPS PUTMULTI-D
 MACRO
 (ARGS (PUTMULTI.EXPAND
 'SASSOC ARGS NIL T)))
+(PUTPROPS PUTMULTI
 MACRO
 (ARGS (PUTMULTI.EXPAND
 'SASSOC ARGS NIL T)))
 
-(PUTPROPS PUTMULTI-NEW
 MACRO
 (ARGS (PUTMULTI.EXPAND
 'SASSOC ARGS)))
+(PUTPROPS PUSHMULTI-NEW
 MACRO
 (ARGS (PUTMULTI.EXPAND
 'SASSOC ARGS)))
 
-(PUTPROPS PUTMULTI-COUNT
 MACRO
 (ARGS (PUTMULTI.EXPAND
 'SASSOC (APPEND ARGS '(1))
-                                            NIL NIL T)))
-
-(PUTPROPS PUTMULTI-SUM
 MACRO
 (ARGS (PUTMULTI.EXPAND
 'SASSOC ARGS NIL NIL T)))
+(PUTPROPS CHANGEMULTI
 MACRO
 (ARGS (PUTMULTI.EXPAND
 'SASSOC ARGS NIL NIL T)))
 
 (PUTPROPS REMOVEMULTI
 MACRO
 (ARGS (REMOVEMULTI.EXPAND
 ARGS)))
 
@@ -43,11 +40,13 @@
 
 (PUTPROPS FGETMULTI
 MACRO
 (ARGS (GETMULTI.EXPAND
 'FASSOC ARGS)))
 
+(PUTPROPS FPUSHMULTI
 MACRO
 (ARGS (PUTMULTI.EXPAND
 'FASSOC ARGS)))
+
 (PUTPROPS FPUTMULTI
 MACRO
 (ARGS (PUTMULTI.EXPAND
 'FASSOC ARGS)))
 
-(PUTPROPS FPUTMULTI-D
 MACRO
 (ARGS (PUTMULTI.EXPAND
 'FASSOC ARGS NIL T)))
+(PUTPROPS FPUSHMULTI-NEW
 MACRO
 (ARGS (PUTMULTI.EXPAND
 'FASSOC ARGS)))
 
-(PUTPROPS FPUTMULTI-NEW
 MACRO
 (ARGS (PUTMULTI.EXPAND
 'FASSOC ARGS)))
+(PUTPROPS FCHANGEMULTI
 MACRO
 (ARGS (PUTMULTI.EXPAND
 'FASSOC ARGS NIL NIL T)))
 )
 (DEFINEQ
 
@@ -95,7 +94,8 @@
 (DEFINEQ
 
 (GETMULTI.EXPAND

-  [LAMBDA (ASSOCFN ARGS)
                                     (* ; "Edited 16-Jan-2025 10:27 by rmk")


+  [LAMBDA (ASSOCFN ARGS)
                                     (* ; "Edited 14-Jun-2025 09:47 by rmk")


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


                                                             (* ; "Edited 19-Jul-2020 00:38 by rmk:")


                                                             (* ; "Edited 22-Mar-2020 13:21 by rmk:")


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


@@ -114,7 +114,9 @@
       ELSE
 (CAR ARGS])
 
 (PUTMULTI.EXPAND

-  [LAMBDA (ASSOCFN ARGS ALLOWREPEATS SINGLEVALUE SUM)
        (* ; "Edited 23-Jan-2025 09:40 by rmk")


+  [LAMBDA (ASSOCFN ARGS ALLOWREPEATS SINGLEVALUE CHANGE)
     (* ; "Edited  8-Jul-2025 12:52 by rmk")


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


+                                                             (* ; "Edited 23-Jan-2025 09:40 by rmk")


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


                                                             (* ; "Edited 17-Aug-2020 14:09 by rmk:")

 
@@ -122,7 +124,7 @@
 
     (* ;; "If SINGLEVALUE, new value smashes out old")

 
-    (* ;; "For SUM, the last argument is the increment to be added to the current  value, and the incremented value is returned for PUTMULTISUM and for GETMULT")

+    (* ;; "For CHANGE, the last argument is the change expression to be evaluated, with the current value denoted by the atom DATUM")

 
     (* ;; "")

 
@@ -131,34 +133,41 @@
     (CL:MULTIPLE-VALUE-BIND
      (TEMPVARS VALFORMS STOREVARS STOREFORM ACCESSFORM)
      (CL:GET-SETF-METHOD (CAR ARGS))
-     (CL:IF (CDR ARGS)
-         `(LET*
-           ,(FOR
 VF IN
 VALFORMS AS
 TV IN
 TEMPVARS COLLECT
 (LIST TV VF))
-           (DECLARE
 (LOCALVARS ,@TEMPVARS))
-           (LET
-            ($$ARG1$$ $$ARG2$$)
-            (DECLARE
 (LOCALVARS $$ARG1$$ $$ARG2$$))
-            ,@[FOR
 ATAIL (HEAD _ ACCESSFORM) ON
 ARGS WHILE
 (CDR ATAIL)
-                 JOIN

-                 (IF
 (AND SUM (NULL (CDDR ATAIL)))
-                     THEN
 (POP
 ATAIL)
-                          `[(CL:UNLESS ,HEAD (RPLACD $$ARG1$$ 0))
-                            (SETQ $$ARG2$$ (ADD
 ,HEAD ,(CAR ATAIL]
-                   ELSE

-                   (PROG1 `[(SETQ $$ARG2$$ ,(CADR ATAIL))
-                            ,(IF
 (CDDR ATAIL)
-                                 THEN
 `[SETQ $$ARG1$$ (OR (,ASSOCFN $$ARG2$$ ,HEAD)
-                                                          (CAR (CL:PUSH (CONS $$ARG2$$)
-                                                                      ,HEAD]
-                               ELSEIF
 ALLOWREPEATS
-                                 THEN
 `(push
 ,HEAD $$ARG2$$)
-                               ELSEIF
 SINGLEVALUE
-                                 THEN
 `(RPLACD $$ARG2$$)
-                               ELSE
 `(OR (MEMBER $$ARG2$$ ,HEAD)
-                                         (push
 ,HEAD $$ARG2$$]
-                       (SETQ HEAD '(CDR $$ARG1$$)))]
-            $$ARG2$$))
-         (CAR ARGS))])
+     (if
 (CDR ARGS)
+         then

+         (LET
+          ((VALBINDINGS (FOR
 VF IN
 VALFORMS AS
 TV IN
 TEMPVARS COLLECT
 (LIST TV VF)))
+           EXPANSION)
+          (SETQ EXPANSION
+           `(LET
+             ($$ARG1$$ $$ARG2$$)
+             (DECLARE
 (LOCALVARS $$ARG1$$ $$ARG2$$))
+             ,@[FOR
 ATAIL (HEAD _ ACCESSFORM) ON
 ARGS WHILE
 (CDR ATAIL)
+                  JOIN

+                  (IF
 (AND CHANGE (NULL (CDDR ATAIL)))
+                      THEN
 (POP
 ATAIL)
+                           [AND NIL `((CL:UNLESS ,HEAD (RPLACD $$ARG1$$ 0))
+                                      (SETQ $$ARG2$$ (ADD
 ,HEAD ,(CAR ATAIL]
+                           `[(SETQ $$ARG2$$ ,(SUBST HEAD 'DATUM (CAR ATAIL]
+                    ELSE

+                    (PROG1 `[(SETQ $$ARG2$$ ,(CADR ATAIL))
+                             ,(IF
 (CDDR ATAIL)
+                                  THEN
 `[SETQ $$ARG1$$ (OR (,ASSOCFN $$ARG2$$ ,HEAD)
+                                                           (CAR (CL:PUSH (CONS $$ARG2$$)
+                                                                       ,HEAD]
+                                ELSEIF
 ALLOWREPEATS
+                                  THEN
 `(push
 ,HEAD $$ARG2$$)
+                                ELSEIF
 SINGLEVALUE
+                                  THEN
 `(CL:SETF ,HEAD $$ARG2$$)
+                                ELSE
 `(OR (MEMBER $$ARG2$$ ,HEAD)
+                                          (push
 ,HEAD $$ARG2$$]
+                        (SETQ HEAD '(CDR $$ARG1$$)))]
+             $$ARG2$$))
+          (CL:IF VALBINDINGS
+              `(LET* ,VALBINDINGS (DECLARE
 (LOCALVARS ,@TEMPVARS))
+                     ,EXPANSION)
+              EXPANSION))
+       else
 (CAR ARGS])
 
 (REMOVEMULTI.EXPAND

   [LAMBDA (ARGS ALLFLAG)
                                     (* ; "Edited 16-Jan-2025 10:34 by rmk")


@@ -233,7 +242,7 @@
 (LOCALVARS . T)
 )
 (DECLARE%: DONTCOPY
-  (FILEMAP (NIL (1837 4449 (MAPMULTI 1847 . 2915) (MAPMULTI1 2917 . 3974) (COLLECTMULTI 3976 . 4447)) (
-4450 10311 (GETMULTI.EXPAND 4460 . 5581) (PUTMULTI.EXPAND 5583 . 7995) (REMOVEMULTI.EXPAND 7997 . 
-10309)) (11461 12146 (ADDTOMULTI1 11471 . 12144)))))
+  (FILEMAP (NIL (1845 4457 (MAPMULTI 1855 . 2923) (MAPMULTI1 2925 . 3982) (COLLECTMULTI 3984 . 4455)) (
+4458 10939 (GETMULTI.EXPAND 4468 . 5698) (PUTMULTI.EXPAND 5700 . 8623) (REMOVEMULTI.EXPAND 8625 . 
+10937)) (12089 12774 (ADDTOMULTI1 12099 . 12772)))))
 STOP

library/POSTSCRIPTSTREAM

@@ -1,16 +1,12 @@
 (DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
 
-
(FILECREATED " 5-Jun-2025 16:12:21" {DSK}<home>matt>Interlisp>medley>library>POSTSCRIPTSTREAM.;5
 258146 
+
(FILECREATED "14-Jul-2025 22:21:34" {WMEDLEY}<library>POSTSCRIPTSTREAM.;24
 258986 
 
-      :EDIT-BY "mth"
+      :EDIT-BY rmk
 
-      :CHANGES-TO (FNS \BLTSHADE.PSC \PSC.COLOR.TO.RGB \DRAWLINE.PSC \DRAWARC.PSC POSTSCRIPTSEND 
-                       \TERPRI.PSC POSTSCRIPT.PUTCOMMAND POSTSCRIPT.PUTRGBCOLOR \DSPCOLOR.PSC 
-                       \DRAWCIRCLE.PSC \DRAWELLIPSE.PSC \DRAWPOINT.PSC \DRAWPOLYGON.PSC 
-                       \FILLCIRCLE.PSC \FILLPOLYGON.PSC POSTSCRIPT.TEDIT \BITBLT.PSC)
+      :CHANGES-TO (FNS \DSPFONT.PSC)
 
-      :PREVIOUS-DATE "28-Apr-2025 00:17:24" 
-{DSK}<home>matt>Interlisp>medley>library>POSTSCRIPTSTREAM.;1)
+      :PREVIOUS-DATE "16-Jun-2025 00:04:32" {WMEDLEY}<library>POSTSCRIPTSTREAM.;23)
 
 
 (PRETTYCOMPRINT POSTSCRIPTSTREAMCOMS)
@@ -46,7 +42,7 @@
         (FNS PSCFONT.READFONT PSCFONT.SPELLFILE PSCFONT.COERCEFILE PSCFONTFROMCACHE.SPELLFILE 
              PSCFONTFROMCACHE.COERCEFILE PSCFONT.WRITEFONT READ-AFM-FILE CONVERT-AFM-FILES 
              POSTSCRIPT.GETFONTID POSTSCRIPT.FONTCREATE \POSTSCRIPT.SPECIALFONT.SCALEDWIDTHS 
-             POSTSCRIPT.FONTSAVAILABLE)
+             POSTSCRIPT.FONTSAVAILABLE POSTSCRIPT.FONTEXISTS?)
         (COMS 
               (* ;; "Until macro in FONT is exported")

 
@@ -175,7 +171,8 @@
                (IMAGESTREAMTYPES (POSTSCRIPT (OPENSTREAM OPENPOSTSCRIPTSTREAM)
                                         (FONTCREATE POSTSCRIPT.FONTCREATE)
                                         (FONTSAVAILABLE POSTSCRIPT.FONTSAVAILABLE)
-                                        (CREATECHARSET \CREATECHARSET.PSC]
+                                        (CREATECHARSET \CREATECHARSET.PSC)
+                                        (FONTEXISTS? POSTSCRIPT.FONTEXISTS?]
         (INITVARS (POSTSCRIPT.PAGETYPE 'LETTER))
         
         (* ;; "NIL means initial clipping is same as paper size.  Don't know why the other regions were specified--rmk")

@@ -619,11 +616,12 @@
          PF])
 
 (PSCFONT.SPELLFILE

-  [LAMBDA (FAMILY SIZE FACE ROTATION DEVICE)
             (* ; "Edited  5-Oct-93 22:15 by rmk:")

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

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


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


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

 
-    (* ;; 
-
  "Find the font file for a postscript font.  Does the display-name conversion as well, for DOS.")

+    (* ;; 
+
    "Find the font file for a postscript font.  Does the display-name conversion as well, for DOS.")

 
     (CL:WHEN POSTSCRIPTFONTDIRECTORIES
         (\FINDFONTFILE (OR (CDR (FASSOC FAMILY POSTSCRIPT.FONT.ALIST))
@@ -883,43 +881,44 @@
          FONTID])
 
 (POSTSCRIPT.FONTCREATE

-  [LAMBDA (FAMILY SIZE FACE ROTATION DEVICE)
             (* ; "Edited 29-Oct-93 16:39 by rmk:")

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

+  [LAMBDA (FAMILY SIZE FACE ROTATION DEVICE)
                 (* ; "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)))
 
-         (* ;; 
-
  "Ignore rotations, it is **MUCH** easier to rotate the Postscript stream user space coordinates.")

+         (* ;; 
+
    "Ignore rotations, it is **MUCH** easier to rotate the Postscript stream user space coordinates.")

 
          [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))
 
-                 (* ;; "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))
 
-                 (* ;; "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 (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))
 
-                 (* ;; "Check file for coerced match")

+                 (* ;; "Check file for coerced match")

 
                  (SETQ PSCFD (PSCFONT.READFONT
 FULLNAME))
                  (SETQ FACECHANGED T)))
@@ -930,15 +929,14 @@
                                                   0.1)))
                        (COND
                           (FACECHANGED (replace
 (PSCFONT IL-FONTID) of
 PSCFD
-                                          with
 (POSTSCRIPT.GETFONTID
 (fetch
 (PSCFONT
-                                                                                         FID)
-                                                                                of
 PSCFD)
-                                                          WEIGHT SLOPE EXPANSION]
+                                          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")

+             (* ;; "Scale the ASCENT and DESCENT")

 
              (SETQ ASCENT (FIXR (TIMES SIZE (fetch
 (PSCFONT ASCENT) of
 PSCFD)
                                        0.1)))
@@ -946,20 +944,20 @@
                                         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.")

+               (* ;; "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))
+                                  ((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:")

+                   (* ;; "Set up the Charset descriptions and Widths vectors for character set 0:")

 
                    (SETQ FD
                     (create
 FONTDESCRIPTOR
@@ -977,37 +975,35 @@
                    (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]
+                                     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.")

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

+                        (* ;; "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)))
+                                                                     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:")

+                        (* ;; 
+
         "Now run thru the mapping table, filling in the new font from whatever source is specified:")

 
                         [MAPHASH *POSTSCRIPT-NS-HASH*
                                (FUNCTION (LAMBDA (MAPPING CODE)
@@ -1015,13 +1011,12 @@
                                             (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 
-                                                     (* ;; 
-
                                               "Translating an NS character to a PSC char in CS 0.")

+                                                     (* ;; 
+
                                                 "Translating an NS character to a PSC char in CS 0.")

 
                                                      (\FSETCHARWIDTH FD CODE (\FGETWIDTH 
                                                                                     PSCWIDTHSBLOCK
@@ -1036,8 +1031,8 @@
                                                                                        (\CHAR8CODE
                                                                                         CODE2])
                                                 (FUNCTION 
-                                                          (* ;; 
-
                              "This is fake and only works for the fractions.  Need a better case.")

+                                                          (* ;; 
+
                                "This is fake and only works for the fractions.  Need a better case.")

 
                                                           [\FSETCHARWIDTH
                                                            FD CODE
@@ -1046,25 +1041,25 @@
                                                                                (\FGETWIDTH
                                                                                 PSCWIDTHSBLOCK
                                                                                 (CHARCODE 1])
-                                                (ACCENT      (* ; 
-
                          "CODE2 is the rendering character but width comes from width of basechar")

+                                                (ACCENT      (* ; 
+
                            "CODE2 is the rendering character but width comes from width of basechar")

                                                         (\FSETCHARWIDTH FD CODE (\FGETWIDTH 
                                                                                        PSCWIDTHSBLOCK
                                                                                        BASECHAR)))
                                                 (ACCENTPAIR 
 
-                                              (* ;; "CODE2 and BASECHAR are overprinted, width is taken from CODE2 (the real character), basechar is the accent")

+                                              (* ;; "CODE2 and BASECHAR are overprinted, width is taken from CODE2 (the real character), basechar is the accent")

 
                                                             (\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")

+                                 (* ;; "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]
 
-                        (* ;; "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)
@@ -1173,6 +1168,22 @@
                                                                                     NF))
                        else
 (LIST FD)))
        else
 FONTSAVAILABLE])
+
+(POSTSCRIPT.FONTEXISTS?

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


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


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

+
+    (* ;; "Non-NIL if a postscript font with these parameters can be constructed.")

+
+    (* ;; "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)))
+         (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])
 )
 
 
@@ -2681,7 +2692,8 @@
           CURRENT])
 
 (\DSPFONT.PSC

-  [LAMBDA (STREAM FONT)                                      (* ; 
+  [LAMBDA (STREAM FONT)
                                      (* ; "Edited 14-Jul-2025 22:21 by rmk")

+                                                             (* ; 
 
                                                        "Edited 26-May-93 01:06 by sybalsky:mv:envos")

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

                                                              (* ; "Edited 19-Jan-93 17:17 by jds")

@@ -2694,7 +2706,7 @@
            (OLDFONT (fetch
 (\POSTSCRIPTDATA POSTSCRIPTFONT) of
 IMAGEDATA))
            NEWFONT FONTID)
           (COND
-             ((AND FONT (SETQ NEWFONT (OR (\COERCEFONTDESC FONT STREAM)
+             ((AND FONT (SETQ NEWFONT (OR (FONTCREATE FONT NIL NIL NIL STREAM T)
                                           (FONTCOPY OLDFONT FONT)))
                    (type?
 FONTDESCRIPTOR NEWFONT)
                    (NEQ NEWFONT OLDFONT))
@@ -4357,7 +4369,8 @@
 (ADDTOVAR IMAGESTREAMTYPES
 (POSTSCRIPT (OPENSTREAM OPENPOSTSCRIPTSTREAM)
                                   (FONTCREATE POSTSCRIPT.FONTCREATE)
                                   (FONTSAVAILABLE POSTSCRIPT.FONTSAVAILABLE)
-                                  (CREATECHARSET \CREATECHARSET.PSC)))
+                                  (CREATECHARSET \CREATECHARSET.PSC)
+                                  (FONTEXISTS? POSTSCRIPT.FONTEXISTS?)))
 
 (RPAQ? POSTSCRIPT.PAGETYPE
 'LETTER)
 
@@ -4401,38 +4414,39 @@
 (ADDTOVAR LAMA
 POSTSCRIPT.PUTCOMMAND)
 )
 (DECLARE%: DONTCOPY
-  (FILEMAP (NIL (22736 33232 (POSTSCRIPT.INIT 22746 . 29838) (POSTSCRIPT.PUTRGBCOLOR 29840 . 30862) (
-\PSC.COLOR.TO.RGB 30864 . 33230)) (34218 69002 (PSCFONT.READFONT 34228 . 36136) (PSCFONT.SPELLFILE 
-36138 . 36716) (PSCFONT.COERCEFILE 36718 . 38290) (PSCFONTFROMCACHE.SPELLFILE 38292 . 39277) (
-PSCFONTFROMCACHE.COERCEFILE 39279 . 40931) (PSCFONT.WRITEFONT 40933 . 41948) (READ-AFM-FILE 41950 . 
-47821) (CONVERT-AFM-FILES 47823 . 49035) (POSTSCRIPT.GETFONTID 49037 . 50432) (POSTSCRIPT.FONTCREATE 
-50434 . 62833) (\POSTSCRIPT.SPECIALFONT.SCALEDWIDTHS 62835 . 65232) (POSTSCRIPT.FONTSAVAILABLE 65234
- . 69000)) (69557 78842 (OPENPOSTSCRIPTSTREAM 69567 . 78508) (CLOSEPOSTSCRIPTSTREAM 78510 . 78840)) (
-78887 84941 (POSTSCRIPT.HARDCOPYW 78897 . 82004) (POSTSCRIPT.TEDIT 82006 . 82490) (POSTSCRIPT.TEXT 
-82492 . 82783) (POSTSCRIPTFILEP 82785 . 83892) (MAKEEPSFILE 83894 . 84939)) (84942 128516 (
-POSTSCRIPT.BITMAPSCALE 84952 . 87408) (POSTSCRIPT.CLOSESTRING 87410 . 87963) (POSTSCRIPT.ENDPAGE 87965
- . 88856) (POSTSCRIPT.OUTSTR 88858 . 90075) (POSTSCRIPT.PUTBITMAPBYTES 90077 . 98548) (
-POSTSCRIPT.PUTCOMMAND 98550 . 99539) (POSTSCRIPT.SET-FAKE-LANDSCAPE 99541 . 104061) (
-POSTSCRIPT.SHOWACCUM 104063 . 106218) (POSTSCRIPT.STARTPAGE 106220 . 108752) (\POSTSCRIPTTAB 108754 . 
-109551) (\PS.BOUTFIXP 109553 . 110833) (\PS.SCALEHACK 110835 . 113478) (\PS.SCALEREGION 113480 . 
-114040) (\SCALEDBITBLT.PSC 114042 . 118352) (\SETPOS.PSC 118354 . 118835) (\SETXFORM.PSC 118837 . 
-121421) (\STRINGWIDTH.PSC 121423 . 121896) (\SWITCHFONTS.PSC 121898 . 127390) (\TERPRI.PSC 127392 . 
-128514)) (128551 182631 (\BITBLT.PSC 128561 . 129113) (\BLTSHADE.PSC 129115 . 133776) (\CHARWIDTH.PSC 
-133778 . 134285) (\CREATECHARSET.PSC 134287 . 135985) (\DRAWARC.PSC 135987 . 138365) (\DRAWCIRCLE.PSC 
-138367 . 140618) (\DRAWCURVE.PSC 140620 . 144464) (\DRAWELLIPSE.PSC 144466 . 146830) (\DRAWLINE.PSC 
-146832 . 149572) (\DRAWPOINT.PSC 149574 . 150150) (\DRAWPOLYGON.PSC 150152 . 153281) (
-\DSPBOTTOMMARGIN.PSC 153283 . 153970) (\DSPCLIPPINGREGION.PSC 153972 . 155347) (\DSPCOLOR.PSC 155349
- . 156280) (\DSPFONT.PSC 156282 . 159801) (\DSPLEFTMARGIN.PSC 159803 . 160489) (\DSPLINEFEED.PSC 
-160491 . 161081) (\DSPPUSHSTATE.PSC 161083 . 162543) (\DSPPOPSTATE.PSC 162545 . 166030) (\DSPRESET.PSC
- 166032 . 166697) (\DSPRIGHTMARGIN.PSC 166699 . 167388) (\DSPROTATE.PSC 167390 . 168389) (
-\DSPSCALE.PSC 168391 . 169343) (\DSPSCALE2.PSC 169345 . 170185) (\DSPSPACEFACTOR.PSC 170187 . 171108) 
-(\DSPTOPMARGIN.PSC 171110 . 171681) (\DSPTRANSLATE.PSC 171683 . 173714) (\DSPXPOSITION.PSC 173716 . 
-174280) (\DSPYPOSITION.PSC 174282 . 174873) (\FILLCIRCLE.PSC 174875 . 177100) (\FILLPOLYGON.PSC 177102
- . 180339) (\FIXLINELENGTH.PSC 180341 . 181660) (\MOVETO.PSC 181662 . 182432) (\NEWPAGE.PSC 182434 . 
-182629)) (182687 204710 (\POSTSCRIPT.CHANGECHARSET 182697 . 183434) (\POSTSCRIPT.OUTCHARFN 183436 . 
-195564) (\POSTSCRIPT.PRINTSLUG 195566 . 197290) (\POSTSCRIPT.SPECIALOUTCHARFN 197292 . 199643) (
-\UPDATE.PSC 199645 . 200891) (\POSTSCRIPT.ACCENTFN 200893 . 201835) (\POSTSCRIPT.ACCENTPAIR 201837 . 
-204708)) (204808 206453 (\PSC.SPACEDISP 204818 . 205097) (\PSC.SPACEWID 205099 . 205718) (\PSC.SYMBOLS
- 205720 . 206451)) (206562 209553 (\POSTSCRIPT.NSHASH 206572 . 209551)) (254327 255033 (POSTSCRIPTSEND
- 254337 . 255031)))))
+  (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)))))
 STOP

library/PRESS

@@ -1,21 +1,17 @@
 (DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
 
-
(FILECREATED "10-Apr-2023 07:15:37" {DSK}<home>larry>il>medley>library>PRESS.;2
 452576Q
+
(FILECREATED "14-Jul-2025 22:58:49" {WMEDLEY}<library>PRESS.;4
 453237Q
 
-      :EDIT-BY "lmm"
+      :EDIT-BY rmk
 
-      :CHANGES-TO (VARS PRESSCOMS)
+      :CHANGES-TO (FNS \DSPFONT.PRESS)
 
-      :PREVIOUS-DATE " 5-Feb-2021 22:18:06" {DSK}<home>larry>il>medley>library>PRESS.;1)
+      :PREVIOUS-DATE " 5-Jul-2025 18:52:40" {WMEDLEY}<library>PRESS.;3)
 
 
-(* ; "
-Copyright (c) 1981-1987, 1990, 1993, 2021 by Venue & Xerox Corporation.
-")
-
 (PRETTYCOMPRINT PRESSCOMS)
 
-(RPAQQ PRESSCOMS
 
+(RPAQQ PRESSCOMS

        [
 
 (* ;;; "PRESS printing support module")

@@ -1321,46 +1317,44 @@ Copyright (c) 1981-1987, 1990, 1993, 2021 by Venue & Xerox Corporation.
                                     (freplace
 PRClippingRegion of
 PRDATA with
 REGION))])])
 
 (\DSPFONT.PRESS

-  [LAMBDA (PRSTREAM FONT)
                               (* ; "Edited 12-Jun-90 10:40 by mitani")

+  [LAMBDA (PRSTREAM FONT)
                                    (* ; "Edited 14-Jul-2025 22:58 by rmk")


+                                                             (* ; "Edited  5-Jul-2025 18:49 by rmk")

 
-         (* * The DSPFONT method for PRESS-type image streams --
-
       change the stream's current font to FONT)

+(* ;;; "The DSPFONT method for PRESS-type image streams -- change the stream's current font to FONT")

+
+         (* * The DSPFONT method for PRESS-type image streams --
+
         change the stream's current font to FONT)

 
     (PROG ((PRDATA (ffetch
 (STREAM IMAGEDATA) of
 PRSTREAM))
            CSINFO OLDFONT FDENTRY)
           (SETQ OLDFONT (ffetch
 PRFONT of
 PRDATA))
           (COND
              ([OR (NULL FONT)
-                  (EQ OLDFONT (SETQ FONT (OR (\GETFONTDESC FONT 'PRESS T)
+                  (EQ OLDFONT (SETQ FONT (OR (FONTCREATE FONT NIL NIL NIL 'PRESS T)
                                              (FONTCOPY OLDFONT FONT]
-
-         (* If no new font was specified, or it's the same font, don't bother with it.)

-
+                                                             (* ; 
+
                         "If no new font was specified, or it's the same font, don't bother with it.")

               (RETURN OLDFONT)))
           (SHOW.PRESS
 PRSTREAM)
-          (SETQ CSINFO (\GETCHARSETINFO 0 FONT T))           (* Since PRESS only uses charset 0 
-
                                                           for now....)

+          (SETQ CSINFO (\GETCHARSETINFO 0 FONT T))           (* ; 
+
                                                        "Since PRESS only uses charset 0 for now....")

           (SETQ FDENTRY (\DEFINEFONT.PRESS
 PRSTREAM FONT))
           (COND
              ((NEQ (ffetch
 FONTSET# of
 FDENTRY)
                    (ffetch
 FONTSET# of
 (ffetch
 PRCURRFDE of
 PRDATA)))
-                                                             (* Swtich font sets)

+                                                             (* ; "Swtich font sets")

               (\ENTITYEND.PRESS
 PRSTREAM)
               (\ENTITYSTART.PRESS
 PRSTREAM)))
           (freplace
 PRCURRFDE of
 PRDATA with
 FDENTRY)
           (freplace
 PRFONT of
 PRDATA with
 FONT)
           (\BOUT (ffetch
 ELSTREAM of
 PRDATA)
                  (LOGOR FontCode (ffetch
 FONT# of
 FDENTRY)))
-          (freplace
 PRWIDTHSCACHE of
 PRDATA with
 (fetch
 (CHARSETINFO WIDTHS)
-                                                                OF
 CSINFO))
+          (freplace
 PRWIDTHSCACHE of
 PRDATA with
 (fetch
 (CHARSETINFO WIDTHS) OF
 CSINFO))
           [\SETSPACE.PRESS
 PRSTREAM (FIXR (TIMES (ffetch
 PRSPACEFACTOR of
 PRDATA)
-                                                     (\FGETWIDTH (ffetch
 PRWIDTHSCACHE
-                                                                    of
 PRDATA)
-                                                            (CHARCODE SPACE]
-          [freplace
 PRLINEFEED of
 PRDATA with
 (IDIFFERENCE (CONSTANT (IMINUS 
-                                                                                        MicasPerPoint
-                                                                                        ))
-                                                                 (FONTPROP FONT 'HEIGHT]
+                                                 (\FGETWIDTH (ffetch
 PRWIDTHSCACHE of
 PRDATA)
+                                                        (CHARCODE SPACE]
+          [freplace
 PRLINEFEED of
 PRDATA with
 (IDIFFERENCE (CONSTANT (IMINUS MicasPerPoint))
+                                                     (FONTPROP FONT 'HEIGHT]
           (\FIXLINELENGTH.PRESS
 PRSTREAM)
           (RETURN OLDFONT])
 
@@ -2417,51 +2411,55 @@ Copyright (c) 1981-1987, 1990, 1993, 2021 by Venue & Xerox Corporation.
 (DECLARE%: DONTCOPY 
 (DECLARE%: EVAL@COMPILE
 
-(DATATYPE PRESSDATA
 (PRHEADING                               (* The string to be printed atop each 
-
                                                             page.)

-                           PRHEADINGFONT                     (* Font to print the heading in)

-                           PRXPOS                            (* Current X position)

-                           PRYPOS                            (* Current Y position)

-                           PRFONT                            (* Current font)

-                           PRCURRFDE PRESSFONTDIR PRWIDTHSCACHE PRCOLOR PRLINEFEED PRPAGESTATE 
-                           PDSTREAM ELSTREAM XPRPAGEREGION PRDOCNAME (PRLEFT WORD)
-                                                             (* Page left margin)

-                           (PRBOTTOM WORD)                   (* Page bottom margin)

-                           (PRRIGHT WORD)                    (* Page right margin)

-                           (PRTOP WORD)                      (* Page top margin)

-                           (PRPAGENUM WORD)                  (* Current Page number)

+(DATATYPE PRESSDATA
 (PRHEADING                               (* ; 
+
                                                           "The string to be printed atop each page.")

+                           PRHEADINGFONT                     (* ; "Font to print the heading in")

+                           PRXPOS                            (* ; "Current X position")

+                           PRYPOS                            (* ; "Current Y position")

+                           PRFONT                            (* ; "Current font")

+                           PRCURRFDE PRESSFONTDIR (PRWIDTHSCACHE POINTER 
+                                                             (* ; 
+
                                                 "Widths table for the current logical character set")

+                                                         )
+                           PRCOLOR PRLINEFEED PRPAGESTATE PDSTREAM ELSTREAM XPRPAGEREGION PRDOCNAME
+                           (PRLEFT WORD)                     (* ; "Page left margin")

+                           (PRBOTTOM WORD)                   (* ; "Page bottom margin")

+                           (PRRIGHT WORD)                    (* ; "Page right margin")

+                           (PRTOP WORD)                      (* ; "Page top margin")

+                           (PRPAGENUM WORD)                  (* ; "Current Page number")

                            (PRNEXTFONT# BYTE)
                            (PRMAXFONTSET BYTE)
                            (PRPARTSTART INTEGER)
                            (DLSTARTBYTE INTEGER)
                            (ELSTARTBYTE INTEGER)
                            (STARTCHARBYTE INTEGER)
-                           (VECMOVINGRIGHT FLAG)             (* If we're drawing a curve with 
-
                                                             vector fonts, are we moving to the 
-
                                                             right?)

+                           (VECMOVINGRIGHT FLAG)             (* ; 
+
                            "If we're drawing a curve with vector fonts, are we moving to the right?")

                            (VECWASDISPLAYING FLAG)
 
-         (* Used during curve/line clipping to remember whether we were on-screen or not, 
-
         so we know when to force a SETXY.)

+                           (* ;; "Used during curve/line clipping to remember whether we were on-screen or not, so we know when to force a SETXY.")

 
-                           VECSEGCHARS                       (* Cache for vector characters while 
-
                                                             we're moving to the left.)

-                           VECCURX                           (* Current X position within vector 
-
                                                             code, in Dover spots)

-                           VECCURY                           (* Current Y position with vector 
-
                                                             code, in Dover spots)

+                           VECSEGCHARS                       (* ; 
+
                                        "Cache for vector characters while we're moving to the left.")

+                           VECCURX                           (* ; 
+
                                              "Current X position within vector code, in Dover spots")

+                           VECCURY                           (* ; 
+
                                                "Current Y position with vector code, in Dover spots")

                            PRSPACEFACTOR PRSPACEWIDTH (CHARWASDISPLAYING FLAG)
-                                                             (* Says whether we have been printing 
-
                                                             characters inside the clipping region)

+                                                             (* ; 
+
                           "Says whether we have been printing characters inside the clipping region")

                            PRClippingRegion
 
-         (* The edges of the paper, as far as PRESS is concerned.
-
         Used to protect SPRUCE users who get killed when the image goes off-paper)

+                           (* ;; "The edges of the paper, as far as PRESS is concerned.  Used to protect SPRUCE users who get killed when the image goes off-paper")

 
-                           )
-                    PRSPACEFACTOR _ 1 PRXPOS _ 0 PRYPOS _ 0  (* We assume that the origin is 
-
                                                             translated to the bottom-left of the 
-
                                                             page region)

+                           PRLOGICALFONT                     (* ; "Current logical font")

+                           PRLOGICALCHARSET                  (* ; 
+
                      "Current logical character set, whose info is cached.  NIL if cache is invalid")

+                           (PRTRANSLATIONCACHE POINTER       (* ; 
+
                                            "Translation table for the current logical character set")

+                                  ))
+                    PRSPACEFACTOR _ 1 PRXPOS _ 0 PRYPOS _ 0  (* ; 
+
                      "We assume that the origin is translated to the bottom-left of the page region")

                     PRClippingRegion _ (create
 REGION
                                               LEFT _ SPRUCEPAPERLEFTMICAS
                                               BOTTOM _ SPRUCEPAPERBOTTOMMICAS
@@ -2492,7 +2490,8 @@ Copyright (c) 1981-1987, 1990, 1993, 2021 by Venue & Xerox Corporation.
 (/DECLAREDATATYPE 'PRESSDATA
        '(POINTER POINTER POINTER POINTER POINTER POINTER POINTER POINTER POINTER POINTER POINTER 
                POINTER POINTER POINTER POINTER WORD WORD WORD WORD WORD BYTE BYTE FIXP FIXP FIXP FIXP
-               FLAG FLAG POINTER POINTER POINTER POINTER POINTER FLAG POINTER)
+               FLAG FLAG POINTER POINTER POINTER POINTER POINTER FLAG POINTER POINTER POINTER POINTER
+               )
        '((PRESSDATA 0 POINTER)
          (PRESSDATA 2 POINTER)
          (PRESSDATA 4 POINTER)
@@ -2527,14 +2526,18 @@ Copyright (c) 1981-1987, 1990, 1993, 2021 by Venue & Xerox Corporation.
          (PRESSDATA 50 POINTER)
          (PRESSDATA 52 POINTER)
          (PRESSDATA 52 (FLAGBITS . 0))
-         (PRESSDATA 54 POINTER))
-       '56)
+         (PRESSDATA 54 POINTER)
+         (PRESSDATA 56 POINTER)
+         (PRESSDATA 58 POINTER)
+         (PRESSDATA 60 POINTER))
+       '62)
 )
 
 (/DECLAREDATATYPE 'PRESSDATA
        '(POINTER POINTER POINTER POINTER POINTER POINTER POINTER POINTER POINTER POINTER POINTER 
                POINTER POINTER POINTER POINTER WORD WORD WORD WORD WORD BYTE BYTE FIXP FIXP FIXP FIXP
-               FLAG FLAG POINTER POINTER POINTER POINTER POINTER FLAG POINTER)
+               FLAG FLAG POINTER POINTER POINTER POINTER POINTER FLAG POINTER POINTER POINTER POINTER
+               )
        '((PRESSDATA 0 POINTER)
          (PRESSDATA 2 POINTER)
          (PRESSDATA 4 POINTER)
@@ -2569,8 +2572,11 @@ Copyright (c) 1981-1987, 1990, 1993, 2021 by Venue & Xerox Corporation.
          (PRESSDATA 50 POINTER)
          (PRESSDATA 52 POINTER)
          (PRESSDATA 52 (FLAGBITS . 0))
-         (PRESSDATA 54 POINTER))
-       '56)
+         (PRESSDATA 54 POINTER)
+         (PRESSDATA 56 POINTER)
+         (PRESSDATA 58 POINTER)
+         (PRESSDATA 60 POINTER))
+       '62)
 
 (RPAQ? DEFAULTPAGEREGION
 (CREATEREGION 2794 1905 16256 24765))
 
@@ -2597,7 +2603,7 @@ Copyright (c) 1981-1987, 1990, 1993, 2021 by Venue & Xerox Corporation.
 
 
 
-(RPAQQ PRESSOPS
 
+(RPAQQ PRESSOPS

        (SetX SetY ShowCharacters ShowCharactersShortCode SkipCharactersShortCode 
              ShowCharactersAndSkipCode SetSpaceXShortCode SetSpaceYShortCode FontCode 
              SkipControlBytesImmediateCode AlternativeCode OnlyOnCopyCode SetXCode SetYCode 
@@ -2722,60 +2728,59 @@ Copyright (c) 1981-1987, 1990, 1993, 2021 by Venue & Xerox Corporation.
                                   (CREATECHARSET \CREATECHARSET.PRESS)
                                   (FONTSAVAILABLE \SEARCHPRESSFONTS)))
 
-(ADDTOVAR PRINTERTYPES
 ((PRESS SPRUCE PENGUIN DOVER)
-                        (CANPRINT (PRESS))
-                        (STATUS PUP.PRINTER.STATUS)
-                        (PROPERTIES PUP.PRINTER.PROPERTIES)
-                        (SEND EFTP)
-                        (BITMAPSCALE NIL)
-                        (BITMAPFILE (PRESSBITMAP FILE BITMAP SCALEFACTOR REGION ROTATION TITLE)))
-                       ((FULLPRESS RAVEN)
+(ADDTOVAR PRINTERTYPES

+          ((PRESS SPRUCE PENGUIN DOVER)
+           (CANPRINT (PRESS))
+           (STATUS PUP.PRINTER.STATUS)
+           (PROPERTIES PUP.PRINTER.PROPERTIES)
+           (SEND EFTP)
+           (BITMAPSCALE NIL)
+           (BITMAPFILE (PRESSBITMAP FILE BITMAP SCALEFACTOR REGION ROTATION TITLE)))
+          ((FULLPRESS RAVEN)
                                                              (* ; 
 
                                                             "same as PRESS but can scale bitmaps")

-                        (CANPRINT (PRESS))
-                        (STATUS TRUE)
-                        (PROPERTIES NILL)
-                        (SEND EFTP)
-                        (BITMAPSCALE PRESS.BITMAPSCALE)
-                        (BITMAPFILE (FULLPRESSBITMAP FILE BITMAP SCALEFACTOR REGION ROTATION TITLE))))
+           (CANPRINT (PRESS))
+           (STATUS TRUE)
+           (PROPERTIES NILL)
+           (SEND EFTP)
+           (BITMAPSCALE PRESS.BITMAPSCALE)
+           (BITMAPFILE (FULLPRESSBITMAP FILE BITMAP SCALEFACTOR REGION ROTATION TITLE))))
 
-(ADDTOVAR PRINTFILETYPES
 [PRESS (TEST PRESSFILEP)
-                                (EXTENSION (PRESS))
-                                (CONVERSION (TEXT MAKEPRESS TEDIT
-                                                  (LAMBDA (FILE PFILE FONTS HEADING)
-                                                         (SETQ FILE (OPENTEXTSTREAM FILE))
-                                                         (TEDIT.FORMAT.HARDCOPY FILE PFILE T NIL NIL
-                                                                NIL 'PRESS)
-                                                         (CLOSEF? FILE)
-                                                         PFILE])
-(PUTPROPS PRESS COPYRIGHT ("Venue & Xerox Corporation" 3675Q 3676Q 3677Q 3700Q 3701Q 3702Q 3703Q 3706Q
- 3711Q 3745Q))
+(ADDTOVAR PRINTFILETYPES

+          [PRESS (TEST PRESSFILEP)
+                 (EXTENSION (PRESS))
+                 (CONVERSION (TEXT MAKEPRESS TEDIT (LAMBDA (FILE PFILE FONTS HEADING)
+                                                          (SETQ FILE (OPENTEXTSTREAM FILE))
+                                                          (TEDIT.FORMAT.HARDCOPY FILE PFILE T NIL NIL
+                                                                 NIL 'PRESS)
+                                                          (CLOSEF? FILE)
+                                                          PFILE])
 (DECLARE%: DONTCOPY
-  (FILEMAP (NIL (15752Q 72731Q (\SEARCHPRESSFONTS 15764Q . 17721Q) (\GETPRESSFONTNAMES 17723Q . 26561Q) 
-(\PRESSFAMILYCODELST 26563Q . 30505Q) (\DECODEPRESSFACEBYTE 30507Q . 33276Q) (\CREATEPRESSFONT 33300Q
- . 35545Q) (\CREATECHARSET.PRESS 35547Q . 72727Q)) (73366Q 127171Q (PRESSBITMAP 73400Q . 103002Q) (
-FULLPRESSBITMAP 103004Q . 111016Q) (SHOWREGION 111020Q . 112362Q) (SHOWPRESSBITMAPREGION 112364Q . 
-113026Q) (PRESSWINDOW 113030Q . 117167Q) (\WRITEPRESSBITMAP 117171Q . 127167Q)) (127267Q 157142Q (
-\BCPLSOUT.PRESS 127301Q . 130256Q) (\PAGEPAD.PRESS 130260Q . 131515Q) (\ENTITYEND.PRESS 131517Q . 
-137013Q) (\PARTEND.PRESS 137015Q . 141402Q) (\ENTITYSTART.PRESS 141404Q . 145015Q) (SETX.PRESS 145017Q
- . 146652Q) (SETXY.PRESS 146654Q . 151656Q) (SETY.PRESS 151660Q . 153260Q) (SHOW.PRESS 153262Q . 
-157140Q)) (157224Q 274041Q (OPENPRSTREAM 157236Q . 164365Q) (\BITBLT.PRESS 164367Q . 167001Q) (
-\BLTSHADE.PRESS 167003Q . 170436Q) (\SCALEDBITBLT.PRESS 170440Q . 173064Q) (\BITMAPSIZE.PRESS 173066Q
- . 174026Q) (\CHARWIDTH.PRESS 174030Q . 176077Q) (\CLOSEF.PRESS 176101Q . 206070Q) (\DRAWLINE.PRESS 
-206072Q . 207430Q) (\ENDPAGE.PRESS 207432Q . 210702Q) (NEWLINE.PRESS 210704Q . 212315Q) (NEWPAGE.PRESS
- 212317Q . 212611Q) (SETUPFONTS.PRESS 212613Q . 216344Q) (\DEFINEFONT.PRESS 216346Q . 220470Q) (
-\DSPBOTTOMMARGIN.PRESS 220472Q . 221266Q) (\DSPCLIPPINGREGION.PRESS 221270Q . 222662Q) (\DSPFONT.PRESS
- 222664Q . 227656Q) (\DSPLEFTMARGIN.PRESS 227660Q . 230540Q) (\DSPLINEFEED.PRESS 230542Q . 232052Q) (
-\DSPRIGHTMARGIN.PRESS 232054Q . 232737Q) (\DSPSPACEFACTOR.PRESS 232741Q . 234345Q) (
-\DSPTOPMARGIN.PRESS 234347Q . 235132Q) (\DSPXPOSITION.PRESS 235134Q . 235652Q) (\DSPYPOSITION.PRESS 
-235654Q . 236372Q) (\FIXLINELENGTH.PRESS 236374Q . 240471Q) (\OUTCHARFN.PRESS 240473Q . 247527Q) (
-\SETSPACE.PRESS 247531Q . 251025Q) (\STARTPAGE.PRESS 251027Q . 255370Q) (\STRINGWIDTH.PRESS 255372Q . 
-270750Q) (SHOWRECTANGLE.PRESS 270752Q . 271473Q) (\PRESS.CONVERT.NSCHARACTER 271475Q . 274037Q)) (
-274101Q 405143Q (\ENDVECRUN 274113Q . 303731Q) (\VECENCODE 303733Q . 304762Q) (\VECPUT 304764Q . 
-314412Q) (\VECSKIP 314414Q . 315147Q) (\VECFONTINIT 315151Q . 322274Q) (\DRAWCIRCLE.PRESS 322276Q . 
-324601Q) (\DRAWARC.PRESS 324603Q . 325374Q) (\DRAWCURVE.PRESS 325376Q . 333334Q) (
-\DRAWCURVE.PRESS.LINE 333336Q . 342203Q) (\DRAWELLIPSE.PRESS 342205Q . 345764Q) (\GETBRUSHFONT.PRESS 
-345766Q . 347670Q) (\PRESSCURVE2 347672Q . 405141Q)) (410775Q 415621Q (\PRESSINIT 411007Q . 415617Q)) 
-(443570Q 446657Q (MAKEPRESS 443602Q . 444106Q) (PRESSFILEP 444110Q . 445665Q) (PRESS.BITMAPSCALE 
-445667Q . 446655Q)))))
+  (FILEMAP (NIL (15566Q 72545Q (\SEARCHPRESSFONTS 15600Q . 17535Q) (\GETPRESSFONTNAMES 17537Q . 26375Q) 
+(\PRESSFAMILYCODELST 26377Q . 30321Q) (\DECODEPRESSFACEBYTE 30323Q . 33112Q) (\CREATEPRESSFONT 33114Q
+ . 35361Q) (\CREATECHARSET.PRESS 35363Q . 72543Q)) (73202Q 127005Q (PRESSBITMAP 73214Q . 102616Q) (
+FULLPRESSBITMAP 102620Q . 110632Q) (SHOWREGION 110634Q . 112176Q) (SHOWPRESSBITMAPREGION 112200Q . 
+112642Q) (PRESSWINDOW 112644Q . 117003Q) (\WRITEPRESSBITMAP 117005Q . 127003Q)) (127103Q 156756Q (
+\BCPLSOUT.PRESS 127115Q . 130072Q) (\PAGEPAD.PRESS 130074Q . 131331Q) (\ENTITYEND.PRESS 131333Q . 
+136627Q) (\PARTEND.PRESS 136631Q . 141216Q) (\ENTITYSTART.PRESS 141220Q . 144631Q) (SETX.PRESS 144633Q
+ . 146466Q) (SETXY.PRESS 146470Q . 151472Q) (SETY.PRESS 151474Q . 153074Q) (SHOW.PRESS 153076Q . 
+156754Q)) (157040Q 273644Q (OPENPRSTREAM 157052Q . 164201Q) (\BITBLT.PRESS 164203Q . 166615Q) (
+\BLTSHADE.PRESS 166617Q . 170252Q) (\SCALEDBITBLT.PRESS 170254Q . 172700Q) (\BITMAPSIZE.PRESS 172702Q
+ . 173642Q) (\CHARWIDTH.PRESS 173644Q . 175713Q) (\CLOSEF.PRESS 175715Q . 205704Q) (\DRAWLINE.PRESS 
+205706Q . 207244Q) (\ENDPAGE.PRESS 207246Q . 210516Q) (NEWLINE.PRESS 210520Q . 212131Q) (NEWPAGE.PRESS
+ 212133Q . 212425Q) (SETUPFONTS.PRESS 212427Q . 216160Q) (\DEFINEFONT.PRESS 216162Q . 220304Q) (
+\DSPBOTTOMMARGIN.PRESS 220306Q . 221102Q) (\DSPCLIPPINGREGION.PRESS 221104Q . 222476Q) (\DSPFONT.PRESS
+ 222500Q . 227461Q) (\DSPLEFTMARGIN.PRESS 227463Q . 230343Q) (\DSPLINEFEED.PRESS 230345Q . 231655Q) (
+\DSPRIGHTMARGIN.PRESS 231657Q . 232542Q) (\DSPSPACEFACTOR.PRESS 232544Q . 234150Q) (
+\DSPTOPMARGIN.PRESS 234152Q . 234735Q) (\DSPXPOSITION.PRESS 234737Q . 235455Q) (\DSPYPOSITION.PRESS 
+235457Q . 236175Q) (\FIXLINELENGTH.PRESS 236177Q . 240274Q) (\OUTCHARFN.PRESS 240276Q . 247332Q) (
+\SETSPACE.PRESS 247334Q . 250630Q) (\STARTPAGE.PRESS 250632Q . 255173Q) (\STRINGWIDTH.PRESS 255175Q . 
+270553Q) (SHOWRECTANGLE.PRESS 270555Q . 271276Q) (\PRESS.CONVERT.NSCHARACTER 271300Q . 273642Q)) (
+273704Q 404746Q (\ENDVECRUN 273716Q . 303534Q) (\VECENCODE 303536Q . 304565Q) (\VECPUT 304567Q . 
+314215Q) (\VECSKIP 314217Q . 314752Q) (\VECFONTINIT 314754Q . 322077Q) (\DRAWCIRCLE.PRESS 322101Q . 
+324404Q) (\DRAWARC.PRESS 324406Q . 325177Q) (\DRAWCURVE.PRESS 325201Q . 333137Q) (
+\DRAWCURVE.PRESS.LINE 333141Q . 342006Q) (\DRAWELLIPSE.PRESS 342010Q . 345567Q) (\GETBRUSHFONT.PRESS 
+345571Q . 347473Q) (\PRESSCURVE2 347475Q . 404744Q)) (410600Q 415424Q (\PRESSINIT 410612Q . 415422Q)) 
+(444757Q 450046Q (MAKEPRESS 444771Q . 445275Q) (PRESSFILEP 445277Q . 447054Q) (PRESS.BITMAPSCALE 
+447056Q . 450044Q)))))
 STOP

library/tedit/TEDIT-LOOKS

@@ -1,13 +1,16 @@
 (DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
 
-
(FILECREATED "13-Jul-2025 19:39:57" {WMEDLEY}<library>TEDIT>TEDIT-LOOKS.;426
 158882 
+
(FILECREATED " 1-Aug-2025 13:43:51" 
+{DSK}<Users>kaplan>Local>medley3.5>working-medley>library>tedit>TEDIT-LOOKS.;443
 160489 
 
       :EDIT-BY rmk
 
-      :CHANGES-TO (VARS TEDIT-LOOKSCOMS)
-                  (FNS \TEDIT.GET.INSERT.CHARLOOKS TEDIT.CARETLOOKS \TEDIT.CARETPIECE)
+      :CHANGES-TO (RECORDS CHARLOOKS)
+                  (FNS \TEDIT.EQCLOOKS \TEDIT.TRANSLATE.ASCIICHARS \TEDIT.UNIQUIFY.ALL 
+                       \TEDIT.FLUSH.UNUSED.LOOKS TEDIT.GET.LOOKS TEDIT.SUBLOOKS TEDIT.FINDLOOKS 
+                       \TEDIT.CHANGE.CHARLOOKS)
 
-      :PREVIOUS-DATE "24-Apr-2025 23:47:54" {WMEDLEY}<library>TEDIT>TEDIT-LOOKS.;425)
+      :PREVIOUS-DATE "29-Jul-2025 09:30:33" {WMEDLEY}<library>tedit>TEDIT-LOOKS.;435)
 
 
 (PRETTYCOMPRINT TEDIT-LOOKSCOMS)
@@ -29,21 +32,23 @@
               (* ;; 
 
              "Added by yabu.fx, for SUNLOADUP without DWIM.  Not sure any of these are needed/used.")

 
-              (FNS \TEDIT.CREATE.DEFAULT.FMTSPEC \TEDIT.CREATE.FACE.MENU \TEDIT.CREATE.SIZE.MENU))
-        [INITVARS (TEDIT.DEFAULT.FOLIO)
-               (TEDIT.KNOWN.FONTS '((Classic 'CLASSIC)
+              (FNS \TEDIT.CREATE.FACE.MENU \TEDIT.CREATE.SIZE.MENU))
+        (INITVARS (TEDIT.DEFAULT.FOLIO)
+               [TEDIT.KNOWN.FONTS '((Classic 'CLASSIC)
                                     (Modern 'MODERN)
                                     (Terminal 'TERMINAL)
                                     (Titan 'TITAN)
                                     (Gacha 'GACHA)
                                     (Helvetica 'HELVETICA)
                                     (Times% Roman 'TIMESROMAN]
-        (VARS TEDIT.CHARLOOKS.FEATURES (TEDIT.DEFAULT.FMTSPEC (\TEDIT.CREATE.DEFAULT.FMTSPEC))
-              (TEDIT.FACE.MENU (\TEDIT.CREATE.FACE.MENU))
+               (TEDIT.DEFAULT.TAB 36)
+               (TEDIT.DEFAULT.PARALOOKS `(QUAD LEFT LEFTMARGIN 0 1STLEFTMARGIN 0 RIGHTMARGIN 0 
+                                               PARALEADING 0 POSTPARALEADING 0 DEFAULTTAB 36))
+               (TEDIT.DEFAULT.FMTSPEC TEDIT.DEFAULT.PARALOOKS))
+        (VARS TEDIT.CHARLOOKS.FEATURES (TEDIT.FACE.MENU (\TEDIT.CREATE.FACE.MENU))
               (TEDIT.SIZE.MENU (\TEDIT.CREATE.SIZE.MENU)))
         (FNS \TEDIT.CHARLOOKS.FEATURE.CHECK)
-        (GLOBALVARS TEDIT.CHARLOOKS.FEATURES TEDIT.KNOWN.FONTS TEDIT.FACE.MENU TEDIT.SIZE.MENU 
-               TEDIT.DEFAULT.FMTSPEC)
+        (GLOBALVARS TEDIT.CHARLOOKS.FEATURES TEDIT.KNOWN.FONTS TEDIT.FACE.MENU TEDIT.SIZE.MENU)
         (ADDVARS (FONTVARS (TEDIT.PROMPT.FONT DEFAULTFONT)
                         (TEDIT.ICON.FONT MENUFONT)))
         (COMS                                                (* ; "Character looks functions")

@@ -130,8 +135,8 @@
 
                                                           "Spaces are treated as nonbreaking spaces")

                      CLSTYLE                                 (* ; 
 
                  "The style to be used in marking these characters;  overridden by the other fields")

-                     CLUSERINFO                              (* ; 
-
                                                  "Any information that an outsider wants to include")

+                     CLPROPS                                 (* ; 
+
                                   "Was CLUSERINFO:Any information that an outsider wants to include")

                      CLLEADER                                (* ; 
 
                                                      "For creating dotted and other kinds of leader")

                      CLRULES
@@ -148,8 +153,9 @@
                     CLOFFSET _ 0 CLCOLOR _ 'BLACK (INIT (DEFPRINT 'CHARLOOKS (FUNCTION 
                                                                             \TEDIT.CHARLOOKS.DEFPRINT
                                                                               )))
-                    (ACCESSFNS (CLNAME (fetch
 (CHARLOOKS CLFONTUNPARSE) of
 DATUM)
-                                      (replace
 (CHARLOOKS CLFONTUNPARSE) of
 DATUM with
 NEWVALUE))))
+                    (ASSOCRECORD CLPROPS (CLUSERINFO CLCHARENCODING))
+                    [ACCESSFNS ((CLNAME (fetch
 (CHARLOOKS CLFONTUNPARSE) of
 DATUM)
+                                       (replace
 (CHARLOOKS CLFONTUNPARSE) of
 DATUM with
 NEWVALUE])
 
 (DATATYPE PARALOOKS
 (
                      (* ;; "Describe the paragraph formatting for a paragraph in a TEdit document.")

@@ -452,21 +458,6 @@
 
 (DEFINEQ
 
-(\TEDIT.CREATE.DEFAULT.FMTSPEC

-  [LAMBDA NIL
                                                (* ; "Edited  8-Feb-2025 22:05 by rmk")


-                                                             (* ; "Edited  4-Aug-2024 17:13 by rmk")


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


-                                                             (* ; "Edited 24-Aug-2023 23:31 by rmk")

-    (create
 PARALOOKS
-           QUAD _ 'LEFT
-           1STLEFTMAR _ 0
-           LEFTMAR _ 0
-           RIGHTMAR _ 0
-           LEADBEFORE _ 0
-           LEADAFTER _ 0
-           LINELEAD _ 0
-           FMTDEFAULTTAB _ DEFAULTTAB])
-
 (\TEDIT.CREATE.FACE.MENU

   [LAMBDA NIL
     (create
 MENU
@@ -494,14 +485,19 @@
          (Helvetica 'HELVETICA)
          (Times% Roman 'TIMESROMAN)))
 
+(RPAQ? TEDIT.DEFAULT.TAB
 36)
+
+(RPAQ? TEDIT.DEFAULT.PARALOOKS
 `(QUAD LEFT LEFTMARGIN 0 1STLEFTMARGIN 0 RIGHTMARGIN 0 PARALEADING 0 
+                                      POSTPARALEADING 0 DEFAULTTAB 36))
+
+(RPAQ? TEDIT.DEFAULT.FMTSPEC
 TEDIT.DEFAULT.PARALOOKS)
+
 (RPAQQ TEDIT.CHARLOOKS.FEATURES

        (DEVICE FAMILY SIZE FACE ITALIC WEIGHT SLOPE BOLD EXPANSION FONT INVERTED INVISIBLE OFFSET 
               OFFSETINCREMENT OVERLINE PROTECTED SELECTPOINT SELAFTER SELBEFORE SIZEINCREMENT 
               SMALLCAPS STRIKEOUT STYLE SUBSCRIPT SUPERSCRIPT UNBREAKABLE UNDERLINE USERINFO 
               OFFSETTYPE COLOR))
 
-(RPAQ TEDIT.DEFAULT.FMTSPEC
 (\TEDIT.CREATE.DEFAULT.FMTSPEC))
-
 (RPAQ TEDIT.FACE.MENU
 (\TEDIT.CREATE.FACE.MENU))
 
 (RPAQ TEDIT.SIZE.MENU
 (\TEDIT.CREATE.SIZE.MENU))
@@ -535,8 +531,7 @@
 )
 (DECLARE%: DOEVAL@COMPILE DONTCOPY
 
-(GLOBALVARS TEDIT.CHARLOOKS.FEATURES TEDIT.KNOWN.FONTS TEDIT.FACE.MENU TEDIT.SIZE.MENU 
-       TEDIT.DEFAULT.FMTSPEC)
+(GLOBALVARS TEDIT.CHARLOOKS.FEATURES TEDIT.KNOWN.FONTS TEDIT.FACE.MENU TEDIT.SIZE.MENU)
 )
 
 (ADDTOVAR FONTVARS
 (TEDIT.PROMPT.FONT DEFAULTFONT)
@@ -576,7 +571,9 @@
            CLNAME _ (FONTUNPARSE FONT])
 
 (\TEDIT.EQCLOOKS

-  [LAMBDA (CLOOK1 CLOOK2)
                                    (* ; "Edited 15-Apr-2025 16:45 by rmk")


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


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


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


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


                                                              (* ; "Edited 18-Oct-2024 22:29 by rmk")


                                                              (* ; "Edited 11-Aug-2024 20:41 by rmk")


@@ -622,11 +619,12 @@
                     (FGETCLOOKS CLOOK2 CLSTYLE))
              (EQ (FGETCLOOKS CLOOK1 CLUNBREAKABLE)
                  (FGETCLOOKS CLOOK2 CLUNBREAKABLE))
-             (EQUAL (FGETCLOOKS CLOOK1 CLUSERINFO)
-                    (FGETCLOOKS CLOOK2 CLUSERINFO])
+             (EQUAL (FGETCLOOKS CLOOK1 CLPROPS)
+                    (FGETCLOOKS CLOOK2 CLPROPS])
 
 (\TEDIT.SAMECLOOKS

-  [LAMBDA (CLOOK1 CLOOK2 FEATURES)
                           (* ; "Edited 15-Apr-2025 16:42 by rmk")


+  [LAMBDA (CLOOK1 CLOOK2 FEATURES)
                           (* ; "Edited 21-Jul-2025 23:45 by rmk")


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


                                                              (* ; "Edited  2-Jan-2025 20:31 by rmk")


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


                                                              (* ; "Edited 31-Jul-2024 00:06 by rmk")


@@ -662,10 +660,12 @@
                                  (FGETCLOOKS CLOOK2 CLSTRIKE)))
                   (UNDERLINE (EQ (FGETCLOOKS CLOOK1 CLULINE)
                                  (FGETCLOOKS CLOOK2 CLULINE)))
-                  (UNBREAKABLE (FGETCLOOKS CLOOK1 CLUNBREAKABLE)
-                               (FGETCLOOKS CLOOK2 CLUNBREAKABLE))
-                  (COLOR (FGETCLOOKS CLOOK1 CLCOLOR)
-                         (FGETCLOOKS CLOOK2 CLCOLOR))
+                  (UNBREAKABLE (EQ (FGETCLOOKS CLOOK1 CLUNBREAKABLE)
+                                   (FGETCLOOKS CLOOK2 CLUNBREAKABLE)))
+                  (COLOR (EQUAL (FGETCLOOKS CLOOK1 CLCOLOR)
+                                (FGETCLOOKS CLOOK2 CLCOLOR)))
+                  (CHARENCODING (EQ (FGETCLOOKS CLOOK1 CLCHARENCODING)
+                                    (FGETCLOOKS CLOOK2 CLCHARENCODING CLCOLOR)))
                   (FACE (EQUAL (FONTPROP FONT1 'FACE)
                                (FONTPROP FONT2 'FACE)))
                   (ERROR (CONCAT F 
@@ -932,7 +932,9 @@
 (DEFINEQ
 
 (\TEDIT.TRANSLATE.ASCIICHARS

-  [LAMBDA (TSTREAM NOASCIIFONTS)
                             (* ; "Edited 24-Apr-2025 23:47 by rmk")


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


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


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


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


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


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


@@ -967,7 +969,7 @@
                      )
          (for
 CHNO CLOOKS TRANS MAPARRAY NEWFONTNAME STRING FAT CLOOKSLIST FAMILY TARRAYLAST
             from
 1 by
 (PLEN PC) as
 PC inpieces
 (\TEDIT.FIRSTPIECE TEXTOBJ)
-            eachtime
 (SETQ CLOOKS (PLOOKS PC))
+            eachtime
 (SETQ CLOOKS (PCHARLOOKS PC))
                   (SETQ FAMILY (FONTPROP (GETCLOOKS CLOOKS CLFONT)
                                       'FAMILY)) unless
 (OR (EQ OBJECT.PTYPE (PTYPE PC))
                                                            (EQ FAMILY 'CLASSIC))
@@ -984,7 +986,7 @@
 
                        (* ;; " Look backward for NEWFONTNAME, since that piece has already been coerced.  The idea is to get Cyrillic to continue the previous looks (serif, san-serif)")

 
-                       (SETQ NEWFONTNAME (FONTPROP (GETCLOOKS (PLOOKS (PREVPIECE PC))
+                       (SETQ NEWFONTNAME (FONTPROP (GETCLOOKS (PCHARLOOKS (PREVPIECE PC))
                                                           CLFONT)
                                                 'FAMILY))))
                (if
 (OR MAPARRAY NOASCIIFONTS)
@@ -1022,8 +1024,8 @@
                                                 (UNFOLD (PLEN PC)
                                                        2)
                                                 (PLEN PC)))
-                        (FSETPC PC PLOOKS (\TEDIT.TRANSLATE.ASCII.CHARLOOKS TEXTOBJ CLOOKS 
-                                                 NEWFONTNAME))
+                        (FSETPC PC PCHARLOOKS (\TEDIT.TRANSLATE.ASCII.CHARLOOKS TEXTOBJ CLOOKS 
+                                                     NEWFONTNAME))
                  else
 
                       (* ;; "Must be a text font (GACHA, TIMESROMAN, HELVETICA)  \ASCIITONS is the translation array, mostly identities.  ")

 
@@ -1047,19 +1049,12 @@
                                do
 (\TEDIT.RPLCHARCODE TSTREAM I NEWCODE NEWLOOKS))
                             (RETURN))) finally
 
 
-                                 (* ;; "Here we change the default and caret looks.  Perhaps this should be done only if NOASCIIFONTS.  But there is a risk that Ascii fonts and characters would slip in by future editing.  ")

+                                 (* ;; "Here we change the caret looks.  Perhaps this should be done only if NOASCIIFONTS.  But there is a risk that Ascii fonts and characters would slip in by future editing.  ")

 
                                              (CL:WHEN NOASCIIFONTS
                                                  (SETQ CLOOKS (FGETTOBJ TEXTOBJ DEFAULTCHARLOOKS))
                                                  (SETQ FAMILY (FONTPROP (GETCLOOKS CLOOKS CLFONT)
                                                                      'FAMILY))
-                                                 (CL:WHEN (AND (NEQ FAMILY 'CLASSIC)
-                                                               (SETQ TRANS (ASSOC FAMILY 
-                                                                                ASCIITONSTRANSLATIONS
-                                                                                  )))
-                                                     (FSETTOBJ TEXTOBJ DEFAULTCHARLOOKS
-                                                            (\TEDIT.TRANSLATE.ASCII.CHARLOOKS
-                                                             TEXTOBJ CLOOKS (CADDR TRANS))))
                                                  (SETQ CLOOKS (FGETTOBJ TEXTOBJ CARETLOOKS))
                                                  (SETQ FAMILY (FONTPROP (GETCLOOKS CLOOKS CLFONT)
                                                                      'FAMILY))
@@ -1222,7 +1217,8 @@
                                          (RETURN NEWLOOK])
 
 (\TEDIT.UNIQUIFY.ALL

-  [LAMBDA (TEXTOBJ)
                                          (* ; "Edited  8-Feb-2025 20:24 by rmk")


+  [LAMBDA (TEXTOBJ)
                                          (* ; "Edited 31-Jul-2025 09:17 by rmk")


+                                                             (* ; "Edited  8-Feb-2025 20:24 by rmk")


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


                                                              (* ; "Edited 14-Nov-2023 16:20 by rmk")


                                                              (* ; "Edited 25-Aug-2023 08:57 by rmk")


@@ -1236,7 +1232,7 @@
                                                     (* ;; 
 
                           "Assure that the CHARLOOKS and PARALOOKS of every piece are in the cache.")

 
-                                                    (change
 (PLOOKS PC)
+                                                    (change
 (PCHARLOOKS PC)
                                                            (\TEDIT.UNIQUIFY.CHARLOOKS
 DATUM TEXTOBJ))
                                                     (change
 (PPARALOOKS PC)
                                                            (\TEDIT.UNIQUIFY.PARALOOKS
 DATUM TEXTOBJ))
@@ -1250,7 +1246,8 @@
            (\TEDIT.UNIQUIFY.PARALOOKS
 DATUM TEXTOBJ])
 
 (\TEDIT.FLUSH.UNUSED.LOOKS

-  [LAMBDA (TEXTOBJ)
                                          (* ; "Edited 19-Feb-2025 11:56 by rmk")


+  [LAMBDA (TEXTOBJ)
                                          (* ; "Edited 31-Jul-2025 09:17 by rmk")


+                                                             (* ; "Edited 19-Feb-2025 11:56 by rmk")


                                                              (* ; "Edited  8-Feb-2025 20:36 by rmk")


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


                                                              (* ; "Edited 25-Aug-2023 08:03 by rmk")


@@ -1269,7 +1266,7 @@
 
          (* ;; "Run thru the pieces in the document, marking the looks that are really in use.")

 
-         (for
 PC inpieces
 (\TEDIT.FIRSTPIECE TEXTOBJ) do
 (FSETCLOOKS (PLOOKS PC)
+         (for
 PC inpieces
 (\TEDIT.FIRSTPIECE TEXTOBJ) do
 (FSETCLOOKS (PCHARLOOKS PC)
                                                                 CLMARK T)
                                                          (FSETPLOOKS (PPARALOOKS PC)
                                                                 FMTMARK T))
@@ -1323,7 +1320,8 @@
     TSTREAM])
 
 (TEDIT.GET.LOOKS

-  [LAMBDA (TEXTOBJ CH#ORCHARLOOKS)
                           (* ; "Edited 17-Mar-2024 00:27 by rmk")


+  [LAMBDA (TEXTOBJ CH#ORCHARLOOKS)
                           (* ; "Edited 31-Jul-2025 09:18 by rmk")


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


                                                              (* ; "Edited 14-Dec-2023 21:00 by rmk")


                                                              (* ; "Edited 21-Jun-2023 11:10 by rmk")


                                                              (* ; "Edited 22-Aug-2022 13:14 by rmk")


@@ -1339,18 +1337,21 @@
                                        then
                  (* ; 
 
                                                            "Empty document, use extant caret looks.")

                                             (FGETTOBJ TEXTOBJ CARETLOOKS)
-                                     else
 (PLOOKS (\TEDIT.CHTOPC
-                                                   (OR (FIXP CH#ORCHARLOOKS)
-                                                       (GETSEL (if
 (type?
 SELECTION CH#ORCHARLOOKS)
-                                                                   then
 CH#ORCHARLOOKS
-                                                                 elseif
 (NULL CH#ORCHARLOOKS)
-                                                                   then
 (TEXTSEL TEXTOBJ)
-                                                                 else
 (\ILLEGAL.ARG CH#ORCHARLOOKS))
-                                                              CH#))
-                                                   TEXTOBJ])
+                                     else
 (PCHARLOOKS (\TEDIT.CHTOPC
+                                                       (OR (FIXP CH#ORCHARLOOKS)
+                                                           (GETSEL (if
 (type?
 SELECTION 
+                                                                              CH#ORCHARLOOKS)
+                                                                       then
 CH#ORCHARLOOKS
+                                                                     elseif
 (NULL CH#ORCHARLOOKS)
+                                                                       then
 (TEXTSEL TEXTOBJ)
+                                                                     else
 (\ILLEGAL.ARG 
+                                                                                 CH#ORCHARLOOKS))
+                                                                  CH#))
+                                                       TEXTOBJ])
 
 (TEDIT.SUBLOOKS

-  [LAMBDA (TSTREAM OLDLOOKSLIST NEWLOOKSLIST)
                (* ; "Edited 22-Apr-2025 20:41 by rmk")


+  [LAMBDA (TSTREAM OLDLOOKSLIST NEWLOOKSLIST)
                (* ; "Edited 31-Jul-2025 09:20 by rmk")


+                                                             (* ; "Edited 22-Apr-2025 20:41 by rmk")


                                                              (* ; "Edited 20-Apr-2025 13:26 by rmk")


                                                              (* ; "Edited  6-Apr-2025 14:27 by rmk")


                                                              (* ; "Edited  5-Apr-2025 13:31 by rmk")


@@ -1377,7 +1378,7 @@
                   (NEWLOOKS _ (\TEDIT.PARSE.CHARLOOKS.LIST
 NEWLOOKSLIST NIL TEXTOBJ))
                   (FEATURELIST _ (for
 A on
 OLDLOOKSLIST by
 (CDDR A) collect
 (CAR A)))
                 inpieces
 (\TEDIT.FIRSTPIECE TEXTOBJ) as
 CH# from
 1 by
 (PLEN PC)
-                when
 (\TEDIT.SAMECLOOKS
 OLDLOOKS (PLOOKS PC)
+                when
 (\TEDIT.SAMECLOOKS
 OLDLOOKS (PCHARLOOKS PC)
                             FEATURELIST) do
 (CL:UNLESS CHANGEMADE
                                                 (SETQ CHANGEMADE T)
                                                 (SETQ SEL (TEXTSEL TEXTOBJ))
@@ -1388,12 +1389,12 @@
                                             (* ;; 
 
  "Note that we may be creating new looks each time, depending on what is there and what is changed.")

 
-                                            (FSETPC PC PLOOKS (\TEDIT.UNIQUIFY.CHARLOOKS

-                                                               (\TEDIT.PARSE.CHARLOOKS.LIST

-                                                                NEWLOOKSLIST
-                                                                (PLOOKS PC)
-                                                                TEXTOBJ)
-                                                               TEXTOBJ)) 
+                                            (FSETPC PC PCHARLOOKS (\TEDIT.UNIQUIFY.CHARLOOKS

+                                                                   (\TEDIT.PARSE.CHARLOOKS.LIST

+                                                                    NEWLOOKSLIST
+                                                                    (PCHARLOOKS PC)
+                                                                    TEXTOBJ)
+                                                                   TEXTOBJ)) 
 
                                        (* ;; "This goes piece by piece, each one adding to the collection of dirty lines.  We keep track of the first and last changes")

 
@@ -1406,7 +1407,8 @@
                       (RETURN CHANGEMADE)))])
 
 (TEDIT.FINDLOOKS

-  [LAMBDA (TEXTSTREAM OLDLOOKSLIST CH#)
                      (* ; "Edited 17-Mar-2024 00:27 by rmk")


+  [LAMBDA (TEXTSTREAM OLDLOOKSLIST CH#)
                      (* ; "Edited 31-Jul-2025 09:18 by rmk")


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


                                                              (* ; "Edited  3-Dec-2023 00:09 by rmk")


                                                              (* ; "Edited 13-Nov-2023 00:26 by rmk")


                                                              (* ; "Edited 18-Apr-2023 23:53 by rmk")


@@ -1428,10 +1430,11 @@
              [for
 PC PCLAST FOUNDCH# (OLDLOOKS _ (\TEDIT.PARSE.CHARLOOKS.LIST
 OLDLOOKSLIST NIL 
                                                         TEXTOBJ))
                   (FEATURELIST _ (for
 A on
 OLDLOOKSLIST by
 (CDDR A) collect
 (CAR A)))
-                inpieces
 (\TEDIT.CHTOPC CH# TEXTOBJ) when
 (\TEDIT.SAMECLOOKS
 OLDLOOKS (PLOOKS PC)
+                inpieces
 (\TEDIT.CHTOPC CH# TEXTOBJ) when
 (\TEDIT.SAMECLOOKS
 OLDLOOKS (PCHARLOOKS
+                                                                                       PC)
                                                                  FEATURELIST)
                 do
 [SETQ PCLAST (find
 PC1 inpieces
 (NEXTPIECE PC)
-                                   suchthat
 (NOT (\TEDIT.SAMECLOOKS
 OLDLOOKS (PLOOKS PC1)
+                                   suchthat
 (NOT (\TEDIT.SAMECLOOKS
 OLDLOOKS (PCHARLOOKS PC1)
                                                         FEATURELIST]
                    (SETQ PCLAST (CL:IF PCLAST
                                     (PREVPIECE PCLAST)
@@ -1449,7 +1452,8 @@
 (DEFINEQ
 
 (\TEDIT.CHANGE.CHARLOOKS

-  [LAMBDA (TSTREAM NEWLOOKS TARGETSEL)
                       (* ; "Edited 22-Apr-2025 20:17 by rmk")


+  [LAMBDA (TSTREAM NEWLOOKS TARGETSEL)
                       (* ; "Edited 31-Jul-2025 09:18 by rmk")


+                                                             (* ; "Edited 22-Apr-2025 20:17 by rmk")


                                                              (* ; "Edited 21-Apr-2025 20:17 by rmk")


                                                              (* ; "Edited 20-Apr-2025 13:27 by rmk")


                                                              (* ; "Edited 16-Apr-2025 09:03 by rmk")


@@ -1508,7 +1512,7 @@
      (* ;; "Verify that all of the new looks are OK before we change anything")

 
           [SETQ NEWLOOKSLIST (for
 PC OLDCHARLOOKS inselpieces
 SELPIECES
-                                collect
 (SETQ OLDCHARLOOKS (PLOOKS PC))
+                                collect
 (SETQ OLDCHARLOOKS (PCHARLOOKS PC))
                                       (OR (CL:IF (type?
 CHARLOOKS NEWLOOKS)
                                               NEWLOOKS
                                               (\TEDIT.CHANGE.CHARLOOKS.NEW
 NEWLOOKS OLDCHARLOOKS 
@@ -1519,12 +1523,12 @@
           [for
 PC UNDOLIST NEWCHARLOOKS (FIRSTCHAR _ (GETSPC SELPIECES SPFIRSTCHAR))
                (ORIGFILEPTR _ (\TEDIT.TEXTGETFILEPTR TSTREAM))
                OLDCHARLOOKS inselpieces
 SELPIECES as
 NEWCHARLOOKS in
 NEWLOOKSLIST
-             do
 (SETQ OLDCHARLOOKS (PLOOKS PC))
+             do
 (SETQ OLDCHARLOOKS (PCHARLOOKS PC))
                 (add
 FIRSTCHAR (PLEN PC))                    (* ; 
 
                              "Beginning of next piece--where to stop undoing if new pieces inserted")

                 (if
 (\TEDIT.EQCLOOKS
 OLDCHARLOOKS NEWCHARLOOKS)
                     then
 (SETQ OLDCHARLOOKS NIL)             (* ; "Undo skips if NIL")

-                  else
 (FSETPC PC PLOOKS (\TEDIT.UNIQUIFY.CHARLOOKS
 NEWCHARLOOKS TEXTOBJ))
+                  else
 (FSETPC PC PCHARLOOKS (\TEDIT.UNIQUIFY.CHARLOOKS
 NEWCHARLOOKS TEXTOBJ))
                        (CL:UNLESS DIRTY                      (* ; 
 
                                                     "Resetting DIRTY is expensive, only do it once ")

                            (FSETTOBJ TEXTOBJ \DIRTY T)
@@ -2033,7 +2037,8 @@
              join
 (LIST PROPNAME PROP])
 
 (\TEDIT.PARSE.PARALOOKS.LIST

-  [LAMBDA (NEWLOOKS OLDLOOKS TEXTOBJ)
                        (* ; "Edited 19-Feb-2025 11:57 by rmk")


+  [LAMBDA (NEWLOOKS OLDPARALOOKS)
                            (* ; "Edited 28-Jul-2025 23:19 by rmk")


+                                                             (* ; "Edited 19-Feb-2025 11:57 by rmk")


                                                              (* ; "Edited  8-Feb-2025 22:27 by rmk")


                                                              (* ; "Edited 28-Jul-2024 22:14 by rmk")


                                                              (* ; "Edited 29-Apr-2024 11:03 by rmk")


@@ -2042,17 +2047,28 @@
                                                              (* ; "Edited  5-Sep-2022 15:39 by rmk")

                                                              (* ; 
 
                                                        "Edited  3-Jul-93 21:49 by sybalskY:MV:ENVOS")

-                                                             (* ; 
-
                        "Apply a given format spec to the paragraphs which are included in this guy.")

+
+    (* ;; "Produce a PARALOOKS based on the priority union of NEWLOOKS over OLDLOOKS.  ")

+
+    (* ;; "This causes errors for invalid arguments (e.g. nonnumeric).  User values should be checked and reported by the caller.ÿ<02><>ÿ")

+
     (if
 (type?
 PARALOOKS NEWLOOKS)
-        then
                                                 (* ; 
-
                       "if we were given a PARALOOKS it replace the PARALOOKS of all pieces affected")

+        then
 
+             (* ;; "A PARALOOKS is complete, OLDPARALOOKS ignored ")

+
              NEWLOOKS
-      else
 (LET (NEWFMT 1STLEFT LEFT RIGHT LEADB LEADA LLEAD TABSPEC QUADD NLOOKSAVE TYPE SUBTYPE 
-                       TYPESET SUBTYPESET NEWBEFORESET NEWBEFORE NEWAFTERSET NEWAFTER KEEP KEEPSET 
-                       HEADINGKEEP BASETOBASE BASESET REVISED REVISEDSET COLUMN COLUMNSET USERINFO 
-                       USERINFOSET SPECIALX SPECXSET SPECIALY SPECYSET STYLE STYLESET CHARSTYLES 
-                       CHARSTYLESSET DEFTAB TABS)            (* ; "create PARALOOKS from the Plist")

+      else
 (LET (NEWPARALOOKS 1STLEFT LEFT RIGHT LEADB LEADA LLEAD TABSPEC QUADD NLOOKSAVE TYPE 
+                       SUBTYPE TYPESET SUBTYPESET NEWBEFORESET NEWBEFORE NEWAFTERSET NEWAFTER KEEP 
+                       KEEPSET HEADINGKEEP HEADINGKEEPSET BASETOBASE BASESET REVISED REVISEDSET 
+                       COLUMN COLUMNSET USERINFO USERINFOSET SPECIALX SPECXSET SPECIALY SPECYSET 
+                       STYLE STYLESET CHARSTYLES CHARSTYLESSET DEFTAB TABS)
+                                                             (* ; "create PARALOOKS from the Plist")

+                (CL:WHEN (LISTP OLDPARALOOKS)                (* ; "Defaults from OLDPARALOOKS")

+                    (SETQ NEWLOOKS (APPEND NEWLOOKS OLDPARALOOKS)))
+
+                (* ;; 
+
  "For values that can be NIL, we have to keep track of what was there. ALIST would have been better")

+
                 (SETQ 1STLEFT (LISTGET NEWLOOKS '1STLEFTMARGIN))
                 (SETQ LEFT (LISTGET NEWLOOKS 'LEFTMARGIN))
                 (SETQ RIGHT (LISTGET NEWLOOKS 'RIGHTMARGIN))
@@ -2067,11 +2083,12 @@
                 (SETQ NEWBEFORE (LISTGET NEWLOOKS 'NEWPAGEBEFORE))
                 (SETQ NEWAFTERSET (FMEMB 'NEWPAGEAFTER NEWLOOKS))
                 (SETQ NEWAFTER (LISTGET NEWLOOKS 'NEWPAGEAFTER))
+                (SETQ HEADINGKEEPSET (FMEMB 'HEADINGKEEP NEWLOOKS))
                 (SETQ HEADINGKEEP (LISTGET NEWLOOKS 'HEADINGKEEP))
                                                              (* ; "Keep for headings")

-                (SETQ KEEP (LISTGET NEWLOOKS 'KEEP))         (* ; 
-
                                       "More general `Keep-together' spec -- undefined as of 5/22/85")

                 (SETQ KEEPSET (FMEMB 'KEEP NEWLOOKS))
+                (SETQ KEEP (LISTGET NEWLOOKS 'KEEP))         (* ; 
+
                                      "More general `Keep-together' spec -- undefined as of 5/22/8ÿ<02>ÿ5")

                 (SETQ BASETOBASE (LISTGET NEWLOOKS 'BASETOBASE))
                 (SETQ BASESET (FMEMB 'BASETOBASE NEWLOOKS))
                 (SETQ REVISED (LISTGET NEWLOOKS 'REVISED))
@@ -2093,6 +2110,9 @@
                 (SETQ TABS (LISTGET NEWLOOKS 'TABS))
                 (SETQ TABSPEC (LISTGET NEWLOOKS 'TABSPEC))
                 (CL:WHEN TABSPEC
+
+                    (* ;; "Cÿœœœÿhange from the users list to the real tabspec, a CONS pair of default width and LIST of TAB record instances")

+
                     (SETQ DEFTAB (fetch
 (TABSPEC DEFAULTTAB) of
 TABSPEC))
                     (SETQ TABS (fetch
 (TABSPEC TABS) of
 TABSPEC)))
                 [SELECTQ QUADD
@@ -2106,39 +2126,36 @@
                     ((C CENTER) 
                          (SETQQ QUADD CENTERED))
                     (PROGN                                   (* ; 
-
                                                           "We got an illegal QUAD value.  Use LEFT.")

-                           (TEDIT.PROMPTPRINT TEXTOBJ (CONCAT "Illegal paragraph quad " QUADD 
-                                                             ", replaced with LEFT.")
-                                  T)
+
                                                     "Value should have been checked, error reported")

                            (SETQ QUADD 'LEFT]
-
-                (* ;; "change from the users list to the real tabspec, a CONS pair of default width and LIST of TAB record instances")

-
-                (SETQ NEWFMT (create
 PARALOOKS using
 (OR OLDLOOKS TEDIT.DEFAULT.FMTSPEC)))
-                (AND 1STLEFT (FSETPLOOKS NEWFMT 1STLEFTMAR 1STLEFT))
-                (AND LEFT (FSETPLOOKS NEWFMT LEFTMAR LEFT))
-                (AND RIGHT (FSETPLOOKS NEWFMT RIGHTMAR RIGHT))
-                (AND LEADB (FSETPLOOKS NEWFMT LEADBEFORE LEADB))
-                (AND LEADA (FSETPLOOKS NEWFMT LEADAFTER LEADA))
-                (AND LLEAD (FSETPLOOKS NEWFMT LINELEAD LLEAD))
-                (AND TABS (FSETPLOOKS NEWFMT FMTTABS TABS))
-                (AND DEFTAB (FSETPLOOKS NEWFMT FMTDEFAULTTAB DEFTAB))
-                (AND QUADD (FSETPLOOKS NEWFMT QUAD QUADD))
-                (AND TYPESET (FSETPLOOKS NEWFMT FMTPARATYPE TYPE))
-                (AND SUBTYPESET (FSETPLOOKS NEWFMT FMTPARASUBTYPE SUBTYPE))
-                (AND NEWBEFORESET (FSETPLOOKS NEWFMT FMTNEWPAGEBEFORE NEWBEFORE))
-                (AND NEWAFTERSET (FSETPLOOKS NEWFMT FMTNEWPAGEAFTER NEWAFTER))
-                [AND HEADINGKEEP (FSETPLOOKS NEWFMT FMTHEADINGKEEP (EQ HEADINGKEEP 'ON]
-                (AND KEEPSET (FSETPLOOKS NEWFMT FMTKEEP KEEP))
-                (AND BASESET (FSETPLOOKS NEWFMT FMTBASETOBASE BASETOBASE))
-                (AND REVISEDSET (FSETPLOOKS NEWFMT FMTREVISED REVISED))
-                (AND COLUMNSET (FSETPLOOKS NEWFMT FMTCOLUMN COLUMN))
-                (AND SPECXSET (FSETPLOOKS NEWFMT FMTSPECIALX SPECIALX))
-                (AND SPECYSET (FSETPLOOKS NEWFMT FMTSPECIALY SPECIALY))
-                (AND STYLESET (FSETPLOOKS NEWFMT FMTSTYLE STYLE))
-                (AND CHARSTYLESSET (FSETPLOOKS NEWFMT FMTCHARSTYLES CHARSTYLES))
-                (AND USERINFOSET (FSETPLOOKS NEWFMT FMTUSERINFO USERINFO))
-                NEWFMT])
+                (SETQ NEWPARALOOKS (if
 (type?
 PARALOOKS OLDPARALOOKS)
+                                       then
 (create
 PARALOOKS using
 OLDPARALOOKS)
+                                     else
 (create
 PARALOOKS)))
+                (AND 1STLEFT (FSETPLOOKS NEWPARALOOKS 1STLEFTMAR 1STLEFT))
+                (AND LEFT (FSETPLOOKS NEWPARALOOKS LEFTMAR LEFT))
+                (AND RIGHT (FSETPLOOKS NEWPARALOOKS RIGHTMAR RIGHT))
+                (AND LEADB (FSETPLOOKS NEWPARALOOKS LEADBEFORE LEADB))
+                (AND LEADA (FSETPLOOKS NEWPARALOOKS LEADAFTER LEADA))
+                (AND LLEAD (FSETPLOOKS NEWPARALOOKS LINELEAD LLEAD))
+                (AND TABS (FSETPLOOKS NEWPARALOOKS FMTTABS TABS))
+                (AND DEFTAB (FSETPLOOKS NEWPARALOOKS FMTDEFAULTTAB DEFTAB))
+                (AND QUADD (FSETPLOOKS NEWPARALOOKS QUAD QUADD))
+                (AND TYPESET (FSETPLOOKS NEWPARALOOKS FMTPARATYPE TYPE))
+                (AND SUBTYPESET (FSETPLOOKS NEWPARALOOKS FMTPARASUBTYPE SUBTYPE))
+                (AND NEWBEFORESET (FSETPLOOKS NEWPARALOOKS FMTNEWPAGEBEFORE NEWBEFORE))
+                (AND NEWAFTERSET (FSETPLOOKS NEWPARALOOKS FMTNEWPAGEAFTER NEWAFTER))
+                [AND HEADINGKEEPSET (FSETPLOOKS NEWPARALOOKS FMTHEADINGKEEP (EQ HEADINGKEEP
+                                                                                'ON]
+                (AND KEEPSET (FSETPLOOKS NEWPARALOOKS FMTKEEP KEEP))
+                (AND BASESET (FSETPLOOKS NEWPARALOOKS FMTBASETOBASE BASETOBASE))
+                (AND REVISEDSET (FSETPLOOKS NEWPARALOOKS FMTREVISED REVISED))
+                (AND COLUMNSET (FSETPLOOKS NEWPARALOOKS FMTCOLUMN COLUMN))
+                (AND SPECXSET (FSETPLOOKS NEWPARALOOKS FMTSPECIALX SPECIALX))
+                (AND SPECYSET (FSETPLOOKS NEWPARALOOKS FMTSPECIALY SPECIALY))
+                (AND STYLESET (FSETPLOOKS NEWPARALOOKS FMTSTYLE STYLE))
+                (AND CHARSTYLESSET (FSETPLOOKS NEWPARALOOKS FMTCHARSTYLES CHARSTYLES))
+                (AND USERINFOSET (FSETPLOOKS NEWPARALOOKS FMTUSERINFO USERINFO))
+                NEWPARALOOKS])
 
 (TEDIT.PARALOOKS

   [LAMBDA (TSTREAM NEWLOOKS SELORCH# LEN)
                    (* ; "Edited 10-Aug-2024 00:23 by rmk")


@@ -2394,7 +2411,8 @@
 (DEFINEQ
 
 (TEDIT.SUBPARALOOKS

-  [LAMBDA (TSTREAM OLDLOOKSLIST NEWLOOKSLIST)
                (* ; "Edited 21-Apr-2025 20:15 by rmk")


+  [LAMBDA (TSTREAM OLDLOOKSLIST NEWLOOKSLIST)
                (* ; "Edited 28-Jul-2025 22:57 by rmk")


+                                                             (* ; "Edited 21-Apr-2025 20:15 by rmk")


                                                              (* ; "Edited 20-Apr-2025 13:27 by rmk")


                                                              (* ; "Edited  6-Apr-2025 14:31 by rmk")


                                                              (* ; "Edited 25-Nov-2024 22:00 by rmk")


@@ -2416,7 +2434,6 @@
     (LET ((TEXTOBJ (FTEXTOBJ TSTREAM)))
          (for
 PC CHANGEMADE SEL FIRSTCHANGEDCHNO (NCHARSCHANGED _ 0)
               (OLDLOOKS _ (\TEDIT.PARSE.PARALOOKS.LIST
 OLDLOOKSLIST))
-              (NEWLOOKS _ (\TEDIT.PARSE.PARALOOKS.LIST
 NEWLOOKSLIST))
               (FEATURELIST _ (for
 A on
 OLDLOOKSLIST by
 (CDDR A) collect
 (CAR A)))
             inpieces
 (\TEDIT.FIRSTPIECE TEXTOBJ) as
 CH# from
 1 by
 (PLEN PC)
             when
 (SAMEPARALOOKS
 OLDLOOKS (PPARALOOKS PC PPARALOOKS)
@@ -2429,8 +2446,7 @@
                                         (FSETPC PC PPARALOOKS (\TEDIT.UNIQUIFY.PARALOOKS

                                                                (\TEDIT.PARSE.PARALOOKS.LIST

                                                                 NEWLOOKSLIST
-                                                                (PPARALOOKS PC)
-                                                                TEXTOBJ)
+                                                                (PPARALOOKS PC))
                                                                TEXTOBJ)) 
 
                                        (* ;; "This goes piece by piece, each one adding to the collection of dirty lines.  We keep track of the first and last changes")

@@ -2517,26 +2533,26 @@
 (ADDTOVAR LAMA
 )
 )
 (DECLARE%: DONTCOPY
-  (FILEMAP (NIL (22170 24112 (\TEDIT.CHARLOOKS.DEFPRINT 22180 . 23316) (\TEDIT.PARALOOKS.DEFPRINT 23318
- . 24110)) (24216 25312 (\TEDIT.CREATE.DEFAULT.FMTSPEC 24226 . 24934) (\TEDIT.CREATE.FACE.MENU 24936
- . 25108) (\TEDIT.CREATE.SIZE.MENU 25110 . 25310)) (26111 28000 (\TEDIT.CHARLOOKS.FEATURE.CHECK 26121
- . 27998)) (28302 52994 (\TEDIT.CHARLOOKS.FROM.FONT 28312 . 30525) (\TEDIT.EQCLOOKS 30527 . 33349) (
-\TEDIT.SAMECLOOKS 33351 . 36237) (TEDIT.CARETLOOKS 36239 . 37785) (TEDIT.COPY.LOOKS 37787 . 41070) (
-\TEDIT.UNPARSE.CHARLOOKS.LIST 41072 . 44566) (\TEDIT.MODIFYLOOKS 44568 . 46728) (TEDIT.NEW.FONT 46730
- . 47177) (\TEDIT.CARETLOOKS.VERIFY 47179 . 48016) (\TEDIT.CARETPIECE 48018 . 48323) (
-\TEDIT.GET.INSERT.CHARLOOKS 48325 . 51372) (\TEDIT.GET.TERMSA.WIDTHS 51374 . 51790) (
-\TEDIT.PARSE.CHARLOOKS.LIST 51792 . 52992)) (52995 70141 (\TEDIT.TRANSLATE.ASCIICHARS 53005 . 63877) (
-\TEDIT.CONVERT.TO.FORMATTED 63879 . 70139)) (71153 78264 (\TEDIT.UNIQUIFY.CHARLOOKS 71163 . 72823) (
-\TEDIT.UNIQUIFY.PARALOOKS 72825 . 74092) (\TEDIT.UNIQUIFY.ALL 74094 . 76069) (
-\TEDIT.FLUSH.UNUSED.LOOKS 76071 . 78262)) (78297 89604 (TEDIT.LOOKS 78307 . 80696) (TEDIT.GET.LOOKS 
-80698 . 82727) (TEDIT.SUBLOOKS 82729 . 86968) (TEDIT.FINDLOOKS 86970 . 89602)) (89679 119187 (
-\TEDIT.CHANGE.CHARLOOKS 89689 . 98346) (\TEDIT.CHANGE.CHARLOOKS.NEW 98348 . 102142) (
-\TEDIT.CHARLOOKS.CHANGE.FONT 102144 . 110451) (\TEDIT.FONT.NEXTSIZE 110453 . 112074) (\TEDIT.LOOKS 
-112076 . 115405) (\TEDIT.FONTCOPY 115407 . 116908) (\TEDIT.COERCE.FONTCLASS 116910 . 118061) (
-\TEDIT.FONTCLASS.TO.FONT 118063 . 119185)) (119230 150187 (\TEDIT.EQFMTSPEC 119240 . 122455) (
-TEDIT.GET.PARALOOKS 122457 . 126504) (\TEDIT.PARSE.PARALOOKS.LIST 126506 . 133848) (TEDIT.PARALOOKS 
-133850 . 134890) (\TEDIT.CHANGE.PARALOOKS 134892 . 141860) (\TEDIT.CHANGE.PARALOOKS.NEW 141862 . 
-145845) (TEDIT.COPY.PARALOOKS 145847 . 148521) (\TEDIT.PARABOUNDS 148523 . 150185)) (150247 158000 (
-TEDIT.SUBPARALOOKS 150257 . 154396) (SAMEPARALOOKS 154398 . 157998)) (158001 158688 (
-\TEDIT.MARK.REVISION 158011 . 158686)))))
+  (FILEMAP (NIL (22579 24521 (\TEDIT.CHARLOOKS.DEFPRINT 22589 . 23725) (\TEDIT.PARALOOKS.DEFPRINT 23727
+ . 24519)) (24625 25011 (\TEDIT.CREATE.FACE.MENU 24635 . 24807) (\TEDIT.CREATE.SIZE.MENU 24809 . 25009
+)) (26015 27904 (\TEDIT.CHARLOOKS.FEATURE.CHECK 26025 . 27902)) (28176 53365 (
+\TEDIT.CHARLOOKS.FROM.FONT 28186 . 30399) (\TEDIT.EQCLOOKS 30401 . 33435) (\TEDIT.SAMECLOOKS 33437 . 
+36608) (TEDIT.CARETLOOKS 36610 . 38156) (TEDIT.COPY.LOOKS 38158 . 41441) (
+\TEDIT.UNPARSE.CHARLOOKS.LIST 41443 . 44937) (\TEDIT.MODIFYLOOKS 44939 . 47099) (TEDIT.NEW.FONT 47101
+ . 47548) (\TEDIT.CARETLOOKS.VERIFY 47550 . 48387) (\TEDIT.CARETPIECE 48389 . 48694) (
+\TEDIT.GET.INSERT.CHARLOOKS 48696 . 51743) (\TEDIT.GET.TERMSA.WIDTHS 51745 . 52161) (
+\TEDIT.PARSE.CHARLOOKS.LIST 52163 . 53363)) (53366 70096 (\TEDIT.TRANSLATE.ASCIICHARS 53376 . 63832) (
+\TEDIT.CONVERT.TO.FORMATTED 63834 . 70094)) (71108 78445 (\TEDIT.UNIQUIFY.CHARLOOKS 71118 . 72778) (
+\TEDIT.UNIQUIFY.PARALOOKS 72780 . 74047) (\TEDIT.UNIQUIFY.ALL 74049 . 76137) (
+\TEDIT.FLUSH.UNUSED.LOOKS 76139 . 78443)) (78478 90436 (TEDIT.LOOKS 78488 . 80877) (TEDIT.GET.LOOKS 
+80879 . 83214) (TEDIT.SUBLOOKS 83216 . 87596) (TEDIT.FINDLOOKS 87598 . 90434)) (90511 120140 (
+\TEDIT.CHANGE.CHARLOOKS 90521 . 99299) (\TEDIT.CHANGE.CHARLOOKS.NEW 99301 . 103095) (
+\TEDIT.CHARLOOKS.CHANGE.FONT 103097 . 111404) (\TEDIT.FONT.NEXTSIZE 111406 . 113027) (\TEDIT.LOOKS 
+113029 . 116358) (\TEDIT.FONTCOPY 116360 . 117861) (\TEDIT.COERCE.FONTCLASS 117863 . 119014) (
+\TEDIT.FONTCLASS.TO.FONT 119016 . 120138)) (120183 151831 (\TEDIT.EQFMTSPEC 120193 . 123408) (
+TEDIT.GET.PARALOOKS 123410 . 127457) (\TEDIT.PARSE.PARALOOKS.LIST 127459 . 135492) (TEDIT.PARALOOKS 
+135494 . 136534) (\TEDIT.CHANGE.PARALOOKS 136536 . 143504) (\TEDIT.CHANGE.PARALOOKS.NEW 143506 . 
+147489) (TEDIT.COPY.PARALOOKS 147491 . 150165) (\TEDIT.PARABOUNDS 150167 . 151829)) (151891 159607 (
+TEDIT.SUBPARALOOKS 151901 . 156003) (SAMEPARALOOKS 156005 . 159605)) (159608 160295 (
+\TEDIT.MARK.REVISION 159618 . 160293)))))
 STOP

library/tedit/TEDIT-STREAM

@@ -1,12 +1,12 @@
 (DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
 
-
(FILECREATED "29-May-2025 19:06:45" {WMEDLEY}<library>tedit>TEDIT-STREAM.;901
 191318 
+
(FILECREATED "29-Jul-2025 11:58:01" {WMEDLEY}<library>TEDIT>TEDIT-STREAM.;912
 190401 
 
       :EDIT-BY rmk
 
-      :CHANGES-TO (FNS \TEDIT.OPENTEXTSTREAM.PIECES)
+      :CHANGES-TO (FNS \TEDIT.OPENTEXTSTREAM.DEFAULTLOOKS)
 
-      :PREVIOUS-DATE "26-Apr-2025 12:59:53" {WMEDLEY}<library>tedit>TEDIT-STREAM.;900)
+      :PREVIOUS-DATE "28-Jul-2025 23:52:41" {WMEDLEY}<library>TEDIT>TEDIT-STREAM.;911)
 
 
 (PRETTYCOMPRINT TEDIT-STREAMCOMS)
@@ -14,8 +14,8 @@
 (RPAQQ TEDIT-STREAMCOMS

        [(DECLARE%: EVAL@COMPILE DONTCOPY
                (EXPORT (RECORDS PIECE TEXTOBJ TEXTSTREAM)
-                      (MACROS NEXTPIECE PREVPIECE PLEN PTYPE PCONTENTS PLOOKS PCHARLOOKS PCHARSET 
-                             PPARALOOKS PPARALAST PFPOS PBYTELEN PNEW PBINABLE PBYTESPERCHAR POBJ)
+                      (MACROS NEXTPIECE PREVPIECE PLEN PTYPE PCONTENTS PCHARLOOKS PCHARSET PPARALOOKS
+                             PPARALAST PFPOS PBYTELEN PNEW PBINABLE PBYTESPERCHAR POBJ)
                       (MACROS SETPC FSETPC GETPC FGETPC)
                       (MACROS THINPIECEP)
                       (MACROS VISIBLEPIECEP \NEXT.VISIBLE.PIECE \PREV.VISIBLE.PIECE)
@@ -126,14 +126,8 @@
 
              "The number of bytes in the UTF-8 encoding of all the Unicode characters in this piece")

                 [ACCESSFNS ((POBJ (AND (EQ OBJECT.PTYPE (PTYPE DATUM))
                                        (type?
 IMAGEOBJ (PCONTENTS DATUM))
-                                       (PCONTENTS DATUM)))
-                            (PLOOKS (STANDARD (fetch
 (PIECE PCHARLOOKS) of
 DATUM)
-                                           FAST
-                                           (fetch
 (PIECE PCHARLOOKS) of
 DATUM))
-                                   (STANDARD (replace
 (PIECE PCHARLOOKS) of
 DATUM with
 NEWVALUE)
-                                          FAST
-                                          (freplace
 (PIECE PCHARLOOKS) of
 DATUM with
 NEWVALUE]
-                PFPOS _ 0 PLEN _ 0 PBYTELEN _ 0 PPARALOOKS _ TEDIT.DEFAULT.FMTSPEC)
+                                       (PCONTENTS DATUM]
+                PFPOS _ 0 PLEN _ 0 PBYTELEN _ 0)
 
 (DATATYPE TEXTOBJ
 (
                    (* ;; 
@@ -202,7 +196,7 @@
 
 "Flag for paragraph formatting.  T if this document is to contain paragraph formatting information.")

                    (TXTREADONLY FLAG)                        (* ; 
 
                                                        "This is only available for shift selection.")

-                   (TXTEDITING FLAG)                         (* ; "T => This document is in a window and there is an edit process behind it.  For example, it only makes sense to have a caret show up if you are editing.")

+                   (UNDERTEDIT FLAG)                         (* ; "Was TXTEDITING, but it was never fetched. T => This document is in a window and there is an edit process behind it.  For example, it only makes sense to have a caret show up if you are editing.")

                    (TXTNOTSPLITTABLE FLAG)                   (* ; "Can't split into panes, split-region not show. Was TXTNONSCHARS: T => If TEdit rns into a 255, it won't attempt to convert to NS characters.  Used for REALLY plain-text manipulation.")

                    TXTTERMSA                                 (* ; 
 
                                       "Special instructions for displaying characters on the screen")

@@ -252,8 +246,7 @@
                                                         (freplace
 \XDIRTY OF
 DATUM WITH
 NEWVALUE))]
                   SEL _ (create
 SELECTION)
                   TEXTLEN _ 0 WTOP _ 0 MOUSEREGION _ 'TEXT THISLINE _ (create
 THISLINE)
-                  DEFAULTPARALOOKS _ TEDIT.DEFAULT.FMTSPEC PARABREAKCHARS _
-                  (CHARCODE (EOL FORM LF CR)))
+                  PARABREAKCHARS _ (CHARCODE (EOL FORM LF CR)))
 
 (ACCESSFNS TEXTSTREAM
 
            (
@@ -410,9 +403,6 @@
 (PUTPROPS PCONTENTS
 MACRO
 ((PC)
                            (ffetch
 (PIECE PCONTENTS) of
 PC)))
 
-(PUTPROPS PLOOKS
 MACRO
 ((PC)
-                        (ffetch
 (PIECE PCHARLOOKS) of
 PC)))
-
 (PUTPROPS PCHARLOOKS
 MACRO
 ((PC)
                             (ffetch
 (PIECE PCHARLOOKS) of
 PC)))
 
@@ -1640,18 +1630,8 @@
          WINDOW])
 
 (\TEDIT.OPENTEXTSTREAM.DEFAULTLOOKS

-  [LAMBDA (TEXTOBJ)
                                          (* ; "Edited 22-Mar-2025 21:37 by rmk")


-                                                             (* ; "Edited  8-Feb-2025 22:04 by rmk")


-                                                             (* ; "Edited 29-Dec-2024 20:37 by rmk")


-                                                             (* ; "Edited 20-Dec-2024 11:56 by rmk")


-                                                             (* ; "Edited 16-Dec-2024 13:14 by rmk")


-                                                             (* ; "Edited 21-Nov-2024 14:35 by rmk")


-                                                             (* ; "Edited 29-Aug-2024 09:46 by rmk")


-                                                             (* ; "Edited 31-Jul-2024 12:09 by rmk")


-                                                             (* ; "Edited 29-Apr-2024 11:05 by rmk")


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


-                                                             (* ; "Edited 17-Sep-2023 07:43 by rmk")


-                                                             (* ; "Edited  3-Aug-2023 23:02 by rmk")


+  [LAMBDA (TEXTOBJ)
                                          (* ; "Edited 29-Jul-2025 11:53 by rmk")


+                                                             (* ; "Edited 22-Mar-2025 21:37 by rmk")


                                                              (* ; "Edited 26-Apr-2023 14:29 by rmk")

 
     (* ;; 
@@ -1663,21 +1643,26 @@
 
          (SETQ FONT (OR (GETTEXTPROP
 TEXTOBJ 'FONT)
                         (FONTCREATE DEFAULTFONT)))
-         (SETQ CHARLOOKS (GETTEXTPROP
 TEXTOBJ 'CHARLOOKS))
+
+         (* ;; "LOOKS for backward compatibility and compatibility with documentation")

+
+         [SETQ CHARLOOKS (OR (GETTEXTPROP
 TEXTOBJ 'CHARLOOKS)
+                             (GETTEXTPROP
 TEXTOBJ 'LOOKS]
          (SETQ CHARLOOKS (OR (AND CHARLOOKS (\TEDIT.PARSE.CHARLOOKS.LIST CHARLOOKS NIL TEXTOBJ))
                              (AND (type?
 CHARLOOKS FONT)
                                   FONT)
                              (\TEDIT.CHARLOOKS.FROM.FONT FONT)))
          (SETQ CHARLOOKS (\TEDIT.UNIQUIFY.CHARLOOKS CHARLOOKS TEXTOBJ))
-         (SETQ PARALOOKS (\TEDIT.UNIQUIFY.PARALOOKS (\TEDIT.PARSE.PARALOOKS.LIST
-                                                     (OR (GETTEXTPROP
 TEXTOBJ 'PARALOOKS)
-                                                         (create
 PARALOOKS using
 
-                                                                                TEDIT.DEFAULT.FMTSPEC
-                                                                ))
-                                                     NIL TEXTOBJ)
-                                TEXTOBJ))
          (SETTOBJ TEXTOBJ DEFAULTCHARLOOKS CHARLOOKS)
          (SETTOBJ TEXTOBJ CARETLOOKS CHARLOOKS)
+
+         (* ;; "PARALOOKS")

+
+         (SETQ PARALOOKS (\TEDIT.UNIQUIFY.PARALOOKS (\TEDIT.PARSE.PARALOOKS.LIST (GETTEXTPROP

+                                                                                  TEXTOBJ
+                                                                                  'PARALOOKS)
+                                                           TEDIT.DEFAULT.PARALOOKS)
+                                TEXTOBJ))
          (SETTOBJ TEXTOBJ DEFAULTPARALOOKS PARALOOKS])
 
 (\TEDIT.OPENTEXTFILE

@@ -1709,7 +1694,8 @@
                (ERROR TEXT " does not identify a Tedit document")))])
 
 (\TEDIT.CREATE.TEXTSTREAM

-  [LAMBDA (PROPS)
                                            (* ; "Edited  7-Feb-2025 08:09 by rmk")


+  [LAMBDA (PROPS)
                                            (* ; "Edited 28-Jul-2025 22:56 by rmk")


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


                                                              (* ; "Edited 16-Mar-2024 09:52 by rmk")


                                                              (* ; "Edited 21-Jan-2024 15:16 by rmk")


                                                              (* ; "Edited 17-Sep-2023 00:38 by rmk")


@@ -1717,15 +1703,15 @@
 
     (* ;; "Creates and initializes an empty, windowless textstream")

 
-    (LET (TSTREAM (TEXTOBJ (create
 TEXTOBJ)))
-         (SETQ TSTREAM (create
 TEXTSTREAM
-                              TEXTOBJ _ TEXTOBJ))
-         (SETTOBJ TEXTOBJ STREAMHINT TSTREAM)
-         (\TEDIT.OPENTEXTSTREAM.PROPS
 TEXTOBJ PROPS)
-         (\TEDIT.MAKEPCTB TEXTOBJ)
-         (\TEDIT.INSTALL.PIECE
 TSTREAM (FGETTOBJ TEXTOBJ SUFFIXPIECE)
-                0)
-         TSTREAM])
+    (LET* ((TEXTOBJ (create
 TEXTOBJ))
+           (TSTREAM (create
 TEXTSTREAM
+                           TEXTOBJ _ TEXTOBJ)))
+          (SETTOBJ TEXTOBJ STREAMHINT TSTREAM)
+          (\TEDIT.OPENTEXTSTREAM.PROPS
 TEXTOBJ PROPS)
+          (\TEDIT.MAKEPCTB TEXTOBJ)
+          (\TEDIT.INSTALL.PIECE
 TSTREAM (FGETTOBJ TEXTOBJ SUFFIXPIECE)
+                 0)
+          TSTREAM])
 
 (\TEDIT.REOPEN.STREAM

   [LAMBDA (TSTREAM PIECESTREAM)
                              (* ; "Edited 14-May-2024 18:00 by rmk")


@@ -1766,7 +1752,8 @@
                 NEWSTREAM])
 
 (\TEDIT.TEXTINIT

-  [LAMBDA NIL
                                                (* ; "Edited 15-Apr-2025 23:10 by rmk")


+  [LAMBDA NIL
                                                (* ; "Edited 10-Jul-2025 11:28 by rmk")


+                                                             (* ; "Edited 15-Apr-2025 23:10 by rmk")


                                                              (* ; "Edited  4-Sep-2024 22:05 by rmk")


                                                              (* ; "Edited 22-May-2024 14:53 by rmk")


                                                              (* ; "Edited 19-Mar-2024 18:16 by rmk")


@@ -1817,7 +1804,7 @@
                                IMCOLOR _ (FUNCTION \TEDIT.TEXTCOLOR)))
     (FONTPROFILE.ADDDEVICE 'TEXT 'DISPLAY)
     (ADDTOVAR IMAGESTREAMTYPES
 (TEXT (FONTCREATE \CREATEDISPLAYFONT)
-                                     (FONTSAVAILABLE \SEARCHDISPLAYFONTFILES)
+                                     (FONTSAVAILABLE \SEARCHFONTFILES)
                                      (CREATECHARSET \CREATECHARSET.DISPLAY)))
 
     (* ;; "Maybe more functions later. The INCODE and BACK functions possibly need to count.  If \TEXTBACKFILEPTR takes a count variable, the extra level wouldn't be needed.  But INCCODE wants to go through the BIN opcode")

@@ -1936,7 +1923,9 @@
          (CLOSEF? (GETTOBJ TEXTOBJ TXTFILE])
 
 (\TEDIT.TEXTDSPFONT

-  [LAMBDA (TSTREAM NEWFONT)
                                  (* ; "Edited 17-Mar-2024 11:49 by rmk")


+  [LAMBDA (TSTREAM NEWFONT)
                                  (* ; "Edited 14-Jul-2025 22:57 by rmk")


+                                                             (* ; "Edited  5-Jul-2025 18:55 by rmk")


+                                                             (* ; "Edited 17-Mar-2024 11:49 by rmk")


                                                              (* ; "Edited 15-Oct-2023 17:13 by rmk")


                                                              (* ; "Edited  8-Sep-2022 14:16 by rmk")


                                                              (* ; "Edited 31-May-91 14:02 by jds")

@@ -1946,7 +1935,7 @@
     (LET ((TEXTOBJ (TEXTOBJ TSTREAM)))
          (PROG1 (fetch
 (CHARLOOKS CLFONT) of
 (FGETTOBJ TEXTOBJ CARETLOOKS))
              (CL:WHEN NEWFONT
-                 (TEDIT.CARETLOOKS TSTREAM (\GETFONTDESC NEWFONT 'DISPLAY))
+                 (TEDIT.CARETLOOKS TSTREAM (FONTCREATE NEWFONT NIL NIL NIL 'DISPLAY))
                  (for
 PANE inpanes
 (PROGN TEXTOBJ) do
 (DSPFONT NEWFONT PANE))))])
 
 (\TEDIT.TEXTEOFP

@@ -2337,7 +2326,8 @@
              TSTREAM))])
 
 (\TEDIT.PIECE.RPLCHARCODE

-  [LAMBDA (TEXTOBJ PC OFFSET NEWCHARCODE NEWCHARLOOKS)
       (* ; "Edited 24-Apr-2025 16:30 by rmk")


+  [LAMBDA (TEXTOBJ PC OFFSET NEWCHARCODE NEWCHARLOOKS)
       (* ; "Edited 28-Jul-2025 23:38 by rmk")


+                                                             (* ; "Edited 24-Apr-2025 16:30 by rmk")


                                                              (* ; "Edited 20-Apr-2025 13:25 by rmk")


                                                              (* ; "Edited 28-Mar-2025 10:04 by rmk")

 
@@ -2353,7 +2343,7 @@
                   (MEMB (PTYPE PC)
                         STRING.PTYPES)
                   (OR (NULL NEWCHARLOOKS)
-                      (EQ NEWCHARLOOKS (PLOOKS PC)))
+                      (EQ NEWCHARLOOKS (PCHARLOOKS PC)))
                   (NEQ PC (FGETTOBJ TEXTOBJ SUFFIXPIECE))
                   (NOT PARALAST))
              then
 
@@ -2375,7 +2365,7 @@
            elseif
 [AND (IMAGEOBJP NEWCHARCODE)
                        (EQ OBJECT.PTYPE (PTYPE PC))
                        (OR (NULL NEWCHARLOOKS)
-                           (EQ NEWCHARLOOKS (PLOOKS PC]
+                           (EQ NEWCHARLOOKS (PCHARLOOKS PC]
              then
 (SETQ OLDCHAR (POBJ PC))                   (* ; "We know PLEN is 1")

                   (FSETPC PC PCONTENTS NEWCHARCODE)
            else
 
@@ -2419,11 +2409,11 @@
                               (FSETPC PC PCHARSET 0)))
                 (FSETPC PC PFPOS NIL)
                 (CL:WHEN NEWCHARLOOKS
-                    (FSETPC PC PLOOKS (CL:IF (FONTP NEWCHARLOOKS)
-                                          (\TEDIT.UNIQUIFY.CHARLOOKS (\TEDIT.CHARLOOKS.FROM.FONT
-                                                                      NEWCHARLOOKS)
-                                                 TEXTOBJ)
-                                          NEWCHARLOOKS)))]
+                    (FSETPC PC PCHARLOOKS (CL:IF (FONTP NEWCHARLOOKS)
+                                              (\TEDIT.UNIQUIFY.CHARLOOKS (\TEDIT.CHARLOOKS.FROM.FONT
+                                                                          NEWCHARLOOKS)
+                                                     TEXTOBJ)
+                                              NEWCHARLOOKS)))]
          (CL:WHEN PARALAST (FSETPC PC PPARALAST T))
          OLDCHAR])
 
@@ -2520,7 +2510,8 @@
              T)])
 
 (\TEDIT.INSERTCH

-  [LAMBDA (CH CH# TEXTOBJ PARALAST)
                          (* ; "Edited 26-Mar-2025 00:29 by rmk")


+  [LAMBDA (CH CH# TEXTOBJ PARALAST)
                          (* ; "Edited 26-Jul-2025 21:13 by rmk")


+                                                             (* ; "Edited 26-Mar-2025 00:29 by rmk")


                                                              (* ; "Edited 22-Nov-2024 13:48 by rmk")


                                                              (* ; "Edited 22-Sep-2024 12:32 by rmk")


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


@@ -2603,7 +2594,7 @@
                                      PCONTENTS _ INSERTION
                                      PLEN _ ILEN
                                      PCHARLOOKS _ (FGETTOBJ TEXTOBJ CARETLOOKS)
-                                     PPARALOOKS _ (PPARALOOKS (OR PREVPC INSERTPC))
+                                     PPARALOOKS _ (PPARALOOKS (OR INSERTPC PREVPC))
                                      PNEW _ T))
                  (SELECTC INSERTPTYPE
                      (THINSTRING.PTYPE 
@@ -2967,7 +2958,8 @@
          OLDITEMS])
 
 (\TEDIT.TEXTPROP

-  [LAMBDA (TEXTOBJ PROP SETNEWVALUE NEWVALUE)
                (* ; "Edited 16-Feb-2025 23:27 by rmk")


+  [LAMBDA (TEXTOBJ PROP SETNEWVALUE NEWVALUE)
                (* ; "Edited 17-Jul-2025 00:19 by rmk")


+                                                             (* ; "Edited 16-Feb-2025 23:27 by rmk")


                                                              (* ; "Edited 15-Feb-2025 14:02 by rmk")


                                                              (* ; "Edited 22-Dec-2024 00:23 by rmk")


                                                              (* ; "Edited 23-Nov-2024 09:47 by rmk")


@@ -2998,9 +2990,8 @@
                      (FSETTOBJ TEXTOBJ TXTREADONLY NEWVALUE)
                      (FSETTOBJ TEXTOBJ TXTREADONLYQUIET (EQ 'QUIET NEWVALUE))
                      (\TEDIT.HISTORY.PROP TEXTOBJ T 'OFF))))
-        ((BEING-EDITED ACTIVE) 
-             (PROG1 (FGETTOBJ TEXTOBJ TXTEDITING)
-                 (CL:IF SETNEWVALUE (FSETTOBJ TEXTOBJ TXTEDITING NEWVALUE))))
+        (ACTIVE (PROG1 (FGETTOBJ TEXTOBJ EDITOPACTIVE)
+                    (CL:IF SETNEWVALUE (FSETTOBJ TEXTOBJ EDITOPACTIVE NEWVALUE))))
         (READTABLE (PROG1 (FGETTOBJ TEXTOBJ TXTRTBL)
                        (CL:IF SETNEWVALUE (FSETTOBJ TEXTOBJ TXTRTBL NEWVALUE))))
         (TERMTABLE (PROG1 (FSETTOBJ TEXTOBJ TXTTERMSA (fetch
 (TERMTABLEP TERMSA) of
 NEWVALUE))
@@ -3132,34 +3123,34 @@
 (ADDTOVAR LAMA
 TEXTPROP)
 )
 (DECLARE%: DONTCOPY
-  (FILEMAP (NIL (37559 68375 (\TEDIT.TEXTBIN 37569 . 48319) (\TEDIT.TEXTPEEKBIN 48321 . 53871) (
-\TEDIT.TEXTBACKFILEPTR 53873 . 59546) (\TEDIT.TEXTBOUT 59548 . 64165) (\TEDIT.INSTALL.FILEBUFFER 64167
- . 68373)) (69273 73564 (\TEDIT.TEXTOUTCHARFN 69283 . 70839) (\TEDIT.TEXTINCCODEFN 70841 . 71580) (
-\TEDIT.TEXTBACKCCODEFN 71582 . 72174) (\TEDIT.TEXTFORMATBYTESTREAM 72176 . 73013) (
-\TEDIT.TEXTFORMATBYTESTRING 73015 . 73562)) (73611 85252 (OPENTEXTSTREAM 73621 . 80573) (
-COPYTEXTSTREAM 80575 . 84475) (TEDIT.STREAMCHANGEDP 84477 . 84779) (TXTFILE 84781 . 85250)) (85253 
-116062 (\TEDIT.REOPENTEXTSTREAM 85263 . 86615) (\TEDIT.OPENTEXTSTREAM.PIECES 86617 . 91551) (
-\TEDIT.OPENTEXTSTREAM.PROPS 91553 . 92655) (\TEDIT.OPENTEXTSTREAM.SETUP.SEL 92657 . 97898) (
-\TEDIT.OPENTEXTSTREAM.WINDOW 97900 . 100691) (\TEDIT.OPENTEXTSTREAM.DEFAULTLOOKS 100693 . 103663) (
-\TEDIT.OPENTEXTFILE 103665 . 105378) (\TEDIT.CREATE.TEXTSTREAM 105380 . 106425) (\TEDIT.REOPEN.STREAM 
-106427 . 108763) (\TEDIT.TEXTINIT 108765 . 116060)) (116100 117288 (\TEDIT.TTYBOUT 116110 . 117286)) (
-117406 137175 (\TEDIT.TEXTCLOSEF 117416 . 118740) (\TEDIT.TEXTDSPFONT 118742 . 119712) (
-\TEDIT.TEXTEOFP 119714 . 121469) (\TEDIT.TEXTGETEOFPTR 121471 . 121794) (\TEDIT.TEXTSETEOFPTR 121796
- . 123083) (\TEDIT.TEXTGETFILEPTR 123085 . 125920) (\TEDIT.TEXTSETFILEINFO 125922 . 126430) (
-\TEDIT.TEXTOPENF 126432 . 127363) (\TEDIT.TEXTSETEOF 127365 . 127981) (\TEDIT.TEXTSETFILEPTR 127983 . 
-130093) (\TEDIT.TEXTDSPXPOSITION 130095 . 131112) (\TEDIT.TEXTDSPYPOSITION 131114 . 131855) (
-\TEDIT.TEXTLEFTMARGIN 131857 . 132448) (\TEDIT.TEXTCOLOR 132450 . 133033) (\TEDIT.TEXTRIGHTMARGIN 
-133035 . 136324) (\TEDIT.TEXTDSPCHARWIDTH 136326 . 136630) (\TEDIT.TEXTDSPSTRINGWIDTH 136632 . 136938)
- (\TEDIT.TEXTDSPLINEFEED 136940 . 137173)) (137213 149689 (\TEDIT.NTHCHARCODE 137223 . 138674) (
-\TEDIT.PIECE.NTHCHARCODE 138676 . 142586) (\TEDIT.RPLCHARCODE 142588 . 144046) (
-\TEDIT.PIECE.RPLCHARCODE 144048 . 149334) (\TEDIT.NTHCHARLOOKS 149336 . 149687)) (150736 171721 (
-\TEDIT.DELETE.SELPIECES 150746 . 154371) (\TEDIT.INSERTCH 154373 . 162303) (\TEDIT.INSERTCH.HISTORY 
-162305 . 165769) (\TEDIT.INSERTEOL 165771 . 167596) (\TEDIT.INSERTCH.INSERTION 167598 . 170435) (
-\TEDIT.INSERTCH.EXTEND 170437 . 171719)) (171722 173226 (\TEDIT.NEXTCHANGEABLE.CHNO 171732 . 172447) (
-\TEDIT.LASTCHANGEABLE.CHNO 172449 . 173224)) (173227 174931 (\SETUPGETCH 173237 . 174929)) (174989 
-179447 (\TEDIT.INSTALL.PIECE 174999 . 179445)) (179485 188499 (TEXTPROP 179495 . 179842) (GETTEXTPROP 
-179844 . 180088) (PUTTEXTPROP 180090 . 180347) (GETTEXTPROPS 180349 . 180793) (PUTTEXTPROPS 180795 . 
-181699) (TEXTPROP.ADD 181701 . 181964) (\TEDIT.TEXTPROP 181966 . 188497)) (188500 190570 (
-\TEDIT.TEXTOBJ.PROPNAMES 188510 . 189462) (\TEDIT.TEXTOBJ.PROPFETCHFN 189464 . 189980) (
-\TEDIT.TEXTOBJ.PROPSTOREFN 189982 . 190568)))))
+  (FILEMAP (NIL (36908 67724 (\TEDIT.TEXTBIN 36918 . 47668) (\TEDIT.TEXTPEEKBIN 47670 . 53220) (
+\TEDIT.TEXTBACKFILEPTR 53222 . 58895) (\TEDIT.TEXTBOUT 58897 . 63514) (\TEDIT.INSTALL.FILEBUFFER 63516
+ . 67722)) (68622 72913 (\TEDIT.TEXTOUTCHARFN 68632 . 70188) (\TEDIT.TEXTINCCODEFN 70190 . 70929) (
+\TEDIT.TEXTBACKCCODEFN 70931 . 71523) (\TEDIT.TEXTFORMATBYTESTREAM 71525 . 72362) (
+\TEDIT.TEXTFORMATBYTESTRING 72364 . 72911)) (72960 84601 (OPENTEXTSTREAM 72970 . 79922) (
+COPYTEXTSTREAM 79924 . 83824) (TEDIT.STREAMCHANGEDP 83826 . 84128) (TXTFILE 84130 . 84599)) (84602 
+114584 (\TEDIT.REOPENTEXTSTREAM 84612 . 85964) (\TEDIT.OPENTEXTSTREAM.PIECES 85966 . 90900) (
+\TEDIT.OPENTEXTSTREAM.PROPS 90902 . 92004) (\TEDIT.OPENTEXTSTREAM.SETUP.SEL 92006 . 97247) (
+\TEDIT.OPENTEXTSTREAM.WINDOW 97249 . 100040) (\TEDIT.OPENTEXTSTREAM.DEFAULTLOOKS 100042 . 101981) (
+\TEDIT.OPENTEXTFILE 101983 . 103696) (\TEDIT.CREATE.TEXTSTREAM 103698 . 104845) (\TEDIT.REOPEN.STREAM 
+104847 . 107183) (\TEDIT.TEXTINIT 107185 . 114582)) (114622 115810 (\TEDIT.TTYBOUT 114632 . 115808)) (
+115928 135925 (\TEDIT.TEXTCLOSEF 115938 . 117262) (\TEDIT.TEXTDSPFONT 117264 . 118462) (
+\TEDIT.TEXTEOFP 118464 . 120219) (\TEDIT.TEXTGETEOFPTR 120221 . 120544) (\TEDIT.TEXTSETEOFPTR 120546
+ . 121833) (\TEDIT.TEXTGETFILEPTR 121835 . 124670) (\TEDIT.TEXTSETFILEINFO 124672 . 125180) (
+\TEDIT.TEXTOPENF 125182 . 126113) (\TEDIT.TEXTSETEOF 126115 . 126731) (\TEDIT.TEXTSETFILEPTR 126733 . 
+128843) (\TEDIT.TEXTDSPXPOSITION 128845 . 129862) (\TEDIT.TEXTDSPYPOSITION 129864 . 130605) (
+\TEDIT.TEXTLEFTMARGIN 130607 . 131198) (\TEDIT.TEXTCOLOR 131200 . 131783) (\TEDIT.TEXTRIGHTMARGIN 
+131785 . 135074) (\TEDIT.TEXTDSPCHARWIDTH 135076 . 135380) (\TEDIT.TEXTDSPSTRINGWIDTH 135382 . 135688)
+ (\TEDIT.TEXTDSPLINEFEED 135690 . 135923)) (135963 148576 (\TEDIT.NTHCHARCODE 135973 . 137424) (
+\TEDIT.PIECE.NTHCHARCODE 137426 . 141336) (\TEDIT.RPLCHARCODE 141338 . 142796) (
+\TEDIT.PIECE.RPLCHARCODE 142798 . 148221) (\TEDIT.NTHCHARLOOKS 148223 . 148574)) (149623 170717 (
+\TEDIT.DELETE.SELPIECES 149633 . 153258) (\TEDIT.INSERTCH 153260 . 161299) (\TEDIT.INSERTCH.HISTORY 
+161301 . 164765) (\TEDIT.INSERTEOL 164767 . 166592) (\TEDIT.INSERTCH.INSERTION 166594 . 169431) (
+\TEDIT.INSERTCH.EXTEND 169433 . 170715)) (170718 172222 (\TEDIT.NEXTCHANGEABLE.CHNO 170728 . 171443) (
+\TEDIT.LASTCHANGEABLE.CHNO 171445 . 172220)) (172223 173927 (\SETUPGETCH 172233 . 173925)) (173985 
+178443 (\TEDIT.INSTALL.PIECE 173995 . 178441)) (178481 187582 (TEXTPROP 178491 . 178838) (GETTEXTPROP 
+178840 . 179084) (PUTTEXTPROP 179086 . 179343) (GETTEXTPROPS 179345 . 179789) (PUTTEXTPROPS 179791 . 
+180695) (TEXTPROP.ADD 180697 . 180960) (\TEDIT.TEXTPROP 180962 . 187580)) (187583 189653 (
+\TEDIT.TEXTOBJ.PROPNAMES 187593 . 188545) (\TEDIT.TEXTOBJ.PROPFETCHFN 188547 . 189063) (
+\TEDIT.TEXTOBJ.PROPSTOREFN 189065 . 189651)))))
 STOP

library/tedit/TEDIT-TFBRAVO

@@ -1,13 +1,13 @@
 (DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
 
-
(FILECREATED "10-May-2025 12:53:24" {WMEDLEY}<library>TEDIT>TEDIT-TFBRAVO.;183
 97073  
+
(FILECREATED "28-Jul-2025 23:34:14" 
+{DSK}<Users>kaplan>Local>medley3.5>working-medley>library>tedit>TEDIT-TFBRAVO.;185
 97353  
 
       :EDIT-BY rmk
 
-      :CHANGES-TO (FNS \TFBRAVO.GET.USER.CM TEDITFROMBRAVO \TFBRAVO.USER.CM.LOOKS)
-                  (VARS TEDIT-TFBRAVOCOMS)
+      :CHANGES-TO (FNS \TFBRAVO.INSERT.RUN \TFBRAVO.INIT.PARALOOKS)
 
-      :PREVIOUS-DATE " 9-May-2025 09:51:51" {WMEDLEY}<library>TEDIT>TEDIT-TFBRAVO.;178)
+      :PREVIOUS-DATE "10-May-2025 12:53:24" {WMEDLEY}<library>TEDIT>TEDIT-TFBRAVO.;183)
 
 
 (PRETTYCOMPRINT TEDIT-TFBRAVOCOMS)
@@ -419,7 +419,8 @@
               (GO LLP)))])
 
 (\TFBRAVO.INIT.PARALOOKS

-  [LAMBDA (ALIST)
                                            (* ; "Edited  8-Feb-2025 22:09 by rmk")


+  [LAMBDA (ALIST)
                                            (* ; "Edited 28-Jul-2025 23:12 by rmk")


+                                                             (* ; "Edited  8-Feb-2025 22:09 by rmk")


                                                              (* ; "Edited  4-Aug-2024 22:17 by rmk")


                                                              (* ; "Edited 28-Jul-2024 21:36 by rmk")


                                                              (* ; "Edited 13-Aug-2023 11:27 by rmk")


@@ -429,7 +430,7 @@
 
     (* ;; "creates the default paragraph looks from the USER.CM.  The numeric values are Bravo defaults as specfied in the Bravo documentation. This assumes that all mica values in the USER.CM have already been converted to points.  ")

 
-    (LET ((INITPARALOOKS (create
 PARALOOKS using
 TEDIT.DEFAULT.FMTSPEC)))
+    (LET ((INITPARALOOKS (\TEDIT.PARSE.PARALOOKS.LIST TEDIT.DEFAULT.PARALOOKS)))
 
          (* ;; "Bravo User Manual says that default tab is 36, the Bravo file format document says 60.  I'm going with 36.")

 
@@ -1010,7 +1011,8 @@
                                                   (\TFBRAVO.INSERT.RUN
 RUN BSTREAM PARALOOKS TEXTOBJ])
 
 (\TFBRAVO.INSERT.RUN

-  [LAMBDA (RUN BSTREAM PARALOOKS TEXTOBJ)
                    (* ; "Edited  8-Feb-2025 23:08 by rmk")


+  [LAMBDA (RUN BSTREAM PARALOOKS TEXTOBJ)
                    (* ; "Edited 28-Jul-2025 23:33 by rmk")


+                                                             (* ; "Edited  8-Feb-2025 23:08 by rmk")


                                                              (* ; "Edited 17-Mar-2024 12:41 by rmk")


                                                              (* ; "Edited 16-Jan-2024 18:28 by rmk")


                                                              (* ; "Edited 29-Dec-2023 11:50 by rmk")


@@ -1030,8 +1032,9 @@
               FATP PC)
              (SETQ PC (create
 PIECE
                              PLEN _ NCHARS
-                             PLOOKS _ (\TEDIT.UNIQUIFY.CHARLOOKS (fetch
 (RUN RUNLOOKS) of
 RUN)
-                                             TEXTOBJ)
+                             PCHARLOOKS _ (\TEDIT.UNIQUIFY.CHARLOOKS (fetch
 (RUN RUNLOOKS)
+                                                                        of
 RUN)
+                                                 TEXTOBJ)
                              PPARALOOKS _ (\TEDIT.UNIQUIFY.PARALOOKS PARALOOKS TEXTOBJ)
                              PPARALAST _ (fetch
 (RUN RUNLAST) of
 RUN)))
              (if
 (STRINGP RUNSTART)
@@ -1552,18 +1555,18 @@
 (AND NIL (\TEDIT.NAMEDTAB.INIT
))
 )
 (DECLARE%: DONTCOPY
-  (FILEMAP (NIL (7682 14673 (TEDIT.BRAVOFILE? 7692 . 9422) (TEDITFROMBRAVO 9424 . 14671)) (14784 31092 (
-\TFBRAVO.GET.USER.CM 14794 . 17974) (\TFBRAVO.USER.CM.LOOKS 17976 . 19469) (\TFBRAVO.READ.USER.CM 
-19471 . 24094) (\TFBRAVO.INIT.PARALOOKS 24096 . 26205) (\TFBRAVO.INIT.PAGEFORMAT 26207 . 27087) (
-\TFBRAVO.GETPARAMS 27089 . 29943) (\TFBRAVO.FIND.LAST.TRAILER 29945 . 31090)) (31134 51832 (
-\TFBRAVO.PARSE.PARA 31144 . 35071) (\TFBRAVO.READ.PARALOOKS 35073 . 41963) (\TFBRAVO.CREATE.RUNS 41965
- . 43353) (\TFBRAVO.READ.CHARLOOKS 43355 . 48384) (\TFBRAVO.FONT.FROM.CHARLOOKS 48386 . 49933) (
-\TFBRAVO.READNUM? 49935 . 51830)) (51869 62910 (\TFBRAVO.HANDLE.HEADING 51879 . 54606) (
-\TFBRAVO.PARSE.PROFILE.PARA 54608 . 62908)) (62953 85098 (\TFBRAVO.INSERT.PARA 62963 . 63804) (
-\TFBRAVO.INSERT.RUN 63806 . 67108) (\TFBRAVO.SPLIT.PARA 67110 . 74534) (\TFBRAVO.RUN.TABSPEC 74536 . 
-79403) (\TFBRAVO.INSTALL.PAGEFORMAT 79405 . 85096)) (85099 89242 (\TFBRAVO.ASSERT 85109 . 85639) (
-\TEST.CHARACTER.LOOKS 85641 . 87527) (\TEST.PARAGRAPH.LOOKS 87529 . 89240)) (90252 96907 (
-\TFBRAVO.ADD.NAMEDTAB 90262 . 93865) (\TFBRAVO.COPY.NAMEDTAB 93867 . 94315) (\TFBRAVO.PUT.NAMEDTAB 
-94317 . 94597) (\TFBRAVO.GET.NAMEDTAB 94599 . 94976) (\NAMEDTABNYET 94978 . 95138) (\NAMEDTABSIZE 
-95140 . 95655) (\NAMEDTABPREPRINT 95657 . 95855) (\TEDIT.NAMEDTAB.INIT 95857 . 96905)))))
+  (FILEMAP (NIL (7665 14656 (TEDIT.BRAVOFILE? 7675 . 9405) (TEDITFROMBRAVO 9407 . 14654)) (14767 31183 (
+\TFBRAVO.GET.USER.CM 14777 . 17957) (\TFBRAVO.USER.CM.LOOKS 17959 . 19452) (\TFBRAVO.READ.USER.CM 
+19454 . 24077) (\TFBRAVO.INIT.PARALOOKS 24079 . 26296) (\TFBRAVO.INIT.PAGEFORMAT 26298 . 27178) (
+\TFBRAVO.GETPARAMS 27180 . 30034) (\TFBRAVO.FIND.LAST.TRAILER 30036 . 31181)) (31225 51923 (
+\TFBRAVO.PARSE.PARA 31235 . 35162) (\TFBRAVO.READ.PARALOOKS 35164 . 42054) (\TFBRAVO.CREATE.RUNS 42056
+ . 43444) (\TFBRAVO.READ.CHARLOOKS 43446 . 48475) (\TFBRAVO.FONT.FROM.CHARLOOKS 48477 . 50024) (
+\TFBRAVO.READNUM? 50026 . 51921)) (51960 63001 (\TFBRAVO.HANDLE.HEADING 51970 . 54697) (
+\TFBRAVO.PARSE.PROFILE.PARA 54699 . 62999)) (63044 85378 (\TFBRAVO.INSERT.PARA 63054 . 63895) (
+\TFBRAVO.INSERT.RUN 63897 . 67388) (\TFBRAVO.SPLIT.PARA 67390 . 74814) (\TFBRAVO.RUN.TABSPEC 74816 . 
+79683) (\TFBRAVO.INSTALL.PAGEFORMAT 79685 . 85376)) (85379 89522 (\TFBRAVO.ASSERT 85389 . 85919) (
+\TEST.CHARACTER.LOOKS 85921 . 87807) (\TEST.PARAGRAPH.LOOKS 87809 . 89520)) (90532 97187 (
+\TFBRAVO.ADD.NAMEDTAB 90542 . 94145) (\TFBRAVO.COPY.NAMEDTAB 94147 . 94595) (\TFBRAVO.PUT.NAMEDTAB 
+94597 . 94877) (\TFBRAVO.GET.NAMEDTAB 94879 . 95256) (\NAMEDTABNYET 95258 . 95418) (\NAMEDTABSIZE 
+95420 . 95935) (\NAMEDTABPREPRINT 95937 . 96135) (\TEDIT.NAMEDTAB.INIT 96137 . 97185)))))
 STOP

library/tedit/TEDIT-WINDOW

@@ -1,12 +1,12 @@
 (DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
 
-
(FILECREATED "21-Jul-2025 11:55:26" {WMEDLEY}<library>TEDIT>TEDIT-WINDOW.;861
 229641 
+
(FILECREATED "26-Jul-2025 15:45:59" {WMEDLEY}<library>TEDIT>TEDIT-WINDOW.;862
 229373 
 
       :EDIT-BY rmk
 
-      :CHANGES-TO (FNS \TEDIT.WINDOW.CREATE)
+      :CHANGES-TO (FNS \TEDIT.SET.WINDOW.EXTENT)
 
-      :PREVIOUS-DATE "30-May-2025 12:54:56" {WMEDLEY}<library>TEDIT>TEDIT-WINDOW.;860)
+      :PREVIOUS-DATE "21-Jul-2025 11:55:26" {WMEDLEY}<library>TEDIT>TEDIT-WINDOW.;861)
 
 
 (PRETTYCOMPRINT TEDIT-WINDOWCOMS)
@@ -937,7 +937,8 @@
                 (RETURN MOVINGPOINT])
 
 (\TEDIT.SET.WINDOW.EXTENT

-  [LAMBDA (TEXTOBJ PANE)
                                     (* ; "Edited  1-Dec-2024 11:28 by rmk")


+  [LAMBDA (TEXTOBJ PANE)
                                     (* ; "Edited 26-Jul-2025 15:45 by rmk")


+                                                             (* ; "Edited  1-Dec-2024 11:28 by rmk")


                                                              (* ; "Edited 29-Nov-2024 10:59 by rmk")


                                                              (* ; "Edited 17-Nov-2024 18:59 by rmk")


                                                              (* ; "Edited 28-Jun-2024 15:11 by rmk")


@@ -960,55 +961,44 @@
             (LET ((TEXTLEN (FGETTOBJ TEXTOBJ TEXTLEN))
                   (PHEIGHT (PANEHEIGHT PANE))
                   (PBOTTOM (PANEBOTTOM PANE))
-                  FIRSTLINE LASTLINE TOPCHAR BOTCHAR EXTHEIGHT EXTBOT YBOT)
-
-                 (* ;; "First visible line")

-
-                 (SETQ FIRSTLINE (find
 L inlines
 (PANEPREFIX PANE)
-                                    suchthat
 (ILESSP (FGETLD L YBOT)
-                                                    PHEIGHT)))
-
-                 (* ;; "Last visible line")

-
-                 (for
 L inlines
 FIRSTLINE while
 (IGEQ (FGETLD L YBOT)
-                                                      PBOTTOM) do
 (SETQ LASTLINE L))
+                  (FIRSTLINE (PANETOPLINE PANE))
+                  (LASTLINE (PANEBOTTOMLINE PANE))
+                  TOPCHAR BOTCHAR EXTHEIGHT EXTBOT YBOT)
 
                  (* ;; "Start of first visible line")

 
                  (SETQ TOPCHAR (CL:IF FIRSTLINE
                                    (FGETLD FIRSTLINE LCHAR1)
                                    TEXTLEN))
-                 (COND
-                    (LASTLINE 
+                 (if
 LASTLINE
+                     then
 
+                          (* ;; "There IS a last line on the screen.  Grab its last character as the bottom character on the screen, and set the lowest-Y position to the bottom of that line")

 
-                           (* ;; "There IS a last line on the screen.  Grab its last character as the bottom character on the screen, and set the lowest-Y position to the bottom of that line")

+                          (SETQ BOTCHAR (IMIN TEXTLEN (FGETLD LASTLINE LCHARLAST)))
+                          (SETQ YBOT (FGETLD LASTLINE YBOT))
+                   else
 
+                        (* ;; "Everything is off the top of the screen.  Bottom character is also the last char in the document, and the lowest Y we encountered is the top of the edit window.")

 
-                           (SETQ BOTCHAR (IMIN TEXTLEN (FGETLD LASTLINE LCHARLAST)))
-                           (SETQ YBOT (FGETLD LASTLINE YBOT)))
-                    (T 
-                       (* ;; "Everything is off the top of the screen.  Bottom character is also the last char in the document, and the lowest Y we encountered is the top of the edit window.")

+                        (SETQ BOTCHAR TEXTLEN)
+                        (SETQ YBOT PHEIGHT))
+                 [if
 (AND (IEQP BOTCHAR TEXTLEN)
+                          (IEQP TOPCHAR TEXTLEN))
+                     then
 (SETQ EXTBOT (SUB1 YBOT))          (* ; "At the bottom of the document")

+                          (SETQ EXTHEIGHT PHEIGHT)
+                   else
 
+                        (* ;; "Otherwise, set the bottom in proportion to what is left below the bottom of the screen, and the extent height in proportion to how much text appears in the window")

 
-                       (SETQ BOTCHAR TEXTLEN)
-                       (SETQ YBOT PHEIGHT)))
-                 [COND
-                    ((AND (IEQP BOTCHAR TEXTLEN)
-                          (IEQP TOPCHAR TEXTLEN))            (* ; "At the bottom of the document")

-                     (SETQ EXTBOT (SUB1 YBOT))
-                     (SETQ EXTHEIGHT PHEIGHT))
-                    (T 
-                       (* ;; "Otherwise, set the bottom in proportion to what is left below the bottom of the screen, and the extent height in proportion to how much text appears in the window")

-
-                       [SETQ EXTHEIGHT (FIXR (FQUOTIENT (ITIMES (IDIFFERENCE PHEIGHT YBOT)
-                                                               TEXTLEN)
-                                                    (IMAX (IDIFFERENCE BOTCHAR TOPCHAR)
-                                                          1]
-                       (SETQ EXTBOT (IDIFFERENCE YBOT (FIXR (FQUOTIENT (ITIMES (IDIFFERENCE PHEIGHT 
-                                                                                      YBOT)
-                                                                              (IDIFFERENCE TEXTLEN 
-                                                                                     BOTCHAR))
-                                                                   (IMAX (IDIFFERENCE BOTCHAR TOPCHAR
-                                                                                )
-                                                                         1]
+                        [SETQ EXTHEIGHT (FIXR (FQUOTIENT (ITIMES (IDIFFERENCE PHEIGHT YBOT)
+                                                                TEXTLEN)
+                                                     (IMAX (IDIFFERENCE BOTCHAR TOPCHAR)
+                                                           1]
+                        (SETQ EXTBOT (IDIFFERENCE YBOT (FIXR (FQUOTIENT (ITIMES (IDIFFERENCE PHEIGHT
+                                                                                       YBOT)
+                                                                               (IDIFFERENCE TEXTLEN 
+                                                                                      BOTCHAR))
+                                                                    (IMAX (IDIFFERENCE BOTCHAR 
+                                                                                 TOPCHAR)
+                                                                          1]
                  (WINDOWPROP PANE 'EXTENT (create
 REGION
                                                  BOTTOM _ EXTBOT
                                                  HEIGHT _ (IMAX 1 EXTHEIGHT)
@@ -3629,36 +3619,36 @@
 (RPAQ? TEDIT.TITLED.ICON.TEMPLATE
 (create TITLEDICON ICON _ TEDITICON MASK _ TEDITMASK TITLEREG _ 
                                          TEDIT.ICON.TITLE.REGION))
 (DECLARE%: DONTCOPY
-  (FILEMAP (NIL (17100 17996 (TEDIT.DEFER.UPDATES 17110 . 17994)) (17997 43942 (\TEDIT.WINDOW.CREATE 
-18007 . 25337) (\TEDIT.WINDOW.GETREGION 25339 . 28829) (\TEDIT.WINDOW.SETUP 28831 . 33161) (
-\TEDIT.MINIMAL.WINDOW.SETUP 33163 . 40574) (\TEDIT.CLEARPANE 40576 . 41293) (\TEDIT.FILL.PANES 41295
- . 43940)) (43943 67916 (\TEDIT.CURSORMOVEDFN 43953 . 49563) (\TEDIT.CURSOROUTFN 49565 . 50253) (
-\TEDIT.ACTIVE.WINDOWP 50255 . 51325) (\TEDIT.EXPANDFN 51327 . 51890) (\TEDIT.MAINW 51892 . 53172) (
-\TEDIT.MAINSTREAM 53174 . 53508) (\TEDIT.PRIMARYPANE 53510 . 54280) (\TEDIT.PANELIST 54282 . 54778) (
-\TEDIT.NEWREGIONFN 54780 . 57296) (\TEDIT.SET.WINDOW.EXTENT 57298 . 62552) (\TEDIT.SHRINK.ICONCREATE 
-62554 . 65287) (\TEDIT.SHRINKFN 65289 . 65698) (\TEDIT.PANEREGION 65700 . 67914)) (67948 100994 (
-\TEDIT.BUTTONEVENTFN 67958 . 80931) (\TEDIT.BUTTONEVENTFN.DOOPERATION 80933 . 88196) (
-\TEDIT.BUTTONEVENTFN.GETOPERATION 88198 . 90040) (\TEDIT.BUTTONEVENTFN.CURSEL.INIT 90042 . 93712) (
-\TEDIT.BUTTONEVENTFN.INACTIVE 93714 . 96144) (\TEDIT.BUTTONEVENTFN.INTITLE 96146 . 97981) (
-\TEDIT.COPYINSERTFN 97983 . 99115) (\TEDIT.FOREIGN.COPY 99117 . 100992)) (100995 118237 (
-\TEDIT.PANE.SPLIT 101005 . 104953) (\TEDIT.SPLITW 104955 . 112693) (\TEDIT.UNSPLITW 112695 . 116894) (
-\TEDIT.LINKPANES 116896 . 117659) (\TEDIT.UNLINKPANE 117661 . 118235)) (119671 120562 (TEDITWINDOWP 
-119681 . 120560)) (120599 123702 (TEDIT.GETINPUT 120609 . 123052) (\TEDIT.MAKEFILENAME 123054 . 123700
-)) (123751 131378 (TEDIT.PROMPTWINDOW 123761 . 124075) (TEDIT.PROMPTPRINT 124077 . 126704) (
-TEDIT.PROMPTCLEAR 126706 . 128425) (TEDIT.PROMPTFLASH 128427 . 129685) (\TEDIT.PROMPT.PAGEFULLFN 
-129687 . 131376)) (131616 142020 (\TEDIT.FILENAME 131626 . 132398) (\TEDIT.DEFAULT.TITLE 132400 . 
-134779) (\TEDIT.WINDOW.TITLE 134781 . 136950) (\TEDIT.LIKELY.FILENAME 136952 . 139502) (
-\TEDIT.UPDATE.TITLE 139504 . 142018)) (142063 154547 (TEDIT.DEACTIVATE.WINDOW 142073 . 147646) (
-\TEDIT.RESHAPEFN 147648 . 149733) (\TEDIT.REPAINTFN 149735 . 149959) (\TEDIT.CLOSESPLITS 149961 . 
-152406) (\TEDIT.CLOSEPANE 152408 . 154545)) (154548 197347 (\TEDIT.SCROLLFN 154558 . 156789) (
-\TEDIT.SCROLLCH.TOP 156791 . 158902) (\TEDIT.SCROLLCH.BOTTOM 158904 . 163234) (\TEDIT.SCROLLUP 163236
- . 168962) (\TEDIT.TOPLINE.YTOP 168964 . 170633) (\TEDIT.SCROLLDOWN 170635 . 177674) (
-\TEDIT.SCROLL.CARET 177676 . 180514) (\TEDIT.VISIBLECARETP 180516 . 182810) (\TEDIT.VISIBLECHARP 
-182812 . 183903) (\TEDIT.BITMAPLINES 183905 . 187825) (\TEDIT.SETPANE.TOPLINE 187827 . 188439) (
-\TEDIT.SHIFTLINES 188441 . 197345)) (197348 208217 (\TEDIT.ONSCREEN? 197358 . 201909) (
-\TEDIT.ONSCREEN.REGION 201911 . 205562) (\TEDIT.AFTERMOVEFN 205564 . 206461) (OFFSCREENP 206463 . 
-208215)) (208259 211073 (\TEDIT.PROCIDLEFN 208269 . 209929) (\TEDIT.PROCENTRYFN 209931 . 210376) (
-\TEDIT.PROCEXITFN 210378 . 211071)) (211152 224377 (\TEDIT.DOWNCARET 211162 . 211955) (
-\TEDIT.FLASHCARET 211957 . 214068) (\TEDIT.UPCARET 214070 . 215174) (TEDIT.NORMALIZECARET 215176 . 
-218394) (\TEDIT.SETCARET 218396 . 223747) (\TEDIT.CARET 223749 . 224375)))))
+  (FILEMAP (NIL (17104 18000 (TEDIT.DEFER.UPDATES 17114 . 17998)) (18001 43946 (\TEDIT.WINDOW.CREATE 
+18011 . 25341) (\TEDIT.WINDOW.GETREGION 25343 . 28833) (\TEDIT.WINDOW.SETUP 28835 . 33165) (
+\TEDIT.MINIMAL.WINDOW.SETUP 33167 . 40578) (\TEDIT.CLEARPANE 40580 . 41297) (\TEDIT.FILL.PANES 41299
+ . 43944)) (43947 67648 (\TEDIT.CURSORMOVEDFN 43957 . 49567) (\TEDIT.CURSOROUTFN 49569 . 50257) (
+\TEDIT.ACTIVE.WINDOWP 50259 . 51329) (\TEDIT.EXPANDFN 51331 . 51894) (\TEDIT.MAINW 51896 . 53176) (
+\TEDIT.MAINSTREAM 53178 . 53512) (\TEDIT.PRIMARYPANE 53514 . 54284) (\TEDIT.PANELIST 54286 . 54782) (
+\TEDIT.NEWREGIONFN 54784 . 57300) (\TEDIT.SET.WINDOW.EXTENT 57302 . 62284) (\TEDIT.SHRINK.ICONCREATE 
+62286 . 65019) (\TEDIT.SHRINKFN 65021 . 65430) (\TEDIT.PANEREGION 65432 . 67646)) (67680 100726 (
+\TEDIT.BUTTONEVENTFN 67690 . 80663) (\TEDIT.BUTTONEVENTFN.DOOPERATION 80665 . 87928) (
+\TEDIT.BUTTONEVENTFN.GETOPERATION 87930 . 89772) (\TEDIT.BUTTONEVENTFN.CURSEL.INIT 89774 . 93444) (
+\TEDIT.BUTTONEVENTFN.INACTIVE 93446 . 95876) (\TEDIT.BUTTONEVENTFN.INTITLE 95878 . 97713) (
+\TEDIT.COPYINSERTFN 97715 . 98847) (\TEDIT.FOREIGN.COPY 98849 . 100724)) (100727 117969 (
+\TEDIT.PANE.SPLIT 100737 . 104685) (\TEDIT.SPLITW 104687 . 112425) (\TEDIT.UNSPLITW 112427 . 116626) (
+\TEDIT.LINKPANES 116628 . 117391) (\TEDIT.UNLINKPANE 117393 . 117967)) (119403 120294 (TEDITWINDOWP 
+119413 . 120292)) (120331 123434 (TEDIT.GETINPUT 120341 . 122784) (\TEDIT.MAKEFILENAME 122786 . 123432
+)) (123483 131110 (TEDIT.PROMPTWINDOW 123493 . 123807) (TEDIT.PROMPTPRINT 123809 . 126436) (
+TEDIT.PROMPTCLEAR 126438 . 128157) (TEDIT.PROMPTFLASH 128159 . 129417) (\TEDIT.PROMPT.PAGEFULLFN 
+129419 . 131108)) (131348 141752 (\TEDIT.FILENAME 131358 . 132130) (\TEDIT.DEFAULT.TITLE 132132 . 
+134511) (\TEDIT.WINDOW.TITLE 134513 . 136682) (\TEDIT.LIKELY.FILENAME 136684 . 139234) (
+\TEDIT.UPDATE.TITLE 139236 . 141750)) (141795 154279 (TEDIT.DEACTIVATE.WINDOW 141805 . 147378) (
+\TEDIT.RESHAPEFN 147380 . 149465) (\TEDIT.REPAINTFN 149467 . 149691) (\TEDIT.CLOSESPLITS 149693 . 
+152138) (\TEDIT.CLOSEPANE 152140 . 154277)) (154280 197079 (\TEDIT.SCROLLFN 154290 . 156521) (
+\TEDIT.SCROLLCH.TOP 156523 . 158634) (\TEDIT.SCROLLCH.BOTTOM 158636 . 162966) (\TEDIT.SCROLLUP 162968
+ . 168694) (\TEDIT.TOPLINE.YTOP 168696 . 170365) (\TEDIT.SCROLLDOWN 170367 . 177406) (
+\TEDIT.SCROLL.CARET 177408 . 180246) (\TEDIT.VISIBLECARETP 180248 . 182542) (\TEDIT.VISIBLECHARP 
+182544 . 183635) (\TEDIT.BITMAPLINES 183637 . 187557) (\TEDIT.SETPANE.TOPLINE 187559 . 188171) (
+\TEDIT.SHIFTLINES 188173 . 197077)) (197080 207949 (\TEDIT.ONSCREEN? 197090 . 201641) (
+\TEDIT.ONSCREEN.REGION 201643 . 205294) (\TEDIT.AFTERMOVEFN 205296 . 206193) (OFFSCREENP 206195 . 
+207947)) (207991 210805 (\TEDIT.PROCIDLEFN 208001 . 209661) (\TEDIT.PROCENTRYFN 209663 . 210108) (
+\TEDIT.PROCEXITFN 210110 . 210803)) (210884 224109 (\TEDIT.DOWNCARET 210894 . 211687) (
+\TEDIT.FLASHCARET 211689 . 213800) (\TEDIT.UPCARET 213802 . 214906) (TEDIT.NORMALIZECARET 214908 . 
+218126) (\TEDIT.SETCARET 218128 . 223479) (\TEDIT.CARET 223481 . 224107)))))
 STOP

lispusers/NSDISPLAYSIZES

@@ -1,19 +1,18 @@
 (DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
 
-
(FILECREATED "10-Apr-2024 09:49:11" {WMEDLEY}<lispusers>NSDISPLAYSIZES.;5
 9232   
+
(FILECREATED "15-Jul-2025 10:25:11" {WMEDLEY}<lispusers>NSDISPLAYSIZES.;7
 7757   
 
       :EDIT-BY rmk
 
-      :CHANGES-TO (FNS NSDISPLAYSIZE)
+      :CHANGES-TO (FNS PURGENSFONTS)
 
-      :PREVIOUS-DATE " 8-Apr-2024 11:48:01" {WMEDLEY}<lispusers>NSDISPLAYSIZES.;4)
+      :PREVIOUS-DATE " 9-Jun-2025 19:52:26" {WMEDLEY}<lispusers>NSDISPLAYSIZES.;6)
 
 
 (PRETTYCOMPRINT NSDISPLAYSIZESCOMS)
 
 (RPAQQ NSDISPLAYSIZESCOMS

        [(FNS NSDISPLAYSIZE NS\FONTFILENAME NS\FONTFILENAME.OLD PURGENSFONTS)
-        (ADDVARS (NSFONTFAMILIES CLASSIC MODERN TERMINAL OPTIMA TITAN))
         (INITVARS (*SMALLSCREEN* (ILESSP SCREENWIDTH 700)))
         [COMS                                                (* ; 
 
                         "VirtualKeyboard font needs adjusting so that real Classic 12 still appears")

@@ -90,44 +89,19 @@
            FACE EXTENSION CHARACTERSET])
 
 (PURGENSFONTS

-  [LAMBDA (TYPES)
                                        (* ; "Edited 14-Sep-96 09:27 by rmk:")

-                                                             (* ; "Edited 14-Dec-87 14:53 by bvm:")

-    (/SETTOPVAL
-     '\FONTSINCORE
-     (FOR
 ENTRY IN
 \FONTSINCORE BIND
 BADTYPES TMP
-        COLLECT

-        (SETQ BADTYPES (IF
 (AND (MEMB (CAR ENTRY)
-                                          NSFONTFAMILIES)
-                                    (OR (NULL TYPES)
-                                        (EQMEMB 'NS TYPES)))
-                           THEN
 (CONS 'DISPLAY TYPES)
-                         ELSE
 (MKLIST TYPES)))
-        (CONS
-         (CAR ENTRY)
-         (FOR
 SIZES IN
 (CDR ENTRY)
-            WHEN
 [SETQ TMP
-                      (IF
 (AND (NULL TYPES)
-                                   (> (CAR SIZES)
-                                      12))
-                          THEN
                           (* ; 
-
                                                    "Only have to get rid of sizes smaller than 14")

-                                (CDR SIZES)
-                        ELSE
 (FOR
 FACE IN
 (CDR SIZES)
-                                    WHEN
 (SETQ TMP
-                                              (FOR
 ROT IN
 (CDR FACE)
-                                                 WHEN
 (SETQ TMP (FOR
 DEV
-                                                                       IN
 (CDR ROT) COLLECT

-                                                                                        DEV
-                                                                       UNLESS
 (MEMB (CAR DEV)
-                                                                                        BADTYPES)))
-                                                 COLLECT
 (CONS (CAR ROT)
-                                                                   TMP)))
-                                    COLLECT
 (CONS (CAR FACE)
-                                                      TMP] COLLECT
 (CONS (CAR SIZES)
-                                                                             TMP])
-)
+  [LAMBDA (TYPES)
                                            (* ; "Edited 15-Jul-2025 09:47 by rmk")


+                                                             (* ; "Edited 14-Sep-96 09:27 by rmk:")


+                                                             (* ; "Edited 14-Dec-87 14:53 by bvm:")

 
-(ADDTOVAR NSFONTFAMILIES
 CLASSIC MODERN TERMINAL OPTIMA TITAN)
+    (* ;; "Removes current NS display fonts with sizes LEQ 12.  No need to be undoable, cache entries will be recreated on demand.")

+
+    (DECLARE
 (GLOBALVARS \FONTSINCORE))
+    (MAPMULTI \FONTSINCORE (FUNCTION (LAMBDA (FM S FC R TAIL)
+                                       (CL:WHEN (AND (MEMB FM NSFONTFAMILIES)
+                                                     (ILEQ S 12)
+                                                     (EQ 'DISPLAY (CAR TAIL)))
+                                              (RPLACD TAIL])
+)
 
 (RPAQ? *SMALLSCREEN*
 (ILESSP SCREENWIDTH 700))
 
@@ -170,7 +144,7 @@
 (VKBD.FIX.FONT
)
 )
 (DECLARE%: DONTCOPY
-  (FILEMAP (NIL (1522 7564 (NSDISPLAYSIZE 1532 . 4862) (NS\FONTFILENAME 4864 . 5105) (
-NS\FONTFILENAME.OLD 5107 . 5356) (PURGENSFONTS 5358 . 7562)) (7776 8814 (VKBD.FIX.FONT 7786 . 8812))))
+  (FILEMAP (NIL (1449 6157 (NSDISPLAYSIZE 1459 . 4789) (NS\FONTFILENAME 4791 . 5032) (
+NS\FONTFILENAME.OLD 5034 . 5283) (PURGENSFONTS 5285 . 6155)) (6301 7339 (VKBD.FIX.FONT 6311 . 7337))))
 )
 STOP

lispusers/PRESSFROMNS

@@ -1,66 +1,61 @@
-(DEFINE-FILE-INFO READTABLE "INTERLISP" PACKAGE "INTERLISP")
-
(FILECREATED " 9-Mar-88 15:54:25" {IVY}<HOGG>LISP>MEDLEY>PRESSFROMNS.;13
 81335  
+(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
 
-      changes to%:  (VARS PRESSFROMNSCOMS)
-                    (FNS \CREATECHARSET.PRESS \CREATECHARSETZERO.PRESS \CREATEPRESSFONT \COERCEFONT)
-                    (RECORDS PRESSDATA)
+
(FILECREATED "14-Jul-2025 23:24:28" 
+{DSK}<Users>kaplan>Local>medley3.5>working-medley>lispusers>PRESSFROMNS.;3
 80159  
 
-      previous date%: " 4-Mar-88 12:52:46" {IVY}<HOGG>LISP>MEDLEY>PRESSFROMNS.;9)
+      :EDIT-BY rmk
 
+      :CHANGES-TO (FNS GETCHARPRESSTRANSLATION PUTCHARPRESSTRANSLATION)
+
+      :PREVIOUS-DATE " 5-Jul-2025 18:52:47" 
+{DSK}<Users>kaplan>Local>medley3.5>working-medley>lispusers>PRESSFROMNS.;2)
 
-(* "
-Copyright (c) 1986, 1988 by Xerox Corporation.  All rights reserved.
-")
 
 (PRETTYCOMPRINT PRESSFROMNSCOMS)
 
-(RPAQQ PRESSFROMNSCOMS
 [(* This file uses CONSTANTS defined in PRESS, so it is necessary to 
-                               LOADFROM PRESS before changing this file.)
-                            (FNS \SMASHPRESSFONTS)
-                            (FNS GETCHARPRESSTRANSLATION PRESS.NSARRAY PUTCHARPRESSTRANSLATION)
-                            (FNS \DSPFONT.PRESS \DSPSPACEFACTOR.PRESS \ENTITYSTART.PRESS 
-                                 \SETSPACE.PRESS \STARTPAGE.PRESS \PRESS.COERCEFONT 
-                                 \DSPFONT.PRESSFONT SETUPFONTS.PRESS)
-                            (FNS \CREATEPRESSFONT \CREATECHARSET.PRESS \CREATECHARSETZERO.PRESS)
-                            (FNS \PRESSCURVE2)
-                            (COMS (* Generic utility for coercing fonts, could be used by other 
-                                     devices)
-                                  (FNS \COERCEFONT))
-                            (ALISTS (FONTCOERCIONS PRESS)
-                                   (MISSINGFONTCOERCIONS PRESS))
-                            (GLOBALVARS FONTCOERCIONS MISSINGFONTCOERCIONS)
-                            (FNS \STRINGWIDTH.PRESS \CHARWIDTH.PRESS \OUTCHARFN.PRESS)
-                            (* * new declaration for PRESSDATA)
-                            (DECLARE%: DONTCOPY (RECORDS PRESSDATA))
-                            (INITRECORDS PRESSDATA)
-                            (* * NSTOASCIITRANSLATIONS is a list with elements of the form
-                               (charset translationArrayName)
-                               %, where translationArrayName is bound to a translation array for 
-                               charset which contains (fontFamily charcode)
-                               lists)
-                            (FNS \NSTOASCIIARRAY \NSTOASCIITRANSLATION)
-                            (GLOBALVARS NSTOASCIITRANSLATIONS PRESSFONTFAMILIES)
-                            [INITVARS (PRESSFONTFAMILIES '((GACHA)
-                                                           (TIMESROMAN)
-                                                           (HELVETICA)
-                                                           (SYMBOL)
-                                                           (MATH)
-                                                           (HIPPO)
-                                                           (CYRILLIC)
-                                                           (NEWVEC)
-                                                           (SNEWVEC)
-                                                           (HNEWVEC)
-                                                           (VNEWVEC]
-                            (INITVARS (NSTOASCIITRANSLATIONS))
-                            (ADDVARS (NSTOASCIITRANSLATIONS (0 ASCIIFROM0ARRAY)
-                                            (38 ASCIIFROM38ARRAY)
-                                            (39 ASCIIFROM39ARRAY)
-                                            (239 ASCIIFROM239ARRAY)))
-                            (UGLYVARS ASCIIFROM0ARRAY ASCIIFROM38ARRAY ASCIIFROM39ARRAY 
-                                   ASCIIFROM239ARRAY)
-                            (P (\SMASHPRESSFONTS))
-                            (DECLARE%: DONTCOPY (CONSTANTS (unknownCharTranslation
-                                                            '(MATH 59])
+(RPAQQ PRESSFROMNSCOMS

+       [(* This file uses CONSTANTS defined in PRESS, so it is necessary to LOADFROM PRESS before 
+           changing this file.)
+        (FNS \SMASHPRESSFONTS)
+        (FNS GETCHARPRESSTRANSLATION PRESS.NSARRAY PUTCHARPRESSTRANSLATION)
+        (FNS \DSPFONT.PRESS \DSPSPACEFACTOR.PRESS \ENTITYSTART.PRESS \SETSPACE.PRESS \STARTPAGE.PRESS
+             \PRESS.COERCEFONT \DSPFONT.PRESSFONT SETUPFONTS.PRESS)
+        (FNS \CREATEPRESSFONT \CREATECHARSET.PRESS \CREATECHARSETZERO.PRESS)
+        (FNS \PRESSCURVE2)
+        (COMS (* Generic utility for coercing fonts, could be used by other devices)
+              (FNS \COERCEFONT))
+        (ALISTS (FONTCOERCIONS PRESS)
+               (MISSINGFONTCOERCIONS PRESS))
+        (GLOBALVARS FONTCOERCIONS MISSINGFONTCOERCIONS)
+        (FNS \STRINGWIDTH.PRESS \CHARWIDTH.PRESS \OUTCHARFN.PRESS)
+        (* * new declaration for PRESSDATA)
+        (DECLARE%: DONTCOPY (RECORDS PRESSDATA))
+        (INITRECORDS PRESSDATA)
+        (* * NSTOASCIITRANSLATIONS is a list with elements of the form (charset translationArrayName)
+           %, where translationArrayName is bound to a translation array for charset which contains
+           (fontFamily charcode)
+           lists)
+        (FNS \NSTOASCIIARRAY \NSTOASCIITRANSLATION)
+        (GLOBALVARS NSTOASCIITRANSLATIONS PRESSFONTFAMILIES)
+        [INITVARS (PRESSFONTFAMILIES '((GACHA)
+                                       (TIMESROMAN)
+                                       (HELVETICA)
+                                       (SYMBOL)
+                                       (MATH)
+                                       (HIPPO)
+                                       (CYRILLIC)
+                                       (NEWVEC)
+                                       (SNEWVEC)
+                                       (HNEWVEC)
+                                       (VNEWVEC]
+        (INITVARS (NSTOASCIITRANSLATIONS))
+        (ADDVARS (NSTOASCIITRANSLATIONS (0 ASCIIFROM0ARRAY)
+                        (38 ASCIIFROM38ARRAY)
+                        (39 ASCIIFROM39ARRAY)
+                        (239 ASCIIFROM239ARRAY)))
+        (UGLYVARS ASCIIFROM0ARRAY ASCIIFROM38ARRAY ASCIIFROM39ARRAY ASCIIFROM239ARRAY)
+        (P (\SMASHPRESSFONTS))
+        (DECLARE%: DONTCOPY (CONSTANTS (unknownCharTranslation '(MATH 59])
 
 
 
@@ -79,30 +74,28 @@ this file.)

 (DEFINEQ
 
 (GETCHARPRESSTRANSLATION

-  [LAMBDA (CHARCODE FONT)
                                (* thh%: "28-Feb-86 12:03")

-          
-          (* returns the Press translation for a character in a font)

-
+  [LAMBDA (CHARCODE FONT)
                                    (* ; "Edited 14-Jul-2025 23:23 by rmk")


+                                                             (* ; "Edited  5-Jul-2025 18:51 by rmk")

+                                                             (* thh%: "28-Feb-86 12:03")

+                                                             (* ; 
+
                                            "returns the Press translation for a character in a font")

     (COND
        ((OR (CHARCODEP CHARCODE)
-            (EQ CHARCODE 256))
-          
-          (* bitmap for char 256 is what gets printed if char not found)

-
+            (EQ CHARCODE 256))                               (* ; 
+
                                         "bitmap for char 256 is what gets printed if char not found")

         )
        ((OR (STRINGP CHARCODE)
             (LITATOM CHARCODE))
         (SETQ CHARCODE (CHCON1 CHARCODE)))
        (T (\ILLEGAL.ARG CHARCODE)))
-    (LET [TR CSINFO (FONTDESC (\GETFONTDESC FONT 'PRESS]
-          
-          (* fetch the csinfo for the character set of this character.)

-
+    (LET [TR CSINFO (FONTDESC (FONTCOPY FONT NIL NIL NIL 'PRESS]
+                                                             (* ; 
+
                                          "fetch the csinfo for the character set of this character.")

          (SETQ CSINFO (\GETCHARSETINFO (\CHARSET CHARCODE)
                              FONTDESC))
          (SETQ TR (\GETBASEPTR (fetch
 (CHARSETINFO CHARSETBITMAP) of
 CSINFO)
                          (UNFOLD (\CHAR8CODE CHARCODE)
-                                2)))                         (* Return a copy)

+                                2)))                         (* ; "Return a copy")

          (LIST (CAR TR)
                (CDR TR])
 
@@ -135,17 +128,18 @@ this file.)

           array])
 
 (PUTCHARPRESSTRANSLATION

-  [LAMBDA (CHARCODE FONT NEWTRANSLATION)
                 (* ; "Edited 29-Feb-88 10:28 by thh:")

+  [LAMBDA (CHARCODE FONT NEWTRANSLATION)
                     (* ; "Edited 14-Jul-2025 23:24 by rmk")


+                                                             (* ; "Edited  5-Jul-2025 18:51 by rmk")


+                                                             (* ; "Edited 29-Feb-88 10:28 by thh:")

                                                              (* ; 
-
                                          "Changes the Press translation for a character in a font")

-
+
                                            "Changes the Press translation for a character in a font")

     (COND
        ((CHARCODEP CHARCODE))
        ((OR (STRINGP CHARCODE)
             (LITATOM CHARCODE))
         (SETQ CHARCODE (CHCON1 CHARCODE)))
        (T (\ILLEGAL.ARG CHARCODE)))
-    (PROG* ((FONTDESC (\GETFONTDESC FONT 'PRESS))
+    (PROG* ((FONTDESC (FONTCREATE FONT NIL NIL NIL 'PRESS))
             (CSINFO (\GETCHARSETINFO (\CHARSET CHARCODE)
                            FONTDESC))
             (CHAR8CODE (\CHAR8CODE CHARCODE))
@@ -162,11 +156,12 @@ this file.)

                       (MAX DATUM (ffetch
 \SFAscent of
 (CAR TR]
                [change
 (ffetch
 CHARSETDESCENT of
 CSINFO)
                       (MAX DATUM (ffetch
 \SFDescent of
 (CAR TR]
-               [freplace
 \SFHeight of
 FONTDESC
-                  with
 (PLUS (change
 (ffetch
 \SFAscent of
 FONTDESC)
-                                        (MAX DATUM (ffetch
 CHARSETASCENT of
 CSINFO)))
-                                 (change
 (ffetch
 \SFDescent of
 FONTDESC)
-                                        (MAX DATUM (ffetch
 CHARSETDESCENT of
 CSINFO])
+               [freplace
 \SFHeight of
 FONTDESC with
 (PLUS (change
 (ffetch
 \SFAscent of
 FONTDESC)
+                                                                 (MAX DATUM (ffetch
 CHARSETASCENT
+                                                                               of
 CSINFO)))
+                                                          (change
 (ffetch
 \SFDescent of
 FONTDESC)
+                                                                 (MAX DATUM (ffetch
 CHARSETDESCENT
+                                                                               of
 CSINFO])
            (RETURN NEWTRANSLATION])
 )
 (DEFINEQ
@@ -1000,16 +995,16 @@ this file.)

 )
 
 (ADDTOVAR FONTCOERCIONS
 (PRESS ((SYMBOL (< 10))
-                                    (SYMBOL 10))
-                                   ((SYMBOL (> 12))
-                                    (SYMBOL 12))))
+                                (SYMBOL 10))
+                               ((SYMBOL (> 12))
+                                (SYMBOL 12))))
 
 (ADDTOVAR MISSINGFONTCOERCIONS
 (PRESS (MODERN HELVETICA)
-                                          (CLASSIC TIMESROMAN)
-                                          (LOGOTYPE LOGO)
-                                          (TERMINAL GACHA)
-                                          (MODERN FRUTIGER)
-                                          (CLASSIC CENTURY)))
+                                      (CLASSIC TIMESROMAN)
+                                      (LOGOTYPE LOGO)
+                                      (TERMINAL GACHA)
+                                      (MODERN FRUTIGER)
+                                      (CLASSIC CENTURY)))
 (DECLARE%: DOEVAL@COMPILE DONTCOPY
 
 (GLOBALVARS FONTCOERCIONS MISSINGFONTCOERCIONS)
@@ -1112,90 +1107,83 @@ this file.)

 (DECLARE%: DONTCOPY 
 (DECLARE%: EVAL@COMPILE
 
-(DATATYPE PRESSDATA
 (PRHEADING                           (* ; 
-
                                                         "The string to be printed atop each page.")

-                               PRHEADINGFONT                 (* ; "Font to print the heading in")

-                               PRXPOS                        (* ; "Current X position")

-                               PRYPOS                        (* ; "Current Y position")

-                               PRFONT                        (* ; "Current font")

-                               PRCURRFDE PRESSFONTDIR (PRWIDTHSCACHE POINTER 
+(DATATYPE PRESSDATA
 (PRHEADING                               (* ; 
+
                                                           "The string to be printed atop each page.")

+                           PRHEADINGFONT                     (* ; "Font to print the heading in")

+                           PRXPOS                            (* ; "Current X position")

+                           PRYPOS                            (* ; "Current Y position")

+                           PRFONT                            (* ; "Current font")

+                           PRCURRFDE PRESSFONTDIR (PRWIDTHSCACHE POINTER 
                                                              (* ; 
-
                                               "Widths table for the current logical character set")

-                                                             )
-                               PRCOLOR PRLINEFEED PRPAGESTATE PDSTREAM ELSTREAM XPRPAGEREGION 
-                               PRDOCNAME (PRLEFT WORD)       (* ; "Page left margin")

-                               (PRBOTTOM WORD)               (* ; "Page bottom margin")

-                               (PRRIGHT WORD)                (* ; "Page right margin")

-                               (PRTOP WORD)                  (* ; "Page top margin")

-                               (PRPAGENUM WORD)              (* ; "Current Page number")

-                               (PRNEXTFONT# BYTE)
-                               (PRMAXFONTSET BYTE)
-                               (PRPARTSTART INTEGER)
-                               (DLSTARTBYTE INTEGER)
-                               (ELSTARTBYTE INTEGER)
-                               (STARTCHARBYTE INTEGER)
-                               (VECMOVINGRIGHT FLAG)         (* ; 
-
                          "If we're drawing a curve with vector fonts, are we moving to the right?")

-                               (VECWASDISPLAYING FLAG)
-          (* ;; "Used during curve/line clipping to remember whether we were on-screen or not, so we know when to force a SETXY.")

+
                                                 "Widths table for the current logical character set")

+                                                         )
+                           PRCOLOR PRLINEFEED PRPAGESTATE PDSTREAM ELSTREAM XPRPAGEREGION PRDOCNAME
+                           (PRLEFT WORD)                     (* ; "Page left margin")

+                           (PRBOTTOM WORD)                   (* ; "Page bottom margin")

+                           (PRRIGHT WORD)                    (* ; "Page right margin")

+                           (PRTOP WORD)                      (* ; "Page top margin")

+                           (PRPAGENUM WORD)                  (* ; "Current Page number")

+                           (PRNEXTFONT# BYTE)
+                           (PRMAXFONTSET BYTE)
+                           (PRPARTSTART INTEGER)
+                           (DLSTARTBYTE INTEGER)
+                           (ELSTARTBYTE INTEGER)
+                           (STARTCHARBYTE INTEGER)
+                           (VECMOVINGRIGHT FLAG)             (* ; 
+
                            "If we're drawing a curve with vector fonts, are we moving to the right?")

+                           (VECWASDISPLAYING FLAG)
 
-                               VECSEGCHARS                   (* ; 
-
                                      "Cache for vector characters while we're moving to the left.")

-                               VECCURX                       (* ; 
-
                                            "Current X position within vector code, in Dover spots")

-                               VECCURY                       (* ; 
-
                                              "Current Y position with vector code, in Dover spots")

-                               PRSPACEFACTOR PRSPACEWIDTH (CHARWASDISPLAYING FLAG)
-                                                             (* ; 
-
                         "Says whether we have been printing characters inside the clipping region")

-                               PRClippingRegion
-          (* ;; "The edges of the paper, as far as PRESS is concerned.  Used to protect SPRUCE users who get killed when the image goes off-paper")

+                           (* ;; "Used during curve/line clipping to remember whether we were on-screen or not, so we know when to force a SETXY.")

 
-                               PRLOGICALFONT                 (* ; "Current logical font")

-                               PRLOGICALCHARSET              (* ; 
-
                    "Current logical character set, whose info is cached.  NIL if cache is invalid")

-                               (PRTRANSLATIONCACHE POINTER   (* ; 
-
                                          "Translation table for the current logical character set")

-                                      ))
-                        PRSPACEFACTOR _ 1 PRXPOS _ 0 PRYPOS _ 0 
+                           VECSEGCHARS                       (* ; 
+
                                        "Cache for vector characters while we're moving to the left.")

+                           VECCURX                           (* ; 
+
                                              "Current X position within vector code, in Dover spots")

+                           VECCURY                           (* ; 
+
                                                "Current Y position with vector code, in Dover spots")

+                           PRSPACEFACTOR PRSPACEWIDTH (CHARWASDISPLAYING FLAG)
                                                              (* ; 
-
                    "We assume that the origin is translated to the bottom-left of the page region")

-                        PRClippingRegion _ (create
 REGION
-                                                  LEFT _ SPRUCEPAPERLEFTMICAS
-                                                  BOTTOM _ SPRUCEPAPERBOTTOMMICAS
-                                                  WIDTH _ (DIFFERENCE SPRUCEPAPERRIGHTMICAS 
-                                                                 SPRUCEPAPERLEFTMICAS)
-                                                  HEIGHT _ 29210)
-                        [ACCESSFNS ((PRWIDTH (IDIFFERENCE (fetch
 (PRESSDATA PRRIGHT) of

-                                                                                         DATUM)
-                                                    (fetch
 (PRESSDATA PRLEFT) of
 DATUM)))
-                                    (PRHEIGHT (IDIFFERENCE (fetch
 (PRESSDATA PRTOP) of
 DATUM)
-                                                     (fetch
 (PRESSDATA PRBOTTOM) of
 DATUM)))
-                                    (PRPAGEREGION (fetch
 (PRESSDATA XPRPAGEREGION) of
 DATUM)
-                                           (PROGN (replace
 (PRESSDATA XPRPAGEREGION) of

-                                                                                         DATUM
-                                                     with
 NEWVALUE)
-                                                  (replace
 (PRESSDATA PRLEFT) of
 DATUM
-                                                     with
 (fetch
 (REGION LEFT) of
 
-                                                                                             NEWVALUE
-                                                                     ))
-                                                  (replace
 (PRESSDATA PRBOTTOM) of
 DATUM
-                                                     with
 (fetch
 (REGION BOTTOM) of

-                                                                                         NEWVALUE))
-                                                  (replace
 (PRESSDATA PRRIGHT) of
 DATUM
-                                                     with
 (IPLUS (fetch
 (REGION LEFT)
-                                                                        of
 NEWVALUE)
-                                                                     (fetch
 (REGION WIDTH)
-                                                                        of
 NEWVALUE)))
-                                                  (replace
 (PRESSDATA PRTOP) of
 DATUM
-                                                     with
 (IPLUS (fetch
 (REGION BOTTOM)
-                                                                        of
 NEWVALUE)
-                                                                     (fetch
 (REGION HEIGHT)
-                                                                        of
 NEWVALUE])
+
                           "Says whether we have been printing characters inside the clipping region")

+                           PRClippingRegion
+
+                           (* ;; "The edges of the paper, as far as PRESS is concerned.  Used to protect SPRUCE users who get killed when the image goes off-paper")

+
+                           PRLOGICALFONT                     (* ; "Current logical font")

+                           PRLOGICALCHARSET                  (* ; 
+
                      "Current logical character set, whose info is cached.  NIL if cache is invalid")

+                           (PRTRANSLATIONCACHE POINTER       (* ; 
+
                                            "Translation table for the current logical character set")

+                                  ))
+                    PRSPACEFACTOR _ 1 PRXPOS _ 0 PRYPOS _ 0  (* ; 
+
                      "We assume that the origin is translated to the bottom-left of the page region")

+                    PRClippingRegion _ (create
 REGION
+                                              LEFT _ SPRUCEPAPERLEFTMICAS
+                                              BOTTOM _ SPRUCEPAPERBOTTOMMICAS
+                                              WIDTH _ (DIFFERENCE SPRUCEPAPERRIGHTMICAS 
+                                                             SPRUCEPAPERLEFTMICAS)
+                                              HEIGHT _ 29210)
+                    [ACCESSFNS ((PRWIDTH (IDIFFERENCE (fetch
 (PRESSDATA PRRIGHT) of
 DATUM)
+                                                (fetch
 (PRESSDATA PRLEFT) of
 DATUM)))
+                                (PRHEIGHT (IDIFFERENCE (fetch
 (PRESSDATA PRTOP) of
 DATUM)
+                                                 (fetch
 (PRESSDATA PRBOTTOM) of
 DATUM)))
+                                (PRPAGEREGION (fetch
 (PRESSDATA XPRPAGEREGION) of
 DATUM)
+                                       (PROGN (replace
 (PRESSDATA XPRPAGEREGION) of
 DATUM
+                                                 with
 NEWVALUE)
+                                              (replace
 (PRESSDATA PRLEFT) of
 DATUM
+                                                 with
 (fetch
 (REGION LEFT) of
 NEWVALUE))
+                                              (replace
 (PRESSDATA PRBOTTOM) of
 DATUM
+                                                 with
 (fetch
 (REGION BOTTOM) of
 NEWVALUE))
+                                              (replace
 (PRESSDATA PRRIGHT) of
 DATUM
+                                                 with
 (IPLUS (fetch
 (REGION LEFT) of
 NEWVALUE)
+                                                             (fetch
 (REGION WIDTH) of
 NEWVALUE)))
+                                              (replace
 (PRESSDATA PRTOP) of
 DATUM
+                                                 with
 (IPLUS (fetch
 (REGION BOTTOM) of
 NEWVALUE)
+                                                             (fetch
 (REGION HEIGHT) of
 NEWVALUE])
 )
+
 (/DECLAREDATATYPE 'PRESSDATA
        '(POINTER POINTER POINTER POINTER POINTER POINTER POINTER POINTER POINTER POINTER POINTER 
-               POINTER POINTER POINTER POINTER WORD WORD WORD WORD WORD BYTE BYTE FIXP FIXP FIXP FIXP 
+               POINTER POINTER POINTER POINTER WORD WORD WORD WORD WORD BYTE BYTE FIXP FIXP FIXP FIXP
                FLAG FLAG POINTER POINTER POINTER POINTER POINTER FLAG POINTER POINTER POINTER POINTER
                )
        '((PRESSDATA 0 POINTER)
@@ -1218,14 +1206,14 @@ this file.)

          (PRESSDATA 32 (BITS . 15))
          (PRESSDATA 33 (BITS . 15))
          (PRESSDATA 34 (BITS . 15))
-         (PRESSDATA 28 (BITS . 7))
-         (PRESSDATA 26 (BITS . 7))
-         (PRESSDATA 35 FIXP)
-         (PRESSDATA 37 FIXP)
-         (PRESSDATA 39 FIXP)
-         (PRESSDATA 41 FIXP)
-         (PRESSDATA 24 (FLAGBITS . 0))
-         (PRESSDATA 24 (FLAGBITS . 16))
+         (PRESSDATA 35 (BITS . 7))
+         (PRESSDATA 35 (BITS . 135))
+         (PRESSDATA 36 FIXP)
+         (PRESSDATA 38 FIXP)
+         (PRESSDATA 40 FIXP)
+         (PRESSDATA 42 FIXP)
+         (PRESSDATA 28 (FLAGBITS . 0))
+         (PRESSDATA 28 (FLAGBITS . 16))
          (PRESSDATA 44 POINTER)
          (PRESSDATA 46 POINTER)
          (PRESSDATA 48 POINTER)
@@ -1238,9 +1226,10 @@ this file.)

          (PRESSDATA 60 POINTER))
        '62)
 )
+
 (/DECLAREDATATYPE 'PRESSDATA
        '(POINTER POINTER POINTER POINTER POINTER POINTER POINTER POINTER POINTER POINTER POINTER 
-               POINTER POINTER POINTER POINTER WORD WORD WORD WORD WORD BYTE BYTE FIXP FIXP FIXP FIXP 
+               POINTER POINTER POINTER POINTER WORD WORD WORD WORD WORD BYTE BYTE FIXP FIXP FIXP FIXP
                FLAG FLAG POINTER POINTER POINTER POINTER POINTER FLAG POINTER POINTER POINTER POINTER
                )
        '((PRESSDATA 0 POINTER)
@@ -1263,14 +1252,14 @@ this file.)

          (PRESSDATA 32 (BITS . 15))
          (PRESSDATA 33 (BITS . 15))
          (PRESSDATA 34 (BITS . 15))
-         (PRESSDATA 28 (BITS . 7))
-         (PRESSDATA 26 (BITS . 7))
-         (PRESSDATA 35 FIXP)
-         (PRESSDATA 37 FIXP)
-         (PRESSDATA 39 FIXP)
-         (PRESSDATA 41 FIXP)
-         (PRESSDATA 24 (FLAGBITS . 0))
-         (PRESSDATA 24 (FLAGBITS . 16))
+         (PRESSDATA 35 (BITS . 7))
+         (PRESSDATA 35 (BITS . 135))
+         (PRESSDATA 36 FIXP)
+         (PRESSDATA 38 FIXP)
+         (PRESSDATA 40 FIXP)
+         (PRESSDATA 42 FIXP)
+         (PRESSDATA 28 (FLAGBITS . 0))
+         (PRESSDATA 28 (FLAGBITS . 16))
          (PRESSDATA 44 POINTER)
          (PRESSDATA 46 POINTER)
          (PRESSDATA 48 POINTER)
@@ -1282,9 +1271,9 @@ this file.)

          (PRESSDATA 58 POINTER)
          (PRESSDATA 60 POINTER))
        '62)
-(* * NSTOASCIITRANSLATIONS is a list with elements of the form (charset translationArrayName) %, 
-where translationArrayName is bound to a translation array for charset which contains (fontFamily 
-charcode) lists)

+(* * NSTOASCIITRANSLATIONS is a list with elements of the form (charset translationArrayName) %, where
+ translationArrayName is bound to a translation array for charset which contains (fontFamily charcode)
+ lists)

 
 (DEFINEQ
 
@@ -1322,24 +1311,26 @@ charcode) lists)

 )
 
 (RPAQ? PRESSFONTFAMILIES
 '((GACHA)
-                               (TIMESROMAN)
-                               (HELVETICA)
-                               (SYMBOL)
-                               (MATH)
-                               (HIPPO)
-                               (CYRILLIC)
-                               (NEWVEC)
-                               (SNEWVEC)
-                               (HNEWVEC)
-                               (VNEWVEC)))
+                           (TIMESROMAN)
+                           (HELVETICA)
+                           (SYMBOL)
+                           (MATH)
+                           (HIPPO)
+                           (CYRILLIC)
+                           (NEWVEC)
+                           (SNEWVEC)
+                           (HNEWVEC)
+                           (VNEWVEC)))
 
 (RPAQ? NSTOASCIITRANSLATIONS
 )
 
 (ADDTOVAR NSTOASCIITRANSLATIONS
 (0 ASCIIFROM0ARRAY)
-                                    (38 ASCIIFROM38ARRAY)
-                                    (39 ASCIIFROM39ARRAY)
-                                    (239 ASCIIFROM239ARRAY))
-(READVARS-FROM-STRINGS '(ASCIIFROM0ARRAY ASCIIFROM38ARRAY ASCIIFROM39ARRAY ASCIIFROM239ARRAY) "({Y256 POINTER 0 {R163 NIL}  (SYMBOL 126)  (SYMBOL 127) NIL NIL  (SYMBOL 120) NIL 96 NIL NIL  (SYMBOL 
+                                (38 ASCIIFROM38ARRAY)
+                                (39 ASCIIFROM39ARRAY)
+                                (239 ASCIIFROM239ARRAY))
+
+(READVARS-FROM-STRINGS '(ASCIIFROM0ARRAY ASCIIFROM38ARRAY ASCIIFROM39ARRAY ASCIIFROM239ARRAY)
+       "({Y256 POINTER 0 {R163 NIL}  (SYMBOL 126)  (SYMBOL 127) NIL NIL  (SYMBOL 120) NIL 96 NIL NIL  (SYMBOL 
 55)  (SYMBOL 34)  (SYMBOL 33)  (SYMBOL 35) NIL  (SYMBOL 6) NIL NIL  (SYMBOL 2) NIL  (SYMBOL 123) NIL  
 (SYMBOL 13) 39 {R25 NIL}  (SYMBOL 125) {R44 NIL} }  {Y256 POINTER 0  (HIPPO 118) {R64 NIL}  (HIPPO 65)
   (HIPPO 66) NIL  (HIPPO 71)  (HIPPO 68)  (HIPPO 69) NIL NIL  (HIPPO 90)  (HIPPO 72)  (HIPPO 81)  (
@@ -1372,24 +1363,25 @@ MATH 7)  (SYMBOL 39) NIL  (SYMBOL 25)  (MATH 19)  (MATH 1)  (SYMBOL 112)  (SYMBO
 SYMBOL 59) {R6 NIL}  (MATH 82) NIL  (SYMBOL 100)  (SYMBOL 101)  (SYMBOL 98)  (SYMBOL 99)  (SYMBOL 57) 
  (SYMBOL 56)  (SYMBOL 94)  (SYMBOL 95)  (MATH 90)  (MATH 68)  (MATH 100) {R69 NIL} })
 ")
-(\SMASHPRESSFONTS)
+
+(\SMASHPRESSFONTS
)
 (DECLARE%: DONTCOPY 
 (DECLARE%: EVAL@COMPILE 
 
 (RPAQQ unknownCharTranslation
 (MATH 59))
 
+
 [CONSTANTS (unknownCharTranslation '(MATH 59]
 )
 )
-(PUTPROPS PRESSFROMNS COPYRIGHT ("Xerox Corporation" 1986 1988))
 (DECLARE%: DONTCOPY
-  (FILEMAP (NIL (3994 4370 (\SMASHPRESSFONTS 4004 . 4368)) (4371 8600 (GETCHARPRESSTRANSLATION 4381 . 
-5419) (PRESS.NSARRAY 5421 . 6744) (PUTCHARPRESSTRANSLATION 6746 . 8598)) (8601 19311 (\DSPFONT.PRESS 
-8611 . 10062) (\DSPSPACEFACTOR.PRESS 10064 . 10916) (\ENTITYSTART.PRESS 10918 . 12640) (
-\SETSPACE.PRESS 12642 . 13344) (\STARTPAGE.PRESS 13346 . 15454) (\PRESS.COERCEFONT 15456 . 16922) (
-\DSPFONT.PRESSFONT 16924 . 18298) (SETUPFONTS.PRESS 18300 . 19309)) (19312 41000 (\CREATEPRESSFONT 
-19322 . 20520) (\CREATECHARSET.PRESS 20522 . 25622) (\CREATECHARSETZERO.PRESS 25624 . 40998)) (41001 
-55544 (\PRESSCURVE2 41011 . 55542)) (55624 59376 (\COERCEFONT 55634 . 59374)) (60032 65529 (
-\STRINGWIDTH.PRESS 60042 . 60535) (\CHARWIDTH.PRESS 60537 . 61002) (\OUTCHARFN.PRESS 61004 . 65527)) (
-75785 76950 (\NSTOASCIIARRAY 75795 . 76147) (\NSTOASCIITRANSLATION 76149 . 76948)))))
+  (FILEMAP (NIL (2898 3274 (\SMASHPRESSFONTS 2908 . 3272)) (3275 8422 (GETCHARPRESSTRANSLATION 3285 . 
+4793) (PRESS.NSARRAY 4795 . 6118) (PUTCHARPRESSTRANSLATION 6120 . 8420)) (8423 19133 (\DSPFONT.PRESS 
+8433 . 9884) (\DSPSPACEFACTOR.PRESS 9886 . 10738) (\ENTITYSTART.PRESS 10740 . 12462) (\SETSPACE.PRESS 
+12464 . 13166) (\STARTPAGE.PRESS 13168 . 15276) (\PRESS.COERCEFONT 15278 . 16744) (\DSPFONT.PRESSFONT 
+16746 . 18120) (SETUPFONTS.PRESS 18122 . 19131)) (19134 40822 (\CREATEPRESSFONT 19144 . 20342) (
+\CREATECHARSET.PRESS 20344 . 25444) (\CREATECHARSETZERO.PRESS 25446 . 40820)) (40823 55366 (
+\PRESSCURVE2 40833 . 55364)) (55446 59198 (\COERCEFONT 55456 . 59196)) (59822 65319 (
+\STRINGWIDTH.PRESS 59832 . 60325) (\CHARWIDTH.PRESS 60327 . 60792) (\OUTCHARFN.PRESS 60794 . 65317)) (
+74712 75877 (\NSTOASCIIARRAY 74722 . 75074) (\NSTOASCIITRANSLATION 75076 . 75875)))))
 STOP

sources/ADISPLAY

@@ -1,12 +1,14 @@
 (DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
 
-
(FILECREATED "19-Dec-2023 11:23:08" {WMEDLEY}<sources>ADISPLAY.;13
 245192 
+
(FILECREATED " 8-Jul-2025 20:19:58" 
+{DSK}<Users>kaplan>Local>medley3.5>working-medley>sources>ADISPLAY.;14
 244883 
 
       :EDIT-BY rmk
 
-      :CHANGES-TO (FNS \CARET.FLASH?)
+      :CHANGES-TO (VARS ADISPLAYCOMS)
 
-      :PREVIOUS-DATE " 2-Nov-2023 23:35:15" {WMEDLEY}<sources>ADISPLAY.;12)
+      :PREVIOUS-DATE "19-Dec-2023 11:23:08" 
+{DSK}<Users>kaplan>Local>medley3.5>working-medley>sources>ADISPLAY.;13)
 
 
 (PRETTYCOMPRINT ADISPLAYCOMS)
@@ -68,7 +70,7 @@
                      (MACROS \CURVEPT .SETUP.FOR.\BBTCURVEPT. \CIRCLEPTS \CURVESMOOTH))
               (FNS \FILLCIRCLE.DISPLAY \LINEBLT))
         [COMS                                                (* ; "making and copying bitmaps")

-              (FNS SCREENBITMAP BITMAPP BITMAPHEIGHT BITSPERPIXEL)
+              (FNS SCREENBITMAP BITMAPP BITSPERPIXEL)
               (EXPORT (FILEPKGCOMS BITMAPS CURSORS))
               (DECLARE%: EVAL@COMPILE (EXPORT (ADDVARS (GLOBALVARS SCREENHEIGHT SCREENWIDTH 
                                                               ScreenBitMap]
@@ -3750,18 +3752,6 @@
     (AND (type?
 BITMAP X)
          X])
 
-(BITMAPHEIGHT

-  [LAMBDA (BITMAP)                                           (* kbr%: " 8-Jul-85 16:01")

-
-    (* ;; "returns the height in pixels of a bitmap.")

-
-    (COND
-       ((type?
 BITMAP BITMAP)
-        (fetch
 (BITMAP BITMAPHEIGHT) of
 BITMAP))
-       ((type?
 WINDOW BITMAP)
-        (WINDOWPROP BITMAP 'HEIGHT))
-       (T (\ILLEGAL.ARG BITMAP])
-
 (BITSPERPIXEL

   [LAMBDA (BITMAP)
                                         (* ; "Edited 15-Feb-94 16:10 by nilsson")

 
@@ -4434,40 +4424,40 @@
 (ADDTOVAR LAMA
 UNIONREGIONS INTERSECTREGIONS)
 )
 (DECLARE%: DONTCOPY
-  (FILEMAP (NIL (10520 10714 (SCREENREGIONP 10530 . 10712)) (12158 19519 (\BBTCURVEPT 12168 . 19517)) (
-19520 29336 (CREATETEXTUREFROMBITMAP 19530 . 21460) (PRINTBITMAP 21462 . 22813) (PRINT-BITMAPS-NICELY 
-22815 . 26666) (PRINTCURSOR 26668 . 27701) (\WRITEBITMAP 27703 . 29334)) (29379 31927 (\GETINTEGERPART
- 29389 . 30934) (\CONVERTTOFRACTION 30936 . 31925)) (32064 32936 (CURSORP 32074 . 32293) (CURSORBITMAP
- 32295 . 32341) (CreateCursorBitMap 32343 . 32934)) (37298 46221 (CARET 37308 . 39068) (\CARET.CREATE 
-39070 . 39248) (\CARET.DOWN 39250 . 40602) (\CARET.FLASH? 40604 . 42298) (\CARET.SHOW 42300 . 42869) (
-CARETRATE 42871 . 43529) (\CARET.FLASH.AGAIN 43531 . 44697) (\CARET.FLASH.MULTIPLE 44699 . 45222) (
-\CARET.FLASH 45224 . 46219)) (46222 51294 (\MEDW.CARET.SHOW 46232 . 51292)) (51658 53493 (
-\AREAVISIBLE? 51668 . 52592) (\REGIONOVERLAPAREAP 52594 . 53139) (\AREAINREGIONP 53141 . 53491)) (
-53542 66018 (CREATEREGION 53552 . 53888) (REGIONP 53890 . 54036) (INTERSECTREGIONS 54038 . 56808) (
-UNIONREGIONS 56810 . 58961) (REGIONSINTERSECTP 58963 . 59571) (SUBREGIONP 59573 . 60218) (EXTENDREGION
- 60220 . 62377) (EXTENDREGIONBOTTOM 62379 . 63021) (EXTENDREGIONLEFT 63023 . 63642) (EXTENDREGIONRIGHT
- 63644 . 64197) (EXTENDREGIONTOP 64199 . 64740) (INSIDEP 64742 . 65510) (STRINGREGION 65512 . 66016)) 
-(66263 71537 (\BRUSHBITMAP 66273 . 67990) (\GETBRUSH 67992 . 68303) (\GETBRUSHBBT 68305 . 70333) (
-\InitCurveBrushes 70335 . 71401) (\BrushFromWidth 71403 . 71535)) (71538 74605 (\MAKEBRUSH.DIAGONAL 
-71548 . 71828) (\MAKEBRUSH.HORIZONTAL 71830 . 72224) (\MAKEBRUSH.VERTICAL 72226 . 72538) (
-\MAKEBRUSH.SQUARE 72540 . 72817) (\MAKEBRUSH.ROUND 72819 . 74603)) (74606 75771 (INSTALLBRUSH 74616 . 
-75769)) (76172 87574 (\DRAWLINE.DISPLAY 76182 . 86289) (RELMOVETO 86291 . 86678) (MOVETOUPPERLEFT 
-86680 . 87572)) (87575 111060 (\CLIPANDDRAWLINE 87585 . 94031) (\CLIPANDDRAWLINE1 94033 . 105781) (
-\CLIPCODE 105783 . 107157) (\LEASTPTAT 107159 . 107757) (\GREATESTPTAT 107759 . 108387) (\DRAWLINE1 
-108389 . 109505) (\DRAWLINE.UFN 109507 . 111058)) (115590 161637 (\DRAWCIRCLE.DISPLAY 115600 . 124413)
- (\DRAWARC.DISPLAY 124415 . 124705) (\DRAWARC.GENERIC 124707 . 125460) (\COMPUTE.ARC.POINTS 125462 . 
-127727) (\DRAWELLIPSE.DISPLAY 127729 . 143398) (\DRAWCURVE.DISPLAY 143400 . 145689) (
-\DRAWPOINT.DISPLAY 145691 . 146887) (\DRAWPOLYGON.DISPLAY 146889 . 150417) (\LINEWITHBRUSH 150419 . 
-161635)) (161638 193330 (LOADPOLY 161648 . 162208) (PARAMETRICSPLINE 162210 . 172407) (\CURVE 172409
- . 178011) (\CURVE2 178013 . 189344) (\CURVEEND 189346 . 189828) (\CURVESLOPE 189830 . 192313) (
-\CURVESTART 192315 . 192639) (\FDIFS/FROM/DERIVS 192641 . 193328)) (205859 220195 (\FILLCIRCLE.DISPLAY
- 205869 . 216617) (\LINEBLT 216619 . 220193)) (220239 222239 (SCREENBITMAP 220249 . 220726) (BITMAPP 
-220728 . 220962) (BITMAPHEIGHT 220964 . 221340) (BITSPERPIXEL 221342 . 222237)) (222880 223873 (
-DSPFILL 222890 . 223573) (INVERTW 223575 . 223871)) (223874 227517 (\DSPCOLOR.DISPLAY 223884 . 225181)
- (\DSPBACKCOLOR.DISPLAY 225183 . 226562) (DSPEOLFN 226564 . 227515)) (227950 232604 (DSPCLEOL 227960
- . 228836) (DSPRUBOUTCHAR 228838 . 229270) (\DSPMOVELR 229272 . 232602)) (232734 233852 (
-\CURSOR.DEFPRINT 232744 . 233850)) (234264 242838 (TEXTUREOFCOLOR 234274 . 235536) (\PRIMARYTEXTURE 
-235538 . 236120) (\LEVELTEXTURE 236122 . 236623) (INSURE.B&W.TEXTURE 236625 . 238020) (
-INSURE.RGB.COLOR 238022 . 239450) (\LOOKUPCOLORNAME 239452 . 239722) (RGBP 239724 . 240489) (HLSP 
-240491 . 240866) (HLSTORGB 240868 . 242008) (\HLSVALUEFN 242010 . 242836)))))
+  (FILEMAP (NIL (10589 10783 (SCREENREGIONP 10599 . 10781)) (12227 19588 (\BBTCURVEPT 12237 . 19586)) (
+19589 29405 (CREATETEXTUREFROMBITMAP 19599 . 21529) (PRINTBITMAP 21531 . 22882) (PRINT-BITMAPS-NICELY 
+22884 . 26735) (PRINTCURSOR 26737 . 27770) (\WRITEBITMAP 27772 . 29403)) (29448 31996 (\GETINTEGERPART
+ 29458 . 31003) (\CONVERTTOFRACTION 31005 . 31994)) (32133 33005 (CURSORP 32143 . 32362) (CURSORBITMAP
+ 32364 . 32410) (CreateCursorBitMap 32412 . 33003)) (37367 46290 (CARET 37377 . 39137) (\CARET.CREATE 
+39139 . 39317) (\CARET.DOWN 39319 . 40671) (\CARET.FLASH? 40673 . 42367) (\CARET.SHOW 42369 . 42938) (
+CARETRATE 42940 . 43598) (\CARET.FLASH.AGAIN 43600 . 44766) (\CARET.FLASH.MULTIPLE 44768 . 45291) (
+\CARET.FLASH 45293 . 46288)) (46291 51363 (\MEDW.CARET.SHOW 46301 . 51361)) (51727 53562 (
+\AREAVISIBLE? 51737 . 52661) (\REGIONOVERLAPAREAP 52663 . 53208) (\AREAINREGIONP 53210 . 53560)) (
+53611 66087 (CREATEREGION 53621 . 53957) (REGIONP 53959 . 54105) (INTERSECTREGIONS 54107 . 56877) (
+UNIONREGIONS 56879 . 59030) (REGIONSINTERSECTP 59032 . 59640) (SUBREGIONP 59642 . 60287) (EXTENDREGION
+ 60289 . 62446) (EXTENDREGIONBOTTOM 62448 . 63090) (EXTENDREGIONLEFT 63092 . 63711) (EXTENDREGIONRIGHT
+ 63713 . 64266) (EXTENDREGIONTOP 64268 . 64809) (INSIDEP 64811 . 65579) (STRINGREGION 65581 . 66085)) 
+(66332 71606 (\BRUSHBITMAP 66342 . 68059) (\GETBRUSH 68061 . 68372) (\GETBRUSHBBT 68374 . 70402) (
+\InitCurveBrushes 70404 . 71470) (\BrushFromWidth 71472 . 71604)) (71607 74674 (\MAKEBRUSH.DIAGONAL 
+71617 . 71897) (\MAKEBRUSH.HORIZONTAL 71899 . 72293) (\MAKEBRUSH.VERTICAL 72295 . 72607) (
+\MAKEBRUSH.SQUARE 72609 . 72886) (\MAKEBRUSH.ROUND 72888 . 74672)) (74675 75840 (INSTALLBRUSH 74685 . 
+75838)) (76241 87643 (\DRAWLINE.DISPLAY 76251 . 86358) (RELMOVETO 86360 . 86747) (MOVETOUPPERLEFT 
+86749 . 87641)) (87644 111129 (\CLIPANDDRAWLINE 87654 . 94100) (\CLIPANDDRAWLINE1 94102 . 105850) (
+\CLIPCODE 105852 . 107226) (\LEASTPTAT 107228 . 107826) (\GREATESTPTAT 107828 . 108456) (\DRAWLINE1 
+108458 . 109574) (\DRAWLINE.UFN 109576 . 111127)) (115659 161706 (\DRAWCIRCLE.DISPLAY 115669 . 124482)
+ (\DRAWARC.DISPLAY 124484 . 124774) (\DRAWARC.GENERIC 124776 . 125529) (\COMPUTE.ARC.POINTS 125531 . 
+127796) (\DRAWELLIPSE.DISPLAY 127798 . 143467) (\DRAWCURVE.DISPLAY 143469 . 145758) (
+\DRAWPOINT.DISPLAY 145760 . 146956) (\DRAWPOLYGON.DISPLAY 146958 . 150486) (\LINEWITHBRUSH 150488 . 
+161704)) (161707 193399 (LOADPOLY 161717 . 162277) (PARAMETRICSPLINE 162279 . 172476) (\CURVE 172478
+ . 178080) (\CURVE2 178082 . 189413) (\CURVEEND 189415 . 189897) (\CURVESLOPE 189899 . 192382) (
+\CURVESTART 192384 . 192708) (\FDIFS/FROM/DERIVS 192710 . 193397)) (205928 220264 (\FILLCIRCLE.DISPLAY
+ 205938 . 216686) (\LINEBLT 216688 . 220262)) (220308 221930 (SCREENBITMAP 220318 . 220795) (BITMAPP 
+220797 . 221031) (BITSPERPIXEL 221033 . 221928)) (222571 223564 (DSPFILL 222581 . 223264) (INVERTW 
+223266 . 223562)) (223565 227208 (\DSPCOLOR.DISPLAY 223575 . 224872) (\DSPBACKCOLOR.DISPLAY 224874 . 
+226253) (DSPEOLFN 226255 . 227206)) (227641 232295 (DSPCLEOL 227651 . 228527) (DSPRUBOUTCHAR 228529 . 
+228961) (\DSPMOVELR 228963 . 232293)) (232425 233543 (\CURSOR.DEFPRINT 232435 . 233541)) (233955 
+242529 (TEXTUREOFCOLOR 233965 . 235227) (\PRIMARYTEXTURE 235229 . 235811) (\LEVELTEXTURE 235813 . 
+236314) (INSURE.B&W.TEXTURE 236316 . 237711) (INSURE.RGB.COLOR 237713 . 239141) (\LOOKUPCOLORNAME 
+239143 . 239413) (RGBP 239415 . 240180) (HLSP 240182 . 240557) (HLSTORGB 240559 . 241699) (\HLSVALUEFN
+ 241701 . 242527)))))
 STOP

sources/AFONT

@@ -1,26 +1,35 @@
-(DEFINE-FILE-INFO READTABLE "INTERLISP" PACKAGE "IL")
-
(FILECREATED "16-May-90 11:59:31" {DSK}<usr>local>lde>lispcore>sources>AFONT.;2
 41645  
+(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
 
-      changes to%:  (VARS AFONTCOMS)
+
(FILECREATED "14-Jul-2025 19:53:00" {WMEDLEY}<sources>AFONT.;13
 43176  
 
-      previous date%: "14-Sep-87 11:59:36" {DSK}<usr>local>lde>lispcore>sources>AFONT.;1)
+      :EDIT-BY rmk
 
+      :CHANGES-TO (FNS ACFONT.GETCHARSET \READACFONTFILE)
+
+      :PREVIOUS-DATE " 8-Jul-2025 22:09:41" {WMEDLEY}<sources>AFONT.;12)
 
-(* ; "
-Copyright (c) 1984, 1985, 1986, 1987, 1990 by Venue & Xerox Corporation.  All rights reserved.
-")
 
 (PRETTYCOMPRINT AFONTCOMS)
 
 (RPAQQ AFONTCOMS

-       ((XCL:FILE-ENVIRONMENTS "AFONT")
+       (
+        (* ;; "AC and Interpress font file support.  ACFILEP is on FONT")

+
+        (XCL:FILE-ENVIRONMENTS "AFONT")
         (DECLARE%: EVAL@COMPILE DONTCOPY (RECORDS BOUNDINGBOX FONTBOUNDINGBOX)
                (CONSTANTS noInfoCode))
-        (FNS \CREATESTARFONT \READACFONTBOXES \READACFONTFILE \ACCHARIMAGELIST \ACCHARWIDTHLIST 
-             \GETFBB \ACCHARPOSLIST \ACROTATECHAR \READFONTWDFILE \FACECODE \FAMILYCODE \FINDFONT)
-        [INITVARS (INTERPRESSFONTDIRECTORIES '("{Erinyes}<Lyric>Fonts>"]
+        (FNS ACFONT.FILEP ACFONT.GETCHARSET \CREATESTARFONT \READACFONTBOXES \READACFONTFILE 
+             \ACCHARIMAGELIST \ACCHARWIDTHLIST \GETFBB \ACCHARPOSLIST \ACROTATECHAR \READFONTWDFILE 
+             \FACECODE \FAMILYCODE \FINDFONT)
+        (ADDVARS (DISPLAYCHARSETFNS (AC ACFONT.FILEP ACFONT.GETCHARSET)))
+        (INITVARS (INTERPRESSFONTDIRECTORIES))
         (MACROS \POSITIONFONTFILE)))
 
+
+
+(* ;; "AC and Interpress font file support.  ACFILEP is on FONT")

+
+
 (XCL:DEFINE-FILE-ENVIRONMENT "AFONT"
 :PACKAGE "IL"
    :READTABLE "INTERLISP"
    :COMPILER :COMPILE-FILE)
@@ -31,23 +40,21 @@ Copyright (c) 1984, 1985, 1986, 1987, 1990 by Venue & Xerox Corporation.  All ri
 
          (* * The bounding box for a character in an AC file)

 
-                         BBOX                                (* Offset from the left edge of the 
-
                                                           bounding box to the character's 
-
                                                           origin)

-                         BBOY                                (* Offset from the bottom of the 
-
                                                           bounding box to the character's 
-
                                                           origin)

-                         BBDX                                (* Width of the character's bounding 
-
                                                           box in pixels)

-                         BBDY                                (* Height of the bounding box in 
-
                                                           bits; -1 if this character doesn't 
-
                                                           really exist)

-                         RASTERWIDTHX                        (* Width of the character's image
-
                                                           (i.e., the escapement for this 
-
                                                           character) in raster bits)

-                         RASTERWIDTHY                        (* Amount this char moves in Y, in 
-
                                                           raster units.)

-                         ))
+                     BBOX                                    (* Offset from the left edge of the 
+
                                                             bounding box to the character's origin)

+                     BBOY                                    (* Offset from the bottom of the 
+
                                                             bounding box to the character's origin)

+                     BBDX                                    (* Width of the character's bounding 
+
                                                             box in pixels)

+                     BBDY                                    (* Height of the bounding box in bits;
+
                                                             -1 if this character doesn't really 
+
                                                             exist)

+                     RASTERWIDTHX                            (* Width of the character's image
+
                                                             (i.e., the escapement for this 
+
                                                             character) in raster bits)

+                     RASTERWIDTHY                            (* Amount this char moves in Y, in 
+
                                                             raster units.)

+                     ))
 
 (RECORD FONTBOUNDINGBOX
 (FBBBDX FBBBDY FBBBOX FBBBOY))
 )
@@ -62,35 +69,61 @@ Copyright (c) 1984, 1985, 1986, 1987, 1990 by Venue & Xerox Corporation.  All ri
 )
 (DEFINEQ
 
+(ACFONT.FILEP

+  [LAMBDA (FILE)
                                             (* ; "Edited 15-May-2025 17:48 by rmk")

+    (RESETLST
+        (CL:UNLESS (OPENP FILE 'INPUT)
+            [RESETSAVE (SETQ FILE (OPENSTREAM FILE 'INPUT 'OLD))
+                   `(PROGN (CLOSEF? OLDVALUE])
+
+        (* ;; "This is the length of a standard index header.  Other files could also have this value, but it's a pretty good discriminator")

+
+        (* ;; "Skip to byte 25;  do it with BINS so works for non-randaccessp devices.  This skips the standard name header, then look for type 3 in the following header")

+
+        (CL:WHEN (EQ (\WIN FILE)
+                     (LOGOR (LLSH 16 8)
+                            12))
+            (FRPTQ 22 (\BIN FILE))                           (* ; "(SETFILEPTR STRM 25)")

+            (EQ 3 (LRSH (\BIN FILE)
+                        4))))])
+
+(ACFONT.GETCHARSET

+  [LAMBDA (STRM CHARSET)
                                     (* ; "Edited 14-Jul-2025 19:50 by rmk")


+                                                             (* ; "Edited 17-May-2025 10:15 by rmk")

+
+    (* ;; 
+
    "STRM must be good for this CHARSET.  This defaults the padding arguments of \READACFONTFILE")

+
+    (\READACFONTFILE
 STRM])
+
 (\CREATESTARFONT

-  [LAMBDA (FAMILY PSIZE FACE ROTATION DEVICE CHARSET)
        (* gbn " 1-Oct-85 18:29")

-          
-          (* ;; "the Build font descriptor for an Interpress NS font.  If we can't find widths info for that font, return NIL")

-          
-          (* ;; "Widths array is fully allocated, with zeroes for characters with no information.  An array is not allocated for fixed WidthsY.  DEVICE is PRESS or INTERPRESS")

+  [LAMBDA (FAMILY PSIZE FACE ROTATION DEVICE CHARSET)
        (* ; "Edited 22-May-2025 09:59 by rmk")


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

+                                                             (* gbn " 1-Oct-85 18:29")

+
+    (* ;; "the Build font descriptor for an Interpress NS font.  If we can't find widths info for that font, return NIL")

+
+    (* ;; "Widths array is fully allocated, with zeroes for characters with no information.  An array is not allocated for fixed WidthsY.  DEVICE is PRESS or INTERPRESS")

 
     (DECLARE
 (GLOBALVARS INTERPRESSFONTDIRECTORIES \ASCIITONS))
     (RESETLST                                                (* ; 
 
                                                     "RESETLST to make sure the fontfiles get closed")

+        (LET [(FD (create
 FONTDESCRIPTOR
+                         FONTDEVICE _ DEVICE
+                         FONTFAMILY _ FAMILY
+                         FONTSIZE _ PSIZE
+                         FONTFACE _ FACE
+                         \SFFACECODE _ (\FACECODE
 FACE)
+                         ROTATION _ ROTATION
+                         OTHERDEVICEFONTPROPS _ \ASCIITONS
+                         FONTSCALE _ (CONSTANT (FQUOTIENT 2540 72]
+             (CL:UNLESS (fetch
 (CHARSETINFO CSSLUGP) of
 (\INSURECHARSETINFO (OR CHARSET 
+                                                                                \DEFAULTCHARSET)
+                                                               FD))
 
-           (PROG [(CS (OR CHARSET \DEFAULTCHARSET))
-                  (NSMICASIZE (FIXR (FQUOTIENT (ITIMES PSIZE 2540)
-                                           72)))
-                  (FD (create
 FONTDESCRIPTOR
-                             FONTDEVICE _ DEVICE
-                             FONTFAMILY _ FAMILY
-                             FONTSIZE _ PSIZE
-                             FONTFACE _ FACE
-                             \SFFACECODE _ (\FACECODE
 FACE)
-                             ROTATION _ ROTATION
-                             OTHERDEVICEFONTPROPS _ \ASCIITONS
-                             FONTSCALE _ (CONSTANT (FQUOTIENT 2540 72]
-                 (RETURN (if
 (NOT (\GETCHARSETINFO CS FD T))
-                             then
                            (* ; 
-
                              "return NIL and let FONTCREATE decide whether or not to cause an error")

+                 (* ;; "return NIL for slug, let FONTCREATE decide whether or not to cause an error")

 
-                                  NIL
-                           else
 FD])
+                 FD)))])
 
 (\READACFONTBOXES

   [LAMBDA (FILE STARTCHAR ENDCHAR)
                           (* jds "15-Jun-85 11:48")

@@ -126,188 +159,180 @@ Copyright (c) 1984, 1985, 1986, 1987, 1990 by Venue & Xerox Corporation.  All ri
                                                                 BITSPERWORD])
 
 (\READACFONTFILE

-  [LAMBDA (STRM FAMILY SIZE FACE PAD.LEFT DONT.PAD.RIGHT)
    (* ; "Edited  1-Sep-87 10:04 by Snow")

-          
-          (* ;; "Read an AC-format font file.  Assumes that the file is open and has already been determined to be of type AC.")

+  [LAMBDA (STRM PAD.LEFT DONT.PAD.RIGHT)
                     (* ; "Edited 14-Jul-2025 19:49 by rmk")


+                                                             (* ; "Edited  8-Jul-2025 22:04 by rmk")


+                                                             (* ; "Edited  9-Jun-2025 14:17 by rmk")


+                                                             (* ; "Edited 16-May-2025 17:44 by rmk")


+                                                             (* ; "Edited  1-Sep-87 10:04 by Snow")

+    (RESETLST
+        (PROG [FBBLIST STARTCHAR ENDCHAR CHARWIDTHLIST CHARIMAGEWIDTHLIST OFFSETS WIDTHS IMAGEWIDTHS
+                     FONTDESC FBBBITMAP CHARBITMAP STARTWORDLIST BBOXLIST DUMMYCHAROFFSET DUMMYWIDTH
+                     (CSINFO (create
 CHARSETINFO
+                                    IMAGEWIDTHS _ (\CREATECSINFOELEMENT)
+                                    LEFTKERN _ (\CREATEKERNELEMENT]
+              (CL:UNLESS (GETSTREAM STRM 'INPUT T)
+                  [RESETSAVE (SETQ STRM (OPENSTREAM STRM 'INPUT 'OLD))
+                         `(PROGN (CLOSEF? OLDVALUE])
+              [COND
+                 ((AND (GETSTREAM STRM 'INPUT T)
+                       (RANDACCESSP STRM))                   (* ; 
+
                                                          "Presumably open from \READDISPLAYFONTFILE")

+                  (RESETSAVE NIL (LIST (FUNCTION CLOSEF?)
+                                       STRM)))
+                 (T 
+                    (* ;; "This is necessary unless we figure out how to read the AC file sequentially.  When we figure this out, we can factor the RESETSAVE back in \READDISPLAYFONTFILE")

 
-    [COND
-       ((RANDACCESSP STRM)
-        (RESETSAVE NIL (LIST (FUNCTION CLOSEF?)
-                             STRM)))
-       (T (* ;; "This is necessary unless we figure out how to read the AC file sequentially.  When we figure this out, we can factor the RESETSAVE back in \READDISPLAYFONTFILE")

-
-          (SETQ STRM (OPENSTREAM (CLOSEF? STRM)
-                            'INPUT))
-          (RESETSAVE NIL (LIST (FUNCTION CLOSEF?)
-                               STRM))
-          (COPYBYTES STRM (SETQ STRM (OPENSTREAM '{NODIRCORE} 'BOTH]
-    (SETFILEPTR STRM 28)                                     (* ; 
+                    (SETQ STRM (OPENSTREAM (CLOSEF? STRM)
+                                      'INPUT))
+                    (RESETSAVE NIL (LIST (FUNCTION CLOSEF?)
+                                         STRM))
+                    (COPYBYTES STRM (SETQ STRM (OPENSTREAM '{NODIRCORE} 'BOTH]
+              (SETFILEPTR STRM 0)
+              (CL:UNLESS (ACFONT.FILEP
 STRM)
+                     (ERROR "Not an AC font file" STRM))
+              (SETFILEPTR STRM 28)                           (* ; 
 
                                                    "Starting at 28 skips the family and face bytes.")

-
-    (PROG [FBBLIST STARTCHAR ENDCHAR CHARWIDTHLIST CHARIMAGEWIDTHLIST LEFTKERNS OFFSETS WIDTHS 
-                 IMAGEWIDTHS FONTDESC FBBBITMAP CHARBITMAP STARTWORDLIST BBOXLIST DUMMYCHAROFFSET 
-                 DUMMYWIDTH (CSINFO (create
 CHARSETINFO
-                                           IMAGEWIDTHS _ (\CREATECSINFOELEMENT)
-                                           LEFTKERN _ (\CREATEKERNELEMENT]
-          (SETQ STARTCHAR (BIN STRM))                        (* ; 
+              (SETQ STARTCHAR (BIN STRM))                    (* ; 
 
                                                     "Get the first and last characters in this font")

-
-          (SETQ ENDCHAR (BIN STRM))
-          (SETQ BBOXLIST (\READACFONTBOXES
 STRM STARTCHAR ENDCHAR))
+              (SETQ ENDCHAR (BIN STRM))
+              (SETQ BBOXLIST (\READACFONTBOXES
 STRM STARTCHAR ENDCHAR))
                                                              (* ; 
 
                                      "Read the list of bounding boxes for all the chars in the font")

-
-          (SETQ FBBLIST (\GETFBB
 BBOXLIST))
-          (SETQ CHARWIDTHLIST (\ACCHARIMAGELIST
 BBOXLIST))   (* ; 
+              (SETQ FBBLIST (\GETFBB
 BBOXLIST))
+              (SETQ CHARWIDTHLIST (\ACCHARIMAGELIST
 BBOXLIST))
+                                                             (* ; 
 
                                                             "And the escapement for each character.")

-
-          (SETQ CHARIMAGEWIDTHLIST (\ACCHARWIDTHLIST
 BBOXLIST FBBLIST))
+              (SETQ CHARIMAGEWIDTHLIST (\ACCHARWIDTHLIST
 BBOXLIST FBBLIST))
                                                              (* ; 
 
                                "Create the list of character widths for the characters in the font.")

-
-          (COND
-             ([EVERY (CDR CHARWIDTHLIST)
-                     (FUNCTION (LAMBDA (WID)
-                                 (OR (ZEROP WID)
-                                     (EQP WID (CAR CHARWIDTHLIST]
+              (COND
+                 ([EVERY (CDR CHARWIDTHLIST)
+                         (FUNCTION (LAMBDA (WID)
+                                     (OR (ZEROP WID)
+                                         (EQP WID (CAR CHARWIDTHLIST]
                                                              (* ; 
 
               "Fixed-pitch font.  Make the dummy character (for non-existent chars) the same width.")

+                  (SETQ DUMMYWIDTH (CAR CHARWIDTHLIST)))
+                 (T                                          (* ; "Otherwise, make the dummy 6 wide.")

+                    (SETQ DUMMYWIDTH 6)))
+              (COND
+                 ((NULL (REMOVE 0 CHARIMAGEWIDTHLIST))
+                  (ERROR "No raster mages" NIL)
+                  (RETURN)))
+              (FOR
 I FROM
 STARTCHAR TO
 ENDCHAR AS
 BOX IN
 BBOXLIST
+                 DO
                                          (* ; "set the left kerning values.  the default value is ZERO which is set when the element is created.  Currently it is an array because kerning values can be negative values.")

+                    (\FSETLEFTKERN CSINFO I (FFETCH
 (BOUNDINGBOX BBOX) OF
 BOX)))
+              (SETQ IMAGEWIDTHS (fetch
 (CHARSETINFO IMAGEWIDTHS) of
 CSINFO))
+              (for
 I from
 0 to
 (ADD1 \MAXTHINCHAR) do
 (\FSETIMAGEWIDTH IMAGEWIDTHS I DUMMYWIDTH))
+              (SETQ WIDTHS (fetch
 (CHARSETINFO WIDTHS) of
 CSINFO))
+              (for
 I from
 0 to
 (ADD1 \MAXTHINCHAR) do
 (\FSETWIDTH WIDTHS I DUMMYWIDTH))
 
-              (SETQ DUMMYWIDTH (CAR CHARWIDTHLIST)))
-             (T                                              (* ; "Otherwise, make the dummy 6 wide.")

+         (* ;; "Create the array of character widths, assuming the dummy width for all characters--we'll write over it later")

 
-                (SETQ DUMMYWIDTH 6)))
-          (COND
-             ((NULL (REMOVE 0 CHARIMAGEWIDTHLIST))
-              (ERROR "No raster images" NIL)
-              (RETURN)))
-          (SETQ LEFTKERNS (FETCH
 (CHARSETINFO LEFTKERN) OF
 CSINFO))
-          (FOR
 I FROM
 STARTCHAR TO
 ENDCHAR AS
 BOX IN
 BBOXLIST DO
 
-                                                             (* ; "set the left kerning values.  the default value is ZERO which is set when the element is created.  Currently it is an array because kerning values can be negative values.")

+              [for
 X from
 STARTCHAR to
 ENDCHAR as
 Y in
 CHARIMAGEWIDTHLIST
+                 do
 
+                    (* ;; "Fill in the image widths (the width of the image, as against how far to space over after printing the character)")

 
-                                                                 (\FSETLEFTKERN LEFTKERNS I
-                                                                        (FFETCH
 (BOUNDINGBOX BBOX)
-                                                                           OF
 BOX)))
-          (SETQ IMAGEWIDTHS (fetch
 (CHARSETINFO IMAGEWIDTHS) of
 CSINFO))
-          (for
 I from
 0 to
 (ADD1 \MAXTHINCHAR) do
 (\FSETIMAGEWIDTH IMAGEWIDTHS I DUMMYWIDTH))
-          (SETQ WIDTHS (fetch
 (CHARSETINFO WIDTHS) of
 CSINFO))
-          (for
 I from
 0 to
 (ADD1 \MAXTHINCHAR) do
 (\FSETWIDTH WIDTHS I DUMMYWIDTH))
-                                                             (* SETQ IMAGEWIDTHS (ARRAY 258
-
                                                             (QUOTE (BITS 16)) DUMMYWIDTH 0))

-          
-          (* ;; "Create the array of character widths, assuming the dummy width for all characters--we'll write over it later")

-
-          [for
 X from
 STARTCHAR to
 ENDCHAR as
 Y in
 CHARIMAGEWIDTHLIST
-             do
 
-          
-          (* ;; "Fill in the image widths (the width of the image, as against how far to space over after printing the character)")

-
-                (\FSETIMAGEWIDTH IMAGEWIDTHS X (COND
-                                                  ((ZEROP Y)
-                                                   0)
-                                                  (T (IPLUS Y (COND
-                                                                 (PAD.LEFT 1)
-                                                                 (T 0))
-                                                            (COND
-                                                               (DONT.PAD.RIGHT 0)
-                                                               (T 1]
+                    (\FSETIMAGEWIDTH IMAGEWIDTHS X (COND
+                                                      ((ZEROP Y)
+                                                       0)
+                                                      (T (IPLUS Y (COND
+                                                                     (PAD.LEFT 1)
+                                                                     (T 0))
+                                                                (COND
+                                                                   (DONT.PAD.RIGHT 0)
+                                                                   (T 1]
                                                              (* ; 
 
                                                             "And the array of image escapements")

-
-          (for
 X from
 STARTCHAR to
 ENDCHAR as
 Y in
 CHARWIDTHLIST do
 (\FSETWIDTH WIDTHS X Y))
-          [replace
 CHARSETDESCENT of
 CSINFO with
 (IMAX 0 (IMINUS (fetch
 (FONTBOUNDINGBOX FBBBOY)
-                                                                    of
 FBBLIST]
-          [replace
 CHARSETASCENT of
 CSINFO with
 (IMAX 0 (IPLUS (fetch
 (FONTBOUNDINGBOX FBBBDY)
-                                                                  of
 FBBLIST)
-                                                               (fetch
 (FONTBOUNDINGBOX FBBBOY)
-                                                                  of
 FBBLIST]
-          [replace
 CHARSETBITMAP of
 CSINFO with
 (SETQ CHARBITMAP
-                                                 (BITMAPCREATE (IPLUS (SETQ DUMMYCHAROFFSET
-                                                                       (for
 (X _ STARTCHAR)
-                                                                          to
 ENDCHAR
-                                                                          sum
 (\FGETWIDTH IMAGEWIDTHS 
-                                                                                     X)))
-                                                                      DUMMYWIDTH)
-                                                        (fetch
 (FONTBOUNDINGBOX FBBBDY) of
 FBBLIST]
-          (SETQ OFFSETS (fetch
 (CHARSETINFO OFFSETS) of
 CSINFO))
-          (for
 I from
 0 to
 (ADD1 \MAXTHINCHAR) do
 (\FSETOFFSET OFFSETS I DUMMYCHAROFFSET))
-          (SETQ STARTWORDLIST (\ACCHARPOSLIST
 STRM STARTCHAR ENDCHAR))
-          (bind
 (DESTLEFT _ 0) for
 NTHCHAR from
 STARTCHAR to
 ENDCHAR as
 BBLIST in
 BBOXLIST
-             as
 STARTWORD in
 STARTWORDLIST as
 CHARWIDTH in
 CHARWIDTHLIST
-             do
 (PROG (RASTERINFO BBOX BBBITMAP BBBMBASE)    (* ; 
+              (for
 X from
 STARTCHAR to
 ENDCHAR as
 Y in
 CHARWIDTHLIST
+                 do
 (\FSETWIDTH WIDTHS X Y))
+              [replace
 CHARSETDESCENT of
 CSINFO with
 (IMAX 0 (IMINUS (fetch
 (FONTBOUNDINGBOX FBBBOY)
+                                                                        of
 FBBLIST]
+              [replace
 CHARSETASCENT of
 CSINFO with
 (IMAX 0 (IPLUS (fetch
 (FONTBOUNDINGBOX FBBBDY)
+                                                                      of
 FBBLIST)
+                                                                   (fetch
 (FONTBOUNDINGBOX FBBBOY)
+                                                                      of
 FBBLIST]
+              [replace
 CHARSETBITMAP of
 CSINFO with
 (SETQ CHARBITMAP
+                                                     (BITMAPCREATE (IPLUS (SETQ DUMMYCHAROFFSET
+                                                                           (for
 (X _ STARTCHAR)
+                                                                              to
 ENDCHAR
+                                                                              sum
 (\FGETWIDTH 
+                                                                                         IMAGEWIDTHS
+                                                                                         X)))
+                                                                          DUMMYWIDTH)
+                                                            (fetch
 (FONTBOUNDINGBOX FBBBDY)
+                                                               of
 FBBLIST]
+              (SETQ OFFSETS (fetch
 (CHARSETINFO OFFSETS) of
 CSINFO))
+              (for
 I from
 0 to
 (ADD1 \MAXTHINCHAR) do
 (\FSETOFFSET OFFSETS I DUMMYCHAROFFSET))
+              (SETQ STARTWORDLIST (\ACCHARPOSLIST
 STRM STARTCHAR ENDCHAR))
+              (bind
 (DESTLEFT _ 0) for
 NTHCHAR from
 STARTCHAR to
 ENDCHAR as
 BBLIST in
 BBOXLIST
+                 as
 STARTWORD in
 STARTWORDLIST as
 CHARWIDTH in
 CHARWIDTHLIST
+                 do
 (PROG (RASTERINFO BBOX BBBITMAP BBBMBASE)(* ; 
 
                                        "\ACCHARPOSLIST returns NIL if no raster exists for the code")

+                          (COND
+                             ((NULL STARTWORD)
 
-                      (COND
-                         ((NULL STARTWORD)
-          
-          (* ;; "This character has no image;  use the dummy char's offset (already in the offset and width arrays from earlier)")

+                              (* ;; "This character has no image;  use the dummy char's offset (already in the offset and width arrays from earlier)")

 
-                          (add
 DESTLEFT (\FGETWIDTH IMAGEWIDTHS NTHCHAR))
-                          (\FSETWIDTH WIDTHS NTHCHAR DUMMYWIDTH)
-                          (\FSETIMAGEWIDTH IMAGEWIDTHS NTHCHAR DUMMYWIDTH)
-                          (GO L2)))
-                      (SETFILEPTR STRM STARTWORD)            (* ; 
+                              (add
 DESTLEFT (\FGETWIDTH IMAGEWIDTHS NTHCHAR))
+                              (\FSETWIDTH WIDTHS NTHCHAR DUMMYWIDTH)
+                              (\FSETIMAGEWIDTH IMAGEWIDTHS NTHCHAR DUMMYWIDTH)
+                              (GO L2)))
+                          (SETFILEPTR STRM STARTWORD)        (* ; 
 
                                         "If could flush this, would work on non-randaccessp devices")

-
-                      (SETQ RASTERINFO (\WIN STRM))
-                      (COND
-                         ((EQ -1 (fetch
 BBDY of
 BBLIST))
-                          (\FSETWIDTH WIDTHS NTHCHAR DUMMYWIDTH)
-                          (\FSETIMAGEWIDTH IMAGEWIDTHS NTHCHAR DUMMYWIDTH)
-                          (GO L2)))                          (* ; 
+                          (SETQ RASTERINFO (\WIN STRM))
+                          (COND
+                             ((EQ -1 (fetch
 BBDY of
 BBLIST))
+                              (\FSETWIDTH WIDTHS NTHCHAR DUMMYWIDTH)
+                              (\FSETIMAGEWIDTH IMAGEWIDTHS NTHCHAR DUMMYWIDTH)
+                              (GO L2)))                      (* ; 
 
                                        "\ACCHARPOSLIST returns NIL if no raster exists for the code")

-
-                      (SETQ BBOX (fetch
 BBOX of
 BBLIST))
-                      (COND
-                         ((AND (ZEROP (fetch
 BBDX of
 BBLIST))
-                               (ZEROP (fetch
 BBDY of
 BBLIST)))
+                          (SETQ BBOX (fetch
 BBOX of
 BBLIST))
+                          (COND
+                             ((AND (ZEROP (fetch
 BBDX of
 BBLIST))
+                                   (ZEROP (fetch
 BBDY of
 BBLIST)))
                                                              (* ; 
 
                          "The image is zero wide or zero high.  Don't bother reading a bitmap image")

+                              )
+                             ((SETQ BBBITMAP (BITMAPCREATE (TIMES 16 (FOLDLO RASTERINFO 1024))
+                                                    (IMOD RASTERINFO 1024)))
+                              (SETQ BBBMBASE (fetch
 BITMAPBASE of
 BBBITMAP))
 
-                          )
-                         ((SETQ BBBITMAP (BITMAPCREATE (TIMES 16 (FOLDLO RASTERINFO 1024))
-                                                (IMOD RASTERINFO 1024)))
-                          (SETQ BBBMBASE (fetch
 BITMAPBASE of
 BBBITMAP))
-          
-          (* ;; "STARTWORD is the characters raster information word.  The high 6 bits record number of words per scan line and the lower 10 bits is the same as bbdx bbdx.  The raster for the char follows STARTWORD")

+                              (* ;; "STARTWORD is the characters raster information word.  The high 6 bits record number of words per scan line and the lower 10 bits is the same as bbdx bbdx.  The raster for the char follows STARTWORD")

 
-                          (\BINS STRM BBBMBASE 0 (TIMES 2 (FOLDLO RASTERINFO 1024)
-                                                        (IMOD RASTERINFO 1024)))
-                          (SETQ BBBITMAP (\ACROTATECHAR
 BBBITMAP))
+                              (\BINS STRM BBBMBASE 0 (TIMES 2 (FOLDLO RASTERINFO 1024)
+                                                            (IMOD RASTERINFO 1024)))
+                              (SETQ BBBITMAP (\ACROTATECHAR
 BBBITMAP))
                                                              (* ; 
 
    "here is the place to add a rotation function to manipulate the character images coming off *.ac")

-
-                          (BITBLT BBBITMAP 0 0 CHARBITMAP [PLUS DESTLEFT (IMAX 0
-                                                                               (COND
-                                                                                  (PAD.LEFT
-                                                                                   (ADD1 BBOX))
-                                                                                  (T BBOX]
-                                 (DIFFERENCE (fetch
 BBOY of
 BBLIST)
-                                        (fetch
 (FONTBOUNDINGBOX FBBBOY) of
 FBBLIST))
-                                 (\FGETWIDTH IMAGEWIDTHS NTHCHAR)
-                                 (CADDDR BBLIST)
-                                 'INPUT
-                                 'REPLACE)                   (* ; 
+                              (BITBLT BBBITMAP 0 0 CHARBITMAP [PLUS DESTLEFT
+                                                                    (IMAX 0 (COND
+                                                                               (PAD.LEFT (ADD1 BBOX))
+                                                                               (T BBOX]
+                                     (DIFFERENCE (fetch
 BBOY of
 BBLIST)
+                                            (fetch
 (FONTBOUNDINGBOX FBBBOY) of
 FBBLIST))
+                                     (\FGETWIDTH IMAGEWIDTHS NTHCHAR)
+                                     (CADDDR BBLIST)
+                                     'INPUT
+                                     'REPLACE)               (* ; 
 
                       "ADD1 to BBOX because we add an empty column to each raster image to the left")

+                              ))
+                          (\FSETOFFSET OFFSETS NTHCHAR DESTLEFT)
 
-                          ))
-                      (\FSETOFFSET OFFSETS NTHCHAR DESTLEFT)
-          
-          (* ;; "on screen ac fonts, there are no spaces stored so that the width of the char is exactly that of the character image without any spacing columns")

+                     (* ;; "on screen ac fonts, there are no spaces stored so that the width of the char is exactly that of the character image without any spacing columns")

 
-                      (add
 DESTLEFT (\FGETWIDTH IMAGEWIDTHS NTHCHAR))
-                  L2                                         (* ; 
+                          (add
 DESTLEFT (\FGETWIDTH IMAGEWIDTHS NTHCHAR))
+                      L2                                     (* ; 
 
          "add 2 because of the two blank columns we add;  one on either side of the ac raster image")

-))
-          (BITBLT NIL 0 0 CHARBITMAP (ADD1 DUMMYCHAROFFSET)
-                 0
-                 (IDIFFERENCE DUMMYWIDTH 2)
-                 NIL
-                 'TEXTURE
-                 'REPLACE BLACKSHADE)                        (* ; 
+                     ))
+              (BITBLT NIL 0 0 CHARBITMAP (ADD1 DUMMYCHAROFFSET)
+                     0
+                     (IDIFFERENCE DUMMYWIDTH 2)
+                     NIL
+                     'TEXTURE
+                     'REPLACE BLACKSHADE)                    (* ; 
 
                                                             "Fill in the dummy-character black blot")

-
-          (RETURN CSINFO])
+              (RETURN CSINFO)))])
 
 (\ACCHARIMAGELIST

   [LAMBDA (BOXLIST)
                                          (* jds "15-Jun-85 11:37")

@@ -595,51 +620,48 @@ Copyright (c) 1984, 1985, 1986, 1987, 1990 by Venue & Xerox Corporation.  All ri
     (HELP])
 )
 
-(RPAQ? INTERPRESSFONTDIRECTORIES
 '("{Erinyes}<Lyric>Fonts>"))
+(ADDTOVAR DISPLAYCHARSETFNS
 (AC ACFONT.FILEP ACFONT.GETCHARSET))
+
+(RPAQ? INTERPRESSFONTDIRECTORIES
 )
 (DECLARE%: EVAL@COMPILE 
 
 (PUTPROPS \POSITIONFONTFILE
 MACRO

-          ((WSTRM NSMICASIZE FIRSTCHAR LASTCHAR FAMILY FACECODE)

+          ((WSTRM NSMICASIZE FIRSTCHAR LASTCHAR FAMILY FACECODE)
                                                              (* gbn "25-Jul-85 02:15")

-                                                             (* ; 
-
                                        "sets FIRSTCHAR LASTCHAR, and positions the file correctly")

-
-           (* ;; "Finds the widths information for the specified FAMILY, FACECODE, MSIZE, and ROTATION.  FIRSTCHAR and LASTCHAR are passed in since we have to read past those to check the size.  If successful, returns the size found in the widths file, with zero indicating that dimensions in the widths file are relative, leaving the file pointing just after the Rotation word of the font.  --- --- Returns NIL if the font is not found")

-
            (bind
 TYPE LENGTH SIZE FAMCODE FILEFAM FILEFACE (NEXT _ 0)
               first
 (OR (SETQ FAMCODE (\FAMILYCODE
 (OR FAMILY T)
-                                                 WSTRM))
-                            (RETURN NIL))
+                                             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))      (* ; "This is the right family/face")

-                           [COND
-                              ((OR (EQ FAMILY T)
-                                   (EQ FAMILY NIL)
-                                   (AND (IEQP FILEFAM FAMCODE)
-                                        (IEQP FILEFACE FACECODE)))
-                               (SETQ FIRSTCHAR (\BIN WSTRM))
-                               (SETQ LASTCHAR (\BIN WSTRM))
-                               (COND
-                                  ((AND (OR (ZEROP (SETQ SIZE (\WIN WSTRM)))
-                                            (LESSP (ABS (FQUOTIENT (IDIFFERENCE NSMICASIZE SIZE)
-                                                               NSMICASIZE))
-                                                   0.02))
-                                        (ZEROP (\WIN WSTRM)))
-                                   (RETURN SIZE])
-                        (0 (RETURN NIL))
-                        NIL)
-                    (SETFILEPTR WSTRM NEXT))))
+                 (SETQ LENGTH (\BIN WSTRM))
+                 (add
 NEXT (LLSH (IPLUS LENGTH (LLSH (LOGAND TYPE 15)
+                                                     8))
+                                 1))
+                 (SELECTQ (LRSH TYPE 4)
+                     (4 (SETQ FILEFAM (\BIN WSTRM))
+                        (SETQ FILEFACE (\BIN WSTRM))
+                        [COND
+                           ((OR (EQ FAMILY T)
+                                (EQ FAMILY NIL)
+                                (AND (IEQP FILEFAM FAMCODE)
+                                     (IEQP FILEFACE FACECODE)))
+                            (SETQ FIRSTCHAR (\BIN WSTRM))
+                            (SETQ LASTCHAR (\BIN WSTRM))
+                            (COND
+                               ((AND (OR (ZEROP (SETQ SIZE (\WIN WSTRM)))
+                                         (LESSP (ABS (FQUOTIENT (IDIFFERENCE NSMICASIZE SIZE)
+                                                            NSMICASIZE))
+                                                0.02))
+                                     (ZEROP (\WIN WSTRM)))
+                                (RETURN SIZE])
+                     (0 (RETURN NIL))
+                     NIL)
+                 (SETFILEPTR WSTRM NEXT))))
 )
-(PUTPROPS AFONT COPYRIGHT ("Venue & Xerox Corporation" 1984 1985 1986 1987 1990))
 (DECLARE%: DONTCOPY
-  (FILEMAP (NIL (2792 38939 (\CREATESTARFONT 2802 . 4480) (\READACFONTBOXES 4482 . 6709) (
-\READACFONTFILE 6711 . 18604) (\ACCHARIMAGELIST 18606 . 18963) (\ACCHARWIDTHLIST 18965 . 20231) (
-\GETFBB 20233 . 23513) (\ACCHARPOSLIST 23515 . 24565) (\ACROTATECHAR 24567 . 25131) (\READFONTWDFILE 
-25133 . 33166) (\FACECODE 33168 . 33762) (\FAMILYCODE 33764 . 35068) (\FINDFONT 35070 . 38937)))))
+  (FILEMAP (NIL (2849 41269 (ACFONT.FILEP 2859 . 3743) (ACFONT.GETCHARSET 3745 . 4137) (\CREATESTARFONT 
+4139 . 5862) (\READACFONTBOXES 5864 . 8091) (\READACFONTFILE 8093 . 20934) (\ACCHARIMAGELIST 20936 . 
+21293) (\ACCHARWIDTHLIST 21295 . 22561) (\GETFBB 22563 . 25843) (\ACCHARPOSLIST 25845 . 26895) (
+\ACROTATECHAR 26897 . 27461) (\READFONTWDFILE 27463 . 35496) (\FACECODE 35498 . 36092) (\FAMILYCODE 
+36094 . 37398) (\FINDFONT 37400 . 41267)))))
 STOP

sources/APUTDQ

@@ -1,18 +1,14 @@
 (DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
 
-
(FILECREATED "16-Jan-2025 13:35:20" {DSK}<home>matt>Interlisp>medley>sources>APUTDQ.;2
 10901  
+
(FILECREATED "11-Jun-2025 08:43:36" {WMEDLEY}<sources>APUTDQ.;5
 10433  
 
-      :EDIT-BY "mth"
+      :EDIT-BY rmk
 
-      :CHANGES-TO (FNS LOADUP)
+      :CHANGES-TO (VARS APUTDQCOMS)
 
-      :PREVIOUS-DATE "25-Oct-2022 11:44:17" {DSK}<home>matt>Interlisp>medley>sources>APUTDQ.;1)
+      :PREVIOUS-DATE "23-May-2025 09:03:46" {WMEDLEY}<sources>APUTDQ.;4)
 
 
-(* ; "
-Copyright (c) 1981-1988, 1990, 2021-2022, 2025 by Venue & Xerox Corporation.
-")
-
 (PRETTYCOMPRINT APUTDQCOMS)
 
 (RPAQQ APUTDQCOMS

@@ -33,10 +29,8 @@ Copyright (c) 1981-1988, 1990, 2021-2022, 2025 by Venue & Xerox Corporation.
                (LOGINHOST/DIR '{DSK}))
         (FNS LOADUP ENDLOADUP)
         (ALISTS (SYSTEMINITVARS \CONNECTED.DIRECTORY DWIMFLG ADDSPELLFLG FILEPKGFLG BUILDMAPFLG 
-                       UPDATEMAPFLG DEFAULTREGISTRY DEFAULTPRINTINGHOST DIRECTORIES USERGREETFILES 
-                       NETWORKOSTYPES CH.NET.HINT CH.DEFAULT.DOMAIN CH.DEFAULT.ORGANIZATION 
-                       ADVISEDFNS LISPUSERSDIRECTORIES DISPLAYFONTDIRECTORIES DISPLAYFONTEXTENSIONS 
-                       INTERPRESSFONTDIRECTORIES))
+                       UPDATEMAPFLG DEFAULTREGISTRY DEFAULTPRINTINGHOST NETWORKOSTYPES CH.NET.HINT 
+                       CH.DEFAULT.DOMAIN CH.DEFAULT.ORGANIZATION ADVISEDFNS))
         [DECLARE%: DONTEVAL@LOAD DOCOPY 
 
                (* ;; "many of these are obsolete and can be removed, but it is unclear which ones")

@@ -173,26 +167,19 @@ Copyright (c) 1981-1988, 1990, 2021-2022, 2025 by Venue & Xerox Corporation.
     (CLRPROMPT])
 )
 
-(ADDTOVAR SYSTEMINITVARS

-          (\CONNECTED.DIRECTORY . {DSK})
-          (DWIMFLG . T)
-          (ADDSPELLFLG . T)
-          (FILEPKGFLG . T)
-          (BUILDMAPFLG . T)
-          (UPDATEMAPFLG . T)
-          (DEFAULTREGISTRY)
-          (DEFAULTPRINTINGHOST)
-          (DIRECTORIES)
-          (USERGREETFILES)
-          (NETWORKOSTYPES)
-          (CH.NET.HINT)
-          (CH.DEFAULT.DOMAIN)
-          (CH.DEFAULT.ORGANIZATION)
-          (ADVISEDFNS)
-          (LISPUSERSDIRECTORIES {DSK})
-          (DISPLAYFONTDIRECTORIES {DSK})
-          (DISPLAYFONTEXTENSIONS DISPLAYFONT)
-          (INTERPRESSFONTDIRECTORIES {DSK}))
+(ADDTOVAR SYSTEMINITVARS
 (\CONNECTED.DIRECTORY . {DSK})
+                         (DWIMFLG . T)
+                         (ADDSPELLFLG . T)
+                         (FILEPKGFLG . T)
+                         (BUILDMAPFLG . T)
+                         (UPDATEMAPFLG . T)
+                         (DEFAULTREGISTRY)
+                         (DEFAULTPRINTINGHOST)
+                         (NETWORKOSTYPES)
+                         (CH.NET.HINT)
+                         (CH.DEFAULT.DOMAIN)
+                         (CH.DEFAULT.ORGANIZATION)
+                         (ADVISEDFNS))
 (DECLARE%: DONTEVAL@LOAD DOCOPY 
 
 (DUMMYDEF (ADDSTATS *
)
@@ -261,10 +248,8 @@ Copyright (c) 1981-1988, 1990, 2021-2022, 2025 by Venue & Xerox Corporation.
 
 (ADDTOVAR LAMA
 )
 )
-(PUTPROPS APUTDQ COPYRIGHT ("Venue & Xerox Corporation" 1981 1982 1983 1984 1985 1986 1987 1988 1990 
-2021 2022 2025))
 (DECLARE%: DONTCOPY
-  (FILEMAP (NIL (3999 6207 (GREETFILENAME 4009 . 5882) (FAULTEVAL 5884 . 5956) (FAULTAPPLY 5958 . 6044) 
-(ERRORX 6046 . 6112) (SET-DOCUMENTATION 6114 . 6205)) (6208 7228 (SMASHFILECOMS 6218 . 6560) (
-SMASHFILECOMSLST 6562 . 7226)) (7322 8926 (LOADUP 7332 . 7916) (ENDLOADUP 7918 . 8924)))))
+  (FILEMAP (NIL (3701 5909 (GREETFILENAME 3711 . 5584) (FAULTEVAL 5586 . 5658) (FAULTAPPLY 5660 . 5746) 
+(ERRORX 5748 . 5814) (SET-DOCUMENTATION 5816 . 5907)) (5910 6930 (SMASHFILECOMS 5920 . 6262) (
+SMASHFILECOMSLST 6264 . 6928)) (7024 8628 (LOADUP 7034 . 7618) (ENDLOADUP 7620 . 8626)))))
 STOP

sources/FILESETS

@@ -1,9 +1,14 @@
 (DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
 
-
(FILECREATED "23-May-2023 08:11:56" {DSK}<home>larry>il>medley>sources>FILESETS.;24

-      :EDIT-BY "lmm"
+
(FILECREATED "17-Jul-2025 12:07:14" {DSK}<Users>kaplan>Local>medley3.5>git-medley>sources>FILESETS.;15
 6295   
+
+      :EDIT-BY rmk
+
+      :CHANGES-TO (VARS EXPORTFILES 0LISPSET)
+
+      :PREVIOUS-DATE "17-Jul-2025 09:32:58" 
+{DSK}<Users>kaplan>Local>medley3.5>git-medley>sources>FILESETS.;14)
 
-      :PREVIOUS-DATE " 1-Mar-2023 07:49:03" {DSK}<home>larry>il>medley>sources>FILESETS.;23)
 
 (PRETTYCOMPRINT FILESETSCOMS)
 
@@ -53,8 +58,8 @@
        (ASTACK DTDECLARE ATBL LLCODE ACODE COREIO AOFD ADIR PMAP VANILLADISK ATERM APRINT ABASIC 
               AERROR AINTERRUPT MISC BOOTSTRAP CMLMACROS CMLEVAL CMLPROGV CMLSPECIALFORMS LLRESTART 
               LLERROR LLSYMBOL LLPACKAGE PACKAGE-STARTUP CONDITION-PACKAGE XCL-PACKAGE PROC CMLARRAY
-              DSK UFS UFSCALLC PASSWORDS FONT LLDISPLAY APUTDQ COMPATIBILITY DMISC CMLMACROS CMLLIST
-              CMLCHARACTER CMLREADTABLE MAIKOLOADUPFNS MAIKOBITBLT MAIKOINIT))
+              DSK UFS UFSCALLC PASSWORDS FONT MEDLEYFONTFORMAT APUTDQ COMPATIBILITY DMISC CMLMACROS 
+              CMLLIST CMLCHARACTER CMLREADTABLE MAIKOLOADUPFNS MAIKOBITBLT MAIKOINIT LLDISPLAY))
 
 (RPAQQ 2LISPSET
 (MACHINEINDEPENDENT))
 
@@ -65,7 +70,7 @@
               LLCHAR LLSTK PMAP LLGC ATBL FILEIO EXTERNALFORMAT LLARITH LLFLOAT FONT LLKEY LLDISPLAY
               ADISPLAY AINTERRUPT RENAMEMACROS HLDISPLAY WINDOW MACROAUX ADDARITH LLFAULT LLTIMER 
               IMAGEIO PROC XCCS PASSWORDS INTERPRESS HARDCOPY CMLARRAY LLSUBRS LLETHER PUP UFS 
-              DTDECLARE BIGBITMAPS))
+              DTDECLARE))
 
 (RPAQQ MAKEINITFILES
 (MAKEINIT MEM I-NEW))
 

sources/HARDCOPY

@@ -1,10 +1,12 @@
 (DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
 
-
(FILECREATED " 6-Apr-2024 20:46:31" {WMEDLEY}<sources>HARDCOPY.;18
 156634 
+
(FILECREATED "14-Jul-2025 23:00:56" {WMEDLEY}<sources>HARDCOPY.;20
 156777 
 
       :EDIT-BY rmk
 
-      :PREVIOUS-DATE " 6-Mar-2024 13:15:30" {WMEDLEY}<sources>HARDCOPY.;16)
+      :CHANGES-TO (FNS \DSPFONT.HCPYMODE)
+
+      :PREVIOUS-DATE " 5-Jul-2025 18:52:09" {WMEDLEY}<sources>HARDCOPY.;19)
 
 
 (PRETTYCOMPRINT HARDCOPYCOMS)
@@ -1873,7 +1875,9 @@
            (\DASHINGCONVERT.HCPYMODE
 DASHING])
 
 (\DSPFONT.HCPYMODE

-  [LAMBDA (HDCPYDSTREAM FONT)
                                (* ; "Edited 20-Apr-88 11:53 by jds")

+  [LAMBDA (HDCPYDSTREAM FONT)
                                (* ; "Edited 14-Jul-2025 23:00 by rmk")


+                                                             (* ; "Edited  5-Jul-2025 18:49 by rmk")


+                                                             (* ; "Edited 20-Apr-88 11:53 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}")

 
@@ -1882,10 +1886,9 @@
 
            "save old value to return, smash new value and update the bitchar portion of the record.")

           (RETURN (PROG1 (SETQ OLDFONT (fetch
 DDFONT of
 DD))
                       [COND
-                         (FONT (SETQ XFONT (OR (\GETFONTDESC FONT (fetch
 IMFONTCREATE
-                                                                     of
 (fetch
 IMAGEOPS of
 
-                                                                                         HDCPYDSTREAM
-                                                                               ))
+                         (FONT (SETQ XFONT (OR (FONTCREATE FONT NIL NIL NIL
+                                                      (fetch
 IMFONTCREATE
+                                                         of
 (fetch
 IMAGEOPS of
 HDCPYDSTREAM))
                                                       T)
                                                (FONTCOPY (ffetch
 DDFONT of
 DD)
                                                       FONT)))(* ; 
@@ -2516,40 +2519,40 @@
 (ADDTOVAR LAMA
 )
 )
 (DECLARE%: DONTCOPY
-  (FILEMAP (NIL (6190 12028 (HARDCOPY.SOMEHOW 6200 . 7566) (HARDCOPYIMAGEW 7568 . 7789) (
-HARDCOPYIMAGEW.TOFILE 7791 . 8099) (HARDCOPYIMAGEW.TOPRINTER 8101 . 9348) (HARDCOPYREGION.TOFILE 9350
- . 9892) (HARDCOPYREGION.TOPRINTER 9894 . 11007) (COPY.WINDOW.TO.BITMAP 11009 . 12026)) (12100 23887 (
-MakeMenuOfPrinters 12110 . 13642) (PRINTERS.WHENSELECTEDFN 13644 . 15267) (MakeMenuOfImageTypes 15269
- . 16088) (GetNewPrinterFromUser 16090 . 16532) (PopUpWindowAndGetAtom 16534 . 17985) (
-PopUpWindowAndGetList 17987 . 19557) (NewPrinter 19559 . 21058) (GetPrinterName 21060 . 21348) (
-GetImageFile 21350 . 23635) (FetchDefaultPrinter 23637 . 23885)) (23922 24687 (
-ExtensionForPrintFileType 23932 . 24179) (PRINTFILETYPE.FROM.EXTENSION 24181 . 24685)) (24742 45126 (
-DEFAULTPRINTER 24752 . 24992) (CAN.PRINT.DIRECTLY 24994 . 25190) (CONVERT.FILE.TO.TYPE.FOR.PRINTER 
-25192 . 26929) (EMPRESS 26931 . 27506) (HARDCOPYW 27508 . 32510) (LISTFILES1 32512 . 32689) (
-PRINTER.BITMAPFILE 32691 . 33080) (PRINTER.BITMAPSCALE 33082 . 33566) (PRINTER.SCRATCH.FILE 33568 . 
-33738) (PRINTERPROP 33740 . 33990) (PRINTERSTATUS 33992 . 34267) (PRINTERTYPE 34269 . 36839) (
-PRINTERNAME 36841 . 37262) (PRINTFILEPROP 37264 . 37520) (PRINTFILETYPE 37522 . 39478) (
-\EXPECTED.FILE.TYPE 39480 . 40270) (SEND.FILE.TO.PRINTER 40272 . 45124)) (45127 49746 (PRINTERDEVICE 
-45137 . 49744)) (50581 58826 (TEXTTOIMAGEFILE 50591 . 52787) (COPY.TEXT.TO.IMAGE 52789 . 58824)) (
-58827 60570 (\BLTSHADE.GENERICPRINTER 58837 . 60568)) (60698 96699 (MAKEHARDCOPYSTREAM 60708 . 62260) 
-(UNMAKEHARDCOPYSTREAM 62262 . 63192) (HARDCOPYSTREAMTYPE 63194 . 63528) (\CHARWIDTH.HDCPYDISPLAY 63530
- . 64262) (\DSPFONT.HDCPYDISPLAY 64264 . 66976) (\DSPRIGHTMARGIN.HDCPYDISPLAY 66978 . 67734) (
-\DSPXPOSITION.HDCPYDISPLAY 67736 . 68111) (\DSPYPOSITION.HDCPYDISPLAY 68113 . 68488) (
-\STRINGWIDTH.HDCPYDISPLAY 68490 . 69357) (\STRINGWIDTH.HCPYDISPLAYAUX 69359 . 74581) (\HDCPYBLTCHAR 
-74583 . 79575) (\HDCPYDISPLAY.FIX.XPOS 79577 . 80235) (\HDCPYDISPLAY.FIX.YPOS 80237 . 80895) (
-\HDCPYDISPLAYINIT 80897 . 82490) (\HDCPYDSPPRINTCHAR 82492 . 88405) (\SLOWHDCPYBLTCHAR 88407 . 94911) 
-(\CHANGECHARSET.HDCPYDISPLAY 94913 . 96697)) (97200 97341 (\MICASTOPTS 97200 . 97341)) (97512 156070 (
-MAKEHARDCOPYMODESTREAM 97522 . 100555) (UNMAKEHARDCOPYMODESTREAM 100557 . 102318) (\BLTSHADE.HCPYMODE 
-102320 . 102986) (\BITBLT.HCPYMODE 102988 . 103736) (\BRUSHCONVERT.HCPYMODE 103738 . 104287) (
-\CHANGECHARSET.HCPYMODE 104289 . 107384) (\DASHINGCONVERT.HCPYMODE 107386 . 107727) (
-\CHARWIDTH.HCPYMODE 107729 . 108166) (\DRAWLINE.HCPYMODE 108168 . 108697) (\DRAWCURVE.HCPYMODE 108699
- . 109286) (\DRAWCIRCLE.HCPYMODE 109288 . 109773) (\DRAWELLIPSE.HCPYMODE 109775 . 110459) (
-\DSPFONT.HCPYMODE 110461 . 113045) (\DSPLEFTMARGIN.HCPYMODE 113047 . 113789) (\DSPLINEFEED.HCPYMODE 
-113791 . 114424) (\DSPRIGHTMARGIN.HCPYMODE 114426 . 115494) (\DSPSPACEFACTOR.HCPYMODE 115496 . 116271)
- (\DSPXPOSITION.HCPYMODE 116273 . 117291) (\DSPYPOSITION.HCPYMODE 117293 . 117943) (\MOVETO.HCPYMODE 
-117945 . 118159) (\FONTCREATE.HCPYMODE.PRESS 118161 . 120298) (\CREATECHARSET.HCPYMODE.PRESS 120300 . 
-121922) (\FONTCREATE.HCPYMODE.INTERPRESS 121924 . 123998) (\CREATECHARSET.HCPYMODE.INTERPRESS 124000
- . 125522) (\STRINGWIDTH.HCPYMODE 125524 . 126231) (\HCPYMODEBLTCHAR 126233 . 131983) (
-\HCPYMODEDISPLAYINIT 131985 . 140117) (\HCPYMODEDSPPRINTCHAR 140119 . 146053) (\SLOWHCPYMODEBLTCHAR 
-146055 . 152572) (\SFFixY.HCPYMODE 152574 . 156068)))))
+  (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)))))
 STOP

sources/IMAGEIO

@@ -1,13 +1,15 @@
 (DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
 
-
(FILECREATED " 8-Dec-2023 21:42:20" {WMEDLEY}<sources>IMAGEIO.;8
 79284  
+
(FILECREATED "21-Jun-2025 11:48:01" {WMEDLEY}<sources>IMAGEIO.;11
 79830  
 
       :EDIT-BY rmk
 
-      :CHANGES-TO (FNS \IMAGEIOINIT)
-                  (RECORDS IMAGEOPS)
+      :CHANGES-TO (ALISTS (IMAGESTREAMTYPES DISPLAY)
+                         (IMAGESTREAMTYPES 4DISPLAY)
+                         (IMAGESTREAMTYPES 8DISPLAY)
+                         (IMAGESTREAMTYPES 24DISPLAY))
 
-      :PREVIOUS-DATE "30-Oct-2021 19:09:48" {WMEDLEY}<sources>IMAGEIO.;7)
+      :PREVIOUS-DATE "15-Jun-2025 20:46:26" {WMEDLEY}<sources>IMAGEIO.;10)
 
 
 (PRETTYCOMPRINT IMAGEIOCOMS)
@@ -1472,16 +1474,24 @@
 (ADDTOVAR IMAGESTREAMTYPES

           (DISPLAY (OPENSTREAM OPENDISPLAYSTREAM)
                  (FONTCREATE \CREATEDISPLAYFONT)
-                 (FONTSAVAILABLE \SEARCHDISPLAYFONTFILES))
+                 (FONTSAVAILABLE \SEARCHFONTFILES)
+                 (CREATECHARSET \CREATECHARSET.DISPLAY)
+                 (FONTEXISTS? \FONTEXISTS?.DISPLAY))
           (4DISPLAY (OPENSTREAM OPENDISPLAYSTREAM)
                  (FONTCREATE \CREATEDISPLAYFONT)
-                 (FONTSAVAILABLE \SEARCHDISPLAYFONTFILES))
+                 (FONTSAVAILABLE \SEARCHFONTFILES)
+                 (CREATECHARSET \CREATECHARSET.DISPLAY)
+                 (FONTEXISTS? \FONTEXISTS?.DISPLAY))
           (8DISPLAY (OPENSTREAM OPENDISPLAYSTREAM)
                  (FONTCREATE \CREATEDISPLAYFONT)
-                 (FONTSAVAILABLE \SEARCHDISPLAYFONTFILES))
+                 (FONTSAVAILABLE \SEARCHFONTFILES)
+                 (CREATECHARSET \CREATECHARSET.DISPLAY)
+                 (FONTEXISTS? \FONTEXISTS?.DISPLAY))
           (24DISPLAY (OPENSTREAM OPENDISPLAYSTREAM)
                  (FONTCREATE \CREATEDISPLAYFONT)
-                 (FONTSAVAILABLE \SEARCHDISPLAYFONTFILES)))
+                 (FONTSAVAILABLE \SEARCHFONTFILES)
+                 (CREATECHARSET \CREATECHARSET.DISPLAY)
+                 (FONTEXISTS? \FONTEXISTS?.DISPLAY)))
 (DECLARE%: DOEVAL@COMPILE DONTCOPY
 
 (GLOBALVARS DisplayFDEV \4DISPLAYFDEV \8DISPLAYFDEV \24DISPLAYFDEV)
@@ -1505,24 +1515,24 @@
 (ADDTOVAR LAMA
 IMAGESTREAMP)
 )
 (DECLARE%: DONTCOPY
-  (FILEMAP (NIL (3234 11991 (IMAGESTREAMP 3244 . 4076) (IMAGESTREAMTYPE 4078 . 4291) (IMAGESTREAMTYPEP 
-4293 . 4928) (OPENIMAGESTREAM 4930 . 9884) (\GOOD.DASHLST 9886 . 11989)) (12026 14323 (DRAWDASHEDLINE 
-12036 . 14321)) (14324 21664 (DSPBACKCOLOR 14334 . 14706) (DSPBOTTOMMARGIN 14708 . 15093) (DSPCOLOR 
-15095 . 15459) (DSPCLIPPINGREGION 15461 . 16166) (DSPRESET 16168 . 16448) (DSPFONT 16450 . 16814) (
-DSPLEFTMARGIN 16816 . 17197) (DSPLINEFEED 17199 . 17499) (DSPOPERATION 17501 . 17878) (DSPRIGHTMARGIN 
-17880 . 18263) (DSPTOPMARGIN 18265 . 18644) (DSPSCALE 18646 . 19013) (DSPSPACEFACTOR 19015 . 19408) (
-DSPXPOSITION 19410 . 19715) (DSPYPOSITION 19717 . 20022) (DSPROTATE 20024 . 20319) (DSPPUSHSTATE 20321
- . 20567) (DSPPOPSTATE 20569 . 20812) (DSPDEFAULTSTATE 20814 . 21066) (DSPSCALE2 21068 . 21359) (
-DSPTRANSLATE 21361 . 21662)) (21665 30466 (DSPNEWPAGE 21675 . 22367) (DRAWBETWEEN 22369 . 23071) (
-DRAWCIRCLE 23073 . 23569) (DRAWARC 23571 . 24088) (DRAWCURVE 24090 . 24767) (DRAWELLIPSE 24769 . 25555
-) (DRAWLINE 25557 . 25947) (DRAWPOLYGON 25949 . 26404) (DRAWPOINT 26406 . 26825) (FILLPOLYGON 26827 . 
-27393) (DRAWTO 27395 . 27813) (FILLCIRCLE 27815 . 28038) (MOVETO 28040 . 28404) (RELDRAWTO 28406 . 
-29323) (BITMAPIMAGESIZE 29325 . 29496) (SCALEDBITBLT 29498 . 30464)) (30467 37506 (\DRAWPOINT.GENERIC 
-30477 . 30824) (\DRAWPOLYGON.GENERIC 30826 . 33134) (\DRAWCIRCLE.GENERIC 33136 . 34794) (
-\DRAWELLIPSE.GENERIC 34796 . 37504)) (37507 42451 (\IMAGEIOINIT 37517 . 40797) (\NOIMAGE.DSPFONT 40799
- . 42285) (\UNIMPIMAGEOP 42287 . 42449)) (42574 45698 (INSURE.BRUSH 42584 . 43958) (BRUSHP 43960 . 
-44750) (\POSSIBLECOLOR 44752 . 45303) (NEGSHADE 45305 . 45696)) (46254 46938 (DASHINGP 46264 . 46594) 
-(INSURE.DASHING 46596 . 46936)) (57676 78222 (\DisplayEventFn 57686 . 58196) (\DISPLAYINIT 58198 . 
-63781) (\4DISPLAYINIT 63783 . 68484) (\8DISPLAYINIT 68486 . 73189) (\24DISPLAYINIT 73191 . 77963) (
-\DISPLAYSTREAMTYPEBPP 77965 . 78220)))))
+  (FILEMAP (NIL (3376 12133 (IMAGESTREAMP 3386 . 4218) (IMAGESTREAMTYPE 4220 . 4433) (IMAGESTREAMTYPEP 
+4435 . 5070) (OPENIMAGESTREAM 5072 . 10026) (\GOOD.DASHLST 10028 . 12131)) (12168 14465 (
+DRAWDASHEDLINE 12178 . 14463)) (14466 21806 (DSPBACKCOLOR 14476 . 14848) (DSPBOTTOMMARGIN 14850 . 
+15235) (DSPCOLOR 15237 . 15601) (DSPCLIPPINGREGION 15603 . 16308) (DSPRESET 16310 . 16590) (DSPFONT 
+16592 . 16956) (DSPLEFTMARGIN 16958 . 17339) (DSPLINEFEED 17341 . 17641) (DSPOPERATION 17643 . 18020) 
+(DSPRIGHTMARGIN 18022 . 18405) (DSPTOPMARGIN 18407 . 18786) (DSPSCALE 18788 . 19155) (DSPSPACEFACTOR 
+19157 . 19550) (DSPXPOSITION 19552 . 19857) (DSPYPOSITION 19859 . 20164) (DSPROTATE 20166 . 20461) (
+DSPPUSHSTATE 20463 . 20709) (DSPPOPSTATE 20711 . 20954) (DSPDEFAULTSTATE 20956 . 21208) (DSPSCALE2 
+21210 . 21501) (DSPTRANSLATE 21503 . 21804)) (21807 30608 (DSPNEWPAGE 21817 . 22509) (DRAWBETWEEN 
+22511 . 23213) (DRAWCIRCLE 23215 . 23711) (DRAWARC 23713 . 24230) (DRAWCURVE 24232 . 24909) (
+DRAWELLIPSE 24911 . 25697) (DRAWLINE 25699 . 26089) (DRAWPOLYGON 26091 . 26546) (DRAWPOINT 26548 . 
+26967) (FILLPOLYGON 26969 . 27535) (DRAWTO 27537 . 27955) (FILLCIRCLE 27957 . 28180) (MOVETO 28182 . 
+28546) (RELDRAWTO 28548 . 29465) (BITMAPIMAGESIZE 29467 . 29638) (SCALEDBITBLT 29640 . 30606)) (30609 
+37648 (\DRAWPOINT.GENERIC 30619 . 30966) (\DRAWPOLYGON.GENERIC 30968 . 33276) (\DRAWCIRCLE.GENERIC 
+33278 . 34936) (\DRAWELLIPSE.GENERIC 34938 . 37646)) (37649 42593 (\IMAGEIOINIT 37659 . 40939) (
+\NOIMAGE.DSPFONT 40941 . 42427) (\UNIMPIMAGEOP 42429 . 42591)) (42716 45840 (INSURE.BRUSH 42726 . 
+44100) (BRUSHP 44102 . 44892) (\POSSIBLECOLOR 44894 . 45445) (NEGSHADE 45447 . 45838)) (46396 47080 (
+DASHINGP 46406 . 46736) (INSURE.DASHING 46738 . 47078)) (57818 78364 (\DisplayEventFn 57828 . 58338) (
+\DISPLAYINIT 58340 . 63923) (\4DISPLAYINIT 63925 . 68626) (\8DISPLAYINIT 68628 . 73331) (
+\24DISPLAYINIT 73333 . 78105) (\DISPLAYSTREAMTYPEBPP 78107 . 78362)))))
 STOP

sources/INTERPRESS

@@ -1,13 +1,16 @@
 (DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
 
-
(FILECREATED "21-Dec-2024 19:05:30" {WMEDLEY}<sources>INTERPRESS.;44
 220448 
+
(FILECREATED "14-Jul-2025 23:31:04" 
+{DSK}<Users>kaplan>Local>medley3.5>git-medley>sources>INTERPRESS.;11
 220765 
 
       :EDIT-BY rmk
 
-      :CHANGES-TO (VARS \ASCII2XCCSMAP INTERPRESSCOMS)
-                  (FNS \ASCIIMAPARRAY \ASCIITONS \ASCII2XCCS \ASCII2MCCS \CREATEINTERPRESSFONT)
+      :CHANGES-TO (VARS INTERPRESSCOMS \SYMBOLTONSARRAY HIPPOTONSARRAY CYRILLICTONSARRAY 
+                        \MATHTONSARRAY)
+                  (FNS \DSPFONT.IP)
 
-      :PREVIOUS-DATE "20-Dec-2024 13:43:13" {WMEDLEY}<sources>INTERPRESS.;36)
+      :PREVIOUS-DATE "13-Jul-2025 23:11:52" 
+{DSK}<Users>kaplan>Local>medley3.5>git-medley>sources>INTERPRESS.;10)
 
 
 (PRETTYCOMPRINT INTERPRESSCOMS)
@@ -2618,7 +2621,9 @@
     ])
 
 (\DSPFONT.IP

-  [LAMBDA (IPSTREAM FONT)
                                    (* ; "Edited  2-May-2023 08:38 by lmm")


+  [LAMBDA (IPSTREAM FONT)
                                    (* ; "Edited 14-Jul-2025 23:30 by rmk")


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


+                                                             (* ; "Edited  2-May-2023 08:38 by lmm")


                                                              (* ; "Edited 21-Aug-91 16:33 by jds")

 
     (* ;; "Change fonts (or return the current font) for an IP stream")

@@ -2630,7 +2635,7 @@
           (SHOW.IP
 IPSTREAM)                                 (* ; 
 
 "ALWAYS do the show, so that font changes force recomputation of the exact position in the printer.")

           (COND
-             ([EQ OLDFONT (SETQ FONT (OR (\GETFONTDESC FONT 'INTERPRESS)
+             ([EQ OLDFONT (SETQ FONT (OR (FONTCREATE FONT NIL NIL NIL 'INTERPRESS)
                                          (FONTCOPY OLDFONT FONT]
                                                              (* ; 
 
                      "There was no change, or he was only asking for the old font.  Just return it.")

@@ -3903,45 +3908,45 @@
 (LOADDEF 'BRUSH 'RECORDS 'IMAGEIO)
 )
 (DECLARE%: DONTCOPY
-  (FILEMAP (NIL (15741 16594 (\IPC 15741 . 16594)) (16827 22479 (APPENDBYTE.IP 16837 . 16973) (
-APPENDIDENTIFIER.IP 16975 . 17497) (APPENDINT.IP 17499 . 17950) (APPENDINTEGER.IP 17952 . 18524) (
-APPENDLARGEVECTOR.IP 18526 . 19491) (APPENDNUMBER.IP 19493 . 19962) (APPENDOP.IP 19964 . 20610) (
-APPENDRATIONAL.IP 20612 . 21105) (APPENDSEQUENCEDESCRIPTOR.IP 21107 . 22302) (BYTESININT.IP 22304 . 
-22477)) (22515 62322 (ARCTO.IP 22525 . 23806) (BEGINMASTER.IP 23808 . 24081) (BEGINPAGE.IP 24083 . 
-24439) (BEGINPREAMBLE.IP 24441 . 24812) (CLIPRECTANGLE.IP 24814 . 25304) (CONCAT.IP 25306 . 25571) (
-CONCATT.IP 25573 . 25840) (ENDMASTER.IP 25842 . 26286) (ENDPAGE.IP 26288 . 26665) (ENDPREAMBLE.IP 
-26667 . 27466) (FGET.IP 27468 . 27771) (FILLRECTANGLE.IP 27773 . 30101) (FILLTRAJECTORY.IP 30103 . 
-30738) (FILLNGON.IP 30740 . 33017) (FSET.IP 33019 . 33322) (GETFRAMEVAR.IP 33324 . 33642) (
-INITIALIZEMASTER.IP 33644 . 34245) (INITIALIZECOLOR.IP 34247 . 35568) (ISET.IP 35570 . 35941) (
-GETCP.IP 35943 . 36252) (LINETO.IP 36254 . 36859) (MASKSTROKE.IP 36861 . 37134) (MOVETO.IP 37136 . 
-37473) (ROTATE.IP 37475 . 37777) (SCALE.IP 37779 . 38082) (SCALE2.IP 38084 . 38421) (SETCOLOR.IP 38423
- . 40652) (SETRGB.IP 40654 . 41710) (SETCOLORLV.IP 41712 . 46325) (SETCOLOR16.IP 46327 . 49433) (
-SETFONT.IP 49435 . 50256) (SETSPACE.IP 50258 . 50570) (SETXREL.IP 50572 . 51756) (SETX.IP 51758 . 
-53275) (SETXY.IP 53277 . 54449) (SETXYREL.IP 54451 . 55757) (SETY.IP 55759 . 57068) (SETYREL.IP 57070
- . 57970) (SHOW.IP 57972 . 61232) (TRAJECTORY.IP 61234 . 61632) (TRANS.IP 61634 . 61973) (TRANSLATE.IP
- 61975 . 62320)) (62353 68443 (\CHANGE-VISIBLE-REGION.IP 62363 . 66024) (\PAPERSIZE.IP 66026 . 66847) 
-(HEADINGOP.IP 66849 . 68441)) (68444 173454 (DEFINEFONT.IP 68454 . 69428) (FONTNAME.IP 69430 . 70360) 
-(INTERPRESS.BITMAPSCALE 70362 . 71171) (INTERPRESS.OUTCHARFN 71173 . 77345) (INTERPRESSFILEP 77347 . 
-78681) (MAKEINTERPRESS 78683 . 78867) (NEWLINE.IP 78869 . 79601) (NEWPAGE.IP 79603 . 84578) (
-NEWPAGE?.IP 84580 . 85059) (OPENIPSTREAM 85061 . 93412) (SETUPFONTS.IP 93414 . 94406) (SHOWBITMAP.IP 
-94408 . 98949) (\BITMAPSIZE.IP 98951 . 99728) (SHOWBITMAP1.IP 99730 . 104102) (SHOWSHADE.IP 104104 . 
-105057) (\BITBLT.IP 105059 . 109263) (\SCALEDBITBLT.IP 109265 . 112910) (\BLTSHADE.IP 112912 . 114370)
- (\CHARWIDTH.IP 114372 . 114822) (\CLOSEIPSTREAM 114824 . 115151) (\DRAWARC.IP 115153 . 115600) (
-\DRAWCURVE.IP 115602 . 118039) (\DRAWPOINT.IP 118041 . 119078) (\DSPCOLOR.IP 119080 . 120031) (
-ENSURE.RGB 120033 . 120697) (\IPCURVE2 120699 . 133953) (\CLIPCURVELINE.IP 133955 . 138653) (
-\DRAWLINE.IP 138655 . 142387) (\CLIPLINE 142389 . 147089) (\DSPBOTTOMMARGIN.IP 147091 . 147507) (
-\DSPFONT.IP 147509 . 151556) (\DSPLEFTMARGIN.IP 151558 . 152018) (\DSPLINEFEED.IP 152020 . 152687) (
-\DSPRIGHTMARGIN.IP 152689 . 153486) (\DSPSPACEFACTOR.IP 153488 . 154617) (\DSPTOPMARGIN.IP 154619 . 
-155055) (\DSPXPOSITION.IP 155057 . 156044) (\DSPROTATE.IP 156046 . 156224) (\PUSHSTATE.IP 156226 . 
-157118) (\POPSTATE.IP 157120 . 157755) (\DEFAULTSTATE.IP 157757 . 158109) (\DSPTRANSLATE.IP 158111 . 
-158292) (\DSPSCALE2.IP 158294 . 158469) (\DSPYPOSITION.IP 158471 . 158772) (FILLCIRCLE.IP 158774 . 
-159857) (\FILLPOLYGON.IP 159859 . 161190) (\DRAWPOLYGON.IP 161192 . 167322) (\FIXLINELENGTH.IP 167324
- . 168538) (\MOVETO.IP 168540 . 168904) (\SETBRUSH.IP 168906 . 171072) (\STRINGWIDTH.IP 171074 . 
-171477) (\DSPCLIPPINGREGION.IP 171479 . 172655) (\DSPOPERATION.IP 172657 . 173452)) (173645 174400 (
-IP-TOS 173655 . 173915) (POP-IP-STACK 173917 . 174212) (PUSH-IP-STACK 174214 . 174398)) (174461 187025
- (\CREATECHARSET.IP 174471 . 186262) (\CHANGECHARSET.IP 186264 . 187023)) (187026 190646 (
-\INTERPRESSINIT 187036 . 190644)) (190647 191205 (SCALEREGION 190657 . 191203)) (204133 206557 (
-INTERPRESSBITMAP 204143 . 206555)) (208765 214180 (\COERCEASCIITONSFONT 208775 . 212264) (
-\CREATEINTERPRESSFONT 212266 . 213839) (\SEARCHINTERPRESSFONTS 213841 . 214178)) (219195 220126 (
-\ASCIIMAPARRAY 219205 . 220124)))))
+  (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)))))
 STOP

sources/LLREAD

@@ -1,12 +1,12 @@
 (DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
 
-
(FILECREATED " 8-Mar-2025 09:05:43" {WMEDLEY}<sources>LLREAD.;107
 90353  
+
(FILECREATED "13-Jun-2025 16:34:10" {WMEDLEY}<sources>LLREAD.;112
 95152  
 
       :EDIT-BY rmk
 
       :CHANGES-TO (VARS LLREADCOMS)
 
-      :PREVIOUS-DATE "30-Jul-2023 17:42:27" {WMEDLEY}<sources>LLREAD.;105)
+      :PREVIOUS-DATE "12-Jun-2025 10:02:38" {WMEDLEY}<sources>LLREAD.;111)
 
 
 (PRETTYCOMPRINT LLREADCOMS)
@@ -31,7 +31,7 @@
               (FNS READVBAR READHASHMACRO DEFMACRO-LAMBDA-LIST-KEYWORD-P DIGITBASEP READNUMBERINBASE
                    ESTIMATE-DIMENSIONALITY SKIP.HASH.COMMENT CMLREAD.FEATURE.PARSER))
         (COMS                                                (* ; "Reading characters with #\")

-              (FNS CHARACTER.READ CHARCODE.DECODE)
+              (FNS CHARACTER.READ CHARCODE.DECODE CHARCODE.ENCODE CHARCODEP)
               (FNS HEXNUM? OCTALNUM?)
               (ALISTS (CHARACTERNAMES Page Form FF Rubout Del Null Escape Esc Bell Tab Backspace Bs 
                              Newline CR EOL Return Tenexeol Space Sp Linefeed LF Zero One Two Three 
@@ -1386,17 +1386,18 @@
                                                          (READ-EXTENDED-TOKEN
 STREAM])
 
 (CHARCODE.DECODE

-  [LAMBDA (C NOERROR)
                                   (* ; "Edited 24-Aug-2021 10:03 by rmk:")


-                                                             (* ; "Edited 18-Feb-87 22:03 by bvm:")

+  [LAMBDA (C NOERROR)
                                        (* ; "Edited 25-Apr-2025 11:14 by rmk")


+                                                            (* ; "Edited 24-Aug-2021 10:03 by rmk:")


+                                                             (* ; "Edited 18-Feb-87 22:03 by bvm:")

     (DECLARE
 (GLOBALVARS CHARACTERNAMES CHARACTERSETNAMES))
 
-    (* ;; "RMK 2020:  Added hexstring decoding for  Unicode:  no commas or other delimiters")

+    (* ;; "RMK 2020:  Added hexstring decoding for  Unicode:  no commas or other delimiters")

 
-    (* ;; "RMK 2021:  Moved single chars above atom test to be more precise about digits.")

+    (* ;; "RMK 2021:  Moved single chars above atom test to be more precise about digits.")

 
-    (* ;; "Moved Unicode up, out of comma testing, allowed lower-case u.")

+    (* ;; "Moved Unicode up, out of comma testing, allowed lower-case u.")

 
-    (* ;; "Also disallowed unknown junk in the parse-integer strings and substrings so we know what's happening")

+    (* ;; "Also disallowed unknown junk in the parse-integer strings and substrings so we know what's happening")

 
     (COND
        ((NOT C)
@@ -1407,70 +1408,150 @@
               (CHARCODE.DECODE
 (CDR C)
                      NOERROR)))
        ((EQ (NCHARS C)
-            1)                                               (* ; 
-
                           "Includes singleton digits 0-9, the only FIXP's allowed. 0 is 0, not 48")

+            1)                                               (* ; 
+
                             "Includes singleton digits 0-9, the only FIXP's allowed. 0 is 0, not 48")

         (CHCON1 C))
-       ((NOT (OR (LITATOM C)
-                 (STRINGP C)))                               (* ; 
-
                                               "LITATOM instead of ATOM stops numbers right here. ")

-        (AND (NOT NOERROR)
-             (ERROR "BAD CHARACTER SPECIFICATION" C)))
+       ((CHARCODEP C)
+        C)
+       ((CL:CHARACTERP C)
+        (CL:CHAR-CODE C))
        ((HEXNUM?
 C T))
+       ((NOT (OR (LITATOM C)
+                 (STRINGP C)))                               (* ; 
+
                                                 "LITATOM instead of ATOM stops numbers right here. ")

+        (CL:UNLESS NOERROR (ERROR "BAD CHARACTER SPECIFICATION" C)))
        (T
         (SELCHARQ (CHCON1 C)
              (^ (AND (SETQ C (CHARCODE.DECODE
 (SUBSTRING C 2 -1)
                                     NOERROR))
                      (LOGAND C (LOGNOT 96))))
              (%# 
-                 (* ;; "We use IPLUS instead of LOGOR here because some people want ##char to read as Xerox Meta, i.e., 1,char")

+                 (* ;; "We use IPLUS instead of LOGOR here because some people want ##char to read as Xerox Meta, i.e., 1,char")

 
-                 (* ;; "RMK:  I don't understand that comment:  %"X,#a%" would map to the high panel corresponding to %"a%" in any character set X, including Meta or Function, wherever they happen to be.  Won't adding and orring be the same?")

+                 (* ;; "RMK:  I don't understand that comment:  %"X,#a%" would map to the high panel corresponding to %"a%" in any character set X, including Meta or Function, wherever they happen to be.  Won't adding and orring be the same?")

 
                  (AND (SETQ C (CHARCODE.DECODE
 (SUBSTRING C 2 -1)
                                      NOERROR))
                       (IPLUS C 128)))
              (for
 X in
 CHARACTERNAMES when
 (STRING.EQUAL (CAR X)
-                                                              C)
-                do
 (RETURN (OR (NUMBERP (CADR X))
-                                   (CHARCODE.DECODE
 (CADR X)
-                                          NOERROR)))
-                finally
 (RETURN
-                             (LET ([POS (find
 I from
 1
-                                           suchthat
 (FMEMB (OR (NTHCHARCODE C I)
-                                                                   (RETURN))
-                                                               (CHARCODE (%, -
 %. %|]
-                                   CH CSET SSTR)             (* ; "In the form charset,char")

+                                                  C) do
 (RETURN (OR (NUMBERP (CADR X))
+                                                                    (CHARCODE.DECODE
 (CADR X)
+                                                                           NOERROR)))
+                finally
 (RETURN (LET ([POS (find
 I from
 1
+                                              suchthat
 (FMEMB (OR (NTHCHARCODE C I)
+                                                                  (RETURN))
+                                                              (CHARCODE (%, -
 %. %|]
+                                      CH CSET SSTR)          (* ; "In the form charset,char")

 
-                                  (* ;; 
-
                         "Don't use STRPOSL because CHARTABLE is not available in loadup sequence.")

+                                     (* ;; 
+
                           "Don't use STRPOSL because CHARTABLE is not available in loadup sequence.")

 
-                                  (* ;; "The character set loop is like the character loop with a different search list and no recursion for character sets.")

+                                     (* ;; "The character set loop is like the character loop with a different search list and no recursion for character sets.")

 
-                                  (COND
-                                     ((AND POS (SETQ CH (OR [OCTALNUM?
 (SETQ SSTR
-                                                                            (SUBSTRING C (ADD1 POS]
-                                                            (CHARCODE.DECODE
 SSTR NOERROR)))
-                                           (< CH 256)
-                                           (>= CH 0)
-                                           (SETQ CSET (OR [OCTALNUM?
 (SETQ SSTR
-                                                                          (SUBSTRING C 1 (SUB1 POS]
-                                                          (CADR (find
 PAIR in
 
-                                                                                    CHARACTERSETNAMES
-                                                                   suchthat
 
+                                     (COND
+                                        ((AND POS (SETQ CH (OR [OCTALNUM?
 (SETQ SSTR
+                                                                           (SUBSTRING C (ADD1 POS]
+                                                               (CHARCODE.DECODE
 SSTR NOERROR)))
+                                              (< CH 256)
+                                              (>= CH 0)
+                                              (SETQ CSET
+                                               (OR [OCTALNUM?
 (SETQ SSTR (SUBSTRING C 1 (SUB1 POS]
+                                                   (CADR (find
 PAIR in
 CHARACTERSETNAMES
+                                                            suchthat
 
 
-                                                                     (* ;; 
-
                                    "No recursion. If not a number the list is bad even if C is OK")

+                                                                  (* ;; 
+
                                      "No recursion. If not a number the list is bad even if C is OK")

 
-                                                                         (STRING.EQUAL (CAR PAIR)
-                                                                                SSTR)))
-                                                          (HEXNUM?
 SSTR T)))
-                                           (< CSET 256)
-                                           (>= CSET 0))      (* ; 
-
                              "parsed the charset part as an octal,  standard charset name, or hex")

-                                      (LOGOR (LLSH CSET 8)
-                                             CH))
-                                     ((NOT NOERROR)
-                                      (ERROR "BAD CHARACTER SPECIFICATION" C])
+                                                                  (STRING.EQUAL (CAR PAIR)
+                                                                         SSTR)))
+                                                   (HEXNUM?
 SSTR T)))
+                                              (< CSET 256)
+                                              (>= CSET 0))   (* ; 
+
                                "parsed the charset part as an octal,  standard charset name, or hex")

+                                         (LOGOR (LLSH CSET 8)
+                                                CH))
+                                        ((NOT NOERROR)
+                                         (ERROR "BAD CHARACTER SPECIFICATION" C])
+
+(CHARCODE.ENCODE

+  [LAMBDA (CODE OCTALCHARS NONCHARIDENTITY)
                  (* ; "Edited 23-Apr-2025 19:08 by rmk")


+                                                             (* ; "Edited 26-Mar-2025 10:37 by rmk")


+                                                             (* ; "Edited 23-Mar-2025 14:57 by rmk")


+                                                             (* ; "Edited 18-Mar-2025 20:55 by rmk")


+                                                             (* ; "Edited  6-Dec-2023 20:30 by rmk")


+                                                            (* ; "Edited 20-Sep-2021 15:03 by rmk:")

+
+    (* ;; "If CODE correspond to a named character, that character is returned.")

+
+    (* ;; "Otherwise, if OCTALCHARS the result is of the form %"cset,octal-char%" where cset is a known name (Meta) or the octal string for an unknown character set.  Ascii codes show up with %"0,xx%"")

+
+    (* ;; "If not OCTALCHARS, the character-name part is constructed from the name of its Ascii equivalent, modified by ^ or #. %"0,%" is suppressed in front of the names for character-set 0.")

+
+    (* ;; "If NONCHARIDENTITY, returns CODE if it isn't something that can be interpreted as a character code.")

+
+    (DECLARE
 (USEDFREE CHARACTERSETNAMES CHARACTERNAMES))
+
+    (* ;; "")

+
+    (if
 (LISTP CODE)
+        then
 (CONS (CHARCODE.ENCODE
 (CAR CODE)
+                          OCTALCHARS NONCHARIDENTITY)
+                   (AND (CDR CODE)
+                        (CHARCODE.ENCODE
 (CDR CODE)
+                               OCTALCHARS NONCHARIDENTITY)))
+      elseif
 (CL:CHARACTERP CODE)
+        then
 (CHARCODE.ENCODE
 (CL:CHAR-CODE CODE)
+                    OCTALCHARS NONCHARIDENTITY)
+      elseif
 (NULL CODE)
+        then
 NIL
+      elseif
 (NOT (CHARCODEP
 CODE))
+        then
 (CL:IF NONCHARIDENTITY
+                 CODE
+                 (\ILLEGAL.ARG CODE))
+      elseif
 [CAR (find
 CN in
 CHARACTERNAMES suchthat
 (if
 (CHARCODEP
 (CADR CN))
+                                                          then
 (IEQP CODE (CADR CN))
+                                                        else
 (IEQP CODE (CHARCODE.DECODE
 (CADR CN]
+      else
 (LET ((CHARSET (LRSH CODE 8))
+                 (CHAR (LOGAND CODE 255))
+                 (ASCIICODE (LOGAND CODE 127))
+                 CSETNAME CHARNAME ASCIINAME)
+                (SETQ CSETNAME (if
 [CAR (find
 CN in
 CHARACTERSETNAMES
+                                           suchthat
 (STRING.EQUAL CHARSET (CADR CN]
+                                 else
 (OCTALSTRING CHARSET)))
+                [SETQ CHARNAME (if
 OCTALCHARS
+                                   then
 (OCTALSTRING CHAR)
+                                 else
 (CAR (for
 CC in
 CHARACTERNAMES when
 (EQ CHAR (CADR CC))
+                                              smallest
 (NCHARS (CAR CC]
+                (CL:WHEN (STREQUAL CHARNAME "Tenexeol")      (* ; 
+
                                                          "Put (%"^_%" Tenexeol) in CHARACTERNAMES ?")

+                    (SETQ CHARNAME "^_"))
+
+                (* ;; "Didn't find the special character name, let's find a corresponding Asciiname to prefix with ^ and/or #")

+
+                (CL:UNLESS CHARNAME
+                    [SETQ ASCIINAME (if
 [CAR (for
 CC in
 CHARACTERNAMES
+                                                when
 (EQ ASCIICODE (CADR CC))
+                                                smallest
 (NCHARS (CAR CC]
+                                      elseif
 (ILESSP ASCIICODE (CHARCODE SPACE))
+                                        then
 [CONCAT "^" (CHARACTER (IPLUS ASCIICODE (CHARCODE @]
+                                      else
 
+                                           (* ;; "Not named and not a control")

+
+                                           (CONCAT (CHARACTER ASCIICODE]
+                    (SETQ CHARNAME (CL:IF (IGEQ CHAR 128)
+                                       (CONCAT "#" ASCIINAME)
+                                       ASCIINAME)))
+                (CL:IF (AND (ZEROP CHARSET)
+                            (NOT OCTALCHARS))
+                    CHARNAME
+                    (CONCAT CSETNAME "," CHARNAME))])
+
+(CHARCODEP

+  [LAMBDA (CHCODE)                                           (* gbn "22-Jul-85 16:35")

+                                                             (* ; "is CHCODE a legal character code?")

+    (AND (SMALLP CHCODE)
+         (IGEQ CHCODE 0)
+         (ILEQ CHCODE \MAXNSCHAR])
 )
 (DEFINEQ
 
@@ -1669,17 +1750,18 @@
 (ADDTOVAR LAMA
 CL:PARSE-INTEGER CL:READ-DELIMITED-LIST CL:READ-PRESERVING-WHITESPACE CL:READ)
 )
 (DECLARE%: DONTCOPY
-  (FILEMAP (NIL (3437 11881 (LASTC 3447 . 3753) (PEEKC 3755 . 4143) (PEEKCCODE 4145 . 4556) (RATOM 4558
- . 5639) (READ 5641 . 6201) (READC 6203 . 6844) (READCCODE 6846 . 7605) (READP 7607 . 8159) (
-SETREADMACROFLG 8161 . 8460) (SKIPSEPRCODES 8462 . 9542) (SKIPSEPRS 9544 . 9930) (SKREAD 9932 . 11879)
-) (11927 20536 (CL:READ 11937 . 12486) (CL:READ-PRESERVING-WHITESPACE 12488 . 13210) (
-CL:READ-DELIMITED-LIST 13212 . 14127) (CL:PARSE-INTEGER 14129 . 20534)) (20629 33106 (RSTRING 20639 . 
-21371) (READ-EXTENDED-TOKEN 21373 . 25245) (\RSTRING2 25247 . 33104)) (33142 63875 (\TOP-LEVEL-READ 
-33152 . 35135) (\SUBREAD 35137 . 60291) (\SUBREADCONCAT 60293 . 60916) (\ORIG-READ.SYMBOL 60918 . 
-61986) (\ORIG-INVALID.SYMBOL 61988 . 62887) (\APPLYREADMACRO 62889 . 63305) (INREADMACROP 63307 . 
-63873)) (64034 64209 (READQUOTE 64044 . 64207)) (64234 76138 (READVBAR 64244 . 65575) (READHASHMACRO 
-65577 . 71387) (DEFMACRO-LAMBDA-LIST-KEYWORD-P 71389 . 71609) (DIGITBASEP 71611 . 72345) (
-READNUMBERINBASE 72347 . 74233) (ESTIMATE-DIMENSIONALITY 74235 . 74560) (SKIP.HASH.COMMENT 74562 . 
-75530) (CMLREAD.FEATURE.PARSER 75532 . 76136)) (76182 82526 (CHARACTER.READ 76192 . 77446) (
-CHARCODE.DECODE 77448 . 82524)) (82527 85697 (HEXNUM? 82537 . 84880) (OCTALNUM? 84882 . 85695)))))
+  (FILEMAP (NIL (3463 11907 (LASTC 3473 . 3779) (PEEKC 3781 . 4169) (PEEKCCODE 4171 . 4582) (RATOM 4584
+ . 5665) (READ 5667 . 6227) (READC 6229 . 6870) (READCCODE 6872 . 7631) (READP 7633 . 8185) (
+SETREADMACROFLG 8187 . 8486) (SKIPSEPRCODES 8488 . 9568) (SKIPSEPRS 9570 . 9956) (SKREAD 9958 . 11905)
+) (11953 20562 (CL:READ 11963 . 12512) (CL:READ-PRESERVING-WHITESPACE 12514 . 13236) (
+CL:READ-DELIMITED-LIST 13238 . 14153) (CL:PARSE-INTEGER 14155 . 20560)) (20655 33132 (RSTRING 20665 . 
+21397) (READ-EXTENDED-TOKEN 21399 . 25271) (\RSTRING2 25273 . 33130)) (33168 63901 (\TOP-LEVEL-READ 
+33178 . 35161) (\SUBREAD 35163 . 60317) (\SUBREADCONCAT 60319 . 60942) (\ORIG-READ.SYMBOL 60944 . 
+62012) (\ORIG-INVALID.SYMBOL 62014 . 62913) (\APPLYREADMACRO 62915 . 63331) (INREADMACROP 63333 . 
+63899)) (64060 64235 (READQUOTE 64070 . 64233)) (64260 76164 (READVBAR 64270 . 65601) (READHASHMACRO 
+65603 . 71413) (DEFMACRO-LAMBDA-LIST-KEYWORD-P 71415 . 71635) (DIGITBASEP 71637 . 72371) (
+READNUMBERINBASE 72373 . 74259) (ESTIMATE-DIMENSIONALITY 74261 . 74586) (SKIP.HASH.COMMENT 74588 . 
+75556) (CMLREAD.FEATURE.PARSER 75558 . 76162)) (76208 87325 (CHARACTER.READ 76218 . 77472) (
+CHARCODE.DECODE 77474 . 82643) (CHARCODE.ENCODE 82645 . 87024) (CHARCODEP 87026 . 87323)) (87326 90496
+ (HEXNUM? 87336 . 89679) (OCTALNUM? 89681 . 90494)))))
 STOP

sources/MEDLEYDIR

@@ -1,12 +1,13 @@
 (DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
 
-
(FILECREATED " 3-Jul-2025 09:54:45" {MEDLEY}<sources>MEDLEYDIR.;4
 11322  
+
(FILECREATED "11-Jul-2025 00:17:20" {WMEDLEY}<sources>MEDLEYDIR.;32
 11437  
 
       :EDIT-BY rmk
 
       :CHANGES-TO (VARS MEDLEY-INIT-VARS)
+                  (FNS MEDLEY-INIT-VARS MEDLEYDIR MEDLEYSUBSTDIR SET-SYSOUT-COMMIT)
 
-      :PREVIOUS-DATE "15-May-2025 00:18:25" {MEDLEY}<sources>MEDLEYDIR.;3)
+      :PREVIOUS-DATE "15-May-2025 00:18:25" {WMEDLEY}<sources>MEDLEYDIR.;31)
 
 
 (PRETTYCOMPRINT MEDLEYDIRCOMS)
@@ -200,7 +201,7 @@
                             LHD))
         [USERGREETFILES (LIST (CONS LOGINHOST/DIR '("INIT" COM))
                               (CONS LOGINHOST/DIR '("INIT"]
-        (DISPLAYFONTDIRECTORIES (MEDLEYDIR '("fonts/displayfonts")
+        (DISPLAYFONTDIRECTORIES (MEDLEYDIR '("fonts/medleydisplayfonts" "fonts/displayfonts")
                                        NIL NIL T))
         (POSTSCRIPTFONTDIRECTORIES (MEDLEYDIR '("fonts/postscriptfonts")
                                           NIL NIL T))
@@ -227,6 +228,6 @@
 (ADDTOVAR GLOBALVARS
 MEDLEYDIR MEDLEY-INIT-VARS \SAVE.MEDLEYDIR DIRECTORIES SYSOUTCOMMITS)
 )
 (DECLARE%: DONTCOPY
-  (FILEMAP (NIL (1643 8717 (MEDLEY-INIT-VARS 1653 . 5131) (MEDLEYDIR 5133 . 7517) (MEDLEYSUBSTDIR 7519
- . 8497) (SET-SYSOUT-COMMIT 8499 . 8715)))))
+  (FILEMAP (NIL (1731 8805 (MEDLEY-INIT-VARS 1741 . 5219) (MEDLEYDIR 5221 . 7605) (MEDLEYSUBSTDIR 7607
+ . 8585) (SET-SYSOUT-COMMIT 8587 . 8803)))))
 STOP

sources/MENU

@@ -1,19 +1,19 @@
 (DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
-
(FILECREATED "16-Jul-99 15:51:36" {DSK}<project>medley3.5>sources>MENU.;3
 102161 
 
-      changes to%:  (FNS UPDATE/MENU/IMAGE)
+
(FILECREATED "14-Jul-2025 22:35:12" {DSK}<Users>kaplan>Local>medley3.5>working-medley>sources>MENU.;3
 101431 
 
-      previous date%: "28-Jun-99 17:05:55" {DSK}<project>medley3.5>sources>MENU.;2)
+      :EDIT-BY rmk
 
+      :CHANGES-TO (FNS MENUTITLEFONT UPDATE/MENU/IMAGE)
+
+      :PREVIOUS-DATE "16-Jul-99 15:51:36" 
+{DSK}<Users>kaplan>Local>medley3.5>working-medley>sources>MENU.;1)
 
-(* ; "
-Copyright (c) 1982, 1983, 1984, 1985, 1986, 1987, 1988, 1990, 1991, 1993, 1994, 1999 by Venue & Xerox Corporation.  All rights reserved.
-")
 
 (PRETTYCOMPRINT MENUCOMS)
 
 (RPAQQ MENUCOMS

-       ((COMS                                                (* ; "window functions")

+       ((COMS                                                (* ; "window functions")

               (FNS MAXMENUITEMHEIGHT MAXMENUITEMWIDTH MENU MENUTITLEFONT ADDMENU DELETEMENU 
                    MENUREGION BLTMENUIMAGE ERASEMENUIMAGE DEFAULTMENUHELDFN DEFAULTWHENSELECTEDFN 
                    BACKGROUNDWHENSELECTEDFN GETMENUITEM MENUBUTTONFN MENU.HANDLER DOSELECTEDITEM 
@@ -26,13 +26,13 @@ Copyright (c) 1982, 1983, 1984, 1985, 1986, 1987, 1988, 1990, 1991, 1993, 1994,
               (BITMAPS MENUSUBITEMMARK)
               (INITVARS (MENUFONT (FONTCREATE 'HELVETICA 10)))
               (DECLARE%: DONTCOPY (MACROS MENU.HELDSTATE.RESET MENU.PRIN2.FLG)))
-        (COMS                                                (* ; 
-
                                                           "scrolling menu functions and utilities")

+        (COMS                                                (* ; 
+
                                                             "scrolling menu functions and utilities")

               (FNS MENUREPAINTFN))
-        (COMS                                                (* ; "misc utility fns.")

+        (COMS                                                (* ; "misc utility fns.")

               (FNS MAXSTRINGWIDTH CENTEREDPRIN1 CENTERPRINTINREGION CENTERPRINTINAREA 
                    STRICTLY/BETWEEN))
-        (COMS                                                (* ; "examples of use.")

+        (COMS                                                (* ; "examples of use.")

               (FNS UNREADITEM TYPEINMENU SHADEITEM RESHADEITEM MOST/VISIBLE/OPERATION %#BITSON 
                    BUTTONPANEL BUTTONPANEL/SELECTION/FN GETSELECTEDITEMS)
               (VARS EDITCMDS MENUHELDWAIT)
@@ -137,24 +137,25 @@ Copyright (c) 1982, 1983, 1984, 1985, 1986, 1987, 1988, 1990, 1991, 1993, 1994,
                                     (CDR SELVAL])
 
 (MENUTITLEFONT

-  [LAMBDA (MENU
 SCREEN)
                              (* kbr%: " 2-Sep-85 14:35")

-                                                             (* returns the title font for a 
-
                                                           menu.)

+  [LAMBDA (MENU
 SCREEN)
                                      (* ; "Edited 14-Jul-2025 22:34 by rmk")

+                                                             (* kbr%: " 2-Sep-85 14:35")

+                                                             (* ; 
+
                                                             "returns the title font for a menu.")

+                                                             (* returns the title font for a menu.)

     (PROG (TITLEFONT)
           [COND
              ((NULL SCREEN)
               (COND
                  [(type?
 WINDOW (fetch
 (MENU
 IMAGE) of
 MENU))
-                  (SETQ SCREEN (fetch
 (WINDOW SCREEN) of
 (fetch
 (MENU
 IMAGE)
-                                                                    of
 MENU]
+                  (SETQ SCREEN (fetch
 (WINDOW SCREEN) of
 (fetch
 (MENU
 IMAGE) of
 MENU]
                  (T (SETQ SCREEN LASTSCREEN]
           (RETURN (COND
                      ((NULL (SETQ TITLEFONT (fetch
 (MENU
 MENUTITLEFONT) of
 MENU)))
-                                                             (* use the window title font)

+                                                             (* ; "use the window title font")

                       (DSPFONT NIL (fetch
 (SCREEN SCTITLEDS) of
 SCREEN)))
-                     ((EQ TITLEFONT T)                       (* use the menu item font)

+                     ((EQ TITLEFONT T)                       (* ; "use the menu item font")

                       (fetch
 (MENU
 MENUFONT) of
 MENU))
-                     ((FONTP (\COERCEFONTDESC TITLEFONT 'DISPLAY T)))
+                     ((FONTP (FONTCREATE TITLEFONT NIL NIL NIL 'DISPLAY T)))
                      (T (DSPFONT NIL (fetch
 (SCREEN SCTITLEDS) of
 SCREEN])
 
 (ADDMENU

@@ -795,11 +796,11 @@ Copyright (c) 1982, 1983, 1984, 1985, 1986, 1987, 1988, 1990, 1991, 1993, 1994,
         (PROMPTPRINT (CADR ITEM])
 
 (UPDATE/MENU/IMAGE

-  [LAMBDA (MNU SCREEN)                                       (* ; "Edited 16-Jul-99 15:51 by rmk:")

-                                                             (* ; 
-
                                                           "Edited 10-Dec-93 16:01 by sybalsky")

-                                                             (* ; 
-
                                                       "recomputes the menu image from its labels.")

+  [LAMBDA (MNU SCREEN)
                                       (* ; "Edited 14-Jul-2025 22:34 by rmk")


+                                                             (* ; "Edited 16-Jul-99 15:51 by rmk:")


+                                                          (* ; "Edited 10-Dec-93 16:01 by sybalsky")

+                                                             (* ; 
+
                                                         "recomputes the menu image from its labels.")

     (PROG (NUMCOLS NUMROWS WIDTH HEIGHT DSP BLK COLWIDTH ROWHEIGHT BITSPERPIXEL MENUITEMS NITEMS 
                  BORDER OUTLINE FONT TITLEFONT TITLEHEIGHT TITLEWIDTH WINDOW TITLE ANYSUBITEMS? 
                  CENTER?)
@@ -807,30 +808,27 @@ Copyright (c) 1982, 1983, 1984, 1985, 1986, 1987, 1988, 1990, 1991, 1993, 1994,
              ((NULL SCREEN)
               (COND
                  [(type?
 WINDOW (fetch
 (MENU
 IMAGE) of
 MNU))
-                  (SETQ SCREEN (fetch
 (WINDOW SCREEN) of
 (fetch
 (MENU
 IMAGE)
-                                                                    of
 MNU]
+                  (SETQ SCREEN (fetch
 (WINDOW SCREEN) of
 (fetch
 (MENU
 IMAGE) of
 MNU]
                  (T (SETQ SCREEN LASTSCREEN]
           (SETQ MENUITEMS (fetch
 (MENU
 ITEMS) of
 MNU))
-          (SETQ CENTER? (fetch
 (MENU
 CENTERFLG) of
 MNU))
-                                                             (* ; "check the font.")

+          (SETQ CENTER? (fetch
 (MENU
 CENTERFLG) of
 MNU))     (* ; "check the font.")

           (COND
              [(FONTP (SETQ FONT (AND (fetch
 (MENU
 MENUFONT) of
 MNU)
-                                     (\COERCEFONTDESC (fetch
 (MENU
 MENUFONT) of
 MNU)
-                                            'DISPLAY T]
+                                     (FONTCREATE (fetch
 (MENU
 MENUFONT) of
 MNU)
+                                            NIL NIL NIL 'DISPLAY T]
              (T [SETQ FONT (COND
                               ((FONTP MENUFONT))
                               (T (SETQ MENUFONT (FONTCREATE 'HELVETICA 10]
-                                                             (* ; "keep font in the menu")

+                                                             (* ; "keep font in the menu")

                 (replace
 (MENU
 MENUFONT) of
 MNU with
 FONT)))
           (COND
-             ((SETQ TITLE (fetch
 (MENU
 TITLE) of
 MNU))
-                                                             (* ; "set the title font")

+             ((SETQ TITLE (fetch
 (MENU
 TITLE) of
 MNU))       (* ; "set the title font")

               (SETQ TITLEFONT (MENUTITLEFONT
 MNU SCREEN))
               (SETQ TITLEHEIGHT (FONTPROP TITLEFONT 'HEIGHT))
               (SETQ TITLEWIDTH (STRINGWIDTH TITLE TITLEFONT)))
              (T (SETQ TITLEHEIGHT 0)
-                (SETQ TITLEWIDTH 0)))                        (* ; 
-
                                                         "calculate the number of columns and rows")

+                (SETQ TITLEWIDTH 0)))                        (* ; 
+
                                                           "calculate the number of columns and rows")

           (SETQ NITEMS (LENGTH MENUITEMS))
           (COND
              [(SETQ NUMCOLS (NUMBERP (fetch
 (MENU
 MENUCOLUMNS) of
 MNU)))
@@ -844,20 +842,19 @@ Copyright (c) 1982, 1983, 1984, 1985, 1986, 1987, 1988, 1990, 1991, 1993, 1994,
              (T (SETQ NUMCOLS 1)
                 (SETQ NUMROWS NITEMS)))
 
-     (* ;; "set BORDER to the size of the outline around each menu item and OUTLINE to the size of the outline around the whole menu.")

+     (* ;; "set BORDER to the size of the outline around each menu item and OUTLINE to the size of the outline around the whole menu.")

 
           (SETQ BORDER (OR (FIXP (fetch
 (MENU
 MENUBORDERSIZE) of
 MNU))
                            (replace
 (MENU
 MENUBORDERSIZE) of
 MNU with
 0)))
           [SETQ OUTLINE (OR (FIXP (fetch
 (MENU
 MENUOUTLINESIZE) of
 MNU))
-                            (replace
 (MENU
 MENUOUTLINESIZE) of
 MNU
-                               with
 (IMAX BORDER 1]
-          (SETQ ANYSUBITEMS? (for
 I in
 (fetch
 (MENU
 ITEMS) of
 MNU)
-                                when
 (\MENUSUBITEMS
 MNU I) do
 (RETURN T)))
+                            (replace
 (MENU
 MENUOUTLINESIZE) of
 MNU with
 (IMAX BORDER 1]
+          (SETQ ANYSUBITEMS? (for
 I in
 (fetch
 (MENU
 ITEMS) of
 MNU) when
 (\MENUSUBITEMS
 MNU I)
+                                do
 (RETURN T)))
           (COND
              ((IGREATERP (SETQ COLWIDTH (fetch
 (MENU
 ITEMWIDTH) of
 MNU))
                      5000)
 
-              (* ;; "If ITEMWIDTH is greater than 5000, it was probably default clipping region.  if no columnwidth is given {common case}, calculate it from the items widths.")

+              (* ;; "If ITEMWIDTH is greater than 5000, it was probably default clipping region.  if no columnwidth is given {common case}, calculate it from the items widths.")

 
               [SETQ COLWIDTH (IPLUS (MAXMENUITEMWIDTH
 MNU T)
                                     (ITIMES (ADD1 BORDER)
@@ -867,8 +864,8 @@ Copyright (c) 1982, 1983, 1984, 1985, 1986, 1987, 1988, 1990, 1991, 1993, 1994,
                                        (T 0]
               [COND
                  ((IGREATERP (IPLUS TITLEWIDTH 2)
-                         (ITIMES COLWIDTH NUMCOLS))          (* ; 
-
                                                           "adjust column width to cover title.")

+                         (ITIMES COLWIDTH NUMCOLS))          (* ; 
+
                                                             "adjust column width to cover title.")

                   (SETQ COLWIDTH (IQUOTIENT (IPLUS TITLEWIDTH (SUB1 NUMCOLS))
                                         NUMCOLS]
               (replace
 (MENU
 ITEMWIDTH) of
 MNU with
 COLWIDTH)))
@@ -889,12 +886,11 @@ Copyright (c) 1982, 1983, 1984, 1985, 1986, 1987, 1988, 1990, 1991, 1993, 1994,
                    (NULL (fetch
 (MENU
 MENUCOLUMNS) of
 MNU))
                    (NULL (fetch
 (MENU
 MENUROWS) of
 MNU)))
 
-              (* ;; "it is too large to fit on the screen and menu is defaulting the number of columns and rows If the user specified either the number of rows or columns, assume they knew what they were doing.")

+              (* ;; "it is too large to fit on the screen and menu is defaulting the number of columns and rows If the user specified either the number of rows or columns, assume they knew what they were doing.")

 
-              (PROG (NITEMSTOFIT)                            (* ; 
-
                                                         "menu is defaulting the number of columns")

-                    (SETQ NITEMSTOFIT (IQUOTIENT (IDIFFERENCE (fetch
 (SCREEN SCHEIGHT)
-                                                                 of
 SCREEN)
+              (PROG (NITEMSTOFIT)                            (* ; 
+
                                                           "menu is defaulting the number of columns")

+                    (SETQ NITEMSTOFIT (IQUOTIENT (IDIFFERENCE (fetch
 (SCREEN SCHEIGHT) of
 SCREEN)
                                                         TITLEHEIGHT)
                                              ROWHEIGHT))
                     (SETQ NUMCOLS (ADD1 (IQUOTIENT (SUB1 NITEMS)
@@ -907,32 +903,28 @@ Copyright (c) 1982, 1983, 1984, 1985, 1986, 1987, 1988, 1990, 1991, 1993, 1994,
                                         (ITIMES OUTLINE 2)
                                         TITLEHEIGHT))
 
-               (* ;; "changing the items field is suspect since conceivably the user might be depending upon it.  At least the fact that MENUCOLUMNS is NIL keeps it from happening twice if it gets called again.")

+               (* ;; "changing the items field is suspect since conceivably the user might be depending upon it.  At least the fact that MENUCOLUMNS is NIL keeps it from happening twice if it gets called again.")

 
-                    (replace
 (MENU
 ITEMS) of
 MNU with
 (SETQ MENUITEMS
-                                                                       (\MAKE.ITEMS.VERT.ORDER

-                                                                        MENUITEMS NUMROWS NUMCOLS]
+                    (replace
 (MENU
 ITEMS) of
 MNU with
 (SETQ MENUITEMS (\MAKE.ITEMS.VERT.ORDER
 
+                                                                             MENUITEMS NUMROWS 
+                                                                             NUMCOLS]
              ((AND (NULL (fetch
 (MENU
 MENUCOLUMNS) of
 MNU))
                    (fetch
 (MENU
 MENUROWS) of
 MNU))
 
-              (* ;; "user wants a certain number of rows but doesn't care about the columns, switch to vertical order so the blanks items appear in the last row.")

+              (* ;; "user wants a certain number of rows but doesn't care about the columns, switch to vertical order so the blanks items appear in the last row.")

 
-              (replace
 (MENU
 ITEMS) of
 MNU with
 (SETQ MENUITEMS (
-
                                                                             \MAKE.ITEMS.VERT.ORDER

-                                                                                 MENUITEMS NUMROWS 
-                                                                                 NUMCOLS]
+              (replace
 (MENU
 ITEMS) of
 MNU with
 (SETQ MENUITEMS (\MAKE.ITEMS.VERT.ORDER
 MENUITEMS 
+                                                                       NUMROWS NUMCOLS]
           (replace
 (MENU
 MENUCOLUMNS) of
 MNU with
 NUMCOLS)
           (replace
 (MENU
 MENUROWS) of
 MNU with
 NUMROWS)
           (SETQ BITSPERPIXEL (OR (fetch
 (SCREEN SCDEPTH) of
 SCREEN)
                                  (fetch
 (SCREEN SCBITSPERPIXEL) of
 SCREEN)))
           [SETQ BLK (COND
                        ((AND [SETQ BLK (COND
-                                          ((type?
 BITMAP (SETQ BLK (fetch
 (MENU
 IMAGE)
-                                                                          of
 MNU)))
+                                          ((type?
 BITMAP (SETQ BLK (fetch
 (MENU
 IMAGE) of
 MNU)))
                                            BLK)
-                                          ((type?
 WINDOW BLK)
-                                                             (* ; 
-
                                              "if it is a window, make sure it is not active, then")

+                                          ((type?
 WINDOW BLK)(* ; 
+
                                                "if it is a window, make sure it is not active, then")

                                            (CLOSEW BLK)
                                            (fetch
 (WINDOW SAVE) of
 BLK]
                              (EQ (fetch
 (BITMAP BITMAPWIDTH) of
 BLK)
@@ -940,13 +932,13 @@ Copyright (c) 1982, 1983, 1984, 1985, 1986, 1987, 1988, 1990, 1991, 1993, 1994,
                              (EQ (fetch
 (BITMAP BITMAPHEIGHT) of
 BLK)
                                  HEIGHT)
                              (EQ (fetch
 (BITMAP BITMAPBITSPERPIXEL) of
 BLK)
-                                 BITSPERPIXEL))              (* ; "reuse current image bitmap")

+                                 BITSPERPIXEL))              (* ; "reuse current image bitmap")

                         BLK)
-                       (T                                    (* ; "create a new one")

+                       (T                                    (* ; "create a new one")

                           (BITMAPCREATE WIDTH HEIGHT BITSPERPIXEL]
           (BITBLT NIL NIL NIL BLK 0 0 WIDTH HEIGHT 'TEXTURE 'REPLACE BLACKSHADE)
-                                                             (* ; "Draw box by nested BitBlts")

-                                                             (* ; "leave outline")

+                                                             (* ; "Draw box by nested BitBlts")

+                                                             (* ; "leave outline")

           (BITBLT NIL NIL NIL BLK OUTLINE OUTLINE (IDIFFERENCE WIDTH (ITIMES OUTLINE 2))
                  (IDIFFERENCE HEIGHT (IPLUS TITLEHEIGHT (ITIMES OUTLINE 2)))
                  'TEXTURE
@@ -955,24 +947,22 @@ Copyright (c) 1982, 1983, 1984, 1985, 1986, 1987, 1988, 1990, 1991, 1993, 1994,
           (DSPRIGHTMARGIN MAX.SMALLP DSP)
           (DSPXOFFSET OUTLINE DSP)
           (DSPYOFFSET OUTLINE DSP)
-          (replace
 (REGION LEFT) of
 (fetch
 (MENU
 MENUGRID) of
 MNU) with

-                                                                                       0)
-          (replace
 (REGION BOTTOM) of
 (fetch
 (MENU
 MENUGRID) of
 MNU) with

-                                                                                         0)
+          (replace
 (REGION LEFT) of
 (fetch
 (MENU
 MENUGRID) of
 MNU) with
 0)
+          (replace
 (REGION BOTTOM) of
 (fetch
 (MENU
 MENUGRID) of
 MNU) with
 0)
           (GRID (fetch
 (MENU
 MENUGRID) of
 MNU)
                 NUMCOLS NUMROWS BORDER DSP)
-          (DSPOPERATION 'INVERT DSP)                         (* ; 
-
          "calculate the offset from the top of the item box to the base line of the printed item.")

+          (DSPOPERATION 'INVERT DSP)                         (* ; 
+
            "calculate the offset from the top of the item box to the base line of the printed item.")

           [COND
-             (TITLE                                          (* ; "if there is a title, display it")

+             (TITLE                                          (* ; "if there is a title, display it")

                     (DSPFONT TITLEFONT DSP)
                     (\SHOWMENULABEL
 TITLE (create
 REGION
-                                                     LEFT _ BORDER
-                                                     BOTTOM _ (IDIFFERENCE (IPLUS HEIGHT BORDER)
-                                                                     (IPLUS TITLEHEIGHT
-                                                                            (ITIMES OUTLINE 2)))
-                                                     WIDTH _ WIDTH
-                                                     HEIGHT _ TITLEHEIGHT)
+                                                 LEFT _ BORDER
+                                                 BOTTOM _ (IDIFFERENCE (IPLUS HEIGHT BORDER)
+                                                                 (IPLUS TITLEHEIGHT (ITIMES OUTLINE 2
+                                                                                           )))
+                                                 WIDTH _ WIDTH
+                                                 HEIGHT _ TITLEHEIGHT)
                            MNU DSP CENTER?)
                     (SETQ HEIGHT (IDIFFERENCE HEIGHT TITLEHEIGHT]
           [PROG (ITEMREGION MAJOR#)
@@ -981,15 +971,14 @@ Copyright (c) 1982, 1983, 1984, 1985, 1986, 1987, 1988, 1990, 1991, 1993, 1994,
                                         BOTTOM _ (IDIFFERENCE (IPLUS HEIGHT BORDER)
                                                         (IPLUS ROWHEIGHT (ITIMES OUTLINE 2)))
                                         WIDTH _ (IDIFFERENCE (IDIFFERENCE (fetch
 (REGION WIDTH)
-                                                                             of

-                                                                             (fetch
 (MENU

-                                                                                         MENUGRID)
-                                                                                of
 MNU))
+                                                                             of
 (fetch
 (MENU
 MENUGRID
+                                                                                             )
+                                                                                   of
 MNU))
                                                                     (ITIMES BORDER 2))
                                                        (COND
                                                           (ANYSUBITEMS? 
-                                                             (* ; 
-
                                          "the subitem mark goes outside of the normal title space")

+                                                             (* ; 
+
                                            "the subitem mark goes outside of the normal title space")

                                                                  (BITMAPWIDTH MENUSUBITEMMARK))
                                                           (T 0)))
                                         HEIGHT _ (IDIFFERENCE ROWHEIGHT (ITIMES BORDER 2]
@@ -1000,44 +989,42 @@ Copyright (c) 1982, 1983, 1984, 1985, 1986, 1987, 1988, 1990, 1991, 1993, 1994,
                                      ITEMREGION MNU DSP CENTER?)
                           (SETQ MENUITEMS (CDR MENUITEMS))
                           [COND
-                             ((EQ MAJOR# NUMCOLS)            (* ; "advance to the next row")

+                             ((EQ MAJOR# NUMCOLS)            (* ; "advance to the next row")

                               (SETQ MAJOR# 1)
                               (replace
 (REGION BOTTOM) of
 ITEMREGION
                                  with
 (IDIFFERENCE (fetch
 (REGION BOTTOM) of
 ITEMREGION)
-                                                 ROWHEIGHT))
+                                             ROWHEIGHT))
                               (replace
 (REGION LEFT) of
 ITEMREGION with
 BORDER))
                              (T (SETQ MAJOR# (ADD1 MAJOR#))
                                 (replace
 (REGION LEFT) of
 ITEMREGION
                                    with
 (IPLUS (fetch
 (REGION LEFT) of
 ITEMREGION)
-                                                   COLWIDTH]
+                                               COLWIDTH]
                           (GO LP]
           [COND
              ((NULL (fetch
 (MENU
 MENUOFFSET) of
 MNU))
 
-              (* ;; "set offset so cursor will be be in middle of the menu on first display if it is to move with the cursor.  If it is fixed offset, initialize it to 0")

+              (* ;; "set offset so cursor will be be in middle of the menu on first display if it is to move with the cursor.  If it is fixed offset, initialize it to 0")

 
               (replace
 (MENU
 MENUOFFSET) of
 MNU
                  with
 (COND
-                             ((fetch
 (MENU
 CHANGEOFFSETFLG) of
 MNU)
-                              (create
 POSITION
-                                     XCOORD _ (IQUOTIENT WIDTH 2)
-                                     YCOORD _ (IQUOTIENT HEIGHT 2)))
-                             (T (create
 POSITION
-                                       XCOORD _ 0
-                                       YCOORD _ 0]
+                         ((fetch
 (MENU
 CHANGEOFFSETFLG) of
 MNU)
+                          (create
 POSITION
+                                 XCOORD _ (IQUOTIENT WIDTH 2)
+                                 YCOORD _ (IQUOTIENT HEIGHT 2)))
+                         (T (create
 POSITION
+                                   XCOORD _ 0
+                                   YCOORD _ 0]
           [COND
              ((AND (type?
 WINDOW (SETQ WINDOW (fetch
 (MENU
 IMAGE) of
 MNU)))
                    (EQ (fetch
 (WINDOW SCREEN) of
 WINDOW)
-                       SCREEN))                              (* ; 
-
                                                       "menu has a window, replace its save image.")

+                       SCREEN))                              (* ; 
+
                                                         "menu has a window, replace its save image.")

               (replace
 (WINDOW SAVE) of
 WINDOW with
 BLK))
-             (T (replace
 (MENU
 IMAGE) of
 MNU with
 (SETQ WINDOW (CREATEWFROMIMAGE
-                                                                                BLK SCREEN]
-                                                             (* ; 
-
                                                           "tell the window about its border")

+             (T (replace
 (MENU
 IMAGE) of
 MNU with
 (SETQ WINDOW (CREATEWFROMIMAGE BLK SCREEN]
+                                                             (* ; "tell the window about its border")

           (replace
 (WINDOW WBORDER) of
 WINDOW with
 OUTLINE)
-          (ADVISEWDS WINDOW)                                 (* ; 
-
               "snap circular link between the display stream created for printing and its stream.")

+          (ADVISEWDS WINDOW)                                 (* ; 
+
                 "snap circular link between the display stream created for printing and its stream.")

           (RETURN (fetch
 (WINDOW SAVE) of
 (fetch
 (MENU
 IMAGE) of
 MNU])
 
 (\MAKE.ITEMS.VERT.ORDER

@@ -1394,21 +1381,20 @@ Copyright (c) 1982, 1983, 1984, 1985, 1986, 1987, 1988, 1990, 1991, 1993, 1994,
 (DECLARE%: DONTCOPY 
 (DECLARE%: EVAL@COMPILE 
 
-(PUTPROPS MENU.HELDSTATE.RESET  MACRO

-   ((BX BY)
-    [COND
-       (HELDSTATE (COND
-                     ((SETQ HELDSTATE (fetch
 (MENU WHENUNHELDFN) of
 MENU))
-                      (APPLY* HELDSTATE (GETMENUITEM MENU BX BY)
-                             MENU
-                             (\FDECODE/BUTTON LASTBUTTONSTATE))
-                      (SETQ HELDSTATE NIL]
-    (SETQ HOLDTIMER (SETUPTIMER MENUHELDWAIT HOLDTIMER))))
+(PUTPROPS MENU.HELDSTATE.RESET
 MACRO
 ((BX BY)
+                                      [COND
+                                         (HELDSTATE (COND
+                                                       ((SETQ HELDSTATE (fetch
 (MENU
 WHENUNHELDFN)
+                                                                           of
 MENU))
+                                                        (APPLY* HELDSTATE (GETMENUITEM
 MENU BX BY)
+                                                               MENU
+                                                               (\FDECODE/BUTTON
 LASTBUTTONSTATE))
+                                                        (SETQ HELDSTATE NIL]
+                                      (SETQ HOLDTIMER (SETUPTIMER MENUHELDWAIT HOLDTIMER))))
 
-(PUTPROPS MENU.PRIN2.FLG  MACRO

-   ((MNU)
-    (LISTGET (fetch
 (MENU MENUUSERDATA) of
 MNU)
-           :ESCAPE)))
+(PUTPROPS MENU.PRIN2.FLG
 MACRO
 ((MNU)
+                                (LISTGET (fetch
 (MENU
 MENUUSERDATA) of
 MNU)
+                                       :ESCAPE)))
 )
 )
 
@@ -1631,7 +1617,7 @@ Copyright (c) 1982, 1983, 1984, 1985, 1986, 1987, 1988, 1990, 1991, 1993, 1994,
 
 (RPAQQ EDITCMDS
 ("P" "PP" ("LF" "%
 ")
-                         0 1 -1 2 3 "BK" "EF" "EVAL"))
+                     0 1 -1 2 3 "BK" "EF" "EVAL"))
 
 (RPAQQ MENUHELDWAIT
 1200)
 (DECLARE%: EVAL@COMPILE 
@@ -1679,23 +1665,20 @@ Copyright (c) 1982, 1983, 1984, 1985, 1986, 1987, 1988, 1990, 1991, 1993, 1994,
                             LEFT _ 0
                             BOTTOM _ 0)
           WHENHELDFN _ 'DEFAULTMENUHELDFN WHENUNHELDFN _ 'CLRPROMPT
-          [ACCESSFNS ((ITEMWIDTH (fetch
 (REGION WIDTH) of
 (fetch
 (MENU MENUGRID)
-                                                                     of
 DATUM))
-                             (replace
 (REGION WIDTH) of
 (fetch
 (MENU MENUGRID)
-                                                                   of
 DATUM) with
 NEWVALUE))
-                      (ITEMHEIGHT (fetch
 (REGION HEIGHT) of
 (fetch
 (MENU MENUGRID)
-                                                                       of
 DATUM))
-                             (replace
 (REGION HEIGHT) of
 (fetch
 (MENU MENUGRID)
-                                                                    of
 DATUM) with
 NEWVALUE))
+          [ACCESSFNS ((ITEMWIDTH (fetch
 (REGION WIDTH) of
 (fetch
 (MENU MENUGRID) of
 DATUM))
+                             (replace
 (REGION WIDTH) of
 (fetch
 (MENU MENUGRID) of
 DATUM) with
 
+                                                                                             NEWVALUE
+                                    ))
+                      (ITEMHEIGHT (fetch
 (REGION HEIGHT) of
 (fetch
 (MENU MENUGRID) of
 DATUM))
+                             (replace
 (REGION HEIGHT) of
 (fetch
 (MENU MENUGRID) of
 DATUM)
+                                with
 NEWVALUE))
                       (IMAGEWIDTH (BITMAPWIDTH (CHECK/MENU/IMAGE DATUM)))
                       (IMAGEHEIGHT (BITMAPHEIGHT (CHECK/MENU/IMAGE DATUM)))
-                      (MENUREGIONLEFT (IDIFFERENCE (fetch
 (REGION LEFT)
-                                                      of
 (fetch
 (MENU MENUGRID) of
 DATUM)
-                                                          )
+                      (MENUREGIONLEFT (IDIFFERENCE (fetch
 (REGION LEFT) of
 (fetch
 (MENU MENUGRID)
+                                                                              of
 DATUM))
                                              (fetch
 (MENU MENUOUTLINESIZE) of
 DATUM)))
                       (MENUREGIONBOTTOM (IDIFFERENCE (fetch
 (REGION BOTTOM)
-                                                        of
 (fetch
 (MENU MENUGRID)
-                                                                  of
 DATUM))
+                                                        of
 (fetch
 (MENU MENUGRID) of
 DATUM))
                                                (fetch
 (MENU MENUOUTLINESIZE) of
 DATUM])
 )
 
@@ -1726,27 +1709,25 @@ Copyright (c) 1982, 1983, 1984, 1985, 1986, 1987, 1988, 1990, 1991, 1993, 1994,
          (MENU
 40 POINTER)
          (MENU
 42 POINTER))
        '44)
-(PUTPROPS MENU COPYRIGHT ("Venue & Xerox Corporation" 1982 1983 1984 1985 1986 1987 1988 1990 1991 
-1993 1994 1999))
 (DECLARE%: DONTCOPY
-  (FILEMAP (NIL (2642 87699 (MAXMENUITEMHEIGHT 2652 . 3589) (MAXMENUITEMWIDTH 3591 . 5290) (MENU 5292 . 
-8189) (MENUTITLEFONT 8191 . 9461) (ADDMENU 9463 . 14901) (DELETEMENU 14903 . 16384) (MENUREGION 16386
- . 17246) (BLTMENUIMAGE 17248 . 19276) (ERASEMENUIMAGE 19278 . 20200) (DEFAULTMENUHELDFN 20202 . 20492
-) (DEFAULTWHENSELECTEDFN 20494 . 20905) (BACKGROUNDWHENSELECTEDFN 20907 . 21342) (GETMENUITEM 21344 . 
-21933) (MENUBUTTONFN 21935 . 22566) (MENU.HANDLER 22568 . 40670) (DOSELECTEDITEM 40672 . 41097) (
-SHOWSHADEDITEMS 41099 . 42516) (\AddShade 42518 . 43710) (\DelShade 43712 . 43983) (\FDECODE/BUTTON 
-43985 . 44372) (MENUITEMREGION 44374 . 47109) (\MENUITEMLABEL 47111 . 47457) (\MENUSUBITEMS 47459 . 
-47697) (CHECK/MENU/IMAGE 47699 . 49705) (PPROMPT2 49707 . 50096) (UPDATE/MENU/IMAGE 50098 . 66458) (
-\MAKE.ITEMS.VERT.ORDER 66460 . 67987) (\SHOWMENULABEL 67989 . 71916) (\POSITION.MENU.IMAGE 71918 . 
-74773) (\SMASHMENUIMAGEONRESET 74775 . 75123) (CLOSE.PROCESS.MENU 75125 . 75307) (DEFAULTSUBITEMFN 
-75309 . 76029) (GETMENUPROP 76031 . 76223) (PUTMENUPROP 76225 . 76598) (WAKE.MY.PROCESS 76600 . 76783)
- (\INVERTITEM 76785 . 77241) (\MENU.ITEM.SELECT 77243 . 78806) (\MENU.ITEM.DESELECT 78808 . 79510) (
-\ItemNumber 79512 . 80079) (\BOXITEM 80081 . 81628) (NESTED.SUBMENU 81630 . 84348) (NESTED.SUBMENU.POS
- 84350 . 87321) (WFROMMENU 87323 . 87697)) (88489 88909 (MENUREPAINTFN 88499 . 88907)) (88944 91993 (
-MAXSTRINGWIDTH 88954 . 89197) (CENTEREDPRIN1 89199 . 89636) (CENTERPRINTINREGION 89638 . 90167) (
-CENTERPRINTINAREA 90169 . 91626) (STRICTLY/BETWEEN 91628 . 91991)) (92027 97969 (UNREADITEM 92037 . 
-92359) (TYPEINMENU 92361 . 92562) (SHADEITEM 92564 . 94308) (RESHADEITEM 94310 . 95403) (
-MOST/VISIBLE/OPERATION 95405 . 95676) (%#BITSON 95678 . 96396) (BUTTONPANEL 96398 . 97190) (
-BUTTONPANEL/SELECTION/FN 97192 . 97744) (GETSELECTEDITEMS 97746 . 97967)) (98289 98830 (MENUDESELECT 
-98299 . 98516) (MENUSELECT 98518 . 98828)))))
+  (FILEMAP (NIL (2583 86884 (MAXMENUITEMHEIGHT 2593 . 3530) (MAXMENUITEMWIDTH 3532 . 5231) (MENU 5233 . 
+8130) (MENUTITLEFONT 8132 . 9572) (ADDMENU 9574 . 15012) (DELETEMENU 15014 . 16495) (MENUREGION 16497
+ . 17357) (BLTMENUIMAGE 17359 . 19387) (ERASEMENUIMAGE 19389 . 20311) (DEFAULTMENUHELDFN 20313 . 20603
+) (DEFAULTWHENSELECTEDFN 20605 . 21016) (BACKGROUNDWHENSELECTEDFN 21018 . 21453) (GETMENUITEM 21455 . 
+22044) (MENUBUTTONFN 22046 . 22677) (MENU.HANDLER 22679 . 40781) (DOSELECTEDITEM 40783 . 41208) (
+SHOWSHADEDITEMS 41210 . 42627) (\AddShade 42629 . 43821) (\DelShade 43823 . 44094) (\FDECODE/BUTTON 
+44096 . 44483) (MENUITEMREGION 44485 . 47220) (\MENUITEMLABEL 47222 . 47568) (\MENUSUBITEMS 47570 . 
+47808) (CHECK/MENU/IMAGE 47810 . 49816) (PPROMPT2 49818 . 50207) (UPDATE/MENU/IMAGE 50209 . 65643) (
+\MAKE.ITEMS.VERT.ORDER 65645 . 67172) (\SHOWMENULABEL 67174 . 71101) (\POSITION.MENU.IMAGE 71103 . 
+73958) (\SMASHMENUIMAGEONRESET 73960 . 74308) (CLOSE.PROCESS.MENU 74310 . 74492) (DEFAULTSUBITEMFN 
+74494 . 75214) (GETMENUPROP 75216 . 75408) (PUTMENUPROP 75410 . 75783) (WAKE.MY.PROCESS 75785 . 75968)
+ (\INVERTITEM 75970 . 76426) (\MENU.ITEM.SELECT 76428 . 77991) (\MENU.ITEM.DESELECT 77993 . 78695) (
+\ItemNumber 78697 . 79264) (\BOXITEM 79266 . 80813) (NESTED.SUBMENU 80815 . 83533) (NESTED.SUBMENU.POS
+ 83535 . 86506) (WFROMMENU 86508 . 86882)) (88093 88513 (MENUREPAINTFN 88103 . 88511)) (88548 91597 (
+MAXSTRINGWIDTH 88558 . 88801) (CENTEREDPRIN1 88803 . 89240) (CENTERPRINTINREGION 89242 . 89771) (
+CENTERPRINTINAREA 89773 . 91230) (STRICTLY/BETWEEN 91232 . 91595)) (91631 97573 (UNREADITEM 91641 . 
+91963) (TYPEINMENU 91965 . 92166) (SHADEITEM 92168 . 93912) (RESHADEITEM 93914 . 95007) (
+MOST/VISIBLE/OPERATION 95009 . 95280) (%#BITSON 95282 . 96000) (BUTTONPANEL 96002 . 96794) (
+BUTTONPANEL/SELECTION/FN 96796 . 97348) (GETSELECTEDITEMS 97350 . 97571)) (97889 98430 (MENUDESELECT 
+97899 . 98116) (MENUSELECT 98118 . 98428)))))
 STOP

sources/XCCS

@@ -1,12 +1,13 @@
 (DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
 
-
(FILECREATED "25-Mar-2025 23:40:52" {WMEDLEY}<sources>XCCS.;72
 14656  
+
(FILECREATED "13-Jul-2025 23:08:39" {DSK}<Users>kaplan>Local>medley3.5>git-medley>sources>XCCS.;10
 15413  
 
       :EDIT-BY rmk
 
       :CHANGES-TO (VARS XCCSCOMS)
 
-      :PREVIOUS-DATE "26-Mar-2024 11:00:37" {WMEDLEY}<sources>XCCS.;70)
+      :PREVIOUS-DATE "25-Mar-2025 23:40:52" 
+{DSK}<Users>kaplan>Local>medley3.5>git-medley>sources>XCCS.;9)
 
 
 (PRETTYCOMPRINT XCCSCOMS)
@@ -16,6 +17,7 @@
              \XCCSCHARSETFN)
         (FNS \CREATE.XCCS.EXTERNALFORMAT)
         (FNS \NSIN.24BITENCODING.ERROR)
+        (FNS KANJICHARSETP CHINESECHARSETP)
         (INITVARS (*SIGNAL-24BIT-NSENCODING-ERROR*))
         (DECLARE%: EVAL@COMPILE DONTCOPY (EXPORT (CONSTANTS (\NORUNCODE 255)
                                                         (NSCHARSETSHIFT 255))
@@ -262,6 +264,25 @@
                                                              (* ; "Return charset zero")

     0])
 )
+(DEFINEQ
+
+(KANJICHARSETP

+  [LAMBDA (CHARSET)
                                          (* ; "Edited 13-Jun-2025 16:33 by rmk")

+
+    (* ;; "Returns CHARSET if it is a charset with MCCS Kanji characters")

+
+    (AND (<= 48 CHARSET 118)
+         CHARSET])
+
+(CHINESECHARSETP

+  [LAMBDA (CHARSET)
                                          (* ; "Edited 18-Jun-2025 23:09 by rmk")


+                                                             (* ; "Edited 13-Jun-2025 16:33 by rmk")

+
+    (* ;; "Returns CHARSET if it is a charset with MCCS Chinese characters")

+
+    (AND (<= 161 CHARSET 212)
+         CHARSET])
+)
 
 (RPAQ? *SIGNAL-24BIT-NSENCODING-ERROR*
 )
 (DECLARE%: EVAL@COMPILE DONTCOPY 
@@ -294,8 +315,9 @@
 (\CREATE.XCCS.EXTERNALFORMAT
)
 )
 (DECLARE%: DONTCOPY
-  (FILEMAP (NIL (881 12137 (\XCCSINCCODE 891 . 3870) (\XCCSPEEKCCODE 3872 . 6541) (\XCCSOUTCHAR 6543 . 
-8763) (\XCCSBACKCCODE 8765 . 10309) (\XCCSFORMATBYTESTREAM 10311 . 10932) (\XCCSCHARSETFN 10934 . 
-12135)) (12138 12911 (\CREATE.XCCS.EXTERNALFORMAT 12148 . 12909)) (12912 13743 (
-\NSIN.24BITENCODING.ERROR 12922 . 13741)))))
+  (FILEMAP (NIL (997 12253 (\XCCSINCCODE 1007 . 3986) (\XCCSPEEKCCODE 3988 . 6657) (\XCCSOUTCHAR 6659 . 
+8879) (\XCCSBACKCCODE 8881 . 10425) (\XCCSFORMATBYTESTREAM 10427 . 11048) (\XCCSCHARSETFN 11050 . 
+12251)) (12254 13027 (\CREATE.XCCS.EXTERNALFORMAT 12264 . 13025)) (13028 13859 (
+\NSIN.24BITENCODING.ERROR 13038 . 13857)) (13860 14500 (KANJICHARSETP 13870 . 14126) (CHINESECHARSETP 
+14128 . 14498)))))
 STOP