Move lispusers/PS-SKETCH-PATCH to obsolete/lispusers/ (#2248)

Incompatible with current font interface, not loaded and sketch seems to work fine without it

library/PDFSTREAM

@@ -1,12 +1,14 @@
 (DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
 
-
(FILECREATED " 5-Jun-2025 08:42:11" {WMEDLEY}<library>PDFSTREAM.;64
 14885  
+
(FILECREATED "30-Jul-2025 18:01:04" 
+{DSK}<Users>kaplan>Local>medley3.5>working-medley>library>PDFSTREAM.;68
 15635  
 
       :EDIT-BY rmk
 
-      :CHANGES-TO (FNS OPEN-PDF-STREAM)
+      :CHANGES-TO (FNS SEE-PDF)
 
-      :PREVIOUS-DATE "23-Feb-2025 12:18:57" {WMEDLEY}<library>PDFSTREAM.;62)
+      :PREVIOUS-DATE "16-Jun-2025 00:52:44" 
+{DSK}<Users>kaplan>Local>medley3.5>working-medley>library>PDFSTREAM.;67)
 
 
 (PRETTYCOMPRINT PDFSTREAMCOMS)
@@ -28,11 +30,12 @@
                                           (CONVERSION (TEXT PDF.TEXT TEDIT PDF.TEDIT]
                      (IMAGESTREAMTYPES (PDF (OPENSTREAM OPEN-PDF-STREAM)
                                             (FONTCREATE POSTSCRIPT.FONTCREATE)
-                                            (FONTSAVAILABLE POSTSCRIPT.FONTSAVAILABLE)
-                                            (CREATECHARSET \CREATECHARSET.PSC]
+                                            (FONTSAVAILABLE PDF.FONTSAVAILABLE)
+                                            (CREATECHARSET \CREATECHARSET.PSC)
+                                            (FONTEXISTS? POSTSCRIPT.FONTEXISTS?]
               (ALISTS (DEFAULTFILETYPELIST PDF))
               (VARS (DEFAULTPRINTERTYPE 'PDF))
-              (FNS PDFFILEP PDF.HARDCOPYW PDF.TEXT PDF.TEDIT)
+              (FNS PDFFILEP PDF.HARDCOPYW PDF.TEXT PDF.TEDIT PDF.FONTSAVAILABLE)
               (P (FONTPROFILE.ADDDEVICE 'PDF 'POSTSCRIPT]
         
         (* ;; "")

@@ -71,8 +74,9 @@
 
 (ADDTOVAR IMAGESTREAMTYPES
 (PDF (OPENSTREAM OPEN-PDF-STREAM)
                                 (FONTCREATE POSTSCRIPT.FONTCREATE)
-                                (FONTSAVAILABLE POSTSCRIPT.FONTSAVAILABLE)
-                                (CREATECHARSET \CREATECHARSET.PSC)))
+                                (FONTSAVAILABLE PDF.FONTSAVAILABLE)
+                                (CREATECHARSET \CREATECHARSET.PSC)
+                                (FONTEXISTS? POSTSCRIPT.FONTEXISTS?)))
 
 (ADDTOVAR DEFAULTFILETYPELIST
 (PDF . BINARY))
 
@@ -123,6 +127,14 @@
     (LET ((TSTREAM (OPENTEXTSTREAM FILE)))
          (TEDIT.FORMAT.HARDCOPY FILE PDFFILE T NIL NIL NIL 'PDF)
          (CLOSEF TSTREAM])
+
+(PDF.FONTSAVAILABLE

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


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

+
+    (* ;; "")

+
+    (POSTSCRIPT.FONTSAVAILABLE FAMILY SIZE FACE ROTATION 'PDF])
 )
 
 (FONTPROFILE.ADDDEVICE 'PDF 'POSTSCRIPT)
@@ -272,14 +284,18 @@
 (DEFINEQ
 
 (SEE-PDF

-  [LAMBDA (PDFFILE)
                                          (* ; "Edited 25-Dec-2024 14:25 by rmk")


+  [LAMBDA (PDFFILE)
                                          (* ; "Edited 30-Jul-2025 18:00 by rmk")


+                                                             (* ; "Edited 25-Dec-2024 14:25 by rmk")


                                                              (* ; "Edited  1-Oct-2023 20:47 by rmk")


                                                              (* ; "Edited 26-Sep-2023 16:52 by rmk")

 
     (* ;; "Use the ShellOpener for this machine to open the PDF file outside of Medley")

 
-    (ShellOpen (OR (FINDFILE-WITH-EXTENSIONS PDFFILE NIL '(PDF))
-                   (ERROR "FILE NOT FOUND" PDFFILE])
+    (LET [(FOUND (FINDFILE-WITH-EXTENSIONS PDFFILE NIL '(PDF]
+         (if
 FOUND
+             then
 (ShellOpen FOUND)
+                  FOUND
+           else
 (ERROR "FILE NOT FOUND" PDFFILE])
 )
 
 (ADDTOVAR FB.SEE.METHODS
 (PDFFILEP SEE-PDF))
@@ -292,8 +308,8 @@
                                    thereis
 (ShellWhich (CAR TEMPLATE])
 )
 (DECLARE%: DONTCOPY
-  (FILEMAP (NIL (3263 5877 (PDFFILEP 3273 . 4187) (PDF.HARDCOPYW 4189 . 4787) (PDF.TEXT 4789 . 5506) (
-PDF.TEDIT 5508 . 5875)) (6317 13962 (OPEN-PDF-STREAM 6327 . 9048) (CLOSE-PDF-STREAM 9050 . 10337) (
-PS-TO-PDF 10339 . 13960)) (13963 14527 (SEE-PDF 13973 . 14525)) (14578 14862 (PDFCONVERTER 14588 . 
-14860)))))
+  (FILEMAP (NIL (3492 6433 (PDFFILEP 3502 . 4416) (PDF.HARDCOPYW 4418 . 5016) (PDF.TEXT 5018 . 5735) (
+PDF.TEDIT 5737 . 6104) (PDF.FONTSAVAILABLE 6106 . 6431)) (6873 14518 (OPEN-PDF-STREAM 6883 . 9604) (
+CLOSE-PDF-STREAM 9606 . 10893) (PS-TO-PDF 10895 . 14516)) (14519 15277 (SEE-PDF 14529 . 15275)) (15328
+ 15612 (PDFCONVERTER 15338 . 15610)))))
 STOP

library/WHERE-IS

@@ -1,12 +1,13 @@
 (DEFINE-FILE-INFO PACKAGE "XEROX-COMMON-LISP" READTABLE "XCL" BASE 10)
 
-
(IL:FILECREATED "30-Apr-2023 13:54:00" IL:|{DSK}<home>larry>il>medley>library>WHERE-IS.;2|
 17396  
+
(IL:FILECREATED "30-Jul-2025 16:15:16" IL:|{DSK}<home>matt>Interlisp>medley>library>WHERE-IS.;5|
 17827  
 
-      :EDIT-BY "lmm"
+      :EDIT-BY "mth"
 
-      :CHANGES-TO (IL:FUNCTIONS ADD-WHERE-IS-DATABASE)
+      :CHANGES-TO (IL:FUNCTIONS WHERE-IS-READ-COMS WHERE-IS-NOTICE)
 
-      :PREVIOUS-DATE "11-Mar-2022 22:40:32" IL:|{DSK}<home>larry>il>medley>library>WHERE-IS.;1|)
+      :PREVIOUS-DATE "30-Apr-2023 13:54:00" IL:|{DSK}<home>matt>Interlisp>medley>library>WHERE-IS.;1|
+)
 
 
 (IL:PRETTYCOMPRINT IL:WHERE-ISCOMS)
@@ -204,60 +205,62 @@
                               (DEFINE-TYPES (WHERE-IS-DEFAULT-DEFINE-TYPES
))
                               (HASH-FILE-SIZE *WHERE-IS-HASH-FILE-SIZE*)
                               (QUIET NIL)
-                              (TEMP-FILE NIL))
-   (LET* ((FILE (IF TEMP-FILE
-                    (IF NEW
-                        TEMP-FILE
-                        (IL:COPYFILE DATABASE-FILE TEMP-FILE))
-                    DATABASE-FILE))
-          (HASH-FILE:HASH-FILE (IF NEW
-                                   (HASH-FILE:MAKE-HASH-FILE FILE HASH-FILE-SIZE)
-                                   (HASH-FILE:OPEN-HASH-FILE FILE :DIRECTION :IO)))
-          (HASH-FILE::*DELETE-OLD-VERSION-ON-REHASH* T))
-         (UNWIND-PROTECT
-             (DOLIST (PATHNAME (WHERE-IS-FILES
 FILES))
-                 (UNLESS QUIET
-                     (FORMAT T ";;; ~A ." (NAMESTRING PATHNAME)))
-                 (LET ((NAMESTRING (WHERE-IS-NAMESTRING
 PATHNAME)))
-                      (IF (AND (NOT NEW)
-                               (LET ((OLD-WRITE-DATE (WHERE-IS-GET-WRITE-DATE
 NAMESTRING 
-                                                            HASH-FILE:HASH-FILE)))
-                                    (AND OLD-WRITE-DATE (= (FILE-WRITE-DATE PATHNAME)
-                                                           OLD-WRITE-DATE))))
-                          (UNLESS QUIET (FORMAT T " up to date.~%"))
-                          (MULTIPLE-VALUE-BIND
-                           (FILE-VARS VALUES)
-                           (WHERE-IS-READ-COMS
 PATHNAME)
-                           (WHEN FILE-VARS
+                              (TEMP-FILE NIL))
        (IL:* IL:\; "Edited 29-Jul-2025 23:55 by mth")

+   (LET*
+    ((FILE (IF TEMP-FILE
+               (IF NEW
+                   TEMP-FILE
+                   (IL:COPYFILE DATABASE-FILE TEMP-FILE))
+               DATABASE-FILE))
+     (HASH-FILE:HASH-FILE (IF NEW
+                              (HASH-FILE:MAKE-HASH-FILE FILE HASH-FILE-SIZE)
+                              (HASH-FILE:OPEN-HASH-FILE FILE :DIRECTION :IO)))
+     (HASH-FILE::*DELETE-OLD-VERSION-ON-REHASH* T))
+    (UNWIND-PROTECT
+        (DOLIST (PATHNAME (WHERE-IS-FILES
 FILES))
+            (WHEN (PATHNAME-NAME PATHNAME)                   (IL:* IL:\; "Skip directory entries")

+                (UNLESS QUIET
+                    (FORMAT T ";;; ~A ." (NAMESTRING PATHNAME)))
+                (LET ((NAMESTRING (WHERE-IS-NAMESTRING
 PATHNAME)))
+                     (IF (AND (NOT NEW)
+                              (LET ((OLD-WRITE-DATE (WHERE-IS-GET-WRITE-DATE
 NAMESTRING 
+                                                           HASH-FILE:HASH-FILE)))
+                                   (AND OLD-WRITE-DATE (= (FILE-WRITE-DATE PATHNAME)
+                                                          OLD-WRITE-DATE))))
+                         (UNLESS QUIET (FORMAT T " up to date.~%"))
+                         (MULTIPLE-VALUE-BIND
+                          (FILE-VARS VALUES)
+                          (WHERE-IS-READ-COMS
 PATHNAME)
+                          (WHEN FILE-VARS
 
-                               (IL:* IL:|;;| "bind the filevars s.t. IL:INFILECOMS? will find them")

+                              (IL:* IL:|;;| "bind the filevars s.t. IL:INFILECOMS? will find them")

 
-                               (PROGV FILE-VARS VALUES
-                                   (UNLESS QUIET (PRINC "."))
-                                   (DOLIST (TYPE DEFINE-TYPES)
-                                       (LET ((NAMES (IL:INFILECOMS? NIL TYPE (FIRST FILE-VARS))))
-                                            (WHEN (CONSP NAMES)
+                              (PROGV FILE-VARS VALUES
+                                  (UNLESS QUIET (PRINC "."))
+                                  (DOLIST (TYPE DEFINE-TYPES)
+                                      (LET ((NAMES (IL:INFILECOMS? NIL TYPE (FIRST FILE-VARS))))
+                                           (WHEN (CONSP NAMES)
 
-                                                (IL:* IL:|;;| "IL:INFILECOMS? sometimes returns T.")

+                                               (IL:* IL:|;;| "IL:INFILECOMS? sometimes returns T.")

 
-                                                (DOLIST (NAME NAMES)
-                                                    (WHERE-IS-NOTICE-INTERNAL
 NAME TYPE NAMESTRING 
-                                                           HASH-FILE:HASH-FILE))))))
-                               (WHERE-IS-SET-WRITE-DATE
 NAMESTRING PATHNAME HASH-FILE:HASH-FILE)
-                               (UNLESS QUIET
-                                   (PRINC ". done.")
-                                   (TERPRI)))))))
-             (HASH-FILE:CLOSE-HASH-FILE HASH-FILE:HASH-FILE))
-         (LET ((PATHNAME (PATHNAME (HASH-FILE::HASH-FILE-STREAM HASH-FILE:HASH-FILE))))
-              (COND
-                 (TEMP-FILE (UNLESS QUIET
-                                (FORMAT T ";;; Renaming ~A ... " (NAMESTRING PATHNAME)))
-                        (MULTIPLE-VALUE-BIND (MERGED TRUE-NAME REAL-TRUE-NAME)
-                               (RENAME-FILE PATHNAME DATABASE-FILE)
-                               (UNLESS QUIET
-                                   (FORMAT T "~A~%" (NAMESTRING REAL-TRUE-NAME)))
-                               REAL-TRUE-NAME))
-                 (T PATHNAME)))))
+                                               (DOLIST (NAME NAMES)
+                                                   (WHERE-IS-NOTICE-INTERNAL
 NAME TYPE NAMESTRING 
+                                                          HASH-FILE:HASH-FILE))))))
+                              (WHERE-IS-SET-WRITE-DATE
 NAMESTRING PATHNAME HASH-FILE:HASH-FILE)
+                              (UNLESS QUIET
+                                  (PRINC ". done.")
+                                  (TERPRI))))))))
+        (HASH-FILE:CLOSE-HASH-FILE HASH-FILE:HASH-FILE))
+    (LET ((PATHNAME (PATHNAME (HASH-FILE::HASH-FILE-STREAM HASH-FILE:HASH-FILE))))
+         (COND
+            (TEMP-FILE (UNLESS QUIET
+                           (FORMAT T ";;; Renaming ~A ... " (NAMESTRING PATHNAME)))
+                   (MULTIPLE-VALUE-BIND (MERGED TRUE-NAME REAL-TRUE-NAME)
+                          (RENAME-FILE PATHNAME DATABASE-FILE)
+                          (UNLESS QUIET
+                              (FORMAT T "~A~%" (NAMESTRING REAL-TRUE-NAME)))
+                          REAL-TRUE-NAME))
+            (T PATHNAME)))))
 
 (DEFUN WHERE-IS-NOTICE-INTERNAL
 (NAME TYPE FILE-NAME HASH-FILE:HASH-FILE)
 
@@ -318,7 +321,7 @@
                           NIL
                           (PATHNAME-TYPE PATHNAME)))))
 
-(DEFUN WHERE-IS-READ-COMS
 (PATHNAME)
+(DEFUN WHERE-IS-READ-COMS
 (PATHNAME)
                  (IL:* IL:\; "Edited 30-Jul-2025 16:13 by mth")

 
 (IL:* IL:|;;;| "returns as first value a list of the filevars on PATHNAME, as second value a list of the values for these filevars.")

 
@@ -330,23 +333,28 @@
        (DO ((IL:LOAD-VERBOSE-STREAM 'NIL)
             (ALL-FILE-VARS)
             (QUEUE (LIST (IL:FILECOMS (STRING-UPCASE (PATHNAME-NAME PATHNAME))))
-                   (COND
-                      ((CONSP (IL:NLSETQ (IL:LOADVARS QUEUE PATHNAME NIL)))
-                       (MAPCAN #'(LAMBDA (FILE-VAR)
-                                        (IF (BOUNDP FILE-VAR)
-                                            (LET ((FILE-VARS (IL:INFILECOMS? NIL 'IL:FILEVARS 
-                                                                    FILE-VAR)))
-                                                 (PUSH FILE-VAR ALL-FILE-VARS)
-                                                 (WHEN (CONSP FILE-VARS)
-                                                       FILE-VARS))
-                                            (PROG1 NIL
-                                                (WARN "Couldn't find ~S on ~A." FILE-VAR (NAMESTRING
-                                                                                          PATHNAME))))
-                                        )
-                              QUEUE))
-                      (T (WARN "Error attempting to LOADVARS ~S from ~A." QUEUE (NAMESTRING PATHNAME)
-                               )
-                         'NIL))))
+                   (MULTIPLE-VALUE-BIND
+                    (LV-RESULT ERROR-CONDITION)
+                    (IGNORE-ERRORS (IL:LOADVARS QUEUE PATHNAME NIL))
+                    (COND
+                       ((CONSP LV-RESULT)
+                        (MAPCAN #'(LAMBDA (FILE-VAR)
+                                         (IF (BOUNDP FILE-VAR)
+                                             (LET ((FILE-VARS (IL:INFILECOMS? NIL 'IL:FILEVARS 
+                                                                     FILE-VAR)))
+                                                  (PUSH FILE-VAR ALL-FILE-VARS)
+                                                  (WHEN (CONSP FILE-VARS)
+                                                        FILE-VARS))
+                                             (PROG1 NIL
+                                                 (WARN "Couldn't find ~S on ~A." FILE-VAR
+                                                       (NAMESTRING PATHNAME)))))
+                               QUEUE))
+                       (ERROR-CONDITION (WARN 
+                                            "Error attempting to LOADVARS ~S from ~A.~%Condition: ~A"
+                                              QUEUE (NAMESTRING PATHNAME)
+                                              ERROR-CONDITION)
+                              'NIL)
+                       (T NIL)))))
            ((NULL QUEUE)
             (SETQ ALL-FILE-VARS (NREVERSE ALL-FILE-VARS))
             (VALUES ALL-FILE-VARS (MAPCAR #'SYMBOL-VALUE ALL-FILE-VARS)))
@@ -379,14 +387,15 @@
 (IL:PUTPROPS IL:WHERE-IS
 IL:MAKEFILE-ENVIRONMENT
 (:READTABLE "XCL" :PACKAGE "XCL"))
 
 (IL:PUTPROPS IL:WHERE-IS
 IL:FILETYPE
 :COMPILE-FILE)
+(IL:PUTPROPS IL:WHERE-IS IL:COPYRIGHT (IL:NONE))
 (IL:DECLARE\: IL:DONTCOPY
-  (IL:FILEMAP (NIL (1737 2069 (HASH-FILE-WHERE-IS 1737 . 2069)) (2071 2464 (HASH-FILE-TYPES-OF 2071 . 
-2464)) (2466 4631 (GET-WHERE-IS-ENTRIES 2466 . 4631)) (4633 5148 (WHERE-IS-READ-FN 4633 . 5148)) (5150
- 5306 (ADD-WHERE-IS-DATABASES 5150 . 5306)) (5308 5695 (ADD-WHERE-IS-DATABASE 5308 . 5695)) (5697 6176
- (DEL-WHERE-IS-DATABASE 5697 . 6176)) (6178 7330 (SAME-WHERE-IS-DATABASE 6178 . 7330)) (7332 8539 (
-CLOSE-WHERE-IS-FILES 7332 . 8539)) (8797 12214 (WHERE-IS-NOTICE 8797 . 12214)) (12216 12960 (
-WHERE-IS-NOTICE-INTERNAL 12216 . 12960)) (12962 13698 (WHERE-IS-FILES 12962 . 13698)) (13700 14065 (
-WHERE-IS-DEFAULT-DEFINE-TYPES 13700 . 14065)) (14067 14486 (WHERE-IS-NAMESTRING 14067 . 14486)) (14488
- 16500 (WHERE-IS-READ-COMS 14488 . 16500)) (16502 16773 (WHERE-IS-SET-WRITE-DATE 16502 . 16773)) (
-16775 17025 (WHERE-IS-GET-WRITE-DATE 16775 . 17025)))))
+  (IL:FILEMAP (NIL (1763 2095 (HASH-FILE-WHERE-IS 1763 . 2095)) (2097 2490 (HASH-FILE-TYPES-OF 2097 . 
+2490)) (2492 4657 (GET-WHERE-IS-ENTRIES 2492 . 4657)) (4659 5174 (WHERE-IS-READ-FN 4659 . 5174)) (5176
+ 5332 (ADD-WHERE-IS-DATABASES 5176 . 5332)) (5334 5721 (ADD-WHERE-IS-DATABASE 5334 . 5721)) (5723 6202
+ (DEL-WHERE-IS-DATABASE 5723 . 6202)) (6204 7356 (SAME-WHERE-IS-DATABASE 6204 . 7356)) (7358 8565 (
+CLOSE-WHERE-IS-FILES 7358 . 8565)) (8823 12278 (WHERE-IS-NOTICE 8823 . 12278)) (12280 13024 (
+WHERE-IS-NOTICE-INTERNAL 12280 . 13024)) (13026 13762 (WHERE-IS-FILES 13026 . 13762)) (13764 14129 (
+WHERE-IS-DEFAULT-DEFINE-TYPES 13764 . 14129)) (14131 14550 (WHERE-IS-NAMESTRING 14131 . 14550)) (14552
+ 16882 (WHERE-IS-READ-COMS 14552 . 16882)) (16884 17155 (WHERE-IS-SET-WRITE-DATE 16884 . 17155)) (
+17157 17407 (WHERE-IS-GET-WRITE-DATE 17157 . 17407)))))
 IL:STOP

library/tedit/TEDIT-WINDOW

@@ -1,12 +1,12 @@
 (DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
 
-
(FILECREATED "30-May-2025 12:54:56" {WMEDLEY}<library>TEDIT>TEDIT-WINDOW.;860
 229476 
+
(FILECREATED "21-Jul-2025 11:55:26" {WMEDLEY}<library>TEDIT>TEDIT-WINDOW.;861
 229641 
 
       :EDIT-BY rmk
 
-      :CHANGES-TO (FNS TEDIT.DEACTIVATE.WINDOW)
+      :CHANGES-TO (FNS \TEDIT.WINDOW.CREATE)
 
-      :PREVIOUS-DATE "29-May-2025 15:02:25" {WMEDLEY}<library>TEDIT>TEDIT-WINDOW.;858)
+      :PREVIOUS-DATE "30-May-2025 12:54:56" {WMEDLEY}<library>TEDIT>TEDIT-WINDOW.;860)
 
 
 (PRETTYCOMPRINT TEDIT-WINDOWCOMS)
@@ -354,7 +354,8 @@
 (DEFINEQ
 
 (\TEDIT.WINDOW.CREATE

-  [LAMBDA (WINDOW TSTREAM PROPS)
                             (* ; "Edited  9-May-2025 12:11 by rmk")


+  [LAMBDA (WINDOW TSTREAM PROPS)
                             (* ; "Edited 21-Jul-2025 11:55 by rmk")


+                                                             (* ; "Edited  9-May-2025 12:11 by rmk")


                                                              (* ; "Edited 25-Apr-2025 21:24 by rmk")


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


                                                              (* ; "Edited 18-Feb-2025 09:49 by rmk")


@@ -392,7 +393,8 @@
                  (TEDIT.KILL WINDOW)
                  (\TEDIT.CLOSESPLITS
 (fetch
 (TEXTWINDOW WTEXTSTREAM) of
 WINDOW)
                         T))
-             (SETQ TITLE (LISTGET PROPS 'TITLE)))
+             [SETQ TITLE (OR (LISTGET PROPS 'TITLE)
+                             (WINDOWPROP WINDOW 'TITLE])
          (SETQ REGIONTYPE (OR (GETTEXTPROP TEXTOBJ 'REGION-TYPE)
                               (AND (LITATOM WINDOW)
                                    WINDOW)))
@@ -3627,36 +3629,36 @@
 (RPAQ? TEDIT.TITLED.ICON.TEMPLATE
 (create TITLEDICON ICON _ TEDITICON MASK _ TEDITMASK TITLEREG _ 
                                          TEDIT.ICON.TITLE.REGION))
 (DECLARE%: DONTCOPY
-  (FILEMAP (NIL (17103 17999 (TEDIT.DEFER.UPDATES 17113 . 17997)) (18000 43777 (\TEDIT.WINDOW.CREATE 
-18010 . 25172) (\TEDIT.WINDOW.GETREGION 25174 . 28664) (\TEDIT.WINDOW.SETUP 28666 . 32996) (
-\TEDIT.MINIMAL.WINDOW.SETUP 32998 . 40409) (\TEDIT.CLEARPANE 40411 . 41128) (\TEDIT.FILL.PANES 41130
- . 43775)) (43778 67751 (\TEDIT.CURSORMOVEDFN 43788 . 49398) (\TEDIT.CURSOROUTFN 49400 . 50088) (
-\TEDIT.ACTIVE.WINDOWP 50090 . 51160) (\TEDIT.EXPANDFN 51162 . 51725) (\TEDIT.MAINW 51727 . 53007) (
-\TEDIT.MAINSTREAM 53009 . 53343) (\TEDIT.PRIMARYPANE 53345 . 54115) (\TEDIT.PANELIST 54117 . 54613) (
-\TEDIT.NEWREGIONFN 54615 . 57131) (\TEDIT.SET.WINDOW.EXTENT 57133 . 62387) (\TEDIT.SHRINK.ICONCREATE 
-62389 . 65122) (\TEDIT.SHRINKFN 65124 . 65533) (\TEDIT.PANEREGION 65535 . 67749)) (67783 100829 (
-\TEDIT.BUTTONEVENTFN 67793 . 80766) (\TEDIT.BUTTONEVENTFN.DOOPERATION 80768 . 88031) (
-\TEDIT.BUTTONEVENTFN.GETOPERATION 88033 . 89875) (\TEDIT.BUTTONEVENTFN.CURSEL.INIT 89877 . 93547) (
-\TEDIT.BUTTONEVENTFN.INACTIVE 93549 . 95979) (\TEDIT.BUTTONEVENTFN.INTITLE 95981 . 97816) (
-\TEDIT.COPYINSERTFN 97818 . 98950) (\TEDIT.FOREIGN.COPY 98952 . 100827)) (100830 118072 (
-\TEDIT.PANE.SPLIT 100840 . 104788) (\TEDIT.SPLITW 104790 . 112528) (\TEDIT.UNSPLITW 112530 . 116729) (
-\TEDIT.LINKPANES 116731 . 117494) (\TEDIT.UNLINKPANE 117496 . 118070)) (119506 120397 (TEDITWINDOWP 
-119516 . 120395)) (120434 123537 (TEDIT.GETINPUT 120444 . 122887) (\TEDIT.MAKEFILENAME 122889 . 123535
-)) (123586 131213 (TEDIT.PROMPTWINDOW 123596 . 123910) (TEDIT.PROMPTPRINT 123912 . 126539) (
-TEDIT.PROMPTCLEAR 126541 . 128260) (TEDIT.PROMPTFLASH 128262 . 129520) (\TEDIT.PROMPT.PAGEFULLFN 
-129522 . 131211)) (131451 141855 (\TEDIT.FILENAME 131461 . 132233) (\TEDIT.DEFAULT.TITLE 132235 . 
-134614) (\TEDIT.WINDOW.TITLE 134616 . 136785) (\TEDIT.LIKELY.FILENAME 136787 . 139337) (
-\TEDIT.UPDATE.TITLE 139339 . 141853)) (141898 154382 (TEDIT.DEACTIVATE.WINDOW 141908 . 147481) (
-\TEDIT.RESHAPEFN 147483 . 149568) (\TEDIT.REPAINTFN 149570 . 149794) (\TEDIT.CLOSESPLITS 149796 . 
-152241) (\TEDIT.CLOSEPANE 152243 . 154380)) (154383 197182 (\TEDIT.SCROLLFN 154393 . 156624) (
-\TEDIT.SCROLLCH.TOP 156626 . 158737) (\TEDIT.SCROLLCH.BOTTOM 158739 . 163069) (\TEDIT.SCROLLUP 163071
- . 168797) (\TEDIT.TOPLINE.YTOP 168799 . 170468) (\TEDIT.SCROLLDOWN 170470 . 177509) (
-\TEDIT.SCROLL.CARET 177511 . 180349) (\TEDIT.VISIBLECARETP 180351 . 182645) (\TEDIT.VISIBLECHARP 
-182647 . 183738) (\TEDIT.BITMAPLINES 183740 . 187660) (\TEDIT.SETPANE.TOPLINE 187662 . 188274) (
-\TEDIT.SHIFTLINES 188276 . 197180)) (197183 208052 (\TEDIT.ONSCREEN? 197193 . 201744) (
-\TEDIT.ONSCREEN.REGION 201746 . 205397) (\TEDIT.AFTERMOVEFN 205399 . 206296) (OFFSCREENP 206298 . 
-208050)) (208094 210908 (\TEDIT.PROCIDLEFN 208104 . 209764) (\TEDIT.PROCENTRYFN 209766 . 210211) (
-\TEDIT.PROCEXITFN 210213 . 210906)) (210987 224212 (\TEDIT.DOWNCARET 210997 . 211790) (
-\TEDIT.FLASHCARET 211792 . 213903) (\TEDIT.UPCARET 213905 . 215009) (TEDIT.NORMALIZECARET 215011 . 
-218229) (\TEDIT.SETCARET 218231 . 223582) (\TEDIT.CARET 223584 . 224210)))))
+  (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)))))
 STOP

lispusers/INSPECTCODE-TEDIT

@@ -1,59 +1,53 @@
-(DEFINE-FILE-INFO §READTABLE "INTERLISP" §PACKAGE (DEFPACKAGE "INSPECTCODE-TEDIT" (§USE "INTERLISP") (
-§NICKNAMES "ICT") (§PREFIX-NAME "ICT")))
-
(FILECREATED " 4-May-87 11:52:50" {DSK}<LISPFILES>MATT>INSPECTCODE-TEDIT.;10
 16087  
+(DEFINE-FILE-INFO PACKAGE (PROGN (CLINTERN "INSPECTCODE-TEDITCOMS" "INTERLISP") (* ;; 
+"Above is to ensure the COMS is in the INTERLISP package!") (DEFPACKAGE "INSPECTCODE-TEDIT" (USE 
+"INTERLISP") (NICKNAMES "ICT") (PREFIX-NAME "ICT"))) READTABLE "INTERLISP" BASE 10)
 
-      changes to%:  (ADVICE IL:OPENTEXTSTREAM-IN-\TEDIT.INSPECTCODE)
-                    (FILEVARS IL:INSPECTCODE-TEDITCOMS)
-                    (FNS TITLEMENU-FN OPENTEXTSTREAM-FOR-\TEDIT.INSPECTCODE)
+
(FILECREATED "28-Jul-2025 12:42:03" {DSK}<home>matt>Interlisp>medley>lispusers>INSPECTCODE-TEDIT.;16
 18137  
 
-      previous date%: " 7-Apr-87 16:03:12" IL:{DSK}<LISPFILES>MATT>INSPECTCODE-TEDIT.;9)
+      :EDIT-BY "mth"
+
+      :CHANGES-TO (VARS INSPECTCODE-TEDITCOMS)
+                  (FNS ADVICE-ON-\TEDIT.INSPECTCODE)
+                  (ADVICE (DECODE.WINDOW.ARG :IN \TEDIT.INSPECTCODE))
+
+      :PREVIOUS-DATE "23-Jul-2025 18:40:40" 
+{DSK}<home>matt>Interlisp>medley>lispusers>INSPECTCODE-TEDIT.;14)
 
 
-(* "
-Copyright (c) 1985, 1986, 1987 by Beckman Instruments, Inc..  All rights reserved.
-")
+(PRETTYCOMPRINT INSPECTCODE-TEDITCOMS)
 
-(PRETTYCOMPRINT IL:INSPECTCODE-TEDITCOMS)
+(RPAQQ INSPECTCODE-TEDITCOMS

+       ((FILES (FROM LISPUSERS)
+               GRAPHCALLS)
+        (FNS ADVICE-ON-\TEDIT.INSPECTCODE ICON-FN INSP.ERROR KILL.TEDIT.PROCESS 
+             OPENTEXTSTREAM-FOR-\TEDIT.INSPECTCODE TITLEMENU-FN)
+        (FUNCTIONS BUILD-TITLEMENU)
+        (GLOBALVARS TITLEMENU-ITEMS)
+        (VARS ICON.TEMPLATE TITLEMENU-ITEMS-TEMPLATE (TITLEMENU-ITEMS (BUILD-TITLEMENU 
+                                                                             TITLEMENU-ITEMS-TEMPLATE
+                                                                             )))
+        (P (CHANGENAME '\TEDIT.INSPECTCODE 'TEXTICON 'ICON-FN))
+        (ADVISE (DECODE.WINDOW.ARG :IN \TEDIT.INSPECTCODE))
+        (COMMANDS IC)
+        (PROP (FILETYPE MAKEFILE-ENVIRONMENT)
+              INSPECTCODE-TEDIT)))
 
-(RPAQQ IL:INSPECTCODE-TEDITCOMS
 ((FNS BUILD.TITLEMENU ICON-FN INSP.ERROR KILL.TEDIT.PROCESS NOSELFN 
-                                      OPENTEXTSTREAM-FOR-\TEDIT.INSPECTCODE TITLEMENU-FN)
-                                 (UGLYVARS ICON.TEMPLATE)
-                                 (P (CHANGENAME '\TEDIT.INSPECTCODE 'TEXTICON 'ICON-FN)
-                                    (CHANGENAME '\TEDIT.INSPECTCODE 'OPENTEXTSTREAM '
-                                           OPENTEXTSTREAM-FOR-\TEDIT.INSPECTCODE))
-                                 (COMMANDS IC)
-                                 (PROP (FILETYPE MAKEFILE-ENVIRONMENT)
-                                       INSPECTCODE-TEDIT)))
+(FILESLOAD (FROM
 LISPUSERS)
+       GRAPHCALLS)
 (DEFINEQ
 
-(BUILD.TITLEMENU

-  [LAMBDA NIL
                                         (* ; "Edited 30-Mar-87 16:32 by Matt Heffron")

-    (DECLARE
 (GLOBALVARS TITLEMENU))
-    (SETQ TITLEMENU (create
 MENU
-                           ITEMS _ '((GraphCalls 'GC "Invoke GRAPHCALLS on the current selection")
-                                     (InspectCode 'IC "INSPECTCODE the current selection")
-                                     (Inspect 'INSP "INSPECT the current selection"
-                                            (SUBITEMS (Freely 'INSP 
-                                                  "INSPECT the free-reference value of the selection"
-                                                             )
-                                                   (Globally 'INSP.GLOB 
-                                              "INSPECT the Global (Top Level) value of the selection"
-                                                          )
-                                                   ("In Process Context" 'INSP.PROC 
-                                           "INSPECT the value of the selection in a process' context"
-                                                          )))
-                                     ("Pretty Print Value" 'PPV 
-                                            "Pretty Print the value of the current selection"
-                                            (SUBITEMS (Freely 'PPV 
-                                             "Pretty Print the free-reference value of the selection"
-                                                             )
-                                                   (Globally 'PPV.GLOB 
-                                         "Pretty Print the Global (Top Level) value of the selection"
-                                                          )
-                                                   ("In Process Context" 'PPV.PROC 
-                                      "Pretty Print the value of the selection in a process' context"
-                                                          )))
-                                     (Quit 'QUIT "Terminates this INSPECTCODE"])
+(ADVICE-ON-\TEDIT.INSPECTCODE

+  [LAMBDA (W FN)
+    (DECLARE
 (GLOBALVARS TITLEMENU-ITEMS))
                   (* ; "Edited 28-Jul-2025 12:28 by mth")

+    (WINDOWPROP W 'TEDIT.MENU.COMMANDS TITLEMENU-ITEMS)
+    [WINDOWPROP W 'FNNAME (COND
+                             ((OR (LITATOM FN)
+                                  (NOT (CCODEP FN)))
+                              FN)
+                             (T (fetch
 (COMPILED-CLOSURE FRAMENAME) of
 FN]
+    (WINDOWPROP W '*PACKAGE* *PACKAGE*)
+    (WINDOWPROP W '*READTABLE* *READTABLE*)
+    W])
 
 (ICON-FN

   [LAMBDA (W)
                                         (* ; "Edited 30-Mar-87 15:59 by Matt Heffron")

@@ -67,59 +61,44 @@ Copyright (c) 1985, 1986, 1987 by Beckman Instruments, Inc..  All rights reserve
          ICON])
 
 (INSP.ERROR

-  [LAMBDA (MESS1 MESS2 MESS3)
                         (* ; "Edited 30-Mar-87 16:00 by Matt Heffron")

-    (CLRPROMPT)
-    (if
 (NOT MESS2)
-        then
 (PROMPTPRINT MESS1)
-      elseif
 (NOT MESS3)
-        then
 (PROMPTPRINT MESS1 MESS2)
-      else
 (PROMPTPRINT MESS1 MESS2 MESS3))
-    (RINGBELLS])
+  [LAMBDA (TSTREAM MESS1 MESS2 MESS3)
                        (* ; "Edited 23-Jul-2025 16:51 by mth")


+                                                      (* ; "Edited 30-Mar-87 16:00 by Matt Heffron")

+    (TEDIT.PROMPTPRINT TSTREAM (CONCAT MESS1 (OR MESS2 "")
+                                      (OR MESS3 ""))
+           T])
 
 (KILL.TEDIT.PROCESS

   [LAMBDA (W)
                                         (* ; "Edited 30-Mar-87 16:00 by Matt Heffron")

     (DEL.PROCESS (WINDOWPROP W 'PROCESS])
 
-(NOSELFN

-  [LAMBDA NIL
                                         (* ; "Edited 30-Mar-87 16:01 by Matt Heffron")

-    (CLRPROMPT)
-    (PROMPTPRINT "No current selection")
-    (RINGBELLS])
-
 (OPENTEXTSTREAM-FOR-\TEDIT.INSPECTCODE

   [LAMBDA (TEXT WINDOW START END PROPS)                      (* ; "Edited  4-May-87 11:47 by ")

     (PROG1 [OPENTEXTSTREAM TEXT WINDOW START END (APPEND PROPS '(QUITFN T TITLEMENUFN TITLEMENU-FN 
                                                                        NOTITLE T]
-           (WINDOWADDPROP WINDOW 'CLOSEFN (FUNCTION KILL.TEDIT.PROCESS))
-           (WINDOWPROP WINDOW 'FNNAME FN)
-           (WINDOWPROP WINDOW '*PACKAGE* *PACKAGE*)
-           (WINDOWPROP WINDOW '*READTABLE* *READTABLE*])
+        (WINDOWADDPROP WINDOW 'CLOSEFN (FUNCTION KILL.TEDIT.PROCESS))
+        (WINDOWPROP WINDOW 'FNNAME FN)
+        (WINDOWPROP WINDOW '*PACKAGE* *PACKAGE*)
+        (WINDOWPROP WINDOW '*READTABLE* *READTABLE*))])
 
 (TITLEMENU-FN

-  [LAMBDA (W)                                                (* ; "Edited  4-May-87 11:32 by ")

-                                                             (* ; "Edited  4-May-87 11:25 by ")

-                                                             (* ; "Edited  4-May-87 11:19 by ")

-    (DECLARE
 (GLOBALVARS TITLEMENU))
-    (if
 (OR (NOT (BOUNDP 'TITLEMENU))
-            (NOT (type?
 MENU TITLEMENU)))
-        then
 (BUILD.TITLEMENU
))
+  [LAMBDA (STREAM MI)
                                        (* ; "Edited 23-Jul-2025 16:56 by mth")

+                                                             (* ; "Edited  4-May-87 11:32 by ")

     [LET*
-     ((STREAM (TEXTSTREAM W))
+     ((W (\TEDIT.PRIMARYPANE STREAM))
       (W*PACKAGE* (WINDOWPROP W '*PACKAGE*))
       (W*READTABLE* (WINDOWPROP W '*READTABLE*))
       (SELLEN (fetch
 (SELECTION DCH) of
 (TEDIT.GETSEL STREAM)))
-      (MENUCHOICE (MENU TITLEMENU))
       (SpecifyRegionString "Specify a region for the value pretty print window")
       INSPVAL SELSTR DISPLAYWINDOW)
-     (if
 (NOT MENUCHOICE)
+     (if
 (NOT MI)
          then
                                                (* ; 
 
                                                             "Nothing to do, clicked out of menu")

-       elseif
 (EQ MENUCHOICE 'QUIT)
+       elseif
 (EQ MI 'QUIT)
          then
 (TEDIT.QUIT STREAM)
               (if
 (OPENWP W)
                   then
 (CLOSEW W))
        else
 [if
 (EQ SELLEN 0)
-                then
 (NOSELFN
)
+                then
 (TEDIT.PROMPTPRINT STREAM SpecifyRegionString T)
               elseif
 (GREATERP SELLEN 255)
                 then
 (INSP.ERROR
 "Selection is too long (> 255 characters)")
                      (TEDIT.SHOWSEL STREAM NIL NIL)
@@ -129,25 +108,24 @@ Copyright (c) 1985, 1986, 1987 by Beckman Instruments, Inc..  All rights reserve
                                       (STRM (OPENSTRINGSTREAM (TEDIT.SEL.AS.STRING STREAM NIL)
                                                    'INPUT]
                                      (READ STRM]
-            (SELECTQ MENUCHOICE
+            (SELECTQ MI
                 (IC (LET ((*PACKAGE* W*PACKAGE*)
                           (*READTABLE* W*READTABLE*))
                          (INSPECTCODE SELSTR)))
-                (GC (if
 (FGETD 'GRAPHCALLSW)
+                (GC (if
 (FGETD 'IL:GRAPHCALLSW)
                         then
 (if
 (NOT (LET ((*PACKAGE* W*PACKAGE*)
                                             (*READTABLE* W*READTABLE*))
-                                           (GRAPHCALLS SELSTR)))
+                                           (IL:GRAPHCALLS SELSTR)))
                                  then
 (INSP.ERROR
 "Nothing to graph!!"))
                       else
 (INSP.ERROR
 "The GRAPHCALLS package is not loaded.  Cannot graph " SELSTR)
                         ))
                 ((INSP PPV) 
                      (if
 (BOUNDP SELSTR)
                          then
 (if
 (EQ MENUCHOICE 'PPV)
-                                  then
 (PROMPTPRINT SpecifyRegionString)
+                                  then
 (TEDIT.PROMPTPRINT STREAM SpecifyRegionString T)
                                        (SETQ DISPLAYWINDOW (CREATEW (GETREGION (WIDTHIFWINDOW 72)
                                                                            (HEIGHTIFWINDOW 72 T))
                                                                   SELSTR))
-                                       (CLRPROMPT)
                                        (printout DISPLAYWINDOW .PPV (EVAL SELSTR))
                                 else
 (INSPECT (EVALV SELSTR)))
                        else
 (INSP.ERROR
 SELSTR " has no value to " (if
 (EQ MENUCHOICE 'PPV)
@@ -157,11 +135,10 @@ Copyright (c) 1985, 1986, 1987 by Beckman Instruments, Inc..  All rights reserve
                      (if
 (NEQ (SETQ INSPVAL (GETTOPVAL SELSTR))
                               'NOBIND)
                          then
 (if
 (EQ MENUCHOICE 'PPV.GLOB)
-                                  then
 (PROMPTPRINT SpecifyRegionString)
+                                  then
 (TEDIT.PROMPTPRINT STREAM SpecifyRegionString T)
                                        (SETQ DISPLAYWINDOW (CREATEW (GETREGION (WIDTHIFWINDOW 72)
                                                                            (HEIGHTIFWINDOW 72 T))
                                                                   SELSTR))
-                                       (CLRPROMPT)
                                        (printout DISPLAYWINDOW .PPV INSPVAL)
                                 else
 (INSPECT INSPVAL))
                        else
 (INSP.ERROR
 SELSTR " has no Global value to "
@@ -181,12 +158,11 @@ Copyright (c) 1985, 1986, 1987 by Beckman Instruments, Inc..  All rights reserve
                               then
 [if
 (NEQ (SETQ INSPVAL (PROCESS.EVALV PROC SELSTR))
                                             'NOBIND)
                                        then
 (if
 (EQ MENUCHOICE 'PPV.PROC)
-                                                then
 (PROMPTPRINT SpecifyRegionString)
+                                                then
 (TEDIT.PROMPTPRINT STREAM SpecifyRegionString T)
                                                      (SETQ DISPLAYWINDOW
                                                       (CREATEW (GETREGION (WIDTHIFWINDOW 72)
                                                                       (HEIGHTIFWINDOW 72 T))
                                                              SELSTR))
-                                                     (CLRPROMPT)
                                                      (printout DISPLAYWINDOW .PPV INSPVAL)
                                               else
 (INSPECT INSPVAL))
                                      else
 (INSP.ERROR
 SELSTR (if
 (EQ MENUCHOICE 'PPV.PROC)
@@ -205,117 +181,110 @@ Copyright (c) 1985, 1986, 1987 by Beckman Instruments, Inc..  All rights reserve
                        ]
     NIL])
 )
-(READVAR-FROM-STRING 'ICON.TEMPLATE "({(READBITMAP)(87 91
-%"OOOOOOOOOOOOOOOOOOOOON@@%"
-%"OOOOOOOOOOOOOOOOOOOOON@@%"
-%"L@@@@@@@@@@@@@@@@@@@@F@@%"
-%"L@@@@@@@@@@@@@@@@@@@@F@@%"
-%"L@@@@@@@@@@@@@@@@@@@@F@@%"
-%"L@@@@@@@@@@@@@@@@@@@@F@@%"
-%"L@@@@@@@@@@@@COO@@@@@F@@%"
-%"L@@@@@@@@@@@AOOON@@@@F@@%"
-%"L@@@@@@@@@@@GN@AOH@@@F@@%"
-%"L@@@@@@@@@@AO@@@CN@@@F@@%"
-%"L@@@@@@@@@@CL@@@@O@@@F@@%"
-%"L@@@@@@@@@@O@@@@@CL@@F@@%"
-%"L@@@@@@@@@AN@@@@@AN@@F@@%"
-%"L@@@@@@@@@CH@@@@@@G@@F@@%"
-%"L@@@@@@@@@C@@@@@@@C@@F@@%"
-%"L@@@@@@@@@G@@@@@@@CH@F@@%"
-%"L@@@@@@@@@N@@@@@@@AL@F@@%"
-%"L@@@@@@@@@L@@@@@@@@L@F@@%"
-%"L@@@@@@@@AL@@@@@@@@N@F@@%"
-%"L@@@@@@@@AH@@@@@@@@F@F@@%"
-%"L@@@@@@@@CH@@@@@@@@G@F@@%"
-%"L@@@@@@@@C@@@@@@@@@C@F@@%"
-%"L@@@@@@@@C@@@@@@@@@C@F@@%"
-%"L@@@@@@@@GGL@OHGO@OOHF@@%"
-%"L@@@@@@@@GLFCHNFALLAHF@@%"
-%"L@@@@@@@@GHCC@FF@LLAHF@@%"
-%"L@@@@@@@@G@@F@CF@FLAHF@@%"
-%"LBIGKMLNOO@@F@CF@FOOHF@@%"
-%"LBMDBEA@BG@@F@CF@FLAHF@@%"
-%"LBOGKMM@BG@@F@CF@FLAHF@@%"
-%"LBK@JAA@BGHCC@FF@LLAHF@@%"
-%"LBIGJALNBGLFCHNFALLAHF@@%"
-%"L@@@@@@@@GGL@OHGO@OOHF@@%"
-%"L@@@@@@@@C@@@@@@@@@C@F@@%"
-%"L@@@@@@@@C@@@@@@@@@C@F@@%"
-%"L@@@@@@@@CH@@@@@@@@G@F@@%"
-%"L@@@@@@@@AH@@@@@@@@F@F@@%"
-%"L@@@@@@@@AL@@@@@@@@N@F@@%"
-%"L@@@@@@@@@L@@@@@@@@L@F@@%"
-%"L@@@@@@@@@N@@@@@@@AL@F@@%"
-%"L@@@@@@@@@G@@@@@@@CH@F@@%"
-%"L@@@@@@@@@G@@@@@@@C@@F@@%"
-%"L@@@@@@@@@OL@@@@@@G@@F@@%"
-%"L@@@@@@@@@ON@@@@@AN@@F@@%"
-%"L@@@@@@@@AGO@@@@@CL@@F@@%"
-%"L@@@@@@@@CKCL@@@@O@@@F@@%"
-%"L@@@@@@@@GLAO@@@CN@@@F@@%"
-%"L@@@@@@@@OH@GN@AOH@@@F@@%"
-%"L@@@@@@@AO@@AOOON@@@@F@@%"
-%"L@@@@@@@FN@@@COO@@@@@F@@%"
-%"L@@@@@@@OD@@@@@@@@@@@F@@%"
-%"L@@@@@@AOH@@@@@@@@@@@F@@%"
-%"L@@@@@@COH@@@@@@@@@@@F@@%"
-%"L@@@@@@GO@@@@@@@@@@@@F@@%"
-%"L@@@@@@ON@@@@@@@@@@@@F@@%"
-%"L@@@@@AOL@@@@@@@@@@@@F@@%"
-%"L@@@@@COH@@@@@@@@@@@@F@@%"
-%"L@@@@@GO@@@@@@@@@@@@@F@@%"
-%"L@@@@@ON@@@@@@@@@@@@@F@@%"
-%"L@@@@AOL@@@@@@@@@@@@@F@@%"
-%"L@@@@COH@@@@@@@@@@@@@F@@%"
-%"L@@@@GO@@@@@@@@@@@@@@F@@%"
-%"L@@@@ON@@@@@@@@@@@@@@F@@%"
-%"L@@@AOL@@@@@@@@@@@@@@F@@%"
-%"L@@@COH@@@@@@@@@@@@@@F@@%"
-%"L@@@GO@@@@@@@@@@@@@@@F@@%"
-%"L@@@GN@@@@@@@@@@@@@@@F@@%"
-%"L@@@CL@@@@@@@@@@@@@@@F@@%"
-%"L@@@AH@@@@@@@@@@@@@@@F@@%"
-%"L@@@@@@@@@@@@@@@@@@@@F@@%"
-%"L@@@@@@@@@@@@@@@@@@@@F@@%"
-%"L@@@@@@@@@@@@@@@@@@@@F@@%"
-%"L@@@@@@@@@@@@@@@@@@@@F@@%"
-%"L@@@@@@@@@@@@@@@@@@@@F@@%"
-%"L@@@@@@@@@@@@@@@@@@@@F@@%"
-%"L@@@@@@@@@@@@@@@@@@@@F@@%"
-%"L@@@@@@@@@@@@@@@@@@@@F@@%"
-%"L@@@@@@@@@@@@@@@@@@@@F@@%"
-%"L@@@@@@@@@@@@@@@@@@@@F@@%"
-%"L@@@@@@@@@@@@@@@@@@@@F@@%"
-%"L@@@@@@@@@@@@@@@@@@@@F@@%"
-%"L@@@@@@@@@@@@@@@@@@@@F@@%"
-%"L@@@@@@@@@@@@@@@@@@@@F@@%"
-%"L@@@@@@@@@@@@@@@@@@@@F@@%"
-%"L@@@@@@@@@@@@@@@@@@@@F@@%"
-%"L@@@@@@@@@@@@@@@@@@@@F@@%"
-%"L@@@@@@@@@@@@@@@@@@@@F@@%"
-%"L@@@@@@@@@@@@@@@@@@@@F@@%"
-%"L@@@@@@@@@@@@@@@@@@@@F@@%"
-%"OOOOOOOOOOOOOOOOOOOOON@@%"
-%"OOOOOOOOOOOOOOOOOOOOON@@%")} NIL  (4 5 79 18))
-")
+
+(CL:DEFUN BUILD-TITLEMENU
 (ITEMS-TEMPLATE &AUX IL-PKG ICT-PKG)

+                                                             (* ; "Edited 23-Jul-2025 17:20 by mth")

+   (SETQ IL-PKG (CL:FIND-PACKAGE "IL"))
+   (SETQ ICT-PKG (CL:FIND-PACKAGE "ICT"))
+   [CL:FLET [(TITLEMENU-FN-CALLER (MI)
+                    #'(CL:LAMBDA (STREAM)
+                             (TITLEMENU-FN
 STREAM MI]
+          (CL:LOOP :FOR ITEM :IN ITEMS-TEMPLATE :COLLECT
+                 (LET (ITEM1)
+                      (COND
+                         ((LITATOM ITEM)
+                          ITEM)
+                         ((NOT (LISTP ITEM))
+
+                          (* ;; "Report ill-formed ITEMS-TEMPLATE")

+
+                          NIL)
+                         ((AND (LITATOM (SETQ ITEM1 (CL:FIRST ITEM)))
+                               (EQ (CL:SYMBOL-PACKAGE ITEM1)
+                                   IL-PKG))
+                          ITEM)
+                         ((OR (STRINGP ITEM1)
+                              (AND (LITATOM ITEM1)
+                                   (EQ (CL:SYMBOL-PACKAGE ITEM1)
+                                       ICT-PKG)))
+                          (LET ((LEN (LENGTH ITEM))
+                                NEWITEM PIECE)
+                               (SETQ NEWITEM (LIST ITEM1 (TITLEMENU-FN-CALLER (CL:SECOND ITEM))
+                                                   (CL:THIRD ITEM)))
+                               (CL:WHEN (AND (SETQ PIECE (CL:FOURTH ITEM))
+                                             (EQ (CL:FIRST PIECE)
+                                                 'SUBITEMS))
+                                   [NCONC1 NEWITEM (CONS 'SUBITEMS (CL:LOOP
+                                                                    :FOR SI :IN (CL:REST PIECE)
+                                                                    :COLLECT
+                                                                    (LIST (CL:FIRST SI)
+                                                                          (TITLEMENU-FN-CALLER
+                                                                           (CL:SECOND SI))
+                                                                          (CL:THIRD SI])
+                               NEWITEM])
+(DECLARE%: DOEVAL@COMPILE DONTCOPY
+
+(GLOBALVARS TITLEMENU-ITEMS)
+)
+
+(RPAQQ ICON.TEMPLATE
 (#*(87 91)OOOOOOOOOOOOOOOOOOOOON@@OOOOOOOOOOOOOOOOOOOOON@@L@@@@@@@@@@@@@@@@@@@@F@@L@@@@@@@@@@@@@@@@@@@@F@@L@@@@@@@@@@@@@@@@@@@@F@@L@@@@@@@@@@@@@@@@@@@@F@@L@@@@@@@@@@@@COO@@@@@F@@L@@@@@@@@@@@AOOON@@@@F@@L@@@@@@@@@@@GN@AOH@@@F@@L@@@@@@@@@@AO@@@CN@@@F@@L@@@@@@@@@@CL@@@@O@@@F@@L@@@@@@@@@@O@@@@@CL@@F@@L@@@@@@@@@AN@@@@@AN@@F@@L@@@@@@@@@CH@@@@@@G@@F@@L@@@@@@@@@C@@@@@@@C@@F@@L@@@@@@@@@G@@@@@@@CH@F@@L@@@@@@@@@N@@@@@@@AL@F@@L@@@@@@@@@L@@@@@@@@L@F@@L@@@@@@@@AL@@@@@@@@N@F@@L@@@@@@@@AH@@@@@@@@F@F@@L@@@@@@@@CH@@@@@@@@G@F@@L@@@@@@@@C@@@@@@@@@C@F@@L@@@@@@@@C@@@@@@@@@C@F@@L@@@@@@@@GGL@OHGO@OOHF@@L@@@@@@@@GLFCHNFALLAHF@@L@@@@@@@@GHCC@FF@LLAHF@@L@@@@@@@@G@@F@CF@FLAHF@@LBIGKMLNOO@@F@CF@FOOHF@@LBMDBEA@BG@@F@CF@FLAHF@@LBOGKMM@BG@@F@CF@FLAHF@@LBK@JAA@BGHCC@FF@LLAHF@@LBIGJALNBGLFCHNFALLAHF@@L@@@@@@@@GGL@OHGO@OOHF@@L@@@@@@@@C@@@@@@@@@C@F@@L@@@@@@@@C@@@@@@@@@C@F@@L@@@@@@@@CH@@@@@@@@G@F@@L@@@@@@@@AH@@@@@@@@F@F@@L@@@@@@@@AL@@@@@@@@N@F@@L@@@@@@@@@L@@@@@@@@L@F@@L@@@@@@@@@N@@@@@@@AL@F@@L@@@@@@@@@G@@@@@@@CH@F@@L@@@@@@@@@G@@@@@@@C@@F@@L@@@@@@@@@OL@@@@@@G@@F@@L@@@@@@@@@ON@@@@@AN@@F@@L@@@@@@@@AGO@@@@@CL@@F@@L@@@@@@@@CKCL@@@@O@@@F@@L@@@@@@@@GLAO@@@CN@@@F@@L@@@@@@@@OH@GN@AOH@@@F@@L@@@@@@@AO@@AOOON@@@@F@@L@@@@@@@FN@@@COO@@@@@F@@L@@@@@@@OD@@@@@@@@@@@F@@L@@@@@@AOH@@@@@@@@@@@F@@L@@@@@@COH@@@@@@@@@@@F@@L@@@@@@GO@@@@@@@@@@@@F@@L@@@@@@ON@@@@@@@@@@@@F@@L@@@@@AOL@@@@@@@@@@@@F@@L@@@@@COH@@@@@@@@@@@@F@@L@@@@@GO@@@@@@@@@@@@@F@@L@@@@@ON@@@@@@@@@@@@@F@@L@@@@AOL@@@@@@@@@@@@@F@@L@@@@COH@@@@@@@@@@@@@F@@L@@@@GO@@@@@@@@@@@@@@F@@L@@@@ON@@@@@@@@@@@@@@F@@L@@@AOL@@@@@@@@@@@@@@F@@L@@@COH@@@@@@@@@@@@@@F@@L@@@GO@@@@@@@@@@@@@@@F@@L@@@GN@@@@@@@@@@@@@@@F@@L@@@CL@@@@@@@@@@@@@@@F@@L@@@AH@@@@@@@@@@@@@@@F@@L@@@@@@@@@@@@@@@@@@@@F@@L@@@@@@@@@@@@@@@@@@@@F@@L@@@@@@@@@@@@@@@@@@@@F@@L@@@@@@@@@@@@@@@@@@@@F@@L@@@@@@@@@@@@@@@@@@@@F@@L@@@@@@@@@@@@@@@@@@@@F@@L@@@@@@@@@@@@@@@@@@@@F@@L@@@@@@@@@@@@@@@@@@@@F@@L@@@@@@@@@@@@@@@@@@@@F@@L@@@@@@@@@@@@@@@@@@@@F@@L@@@@@@@@@@@@@@@@@@@@F@@L@@@@@@@@@@@@@@@@@@@@F@@L@@@@@@@@@@@@@@@@@@@@F@@L@@@@@@@@@@@@@@@@@@@@F@@L@@@@@@@@@@@@@@@@@@@@F@@L@@@@@@@@@@@@@@@@@@@@F@@L@@@@@@@@@@@@@@@@@@@@F@@L@@@@@@@@@@@@@@@@@@@@F@@L@@@@@@@@@@@@@@@@@@@@F@@L@@@@@@@@@@@@@@@@@@@@F@@OOOOOOOOOOOOOOOOOOOOON@@OOOOOOOOOOOOOOOOOOOOON@@
+                      NIL
+                      (4 5 79 18)))
+
+(RPAQQ TITLEMENU-ITEMS-TEMPLATE

+       (("GraphCalls" GC "Invoke GRAPHCALLS on the current selection")
+        ("InspectCode" IC "INSPECTCODE the current selection")
+        ("Inspect" INSP "INSPECT the current selection" (SUBITEMS ("Freely" INSP 
+                                                  "INSPECT the free-reference value of the selection"
+                                                                         )
+                                                               ("Globally" INSP.GLOB 
+                                              "INSPECT the Global (Top Level) value of the selection"
+                                                                      )
+                                                               ("In Process Context" INSP.PROC 
+                                           "INSPECT the value of the selection in a process' context"
+                                                                      )))
+        ("Pretty Print Value" PPV "Pretty Print the value of the current selection"
+               (SUBITEMS ("Freely" PPV "Pretty Print the free-reference value of the selection")
+                      ("Globally" PPV.GLOB 
+                             "Pretty Print the Global (Top Level) value of the selection")
+                      ("In Process Context" PPV.PROC 
+                             "Pretty Print the value of the selection in a process' context")))
+        ("Quit" QUIT "Terminates this INSPECTCODE")
+        (Expanded% Menu 'Expanded% Menu)
+        (Put 'Put NIL (SUBITEMS |Put Formatted Document| Plain-Text))
+        Find
+        (Buttons 'Buttons "Display action buttons")))
+
+(RPAQ TITLEMENU-ITEMS
 (BUILD-TITLEMENU TITLEMENU-ITEMS-TEMPLATE))
+
 (CHANGENAME '\TEDIT.INSPECTCODE 'TEXTICON 'ICON-FN)
-(CHANGENAME '\TEDIT.INSPECTCODE 'OPENTEXTSTREAM 'OPENTEXTSTREAM-FOR-\TEDIT.INSPECTCODE)
 
-(DEFCOMMAND IC
 (FN) (INSPECTCODE FN))
+[XCL:REINSTALL-ADVICE '(DECODE.WINDOW.ARG :IN \TEDIT.INSPECTCODE)
+       :AROUND
+       '((:LAST (LET ((W *
))
+                     (DECLARE
 (SPECVARS FN))
+                     (ADVICE-ON-\TEDIT.INSPECTCODE
 W FN)
+                     W]
 
+(READVISE (DECODE.WINDOW.ARG :IN \TEDIT.INSPECTCODE))
 
-(PUTPROPS INSPECTCODE-TEDIT FILETYPE
 :TCOMPL)
+(DEFCOMMAND IC (FN) (INSPECTCODE FN))
 
-(PUTPROPS INSPECTCODE-TEDIT MAKEFILE-ENVIRONMENT
 (:READTABLE "INTERLISP" :PACKAGE (DEFPACKAGE
-                                                                                   
-                                                                                  "INSPECTCODE-TEDIT"
-                                                                                   (:USE "INTERLISP")
-                                                                                   (:NICKNAMES "ICT")
-                                                                                   (:PREFIX-NAME
-                                                                                    "ICT"))))
-(PUTPROPS INSPECTCODE-TEDIT COPYRIGHT ("Beckman Instruments, Inc." 1985 1986 1987))
+(PUTPROPS INSPECTCODE-TEDIT
 FILETYPE
 :COMPILE-FILE)
+
+(PUTPROPS INSPECTCODE-TEDIT
 MAKEFILE-ENVIRONMENT
 [:READTABLE "INTERLISP" :PACKAGE
+                                                        (PROGN (CL:INTERN "INSPECTCODE-TEDITCOMS" 
+                                                                      "INTERLISP")
+                                                               
+                                                               (* ;; 
+
                                           "Above is to ensure the COMS is in the INTERLISP package!")

+
+                                                               (DEFPACKAGE "INSPECTCODE-TEDIT"
+                                                                      (:USE "INTERLISP")
+                                                                      (:NICKNAMES "ICT")
+                                                                      (:PREFIX-NAME "ICT"])
 (DECLARE%: DONTCOPY
-  (FILEMAP (NIL (1353 12345 (BUILD.TITLEMENU 1363 . 3517) (ICON-FN 3519 . 3975) (INSP.ERROR 3977 . 4315)
- (KILL.TEDIT.PROCESS 4317 . 4491) (NOSELFN 4493 . 4688) (OPENTEXTSTREAM-FOR-\TEDIT.INSPECTCODE 4690 . 
-5238) (TITLEMENU-FN 5240 . 12343)))))
+  (FILEMAP (NIL (1600 10420 (ADVICE-ON-\TEDIT.INSPECTCODE 1610 . 2170) (ICON-FN 2172 . 2628) (INSP.ERROR
+ 2630 . 2990) (KILL.TEDIT.PROCESS 2992 . 3166) (OPENTEXTSTREAM-FOR-\TEDIT.INSPECTCODE 3168 . 3706) (
+TITLEMENU-FN 3708 . 10418)) (10422 12694 (BUILD-TITLEMENU 10422 . 12694)))))
 STOP

lispusers/MODERNIZE

@@ -1,12 +1,12 @@
 (DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
 
-
(FILECREATED "30-Jun-2024 22:38:08" {WMEDLEY}<lispusers>MODERNIZE.;50
 30912  
+
(FILECREATED "23-Jul-2025 14:41:38" {WMEDLEY}<lispusers>MODERNIZE.;51
 30928  
 
       :EDIT-BY rmk
 
       :CHANGES-TO (FNS \MODERNIZED.TEDIT.BUTTONEVENTFN)
 
-      :PREVIOUS-DATE "27-Jan-2024 13:38:15" {WMEDLEY}<lispusers>MODERNIZE.;49)
+      :PREVIOUS-DATE "30-Jun-2024 22:38:08" {WMEDLEY}<lispusers>MODERNIZE.;50)
 
 
 (PRETTYCOMPRINT MODERNIZECOMS)
@@ -500,7 +500,8 @@
            (FUNCTION \MODERNIZED.TEDIT.BUTTONEVENTFN])
 
 (\MODERNIZED.TEDIT.BUTTONEVENTFN

-  [LAMBDA (W STREAM)
                                         (* ; "Edited 30-Jun-2024 22:29 by rmk")


+  [LAMBDA (W STREAM)
                                         (* ; "Edited 23-Jul-2025 14:41 by rmk")


+                                                             (* ; "Edited 30-Jun-2024 22:29 by rmk")


                                                              (* ; "Edited 29-Jul-2023 10:48 by rmk")


                                                             (* ; "Edited 13-Oct-2021 21:43 by rmk:")

 
@@ -512,9 +513,8 @@
            NIL
            (WINDOWPROP W 'MODERNIZE.TITLEPROPORTION)
            [APPLY (FUNCTION UNIONREGIONS)
-                  (for
 PANE in
 (\TEDIT.PANELIST (CENTRALWINDOW W)) collect
 (WINDOWPROP PANE
-                                                                                  'REGION]
-           (WINDOWPROP (CENTRALWINDOW W)
+                  (for
 PANE in
 (\TEDIT.PANELIST W) collect
 (WINDOWPROP PANE 'REGION]
+           (WINDOWPROP (\TEDIT.PRIMARYPANE W)
                   'TITLE])
 )
 (DECLARE%: DONTEVAL@LOAD DOCOPY 
@@ -622,5 +622,5 @@
 21329) (INCORNER.REGION 21331 . 22457)) (22517 24989 (MODERN-ADD-EXEC 22527 . 22958) (MODERN-SNAPW 
 22960 . 23503) (TOTOPW.MODERNIZE 23505 . 23933) (MODERN-MENUBUTTONFN 23935 . 24987)) (24990 27419 (
 \MODERNIZED.FREEMENU.BUTTONEVENTFN 25000 . 25647) (MODERNIZED.TB.BUTTONEVENTFN 25649 . 27417)) (27460 
-29151 (TEDIT.MODERNIZE 27470 . 27823) (\MODERNIZED.TEDIT.BUTTONEVENTFN 27825 . 29149)))))
+29167 (TEDIT.MODERNIZE 27470 . 27823) (\MODERNIZED.TEDIT.BUTTONEVENTFN 27825 . 29165)))))
 STOP

lispusers/PICK

@@ -1,11 +1,12 @@
 (DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
 
-
(FILECREATED "11-Aug-2022 17:53:58" {DSK}<home>larry>medley>lispusers>PICK.;3
 4261   
+
(FILECREATED " 9-Aug-2025 09:20:03" {DSK}<home>larry>il>medley>lispusers>PICK.;2
 4413   
 
-      :CHANGES-TO (VARS PICKCOMS)
-                  (FNS PICK)
+      :EDIT-BY "lmm"
 
-      :PREVIOUS-DATE "10-Aug-2022 16:57:49" {DSK}<home>larry>medley>lispusers>PICK.;1)
+      :CHANGES-TO (FNS PICK)
+
+      :PREVIOUS-DATE "11-Aug-2022 17:53:58" {DSK}<home>larry>il>medley>lispusers>PICK.;1)
 
 
 (PRETTYCOMPRINT PICKCOMS)
@@ -27,14 +28,15 @@
 (DEFINEQ
 
 (PICK

-  [LAMBDA (TYPE CHOICES)
                                     (* ; "Edited 11-Aug-2022 17:15 by lmm")


+  [LAMBDA (TYPE CHOICES)
                                     (* ; "Edited  8-Aug-2025 09:06 by lmm")


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


                                                              (* ; "Edited 10-Aug-2022 16:57 by lmm")

     (SELECTQ (MKATOM (U-CASE (MKSTRING TYPE)))
         (ONEOF                                               (* ; 
 
                                          "PICK ONEOF A1 A2 A3 ... - just choose from choices listed")

                [CAR (NTH CHOICES (RAND 1 (LENGTH CHOICES])
         (NIL                                                 (* ; 
-
                                                         "pick -- choose an issue, a file, a project")

+
                                       "PICK (with no parameters) choose an issue, a file, a project")

              [PICK
 (PICK
 'ONEOF '(FILE ISSUE PROJECT])
         (ISSUE                                               (* ; 
 
                       "pick issue [number] -- display an issue; if none given, choose one at random")

@@ -46,14 +48,9 @@
                      (TITLE))
                     (for
 S in
 (GIT-COMMAND (CL:FORMAT NIL "gh issue view -R interlisp/medley ~d" 
                                                   ISSUE)) do
 (CL:FORMAT STR "~a~&" S)
-                       finally
 
-
-                             (* ;; 
-
             "this TEDIT call is wrong -- it takes the keyboard and the promptwindow prompt is wrong")

-
-                             [TEDIT STR NIL NIL `(READONLY T TITLE ,(SETQ TITLE (CL:FORMAT NIL 
-                                                                                       "Issue #~d" 
-                                                                                       ISSUE] 
+                       finally
 [TEDIT STR NIL NIL `(READONLY T TITLE ,(SETQ TITLE
+                                                                       (CL:FORMAT NIL "Issue #~d" 
+                                                                              ISSUE] 
 
                              (* ;; "if there are comments (or always) show comments too -- the -w switch doesn't work online -- no browser")

 
@@ -65,23 +62,27 @@
         (DIR 
              (* ;; "pick a directory to choose files from")

 
-             (PICK
 'ONEOF '(LISPUSERS LIBRARY DOCTOOLS SOURCES INTERNAL)))
+             [LIST 'DIRECTORY "Examine directory"
+                   (PICK
 'ONEOF '(CLOS CLTL2 FONTS GREETFILES LISPUSERS LIBRARY DOCTOOLS DOCS SOURCES
+                                       INTERNAL])
         (FILE 
               (* ;; " pick a file from a (randomly chosen) directory")

 
-              [LIST 'FILE (PICK
 'ONEOF (DIRECTORY (OR (MEDLEYDIR (OR (CAR CHOICES)
-                                                                     (PICK
 'DIR))
-                                                             NIL T)
-                                                      (FETCH
 (GIT-PROJECT CLONEPATH)
-                                                         OF
 (CDR (ASSOC (CAR CHOICES)
-                                                                        GIT-PROJECTS])
+              [LIST 'FILE "Examine file"
+                    (PICK
 'ONEOF (DIRECTORY (OR (MEDLEYDIR [OR (CAR CHOICES)
+                                                               (CL:THIRD (PICK
 'DIR]
+                                                       NIL T)
+                                                (FETCH
 (GIT-PROJECT CLONEPATH)
+                                                   OF
 (CDR (ASSOC (CAR CHOICES)
+                                                                  GIT-PROJECTS])
         (PROJECT 
                  (* ;; "pick PROJECT will choose some repo to work on")

 
-                 [PICK
 'ONEOF (PICK
 'ONEOF (LIST (MAPCAR GIT-PROJECTS #'CAR)
-                                                 '(CLOS ROOMS ONLINE WEBSITE COMMUNITY ENVOS])
-        (HELP TYPE "Unknown type"])
+                 [LIST 'PROJECT "Examine the fiiles associated with the GITFNS project"
+                       (PICK
 'ONEOF (PICK
 'ONEOF (LIST (MAPCAR GIT-PROJECTS #'CAR)
+                                                       '(CLOS ROOMS ONLINE WEBSITE COMMUNITY ENVOS])
+        (HELP TYPE "Unknown type to pick from"])
 )
 (DECLARE%: DONTCOPY
-  (FILEMAP (NIL (735 4238 (PICK 745 . 4236)))))
+  (FILEMAP (NIL (729 4390 (PICK 739 . 4388)))))
 STOP

sources/INSPECT

@@ -1,13 +1,12 @@
 (DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
 
-
(FILECREATED "16-Jul-2024 18:28:42" {WMEDLEY}<sources>INSPECT.;33
 129220 
+
(FILECREATED "21-Jul-2025 16:55:18" {WMEDLEY}<sources>INSPECT.;36
 129584 
 
       :EDIT-BY rmk
 
-      :CHANGES-TO (FNS IMAGEOBJ\PROPFETCHFN IMAGEOBJ\PROPSTOREFN)
-                  (VARS INSPECTCOMS)
+      :CHANGES-TO (FNS \TEDIT.INSPECTCODE)
 
-      :PREVIOUS-DATE " 4-Jul-2024 12:16:52" {WMEDLEY}<sources>INSPECT.;31)
+      :PREVIOUS-DATE "21-Jul-2025 11:55:38" {WMEDLEY}<sources>INSPECT.;35)
 
 
 (PRETTYCOMPRINT INSPECTCOMS)
@@ -1802,24 +1801,29 @@
                (\INSPECT/CODE/RESHAPEFN
 WINDOW])
 
 (\TEDIT.INSPECTCODE

-  [LAMBDA (FN WHERE LVFLG RADIX PC CODEPRINTER)
         (* ; "Edited 11-Oct-2021 14:04 by rmk:")

+  [LAMBDA (FN WHERE LVFLG RADIX PC CODEPRINTER)
              (* ; "Edited 21-Jul-2025 16:54 by rmk")


+                                                            (* ; "Edited 11-Oct-2021 14:04 by rmk:")

     (PROG ((STREAM (OPENSTREAM '{NODIRCORE} 'BOTH))
            WINDOW SEL)
           (APPLY* (OR CODEPRINTER (FUNCTION PRINTCODE))
                  FN LVFLG RADIX STREAM NIL PC)
-          [SETQ STREAM (OPENTEXTSTREAM STREAM [SETQ WINDOW (DECODE.WINDOW.ARG

-                                                            WHERE 400 280
-                                                            (COND
-                                                               ((OR (LITATOM FN)
-                                                                    (NOT (CCODEP FN)))
-                                                                (CONCAT "Code for " FN))
-                                                               (T (CONCAT (COND
-                                                                             (PC "Code for frame ")
-                                                                             (T "CCODEP named "))
-                                                                         (fetch
 (COMPILED-CLOSURE
-                                                                                     FRAMENAME)
-                                                                            of
 FN]
-                              NIL NIL `(READONLY T PROMPTWINDOW DON'T FONT ,DEFAULTFONT]
+          [SETQ STREAM (TEDIT STREAM [SETQ WINDOW (DECODE.WINDOW.ARG

+                                                   WHERE 400 280 (COND
+                                                                    ((OR (LITATOM FN)
+                                                                         (NOT (CCODEP FN)))
+                                                                     (CONCAT "Code for " FN))
+                                                                    (T (CONCAT (COND
+                                                                                  (PC 
+                                                                                    "Code for frame "
+                                                                                      )
+                                                                                  (T "CCODEP named ")
+                                                                                  )
+                                                                              (fetch
 (
+                                                                                     COMPILED-CLOSURE
+                                                                                      FRAMENAME)
+                                                                                 of
 FN]
+                              NIL
+                              `(READONLY T FONT ,DEFAULTFONT]
           (COND
              ((AND PC (SETQ SEL (TEDIT.FIND STREAM "----------" 1)))
                                                              (* ; "Highlight location of PC")

@@ -2311,43 +2315,43 @@
          ("As Character array" '(8 \INSPECT.FETCH.CHAR \INSPECT.STORE.CHAR))
          ("As Fat Character array" '(16 \INSPECT.FETCH.FATCHAR \INSPECT.STORE.FATCHAR])
 (DECLARE%: DONTCOPY
-  (FILEMAP (NIL (7776 46129 (INSPECTW.CREATE 7786 . 13081) (INSPECTW.REPAINTFN 13083 . 18619) (
-INSPECTW.REDISPLAY 18621 . 27493) (\INSPECTW.VALUE.MARGIN 27495 . 27898) (INSPECTW.REPLACE 27900 . 
-28608) (INSPECTW.SELECTITEM 28610 . 29600) (\INSPECTW.REDISPLAYPROP 29602 . 32032) (INSPECTW.FETCH 
-32034 . 32457) (INSPECTW.PROPERTIES 32459 . 33100) (DECODE.WINDOW.ARG 33102 . 34830) (
-DEFAULT.INSPECTW.PROPCOMMANDFN 34832 . 36860) (DEFAULT.INSPECTW.VALUECOMMANDFN 36862 . 38278) (
-DEFAULT.INSPECTW.TITLECOMMANDFN 38280 . 41729) (\SELITEM.FROM.PROPERTY 41731 . 42173) (
-\INSPECT.COMPUTE.TITLE 42175 . 43459) (LEVELEDFORM 43461 . 44180) (MAKEWITHINREGION 44182 . 46127)) (
-46130 63435 (ITEMW.REPAINTFN 46140 . 47360) (\ITEM.WINDOW.BUTTON.HANDLER 47362 . 47781) (
-\ITEM.WINDOW.SELECTION.HANDLER 47783 . 50450) (\INSPECTW.COMMAND.HANDLER 50452 . 54453) (
-ITEM.WINDOW.SET.STACK.ARG 54455 . 56659) (REPLACESTKARG 56661 . 57760) (IN/ITEM? 57762 . 58644) (
-\ITEMW.DESELECTITEM 58646 . 58910) (\ITEMW.SELECTITEM 58912 . 59174) (\ITEMW.CLEARSELECTION 59176 . 
-59531) (\ITEMW.FLIPITEM 59533 . 60006) (PRINTANDBOX 60008 . 62517) (PRINTATBOX 62519 . 63036) (
-ITEMOFPROPERTYVALUE 63038 . 63433)) (63436 67177 (\ITEM.WINDOW.COPY.HANDLER 63446 . 65303) (
-\ITEMW.FLIPCOPY 65305 . 65764) (BKSYSBUF.GENERAL 65766 . 67175)) (67569 92484 (INSPECT 67579 . 72109) 
-(\APPLYINSPECTMACRO 72111 . 73172) (INSPECT/BITMAP 73174 . 74326) (INSPECT/DATATYPE 74328 . 77842) (
-INSPECTABLEFIELDNAMES 77844 . 79177) (REMOVEDUPS 79179 . 79384) (INSPECT/ARRAY 79386 . 80451) (
-INSPECT/TOP/LEVEL/LIST 80453 . 81570) (INSPECT/PROPLIST 81572 . 82660) (NONSYSPROPNAMES 82662 . 82958)
- (INSPECT/LISTP 82960 . 83399) (ALISTP 83401 . 83610) (PROPLISTP 83612 . 84252) (INSPECT/ALIST 84254
- . 84730) (ASSOCGET 84732 . 84943) (/ASSOCPUT 84945 . 85210) (INSPECT/PLIST 85212 . 85696) (
-INSPECT/TYPERECORD 85698 . 86055) (INSPECT/AS/RECORD 86057 . 87294) (SELECT.LIST.INSPECTOR 87296 . 
-89347) (STANDARDEDITE 89349 . 89632) (NTHTOPLEVELELT 89634 . 89950) (SETNTHTOPLEVELELT 89952 . 90712) 
-(DEDITE 90714 . 90921) (FINDRECDECL 90923 . 91506) (FINDSYSRECDECL 91508 . 91909) (
-MAKE-INSPECTOR-PROFILE 91911 . 92296) (CONFIRM-SET 92298 . 92482)) (94308 102522 (INSPECT/ATOM 94318
- . 98423) (SELECT.ATOM.ASPECT 98425 . 99569) (INSPECT/AS/FUNCTION 99571 . 101857) (SELECT.FNS.EDITOR 
-101859 . 102520)) (102563 107988 (INSPECTCODE 102573 . 103725) (\TEDIT.INSPECTCODE 103727 . 105705) (
-\INSPECT/CODE/RESHAPEFN 105707 . 107246) (\INSPECT/CODE/REPAINTFN 107248 . 107986)) (108026 109632 (
-INSPECT/HARRAYP 108036 . 108784) (HARRAYKEYS 108786 . 109165) (INSPECTW.GETHASH 109167 . 109394) (
-INSPECTW.PUTHASH 109396 . 109630)) (109681 115890 (RDTBL\NONOTHERCODES 109691 . 110711) (GETSYNTAXPROP
- 110713 . 112211) (SETSYNTAXPROP 112213 . 113940) (GETTTBLPROP 113942 . 114860) (SETTTBLPROP 114862 . 
-115888)) (116395 117845 (WINDOW\INSPECTPROPS 116405 . 117260) (WINDOW\PROPFETCHFN 117262 . 117616) (
-WINDOW\PROPSTOREFN 117618 . 117843)) (117994 120023 (IMAGEOBJ\INSPECTPROPS 118004 . 119070) (
-IMAGEOBJ\PROPFETCHFN 119072 . 119602) (IMAGEOBJ\PROPSTOREFN 119604 . 120021)) (120160 128802 (
-INSPECT/AS/BLOCKRECORD 120170 . 121170) (INSPECT/TYPELESS 121172 . 122563) (LIST-ALL-BLOCKRECORDS 
-122565 . 122840) (INSPECT/HUNK 122842 . 125445) (\INSPECT.DATATYPE.RAW.FETCH 125447 . 125773) (
-\INSPECT.FETCH.8 125775 . 125924) (\INSPECT.FETCH.32 125926 . 126097) (\INSPECT.FETCH.CHAR 126099 . 
-126262) (\INSPECT.FETCH.FATCHAR 126264 . 126426) (\INSPECT.FETCH.PTR 126428 . 126599) (
-\INSPECT.STORE.8 126601 . 126907) (\INSPECT.STORE.16 126909 . 127209) (\INSPECT.STORE.32 127211 . 
-127646) (\INSPECT.STORE.CHAR 127648 . 127974) (\INSPECT.STORE.FATCHAR 127976 . 128298) (
-\INSPECT.STORE.PTR 128300 . 128647) (INSPECT/MAKE/CCODEP 128649 . 128800)))))
+  (FILEMAP (NIL (7716 46069 (INSPECTW.CREATE 7726 . 13021) (INSPECTW.REPAINTFN 13023 . 18559) (
+INSPECTW.REDISPLAY 18561 . 27433) (\INSPECTW.VALUE.MARGIN 27435 . 27838) (INSPECTW.REPLACE 27840 . 
+28548) (INSPECTW.SELECTITEM 28550 . 29540) (\INSPECTW.REDISPLAYPROP 29542 . 31972) (INSPECTW.FETCH 
+31974 . 32397) (INSPECTW.PROPERTIES 32399 . 33040) (DECODE.WINDOW.ARG 33042 . 34770) (
+DEFAULT.INSPECTW.PROPCOMMANDFN 34772 . 36800) (DEFAULT.INSPECTW.VALUECOMMANDFN 36802 . 38218) (
+DEFAULT.INSPECTW.TITLECOMMANDFN 38220 . 41669) (\SELITEM.FROM.PROPERTY 41671 . 42113) (
+\INSPECT.COMPUTE.TITLE 42115 . 43399) (LEVELEDFORM 43401 . 44120) (MAKEWITHINREGION 44122 . 46067)) (
+46070 63375 (ITEMW.REPAINTFN 46080 . 47300) (\ITEM.WINDOW.BUTTON.HANDLER 47302 . 47721) (
+\ITEM.WINDOW.SELECTION.HANDLER 47723 . 50390) (\INSPECTW.COMMAND.HANDLER 50392 . 54393) (
+ITEM.WINDOW.SET.STACK.ARG 54395 . 56599) (REPLACESTKARG 56601 . 57700) (IN/ITEM? 57702 . 58584) (
+\ITEMW.DESELECTITEM 58586 . 58850) (\ITEMW.SELECTITEM 58852 . 59114) (\ITEMW.CLEARSELECTION 59116 . 
+59471) (\ITEMW.FLIPITEM 59473 . 59946) (PRINTANDBOX 59948 . 62457) (PRINTATBOX 62459 . 62976) (
+ITEMOFPROPERTYVALUE 62978 . 63373)) (63376 67117 (\ITEM.WINDOW.COPY.HANDLER 63386 . 65243) (
+\ITEMW.FLIPCOPY 65245 . 65704) (BKSYSBUF.GENERAL 65706 . 67115)) (67509 92424 (INSPECT 67519 . 72049) 
+(\APPLYINSPECTMACRO 72051 . 73112) (INSPECT/BITMAP 73114 . 74266) (INSPECT/DATATYPE 74268 . 77782) (
+INSPECTABLEFIELDNAMES 77784 . 79117) (REMOVEDUPS 79119 . 79324) (INSPECT/ARRAY 79326 . 80391) (
+INSPECT/TOP/LEVEL/LIST 80393 . 81510) (INSPECT/PROPLIST 81512 . 82600) (NONSYSPROPNAMES 82602 . 82898)
+ (INSPECT/LISTP 82900 . 83339) (ALISTP 83341 . 83550) (PROPLISTP 83552 . 84192) (INSPECT/ALIST 84194
+ . 84670) (ASSOCGET 84672 . 84883) (/ASSOCPUT 84885 . 85150) (INSPECT/PLIST 85152 . 85636) (
+INSPECT/TYPERECORD 85638 . 85995) (INSPECT/AS/RECORD 85997 . 87234) (SELECT.LIST.INSPECTOR 87236 . 
+89287) (STANDARDEDITE 89289 . 89572) (NTHTOPLEVELELT 89574 . 89890) (SETNTHTOPLEVELELT 89892 . 90652) 
+(DEDITE 90654 . 90861) (FINDRECDECL 90863 . 91446) (FINDSYSRECDECL 91448 . 91849) (
+MAKE-INSPECTOR-PROFILE 91851 . 92236) (CONFIRM-SET 92238 . 92422)) (94248 102462 (INSPECT/ATOM 94258
+ . 98363) (SELECT.ATOM.ASPECT 98365 . 99509) (INSPECT/AS/FUNCTION 99511 . 101797) (SELECT.FNS.EDITOR 
+101799 . 102460)) (102503 108352 (INSPECTCODE 102513 . 103665) (\TEDIT.INSPECTCODE 103667 . 106069) (
+\INSPECT/CODE/RESHAPEFN 106071 . 107610) (\INSPECT/CODE/REPAINTFN 107612 . 108350)) (108390 109996 (
+INSPECT/HARRAYP 108400 . 109148) (HARRAYKEYS 109150 . 109529) (INSPECTW.GETHASH 109531 . 109758) (
+INSPECTW.PUTHASH 109760 . 109994)) (110045 116254 (RDTBL\NONOTHERCODES 110055 . 111075) (GETSYNTAXPROP
+ 111077 . 112575) (SETSYNTAXPROP 112577 . 114304) (GETTTBLPROP 114306 . 115224) (SETTTBLPROP 115226 . 
+116252)) (116759 118209 (WINDOW\INSPECTPROPS 116769 . 117624) (WINDOW\PROPFETCHFN 117626 . 117980) (
+WINDOW\PROPSTOREFN 117982 . 118207)) (118358 120387 (IMAGEOBJ\INSPECTPROPS 118368 . 119434) (
+IMAGEOBJ\PROPFETCHFN 119436 . 119966) (IMAGEOBJ\PROPSTOREFN 119968 . 120385)) (120524 129166 (
+INSPECT/AS/BLOCKRECORD 120534 . 121534) (INSPECT/TYPELESS 121536 . 122927) (LIST-ALL-BLOCKRECORDS 
+122929 . 123204) (INSPECT/HUNK 123206 . 125809) (\INSPECT.DATATYPE.RAW.FETCH 125811 . 126137) (
+\INSPECT.FETCH.8 126139 . 126288) (\INSPECT.FETCH.32 126290 . 126461) (\INSPECT.FETCH.CHAR 126463 . 
+126626) (\INSPECT.FETCH.FATCHAR 126628 . 126790) (\INSPECT.FETCH.PTR 126792 . 126963) (
+\INSPECT.STORE.8 126965 . 127271) (\INSPECT.STORE.16 127273 . 127573) (\INSPECT.STORE.32 127575 . 
+128010) (\INSPECT.STORE.CHAR 128012 . 128338) (\INSPECT.STORE.FATCHAR 128340 . 128662) (
+\INSPECT.STORE.PTR 128664 . 129011) (INSPECT/MAKE/CCODEP 129013 . 129164)))))
 STOP

sources/LLDISPLAY

@@ -1,12 +1,14 @@
 (DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
 
-
(FILECREATED "31-Jul-2023 14:50:58" {WMEDLEY}<sources>LLDISPLAY.;19
 270570 
+
(FILECREATED "27-Jul-2025 20:25:24" 
+{DSK}<Users>kaplan>Local>medley3.5>working-medley>sources>LLDISPLAY.;25
 272767 
 
       :EDIT-BY rmk
 
-      :CHANGES-TO (FNS BITMAPEQUAL)
+      :CHANGES-TO (VARS LLDISPLAYCOMS)
 
-      :PREVIOUS-DATE "31-Jul-2023 14:45:32" {WMEDLEY}<sources>LLDISPLAY.;18)
+      :PREVIOUS-DATE "14-Jul-2025 22:06:59" 
+{DSK}<Users>kaplan>Local>medley3.5>working-medley>sources>LLDISPLAY.;23)
 
 
 (PRETTYCOMPRINT LLDISPLAYCOMS)
@@ -30,9 +32,10 @@
         [COMS                                                (* ; "bitmap functions.")

               (FNS BITBLT BLTSHADE \BITBLTSUB \GETPILOTBBTSCRATCHBM BITMAPCOPY BITMAPCREATE BITMAPBIT
                    BITMAPEQUAL BLTCHAR \BLTCHAR \MEDW.BLTCHAR \CHANGECHARSET.DISPLAY \INDICATESTRING
-                   \SLOWBLTCHAR TEXTUREP INVERT.TEXTURE INVERT.TEXTURE.BITMAP BITMAPWIDTH READBITMAP
-                   \INSUREBITSPERPIXEL MAXIMUMCOLOR OPPOSITECOLOR MAXIMUMSHADE OPPOSITESHADE 
-                   \MEDW.BITBLT)
+                   \SLOWBLTCHAR TEXTUREP INVERT.TEXTURE INVERT.TEXTURE.BITMAP BITMAPWIDTH 
+                   BITMAPHEIGHT READBITMAP \INSUREBITSPERPIXEL MAXIMUMCOLOR OPPOSITECOLOR 
+                   MAXIMUMSHADE OPPOSITESHADE \MEDW.BITBLT)
+              (FNS \READBINARYBITMAP \PRINTBINARYBITMAP)
               (FUNCTIONS FINISH-READING-BITMAP)
               (CONSTANTS (MINIMUMCOLOR 0)
                      (MINIMUMSHADE 0))
@@ -1361,6 +1364,18 @@
         (WINDOWPROP BITMAP 'WIDTH))
        (T (\ILLEGAL.ARG BITMAP])
 
+(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])
+
 (READBITMAP

   [LAMBDA (FILE)
                                        (* ; "Edited  8-Aug-2021 00:18 by rmk:")

 
@@ -1501,6 +1516,44 @@
        (T (SHOULDNT "Invalid argument to \XW.BIBLT")))
     T])
 )
+(DEFINEQ
+
+(\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])
+
+(\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])
+)
 
 (CL:DEFUN FINISH-READING-BITMAP
 (STREAM)
 
@@ -3249,34 +3302,33 @@
                                     (\INVALIDATEDISPLAYCACHE DD))])])
 
 (\DSPFONT.DISPLAY

-  [LAMBDA (DISPLAYSTREAM FONT)
                           (* ; "Edited 11-Nov-87 15:36 by FS")

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


+                                                             (* ; "Edited 11-Nov-87 15:36 by FS")

 
     (* ;; "sets the font that a display stream uses to print characters.  DISPLAYSTREAM is guaranteed to be a stream of type display")

 
     (PROG (XFONT OLDFONT DD)
           (SETQ DD (fetch
 (STREAM IMAGEDATA) of
 DISPLAYSTREAM))
                                                              (* ; 
-
          "save old value to return, smash new value and update the bitchar portion of the record.")

+
            "save old value to return, smash new value and update the bitchar portion of the record.")

           (RETURN (PROG1 (SETQ OLDFONT (fetch
 (\DISPLAYDATA DDFONT) of
 DD))
                       [COND
                          (FONT 
                                (* ;; "Either FONT is coerceable to a font, or its a proplist of ways to change the current font (see IRM), otherwise an error.")

 
-                               (SETQ XFONT (OR (\COERCEFONTDESC FONT DISPLAYSTREAM T)
-                                               (FONTCOPY (ffetch
 (\DISPLAYDATA DDFONT)
-                                                            of
 DD)
+                               (SETQ XFONT (OR (FONTCREATE FONT NIL NIL NIL DISPLAYSTREAM T)
+                                               (FONTCOPY (ffetch
 (\DISPLAYDATA DDFONT) of
 DD)
                                                       (CONS 'NOERROR (CONS T FONT)))
                                                (ERROR "FONT NOT FOUND OR ILLEGAL FONTCOPY PARAMETER")
                                                ))            (* ; 
-
  "updating font information is fairly expensive operation.  Don't bother unless font has changed.")

+
    "updating font information is fairly expensive operation.  Don't bother unless font has changed.")

                                (OR (EQ XFONT OLDFONT)
                                    (UNINTERRUPTABLY
                                        (freplace
 (\DISPLAYDATA DDFONT) of
 DD with
 XFONT)
                                        (freplace
 (\DISPLAYDATA DDLINEFEED) of
 DD
-                                          with
 (IMINUS (fetch
 (FONTDESCRIPTOR \SFHeight)
-                                                              of
 XFONT)))
+                                          with
 (IMINUS (fetch
 (FONTDESCRIPTOR \SFHeight) of
 XFONT)))
                                                              (* ; 
-
                       "This will be difference when spacefactor is implemented for the display.  ")

+
                         "This will be difference when spacefactor is implemented for the display.  ")

                                        (freplace
 (\DISPLAYDATA DDSPACEWIDTH) of
 DD
                                           with
 (\FGETCHARWIDTH XFONT (CHARCODE SPACE)))
                                        (\SFFixFont
 DISPLAYSTREAM DD))])])
@@ -4541,14 +4593,17 @@
 (DEFINEQ
 
 (INITIALIZEDISPLAYSTREAMS

-  [LAMBDA NIL
                                            (* lmm " 7-Jan-86 16:51")

+  [LAMBDA NIL
                                                (* ; "Edited  6-Jul-2025 12:57 by rmk")

+                                                             (* lmm " 7-Jan-86 16:51")

     (SETQ WHOLEDISPLAY (create
 REGION))
-    (SETQ \SYSPILOTBBT (create
 PILOTBBT))                (* ; "For BITBLT")

-    (SETQ \SYSBBTEXTURE (BITMAPCREATE
 16 16))            (* ; 
-
                                                           "For texture handling in \BITBLTSUB")

+    (SETQ \SYSPILOTBBT (create
 PILOTBBT))                    (* ; "For BITBLT")

+    (SETQ \SYSBBTEXTURE (BITMAPCREATE
 16 16))                (* ; 
+
                                                             "For texture handling in \BITBLTSUB")

                                                              (* ; 
-
  "A guaranteed display font is initialized here after pup, font, and bitmap code has been loaded.")

-    (SETQ \GUARANTEEDDISPLAYFONT (FONTCREATE 'GACHA 10 NIL NIL 'DISPLAY))
+
    "A guaranteed display font is initialized here after pup, font, and bitmap code has been loaded.")

+    (SETQ \GUARANTEEDDISPLAYFONT (FONTCREATE 'GACHA 10 '(MEDIUM REGULAR REGULAR)
+                                        NIL
+                                        'DISPLAY))
     (SETQ DEFAULTFONT (FONTCLASS 'DEFAULTFONT (LIST 1 \GUARANTEEDDISPLAYFONT])
 )
 (DECLARE%: DOCOPY DONTEVAL@LOAD 
@@ -4563,7 +4618,7 @@
 (DISPLAYSTREAMINIT
 1000)
 )
 
-(PUTPROPS LLDISPLAY
 FILETYPE
 COMPILE-FILE)
+(PUTPROPS LLDISPLAY
 FILETYPE
 :FAKE-COMPILE-FILE)
 (DECLARE%: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY COMPILERVARS 
 
 (ADDTOVAR NLAMA
 )
@@ -4573,43 +4628,44 @@
 (ADDTOVAR LAMA
 )
 )
 (DECLARE%: DONTCOPY
-  (FILEMAP (NIL (20459 23127 (\FBITMAPBIT 20469 . 20929) (\FBITMAPBIT.UFN 20931 . 21950) (
-\NEWPAGE.DISPLAY 21952 . 22087) (INITBITMASKS 22089 . 23125)) (25052 25561 (\CreateCursorBitMap 25062
- . 25559)) (25678 86230 (BITBLT 25688 . 36078) (BLTSHADE 36080 . 36858) (\BITBLTSUB 36860 . 46995) (
-\GETPILOTBBTSCRATCHBM 46997 . 47612) (BITMAPCOPY 47614 . 48190) (BITMAPCREATE 48192 . 49752) (
-BITMAPBIT 49754 . 58141) (BITMAPEQUAL 58143 . 59605) (BLTCHAR 59607 . 60223) (\BLTCHAR 60225 . 60727) 
-(\MEDW.BLTCHAR 60729 . 65607) (\CHANGECHARSET.DISPLAY 65609 . 68567) (\INDICATESTRING 68569 . 69765) (
-\SLOWBLTCHAR 69767 . 76863) (TEXTUREP 76865 . 77135) (INVERT.TEXTURE 77137 . 77411) (
-INVERT.TEXTURE.BITMAP 77413 . 78948) (BITMAPWIDTH 78950 . 79322) (READBITMAP 79324 . 81834) (
-\INSUREBITSPERPIXEL 81836 . 82131) (MAXIMUMCOLOR 82133 . 82274) (OPPOSITECOLOR 82276 . 82455) (
-MAXIMUMSHADE 82457 . 82668) (OPPOSITESHADE 82670 . 82849) (\MEDW.BITBLT 82851 . 86228)) (86232 91418 (
-FINISH-READING-BITMAP 86232 . 91418)) (92540 93021 (BITMAPBIT.EXPANDER 92550 . 93019)) (93022 141556 (
-\BITBLT.DISPLAY 93032 . 116271) (\BITBLT.BITMAP 116273 . 125372) (\BITBLT.MERGE 125374 . 127627) (
-\BLTSHADE.DISPLAY 127629 . 134729) (\BLTSHADE.BITMAP 134731 . 141554)) (141557 150877 (
-\BITBLT.BITMAP.SLOW 141567 . 150875)) (150878 167259 (\PUNT.BLTSHADE.BITMAP 150888 . 157984) (
-\PUNT.BITBLT.BITMAP 157986 . 167257)) (167260 170700 (\SCALEDBITBLT.DISPLAY 167270 . 168903) (
-\BACKCOLOR.DISPLAY 168905 . 170698)) (174555 176828 (DISPLAYSTREAMP 174565 . 175173) (DSPSOURCETYPE 
-175175 . 176184) (DSPXOFFSET 176186 . 176505) (DSPYOFFSET 176507 . 176826)) (176829 191024 (
-DSPDESTINATION 176839 . 179942) (DSPTEXTURE 179944 . 180106) (\DISPLAYSTREAMINCRXPOSITION 180108 . 
-180395) (\SFFixDestination 180397 . 181575) (\SFFixClippingRegion 181577 . 183749) (\SFFixFont 183751
- . 184801) (\SFFIXLINELENGTH 184803 . 186299) (\UPDATE-SYNONYM-STREAM-LINELENGTH-FIELD 186301 . 188114
-) (\SFFixY 188116 . 191022)) (191025 194872 (\SIMPLE.DSPCREATE 191035 . 191585) (\COMMON.DSPCREATE 
-191587 . 194870)) (194973 197167 (\MEDW.XOFFSET 194983 . 196124) (\MEDW.YOFFSET 196126 . 197165)) (
-197168 205094 (\DSPCLIPPINGREGION.DISPLAY 197178 . 197924) (\DSPFONT.DISPLAY 197926 . 200296) (
-\DISPLAY.PILOTBITBLT 200298 . 200447) (\DSPLINEFEED.DISPLAY 200449 . 201020) (\DSPLEFTMARGIN.DISPLAY 
-201022 . 201753) (\DSPOPERATION.DISPLAY 201755 . 202779) (\DSPRIGHTMARGIN.DISPLAY 202781 . 203626) (
-\DSPXPOSITION.DISPLAY 203628 . 204485) (\DSPYPOSITION.DISPLAY 204487 . 205092)) (209282 214318 (
-TTYDISPLAYSTREAM 209292 . 214316)) (214621 215651 (DSPSCROLL 214631 . 215331) (PAGEHEIGHT 215333 . 
-215649)) (215696 218718 (\DSPRESET.DISPLAY 215706 . 218716)) (218754 219277 (\MAYBE-DRIBBLE-CHAR 
-218754 . 219277)) (219278 239916 (\DSPPRINTCHAR 219288 . 227126) (\DSPPRINTCR/LF 227128 . 239914)) (
-239917 240509 (\TTYBACKGROUND 239927 . 240507)) (240510 243797 (DSPBACKUP 240520 . 243795)) (243981 
-244237 (COLORDISPLAYP 243991 . 244235)) (244238 246309 (DISPLAYBEFOREEXIT 244248 . 245074) (
-DISPLAYAFTERENTRY 245076 . 246307)) (246681 251213 (\DSPCLIPTRANSFORMX 246691 . 247280) (
-\DSPCLIPTRANSFORMY 247282 . 248007) (\DSPTRANSFORMREGION 248009 . 248541) (\DSPUNTRANSFORMY 248543 . 
-248803) (\DSPUNTRANSFORMX 248805 . 249065) (\OFFSETCLIPPINGREGION 249067 . 251211)) (252527 255114 (
-UPDATESCREENDIMENSIONS 252537 . 253166) (\CreateScreenBitMap 253168 . 255112)) (255673 268832 (
-\CoerceToDisplayDevice 255683 . 256096) (\CREATEDISPLAY 256098 . 257938) (DISPLAYSTREAMINIT 257940 . 
-261084) (\STARTDISPLAY 261086 . 263997) (\MOVE.WINDOWS.ONTO.SCREEN 263999 . 266191) (
-\UPDATE.PBT.RASTERWIDTHS 266193 . 267975) (\STOPDISPLAY 267977 . 268469) (\DEFINEDISPLAYINFO 268471 . 
-268830)) (269440 270201 (INITIALIZEDISPLAYSTREAMS 269450 . 270199)))))
+  (FILEMAP (NIL (20615 23283 (\FBITMAPBIT 20625 . 21085) (\FBITMAPBIT.UFN 21087 . 22106) (
+\NEWPAGE.DISPLAY 22108 . 22243) (INITBITMASKS 22245 . 23281)) (25208 25717 (\CreateCursorBitMap 25218
+ . 25715)) (25834 86764 (BITBLT 25844 . 36234) (BLTSHADE 36236 . 37014) (\BITBLTSUB 37016 . 47151) (
+\GETPILOTBBTSCRATCHBM 47153 . 47768) (BITMAPCOPY 47770 . 48346) (BITMAPCREATE 48348 . 49908) (
+BITMAPBIT 49910 . 58297) (BITMAPEQUAL 58299 . 59761) (BLTCHAR 59763 . 60379) (\BLTCHAR 60381 . 60883) 
+(\MEDW.BLTCHAR 60885 . 65763) (\CHANGECHARSET.DISPLAY 65765 . 68723) (\INDICATESTRING 68725 . 69921) (
+\SLOWBLTCHAR 69923 . 77019) (TEXTUREP 77021 . 77291) (INVERT.TEXTURE 77293 . 77567) (
+INVERT.TEXTURE.BITMAP 77569 . 79104) (BITMAPWIDTH 79106 . 79478) (BITMAPHEIGHT 79480 . 79856) (
+READBITMAP 79858 . 82368) (\INSUREBITSPERPIXEL 82370 . 82665) (MAXIMUMCOLOR 82667 . 82808) (
+OPPOSITECOLOR 82810 . 82989) (MAXIMUMSHADE 82991 . 83202) (OPPOSITESHADE 83204 . 83383) (\MEDW.BITBLT 
+83385 . 86762)) (86765 88194 (\READBINARYBITMAP 86775 . 87413) (\PRINTBINARYBITMAP 87415 . 88192)) (
+88196 93382 (FINISH-READING-BITMAP 88196 . 93382)) (94504 94985 (BITMAPBIT.EXPANDER 94514 . 94983)) (
+94986 143520 (\BITBLT.DISPLAY 94996 . 118235) (\BITBLT.BITMAP 118237 . 127336) (\BITBLT.MERGE 127338
+ . 129591) (\BLTSHADE.DISPLAY 129593 . 136693) (\BLTSHADE.BITMAP 136695 . 143518)) (143521 152841 (
+\BITBLT.BITMAP.SLOW 143531 . 152839)) (152842 169223 (\PUNT.BLTSHADE.BITMAP 152852 . 159948) (
+\PUNT.BITBLT.BITMAP 159950 . 169221)) (169224 172664 (\SCALEDBITBLT.DISPLAY 169234 . 170867) (
+\BACKCOLOR.DISPLAY 170869 . 172662)) (176519 178792 (DISPLAYSTREAMP 176529 . 177137) (DSPSOURCETYPE 
+177139 . 178148) (DSPXOFFSET 178150 . 178469) (DSPYOFFSET 178471 . 178790)) (178793 192988 (
+DSPDESTINATION 178803 . 181906) (DSPTEXTURE 181908 . 182070) (\DISPLAYSTREAMINCRXPOSITION 182072 . 
+182359) (\SFFixDestination 182361 . 183539) (\SFFixClippingRegion 183541 . 185713) (\SFFixFont 185715
+ . 186765) (\SFFIXLINELENGTH 186767 . 188263) (\UPDATE-SYNONYM-STREAM-LINELENGTH-FIELD 188265 . 190078
+) (\SFFixY 190080 . 192986)) (192989 196836 (\SIMPLE.DSPCREATE 192999 . 193549) (\COMMON.DSPCREATE 
+193551 . 196834)) (196937 199131 (\MEDW.XOFFSET 196947 . 198088) (\MEDW.YOFFSET 198090 . 199129)) (
+199132 207062 (\DSPCLIPPINGREGION.DISPLAY 199142 . 199888) (\DSPFONT.DISPLAY 199890 . 202264) (
+\DISPLAY.PILOTBITBLT 202266 . 202415) (\DSPLINEFEED.DISPLAY 202417 . 202988) (\DSPLEFTMARGIN.DISPLAY 
+202990 . 203721) (\DSPOPERATION.DISPLAY 203723 . 204747) (\DSPRIGHTMARGIN.DISPLAY 204749 . 205594) (
+\DSPXPOSITION.DISPLAY 205596 . 206453) (\DSPYPOSITION.DISPLAY 206455 . 207060)) (211250 216286 (
+TTYDISPLAYSTREAM 211260 . 216284)) (216589 217619 (DSPSCROLL 216599 . 217299) (PAGEHEIGHT 217301 . 
+217617)) (217664 220686 (\DSPRESET.DISPLAY 217674 . 220684)) (220722 221245 (\MAYBE-DRIBBLE-CHAR 
+220722 . 221245)) (221246 241884 (\DSPPRINTCHAR 221256 . 229094) (\DSPPRINTCR/LF 229096 . 241882)) (
+241885 242477 (\TTYBACKGROUND 241895 . 242475)) (242478 245765 (DSPBACKUP 242488 . 245763)) (245949 
+246205 (COLORDISPLAYP 245959 . 246203)) (246206 248277 (DISPLAYBEFOREEXIT 246216 . 247042) (
+DISPLAYAFTERENTRY 247044 . 248275)) (248649 253181 (\DSPCLIPTRANSFORMX 248659 . 249248) (
+\DSPCLIPTRANSFORMY 249250 . 249975) (\DSPTRANSFORMREGION 249977 . 250509) (\DSPUNTRANSFORMY 250511 . 
+250771) (\DSPUNTRANSFORMX 250773 . 251033) (\OFFSETCLIPPINGREGION 251035 . 253179)) (254495 257082 (
+UPDATESCREENDIMENSIONS 254505 . 255134) (\CreateScreenBitMap 255136 . 257080)) (257641 270800 (
+\CoerceToDisplayDevice 257651 . 258064) (\CREATEDISPLAY 258066 . 259906) (DISPLAYSTREAMINIT 259908 . 
+263052) (\STARTDISPLAY 263054 . 265965) (\MOVE.WINDOWS.ONTO.SCREEN 265967 . 268159) (
+\UPDATE.PBT.RASTERWIDTHS 268161 . 269943) (\STOPDISPLAY 269945 . 270437) (\DEFINEDISPLAYINFO 270439 . 
+270798)) (271408 272392 (INITIALIZEDISPLAYSTREAMS 271418 . 272390)))))
 STOP

sources/LLDISPLAY.LCOM

@@ -1,9 +1,12 @@
 (DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
 
-(FILECREATED "31-Jul-2023 14:50:58" ("compiled on " {WMEDLEY}<sources>LLDISPLAY.;19) 
-"31-Jul-2023 14:48:17" "COMPILE-FILEd" in "FULL 31-Jul-2023 ..." dated "31-Jul-2023 14:48:24")
-(FILECREATED "31-Jul-2023 14:50:58" {WMEDLEY}<sources>LLDISPLAY.;19 270570 :EDIT-BY rmk :CHANGES-TO (
-FNS BITMAPEQUAL) :PREVIOUS-DATE "31-Jul-2023 14:45:32" {WMEDLEY}<sources>LLDISPLAY.;18)
+(FILECREATED "27-Jul-2025 20:25:50" ("compiled on " 
+{DSK}<Users>kaplan>Local>medley3.5>working-medley>sources>LLDISPLAY.;25) "27-Jul-2025 13:59:31" 
+"COMPILE-FILEd" in "FULL 27-Jul-2025 ..." dated "27-Jul-2025 13:59:38")
+(FILECREATED "27-Jul-2025 20:25:24" 
+{DSK}<Users>kaplan>Local>medley3.5>working-medley>sources>LLDISPLAY.;25 272767 :EDIT-BY rmk 
+:CHANGES-TO (VARS LLDISPLAYCOMS) :PREVIOUS-DATE "14-Jul-2025 22:06:59" 
+{DSK}<Users>kaplan>Local>medley3.5>working-medley>sources>LLDISPLAY.;23)
 (RPAQQ LLDISPLAYCOMS ((DECLARE%: DONTCOPY (EXPORT (RECORDS PILOTBBT \DISPLAYDATA DISPLAYSTATE 
 DISPLAYINFO) (MACROS \GETDISPLAYDATA))) (* ; 
 "User-visible records are on ADISPLAY --- must be init'ed here") (INITRECORDS BITMAP PILOTBBT REGION 
@@ -14,12 +17,13 @@ WORDMASK 65535)))) (DECLARE%: DONTEVAL@LOAD DOCOPY (P (INITBITMASKS)))) (COMS (*
  \CreateCursorBitMap) (DECLARE%: DONTEVAL@LOAD DOCOPY (VARS (CursorBitMap (\CreateCursorBitMap))))) (
 COMS (* ; "bitmap functions.") (FNS BITBLT BLTSHADE \BITBLTSUB \GETPILOTBBTSCRATCHBM BITMAPCOPY 
 BITMAPCREATE BITMAPBIT BITMAPEQUAL BLTCHAR \BLTCHAR \MEDW.BLTCHAR \CHANGECHARSET.DISPLAY 
-\INDICATESTRING \SLOWBLTCHAR TEXTUREP INVERT.TEXTURE INVERT.TEXTURE.BITMAP BITMAPWIDTH READBITMAP 
-\INSUREBITSPERPIXEL MAXIMUMCOLOR OPPOSITECOLOR MAXIMUMSHADE OPPOSITESHADE \MEDW.BITBLT) (FUNCTIONS 
-FINISH-READING-BITMAP) (CONSTANTS (MINIMUMCOLOR 0) (MINIMUMSHADE 0)) (P (MOVD (QUOTE BITMAPBIT) (QUOTE
- \BITMAPBIT))) (DECLARE%: DONTCOPY (EXPORT (MACROS \INVALIDATEDISPLAYCACHE))) (OPTIMIZERS BITMAPBIT 
-BITMAPP) (FNS BITMAPBIT.EXPANDER) (FNS \BITBLT.DISPLAY \BITBLT.BITMAP \BITBLT.MERGE \BLTSHADE.DISPLAY 
-\BLTSHADE.BITMAP) (FNS (* ;; "For SunLoadup") \BITBLT.BITMAP.SLOW) (FNS (* ;; 
+\INDICATESTRING \SLOWBLTCHAR TEXTUREP INVERT.TEXTURE INVERT.TEXTURE.BITMAP BITMAPWIDTH BITMAPHEIGHT 
+READBITMAP \INSUREBITSPERPIXEL MAXIMUMCOLOR OPPOSITECOLOR MAXIMUMSHADE OPPOSITESHADE \MEDW.BITBLT) (
+FNS \READBINARYBITMAP \PRINTBINARYBITMAP) (FUNCTIONS FINISH-READING-BITMAP) (CONSTANTS (MINIMUMCOLOR 0
+) (MINIMUMSHADE 0)) (P (MOVD (QUOTE BITMAPBIT) (QUOTE \BITMAPBIT))) (DECLARE%: DONTCOPY (EXPORT (
+MACROS \INVALIDATEDISPLAYCACHE))) (OPTIMIZERS BITMAPBIT BITMAPP) (FNS BITMAPBIT.EXPANDER) (FNS 
+\BITBLT.DISPLAY \BITBLT.BITMAP \BITBLT.MERGE \BLTSHADE.DISPLAY \BLTSHADE.BITMAP) (FNS (* ;; 
+"For SunLoadup") \BITBLT.BITMAP.SLOW) (FNS (* ;; 
 " punt case for C funcs.bitblt_bitmap,bitshade.bitmap") \PUNT.BLTSHADE.BITMAP \PUNT.BITBLT.BITMAP) (
 FNS (* ;; "from SUMEX-AIM") \SCALEDBITBLT.DISPLAY \BACKCOLOR.DISPLAY) (DECLARE%: DONTCOPY (CONSTANTS (
 \DisplayWordAlign 16) (\MaxBitMapWidth 65535) (\MaxBitMapHeight 65535) (\MaxBitMapWords 131066)) (
@@ -192,7 +196,7 @@ BLTCHAR :D8
 (42 \DISPLAYDATA 35 STREAM 24 OUTPUT)
 ()
 \BLTCHAR :D8
-(P 0 A0229 I 2 DISPLAYDATA I 1 DISPLAYSTREAM I 0 CHARCODE) (
AghbÉ.ÉZ
@ABlH(11 \GETSTREAM)
+(P 0 A0169 I 2 DISPLAYDATA I 1 DISPLAYSTREAM I 0 CHARCODE) (
AghbÉ.ÉZ
@ABlH(11 \GETSTREAM)
 (25 IMAGEOPS 18 STREAM 5 OUTPUT)
 ()
 \MEDW.BLTCHAR :D8
@@ -205,10 +209,11 @@ BLTCHAR :D8
 (256 \EM.DISPINTERRUPT 191 \TOPWDS 175 \EM.DISPINTERRUPT 167 \EM.DISPINTERRUPT 132 PILOTBBT)
 ()
 \CHANGECHARSET.DISPLAY :D8
-(P 4 \INTERRUPTABLE P 2 BM P 1 CSINFO P 0 PBT I 1 CHARSET I 0 DISPLAYDATA) Š@É*@ÉÉAàÐɵA@Éh"@IÉ¿@IÉ¿@IÉ0¿@A>¿IɺHJÈàààànÿÿåÍ¿@È'IÈ
-ð—@È@IÈð©@I
-¿°#JÉJÈ@ÉBÚлHKÒÍ¿HKÓÍh(98 \SFFixY 24 \CREATECHARSET)
-(130 PILOTBBT 119 PILOTBBT)
+(P 7 \INTERRUPTABLE P 5 BM P 4 CSINFO P 3 PBT I 1 CHARSET I 0 DISPLAYDATA) œ@É*@ÉÉAàÐɵ@ÉÉAàA@É
+HIÐJ¿J"@LÉ¿@LÉ¿@LÉ0¿@A>¿LɽKMÈàààànÿÿåÍ¿@È'LÈ
+ð—@È@LÈð©@L
+¿°#MÉMÈ@ÉBÚоKNÒÍ¿KNÓÍh(116 \SFFixY 30 \CREATECHARSET)
+(148 PILOTBBT 137 PILOTBBT)
 ()
 \INDICATESTRINGA0001 :D8
 (NAME SI::*UNWIND-PROTECT* I 0 SI::*CLEANUP-FORMS* F 0 SI::*RESETFORMS* F 1 CHARCODE) H
gd	gi
@@ -220,17 +225,18 @@ BLTCHAR :D8
 (75 ^ 52 %# 16 SI::RESETUNWIND)
 ( 81 "" 58 "")
 \SLOWBLTCHAR :D8
-(P 16 CSINFO P 15 HEIGHTMOVED P 14 YPOS P 13 SOFTCURSORUP P 12 DISPINTERRUPT P 11 SOURCEBIT P 10 WIDTH P 9 DESTBIT P 8 PILOTBBT P 7 CURX P 6 RIGHT P 5 LEFT P 4 NEWX P 2 DD P 1 CHAR8CODE P 0 ROTATION I 1 DISPLAYSTREAM I 0 CHARCODE F 17 \SOFTCURSORP F 18 \SOFTCURSORUPP F 19 \CURSORDESTINATION F 20 \SCREENBITMAPS) K@@lÿåYAÉ0ZdÉÈXdjð¢±
~€JÉ_JÉIÐÈØ\JÉñ²l
A
-¿JÉ_JÉIÐÈؼJL¿OJÉØ_¿JÈ"dOñ¢¿O½JÈ#LJÉØ»dKñ‘¿K¾JÉ*_¿NMñ¢±
OÈ	jð’±

M_¿NMÙ_¿JÉIÐÈMØOÙ_¿JÉÈdkð³adlð²¿Oàà_¿Oàà_¿Oàà_°Ddlð²¿Oààà_¿Oààà_¿Oààà_°$lð²lOÚ_¿lOÚ_¿lOÚ_„¿ 
W"²-W$´hA
-W&ð_²`È_¿`jÍ¿¿A`ð³hA
-W(–A	¿OOÍ¿OOÍ¿OOÍ¿Ojv¿OŸ¿`OÍ¿±·0JÉ_¿JÉIÐÈ_¿JÉÉ@ãàÐɵ
@ãJÉh_ ¿HdlZð²;¿AOOØ
+(P 16 CSINFO P 15 HEIGHTMOVED P 14 YPOS P 13 SOFTCURSORUP P 12 DISPINTERRUPT P 11 SOURCEBIT P 10 WIDTH P 9 DESTBIT P 8 PILOTBBT P 7 CURX P 6 RIGHT P 5 LEFT P 4 NEWX P 2 DD P 1 CHAR8CODE P 0 ROTATION I 1 DISPLAYSTREAM I 0 CHARCODE F 20 \SOFTCURSORP F 21 \SOFTCURSORUPP F 22 \CURSORDESTINATION F 23 \SCREENBITMAPS) b@@lÿåYAÉ0ZdÉÈXdjð¢±
~€JÉ_JÉIÐÈØ\JÉñ²l
A
+¿JÉ_JÉIÐÈؼJL¿OJÉØ_¿JÈ"dOñ¢¿O½JÈ#LJÉØ»dKñ‘¿K¾JÉ*_¿NMñ¢±
OÈ	jð’±

M_¿NMÙ_¿JÉIÐÈMØOÙ_¿JÉÈdkð³adlð²¿Oàà_¿Oàà_¿Oàà_°Ddlð²¿Oààà_¿Oààà_¿Oààà_°$lð²lOÚ_¿lOÚ_¿lOÚ_„¿ 
W(²-W*´hA
+W,ð_²`È_¿`jÍ¿¿A`ð³hA
+W.–A	¿OOÍ¿OOÍ¿OOÍ¿Ojv¿OŸ¿`OÍ¿±Î0JÉ_¿JÉIÐÈ_¿JÉÉ@ãàÐɵ$JÉÉ@ãà@ãJÉ
+O"O$ÐO&¿O&_ ¿HdlZð²;¿AOOØ
 ¿O ÉjJÉIÐÈAJÉO È
 ÙkØOO È
 O ÈØO
°Hn
ð²8AOOÙ
 ¿O ÉjJÉIÐÈAJÉO ÈÙJÉO È
-O ÈØO
‰o	h(583 ERROR 572 BKBITBLT 530 \DSPYPOSITION.DISPLAY 511 BKBITBLT 468 \DSPYPOSITION.DISPLAY 446 \CREATECHARSET 387 \SOFTCURSORUPCURRENT 352 \TOTOPWDS 342 DSPDESTINATION 325 \SOFTCURSORDOWN 294 DSPDESTINATION 275 SHOULDNT 55 \DSPPRINTCR/LF)
+O ÈØO
‰o	h(606 ERROR 595 BKBITBLT 553 \DSPYPOSITION.DISPLAY 534 BKBITBLT 491 \DSPYPOSITION.DISPLAY 453 \CREATECHARSET 387 \SOFTCURSORUPCURRENT 352 \TOTOPWDS 342 DSPDESTINATION 325 \SOFTCURSORDOWN 294 DSPDESTINATION 275 SHOULDNT 55 \DSPPRINTCR/LF)
 (393 \EM.DISPINTERRUPT 332 \TOPWDS 316 \EM.DISPINTERRUPT 306 \EM.DISPINTERRUPT 111 \DISPLAYDATA 83 \DISPLAYDATA)
-( 578 "Not implemented to rotate by other than 0, 90 or 270")
+( 601 "Not implemented to rotate by other than 0, 90 or 270")
 TEXTUREP :D8
 (I 0 OBJECT) 
@d3 ³ô@Èkð´@NIL
 (18 BITMAP 10 BITMAP)
@@ -250,6 +256,11 @@ BITMAPWIDTH :D8
 @	(35 \ILLEGAL.ARG 28 GETWINDOWPROP)
 (23 WIDTH 16 WINDOW 5 BITMAP)
 ()
+BITMAPHEIGHT :D8
+(I 0 BITMAP) +
@Ø@È@Û@g
+@	(40 \ILLEGAL.ARG 33 GETWINDOWPROP)
+(28 HEIGHT 21 WINDOW 12 BITMAP 5 BITMAP)
+()
 READBITMAP :D8
 (P 6 BITSPERPIXEL P 5 W P 4 BM P 3 BASE P 2 STRM P 1 HEIGHT P 0 WIDTH I 0 FILE) 

@	@	gðªo	¿@	@	@g
 CJ	dgð§dgð’¿k†¿@	^HÚlØââââ½HIN\É»Ij𒱊J	gð²jIdjñ²tJ	¿J	l"ð²QMdjñ²@KjJ	l@ÙààààJ	l@ÙäÇ¿KkJ	l@ÙààààJ	l@ÙäÇ¿KkлkÙ°¿¿J	l"ð¬¿o	hkÙ°‹¿J	¿J	l)ð²ßL(270 \INCCODE 263 SKIPSEPRS 250 ERROR 235 \INCCODE 214 \INCCODE 201 \INCCODE 187 \INCCODE 174 \INCCODE 155 \INCCODE 148 SKIPSEPRS 128 SKIPSEPRS 106 BITMAPCREATE 87 RATOM 61 SKIPSEPRS 52 GETSTREAM 41 RATOM 35 RATOM 28 ERROR 11 READC 5 SKIPSEPRS)
@@ -278,7 +289,7 @@ OPPOSITESHADE :D8
 NIL
 ()
 \MEDW.BITBLT :D8
-(P 9 A0232 P 8 A0231 P 7 SOURCEBOTTOMTRANSFORMED P 6 SOURCELEFTTRANSFORMED P 3 SRCWIN P 2 A0230 P 1 DD P 0 DSTWIN I 11 CLIPPINGREGION I 10 TEXTURE I 9 OPERATION I 8 SOURCETYPE I 7 HEIGHT I 6 WIDTH I 5 DESTINATIONBOTTOM I 4 DESTINATIONLEFT I 3 DESTINATION I 2 SOURCEBOTTOM I 1 SOURCELEFT I 0 SOURCE F 10 \SCREENBITMAPS) 
+(P 9 A0172 P 8 A0171 P 7 SOURCEBOTTOMTRANSFORMED P 6 SOURCELEFTTRANSFORMED P 3 SRCWIN P 2 A0170 P 1 DD P 0 DSTWIN I 11 CLIPPINGREGION I 10 TEXTURE I 9 OPERATION I 8 SOURCETYPE I 7 HEIGHT I 6 WIDTH I 5 DESTINATIONBOTTOM I 4 DESTINATIONLEFT I 3 DESTINATION I 2 SOURCEBOTTOM I 1 SOURCELEFT I 0 SOURCE F 10 \SCREENBITMAPS) 
 
@	³C	ªo	¿@òZ@²WCi
 CghÉ0HÉ2ÉHºHÉ2@ABCDEFGGGGGABlJ±
–Cô‚±¯C´‚±¨@i
 !@ghÉ0

AIÉصA
BIÉصBKÉ2ÉJ_¿KÉ2IÉNOCDEFGGGGGNIÈ"¼dLñ¡¿LOIÈ$½dMñ¡¿MlO±Þ@
@@ -288,6 +299,25 @@ NIL
 W–@	¿KÉ2ÉL
	KÉ2IÉNOCDEFGGGGGNIÈ"¼dLñ¡¿LOIÈ$½dMñ¡¿MlO‰o	i(524 SHOULDNT 418 \TOTOPWDS 408 DSPDESTINATION 345 \GETSTREAM 330 WFROMDS 318 DSPDESTINATION 311 DSPDESTINATION 162 \GETSTREAM 147 WFROMDS 55 \GETSTREAM 43 WFROMDS 24 SHOULDNT 13 IMAGESTREAMP 5 IMAGESTREAMP)
 (494 \DISPLAYDATA 477 \DISPLAYDATA 451 \DISPLAYDATA 443 WINDOW 432 SCREEN 425 WINDOW 398 \TOPWDS 383 \DISPLAYDATA 367 \DISPLAYDATA 357 \DISPLAYDATA 350 STREAM 339 OUTPUT 284 \DISPLAYDATA 267 \DISPLAYDATA 241 \DISPLAYDATA 233 WINDOW 222 SCREEN 215 WINDOW 200 \DISPLAYDATA 184 \DISPLAYDATA 174 \DISPLAYDATA 167 STREAM 156 OUTPUT 127 BITMAP 92 WINDOW 83 SCREEN 76 WINDOW 67 \DISPLAYDATA 60 STREAM 49 OUTPUT 31 BITMAP)
 ( 519 "Invalid argument to \XW.BIBLT" 19 "Neither SOURCE nor DESTINATION is an imagestream.")
+\READBINARYBITMAP :D8
+(P 3 BITMAP P 2 BPP P 1 BMH P 0 BMW I 0 STREAM) `
@g
+bd á@ Ø@ á@ Ø@ á@ Ø#HIJ[@KÉKÈIÚlÚMÉ
+É>¼MNjOlLK(41 BITMAPCREATE 10 GETSTREAM)
+(80 FDEV 73 STREAM 57 BITMAP 49 BITMAP 5 INPUT)
+()
+\PRINTBINARYBITMAP :D8
+(P 1 BMH P 0 STREAM I 1 STREAM I 0 BITMAP) ­Ag
+q@Ñ@¦@	¿H@	»ZKã
+¿JKlÿå
+¿H@	¹\Iã
+¿LIlÿå
+¿H@	¾]Nã
+¿MNlÿå
+¿H@É@ÈIÚlÚ
+OÉ
+É@_¿OOjOlO@(112 \BOUT 101 \BOUT 92 BITSPERPIXEL 84 \BOUT 73 \BOUT 64 BITMAPHEIGHT 56 \BOUT 45 \BOUT 36 BITMAPWIDTH 28 \ILLEGAL.ARG 10 GETSTREAM)
+(152 FDEV 145 STREAM 128 BITMAP 120 BITMAP 19 BITMAP 5 OUTPUT)
+()
 FINISH-READING-BITMAP :D8
 (L (0 STREAM) F 29 *READ-SUPPRESS*) (

@	ñ Hd²µoH
 ¿°íY
ºI[
¼K]µLk¾M_¿J3 šL3 –N3 ’O›oH
@@ -425,11 +455,11 @@ Q
 (145 ERASE 138 INVERT 121 INVERT 110 PAINT 99 ERASE 86 \DISPLAYDATA 77 \DISPLAYDATA 53 INVERT 43 INPUT 32 \DISPLAYDATA 23 \DISPLAYDATA 16 STREAM 5 OUTPUT)
 ()
 DSPXOFFSET :D8
-(P 0 A0244 I 1 DISPLAYSTREAM I 0 XOFFSET) '
AghbÉ.É\
@AlH(11 \GETSTREAM)
+(P 0 A0186 I 1 DISPLAYSTREAM I 0 XOFFSET) '
AghbÉ.É\
@AlH(11 \GETSTREAM)
 (25 IMAGEOPS 18 STREAM 5 OUTPUT)
 ()
 DSPYOFFSET :D8
-(P 0 A0245 I 1 DISPLAYSTREAM I 0 YOFFSET) '
AghbÉ.É^
@AlH(11 \GETSTREAM)
+(P 0 A0187 I 1 DISPLAYSTREAM I 0 YOFFSET) '
AghbÉ.É^
@AlH(11 \GETSTREAM)
 (25 IMAGEOPS 18 STREAM 5 OUTPUT)
 ()
 DSPDESTINATION :D8
@@ -514,13 +544,13 @@ A
 (23 \DISPLAYDATA 16 STREAM 5 OUTPUT)
 ( 63 " is not a REGION.")
 \DSPFONT.DISPLAY :D8
-(P 3 \INTERRUPTABLE P 2 DD P 1 OLDFONT P 0 XFONT I 1 FONT I 0 DISPLAYSTREAM) {0@É0ZdÉYA²cA@iµJÉgiA
-µo	XIð³7JH¿JjHÈ
-Ù¿JHÉɵ
-jHhÉÈ ÍA¿@J
-(119 \SFFixFont 105 \CREATECHARSET 62 ERROR 50 FONTCOPY 31 \COERCEFONTDESC)
-(83 FONTDESCRIPTOR 41 NOERROR 17 \DISPLAYDATA 8 STREAM)
-( 57 "FONT NOT FOUND OR ILLEGAL FONTCOPY PARAMETER")
+(P 4 \INTERRUPTABLE P 2 DD P 1 OLDFONT P 0 XFONT I 1 FONT I 0 DISPLAYSTREAM) †@@É0ZdÉYA²nAhdd@i
µJÉgiA
+µo	XIð³>JH¿JjHÈ
+Ù¿JHÉɵHÉjH
+[¿KÉÈ ÍA¿@J
+(130 \SFFixFont 111 \CREATECHARSET 66 ERROR 54 FONTCOPY 35 FONTCREATE)
+(87 FONTDESCRIPTOR 45 NOERROR 17 \DISPLAYDATA 8 STREAM)
+( 61 "FONT NOT FOUND OR ILLEGAL FONTCOPY PARAMETER")
 \DISPLAY.PILOTBITBLT :D8
 (I 1 N I 0 PILOTBBT) @AvNIL
 NIL
@@ -594,7 +624,7 @@ NIL
 hI
 I
 HÉ
-ZHÉ[dÈ\KÈdjð²%¿@HÉ
+ZHÉ[d	È\KÈdjð²%¿@HÉ
 ¿@J
J
ØmÿØLÙkØ
 °UdlZð²¿@J
LØ
 ¿@J

@@ -602,8 +632,8 @@ ZH
 ¿@J
J
ØmÿØ
 ‰o	¿hdd@J
J
J
J
ggHÉ6
@i
 
Md²"	É.]d²	@ð´Mo
-h(297 PROCESS.EVAL 282 PROCESS.TTY 271 \INSUREWINDOW 259 WFROMDS 252 BKBITBLT 214 ERROR 203 \DSPYPOSITION.DISPLAY 184 \DSPXPOSITION.DISPLAY 158 \DSPYPOSITION.DISPLAY 148 \DSPXPOSITION.DISPLAY 129 \DSPYPOSITION.DISPLAY 106 \DSPXPOSITION.DISPLAY 61 WYOFFSET 55 WYOFFSET 48 WXOFFSET 42 WXOFFSET 32 WFROMDS 11 \GETSTREAM)
-(243 REPLACE 238 TEXTURE 89 FONTDESCRIPTOR 80 FONTDESCRIPTOR 71 \DISPLAYDATA 25 \DISPLAYDATA 18 STREAM 5 OUTPUT)
+h(297 PROCESS.EVAL 282 PROCESS.TTY 271 \INSUREWINDOW 259 WFROMDS 252 BKBITBLT 214 ERROR 203 \DSPYPOSITION.DISPLAY 184 \DSPXPOSITION.DISPLAY 158 \DSPYPOSITION.DISPLAY 148 \DSPXPOSITION.DISPLAY 129 \DSPYPOSITION.DISPLAY 106 \DSPXPOSITION.DISPLAY 80 FONTCREATE 61 WYOFFSET 55 WYOFFSET 48 WXOFFSET 42 WXOFFSET 32 WFROMDS 11 \GETSTREAM)
+(243 REPLACE 238 TEXTURE 89 FONTDESCRIPTOR 71 \DISPLAYDATA 25 \DISPLAYDATA 18 STREAM 5 OUTPUT)
 ( 292 (SETQ \CURRENTDISPLAYLINE 0) 209 "only supported rotations are 0, 90 and 270")
 (RPAQ? *DRIBBLE-OUTPUT* NIL)
 expand-\MAYBE-DRIBBLE-CHAR :D8
@@ -655,14 +685,14 @@ expand-\MAYBE-DRIBBLE-CHAR :D8
 DSPBACKUP :D8
 (P 4 XPOS P 3 BLTWIDTH P 2 ROTATION P 1 FONT P 0 DD I 1 DISPLAYSTREAM I 0 WIDTH) 
fA	³Ag
 b	¢±
AghbÉ0q@HÉ\HÉÙ½dMñ‘¿M[HÉYHɘIÈ€jZKjñ´‚±Ä`–A	¿Jdjð²0¿LKÙA
-¿hjdAHÉHÉIÈ	ÙKIÈ
-°qlZð²0hjdAHÉIÈÙHHÉjKÙÔ^¿N°5Jn
ð²GhjdAHÉIÈ	ÙHHÉKÔ_¿OIÈ
+¿hjdAHÉHÉI	È	ÙKI	È
+°qlZð²0hjdAHÉI	ÈÙHHÉjKÙÔ^¿N°5Jn
ð²GhjdAHÉI	È	ÙHHÉKÔ_¿OI	È
 Kgg
 i@Mjñ²#Al
 ¿Al 
 ¿Al
-¾MkÙ]°ÝN(347 BOUT 338 BOUT 329 BOUT 310 BKBITBLT 147 DSPXPOSITION 130 \CARET.DOWN 41 \GETSTREAM 25 DISPLAYSTREAMP 18 GETSTREAM 5 DISPLAYSTREAMP)
-(304 REPLACE 299 TEXTURE 291 FONTDESCRIPTOR 274 \DISPLAYDATA 268 \DISPLAYDATA 259 FONTDESCRIPTOR 251 \DISPLAYDATA 221 \DISPLAYDATA 215 \DISPLAYDATA 206 FONTDESCRIPTOR 198 \DISPLAYDATA 179 FONTDESCRIPTOR 169 FONTDESCRIPTOR 158 \DISPLAYDATA 123 \CARET.UP 104 FONTDESCRIPTOR 95 \DISPLAYDATA 86 \DISPLAYDATA 65 \DISPLAYDATA 55 \DISPLAYDATA 48 STREAM 35 OUTPUT 13 OUTPUT)
+¾MkÙ]°ÝN(347 BOUT 338 BOUT 329 BOUT 310 BKBITBLT 291 FONTCREATE 259 FONTCREATE 206 FONTCREATE 179 FONTCREATE 169 FONTCREATE 147 DSPXPOSITION 130 \CARET.DOWN 41 \GETSTREAM 25 DISPLAYSTREAMP 18 GETSTREAM 5 DISPLAYSTREAMP)
+(304 REPLACE 299 TEXTURE 274 \DISPLAYDATA 268 \DISPLAYDATA 251 \DISPLAYDATA 221 \DISPLAYDATA 215 \DISPLAYDATA 198 \DISPLAYDATA 158 \DISPLAYDATA 123 \CARET.UP 104 FONTDESCRIPTOR 95 \DISPLAYDATA 86 \DISPLAYDATA 65 \DISPLAYDATA 55 \DISPLAYDATA 48 STREAM 35 OUTPUT 13 OUTPUT)
 ()
 (RPAQ? \CARET.UP)
 (RPAQQ BELLCNT 2)
@@ -749,22 +779,22 @@ NIL
 ()
 DISPLAYSTREAMINIT :D8
 (P 2 TTYFONTHEIGHT P 1 TTYHEIGHT P 0 TTYFONT I 0 N F 3 TtyDisplayStream) «

chS
-!HÈ
+!H	È
 Z`S
 S	`@3µLdJÚ¹`IÙS
-¿HÈ	S
+¿H	È	S
 ¿jS
 ¿jd`IhS
 ¿`S
-¿JÚ`ñš`JÛlÙ€@°<>(139 DSPRIGHTMARGIN 127 DSPCLIPPINGREGION 107 DSPXOFFSET 99 DSPYPOSITION 84 DSPYOFFSET 57 TERMINAL-OUTPUT 41 DSPDESTINATION 18 DSPFONT 9 DSPCREATE 4 \STARTDISPLAY)
-(167 \LastTTYLines 155 SCREENHEIGHT 148 SCREENHEIGHT 133 SCREENWIDTH 115 SCREENWIDTH 91 FONTDESCRIPTOR 76 SCREENHEIGHT 62 \LastTTYLines 52 \TopLevelTtyWindow 47 \DEFAULTTTYDISPLAYSTREAM 35 ScreenBitMap 27 FONTDESCRIPTOR)
+¿JÚ`ñš`JÛlÙ€@°<>(139 DSPRIGHTMARGIN 127 DSPCLIPPINGREGION 107 DSPXOFFSET 99 DSPYPOSITION 91 FONTCREATE 84 DSPYOFFSET 57 TERMINAL-OUTPUT 41 DSPDESTINATION 27 FONTCREATE 18 DSPFONT 9 DSPCREATE 4 \STARTDISPLAY)
+(167 \LastTTYLines 155 SCREENHEIGHT 148 SCREENHEIGHT 133 SCREENWIDTH 115 SCREENWIDTH 76 SCREENHEIGHT 62 \LastTTYLines 52 \TopLevelTtyWindow 47 \DEFAULTTTYDISPLAYSTREAM 35 ScreenBitMap)
 ()
 \STARTDISPLAY :D8
-(P 2 \INTERRUPTABLE P 1 W P 0 OLDWINDOWS F 3 \MAINSCREEN F 4 \WINDOWWORLD F 5 \CURSORDESTINATION F 6 WINDOWBACKGROUNDSHADE F 7 \CURSORDESTWIDTH F 8 \CURSORDESTHEIGHT F 9 \CURSORDESTRASTERWIDTH) 
<``ðœ``ð³AT²>	¸``ó«``ó–H	¿HŒd


I	µò``
+(P 2 \INTERRUPTABLE P 1 W P 0 OLDWINDOWS F 3 \MAINSCREEN F 4 \WINDOWWORLD F 5 \CURSORDESTINATION F 6 \CURSORDESTRASTERWIDTH F 7 \CURSORDESTWIDTH F 8 \CURSORDESTHEIGHT) 
@``ðœ``ð³AT²>	¸``ó«``ó–H	¿HŒd


I	µò``
 É`È
-¿ijd``hSµ7`c
-`c`c`ÈcH²LV	¿H	°:`¿S`¿S`¿°¢d


I	µò``h(287 \OPENW1 231 REVERSE 224 CHANGEBACKGROUND 142 SHOWDISPLAY 113 \CreateScreenBitMap 90 \CLOSEW1 76 \MOVE.WINDOWS.ONTO.SCREEN 45 REVERSE 40 OPENWINDOWS 7 UPDATESCREENDIMENSIONS)
-(312 \OLDSCREENWIDTH 307 SCREENWIDTH 302 \OLDSCREENHEIGHT 297 SCREENHEIGHT 271 SCREENHEIGHT 266 SCREEN 257 SCREENWIDTH 252 SCREEN 243 ScreenBitMap 238 SCREEN 211 BITMAP 206 ScreenBitMap 199 SCREENHEIGHT 192 SCREENWIDTH 185 ScreenBitMap 177 WHOLESCREEN 172 WHOLEDISPLAY 162 SCREENHEIGHT 157 SCREENWIDTH 149 \DisplayStarted 135 BITMAP 130 ScreenBitMap 123 BITMAP 118 ScreenBitMap 108 SCREENHEIGHT 103 SCREENWIDTH 68 SCREENHEIGHT 63 \OLDSCREENHEIGHT 56 SCREENWIDTH 51 \OLDSCREENWIDTH 29 \OLDSCREENHEIGHT 24 SCREENHEIGHT 17 \OLDSCREENWIDTH 12 SCREENWIDTH)
+¿ijd``hSµ;`c
+`c`c`ÈcH²P`	¿H	°:`¿S`¿S`¿°žd


I	µò``h(291 \OPENW1 235 REVERSE 228 CHANGEBACKGROUND 142 SHOWDISPLAY 113 \CreateScreenBitMap 90 \CLOSEW1 76 \MOVE.WINDOWS.ONTO.SCREEN 45 REVERSE 40 OPENWINDOWS 7 UPDATESCREENDIMENSIONS)
+(316 \OLDSCREENWIDTH 311 SCREENWIDTH 306 \OLDSCREENHEIGHT 301 SCREENHEIGHT 275 SCREENHEIGHT 270 SCREEN 261 SCREENWIDTH 256 SCREEN 247 ScreenBitMap 242 SCREEN 223 WINDOWBACKGROUNDSHADE 211 BITMAP 206 ScreenBitMap 199 SCREENHEIGHT 192 SCREENWIDTH 185 ScreenBitMap 177 WHOLESCREEN 172 WHOLEDISPLAY 162 SCREENHEIGHT 157 SCREENWIDTH 149 \DisplayStarted 135 BITMAP 130 ScreenBitMap 123 BITMAP 118 ScreenBitMap 108 SCREENHEIGHT 103 SCREENWIDTH 68 SCREENHEIGHT 63 \OLDSCREENHEIGHT 56 SCREENWIDTH 51 \OLDSCREENWIDTH 29 \OLDSCREENHEIGHT 24 SCREENHEIGHT 17 \OLDSCREENWIDTH 12 SCREENWIDTH)
 ()
 \MOVE.WINDOWS.ONTO.SCREEN :D8
 (P 4 REG P 3 YFACTOR P 2 XFACTOR P 1 W I 0 WINDOWS) Ú
@
Hµ+h´&```ëZ``ë[@
HµAh
YÉ
L
L
ØmÿØ`óµL
L
ØmÿØ`ó•Iµ¥i°¢HX°™
Yd	ð²\Ii
@@ -785,15 +815,15 @@ NIL
 (PUTPROPS DISPLAYSTARTEDP MACRO (NIL \DisplayStarted))
 (ADDTOVAR GLOBALVARS WHOLESCREEN)
 INITIALIZEDISPLAYSTREAMS :D8
-(F 0 \GUARANTEEDDISPLAYFONT F 1 DEFAULTFONT) Uodnÿdh`ld
+(F 0 \GUARANTEEDDISPLAYFONT F 1 DEFAULTFONT) Yodnÿdh`ld
 gl
-hdg
cgkPh
-c(80 FONTCLASS 63 FONTCREATE 38 BITMAPCREATE)
-(70 DEFAULTFONT 57 DISPLAY 48 GACHA 43 \SYSBBTEXTURE 30 \SYSPILOTBBT 24 |PILOTBBTTYPE#| 19 WHOLEDISPLAY)
-( 4 -16383)
+ohg
cgkPh
+c(84 FONTCLASS 67 FONTCREATE 38 BITMAPCREATE)
+(74 DEFAULTFONT 61 DISPLAY 48 GACHA 43 \SYSBBTEXTURE 30 \SYSPILOTBBT 24 |PILOTBBTTYPE#| 19 WHOLEDISPLAY)
+( 55 (MEDIUM REGULAR REGULAR) 4 -16383)
 (RPAQQ \DisplayStarted NIL)
 (RPAQQ \LastTTYLines 12)
 (INITIALIZEDISPLAYSTREAMS)
 (DISPLAYSTREAMINIT 1000)
-(PUTPROPS LLDISPLAY FILETYPE COMPILE-FILE)
+(PUTPROPS LLDISPLAY FILETYPE :FAKE-COMPILE-FILE)
 NIL

sources/MEDLEYFONTFORMAT

@@ -0,0 +1,914 @@
+(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
+
+
(FILECREATED "27-Jul-2025 22:22:23" {WMEDLEY}<sources>MEDLEYFONTFORMAT.;218
 57699  
+
+      :EDIT-BY rmk
+
+      :CHANGES-TO (FNS MEDLEYFONT.READ.ITEM)
+
+      :PREVIOUS-DATE "24-Jul-2025 22:07:35" {WMEDLEY}<sources>MEDLEYFONTFORMAT.;217)
+
+
+(PRETTYCOMPRINT MEDLEYFONTFORMATCOMS)
+
+(RPAQQ MEDLEYFONTFORMATCOMS

+       [
+        (* ;; "Eventually, MEDLEYFONT should be a package")

+
+        
+        (* ;; "Main public entries")

+
+        (FNS MEDLEYFONT.WRITE.FONT MEDLEYFONT.GETCHARSET MEDLEYFONT.CHARSET? MEDLEYFONT.GETFILEPROP 
+             MEDLEYFONT.FILEP)
+        
+        (* ;; "Reading")

+
+        (FNS MEDLEYFONT.READ.FONT MEDLEYFONT.READ.CHARSET MEDLEYFONT.READ.ITEM MEDLEYFONT.PEEK.ITEM 
+             MEDLEYFONT.READ.FONTPROPS MEDLEYFONT.READ.VERIFIEDFONT)
+        
+        (* ;; "Writing")

+
+        (FNS MEDLEYFONT.WRITE.CHARSET MEDLEYFONT.WRITE.ITEM MEDLEYFONT.WRITE.FONTPROPS 
+             MEDLEYFONT.WRITE.HEADER)
+        (FNS MEDLEYFONT.FILENAME)
+        (ADDVARS (DISPLAYFONTEXTENSIONS MEDLEYDISPLAYFONT)
+               (DISPLAYCHARSETFNS (MEDLEYFONT MEDLEYFONT.FILEP MEDLEYFONT.GETCHARSET))
+               (INTERPRESSFONTEXTENSIONS MEDLEYINTERPRESSFONT))
+        (DECLARE%: EVAL@COMPILE DONTCOPY (CONSTANTS (PRINTDATA 0)
+                                                (SMALLPDATA 1)
+                                                (BITMAPDATA 2)
+                                                (WORDBLOCKDATA 3)
+                                                (CLARRAYDATA 4)
+                                                (FIXPDATA 5)
+                                                (ILPOINTERARRAY 6)
+                                                (ILNUMBERARRAY 11)
+                                                (HPRINTDATA 7)
+                                                (ALISTDATA 8)
+                                                (PLISTDATA 9)
+                                                (LISTDATA 10])
+
+
+
+(* ;; "Eventually, MEDLEYFONT should be a package")

+
+
+
+
+(* ;; "Main public entries")

+
+(DEFINEQ
+
+(MEDLEYFONT.WRITE.FONT

+  [LAMBDA (FONT FILE CHARSETNOS OTHERFONTPROPS NOINDIRECTS)
  (* ; "Edited 15-Jul-2025 16:43 by rmk")


+                                                             (* ; "Edited  9-Jul-2025 09:32 by rmk")


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


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


+                                                             (* ; "Edited 25-May-2025 20:48 by rmk")


+                                                             (* ; "Edited 23-May-2025 14:59 by rmk")


+                                                             (* ; "Edited 22-May-2025 09:58 by rmk")


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


+                                                             (* ; "Edited 14-May-2025 17:45 by rmk")

+    (SETQ FONT (FONTCREATE FONT))
+    (CL:UNLESS FILE
+        (SETQ FILE (MEDLEYFONT.FILENAME
 FONT CHARSETNOS)))
+    (SETQ CHARSETNOS (SORT (MKLIST CHARSETNOS)))
+    (CL:WITH-OPEN-FILE (STREAM FILE :DIRECTION :OUTPUT :IF-EXISTS :NEW-VERSION)
+           (MEDLEYFONT.WRITE.HEADER
 STREAM OTHERFONTPROPS)
+           (LET ((CHARSETLOCS (CL:MAKE-ARRAY 256 :INITIAL-ELEMENT 0))
+                 (FONTCHARENCODING (FONTPROP FONT 'CHARENCODING))
+                 (*READTABLE* (FIND-READTABLE "INTERLISP"))
+                 CSVECTORPTRLOC CSVECTORLOC FILECHARSETS)
+
+                (* ;; "Figure out the actual non empty/sluggish charsets that will be wrtitten.")

+
+                (SETQ FILECHARSETS (for
 CSNO CSINFO from
 0 to
 \MAXCHARSET
+                                      when
 (OR (NULL CHARSETNOS)
+                                               (MEMB CSNO CHARSETNOS))
+                                      when
 (SETQ CSINFO (\XGETCHARSETINFO FONT CSNO))
+                                      unless
 (fetch
 (CHARSETINFO CSSLUGP) of
 CSINFO) collect
 CSNO))
+                (CL:UNLESS FILECHARSETS (ERROR "No character sets to write" FONT))
+
+                (* ;; "Right after the header, leave 4 bytes for the pointer to the charset dispatch vector. If writing a single charset, we store the negative of the byte location so we can still easily skip the font properties without writing the whole vector. The byte in front of the single charset holds its number.")

+
+                (* ;; "")

+
+                (SETQ CSVECTORPTRLOC (GETFILEPTR STREAM))    (* ; 
+
                                                      "Ptr is before fontproperties, vector is after")

+                (\FIXPOUT STREAM 0)
+                (MEDLEYFONT.WRITE.FONTPROPS
 STREAM FONT)
+                (if
 (CDR FILECHARSETS)
+                    then
 (PRINTOUT STREAM "CHARSET LOCATIONS" T) 
+                                                             (* ; 
+
                                                             "Allocate the vector space if multiple")

+                         (SETQ CSVECTORLOC (GETFILEPTR STREAM))
+                         (for
 I from
 0 to
 \MAXCHARSET do
 (\FIXPOUT STREAM 0))
+                         (TERPRI STREAM)
+                         (for
 CSNO in
 FILECHARSETS do
 
+
+                                                    (* ;; 
+
    "LOC remains zero for missing charsets, slug properties are determined by font-level properties.")

+
+                                                      (CL:SETF (CL:SVREF CHARSETLOCS CSNO)
+                                                             (GETFILEPTR STREAM))
+                                                      (MEDLEYFONT.WRITE.CHARSET
 FONT CSNO STREAM 
+                                                             NOINDIRECTS))
+                         (SETFILEPTR STREAM CSVECTORLOC)
+                         (for
 CSNO from
 0 to
 \MAXCHARSET do
 (\FIXPOUT STREAM (CL:SVREF CHARSETLOCS 
+                                                                                    CSNO)))
+                  else
 
+                       (* ;; "Only one.  The %"vector%" is the charset byte immediately before the charset, the sign bit tells the tale.")

+
+                       (SETQ CSVECTORLOC (IMINUS (GETFILEPTR STREAM)))
+                       (BOUT STREAM (CAR FILECHARSETS))
+                       (MEDLEYFONT.WRITE.CHARSET
 FONT (CAR FILECHARSETS)
+                              STREAM NOINDIRECTS))
+                (SETFILEPTR STREAM CSVECTORPTRLOC)
+                (\FIXPOUT STREAM CSVECTORLOC)                (* ; 
+
             "Pointer to the charset dispatch vector--or negative of actual location for a singleton")

+                (FULLNAME STREAM])
+
+(MEDLEYFONT.GETCHARSET

+  [LAMBDA (STREAM CHARSET)
                                   (* ; "Edited 15-Jul-2025 17:09 by rmk")


+                                                             (* ; "Edited  9-Jul-2025 15:45 by rmk")


+                                                             (* ; "Edited 14-May-2025 17:46 by rmk")

+
+    (* ;; "If open, assume its a medleyfont stream, that the initial Me etc. has been checked, and we are positioned after the header information")

+
+    (CL:UNLESS (<= 0 CHARSET \MAXCHARSET)
+           (\ILLEGAL.ARG CHARSET))
+    (RESETLST
+        (CL:UNLESS (\GETSTREAM STREAM 'INPUT T)
+            [RESETSAVE (SETQ STREAM (OPENSTREAM STREAM 'INPUT))
+                   `(PROGN (CLOSEF? OLDVALUE]
+            (CL:UNLESS (MEDLEYFONT.FILEP
 STREAM)             (* ; 
+
                                                             "Checks and positions, if reopening.")

+                (ERROR "NOT A MEDLEYFONT FILE" (FULLNAME STREAM))))
+        (LET ((CSVECTORLOC (\FIXPIN STREAM))
+              CSLOC)
+
+             (* ;; "We know now that this file has information about the requested charset, including NIL entries for empty/slugglish ones in the middle of populated ones.  A file that would have contain a single empty/sluggish charset cannot be created--the caller would recognize the case of a missing file and provide either NIL or a slug-vector.")

+
+             (CL:WHEN (if
 (ILESSP CSVECTORLOC 0)
+                          then
 
+                               (* ;; "File contains only one charset. Is it the one we want? If the intended charset is empty/sluggish, the file would not have been constructed and we wouldn't be here.")

+
+                               (SETFILEPTR STREAM (IMINUS CSVECTORLOC))
+                               (EQ CHARSET (BIN STREAM))
+                        else
 
+                             (* ;; "The vector-entry points to the one we want.  Is it there?")

+
+                             (SETFILEPTR STREAM (IPLUS CSVECTORLOC (UNFOLD CHARSET BYTESPERCELL)))
+                             (CL:UNLESS (EQ 0 (SETQ CSLOC (\FIXPIN STREAM)))
+                                    (SETFILEPTR STREAM CSLOC)))
+                    (MEDLEYFONT.READ.CHARSET
 STREAM CHARSET))))])
+
+(MEDLEYFONT.CHARSET?

+  [LAMBDA (FILE CHARSET)
                                     (* ; "Edited 15-Jul-2025 15:21 by rmk")


+                                                             (* ; "Edited 25-May-2025 20:53 by rmk")


+                                                             (* ; "Edited 21-May-2025 11:35 by rmk")


+                                                             (* ; "Edited 17-May-2025 11:29 by rmk")


+                                                             (* ; "Edited 14-May-2025 17:46 by rmk")

+
+    (* ;; "If CHARSET, returns CHARSET if FILE contains a non-slug entry for CHARSET.  If not CHARSET, returns the list of non-slug charsets in FILE.")

+
+    (CL:WITH-OPEN-FILE (STREAM FILE :DIRECTION :INPUT)
+           (CL:UNLESS (MEDLEYFONT.FILEP
 STREAM)
+                  (ERROR "Not a MEDLEYFONT file" FILE))
+           (LET ((CSVECTORLOC (\FIXPIN STREAM)))
+                (CL:WHEN (if
 (ILESSP CSVECTORLOC 0)
+                             then
 
+                                  (* ;; "File contains only one charse, is it the one we want? ")

+
+                                  (SETFILEPTR STREAM (IMINUS CSVECTORLOC))
+                                  (EQ CHARSET (BIN STREAM))
+                           else
 (SETFILEPTR STREAM (IPLUS CSVECTORLOC (UNFOLD CHARSET BYTESPERCELL)))
+                                (NEQ 0 (\FIXPIN STREAM)))
+                       CHARSET])
+
+(MEDLEYFONT.GETFILEPROP

+  [LAMBDA (FILE PROP)
                                        (* ; "Edited 15-Jul-2025 20:21 by rmk")


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


+                                                             (* ; "Edited 25-May-2025 20:53 by rmk")


+                                                             (* ; "Edited 21-May-2025 11:36 by rmk")


+                                                             (* ; "Edited 17-May-2025 19:07 by rmk")


+                                                             (* ; "Edited 14-May-2025 17:46 by rmk")

+    (CL:UNLESS (OR (LITATOM FILE)
+                   (STRINGP FILE))
+        [SETQ FILE (CAR (APPLY (FUNCTION FONTFILES)
+                               (FONTPROP (FONTCREATE FILE)
+                                      'SPEC])
+    (CL:WITH-OPEN-FILE (STREAM FILE :DIRECTION :INPUT)
+           (LET (HEADERPROPS CSVECTORLOC)
+                (CL:UNLESS (SETQ HEADERPROPS (MEDLEYFONT.FILEP
 STREAM))
+                    (ERROR "Not a MEDLEYFONT file" (FULLNAME STREAM)))
+                (SETQ CSVECTORLOC (\FIXPIN STREAM))
+                (SELECTQ PROP
+                    (OTHERPROPS (CDDR HEADERPROPS))
+                    (DATE (CADR HEADERPROPS))
+                    (FONTPROPS (MEDLEYFONT.READ.FONTPROPS
 STREAM))
+                    (CHARSETS (if
 (ILESSP CSVECTORLOC 0)
+                                  then
 
+                                       (* ;; "File contains only one charset ")

+
+                                       (SETFILEPTR STREAM (IMINUS CSVECTORLOC))
+                                       (CONS (BIN STREAM))
+                                else
 (SETFILEPTR STREAM CSVECTORLOC)
+                                     (for
 CS from
 0 to
 \MAXCHARSET unless
 (EQ 0 (\FIXPIN STREAM))
+                                        collect
 CS)))
+                    (ERROR "Unknown MEDLEYFONT property"])
+
+(MEDLEYFONT.FILEP

+  [LAMBDA (FILE)
                                             (* ; "Edited  6-Jul-2025 11:44 by rmk")


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


+                                                             (* ; "Edited  8-Jun-2025 22:55 by rmk")


+                                                             (* ; "Edited 25-May-2025 20:54 by rmk")


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


+                                                             (* ; "Edited 16-May-2025 21:58 by rmk")


+                                                             (* ; "Edited 14-May-2025 17:00 by rmk")

+
+    (* ;; "Me in first 2 bytes distinguishes MEDLEYFONT format from others.  This may be called after the first 2 bytes have been read to verify the %"Me%", if not we skip over it here.")

+
+    (* ;; "For a valid file, returns (fullname date)")

+
+    (* ;; "If FILE is an open stream, it is left open.  Otherwise it is opened and closed.")

+
+    (RESETLST
+        [LET (STREAM VERSION DATE)
+             [if
 (\GETSTREAM FILE 'INPUT T)
+                 then
 (SETQ STREAM FILE)
+               else
 (RESETSAVE (SETQ STREAM (OPENSTREAM FILE 'INPUT))
+                           `(PROGN (CLOSEF? OLDVALUE]
+             (CL:UNLESS (ZEROP (GETFILEPTR STREAM))
+                    (SETFILEPTR STREAM 0))
+             (CL:WHEN (for
 C in
 (CONSTANT (CHCON "Medley font")) always
 (EQ C (READCCODE STREAM)))
+                 [CAR (NLSETQ [CL:WHEN (EQ 0 (SETQ VERSION (MEDLEYFONT.READ.ITEM
 STREAM 'VERSION]
+                             `(,(FULLNAME STREAM)
+                               ,(MEDLEYFONT.READ.ITEM
 STREAM 'DATE)
+                               ,VERSION
+                               ,@(MEDLEYFONT.READ.ITEM
 STREAM 'OTHERFONTPROPS])])])
+)
+
+
+
+(* ;; "Reading")

+
+(DEFINEQ
+
+(MEDLEYFONT.READ.FONT

+  [LAMBDA (FILE CHARSETNOS FONT)
                             (* ; "Edited 15-Jul-2025 20:20 by rmk")


+                                                             (* ; "Edited  9-Jul-2025 00:06 by rmk")


+                                                             (* ; "Edited  6-Jul-2025 11:45 by rmk")

+    (CL:UNLESS FILE (SETQ FILE FONT))
+    (CL:WHEN (OR (type?
 FONTDESCRIPTOR FILE)
+                 (LISTP FILE))
+        (SETQ FILE (MEDLEYFONT.FILENAME
 FILE)))
+    (SETQ CHARSETNOS (SORT (MKLIST CHARSETNOS)))
+    (CL:WITH-OPEN-FILE (STREAM FILE :DIRECTION :INPUT)
+           (CL:UNLESS (MEDLEYFONT.FILEP
 STREAM)
+               (ERROR "NOT A MEDLEYFONT FILE" (FULLNAME STREAM)))
+           (LET ((*READTABLE* (FIND-READTABLE "INTERLISP"))
+                 FONTCHARSETVECTOR CSVECTORLOC NOTFOUND SINGLECS)
+                (SETQ CSVECTORLOC (\FIXPIN STREAM))          (* ; 
+
                                                       "Byte location of the charset dispatch vector")

+
+                (* ;; "We know now that this file has information about all requested charsets, including NIL entries for empty/slugglish ones in the middle of populated ones.  A file that would have contain a single empty/sluggish charset cannot be created--the caller would recognize the case of a missing file and provide either NIL or a slug-vector.")

+
+                (SETQ FONT (MEDLEYFONT.READ.VERIFIEDFONT
 STREAM FONT))
+                (SETQ FONTCHARSETVECTOR (fetch
 (FONTDESCRIPTOR FONTCHARSETVECTOR) of
 FONT))
+                (CL:UNLESS (EQ CSVECTORLOC 0)                (* ; "Not empty")

+                    [if
 (ILESSP CSVECTORLOC 0)
+                        then
 
+                             (* ;; 
+
  "File contains only one charset and it's the one we want. Its CHARSET number is in the first byte.")

+
+                             (* ;; "If the intended charset is empty/sluggish, the file would not have been constructed and we wouldn't be here.")

+
+                             (SETFILEPTR STREAM (IMINUS CSVECTORLOC))
+                             (SETQ SINGLECS (BIN STREAM))
+                             (CL:WHEN CHARSETNOS
+                                 (CL:UNLESS (AND (EQ SINGLECS (CAR CHARSETNOS))
+                                                 (NULL (CDR CHARSETNOS)))
+                                     (ERROR (CONCAT FILE 
+                                                   " does not contain information for charsets ÿ4ÿ"
+                                                   (REMOVE SINGLECS CHARSETNOS)))))
+                             (\SETCHARSETINFO FONTCHARSETVECTOR SINGLECS (MEDLEYFONT.READ.CHARSET

+                                                                          STREAM SINGLECS))
+                      else
 
+                           (* ;; 
+
                           "Gather all of the CSLOCS before reading, so that we always move forward")

+
+                           (for
 CSNO CSLOC
+                              in
 (OR CHARSETNOS (for
 I from
 0 to
 \MAXCHARSET collect
 I))
+                              eachtime
 (SETFILEPTR STREAM (IPLUS CSVECTORLOC (UNFOLD CSNO 
+                                                                                    BYTESPERCELL)))
+                                    (SETQ CSLOC (\FIXPIN STREAM))
+                                    (CL:WHEN (ZEROP CSLOC)
+                                           (push
 NOTFOUND CSNO)) unless
 (ZEROP CSLOC)
+                              collect
 (CONS CSNO CSLOC)
+                              finally
 (CL:WHEN (AND CHARSETNOS NOTFOUND)
+                                          (ERROR FILE (CONCAT 
+                                                        " does not contain information for charsets "
+                                                             (DREVERSE NOTFOUND))))
+                                    (for
 X CS in
 $$VAL do
 (SETQ CSNO (CAR X))
+                                                          (SETFILEPTR STREAM (CDR X))
+                                                          (\SETCHARSETINFO FONTCHARSETVECTOR CSNO
+                                                                 (MEDLEYFONT.READ.CHARSET
 STREAM CSNO
+                                                                        ])
+                FONT])
+
+(MEDLEYFONT.READ.CHARSET

+  [LAMBDA (STREAM CHARSET)
                                   (* ; "Edited 15-Jul-2025 11:27 by rmk")


+                                                             (* ; "Edited  9-Jul-2025 19:33 by rmk")


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


+                                                             (* ; "Edited 25-May-2025 20:54 by rmk")


+                                                             (* ; "Edited 23-May-2025 11:01 by rmk")


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


+                                                             (* ; "Edited 16-May-2025 20:19 by rmk")


+                                                             (* ; "Edited 14-May-2025 10:43 by rmk")


+                                                             (* ; "Edited 12-May-2025 07:55 by rmk")

+    (MEDLEYFONT.READ.ITEM
 STREAM 'CHARSETSTRING)             (* ; 
+
                                                             "Throwaway for looking with text editor")

+    (LET (CSNO INDIRECT)
+         (CL:UNLESS [EQ CHARSET (SETQ CSNO (MEDLEYFONT.READ.ITEM
 STREAM 'CHARSET]
+             (ERROR "Charset mismatch" (LIST CHARSET CSNO)))
+         (if
 [EQ 'INDIRECTCHARSET (CAR (SETQ INDIRECT (MEDLEYFONT.PEEK.ITEM
 STREAM]
+             then
                                            (* ; 
+
                                      "Read a complete charset from another file (e.g. shared Kanji)")

+                  (MEDLEYFONT.READ.ITEM
 STREAM 'INDIRECTCHARSET)
+                  (APPLY (FUNCTION \READCHARSET)
+                         (CADR INDIRECT))
+           else
 (bind
 PAIR LABEL ITEM (CSINFO _ (create
 CHARSETINFO
+                                                       WIDTHS _ NIL
+                                                       OFFSETS _ NIL)) eachtime
 (SETQ PAIR
+                                                                                 (
+
                                                                                 MEDLEYFONT.READ.ITEM

+                                                                                  STREAM))
+                                                                             (SETQ LABEL (CAR PAIR))
+                                                                             (SETQ ITEM (CADR PAIR))
+                   until
 (EQ LABEL 'STOP) do
 (SELECTQ LABEL
+                                                 (WIDTHS (replace
 (CHARSETINFO WIDTHS) of
 CSINFO
+                                                            with
 ITEM))
+                                                 (OFFSETS (replace
 (CHARSETINFO OFFSETS) of
 CSINFO
+                                                             with
 ITEM))
+                                                 (IMAGEWIDTHS (replace
 (CHARSETINFO IMAGEWIDTHS)
+                                                                 of
 CSINFO with
 ITEM))
+                                                 (YWIDTHS (replace
 (CHARSETINFO YWIDTHS) of
 CSINFO
+                                                             with
 ITEM))
+                                                 (ASCENT (replace
 (CHARSETINFO CHARSETASCENT)
+                                                            of
 CSINFO with
 ITEM))
+                                                 (DESCENT (replace
 (CHARSETINFO CHARSETDESCENT)
+                                                             of
 CSINFO with
 ITEM))
+                                                 (LEFTKERN (replace
 (CHARSETINFO LEFTKERN)
+                                                              of
 CSINFO with
 ITEM))
+                                                 (BITMAP (replace
 (CHARSETINFO CHARSETBITMAP)
+                                                            of
 CSINFO with
 ITEM))
+                                                 (CSINFOPROPS (replace
 (CHARSETINFO CSINFOPROPS)
+                                                                 of
 CSINFO with
 ITEM))
+                                                 (CSCOMPLETEP (replace
 (CHARSETINFO CSCOMPLETEP)
+                                                                 of
 CSINFO with
 ITEM))
+                                                 (HELP "Unrecognized charsetinfo label'" LABEL))
+                   finally
 (CL:UNLESS (fetch
 (CHARSETINFO IMAGEWIDTHS) of
 CSINFO)
+                               (replace
 (CHARSETINFO IMAGEWIDTHS) of
 CSINFO
+                                  with
 (fetch
 (CHARSETINFO WIDTHS) of
 CSINFO)))
+                         (RETURN CSINFO])
+
+(MEDLEYFONT.READ.ITEM

+  [LAMBDA (STREAM LABEL?)
                                    (* ; "Edited 27-Jul-2025 22:22 by rmk")


+                                                             (* ; "Edited 24-Jul-2025 22:07 by rmk")


+                                                             (* ; "Edited 14-Jul-2025 15:47 by rmk")

+
+    (* ;; "Reads and returns the (label data) that starts at the current position in STREAM according to its storage type.  If LABEL? is provided, error if the data read does not have that label. ")

+
+    (LET
+     [(ITEM (GETSTREAMPROP STREAM 'MEDLEYFONT.PEEKEDITEM]
+     (if
 ITEM
+         then
 (PUTSTREAMPROP STREAM 'MEDLEYFONT.PEEKEDITEM NIL)
+       else
 (LET ((*READTABLE* (FIND-READTABLE 'INTERLISP))
+                  (*PACKAGE* (CL:FIND-PACKAGE 'INTERLISP))
+                  LABEL NELTS)
+                 (SETQ LABEL (RATOM STREAM))
+                 (READCCODE STREAM)
+                 [SETQ ITEM
+                  (LIST LABEL (SELECTC (BIN STREAM)
+                                  (SMALLPDATA (\WIN STREAM))
+                                  (FIXPDATA (\FIXPIN STREAM))
+                                  (PRINTDATA (READ STREAM))
+                                  (ALISTDATA (bind
 X until
 [EQ 'STOP (CAR (SETQ X (
+
                                                                                 MEDLEYFONT.READ.ITEM

+                                                                                   STREAM]
+                                                collect
 (CONS (CAR X)
+                                                              (CADR X))))
+                                  (PLISTDATA (bind
 X until
 [EQ 'STOP (CAR (SETQ X (
+
                                                                                 MEDLEYFONT.READ.ITEM

+                                                                                   STREAM]
+                                                join
 X))
+                                  (LISTDATA (bind
 ELT until
 [EQ 'STOP (CAR (SETQ ELT (
+
                                                                                 MEDLEYFONT.READ.ITEM

+                                                                                      STREAM]
+                                               collect
 (CADR ELT)
+                                               finally
 (CL:WHEN (CADR ELT)
+                                                              (NCONC $$VAL ELT))))
+                                  (BITMAPDATA (\READBINARYBITMAP STREAM))
+                                  (CLARRAYDATA (LET [[ARRAY (CL:MAKE-ARRAY (READ STREAM)
+                                                                   :ELEMENT-TYPE
+                                                                   (MEDLEYFONT.READ.ITEM
 STREAM
+                                                                          'ELEMENT-TYPE]
+                                                     (ALLFIXED (EQ 1 (BIN STREAM]
+                                                    (for
 I from
 0 to
 (\FIXPIN STREAM)
+                                                       do
 [CL:SETF (XCL:ROW-MAJOR-AREF ARRAY I)
+                                                                 (CL:IF ALLFIXED
+                                                                     (\FIXPIN STREAM)
+                                                                     (CADR (MEDLEYFONT.READ.ITEM

+                                                                            STREAM)))]
+                                                       finally
 (RETURN ARRAY))))
+                                  (ILPOINTERARRAY 
+                                       (LET [(NELTS (\FIXPIN STREAM))
+                                             (ORIG (BIN STREAM))
+                                             (ALLFIXED (EQ 1 (BIN STREAM]
+                                            (for
 I (ARRAY _ (ARRAY NELTS NIL NIL ORIG)) from
 ORIG
+                                               to
 (CL:IF (EQ ORIG 1)
+                                                      NELTS
+                                                      (SUB1 NELTS))
+                                               do
 (SETA ARRAY I (CL:IF ALLFIXED
+                                                                    (\FIXPIN STREAM)
+                                                                    (MEDLEYFONT.READ.ITEM
 STREAM I)))
+                                               finally
 (RETURN ARRAY))))
+                                  (ILNUMBERARRAY (LET ((NELTS (\FIXPIN STREAM))
+                                                       (ORIG (BIN STREAM)))
+                                                      (AIN (ARRAY NELTS (MEDLEYFONT.READ.ITEM

+                                                                         STREAM
+                                                                         'ARRAYTYP)
+                                                                  NIL ORIG)
+                                                           ORIG NELTS STREAM)))
+                                  (WORDBLOCKDATA (LET* [(NWORDS (\FIXPIN STREAM))
+                                                        (BLOCK (\ALLOCBLOCK (FOLDHI NWORDS 
+                                                                                   WORDSPERCELL]
+                                                       (\BINS STREAM BLOCK 0 (UNFOLD NWORDS 
+                                                                                    BYTESPERWORD))
+                                                       BLOCK))
+                                  (HPRINTDATA (HREAD STREAM))
+                                  (SHOULDNT "UNKNOWN MEDLEYFONT DATA TYPE"]
+                                                             (* ; "Skip the EOL")

+                 (READCCODE STREAM)))
+     (CL:WHEN (AND LABEL? (NEQ LABEL? (CAR ITEM)))
+         (ERROR (CONCAT LABEL? " item not found")
+                ITEM))
+     (CL:IF LABEL?
+         (CADR ITEM)
+         ITEM)])
+
+(MEDLEYFONT.PEEK.ITEM

+  [LAMBDA (STREAM LABEL?)
                                    (* ; "Edited  6-Jul-2025 14:10 by rmk")

+
+    (* ;; "If previously peeked and not read, returns that item.  Otherwise calls the reader to get the new item. We always record the (LABEL DATA pair)")

+
+    (LET [(PEEKEDITEM (GETSTREAMPROP STREAM 'MEDLEYFONT.PEEKEDITEM]
+         (CL:UNLESS PEEKEDITEM
+             (PUTSTREAMPROP STREAM 'MEDLEYFONT.PEEKEDITEM (SETQ PEEKEDITEM (MEDLEYFONT.READ.ITEM

+                                                                            STREAM))))
+         (CL:WHEN (AND LABEL? (NEQ LABEL? (CAR PEEKEDITEM)))
+             (ERROR (CONCAT "Peeked " (CAR PEEKEDITEM)
+                           " instead of " LABEL?)
+                    PEEKEDITEM))
+         (CL:IF LABEL?
+             (CADR PEEKEDITEM)
+             PEEKEDITEM)])
+
+(MEDLEYFONT.READ.FONTPROPS

+  [LAMBDA (STREAM)
                                           (* ; "Edited 25-May-2025 20:55 by rmk")


+                                                             (* ; "Edited 16-May-2025 21:58 by rmk")


+                                                             (* ; "Edited 14-May-2025 09:11 by rmk")

+    (bind
 PAIR until
 [EQ 'STOP (CAR (SETQ PAIR (MEDLEYFONT.READ.ITEM
 STREAM] collect
 PAIR])
+
+(MEDLEYFONT.READ.VERIFIEDFONT

+  [LAMBDA (STREAM FONT)
                                      (* ; "Edited 10-Jun-2025 20:57 by rmk")


+                                                             (* ; "Edited 21-May-2025 22:55 by rmk")


+                                                             (* ; "Edited 19-May-2025 17:42 by rmk")


+                                                             (* ; "Edited 16-May-2025 10:28 by rmk")

+    (LET ((FONTPROPS (MEDLEYFONT.READ.FONTPROPS
 STREAM)))
+         [if
 FONT
+             then
                                            (* ; "compare/verify")

+                  (for
 P in
 FONTPROPS unless
 (EQUAL (CADR P)
+                                                    (RECORDACCESS (CAR P)
+                                                           FONT NIL 'FETCH))
+                     do
 (ERROR "Mismatching font property" P))
+           else
 (SETQ FONT (create
 FONTDESCRIPTOR))          (* ; "Construct")

+                (for
 P VAL in
 FONTPROPS do
 (SETQ VAL (CADR P))
+                                           (SELECTQ (CAR P)
+                                               (FONTDEVICE (replace
 (FONTDESCRIPTOR FONTDEVICE)
+                                                              of
 FONT with
 VAL))
+                                               (FONTCOMPLETEP (replace
 (FONTDESCRIPTOR FONTCOMPLETEP)
+                                                                 of
 FONT with
 VAL))
+                                               (FONTFAMILY (replace
 (FONTDESCRIPTOR FONTFAMILY)
+                                                              of
 FONT with
 VAL))
+                                               (FONTSIZE (replace
 (FONTDESCRIPTOR FONTSIZE)
+                                                            of
 FONT with
 VAL))
+                                               (FONTFACE (replace
 (FONTDESCRIPTOR FONTFACE)
+                                                            of
 FONT with
 VAL))
+                                               (\SFAscent (replace
 (FONTDESCRIPTOR \SFAscent)
+                                                             of
 FONT with
 VAL))
+                                               (\SFDescent (replace
 (FONTDESCRIPTOR \SFDescent)
+                                                              of
 FONT with
 VAL))
+                                               (\SFHeight (replace
 (FONTDESCRIPTOR \SFHeight)
+                                                             of
 FONT with
 VAL))
+                                               (ROTATION (replace
 (FONTDESCRIPTOR ROTATION)
+                                                            of
 FONT with
 VAL))
+                                               (FONTDEVICESPEC 
+                                                    (replace
 (FONTDESCRIPTOR FONTDEVICESPEC)
+                                                       of
 FONT with
 VAL))
+                                               (OTHERDEVICEFONTPROPS 
+                                                    (replace
 (FONTDESCRIPTOR OTHERDEVICEFONTPROPS)
+                                                       of
 FONT with
 VAL))
+                                               (FONTSCALE (replace
 (FONTDESCRIPTOR FONTSCALE)
+                                                             of
 FONT with
 VAL))
+                                               (\SFFACECODE (replace
 (FONTDESCRIPTOR \SFFACECODE)
+                                                               of
 FONT with
 VAL))
+                                               (FONTAVGCHARWIDTH 
+                                                    (replace
 (FONTDESCRIPTOR FONTAVGCHARWIDTH)
+                                                       of
 FONT with
 VAL))
+                                               (FONTCHARENCODING 
+                                                    (replace
 (FONTDESCRIPTOR FONTCHARENCODING)
+                                                       of
 FONT with
 VAL))
+                                               (FONTCHARSETVECTOR 
+                                                    (replace
 (FONTDESCRIPTOR FONTCHARSETVECTOR)
+                                                       of
 FONT with
 VAL))
+                                               (FONTHASLEFTKERNS 
+                                                    (replace
 (FONTDESCRIPTOR FONTHASLEFTKERNS)
+                                                       of
 FONT with
 VAL))
+                                               (FONTEXTRAFIELD2 
+                                                    (replace
 (FONTDESCRIPTOR FONTEXTRAFIELD2)
+                                                       of
 FONT with
 VAL))
+                                               (HELP "UNKNOWN FONTDESCRIPTOR PROPERTY: P"]
+         FONT])
+)
+
+
+
+(* ;; "Writing")

+
+(DEFINEQ
+
+(MEDLEYFONT.WRITE.CHARSET

+  [LAMBDA (FONT CHARSET STREAM NOINDIRECTS)
                  (* ; "Edited  9-Jul-2025 19:14 by rmk")


+                                                             (* ; "Edited 25-May-2025 20:49 by rmk")


+                                                             (* ; "Edited 22-May-2025 09:58 by rmk")


+                                                             (* ; "Edited 16-May-2025 20:18 by rmk")


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

+
+    (* ;; "This outputs the characterset info for CHARSET in FONT.")

+
+    (LET ((CSINFO (\INSURECHARSETINFO CHARSET FONT))
+          CSCHARENCODING)
+         (MEDLEYFONT.WRITE.ITEM
 STREAM 'CHARSETSTRING (MKSTRING CHARSET))
+                                                             (* ; "For human file-scan")

+         (MEDLEYFONT.WRITE.ITEM
 STREAM 'CHARSET CHARSET)
+         (CL:UNLESS (OR (NULL CSINFO)
+                        (fetch
 (CHARSETINFO CSSLUGP) of
 CSINFO))
+                                                             (* ; 
+
                                                         "Slug info is determined by FONT properties")

+
+             (* ;; "Copy the fonts charencoding down to each charset info so that it is available when the charsetinfo is read.  The fontdescriptor isn't available at that point and coercion could lead to fonts of different encodings.  At least this would make it possible to fix things up.")

+
+             (if
 (CL:UNLESS NOINDIRECTS (INDIRECTCHARSETP CSINFO FONT CHARSET))
+                 then
 
+                      (* ;; 
+
           "This charset is is taken entirely from on another file, no need to copy it to this file.")

+
+                      (MEDLEYFONT.WRITE.ITEM
 STREAM 'INDIRECTCHARSET (GETMULTI (fetch
 (CHARSETINFO
+                                                                                       CSINFOPROPS)
+                                                                                  of
 CSINFO)
+                                                                            'SOURCE)
+                             NIL
+                             'PRINT)
+               else
 (MEDLEYFONT.WRITE.ITEM
 STREAM 'CSINFOPROPS (fetch
 (CHARSETINFO CSINFOPROPS)
+                                                                  of
 CSINFO)
+                           NIL
+                           'ALIST)
+                    (MEDLEYFONT.WRITE.ITEM
 STREAM 'WIDTHS (fetch
 (CHARSETINFO WIDTHS) of
 CSINFO))
+                    (CL:UNLESS [OR (EQ (fetch
 (CHARSETINFO IMAGEWIDTHS) of
 CSINFO)
+                                       (fetch
 (CHARSETINFO WIDTHS) of
 CSINFO))
+                                   (for
 I (W _ (fetch
 (CHARSETINFO WIDTHS) of
 CSINFO))
+                                        (IM _ (fetch
 (CHARSETINFO IMAGEWIDTHS) of
 CSINFO))
+                                      from
 0 to
 (SUB1 (IPLUS \MAXTHINCHAR 3))
+                                      always
 (EQ (\GETBASE W I)
+                                                 (\GETBASE IM I]
+                        (MEDLEYFONT.WRITE.ITEM
 STREAM 'IMAGEWIDTHS (fetch
 (CHARSETINFO IMAGEWIDTHS)
+                                                                      of
 CSINFO)))
+                    (MEDLEYFONT.WRITE.ITEM
 STREAM 'OFFSETS (fetch
 (CHARSETINFO OFFSETS) of
 CSINFO))
+                    (MEDLEYFONT.WRITE.ITEM
 STREAM 'YWIDTHS (fetch
 (CHARSETINFO YWIDTHS) of
 CSINFO))
+                    (MEDLEYFONT.WRITE.ITEM
 STREAM 'ASCENT (fetch
 (CHARSETINFO CHARSETASCENT)
+                                                             of
 CSINFO))
+                    (MEDLEYFONT.WRITE.ITEM
 STREAM 'DESCENT (fetch
 (CHARSETINFO CHARSETDESCENT)
+                                                              of
 CSINFO))
+                    (MEDLEYFONT.WRITE.ITEM
 STREAM 'LEFTKERN (fetch
 (CHARSETINFO LEFTKERN)
+                                                               of
 CSINFO))
+                    (MEDLEYFONT.WRITE.ITEM
 STREAM 'BITMAP (fetch
 (CHARSETINFO CHARSETBITMAP)
+                                                             of
 CSINFO))
+                    (MEDLEYFONT.WRITE.ITEM
 STREAM 'CSCOMPLETEP (fetch
 (CHARSETINFO CSCOMPLETEP)
+                                                                  of
 CSINFO))
+                    (MEDLEYFONT.WRITE.ITEM
 STREAM 'STOP T)))])
+
+(MEDLEYFONT.WRITE.ITEM

+  [LAMBDA (STREAM LABEL ITEM EVENIFNIL TYPE BLOCKNELTS)
      (* ; "Edited 24-Jul-2025 22:07 by rmk")


+                                                             (* ; "Edited 15-Jul-2025 11:06 by rmk")


+                                                             (* ; "Edited  8-Jul-2025 23:03 by rmk")


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


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


+                                                             (* ; "Edited 25-May-2025 20:48 by rmk")


+                                                             (* ; "Edited 23-May-2025 10:58 by rmk")


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


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


+                                                             (* ; "Edited 14-May-2025 00:07 by rmk")

+
+    (* ;; "Writes ITEM preceded by LABEL.    BLOCKNELTS overrides the default for array blocks, because of the uncertainty/complexity in determining arrayblock length.")

+
+    (LET [(*READTABLE* (FIND-READTABLE 'INTERLISP))
+          (*PACKAGE* (CL:FIND-PACKAGE 'INTERLISP]
+         (CL:WHEN (OR ITEM EVENIFNIL)
+             (PRIN2 LABEL STREAM)
+             (PRIN1 " " STREAM)
+             (SELECTQ (OR TYPE (TYPENAME ITEM))
+                 (SMALLP (BOUT STREAM SMALLPDATA)
+                         (\WOUT STREAM ITEM))
+                 (FIXP                                       (* ; "Must come after SMALLP")

+                       (BOUT STREAM FIXPDATA)
+                       (\FIXPOUT STREAM ITEM))
+                 ((LITATOM STRINGP PRINT) 
+                      (BOUT STREAM PRINTDATA)                (* ; 
+
                                                   "A printable Lisp object, even some lists (below)")

+                      (PRIN2 ITEM STREAM))
+                 (LISTP [if
 (for
 TAIL on
 ITEM always
 (ATOM (CAR TAIL))
+                               finally
 
+
+                                     (* ;; "Check the final CDR.")

+
+                                     (CL:UNLESS (ATOM TAIL)
+                                            (RETURN NIL)))
+                            then
 (BOUT STREAM PRINTDATA)     (* ; "More compact for simple lists.")

+                                 (PRIN2 ITEM STREAM)
+                          else
 (BOUT STREAM LISTDATA)
+                               (for
 TAIL on
 ITEM as
 I from
 1 do
 (MEDLEYFONT.WRITE.ITEM
 STREAM I
+                                                                       (CAR TAIL)
+                                                                       T)
+                                                                (CL:UNLESS (LISTP (CDR TAIL))
+                                                                    (MEDLEYFONT.WRITE.ITEM

+                                                                     STREAM
+                                                                     'STOP
+                                                                     (CDR TAIL)
+                                                                     T)
+                                                                    (RETURN))])
+                 (ALIST 
+                        (* ;; 
+
                    " This could be done as LISTDATA, but this way it uses the alist keys as labels.")

+
+                        (BOUT STREAM ALISTDATA)
+                        (for
 X KEY in
 ITEM do
 (SETQ KEY (CAR X))
+                                              (CL:UNLESS (OR (LITATOM KEY)
+                                                             (SMALLP KEY))
+                                                     (ERROR "NOT AN ALIST" ITEM))
+                                              (MEDLEYFONT.WRITE.ITEM
 STREAM KEY (CDR X)
+                                                     EVENIFNIL))
+                        (MEDLEYFONT.WRITE.ITEM
 STREAM 'STOP T))
+                 (PLIST (BOUT STREAM PLISTDATA)
+                        (for
 DTAIL KEY on
 ITEM by
 (CDDR DTAIL)
+                           do
 (SETQ KEY (CAR DTAIL))
+                              (CL:UNLESS (OR (LITATOM KEY)
+                                             (SMALLP KEY))
+                                     (ERROR "NOT A PLIST" ITEM))
+                              (MEDLEYFONT.WRITE.ITEM
 STREAM KEY (CADR DTAIL)
+                                     EVENIFNIL))
+                        (MEDLEYFONT.WRITE.ITEM
 STREAM 'STOP T))
+                 (BITMAP (BOUT STREAM BITMAPDATA)
+                         (\PRINTBINARYBITMAP ITEM STREAM))
+                 ((ONED-ARRAY TWOD-ARRAY GENERAL-ARRAY)      (* ; 
+
                                                             "Note: can't be used in MAKEINIT fonts")

+                      (BOUT STREAM CLARRAYDATA)
+                      (PRIN2 (CL:ARRAY-DIMENSIONS ITEM)
+                             STREAM)                         (* ; "A list, READ's OK")

+                      (MEDLEYFONT.WRITE.ITEM
 STREAM 'ELEMENT-TYPE (CL:ARRAY-ELEMENT-TYPE ITEM))
+                      (for
 I ALLFIXED ELT from
 0 to
 (SUB1 (CL:ARRAY-TOTAL-SIZE ITEM))
+                         first
 [SETQ ALLFIXED (for
 I from
 0 to
 (SUB1 (CL:ARRAY-TOTAL-SIZE ITEM))
+                                                 always
 (FIXP (XCL:ROW-MAJOR-AREF ITEM I]
+                               (BOUT STREAM (CL:IF ALLFIXED
+                                                1
+                                                0))
+                               (\FIXPOUT STREAM (SUB1 (CL:ARRAY-TOTAL-SIZE ITEM)))
+                         do
 (SETQ ELT (XCL:ROW-MAJOR-AREF ITEM I))
+                            (CL:IF ALLFIXED
+                                (\FIXPOUT STREAM ELT)
+                                (MEDLEYFONT.WRITE.ITEM
 STREAM I ELT T))))
+                 (ARRAYP (if
 (EQ 'POINTER (ARRAYTYP ITEM))
+                             then
 (BOUT STREAM ILPOINTERARRAY)
+                                  (\FIXPOUT STREAM (ARRAYSIZE ITEM))
+                                  (BOUT STREAM (ARRAYORIG ITEM))
+                                  (for
 I ALLFIXED from
 (ARRAYORIG ITEM)
+                                     to
 (IPLUS (ARRAYORIG ITEM)
+                                               (SUB1 (ARRAYSIZE ITEM)))
+                                     first
 [SETQ ALLFIXED (for
 I from
 (ARRAYORIG ITEM)
+                                                             to
 (IPLUS (ARRAYORIG ITEM)
+                                                                       (SUB1 (ARRAYSIZE ITEM)))
+                                                             always
 (FIXP (ELT ITEM I]
+                                           (BOUT STREAM (CL:IF ALLFIXED
+                                                            1
+                                                            0))
+                                     do
 
+                                        (* ;; "Don't need to do the item recursion if all integers")

+
+                                        (CL:IF ALLFIXED
+                                            (\FIXPOUT STREAM (ELT ITEM I))
+                                            (MEDLEYFONT.WRITE.ITEM
 STREAM I (ELT ITEM I)
+                                                   T)))
+                           else
 (BOUT STREAM ILNUMBERARRAY)
+                                (\FIXPOUT STREAM (ARRAYSIZE ITEM))
+                                (BOUT STREAM (ARRAYORIG ITEM))
+                                (MEDLEYFONT.WRITE.ITEM
 STREAM 'ARRAYTYP (ARRAYTYP ITEM))
+                                (AOUT ITEM (ARRAYORIG ITEM)
+                                      (ARRAYSIZE ITEM)
+                                      STREAM)))
+                 (if
 (\BLOCKDATAP ITEM)
+                     then
 
+                          (* ;; "This assumes word-element blocks. We can distinguish pointer blocks (from the DTD, see BLOCKEQUALP), caller would have to tell us (a different TYPE?) whether we are looking at full integer or word blocks--how to interpret NELTS")

+
+                          (BOUT STREAM WORDBLOCKDATA)
+                          (CL:UNLESS BLOCKNELTS              (* ; "Why 3 ?")

+                              (SETQ BLOCKNELTS (IPLUS \MAXTHINCHAR 3)))
+                          (\FIXPOUT STREAM BLOCKNELTS)
+                          (\BOUTS STREAM ITEM 0 (UNFOLD BLOCKNELTS BYTESPERWORD))
+                   else
 (BOUT STREAM HPRINTDATA)             (* ; "A datatype?")

+                        (HPRINT ITEM STREAM T T)))
+
+             (* ;; "Terpri to make sure ratom is OK, also looks better")

+
+             (TERPRI STREAM))])
+
+(MEDLEYFONT.WRITE.FONTPROPS

+  [LAMBDA (STREAM FONT)
                                      (* ; "Edited 10-Jun-2025 20:50 by rmk")


+                                                             (* ; "Edited 25-May-2025 20:50 by rmk")


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


+                                                             (* ; "Edited 19-May-2025 10:42 by rmk")


+                                                             (* ; "Edited 14-May-2025 17:26 by rmk")

+
+    (* ;; "RECORDFIELDACCESS would be more succinct but would depend on runtime availability of the record.  If the record changes, this and the reader have to be updated.")

+
+    (* ;; "HPRINT would be obvious, but it would get charsetvector etc.")

+
+    (* ;; "Exclude FONTCHARSETVECTOR and \SFFACECODE")

+
+    (* ;; "Write even NIL values for default overerides")

+
+    (MEDLEYFONT.WRITE.ITEM
 STREAM 'FONTDEVICE (fetch
 (FONTDESCRIPTOR FONTDEVICE) of
 FONT)
+           T)
+    (MEDLEYFONT.WRITE.ITEM
 STREAM 'FONTCOMPLETEP (fetch
 (FONTDESCRIPTOR FONTCOMPLETEP) of
 FONT)
+           T)
+    (MEDLEYFONT.WRITE.ITEM
 STREAM 'FONTFAMILY (fetch
 (FONTDESCRIPTOR FONTFAMILY) of
 FONT)
+           T)
+    (MEDLEYFONT.WRITE.ITEM
 STREAM 'FONTSIZE (fetch
 (FONTDESCRIPTOR FONTSIZE) of
 FONT)
+           T)
+    (MEDLEYFONT.WRITE.ITEM
 STREAM 'FONTFACE (fetch
 (FONTDESCRIPTOR FONTFACE) of
 FONT)
+           T)
+    (MEDLEYFONT.WRITE.ITEM
 STREAM '\SFAscent (fetch
 (FONTDESCRIPTOR \SFAscent) of
 FONT)
+           T)
+    (MEDLEYFONT.WRITE.ITEM
 STREAM '\SFDescent (fetch
 (FONTDESCRIPTOR \SFDescent) of
 FONT)
+           T)
+    (MEDLEYFONT.WRITE.ITEM
 STREAM '\SFHeight (fetch
 (FONTDESCRIPTOR \SFHeight) of
 FONT)
+           T)
+    (MEDLEYFONT.WRITE.ITEM
 STREAM 'ROTATION (fetch
 (FONTDESCRIPTOR ROTATION) of
 FONT)
+           T)
+    (MEDLEYFONT.WRITE.ITEM
 STREAM 'FONTDEVICESPEC (fetch
 (FONTDESCRIPTOR FONTDEVICESPEC) of
 FONT)
+           T)
+    (MEDLEYFONT.WRITE.ITEM
 STREAM 'OTHERDEVICEFONTPROPS (fetch
 (FONTDESCRIPTOR OTHERDEVICEFONTPROPS)
+                                                           of
 FONT)
+           T)
+    (MEDLEYFONT.WRITE.ITEM
 STREAM 'FONTSCALE (fetch
 (FONTDESCRIPTOR FONTSCALE) of
 FONT)
+           T)
+    (MEDLEYFONT.WRITE.ITEM
 STREAM 'FONTAVGCHARWIDTH (fetch
 (FONTDESCRIPTOR FONTAVGCHARWIDTH)
+                                                       of
 FONT)
+           T)
+    (MEDLEYFONT.WRITE.ITEM
 STREAM 'FONTCHARENCODING (fetch
 (FONTDESCRIPTOR FONTCHARENCODING)
+                                                       of
 FONT)
+           T)
+    (MEDLEYFONT.WRITE.ITEM
 STREAM 'FONTHASLEFTKERNS (fetch
 (FONTDESCRIPTOR FONTHASLEFTKERNS)
+                                                       of
 FONT)
+           T)
+    (MEDLEYFONT.WRITE.ITEM
 STREAM 'FONTEXTRAFIELD2 (fetch
 (FONTDESCRIPTOR FONTEXTRAFIELD2)
+                                                      of
 FONT)
+           T)
+    (MEDLEYFONT.WRITE.ITEM
 STREAM 'STOP T])
+
+(MEDLEYFONT.WRITE.HEADER

+  [LAMBDA (STREAM OTHERFONTPROPS)
                            (* ; "Edited 25-May-2025 20:51 by rmk")


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


+                                                             (* ; "Edited 14-May-2025 17:01 by rmk")

+
+    (* ;; "Me in first 2 bytes distinguishes MEDLEYFONT format from others")

+
+    (PRINTOUT STREAM "Medley font" T)
+    (MEDLEYFONT.WRITE.ITEM
 STREAM 'VERSION 0)
+    (MEDLEYFONT.WRITE.ITEM
 STREAM 'DATE (DATE))
+    (MEDLEYFONT.WRITE.ITEM
 STREAM 'OTHERFONTPROPS OTHERFONTPROPS T])
+)
+(DEFINEQ
+
+(MEDLEYFONT.FILENAME

+  [LAMBDA (FONT CHARSET EXTENSION FILE)
                      (* ; "Edited 10-Jun-2025 11:02 by rmk")


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


+                                                             (* ; "Edited 19-May-2025 17:42 by rmk")


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

+
+    (* ;; "If EXTENSION and FILE are NIL, puts the file in the MEDLEYDIR fonts/medley[device]fonts/ directory with extension MEDLEY[device]FONT.  If CHARSET, goes in the CHARSET subdirectory.")

+
+    (CL:WHEN (AND (LISTP CHARSET)
+                  (NULL (CDR CHARSET)))
+        (SETQ CHARSET (CAR CHARSET)))
                        (* ; "Edited 14-May-2025 12:02 by rmk")

+    (LET (FAMILY SIZE FACE DEVICE FILENAME)
+         [if
 (LISTP FONT)
+             then
 (SETQ FAMILY (CAR FONT))
+                  (SETQ SIZE (CADR FONT))
+                  (SETQ FACE (OR (CADDR FONT)
+                                 'MRR))
+                  (SETQ DEVICE (OR (CADDDR FONT)
+                                   'DISPLAY))
+           elseif
 (type?
 FONTDESCRIPTOR FONT)
+             then
 (SETQ FAMILY (FONTPROP FONT 'FAMILY))
+                  (SETQ SIZE (FONTPROP FONT 'SIZE))
+                  (SETQ FACE (FONTPROP FONT 'FACE))
+                  (SETQ DEVICE (FONTPROP FONT 'DEVICE]
+         (CL:WHEN (LISTP FACE)
+             (SETQ FACE (CONCAT (NTHCHAR (CAR FACE)
+                                       1)
+                               (NTHCHAR (CADR FACE)
+                                      1)
+                               (NTHCHAR (CADDR FACE)
+                                      1))))
+         (CL:UNLESS EXTENSION
+             (SETQ EXTENSION (CONCAT "MEDLEY" (U-CASE DEVICE)
+                                    "FONT"))
+             (CL:UNLESS FILE
+                 [SETQ FILE (PSEUDOFILENAME (MEDLEYDIR (CONCAT "fonts/" (L-CASE EXTENSION)
+                                                              "s"]))
+         (SETQ FILENAME (PACK* FAMILY (CL:IF (ILEQ SIZE 9)
+                                          "0"
+                                          "")
+                               SIZE "-" FACE (CL:IF (SMALLP CHARSET)
+                                                 (CONCAT "-C" (OCTALSTRING CHARSET))
+                                                 "")
+                               "." EXTENSION))
+         (PACKFILENAME 'BODY FILE 'BODY FILENAME])
+)
+
+(ADDTOVAR DISPLAYFONTEXTENSIONS
 MEDLEYDISPLAYFONT)
+
+(ADDTOVAR DISPLAYCHARSETFNS
 (MEDLEYFONT MEDLEYFONT.FILEP MEDLEYFONT.GETCHARSET))
+
+(ADDTOVAR INTERPRESSFONTEXTENSIONS
 MEDLEYINTERPRESSFONT)
+(DECLARE%: EVAL@COMPILE DONTCOPY 
+(DECLARE%: EVAL@COMPILE 
+
+(RPAQQ PRINTDATA
 0)
+
+(RPAQQ SMALLPDATA
 1)
+
+(RPAQQ BITMAPDATA
 2)
+
+(RPAQQ WORDBLOCKDATA
 3)
+
+(RPAQQ CLARRAYDATA
 4)
+
+(RPAQQ FIXPDATA
 5)
+
+(RPAQQ ILPOINTERARRAY
 6)
+
+(RPAQQ ILNUMBERARRAY
 11)
+
+(RPAQQ HPRINTDATA
 7)
+
+(RPAQQ ALISTDATA
 8)
+
+(RPAQQ PLISTDATA
 9)
+
+(RPAQQ LISTDATA
 10)
+
+
+(CONSTANTS (PRINTDATA 0)
+       (SMALLPDATA 1)
+       (BITMAPDATA 2)
+       (WORDBLOCKDATA 3)
+       (CLARRAYDATA 4)
+       (FIXPDATA 5)
+       (ILPOINTERARRAY 6)
+       (ILNUMBERARRAY 11)
+       (HPRINTDATA 7)
+       (ALISTDATA 8)
+       (PLISTDATA 9)
+       (LISTDATA 10))
+)
+)
+(DECLARE%: DONTCOPY
+  (FILEMAP (NIL (2127 14772 (MEDLEYFONT.WRITE.FONT 2137 . 6995) (MEDLEYFONT.GETCHARSET 6997 . 9296) (
+MEDLEYFONT.CHARSET? 9298 . 10767) (MEDLEYFONT.GETFILEPROP 10769 . 12804) (MEDLEYFONT.FILEP 12806 . 
+14770)) (14798 36689 (MEDLEYFONT.READ.FONT 14808 . 19241) (MEDLEYFONT.READ.CHARSET 19243 . 24137) (
+MEDLEYFONT.READ.ITEM 24139 . 30288) (MEDLEYFONT.PEEK.ITEM 30290 . 31152) (MEDLEYFONT.READ.FONTPROPS 
+31154 . 31619) (MEDLEYFONT.READ.VERIFIEDFONT 31621 . 36687)) (36715 54244 (MEDLEYFONT.WRITE.CHARSET 
+36725 . 41330) (MEDLEYFONT.WRITE.ITEM 41332 . 50385) (MEDLEYFONT.WRITE.FONTPROPS 50387 . 53589) (
+MEDLEYFONT.WRITE.HEADER 53591 . 54242)) (54245 56814 (MEDLEYFONT.FILENAME 54255 . 56812)))))
+STOP