Fix MANAGER Warnings issued at load time. (#2440)

Don't remember why, probably to make sure that the (create STREAM) tracks that declaration.

library/MAIKOCOLOR

@@ -1,21 +1,13 @@
 (DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
 
-
(FILECREATED "26-Oct-2021 10:53:57" {DSK}<home>larry>medley>library>MAIKOCOLOR.;2
 60141  
+
(FILECREATED "30-Dec-2025 14:53:37" {WMEDLEY}<library>MAIKOCOLOR.;3
 58803  
 
-      changes to%:  (VARS MAIKOCOLORCOMS)
-                    (MACROS \MAIKO.CGTHREEP \MAIKO.CGFOURP \MAIKO.CGSIXP \MAIKO.CGTWOP)
-                    (FNS \MAIKO.COLORINIT \MAIKO.STARTCOLOR \MAIKO.STOPCOLOR \MAIKOCOLOR.EVENTFN 
-                         \MAIKO.SENDCOLORMAPENTRY \MAIKO.CHANGESCREEN CURSOREXIT CURSORSCREEN 
-                         WARPCURSOR \SLOWBLTCHAR \SOFTCURSORUP \BITBLT.DISPLAY \PUNT.SLOWBLTCHAR 
-                         \PUNT.BLTSHADE.BITMAP \PUNT.BITBLT.BITMAP BITMAPOBJ.SNAPW \MAIKO.PUNTBLTCHAR
-                         \MAIKO.BLTCHAR)
+      :EDIT-BY rmk
 
-      previous date%: "23-Oct-91 14:43:35" {DSK}<home>larry>medley>library>MAIKOCOLOR.;1)
+      :CHANGES-TO (VARS MAIKOCOLORCOMS)
 
+      :PREVIOUS-DATE "26-Oct-2021 10:53:57" {WMEDLEY}<library>MAIKOCOLOR.;2)
 
-(* ; "
-Copyright (c) 1988-1991 by Fuji Xerox Co., Ltd..
-")
 
 (PRETTYCOMPRINT MAIKOCOLORCOMS)
 
@@ -29,7 +21,7 @@ Copyright (c) 1988-1991 by Fuji Xerox Co., Ltd..
              \MAIKO.SENDCOLORMAPENTRY \MAIKO.CHANGESCREEN)
         (FNS CURSOREXIT CURSORSCREEN WARPCURSOR \SLOWBLTCHAR \SOFTCURSORUP \BITBLT.DISPLAY)
                                                              (* ; 
-
                                            "these FNS defs. will be moved to original files,later")

+
                                              "these FNS defs. will be moved to original files,later")

         (FNS \PUNT.SLOWBLTCHAR \MAIKO.PUNTBLTCHAR \MAIKO.BLTCHAR)
         (FNS \PUNT.BLTSHADE.BITMAP \PUNT.BITBLT.BITMAP)
         (FNS BITMAPOBJ.SNAPW)
@@ -47,7 +39,7 @@ Copyright (c) 1988-1991 by Fuji Xerox Co., Ltd..
         (GLOBALVARS MAIKOCOLOR.BITSPERPIXEL)
         (FILES COLOR BIGBITMAPS)
         (DECLARE%: DONTEVAL@LOAD DOCOPY (P (MOVD 'CURSOREXIT 'SAVE.CURSOREXIT)
-                                           (MOVD '\MAIKO.BLTCHAR '\BILTCHAR)
+                                           (MOVD '\MAIKO.BLTCHAR '\BLTCHAR)
                                            (\MAIKO.COLORINIT)
                                            (COLORDISPLAY 'ON 'MAIKOCOLOR)
                                            (CURSORSCREEN (COLORSCREEN)
@@ -909,28 +901,20 @@ Copyright (c) 1988-1991 by Fuji Xerox Co., Ltd..
 [PROGN (DEFMACRO \MAIKO.CGTHREEP ()
           (EQ (LOGAND 120 (fetch
 DEVCONFIG of
 \InterfacePage))
               48))
-       (PUTPROPS \MAIKO.CGTHREEP
 MACRO
 (NIL (EQ (LOGAND 120 (fetch
 DEVCONFIG of

-                                                                                         
-                                                                                       \InterfacePage
-                                                                           ))
-                                                        48)))]
+       (PUTPROPS \MAIKO.CGTHREEP
 MACRO
 (NIL (EQ (LOGAND 120 (fetch
 DEVCONFIG of
 \InterfacePage))
+                                                48)))]
 
-(PUTPROPS \MAIKO.CGFOURP
 MACRO
 (NIL (EQ (LOGAND 120 (fetch
 DEVCONFIG of
 
-                                                                                       \InterfacePage
-                                                                   ))
-                                                64)))
+(PUTPROPS \MAIKO.CGFOURP
 MACRO
 (NIL (EQ (LOGAND 120 (fetch
 DEVCONFIG of
 \InterfacePage))
+                                        64)))
 
 [PROGN (DEFMACRO \MAIKO.CGSIXP ()
           (EQ (LOGAND 120 (fetch
 DEVCONFIG of
 \InterfacePage))
               96))
-       (PUTPROPS \MAIKO.CGSIXP
 MACRO
 (NIL (EQ (LOGAND 120 (fetch
 DEVCONFIG of
 
-                                                                                       \InterfacePage
-                                                                         ))
-                                                      96)))]
+       (PUTPROPS \MAIKO.CGSIXP
 MACRO
 (NIL (EQ (LOGAND 120 (fetch
 DEVCONFIG of
 \InterfacePage))
+                                              96)))]
 
-(PUTPROPS \MAIKO.CGTWOP
 MACRO
 (NIL (EQ (LOGAND 120 (fetch
 DEVCONFIG of
 \InterfacePage
-                                                                  ))
-                                               24)))
+(PUTPROPS \MAIKO.CGTWOP
 MACRO
 (NIL (EQ (LOGAND 120 (fetch
 DEVCONFIG of
 \InterfacePage))
+                                       24)))
 )
 
 (DECLARE%: EVAL@COMPILE 
@@ -974,7 +958,7 @@ Copyright (c) 1988-1991 by Fuji Xerox Co., Ltd..
 
 (MOVD 'CURSOREXIT 'SAVE.CURSOREXIT)
 
-(MOVD '\MAIKO.BLTCHAR '\BILTCHAR)
+(MOVD '\MAIKO.BLTCHAR '\BLTCHAR)
 
 (\MAIKO.COLORINIT
)
 
@@ -989,13 +973,12 @@ Copyright (c) 1988-1991 by Fuji Xerox Co., Ltd..
 
 (LOGOW)
 )
-(PUTPROPS MAIKOCOLOR COPYRIGHT ("Fuji Xerox Co., Ltd." 1988 1989 1990 1991))
 (DECLARE%: DONTCOPY
-  (FILEMAP (NIL (3229 7254 (\MAIKO.COLORINIT 3239 . 4475) (\MAIKO.STARTCOLOR 4477 . 5293) (
-\MAIKO.STOPCOLOR 5295 . 5749) (\MAIKOCOLOR.EVENTFN 5751 . 6382) (\MAIKO.SENDCOLORMAPENTRY 6384 . 6842)
- (\MAIKO.CHANGESCREEN 6844 . 7252)) (7255 28244 (CURSOREXIT 7265 . 8769) (CURSORSCREEN 8771 . 10877) (
-WARPCURSOR 10879 . 11194) (\SLOWBLTCHAR 11196 . 11608) (\SOFTCURSORUP 11610 . 17471) (\BITBLT.DISPLAY 
-17473 . 28242)) (28315 40283 (\PUNT.SLOWBLTCHAR 28325 . 35163) (\MAIKO.PUNTBLTCHAR 35165 . 39855) (
-\MAIKO.BLTCHAR 39857 . 40281)) (40284 56617 (\PUNT.BLTSHADE.BITMAP 40294 . 47386) (\PUNT.BITBLT.BITMAP
- 47388 . 56615)) (56618 57426 (BITMAPOBJ.SNAPW 56628 . 57424)))))
+  (FILEMAP (NIL (2639 6664 (\MAIKO.COLORINIT 2649 . 3885) (\MAIKO.STARTCOLOR 3887 . 4703) (
+\MAIKO.STOPCOLOR 4705 . 5159) (\MAIKOCOLOR.EVENTFN 5161 . 5792) (\MAIKO.SENDCOLORMAPENTRY 5794 . 6252)
+ (\MAIKO.CHANGESCREEN 6254 . 6662)) (6665 27654 (CURSOREXIT 6675 . 8179) (CURSORSCREEN 8181 . 10287) (
+WARPCURSOR 10289 . 10604) (\SLOWBLTCHAR 10606 . 11018) (\SOFTCURSORUP 11020 . 16881) (\BITBLT.DISPLAY 
+16883 . 27652)) (27725 39693 (\PUNT.SLOWBLTCHAR 27735 . 34573) (\MAIKO.PUNTBLTCHAR 34575 . 39265) (
+\MAIKO.BLTCHAR 39267 . 39691)) (39694 56027 (\PUNT.BLTSHADE.BITMAP 39704 . 46796) (\PUNT.BITBLT.BITMAP
+ 46798 . 56025)) (56028 56836 (BITMAPOBJ.SNAPW 56038 . 56834)))))
 STOP

lispusers/FONTSAMPLER

@@ -1,12 +1,12 @@
 (DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
 
-
(FILECREATED " 5-Dec-2025 11:09:30" {DSK}<home>matt>Interlisp>medley>lispusers>FONTSAMPLER.;6
 12333  
+
(FILECREATED "26-Dec-2025 16:37:05" {DSK}<home>matt>Interlisp>medley>lispusers>FONTSAMPLER.;4
 14367  
 
       :EDIT-BY "mth"
 
-      :CHANGES-TO (FNS FontSample FontTable)
+      :CHANGES-TO (FNS FontSample)
 
-      :PREVIOUS-DATE " 4-Dec-2025 23:56:07" {DSK}<home>matt>Interlisp>medley>lispusers>FONTSAMPLER.;5
+      :PREVIOUS-DATE " 9-Dec-2025 14:00:20" {DSK}<home>matt>Interlisp>medley>lispusers>FONTSAMPLER.;3
 )
 
 
@@ -20,7 +20,9 @@
 (DEFINEQ
 
 (FontSample

-  [LAMBDA (Fonts CharacterSets Printer StreamType Hexadecimal)

+  [LAMBDA (Fonts CharacterSets Printer StreamType Hexadecimal ColumnMajor NoSlugOnlyCS)

+                                                             (* ; "Edited 26-Dec-2025 16:25 by mth")


+                                                             (* ; "Edited  9-Dec-2025 13:48 by mth")


                                                              (* ; "Edited  5-Dec-2025 11:06 by mth")


                                                              (* ; "Edited  5-Feb-2025 17:02 by mth")

                                                              (* ; "Edited 29-Apr-87 22:03")

@@ -30,12 +32,10 @@
            [Stream (OPENIMAGESTREAM Printer StreamType (LIST 'FONTS (CONS TitleFont FontList]
            (InchesToPrinterUnits (FTIMES 72.0 (DSPSCALE NIL Stream)))
            (LastFont (CAR (LAST FontList)))
-           [CharacterSets (if
 (LISTP CharacterSets)
-                              then
 CharacterSets
-                            elseif
 (MEMB CharacterSets '(T :INCORE :ALL :INTERESTING))
-                              then
 CharacterSets
-                            else
 (LIST (OR CharacterSets 0]
            (AllCharacterSets (CONSTANT (for
 CS from
 0 to
 255 collect
 CS]
+          (CL:UNLESS [OR (LISTP CharacterSets)
+                         (MEMB CharacterSets '(T :INCORE :ALL :INTERESTING]
+              (SETQ CharacterSets (LIST (OR CharacterSets 0))))
           (DSPRIGHTMARGIN (fetch
 (REGION WIDTH) of
 (DSPCLIPPINGREGION NIL Stream))
                  Stream)
           (for
 Font in
 FontList do
 
@@ -60,23 +60,37 @@
                                              CharacterSets))
 
                                         (* ;; 
-
                                    "Exclude any CharacterSet known to reference the SlugCharsetInfo")

+
             "If requested to do so, exclude any CharacterSet known to reference the SlugCharsetInfo")

 
-                                        (SETQ FontCharacterSets (for
 CS in
 FontCharacterSets
-                                                                   unless
 (EQ SlugCharsetInfo
-                                                                              (\GETCHARSETINFO Font 
-                                                                                     CS))
-                                                                   collect
 CS))
+                                        (CL:WHEN (AND NoSlugOnlyCS SlugCharsetInfo)
+
+                                            (* ;; 
+
                         "Only if SlugCharsetInfo is non-NIL, else it won't load a requested charset")

+
+                                            (SETQ FontCharacterSets
+                                             (for
 CS in
 FontCharacterSets
+                                                unless
 (EQ SlugCharsetInfo (\GETCHARSETINFO Font CS))
+                                                collect
 CS)))
+
+                                        (* ;; 
+
                                        "Probably ought to report charsets eliminated by the above.")

+
+                                        (* ;; " At least report if NO charsets remain for this font.")

+
+                                        (CL:UNLESS FontCharacterSets (printout T 
+                                             "All requested character sets are empty for this font: "
+                                                                            Font T))
                                         (for
 CharacterSet in
 FontCharacterSets
                                            bind
 (LastCharacterSet _ (CAR (LAST FontCharacterSets)))
                                            do
 (FontTable
 Font CharacterSet Stream
                                                      (OR (NEQ Font LastFont)
                                                          (NEQ CharacterSet LastCharacterSet))
-                                                     TitleFont InchesToPrinterUnits Hexadecimal)))
-             finally
 (CLOSEF Stream])
+                                                     TitleFont InchesToPrinterUnits Hexadecimal 
+                                                     ColumnMajor))) finally
 (CLOSEF Stream])
 
 (FontSampleFaked

-  [LAMBDA (FontAsList Printer StreamType)                    (* N.H.Briggs "27-Apr-87 18:12")

+  [LAMBDA (FontAsList Printer StreamType ColumnMajor)
        (* ; "Edited  8-Dec-2025 21:19 by mth")


+                                                       (* ; "Edited 27-Apr-87 18:12 by N.H.Briggs ")

     (LET* [[TitleFont (FONTCREATE NIL 12 'MRR 0 (OR StreamType (PRINTERTYPE Printer]
            (Font)
            [Stream (OPENIMAGESTREAM Printer StreamType (LIST 'FONTS (LIST TitleFont]
@@ -86,11 +100,12 @@
           (replace
 FONTSIZE of
 Font with
 (CADR FontAsList))
           (replace
 FONTFACE of
 Font with
 (\FONTFACE (CADDR FontAsList)))
           (FontTable
 Font '(0)
-                 Stream NIL TitleFont InchesToPrinterUnits)
+                 Stream NIL TitleFont InchesToPrinterUnits NIL ColumnMajor)
           (CLOSEF Stream])
 
 (FontTable

-  [LAMBDA (Font CharacterSet Stream FormFeed TitleFont InchesToPrinterUnits Hexadecimal)

+  [LAMBDA (Font CharacterSet Stream FormFeed TitleFont InchesToPrinterUnits Hexadecimal ColumnMajor)

+                                                             (* ; "Edited  9-Dec-2025 13:23 by mth")


                                                              (* ; "Edited  5-Dec-2025 11:09 by mth")


                                                              (* ; "Edited  5-Feb-2025 17:03 by mth")


                                                              (* ; "Edited  3-Feb-2025 20:07 by mth")

@@ -103,14 +118,15 @@
                     " "
                     (L-CASE Face T)
                     " Character set "))
+      (StreamType (IMAGESTREAMTYPE Stream))
       [UseDisplayFontBitmaps (AND (EQ (FONTPROP Font 'DEVICE)
                                       'DISPLAY)
-                                  (NOT (EQ (IMAGESTREAMTYPE Stream)
-                                           'DISPLAY]
+                                  (NOT (EQ StreamType 'DISPLAY]
       [RelativeDescent (FQUOTIENT (FONTPROP Font 'DESCENT)
                               (FONTPROP Font 'HEIGHT]
       (XCellSpacing (TIMES 0.45 InchesToPrinterUnits))
-      (YCellSpacing (TIMES 0.5 InchesToPrinterUnits)))
+      (YCellSpacing (TIMES 0.5 InchesToPrinterUnits))
+      ColLabelStep RowLabelStep)
      (printout T Title .I0.8 CharacterSet "Q" T)
      (RESETLST
          (RESETSAVE (RADIX (if
 Hexadecimal
@@ -129,15 +145,31 @@
          (printout Stream (if
 Hexadecimal
                               then
 "16"
                             else
 "8"))
+         (if
 ColumnMajor
+             then
 (SETQ ColLabelStep 16)
+                  (SETQ RowLabelStep 1)
+           else
 (SETQ ColLabelStep 1)
+                (SETQ RowLabelStep 16))
          (for
 XPosition from
 (TIMES 0.75 InchesToPrinterUnits) by
 XCellSpacing as
 Counter
-            from
 0 to
 15 bind
 (YPosition _ (TIMES 9.5 InchesToPrinterUnits))
-            do
 (MOVETO XPosition YPosition Stream)
-               (PRIN1 Counter Stream))
-         (for
 YPosition from
 (TIMES 9 InchesToPrinterUnits) by
 (MINUS YCellSpacing) as
 Counter
-            from
 0 to
 240 by
 16 bind
 (XPosition _ (TIMES 0.25 InchesToPrinterUnits))
+            from
 0 to
 (ITIMES ColLabelStep 15) by
 ColLabelStep bind
 (YPosition _ (TIMES 9.5 
+                                                                                 InchesToPrinterUnits
+                                                                                        ))
             do
 (MOVETO XPosition YPosition Stream)
                (PRINTNUM (if
 Hexadecimal
                              then
 '(FIX 2 16 T)
+                           elseif
 ColumnMajor
+                             then
 '(FIX 1 8 NIL T)
+                           else
 '(FIX 2 8))
+                      Counter Stream))
+         (for
 YPosition from
 (TIMES 9 InchesToPrinterUnits) by
 (MINUS YCellSpacing) as
 Counter
+            from
 0 to
 (ITIMES RowLabelStep 15) by
 RowLabelStep bind
 (XPosition _ (TIMES 0.25 
+                                                                                 InchesToPrinterUnits
+                                                                                        ))
+            do
 (MOVETO XPosition YPosition Stream)
+               (PRINTNUM (if
 Hexadecimal
+                             then
 '(FIX 2 16 T)
+                           elseif
 ColumnMajor
+                             then
 '(FIX 2 8)
                            else
 '(FIX 3 8))
                       Counter Stream)))
      (DRAWLINE (TIMES 0.25 InchesToPrinterUnits)
@@ -154,33 +186,32 @@
             'PAINT Stream)
      (CL:UNLESS UseDisplayFontBitmaps (DSPFONT Font Stream))
      (for
 XPosition from
 (TIMES 0.75 InchesToPrinterUnits) by
 XCellSpacing as
 XCounter from
 0
-        to
 15 bind
 (CharacterCode _ 0)
-                   [RangedCodesStreamType _ (MEMB (IMAGESTREAMTYPE Stream)
-                                                  '(DISPLAY INTERPRESS]
+        to
 15 bind
 [RangedCodesStreamType _ (MEMB StreamType '(DISPLAY INTERPRESS]
         do

-        (for
 YPosition from
 (TIMES 9 InchesToPrinterUnits) by
 (MINUS YCellSpacing) as
 YCounter
+        [for
 YPosition from
 (TIMES 9 InchesToPrinterUnits) by
 (MINUS YCellSpacing) as
 YCounter
            from
 0 to
 15
-           do
 [LET ((CCode (IPLUS (ITIMES CharacterSet 256)
-                                  CharacterCode)))
-                   (MOVETO XPosition YPosition Stream)
-                   (if
 UseDisplayFontBitmaps
-                       then
 (LET* ((Glyph (GETCHARBITMAP CCode Font))
-                                   (ImSize (BITMAPIMAGESIZE Glyph NIL Stream))
-                                   (ImWidth (CAR ImSize))
-                                   (ImHeight (CDR ImSize)))
-                                  (BITBLT Glyph 0 0 Stream XPosition (FDIFFERENCE YPosition
-                                                                            (FTIMES ImHeight 
-                                                                                   RelativeDescent))
-                                         ImWidth ImHeight 'INPUT 'REPLACE))
-                     else
 (if
 (AND (NEQ CharacterCode (CHARCODE FF))
-                                   (if
 RangedCodesStreamType
-                                       then
 (OR (AND (IGREATERP CharacterCode 31)
-                                                     (ILESSP CharacterCode 127))
-                                                (AND (IGREATERP CharacterCode 160)
-                                                     (ILESSP CharacterCode 255)))
-                                     else
 T))
-                              then
 (PRINTCCODE CCode Stream]
-              (SETQ CharacterCode (ADD1 CharacterCode)))
+           do
 (LET* ((CharacterCode (IPLUS (ITIMES YCounter RowLabelStep)
+                                           (ITIMES XCounter ColLabelStep)))
+                     (CCode (IPLUS (ITIMES CharacterSet 256)
+                                   CharacterCode)))
+                    (MOVETO XPosition YPosition Stream)
+                    (if
 UseDisplayFontBitmaps
+                        then
 (LET* ((Glyph (GETCHARBITMAP CCode Font))
+                                    (ImSize (BITMAPIMAGESIZE Glyph NIL Stream))
+                                    (ImWidth (CAR ImSize))
+                                    (ImHeight (CDR ImSize)))
+                                   (BITBLT Glyph 0 0 Stream XPosition (FDIFFERENCE YPosition
+                                                                             (FTIMES ImHeight 
+                                                                                    RelativeDescent))
+                                          ImWidth ImHeight 'INPUT 'REPLACE))
+                      else
 (if
 (AND (NEQ CharacterCode (CHARCODE FF))
+                                    (if
 RangedCodesStreamType
+                                        then
 (OR (AND (IGREATERP CharacterCode 31)
+                                                      (ILESSP CharacterCode 127))
+                                                 (AND (IGREATERP CharacterCode 160)
+                                                      (ILESSP CharacterCode 255)))
+                                      else
 T))
+                               then
 (PRINTCCODE CCode Stream]
         (printout T "."))
      (MOVETO (FTIMES 0.75 InchesToPrinterUnits)
             (FTIMES 0.75 InchesToPrinterUnits)
@@ -220,6 +251,6 @@
        FONT)
 )
 (DECLARE%: DONTCOPY
-  (FILEMAP (NIL (655 12170 (FontSample 665 . 4700) (FontSampleFaked 4702 . 5524) (FontTable 5526 . 12168
+  (FILEMAP (NIL (645 14204 (FontSample 655 . 5488) (FontSampleFaked 5490 . 6448) (FontTable 6450 . 14202
 )))))
 STOP

lispusers/MANAGER

@@ -1,12 +1,13 @@
 (DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
 
-
(FILECREATED "21-May-2024 18:45:54" {LU}MANAGER.;4
 102968 
+
(FILECREATED " 5-Jan-2026 12:41:54" {DSK}<home>matt>Interlisp>medley>lispusers>MANAGER.;5
 106149 
 
       :EDIT-BY "mth"
 
-      :CHANGES-TO (FNS Manager.DO.COMMAND)
+      :CHANGES-TO (ADVICE ADDTOFILES? ADDTOCOMS LOAD LOADFNS MAKEFILE MARKASCHANGED UNMARKASCHANGED 
+                         DELFROMCOMS UPDATEFILES \ADDTOFILEBLOCK/ADDNEWCOM ADDFILE)
 
-      :PREVIOUS-DATE "20-May-2024 11:16:10" {LU}MANAGER.;3)
+      :PREVIOUS-DATE " 5-Jan-2026 12:35:04" {DSK}<home>matt>Interlisp>medley>lispusers>MANAGER.;4)
 
 
 (PRETTYCOMPRINT MANAGERCOMS)
@@ -1545,66 +1546,105 @@ Will load DataBaseFNS if necessary" (SUBITEMS ("All" 'DB
                                                                        (RPLACA LST (CDAR LST)))])
 )
 
-[XCL:REINSTALL-ADVICE 'ADDFILE :AROUND '((:LAST (PROG1 (LET ((Manager.ACTIVEFLG NIL))
-                                                            *
)
-                                                    (AND Manager.ACTIVEFLG (Manager.CHECKFILE
 FILE)))
-                                                ]
+[XCL:REINSTALL-ADVICE 'ADDFILE :AROUND '((:LAST (LET* ((Orig.Manager.ACTIVELFG Manager.ACTIVEFLG)
+                                                       (Manager.ACTIVEFLG NIL))
+                                                      (DECLARE
 (SPECVARS Manager.ACTIVEFLG))
+                                                      (PROG1 *
+                                                          (AND (SETQ Manager.ACTIVEFLG 
+                                                                Orig.Manager.ACTIVELFG)
+                                                               (Manager.CHECKFILE
 FILE)))]
 
-[XCL:REINSTALL-ADVICE 'ADDTOFILES? :AROUND '((:LAST (PROG1 (LET ((MANAGER-ADDTOFILES? T))
-                                                                *
)
-                                                        (AND Manager.ACTIVEFLG (Manager.ADDTOFILES?
)))
-                                                    ]
+[XCL:REINSTALL-ADVICE 'ADDTOFILES? :AROUND '((:LAST (LET* ((Orig.Manager.ACTIVELFG Manager.ACTIVEFLG)
+                                                           (Manager.ACTIVEFLG NIL))
+                                                          (DECLARE
 (SPECVARS Manager.ACTIVEFLG))
+                                                          (PROG1 *
+                                                              (AND (SETQ Manager.ACTIVEFLG 
+                                                                    Orig.Manager.ACTIVELFG)
+                                                                   (Manager.ADDTOFILES?
)))]
 
-[XCL:REINSTALL-ADVICE 'MAKEFILE :AROUND '((:LAST (PROG1 (LET ((Manager.ACTIVEFLG NIL))
-                                                             *
)
-                                                     (AND Manager.ACTIVEFLG (Manager.MAKEFILE.ADV

-                                                                             FILE OPTIONS)))]
+[XCL:REINSTALL-ADVICE 'MAKEFILE :AROUND '((:LAST (LET* ((Orig.Manager.ACTIVELFG Manager.ACTIVEFLG)
+                                                        (Manager.ACTIVEFLG NIL))
+                                                       (DECLARE
 (SPECVARS Manager.ACTIVEFLG))
+                                                       (PROG1 *
+                                                           (AND (SETQ Manager.ACTIVEFLG 
+                                                                 Orig.Manager.ACTIVELFG)
+                                                                (Manager.MAKEFILE.ADV
 FILE OPTIONS)))
+                                                       ]
 
-[XCL:REINSTALL-ADVICE 'MARKASCHANGED :AROUND '((:LAST (PROG1 (LET ((Manager.ACTIVEFLG NIL))
-                                                                  *
)
-                                                          (AND Manager.ACTIVEFLG
-                                                               (Manager.ALTERMARKING
 NAME TYPE
-                                                                      (OR REASON T))))]
+[XCL:REINSTALL-ADVICE 'MARKASCHANGED :AROUND
+       '((:LAST (LET* ((Orig.Manager.ACTIVELFG Manager.ACTIVEFLG)
+                       (Manager.ACTIVEFLG NIL))
+                      (DECLARE
 (SPECVARS Manager.ACTIVEFLG))
+                      (PROG1 *
+                          (AND (SETQ Manager.ACTIVEFLG Orig.Manager.ACTIVELFG)
+                               (Manager.ALTERMARKING
 NAME TYPE (OR REASON T))))]
 
 [XCL:REINSTALL-ADVICE 'UNMARKASCHANGED :AROUND
-       '((:LAST (LET (!VALUE)
-                     (PROG1 (LET ((Manager.ACTIVEFLG NIL))
-                                 (SETQ !VALUE *
))
-                         (AND Manager.ACTIVEFLG !VALUE (Manager.ALTERMARKING
 NAME TYPE NIL)))]
+       '((:LAST (LET* ((Orig.Manager.ACTIVELFG Manager.ACTIVEFLG)
+                       (Manager.ACTIVEFLG NIL)
+                       !VALUE)
+                      (DECLARE
 (SPECVARS Manager.ACTIVEFLG))
+                      (PROG1 (SETQ !VALUE *
)
+                          (AND (SETQ Manager.ACTIVEFLG Orig.Manager.ACTIVELFG)
+                               !VALUE
+                               (Manager.ALTERMARKING
 NAME TYPE NIL)))]
 
-[XCL:REINSTALL-ADVICE 'UPDATEFILES :AROUND '((:LAST (PROG1 (LET ((Manager.ACTIVEFLG NIL))
-                                                                *
)
-                                                        (AND Manager.ACTIVEFLG (Manager.MAINUPDATE

-                                                                                T)))]
+[XCL:REINSTALL-ADVICE 'UPDATEFILES :AROUND '((:LAST (LET* ((Orig.Manager.ACTIVELFG Manager.ACTIVEFLG)
+                                                           (Manager.ACTIVEFLG NIL))
+                                                          (DECLARE
 (SPECVARS Manager.ACTIVEFLG))
+                                                          (PROG1 *
+                                                              (AND (SETQ Manager.ACTIVEFLG 
+                                                                    Orig.Manager.ACTIVELFG)
+                                                                   (Manager.MAINUPDATE
 T)))]
 
 [XCL:REINSTALL-ADVICE 'ADDTOCOMS :AROUND
-       '((:LAST (LET (!VALUE)
-                     (PROG1 (LET ((Manager.ACTIVEFLG NIL))
-                                 (SETQ !VALUE *
))
-                         (AND Manager.ACTIVEFLG (Manager.ADDADV
 !VALUE COMS NAME TYPE)))]
+       '((:LAST (LET* ((Orig.Manager.ACTIVELFG Manager.ACTIVEFLG)
+                       (Manager.ACTIVEFLG NIL)
+                       !VALUE)
+                      (DECLARE
 (SPECVARS Manager.ACTIVEFLG))
+                      (PROG1 (SETQ !VALUE *
)
+                          (AND (SETQ Manager.ACTIVEFLG Orig.Manager.ACTIVELFG)
+                               (Manager.ADDADV
 !VALUE COMS NAME TYPE)))]
 
 [XCL:REINSTALL-ADVICE 'DELFROMCOMS :AROUND
-       '((:LAST (LET (!VALUE)
-                     (PROG1 (LET ((Manager.ACTIVEFLG NIL))
-                                 (SETQ !VALUE *
))
-                         (AND Manager.ACTIVEFLG (Manager.ADDADV
 !VALUE COMS NAME TYPE)))]
+       '((:LAST (LET* ((Orig.Manager.ACTIVELFG Manager.ACTIVEFLG)
+                       (Manager.ACTIVEFLG NIL)
+                       !VALUE)
+                      (DECLARE
 (SPECVARS Manager.ACTIVEFLG))
+                      (PROG1 (SETQ !VALUE *
)
+                          (AND (SETQ Manager.ACTIVEFLG Orig.Manager.ACTIVELFG)
+                               (Manager.ADDADV
 !VALUE COMS NAME TYPE)))]
 
 [XCL:REINSTALL-ADVICE '\ADDTOFILEBLOCK/ADDNEWCOM :AROUND
-       '((:LAST (PROG1 (LET ((Manager.ACTIVEFLG NIL))
-                            *
)
-                    (AND Manager.ACTIVEFLG (Manager.RESETSUBITEMS
 FILE TYPE)))]
+       '((:LAST (LET* ((Orig.Manager.ACTIVELFG Manager.ACTIVEFLG)
+                       (Manager.ACTIVEFLG NIL))
+                      (DECLARE
 (SPECVARS Manager.ACTIVEFLG))
+                      (PROG1 *
+                          (AND (SETQ Manager.ACTIVEFLG Orig.Manager.ACTIVELFG)
+                               (Manager.RESETSUBITEMS
 FILE TYPE)))]
 
-[XCL:REINSTALL-ADVICE 'LOAD :AROUND '((:LAST (PROG1 (LET ((Manager.ACTIVEFLG NIL))
-                                                         *
)
-                                                 (if
 Manager.ACTIVEFLG
-                                                     then
 (Manager.REMOVE.DUPLICATE.ADVICE
 FILE)
-                                                          (Manager.CHECKFILE
 FILE)))]
+[XCL:REINSTALL-ADVICE 'LOAD :AROUND '((:LAST (LET* ((Orig.Manager.ACTIVELFG Manager.ACTIVEFLG)
+                                                    (Manager.ACTIVEFLG NIL))
+                                                   (DECLARE
 (SPECVARS Manager.ACTIVEFLG))
+                                                   (PROG1 *
+                                                       (AND (SETQ Manager.ACTIVEFLG 
+                                                             Orig.Manager.ACTIVELFG)
+                                                            (if
 Manager.ACTIVEFLG
+                                                                then
 (Manager.REMOVE.DUPLICATE.ADVICE

+                                                                      FILE)
+                                                                     (Manager.CHECKFILE
 FILE))))]
 
-[XCL:REINSTALL-ADVICE 'LOADFNS :AROUND '((:LAST (PROG1 (LET ((Manager.ACTIVEFLG NIL))
-                                                            *
)
-                                                    (if
 Manager.ACTIVEFLG
-                                                        then
 (Manager.REMOVE.DUPLICATE.ADVICE
 FILE)
-                                                             (Manager.CHECKFILE
 FILE)))]
+[XCL:REINSTALL-ADVICE 'LOADFNS :AROUND '((:LAST (LET* ((Orig.Manager.ACTIVELFG Manager.ACTIVEFLG)
+                                                       (Manager.ACTIVEFLG NIL))
+                                                      (DECLARE
 (SPECVARS Manager.ACTIVEFLG))
+                                                      (PROG1 *
+                                                          (AND (SETQ Manager.ACTIVEFLG 
+                                                                Orig.Manager.ACTIVELFG)
+                                                               (if
 Manager.ACTIVEFLG
+                                                                   then
 (
+
                                                                      Manager.REMOVE.DUPLICATE.ADVICE

+                                                                         FILE)
+                                                                        (Manager.CHECKFILE
 FILE))))]
 
 [XCL:REINSTALL-ADVICE '(MARKASCHANGED :IN DEFAULT.EDITDEFA0001)
        :AROUND
@@ -1710,20 +1750,20 @@ Will load DataBaseFNS if necessary" (SUBITEMS ("All" 'DB
 )
 (PUTPROPS MANAGER COPYRIGHT (NONE))
 (DECLARE%: DONTCOPY
-  (FILEMAP (NIL (25632 93132 (MANAGER 25642 . 26441) (MANAGER.RESET 26443 . 27957) (Manager.ADDADV 27959
- . 29312) (Manager.ADDTOFILES? 29314 . 29592) (Manager.ALTERMARKING 29594 . 31204) (
-Manager.ANCHORED-SET-POSITION 31206 . 32309) (Manager.DO.COMMAND 32311 . 33918) (
-Manager.DO.COMMAND.PROCFN 33920 . 53275) (Manager.HIGHLIGHT 53277 . 53574) (Manager.PROMPT 53576 . 
-53889) (Manager.WINDOW 53891 . 54524) (Manager.insurefilehighlights 54526 . 55597) (Manager.CHANGED? 
-55599 . 56148) (Manager.CHECKFILE 56150 . 57249) (Manager.COLLECTCOMS 57251 . 58689) (Manager.COMS.WSF
- 58691 . 61361) (Manager.COMSOPEN 61363 . 66101) (Manager.COMSUPDATE 66103 . 67195) (
-Manager.HIGHLIGHTED 67197 . 67503) (Manager.INSUREHIGHLIGHTS 67505 . 68063) (Manager.FILECHANGES 68065
- . 68364) (Manager.FILELSTCHANGED? 68366 . 68694) (Manager.FILESUBTYPES 68696 . 69334) (
-Manager.GET.ENVIRONMENT 69336 . 71874) (Manager.GETFILE 71876 . 74190) (Manager.INTITLE? 74192 . 74870
-) (Manager.MAIN.WSF 74872 . 77516) (Manager.MAINCLOSE 77518 . 78628) (Manager.MAINMENUITEMS 78630 . 
-79707) (Manager.MAINOPEN 79709 . 85102) (Manager.MAINUPDATE 85104 . 85740) (Manager.MAKEFILE.ADV 85742
- . 86778) (Manager.MENUCOLUMNS 86780 . 87584) (Manager.MENUHASITEM 87586 . 87943) (Manager.MENUITEMS 
-87945 . 88190) (Manager.REMOVE.DUPLICATE.ADVICE 88192 . 89798) (Manager.RESETSUBITEMS 89800 . 91037) (
-Manager.SET-ANCHOR 91039 . 91358) (Manager.SORT.COMS 91360 . 91892) (Manager.SORTBYCOLUMN 91894 . 
-93130)))))
+  (FILEMAP (NIL (25852 93352 (MANAGER 25862 . 26661) (MANAGER.RESET 26663 . 28177) (Manager.ADDADV 28179
+ . 29532) (Manager.ADDTOFILES? 29534 . 29812) (Manager.ALTERMARKING 29814 . 31424) (
+Manager.ANCHORED-SET-POSITION 31426 . 32529) (Manager.DO.COMMAND 32531 . 34138) (
+Manager.DO.COMMAND.PROCFN 34140 . 53495) (Manager.HIGHLIGHT 53497 . 53794) (Manager.PROMPT 53796 . 
+54109) (Manager.WINDOW 54111 . 54744) (Manager.insurefilehighlights 54746 . 55817) (Manager.CHANGED? 
+55819 . 56368) (Manager.CHECKFILE 56370 . 57469) (Manager.COLLECTCOMS 57471 . 58909) (Manager.COMS.WSF
+ 58911 . 61581) (Manager.COMSOPEN 61583 . 66321) (Manager.COMSUPDATE 66323 . 67415) (
+Manager.HIGHLIGHTED 67417 . 67723) (Manager.INSUREHIGHLIGHTS 67725 . 68283) (Manager.FILECHANGES 68285
+ . 68584) (Manager.FILELSTCHANGED? 68586 . 68914) (Manager.FILESUBTYPES 68916 . 69554) (
+Manager.GET.ENVIRONMENT 69556 . 72094) (Manager.GETFILE 72096 . 74410) (Manager.INTITLE? 74412 . 75090
+) (Manager.MAIN.WSF 75092 . 77736) (Manager.MAINCLOSE 77738 . 78848) (Manager.MAINMENUITEMS 78850 . 
+79927) (Manager.MAINOPEN 79929 . 85322) (Manager.MAINUPDATE 85324 . 85960) (Manager.MAKEFILE.ADV 85962
+ . 86998) (Manager.MENUCOLUMNS 87000 . 87804) (Manager.MENUHASITEM 87806 . 88163) (Manager.MENUITEMS 
+88165 . 88410) (Manager.REMOVE.DUPLICATE.ADVICE 88412 . 90018) (Manager.RESETSUBITEMS 90020 . 91257) (
+Manager.SET-ANCHOR 91259 . 91578) (Manager.SORT.COMS 91580 . 92112) (Manager.SORTBYCOLUMN 92114 . 
+93350)))))
 STOP

sources/DIRECTORY

@@ -1,16 +1,13 @@
 (DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
 
-
(FILECREATED "29-Mar-2022 10:53:16" {DSK}<Users>kaplan>Local>medley3.5>my-medley>sources>DIRECTORY.;15
 28665  
+
(FILECREATED " 6-Nov-2025 00:13:55" {WMEDLEY}<sources>DIRECTORY.;17
 28439  
 
-      :CHANGES-TO (FNS DIRECTORY)
+      :EDIT-BY rmk
 
-      :PREVIOUS-DATE "29-Mar-2022 08:29:33" 
-{DSK}<Users>kaplan>Local>medley3.5>my-medley>sources>DIRECTORY.;14)
+      :CHANGES-TO (VARS DIRCOMMANDS)
 
+      :PREVIOUS-DATE "22-Oct-2025 22:07:27" {WMEDLEY}<sources>DIRECTORY.;16)
 
-(* ; "
-Copyright (c) 1986-1988, 1990, 1992 by Venue & Xerox Corporation.
-")
 
 (PRETTYCOMPRINT DIRECTORYCOMS)
 
@@ -419,7 +416,7 @@ Copyright (c) 1986-1988, 1990, 1992 by Venue & Xerox Corporation.
         DELETE
         (DELETE? PROMPT " delete? " DELETE)
         DELETED
-        (LE LENGTH "(" BYTESIZE ")")
+        (LE . LENGTH)
         NEWERTHAN OLDVERSIONS (OLD OLDERTHAN 90)
         OLDERTHAN
         (OU . OUT)
@@ -463,12 +460,11 @@ Copyright (c) 1986-1988, 1990, 1992 by Venue & Xerox Corporation.
 (GLOBALVARS DIRCOMMANDS ASKUSERTTBL FILEINFOTYPES)
 )
 )
-(PUTPROPS DIRECTORY COPYRIGHT ("Venue & Xerox Corporation" 1986 1987 1988 1990 1992))
 (DECLARE%: DONTCOPY
-  (FILEMAP (NIL (1325 27144 (DODIR 1335 . 1882) (FILDIR 1884 . 2164) (DIRECTORY 2166 . 12883) (
-DIRECTORY.PARSE 12885 . 14179) (DIRECTORY.FILL.PATTERN 14181 . 14711) (DIRCONJ 14713 . 14933) (
-DIRECTORY.NEXTFILE 14935 . 15528) (DMATCH 15530 . 15905) (DIRECTORY.MATCH.SETUP 15907 . 16441) (
-DIRECTORY.MATCH 16443 . 16860) (DIRECTORY.MATCH1 16862 . 18975) (DODIRCOMMANDS 18977 . 24447) (
-DIRPRINTNAME 24449 . 25865) (DPRIN1 25867 . 25952) (DIRFILENAME 25954 . 26675) (DIRGETFILEINFO 26677
- . 26829) (DREAD 26831 . 27142)))))
+  (FILEMAP (NIL (1200 27019 (DODIR 1210 . 1757) (FILDIR 1759 . 2039) (DIRECTORY 2041 . 12758) (
+DIRECTORY.PARSE 12760 . 14054) (DIRECTORY.FILL.PATTERN 14056 . 14586) (DIRCONJ 14588 . 14808) (
+DIRECTORY.NEXTFILE 14810 . 15403) (DMATCH 15405 . 15780) (DIRECTORY.MATCH.SETUP 15782 . 16316) (
+DIRECTORY.MATCH 16318 . 16735) (DIRECTORY.MATCH1 16737 . 18850) (DODIRCOMMANDS 18852 . 24322) (
+DIRPRINTNAME 24324 . 25740) (DPRIN1 25742 . 25827) (DIRFILENAME 25829 . 26550) (DIRGETFILEINFO 26552
+ . 26704) (DREAD 26706 . 27017)))))
 STOP

sources/XCL-EXTRAS

@@ -1,13 +1,14 @@
-(DEFINE-FILE-INFO READTABLE "XCL" PACKAGE "XCL")
-
(IL:FILECREATED "18-May-90 01:15:40" IL:|{DSK}<usr>local>lde>lispcore>sources>XCL-EXTRAS.;2|
 15315  
+(DEFINE-FILE-INFO PACKAGE "XEROX-COMMON-LISP" READTABLE "XCL" BASE 10)
 
-      IL:|changes| IL:|to:|  (IL:VARS IL:XCL-EXTRASCOMS)
+
(IL:FILECREATED "11-Dec-2025 22:27:58" IL:|{DSK}<home>matt>Interlisp>medley>sources>XCL-EXTRAS.;2|
 15547  
 
-      IL:|previous| IL:|date:| "11-Jan-88 16:59:17" 
-IL:|{DSK}<usr>local>lde>lispcore>sources>XCL-EXTRAS.;1|)
+      :EDIT-BY "mth"
 
+      :CHANGES-TO (IL:FUNCTIONS DEFINE-RECORD)
+
+      :PREVIOUS-DATE "18-May-90 01:15:40" IL:|{DSK}<home>matt>Interlisp>medley>sources>XCL-EXTRAS.;1|
+)
 
-; Copyright (c) 1987, 1988, 1990 by Venue & Xerox Corporation.  All rights reserved.
 
 (IL:PRETTYCOMPRINT IL:XCL-EXTRASCOMS)
 
@@ -145,8 +146,7 @@ IL:|{DSK}<usr>local>lde>lispcore>sources>XCL-EXTRAS.;1|)
                                                                  IL:*INTERLISP-PACKAGE*))
                                      (COLLECT KEYWORD-SYMBOL)
                                      (IF (NOT (MEMBER KEYWORD-SYMBOL '(IL:USING
 IL:COPYING

-                                                                         IL:REUSING
 IL:SMASHING

-                                                                       )
+                                                                         IL:REUSING
 IL:SMASHING
)
                                                      :TEST
                                                      #'EQ))
                                          (COLLECT 'IL:_))
@@ -162,12 +162,12 @@ IL:|{DSK}<usr>local>lde>lispcore>sources>XCL-EXTRAS.;1|)
 
 
 (DEFDEFINER DEFINE-RECORD
 IL:STRUCTURES (RECORD-NAME INTERLISP-RECORD-NAME &KEY (CONC-NAME NIL 
-                                                                                          CONC-NAME-P
-                                                                                           )
-                                                   (CONSTRUCTOR NIL CONSTRUCTOR-P)
-                                                   (PREDICATE NIL PREDICATE-P)
-                                                   (FAST-ACCESSORS NIL)
-                                                   (PACKAGE *PACKAGE*))
+                                                                                       CONC-NAME-P)
+                                               (CONSTRUCTOR NIL CONSTRUCTOR-P)
+                                               (PREDICATE NIL PREDICATE-P)
+                                               (FAST-ACCESSORS NIL)
+                                               (PACKAGE *PACKAGE*))

+                                                      (IL:* IL:\; "Edited 11-Dec-2025 21:43 by mth")

    (IF (NOT (PACKAGEP PACKAGE))
        (SETQ PACKAGE (FIND-PACKAGE PACKAGE)))
    (SETQ CONC-NAME (IF CONC-NAME-P
@@ -195,7 +195,8 @@ IL:|{DSK}<usr>local>lde>lispcore>sources>XCL-EXTRAS.;1|)
                                            'SETF-RECORD-ACCESS-MACRO)
                                     (SETF (GET ',NEW-NAME :SLOT-INFO)
                                           ',`((,INTERLISP-RECORD-NAME ,FIELD-NAME)
-                                              ,FAST-ACCESSORS))))))
+                                              ,FAST-ACCESSORS))
+                                    (IL:CLSMARTEN '((,NEW-NAME IL:OBJECT)))))))
                FIELD-NAMES)
       ,@(LET ((NEW-NAME (IF PREDICATE-P
                             PREDICATE
@@ -214,7 +215,8 @@ IL:|{DSK}<usr>local>lde>lispcore>sources>XCL-EXTRAS.;1|)
                  `((SETF (MACRO-FUNCTION ',NEW-NAME)
                          'RECORD-PREDICATE-MACRO)
                    (SETF (GET ',NEW-NAME :TYPE-INFO)
-                         ',INTERLISP-RECORD-NAME))))
+                         ',INTERLISP-RECORD-NAME)
+                   (IL:CLSMARTEN '((,NEW-NAME IL:OBJECT))))))
       ,@(LET ((NEW-NAME (IF CONSTRUCTOR-P
                             CONSTRUCTOR
                             (INTERN (CONCATENATE 'STRING "MAKE-" (STRING RECORD-NAME))
@@ -234,7 +236,8 @@ IL:|{DSK}<usr>local>lde>lispcore>sources>XCL-EXTRAS.;1|)
                  `((SETF (MACRO-FUNCTION ',NEW-NAME)
                          'RECORD-CONSTRUCTOR-MACRO)
                    (SETF (GET ',NEW-NAME :FIELD-INFO)
-                         '(,INTERLISP-RECORD-NAME ,FIELD-NAMES))))))))
+                         '(,INTERLISP-RECORD-NAME ,FIELD-NAMES))
+                   (IL:CLSMARTEN '((,NEW-NAME &KEY ,@FIELD-NAMES)))))))))
 
 (DEFUN RECORD-ACCESS-MACRO
 (FORM &OPTIONAL ENV)
    (DECLARE
 (IGNORE ENV))
@@ -257,8 +260,8 @@ IL:|{DSK}<usr>local>lde>lispcore>sources>XCL-EXTRAS.;1|)
 (DEFUN RECORD-PREDICATE-MACRO
 (FORM &OPTIONAL ENV)
    (DECLARE
 (IGNORE ENV))
    `(IL:|type?|
 ,(OR (GET (CAR FORM)
-                              :TYPE-INFO)
-                         (ERROR "No type information cached."))
+                          :TYPE-INFO)
+                     (ERROR "No type information cached."))
            ,(SECOND FORM)))
 
 (DEFUN RECORD-CONSTRUCTOR-MACRO
 (FORM &OPTIONAL ENV)
@@ -267,32 +270,35 @@ IL:|{DSK}<usr>local>lde>lispcore>sources>XCL-EXTRAS.;1|)
           (OR (GET (CAR FORM)
                    :FIELD-INFO)
               (ERROR "No field information cached."))
-          `(IL:|create|
 ,TYPE
-                  ,@(WITH-COLLECTION (DO* ((KEYWORD (CDR FORM)
-                                                  (CDDR KEYWORD))
-                                           (KEYWORD-SYMBOL (CAR KEYWORD)
-                                                  (CAR KEYWORD))
-                                           (VALUE (CADR KEYWORD)
-                                                  (CADR KEYWORD))
-                                           RESERVED-WORD)
-                                          ((NULL KEYWORD))
-                                        (SETQ RESERVED-WORD
-                                              (CAR (MEMBER KEYWORD-SYMBOL
-                                                          '(IL:USING
 IL:COPYING
 IL:REUSING

-                                                              IL:SMASHING
)
-                                                          :TEST
-                                                          'STRING=)))
-                                        (COLLECT (OR RESERVED-WORD (CAR (MEMBER KEYWORD-SYMBOL 
-                                                                               FIELD-NAMES :TEST
-                                                                               'STRING=))))
-                                        (IF (NOT RESERVED-WORD)
-                                            (COLLECT 'IL:_))
-                                        (COLLECT VALUE))))))
+          `(IL:|create|
 ,TYPE ,@(WITH-COLLECTION (DO* ((KEYWORD (CDR FORM)
+                                                              (CDDR KEYWORD))
+                                                       (KEYWORD-SYMBOL (CAR KEYWORD)
+                                                              (CAR KEYWORD))
+                                                       (VALUE (CADR KEYWORD)
+                                                              (CADR KEYWORD))
+                                                       RESERVED-WORD)
+                                                      ((NULL KEYWORD))
+                                                    (SETQ RESERVED-WORD
+                                                          (CAR (MEMBER KEYWORD-SYMBOL
+                                                                      '(IL:USING
 IL:COPYING

+                                                                          IL:REUSING
 IL:SMASHING
)
+                                                                      :TEST
+                                                                      'STRING=)))
+                                                    (COLLECT (OR RESERVED-WORD
+                                                                 (CAR (MEMBER KEYWORD-SYMBOL 
+                                                                             FIELD-NAMES :TEST
+                                                                             'STRING=))))
+                                                    (IF (NOT RESERVED-WORD)
+                                                        (COLLECT 'IL:_))
+                                                    (COLLECT VALUE))))))
 
 (IL:PUTPROPS IL:XCL-EXTRAS
 IL:FILETYPE
 :COMPILE-FILE)
 
 (IL:PUTPROPS IL:XCL-EXTRAS
 IL:MAKEFILE-ENVIRONMENT
 (:READTABLE "XCL" :PACKAGE "XCL"))
-(IL:PUTPROPS IL:XCL-EXTRAS IL:COPYRIGHT ("Venue & Xerox Corporation" 1987 1988 1990))
 (IL:DECLARE\: IL:DONTCOPY
-  (IL:FILEMAP (NIL)))
+  (IL:FILEMAP (NIL (2264 4771 (ONCE-ONLY 2264 . 4771)) (4828 5137 (RECORD-FETCH 4828 . 5137)) (5139 5483
+ (SETF-FETCH 5139 . 5483)) (5485 5796 (RECORD-FFETCH 5485 . 5796)) (5798 6144 (SETF-FFETCH 5798 . 6144
+)) (6146 7341 (RECORD-CREATE 6146 . 7341)) (12279 12699 (RECORD-ACCESS-MACRO 12279 . 12699)) (13146 
+13397 (RECORD-PREDICATE-MACRO 13146 . 13397)) (13399 15360 (RECORD-CONSTRUCTOR-MACRO 13399 . 15360))))
+)
 IL:STOP