Support for MCCS and other font character codes, medley-font format

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 "24-May-2025 10:18:08" {WMEDLEY}<internal>loadups>LOADUP-FULL.;11
 5247   
 
-      :EDIT-BY "lmm"
+      :EDIT-BY rmk
 
-      :CHANGES-TO (FNS LOADFULLFONTS)
+      :CHANGES-TO (FNS LOADUP-FULL)
 
-      :PREVIOUS-DATE "31-Jul-2023 18:28:53" {DSK}<home>larry>il>medley>internal>loadups>LOADUP-FULL.;1
-)
+      :PREVIOUS-DATE "22-May-2025 00:10:07" {WMEDLEY}<internal>loadups>LOADUP-FULL.;10)
 
 
 (PRETTYCOMPRINT LOADUP-FULLCOMS)
@@ -17,16 +16,18 @@
 (DEFINEQ
 
 (LOADFULLFONTS

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


+  [LAMBDA NIL
                                                (* ; "Edited 22-May-2025 00:10 by rmk")


+                                                             (* ; "Edited 16-May-2025 09:32 by rmk")


+                                                             (* ; "Edited  2-May-2025 14:32 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 DISPLAYFONTEXTENSIONS '(MEDLEYDISPLAYFONT DISPLAYFONT STRIKE))
     (SETQ *POSTSCRIPT-FILE-TYPE* 'TEXT)
-    (RESETVARS ((MISSINGDISPLAYFONTCOERCIONS NIL)
-                (MISSINGCHARSETDISPLAYFONTCOERCIONS NIL))    (* ; 
+    (RESETVARS ((DISPLAYFONTCOERCIONS NIL)
+                (DISPLAYCHARSETCOERCIONS 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 " ")
@@ -42,7 +43,10 @@
                (PRINTOUT T "FULL fonts loaded" T])
 
 (LOADUP-FULL

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


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


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


+                                                             (* ; "Edited  2-May-2025 22:12 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")


@@ -89,5 +93,5 @@
 
 (FIXMETA
)
 (DECLARE%: DONTCOPY
-  (FILEMAP (NIL (493 4624 (LOADFULLFONTS 503 . 2059) (LOADUP-FULL 2061 . 4374) (FIXMETA 4376 . 4622)))))
+  (FILEMAP (NIL (456 5209 (LOADFULLFONTS 466 . 2317) (LOADUP-FULL 2319 . 4959) (FIXMETA 4961 . 5207)))))
 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 "24-May-2025 10:20:14" |{WMEDLEY}<internal>loadups>LOADUP-LISP.;14|
 6330   
 
-      :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 "21-May-2025 09:25:09" |{WMEDLEY}<internal>loadups>LOADUP-LISP.;13|)
 
 
 (PRETTYCOMPRINT LOADUP-LISPCOMS)
@@ -20,7 +19,11 @@
 (DEFINEQ
 
 (LOADUP-LISP

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


+  (LAMBDA (DRIBBLEFILE)
                                     (* \; "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 +64,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 +82,12 @@
                     CMLENVIRONMENT CMLLOAD CMLFLOAT CMLTIME CMLRAND CMLMODULES))
     (LOADUP '(PROFILE CMLEXEC EXEC-COMMANDS DEBUGGER IL-ERROR-STUFF DEBUGEDIT))
     (LOADUP '(ADDARITH))
+
+    (* |;;| "Before the MEDLEYFONT implementation, FONTPROFILE came after NEWPRINTDEF above, but the loadup failed for undiagnosed reasons.  Loadup  also fails if FONTPROFILE comes at the beginning of the following list, succeeds if its at the end.  Needs a binary search to figure out the dependencies, but this sequence does work.")

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