diff --git a/doctools/IMINDEX b/doctools/IMINDEX
index 1e96d387..b0a0e94b 100644
--- a/doctools/IMINDEX
+++ b/doctools/IMINDEX
@@ -1,21 +1,20 @@
 (DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
-(FILECREATED "12-Feb-92 12:28:48" {DSK}<users>sybalsky>PUBS>IMINDEX.;2 37264  
 
-      changes to%:  (FNS IM.CHAP.DISPLAYFN)
+(FILECREATED " 6-Mar-2024 21:19:25" {WMEDLEY}<doctools>IMINDEX.;2 36416  
 
-      previous date%: " 8-Dec-91 15:46:22" {DSK}<users>sybalsky>PUBS>IMINDEX.;1)
+      :EDIT-BY rmk
 
+      :CHANGES-TO (VARS IMINDEXCOMS)
+
+      :PREVIOUS-DATE "12-Feb-92 12:28:48" {WMEDLEY}<doctools>IMINDEX.;1)
 
-(* ; "
-Copyright (c) 1986, 1987, 1988, 1991, 1992 by Xerox Corporation.  All rights reserved.
-")
 
 (PRETTYCOMPRINT IMINDEXCOMS)
 
 (RPAQQ IMINDEXCOMS
        (
         (* ;; 
-      "this file contains the functions used for creating and manipulating index image objects")
+        "this file contains the functions used for creating and manipulating index image objects")
 
         (FNS IM.INDEX.CLOSEF IM.INDEX.COPYFN IM.INDEX.CREATEOBJ IM.INDEX.DISPLAY.STRING 
              IM.INDEX.DISPLAYFN IM.INDEX.EDIT IM.INDEX.LIST.FROM.STRING IM.INDEX.SIZEFN 
@@ -32,12 +31,7 @@ Copyright (c) 1986, 1987, 1988, 1991, 1992 by Xerox Corporation.  All rights res
         (COMS                                                (* ; "An image object to set the chapter number, on the TEXTOBJ's proplist, on the INDEXING-CHAPTER property.")
               (FNS IM.CHAP.COPYFN IM.CHAP.CREATEOBJ IM.CHAP.DISPLAYFN IM.CHAP.SIZEFN IM.CHAP.PUTFN 
                    IM.CHAP.GETFN IM.CHAP.BUTTONEVENTFN))
-        (P (ADVISE 'TEDIT.FORMAT.HARDCOPY 'AROUND '(RESETLST
-                                                       (RESETSAVE NIL (LIST (FUNCTION IM.INDEX.CLOSEF
-                                                                                   )
-                                                                            STREAM))
-                                                       *))
-           (IM.INDEX.INIT))))
+        (P (IM.INDEX.INIT))))
 
 
 
@@ -494,9 +488,9 @@ Copyright (c) 1986, 1987, 1988, 1991, 1992 by Xerox Corporation.  All rights res
 (DECLARE%: EVAL@COMPILE
 
 (RECORD IM.INDEX.DATA (NAME TYPE SAV INFO SUBSEC PAGE# . PROPLIST)
-                          SUBSEC _ IM.INDEX.DEFAULT.SUBSEC (TYPE? (AND (LISTP DATUM)
-                                                                           (IGEQ (LENGTH DATUM)
-                                                                                 6))))
+                      SUBSEC _ IM.INDEX.DEFAULT.SUBSEC (TYPE? (AND (LISTP DATUM)
+                                                                   (IGEQ (LENGTH DATUM)
+                                                                         6))))
 )
 
 (RPAQQ IM.INDEX.OBJ.FREEMENU.SPECS
@@ -638,21 +632,15 @@ Copyright (c) 1986, 1987, 1988, 1991, 1992 by Xerox Corporation.  All rights res
     T])
 )
 
-(ADVISE 'TEDIT.FORMAT.HARDCOPY 'AROUND '(RESETLST
-                                            (RESETSAVE NIL (LIST (FUNCTION IM.INDEX.CLOSEF)
-                                                                 STREAM))
-                                            *))
-
 (IM.INDEX.INIT)
-(PUTPROPS IMINDEX COPYRIGHT ("Xerox Corporation" 1986 1987 1988 1991 1992))
 (DECLARE%: DONTCOPY
-  (FILEMAP (NIL (2160 15212 (IM.INDEX.CLOSEF 2170 . 2785) (IM.INDEX.COPYFN 2787 . 2972) (
-IM.INDEX.CREATEOBJ 2974 . 4320) (IM.INDEX.DISPLAY.STRING 4322 . 4743) (IM.INDEX.DISPLAYFN 4745 . 8588)
- (IM.INDEX.EDIT 8590 . 12058) (IM.INDEX.LIST.FROM.STRING 12060 . 13094) (IM.INDEX.SIZEFN 13096 . 13856
-) (IM.INDEX.STRING.FROM.LIST 13858 . 14103) (IM.INDEX.PUTFN 14105 . 14294) (IM.INDEX.GETFN 14296 . 
-14451) (IM.INDEX.BUTTONEVENTFN 14453 . 15210)) (15213 17283 (IM.INDEX.INIT 15223 . 17281)) (17284 
-29200 (IM.INDEX.MENU 17294 . 18982) (IM.INDEX.MENU.WHENSELECTEDFN 18984 . 25739) (
-IM.INDEX.OBJ.FREEMENU.SELECTEDFN 25741 . 29198)) (31736 36879 (IM.CHAP.COPYFN 31746 . 31926) (
-IM.CHAP.CREATEOBJ 31928 . 33354) (IM.CHAP.DISPLAYFN 33356 . 35316) (IM.CHAP.SIZEFN 35318 . 36320) (
-IM.CHAP.PUTFN 36322 . 36506) (IM.CHAP.GETFN 36508 . 36669) (IM.CHAP.BUTTONEVENTFN 36671 . 36877)))))
+  (FILEMAP (NIL (1673 14725 (IM.INDEX.CLOSEF 1683 . 2298) (IM.INDEX.COPYFN 2300 . 2485) (
+IM.INDEX.CREATEOBJ 2487 . 3833) (IM.INDEX.DISPLAY.STRING 3835 . 4256) (IM.INDEX.DISPLAYFN 4258 . 8101)
+ (IM.INDEX.EDIT 8103 . 11571) (IM.INDEX.LIST.FROM.STRING 11573 . 12607) (IM.INDEX.SIZEFN 12609 . 13369
+) (IM.INDEX.STRING.FROM.LIST 13371 . 13616) (IM.INDEX.PUTFN 13618 . 13807) (IM.INDEX.GETFN 13809 . 
+13964) (IM.INDEX.BUTTONEVENTFN 13966 . 14723)) (14726 16796 (IM.INDEX.INIT 14736 . 16794)) (16797 
+28713 (IM.INDEX.MENU 16807 . 18495) (IM.INDEX.MENU.WHENSELECTEDFN 18497 . 25252) (
+IM.INDEX.OBJ.FREEMENU.SELECTEDFN 25254 . 28711)) (31229 36372 (IM.CHAP.COPYFN 31239 . 31419) (
+IM.CHAP.CREATEOBJ 31421 . 32847) (IM.CHAP.DISPLAYFN 32849 . 34809) (IM.CHAP.SIZEFN 34811 . 35813) (
+IM.CHAP.PUTFN 35815 . 35999) (IM.CHAP.GETFN 36001 . 36162) (IM.CHAP.BUTTONEVENTFN 36164 . 36370)))))
 STOP
diff --git a/doctools/IMINDEX.LCOM b/doctools/IMINDEX.LCOM
index 02a963a9..133af2de 100644
Binary files a/doctools/IMINDEX.LCOM and b/doctools/IMINDEX.LCOM differ
diff --git a/doctools/IMTEDIT b/doctools/IMTEDIT
index 31b3417c..b5539ee0 100644
--- a/doctools/IMTEDIT
+++ b/doctools/IMTEDIT
@@ -1,17 +1,13 @@
 (DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
 
-(FILECREATED "20-Jul-2022 15:10:53" 
-{DSK}<Users>kaplan>Local>medley3.5>working-medley>doctools>IMTEDIT.;2 117347 
+(FILECREATED " 6-Mar-2024 21:18:02" {WMEDLEY}<doctools>IMTEDIT.;4 116622 
 
-      :CHANGES-TO (FNS MAKE.IM.DOCUMENT)
+      :EDIT-BY rmk
 
-      :PREVIOUS-DATE " 8-Dec-91 15:41:54" 
-{DSK}<Users>kaplan>Local>medley3.5>working-medley>doctools>IMTEDIT.;1)
+      :CHANGES-TO (FNS TRANSLATE.DUMPOUT MAKE.IM.DOCUMENT)
 
+      :PREVIOUS-DATE "20-Jul-2022 15:10:53" {WMEDLEY}<doctools>IMTEDIT.;2)
 
-(* ; "
-Copyright (c) 1983-1986, 1991 by Xerox Corporation.
-")
 
 (PRETTYCOMPRINT IMTEDITCOMS)
 
@@ -493,27 +489,26 @@ Copyright (c) 1983-1986, 1991 by Xerox Corporation.
     (DUMPOUT FONT LISP DUMP.CHARS SAV])
 
 (MAKE.IM.DOCUMENT
-  [LAMBDA (FORM OUTFILE.FLG PAGE.LAYOUT OUTPUT.MESSAGE DEFAULT.PARALOOKS PTRFILENAME)
-                                                             (* ; "Edited 20-Jul-2022 15:10 by rmk")
+  [LAMBDA (FORM OUTFILE.FLG PAGE.LAYOUT OUTPUT.MESSAGE DEFAULT.PARALOOKS PTRFILENAME)
+
+    (* ;; "Edited  6-Mar-2024 21:17 by rmk: Fixed backquote commas. Also put IM.INDEX.CLOSEF calls in TEXTPROPs so advice in IMINDEX can be eliminated.")
+
+    (* ;; "Edited 20-Jul-2022 15:10 by rmk")
                                                              (* mjs " 4-Aug-86 10:52")
 
-         (* * this function creates an IM output file, in XPS-compatible format.
-         If sets up all of the special variables needed by DUMP, evaluates FORM, and sets 
-         all of the para and font looks)
+(* ;;; "this function creates an IM output file, in XPS-compatible format.  If sets up all of the special variables needed by DUMP, evaluates FORM, and sets all of the para and font looks")
 
-         (* * If OUTFILE.FLG is NIL, the output file is just sent to the default printer.
-         If OUTFILE.FLG is T, the outfile textstream is simply returned.
-         If OUTFILE.FLG = anything else, it is taken as a file name to put the press file 
-         which is created <but not printed>.)
+(* ;;; "If OUTFILE.FLG is NIL, the output file is just sent to the default printer.  If OUTFILE.FLG is T, the outfile textstream is simply returned.  If OUTFILE.FLG = anything else, it is taken as a file name to put the press file which is created <but not printed>.")
 
-         (* * if PAGE.LAYOUT is non-NIL, it should be the compound page layout to be used.)
+(* ;;; "if PAGE.LAYOUT is non-NIL, it should be the compound page layout to be used.")
 
-         (* * if OUTPUT.MESSAGE is non-NIL, it is printed on the hardcopy output)
+(* ;;; "if OUTPUT.MESSAGE is non-NIL, it is printed on the hardcopy output")
 
-         (* * PTRFILENAME is the name to be used if an index pointer file is generated 
-         during hardcopy <by printing index objects>)
+(* ;;; "PTRFILENAME is the name to be used if an index pointer file is generated during hardcopy <by printing index objects>")
 
-    (PROG ((IM.OUTFILE (OPENTEXTSTREAM NIL NIL NIL NIL (LIST 'IM.INDEX.PTRFILENAME PTRFILENAME)))
+    (PROG ([IM.OUTFILE (OPENTEXTSTREAM NIL NIL NIL NIL `(IM.INDEX.PTRFILENAME ,PTRFILENAME 
+                                                               AFTERHARDCOPYFN (FUNCTION 
+                                                                                IM.INDEX.INIT]
            (FONT.STACK (CONS))
            (IM.TEDIT.LAST.PARA.BEGIN 1)
            (IM.TEDIT.LAST.FONT.BEGIN 1)
@@ -532,7 +527,7 @@ Copyright (c) 1983-1986, 1991 by Xerox Corporation.
           (DUMP.HEADERS.FOOTERS "  " "  ")
           (DUMPOUT CR CR START.PARA PARALOOKS
                  `(TYPE PAGEHEADING SUBTYPE DRAFTMESSAGE QUAD LEFT 1STLEFTMARGIN 0 LEFTMARGIN 0 
-                        RIGHTMARGIN %, IM.TEXT.RIGHTMARGIN)
+                        RIGHTMARGIN ,IM.TEXT.RIGHTMARGIN)
                  DUMP.CHARS
                  (COND
                     (IM.DRAFT.FLG (CONCAT "***DRAFT***  " (DATE)
@@ -543,73 +538,65 @@ Copyright (c) 1983-1986, 1991 by Xerox Corporation.
           (COND
              (IM.EVEN.FLG 
 
-         (* if you must quarantee that you have an even number of pages for two-sided 
-         copying, dump out a blank page no matter what --
-         it can always be discarded)
+                    (* ;; "if you must quarantee that you have an even number of pages for two-sided copying, dump out a blank page no matter what -- it can always be discarded")
 
                     (DUMPOUT CR CR START.PARA PARALOOKS
-                           `(NEWPAGEBEFORE T QUAD LEFT 1STLEFTMARGIN 0 LEFTMARGIN 0 RIGHTMARGIN %, 
-                                   IM.TEXT.RIGHTMARGIN SPECIALX %, IM.BLANKPAGE.SPECIALX SPECIALY %,
-                                   IM.BLANKPAGE.SPECIALY)
+                           `(NEWPAGEBEFORE T QUAD LEFT 1STLEFTMARGIN 0 LEFTMARGIN 0 RIGHTMARGIN
+                                   ,IM.TEXT.RIGHTMARGIN SPECIALX ,IM.BLANKPAGE.SPECIALX SPECIALY
+                                   ,IM.BLANKPAGE.SPECIALY)
                            DUMP.CHARS "[This page intentionally left blank]" CR CR)))
 
-         (* after converting document, make sure that last para is formatted correctly by 
-         changing font, ending current para, and starting new para)
+     (* ;; "after converting document, make sure that last para is formatted correctly by changing font, ending current para, and starting new para")
 
           (DUMPOUT CR CR FONT NIL)
           (DUMP '(START.PARA))
 
-         (* * set page format)
+(* ;;; "set page format")
 
           [TEDIT.PAGEFORMAT IM.OUTFILE
                  (COND
                     (PAGE.LAYOUT)
-                    (T (TEDIT.COMPOUND.PAGEFORMAT [TEDIT.SINGLE.PAGEFORMAT NIL NIL NIL NIL NIL 
-                                                         IM.PAGE.LEFTMARGIN IM.PAGE.RIGHTMARGIN 
-                                                         IM.PAGE.FIRST.TOPMARGIN IM.PAGE.BOTTOMMARGIN
-                                                         1 NIL NIL
-                                                         `((RECTOFOOT %, IM.PAGE.LEFTMARGIN %, 
-                                                                  IM.FOOTER.Y)
-                                                           (RECTOFOOTRULE %, IM.PAGE.LEFTMARGIN %, 
-                                                                  IM.FOOTER.RULE.Y)
-                                                           (DRAFTMESSAGE %, IM.DRAFT.MESSAGE.X %, 
-                                                                  IM.DRAFT.MESSAGE.BOTTOM.Y]
+                    (T (TEDIT.COMPOUND.PAGEFORMAT [TEDIT.SINGLE.PAGEFORMAT
+                                                   NIL NIL NIL NIL NIL IM.PAGE.LEFTMARGIN 
+                                                   IM.PAGE.RIGHTMARGIN IM.PAGE.FIRST.TOPMARGIN 
+                                                   IM.PAGE.BOTTOMMARGIN 1 NIL NIL
+                                                   `((RECTOFOOT ,IM.PAGE.LEFTMARGIN ,IM.FOOTER.Y)
+                                                     (RECTOFOOTRULE ,IM.PAGE.LEFTMARGIN 
+                                                            ,IM.FOOTER.RULE.Y)
+                                                     (DRAFTMESSAGE ,IM.DRAFT.MESSAGE.X 
+                                                            ,IM.DRAFT.MESSAGE.BOTTOM.Y]
                               [TEDIT.SINGLE.PAGEFORMAT NIL NIL NIL NIL NIL IM.PAGE.LEFTMARGIN 
                                      IM.PAGE.RIGHTMARGIN IM.PAGE.TOPMARGIN IM.PAGE.BOTTOMMARGIN 1 NIL
-                                     NIL `((DRAFTMESSAGE %, IM.DRAFT.MESSAGE.X %, 
-                                                  IM.DRAFT.MESSAGE.TOP.Y)
-                                           (VERSOHEAD %, IM.PAGE.LEFTMARGIN %, IM.HEADER.Y)
-                                           (VERSOHEADRULE %, IM.PAGE.LEFTMARGIN %, IM.HEADER.RULE.Y)
-                                           (VERSOFOOT %, IM.PAGE.LEFTMARGIN %, IM.FOOTER.Y)
-                                           (VERSOFOOTRULE %, IM.PAGE.LEFTMARGIN %, IM.FOOTER.RULE.Y)
-                                           (DRAFTMESSAGE %, IM.DRAFT.MESSAGE.X %, 
-                                                  IM.DRAFT.MESSAGE.BOTTOM.Y]
+                                     NIL `((DRAFTMESSAGE ,IM.DRAFT.MESSAGE.X ,IM.DRAFT.MESSAGE.TOP.Y)
+                                           (VERSOHEAD ,IM.PAGE.LEFTMARGIN ,IM.HEADER.Y)
+                                           (VERSOHEADRULE ,IM.PAGE.LEFTMARGIN ,IM.HEADER.RULE.Y)
+                                           (VERSOFOOT ,IM.PAGE.LEFTMARGIN ,IM.FOOTER.Y)
+                                           (VERSOFOOTRULE ,IM.PAGE.LEFTMARGIN ,IM.FOOTER.RULE.Y)
+                                           (DRAFTMESSAGE ,IM.DRAFT.MESSAGE.X 
+                                                  ,IM.DRAFT.MESSAGE.BOTTOM.Y]
                               (TEDIT.SINGLE.PAGEFORMAT NIL NIL NIL NIL NIL IM.PAGE.LEFTMARGIN 
                                      IM.PAGE.RIGHTMARGIN IM.PAGE.TOPMARGIN IM.PAGE.BOTTOMMARGIN 1 NIL
-                                     NIL `((DRAFTMESSAGE %, IM.DRAFT.MESSAGE.X %, 
-                                                  IM.DRAFT.MESSAGE.TOP.Y)
-                                           (RECTOHEAD %, IM.PAGE.LEFTMARGIN %, IM.HEADER.Y)
-                                           (RECTOHEADRULE %, IM.PAGE.LEFTMARGIN %, IM.HEADER.RULE.Y)
-                                           (RECTOFOOT %, IM.PAGE.LEFTMARGIN %, IM.FOOTER.Y)
-                                           (RECTOFOOTRULE %, IM.PAGE.LEFTMARGIN %, IM.FOOTER.RULE.Y)
-                                           (DRAFTMESSAGE %, IM.DRAFT.MESSAGE.X %, 
-                                                  IM.DRAFT.MESSAGE.BOTTOM.Y]
+                                     NIL `((DRAFTMESSAGE ,IM.DRAFT.MESSAGE.X ,IM.DRAFT.MESSAGE.TOP.Y)
+                                           (RECTOHEAD ,IM.PAGE.LEFTMARGIN ,IM.HEADER.Y)
+                                           (RECTOHEADRULE ,IM.PAGE.LEFTMARGIN ,IM.HEADER.RULE.Y)
+                                           (RECTOFOOT ,IM.PAGE.LEFTMARGIN ,IM.FOOTER.Y)
+                                           (RECTOFOOTRULE ,IM.PAGE.LEFTMARGIN ,IM.FOOTER.RULE.Y)
+                                           (DRAFTMESSAGE ,IM.DRAFT.MESSAGE.X 
+                                                  ,IM.DRAFT.MESSAGE.BOTTOM.Y]
 
-         (* * dump default char and para looks for whole document --
-         and looks that should be different should be specified in the fns)
+(* ;;; "dump default char and para looks for whole document -- and looks that should be different should be specified in the fns")
 
           (TEDIT.LOOKS IM.OUTFILE IM.TEXT.FONT 1 (GETFILEINFO IM.OUTFILE 'LENGTH))
-          (TEDIT.PARALOOKS IM.OUTFILE
-                 [COND
-                    (DEFAULT.PARALOOKS)
-                    (T `(QUAD JUSTIFIED 1STLEFTMARGIN %, IM.TEXT.LEFTMARGIN LEFTMARGIN %, 
-                              IM.TEXT.LEFTMARGIN RIGHTMARGIN %, IM.TEXT.RIGHTMARGIN LINELEADING 0 
-                              PARALEADING 5 POSTPARALEADING 0]
+          (TEDIT.PARALOOKS IM.OUTFILE [COND
+                                         (DEFAULT.PARALOOKS)
+                                         (T `(QUAD JUSTIFIED 1STLEFTMARGIN ,IM.TEXT.LEFTMARGIN 
+                                                   LEFTMARGIN ,IM.TEXT.LEFTMARGIN RIGHTMARGIN
+                                                   ,IM.TEXT.RIGHTMARGIN LINELEADING 0 PARALEADING 5 
+                                                   POSTPARALEADING 0]
                  1
                  (GETFILEINFO IM.OUTFILE 'LENGTH))
 
-         (* must reverse list because the order of some char and paragraph looks is 
-         significant << earlier looks are overridden by later ones >>)
+     (* ;; "must reverse list because the order of some char and paragraph looks is significant << earlier looks are overridden by later ones >>")
 
           (SETQ IM.CHARLOOKS (DREVERSE IM.CHARLOOKS))
           (SETQ IM.PARALOOKS (DREVERSE IM.PARALOOKS))
@@ -2309,83 +2296,75 @@ page edge.)
 (DEFINEQ
 
 (TRANSLATE.DUMPOUT
-  [LAMBDA (DUMPOUT.ARGS)                                 (* mjs "18-Sep-85 16:17")
+  [LAMBDA (DUMPOUT.ARGS)                                     (* mjs "18-Sep-85 16:17")
 
-         (* * this function translates the DUMPOUT macro form into a PROGN form that 
-       calls a series of functions, such as DUMP.)
+         (* * this function translates the DUMPOUT macro form into a PROGN form that calls 
+         a series of functions, such as DUMP.)
 
          (* * the indentation code has been commented out ---
-       will try indenting everything to same, unless specified otherwise with 
-       PARALOOKS)
+         will try indenting everything to same, unless specified otherwise with PARALOOKS)
 
     (PROG ((DUMPOUT.FORMS NIL)
            (DUMPOUT.UNDO NIL)
            COMM COMM.ARG)
           [while DUMPOUT.ARGS do (SELECTQ (SETQ COMM (pop DUMPOUT.ARGS))
-                                             (NIL)
-                                             ((CR TAB START.PARA DUMP.FOOTNOTES START.SUPER START.SUB
-                                                  END.SUPER END.SUB) 
-                                                             (* just pass these atoms as commands 
-                                                           to DUMP)
-                                                  (push DUMPOUT.FORMS (LIST 'DUMP.FORMAT
-                                                                                (KWOTE COMM))))
-                                             ((FLUSH.ARG TRIVIAL.ARG DUMP.ARG) 
-                                                  (push DUMPOUT.FORMS (LIST COMM)))
-                                             (INDENT 
+                                     (NIL)
+                                     ((CR TAB START.PARA DUMP.FOOTNOTES START.SUPER START.SUB 
+                                          END.SUPER END.SUB) (* just pass these atoms as commands 
+                                                             to DUMP)
+                                          (push DUMPOUT.FORMS (LIST 'DUMP.FORMAT (KWOTE COMM))))
+                                     ((FLUSH.ARG TRIVIAL.ARG DUMP.ARG) 
+                                          (push DUMPOUT.FORMS (LIST COMM)))
+                                     (INDENT 
 
          (* * SELECTQ (SETQ COMM.ARG (pop DUMPOUT.ARGS))
-       (INIT (push DUMPOUT.FORMS (QUOTE (PUT.MY.PROP
-       (QUOTE INDENT) INITIAL.INDENT))) (push DUMPOUT.FORMS
-       (QUOTE (PUT.MY.PROP (QUOTE WIDTH) INITIAL.WIDTH)))
-       (push DUMPOUT.FORMS (QUOTE (DUMP.FORMAT
-       (QUOTE INDENT) INITIAL.INDENT)))) (NONE
-       (push DUMPOUT.FORMS (QUOTE (PUT.MY.PROP
-       (QUOTE INDENT) (QUOTE NONE)))) (push DUMPOUT.FORMS
-       (QUOTE (PUT.MY.PROP (QUOTE WIDTH) (ANC.WIDTH))))
-       (push DUMPOUT.FORMS (QUOTE (DUMP.FORMAT
-       (QUOTE INDENT) (QUOTE NONE))))) (push DUMPOUT.FORMS
-       (LIST (QUOTE (LAMBDA (I) (PUT.MY.PROP (QUOTE INDENT)
-       (IPLUS (ANC.INDENT) I)) (PUT.MY.PROP (QUOTE WIDTH)
-       (IDIFFERENCE (ANC.WIDTH) I)) (DUMP.FORMAT
-       (QUOTE INDENT) (IPLUS (ANC.INDENT) I)))) COMM.ARG)))
+         (INIT (push DUMPOUT.FORMS (QUOTE (PUT.MY.PROP
+         (QUOTE INDENT) INITIAL.INDENT))) (push DUMPOUT.FORMS
+         (QUOTE (PUT.MY.PROP (QUOTE WIDTH) INITIAL.WIDTH)))
+         (push DUMPOUT.FORMS (QUOTE (DUMP.FORMAT (QUOTE INDENT) INITIAL.INDENT))))
+         (NONE (push DUMPOUT.FORMS (QUOTE (PUT.MY.PROP
+         (QUOTE INDENT) (QUOTE NONE)))) (push DUMPOUT.FORMS
+         (QUOTE (PUT.MY.PROP (QUOTE WIDTH) (ANC.WIDTH))))
+         (push DUMPOUT.FORMS (QUOTE (DUMP.FORMAT (QUOTE INDENT)
+         (QUOTE NONE))))) (push DUMPOUT.FORMS (LIST
+         (QUOTE (LAMBDA (I) (PUT.MY.PROP (QUOTE INDENT)
+         (IPLUS (ANC.INDENT) I)) (PUT.MY.PROP (QUOTE WIDTH)
+         (IDIFFERENCE (ANC.WIDTH) I)) (DUMP.FORMAT
+         (QUOTE INDENT) (IPLUS (ANC.INDENT) I)))) COMM.ARG)))
 
          (* * push DUMPOUT.UNDO (QUOTE INDENT))
 
-                                                     (SETQ COMM.ARG (pop DUMPOUT.ARGS)))
-                                             (WIDTH (push DUMPOUT.FORMS
-                                                           (LIST 'PUT.MY.PROP (KWOTE 'WIDTH)
-                                                                 (pop DUMPOUT.ARGS))))
-                                             (FONT (SETQ COMM.ARG (pop DUMPOUT.ARGS))
-                                                   [push DUMPOUT.FORMS
-                                                          (LIST 'DUMP.FORMAT (KWOTE 'FONT)
-                                                                (COND
-                                                                   ((LISTGET IM.TEDIT.FONT.DEFS 
-                                                                           COMM.ARG)
-                                                                    (KWOTE COMM.ARG))
-                                                                   (T COMM.ARG]
-                                                   (push DUMPOUT.UNDO 'FONT))
-                                             (PARALOOKS (push DUMPOUT.FORMS
-                                                               (LIST 'DUMP.FORMAT (KWOTE 'PARALOOKS)
-                                                                     (pop DUMPOUT.ARGS))))
-                                             (DUMP.CHARS (push DUMPOUT.FORMS
-                                                                (LIST (FUNCTION IM.DUMP.CHARS)
+                                             (SETQ COMM.ARG (pop DUMPOUT.ARGS)))
+                                     (WIDTH (push DUMPOUT.FORMS (LIST 'PUT.MY.PROP
+                                                                      (KWOTE 'WIDTH)
                                                                       (pop DUMPOUT.ARGS))))
-                                             (push DUMPOUT.FORMS (LIST 'DUMP.FORMAT
-                                                                           (KWOTE 'TEXT)
-                                                                           (LIST 'MAKE.SAVE COMM]
-          [for X in DUMPOUT.UNDO do (push DUMPOUT.FORMS (LIST 'DUMP.FORMAT
-                                                                              (KWOTE 'UNDO)
-                                                                              (KWOTE X]
+                                     (FONT (SETQ COMM.ARG (pop DUMPOUT.ARGS))
+                                           [push DUMPOUT.FORMS (LIST 'DUMP.FORMAT (KWOTE 'FONT)
+                                                                     (COND
+                                                                        ((LISTGET IM.TEDIT.FONT.DEFS
+                                                                                COMM.ARG)
+                                                                         (KWOTE COMM.ARG))
+                                                                        (T COMM.ARG]
+                                           (push DUMPOUT.UNDO 'FONT))
+                                     (PARALOOKS (push DUMPOUT.FORMS (LIST 'DUMP.FORMAT
+                                                                          (KWOTE 'PARALOOKS)
+                                                                          (pop DUMPOUT.ARGS))))
+                                     (DUMP.CHARS (push DUMPOUT.FORMS (LIST (FUNCTION IM.DUMP.CHARS)
+                                                                           (pop DUMPOUT.ARGS))))
+                                     (push DUMPOUT.FORMS (LIST 'DUMP.FORMAT (KWOTE 'TEXT)
+                                                               (LIST 'MAKE.SAVE COMM]
+          [for X in DUMPOUT.UNDO do (push DUMPOUT.FORMS (LIST 'DUMP.FORMAT (KWOTE 'UNDO)
+                                                              (KWOTE X]
 
          (* * push DUMPOUT.FORMS (QUOTE (PUT.MY.PROP
-       (QUOTE INDENT) DUMPOUT.SAVE.INDENT)))
+         (QUOTE INDENT) DUMPOUT.SAVE.INDENT)))
 
          (* * push DUMPOUT.FORMS (QUOTE (PUT.MY.PROP
-       (QUOTE WIDTH) DUMPOUT.SAVE.WIDTH)))
+         (QUOTE WIDTH) DUMPOUT.SAVE.WIDTH)))
 
          (* * RETURN (APPEND (QUOTE (PROG ((DUMPOUT.SAVE.INDENT
-       (GET.MY.PROP (QUOTE INDENT))) (DUMPOUT.SAVE.WIDTH
-       (GET.MY.PROP (QUOTE WIDTH)))))) (DREVERSE DUMPOUT.FORMS)))
+         (GET.MY.PROP (QUOTE INDENT))) (DUMPOUT.SAVE.WIDTH
+         (GET.MY.PROP (QUOTE WIDTH)))))) (DREVERSE DUMPOUT.FORMS)))
 
           (RETURN (CONS 'PROGN (DREVERSE DUMPOUT.FORMS])
 
@@ -2408,25 +2387,24 @@ page edge.)
 
 (PUTPROPS SAVE.DUMPOUT MACRO (X (TRANSLATE.SAVE.DUMPOUT X)))
 )
-(PUTPROPS IMTEDIT COPYRIGHT ("Xerox Corporation" 1983 1984 1985 1986 1991))
 (DECLARE%: DONTCOPY
-  (FILEMAP (NIL (10773 38278 (IM.TEDIT 10783 . 12464) (DUMP 12466 . 14761) (DUMP.HEADERS.FOOTERS 14763
- . 17129) (DUMP.HRULE 17131 . 18282) (CHANGE.FONT 18284 . 19478) (IM.BOUT.IMAGEOBJ 19480 . 19803) (
-IM.TEDIT.DUMP.COMMANDS 19805 . 23358) (IM.TEDIT.DUMP.FOOTNOTES 23360 . 23801) (IM.TEDIT.DUMP.PARA 
-23803 . 24577) (INDEXX.PARSE.TYPE 24579 . 25874) (FORMAT.DEF 25876 . 28007) (FORMAT.LISPWORD 28009 . 
-28160) (MAKE.IM.DOCUMENT 28162 . 37133) (PRINT.NOTE 37135 . 37349) (SEND.INFO 37351 . 38276)) (38387 
-42405 (IM.VRULE.DISPLAYFN 38397 . 38721) (CREATE.VRULE.OBJECT 38723 . 40503) (PRINT.VRULES.ON.PAGE 
-40505 . 42403)) (42563 47318 (IM.FOLIO.DISPLAYFN 42573 . 43251) (IM.FOLIO.SIZEFN 43253 . 44102) (
-CREATE.FOLIO.OBJECT 44104 . 45650) (GET.FOLIO.STRING 45652 . 47316)) (47450 93690 (ARG#TOPROG 47460 . 
-47599) (BIGLISPCODE#TOPROG 47601 . 48837) (BRACKET#TOPROG 48839 . 49003) (CHAPTER#TOPROG 49005 . 51686
-) (COMMENT#TOPROG 51688 . 52240) (DEF#TOPROG 52242 . 55577) (FIGURE#TOPROG 55579 . 56923) (FN#TOPROG 
-56925 . 57322) (FNDEF#TOPROG 57324 . 61216) (FOOT#TOPROG 61218 . 61759) (INCLUDE#TOPROG 61761 . 62076)
- (INDEX#TOPROG 62078 . 63168) (INDEXX#TOPROG 63170 . 65251) (IT#TOPROG 65253 . 65394) (LBRACKET#TOPROG
- 65396 . 65550) (LISP#TOPROG 65552 . 65693) (LISPCODE#TOPROG 65695 . 66814) (LISPWORD#TOPROG 66816 . 
-67556) (LIST#TOPROG 67558 . 71980) (MACDEF#TOPROG 71982 . 73160) (NOTE#TOPROG 73162 . 73842) (
-PRINT.SPECIAL.CHARS#TOPROG 73844 . 74821) (PROPDEF#TOPROG 74823 . 75100) (RBRACKET#TOPROG 75102 . 
-75256) (REF#TOPROG 75258 . 83097) (RM#TOPROG 83099 . 83237) (SUB#TOPROG 83239 . 83387) (SUBSEC#TOPROG 
-83389 . 87892) (SUPER#TOPROG 87894 . 88048) (TABLE#TOPROG 88050 . 92002) (TAG#TOPROG 92004 . 92271) (
-TERM#TOPROG 92273 . 92586) (VAR#TOPROG 92588 . 92991) (VARDEF#TOPROG 92993 . 93688)) (111336 116764 (
-TRANSLATE.DUMPOUT 111346 . 116363) (TRANSLATE.SAVE.DUMPOUT 116365 . 116762)))))
+  (FILEMAP (NIL (10668 38115 (IM.TEDIT 10678 . 12359) (DUMP 12361 . 14656) (DUMP.HEADERS.FOOTERS 14658
+ . 17024) (DUMP.HRULE 17026 . 18177) (CHANGE.FONT 18179 . 19373) (IM.BOUT.IMAGEOBJ 19375 . 19698) (
+IM.TEDIT.DUMP.COMMANDS 19700 . 23253) (IM.TEDIT.DUMP.FOOTNOTES 23255 . 23696) (IM.TEDIT.DUMP.PARA 
+23698 . 24472) (INDEXX.PARSE.TYPE 24474 . 25769) (FORMAT.DEF 25771 . 27902) (FORMAT.LISPWORD 27904 . 
+28055) (MAKE.IM.DOCUMENT 28057 . 36970) (PRINT.NOTE 36972 . 37186) (SEND.INFO 37188 . 38113)) (38224 
+42242 (IM.VRULE.DISPLAYFN 38234 . 38558) (CREATE.VRULE.OBJECT 38560 . 40340) (PRINT.VRULES.ON.PAGE 
+40342 . 42240)) (42400 47155 (IM.FOLIO.DISPLAYFN 42410 . 43088) (IM.FOLIO.SIZEFN 43090 . 43939) (
+CREATE.FOLIO.OBJECT 43941 . 45487) (GET.FOLIO.STRING 45489 . 47153)) (47287 93527 (ARG#TOPROG 47297 . 
+47436) (BIGLISPCODE#TOPROG 47438 . 48674) (BRACKET#TOPROG 48676 . 48840) (CHAPTER#TOPROG 48842 . 51523
+) (COMMENT#TOPROG 51525 . 52077) (DEF#TOPROG 52079 . 55414) (FIGURE#TOPROG 55416 . 56760) (FN#TOPROG 
+56762 . 57159) (FNDEF#TOPROG 57161 . 61053) (FOOT#TOPROG 61055 . 61596) (INCLUDE#TOPROG 61598 . 61913)
+ (INDEX#TOPROG 61915 . 63005) (INDEXX#TOPROG 63007 . 65088) (IT#TOPROG 65090 . 65231) (LBRACKET#TOPROG
+ 65233 . 65387) (LISP#TOPROG 65389 . 65530) (LISPCODE#TOPROG 65532 . 66651) (LISPWORD#TOPROG 66653 . 
+67393) (LIST#TOPROG 67395 . 71817) (MACDEF#TOPROG 71819 . 72997) (NOTE#TOPROG 72999 . 73679) (
+PRINT.SPECIAL.CHARS#TOPROG 73681 . 74658) (PROPDEF#TOPROG 74660 . 74937) (RBRACKET#TOPROG 74939 . 
+75093) (REF#TOPROG 75095 . 82934) (RM#TOPROG 82936 . 83074) (SUB#TOPROG 83076 . 83224) (SUBSEC#TOPROG 
+83226 . 87729) (SUPER#TOPROG 87731 . 87885) (TABLE#TOPROG 87887 . 91839) (TAG#TOPROG 91841 . 92108) (
+TERM#TOPROG 92110 . 92423) (VAR#TOPROG 92425 . 92828) (VARDEF#TOPROG 92830 . 93525)) (111173 116115 (
+TRANSLATE.DUMPOUT 111183 . 115714) (TRANSLATE.SAVE.DUMPOUT 115716 . 116113)))))
 STOP
diff --git a/doctools/IMTEDIT.LCOM b/doctools/IMTEDIT.LCOM
index ae61f369..68d91551 100644
Binary files a/doctools/IMTEDIT.LCOM and b/doctools/IMTEDIT.LCOM differ
diff --git a/internal/loadups/LOADUP-LISP b/internal/loadups/LOADUP-LISP
index 140f17a9..006b3fc7 100644
--- a/internal/loadups/LOADUP-LISP
+++ b/internal/loadups/LOADUP-LISP
@@ -1,11 +1,13 @@
 (DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "XCL" BASE 10)
 
-(FILECREATED "31-Jul-2023 18:22:53" |{DSK}<home>frank>il>medley>gmedley>sources>LOADUP-LISP.;2| 5235   
+(FILECREATED "14-Mar-2024 12:16:33" |{DSK}<home>larry>il>medley>internal>loadups>LOADUP-LISP.;2| 5426   
+
+      :EDIT-BY "lmm"
 
       :CHANGES-TO (FNS LOADUP-LISP)
 
-      :PREVIOUS-DATE "27-Feb-2023 17:15:53" 
-|{DSK}<home>frank>il>medley>gmedley>sources>LOADUP-LISP.;1|)
+      :PREVIOUS-DATE "31-Jul-2023 18:22:53" 
+|{DSK}<home>larry>il>medley>internal>loadups>LOADUP-LISP.;1|)
 
 
 (PRETTYCOMPRINT LOADUP-LISPCOMS)
@@ -18,7 +20,8 @@
 (DEFINEQ
 
 (LOADUP-LISP
-  (LAMBDA (DRIBBLEFILE)                                     (* \; "Edited 26-Feb-2023 12:17 by lmm")
+  (LAMBDA (DRIBBLEFILE)                                     (* \; "Edited 14-Mar-2024 12:16 by lmm")
+                                                            (* \; "Edited 26-Feb-2023 12:17 by lmm")
                                                             (* \; "Edited 13-Jul-2022 14:09 by rmk")
                                                           (* \; "Edited  4-Mar-2022 19:13 by larry")
                                                            (* \; "Edited 29-Apr-2021 22:30 by rmk:")
@@ -107,6 +110,10 @@
 
     (PACKAGE-ENABLE)
 
+    (* |;;| " Added late")
+
+    (LOADUP '(XCL-LOOP))
+
     (* |;;| " networking code -- should make it optional but too many cross dependencies")
 
     (LOADUP '(PUP 10MBDRIVER LEAF LLETHER DPUPFTP LOCALFILE DSKDISPLAY COURIER LLNS TRSERVER SPP 
@@ -123,5 +130,5 @@
 (GLOBALVARS MAKESYSFILENAME MEDLEY-INIT-VARS MEDLEYDIR SYSTEMINITVARS USERRECLST)
 )
 (DECLARE\: DONTCOPY
-  (FILEMAP (NIL (649 5029 (LOADUP-LISP 659 . 5027)))))
+  (FILEMAP (NIL (673 5220 (LOADUP-LISP 683 . 5218)))))
 STOP
diff --git a/internal/loadups/LOADUP-LISP.LCOM b/internal/loadups/LOADUP-LISP.LCOM
index 46a716e5..b76af649 100644
Binary files a/internal/loadups/LOADUP-LISP.LCOM and b/internal/loadups/LOADUP-LISP.LCOM differ
diff --git a/library/lafite/LAFITE b/library/lafite/LAFITE
index 57fb5654..7cd7be7e 100644
--- a/library/lafite/LAFITE
+++ b/library/lafite/LAFITE
@@ -1,16 +1,13 @@
 (DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
-(FILECREATED "30-Sep-2021 22:59:08" 
-{DSK}<Users>kaplan>Local>medley3.5>git-medley>library>lafite>LAFITE.;5 71956  
 
-      changes to%:  (FILES LAFITEDECLS)
+(FILECREATED "26-Feb-2024 20:10:22" {WMEDLEY}<library>lafite>LAFITE.;19 72156  
 
-      previous date%: "24-Jun-2021 19:17:01" 
-{DSK}<Users>kaplan>Local>medley3.5>git-medley>library>lafite>LAFITE.;4)
+      :EDIT-BY rmk
 
+      :CHANGES-TO (VARS LAFITECOMS LAFITEFILES)
+
+      :PREVIOUS-DATE "24-Feb-2024 11:56:21" {WMEDLEY}<library>lafite>LAFITE.;18)
 
-(* ; "
-Copyright (c) 1982-1989, 1993-1994, 2021 by Xerox Corporation and Bolt Beranek and Newman Inc..
-")
 
 (PRETTYCOMPRINT LAFITECOMS)
 
@@ -86,29 +83,29 @@ Copyright (c) 1982-1989, 1993-1994, 2021 by Xerox Corporation and Bolt Beranek a
                    \LAFITE.CLOSE.FOLDER)
               (FNS \LAFITE.DESCRIBE.FOLDER))
         (COMS                                                (* ; 
-                                                      "Make is easy to load new versions of Lafite")
+                                                        "Make is easy to load new versions of Lafite")
               (FNS LOAD-LAFITE)
               (VARS LAFITEFILES))
         [DECLARE%: DOEVAL@COMPILE DONTCOPY (FILES (SOURCE)
-                                                  LAFITEDECLS)
+                                                  LAFITE-DECLS)
                (LOCALVARS . T)
                (GLOBALVARS TEDIT.DEFAULT.MENU LAFITEFILES *COMPILED-EXTENSIONS*)
                (P (CL:PROCLAIM '(CL:SPECIAL *LAFITE-LOGGING-IN*]
         (INITRECORDS MAILFOLDER LAFITEMSG)
         (SYSRECORDS MAILFOLDER LAFITEMSG)
         [COMS (FNS \LAFITE.GLOBAL.INIT)
-              (DECLARE%: DONTEVAL@LOAD DOCOPY
-                     (FILES LAFITEBROWSE LAFITECOMMANDS LAFITEFOLDERS LAFITESEND LAFITEMAIL 
-                            LAFITESORT TEDIT LAFITETEDIT LAFITEFIND ATTACHEDWINDOW MAILSCAVENGE)
+              (DECLARE%: DONTEVAL@LOAD DOCOPY (FILES TEDIT ATTACHEDWINDOW)
+                     (FILES LAFITE-BROWSE LAFITE-COMMANDS LAFITE-FOLDERS LAFITE-SEND LAFITE-MAIL 
+                            LAFITE-SORT LAFITE-TEDIT LAFITE-FIND LAFITE-MAILSCAVENGE)
                      (P * (PROGN LAFITE.PROCLAMATIONS))
                                                              (* ; 
-                                      "Proclaim user interface variables.  Value is on LAFITEDECLS")
+                                       "Proclaim user interface variables.  Value is on LAFITE-DECLS")
                      (P (\LAFITE.GLOBAL.INIT)
                         (COND ((EQ MAKESYSNAME :LYRIC)
                                (FILESLOAD (SYSLOAD)
                                       NSCHARPATCH)
                                                              (* ; 
-                                                           "Patch to horrid Lyric NS chars bug")
+                                                             "Patch to horrid Lyric NS chars bug")
                                (MOVD? 'PROMPTFORWORD 'TTYINPROMPTFORWORD NIL T]
         (DECLARE%: DOEVAL@LOAD DOEVAL@COMPILE DONTCOPY COMPILERVARS (ADDVARS (NLAMA)
                                                                            (NLAML)
@@ -116,7 +113,7 @@ Copyright (c) 1982-1989, 1993-1994, 2021 by Xerox Corporation and Bolt Beranek a
 
 (RPAQQ LAFITEVERSION# 10)
 
-(RPAQQ LAFITESYSTEMDATE "30-Sep-2021 22:59:08")
+(RPAQQ LAFITESYSTEMDATE "26-Feb-2024 20:10:22")
 (DEFINEQ
 
 (LAFITE
@@ -277,7 +274,7 @@ Mode affects SendMail only; mail is still retrieved in all modes.~]" (if \LAFITE
                                          (CHARWIDTH (CHARCODE "W")
                                                 DEFAULTFONT))
                                                              (* ; 
-                                       "Yes, user has not changed default to a variable width font")
+                                         "Yes, user has not changed default to a variable width font")
                                      DEFAULTFONT)
                                     (T (FONTCREATE '(GACHA 10]
         (LAFITEHARDCOPYFONT LAFITEDISPLAYFONT)
@@ -317,7 +314,7 @@ Mode affects SendMail only; mail is still retrieved in all modes.~]" (if \LAFITE
                   (CHARWIDTH (CHARCODE "W")
                          DEFAULTFONT))
                                                              (* ; 
-                                       "Yes, user has not changed default to a variable width font")
+                                         "Yes, user has not changed default to a variable width font")
               DEFAULTFONT)
              (T (FONTCREATE '(GACHA 10])
 
@@ -354,9 +351,9 @@ Mode affects SendMail only; mail is still retrieved in all modes.~]" (if \LAFITE
 (RPAQ? LAFITE.USE.ALL.MODES T)
 
 (RPAQQ LAFITERANDOMGLOBALS ((UNSUPPLIEDFIELDSTR "---")
-                                (LAFITEBUSYWAITTIME 1000)
-                                (LAFITEITEMBUSYSHADE 43605)
-                                (LAFITEEOL "
+                            (LAFITEBUSYWAITTIME 1000)
+                            (LAFITEITEMBUSYSHADE 43605)
+                            (LAFITEEOL "
 ")))
 
 (RPAQ? UNSUPPLIEDFIELDSTR "---")
@@ -394,13 +391,13 @@ Mode affects SendMail only; mail is still retrieved in all modes.~]" (if \LAFITE
 
 (RPAQ HEARDMARK (CHARCODE @))
 
-(RPAQQ LAFITECOMMANDMENUITEMS (("Browse" '\LAFITE.BROWSE 
-                                          "Browse a mail file; MIDDLE for subcommands")
-                                   ("Send Mail" '\LAFITE.MESSAGEFORM 
+(RPAQQ LAFITECOMMANDMENUITEMS (("Browse" '\LAFITE.BROWSE "Browse a mail file; MIDDLE for subcommands"
+                                      )
+                               ("Send Mail" '\LAFITE.MESSAGEFORM 
                                       "Open a message composition window; MIDDLE for choice of forms"
-                                          )
-                                   ("Quit" '\LAFITE.QUIT 
-                                          "Update and close all mail files and stop Lafite")))
+                                      )
+                               ("Quit" '\LAFITE.QUIT 
+                                      "Update and close all mail files and stop Lafite")))
 
 (RPAQQ LAFITEUPDATEMENUITEMS
        (("Do Hardcopy Only" '\LAFITE.HARDCOPYONLY.PROC 
@@ -435,7 +432,7 @@ Mode affects SendMail only; mail is still retrieved in all modes.~]" (if \LAFITE
         ("Server trace" 'LAFITE.TOGGLE.SERVER.TRACE "Change setting of *NSMAIL-TRACE-SERVERS*")))
 
 (RPAQQ ANOTHERFOLDERMENUITEM ("** Other Folder **" '%##ANOTHERFILE## 
-                                        "You will be asked to specify another mail filename"))
+                                    "You will be asked to specify another mail filename"))
 
 (RPAQ? LAFITESTATUSWINDOW )
 
@@ -622,17 +619,40 @@ Mode affects SendMail only; mail is still retrieved in all modes.~]" (if \LAFITE
 (DEFINEQ
 
 (LOAD-LAFITE
-(LAMBDA (DIR SOURCEP) (* ; "Edited  3-May-89 18:39 by bvm") (* ;; "Load Lafite from a specified directory (or the dir where we find the first file).  If SOURCEP true we load the sources PROP, else the compiled files SYSLOAD.  When loading compiled, we only load files that are noted as already loaded, since those are the only ones that won't be automatically loaded by the FILES command in file LAFITE (which must have been loaded if this function is defined).") (SETQ DIR (MKLIST DIR)) (for FILE in (if SOURCEP then LAFITEFILES else (REMOVE (QUOTE LAFITEDECLS) LAFITEFILES)) bind F when (OR SOURCEP (GET FILE (QUOTE FILEDATES))) collect (if (SETQ F (if SOURCEP then (FINDFILE FILE T DIR) else (FINDFILE-WITH-EXTENSIONS FILE DIR *COMPILED-EXTENSIONS*))) then (SETQ F (LOAD F (COND ((NOT SOURCEP) (QUOTE SYSLOAD)) ((EQ F (QUOTE LAFITEDECLS)) T) (T (QUOTE PROP))))) (if (NULL DIR) then (* ; "Fix dir for subsequent loading") (SETQ DIR (LIST (PACKFILENAME.STRING (QUOTE NAME) NIL (QUOTE EXTENSION) NIL (QUOTE VERSION) NIL (QUOTE BODY) F)))) F else (CONCAT FILE " not found"))))
-)
+  [LAMBDA (DIR SOURCEP)                                      (* ; "Edited 23-Feb-2024 23:02 by rmk")
+                                                             (* ; "Edited  3-May-89 18:39 by bvm")
+
+    (* ;; "Load Lafite from a specified directory (or the dir where we find the first file).  If SOURCEP true we load the sources PROP, else the compiled files SYSLOAD.  When loading compiled, we only load files that are noted as already loaded, since those are the only ones that won't be automatically loaded by the FILES command in file LAFITE (which must have been loaded if this function is defined).")
+
+    (SETQ DIR (MKLIST DIR))
+    (for FILE in (if SOURCEP
+                     then LAFITEFILES
+                   else (REMOVE 'LAFITE-DECLS LAFITEFILES)) bind F
+       when (OR SOURCEP (GET FILE 'FILEDATES))
+       collect (if (SETQ F (if SOURCEP
+                               then (FINDFILE FILE T DIR)
+                             else (FINDFILE-WITH-EXTENSIONS FILE DIR *COMPILED-EXTENSIONS*)))
+                   then [SETQ F (LOAD F (COND
+                                           ((NOT SOURCEP)
+                                            'SYSLOAD)
+                                           ((EQ F 'LAFITE-DECLS)
+                                            T)
+                                           (T 'PROP]
+                        [if (NULL DIR)
+                            then                             (* ; "Fix dir for subsequent loading")
+                                 (SETQ DIR (LIST (PACKFILENAME.STRING 'NAME NIL 'EXTENSION NIL
+                                                        'VERSION NIL 'BODY F]
+                        F
+                 else (CONCAT FILE " not found"])
 )
 
-(RPAQQ LAFITEFILES (LAFITEDECLS LAFITEBROWSE LAFITECOMMANDS LAFITEFOLDERS LAFITEMAIL LAFITESEND 
-                              LAFITESORT LAFITETEDIT NSMAIL OLDNSMAIL NEWNSMAIL LAFITEFIND 
-                              MAILSCAVENGE LAFITE))
+(RPAQQ LAFITEFILES (LAFITE-DECLS LAFITE-BROWSE LAFITE-COMMANDS LAFITE-FOLDERS LAFITE-MAIL LAFITE-SEND
+                          LAFITE-SORT LAFITE-TEDIT LAFITE-NSMAIL OLDNSMAIL LAFITE-NEWNSMAIL 
+                          LAFITE-FIND LAFITE-MAILSCAVENGE LAFITE))
 (DECLARE%: DOEVAL@COMPILE DONTCOPY 
 
 (FILESLOAD (SOURCE)
-       LAFITEDECLS)
+       LAFITE-DECLS)
 
 (DECLARE%: DOEVAL@COMPILE DONTCOPY
 
@@ -743,81 +763,81 @@ Mode affects SendMail only; mail is still retrieved in all modes.~]" (if \LAFITE
 (ADDTOVAR SYSTEMRECLST
 
 (DATATYPE MAILFOLDER ((BROWSERPROMPTDIRTY FLAG)
-                          (BROWSERPROMPTGREW FLAG)
-                          (FOLDERNEEDSUPDATE FLAG)
-                          (FOLDERNEEDSEXPUNGE FLAG)
-                          (FOLDERBEINGUPDATED FLAG)
-                          (BROWSERSTATUS BITS 3)
-                          (FULLFOLDERNAME POINTER)
-                          (FOLDEROKTOSHRINK FLAG)
-                          (FOLDERGETSMAIL FLAG)
-                          (FOLDEROUTOFORDER FLAG)
-                          (NIL 5 FLAG)
-                          (VERSIONLESSFOLDERNAME POINTER)
-                          (SHORTFOLDERNAME POINTER)
-                          (FOLDERSTREAM POINTER)
-                          (MESSAGEDESCRIPTORS POINTER)
-                          (FOLDERLOCK POINTER)
-                          (%#OFMESSAGES WORD)
-                          (TOCLASTMESSAGE# WORD)
-                          (BROWSERFONTHEIGHT WORD)
-                          (BROWSERFONTASCENT WORD)
-                          (BROWSERFONTDESCENT WORD)
-                          (BROWSERMAXXPOS WORD)
-                          (ORDINALXPOS WORD)
-                          (DATEXPOS WORD)
-                          (FROMXPOS WORD)
-                          (FROMMAXXPOS WORD)
-                          (SUBJECTXPOS WORD)
-                          (BROWSERDIGITWIDTH WORD)
-                          (FIRSTSELECTEDMESSAGE WORD)
-                          (LASTSELECTEDMESSAGE WORD)
-                          (FIRSTCHANGEDMESSAGE WORD)
-                          (CURRENTPROMPTLINE WORD)
-                          (CURRENTDISPLAYEDSTREAM POINTER)
-                          (BROWSEREXTENT POINTER)
-                          (BROWSERORIGIN POINTER)
-                          (FOLDERDISPLAYREGION POINTER)
-                          (BROWSERWINDOW POINTER)
-                          (BROWSERMENU POINTER)
-                          (BROWSERMENUWINDOW POINTER)
-                          (BROWSERPROMPTWINDOW POINTER)
-                          (ORIGINALBROWSERTITLE POINTER)
-                          (FOLDERDISPLAYWINDOWS POINTER)
-                          (FOLDEREOFPTR POINTER)
-                          (DEFAULTMOVETOFILE POINTER)
-                          (CURRENTDISPLAYEDMESSAGE POINTER)
-                          (BROWSERUPDATEFROMHERE POINTER)
-                          (BROWSERLAYOUT POINTER)
-                          (FOLDERCREATIONDATE POINTER)
-                          (HARDCOPYMESSAGES POINTER)
-                          (HARDCOPYSTREAM POINTER)))
+                      (BROWSERPROMPTGREW FLAG)
+                      (FOLDERNEEDSUPDATE FLAG)
+                      (FOLDERNEEDSEXPUNGE FLAG)
+                      (FOLDERBEINGUPDATED FLAG)
+                      (BROWSERSTATUS BITS 3)
+                      (FULLFOLDERNAME POINTER)
+                      (FOLDEROKTOSHRINK FLAG)
+                      (FOLDERGETSMAIL FLAG)
+                      (FOLDEROUTOFORDER FLAG)
+                      (NIL 5 FLAG)
+                      (VERSIONLESSFOLDERNAME POINTER)
+                      (SHORTFOLDERNAME POINTER)
+                      (FOLDERSTREAM POINTER)
+                      (MESSAGEDESCRIPTORS POINTER)
+                      (FOLDERLOCK POINTER)
+                      (%#OFMESSAGES WORD)
+                      (TOCLASTMESSAGE# WORD)
+                      (BROWSERFONTHEIGHT WORD)
+                      (BROWSERFONTASCENT WORD)
+                      (BROWSERFONTDESCENT WORD)
+                      (BROWSERMAXXPOS WORD)
+                      (ORDINALXPOS WORD)
+                      (DATEXPOS WORD)
+                      (FROMXPOS WORD)
+                      (FROMMAXXPOS WORD)
+                      (SUBJECTXPOS WORD)
+                      (BROWSERDIGITWIDTH WORD)
+                      (FIRSTSELECTEDMESSAGE WORD)
+                      (LASTSELECTEDMESSAGE WORD)
+                      (FIRSTCHANGEDMESSAGE WORD)
+                      (CURRENTPROMPTLINE WORD)
+                      (CURRENTDISPLAYEDSTREAM POINTER)
+                      (BROWSEREXTENT POINTER)
+                      (BROWSERORIGIN POINTER)
+                      (FOLDERDISPLAYREGION POINTER)
+                      (BROWSERWINDOW POINTER)
+                      (BROWSERMENU POINTER)
+                      (BROWSERMENUWINDOW POINTER)
+                      (BROWSERPROMPTWINDOW POINTER)
+                      (ORIGINALBROWSERTITLE POINTER)
+                      (FOLDERDISPLAYWINDOWS POINTER)
+                      (FOLDEREOFPTR POINTER)
+                      (DEFAULTMOVETOFILE POINTER)
+                      (CURRENTDISPLAYEDMESSAGE POINTER)
+                      (BROWSERUPDATEFROMHERE POINTER)
+                      (BROWSERLAYOUT POINTER)
+                      (FOLDERCREATIONDATE POINTER)
+                      (HARDCOPYMESSAGES POINTER)
+                      (HARDCOPYSTREAM POINTER)))
 
 (DATATYPE LAFITEMSG ((PARSED? FLAG)
-                         (DELETED? FLAG)
-                         (SEEN? FLAG)
-                         (DATEKNOWN? FLAG)
-                         (DATEFETCHED? FLAG)
-                         (MODEBITS BITS 3)
-                         (MARKCHAR BYTE)
-                         (%# WORD)
-                         (BEGIN POINTER)
-                         (MESSAGELENGTH POINTER)
-                         (STAMPLENGTH WORD)
-                         (TOCLENGTH WORD)
-                         (MESSAGELENGTHCHANGED? FLAG)
-                         (SELECTED? FLAG)
-                         (MSGFROMMECHECKED? FLAG)
-                         (MSGFROMMETRUTH FLAG)
-                         (DATE POINTER)
-                         (NIL FLAG)
-                         (MARKSCHANGEDINFILE? FLAG)
-                         (MARKSCHANGEDINTOC? FLAG)
-                         (NIL FLAG)
-                         (FROM POINTER)
-                         (SUBJECT POINTER)
-                         (TO POINTER)
-                         (IDATE FIXP)))
+                     (DELETED? FLAG)
+                     (SEEN? FLAG)
+                     (DATEKNOWN? FLAG)
+                     (DATEFETCHED? FLAG)
+                     (MODEBITS BITS 3)
+                     (MARKCHAR BYTE)
+                     (%# WORD)
+                     (BEGIN POINTER)
+                     (MESSAGELENGTH POINTER)
+                     (STAMPLENGTH WORD)
+                     (TOCLENGTH WORD)
+                     (MESSAGELENGTHCHANGED? FLAG)
+                     (SELECTED? FLAG)
+                     (MSGFROMMECHECKED? FLAG)
+                     (MSGFROMMETRUTH FLAG)
+                     (DATE POINTER)
+                     (NIL FLAG)
+                     (MARKSCHANGEDINFILE? FLAG)
+                     (MARKSCHANGEDINTOC? FLAG)
+                     (NIL FLAG)
+                     (FROM POINTER)
+                     (SUBJECT POINTER)
+                     (TO POINTER)
+                     (IDATE FIXP)))
 )
 (DEFINEQ
 
@@ -827,8 +847,11 @@ Mode affects SendMail only; mail is still retrieved in all modes.~]" (if \LAFITE
 )
 (DECLARE%: DONTEVAL@LOAD DOCOPY 
 
-(FILESLOAD LAFITEBROWSE LAFITECOMMANDS LAFITEFOLDERS LAFITESEND LAFITEMAIL LAFITESORT TEDIT 
-       LAFITETEDIT LAFITEFIND ATTACHEDWINDOW MAILSCAVENGE)
+(FILESLOAD TEDIT ATTACHEDWINDOW)
+
+
+(FILESLOAD LAFITE-BROWSE LAFITE-COMMANDS LAFITE-FOLDERS LAFITE-SEND LAFITE-MAIL LAFITE-SORT 
+       LAFITE-TEDIT LAFITE-FIND LAFITE-MAILSCAVENGE)
 
 
 (CL:PROCLAIM '(GLOBAL ANSWERMARK BROWSERMARKXPOSITION DEFAULTMAILFOLDERNAME 
@@ -864,7 +887,7 @@ Mode affects SendMail only; mail is still retrieved in all modes.~]" (if \LAFITE
    ((EQ MAKESYSNAME :LYRIC)
     (FILESLOAD (SYSLOAD)
            NSCHARPATCH)                                      (* ; 
-                                                           "Patch to horrid Lyric NS chars bug")
+                                                             "Patch to horrid Lyric NS chars bug")
     (MOVD? 'PROMPTFORWORD 'TTYINPROMPTFORWORD NIL T)))
 )
 (DECLARE%: DOEVAL@LOAD DOEVAL@COMPILE DONTCOPY COMPILERVARS 
@@ -875,31 +898,29 @@ Mode affects SendMail only; mail is still retrieved in all modes.~]" (if \LAFITE
 
 (ADDTOVAR LAMA LAFITE)
 )
-(PUTPROPS LAFITE COPYRIGHT ("Xerox Corporation and Bolt Beranek and Newman Inc." 1982 1983 1984 1985 
-1986 1987 1988 1989 1993 1994 2021))
 (DECLARE%: DONTCOPY
-  (FILEMAP (NIL (7104 22150 (LAFITE 7114 . 8425) (LAFITE.ON.FROM.BACKGROUND 8427 . 8798) (\LAFITE.OFF 
-8800 . 9184) (\LAFITE.START.PROC 9186 . 10962) (LAFITE.COMPUTE.CACHED.VARS 10964 . 13666) (
-\LAFITE.PROCESS 13668 . 14034) (\LAFITE.START.ABORT 14036 . 14228) (\LAFITE.QUIT 14230 . 14472) (
-\LAFITE.RESTART 14474 . 14607) (\LAFITE.SUBQUIT 14609 . 15907) (\LAFITE.QUIT.PROC 15909 . 18645) (
-\LAFITEDEFAULTHOST&DIR 18647 . 19457) (LAFITEDEFAULTHOST&DIR 19459 . 19629) (MAKELAFITECOMMANDWINDOW 
-19631 . 21270) (EXTRACTMENUCOMMAND 21272 . 21520) (DOMAINLAFITECOMMAND 21522 . 21671) (
-LAFITE.TOGGLE.SERVER.TRACE 21673 . 22148)) (22225 25193 (LAFITEMODE 22235 . 22715) (\LAFITE.INFER.MODE
- 22717 . 23070) (\LAFITE.SHOW.MODE 23072 . 23309) (\LAFITE.MODE.TITLE 23311 . 23596) (
-LAFITE.SHOW.MODE.P 23598 . 23839) (LAFITE.ALL.MODES.P 23841 . 24184) (SET.LAFITE.MODE.INTERACTIVELY 
-24186 . 24768) (\LAFITE.COMPUTE.MODE.COMMANDS 24770 . 25191)) (26043 27799 (\LAFITE.LOGIN 26053 . 
-26435) (\LAFITE.LOGIN.NORESTART 26437 . 26543) (LAFITE.PROMPT.FOR.LOGIN 26545 . 27564) (
-\LAFITE.REAUTHENTICATE 27566 . 27797)) (35310 38752 (LAFITE.AROUNDEXIT 35320 . 35858) (
-\LAFITE.MARK.FOLDERS.OBSOLETE 35860 . 36776) (\LAFITE.CHECK.FOLDERS 36778 . 37177) (
-\LAFITE.ASSURE.FOLDER.READY 37179 . 37589) (\LAFITE.AFTERLOGIN 37591 . 38750)) (38784 41722 (
-LA.RESETSHADE 38794 . 39172) (LA.MENU.ITEM 39174 . 39592) (NTHMESSAGE 39594 . 39677) (
-\LAFITE.MAKE.MSGARRAY 39679 . 40109) (\LAFITE.ADDMESSAGES.TO.ARRAY 40111 . 40692) (
-\MAILFOLDER.DEFPRINT 40694 . 40941) (\LAFITEMSG.DEFPRINT 40943 . 41105) (LA.POSITION.FROM.REGION 41107
- . 41584) (MAILFOLDERBUSY 41586 . 41720)) (41900 58288 (TOCFILENAME 41910 . 42341) (DELETEMAILFOLDER 
-42343 . 42863) (\LAFITE.OPEN.FOLDER 42865 . 47480) (\LAFITE.REPORT.FILE.WONT.OPEN 47482 . 48206) (
-\LAFITE.FOLDER.CHANGED 48208 . 50612) (\LAFITE.REBROWSE.FOLDER 50614 . 53579) (
-\LAFITE.FOLDER.CHANGED.MENU 53581 . 54504) (\LAFITE.SET.FOLDER.STREAM 54506 . 55200) (
-\LAFITE.OPENSTREAM 55202 . 55741) (\LAFITE.CREATE.MENU 55743 . 56096) (\LAFITE.EOF 56098 . 57440) (
-\LAFITE.CLOSE.FOLDER 57442 . 58286)) (58289 58873 (\LAFITE.DESCRIBE.FOLDER 58299 . 58871)) (58934 
-60040 (LOAD-LAFITE 58944 . 60038)) (67751 69028 (\LAFITE.GLOBAL.INIT 67761 . 69026)))))
+  (FILEMAP (NIL (6983 22029 (LAFITE 6993 . 8304) (LAFITE.ON.FROM.BACKGROUND 8306 . 8677) (\LAFITE.OFF 
+8679 . 9063) (\LAFITE.START.PROC 9065 . 10841) (LAFITE.COMPUTE.CACHED.VARS 10843 . 13545) (
+\LAFITE.PROCESS 13547 . 13913) (\LAFITE.START.ABORT 13915 . 14107) (\LAFITE.QUIT 14109 . 14351) (
+\LAFITE.RESTART 14353 . 14486) (\LAFITE.SUBQUIT 14488 . 15786) (\LAFITE.QUIT.PROC 15788 . 18524) (
+\LAFITEDEFAULTHOST&DIR 18526 . 19336) (LAFITEDEFAULTHOST&DIR 19338 . 19508) (MAKELAFITECOMMANDWINDOW 
+19510 . 21149) (EXTRACTMENUCOMMAND 21151 . 21399) (DOMAINLAFITECOMMAND 21401 . 21550) (
+LAFITE.TOGGLE.SERVER.TRACE 21552 . 22027)) (22104 25072 (LAFITEMODE 22114 . 22594) (\LAFITE.INFER.MODE
+ 22596 . 22949) (\LAFITE.SHOW.MODE 22951 . 23188) (\LAFITE.MODE.TITLE 23190 . 23475) (
+LAFITE.SHOW.MODE.P 23477 . 23718) (LAFITE.ALL.MODES.P 23720 . 24063) (SET.LAFITE.MODE.INTERACTIVELY 
+24065 . 24647) (\LAFITE.COMPUTE.MODE.COMMANDS 24649 . 25070)) (25922 27678 (\LAFITE.LOGIN 25932 . 
+26314) (\LAFITE.LOGIN.NORESTART 26316 . 26422) (LAFITE.PROMPT.FOR.LOGIN 26424 . 27443) (
+\LAFITE.REAUTHENTICATE 27445 . 27676)) (35157 38599 (LAFITE.AROUNDEXIT 35167 . 35705) (
+\LAFITE.MARK.FOLDERS.OBSOLETE 35707 . 36623) (\LAFITE.CHECK.FOLDERS 36625 . 37024) (
+\LAFITE.ASSURE.FOLDER.READY 37026 . 37436) (\LAFITE.AFTERLOGIN 37438 . 38597)) (38631 41569 (
+LA.RESETSHADE 38641 . 39019) (LA.MENU.ITEM 39021 . 39439) (NTHMESSAGE 39441 . 39524) (
+\LAFITE.MAKE.MSGARRAY 39526 . 39956) (\LAFITE.ADDMESSAGES.TO.ARRAY 39958 . 40539) (
+\MAILFOLDER.DEFPRINT 40541 . 40788) (\LAFITEMSG.DEFPRINT 40790 . 40952) (LA.POSITION.FROM.REGION 40954
+ . 41431) (MAILFOLDERBUSY 41433 . 41567)) (41747 58135 (TOCFILENAME 41757 . 42188) (DELETEMAILFOLDER 
+42190 . 42710) (\LAFITE.OPEN.FOLDER 42712 . 47327) (\LAFITE.REPORT.FILE.WONT.OPEN 47329 . 48053) (
+\LAFITE.FOLDER.CHANGED 48055 . 50459) (\LAFITE.REBROWSE.FOLDER 50461 . 53426) (
+\LAFITE.FOLDER.CHANGED.MENU 53428 . 54351) (\LAFITE.SET.FOLDER.STREAM 54353 . 55047) (
+\LAFITE.OPENSTREAM 55049 . 55588) (\LAFITE.CREATE.MENU 55590 . 55943) (\LAFITE.EOF 55945 . 57287) (
+\LAFITE.CLOSE.FOLDER 57289 . 58133)) (58136 58720 (\LAFITE.DESCRIBE.FOLDER 58146 . 58718)) (58781 
+60618 (LOAD-LAFITE 58791 . 60616)) (68059 69336 (\LAFITE.GLOBAL.INIT 68069 . 69334)))))
 STOP
diff --git a/library/lafite/LAFITEABBREV b/library/lafite/LAFITE-ABBREV
similarity index 66%
rename from library/lafite/LAFITEABBREV
rename to library/lafite/LAFITE-ABBREV
index 67f86984..16a43f61 100644
--- a/library/lafite/LAFITEABBREV
+++ b/library/lafite/LAFITE-ABBREV
@@ -1,30 +1,47 @@
 (DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
-(FILECREATED "11-Nov-88 19:37:06" |{NEWTON:EUROPARC:RX}<LOVSTRAND>LISP>MEDLEY>LAFITEABBREV.;1| 5987   
 
-      changes to%:  (VARS LAFITEABBREVCOMS)
+(FILECREATED "23-Feb-2024 23:14:08" {WMEDLEY}<library>lafite>LAFITE-ABBREV.;1 6164   
 
-      previous date%: "22-Sep-88 13:06:40" |{NEWTON:EUROPARC:RX}<LOVSTRAND>LISP>LYRIC>LAFITEABBREV.;7|
-)
+      :EDIT-BY rmk
+
+      :PREVIOUS-DATE "11-Nov-88 19:37:06" {WMEDLEY}<library>lafite>LAFITEABBREV.;1)
 
 
-(* "
-Copyright (c) 1988, 1901 by Xerox Corporation.  All rights reserved.
-")
+(PRETTYCOMPRINT LAFITE-ABBREVCOMS)
 
-(PRETTYCOMPRINT LAFITEABBREVCOMS)
+(RPAQQ LAFITE-ABBREVCOMS
+       ((APPENDVARS (LAFITE.ABBREVS ("*@*:*" "*@*:*" :OUT)
+                           ("*@*" "%"*%%*%":GV:Xerox" :IN)
+                           ("*@*" "*%%*:GV:Xerox")
+                           ("*@*.*" "*%%*:*:Xerox" :IN)
+                           ("*.pa" "*:PA:Xerox")))
+        (INITVARS (LAFITE.ABBREV.DIRECTIONS :BOTH)
+               (LAFITE.ABBREV.MOVE.GAZE.RIGHT T)
+               (LAFITE.ABBREV.TRACE))
+        (FUNCTIONS SAFEUPPERCHARCODE)
+        (FNS LAFITE.ABBREV LAFITE.ABBREV.MATCH)
+        (ADVISE (NSNAME.TO.STRING :IN \NSMAIL.PRINT.NAMES)
+               (PARSE.NSNAME :IN \NSMAIL.PARSE1))
+        (GLOBALVARS LAFITE.ABBREVS LAFITE.ABBREV.DIRECTIONS LAFITE.ABBREV.MOVE.GAZE.RIGHT 
+               LAFITE.ABBREV.TRACE)))
 
-(RPAQQ LAFITEABBREVCOMS ((APPENDVARS (LAFITE.ABBREVS ("*@*:*" "*@*:*" :OUT) ("*@*" "%"*%%*%":GV:Xerox" :IN) ("*@*" "*%%*:GV:Xerox") ("*@*.*" "*%%*:*:Xerox" :IN) ("*.pa" "*:PA:Xerox"))) (INITVARS (LAFITE.ABBREV.DIRECTIONS :BOTH) (LAFITE.ABBREV.MOVE.GAZE.RIGHT T) (LAFITE.ABBREV.TRACE)) (FUNCTIONS SAFEUPPERCHARCODE) (FNS LAFITE.ABBREV LAFITE.ABBREV.MATCH) (ADVISE (NSNAME.TO.STRING :IN \NSMAIL.PRINT.NAMES) (PARSE.NSNAME :IN \NSMAIL.PARSE1)) (GLOBALVARS LAFITE.ABBREVS LAFITE.ABBREV.DIRECTIONS LAFITE.ABBREV.MOVE.GAZE.RIGHT LAFITE.ABBREV.TRACE)))
+(APPENDTOVAR LAFITE.ABBREVS ("*@*:*" "*@*:*" :OUT)
+                            ("*@*" "%"*%%*%":GV:Xerox" :IN)
+                            ("*@*" "*%%*:GV:Xerox")
+                            ("*@*.*" "*%%*:*:Xerox" :IN)
+                            ("*.pa" "*:PA:Xerox"))
 
-(APPENDTOVAR LAFITE.ABBREVS ("*@*:*" "*@*:*" :OUT) ("*@*" "%"*%%*%":GV:Xerox" :IN) ("*@*" "*%%*:GV:Xerox")
- ("*@*.*" "*%%*:*:Xerox" :IN) ("*.pa" "*:PA:Xerox"))
+(RPAQ? LAFITE.ABBREV.DIRECTIONS :BOTH)
 
-(RPAQ? LAFITE.ABBREV.DIRECTIONS :BOTH)
+(RPAQ? LAFITE.ABBREV.MOVE.GAZE.RIGHT T)
 
-(RPAQ? LAFITE.ABBREV.MOVE.GAZE.RIGHT T)
+(RPAQ? LAFITE.ABBREV.TRACE )
 
-(RPAQ? LAFITE.ABBREV.TRACE)
-
-(DEFMACRO SAFEUPPERCHARCODE (CODE) (BQUOTE (if (AND (NUMBERP (\, CODE)) (LEQ (\, CODE) 255)) THEN (GETCASEARRAY UPPERCASEARRAY (\, CODE)) ELSE (\, CODE))))
+(DEFMACRO SAFEUPPERCHARCODE (CODE)
+   `(if (AND (NUMBERP ,CODE)
+             (LEQ ,CODE 255))
+        THEN (GETCASEARRAY UPPERCASEARRAY ,CODE)
+      ELSE ,CODE))
 (DEFINEQ
 
 (LAFITE.ABBREV
@@ -36,16 +53,22 @@ Copyright (c) 1988, 1901 by Xerox Corporation.  All rights reserved.
 )
 )
 
-(XCL:REINSTALL-ADVICE (QUOTE (NSNAME.TO.STRING :IN \NSMAIL.PRINT.NAMES)) :AFTER (QUOTE ((:LAST (SETQ !VALUE (LAFITE.ABBREV !VALUE :IN))))))
+[XCL:REINSTALL-ADVICE '(NSNAME.TO.STRING :IN \NSMAIL.PRINT.NAMES)
+       :AFTER
+       '((:LAST (SETQ !VALUE (LAFITE.ABBREV !VALUE :IN]
 
-(XCL:REINSTALL-ADVICE (QUOTE (PARSE.NSNAME :IN \NSMAIL.PARSE1)) :BEFORE (QUOTE ((:LAST (SETQ NAME (LAFITE.ABBREV NAME :OUT))))))
+[XCL:REINSTALL-ADVICE '(PARSE.NSNAME :IN \NSMAIL.PARSE1)
+       :BEFORE
+       '((:LAST (SETQ NAME (LAFITE.ABBREV NAME :OUT]
 
-(READVISE (NSNAME.TO.STRING :IN \NSMAIL.PRINT.NAMES) (PARSE.NSNAME :IN \NSMAIL.PARSE1))
+(READVISE (NSNAME.TO.STRING :IN \NSMAIL.PRINT.NAMES)
+       (PARSE.NSNAME :IN \NSMAIL.PARSE1))
 (DECLARE%: DOEVAL@COMPILE DONTCOPY
 
-(GLOBALVARS LAFITE.ABBREVS LAFITE.ABBREV.DIRECTIONS LAFITE.ABBREV.MOVE.GAZE.RIGHT LAFITE.ABBREV.TRACE)
+(GLOBALVARS LAFITE.ABBREVS LAFITE.ABBREV.DIRECTIONS LAFITE.ABBREV.MOVE.GAZE.RIGHT LAFITE.ABBREV.TRACE
+       )
 )
-(PUTPROPS LAFITEABBREV COPYRIGHT ("Xerox Corporation" 1988 1901))
 (DECLARE%: DONTCOPY
-  (FILEMAP (NIL (1425 5397 (LAFITE.ABBREV 1435 . 3321) (LAFITE.ABBREV.MATCH 3323 . 5395)))))
+  (FILEMAP (NIL (1475 1652 (SAFEUPPERCHARCODE 1475 . 1652)) (1653 5625 (LAFITE.ABBREV 1663 . 3549) (
+LAFITE.ABBREV.MATCH 3551 . 5623)))))
 STOP
diff --git a/library/lafite/LAFITEABBREV.TEDIT b/library/lafite/LAFITE-ABBREV.TEDIT
similarity index 100%
rename from library/lafite/LAFITEABBREV.TEDIT
rename to library/lafite/LAFITE-ABBREV.TEDIT
diff --git a/library/lafite/LAFITEBROWSE b/library/lafite/LAFITE-BROWSE
similarity index 96%
rename from library/lafite/LAFITEBROWSE
rename to library/lafite/LAFITE-BROWSE
index 7356489e..8fae85ce 100644
--- a/library/lafite/LAFITEBROWSE
+++ b/library/lafite/LAFITE-BROWSE
@@ -1,18 +1,17 @@
 (DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
-(FILECREATED "30-Sep-2021 22:58:57" 
-{DSK}<USERS>KAPLAN>LOCAL>MEDLEY3.5>GIT-MEDLEY>LIBRARY>LAFITE>LAFITEBROWSE.;1 141883 
 
-      previous date%: "19-Feb-2001 09:26:50" 
-{DSK}<USERS>KAPLAN>LOCAL>MEDLEY3.5>GIT-MEDLEY>LIBRARY>LAFITE>LAFITEBROWSE.;1)
+(FILECREATED "23-Feb-2024 22:24:01" {WMEDLEY}<library>lafite>LAFITE-BROWSE.;2 141738 
+
+      :EDIT-BY rmk
+
+      :CHANGES-TO (VARS LAFITE-BROWSECOMS)
+
+      :PREVIOUS-DATE "23-Feb-2024 21:54:27" {WMEDLEY}<library>lafite>LAFITE-BROWSE.;1)
 
 
-(* ; "
-Copyright (c) 1984-1989, 1999, 2001, 2021 by Xerox Corporation.
-")
+(PRETTYCOMPRINT LAFITE-BROWSECOMS)
 
-(PRETTYCOMPRINT LAFITEBROWSECOMS)
-
-(RPAQQ LAFITEBROWSECOMS
+(RPAQQ LAFITE-BROWSECOMS
        [(COMS                                                (* ; "BROWSE")
               (FNS \LAFITE.BROWSE \LAFITE.SUBBROWSE \LAFITE.BROWSE.PROC \LAFITE.BROWSE.FORGET 
                    LAFITE.BROWSE.FOLDER \LAFITE.PREPARE.BROWSER \LAFITE.MAYBE.OPEN.FOLDER 
@@ -78,7 +77,7 @@ Copyright (c) 1984-1989, 1999, 2001, 2021 by Xerox Corporation.
         (DECLARE%: DOEVAL@COMPILE DONTCOPY (CONSTANTS * TOCSTATES)
                [P (CL:PROCLAIM '(CL:SPECIAL \CURRENTDISPLAYLINE]
                (FILES (SOURCE)
-                      LAFITEDECLS)
+                      LAFITE-DECLS)
                (LOCALVARS . T))
         (DECLARE%: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY COMPILERVARS (ADDVARS (NLAMA)
                                                                              (NLAML)
@@ -93,12 +92,13 @@ Copyright (c) 1984-1989, 1999, 2001, 2021 by Xerox Corporation.
 (DEFINEQ
 
 (\LAFITE.BROWSE
-  [LAMBDA (ITEM MENU BUTTON)                             (* ; "Edited 17-Sep-87 19:13 by bvm:")
+  [LAMBDA (ITEM MENU BUTTON)                                 (* ; "Edited 23-Feb-2024 21:53 by rmk")
+                                                             (* ; "Edited 17-Sep-87 19:13 by bvm:")
 
 (* ;;; "Function called by the Browse button on main Lafite window.")
 
     (LET [(SUBP (EQ BUTTON 'MIDDLE]                          (* ; 
-     "Pass the :confirm option to LAFITE.BROWSE.FOLDER to require confirmation on folder creation.")
+       "Pass the :confirm option to LAFITE.BROWSE.FOLDER to require confirmation on folder creation.")
          (\LAFITE.PROCESS `[,(COND
                                 (SUBP (FUNCTION \LAFITE.SUBBROWSE))
                                 (T (FUNCTION \LAFITE.BROWSE.PROC)))
@@ -106,7 +106,7 @@ Copyright (c) 1984-1989, 1999, 2001, 2021 by Xerox Corporation.
                             ',MENU
                             ,@(AND (NOT SUBP)
                                    '(NIL '(:CONFIRM]
-                'LAFITEBROWSE])
+                'LAFITE-BROWSE])
 
 (\LAFITE.SUBBROWSE
   [LAMBDA (ITEM MENU)                                    (* ; "Edited  3-Sep-87 18:00 by bvm:")
@@ -633,8 +633,7 @@ Copyright (c) 1984-1989, 1999, 2001, 2021 by Xerox Corporation.
          MAINW])
 )
 
-(RPAQQ LAFITE.DUMMY.SHADE 
-                            #*(16 16)@L@HA@@FALD@@DJ@AHF@@@JDH@NFD@@EDD@EDJ@EDJD@@LD@@HD@@HDD@@DJ@@DL)
+(RPAQQ LAFITE.DUMMY.SHADE #*(16 16)@L@HA@@FALD@@DJ@AHF@@@JDH@NFD@@EDD@EDJ@EDJD@@LD@@HD@@HDD@@DJ@@DL)
 
 (RPAQQ LAFITE.DUMMY.HALF.SHADE 
                             #*(16 16)@H@@A@@D@@D@@DB@A@D@@@HDH@DB@@@DDD@A@B@DDHD@@D@@@@D@@H@D@@DJ@@@@)
@@ -2134,8 +2133,8 @@ Copyright (c) 1984-1989, 1999, 2001, 2021 by Xerox Corporation.
 )
 
 (RPAQQ LAFITE.FOLDER.ICON (#*(100 72)@OOOOOOOO@@@@@@@@@@@@@@@@@@@AOOOOOOOOH@@@@@@@@@@@@@@@@@@C@@@@@@@@L@@@@@@@@@@@@@@@@@@F@@@@@@@@F@@@@@@@@@@@@@@@@@@L@DA@@@@@C@@@@@@@@@@@@@@@@@@L@FC@@@@@C@@@@@@@@@@@@@@@@@@L@EE@HGB@C@@@@@@@@@@@@@@@@@@L@EEADBB@C@@@@@@@@@@@@@@@@@@L@DIBBBB@COOOOOOOOOOOOOOL@@@L@DACNBB@COOOOOOOOOOOOOOL@@@L@DABBGCL@@@@@@@@@@@@@@@L@@@L@@@@@@@@@@@@@@@@@@@@@@@L@@@L@@@@@@@@@@@@@@@@@@@@@@@L@@@LOOOOOOOOOOOOOOOOOOOOOOOO@@@LOOOOOOOOOOOOOOOOOOOOOOOO@@@LL@@@@@@@@@@@@@@@@@@@@@@C@@@LL@@@@@@@@@@@@@@@@@@@@@@C@@@LL@@@@@@@@@@@@@@@@@@@@@@C@@@LL@@@@@@@@@@@@@@@@@@@@@@C@@@LL@@@@@@@@@@@@@@@@@@@@@@C@@@LL@@@@@@@@@@@@@@@@@@@@@@C@@@LL@@@@@@@@@@@@@@@@@@@@@@C@@@LL@@@@@@@@@@@@@@@@@@@@@@C@@@LL@@@@@@@@@@@@@@@@@@@@@@C@@@LL@@@@@@@@@@@@@@@@@@@@@@C@@@LL@@@@@@@@@@@@@@@@@@@@@@C@@@LL@@@@@@@@@@@@@@@@@@@@@@C@@@LL@@@@@@@@@@@@@@@@@@@@@@C@@@LL@@@@@@@@@@@@@@@@@@@@@@C@@@LL@@@@@@@@@@@@@@@@@@@@@@C@@@LL@@@@@@@@@@@@@@@@@@@@@@C@@@LL@@@@@@@@@@@@@@@@@@@@@@C@@@LL@@@@@@@@@@@@@@@@@@@@@@C@@@LL@@@@@@@@@@@@@@@@@@@@@@C@@@LL@@@@@@@@@@@@@@@@@@@@@@C@@@LL@@@@@@@@@@@@@@@@@@@@@@C@@@LL@@@@@@@@@@@@@@@@@@@@@@C@@@LL@@@@@@@@@@@@@@@@@@@@@@C@@@LL@@@@@@@@@@@@@@@@@@@@@@C@@@LL@@@@@@@@@@@@@@@@@@@@@@C@@@LL@@@@@@@@@@@@@@@@@@@@@@C@@@LL@@@@@@@@@@@@@@@@@@@@@@C@@@LL@@@@@@@@@@@@@@@@@@@@@@C@@@LL@@@@@@@@@@@@@@@@@@@@@@C@@@LL@@@@@@@@@@@@@@@@@@@@@@C@@@LL@@@@@@@@@@@@@@@@@@@@@@C@@@LL@@@@@@@@@@@@@@@@@@@@@@C@@@LL@@@@@@@@@@@@@@@@@@@@@@C@@@LL@@@@@@@@@@@@@@@@@@@@@@C@@@LL@@@@@@@@@@@@@@@@@@@@@@C@@@LL@@@@@@@@@@@@@@@@@@@@@@C@@@LL@@@@@@@@@@@@@@@@@@@@@@C@@@LL@@@@@@@@@@@@@@@@@@@@@@C@@@LL@@@@@@@@@@@@@@@@@@@@@@C@@@LL@@@@@@@@@@@@@@@@@@@@@@C@@@LL@@@@@@@@@@@@@@@@@@@@@@C@@@LL@@@@@@@@@@@@@@@@@@@@@@C@@@LL@@@@@@@@@@@@@@@@@@@@@@C@@@LL@@@@@@@@@@@@@@@@@@@@@@C@@@LL@@@@@@@@@@@@@@@@@@@@@@C@@@LL@@@@@@@@@@@@@@@@@@@@@@C@@@LL@@@@@@@@@@@@@@@@@@@@@@C@@@LL@@@@@@@@@@@@@@@@@@@@@@C@@@LL@@@@@@@@@@@@@@@@@@@@@@C@@@LL@@@@@@@@@@@@@@@@@@@@@@C@@@LL@@@@@@@@@@@@@@@@@@@@@@C@@@LL@@@@@@@@@@@@@@@@@@@@@@C@@@LL@@@@@@@@@@@@@@@@@@@@@@C@@@FL@@@@@@@@@@@@@@@@@@@@@@C@@@CL@@@@@@@@@@@@@@@@@@@@@@C@@@AOOOOOOOOOOOOOOOOOOOOOOOO@@@@OOOOOOOOOOOOOOOOOOOOOOOO@@@
-                               #*(100 72)@OOOOOOOO@@@@@@@@@@@@@@@@@@@AOOOOOOOOH@@@@@@@@@@@@@@@@@@COOOOOOOOL@@@@@@@@@@@@@@@@@@GOOOOOOOON@@@@@@@@@@@@@@@@@@OOOOOOOOOO@@@@@@@@@@@@@@@@@@OOOOOOOOOO@@@@@@@@@@@@@@@@@@OOOOOOOOOO@@@@@@@@@@@@@@@@@@OOOOOOOOOO@@@@@@@@@@@@@@@@@@OOOOOOOOOOOOOOOOOOOOOOOOL@@@OOOOOOOOOOOOOOOOOOOOOOOOL@@@OOOOOOOOOOOOOOOOOOOOOOOOL@@@OOOOOOOOOOOOOOOOOOOOOOOOL@@@OOOOOOOOOOOOOOOOOOOOOOOOL@@@OOOOOOOOOOOOOOOOOOOOOOOOO@@@OOOOOOOOOOOOOOOOOOOOOOOOO@@@OOOOOOOOOOOOOOOOOOOOOOOOO@@@OOOOOOOOOOOOOOOOOOOOOOOOO@@@OOOOOOOOOOOOOOOOOOOOOOOOO@@@OOOOOOOOOOOOOOOOOOOOOOOOO@@@OOOOOOOOOOOOOOOOOOOOOOOOO@@@OOOOOOOOOOOOOOOOOOOOOOOOO@@@OOOOOOOOOOOOOOOOOOOOOOOOO@@@OOOOOOOOOOOOOOOOOOOOOOOOO@@@OOOOOOOOOOOOOOOOOOOOOOOOO@@@OOOOOOOOOOOOOOOOOOOOOOOOO@@@OOOOOOOOOOOOOOOOOOOOOOOOO@@@OOOOOOOOOOOOOOOOOOOOOOOOO@@@OOOOOOOOOOOOOOOOOOOOOOOOO@@@OOOOOOOOOOOOOOOOOOOOOOOOO@@@OOOOOOOOOOOOOOOOOOOOOOOOO@@@OOOOOOOOOOOOOOOOOOOOOOOOO@@@OOOOOOOOOOOOOOOOOOOOOOOOO@@@OOOOOOOOOOOOOOOOOOOOOOOOO@@@OOOOOOOOOOOOOOOOOOOOOOOOO@@@OOOOOOOOOOOOOOOOOOOOOOOOO@@@OOOOOOOOOOOOOOOOOOOOOOOOO@@@OOOOOOOOOOOOOOOOOOOOOOOOO@@@OOOOOOOOOOOOOOOOOOOOOOOOO@@@OOOOOOOOOOOOOOOOOOOOOOOOO@@@OOOOOOOOOOOOOOOOOOOOOOOOO@@@OOOOOOOOOOOOOOOOOOOOOOOOO@@@OOOOOOOOOOOOOOOOOOOOOOOOO@@@OOOOOOOOOOOOOOOOOOOOOOOOO@@@OOOOOOOOOOOOOOOOOOOOOOOOO@@@OOOOOOOOOOOOOOOOOOOOOOOOO@@@OOOOOOOOOOOOOOOOOOOOOOOOO@@@OOOOOOOOOOOOOOOOOOOOOOOOO@@@OOOOOOOOOOOOOOOOOOOOOOOOO@@@OOOOOOOOOOOOOOOOOOOOOOOOO@@@OOOOOOOOOOOOOOOOOOOOOOOOO@@@OOOOOOOOOOOOOOOOOOOOOOOOO@@@OOOOOOOOOOOOOOOOOOOOOOOOO@@@OOOOOOOOOOOOOOOOOOOOOOOOO@@@OOOOOOOOOOOOOOOOOOOOOOOOO@@@OOOOOOOOOOOOOOOOOOOOOOOOO@@@OOOOOOOOOOOOOOOOOOOOOOOOO@@@OOOOOOOOOOOOOOOOOOOOOOOOO@@@OOOOOOOOOOOOOOOOOOOOOOOOO@@@OOOOOOOOOOOOOOOOOOOOOOOOO@@@OOOOOOOOOOOOOOOOOOOOOOOOO@@@OOOOOOOOOOOOOOOOOOOOOOOOO@@@OOOOOOOOOOOOOOOOOOOOOOOOO@@@OOOOOOOOOOOOOOOOOOOOOOOOO@@@OOOOOOOOOOOOOOOOOOOOOOOOO@@@OOOOOOOOOOOOOOOOOOOOOOOOO@@@OOOOOOOOOOOOOOOOOOOOOOOOO@@@OOOOOOOOOOOOOOOOOOOOOOOOO@@@OOOOOOOOOOOOOOOOOOOOOOOOO@@@GOOOOOOOOOOOOOOOOOOOOOOOO@@@COOOOOOOOOOOOOOOOOOOOOOOO@@@AOOOOOOOOOOOOOOOOOOOOOOOO@@@@OOOOOOOOOOOOOOOOOOOOOOOO@@@
-                               (8 4 88 51)))
+                           #*(100 72)@OOOOOOOO@@@@@@@@@@@@@@@@@@@AOOOOOOOOH@@@@@@@@@@@@@@@@@@COOOOOOOOL@@@@@@@@@@@@@@@@@@GOOOOOOOON@@@@@@@@@@@@@@@@@@OOOOOOOOOO@@@@@@@@@@@@@@@@@@OOOOOOOOOO@@@@@@@@@@@@@@@@@@OOOOOOOOOO@@@@@@@@@@@@@@@@@@OOOOOOOOOO@@@@@@@@@@@@@@@@@@OOOOOOOOOOOOOOOOOOOOOOOOL@@@OOOOOOOOOOOOOOOOOOOOOOOOL@@@OOOOOOOOOOOOOOOOOOOOOOOOL@@@OOOOOOOOOOOOOOOOOOOOOOOOL@@@OOOOOOOOOOOOOOOOOOOOOOOOL@@@OOOOOOOOOOOOOOOOOOOOOOOOO@@@OOOOOOOOOOOOOOOOOOOOOOOOO@@@OOOOOOOOOOOOOOOOOOOOOOOOO@@@OOOOOOOOOOOOOOOOOOOOOOOOO@@@OOOOOOOOOOOOOOOOOOOOOOOOO@@@OOOOOOOOOOOOOOOOOOOOOOOOO@@@OOOOOOOOOOOOOOOOOOOOOOOOO@@@OOOOOOOOOOOOOOOOOOOOOOOOO@@@OOOOOOOOOOOOOOOOOOOOOOOOO@@@OOOOOOOOOOOOOOOOOOOOOOOOO@@@OOOOOOOOOOOOOOOOOOOOOOOOO@@@OOOOOOOOOOOOOOOOOOOOOOOOO@@@OOOOOOOOOOOOOOOOOOOOOOOOO@@@OOOOOOOOOOOOOOOOOOOOOOOOO@@@OOOOOOOOOOOOOOOOOOOOOOOOO@@@OOOOOOOOOOOOOOOOOOOOOOOOO@@@OOOOOOOOOOOOOOOOOOOOOOOOO@@@OOOOOOOOOOOOOOOOOOOOOOOOO@@@OOOOOOOOOOOOOOOOOOOOOOOOO@@@OOOOOOOOOOOOOOOOOOOOOOOOO@@@OOOOOOOOOOOOOOOOOOOOOOOOO@@@OOOOOOOOOOOOOOOOOOOOOOOOO@@@OOOOOOOOOOOOOOOOOOOOOOOOO@@@OOOOOOOOOOOOOOOOOOOOOOOOO@@@OOOOOOOOOOOOOOOOOOOOOOOOO@@@OOOOOOOOOOOOOOOOOOOOOOOOO@@@OOOOOOOOOOOOOOOOOOOOOOOOO@@@OOOOOOOOOOOOOOOOOOOOOOOOO@@@OOOOOOOOOOOOOOOOOOOOOOOOO@@@OOOOOOOOOOOOOOOOOOOOOOOOO@@@OOOOOOOOOOOOOOOOOOOOOOOOO@@@OOOOOOOOOOOOOOOOOOOOOOOOO@@@OOOOOOOOOOOOOOOOOOOOOOOOO@@@OOOOOOOOOOOOOOOOOOOOOOOOO@@@OOOOOOOOOOOOOOOOOOOOOOOOO@@@OOOOOOOOOOOOOOOOOOOOOOOOO@@@OOOOOOOOOOOOOOOOOOOOOOOOO@@@OOOOOOOOOOOOOOOOOOOOOOOOO@@@OOOOOOOOOOOOOOOOOOOOOOOOO@@@OOOOOOOOOOOOOOOOOOOOOOOOO@@@OOOOOOOOOOOOOOOOOOOOOOOOO@@@OOOOOOOOOOOOOOOOOOOOOOOOO@@@OOOOOOOOOOOOOOOOOOOOOOOOO@@@OOOOOOOOOOOOOOOOOOOOOOOOO@@@OOOOOOOOOOOOOOOOOOOOOOOOO@@@OOOOOOOOOOOOOOOOOOOOOOOOO@@@OOOOOOOOOOOOOOOOOOOOOOOOO@@@OOOOOOOOOOOOOOOOOOOOOOOOO@@@OOOOOOOOOOOOOOOOOOOOOOOOO@@@OOOOOOOOOOOOOOOOOOOOOOOOO@@@OOOOOOOOOOOOOOOOOOOOOOOOO@@@OOOOOOOOOOOOOOOOOOOOOOOOO@@@OOOOOOOOOOOOOOOOOOOOOOOOO@@@OOOOOOOOOOOOOOOOOOOOOOOOO@@@OOOOOOOOOOOOOOOOOOOOOOOOO@@@GOOOOOOOOOOOOOOOOOOOOOOOO@@@COOOOOOOOOOOOOOOOOOOOOOOO@@@AOOOOOOOOOOOOOOOOOOOOOOOO@@@@OOOOOOOOOOOOOOOOOOOOOOOO@@@
+                           (8 4 88 51)))
 
 (RPAQ? LAFITEFROMFRACTION 0.3)
 
@@ -2191,7 +2190,7 @@ and delete the file(s) containing it."
                              "Specify which subgroups should also appear at top level."])
 
 (RPAQQ LAFITEBROWSERICONMENUITEMS (("Get Mail" '\LAFITE.GETMAIL.FROM.ICON 
-                                              "Open this window and retrieve new mail into it")))
+                                          "Open this window and retrieve new mail into it")))
 
 (RPAQ? LAFITESUBBROWSEMENU )
 
@@ -2206,10 +2205,10 @@ and delete the file(s) containing it."
 (ADDTOVAR LAFITEMENUVARS LAFITESUBBROWSEMENU LAFITEBROWSERICONMENU LAFITEEXTRAMENU)
 
 (ADDTOVAR LAFITEEXTRAMENUITEMS ("Describe Folder" '\LAFITE.DESCRIBE.FOLDER 
-                                          "Display some relevant info about this folder"
-                                          (SUBITEMS ("Inspect Folder" 'INSPECT 
+                                      "Display some relevant info about this folder"
+                                      (SUBITEMS ("Inspect Folder" 'INSPECT 
                                  "Inspect the MAILFOLDER data structure associated with this browser"
-                                                           ))))
+                                                       ))))
 
 (RPAQQ BROWSERMARKXPOSITION 8)
 
@@ -2224,13 +2223,13 @@ and delete the file(s) containing it."
 (DECLARE%: DOEVAL@COMPILE DONTCOPY 
 
 (RPAQQ TOCSTATES ((TS.IDLE 0)
-                      (TS.REPLACING 1)
-                      (TS.ADDING 2)
-                      (TS.REMOVING 3)
-                      (TS.EXTENDING.HI 4)
-                      (TS.EXTENDING.LO 5)
-                      (TS.SHRINKING.HI 6)
-                      (TS.SHRINKING.LO 7)))
+                  (TS.REPLACING 1)
+                  (TS.ADDING 2)
+                  (TS.REMOVING 3)
+                  (TS.EXTENDING.HI 4)
+                  (TS.EXTENDING.LO 5)
+                  (TS.SHRINKING.HI 6)
+                  (TS.SHRINKING.LO 7)))
 (DECLARE%: EVAL@COMPILE 
 
 (RPAQQ TS.IDLE 0)
@@ -2265,7 +2264,7 @@ and delete the file(s) containing it."
 
 
 (FILESLOAD (SOURCE)
-       LAFITEDECLS)
+       LAFITE-DECLS)
 
 (DECLARE%: DOEVAL@COMPILE DONTCOPY
 
@@ -2280,36 +2279,35 @@ and delete the file(s) containing it."
 
 (ADDTOVAR LAMA LAB.MOUSECONFIRM LAB.FORMAT LAB.PROMPTPRINT)
 )
-(PUTPROPS LAFITEBROWSE COPYRIGHT ("Xerox Corporation" 1984 1985 1986 1987 1988 1989 1999 2001 2021))
 (DECLARE%: DONTCOPY
-  (FILEMAP (NIL (5768 31473 (\LAFITE.BROWSE 5778 . 6525) (\LAFITE.SUBBROWSE 6527 . 6864) (
-\LAFITE.BROWSE.PROC 6866 . 7959) (\LAFITE.BROWSE.FORGET 7961 . 8507) (LAFITE.BROWSE.FOLDER 8509 . 
-10444) (\LAFITE.PREPARE.BROWSER 10446 . 12612) (\LAFITE.MAYBE.OPEN.FOLDER 12614 . 16056) (
-LAB.LOADFOLDER 16058 . 16553) (LAB.DISPLAYFOLDER 16555 . 18126) (LAB.MAKE.INITIAL.SELECTION 18128 . 
-19364) (LAB.CREATEWINDOW 19366 . 27821) (LAB.TITLE.STRING 27823 . 29588) (LAB.COMMANDFN 29590 . 30120)
- (LAB.DO.COMMAND 30122 . 31099) (LAB.ASSURE.SELECTIONS 31101 . 31471)) (31474 41387 (
-BUILD.LAFITE.LAYOUTS 31484 . 37742) (\LAFITE.LAYOUT.FROM.WINDOW 37744 . 40224) (
-\LAFITE.MAKE.DUMMY.WINDOWS 40226 . 41385)) (41813 67265 (LAB.SETUP 41823 . 48008) (LAB.BUTTONEVENTFN 
-48010 . 48540) (LAB.DO.UNLESS.BUSY 48542 . 49038) (LOADMAILFOLDER 49040 . 50323) (LAFITE.OBTAIN.FOLDER
- 50325 . 59227) (\LAFITE.FIND.EXISTING.FOLDER 59229 . 60076) (\LAFITE.CONFLICTING.OLD.FOLDER 60078 . 
-61249) (LAB.REPAINTFN 61251 . 61876) (LAB.SCROLLFN 61878 . 62466) (LAB.RESHAPEFN 62468 . 63761) (
-LAB.CLOSEFN 63763 . 63932) (LAB.SHRINKFN 63934 . 64098) (LAB.CLOSE/SHRINK 64100 . 65685) (LAB.EXPANDFN
- 65687 . 66931) (LAFITEEXTRABROWSERCOMMANDFN 66933 . 67263)) (67300 85005 (LAB.SELECTMESSAGE 67310 . 
-80668) (LAB.CHANGEMARK 80670 . 82271) (LA.READ.NEW.MARK 82273 . 84056) (YPOS.TO.MESSAGE# 84058 . 84666
-) (MESSAGE#.TO.YPOS 84668 . 85003)) (85006 93673 (LA.CONSIDERRANGE 85016 . 85700) (LA.DECONSIDERRANGE 
-85702 . 86118) (LA.RECONSIDERRANGE 86120 . 86824) (LA.SELECTRANGE 86826 . 88162) (LA.DESELECTRANGE 
-88164 . 90242) (LAB.FIND.SELECTED.MSG 90244 . 90621) (LAB.REV.FIND.SELECTED.MSG 90623 . 91108) (
-LA.UNDOSELECTION 91110 . 91404) (LA.VERIFY.SELECTION 91406 . 93671)) (93674 100537 (
-LAB.COPYBUTTONEVENTFN 93684 . 98889) (LAB.SHOW.COPY.SELECTION 98891 . 100535)) (100744 108238 (
-LAB.PROMPTPRINT 100754 . 100933) (LAB.FORMAT 100935 . 101372) (LAB.MOUSECONFIRM 101374 . 101837) (
-LAB.PRINT.TO.PROMPTWINDOW 101839 . 104988) (LAB.PAGEFULLFN 104990 . 106042) (
-\LAFITE.MAYBE.CLEAR.PROMPT 106044 . 108236)) (108462 129133 (PRINTMESSAGESUMMARY 108472 . 113229) (
-FIRSTVISIBLEMESSAGE 113231 . 114251) (LASTVISIBLEMESSAGE 114253 . 115442) (LAB.DISPLAYLINES 115444 . 
-117686) (LAB.EXPOSEMESSAGE 117688 . 118795) (LAB.SELECTED.MESSAGES 118797 . 119059) (
-UNSELECTALLMESSAGES 119061 . 119547) (SELECTMESSAGE 119549 . 119841) (LAB.GO.TO.MESSAGE 119843 . 
-121152) (MARKMESSAGE 121154 . 122201) (LAB.MARKS.CHANGED 122203 . 123010) (LA.SHOW.MARK 123012 . 
-123657) (LA.INVERT.MARK.BOX 123659 . 124228) (LA.BLT.MARK.BOX 124230 . 124736) (LA.SHOW.DELETION 
-124738 . 125642) (LA.SHOW.SELECTION 125644 . 126208) (SEENMESSAGE 126210 . 126996) (DELETEMESSAGE 
-126998 . 127406) (UNDELETEMESSAGE 127408 . 128287) (LAB.SET.EXPUNGEABILITY 128289 . 129131)) (129370 
-132578 (LAB.ICONFN 129380 . 131073) (LAB.ICON.BUTTONEVENTFN 131075 . 132576)))))
+  (FILEMAP (NIL (5688 31509 (\LAFITE.BROWSE 5698 . 6561) (\LAFITE.SUBBROWSE 6563 . 6900) (
+\LAFITE.BROWSE.PROC 6902 . 7995) (\LAFITE.BROWSE.FORGET 7997 . 8543) (LAFITE.BROWSE.FOLDER 8545 . 
+10480) (\LAFITE.PREPARE.BROWSER 10482 . 12648) (\LAFITE.MAYBE.OPEN.FOLDER 12650 . 16092) (
+LAB.LOADFOLDER 16094 . 16589) (LAB.DISPLAYFOLDER 16591 . 18162) (LAB.MAKE.INITIAL.SELECTION 18164 . 
+19400) (LAB.CREATEWINDOW 19402 . 27857) (LAB.TITLE.STRING 27859 . 29624) (LAB.COMMANDFN 29626 . 30156)
+ (LAB.DO.COMMAND 30158 . 31135) (LAB.ASSURE.SELECTIONS 31137 . 31507)) (31510 41423 (
+BUILD.LAFITE.LAYOUTS 31520 . 37778) (\LAFITE.LAYOUT.FROM.WINDOW 37780 . 40260) (
+\LAFITE.MAKE.DUMMY.WINDOWS 40262 . 41421)) (41820 67272 (LAB.SETUP 41830 . 48015) (LAB.BUTTONEVENTFN 
+48017 . 48547) (LAB.DO.UNLESS.BUSY 48549 . 49045) (LOADMAILFOLDER 49047 . 50330) (LAFITE.OBTAIN.FOLDER
+ 50332 . 59234) (\LAFITE.FIND.EXISTING.FOLDER 59236 . 60083) (\LAFITE.CONFLICTING.OLD.FOLDER 60085 . 
+61256) (LAB.REPAINTFN 61258 . 61883) (LAB.SCROLLFN 61885 . 62473) (LAB.RESHAPEFN 62475 . 63768) (
+LAB.CLOSEFN 63770 . 63939) (LAB.SHRINKFN 63941 . 64105) (LAB.CLOSE/SHRINK 64107 . 65692) (LAB.EXPANDFN
+ 65694 . 66938) (LAFITEEXTRABROWSERCOMMANDFN 66940 . 67270)) (67307 85012 (LAB.SELECTMESSAGE 67317 . 
+80675) (LAB.CHANGEMARK 80677 . 82278) (LA.READ.NEW.MARK 82280 . 84063) (YPOS.TO.MESSAGE# 84065 . 84673
+) (MESSAGE#.TO.YPOS 84675 . 85010)) (85013 93680 (LA.CONSIDERRANGE 85023 . 85707) (LA.DECONSIDERRANGE 
+85709 . 86125) (LA.RECONSIDERRANGE 86127 . 86831) (LA.SELECTRANGE 86833 . 88169) (LA.DESELECTRANGE 
+88171 . 90249) (LAB.FIND.SELECTED.MSG 90251 . 90628) (LAB.REV.FIND.SELECTED.MSG 90630 . 91115) (
+LA.UNDOSELECTION 91117 . 91411) (LA.VERIFY.SELECTION 91413 . 93678)) (93681 100544 (
+LAB.COPYBUTTONEVENTFN 93691 . 98896) (LAB.SHOW.COPY.SELECTION 98898 . 100542)) (100751 108245 (
+LAB.PROMPTPRINT 100761 . 100940) (LAB.FORMAT 100942 . 101379) (LAB.MOUSECONFIRM 101381 . 101844) (
+LAB.PRINT.TO.PROMPTWINDOW 101846 . 104995) (LAB.PAGEFULLFN 104997 . 106049) (
+\LAFITE.MAYBE.CLEAR.PROMPT 106051 . 108243)) (108469 129140 (PRINTMESSAGESUMMARY 108479 . 113236) (
+FIRSTVISIBLEMESSAGE 113238 . 114258) (LASTVISIBLEMESSAGE 114260 . 115449) (LAB.DISPLAYLINES 115451 . 
+117693) (LAB.EXPOSEMESSAGE 117695 . 118802) (LAB.SELECTED.MESSAGES 118804 . 119066) (
+UNSELECTALLMESSAGES 119068 . 119554) (SELECTMESSAGE 119556 . 119848) (LAB.GO.TO.MESSAGE 119850 . 
+121159) (MARKMESSAGE 121161 . 122208) (LAB.MARKS.CHANGED 122210 . 123017) (LA.SHOW.MARK 123019 . 
+123664) (LA.INVERT.MARK.BOX 123666 . 124235) (LA.BLT.MARK.BOX 124237 . 124743) (LA.SHOW.DELETION 
+124745 . 125649) (LA.SHOW.SELECTION 125651 . 126215) (SEENMESSAGE 126217 . 127003) (DELETEMESSAGE 
+127005 . 127413) (UNDELETEMESSAGE 127415 . 128294) (LAB.SET.EXPUNGEABILITY 128296 . 129138)) (129377 
+132585 (LAB.ICONFN 129387 . 131080) (LAB.ICON.BUTTONEVENTFN 131082 . 132583)))))
 STOP
diff --git a/library/lafite/LAFITEBROWSE.LCOM b/library/lafite/LAFITE-BROWSE.LCOM
similarity index 65%
rename from library/lafite/LAFITEBROWSE.LCOM
rename to library/lafite/LAFITE-BROWSE.LCOM
index 79d71e36..59b9e397 100644
Binary files a/library/lafite/LAFITEBROWSE.LCOM and b/library/lafite/LAFITE-BROWSE.LCOM differ
diff --git a/library/lafite/LAFITECOMMANDS b/library/lafite/LAFITE-COMMANDS
similarity index 97%
rename from library/lafite/LAFITECOMMANDS
rename to library/lafite/LAFITE-COMMANDS
index f0c6774a..d962475f 100644
--- a/library/lafite/LAFITECOMMANDS
+++ b/library/lafite/LAFITE-COMMANDS
@@ -1,17 +1,17 @@
 (DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
 
-(FILECREATED "14-Jan-2024 16:35:53" {WMEDLEY}<library>lafite>LAFITECOMMANDS.;3 164474 
+(FILECREATED "23-Feb-2024 22:24:01" {WMEDLEY}<library>lafite>LAFITE-COMMANDS.;2 164484 
 
       :EDIT-BY rmk
 
-      :CHANGES-TO (FNS MESSAGEDISPLAYER)
+      :CHANGES-TO (VARS LAFITE-COMMANDSCOMS)
 
-      :PREVIOUS-DATE " 7-Feb-2022 12:04:09" {WMEDLEY}<library>lafite>LAFITECOMMANDS.;2)
+      :PREVIOUS-DATE "23-Feb-2024 21:58:18" {WMEDLEY}<library>lafite>LAFITE-COMMANDS.;1)
 
 
-(PRETTYCOMPRINT LAFITECOMMANDSCOMS)
+(PRETTYCOMPRINT LAFITE-COMMANDSCOMS)
 
-(RPAQQ LAFITECOMMANDSCOMS
+(RPAQQ LAFITE-COMMANDSCOMS
        [
         (* ;; "Handling of the main Lafite browser commands")
 
@@ -102,7 +102,7 @@
               (COMS                                          (* ; "Obsolete")
                     (INITVARS (LAFITEDISPLAYREGION (CREATEREGION 375 25 600 335]
         (DECLARE%: DOEVAL@COMPILE DONTCOPY (FILES (SOURCE)
-                                                  LAFITEDECLS)
+                                                  LAFITE-DECLS)
                (LOCALVARS . T))
         (DECLARE%: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY COMPILERVARS (ADDVARS (NLAMA)
                                                                              (NLAML)
@@ -2530,7 +2530,7 @@
 (DECLARE%: DOEVAL@COMPILE DONTCOPY 
 
 (FILESLOAD (SOURCE)
-       LAFITEDECLS)
+       LAFITE-DECLS)
 
 (DECLARE%: DOEVAL@COMPILE DONTCOPY
 
@@ -2546,37 +2546,37 @@
 (ADDTOVAR LAMA LAFITE.HARDCOPY.MESSAGES)
 )
 (DECLARE%: DONTCOPY
-  (FILEMAP (NIL (7734 27538 (\LAFITE.DISPLAY 7744 . 9449) (\LAFITE.DO.DISPLAY 9451 . 13616) (
-SELECTMESSAGETODISPLAY 13618 . 15986) (MESSAGEDISPLAYER 15988 . 23540) (LA.COPY.MESSAGE.TEXT 23542 . 
-24296) (\LAFITE.CLOSE.DISPLAYWINDOWS 24298 . 25892) (\LAFITE.CLOSE.DISPLAYER 25894 . 27536)) (27539 
-36131 (\LAFITE.UNHIDE.HEADERS 27549 . 28639) (\LAFITE.HIDE.HEADERS 28641 . 29294) (
-\LAFITE.REHIDE.HEADERS 29296 . 30332) (LAFITE.EAT.UNDESIRABLE.FIELD 30334 . 31093) (LAFITE.EAT.GVGV 
-31095 . 32256) (\LAFITE.HARDCOPY.FROM.DISPLAY 32258 . 35777) (LAFITE.HARDCOPY.TAB.WIDTH 35779 . 36129)
-) (36132 44435 (\LAFITE.SET.LOOKS.FROM.MENU 36142 . 36319) (\LAFITE.SET.DEFAULT.LOOKS 36321 . 36512) (
-\LAFITE.SET.FIXED.LOOKS 36514 . 36706) (LAFITE.SET.LOOKS 36708 . 41165) (LAFITE.SET.TAB.LOOKS 41167 . 
-41878) (LAFITE.SET.PARA.SEPARATION 41880 . 42088) (LAFITE.SET.LOWER.CASE 42090 . 42941) (
-LAFITE.SUBSTITUTE.VP.EOL 42943 . 44433)) (46352 54680 (LAFITE.DELETE.MESSAGES 46362 . 47412) (
-\LAFITE.DELETE 47414 . 48601) (DISPLAYAFTERDELETE 48603 . 53329) (\LAFITE.SELECT.NEXT 53331 . 53969) (
-\LAFITE.UNDELETE 53971 . 54678)) (54702 69197 (LAFITE.MOVE.MESSAGES 54712 . 55359) (\COERCE.TO.MSGLST 
-55361 . 56119) (\LAFITE.MOVETO 56121 . 60065) (\LAFITE.COPYTO 60067 . 60483) (\LAFITE.MOVETO.PROC 
-60485 . 61755) (\LAFITE.MOVE.MESSAGES.INTERNAL 61757 . 69195)) (69223 77775 (\LAFITE.ENABLE.MOVE.MENU 
-69233 . 70275) (\LAFITE.ADD.TO.MOVE.MENU 70277 . 71293) (\LAFITE.UPDATE.MOVE.MENU 71295 . 75935) (
-\LAFITE.RESTORE.MOVE.MENU 75937 . 76613) (\LAFITE.HANDLE.AUTO.MOVE 76615 . 77773)) (78631 96115 (
-\LAFITE.UPDATE 78641 . 84274) (\LAFITE.EXPUNGE.PROC 84276 . 85081) (\LAFITE.UPDATE.PROC 85083 . 86166)
- (\LAFITE.HARDCOPYONLY.PROC 86168 . 86610) (LAB.CHOOSE.UPDATE.MENU 86612 . 87393) (
-LAB.CREATE.UPDATE.MENU 87395 . 89294) (LAB.UPDATE.NEEDED? 89296 . 90866) (\LAFITE.START.UPDATE 90868
- . 91900) (LAB.START.COMMAND 91902 . 92752) (\LAFITE.FINISH.UPDATE 92754 . 95007) (
-\LAFITE.CLOSE.OTHER.FOLDERS 95009 . 96113)) (96116 130910 (LAB.FLUSHWINDOW 96126 . 97805) (
-LAB.APPENDMESSAGES 97807 . 100969) (\LAFITE.COMPACT.FOLDER 100971 . 105135) (\LAFITE.COMPACT.FOLDER1 
-105137 . 121176) (\LAFITE.COMPACT.FOLDER2 121178 . 125892) (\LAFITE.COMPACT.EXTRA 125894 . 128209) (
-\LAFITE.INVALIDATE.TOC 128211 . 128904) (\LAFITE.RENAMEFILE 128906 . 129376) (SMART-RENAMEFILEP 129378
- . 129938) (LA.OPENTEMPFILE 129940 . 130908)) (130911 144253 (\LAFITE.UPDATE.FOLDER 130921 . 132898) (
-\LAFITE.UPDATE.CONTENTS 132900 . 133617) (\LAFITE.UPDATE.CONTENTS1 133619 . 138473) (WRITETOCENTRY 
-138475 . 141593) (WRITETOCMARKBYTES 141595 . 141837) (WRITEFOLDERMARKBYTES 141839 . 144251)) (144279 
-163254 (LAFITE.HARDCOPY.MESSAGES 144289 . 144749) (\LAFITE.HARDCOPY 144751 . 145086) (
-\LAFITE.HARDCOPY.PROC 145088 . 148566) (\LAFITE.HARDCOPY.HEADERS 148568 . 153897) (
-\LAFITE.MARK.HARDCOPIED 153899 . 155609) (\LAFITE.TRANSMIT.HARDCOPY 155611 . 157201) (
-\LAFITE.HARDCOPY.BODIES 157203 . 158445) (\LAFITE.APPEND.MESSAGE.BODY 158447 . 160555) (
-\LAFITE.DO.PENDING.HARDCOPY 160557 . 161632) (\LAFITE.CANCEL.HARDCOPY 161634 . 162350) (
-\LAFITE.CLEAR.HARDCOPY.STATE 162352 . 163252)))))
+  (FILEMAP (NIL (7743 27547 (\LAFITE.DISPLAY 7753 . 9458) (\LAFITE.DO.DISPLAY 9460 . 13625) (
+SELECTMESSAGETODISPLAY 13627 . 15995) (MESSAGEDISPLAYER 15997 . 23549) (LA.COPY.MESSAGE.TEXT 23551 . 
+24305) (\LAFITE.CLOSE.DISPLAYWINDOWS 24307 . 25901) (\LAFITE.CLOSE.DISPLAYER 25903 . 27545)) (27548 
+36140 (\LAFITE.UNHIDE.HEADERS 27558 . 28648) (\LAFITE.HIDE.HEADERS 28650 . 29303) (
+\LAFITE.REHIDE.HEADERS 29305 . 30341) (LAFITE.EAT.UNDESIRABLE.FIELD 30343 . 31102) (LAFITE.EAT.GVGV 
+31104 . 32265) (\LAFITE.HARDCOPY.FROM.DISPLAY 32267 . 35786) (LAFITE.HARDCOPY.TAB.WIDTH 35788 . 36138)
+) (36141 44444 (\LAFITE.SET.LOOKS.FROM.MENU 36151 . 36328) (\LAFITE.SET.DEFAULT.LOOKS 36330 . 36521) (
+\LAFITE.SET.FIXED.LOOKS 36523 . 36715) (LAFITE.SET.LOOKS 36717 . 41174) (LAFITE.SET.TAB.LOOKS 41176 . 
+41887) (LAFITE.SET.PARA.SEPARATION 41889 . 42097) (LAFITE.SET.LOWER.CASE 42099 . 42950) (
+LAFITE.SUBSTITUTE.VP.EOL 42952 . 44442)) (46361 54689 (LAFITE.DELETE.MESSAGES 46371 . 47421) (
+\LAFITE.DELETE 47423 . 48610) (DISPLAYAFTERDELETE 48612 . 53338) (\LAFITE.SELECT.NEXT 53340 . 53978) (
+\LAFITE.UNDELETE 53980 . 54687)) (54711 69206 (LAFITE.MOVE.MESSAGES 54721 . 55368) (\COERCE.TO.MSGLST 
+55370 . 56128) (\LAFITE.MOVETO 56130 . 60074) (\LAFITE.COPYTO 60076 . 60492) (\LAFITE.MOVETO.PROC 
+60494 . 61764) (\LAFITE.MOVE.MESSAGES.INTERNAL 61766 . 69204)) (69232 77784 (\LAFITE.ENABLE.MOVE.MENU 
+69242 . 70284) (\LAFITE.ADD.TO.MOVE.MENU 70286 . 71302) (\LAFITE.UPDATE.MOVE.MENU 71304 . 75944) (
+\LAFITE.RESTORE.MOVE.MENU 75946 . 76622) (\LAFITE.HANDLE.AUTO.MOVE 76624 . 77782)) (78640 96124 (
+\LAFITE.UPDATE 78650 . 84283) (\LAFITE.EXPUNGE.PROC 84285 . 85090) (\LAFITE.UPDATE.PROC 85092 . 86175)
+ (\LAFITE.HARDCOPYONLY.PROC 86177 . 86619) (LAB.CHOOSE.UPDATE.MENU 86621 . 87402) (
+LAB.CREATE.UPDATE.MENU 87404 . 89303) (LAB.UPDATE.NEEDED? 89305 . 90875) (\LAFITE.START.UPDATE 90877
+ . 91909) (LAB.START.COMMAND 91911 . 92761) (\LAFITE.FINISH.UPDATE 92763 . 95016) (
+\LAFITE.CLOSE.OTHER.FOLDERS 95018 . 96122)) (96125 130919 (LAB.FLUSHWINDOW 96135 . 97814) (
+LAB.APPENDMESSAGES 97816 . 100978) (\LAFITE.COMPACT.FOLDER 100980 . 105144) (\LAFITE.COMPACT.FOLDER1 
+105146 . 121185) (\LAFITE.COMPACT.FOLDER2 121187 . 125901) (\LAFITE.COMPACT.EXTRA 125903 . 128218) (
+\LAFITE.INVALIDATE.TOC 128220 . 128913) (\LAFITE.RENAMEFILE 128915 . 129385) (SMART-RENAMEFILEP 129387
+ . 129947) (LA.OPENTEMPFILE 129949 . 130917)) (130920 144262 (\LAFITE.UPDATE.FOLDER 130930 . 132907) (
+\LAFITE.UPDATE.CONTENTS 132909 . 133626) (\LAFITE.UPDATE.CONTENTS1 133628 . 138482) (WRITETOCENTRY 
+138484 . 141602) (WRITETOCMARKBYTES 141604 . 141846) (WRITEFOLDERMARKBYTES 141848 . 144260)) (144288 
+163263 (LAFITE.HARDCOPY.MESSAGES 144298 . 144758) (\LAFITE.HARDCOPY 144760 . 145095) (
+\LAFITE.HARDCOPY.PROC 145097 . 148575) (\LAFITE.HARDCOPY.HEADERS 148577 . 153906) (
+\LAFITE.MARK.HARDCOPIED 153908 . 155618) (\LAFITE.TRANSMIT.HARDCOPY 155620 . 157210) (
+\LAFITE.HARDCOPY.BODIES 157212 . 158454) (\LAFITE.APPEND.MESSAGE.BODY 158456 . 160564) (
+\LAFITE.DO.PENDING.HARDCOPY 160566 . 161641) (\LAFITE.CANCEL.HARDCOPY 161643 . 162359) (
+\LAFITE.CLEAR.HARDCOPY.STATE 162361 . 163261)))))
 STOP
diff --git a/library/lafite/LAFITECOMMANDS.LCOM b/library/lafite/LAFITE-COMMANDS.LCOM
similarity index 63%
rename from library/lafite/LAFITECOMMANDS.LCOM
rename to library/lafite/LAFITE-COMMANDS.LCOM
index df32df71..00404394 100644
Binary files a/library/lafite/LAFITECOMMANDS.LCOM and b/library/lafite/LAFITE-COMMANDS.LCOM differ
diff --git a/library/lafite/LAFITEDECLS b/library/lafite/LAFITE-DECLS
similarity index 50%
rename from library/lafite/LAFITEDECLS
rename to library/lafite/LAFITE-DECLS
index 00b614e7..ff317061 100644
--- a/library/lafite/LAFITEDECLS
+++ b/library/lafite/LAFITE-DECLS
@@ -1,260 +1,244 @@
 (DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
-(FILECREATED "22-Aug-94 12:59:34" {DSK}<king>export>lispcore>lafite>parc-94>LAFITEDECLS.;2 37889  
 
-      changes to%:  (VARS LAFITEDECLSCOMS)
-                    (RECORDS LAFITEMSG)
+(FILECREATED "26-Feb-2024 20:14:22" {WMEDLEY}<library>lafite>LAFITE-DECLS.;5 35711  
 
-      previous date%: "21-Jun-89 12:10:42" {DSK}<king>export>lispcore>lafite>parc-94>LAFITEDECLS.;1
-)
+      :EDIT-BY rmk
+
+      :CHANGES-TO (VARS LAFITE.PROGRAMMER.ENTRIES)
+
+      :PREVIOUS-DATE "24-Feb-2024 12:01:11" {WMEDLEY}<library>lafite>LAFITE-DECLS.;4)
 
 
-(* ; "
-Copyright (c) 1985, 1986, 1987, 1988, 1989, 1994 by Xerox Corporation.  All rights reserved.
-")
+(PRETTYCOMPRINT LAFITE-DECLSCOMS)
 
-(PRETTYCOMPRINT LAFITEDECLSCOMS)
-
-(RPAQQ LAFITEDECLSCOMS ((RECORDS LAFITEOPS LAFITEMODEDATA LAFITEMSG MAILFOLDER FOLDERGROUP 
-                                   DEFAULTHOST&DIR MAILSERVER MAILSERVEROPS OPENEDMAILBOX OUTBOX 
-                                   PROFILEVAR)
-                            (COMS                            (* ; 
-                                                      "characteristics of standard Laurel messages")
-                                  (CONSTANTS (LAFITEBASICSTAMPLENGTH 19)
-                                         (LAFITESTAMPLENGTH 24)
-                                         (DELETEDFLAG (CHARCODE D))
-                                         (UNDELETEDFLAG (CHARCODE U))
-                                         (SEENFLAG (CHARCODE S))
-                                         (UNSEENFLAG (CHARCODE U))
-                                         (DUPLICATEMARK 128)))
-                            (COMS                            (* ; "Stuff for table of contents")
-                                  (CONSTANTS LAFITETOCPASSWORD LAFITETOCHEADERLENGTH))
-                            (COMS                            (* ; 
-                                         "Browser status values.  %"Ready%" values have low bit 1.")
-                                  (CONSTANTS LAS.READY LAS.LOGGED.OUT)
-                                  (CONSTANTS LAS.PARSING LAS.FLUSHED LAS.OUT.OF.DATE))
-                            (COMS                            (* ; 
-                                          "Bits for figuring out which menu to use on Update, etc.")
-                                  (CONSTANTS (\HARDCOPY.MENU.BIT 1)
-                                         (\UPDATE.MENU.BIT 2)
-                                         (\TOC.MENU.BIT 4)
-                                         (\EXPUNGE.MENU.BIT 8)
-                                         (\SORT.MENU.BIT 16)
-                                         (\EXPUNGE&SORT.MENU.BIT 32)
-                                         (\CLOSE.MENU.BIT 64)
-                                         (\SHRINK.MENU.BIT 128)))
-                            (COMS                            (* ; 
-                                            "For iterating over the selected messages of a browser")
-                                  (I.S.OPRS SELECTEDIN))
-                            (MACROS WORDIN FIXPIN WORDOUT FIXPOUT UCASECODE NTHMESSAGE .LAFITEMENU. 
-                                   MAYBEVERIFYMSG UNSEENMARKP)
-                            (COMS (GLOBALVARS * LAFITEGLOBALS)
-                                  [P (CL:PROCLAIM '(CL:SPECIAL *LAFITE-MODE-DATA* 
-                                                          *UPPER-CASE-FILE-NAMES* \#DISPLAYLINES]
+(RPAQQ LAFITE-DECLSCOMS
+       ((RECORDS LAFITEOPS LAFITEMODEDATA LAFITEMSG MAILFOLDER FOLDERGROUP DEFAULTHOST&DIR MAILSERVER
+               MAILSERVEROPS OPENEDMAILBOX OUTBOX PROFILEVAR)
+        (COMS                                                (* ; 
+                                                        "characteristics of standard Laurel messages")
+              (CONSTANTS (LAFITEBASICSTAMPLENGTH 19)
+                     (LAFITESTAMPLENGTH 24)
+                     (DELETEDFLAG (CHARCODE D))
+                     (UNDELETEDFLAG (CHARCODE U))
+                     (SEENFLAG (CHARCODE S))
+                     (UNSEENFLAG (CHARCODE U))
+                     (DUPLICATEMARK 128)))
+        (COMS                                                (* ; "Stuff for table of contents")
+              (CONSTANTS LAFITETOCPASSWORD LAFITETOCHEADERLENGTH))
+        (COMS                                                (* ; 
+                                           "Browser status values.  %"Ready%" values have low bit 1.")
+              (CONSTANTS LAS.READY LAS.LOGGED.OUT)
+              (CONSTANTS LAS.PARSING LAS.FLUSHED LAS.OUT.OF.DATE))
+        (COMS                                                (* ; 
+                                            "Bits for figuring out which menu to use on Update, etc.")
+              (CONSTANTS (\HARDCOPY.MENU.BIT 1)
+                     (\UPDATE.MENU.BIT 2)
+                     (\TOC.MENU.BIT 4)
+                     (\EXPUNGE.MENU.BIT 8)
+                     (\SORT.MENU.BIT 16)
+                     (\EXPUNGE&SORT.MENU.BIT 32)
+                     (\CLOSE.MENU.BIT 64)
+                     (\SHRINK.MENU.BIT 128)))
+        (COMS                                                (* ; 
+                                              "For iterating over the selected messages of a browser")
+              (I.S.OPRS SELECTEDIN))
+        (MACROS WORDIN FIXPIN WORDOUT FIXPOUT UCASECODE NTHMESSAGE .LAFITEMENU. MAYBEVERIFYMSG 
+               UNSEENMARKP)
+        (COMS (GLOBALVARS * LAFITEGLOBALS)
+              [P (CL:PROCLAIM '(CL:SPECIAL *LAFITE-MODE-DATA* *UPPER-CASE-FILE-NAMES* \#DISPLAYLINES]
                                                              (* ; 
-     "LAFITE.PROCLAMATIONS are exported to user in file LAFITE--these are the documented variables")
-                                  (P * LAFITE.PROCLAMATIONS))
-                            (COMS                            (* ; 
-                                "For debugging with Masterscope, here are fns not called from code")
-                                  (VARS LAFITE.CALLED.FROM.LITERALS LAFITE.PROGRAMMER.ENTRIES)
-                                  (COMMANDS WHONOTLAFITE CHECKLAFITE))
-                            (DECLARE%: DONTEVAL@COMPILE (TEMPLATES WINDOWPROP WINDOWADDPROP 
-                                                               WINDOWDELPROP PROCESSPROP TEXTPROP))))
+       "LAFITE.PROCLAMATIONS are exported to user in file LAFITE--these are the documented variables")
+              (P * LAFITE.PROCLAMATIONS))
+        (COMS                                                (* ; 
+                                  "For debugging with Masterscope, here are fns not called from code")
+              (VARS LAFITE.CALLED.FROM.LITERALS LAFITE.PROGRAMMER.ENTRIES)
+              (COMMANDS WHONOTLAFITE CHECKLAFITE))
+        (DECLARE%: DONTEVAL@COMPILE (TEMPLATES WINDOWPROP WINDOWADDPROP WINDOWDELPROP PROCESSPROP 
+                                           TEXTPROP))))
 (DECLARE%: EVAL@COMPILE
 
 (RECORD LAFITEOPS (LAFITEMODE MODEINDEX SENDPARSER SENDER ANSWERER AUTHENTICATOR MESSAGEP 
-                             MESSAGE-FROM-SELFP LOGIN))
+                         MESSAGE-FROM-SELFP LOGIN))
 
-(RECORD LAFITEMODEDATA (LAFITEOPS (FULLUSERNAME CREDENTIALS UNPACKEDUSERNAME SHORTUSERNAME 
-                                             FROMFIELD)
-                                  MAILSERVERS))
+(RECORD LAFITEMODEDATA (LAFITEOPS (FULLUSERNAME CREDENTIALS UNPACKEDUSERNAME SHORTUSERNAME FROMFIELD)
+                              MAILSERVERS))
 
-(DATATYPE LAFITEMSG ((PARSED? FLAG)                      (* ; 
-     "True if we have parsed the message, and thus filled in the fields DATE, FROM, SUBJECT below.")
-                         (DELETED? FLAG)                     (* ; 
-                                                           "True if message marked for deletion")
-                         (SEEN? FLAG)                        (* ; "True if message is examined.")
-                         (DATEKNOWN? FLAG)                   (* ; 
-                        "True if DATE field correctly parsed into IDATE [formerly formatted? flag]")
-                         (DATEFETCHED? FLAG)                 (* ; 
-                                             "True if IDATE field contains a date (could be guess)")
-                         (MODEBITS BITS 3)                   (* ; 
-                                                           "Mode in which the message was received")
-                         (MARKCHAR BYTE)                     (* ; "Arbitrary mark byte")
-                         (%# WORD)                           (* ; "Ordinal number of message")
-                         (BEGIN POINTER)                     (* ; "Start of the whole message")
-                         (MESSAGELENGTH POINTER)             (* ; "Lengfth of whole message")
-                         (STAMPLENGTH WORD)                  (* ; 
-                                                      "Number of bytes in file header (usually 24)")
-                         (TOCLENGTH WORD)                    (* ; 
-                                                     "Number of bytes this message consumes on toc")
-                         (MESSAGELENGTHCHANGED? FLAG)        (* ; 
-"True if we have decided that the true length of this message is different from what the file says")
-                         (SELECTED? FLAG)                    (* ; "True if msg currently selected")
-                         (MSGFROMMECHECKED? FLAG)            (* ; 
-                                         "True if we have tested whether this message is from self")
-                         (MSGFROMMETRUTH FLAG)               (* ; "Is it?")
-                         (DATE POINTER)                      (* ; 
-                                                           "The fields of the parse (strings)")
-                         (NIL FLAG)
-                         (MARKSCHANGEDINFILE? FLAG)
-                         (MARKSCHANGEDINTOC? FLAG)
-                         (NIL FLAG)
-                         (FROM POINTER)
-                         (SUBJECT POINTER)
-                         (TO POINTER)
-                         (IDATE FIXP)                        (* ; 
-                                                           "Integer form of DATE (for sorting)")
-                         )
+(DATATYPE LAFITEMSG ((PARSED? FLAG)                          (* ; 
+       "True if we have parsed the message, and thus filled in the fields DATE, FROM, SUBJECT below.")
+                     (DELETED? FLAG)                         (* ; 
+                                                             "True if message marked for deletion")
+                     (SEEN? FLAG)                            (* ; "True if message is examined.")
+                     (DATEKNOWN? FLAG)                       (* ; 
+                          "True if DATE field correctly parsed into IDATE [formerly formatted? flag]")
+                     (DATEFETCHED? FLAG)                     (* ; 
+                                               "True if IDATE field contains a date (could be guess)")
+                     (MODEBITS BITS 3)                       (* ; 
+                                                             "Mode in which the message was received")
+                     (MARKCHAR BYTE)                         (* ; "Arbitrary mark byte")
+                     (%# WORD)                               (* ; "Ordinal number of message")
+                     (BEGIN POINTER)                         (* ; "Start of the whole message")
+                     (MESSAGELENGTH POINTER)                 (* ; "Lengfth of whole message")
+                     (STAMPLENGTH WORD)                      (* ; 
+                                                        "Number of bytes in file header (usually 24)")
+                     (TOCLENGTH WORD)                        (* ; 
+                                                       "Number of bytes this message consumes on toc")
+                     (MESSAGELENGTHCHANGED? FLAG)            (* ; 
+  "True if we have decided that the true length of this message is different from what the file says")
+                     (SELECTED? FLAG)                        (* ; "True if msg currently selected")
+                     (MSGFROMMECHECKED? FLAG)                (* ; 
+                                           "True if we have tested whether this message is from self")
+                     (MSGFROMMETRUTH FLAG)                   (* ; "Is it?")
+                     (DATE POINTER)                          (* ; "The fields of the parse (strings)")
+                     (NIL FLAG)
+                     (MARKSCHANGEDINFILE? FLAG)
+                     (MARKSCHANGEDINTOC? FLAG)
+                     (NIL FLAG)
+                     (FROM POINTER)
+                     (SUBJECT POINTER)
+                     (TO POINTER)
+                     (IDATE FIXP)                            (* ; 
+                                                             "Integer form of DATE (for sorting)")
+                     )
 
-                        (* ;; "BEGIN is the only absolute pointer into the message file -- all other positions are relative to BEGIN -- see the ACCESSFNS")
+                    (* ;; "BEGIN is the only absolute pointer into the message file -- all other positions are relative to BEGIN -- see the ACCESSFNS")
 
-                        (BLOCKRECORD LAFITEMSG ((PARSED&DELETED&SEENBITS BITS 3)
+                    (BLOCKRECORD LAFITEMSG ((PARSED&DELETED&SEENBITS BITS 3)
                                                              (* ; "For toc version 8")
-                                                (DATEBITS BITS 2)
-                                                             (* ; "For toc version 10")
-                                                (NIL BITS 3)
-                                                (NIL BYTE)
-                                                (NIL WORD)))
-                        (BLOCKRECORD LAFITEMSG ((MSGFLAGBITS BITS 8)
-                                                (NIL BYTE)
-                                                (NIL WORD)
-                                                (NIL BITS 4)
-                                                (NIL POINTER)
-                                                (NIL BITS 4)
-                                                (NIL POINTER)
-                                                (NIL WORD)
-                                                (NIL WORD)
-                                                (NIL BITS 4)
-                                                (NIL POINTER)
-                                                (NIL BITS 1)
-                                                (MARKSCHANGEDBITS BITS 2)
-                                                (NIL BITS 1)
-                                                (NIL 3 POINTER)
-                                                (IDATEHI WORD)
-                                                (IDATELO WORD)))
-                        [ACCESSFNS LAFITEMSG ((END (+ (fetch (LAFITEMSG MESSAGELENGTH)
-                                                         of DATUM)
-                                                      (fetch (LAFITEMSG BEGIN) of DATUM)))
-                                              (START (+ (fetch (LAFITEMSG BEGIN) of DATUM)
-                                                        (fetch (LAFITEMSG STAMPLENGTH)
-                                                           of DATUM)))
-                                              (MSGFROMMEP (COND
-                                                             ((fetch (LAFITEMSG MSGFROMMECHECKED?
-                                                                                ) of DATUM)
-                                                              (fetch (LAFITEMSG MSGFROMMETRUTH)
-                                                                 of DATUM))
-                                                             (T (LA.MSGFROMMEP DATUM)))
-                                                     (PROG1 (replace (LAFITEMSG MSGFROMMETRUTH)
-                                                               of DATUM with NEWVALUE)
-                                                         (replace (LAFITEMSG MSGFROMMECHECKED?)
-                                                            of DATUM with T)))
-                                              (MARKSCHANGED? (NEQ 0 (fetch (LAFITEMSG 
-                                                                                     MARKSCHANGEDBITS
-                                                                                      ) of DATUM)
-                                                                  )
-                                                     (replace (LAFITEMSG MARKSCHANGEDBITS)
-                                                        of DATUM with 3))
-                                              (MODE (CL:NTH (fetch (LAFITEMSG MODEBITS)
-                                                               of DATUM)
-                                                           *LAFITE-WELL-KNOWN-MODES*)
-                                                    (replace (LAFITEMSG MODEBITS) of DATUM
-                                                       WITH (OR (CL:POSITION NEWVALUE 
-                                                                           *LAFITE-WELL-KNOWN-MODES*)
-                                                                    0])
+                                            (DATEBITS BITS 2)(* ; "For toc version 10")
+                                            (NIL BITS 3)
+                                            (NIL BYTE)
+                                            (NIL WORD)))
+                    (BLOCKRECORD LAFITEMSG ((MSGFLAGBITS BITS 8)
+                                            (NIL BYTE)
+                                            (NIL WORD)
+                                            (NIL BITS 4)
+                                            (NIL POINTER)
+                                            (NIL BITS 4)
+                                            (NIL POINTER)
+                                            (NIL WORD)
+                                            (NIL WORD)
+                                            (NIL BITS 4)
+                                            (NIL POINTER)
+                                            (NIL BITS 1)
+                                            (MARKSCHANGEDBITS BITS 2)
+                                            (NIL BITS 1)
+                                            (NIL 3 POINTER)
+                                            (IDATEHI WORD)
+                                            (IDATELO WORD)))
+                    [ACCESSFNS LAFITEMSG ((END (+ (fetch (LAFITEMSG MESSAGELENGTH) of DATUM)
+                                                  (fetch (LAFITEMSG BEGIN) of DATUM)))
+                                          (START (+ (fetch (LAFITEMSG BEGIN) of DATUM)
+                                                    (fetch (LAFITEMSG STAMPLENGTH) of DATUM)))
+                                          (MSGFROMMEP (COND
+                                                         ((fetch (LAFITEMSG MSGFROMMECHECKED?)
+                                                             of DATUM)
+                                                          (fetch (LAFITEMSG MSGFROMMETRUTH)
+                                                             of DATUM))
+                                                         (T (LA.MSGFROMMEP DATUM)))
+                                                 (PROG1 (replace (LAFITEMSG MSGFROMMETRUTH)
+                                                           of DATUM with NEWVALUE)
+                                                     (replace (LAFITEMSG MSGFROMMECHECKED?)
+                                                        of DATUM with T)))
+                                          (MARKSCHANGED? (NEQ 0 (fetch (LAFITEMSG MARKSCHANGEDBITS)
+                                                                   of DATUM))
+                                                 (replace (LAFITEMSG MARKSCHANGEDBITS) of DATUM
+                                                    with 3))
+                                          (MODE (CL:NTH (fetch (LAFITEMSG MODEBITS) of DATUM)
+                                                       *LAFITE-WELL-KNOWN-MODES*)
+                                                (replace (LAFITEMSG MODEBITS) of DATUM
+                                                   WITH (OR (CL:POSITION NEWVALUE 
+                                                                   *LAFITE-WELL-KNOWN-MODES*)
+                                                            0])
 
-(DATATYPE MAILFOLDER ((BROWSERPROMPTDIRTY FLAG)          (* ; 
-                                                        "Something's been printed in prompt window")
-                          (BROWSERPROMPTGREW FLAG)           (* ; 
-                                                           "Browser prompt window has expanded")
-                          (FOLDERNEEDSUPDATE FLAG)           (* ; "Something changed")
-                          (FOLDERNEEDSEXPUNGE FLAG)          (* ; "True if deleted msgs")
-                          (FOLDERBEINGUPDATED FLAG)          (* ; "True during Update cmd")
-                          (BROWSERSTATUS BITS 3)             (* ; "Ready, etc.")
-                          (FULLFOLDERNAME POINTER)           (* ; "Full name of actual file")
-                          (FOLDEROKTOSHRINK FLAG)            (* ; 
-                        "Kludge to allow you to call SHRINKW without invoking the Update? question")
-                          (FOLDERGETSMAIL FLAG)              (* ; "True if GetMail ok")
-                          (FOLDEROUTOFORDER FLAG)            (* ; "True if folder has been sorted")
-                          (NIL 5 FLAG)
-                          (VERSIONLESSFOLDERNAME POINTER)    (* ; "Versionless for conflict check")
-                          (SHORTFOLDERNAME POINTER)          (* ; "Normal name displayed to user")
-                          (FOLDERSTREAM POINTER)             (* ; "Stream open on the file, or NIL")
-                          (MESSAGEDESCRIPTORS POINTER)       (* ; "Array of LAFITEMSG")
-                          (FOLDERLOCK POINTER)               (* ; "Monitor lock for all access")
-                          (%#OFMESSAGES WORD)
-                          (TOCLASTMESSAGE# WORD)             (* ; 
-                                                           "Last message that is in TOC file")
-                          (BROWSERFONTHEIGHT WORD)           (* ; "Cached info about browser font")
-                          (BROWSERFONTASCENT WORD)
-                          (BROWSERFONTDESCENT WORD)
-                          (BROWSERMAXXPOS WORD)              (* ; "For extent computations")
-                          (ORDINALXPOS WORD)                 (* ; "Where msg # starts")
-                          (DATEXPOS WORD)                    (* ; "Where msg date starts")
-                          (FROMXPOS WORD)                    (* ; "Where msg From starts")
-                          (FROMMAXXPOS WORD)                 (* ; "Beyond here, From is truncated")
-                          (SUBJECTXPOS WORD)                 (* ; "Where msg subject starts")
-                          (BROWSERDIGITWIDTH WORD)
-                          (FIRSTSELECTEDMESSAGE WORD)        (* ; 
-                                                           "First/last msgs currently selected")
-                          (LASTSELECTEDMESSAGE WORD)
-                          (FIRSTCHANGEDMESSAGE WORD)         (* ; 
-                                                "First message with any change--not currently used")
-                          (CURRENTPROMPTLINE WORD)           (* ; 
-                                                  "Value of \currentdisplayline for browser prompt")
-                          (CURRENTDISPLAYEDSTREAM POINTER)   (* ; 
-                           "The backing core file for the current message (not used interestingly)")
-                          (BROWSEREXTENT POINTER)
-                          (BROWSERORIGIN POINTER)
-                          (FOLDERDISPLAYREGION POINTER)      (* ; 
-                                             "Region of display window (valid when browser shrunk)")
-                          (BROWSERWINDOW POINTER)            (* ; 
-                                                         "The browser window and various pieces...")
-                          (BROWSERMENU POINTER)
-                          (BROWSERMENUWINDOW POINTER)
-                          (BROWSERPROMPTWINDOW POINTER)
-                          (ORIGINALBROWSERTITLE POINTER)     (* ; 
-                                               "Original title before we added %"default move to%"")
-                          (FOLDERDISPLAYWINDOWS POINTER)     (* ; "WIndows currently displaying messages from this folder.  First element is %"primary%" display window, or NIL")
-                          (FOLDEREOFPTR POINTER)             (* ; "Length of file")
-                          (DEFAULTMOVETOFILE POINTER)        (* ; "Folder we last moved to, or NIL")
-                          (CURRENTDISPLAYEDMESSAGE POINTER)  (* ; 
-                                            "Message descriptor of most recently displayed message")
-                          (BROWSERUPDATEFROMHERE POINTER)    (* ; 
-        "First potentially changed message, from which redisplay needs to occur when icon expands.")
-                          (BROWSERLAYOUT POINTER)            (* ; 
-                            "The element of LAFITEBROWSERLAYOUTS used to build this window, if any")
-                          (FOLDERCREATIONDATE POINTER)       (* ; "the ICREATIONDATE of the file")
-                          (HARDCOPYMESSAGES POINTER)         (* ; 
-                                                         "List of msg descriptors being hardcopied")
-                          (HARDCOPYSTREAM POINTER)           (* ; 
-                                                           "A Textstream for pending hardcopy")
-                          )
-                         (BLOCKRECORD MAILFOLDER ((NIL 5 FLAG)
-                                                  (NIL BITS 2)
-                                                  (BROWSERREADYBIT FLAG)
-                                                             (* ; 
-                                                           "Low bit of status on means ready")
-                                                  ))
-                         [ACCESSFNS MAILFOLDER ((BROWSERREADY (fetch (MAILFOLDER BROWSERREADYBIT)
-                                                                 of DATUM)
-                                                       (REPLACE (MAILFOLDER BROWSERSTATUS)
-                                                          OF DATUM WITH (COND
-                                                                                   (NEWVALUE 
-                                                                                          LAS.READY)
-                                                                                   (T LAS.PARSING])
+(DATATYPE MAILFOLDER ((BROWSERPROMPTDIRTY FLAG)              (* ; 
+                                                          "Something's been printed in prompt window")
+                      (BROWSERPROMPTGREW FLAG)               (* ; 
+                                                             "Browser prompt window has expanded")
+                      (FOLDERNEEDSUPDATE FLAG)               (* ; "Something changed")
+                      (FOLDERNEEDSEXPUNGE FLAG)              (* ; "True if deleted msgs")
+                      (FOLDERBEINGUPDATED FLAG)              (* ; "True during Update cmd")
+                      (BROWSERSTATUS BITS 3)                 (* ; "Ready, etc.")
+                      (FULLFOLDERNAME POINTER)               (* ; "Full name of actual file")
+                      (FOLDEROKTOSHRINK FLAG)                (* ; 
+                          "Kludge to allow you to call SHRINKW without invoking the Update? question")
+                      (FOLDERGETSMAIL FLAG)                  (* ; "True if GetMail ok")
+                      (FOLDEROUTOFORDER FLAG)                (* ; "True if folder has been sorted")
+                      (NIL 5 FLAG)
+                      (VERSIONLESSFOLDERNAME POINTER)        (* ; "Versionless for conflict check")
+                      (SHORTFOLDERNAME POINTER)              (* ; "Normal name displayed to user")
+                      (FOLDERSTREAM POINTER)                 (* ; "Stream open on the file, or NIL")
+                      (MESSAGEDESCRIPTORS POINTER)           (* ; "Array of LAFITEMSG")
+                      (FOLDERLOCK POINTER)                   (* ; "Monitor lock for all access")
+                      (%#OFMESSAGES WORD)
+                      (TOCLASTMESSAGE# WORD)                 (* ; "Last message that is in TOC file")
+                      (BROWSERFONTHEIGHT WORD)               (* ; "Cached info about browser font")
+                      (BROWSERFONTASCENT WORD)
+                      (BROWSERFONTDESCENT WORD)
+                      (BROWSERMAXXPOS WORD)                  (* ; "For extent computations")
+                      (ORDINALXPOS WORD)                     (* ; "Where msg # starts")
+                      (DATEXPOS WORD)                        (* ; "Where msg date starts")
+                      (FROMXPOS WORD)                        (* ; "Where msg From starts")
+                      (FROMMAXXPOS WORD)                     (* ; "Beyond here, From is truncated")
+                      (SUBJECTXPOS WORD)                     (* ; "Where msg subject starts")
+                      (BROWSERDIGITWIDTH WORD)
+                      (FIRSTSELECTEDMESSAGE WORD)            (* ; 
+                                                             "First/last msgs currently selected")
+                      (LASTSELECTEDMESSAGE WORD)
+                      (FIRSTCHANGEDMESSAGE WORD)             (* ; 
+                                                  "First message with any change--not currently used")
+                      (CURRENTPROMPTLINE WORD)               (* ; 
+                                                    "Value of \currentdisplayline for browser prompt")
+                      (CURRENTDISPLAYEDSTREAM POINTER)       (* ; 
+                             "The backing core file for the current message (not used interestingly)")
+                      (BROWSEREXTENT POINTER)
+                      (BROWSERORIGIN POINTER)
+                      (FOLDERDISPLAYREGION POINTER)          (* ; 
+                                               "Region of display window (valid when browser shrunk)")
+                      (BROWSERWINDOW POINTER)                (* ; 
+                                                           "The browser window and various pieces...")
+                      (BROWSERMENU POINTER)
+                      (BROWSERMENUWINDOW POINTER)
+                      (BROWSERPROMPTWINDOW POINTER)
+                      (ORIGINALBROWSERTITLE POINTER)         (* ; 
+                                                 "Original title before we added %"default move to%"")
+                      (FOLDERDISPLAYWINDOWS POINTER)         (* ; "WIndows currently displaying messages from this folder.  First element is %"primary%" display window, or NIL")
+                      (FOLDEREOFPTR POINTER)                 (* ; "Length of file")
+                      (DEFAULTMOVETOFILE POINTER)            (* ; "Folder we last moved to, or NIL")
+                      (CURRENTDISPLAYEDMESSAGE POINTER)      (* ; 
+                                              "Message descriptor of most recently displayed message")
+                      (BROWSERUPDATEFROMHERE POINTER)        (* ; 
+          "First potentially changed message, from which redisplay needs to occur when icon expands.")
+                      (BROWSERLAYOUT POINTER)                (* ; 
+                              "The element of LAFITEBROWSERLAYOUTS used to build this window, if any")
+                      (FOLDERCREATIONDATE POINTER)           (* ; "the ICREATIONDATE of the file")
+                      (HARDCOPYMESSAGES POINTER)             (* ; 
+                                                           "List of msg descriptors being hardcopied")
+                      (HARDCOPYSTREAM POINTER)               (* ; "A Textstream for pending hardcopy")
+                      )
+                     (BLOCKRECORD MAILFOLDER ((NIL 5 FLAG)
+                                              (NIL BITS 2)
+                                              (BROWSERREADYBIT FLAG)
+                                                             (* ; "Low bit of status on means ready")
+                                              ))
+                     [ACCESSFNS MAILFOLDER ((BROWSERREADY (fetch (MAILFOLDER BROWSERREADYBIT)
+                                                             of DATUM)
+                                                   (REPLACE (MAILFOLDER BROWSERSTATUS) OF DATUM
+                                                      WITH (COND
+                                                              (NEWVALUE LAS.READY)
+                                                              (T LAS.PARSING])
 
 (RECORD FOLDERGROUP (FGNAME (FGTOPLEVEL . FGSUBGROUPS) . FGFOLDERS))
 
 (RECORD DEFAULTHOST&DIR (PACKEDHOST&DIR . UNPACKEDHOST&DIR)
-                            (PROPRECORD UNPACKEDHOST&DIR (DEFAULTDIR DEFAULTHOST DEFAULTDEV)))
+                        (PROPRECORD UNPACKEDHOST&DIR (DEFAULTDIR DEFAULTHOST DEFAULTDEV)))
 
 (RECORD MAILSERVER (MAILSERVEROPS MAILPORT MAILSERVERNAME CONTINUANCE NEWMAILP . MAILSTATE))
 
 (RECORD MAILSERVEROPS (POLLNEWMAIL OPENMAILBOX NEXTMESSAGE RETRIEVEMESSAGE CLOSEMAILBOX 
-                                 SERVERPORTFROMNAME))
+                             SERVERPORTFROMNAME))
 
 (RECORD OPENEDMAILBOX (MAILBOX . PROPERTIES)
-                          (PROPRECORD PROPERTIES (%#OFMESSAGES)))
+                      (PROPRECORD PROPERTIES (%#OFMESSAGES)))
 
 (RECORD OUTBOX (OBWINDOW OBSIZE OBHEIGHT OBDESCENT OBORIGIN OBITEMS))
 
@@ -462,55 +446,51 @@ Copyright (c) 1985, 1986, 1987, 1988, 1989, 1994 by Xerox Corporation.  All righ
 
 (DECLARE%: EVAL@COMPILE 
 
-[I.S.OPR 'SELECTEDIN NIL '(bind ($$MESSAGES _ (fetch (MAILFOLDER MESSAGEDESCRIPTORS)
-                                                     of BODY))
-                                 ($$MSG# _ (SUB1 (fetch (MAILFOLDER FIRSTSELECTEDMESSAGE)
-                                                    of BODY)))
-                                 ($$MSGLAST _ (fetch (MAILFOLDER LASTSELECTEDMESSAGE)
-                                                 of BODY)) until (IGREATERP (add $$MSG# 1
-                                                                                           )
-                                                                                $$MSGLAST)
-                             when (fetch (LAFITEMSG SELECTED?) of (SETQ I.V.
-                                                                               (NTHMESSAGE $$MESSAGES
-                                                                                      $$MSG#]
+[I.S.OPR 'SELECTEDIN NIL '(bind ($$MESSAGES _ (fetch (MAILFOLDER MESSAGEDESCRIPTORS) of BODY))
+                                ($$MSG# _ (SUB1 (fetch (MAILFOLDER FIRSTSELECTEDMESSAGE) of BODY)))
+                                ($$MSGLAST _ (fetch (MAILFOLDER LASTSELECTEDMESSAGE) of BODY))
+                             until (IGREATERP (add $$MSG# 1)
+                                          $$MSGLAST) when (fetch (LAFITEMSG SELECTED?)
+                                                             of (SETQ I.V. (NTHMESSAGE $$MESSAGES 
+                                                                                  $$MSG#]
 )
 (DECLARE%: EVAL@COMPILE 
 
-(PROGN (PUTPROPS WORDIN DMACRO (= . \WIN))
-       (PUTPROPS WORDIN MACRO (= . \WIN)))
+(PROGN (PUTPROPS WORDIN DMACRO (= . \WIN))
+       (PUTPROPS WORDIN MACRO (= . \WIN)))
 
-[PUTPROPS FIXPIN DMACRO (OPENLAMBDA (STREAM)
-                               (\MAKENUMBER (WORDIN STREAM)
-                                      (WORDIN STREAM]
+(PUTPROPS FIXPIN DMACRO (OPENLAMBDA (STREAM)
+                          (\MAKENUMBER (WORDIN STREAM)
+                                 (WORDIN STREAM))))
 
-(PUTPROPS WORDOUT DMACRO (= . \WOUT))
+(PUTPROPS WORDOUT DMACRO (= . \WOUT))
 
-[PUTPROPS FIXPOUT DMACRO (OPENLAMBDA (STREAM N)
-                                (PROGN (WORDOUT STREAM (LRSH N 16))
-                                       (WORDOUT STREAM (LOGAND N 65535]
+(PUTPROPS FIXPOUT DMACRO [OPENLAMBDA (STREAM N)
+                           (PROGN (WORDOUT STREAM (LRSH N 16))
+                                  (WORDOUT STREAM (LOGAND N 65535])
 
-[PUTPROPS UCASECODE MACRO (OPENLAMBDA (CHAR)
-                                 (COND
-                                    ((AND (IGEQ CHAR (CHARCODE a))
-                                          (ILEQ CHAR (CHARCODE z)))
-                                     (LOGAND CHAR 95))
-                                    (T CHAR]
+(PUTPROPS UCASECODE MACRO (OPENLAMBDA (CHAR)
+                            (COND
+                               ((AND (IGEQ CHAR (CHARCODE a))
+                                     (ILEQ CHAR (CHARCODE z)))
+                                (LOGAND CHAR 95))
+                               (T CHAR))))
 
-(PUTPROPS NTHMESSAGE MACRO (= . ELT))
+(PUTPROPS NTHMESSAGE MACRO (= . ELT))
 
-[PUTPROPS .LAFITEMENU. MACRO ((NAME ITEMS TITLE)
+(PUTPROPS .LAFITEMENU. MACRO [(NAME ITEMS TITLE)
                               (PROGN (DECLARE (GLOBALVARS NAME))
-                                     (OR NAME (SETQ NAME (\LAFITE.CREATE.MENU ITEMS TITLE]
+                                     (OR NAME (SETQ NAME (\LAFITE.CREATE.MENU ITEMS TITLE])
 
-[PUTPROPS MAYBEVERIFYMSG MACRO ((MSG MAILFOLDER)
-                                (AND LAFITEVERIFYFLG (\LAFITE.VERIFYMSG MSG MAILFOLDER]
+(PUTPROPS MAYBEVERIFYMSG MACRO ((MSG MAILFOLDER)
+                                (AND LAFITEVERIFYFLG (\LAFITE.VERIFYMSG MSG MAILFOLDER))))
 
-[PUTPROPS UNSEENMARKP MACRO (OPENLAMBDA (MK)
-                                   (OR (EQ MK UNSEENMARK)
-                                       (EQ MK HEARDMARK]
+(PUTPROPS UNSEENMARKP MACRO (OPENLAMBDA (MK)
+                              (OR (EQ MK UNSEENMARK)
+                                  (EQ MK HEARDMARK))))
 )
 
-(RPAQQ LAFITEGLOBALS 
+(RPAQQ LAFITEGLOBALS
        (*LAFITE-WELL-KNOWN-MODES* ANOTHERFOLDERMENUITEM AROUNDEXITFNS BackgroundMenu 
               BackgroundMenuCommands FORWARDMARK HARDCOPYBATCHMARK HARDCOPYMARK HEARDMARK 
               LA.CROSSCURSOR LA.SELECTION.BITMAP LAFITE.PERSONAL.VARS LAFITE.UPDATE.MENU.HASH 
@@ -551,7 +531,7 @@ Copyright (c) 1985, 1986, 1987, 1988, 1989, 1994 by Xerox Corporation.  All righ
 (* ; "LAFITE.PROCLAMATIONS are exported to user in file LAFITE--these are the documented variables")
 
 
-(RPAQQ LAFITE.PROCLAMATIONS 
+(RPAQQ LAFITE.PROCLAMATIONS
        [(CL:PROCLAIM '(GLOBAL ANSWERMARK BROWSERMARKXPOSITION DEFAULTMAILFOLDERNAME 
                              LAFITE.2COLUMN.MENU.MIN.ITEMS LAFITE.AUTO.MOVE.MENU 
                              LAFITE.BACKGROUND.ITEM LAFITE.BROWSER.ICON.PREFERENCE 
@@ -610,7 +590,7 @@ Copyright (c) 1985, 1986, 1987, 1988, 1989, 1994 by Xerox Corporation.  All righ
 (* ; "For debugging with Masterscope, here are fns not called from code")
 
 
-(RPAQQ LAFITE.CALLED.FROM.LITERALS 
+(RPAQQ LAFITE.CALLED.FROM.LITERALS
        (GV.CLOSEMAILBOX GV.INIT.MAIL.USER GV.MAKEANSWERFORM GV.NEXTMESSAGE GV.OPENMAILBOX 
               GV.POLLNEWMAIL GV.PORTFROMNAME GV.RETRIEVEMESSAGE LAFITE.COMPUTE.CACHED.VARS 
               LAFITE.GRAB.DATE LAFITE.ON.FROM.BACKGROUND LAFITE.PARSE.DATE.FIELD.ONLY 
@@ -637,11 +617,11 @@ Copyright (c) 1985, 1986, 1987, 1988, 1989, 1994 by Xerox Corporation.  All righ
               \NSMAIL.MESSAGE.FROM.SELF.P \NSMAIL.MESSAGE.P \NSMAIL.SEND \NSMAIL.SEND.PARSE 
               \SENDMSG.CHANGE.MODE \SENDMSG.DELIVER \SENDMSG.SAVE.FORM))
 
-(RPAQQ LAFITE.PROGRAMMER.ENTRIES 
-       (LAFITEDEFAULTHOST&DIR LOAD-LAFITE LAFITE.SENDMESSAGE BUILD.LAFITE.LAYOUTS 
-              LAB.SELECTED.MESSAGES LAFITE.DELETE.MESSAGES LAFITE.MOVE.MESSAGES 
-              LAFITE.HARDCOPY.MESSAGES LAFITE.OBTAIN.FOLDER MAILSCAVENGE MS.EXPAND GV.READTOC 
-              GV.WRITETOC GV.DELETEMESSAGE))
+(RPAQQ LAFITE.PROGRAMMER.ENTRIES (LAFITEDEFAULTHOST&DIR LOAD-LAFITE LAFITE.SENDMESSAGE 
+                                        BUILD.LAFITE.LAYOUTS LAB.SELECTED.MESSAGES 
+                                        LAFITE.DELETE.MESSAGES LAFITE.MOVE.MESSAGES 
+                                        LAFITE.HARDCOPY.MESSAGES LAFITE.OBTAIN.FOLDER MAILSCAVENGE 
+                                        MS.EXPAND GV.READTOC GV.WRITETOC GV.DELETEMESSAGE))
 
 (DEFCOMMAND (WHONOTLAFITE :HISTORY) NIL 
    '((CL:SET-DIFFERENCE (CL:SET-DIFFERENCE (%. WHO ON ANY IN LAFITEFILES IS NOT CALLED)
@@ -662,7 +642,6 @@ Copyright (c) 1985, 1986, 1987, 1988, 1989, 1994 by Xerox Corporation.  All righ
 
 (SETTEMPLATE 'TEXTPROP '(EVAL PROP EVAL . PPE))
 )
-(PUTPROPS LAFITEDECLS COPYRIGHT ("Xerox Corporation" 1985 1986 1987 1988 1989 1994))
 (DECLARE%: DONTCOPY
   (FILEMAP (NIL)))
 STOP
diff --git a/library/lafite/LAFITEFIND b/library/lafite/LAFITE-FIND
similarity index 93%
rename from library/lafite/LAFITEFIND
rename to library/lafite/LAFITE-FIND
index fd00c40c..699cb6f9 100644
--- a/library/lafite/LAFITEFIND
+++ b/library/lafite/LAFITE-FIND
@@ -1,20 +1,17 @@
 (DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
-(FILECREATED "30-Sep-2021 23:01:05" 
-{DSK}<Users>kaplan>Local>medley3.5>git-medley>library>lafite>LAFITEFIND.;2 14882  
 
-      changes to%:  (FILES LAFITEDECLS)
+(FILECREATED "23-Feb-2024 22:24:01" {WMEDLEY}<library>lafite>LAFITE-FIND.;2 14652  
 
-      previous date%: " 3-Jun-92 10:10:41" 
-{DSK}<Users>kaplan>Local>medley3.5>git-medley>library>lafite>LAFITEFIND.;1)
+      :EDIT-BY rmk
+
+      :CHANGES-TO (VARS LAFITE-FINDCOMS)
+
+      :PREVIOUS-DATE "23-Feb-2024 22:11:33" {WMEDLEY}<library>lafite>LAFITE-FIND.;1)
 
 
-(* ; "
-Copyright (c) 1984-1988, 1990, 1992, 2021 by Venue & Xerox Corporation.
-")
+(PRETTYCOMPRINT LAFITE-FINDCOMS)
 
-(PRETTYCOMPRINT LAFITEFINDCOMS)
-
-(RPAQQ LAFITEFINDCOMS
+(RPAQQ LAFITE-FINDCOMS
        ((FNS \LAFITE.FIND \LAFITE.FIND.RELATED \LAFITE.FIND.RELATED.BACKWARD \LAFITE.GO.TO.FIRST 
              \LAFITE.GO.TO.INTERACTIVE \LAFITE.GO.TO.LAST \LAFITE.FIND.AGAIN \LAFITE.FIND.PROMPT 
              \LAFITE.DO.FIND \LAFITE.FIND.START)
@@ -22,7 +19,7 @@ Copyright (c) 1984-1988, 1990, 1992, 2021 by Venue & Xerox Corporation.
                (GLOBALVARS LAFITEFINDAREAMENUITEMS LAFITEFINDTYPEMENUITEMS LAFITEFINDTYPEMENU 
                       LAFITEFINDAREAMENU LAFITEEXTRAMENU LAFITEEXTRAMENUFLG \LAFITE.LAST.SEARCH)
                (FILES (SOURCE)
-                      LAFITEDECLS)
+                      LAFITE-DECLS)
                (LOCALVARS . T))
         (INITVARS LAFITEFINDTYPEMENU LAFITEFINDAREAMENU)
         (VARS LAFITEFINDAREAMENUITEMS LAFITEFINDTYPEMENUITEMS)
@@ -133,7 +130,7 @@ Copyright (c) 1984-1988, 1990, 1992, 2021 by Venue & Xerox Corporation.
 
 
 (FILESLOAD (SOURCE)
-       LAFITEDECLS)
+       LAFITE-DECLS)
 
 (DECLARE%: DOEVAL@COMPILE DONTCOPY
 
@@ -181,11 +178,10 @@ Copyright (c) 1984-1988, 1990, 1992, 2021 by Venue & Xerox Corporation.
 (ADDTOVAR LAFITEMENUVARS LAFITEFINDTYPEMENU LAFITEFINDAREAMENU)
 
 (RPAQQ \LAFITE.LAST.SEARCH NIL)
-(PUTPROPS LAFITEFIND COPYRIGHT ("Venue & Xerox Corporation" 1984 1985 1986 1987 1988 1990 1992 2021))
 (DECLARE%: DONTCOPY
-  (FILEMAP (NIL (2309 12081 (\LAFITE.FIND 2319 . 3351) (\LAFITE.FIND.RELATED 3353 . 4018) (
-\LAFITE.FIND.RELATED.BACKWARD 4020 . 4156) (\LAFITE.GO.TO.FIRST 4158 . 4325) (
-\LAFITE.GO.TO.INTERACTIVE 4327 . 4939) (\LAFITE.GO.TO.LAST 4941 . 5149) (\LAFITE.FIND.AGAIN 5151 . 
-5733) (\LAFITE.FIND.PROMPT 5735 . 7857) (\LAFITE.DO.FIND 7859 . 11010) (\LAFITE.FIND.START 11012 . 
-12079)))))
+  (FILEMAP (NIL (2180 11952 (\LAFITE.FIND 2190 . 3222) (\LAFITE.FIND.RELATED 3224 . 3889) (
+\LAFITE.FIND.RELATED.BACKWARD 3891 . 4027) (\LAFITE.GO.TO.FIRST 4029 . 4196) (
+\LAFITE.GO.TO.INTERACTIVE 4198 . 4810) (\LAFITE.GO.TO.LAST 4812 . 5020) (\LAFITE.FIND.AGAIN 5022 . 
+5604) (\LAFITE.FIND.PROMPT 5606 . 7728) (\LAFITE.DO.FIND 7730 . 10881) (\LAFITE.FIND.START 10883 . 
+11950)))))
 STOP
diff --git a/library/lafite/LAFITE-FIND.LCOM b/library/lafite/LAFITE-FIND.LCOM
new file mode 100644
index 00000000..04c0f9ab
Binary files /dev/null and b/library/lafite/LAFITE-FIND.LCOM differ
diff --git a/library/lafite/LAFITEFOLDERS b/library/lafite/LAFITE-FOLDERS
similarity index 94%
rename from library/lafite/LAFITEFOLDERS
rename to library/lafite/LAFITE-FOLDERS
index a4c215fe..5c2408b0 100644
--- a/library/lafite/LAFITEFOLDERS
+++ b/library/lafite/LAFITE-FOLDERS
@@ -1,21 +1,17 @@
 (DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
 
-(FILECREATED " 7-Feb-2022 12:04:09" 
-{DSK}<Users>kaplan>Local>medley3.5>my-medley>library>lafite>LAFITEFOLDERS.;2 44421  
+(FILECREATED "23-Feb-2024 22:24:01" {WMEDLEY}<library>lafite>LAFITE-FOLDERS.;2 44255  
 
-      :CHANGES-TO (FNS \LAFITE.MAKE.RANDOM.DISPLAY)
+      :EDIT-BY rmk
 
-      :PREVIOUS-DATE " 2-Nov-89 18:16:37" 
-{DSK}<Users>kaplan>Local>medley3.5>my-medley>library>lafite>LAFITEFOLDERS.;1)
+      :CHANGES-TO (VARS LAFITE-FOLDERSCOMS)
+
+      :PREVIOUS-DATE "23-Feb-2024 22:01:00" {WMEDLEY}<library>lafite>LAFITE-FOLDERS.;1)
 
 
-(* ; "
-Copyright (c) 1989 by Xerox Corporation.
-")
+(PRETTYCOMPRINT LAFITE-FOLDERSCOMS)
 
-(PRETTYCOMPRINT LAFITEFOLDERSCOMS)
-
-(RPAQQ LAFITEFOLDERSCOMS
+(RPAQQ LAFITE-FOLDERSCOMS
        [
         (* ;; "Maintenance of Lafite's folder structures, menus etc.")
 
@@ -53,7 +49,7 @@ Copyright (c) 1989 by Xerox Corporation.
                    UALPHORDERCAR)
               (VARS LAFITE.SPACER.MENU.ITEM LAFITE.GROUP.COMMANDS (LAFITE.GROUP.COMMANDS.MENU)))
         (DECLARE%: EVAL@COMPILE DONTCOPY (FILES (SOURCE)
-                                                LAFITEDECLS)
+                                                LAFITE-DECLS)
                (LOCALVARS . T)
                (GLOBALVARS MENUFONT LAFITE.GROUP.COMMANDS.MENU LAFITE.GROUP.COMMANDS)
                (P (CL:PROCLAIM '(CL:SPECIAL *LA.ABBREVS.IN.PROFILE*])
@@ -334,7 +330,7 @@ Done." (ADD1 (GETEOFPTR TEXTSTREAM))))))
 (DECLARE%: EVAL@COMPILE DONTCOPY 
 
 (FILESLOAD (SOURCE)
-       LAFITEDECLS)
+       LAFITE-DECLS)
 
 (DECLARE%: DOEVAL@COMPILE DONTCOPY
 
@@ -349,25 +345,24 @@ Done." (ADD1 (GETEOFPTR TEXTSTREAM))))))
 
 (CL:PROCLAIM '(CL:SPECIAL *LA.ABBREVS.IN.PROFILE*))
 )
-(PUTPROPS LAFITEFOLDERS COPYRIGHT ("Xerox Corporation" 1989))
 (DECLARE%: DONTCOPY
-  (FILEMAP (NIL (3536 11401 (\LAFITE.READ.PROFILE 3546 . 5750) (\LAFITE.PROCESS.PROFILE 5752 . 6942) (
-\LAFITE.WRITE.PROFILE 6944 . 8778) (\LAFITE.MERGE.NAMELISTS 8780 . 9514) (\LAFITE.READ.OLD.PROFILE 
-9516 . 10115) (\LAFITE.MERGE.FOLDERS 10117 . 10429) (\LAFITE.MERGE.STRUCTURES 10431 . 10631) (
-\LAFITE.REPACK.FOLDERS 10633 . 11399)) (11828 20372 (\LAFITE.PROMPTFORFOLDER 11838 . 12388) (
-PROMPTFORFILENAME 12390 . 13231) (MAKELAFITEMAILFOLDERSMENU 13233 . 13397) (MAKELAFITEFOLDERSMENUITEMS
- 13399 . 14514) (LAFITE.GROUP.ITEM 14516 . 15053) (\LAFITE.ARRANGE.MENU 15055 . 16337) (
-\LAFITE.MAKE.FOLDER.MENU 16339 . 16864) (LAFITE.SELECT.FOLDERS 16866 . 17251) (LAFITE.SELECT.MULTIPLE 
-17253 . 19597) (\LAFITE.HANDLE.MULTIPLE.SELECTION 19599 . 20071) (COLLECT.SHADED.ITEMS 20073 . 20370))
- (20595 29104 (LA.LONGFILENAME 20605 . 22480) (LA.SHORTFILENAME 22482 . 24305) (FORGETMAILFILE 24307
- . 24767) (\LAFITE.FOLDER.NAME.CHANGED 24769 . 25992) (\LAFITE.CHANGE.NAME.IN.LIST 25994 . 26373) (
-\LAFITE.RECOMPUTE.FOLDER.NAMES 26375 . 27796) (\LAFITE.NEW.SHORT.NAME 27798 . 28479) (
-\LAFITE.NOTICE.FILE 28481 . 28662) (\LAFITE.UNCACHE.FOLDER 28664 . 29102)) (29220 43399 (
-\LAFITE.NOTICE.FOLDERS 29230 . 30870) (\LAFITE.GC.FOLDERS 30872 . 31959) (\LAFITE.GC.FOLDERS.CONFIRM 
-31961 . 32771) (\LAFITE.MAKE.RANDOM.DISPLAY 32773 . 34764) (\LAFITE.CHANGE.FOLDER.LIST 34766 . 35519) 
-(\LAFITE.RENAME.FOLDER 35521 . 37251) (\LAFITE.ADD.NEW.GROUP 37253 . 37978) (\LAFITE.CHECK.GROUP.NAME 
-37980 . 38331) (\LAFITE.CHANGE.GROUP.MEMBERS 38333 . 38708) (\LAFITE.SELECT.GROUP.FOLDERS 38710 . 
-39716) (\LAFITE.CHANGE.SUBGROUPS 39718 . 40369) (\LAFITE.CHANGE.TOP.GROUPS 40371 . 41079) (
-\LAFITE.DELETE.GROUP 41081 . 41663) (LAFITE.RENAME.GROUP 41665 . 42521) (\LAFITE.EDIT.HIERARCHY 42523
- . 43082) (LAFITE.FIND.GROUP 43084 . 43280) (UALPHORDERCAR 43282 . 43397)))))
+  (FILEMAP (NIL (3431 11296 (\LAFITE.READ.PROFILE 3441 . 5645) (\LAFITE.PROCESS.PROFILE 5647 . 6837) (
+\LAFITE.WRITE.PROFILE 6839 . 8673) (\LAFITE.MERGE.NAMELISTS 8675 . 9409) (\LAFITE.READ.OLD.PROFILE 
+9411 . 10010) (\LAFITE.MERGE.FOLDERS 10012 . 10324) (\LAFITE.MERGE.STRUCTURES 10326 . 10526) (
+\LAFITE.REPACK.FOLDERS 10528 . 11294)) (11723 20267 (\LAFITE.PROMPTFORFOLDER 11733 . 12283) (
+PROMPTFORFILENAME 12285 . 13126) (MAKELAFITEMAILFOLDERSMENU 13128 . 13292) (MAKELAFITEFOLDERSMENUITEMS
+ 13294 . 14409) (LAFITE.GROUP.ITEM 14411 . 14948) (\LAFITE.ARRANGE.MENU 14950 . 16232) (
+\LAFITE.MAKE.FOLDER.MENU 16234 . 16759) (LAFITE.SELECT.FOLDERS 16761 . 17146) (LAFITE.SELECT.MULTIPLE 
+17148 . 19492) (\LAFITE.HANDLE.MULTIPLE.SELECTION 19494 . 19966) (COLLECT.SHADED.ITEMS 19968 . 20265))
+ (20490 28999 (LA.LONGFILENAME 20500 . 22375) (LA.SHORTFILENAME 22377 . 24200) (FORGETMAILFILE 24202
+ . 24662) (\LAFITE.FOLDER.NAME.CHANGED 24664 . 25887) (\LAFITE.CHANGE.NAME.IN.LIST 25889 . 26268) (
+\LAFITE.RECOMPUTE.FOLDER.NAMES 26270 . 27691) (\LAFITE.NEW.SHORT.NAME 27693 . 28374) (
+\LAFITE.NOTICE.FILE 28376 . 28557) (\LAFITE.UNCACHE.FOLDER 28559 . 28997)) (29115 43294 (
+\LAFITE.NOTICE.FOLDERS 29125 . 30765) (\LAFITE.GC.FOLDERS 30767 . 31854) (\LAFITE.GC.FOLDERS.CONFIRM 
+31856 . 32666) (\LAFITE.MAKE.RANDOM.DISPLAY 32668 . 34659) (\LAFITE.CHANGE.FOLDER.LIST 34661 . 35414) 
+(\LAFITE.RENAME.FOLDER 35416 . 37146) (\LAFITE.ADD.NEW.GROUP 37148 . 37873) (\LAFITE.CHECK.GROUP.NAME 
+37875 . 38226) (\LAFITE.CHANGE.GROUP.MEMBERS 38228 . 38603) (\LAFITE.SELECT.GROUP.FOLDERS 38605 . 
+39611) (\LAFITE.CHANGE.SUBGROUPS 39613 . 40264) (\LAFITE.CHANGE.TOP.GROUPS 40266 . 40974) (
+\LAFITE.DELETE.GROUP 40976 . 41558) (LAFITE.RENAME.GROUP 41560 . 42416) (\LAFITE.EDIT.HIERARCHY 42418
+ . 42977) (LAFITE.FIND.GROUP 42979 . 43175) (UALPHORDERCAR 43177 . 43292)))))
 STOP
diff --git a/library/lafite/LAFITEFOLDERS.LCOM b/library/lafite/LAFITE-FOLDERS.LCOM
similarity index 57%
rename from library/lafite/LAFITEFOLDERS.LCOM
rename to library/lafite/LAFITE-FOLDERS.LCOM
index 42c20c7f..13ccd31a 100644
Binary files a/library/lafite/LAFITEFOLDERS.LCOM and b/library/lafite/LAFITE-FOLDERS.LCOM differ
diff --git a/library/lafite/LAFITEHAX b/library/lafite/LAFITE-HAX
similarity index 79%
rename from library/lafite/LAFITEHAX
rename to library/lafite/LAFITE-HAX
index f03cfe66..c74a05a7 100644
--- a/library/lafite/LAFITEHAX
+++ b/library/lafite/LAFITE-HAX
@@ -1,19 +1,30 @@
-(DEFINE-FILE-INFO READTABLE "INTERLISP" PACKAGE "INTERLISP")
-(FILECREATED "26-Feb-93 14:36:38" "{DSK}<tilde>vanmelle>lisp>lafite>LAFITEHAX.;12" 9033   
+(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
 
-      changes to%:  (FNS \NSMAIL.PARSE1 \NSMAIL.NEW.CHECKSERVER LAFITE.TOGGLE.SERVER.TRACE LAFITE.HANDLE.ORIGINAL.FIELD LAFITE.COMPUTE.CACHED.VARS LAFITE.NEW.PARSE.HEADER INIT.NEW.PARSE.HANDLER)
- (VARS LAFITEHAXCOMS)
+(FILECREATED "23-Feb-2024 23:58:34" {WMEDLEY}<library>lafite>LAFITE-HAX.;1 9138   
 
-      previous date%: " 3-Jun-92 16:10:47" "{DSK}<tilde>vanmelle>lisp>lafite>LAFITEHAX.;1")
+      :EDIT-BY rmk
+
+      :PREVIOUS-DATE "26-Feb-93 14:36:38" {WMEDLEY}<library>lafite>LAFITEHAX.;1)
 
 
-(* ; "
-Copyright (c) 1992, 1993 by Xerox Corporation.  All rights reserved.
-")
+(PRETTYCOMPRINT LAFITE-HAXCOMS)
 
-(PRETTYCOMPRINT LAFITEHAXCOMS)
-
-(RPAQQ LAFITEHAXCOMS ((COMS (* ; "New header parser") (FNS LAFITE.NEW.PARSE.HEADER LAFITE.HANDLE.ORIGINAL.FIELD INIT.NEW.PARSE.HANDLER LAFITE.COMPUTE.CACHED.VARS) (INITVARS (*LAFITE-MAX-FIELD-WIDTH* 100) (*LAFITE-PARSE-HEADER-STRING-RESOURCE*)) (GLOBALVARS *LAFITE-MAX-FIELD-WIDTH* *LAFITE-PARSE-HEADER-STRING-RESOURCE*) (DECLARE%: DONTEVAL@LOAD DOCOPY (P (INIT.NEW.PARSE.HANDLER)))) (COMS (* ; "automatically handle internet addresses") (FNS \NSMAIL.PARSE1)) (COMS (FNS LAFITE.TOGGLE.SERVER.TRACE) (APPENDVARS (LAFITESUBQUITMENUITEMS ("Server trace" (QUOTE LAFITE.TOGGLE.SERVER.TRACE) "Change setting of *NSMAIL-TRACE-SERVERS*"))) (VARS (LAFITESUBQUITMENU)))))
+(RPAQQ LAFITE-HAXCOMS
+       [[COMS                                                (* ; "New header parser")
+              (FNS LAFITE.NEW.PARSE.HEADER LAFITE.HANDLE.ORIGINAL.FIELD INIT.NEW.PARSE.HANDLER 
+                   LAFITE.COMPUTE.CACHED.VARS)
+              (INITVARS (*LAFITE-MAX-FIELD-WIDTH* 100)
+                     (*LAFITE-PARSE-HEADER-STRING-RESOURCE*))
+              (GLOBALVARS *LAFITE-MAX-FIELD-WIDTH* *LAFITE-PARSE-HEADER-STRING-RESOURCE*)
+              (DECLARE%: DONTEVAL@LOAD DOCOPY (P (INIT.NEW.PARSE.HANDLER]
+        (COMS                                                (* ; 
+                                                            "automatically handle internet addresses")
+              (FNS \NSMAIL.PARSE1))
+        (COMS (FNS LAFITE.TOGGLE.SERVER.TRACE)
+              (APPENDVARS (LAFITESUBQUITMENUITEMS ("Server trace" 'LAFITE.TOGGLE.SERVER.TRACE 
+                                                         "Change setting of *NSMAIL-TRACE-SERVERS*"))
+                     )
+              (VARS (LAFITESUBQUITMENU])
 
 
 
@@ -40,16 +51,16 @@ Copyright (c) 1992, 1993 by Xerox Corporation.  All rights reserved.
 )
 )
 
-(RPAQ? *LAFITE-MAX-FIELD-WIDTH* 100)
+(RPAQ? *LAFITE-MAX-FIELD-WIDTH* 100)
 
-(RPAQ? *LAFITE-PARSE-HEADER-STRING-RESOURCE*)
+(RPAQ? *LAFITE-PARSE-HEADER-STRING-RESOURCE* )
 (DECLARE%: DOEVAL@COMPILE DONTCOPY
 
 (GLOBALVARS *LAFITE-MAX-FIELD-WIDTH* *LAFITE-PARSE-HEADER-STRING-RESOURCE*)
 )
 (DECLARE%: DONTEVAL@LOAD DOCOPY 
 
-(INIT.NEW.PARSE.HANDLER)
+(INIT.NEW.PARSE.HANDLER)
 )
 
 
@@ -69,13 +80,12 @@ Copyright (c) 1992, 1993 by Xerox Corporation.  All rights reserved.
 )
 )
 
-(APPENDTOVAR LAFITESUBQUITMENUITEMS ("Server trace" (QUOTE LAFITE.TOGGLE.SERVER.TRACE) "Change setting of *NSMAIL-TRACE-SERVERS*")
-)
+(APPENDTOVAR LAFITESUBQUITMENUITEMS ("Server trace" 'LAFITE.TOGGLE.SERVER.TRACE 
+                                           "Change setting of *NSMAIL-TRACE-SERVERS*"))
 
-(RPAQQ LAFITESUBQUITMENU NIL)
-(PUTPROPS LAFITEHAX COPYRIGHT ("Xerox Corporation" 1992 1993))
+(RPAQQ LAFITESUBQUITMENU NIL)
 (DECLARE%: DONTCOPY
-  (FILEMAP (NIL (1281 6753 (LAFITE.NEW.PARSE.HEADER 1291 . 3112) (LAFITE.HANDLE.ORIGINAL.FIELD 3114 . 
-3790) (INIT.NEW.PARSE.HANDLER 3792 . 4047) (LAFITE.COMPUTE.CACHED.VARS 4049 . 6751)) (7070 8290 (
-\NSMAIL.PARSE1 7080 . 8288)) (8291 8778 (LAFITE.TOGGLE.SERVER.TRACE 8301 . 8776)))))
+  (FILEMAP (NIL (1396 6868 (LAFITE.NEW.PARSE.HEADER 1406 . 3227) (LAFITE.HANDLE.ORIGINAL.FIELD 3229 . 
+3905) (INIT.NEW.PARSE.HANDLER 3907 . 4162) (LAFITE.COMPUTE.CACHED.VARS 4164 . 6866)) (7198 8418 (
+\NSMAIL.PARSE1 7208 . 8416)) (8419 8906 (LAFITE.TOGGLE.SERVER.TRACE 8429 . 8904)))))
 STOP
diff --git a/library/lafite/LAFITEMAIL b/library/lafite/LAFITE-MAIL
similarity index 97%
rename from library/lafite/LAFITEMAIL
rename to library/lafite/LAFITE-MAIL
index 9d43877d..43e73f82 100644
--- a/library/lafite/LAFITEMAIL
+++ b/library/lafite/LAFITE-MAIL
@@ -1,18 +1,17 @@
 (DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
-(FILECREATED "30-Sep-2021 23:01:47" 
-{DSK}<Users>kaplan>Local>medley3.5>git-medley>library>lafite>LAFITEMAIL.;3 133718 
 
-      previous date%: "22-Jun-2021 10:19:08" 
-{DSK}<Users>kaplan>Local>medley3.5>git-medley>library>lafite>LAFITEMAIL.;2)
+(FILECREATED "23-Feb-2024 22:24:01" {WMEDLEY}<library>lafite>LAFITE-MAIL.;2 133521 
+
+      :EDIT-BY rmk
+
+      :CHANGES-TO (VARS LAFITE-MAILCOMS)
+
+      :PREVIOUS-DATE "23-Feb-2024 22:05:03" {WMEDLEY}<library>lafite>LAFITE-MAIL.;1)
 
 
-(* ; "
-Copyright (c) 1984-1989, 1991-1993, 2021 by Xerox Corporation.
-")
+(PRETTYCOMPRINT LAFITE-MAILCOMS)
 
-(PRETTYCOMPRINT LAFITEMAILCOMS)
-
-(RPAQQ LAFITEMAILCOMS
+(RPAQQ LAFITE-MAILCOMS
        ((COMS                                                (* ; "Retrieving mail")
               (FNS \LAFITE.GETMAIL \LAFITE.GETMAIL.FROM.ICON \LAFITE.GETMAIL.PROC \LAFITE.GETNEWMAIL
                    \LAFITE.GETNEWMAIL1 \LAFITE.GETNEWMAIL# \LAFITE.RETRIEVEMESSAGES))
@@ -64,7 +63,7 @@ Copyright (c) 1984-1989, 1991-1993, 2021 by Xerox Corporation.
                       \LAPARSE.TOCFIELDS \LAPARSE.TOFIELD \LAPARSE.SUBJECTFIELD \LAPARSE.DATEFIELD 
                       LAFITE.AFTER.GETMAIL.FN)
                (FILES (SOURCE)
-                      LAFITEDECLS)
+                      LAFITE-DECLS)
                (LOCALVARS . T))))
 
 
@@ -1909,9 +1908,9 @@ Copyright (c) 1984-1989, 1991-1993, 2021 by Xerox Corporation.
         ("FORMAT:" LAFITE.READ.FORMAT)))
 
 (RPAQQ LA.TOCFIELDS (("DATE:" LAFITE.GRAB.DATE)
-                         ("FROM:" LAFITE.READ.LINE.FOR.TOC From)
-                         ("SUBJECT:" LAFITE.READ.LINE.FOR.TOC Subject)
-                         ("ORIGINAL-FROM:" LAFITE.READ.LINE.FOR.TOC Original-From)))
+                     ("FROM:" LAFITE.READ.LINE.FOR.TOC From)
+                     ("SUBJECT:" LAFITE.READ.LINE.FOR.TOC Subject)
+                     ("ORIGINAL-FROM:" LAFITE.READ.LINE.FOR.TOC Original-From)))
 
 (RPAQQ LA.TOFIELDONLY (("TO:" LAFITE.READ.ONE.LINE.FOR.TOC)))
 
@@ -2110,39 +2109,37 @@ Copyright (c) 1984-1989, 1991-1993, 2021 by Xerox Corporation.
 
 
 (FILESLOAD (SOURCE)
-       LAFITEDECLS)
+       LAFITE-DECLS)
 
 (DECLARE%: DOEVAL@COMPILE DONTCOPY
 
 (LOCALVARS . T)
 )
 )
-(PUTPROPS LAFITEMAIL COPYRIGHT ("Xerox Corporation" 1984 1985 1986 1987 1988 1989 1991 1992 1993 2021)
-)
 (DECLARE%: DONTCOPY
-  (FILEMAP (NIL (4395 22354 (\LAFITE.GETMAIL 4405 . 4776) (\LAFITE.GETMAIL.FROM.ICON 4778 . 5126) (
-\LAFITE.GETMAIL.PROC 5128 . 5575) (\LAFITE.GETNEWMAIL 5577 . 11919) (\LAFITE.GETNEWMAIL1 11921 . 14653
-) (\LAFITE.GETNEWMAIL# 14655 . 15044) (\LAFITE.RETRIEVEMESSAGES 15046 . 22352)) (22401 51381 (
-\LAFITE.GET.USER.DATA 22411 . 25245) (\LAFITE.GUESS.MODE 25247 . 27467) (\LAFITE.REGISTER.MODE 27469
- . 28728) (LAFITECLEARCACHE 28730 . 29484) (FULLUSERNAME 29486 . 30585) (LAFITE.USER.NAME.FROM.LOGIN 
-30587 . 32370) (LAFITEMAILWATCH 32372 . 33702) (\LAFITE.WAKE.WATCHER 33704 . 34293) (POLLNEWMAIL 34295
- . 47918) (\LAFITE.NEW.MAIL.EXISTS 47920 . 48256) (PRINTLAFITESTATUS 48258 . 50624) (
-LAFITE.STATUS.WITH.TIME 50626 . 50930) (\LAFITE.REINITIALIZING 50932 . 51379)) (51417 106191 (
-\LAFITE.PARSE.FOLDER 51427 . 52795) (\LAFITE.PARSE.FOLDER1 52797 . 60252) (\LAFITE.HANDLE.DUPLICATES 
-60254 . 63290) (\LAFITE.CHECK.DUPLICATE 63292 . 64227) (\LAFITE.REPORT.DUPLICATES 64229 . 66114) (
-BADMAILFILE 66116 . 74672) (BADMAILFILE.CLOSEFN 74674 . 75002) (BADMAILFILE.FLAGBYTE 75004 . 75202) (
-VERIFYMAILFOLDER 75204 . 79775) (VERIFYFAILED 79777 . 79965) (\LAFITE.READ.TOC.FILE 79967 . 93470) (
-BADTOCFILE 93472 . 93966) (\LAFITE.TOCEOF 93968 . 94303) (LA.READCOUNT 94305 . 95533) (LA.READSTAMP 
-95535 . 96078) (LA.PRINTHEADER 96080 . 99402) (LA.PRINTCOUNT 99404 . 99637) (LA.PRINTSTAMP 99639 . 
-100063) (LA.READSHORTSTRING 100065 . 100832) (LA.PRINTSHORTSTRING 100834 . 101963) (LA.READSTRING 
-101965 . 102436) (\LAFITE.VERIFYMSG 102438 . 104219) (LA.MSGFROMMEP 104221 . 106189)) (106192 122077 (
-LAFITE.PARSE.MSG.FOR.TOC 106202 . 109562) (LAFITE-EXTRACT-REAL-NAME 109564 . 112693) (
-LAFITE.FETCH.TO.FIELD 112695 . 113970) (LAFITE.PARSE.HEADER 113972 . 117081) (LAFITE.GRAB.DATE 117083
- . 117488) (LAFITE.READ.LINE.FOR.TOC 117490 . 117926) (LAFITE.READ.FORMAT 117928 . 118310) (
-LAFITE.READ.NAME.FIELD 118312 . 119345) (LAFITE.READ.ONE.LINE.FOR.TOC 119347 . 119528) (
-LAFITE.READ.TO.EOL 119530 . 120460) (LA.SKIP.TO.EOL 120462 . 121797) (LAFITE.SKIP.WHITE.SPACE 121799
- . 122075)) (122078 122719 (\LAFITE.PARSE.MESSAGE 122088 . 122717)) (123679 127667 (
-LAFITE.INIT.PARSETABLES 123689 . 124200) (LAFITE.MAKE.PARSE.TABLE 124202 . 125172) (
-LAFITE.MAKE.PARSE.TABLE1 125174 . 127665)) (127702 132269 (LAFITE.NEW.PARSE.HEADER 127712 . 131321) (
-LAFITE.HANDLE.ORIGINAL.FIELD 131323 . 132267)))))
+  (FILEMAP (NIL (4314 22273 (\LAFITE.GETMAIL 4324 . 4695) (\LAFITE.GETMAIL.FROM.ICON 4697 . 5045) (
+\LAFITE.GETMAIL.PROC 5047 . 5494) (\LAFITE.GETNEWMAIL 5496 . 11838) (\LAFITE.GETNEWMAIL1 11840 . 14572
+) (\LAFITE.GETNEWMAIL# 14574 . 14963) (\LAFITE.RETRIEVEMESSAGES 14965 . 22271)) (22320 51300 (
+\LAFITE.GET.USER.DATA 22330 . 25164) (\LAFITE.GUESS.MODE 25166 . 27386) (\LAFITE.REGISTER.MODE 27388
+ . 28647) (LAFITECLEARCACHE 28649 . 29403) (FULLUSERNAME 29405 . 30504) (LAFITE.USER.NAME.FROM.LOGIN 
+30506 . 32289) (LAFITEMAILWATCH 32291 . 33621) (\LAFITE.WAKE.WATCHER 33623 . 34212) (POLLNEWMAIL 34214
+ . 47837) (\LAFITE.NEW.MAIL.EXISTS 47839 . 48175) (PRINTLAFITESTATUS 48177 . 50543) (
+LAFITE.STATUS.WITH.TIME 50545 . 50849) (\LAFITE.REINITIALIZING 50851 . 51298)) (51336 106110 (
+\LAFITE.PARSE.FOLDER 51346 . 52714) (\LAFITE.PARSE.FOLDER1 52716 . 60171) (\LAFITE.HANDLE.DUPLICATES 
+60173 . 63209) (\LAFITE.CHECK.DUPLICATE 63211 . 64146) (\LAFITE.REPORT.DUPLICATES 64148 . 66033) (
+BADMAILFILE 66035 . 74591) (BADMAILFILE.CLOSEFN 74593 . 74921) (BADMAILFILE.FLAGBYTE 74923 . 75121) (
+VERIFYMAILFOLDER 75123 . 79694) (VERIFYFAILED 79696 . 79884) (\LAFITE.READ.TOC.FILE 79886 . 93389) (
+BADTOCFILE 93391 . 93885) (\LAFITE.TOCEOF 93887 . 94222) (LA.READCOUNT 94224 . 95452) (LA.READSTAMP 
+95454 . 95997) (LA.PRINTHEADER 95999 . 99321) (LA.PRINTCOUNT 99323 . 99556) (LA.PRINTSTAMP 99558 . 
+99982) (LA.READSHORTSTRING 99984 . 100751) (LA.PRINTSHORTSTRING 100753 . 101882) (LA.READSTRING 101884
+ . 102355) (\LAFITE.VERIFYMSG 102357 . 104138) (LA.MSGFROMMEP 104140 . 106108)) (106111 121996 (
+LAFITE.PARSE.MSG.FOR.TOC 106121 . 109481) (LAFITE-EXTRACT-REAL-NAME 109483 . 112612) (
+LAFITE.FETCH.TO.FIELD 112614 . 113889) (LAFITE.PARSE.HEADER 113891 . 117000) (LAFITE.GRAB.DATE 117002
+ . 117407) (LAFITE.READ.LINE.FOR.TOC 117409 . 117845) (LAFITE.READ.FORMAT 117847 . 118229) (
+LAFITE.READ.NAME.FIELD 118231 . 119264) (LAFITE.READ.ONE.LINE.FOR.TOC 119266 . 119447) (
+LAFITE.READ.TO.EOL 119449 . 120379) (LA.SKIP.TO.EOL 120381 . 121716) (LAFITE.SKIP.WHITE.SPACE 121718
+ . 121994)) (121997 122638 (\LAFITE.PARSE.MESSAGE 122007 . 122636)) (123586 127574 (
+LAFITE.INIT.PARSETABLES 123596 . 124107) (LAFITE.MAKE.PARSE.TABLE 124109 . 125079) (
+LAFITE.MAKE.PARSE.TABLE1 125081 . 127572)) (127609 132176 (LAFITE.NEW.PARSE.HEADER 127619 . 131228) (
+LAFITE.HANDLE.ORIGINAL.FIELD 131230 . 132174)))))
 STOP
diff --git a/library/lafite/LAFITEMAIL.LCOM b/library/lafite/LAFITE-MAIL.LCOM
similarity index 60%
rename from library/lafite/LAFITEMAIL.LCOM
rename to library/lafite/LAFITE-MAIL.LCOM
index c687d4bb..62917b39 100644
Binary files a/library/lafite/LAFITEMAIL.LCOM and b/library/lafite/LAFITE-MAIL.LCOM differ
diff --git a/library/lafite/MAILSCAVENGE b/library/lafite/LAFITE-MAILSCAVENGE
similarity index 96%
rename from library/lafite/MAILSCAVENGE
rename to library/lafite/LAFITE-MAILSCAVENGE
index a88057e6..1bcc2b26 100644
--- a/library/lafite/MAILSCAVENGE
+++ b/library/lafite/LAFITE-MAILSCAVENGE
@@ -1,25 +1,22 @@
 (DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
 
-(FILECREATED " 7-Feb-2022 12:04:09" 
-{DSK}<Users>kaplan>Local>medley3.5>my-medley>library>lafite>MAILSCAVENGE.;4 40080  
+(FILECREATED "26-Feb-2024 20:13:24" {WMEDLEY}<library>lafite>LAFITE-MAILSCAVENGE.;2 39927  
 
-      :CHANGES-TO (FNS \MAILSCAVENGE.MAKEWINDOW)
+      :EDIT-BY rmk
 
-      :PREVIOUS-DATE "30-Sep-2021 22:57:39" 
-{DSK}<Users>kaplan>Local>medley3.5>my-medley>library>lafite>MAILSCAVENGE.;3)
+      :CHANGES-TO (VARS LAFITE-MAILSCAVENGECOMS)
+                  (FNS MAILSCAVENGE)
+
+      :PREVIOUS-DATE "24-Feb-2024 11:28:52" {WMEDLEY}<library>lafite>LAFITE-SCAVENGE.;1)
 
 
-(* ; "
-Copyright (c) 1985, 1989-1990, 2021 by Venue & Xerox Corporation.
-")
+(PRETTYCOMPRINT LAFITE-MAILSCAVENGECOMS)
 
-(PRETTYCOMPRINT MAILSCAVENGECOMS)
-
-(RPAQQ MAILSCAVENGECOMS
-       [(FNS LAFITE.SCAVENGE \MAILSCAVENGE.INTERNAL \MAILSCAVENGE.OPEN.SCRATCH 
-             \MAILSCAVENGE.LENGTHWIDTH \MAILSCAVENGE.LFCOPYBYTES \MAILSCAVENGE.READSTAMP 
-             \MAILSCAVENGE.DUPLICATE? \MAILSCAVENGE.FORMAT \MAILSCAVENGE.MAKEWINDOW 
-             \MAILSCAVENGE.ASKUSER \MAILSCAVENGE.FIX.LENGTHS \MAILSCAVENGE.CONFIRM)
+(RPAQQ LAFITE-MAILSCAVENGECOMS
+       [(FNS MAILSCAVENGE \MAILSCAVENGE.INTERNAL \MAILSCAVENGE.OPEN.SCRATCH \MAILSCAVENGE.LENGTHWIDTH
+             \MAILSCAVENGE.LFCOPYBYTES \MAILSCAVENGE.READSTAMP \MAILSCAVENGE.DUPLICATE? 
+             \MAILSCAVENGE.FORMAT \MAILSCAVENGE.MAKEWINDOW \MAILSCAVENGE.ASKUSER 
+             \MAILSCAVENGE.FIX.LENGTHS \MAILSCAVENGE.CONFIRM)
         (DECLARE%: EVAL@COMPILE DONTCOPY (CONSTANTS (*START*LENGTH 8))
                (SPECVARS *FOLDER* *ERRORMSGSTREAM* *EOL*)
                (LOCALVARS . T))
@@ -30,11 +27,11 @@ Copyright (c) 1985, 1989-1990, 2021 by Venue & Xerox Corporation.
                                                                                    ])
 (DEFINEQ
 
-(LAFITE.SCAVENGE
-  [LAMBDA (FOLDERNAME ERRORMSGSTREAM FORGET?)            (* ; "Edited 18-Apr-89 18:19 by bvm")
+(MAILSCAVENGE
+  [LAMBDA (FOLDERNAME ERRORMSGSTREAM FORGET?)                (* ; "Edited 18-Apr-89 18:19 by bvm")
 
     (* ;; 
-  "User entry to the scavenger.  If FORGET?, we won't add folder to the list of known folders.")
+    "User entry to the scavenger.  If FORGET?, we won't add folder to the list of known folders.")
 
     (LET [(FOLDER (LAFITE.OBTAIN.FOLDER (LA.LONGFILENAME FOLDERNAME LAFITEMAIL.EXT)
                          'INPUT T (AND FORGET? :FORGET]
@@ -654,12 +651,11 @@ Copyright (c) 1985, 1989-1990, 2021 by Venue & Xerox Corporation.
 
 (ADDTOVAR LAMA \MAILSCAVENGE.FORMAT)
 )
-(PUTPROPS MAILSCAVENGE COPYRIGHT ("Venue & Xerox Corporation" 1985 1989 1990 2021))
 (DECLARE%: DONTCOPY
-  (FILEMAP (NIL (1459 39559 (LAFITE.SCAVENGE 1469 . 1991) (\MAILSCAVENGE.INTERNAL 1993 . 28504) (
-\MAILSCAVENGE.OPEN.SCRATCH 28506 . 29109) (\MAILSCAVENGE.LENGTHWIDTH 29111 . 29524) (
-\MAILSCAVENGE.LFCOPYBYTES 29526 . 30095) (\MAILSCAVENGE.READSTAMP 30097 . 30844) (
-\MAILSCAVENGE.DUPLICATE? 30846 . 31547) (\MAILSCAVENGE.FORMAT 31549 . 32376) (\MAILSCAVENGE.MAKEWINDOW
- 32378 . 34275) (\MAILSCAVENGE.ASKUSER 34277 . 37407) (\MAILSCAVENGE.FIX.LENGTHS 37409 . 38567) (
-\MAILSCAVENGE.CONFIRM 38569 . 39557)))))
+  (FILEMAP (NIL (1387 39490 (MAILSCAVENGE 1397 . 1922) (\MAILSCAVENGE.INTERNAL 1924 . 28435) (
+\MAILSCAVENGE.OPEN.SCRATCH 28437 . 29040) (\MAILSCAVENGE.LENGTHWIDTH 29042 . 29455) (
+\MAILSCAVENGE.LFCOPYBYTES 29457 . 30026) (\MAILSCAVENGE.READSTAMP 30028 . 30775) (
+\MAILSCAVENGE.DUPLICATE? 30777 . 31478) (\MAILSCAVENGE.FORMAT 31480 . 32307) (\MAILSCAVENGE.MAKEWINDOW
+ 32309 . 34206) (\MAILSCAVENGE.ASKUSER 34208 . 37338) (\MAILSCAVENGE.FIX.LENGTHS 37340 . 38498) (
+\MAILSCAVENGE.CONFIRM 38500 . 39488)))))
 STOP
diff --git a/library/lafite/MAILSCAVENGE.LCOM b/library/lafite/LAFITE-MAILSCAVENGE.LCOM
similarity index 60%
rename from library/lafite/MAILSCAVENGE.LCOM
rename to library/lafite/LAFITE-MAILSCAVENGE.LCOM
index 29cbfe3a..4eea03fd 100644
Binary files a/library/lafite/MAILSCAVENGE.LCOM and b/library/lafite/LAFITE-MAILSCAVENGE.LCOM differ
diff --git a/library/lafite/MAILSCAVENGE.TEDIT b/library/lafite/LAFITE-MAILSCAVENGE.TEDIT
similarity index 100%
rename from library/lafite/MAILSCAVENGE.TEDIT
rename to library/lafite/LAFITE-MAILSCAVENGE.TEDIT
diff --git a/library/lafite/MAILSHARE b/library/lafite/LAFITE-MAILSHARE
similarity index 88%
rename from library/lafite/MAILSHARE
rename to library/lafite/LAFITE-MAILSHARE
index b2ba147a..1382ca0c 100644
--- a/library/lafite/MAILSHARE
+++ b/library/lafite/LAFITE-MAILSHARE
@@ -1,26 +1,26 @@
-(DEFINE-FILE-INFO §READTABLE "INTERLISP" §PACKAGE "INTERLISP")
-(FILECREATED "20-Feb-87 08:05:52" {IVY}<BLOOMBERG>LISP>MAILSHARE.;1 12250  
+(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
 
-      previous date%: "15-Dec-86 10:01:06" {INDIGO}<GSLWS>BASICS>MAILSHARE.;3)
+(FILECREATED "23-Feb-2024 23:24:20" {WMEDLEY}<library>lafite>LAFITE-MAILSHARE.;1 12072  
+
+      :EDIT-BY rmk
+
+      :PREVIOUS-DATE "20-Feb-87 08:05:52" {WMEDLEY}<library>lafite>MAILSHARE.;1)
 
 
-(* "
-Copyright (c) 1986, 1987 by Xerox Corporation.  All rights reserved.
-")
+(PRETTYCOMPRINT LAFITE-MAILSHARECOMS)
 
-(PRETTYCOMPRINT MAILSHARECOMS)
-
-(RPAQQ MAILSHARECOMS ((* Menu Functions)
-                      (FNS MASH.TopLevel MASH.CreateFreeMenu MASH.GetMail MASH.Quit MASH.Consistent 
-                           MASH.MakeDirectoryName MASH.MakeProfileName MASH.MakeIconWindow)
-                      (* Icon bitmaps)
-                      (BITMAPS MASH.Icon MASH.IconMask)
-                      (* VARS)
-                      (INITVARS (MASH.VALID-HOSTS '(IVY INDIGO PHYLUM ERIS QV CHERRY)))
-                      (GLOBALVARS MASH.VALID-HOSTS)
-                      (ADDVARS (BackgroundMenuCommands (Mail% Share '(MASH.TopLevel) 
-                                                              "Start the Mail Share menu")))
-                      (VARS (BackgroundMenu NIL))))
+(RPAQQ LAFITE-MAILSHARECOMS
+       ((* Menu Functions)
+        (FNS MASH.TopLevel MASH.CreateFreeMenu MASH.GetMail MASH.Quit MASH.Consistent 
+             MASH.MakeDirectoryName MASH.MakeProfileName MASH.MakeIconWindow)
+        (* Icon bitmaps)
+        (BITMAPS MASH.Icon MASH.IconMask)
+        (* VARS)
+        [INITVARS (MASH.VALID-HOSTS '(IVY INDIGO PHYLUM ERIS QV CHERRY]
+        (GLOBALVARS MASH.VALID-HOSTS)
+        (ADDVARS (BackgroundMenuCommands (Mail% Share '(MASH.TopLevel)
+                                                "Start the Mail Share menu")))
+        (VARS (BackgroundMenu NIL))))
 
 
 
@@ -237,12 +237,12 @@ Copyright (c) 1986, 1987 by Xerox Corporation.  All rights reserved.
 (GLOBALVARS MASH.VALID-HOSTS)
 )
 
-(ADDTOVAR BackgroundMenuCommands (Mail% Share '(MASH.TopLevel) "Start the Mail Share menu"))
+(ADDTOVAR BackgroundMenuCommands (Mail% Share '(MASH.TopLevel)
+                                        "Start the Mail Share menu"))
 
 (RPAQQ BackgroundMenu NIL)
-(PUTPROPS MAILSHARE COPYRIGHT ("Xerox Corporation" 1986 1987))
 (DECLARE%: DONTCOPY
-  (FILEMAP (NIL (1099 9386 (MASH.TopLevel 1109 . 1795) (MASH.CreateFreeMenu 1797 . 2978) (MASH.GetMail 
-2980 . 6921) (MASH.Quit 6923 . 7601) (MASH.Consistent 7603 . 8502) (MASH.MakeDirectoryName 8504 . 8783
-) (MASH.MakeProfileName 8785 . 9126) (MASH.MakeIconWindow 9128 . 9384)))))
+  (FILEMAP (NIL (944 9231 (MASH.TopLevel 954 . 1640) (MASH.CreateFreeMenu 1642 . 2823) (MASH.GetMail 
+2825 . 6766) (MASH.Quit 6768 . 7446) (MASH.Consistent 7448 . 8347) (MASH.MakeDirectoryName 8349 . 8628
+) (MASH.MakeProfileName 8630 . 8971) (MASH.MakeIconWindow 8973 . 9229)))))
 STOP
diff --git a/library/lafite/LAFITE-MAILSHARE.LCOM b/library/lafite/LAFITE-MAILSHARE.LCOM
new file mode 100644
index 00000000..adcf94df
Binary files /dev/null and b/library/lafite/LAFITE-MAILSHARE.LCOM differ
diff --git a/library/lafite/MIME b/library/lafite/LAFITE-MIME
similarity index 95%
rename from library/lafite/MIME
rename to library/lafite/LAFITE-MIME
index e28fe0dc..884d16cd 100644
--- a/library/lafite/MIME
+++ b/library/lafite/LAFITE-MIME
@@ -1,29 +1,28 @@
-(DEFINE-FILE-INFO READTABLE "INTERLISP" PACKAGE "INTERLISP")
-(FILECREATED " 3-Aug-2005 09:39:34" {DSK}<project>medley3.5>lispusers>MIME.;42 139917 
+(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
 
-      changes to%:  (FNS DEMIMEPART)
+(FILECREATED "24-Feb-2024 10:05:37" {WMEDLEY}<library>lafite>LAFITE-MIME.;1 140113 
 
-      previous date%: "28-Jun-2002 16:23:39" {DSK}<project>medley3.5>lispusers>MIME.;41)
+      :EDIT-BY rmk
+
+      :CHANGES-TO (VARS MIMECOMS)
+
+      :PREVIOUS-DATE " 3-Aug-2005 09:39:34" {WMEDLEY}<library>lafite>MIME.;1)
 
 
-(* ; "
-Copyright (c) 1998, 1999, 1920, 2000, 2001, 2002, 2005 by Xerox Corporation.  All rights reserved.
-")
+(PRETTYCOMPRINT LAFITE-MIMECOMS)
 
-(PRETTYCOMPRINT MIMECOMS)
-
-(RPAQQ MIMECOMS
+(RPAQQ LAFITE-MIMECOMS
        ((FNS DEMIME PARSEMIME DEMIMEPART DEMIMETEXT DEMIMEAPPL MIMEERROR MIMEHEADERS MIMEPARAMS 
              PARSE-SUNATTACHMENT RECODEMIMEHEADER)
         (COMS 
               (* ;; "Replaces function on LAFITECOMMANDS and LAFITEHARDCOPY, so that MIME objects are decoded in messages.  These functions require the LAFITEMSG and MAILFOLDER records to be available:")
 
               (DECLARE%: DONTEVAL@LOAD DONTCOPY EVAL@COMPILE (FILES (LOADCOMP)
-                                                                    LAFITEDECLS))
+                                                                    LAFITE-DECLS))
               (FNS LA.COPY.MESSAGE.TEXT \LAFITE.APPEND.MESSAGE.BODY)
               
               (* ;; 
-   "Replaces function on LAFITEBROWSE, so that browser window interprets different character sets.")
+     "Replaces function on LAFITEBROWSE, so that browser window interprets different character sets.")
 
               (FNS PRINTMESSAGESUMMARY.STRING))
         (FNS ADDMIMEOBJECT MIMEOBJINIT MIMEOBJ.DISPLAYFN MIMEOBJ.COPYFN MIMEOBJ.BUTTONEVENTINFN 
@@ -41,7 +40,7 @@ Copyright (c) 1998, 1999, 1920, 2000, 2001, 2002, 2005 by Xerox Corporation.  Al
         (GLOBALVARS ATTACHMENTDIR)
         [COMS 
               (* ;; 
-       "MIMEFASTRECODECHARCODE is a copy of FASTRECODECHARCODED on /project/dict/code/CHARACTERFNS")
+         "MIMEFASTRECODECHARCODE is a copy of FASTRECODECHARCODED on /project/dict/code/CHARACTERFNS")
 
               (FNS CACHEMIMECHARRECODEMAPS MIMEFASTRECODECHARCODE MIMERECODEMAP)
               (INITVARS (CURRENTCHARENCODING 'XEROX-RENDERING))
@@ -582,7 +581,7 @@ Copyright (c) 1998, 1999, 1920, 2000, 2001, 2002, 2005 by Xerox Corporation.  Al
 (DECLARE%: DONTEVAL@LOAD DONTCOPY EVAL@COMPILE 
 
 (FILESLOAD (LOADCOMP)
-       LAFITEDECLS)
+       LAFITE-DECLS)
 )
 (DEFINEQ
 
@@ -685,8 +684,8 @@ Copyright (c) 1998, 1999, 1920, 2000, 2001, 2002, 2005 by Xerox Corporation.  Al
 
 
 
-(* ;; 
-"Replaces function on LAFITEBROWSE, so that browser window interprets different character sets.")
+(* ;; "Replaces function on LAFITEBROWSE, so that browser window interprets different character sets."
+)
 
 (DEFINEQ
 
@@ -1649,84 +1648,83 @@ Copyright (c) 1998, 1999, 1920, 2000, 2001, 2002, 2005 by Xerox Corporation.  Al
 
 (DECLARE%: EVAL@COMPILE 
 
-(PUTPROPS BINHEXBYTE  MACRO
-   (NIL (IF (EQ REPEAT 0)
-            THEN [PROG (C C2 REPFLAG)
-                       GETBYTE
-                           [WHILE (MEMB (SETQ C (BIN INSTREAM))
-                                            (CHARCODE (CR LF]
-                           (CL:UNLESS (EQ (CHARCODE %:)
-                                          C)
-                               [SETQ C (CL:SVREF BINHEXCHARARRAY (- C (CONSTANT (CHCON1 BINHEXCHARS]
+(PUTPROPS BINHEXBYTE MACRO
+          (NIL (IF (EQ REPEAT 0)
+                   THEN [PROG (C C2 REPFLAG)
+                          GETBYTE
+                              [WHILE (MEMB (SETQ C (BIN INSTREAM))
+                                           (CHARCODE (CR LF]
+                              (CL:UNLESS (EQ (CHARCODE %:)
+                                             C)
+                                  [SETQ C (CL:SVREF BINHEXCHARARRAY (- C (CONSTANT (CHCON1 
+                                                                                          BINHEXCHARS
+                                                                                          ]
 
-                               (* ;; "Save byte in C for repetition")
+                                  (* ;; "Save byte in C for repetition")
 
-                               (SETQ C (SELECTQ POS
-                                           (0                (* ; 
-           "Start of byte, used 6 bits from first code, 2 bits from second code, carry over 4 bits")
-                                              (SETQ POS 1)
-                                              [WHILE (MEMB (SETQ C2 (BIN INSTREAM))
-                                                               (CHARCODE (CR LF]
-                                              (CL:WHEN (EQ (CHARCODE %:)
-                                                           C2)
-                                                     (HELP 
+                                  (SETQ C (SELECTQ POS
+                                              (0             (* ; 
+             "Start of byte, used 6 bits from first code, 2 bits from second code, carry over 4 bits")
+                                                 (SETQ POS 1)
+                                                 [WHILE (MEMB (SETQ C2 (BIN INSTREAM))
+                                                              (CHARCODE (CR LF]
+                                                 (CL:WHEN (EQ (CHARCODE %:)
+                                                              C2)
+                                                        (HELP 
                                                      "BINHEX FILE TERMINATES IN THE MIDDLE OF A BYTE"
-                                                           ))
-                                              [SETQ C2 (CL:SVREF BINHEXCHARARRAY
-                                                              (- C2 (CONSTANT (CHCON1 BINHEXCHARS]
-                                              (SETQ NEXTBYTE (LOGAND 255 (LLSH C2 4)))
-                                              (LOGOR (LLSH C 2)
-                                                     (LRSH C2 4)))
-                                           (1                (* ; 
-                    " NEXTBYTE has 4 left-adjusted bits, use 4 bits from current code, save 2 bits")
-                                              (SETQ POS 2)
-                                              (PROG1 (LOGOR NEXTBYTE (LRSH C 2))
-                                                  (SETQ NEXTBYTE (LOGAND 255 (LLSH C 6)))))
-                                           (2                (* ; 
-                "NEXTBYTE has 2 left-adjusted bits, use all 6 bits from current code, save nothing")
-                                              (SETQ POS 0)
-                                              (PROG1 (LOGOR NEXTBYTE C)
-                                                     (SETQ NEXTBYTE 0)))
-                                           NIL))
+                                                              ))
+                                                 [SETQ C2 (CL:SVREF BINHEXCHARARRAY
+                                                                 (- C2 (CONSTANT (CHCON1 BINHEXCHARS]
+                                                 (SETQ NEXTBYTE (LOGAND 255 (LLSH C2 4)))
+                                                 (LOGOR (LLSH C 2)
+                                                        (LRSH C2 4)))
+                                              (1             (* ; 
+                      " NEXTBYTE has 4 left-adjusted bits, use 4 bits from current code, save 2 bits")
+                                                 (SETQ POS 2)
+                                                 (PROG1 (LOGOR NEXTBYTE (LRSH C 2))
+                                                     (SETQ NEXTBYTE (LOGAND 255 (LLSH C 6)))))
+                                              (2             (* ; 
+                  "NEXTBYTE has 2 left-adjusted bits, use all 6 bits from current code, save nothing")
+                                                 (SETQ POS 0)
+                                                 (PROG1 (LOGOR NEXTBYTE C)
+                                                        (SETQ NEXTBYTE 0)))
+                                              NIL))
 
-                               (* ;; "144 is hex 90, the repetition mark")
+                                  (* ;; "144 is hex 90, the repetition mark")
 
-                               (IF REPFLAG
-                                   THEN 
+                                  (IF REPFLAG
+                                      THEN 
+                                           (* ;; "C now contains the repetition factor")
 
-                                         (* ;; "C now contains the repetition factor")
-
-                                         (IF (EQ C 0)
-                                             THEN (SETQ LASTBYTE 144)
-                                                   (RETURN 144)
-                                           ELSE 
+                                           (IF (EQ C 0)
+                                               THEN (SETQ LASTBYTE 144)
+                                                    (RETURN 144)
+                                             ELSE 
 
                                             (* ;; "We already put out the prefix byte, and now we are putting out one that corresponds to the repeat-mark+number.")
 
-                                                 (SETQ REPEAT (- C 2))
-                                                 (RETURN LASTBYTE))
-                                 ELSEIF (EQ C 144)
-                                   THEN (SETQ REPFLAG T)
-                                         (GO GETBYTE)
-                                 ELSE (SETQ LASTBYTE C)
-                                       (RETURN C)))]
-          ELSE (CL:DECF REPEAT)
-                LASTBYTE)))
+                                                  (SETQ REPEAT (- C 2))
+                                                  (RETURN LASTBYTE))
+                                    ELSEIF (EQ C 144)
+                                      THEN (SETQ REPFLAG T)
+                                           (GO GETBYTE)
+                                    ELSE (SETQ LASTBYTE C)
+                                         (RETURN C)))]
+                 ELSE (CL:DECF REPEAT)
+                      LASTBYTE)))
 
-(PUTPROPS BINHEXWORD  MACRO
-   (NIL (LOGOR (LLSH (BINHEXBYTE)
-                     8)
-               (BINHEXBYTE))))
+(PUTPROPS BINHEXWORD MACRO (NIL (LOGOR (LLSH (BINHEXBYTE)
+                                             8)
+                                       (BINHEXBYTE))))
 
-(PUTPROPS BINHEXLONG  MACRO
-   (NIL (LOGOR (LLSH (BINHEXWORD)
-                     16)
-               (BINHEXWORD))))
+(PUTPROPS BINHEXLONG MACRO (NIL (LOGOR (LLSH (BINHEXWORD)
+                                             16)
+                                       (BINHEXWORD))))
 )
 )
 
 (RPAQ? ATTACHMENTDIR '(CONCAT "{dsk}/tilde/" (L-CASE (USERNAME))
-                                 "/attachments"))
+                             "/attachments"))
 (DECLARE%: DOEVAL@COMPILE DONTCOPY
 
 (GLOBALVARS ATTACHMENTDIR)
@@ -1823,9 +1821,8 @@ Copyright (c) 1998, 1999, 1920, 2000, 2001, 2002, 2005 by Xerox Corporation.  Al
 
 (RPAQ? CURRENTCHARENCODING 'XEROX-RENDERING)
 
-(RPAQQ CACHEDCHARENCODINGS (ISO8859/1 ISO-8859-1 ISO8859_1 ISO% 8859-1 LATIN1 ISO8859/2 
-                                      ISO-8859-2 ISO8859_2 LATIN2 CP1252 WINDOWS-1252 CP1250 
-                                      WINDOWS-1250))
+(RPAQQ CACHEDCHARENCODINGS (ISO8859/1 ISO-8859-1 ISO8859_1 ISO% 8859-1 LATIN1 ISO8859/2 ISO-8859-2 
+                                  ISO8859_2 LATIN2 CP1252 WINDOWS-1252 CP1250 WINDOWS-1250))
 
 
 
@@ -1951,22 +1948,21 @@ Copyright (c) 1998, 1999, 1920, 2000, 2001, 2002, 2005 by Xerox Corporation.  Al
 (DECLARE%: EVAL@COMPILE
 
 (RECORD MIMEPART (STARTPOS ENDPOS TYPE ENCODING DISPOSITION PARTNUM SUBPARTS)
-                     (RECORD TYPE ((MAINTYPE SUBTYPE) . TYPEPROPS))
-                     (RECORD DISPOSITION ((MAINDISPOSITION SUBDISPOSITION) . DISPOSITIONPROPS)))
+                 (RECORD TYPE ((MAINTYPE SUBTYPE) . TYPEPROPS))
+                 (RECORD DISPOSITION ((MAINDISPOSITION SUBDISPOSITION) . DISPOSITIONPROPS)))
 )
 )
-(PUTPROPS MIME COPYRIGHT ("Xerox Corporation" 1998 1999 1920 2000 2001 2002 2005))
 (DECLARE%: DONTCOPY
-  (FILEMAP (NIL (2958 37439 (DEMIME 2968 . 4254) (PARSEMIME 4256 . 12136) (DEMIMEPART 12138 . 15903) (
-DEMIMETEXT 15905 . 20315) (DEMIMEAPPL 20317 . 25190) (MIMEERROR 25192 . 25520) (MIMEHEADERS 25522 . 
-27090) (MIMEPARAMS 27092 . 30800) (PARSE-SUNATTACHMENT 30802 . 33712) (RECODEMIMEHEADER 33714 . 37437)
-) (37733 44293 (LA.COPY.MESSAGE.TEXT 37743 . 40444) (\LAFITE.APPEND.MESSAGE.BODY 40446 . 44291)) (
-44407 44646 (PRINTMESSAGESUMMARY.STRING 44417 . 44644)) (44647 54572 (ADDMIMEOBJECT 44657 . 46002) (
-MIMEOBJINIT 46004 . 46929) (MIMEOBJ.DISPLAYFN 46931 . 48688) (MIMEOBJ.COPYFN 48690 . 49587) (
-MIMEOBJ.BUTTONEVENTINFN 49589 . 52996) (MIMEOBJ.IMAGEBOXFN 52998 . 54570)) (54592 64584 (DEPS 54602 . 
-57677) (FINDPSSEGMENTS 57679 . 59923) (POSTSCRIPTPART 59925 . 64582)) (64585 101169 (STREAMFROMBASE64 
-64595 . 73017) (STREAMFROMBINHEX 73019 . 78166) (STREAMFROMASCII 78168 . 79197) (
-STREAMFROMENRICHEDTEXT 79199 . 86552) (STREAMFROMUUENCODE 86554 . 89507) (STREAMFROMQUOTEDPRINTABLE 
-89509 . 94702) (STREAMFROMUTF-8 94704 . 101167)) (105793 110524 (CACHEMIMECHARRECODEMAPS 105803 . 
-107748) (MIMEFASTRECODECHARCODE 107750 . 109231) (MIMERECODEMAP 109233 . 110522)))))
+  (FILEMAP (NIL (2880 37361 (DEMIME 2890 . 4176) (PARSEMIME 4178 . 12058) (DEMIMEPART 12060 . 15825) (
+DEMIMETEXT 15827 . 20237) (DEMIMEAPPL 20239 . 25112) (MIMEERROR 25114 . 25442) (MIMEHEADERS 25444 . 
+27012) (MIMEPARAMS 27014 . 30722) (PARSE-SUNATTACHMENT 30724 . 33634) (RECODEMIMEHEADER 33636 . 37359)
+) (37656 44216 (LA.COPY.MESSAGE.TEXT 37666 . 40367) (\LAFITE.APPEND.MESSAGE.BODY 40369 . 44214)) (
+44330 44569 (PRINTMESSAGESUMMARY.STRING 44340 . 44567)) (44570 54495 (ADDMIMEOBJECT 44580 . 45925) (
+MIMEOBJINIT 45927 . 46852) (MIMEOBJ.DISPLAYFN 46854 . 48611) (MIMEOBJ.COPYFN 48613 . 49510) (
+MIMEOBJ.BUTTONEVENTINFN 49512 . 52919) (MIMEOBJ.IMAGEBOXFN 52921 . 54493)) (54515 64507 (DEPS 54525 . 
+57600) (FINDPSSEGMENTS 57602 . 59846) (POSTSCRIPTPART 59848 . 64505)) (64508 101092 (STREAMFROMBASE64 
+64518 . 72940) (STREAMFROMBINHEX 72942 . 78089) (STREAMFROMASCII 78091 . 79120) (
+STREAMFROMENRICHEDTEXT 79122 . 86475) (STREAMFROMUUENCODE 86477 . 89430) (STREAMFROMQUOTEDPRINTABLE 
+89432 . 94625) (STREAMFROMUTF-8 94627 . 101090)) (106123 110854 (CACHEMIMECHARRECODEMAPS 106133 . 
+108078) (MIMEFASTRECODECHARCODE 108080 . 109561) (MIMERECODEMAP 109563 . 110852)))))
 STOP
diff --git a/library/lafite/LAFITE-MIME.LCOM b/library/lafite/LAFITE-MIME.LCOM
new file mode 100644
index 00000000..6556fa2f
Binary files /dev/null and b/library/lafite/LAFITE-MIME.LCOM differ
diff --git a/library/lafite/MIME.TEDIT b/library/lafite/LAFITE-MIME.TEDIT
similarity index 100%
rename from library/lafite/MIME.TEDIT
rename to library/lafite/LAFITE-MIME.TEDIT
diff --git a/library/lafite/NEWNSMAIL b/library/lafite/LAFITE-NEWNSMAIL
similarity index 88%
rename from library/lafite/NEWNSMAIL
rename to library/lafite/LAFITE-NEWNSMAIL
index 04dba466..7d67e5de 100644
--- a/library/lafite/NEWNSMAIL
+++ b/library/lafite/LAFITE-NEWNSMAIL
@@ -1,18 +1,18 @@
-(DEFINE-FILE-INFO READTABLE "INTERLISP" PACKAGE "INTERLISP")
-(FILECREATED " 5-Sep-95 16:43:15" {DSK}<lispcore>lafite>parc-94>NEWNSMAIL.;2 91089  
+(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
 
-      changes to%:  (VARS NEWNSMAILCOMS)
+(FILECREATED "24-Feb-2024 11:59:44" {WMEDLEY}<library>lafite>LAFITE-NEWNSMAIL.;2 95095  
 
-      previous date%: " 6-Aug-93 17:20:37" {DSK}<lispcore>lafite>parc-94>NEWNSMAIL.;1)
+      :EDIT-BY rmk
+
+      :CHANGES-TO (VARS LAFITE-NEWNSMAILCOMS NEWNSMAILCOMS)
+                  (FNS \NSMAIL.NEW.CHECK)
+
+      :PREVIOUS-DATE " 5-Sep-95 16:43:15" {WMEDLEY}<library>lafite>NEWNSMAIL.;1)
 
 
-(* ; "
-Copyright (c) 1989, 1990, 1992, 1993, 1995 by Xerox Corporation.  All rights reserved.
-")
+(PRETTYCOMPRINT LAFITE-NEWNSMAILCOMS)
 
-(PRETTYCOMPRINT NEWNSMAILCOMS)
-
-(RPAQQ NEWNSMAILCOMS
+(RPAQQ LAFITE-NEWNSMAILCOMS
        [(COURIERPROGRAMS NEW.MAILTRANSPORT NEW.INBASKET)
         (COMS                                                (* ; "Courier type EnvelopeItem")
               (FNS \NS.NEW.READ.ENVELOPE.ITEM \NS.NEW.WRITE.ENVELOPE.ITEM)
@@ -68,20 +68,19 @@ Copyright (c) 1989, 1990, 1992, 1993, 1995 by Xerox Corporation.  All rights res
               (VARS \NSMAIL.GOOD.BODY.PARTS \NSMAIL.DISCARDABLE.BODY.PARTS)
               (GLOBALVARS \NSMAIL.GOOD.BODY.PARTS \NSMAIL.DISCARDABLE.BODY.PARTS)
               (ALISTS (LAFITEMODELST NS))
-              (FILES NSMAIL))
+              (FILES LAFITE-NSMAIL))
         (DECLARE%: EVAL@COMPILE DONTCOPY (LOCALVARS . T)
                (RECORDS FORWARD)
                (MACROS \NSMAIL.BODY.PART.TYPE)
                (GLOBALVARS \NSMAIL.BODY.PART.TYPES \NSMAIL.HEADING.ATTRIBUTES)
                [P (CL:PROCLAIM '(CL:SPECIAL *RETRIEVAL-ERROR*]
                (FILES (SOURCE)
-                      LAFITEDECLS)
+                      LAFITE-DECLS)
                (FILES (LOADCOMP)
-                      NSMAIL ATBL)
+                      LAFITE-NSMAIL ATBL)
                                                              (* ; "ATBL has \COMPUTED.FORM macro.")
                (CONSTANTS * \NSMAIL.CONTENTS.TYPES)
-                                                             (* ; 
-                                                           "This one we need at run time also")
+                                                             (* ; "This one we need at run time also")
                DOCOPY
                (VARS \NSMAIL.BODY.PART.TYPES))
         (DECLARE%: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY COMPILERVARS (ADDVARS (NLAMA)
@@ -106,7 +105,7 @@ Copyright (c) 1989, 1990, 1992, 1993, 1995 by Xerox Corporation.  All rights res
                               (ReportNotAllowed 4)))
        (NAME NSNAME)
        (RNAME NEW.RNAME                                      (* ; 
-                                                   "(choice (xns 0 name) (gateway 1 gateway.name))")
+                                                     "(choice (xns 0 name) (gateway 1 gateway.name))")
               )
        (RNAME.LIST (SEQUENCE RNAME))
        [GATEWAY.NAME (RECORD (COUNTRY STRING)
@@ -367,8 +366,7 @@ Copyright (c) 1989, 1990, 1992, 1993, 1995 by Xerox Corporation.  All rights res
         (Converted 15 (SEQUENCE CONVERTED.ITEM))
         (AuthenticationLevelOfSender 16 AUTHENTICATION.LEVEL)))
 
-(PUTPROPS NEW.ENVELOPE.ITEM COURIERDEF (\NS.NEW.READ.ENVELOPE.ITEM 
-                                                      \NS.NEW.WRITE.ENVELOPE.ITEM))
+(PUTPROPS NEW.ENVELOPE.ITEM COURIERDEF (\NS.NEW.READ.ENVELOPE.ITEM \NS.NEW.WRITE.ENVELOPE.ITEM))
 
 
 
@@ -414,8 +412,7 @@ Copyright (c) 1989, 1990, 1992, 1993, 1995 by Xerox Corporation.  All rights res
         (BodyOffset 198 LONGCARDINAL)
         (LispFormatting 4911 STRING)))
 
-(PUTPROPS HEADING.ATTRIBUTE COURIERDEF (\NS.READ.HEADING.ATTRIBUTE 
-                                                      \NS.WRITE.HEADING.ATTRIBUTE))
+(PUTPROPS HEADING.ATTRIBUTE COURIERDEF (\NS.READ.HEADING.ATTRIBUTE \NS.WRITE.HEADING.ATTRIBUTE))
 
 
 
@@ -546,7 +543,7 @@ Copyright (c) 1989, 1990, 1992, 1993, 1995 by Xerox Corporation.  All rights res
 (RPAQ? \NSMAIL.NEW.SERVER.CACHE )
 
 (RPAQQ *NSMAIL-OP-VECTOR* (NEWNS.POLLNEWMAIL NEWNS.OPENMAILBOX NEWNS.NEXTMESSAGE 
-                                     NEWNS.RETRIEVEMESSAGE NEWNS.CLOSEMAILBOX))
+                                 NEWNS.RETRIEVEMESSAGE NEWNS.CLOSEMAILBOX))
 (DECLARE%: DOEVAL@COMPILE DONTCOPY
 
 (GLOBALVARS \NSMAIL.NEW.SERVER.CACHE \NSMAIL.MIN.VP.TYPE \NSMAIL.MAX.VP.TYPE)
@@ -577,8 +574,127 @@ Copyright (c) 1989, 1990, 1992, 1993, 1995 by Xerox Corporation.  All rights res
 )
 
 (\NSMAIL.NEW.CHECK
-(LAMBDA (ADDRESS REGISTEREDNAME CREDENTIALS MAILSERVER STREAM RETURNERRORS) (* ; "Edited  6-Aug-93 16:41 by bvm") (* ;;; "Performs a mail check for user REGISTEREDNAME at ADDRESS, returning INBASKETSTATE if successful, NIL if not.  Updates the MAILSTATE of MAILSERVER as appropriate to reflect current SESSION and STATEFIRSTNEW (first new message)") (RESETLST (PROG ((JUSTCHECKING (NULL STREAM)) (STATE (fetch (MAILSERVER MAILSTATE) of MAILSERVER)) SESSION POLLRESULT TIMER) (SETQ SESSION (fetch STATESESSION of STATE)) RETRY (COND ((NULL SESSION) (if JUSTCHECKING then (* ; "Just polling, don't need session") (SETQ POLLRESULT (COURIER.EXPEDITED.CALL ADDRESS \NSMAIL.SOCKET (QUOTE NEW.INBASKET) (QUOTE MAILPOLL) (fetch STATENAME of STATE) (CAR CREDENTIALS) (CDR CREDENTIALS) (QUOTE RETURNERRORS))) (GO GOTRESULT)) (COND ((NULL STREAM) (* ; "Need a real Courier stream for some reason here") (COND ((SETQ STREAM (COURIER.OPEN ADDRESS NIL T (QUOTE NSMAIL))) (RESETSAVE NIL (LIST (QUOTE CLOSEF) STREAM))) (T (RETURN NIL))))) (COND ((EQ (CAR (SETQ SESSION (COURIER.CALL STREAM (QUOTE NEW.INBASKET) (QUOTE LOGON) (fetch STATENAME of STATE) (CAR CREDENTIALS) (CDR CREDENTIALS) (QUOTE RETURNERRORS)))) (QUOTE ERROR)) (GO ERROR))) (* ; "result = (session state anchor)") (SETQ POLLRESULT (CADR SESSION)) (replace STATESESSION of STATE with (SETQ SESSION (CAR SESSION)))) (T (SETQ POLLRESULT (COND ((NULL STREAM) (* ; "Just checking") (COURIER.EXPEDITED.CALL ADDRESS \NSMAIL.SOCKET (QUOTE NEW.INBASKET) (QUOTE MAILCHECK) SESSION (QUOTE RETURNERRORS))) (T (COURIER.CALL STREAM (QUOTE NEW.INBASKET) (QUOTE MAILCHECK) SESSION (QUOTE RETURNERRORS))))))) GOTRESULT (COND ((NULL POLLRESULT) (* ; "Failed somehow") (RETURN NIL)) ((EQ (CAR (LISTP POLLRESULT)) (QUOTE ERROR)) (COND ((EQ (CADR POLLRESULT) (QUOTE SESSION.ERROR)) (* ; "Session timed out, start a new one") (replace STATESESSION of STATE with (SETQ SESSION NIL)) (replace STATEFIRSTNEW of STATE with NIL) (replace STATEOLDLAST of STATE with NIL) (GO RETRY)) (T (SETQ SESSION POLLRESULT) (GO ERROR))))) (replace STATELASTERROR of STATE with NIL) (replace (MAILSERVER CONTINUANCE) of MAILSERVER with NIL) (RETURN (COURIER.FETCH (NEW.INBASKET . STATE) TOTAL of POLLRESULT)) ERROR (if (AND (NOT (EQUAL (CDR SESSION) (QUOTE (CONNECTION.PROBLEM NoResponse)))) (NOT (EQUAL (CDR SESSION) (fetch STATELASTERROR of STATE)))) then (* ;; "Don't bother mentioning the error if it's just a timeout, since mailwatch will handle our NIL response fine.  Also don't repeatedly print the same error message.") (replace STATELASTERROR of STATE with (CDR SESSION)) (LET ((ERRMSG (CASE (CADR SESSION) ((REJECT) (* ; "3rd element = reject reason") (LET* ((REASON (CADDR SESSION)) (TYPE (CAR REASON))) (if (AND (EQ TYPE (QUOTE WrongVersionOfService)) (<= (CAADR REASON) 1) (< (CADADR REASON) 2)) then (* ; "Server supports old inbasket, but not new") (PRINTOUT PROMPTWINDOW T T "****Note: " (fetch (MAILSERVER MAILSERVERNAME) of MAILSERVER) " does not support new mail protocols." T) (if (NOT RETURNERRORS) then (RETURN NIL))) TYPE)) ((SERVICE.ERROR ACCESS.ERROR) (* ; "the specific reason is just as informative, and more readable than the whole error.") (CADDR SESSION)) (T (COND (NSWIZARDFLG (HELP SESSION))) (SUBSTRING (CDR SESSION) 2 -2))))) (if RETURNERRORS then (RETURN (CONS (QUOTE ERROR) ERRMSG)) elseif (AND (EQ ERRMSG (QUOTE NoSuchInbasket)) (\NSMAIL.FIX.MAILBOX.LOCATIONS)) then (* ;; "We get this when the server no longer holds this inbox.  At this point we have fixed mail servers in NS mode, but there's no good way for us to report the news, so go ahead and return NIL, but set %"continuance%" so that poll will happen again immediately") (replace (MAILSERVER CONTINUANCE) of MAILSERVER with 0) else (LET ((*PRINT-CASE* :UPCASE)) (* ; "Lousy atomic error names...") (CL:FORMAT PROMPTWINDOW "~%%From mail server ~A: ~A" (fetch (MAILSERVER MAILSERVERNAME) of MAILSERVER) (CASE ERRMSG (NoSuchService "Mail service not running") (T ERRMSG))))))) (RETURN NIL))))
-)
+  [LAMBDA (ADDRESS REGISTEREDNAME CREDENTIALS MAILSERVER STREAM RETURNERRORS)
+                                                             (* ; "Edited 24-Feb-2024 11:54 by rmk")
+                                                             (* ; "Edited  6-Aug-93 16:41 by bvm")
+
+(* ;;; "Performs a mail check for user REGISTEREDNAME at ADDRESS, returning INBASKETSTATE if successful, NIL if not.  Updates the MAILSTATE of MAILSERVER as appropriate to reflect current SESSION and STATEFIRSTNEW (first new message)")
+
+    (RESETLST
+        (PROG ((JUSTCHECKING (NULL STREAM))
+               (STATE (fetch (MAILSERVER MAILSTATE) of MAILSERVER))
+               SESSION POLLRESULT TIMER)
+              (SETQ SESSION (fetch STATESESSION of STATE))
+          RETRY
+              [COND
+                 [(NULL SESSION)
+                  (if JUSTCHECKING
+                      then                                   (* ; "Just polling, don't need session")
+                           (SETQ POLLRESULT (COURIER.EXPEDITED.CALL ADDRESS \NSMAIL.SOCKET
+                                                   'NEW.INBASKET
+                                                   'MAILPOLL
+                                                   (fetch STATENAME of STATE)
+                                                   (CAR CREDENTIALS)
+                                                   (CDR CREDENTIALS)
+                                                   'RETURNERRORS))
+                           (GO GOTRESULT))
+                  [COND
+                     ((NULL STREAM)                          (* ; 
+                                                    "Need a real Courier stream for some reason here")
+                      (COND
+                         ((SETQ STREAM (COURIER.OPEN ADDRESS NIL T 'NSMAIL))
+                          (RESETSAVE NIL (LIST 'CLOSEF STREAM)))
+                         (T (RETURN NIL]
+                  (COND
+                     ((EQ [CAR (SETQ SESSION (COURIER.CALL STREAM 'NEW.INBASKET 'LOGON
+                                                    (fetch STATENAME of STATE)
+                                                    (CAR CREDENTIALS)
+                                                    (CDR CREDENTIALS)
+                                                    'RETURNERRORS]
+                          'ERROR)
+                      (GO ERROR)))                           (* ; "result = (session state anchor)")
+                  (SETQ POLLRESULT (CADR SESSION))
+                  (replace STATESESSION of STATE with (SETQ SESSION (CAR SESSION]
+                 (T (SETQ POLLRESULT (COND
+                                        ((NULL STREAM)       (* ; "Just checking")
+                                         (COURIER.EXPEDITED.CALL ADDRESS \NSMAIL.SOCKET 
+                                                'NEW.INBASKET 'MAILCHECK SESSION 'RETURNERRORS))
+                                        (T (COURIER.CALL STREAM 'NEW.INBASKET 'MAILCHECK SESSION
+                                                  'RETURNERRORS]
+          GOTRESULT
+              [COND
+                 ((NULL POLLRESULT)                          (* ; "Failed somehow")
+                  (RETURN NIL))
+                 ((EQ (CAR (LISTP POLLRESULT))
+                      'ERROR)
+                  (COND
+                     ((EQ (CADR POLLRESULT)
+                          'SESSION.ERROR)                    (* ; 
+                                                             "Session timed out, start a new one")
+                      (replace STATESESSION of STATE with (SETQ SESSION NIL))
+                      (replace STATEFIRSTNEW of STATE with NIL)
+                      (replace STATEOLDLAST of STATE with NIL)
+                      (GO RETRY))
+                     (T (SETQ SESSION POLLRESULT)
+                        (GO ERROR]
+              (replace STATELASTERROR of STATE with NIL)
+              (replace (MAILSERVER CONTINUANCE) of MAILSERVER with NIL)
+              (RETURN (COURIER.FETCH (NEW.INBASKET . STATE)
+                             TOTAL of POLLRESULT))
+          ERROR
+              [if [AND [NOT (EQUAL (CDR SESSION)
+                                   '(CONNECTION.PROBLEM NoResponse]
+                       (NOT (EQUAL (CDR SESSION)
+                                   (fetch STATELASTERROR of STATE]
+                  then 
+                       (* ;; "Don't bother mentioning the error if it's just a timeout, since mailwatch will handle our NIL response fine.  Also don't repeatedly print the same error message.")
+
+                       (replace STATELASTERROR of STATE with (CDR SESSION))
+                       (LET [(ERRMSG (CASE (CADR SESSION)
+                                         ((REJECT)           (* ; "3rd element = reject reason")
+                                            (LET* ((REASON (CADDR SESSION))
+                                                   (TYPE (CAR REASON)))
+                                                  (if (AND (EQ TYPE 'WrongVersionOfService)
+                                                           (<= (CAADR REASON)
+                                                               1)
+                                                           (< (CADADR REASON)
+                                                              2))
+                                                      then   (* ; 
+                                                          "Server supports old inbasket, but not new")
+                                                           (PRINTOUT PROMPTWINDOW T T "****Note: "
+                                                                  (fetch (MAILSERVER MAILSERVERNAME)
+                                                                     of MAILSERVER)
+                                                                  
+                                                              " does not support new mail protocols."
+                                                                  T)
+                                                           (if (NOT RETURNERRORS)
+                                                               then (RETURN NIL)))
+                                                  TYPE))
+                                         ((SERVICE.ERROR ACCESS.ERROR) 
+                                                             (* ; 
+                "the specific reason is just as informative, and more readable than the whole error.")
+                                            (CADDR SESSION))
+                                         (T (COND
+                                               (NSWIZARDFLG (HELP SESSION)))
+                                            (SUBSTRING (CDR SESSION)
+                                                   2 -2)))]
+                            (if RETURNERRORS
+                                then (RETURN (CONS 'ERROR ERRMSG))
+                              elseif (AND (EQ ERRMSG 'NoSuchInbasket)
+                                          (\NSMAIL.FIX.MAILBOX.LOCATIONS))
+                                then 
+
+                                 (* ;; "We get this when the server no longer holds this inbox.  At this point we have fixed mail servers in NS mode, but there's no good way for us to report the news, so go ahead and return NIL, but set %"continuance%" so that poll will happen again immediately")
+
+                                     (replace (MAILSERVER CONTINUANCE) of MAILSERVER with 0)
+                              else (LET ((*PRINT-CASE* :UPCASE))
+                                                             (* ; "Lousy atomic error names...")
+                                        (CL:FORMAT PROMPTWINDOW "~%%From mail server ~A: ~A"
+                                               (fetch (MAILSERVER MAILSERVERNAME) of MAILSERVER)
+                                               (CASE ERRMSG
+                                                   (NoSuchService "Mail service not running")
+                                                   (T ERRMSG))]
+              (RETURN NIL)))])
 
 (NEWNS.NEXTMESSAGE
 (LAMBDA (MAILBOX) (* ; "Edited 13-Dec-89 17:27 by bvm") (LET ((NEXT (NEW.INBASKET.CALL MAILBOX (QUOTE RETRIEVE.ENVELOPES) (fetch NSMAILLASTINDEX of MAILBOX) (QUOTE NEXT) (fetch NSMAILSESSION of MAILBOX)))) (* ;; "NEXT = (envelope status index)") (DESTRUCTURING-BIND (ENVELOPE STATUS INDEX) NEXT (if (EQ INDEX 0) then (* ; "No more messages") NIL else (replace NSMAILLASTINDEX of MAILBOX with INDEX) (replace NSMAILENVTAIL of MAILBOX with ENVELOPE) (* ; "Success") T))))
@@ -684,17 +800,17 @@ Attachment: " T)) (TERPRI *MSGSTREAM*) (* ; "End header with blank line") (SETQ
 (RPAQQ \NSMAIL.GOOD.BODY.PARTS (0 5 6 2))
 
 (RPAQQ \NSMAIL.DISCARDABLE.BODY.PARTS ((201 "Tioga formatting")
-                                           (202 "Tioga header")))
+                                       (202 "Tioga header")))
 (DECLARE%: DOEVAL@COMPILE DONTCOPY
 
 (GLOBALVARS \NSMAIL.GOOD.BODY.PARTS \NSMAIL.DISCARDABLE.BODY.PARTS)
 )
 
 (ADDTOVAR LAFITEMODELST (NS 1 \NSMAIL.NEW.SEND.PARSE \NSMAIL.NEW.SEND \NSMAIL.MAKEANSWERFORM 
-                                \NSMAIL.NEW.AUTHENTICATE \NSMAIL.MESSAGE.P 
-                                \NSMAIL.MESSAGE.FROM.SELF.P \NSMAIL.LOGIN))
+                            \NSMAIL.NEW.AUTHENTICATE \NSMAIL.MESSAGE.P \NSMAIL.MESSAGE.FROM.SELF.P 
+                            \NSMAIL.LOGIN))
 
-(FILESLOAD NSMAIL)
+(FILESLOAD LAFITE-NSMAIL)
 (DECLARE%: EVAL@COMPILE DONTCOPY 
 (DECLARE%: DOEVAL@COMPILE DONTCOPY
 
@@ -709,11 +825,10 @@ Attachment: " T)) (TERPRI *MSGSTREAM*) (* ; "End header with blank line") (SETQ
 (DECLARE%: EVAL@COMPILE 
 
 (PUTPROPS \NSMAIL.BODY.PART.TYPE MACRO [ARGS (COND
-                                                        ((CADR (ASSOC (CAR ARGS)
-                                                                      \NSMAIL.BODY.PART.TYPES)))
-                                                        (T (ERROR "Unknown body part type"
-                                                                  (CAR ARGS))
-                                                           'IGNOREMACRO])
+                                                ((CADR (ASSOC (CAR ARGS)
+                                                              \NSMAIL.BODY.PART.TYPES)))
+                                                (T (ERROR "Unknown body part type" (CAR ARGS))
+                                                   'IGNOREMACRO])
 )
 
 (DECLARE%: DOEVAL@COMPILE DONTCOPY
@@ -726,16 +841,16 @@ Attachment: " T)) (TERPRI *MSGSTREAM*) (* ; "End header with blank line") (SETQ
 
 
 (FILESLOAD (SOURCE)
-       LAFITEDECLS)
+       LAFITE-DECLS)
 
 
 (FILESLOAD (LOADCOMP)
-       NSMAIL ATBL)
+       LAFITE-NSMAIL ATBL)
 
 
 (RPAQQ \NSMAIL.CONTENTS.TYPES ((\CT.NULL 0)
-                                   (\CT.STANDARD.MESSAGE 4)
-                                   (\CT.REPORT 6)))
+                               (\CT.STANDARD.MESSAGE 4)
+                               (\CT.REPORT 6)))
 (DECLARE%: EVAL@COMPILE 
 
 (RPAQQ \CT.NULL 0)
@@ -774,26 +889,25 @@ DOCOPY
 
 (ADDTOVAR LAMA NEW.INBASKET.CALL)
 )
-(PUTPROPS NEWNSMAIL COPYRIGHT ("Xerox Corporation" 1989 1990 1992 1993 1995))
 (DECLARE%: DONTCOPY
-  (FILEMAP (NIL (17944 19459 (\NS.NEW.READ.ENVELOPE.ITEM 17954 . 18719) (\NS.NEW.WRITE.ENVELOPE.ITEM 
-18721 . 19457)) (20397 22075 (\NS.READ.HEADING.ATTRIBUTE 20407 . 21385) (\NS.WRITE.HEADING.ATTRIBUTE 
-21387 . 22073)) (23334 24737 (\NSMAIL.READ.RNAME 23344 . 23902) (\NSMAIL.WRITE.RNAME 23904 . 24395) (
-\NSMAIL.RNAME.LENGTH 24397 . 24735)) (24841 26915 (RNAME.TO.STRING 24851 . 25030) (X400.NAME.TO.STRING
- 25032 . 26719) (EQUAL.RNAMES 26721 . 26913)) (26940 46533 (\NSMAIL.NEW.SEND.PARSE 26950 . 29292) (
-\NSMAIL.CHECK.ENUMERATION 29294 . 30213) (\NSMAIL.NEW.SEND 30215 . 38707) (
-\NSMAIL.NEW.INVALID.RECIPIENTS 38709 . 39290) (\NSMAIL.BUILD.HEADING 39292 . 40591) (
-\NSMAIL.POST.BODY.PART 40593 . 42424) (\NSMAIL.NEW.PREPARE.ATTACHMENT 42426 . 44075) (
-\NSMAIL.CHECK.ABORT 44077 . 44435) (\NSMAIL.NEW.FINDSERVER 44437 . 45492) (\NSMAIL.NEW.CHECKSERVER 
-45494 . 46531)) (48707 88661 (\NSMAIL.NEW.AUTHENTICATE 48717 . 49925) (NEWNS.POLLNEWMAIL 49927 . 50242
-) (NEWNS.OPENMAILBOX 50244 . 50928) (\NSMAIL.NEW.CHECK 50930 . 54952) (NEWNS.NEXTMESSAGE 54954 . 55448
-) (NEWNS.RETRIEVEMESSAGE 55450 . 59314) (\NSMAIL.READ.BODY.PARTS 59316 . 64727) (\NSMAIL.COPY.IA5 
-64729 . 65478) (\NSMAIL.COPY.NSTEXTFILE 65480 . 67629) (\NSMAIL.READ.HEADING 67631 . 70366) (
-\NSMAIL.PARSE.ANNOTATION 70368 . 71102) (\NSMAIL.EMIT.ANNOTATION 71104 . 72372) (LA.TRIM.WHITESPACE 
-72374 . 72496) (\NSMAIL.READ.FORWARDING 72498 . 73523) (\NSMAIL.NEW.PRINT.HEADING 73525 . 79149) (
-\NSMAIL.NEW.PRINT.NAMES 79151 . 80127) (\NSMAIL.EMIT.FORWARDING 80129 . 81963) (\NSMAIL.GDATE 81965 . 
-82081) (\NSMAIL.TRANSLATE.IP.MESSAGEID 82083 . 82630) (\NSMAIL.MAYBE.QUOTE 82632 . 83270) (NULL.NSNAME
- 83272 . 83614) (\NSMAIL.HANDLE.DELIVERY.REPORT 83616 . 86647) (\NSMAIL.RECIPIENT.NAME 86649 . 86876) 
-(NEW.INBASKET.CALL 86878 . 87502) (NEWNS.CLOSEMAILBOX 87504 . 88220) (\NSMAIL.NEW.LOGOFF 88222 . 88659
+  (FILEMAP (NIL (17902 19417 (\NS.NEW.READ.ENVELOPE.ITEM 17912 . 18677) (\NS.NEW.WRITE.ENVELOPE.ITEM 
+18679 . 19415)) (20300 21978 (\NS.READ.HEADING.ATTRIBUTE 20310 . 21288) (\NS.WRITE.HEADING.ATTRIBUTE 
+21290 . 21976)) (23182 24585 (\NSMAIL.READ.RNAME 23192 . 23750) (\NSMAIL.WRITE.RNAME 23752 . 24243) (
+\NSMAIL.RNAME.LENGTH 24245 . 24583)) (24689 26763 (RNAME.TO.STRING 24699 . 24878) (X400.NAME.TO.STRING
+ 24880 . 26567) (EQUAL.RNAMES 26569 . 26761)) (26788 46381 (\NSMAIL.NEW.SEND.PARSE 26798 . 29140) (
+\NSMAIL.CHECK.ENUMERATION 29142 . 30061) (\NSMAIL.NEW.SEND 30063 . 38555) (
+\NSMAIL.NEW.INVALID.RECIPIENTS 38557 . 39138) (\NSMAIL.BUILD.HEADING 39140 . 40439) (
+\NSMAIL.POST.BODY.PART 40441 . 42272) (\NSMAIL.NEW.PREPARE.ATTACHMENT 42274 . 43923) (
+\NSMAIL.CHECK.ABORT 43925 . 44283) (\NSMAIL.NEW.FINDSERVER 44285 . 45340) (\NSMAIL.NEW.CHECKSERVER 
+45342 . 46379)) (48551 92848 (\NSMAIL.NEW.AUTHENTICATE 48561 . 49769) (NEWNS.POLLNEWMAIL 49771 . 50086
+) (NEWNS.OPENMAILBOX 50088 . 50772) (\NSMAIL.NEW.CHECK 50774 . 59139) (NEWNS.NEXTMESSAGE 59141 . 59635
+) (NEWNS.RETRIEVEMESSAGE 59637 . 63501) (\NSMAIL.READ.BODY.PARTS 63503 . 68914) (\NSMAIL.COPY.IA5 
+68916 . 69665) (\NSMAIL.COPY.NSTEXTFILE 69667 . 71816) (\NSMAIL.READ.HEADING 71818 . 74553) (
+\NSMAIL.PARSE.ANNOTATION 74555 . 75289) (\NSMAIL.EMIT.ANNOTATION 75291 . 76559) (LA.TRIM.WHITESPACE 
+76561 . 76683) (\NSMAIL.READ.FORWARDING 76685 . 77710) (\NSMAIL.NEW.PRINT.HEADING 77712 . 83336) (
+\NSMAIL.NEW.PRINT.NAMES 83338 . 84314) (\NSMAIL.EMIT.FORWARDING 84316 . 86150) (\NSMAIL.GDATE 86152 . 
+86268) (\NSMAIL.TRANSLATE.IP.MESSAGEID 86270 . 86817) (\NSMAIL.MAYBE.QUOTE 86819 . 87457) (NULL.NSNAME
+ 87459 . 87801) (\NSMAIL.HANDLE.DELIVERY.REPORT 87803 . 90834) (\NSMAIL.RECIPIENT.NAME 90836 . 91063) 
+(NEW.INBASKET.CALL 91065 . 91689) (NEWNS.CLOSEMAILBOX 91691 . 92407) (\NSMAIL.NEW.LOGOFF 92409 . 92846
 )))))
 STOP
diff --git a/library/lafite/LAFITE-NEWNSMAIL.LCOM b/library/lafite/LAFITE-NEWNSMAIL.LCOM
new file mode 100644
index 00000000..04058240
Binary files /dev/null and b/library/lafite/LAFITE-NEWNSMAIL.LCOM differ
diff --git a/library/lafite/LAFITE-NOXNSPATCH b/library/lafite/LAFITE-NOXNSPATCH
new file mode 100644
index 00000000..8f4daeea
--- /dev/null
+++ b/library/lafite/LAFITE-NOXNSPATCH
@@ -0,0 +1,117 @@
+(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
+
+(FILECREATED "24-Feb-2024 12:03:41" {WMEDLEY}<library>lafite>LAFITE-NOXNSPATCH.;1 7148   
+
+      :EDIT-BY rmk
+
+      :PREVIOUS-DATE "24-Feb-2024 12:02:23" {WMEDLEY}<library>lafite>NOXNSPATCH.;2)
+
+
+(PRETTYCOMPRINT LAFITE-NOXNSPATCHCOMS)
+
+(RPAQQ LAFITE-NOXNSPATCHCOMS
+       [
+        (* ;; "Suppress login/clearinghouse/nsmail if not running XNS.  Mail stuff is necessary in order to parse old NS messages in existing folders.  User should set NS.USER.NAME to the canonical name (E.g. %"Ronald Kaplan%") before starting Lafite.")
+
+        [COMS                                                (* ; "Suppress general XNS access")
+              (FNS NOXNSLOGIN NOXNSCANONICAL.NSHOSTNAME NOXNSGETCLEARINGHOUSE)
+              (P (MOVD? 'LOGIN 'XNSLOGIN)
+                 (MOVD 'NOXNSLOGIN 'LOGIN)
+                 (MOVD? '\CANONICAL.NSHOSTNAME 'XNSCANONICAL.NSHOSTNAME)
+                 (MOVD 'NOXNSCANONICAL.NSHOSTNAME '\CANONICAL.NSHOSTNAME)
+                 (MOVD? 'GETCLEARINGHOUSE 'XNSGETCLEARINGHOUSE)
+                 (MOVD 'NOXNSGETCLEARINGHOUSE 'GETCLEARINGHOUSE]
+        (COMS                                                (* ; 
+                                        "Let Unixmail deal with old NS messages when XNS unavailable")
+              (FNS NOXNSNSMAIL.NEW.AUTHENTICATE NOXNSNSMAIL.MAKEANSWERFORM NOXNSNSMAIL.NEW.SEND 
+                   NOXNSNSMAIL.NEW.SEND.PARSE)
+              (INITVARS (NS.USER.NAME "no NS user name"))
+              (VARS (LAFITE.USE.ALL.MODES NIL))
+              (P (MOVD? '\NSMAIL.NEW.AUTHENTICATE 'XNSNSMAIL.NEW.AUTHENTICATE)
+                 (MOVD 'NOXNSNSMAIL.NEW.AUTHENTICATE '\NSMAIL.NEW.AUTHENTICATE)
+                 (MOVD? '\NSMAIL.MAKEANSWERFORM 'XNSNSMAIL.MAKEANSWERFORM)
+                 (MOVD 'NOXNSNSMAIL.MAKEANSWERFORM '\NSMAIL.MAKEANSWERFORM)
+                 (MOVD? '\NSMAIL.NEW.SEND 'XNSNSMAIL.NEW.SEND)
+                 (MOVD 'NOXNSNSMAIL.NEW.SEND '\NSMAIL.NEW.SEND)
+                 (MOVD? '\NSMAIL.NEW.SEND.PARSE 'XNSNSMAIL.NEW.SEND.PARSE)
+                 (MOVD 'NOXNSNSMAIL.NEW.SEND.PARSE '\NSMAIL.NEW.SEND.PARSE))
+              (DECLARE%: EVAL@COMPILE DONTCOPY (FILES (LOADCOMP)
+                                                      LAFITE-DECLS])
+
+
+
+(* ;; 
+"Suppress login/clearinghouse/nsmail if not running XNS.  Mail stuff is necessary in order to parse old NS messages in existing folders.  User should set NS.USER.NAME to the canonical name (E.g. %"Ronald Kaplan%") before starting Lafite."
+)
+
+
+
+
+(* ; "Suppress general XNS access")
+
+(DEFINEQ
+
+(NOXNSLOGIN
  [LAMBDA (HOST FLG DIRECTORY MSG)                       (* ; "Edited 14-Oct-97 18:38 by rmk:")

    (* ;; "Replace login with NOOP Lisp isn't running XNS")

    (CL:WHEN (STREQUAL "1" (UNIX-GETENV "LDELISPXNS"))
           (XNSLOGIN HOST FLG DIRECTORY MSG])
+
+(NOXNSCANONICAL.NSHOSTNAME
  [LAMBDA (HOST)                                         (* ; "Edited 11-Feb-98 14:34 by rmk:")

    (* ;; "Replace login with NOOP Lisp isn't running XNS")

    (CL:WHEN (STREQUAL "1" (UNIX-GETENV "LDELISPXNS"))
           (XNSCANONICAL.NSHOSTNAME HOST])
+
+(NOXNSGETCLEARINGHOUSE
  [LAMBDA NIL                                            (* ; "Edited  6-Mar-99 01:15 by rmk:")

    (* ;; "Replace login with NOOP Lisp isn't running XNS")

    (CL:WHEN (STREQUAL "1" (UNIX-GETENV "LDELISPXNS"))
           (XNSGETCLEARINGHOUSE])
+)
+
+(MOVD? 'LOGIN 'XNSLOGIN)
+
+(MOVD 'NOXNSLOGIN 'LOGIN)
+
+(MOVD? '\CANONICAL.NSHOSTNAME 'XNSCANONICAL.NSHOSTNAME)
+
+(MOVD 'NOXNSCANONICAL.NSHOSTNAME '\CANONICAL.NSHOSTNAME)
+
+(MOVD? 'GETCLEARINGHOUSE 'XNSGETCLEARINGHOUSE)
+
+(MOVD 'NOXNSGETCLEARINGHOUSE 'GETCLEARINGHOUSE)
+
+
+
+(* ; "Let Unixmail deal with old NS messages when XNS unavailable")
+
+(DEFINEQ
+
+(NOXNSNSMAIL.NEW.AUTHENTICATE
  [LAMBDA NIL                                                (* ; "Edited 18-Mar-99 10:39 by rmk:")
                                                             (* ; "Edited  8-Mar-99 20:59 by rmk:")
                                                             (* ; "Edited  6-Mar-99 11:54 by rmk:")

    (* ;; "Fake up lafite user data when not running XNS.  This permits us to parse old mail folders with NS mesages and detect whether they are from the current user.")

    (IF (STREQUAL "1" (UNIX-GETENV "LDELISPXNS"))
        THEN (XNSNSMAIL.NEW.AUTHENTICATE)
      ELSE (CREATE LAFITEMODEDATA
                      FULLUSERNAME _ (CONCAT NS.USER.NAME ":" CH.DEFAULT.DOMAIN ":" 
                                            CH.DEFAULT.ORGANIZATION)
                      SHORTUSERNAME _ (UNIX-USERNAME)
                      UNPACKEDUSERNAME _ (CREATE NSNAME
                                                NSOBJECT _ NS.USER.NAME
                                                NSDOMAIN _ CH.DEFAULT.DOMAIN
                                                NSORGANIZATION _ CH.DEFAULT.ORGANIZATION])
+
+(NOXNSNSMAIL.MAKEANSWERFORM
  [LAMBDA (MSGDESCRIPTORS MAILFOLDER)                        (* ; "Edited 31-Mar-99 17:04 by rmk:")

    (* ;; "Fake up lafite user data when not running XNS.  This permits us to parse old mail folders with NS mesages and detect whether they are from the current user.")

    (IF (STREQUAL "1" (UNIX-GETENV "LDELISPXNS"))
        THEN (XNSNSMAIL.MAKEANSWERFORM MSGDESCRIPTORS MAILFOLDER)
      ELSE (\UNIXMAIL.MAKEANSWERFORM MSGDESCRIPTORS MAILFOLDER])
+
+(NOXNSNSMAIL.NEW.SEND
  [LAMBDA (PARSE EDITORWINDOW ABORTWINDOW)                   (* ; "Edited 31-Mar-99 17:06 by rmk:")

    (* ;; "Fake up lafite user data when not running XNS.  This permits us to parse old mail folders with NS mesages and detect whether they are from the current user.")

    (IF (STREQUAL "1" (UNIX-GETENV "LDELISPXNS"))
        THEN (XNSNSMAIL.NEW.SEND PARSE EDITORWINDOW ABORTWINDOW)
      ELSE (\UNIXMAIL.SEND PARSE EDITORWINDOW ABORTWINDOW])
+
+(NOXNSNSMAIL.NEW.SEND.PARSE
  [LAMBDA (MSG EDITORWINDOW)                                 (* ; "Edited 31-Mar-99 17:08 by rmk:")

    (* ;; "Fake up lafite user data when not running XNS.  This permits us to parse old mail folders with NS mesages and detect whether they are from the current user.")

    (IF (STREQUAL "1" (UNIX-GETENV "LDELISPXNS"))
        THEN (XNSNSMAIL.NEW.SEND.PARSE MSG EDITORWINDOW)
      ELSE (\UNIXMAIL.SEND.PARSE MSG EDITORWINDOW])
+)
+
+(RPAQ? NS.USER.NAME "no NS user name")
+
+(RPAQQ LAFITE.USE.ALL.MODES NIL)
+
+(MOVD? '\NSMAIL.NEW.AUTHENTICATE 'XNSNSMAIL.NEW.AUTHENTICATE)
+
+(MOVD 'NOXNSNSMAIL.NEW.AUTHENTICATE '\NSMAIL.NEW.AUTHENTICATE)
+
+(MOVD? '\NSMAIL.MAKEANSWERFORM 'XNSNSMAIL.MAKEANSWERFORM)
+
+(MOVD 'NOXNSNSMAIL.MAKEANSWERFORM '\NSMAIL.MAKEANSWERFORM)
+
+(MOVD? '\NSMAIL.NEW.SEND 'XNSNSMAIL.NEW.SEND)
+
+(MOVD 'NOXNSNSMAIL.NEW.SEND '\NSMAIL.NEW.SEND)
+
+(MOVD? '\NSMAIL.NEW.SEND.PARSE 'XNSNSMAIL.NEW.SEND.PARSE)
+
+(MOVD 'NOXNSNSMAIL.NEW.SEND.PARSE '\NSMAIL.NEW.SEND.PARSE)
+(DECLARE%: EVAL@COMPILE DONTCOPY 
+
+(FILESLOAD (LOADCOMP)
+       LAFITE-DECLS)
+)
+(DECLARE%: DONTCOPY
+  (FILEMAP (NIL (2609 3494 (NOXNSLOGIN 2619 . 2905) (NOXNSCANONICAL.NSHOSTNAME 2907 . 3205) (
+NOXNSGETCLEARINGHOUSE 3207 . 3492)) (3836 6503 (NOXNSNSMAIL.NEW.AUTHENTICATE 3846 . 5017) (
+NOXNSNSMAIL.MAKEANSWERFORM 5019 . 5523) (NOXNSNSMAIL.NEW.SEND 5525 . 6017) (NOXNSNSMAIL.NEW.SEND.PARSE
+ 6019 . 6501)))))
+STOP
diff --git a/library/lafite/LAFITE-NOXNSPATCH.LCOM b/library/lafite/LAFITE-NOXNSPATCH.LCOM
new file mode 100644
index 00000000..f7ad532d
Binary files /dev/null and b/library/lafite/LAFITE-NOXNSPATCH.LCOM differ
diff --git a/library/lafite/NSMAIL b/library/lafite/LAFITE-NSMAIL
similarity index 75%
rename from library/lafite/NSMAIL
rename to library/lafite/LAFITE-NSMAIL
index fc73bc4b..51267ab3 100644
--- a/library/lafite/NSMAIL
+++ b/library/lafite/LAFITE-NSMAIL
@@ -1,22 +1,94 @@
 (DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
-(FILECREATED " 6-Aug-93 17:14:21" {DSK}<archive>lafite>sources>nsmail.;34 48519  
 
-      changes to%:  (VARS NSMAILCOMS) (FILES LLNSDECLS) (FNS \NSMAIL.MESSAGE.FROM.SELF.P \NSMAIL.PARSE1 \NSMAIL.MAKE.MAILSERVERS)
+(FILECREATED "24-Feb-2024 11:55:46" {WMEDLEY}<library>lafite>LAFITE-NSMAIL.;1 51946  
 
-      previous date%: "26-May-92 11:56:11" {DSK}<archive>lafite>sources>nsmail.;30)
+      :EDIT-BY rmk
+
+      :CHANGES-TO (VARS NSMAILCOMS)
+                  (FNS \NSMAIL.COURIER.OPEN)
+
+      :PREVIOUS-DATE "13-Jan-2024 18:26:57" {WMEDLEY}<library>lafite>NSMAIL.;2)
 
 
-(* ; "
-Copyright (c) 1984, 1985, 1986, 1987, 1988, 1989, 1990, 1992, 1993 by Xerox Corporation.  All rights reserved.
-")
+(PRETTYCOMPRINT LAFITE-NSMAILCOMS)
 
-(PRETTYCOMPRINT NSMAILCOMS)
+(RPAQQ LAFITE-NSMAILCOMS
+       (
+        (* ;; "Stuff used by both LAFITE-NEWNSMAIL & OLDNSMAIL")
 
-(RPAQQ NSMAILCOMS ((* ;; "Stuff used by both NEWNSMAIL & OLDNSMAIL") (COMS (* ; "Support of authentication") (FNS \NSMAIL.LOGIN NS.FINDMAILBOXES \NSMAIL.MAKE.MAILSERVERS \NSMAIL.FIX.MAILBOX.LOCATIONS)) (COMS (* ; "Utilities") (FNS \NSMAIL.CHECK.SERIALIZED.VERSION \NSMAIL.READ.SERIALIZED.CONTENT \NSMAIL.DISCARD.SERIALIZED.CONTENT \NSMAIL.READ.STRING.AS.STREAM) (* ; "Error handling") (FNS \NSMAIL.COURIER.OPEN \NSMAIL.ERRORHANDLER \NSMAIL.SIGNAL.ERROR) (INITVARS (NSMAILDEBUGFLG) (NSMAIL.HEADER.ORDER (QUOTE (Date Sender From Subject In-Reply-to To cc Message-ID Reply-to))))) (COMS (* ; "Handling attachments as a special kind of image object") (FNS \MAILOBJ.CREATE \MAILOBJ.TYPE.NAME \MAILOBJ.NS.TO.LISP.NAME \MAILOBJ.DISPLAY \MAILOBJ.GET \MAILOBJ.IMAGEBOX \MAILOBJ.PUT \MAILOBJ.INIT) (FNS \MAILOBJ.BUTTONEVENTFN \MAILOBJ.DO.COMMAND \MAILOBJ.HARDCOPY \MAILOBJ.FB \MAILOBJ.PUT.FILE \MAILOBJ.VIEW \MAILOBJ.MUNGE.NAME \MAILOBJ.COPY.BODY \MAILOBJ.EXPAND \MAILOBJ.COPY.CHILD \MAILOBJ.COPY.SEQUENCE \MAILOBJ.EXTRACT.TEXT \MAILOBJ.PARSE.ATTRIBUTES) (ADDVARS (FILING.TYPES (VIEWPOINT 4353) (RES 4428) (XEROX860 5120) (REFERENCE 4427) (MAILFOLDER 4417))) (VARS MAILOBJ.REFERENCE.FIELD) (INITVARS (MAILOBJ.WINDOWOFFSET 16) (MAILOBJ.SKIPCHAR (CHARCODE "."))) (DECLARE%: EVAL@COMPILE DONTCOPY (RECORDS MAILOBJ) (CONSTANTS \MAILOBJ.REFERENCE.LAST.FILED)) (DECLARE%: DONTEVAL@LOAD DOCOPY (P (\MAILOBJ.INIT) (AND (EQ MAKESYSNAME :LYRIC) (FILESLOAD (SYSLOAD) NSRANDOM))))) (COMS (FNS \NSMAIL.WRITE.ATTRIBUTE) (DECLARE%: EVAL@COMPILE DOCOPY (VARS \NSMAIL.ATTRIBUTES))) (COMS (* ; "sending mail") (FNS \NSMAIL.PARSE.REFERENCE \NSMAIL.EXPAND.DL \NSMAIL.PARSE \NSMAIL.PARSE1 NS.REMOVEDUPLICATES \NSMAIL.GUESS.FILE.TYPE COURIER.WRITE.STREAM.UNSPECIFIED \NSMAIL.SEND.STREAM.AS.STRING) (FILES LAFITEMAIL) (* ; "for LAFITE.MAKE.PARSE.TABLE") (VARS NSMAIL.PARSEFIELDS (\LAPARSE.NSMAIL (LAFITE.MAKE.PARSE.TABLE NSMAIL.PARSEFIELDS))) (GLOBALVARS \LAPARSE.NSMAIL) (INITVARS (NSMAIL.NET.HINT) (*NSMAIL-MAX-NOTE-LENGTH* 8000) (*NSMAIL-CACHE-TIMEOUT* 14400000) (*NSMAIL-GENEROUS-SELF-TEST* T) (LAFITEDL.EXT "DL")) (P (CL:PROCLAIM (QUOTE (GLOBAL NSMAIL.NET.HINT *NSMAIL-MAX-NOTE-LENGTH* *NSMAIL-CACHE-TIMEOUT* *NSMAIL-GENEROUS-SELF-TEST*)))) (FNS \NSMAIL.MESSAGE.P \NSMAIL.MESSAGE.FROM.SELF.P \NSMAIL.MAKEANSWERFORM \NSMAIL.PRINT.NAMES)) (DECLARE%: EVAL@COMPILE DONTCOPY (RECORDS NSMAILBOX NSMAILSTATE NSMAILPARSE) (CONSTANTS \NSMAIL.SOCKET \SERIALIZED.FILE.VERSION \SERIALIZED.FILE.VERSIONS \NSMAIL.TEXT.BODYTYPE \NSMAIL.EMPTY.BODYTYPE \NSMAIL.REFERENCE.BODYTYPE MAX.BULK.SEGMENT.LENGTH) (MACROS \NSMAIL.ATTRIBUTE.TYPE \NSMAIL.WRITE.ATTRIBUTE \NSMAIL.WRITE.ATTRIBUTE.MACRO) (PROP INFO \NSMAIL.ATTRIBUTE.TYPE) (GLOBALVARS *NSMAIL-OP-VECTOR* DEFAULTICONFONT FILING.TYPES MAILOBJ.REFERENCE.FIELD MAILOBJ.SKIPCHAR MAILOBJ.WINDOWOFFSET NSMAIL.HEADER.ORDER NSMAIL.NET.HINT NSMAILDEBUGFLG NSPRINT.WATCHERFLG NSWIZARDFLG \MAILOBJ.IMAGEFNS \NSFILING.ATTRIBUTES \NSMAIL.ATTRIBUTES) (FILES (SOURCE) LAFITEDECLS LLNSDECLS) (* ;; "LLNSDECLS to get NSADDRESS, needed by \NSMAIL.SIGNAL.ERROR") (LOCALVARS . T))))
+        (COMS                                                (* ; "Support of authentication")
+              (FNS \NSMAIL.LOGIN NS.FINDMAILBOXES \NSMAIL.MAKE.MAILSERVERS 
+                   \NSMAIL.FIX.MAILBOX.LOCATIONS))
+        [COMS                                                (* ; "Utilities")
+              (FNS \NSMAIL.CHECK.SERIALIZED.VERSION \NSMAIL.READ.SERIALIZED.CONTENT 
+                   \NSMAIL.DISCARD.SERIALIZED.CONTENT \NSMAIL.READ.STRING.AS.STREAM)
+                                                             (* ; "Error handling")
+              (FNS \NSMAIL.COURIER.OPEN \NSMAIL.ERRORHANDLER \NSMAIL.SIGNAL.ERROR)
+              (INITVARS (NSMAILDEBUGFLG)
+                     (NSMAIL.HEADER.ORDER '(Date Sender From Subject In-Reply-to To cc Message-ID 
+                                                 Reply-to]
+        [COMS                                                (* ; 
+                                             "Handling attachments as a special kind of image object")
+              (FNS \MAILOBJ.CREATE \MAILOBJ.TYPE.NAME \MAILOBJ.NS.TO.LISP.NAME \MAILOBJ.DISPLAY 
+                   \MAILOBJ.GET \MAILOBJ.IMAGEBOX \MAILOBJ.PUT \MAILOBJ.INIT)
+              (FNS \MAILOBJ.BUTTONEVENTFN \MAILOBJ.DO.COMMAND \MAILOBJ.HARDCOPY \MAILOBJ.FB 
+                   \MAILOBJ.PUT.FILE \MAILOBJ.VIEW \MAILOBJ.MUNGE.NAME \MAILOBJ.COPY.BODY 
+                   \MAILOBJ.EXPAND \MAILOBJ.COPY.CHILD \MAILOBJ.COPY.SEQUENCE \MAILOBJ.EXTRACT.TEXT 
+                   \MAILOBJ.PARSE.ATTRIBUTES)
+              (ADDVARS (FILING.TYPES (VIEWPOINT 4353)
+                              (RES 4428)
+                              (XEROX860 5120)
+                              (REFERENCE 4427)
+                              (MAILFOLDER 4417)))
+              (VARS MAILOBJ.REFERENCE.FIELD)
+              (INITVARS (MAILOBJ.WINDOWOFFSET 16)
+                     (MAILOBJ.SKIPCHAR (CHARCODE ".")))
+              (DECLARE%: EVAL@COMPILE DONTCOPY (RECORDS MAILOBJ)
+                     (CONSTANTS \MAILOBJ.REFERENCE.LAST.FILED))
+              (DECLARE%: DONTEVAL@LOAD DOCOPY (P (\MAILOBJ.INIT)
+                                                 (AND (EQ MAKESYSNAME :LYRIC)
+                                                      (FILESLOAD (SYSLOAD)
+                                                             NSRANDOM]
+        (COMS (FNS \NSMAIL.WRITE.ATTRIBUTE)
+              (DECLARE%: EVAL@COMPILE DOCOPY (VARS \NSMAIL.ATTRIBUTES)))
+        (COMS                                                (* ; "sending mail")
+              (FNS \NSMAIL.PARSE.REFERENCE \NSMAIL.EXPAND.DL \NSMAIL.PARSE \NSMAIL.PARSE1 
+                   NS.REMOVEDUPLICATES \NSMAIL.GUESS.FILE.TYPE COURIER.WRITE.STREAM.UNSPECIFIED 
+                   \NSMAIL.SEND.STREAM.AS.STRING)
+              (FILES LAFITE-MAIL)
+                                                             (* ; "for LAFITE.MAKE.PARSE.TABLE")
+              (VARS NSMAIL.PARSEFIELDS (\LAPARSE.NSMAIL (LAFITE.MAKE.PARSE.TABLE NSMAIL.PARSEFIELDS))
+                    )
+              (GLOBALVARS \LAPARSE.NSMAIL)
+              (INITVARS (NSMAIL.NET.HINT)
+                     (*NSMAIL-MAX-NOTE-LENGTH* 8000)
+                     (*NSMAIL-CACHE-TIMEOUT* 14400000)
+                     (*NSMAIL-GENEROUS-SELF-TEST* T)
+                     (LAFITEDL.EXT "DL"))
+              [P (CL:PROCLAIM '(GLOBAL NSMAIL.NET.HINT *NSMAIL-MAX-NOTE-LENGTH* 
+                                      *NSMAIL-CACHE-TIMEOUT* *NSMAIL-GENEROUS-SELF-TEST*]
+              (FNS \NSMAIL.MESSAGE.P \NSMAIL.MESSAGE.FROM.SELF.P \NSMAIL.MAKEANSWERFORM 
+                   \NSMAIL.PRINT.NAMES))
+        (DECLARE%: EVAL@COMPILE DONTCOPY (RECORDS NSMAILBOX NSMAILSTATE NSMAILPARSE)
+               (CONSTANTS \NSMAIL.SOCKET \SERIALIZED.FILE.VERSION \SERIALIZED.FILE.VERSIONS 
+                      \NSMAIL.TEXT.BODYTYPE \NSMAIL.EMPTY.BODYTYPE \NSMAIL.REFERENCE.BODYTYPE 
+                      MAX.BULK.SEGMENT.LENGTH)
+               (MACROS \NSMAIL.ATTRIBUTE.TYPE \NSMAIL.WRITE.ATTRIBUTE \NSMAIL.WRITE.ATTRIBUTE.MACRO)
+               (PROP INFO \NSMAIL.ATTRIBUTE.TYPE)
+               (GLOBALVARS *NSMAIL-OP-VECTOR* DEFAULTICONFONT FILING.TYPES MAILOBJ.REFERENCE.FIELD 
+                      MAILOBJ.SKIPCHAR MAILOBJ.WINDOWOFFSET NSMAIL.HEADER.ORDER NSMAIL.NET.HINT 
+                      NSMAILDEBUGFLG NSPRINT.WATCHERFLG NSWIZARDFLG \MAILOBJ.IMAGEFNS 
+                      \NSFILING.ATTRIBUTES \NSMAIL.ATTRIBUTES)
+               (FILES (SOURCE)
+                      LAFITE-DECLS LLNSDECLS)
+               
+               (* ;; "LLNSDECLS to get NSADDRESS, needed by \NSMAIL.SIGNAL.ERROR")
+
+               (LOCALVARS . T))))
 
 
 
-(* ;; "Stuff used by both NEWNSMAIL & OLDNSMAIL")
+(* ;; "Stuff used by both LAFITE-NEWNSMAIL & OLDNSMAIL")
 
 
 
@@ -61,8 +133,16 @@ RETURN to attempt retrieval anyway." V))))))
 )
 
 (\NSMAIL.READ.STRING.AS.STREAM
-(LAMBDA (INSTREAM OUTSTREAM) (* bvm%: "30-Jul-84 16:13") (* ;; "Considers INSTREAM to be positioned at a sequence of unspecified, and reads it as if its datatype were string, and copies said bytes to OUTSTREAM") (PROG (LENGTH) (\WIN INSTREAM) (* ; "Skip sequence count") (COPYBYTES INSTREAM OUTSTREAM (SETQ LENGTH (\WIN INSTREAM))) (COND ((ODDP LENGTH) (\BIN INSTREAM)))))
-)
+  [LAMBDA (INSTREAM OUTSTREAM)                               (* bvm%: "30-Jul-84 16:13")
+
+    (* ;; "Considers INSTREAM to be positioned at a sequence of unspecified, and reads it as if its datatype were string, and copies said bytes to OUTSTREAM")
+
+    (PROG (LENGTH)
+          (\WIN INSTREAM)                                    (* ; "Skip sequence count")
+          (COPYBYTES INSTREAM OUTSTREAM (SETQ LENGTH (\WIN INSTREAM)))
+          (COND
+             ((ODDP LENGTH)
+              (\BIN INSTREAM])
 )
 
 
@@ -72,8 +152,10 @@ RETURN to attempt retrieval anyway." V))))))
 (DEFINEQ
 
 (\NSMAIL.COURIER.OPEN
-(LAMBDA (ADDRESS) (* ; "Edited  9-Sep-88 12:06 by bvm") (COURIER.OPEN ADDRESS NIL T (QUOTE NSMAIL) NIL (CONSTANT (LIST (QUOTE ERRORHANDLER) (FUNCTION \NSMAIL.ERRORHANDLER)))))
-)
+  [LAMBDA (ADDRESS)                                          (* ; "Edited 24-Feb-2024 11:52 by rmk")
+                                                             (* ; "Edited  9-Sep-88 12:06 by bvm")
+    (COURIER.OPEN ADDRESS NIL T 'LAFITE-NSMAIL NIL (CONSTANT (LIST 'ERRORHANDLER
+                                                                   (FUNCTION \NSMAIL.ERRORHANDLER])
 
 (\NSMAIL.ERRORHANDLER
 (LAMBDA (STREAM ERRCODE) (* ; "Edited  9-Sep-88 12:35 by bvm") (* ;; "Called when SPP error occurs on NS mail courier connection STREAM.  Fakes an error return from the courier.call.") (LET (POS) (if (AND (EQ ERRCODE (QUOTE STREAM.LOST)) (SETQ POS (STKPOS (FUNCTION COURIER.CALL)))) then (BLOCK 500) (RETFROM POS (QUOTE (ERROR STREAM.LOST)) T) else (\SPP.DEFAULT.ERRORHANDLER STREAM ERRCODE))))
@@ -84,9 +166,9 @@ RETURN to attempt retrieval anyway." V))))))
 )
 )
 
-(RPAQ? NSMAILDEBUGFLG)
+(RPAQ? NSMAILDEBUGFLG )
 
-(RPAQ? NSMAIL.HEADER.ORDER (QUOTE (Date Sender From Subject In-Reply-to To cc Message-ID Reply-to)))
+(RPAQ? NSMAIL.HEADER.ORDER '(Date Sender From Subject In-Reply-to To cc Message-ID Reply-to))
 
 
 
@@ -181,23 +263,38 @@ RETURN to attempt retrieval anyway." V))))))
 )
 )
 
-(ADDTOVAR FILING.TYPES (VIEWPOINT 4353) (RES 4428) (XEROX860 5120) (REFERENCE 4427) (MAILFOLDER 4417))
+(ADDTOVAR FILING.TYPES (VIEWPOINT 4353)
+                       (RES 4428)
+                       (XEROX860 5120)
+                       (REFERENCE 4427)
+                       (MAILFOLDER 4417))
 
-(RPAQQ MAILOBJ.REFERENCE.FIELD (REFERENCE 4421 (NAMEDRECORD (FILE.ID (FILING . FILE.ID)) (SERVICE NSNAME) (ADDRESS NSADDRESS) (HOST STRING) (DIRECTORY STRING) (NAME STRING) (TYPE (FILING . ATTRIBUTE.TYPE)) (NIL UNSPECIFIED) (PAGES CARDINAL) (VERSION CARDINAL) (FLAGS CARDINAL))))
+(RPAQQ MAILOBJ.REFERENCE.FIELD
+       (REFERENCE 4421 (NAMEDRECORD (FILE.ID (FILING . FILE.ID))
+                              (SERVICE NSNAME)
+                              (ADDRESS NSADDRESS)
+                              (HOST STRING)
+                              (DIRECTORY STRING)
+                              (NAME STRING)
+                              (TYPE (FILING . ATTRIBUTE.TYPE))
+                              (NIL UNSPECIFIED)
+                              (PAGES CARDINAL)
+                              (VERSION CARDINAL)
+                              (FLAGS CARDINAL))))
 
-(RPAQ? MAILOBJ.WINDOWOFFSET 16)
+(RPAQ? MAILOBJ.WINDOWOFFSET 16)
 
-(RPAQ? MAILOBJ.SKIPCHAR (CHARCODE "."))
+(RPAQ? MAILOBJ.SKIPCHAR (CHARCODE "."))
 (DECLARE%: EVAL@COMPILE DONTCOPY 
 (DECLARE%: EVAL@COMPILE
 
-(RECORD MAILOBJ (MAILOBJ.IMAGE MAILOBJ.BOX MAILOBJ.TYPE MAILOBJ.DATA MAILOBJ.ATTR.LENGTH MAILOBJ.START MAILOBJ.NAME MAILOBJ.EXPANDABLE . MAILOBJ.INFO)
-)
+(RECORD MAILOBJ (MAILOBJ.IMAGE MAILOBJ.BOX MAILOBJ.TYPE MAILOBJ.DATA MAILOBJ.ATTR.LENGTH 
+                       MAILOBJ.START MAILOBJ.NAME MAILOBJ.EXPANDABLE . MAILOBJ.INFO))
 )
 
 (DECLARE%: EVAL@COMPILE 
 
-(RPAQQ \MAILOBJ.REFERENCE.LAST.FILED 8192)
+(RPAQQ \MAILOBJ.REFERENCE.LAST.FILED 8192)
 
 
 (CONSTANTS \MAILOBJ.REFERENCE.LAST.FILED)
@@ -205,9 +302,11 @@ RETURN to attempt retrieval anyway." V))))))
 )
 (DECLARE%: DONTEVAL@LOAD DOCOPY 
 
-(\MAILOBJ.INIT)
+(\MAILOBJ.INIT)
 
-(AND (EQ MAKESYSNAME :LYRIC) (FILESLOAD (SYSLOAD) NSRANDOM))
+(AND (EQ MAKESYSNAME :LYRIC)
+     (FILESLOAD (SYSLOAD)
+            NSRANDOM))
 )
 (DEFINEQ
 
@@ -217,7 +316,21 @@ RETURN to attempt retrieval anyway." V))))))
 )
 (DECLARE%: EVAL@COMPILE DOCOPY 
 
-(RPAQQ \NSMAIL.ATTRIBUTES ((From 4672 NAME.LIST) (Date 4673 TIME) (Reply-to 4674 NAME.LIST) (To 4676 NAME.LIST) (cc 4677 NAME.LIST) (Subject 9 STRING) (Message-ID 4693 MESSAGEID) (Sender 4705 NAME) (BodySize 16 LONGCARDINAL) (BodyType 17 LONGCARDINAL) (Note 4687 STRING) (OldLispFormatting 4910 STRING) (LispFormatting 4911 STRING) (In-Reply-to 4690 STRING)))
+(RPAQQ \NSMAIL.ATTRIBUTES
+       ((From 4672 NAME.LIST)
+        (Date 4673 TIME)
+        (Reply-to 4674 NAME.LIST)
+        (To 4676 NAME.LIST)
+        (cc 4677 NAME.LIST)
+        (Subject 9 STRING)
+        (Message-ID 4693 MESSAGEID)
+        (Sender 4705 NAME)
+        (BodySize 16 LONGCARDINAL)
+        (BodyType 17 LONGCARDINAL)
+        (Note 4687 STRING)
+        (OldLispFormatting 4910 STRING)
+        (LispFormatting 4911 STRING)
+        (In-Reply-to 4690 STRING)))
 )
 
 
@@ -259,32 +372,47 @@ RETURN to attempt retrieval anyway." V))))))
 )
 )
 
-(FILESLOAD LAFITEMAIL)
+(FILESLOAD LAFITE-MAIL)
 
 
 
 (* ; "for LAFITE.MAKE.PARSE.TABLE")
 
 
-(RPAQQ NSMAIL.PARSEFIELDS (("DATE:" LAFITE.READ.LINE.FOR.TOC Date) ("SUBJECT:" LAFITE.READ.LINE.FOR.TOC Subject) ("SENDER:" LAFITE.READ.NAME.FIELD Sender) ("FROM:" LAFITE.READ.NAME.FIELD From) ("REPLY-TO:" LAFITE.READ.NAME.FIELD Reply-to) ("IN-REPLY-TO:" LAFITE.READ.LINE.FOR.TOC In-Reply-to) ("TO:" LAFITE.READ.NAME.FIELD To) ("CC:" LAFITE.READ.NAME.FIELD cc) ("FORMAT:" LAFITE.READ.FORMAT) ("ATTACHED-REFERENCE:" LAFITE.READ.LINE.FOR.TOC REFERENCE) ("ATTACHED-FILE:" LAFITE.READ.LINE.FOR.TOC ATTACHMENT) ("Importance:" LAFITE.READ.LINE.FOR.TOC Importance) ("Sensitivity:" LAFITE.READ.LINE.FOR.TOC Sensitivity) ("Immutable:" LAFITE.READ.LINE.FOR.TOC Immutable)))
+(RPAQQ NSMAIL.PARSEFIELDS
+       (("DATE:" LAFITE.READ.LINE.FOR.TOC Date)
+        ("SUBJECT:" LAFITE.READ.LINE.FOR.TOC Subject)
+        ("SENDER:" LAFITE.READ.NAME.FIELD Sender)
+        ("FROM:" LAFITE.READ.NAME.FIELD From)
+        ("REPLY-TO:" LAFITE.READ.NAME.FIELD Reply-to)
+        ("IN-REPLY-TO:" LAFITE.READ.LINE.FOR.TOC In-Reply-to)
+        ("TO:" LAFITE.READ.NAME.FIELD To)
+        ("CC:" LAFITE.READ.NAME.FIELD cc)
+        ("FORMAT:" LAFITE.READ.FORMAT)
+        ("ATTACHED-REFERENCE:" LAFITE.READ.LINE.FOR.TOC REFERENCE)
+        ("ATTACHED-FILE:" LAFITE.READ.LINE.FOR.TOC ATTACHMENT)
+        ("Importance:" LAFITE.READ.LINE.FOR.TOC Importance)
+        ("Sensitivity:" LAFITE.READ.LINE.FOR.TOC Sensitivity)
+        ("Immutable:" LAFITE.READ.LINE.FOR.TOC Immutable)))
 
-(RPAQ \LAPARSE.NSMAIL (LAFITE.MAKE.PARSE.TABLE NSMAIL.PARSEFIELDS))
+(RPAQ \LAPARSE.NSMAIL (LAFITE.MAKE.PARSE.TABLE NSMAIL.PARSEFIELDS))
 (DECLARE%: DOEVAL@COMPILE DONTCOPY
 
 (GLOBALVARS \LAPARSE.NSMAIL)
 )
 
-(RPAQ? NSMAIL.NET.HINT)
+(RPAQ? NSMAIL.NET.HINT )
 
-(RPAQ? *NSMAIL-MAX-NOTE-LENGTH* 8000)
+(RPAQ? *NSMAIL-MAX-NOTE-LENGTH* 8000)
 
-(RPAQ? *NSMAIL-CACHE-TIMEOUT* 14400000)
+(RPAQ? *NSMAIL-CACHE-TIMEOUT* 14400000)
 
-(RPAQ? *NSMAIL-GENEROUS-SELF-TEST* T)
+(RPAQ? *NSMAIL-GENEROUS-SELF-TEST* T)
 
-(RPAQ? LAFITEDL.EXT "DL")
+(RPAQ? LAFITEDL.EXT "DL")
 
-(CL:PROCLAIM (QUOTE (GLOBAL NSMAIL.NET.HINT *NSMAIL-MAX-NOTE-LENGTH* *NSMAIL-CACHE-TIMEOUT* *NSMAIL-GENEROUS-SELF-TEST*)))
+(CL:PROCLAIM '(GLOBAL NSMAIL.NET.HINT *NSMAIL-MAX-NOTE-LENGTH* *NSMAIL-CACHE-TIMEOUT* 
+                     *NSMAIL-GENEROUS-SELF-TEST*))
 (DEFINEQ
 
 (\NSMAIL.MESSAGE.P
@@ -306,79 +434,100 @@ RETURN to attempt retrieval anyway." V))))))
 (DECLARE%: EVAL@COMPILE DONTCOPY 
 (DECLARE%: EVAL@COMPILE
 
-(RECORD NSMAILBOX (NSMAILSTREAM NSMAILENVTAIL NSMAILENVELOPES NSMAILLASTINDEX . NSMAILSTATE) (ACCESSFNS NSMAILBOX ((NSMAILSESSION (fetch STATESESSION of (fetch NSMAILSTATE of DATUM))) (NSMAILFIRSTINDEX (fetch STATEFIRSTNEW of (fetch NSMAILSTATE of DATUM)))))
-)
+(RECORD NSMAILBOX (NSMAILSTREAM NSMAILENVTAIL NSMAILENVELOPES NSMAILLASTINDEX . NSMAILSTATE)
+                  [ACCESSFNS NSMAILBOX ((NSMAILSESSION (fetch STATESESSION
+                                                          of (fetch NSMAILSTATE of DATUM)))
+                                        (NSMAILFIRSTINDEX (fetch STATEFIRSTNEW
+                                                             of (fetch NSMAILSTATE of DATUM])
 
-(RECORD NSMAILSTATE (STATESESSION STATEFIRSTNEW STATEOLDLAST STATENAME STATECREDENTIALS STATEADDRESS STATELASTERROR STATETIMER)
-)
+(RECORD NSMAILSTATE (STATESESSION STATEFIRSTNEW STATEOLDLAST STATENAME STATECREDENTIALS STATEADDRESS
+                           STATELASTERROR STATETIMER))
 
 (RECORD NSMAILPARSE (NSPSUBJECT NSPRECIPIENTS NSPSTART NSPFORMATTED . NSPFIELDS))
 )
 
 (DECLARE%: EVAL@COMPILE 
 
-(RPAQQ \NSMAIL.SOCKET 26)
+(RPAQQ \NSMAIL.SOCKET 26)
 
-(RPAQQ \SERIALIZED.FILE.VERSION 2)
+(RPAQQ \SERIALIZED.FILE.VERSION 2)
 
-(RPAQQ \SERIALIZED.FILE.VERSIONS (2 3))
+(RPAQQ \SERIALIZED.FILE.VERSIONS (2 3))
 
-(RPAQQ \NSMAIL.TEXT.BODYTYPE 2)
+(RPAQQ \NSMAIL.TEXT.BODYTYPE 2)
 
-(RPAQQ \NSMAIL.EMPTY.BODYTYPE 4)
+(RPAQQ \NSMAIL.EMPTY.BODYTYPE 4)
 
-(RPAQQ \NSMAIL.REFERENCE.BODYTYPE 4427)
+(RPAQQ \NSMAIL.REFERENCE.BODYTYPE 4427)
 
-(RPAQQ MAX.BULK.SEGMENT.LENGTH 32768)
+(RPAQQ MAX.BULK.SEGMENT.LENGTH 32768)
 
 
-(CONSTANTS \NSMAIL.SOCKET \SERIALIZED.FILE.VERSION \SERIALIZED.FILE.VERSIONS \NSMAIL.TEXT.BODYTYPE \NSMAIL.EMPTY.BODYTYPE \NSMAIL.REFERENCE.BODYTYPE MAX.BULK.SEGMENT.LENGTH)
+(CONSTANTS \NSMAIL.SOCKET \SERIALIZED.FILE.VERSION \SERIALIZED.FILE.VERSIONS \NSMAIL.TEXT.BODYTYPE 
+       \NSMAIL.EMPTY.BODYTYPE \NSMAIL.REFERENCE.BODYTYPE MAX.BULK.SEGMENT.LENGTH)
 )
 
 (DECLARE%: EVAL@COMPILE 
 
-(PUTPROPS \NSMAIL.ATTRIBUTE.TYPE MACRO (ARGS (COND ((CADR (ASSOC (CAR ARGS) \NSMAIL.ATTRIBUTES))) (T (ERROR "Unknown mail attribute" (CAR ARGS)) (QUOTE IGNOREMACRO)))))
+(PUTPROPS \NSMAIL.ATTRIBUTE.TYPE MACRO [ARGS (COND
+                                                ((CADR (ASSOC (CAR ARGS)
+                                                              \NSMAIL.ATTRIBUTES)))
+                                                (T (ERROR "Unknown mail attribute" (CAR ARGS))
+                                                   'IGNOREMACRO])
 
-(PUTPROPS \NSMAIL.WRITE.ATTRIBUTE MACRO (ARGS (LET ((INFO (CDR (ASSOC (CAR (CONSTANTEXPRESSIONP (CADR ARGS))) \NSMAIL.ATTRIBUTES)))) (COND (INFO (LIST (QUOTE \NSMAIL.WRITE.ATTRIBUTE.MACRO) (CAR ARGS) (CAR INFO) (CADDR ARGS) (KWOTE (CADR INFO)))) (T (QUOTE IGNOREMACRO))))))
+(PUTPROPS \NSMAIL.WRITE.ATTRIBUTE MACRO
+          [ARGS (LET [(INFO (CDR (ASSOC (CAR (CONSTANTEXPRESSIONP (CADR ARGS)))
+                                        \NSMAIL.ATTRIBUTES]
+                     (COND
+                        [INFO (LIST '\NSMAIL.WRITE.ATTRIBUTE.MACRO (CAR ARGS)
+                                    (CAR INFO)
+                                    (CADDR ARGS)
+                                    (KWOTE (CADR INFO]
+                        (T 'IGNOREMACRO])
 
-(PUTPROPS \NSMAIL.WRITE.ATTRIBUTE.MACRO MACRO (OPENLAMBDA (STREAM TYPENO VALUE VALUETYPE) (COURIER.WRITE STREAM TYPENO NIL (QUOTE LONGCARDINAL)) (COURIER.WRITE.SEQUENCE.UNSPECIFIED STREAM VALUE (QUOTE MAILTRANSPORT) VALUETYPE)))
+(PUTPROPS \NSMAIL.WRITE.ATTRIBUTE.MACRO MACRO (OPENLAMBDA (STREAM TYPENO VALUE VALUETYPE)
+                                                (COURIER.WRITE STREAM TYPENO NIL 'LONGCARDINAL)
+                                                (COURIER.WRITE.SEQUENCE.UNSPECIFIED STREAM VALUE
+                                                       'MAILTRANSPORT VALUETYPE)))
 )
 
 
-(PUTPROPS \NSMAIL.ATTRIBUTE.TYPE INFO NOEVAL)
+(PUTPROPS \NSMAIL.ATTRIBUTE.TYPE INFO NOEVAL)
 
 (DECLARE%: DOEVAL@COMPILE DONTCOPY
 
-(GLOBALVARS *NSMAIL-OP-VECTOR* DEFAULTICONFONT FILING.TYPES MAILOBJ.REFERENCE.FIELD MAILOBJ.SKIPCHAR MAILOBJ.WINDOWOFFSET NSMAIL.HEADER.ORDER NSMAIL.NET.HINT NSMAILDEBUGFLG NSPRINT.WATCHERFLG NSWIZARDFLG \MAILOBJ.IMAGEFNS \NSFILING.ATTRIBUTES \NSMAIL.ATTRIBUTES)
+(GLOBALVARS *NSMAIL-OP-VECTOR* DEFAULTICONFONT FILING.TYPES MAILOBJ.REFERENCE.FIELD MAILOBJ.SKIPCHAR
+       MAILOBJ.WINDOWOFFSET NSMAIL.HEADER.ORDER NSMAIL.NET.HINT NSMAILDEBUGFLG NSPRINT.WATCHERFLG 
+       NSWIZARDFLG \MAILOBJ.IMAGEFNS \NSFILING.ATTRIBUTES \NSMAIL.ATTRIBUTES)
 )
 
 
-(FILESLOAD (SOURCE) LAFITEDECLS LLNSDECLS)
+(FILESLOAD (SOURCE)
+       LAFITE-DECLS LLNSDECLS)
 
 (DECLARE%: DOEVAL@COMPILE DONTCOPY
 
 (LOCALVARS . T)
 )
 )
-(PUTPROPS NSMAIL COPYRIGHT ("Xerox Corporation" 1984 1985 1986 1987 1988 1989 1990 1992 1993))
 (DECLARE%: DONTCOPY
-  (FILEMAP (NIL (3699 7008 (\NSMAIL.LOGIN 3709 . 3935) (NS.FINDMAILBOXES 3937 . 4394) (
-\NSMAIL.MAKE.MAILSERVERS 4396 . 5190) (\NSMAIL.FIX.MAILBOX.LOCATIONS 5192 . 7006)) (7035 9116 (
-\NSMAIL.CHECK.SERIALIZED.VERSION 7045 . 7358) (\NSMAIL.READ.SERIALIZED.CONTENT 7360 . 8254) (
-\NSMAIL.DISCARD.SERIALIZED.CONTENT 8256 . 8703) (\NSMAIL.READ.STRING.AS.STREAM 8705 . 9114)) (9148 
-10549 (\NSMAIL.COURIER.OPEN 9158 . 9361) (\NSMAIL.ERRORHANDLER 9363 . 9785) (\NSMAIL.SIGNAL.ERROR 9787
- . 10547)) (10747 16949 (\MAILOBJ.CREATE 10757 . 12982) (\MAILOBJ.TYPE.NAME 12984 . 13451) (
-\MAILOBJ.NS.TO.LISP.NAME 13453 . 14804) (\MAILOBJ.DISPLAY 14806 . 15126) (\MAILOBJ.GET 15128 . 15951) 
-(\MAILOBJ.IMAGEBOX 15953 . 16081) (\MAILOBJ.PUT 16083 . 16669) (\MAILOBJ.INIT 16671 . 16947)) (16950 
-31846 (\MAILOBJ.BUTTONEVENTFN 16960 . 19089) (\MAILOBJ.DO.COMMAND 19091 . 19338) (\MAILOBJ.HARDCOPY 
-19340 . 21146) (\MAILOBJ.FB 21148 . 21362) (\MAILOBJ.PUT.FILE 21364 . 23029) (\MAILOBJ.VIEW 23031 . 
-25968) (\MAILOBJ.MUNGE.NAME 25970 . 26234) (\MAILOBJ.COPY.BODY 26236 . 26550) (\MAILOBJ.EXPAND 26552
- . 28273) (\MAILOBJ.COPY.CHILD 28275 . 29632) (\MAILOBJ.COPY.SEQUENCE 29634 . 30002) (
-\MAILOBJ.EXTRACT.TEXT 30004 . 31065) (\MAILOBJ.PARSE.ATTRIBUTES 31067 . 31844)) (32756 33393 (
-\NSMAIL.WRITE.ATTRIBUTE 32766 . 33391)) (33818 40701 (\NSMAIL.PARSE.REFERENCE 33828 . 35746) (
-\NSMAIL.EXPAND.DL 35748 . 36815) (\NSMAIL.PARSE 36817 . 37078) (\NSMAIL.PARSE1 37080 . 38288) (
-NS.REMOVEDUPLICATES 38290 . 38428) (\NSMAIL.GUESS.FILE.TYPE 38430 . 38931) (
-COURIER.WRITE.STREAM.UNSPECIFIED 38933 . 40077) (\NSMAIL.SEND.STREAM.AS.STRING 40079 . 40699)) (41866 
-46243 (\NSMAIL.MESSAGE.P 41876 . 42014) (\NSMAIL.MESSAGE.FROM.SELF.P 42016 . 43715) (
-\NSMAIL.MAKEANSWERFORM 43717 . 45341) (\NSMAIL.PRINT.NAMES 45343 . 46241)))))
+  (FILEMAP (NIL (5263 8572 (\NSMAIL.LOGIN 5273 . 5499) (NS.FINDMAILBOXES 5501 . 5958) (
+\NSMAIL.MAKE.MAILSERVERS 5960 . 6754) (\NSMAIL.FIX.MAILBOX.LOCATIONS 6756 . 8570)) (8599 10821 (
+\NSMAIL.CHECK.SERIALIZED.VERSION 8609 . 8922) (\NSMAIL.READ.SERIALIZED.CONTENT 8924 . 9818) (
+\NSMAIL.DISCARD.SERIALIZED.CONTENT 9820 . 10267) (\NSMAIL.READ.STRING.AS.STREAM 10269 . 10819)) (10853
+ 12473 (\NSMAIL.COURIER.OPEN 10863 . 11285) (\NSMAIL.ERRORHANDLER 11287 . 11709) (\NSMAIL.SIGNAL.ERROR
+ 11711 . 12471)) (12673 18875 (\MAILOBJ.CREATE 12683 . 14908) (\MAILOBJ.TYPE.NAME 14910 . 15377) (
+\MAILOBJ.NS.TO.LISP.NAME 15379 . 16730) (\MAILOBJ.DISPLAY 16732 . 17052) (\MAILOBJ.GET 17054 . 17877) 
+(\MAILOBJ.IMAGEBOX 17879 . 18007) (\MAILOBJ.PUT 18009 . 18595) (\MAILOBJ.INIT 18597 . 18873)) (18876 
+33772 (\MAILOBJ.BUTTONEVENTFN 18886 . 21015) (\MAILOBJ.DO.COMMAND 21017 . 21264) (\MAILOBJ.HARDCOPY 
+21266 . 23072) (\MAILOBJ.FB 23074 . 23288) (\MAILOBJ.PUT.FILE 23290 . 24955) (\MAILOBJ.VIEW 24957 . 
+27894) (\MAILOBJ.MUNGE.NAME 27896 . 28160) (\MAILOBJ.COPY.BODY 28162 . 28476) (\MAILOBJ.EXPAND 28478
+ . 30199) (\MAILOBJ.COPY.CHILD 30201 . 31558) (\MAILOBJ.COPY.SEQUENCE 31560 . 31928) (
+\MAILOBJ.EXTRACT.TEXT 31930 . 32991) (\MAILOBJ.PARSE.ATTRIBUTES 32993 . 33770)) (35145 35782 (
+\NSMAIL.WRITE.ATTRIBUTE 35155 . 35780)) (36322 43205 (\NSMAIL.PARSE.REFERENCE 36332 . 38250) (
+\NSMAIL.EXPAND.DL 38252 . 39319) (\NSMAIL.PARSE 39321 . 39582) (\NSMAIL.PARSE1 39584 . 40792) (
+NS.REMOVEDUPLICATES 40794 . 40932) (\NSMAIL.GUESS.FILE.TYPE 40934 . 41435) (
+COURIER.WRITE.STREAM.UNSPECIFIED 41437 . 42581) (\NSMAIL.SEND.STREAM.AS.STRING 42583 . 43203)) (44526 
+48903 (\NSMAIL.MESSAGE.P 44536 . 44674) (\NSMAIL.MESSAGE.FROM.SELF.P 44676 . 46375) (
+\NSMAIL.MAKEANSWERFORM 46377 . 48001) (\NSMAIL.PRINT.NAMES 48003 . 48901)))))
 STOP
diff --git a/library/lafite/LAFITE-NSMAIL.LCOM b/library/lafite/LAFITE-NSMAIL.LCOM
new file mode 100644
index 00000000..3c9fecbc
Binary files /dev/null and b/library/lafite/LAFITE-NSMAIL.LCOM differ
diff --git a/library/lafite/LAFITE-NSMAIL.TEDIT b/library/lafite/LAFITE-NSMAIL.TEDIT
new file mode 100644
index 00000000..311aabbd
Binary files /dev/null and b/library/lafite/LAFITE-NSMAIL.TEDIT differ
diff --git a/library/lafite/LAFITEPRIVATEDL b/library/lafite/LAFITE-PRIVATEDL
similarity index 100%
rename from library/lafite/LAFITEPRIVATEDL
rename to library/lafite/LAFITE-PRIVATEDL
diff --git a/library/lafite/LAFITESEND b/library/lafite/LAFITE-SEND
similarity index 97%
rename from library/lafite/LAFITESEND
rename to library/lafite/LAFITE-SEND
index b2fcb0ec..79ddadce 100644
--- a/library/lafite/LAFITESEND
+++ b/library/lafite/LAFITE-SEND
@@ -1,20 +1,17 @@
 (DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
 
-(FILECREATED "16-Oct-2022 10:02:19" {DSK}<Users>briggs>projects>medley>library>lafite>LAFITESEND.;2 100794 
+(FILECREATED "23-Feb-2024 22:24:01" {WMEDLEY}<library>lafite>LAFITE-SEND.;2 100561 
 
-      :CHANGES-TO (FNS \SENDMESSAGE.RESTARTABLE)
+      :EDIT-BY rmk
 
-      :PREVIOUS-DATE " 7-Feb-2022 12:04:09" 
-{DSK}<Users>briggs>projects>medley>library>lafite>LAFITESEND.;1)
+      :CHANGES-TO (VARS LAFITE-SENDCOMS)
+
+      :PREVIOUS-DATE "23-Feb-2024 22:03:43" {WMEDLEY}<library>lafite>LAFITE-SEND.;1)
 
 
-(* ; "
-Copyright (c) 1984-1990, 1993, 1999-2000, 2021-2022 by Xerox Corporation.
-")
+(PRETTYCOMPRINT LAFITE-SENDCOMS)
 
-(PRETTYCOMPRINT LAFITESENDCOMS)
-
-(RPAQQ LAFITESENDCOMS
+(RPAQQ LAFITE-SENDCOMS
        ((COMS                                                (* ; "Sending mail")
               (FNS DOLAFITESENDINGCOMMAND \SENDMESSAGE.INITIATE \SENDMSG.DELIVER \SENDMSG.EXIT.TEDIT
                    \SENDMSG.SAVE.FORM \LAFITE.HEADER.EOF \LAFITE.INSERT.REPLYTO \SENDMSG.REPLYTO 
@@ -82,7 +79,7 @@ Copyright (c) 1984-1990, 1993, 1999-2000, 2021-2022 by Xerox Corporation.
                       RECIPIENTSSTR SUBJECTSTR LAFITE.MSG.ICON LAFITEFORMDIRECTORIES 
                       LAFITE.SEND.FORMATTED)
                (FILES (SOURCE)
-                      LAFITEDECLS)
+                      LAFITE-DECLS)
                (LOCALVARS . T))))
 
 
@@ -1756,39 +1753,37 @@ cc: ~A
 
 
 (FILESLOAD (SOURCE)
-       LAFITEDECLS)
+       LAFITE-DECLS)
 
 (DECLARE%: DOEVAL@COMPILE DONTCOPY
 
 (LOCALVARS . T)
 )
 )
-(PUTPROPS LAFITESEND COPYRIGHT ("Xerox Corporation" 1984 1985 1986 1987 1988 1989 1990 1993 1999 2000 
-2021 2022))
 (DECLARE%: DONTCOPY
-  (FILEMAP (NIL (5333 28310 (DOLAFITESENDINGCOMMAND 5343 . 5833) (\SENDMESSAGE.INITIATE 5835 . 7774) (
-\SENDMSG.DELIVER 7776 . 8384) (\SENDMSG.EXIT.TEDIT 8386 . 8757) (\SENDMSG.SAVE.FORM 8759 . 10746) (
-\LAFITE.HEADER.EOF 10748 . 11041) (\LAFITE.INSERT.REPLYTO 11043 . 11651) (\SENDMSG.REPLYTO 11653 . 
-12212) (\SENDMSG.CHANGE.MODE 12214 . 17790) (\SENDMSG.FIND.FIELD 17792 . 18302) (\SENDMESSAGE.PARSE 
-18304 . 19100) (\LAFITE.PREPARE.SEND 19102 . 21935) (\LAFITE.PREPARE.ERROR 21937 . 23119) (
-\LAFITE.CHOOSE.MSG.FORMAT 23121 . 25762) (LAFITE.MAKE.PLAIN.TEXTSTREAM 25764 . 26689) (
-\SENDMESSAGE.MENUPROMPT 26691 . 27554) (\SENDMESSAGE.PROMPT 27556 . 28092) (\SENDMESSAGEFAIL 28094 . 
-28308)) (28311 52973 (\SENDMESSAGE 28321 . 29673) (\SENDMESSAGE.RESTARTABLE 29675 . 34876) (
-\SENDMESSAGE.CLEANUP 34878 . 35094) (\SENDMESSAGE.MAKEWINDOW 35096 . 41269) (MAKELAFITEDELIVERMENU 
-41271 . 41578) (\LAFITE.CLOSEMSG? 41580 . 42530) (\LAFITE.AFTER.DELIVER 42532 . 45851) (
-\LAFITE.UNSENT.ICON 45853 . 46163) (\LAFITE.FETCH.SUBJECT 46165 . 46965) (LAFITE.SENDMESSAGE 46967 . 
-47860) (\SENDMESSAGE0 47862 . 50726) (LA.ASSURE.PROMPT.WINDOW 50728 . 51625) (\LAFITE.SEND.FAIL 51627
- . 52098) (\LAFITE.INVALID.RECIPIENTS 52100 . 52558) (\SENDMESSAGE.ABORT 52560 . 52971)) (53005 62918 
-(\OUTBOX.CREATE 53015 . 54478) (\OUTBOX.RESET 54480 . 54973) (\OUTBOX.CLOSEFN 54975 . 55115) (
-\OUTBOX.REPAINTFN 55117 . 55780) (\OUTBOX.RESHAPEFN 55782 . 57065) (\OUTBOX.SHADEITEM 57067 . 57740) (
-\OUTBOX.BUTTONFN 57742 . 60590) (\OUTBOX.DISPLAYLINE 60592 . 61086) (\OUTBOX.ADD.ITEM 61088 . 62916)) 
-(63214 79622 (\LAFITE.MESSAGEFORM 63224 . 67567) (MAKELAFITESUPPORTFORM 67569 . 67758) (
-MAKELISPSUPPORTFORM 67760 . 67926) (MAKEXXXSUPPORTFORM 67928 . 71977) (MAKENEWMESSAGEFORM 71979 . 
-72935) (MAKELAFITEPRIVATEFORMSITEMS 72937 . 73365) (\LAFITE.UNCACHE.MESSAGEFORM 73367 . 73820) (
-\LAFITE.DELETE.MESSAGEFORM 73822 . 74423) (\LAFITE.SELECT.FORM 74425 . 74780) (
-\LAFITE.DELETE.FORM.INTERNAL 74782 . 75926) (\LAFITE.READ.FORM 75928 . 78665) (\LAFITE.FIND.TEMPLATE 
-78667 . 79620)) (79646 87377 (\LAFITE.ANSWER 79656 . 80061) (\LAFITE.ANSWER.PROC 80063 . 81957) (
-MAKEANSWERFORM 81959 . 84489) (LA.PRINT.COMMA.LIST 84491 . 84977) (LAFITE.FILL.IN.ANSWER.FORM 84979 . 
-87375)) (87402 93598 (\LAFITE.FORWARD 87412 . 87820) (\LAFITE.FORWARD.PROC 87822 . 89811) (
-MAKEFORWARDFORM 89813 . 93596)))))
+  (FILEMAP (NIL (5214 28191 (DOLAFITESENDINGCOMMAND 5224 . 5714) (\SENDMESSAGE.INITIATE 5716 . 7655) (
+\SENDMSG.DELIVER 7657 . 8265) (\SENDMSG.EXIT.TEDIT 8267 . 8638) (\SENDMSG.SAVE.FORM 8640 . 10627) (
+\LAFITE.HEADER.EOF 10629 . 10922) (\LAFITE.INSERT.REPLYTO 10924 . 11532) (\SENDMSG.REPLYTO 11534 . 
+12093) (\SENDMSG.CHANGE.MODE 12095 . 17671) (\SENDMSG.FIND.FIELD 17673 . 18183) (\SENDMESSAGE.PARSE 
+18185 . 18981) (\LAFITE.PREPARE.SEND 18983 . 21816) (\LAFITE.PREPARE.ERROR 21818 . 23000) (
+\LAFITE.CHOOSE.MSG.FORMAT 23002 . 25643) (LAFITE.MAKE.PLAIN.TEXTSTREAM 25645 . 26570) (
+\SENDMESSAGE.MENUPROMPT 26572 . 27435) (\SENDMESSAGE.PROMPT 27437 . 27973) (\SENDMESSAGEFAIL 27975 . 
+28189)) (28192 52854 (\SENDMESSAGE 28202 . 29554) (\SENDMESSAGE.RESTARTABLE 29556 . 34757) (
+\SENDMESSAGE.CLEANUP 34759 . 34975) (\SENDMESSAGE.MAKEWINDOW 34977 . 41150) (MAKELAFITEDELIVERMENU 
+41152 . 41459) (\LAFITE.CLOSEMSG? 41461 . 42411) (\LAFITE.AFTER.DELIVER 42413 . 45732) (
+\LAFITE.UNSENT.ICON 45734 . 46044) (\LAFITE.FETCH.SUBJECT 46046 . 46846) (LAFITE.SENDMESSAGE 46848 . 
+47741) (\SENDMESSAGE0 47743 . 50607) (LA.ASSURE.PROMPT.WINDOW 50609 . 51506) (\LAFITE.SEND.FAIL 51508
+ . 51979) (\LAFITE.INVALID.RECIPIENTS 51981 . 52439) (\SENDMESSAGE.ABORT 52441 . 52852)) (52886 62799 
+(\OUTBOX.CREATE 52896 . 54359) (\OUTBOX.RESET 54361 . 54854) (\OUTBOX.CLOSEFN 54856 . 54996) (
+\OUTBOX.REPAINTFN 54998 . 55661) (\OUTBOX.RESHAPEFN 55663 . 56946) (\OUTBOX.SHADEITEM 56948 . 57621) (
+\OUTBOX.BUTTONFN 57623 . 60471) (\OUTBOX.DISPLAYLINE 60473 . 60967) (\OUTBOX.ADD.ITEM 60969 . 62797)) 
+(63095 79503 (\LAFITE.MESSAGEFORM 63105 . 67448) (MAKELAFITESUPPORTFORM 67450 . 67639) (
+MAKELISPSUPPORTFORM 67641 . 67807) (MAKEXXXSUPPORTFORM 67809 . 71858) (MAKENEWMESSAGEFORM 71860 . 
+72816) (MAKELAFITEPRIVATEFORMSITEMS 72818 . 73246) (\LAFITE.UNCACHE.MESSAGEFORM 73248 . 73701) (
+\LAFITE.DELETE.MESSAGEFORM 73703 . 74304) (\LAFITE.SELECT.FORM 74306 . 74661) (
+\LAFITE.DELETE.FORM.INTERNAL 74663 . 75807) (\LAFITE.READ.FORM 75809 . 78546) (\LAFITE.FIND.TEMPLATE 
+78548 . 79501)) (79527 87258 (\LAFITE.ANSWER 79537 . 79942) (\LAFITE.ANSWER.PROC 79944 . 81838) (
+MAKEANSWERFORM 81840 . 84370) (LA.PRINT.COMMA.LIST 84372 . 84858) (LAFITE.FILL.IN.ANSWER.FORM 84860 . 
+87256)) (87283 93479 (\LAFITE.FORWARD 87293 . 87701) (\LAFITE.FORWARD.PROC 87703 . 89692) (
+MAKEFORWARDFORM 89694 . 93477)))))
 STOP
diff --git a/library/lafite/LAFITESEND.LCOM b/library/lafite/LAFITE-SEND.LCOM
similarity index 70%
rename from library/lafite/LAFITESEND.LCOM
rename to library/lafite/LAFITE-SEND.LCOM
index 0f96e604..6ca56388 100644
Binary files a/library/lafite/LAFITESEND.LCOM and b/library/lafite/LAFITE-SEND.LCOM differ
diff --git a/library/lafite/LAFITESORT b/library/lafite/LAFITE-SORT
similarity index 93%
rename from library/lafite/LAFITESORT
rename to library/lafite/LAFITE-SORT
index 595f7411..08a9c8e8 100644
--- a/library/lafite/LAFITESORT
+++ b/library/lafite/LAFITE-SORT
@@ -1,20 +1,19 @@
 (DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
-(FILECREATED "30-Sep-2021 22:58:58" 
-{DSK}<USERS>KAPLAN>LOCAL>MEDLEY3.5>GIT-MEDLEY>LIBRARY>LAFITE>LAFITESORT.;1 19675  
 
-      previous date%: " 7-Feb-95 13:10:22" 
-{DSK}<USERS>KAPLAN>LOCAL>MEDLEY3.5>GIT-MEDLEY>LIBRARY>LAFITE>LAFITESORT.;1)
+(FILECREATED "23-Feb-2024 22:24:01" {WMEDLEY}<library>lafite>LAFITE-SORT.;2 19458  
+
+      :EDIT-BY rmk
+
+      :CHANGES-TO (VARS LAFITE-SORTCOMS)
+
+      :PREVIOUS-DATE "23-Feb-2024 22:07:18" {WMEDLEY}<library>lafite>LAFITE-SORT.;1)
 
 
-(* ; "
-Copyright (c) 1989, 1995, 2021 by Xerox Corporation.
-")
+(PRETTYCOMPRINT LAFITE-SORTCOMS)
 
-(PRETTYCOMPRINT LAFITESORTCOMS)
-
-(RPAQQ LAFITESORTCOMS
+(RPAQQ LAFITE-SORTCOMS
        [(DECLARE%: EVAL@COMPILE DONTCOPY (FILES (SOURCE)
-                                                LAFITEDECLS))
+                                                LAFITE-DECLS))
         (FNS LAFITE.ASSURE.DATE.FIELDS LAFITE.PARSE.DATE.FIELD LAFITE.PARSE.DATE.FIELD.ONLY 
              LAFITE.SORT.BY.DATE LAFITE.SORT.MESSAGES LAFITEMSG.DATE.ORDER 
              \LAFITE.SORT.BY.DATE.INTERACTIVE \LAFITE.SORT.BY.DATE.REGION)
@@ -35,7 +34,7 @@ Copyright (c) 1989, 1995, 2021 by Xerox Corporation.
 (DECLARE%: EVAL@COMPILE DONTCOPY 
 
 (FILESLOAD (SOURCE)
-       LAFITEDECLS)
+       LAFITE-DECLS)
 )
 (DEFINEQ
 
@@ -229,14 +228,13 @@ Copyright (c) 1989, 1995, 2021 by Xerox Corporation.
 
 (APPENDTOVAR LAFITEEXTRAMENUITEMS ("Sort by Date" '\LAFITE.SORT.BY.DATE.INTERACTIVE 
                                         "Sort all the messages in this folder by their Date: fields."
-                                             (SUBITEMS ("Sort Entire Folder" 
-                                                              '\LAFITE.SORT.BY.DATE.INTERACTIVE 
+                                         (SUBITEMS ("Sort Entire Folder" 
+                                                          '\LAFITE.SORT.BY.DATE.INTERACTIVE 
                                         "Sort all the messages in this folder by their Date: fields."
-                                                              )
-                                                    ("Sort Selected Range" 
-                                                           '\LAFITE.SORT.BY.DATE.REGION 
+                                                          )
+                                                ("Sort Selected Range" '\LAFITE.SORT.BY.DATE.REGION 
                                "Sort only the messages between the first and last selected messages."
-                                                           ))))
+                                                       ))))
 
 
 
@@ -325,10 +323,9 @@ Copyright (c) 1989, 1995, 2021 by Xerox Corporation.
 (GLOBALVARS \TimeZoneComp \DayLightSavings)
 )
 )
-(PUTPROPS LAFITESORT COPYRIGHT ("Xerox Corporation" 1989 1995 2021))
 (DECLARE%: DONTCOPY
-  (FILEMAP (NIL (2020 14676 (LAFITE.ASSURE.DATE.FIELDS 2030 . 8127) (LAFITE.PARSE.DATE.FIELD 8129 . 8766
-) (LAFITE.PARSE.DATE.FIELD.ONLY 8768 . 8983) (LAFITE.SORT.BY.DATE 8985 . 9345) (LAFITE.SORT.MESSAGES 
-9347 . 12737) (LAFITEMSG.DATE.ORDER 12739 . 13487) (\LAFITE.SORT.BY.DATE.INTERACTIVE 13489 . 14133) (
-\LAFITE.SORT.BY.DATE.REGION 14135 . 14674)) (15566 19381 (GDATE1-6 15576 . 19379)))))
+  (FILEMAP (NIL (1952 14608 (LAFITE.ASSURE.DATE.FIELDS 1962 . 8059) (LAFITE.PARSE.DATE.FIELD 8061 . 8698
+) (LAFITE.PARSE.DATE.FIELD.ONLY 8700 . 8915) (LAFITE.SORT.BY.DATE 8917 . 9277) (LAFITE.SORT.MESSAGES 
+9279 . 12669) (LAFITEMSG.DATE.ORDER 12671 . 13419) (\LAFITE.SORT.BY.DATE.INTERACTIVE 13421 . 14065) (
+\LAFITE.SORT.BY.DATE.REGION 14067 . 14606)) (15418 19233 (GDATE1-6 15428 . 19231)))))
 STOP
diff --git a/library/lafite/LAFITESORT.LCOM b/library/lafite/LAFITE-SORT.LCOM
similarity index 51%
rename from library/lafite/LAFITESORT.LCOM
rename to library/lafite/LAFITE-SORT.LCOM
index f2ac6bd9..17c33912 100644
Binary files a/library/lafite/LAFITESORT.LCOM and b/library/lafite/LAFITE-SORT.LCOM differ
diff --git a/library/lafite/LAFITETEDIT b/library/lafite/LAFITE-TEDIT
similarity index 85%
rename from library/lafite/LAFITETEDIT
rename to library/lafite/LAFITE-TEDIT
index 4c61eb75..e1f4192f 100644
--- a/library/lafite/LAFITETEDIT
+++ b/library/lafite/LAFITE-TEDIT
@@ -1,26 +1,25 @@
 (DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
 
-(FILECREATED "18-Jan-2024 10:34:16" {WMEDLEY}<library>lafite>LAFITETEDIT.;33 6622   
+(FILECREATED "23-Feb-2024 22:24:01" {WMEDLEY}<library>lafite>LAFITE-TEDIT.;2 6592   
 
       :EDIT-BY rmk
 
-      :CHANGES-TO (FILES LAFITEDECLS)
-                  (FNS LA.ADJUST.FORMATTING)
+      :CHANGES-TO (VARS LAFITE-TEDITCOMS)
 
-      :PREVIOUS-DATE "14-Jan-2024 12:56:19" {WMEDLEY}<library>lafite>LAFITETEDIT.;32)
+      :PREVIOUS-DATE "23-Feb-2024 22:09:24" {WMEDLEY}<library>lafite>LAFITE-TEDIT.;1)
 
 
-(PRETTYCOMPRINT LAFITETEDITCOMS)
+(PRETTYCOMPRINT LAFITE-TEDITCOMS)
 
-(RPAQQ LAFITETEDITCOMS (
-                        (* ;; "Lafite's more explicit dependencies on %"internals%" of TEDIT")
+(RPAQQ LAFITE-TEDITCOMS (
+                         (* ;; "Lafite's more explicit dependencies on %"internals%" of TEDIT")
 
-                        (FNS LA.ADJUST.FORMATTING LA.DETACH.TEDIT TEDIT.ASSURE.NO.BACKING.FILE 
-                             LA.WINDOW.FROM.TEXTSTREAM)
-                        (DECLARE%: EVAL@COMPILE DONTCOPY (FILES (SOURCE)
-                                                                LAFITEDECLS)
-                               (GLOBALVARS *TEDIT-FILE-READTABLE*)
-                               (LOCALVARS . T))))
+                         (FNS LA.ADJUST.FORMATTING LA.DETACH.TEDIT TEDIT.ASSURE.NO.BACKING.FILE 
+                              LA.WINDOW.FROM.TEXTSTREAM)
+                         (DECLARE%: EVAL@COMPILE DONTCOPY (FILES (SOURCE)
+                                                                 LAFITE-DECLS)
+                                (GLOBALVARS *TEDIT-FILE-READTABLE*)
+                                (LOCALVARS . T))))
 
 
 
@@ -106,7 +105,7 @@
 (DECLARE%: EVAL@COMPILE DONTCOPY 
 
 (FILESLOAD (SOURCE)
-       LAFITEDECLS)
+       LAFITE-DECLS)
 
 (DECLARE%: DOEVAL@COMPILE DONTCOPY
 
@@ -119,6 +118,6 @@
 )
 )
 (DECLARE%: DONTCOPY
-  (FILEMAP (NIL (1018 6392 (LA.ADJUST.FORMATTING 1028 . 4074) (LA.DETACH.TEDIT 4076 . 4442) (
-TEDIT.ASSURE.NO.BACKING.FILE 4444 . 6110) (LA.WINDOW.FROM.TEXTSTREAM 6112 . 6390)))))
+  (FILEMAP (NIL (987 6361 (LA.ADJUST.FORMATTING 997 . 4043) (LA.DETACH.TEDIT 4045 . 4411) (
+TEDIT.ASSURE.NO.BACKING.FILE 4413 . 6079) (LA.WINDOW.FROM.TEXTSTREAM 6081 . 6359)))))
 STOP
diff --git a/library/lafite/LAFITETEDIT.LCOM b/library/lafite/LAFITE-TEDIT.LCOM
similarity index 60%
rename from library/lafite/LAFITETEDIT.LCOM
rename to library/lafite/LAFITE-TEDIT.LCOM
index 8f738ad3..2d7599ec 100644
Binary files a/library/lafite/LAFITETEDIT.LCOM and b/library/lafite/LAFITE-TEDIT.LCOM differ
diff --git a/library/lafite/LAFITETIMEDDELETE b/library/lafite/LAFITE-TIMEDDELETE
similarity index 89%
rename from library/lafite/LAFITETIMEDDELETE
rename to library/lafite/LAFITE-TIMEDDELETE
index 7b557f7c..154e3cca 100644
--- a/library/lafite/LAFITETIMEDDELETE
+++ b/library/lafite/LAFITE-TIMEDDELETE
@@ -1,20 +1,19 @@
-(DEFINE-FILE-INFO READTABLE "INTERLISP" PACKAGE "INTERLISP")
-(FILECREATED "28-Jun-89 08:53:23" {POOH/N}<POOH>MAXWELL>LISP>LAFITETIMEDDELETE;1 11153  
+(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
 
-      changes to%:  (FNS \LAFITE.DELETEEXPIRED MESSAGEAGE)
+(FILECREATED "27-Feb-2024 09:28:24" {WMEDLEY}<library>lafite>LAFITE-TIMEDDELETE.;3 10989  
 
-      previous date%: "13-Oct-88 11:05:53" {PHYLUM}<LISPUSERS>MEDLEY>LAFITETIMEDDELETE.;1)
+      :EDIT-BY rmk
+
+      :CHANGES-TO (VARS LAFITE-TIMEDDELETECOMS)
+
+      :PREVIOUS-DATE "23-Feb-2024 23:23:25" {WMEDLEY}<library>lafite>LAFITE-TIMEDDELETE.;2)
 
 
-(* "
-Copyright (c) 1987, 1988, 1989 by Xerox Corporation.  All rights reserved.
-")
+(PRETTYCOMPRINT LAFITE-TIMEDDELETECOMS)
 
-(PRETTYCOMPRINT LAFITETIMEDDELETECOMS)
-
-(RPAQQ LAFITETIMEDDELETECOMS
-       ((DECLARE%: DONTCOPY EVAL@COMPILE (FILES LAFITEDECLS))
-        (FILES LAFITEFIND)
+(RPAQQ LAFITE-TIMEDDELETECOMS
+       ((DECLARE%: DONTCOPY EVAL@COMPILE (FILES LAFITE-DECLS))
+        (FILES LAFITE-FIND)
         (FNS \LAFITE.TIMEDDELETE \LAFITE.SETEXPIRATIONS \LAFITE.DELETEEXPIRED)
         (FNS LTD.INIT MESSAGEAGE)
         (INITVARS EXPIRATIONMENU)
@@ -23,10 +22,10 @@ Copyright (c) 1987, 1988, 1989 by Xerox Corporation.  All rights reserved.
         (P (LTD.INIT))))
 (DECLARE%: DONTCOPY EVAL@COMPILE 
 
-(FILESLOAD LAFITEDECLS)
+(FILESLOAD LAFITE-DECLS)
 )
 
-(FILESLOAD LAFITEFIND)
+(FILESLOAD LAFITE-FIND)
 (DEFINEQ
 
 (\LAFITE.TIMEDDELETE
@@ -207,22 +206,21 @@ Copyright (c) 1987, 1988, 1989 by Xerox Corporation.  All rights reserved.
         ("forever" 0)))
 
 (RPAQQ MARKDURATIONS ((1 1)
-                          (2 2)
-                          (3 4)
-                          (4 7)
-                          (5 14)
-                          (6 30)
-                          (7 61)
-                          (8 122)
-                          (9 244)))
+                      (2 2)
+                      (3 4)
+                      (4 7)
+                      (5 14)
+                      (6 30)
+                      (7 61)
+                      (8 122)
+                      (9 244)))
 (DECLARE%: DOEVAL@COMPILE DONTCOPY
 
 (GLOBALVARS EXPIRATIONMENU EXPIRATIONMENUITEMS MARKDURATIONS)
 )
 
 (LTD.INIT)
-(PUTPROPS LAFITETIMEDDELETE COPYRIGHT ("Xerox Corporation" 1987 1988 1989))
 (DECLARE%: DONTCOPY
-  (FILEMAP (NIL (934 8084 (\LAFITE.TIMEDDELETE 944 . 1218) (\LAFITE.SETEXPIRATIONS 1220 . 5600) (
-\LAFITE.DELETEEXPIRED 5602 . 8082)) (8085 10316 (LTD.INIT 8095 . 8984) (MESSAGEAGE 8986 . 10314)))))
+  (FILEMAP (NIL (878 8028 (\LAFITE.TIMEDDELETE 888 . 1162) (\LAFITE.SETEXPIRATIONS 1164 . 5544) (
+\LAFITE.DELETEEXPIRED 5546 . 8026)) (8029 10260 (LTD.INIT 8039 . 8928) (MESSAGEAGE 8930 . 10258)))))
 STOP
diff --git a/library/lafite/LAFITE-TIMEDDELETE.LCOM b/library/lafite/LAFITE-TIMEDDELETE.LCOM
new file mode 100644
index 00000000..c8f15358
Binary files /dev/null and b/library/lafite/LAFITE-TIMEDDELETE.LCOM differ
diff --git a/library/lafite/LAFITETIMEDDELETE.TEDIT b/library/lafite/LAFITE-TIMEDDELETE.TEDIT
similarity index 100%
rename from library/lafite/LAFITETIMEDDELETE.TEDIT
rename to library/lafite/LAFITE-TIMEDDELETE.TEDIT
diff --git a/library/lafite/UNIXMAIL b/library/lafite/LAFITE-UNIXMAIL
similarity index 97%
rename from library/lafite/UNIXMAIL
rename to library/lafite/LAFITE-UNIXMAIL
index 87e92570..9743c84d 100644
--- a/library/lafite/UNIXMAIL
+++ b/library/lafite/LAFITE-UNIXMAIL
@@ -1,27 +1,22 @@
 (DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "XCL" BASE 10)
 
-(FILECREATED "24-Feb-2024 10:26:07" |{DSK}<home>larry>il>medley>library>lafite>UNIXMAIL.;3| 81776  
+(FILECREATED "24-Feb-2024 11:57:21" |{WMEDLEY}<library>lafite>LAFITE-UNIXMAIL.;4| 81665  
 
-      :EDIT-BY "lmm"
+      :EDIT-BY |rmk|
 
-      :CHANGES-TO (VARS UNIXMAILCOMS)
+      :CHANGES-TO (VARS LAFITE-UNIXMAILCOMS)
 
-      :PREVIOUS-DATE "30-Sep-2021 16:06:26" |{DSK}<home>larry>il>medley>library>lafite>UNIXMAIL.;1|
-)
+      :PREVIOUS-DATE "24-Feb-2024 11:35:24" |{WMEDLEY}<library>lafite>LAFITE-UNIXMAIL.;3|)
 
 
-; Copyright (c) 1989-1992, 1997, 1999, 1920, 2021 by ENVOS Corporation.
+(PRETTYCOMPRINT LAFITE-UNIXMAILCOMS)
 
-(PRETTYCOMPRINT UNIXMAILCOMS)
-
-(RPAQQ UNIXMAILCOMS
-       (
-        (* |;;| " LMM 2/24/24 need LAFITE to load")
-
-        (FILES LAFITE)
-        (DECLARE\: DOEVAL@COMPILE DONTCOPY (FILES (SOURCE)
-                                                  LAFITEDECLS NSMAIL)
+(RPAQQ LAFITE-UNIXMAILCOMS
+       ((DECLARE\: DOEVAL@COMPILE DONTCOPY (FILES (SOURCE)
+                                                  LAFITE-DECLS LAFITE-NSMAIL)
                (RECORDS UNIXMAILBOX UNIXMAILFILEINFO UNIXMAILPARSE))
+        (DECLARE\: DONTEVAL@LOAD DOCOPY (FILES (SYSLOAD)
+                                               LAFITE))
         (ALISTS (LAFITEMODELST UNIX))
         
         (* |;;| "JDS 4/6/97:  CHANGE TRANSMIT SMTP INTERACTION TO put <> around mail-from name, which SMTP seems to require.")
@@ -86,18 +81,11 @@
                                                          (CDR LAFITESENDINGMENUITEMS))
                                                    '(CHANGE \\SENDMSG.CHANGE.MODE TO 
                                                            \\UNIXMAIL.CHANGE.MODE)))))
-        (PROP FILETYPE UNIXMAIL)))
-
-
-
-(* |;;| " LMM 2/24/24 need LAFITE to load")
-
-
-(FILESLOAD LAFITE)
+        (PROP FILETYPE LAFITE-UNIXMAIL)))
 (DECLARE\: DOEVAL@COMPILE DONTCOPY 
 
 (FILESLOAD (SOURCE)
-       LAFITEDECLS NSMAIL)
+       LAFITE-DECLS LAFITE-NSMAIL)
 
 (DECLARE\: EVAL@COMPILE
 
@@ -108,6 +96,11 @@
 (RECORD UNIXMAILPARSE (UNIXMAILSUBJECT UNIXFROM UNIXTO UNIXOTHER FORMATTED? UNIXBODY))
 )
 )
+(DECLARE\: DONTEVAL@LOAD DOCOPY 
+
+(FILESLOAD (SYSLOAD)
+       LAFITE)
+)
 
 (ADDTOVAR LAFITEMODELST (UNIX 3 \\UNIXMAIL.SEND.PARSE \\UNIXMAIL.SEND \\UNIXMAIL.MAKEANSWERFORM 
                               \\UNIXMAIL.AUTHENTICATE \\UNIXMAIL.MESSAGE.P 
@@ -1370,20 +1363,19 @@
                                               (CDR LAFITESENDINGMENUITEMS))
                                         '(CHANGE \\SENDMSG.CHANGE.MODE TO \\UNIXMAIL.CHANGE.MODE))))
 
-(PUTPROPS UNIXMAIL FILETYPE :COMPILE-FILE)
-(PUTPROPS UNIXMAIL COPYRIGHT ("ENVOS Corporation" 1989 1990 1991 1992 1997 1999 1920 2021))
+(PUTPROPS LAFITE-UNIXMAIL FILETYPE :COMPILE-FILE)
 (DECLARE\: DONTCOPY
-  (FILEMAP (NIL (7090 25515 (UNIX.POLLNEWMAIL 7100 . 9050) (UNIX.NEXTMESSAGE 9052 . 9228) (
-UNIXMAILER.OPENMAILBOX 9230 . 13626) (UNIXMAILER.RETRIEVEMESSAGE 13628 . 14835) (
-UNIXMAILER.CLOSEMAILBOX 14837 . 15862) (UNIXSPOOL.OPENMAILBOX 15864 . 22081) (
-UNIXSPOOL.RETRIEVEMESSAGE 22083 . 24164) (UNIXSPOOL.CLOSEMAILBOX 24166 . 25513)) (25563 56053 (
-UNIX.FLUSH.STREAM 25573 . 26154) (UNIX.RETRIEVE.LINE 26156 . 27345) (\\UNIXMAIL.SEND 27347 . 37641) (
-\\UNIXMAIL.SEND.WRAPLINES 37643 . 41273) (\\SMTP-DUMP 41275 . 42545) (\\UNIXMAIL.SEND.PARSE 42547 . 
-45791) (\\UNIXMAIL.CHECK.ABORT 45793 . 46621) (\\UNIXMAIL.MUNG.RECIPIENTS 46623 . 51491) (
-\\UNIXMAIL.SMTP 51493 . 52098) (\\UNIXMAIL.SMTP.FLUSH 52100 . 54577) (\\UNIXMAIL.CHANGE.MODE 54579 . 
-56051)) (56141 59147 (\\UNIXMAIL.SMTP.TCP.STREAMS 56141 . 59147)) (59226 80798 (
-\\UNIXMAIL.AUTHENTICATE 59236 . 60927) (\\UNIXMAIL.LOGIN 60929 . 61274) (\\UNIXMAIL.PARSENAMES 61276
- . 63594) (\\UNIXMAIL.MAKEANSWERFORM 63596 . 68478) (\\UNIXMAIL.MESSAGE.FROM.SELF.P 68480 . 69609) (
-\\UNIXMAIL.MESSAGE.P 69611 . 69930) (\\UNIXMAIL.REALADDRESS 69932 . 73976) (\\UNIXMAIL.FQNAME 73978 . 
-74583) (\\UNIXMAIL.FIXMICROSOFT 74585 . 80796)))))
+  (FILEMAP (NIL (7064 25489 (UNIX.POLLNEWMAIL 7074 . 9024) (UNIX.NEXTMESSAGE 9026 . 9202) (
+UNIXMAILER.OPENMAILBOX 9204 . 13600) (UNIXMAILER.RETRIEVEMESSAGE 13602 . 14809) (
+UNIXMAILER.CLOSEMAILBOX 14811 . 15836) (UNIXSPOOL.OPENMAILBOX 15838 . 22055) (
+UNIXSPOOL.RETRIEVEMESSAGE 22057 . 24138) (UNIXSPOOL.CLOSEMAILBOX 24140 . 25487)) (25537 56027 (
+UNIX.FLUSH.STREAM 25547 . 26128) (UNIX.RETRIEVE.LINE 26130 . 27319) (\\UNIXMAIL.SEND 27321 . 37615) (
+\\UNIXMAIL.SEND.WRAPLINES 37617 . 41247) (\\SMTP-DUMP 41249 . 42519) (\\UNIXMAIL.SEND.PARSE 42521 . 
+45765) (\\UNIXMAIL.CHECK.ABORT 45767 . 46595) (\\UNIXMAIL.MUNG.RECIPIENTS 46597 . 51465) (
+\\UNIXMAIL.SMTP 51467 . 52072) (\\UNIXMAIL.SMTP.FLUSH 52074 . 54551) (\\UNIXMAIL.CHANGE.MODE 54553 . 
+56025)) (56115 59121 (\\UNIXMAIL.SMTP.TCP.STREAMS 56115 . 59121)) (59200 80772 (
+\\UNIXMAIL.AUTHENTICATE 59210 . 60901) (\\UNIXMAIL.LOGIN 60903 . 61248) (\\UNIXMAIL.PARSENAMES 61250
+ . 63568) (\\UNIXMAIL.MAKEANSWERFORM 63570 . 68452) (\\UNIXMAIL.MESSAGE.FROM.SELF.P 68454 . 69583) (
+\\UNIXMAIL.MESSAGE.P 69585 . 69904) (\\UNIXMAIL.REALADDRESS 69906 . 73950) (\\UNIXMAIL.FQNAME 73952 . 
+74557) (\\UNIXMAIL.FIXMICROSOFT 74559 . 80770)))))
 STOP
diff --git a/library/lafite/LAFITE-UNIXMAIL.DFASL b/library/lafite/LAFITE-UNIXMAIL.DFASL
new file mode 100644
index 00000000..7a5b78a2
Binary files /dev/null and b/library/lafite/LAFITE-UNIXMAIL.DFASL differ
diff --git a/library/lafite/UNIXMAIL.TEDIT b/library/lafite/LAFITE-UNIXMAIL.TEDIT
similarity index 100%
rename from library/lafite/UNIXMAIL.TEDIT
rename to library/lafite/LAFITE-UNIXMAIL.TEDIT
diff --git a/library/lafite/LAFITE.LCOM b/library/lafite/LAFITE.LCOM
index 10fd98ac..bb36a3ea 100644
Binary files a/library/lafite/LAFITE.LCOM and b/library/lafite/LAFITE.LCOM differ
diff --git a/library/lafite/LAFITEFIND.LCOM b/library/lafite/LAFITEFIND.LCOM
deleted file mode 100644
index daddd438..00000000
Binary files a/library/lafite/LAFITEFIND.LCOM and /dev/null differ
diff --git a/library/lafite/LAFITETIMEDDELETE.LCOM b/library/lafite/LAFITETIMEDDELETE.LCOM
deleted file mode 100644
index dcd41dac..00000000
Binary files a/library/lafite/LAFITETIMEDDELETE.LCOM and /dev/null differ
diff --git a/library/lafite/MAILSHARE.LCOM b/library/lafite/MAILSHARE.LCOM
deleted file mode 100644
index 3c39291c..00000000
Binary files a/library/lafite/MAILSHARE.LCOM and /dev/null differ
diff --git a/library/lafite/MIME.LCOM b/library/lafite/MIME.LCOM
deleted file mode 100644
index 8df05d3a..00000000
Binary files a/library/lafite/MIME.LCOM and /dev/null differ
diff --git a/library/lafite/NEWNSMAIL.LCOM b/library/lafite/NEWNSMAIL.LCOM
deleted file mode 100644
index 8f58f68d..00000000
Binary files a/library/lafite/NEWNSMAIL.LCOM and /dev/null differ
diff --git a/library/lafite/NOXNSPATCH b/library/lafite/NOXNSPATCH
deleted file mode 100644
index ea4dbc63..00000000
--- a/library/lafite/NOXNSPATCH
+++ /dev/null
@@ -1 +0,0 @@
-(DEFINE-FILE-INFO READTABLE "INTERLISP" PACKAGE "INTERLISP")
(FILECREATED "31-Mar-99 17:08:40" {DSK}<project>medley3.5>patches>NOXNSPATCH.;6 7381   

      changes to%:  (VARS NOXNSPATCHCOMS)
                    (FNS NOXNSNSMAIL.MAKEANSWERFORM NOXNSNSMAIL.NEW.SEND NOXNSNSMAIL.NEW.SEND.PARSE)

      previous date%: "18-Mar-99 10:40:16" {DSK}<project>medley3.5>patches>NOXNSPATCH.;5)


(* ; "
Copyright (c) 1999 by Xerox Corporation.  All rights reserved.
")

(PRETTYCOMPRINT NOXNSPATCHCOMS)

(RPAQQ NOXNSPATCHCOMS
       [
        (* ;; "Suppress login/clearinghouse/nsmail if not running XNS.  Mail stuff is necessary in order to parse old NS messages in existing folders.  User should set NS.USER.NAME to the canonical name (E.g. %"Ronald Kaplan%") before starting Lafite.")

        [COMS                                                (* ; "Suppress general XNS access")
              (FNS NOXNSLOGIN NOXNSCANONICAL.NSHOSTNAME NOXNSGETCLEARINGHOUSE)
              (P (MOVD? 'LOGIN 'XNSLOGIN)
                 (MOVD 'NOXNSLOGIN 'LOGIN)
                 (MOVD? '\CANONICAL.NSHOSTNAME 'XNSCANONICAL.NSHOSTNAME)
                 (MOVD 'NOXNSCANONICAL.NSHOSTNAME '\CANONICAL.NSHOSTNAME)
                 (MOVD? 'GETCLEARINGHOUSE 'XNSGETCLEARINGHOUSE)
                 (MOVD 'NOXNSGETCLEARINGHOUSE 'GETCLEARINGHOUSE]
        (COMS                                                (* ; 
                                      "Let Unixmail deal with old NS messages when XNS unavailable")
              (FNS NOXNSNSMAIL.NEW.AUTHENTICATE NOXNSNSMAIL.MAKEANSWERFORM NOXNSNSMAIL.NEW.SEND 
                   NOXNSNSMAIL.NEW.SEND.PARSE)
              (INITVARS (NS.USER.NAME "no NS user name"))
              (VARS (LAFITE.USE.ALL.MODES NIL))
              (P (MOVD? '\NSMAIL.NEW.AUTHENTICATE 'XNSNSMAIL.NEW.AUTHENTICATE)
                 (MOVD 'NOXNSNSMAIL.NEW.AUTHENTICATE '\NSMAIL.NEW.AUTHENTICATE)
                 (MOVD? '\NSMAIL.MAKEANSWERFORM 'XNSNSMAIL.MAKEANSWERFORM)
                 (MOVD 'NOXNSNSMAIL.MAKEANSWERFORM '\NSMAIL.MAKEANSWERFORM)
                 (MOVD? '\NSMAIL.NEW.SEND 'XNSNSMAIL.NEW.SEND)
                 (MOVD 'NOXNSNSMAIL.NEW.SEND '\NSMAIL.NEW.SEND)
                 (MOVD? '\NSMAIL.NEW.SEND.PARSE 'XNSNSMAIL.NEW.SEND.PARSE)
                 (MOVD 'NOXNSNSMAIL.NEW.SEND.PARSE '\NSMAIL.NEW.SEND.PARSE))
              (DECLARE%: EVAL@COMPILE DONTCOPY (FILES (LOADCOMP)
                                                      LAFITEDECLS])



(* ;; 
"Suppress login/clearinghouse/nsmail if not running XNS.  Mail stuff is necessary in order to parse old NS messages in existing folders.  User should set NS.USER.NAME to the canonical name (E.g. %"Ronald Kaplan%") before starting Lafite."
)




(* ; "Suppress general XNS access")

(DEFINEQ

(NOXNSLOGIN
  [LAMBDA (HOST FLG DIRECTORY MSG)                       (* ; "Edited 14-Oct-97 18:38 by rmk:")

    (* ;; "Replace login with NOOP Lisp isn't running XNS")

    (CL:WHEN (STREQUAL "1" (UNIX-GETENV "LDELISPXNS"))
           (XNSLOGIN HOST FLG DIRECTORY MSG])

(NOXNSCANONICAL.NSHOSTNAME
  [LAMBDA (HOST)                                         (* ; "Edited 11-Feb-98 14:34 by rmk:")

    (* ;; "Replace login with NOOP Lisp isn't running XNS")

    (CL:WHEN (STREQUAL "1" (UNIX-GETENV "LDELISPXNS"))
           (XNSCANONICAL.NSHOSTNAME HOST])

(NOXNSGETCLEARINGHOUSE
  [LAMBDA NIL                                            (* ; "Edited  6-Mar-99 01:15 by rmk:")

    (* ;; "Replace login with NOOP Lisp isn't running XNS")

    (CL:WHEN (STREQUAL "1" (UNIX-GETENV "LDELISPXNS"))
           (XNSGETCLEARINGHOUSE])
)

(MOVD? 'LOGIN 'XNSLOGIN)

(MOVD 'NOXNSLOGIN 'LOGIN)

(MOVD? '\CANONICAL.NSHOSTNAME 'XNSCANONICAL.NSHOSTNAME)

(MOVD 'NOXNSCANONICAL.NSHOSTNAME '\CANONICAL.NSHOSTNAME)

(MOVD? 'GETCLEARINGHOUSE 'XNSGETCLEARINGHOUSE)

(MOVD 'NOXNSGETCLEARINGHOUSE 'GETCLEARINGHOUSE)



(* ; "Let Unixmail deal with old NS messages when XNS unavailable")

(DEFINEQ

(NOXNSNSMAIL.NEW.AUTHENTICATE
  [LAMBDA NIL                                                (* ; "Edited 18-Mar-99 10:39 by rmk:")
                                                             (* ; "Edited  8-Mar-99 20:59 by rmk:")
                                                             (* ; "Edited  6-Mar-99 11:54 by rmk:")

    (* ;; "Fake up lafite user data when not running XNS.  This permits us to parse old mail folders with NS mesages and detect whether they are from the current user.")

    (IF (STREQUAL "1" (UNIX-GETENV "LDELISPXNS"))
        THEN (XNSNSMAIL.NEW.AUTHENTICATE)
      ELSE (CREATE LAFITEMODEDATA
                      FULLUSERNAME _ (CONCAT NS.USER.NAME ":" CH.DEFAULT.DOMAIN ":" 
                                            CH.DEFAULT.ORGANIZATION)
                      SHORTUSERNAME _ (UNIX-USERNAME)
                      UNPACKEDUSERNAME _ (CREATE NSNAME
                                                NSOBJECT _ NS.USER.NAME
                                                NSDOMAIN _ CH.DEFAULT.DOMAIN
                                                NSORGANIZATION _ CH.DEFAULT.ORGANIZATION])

(NOXNSNSMAIL.MAKEANSWERFORM
  [LAMBDA (MSGDESCRIPTORS MAILFOLDER)                        (* ; "Edited 31-Mar-99 17:04 by rmk:")

    (* ;; "Fake up lafite user data when not running XNS.  This permits us to parse old mail folders with NS mesages and detect whether they are from the current user.")

    (IF (STREQUAL "1" (UNIX-GETENV "LDELISPXNS"))
        THEN (XNSNSMAIL.MAKEANSWERFORM MSGDESCRIPTORS MAILFOLDER)
      ELSE (\UNIXMAIL.MAKEANSWERFORM MSGDESCRIPTORS MAILFOLDER])

(NOXNSNSMAIL.NEW.SEND
  [LAMBDA (PARSE EDITORWINDOW ABORTWINDOW)                   (* ; "Edited 31-Mar-99 17:06 by rmk:")

    (* ;; "Fake up lafite user data when not running XNS.  This permits us to parse old mail folders with NS mesages and detect whether they are from the current user.")

    (IF (STREQUAL "1" (UNIX-GETENV "LDELISPXNS"))
        THEN (XNSNSMAIL.NEW.SEND PARSE EDITORWINDOW ABORTWINDOW)
      ELSE (\UNIXMAIL.SEND PARSE EDITORWINDOW ABORTWINDOW])

(NOXNSNSMAIL.NEW.SEND.PARSE
  [LAMBDA (MSG EDITORWINDOW)                                 (* ; "Edited 31-Mar-99 17:08 by rmk:")

    (* ;; "Fake up lafite user data when not running XNS.  This permits us to parse old mail folders with NS mesages and detect whether they are from the current user.")

    (IF (STREQUAL "1" (UNIX-GETENV "LDELISPXNS"))
        THEN (XNSNSMAIL.NEW.SEND.PARSE MSG EDITORWINDOW)
      ELSE (\UNIXMAIL.SEND.PARSE MSG EDITORWINDOW])
)

(RPAQ? NS.USER.NAME "no NS user name")

(RPAQQ LAFITE.USE.ALL.MODES NIL)

(MOVD? '\NSMAIL.NEW.AUTHENTICATE 'XNSNSMAIL.NEW.AUTHENTICATE)

(MOVD 'NOXNSNSMAIL.NEW.AUTHENTICATE '\NSMAIL.NEW.AUTHENTICATE)

(MOVD? '\NSMAIL.MAKEANSWERFORM 'XNSNSMAIL.MAKEANSWERFORM)

(MOVD 'NOXNSNSMAIL.MAKEANSWERFORM '\NSMAIL.MAKEANSWERFORM)

(MOVD? '\NSMAIL.NEW.SEND 'XNSNSMAIL.NEW.SEND)

(MOVD 'NOXNSNSMAIL.NEW.SEND '\NSMAIL.NEW.SEND)

(MOVD? '\NSMAIL.NEW.SEND.PARSE 'XNSNSMAIL.NEW.SEND.PARSE)

(MOVD 'NOXNSNSMAIL.NEW.SEND.PARSE '\NSMAIL.NEW.SEND.PARSE)
(DECLARE%: EVAL@COMPILE DONTCOPY 

(FILESLOAD (LOADCOMP)
       LAFITEDECLS)
)
(PUTPROPS NOXNSPATCH COPYRIGHT ("Xerox Corporation" 1999))
(DECLARE%: DONTCOPY
  (FILEMAP (NIL (2784 3669 (NOXNSLOGIN 2794 . 3080) (NOXNSCANONICAL.NSHOSTNAME 3082 . 3380) (
NOXNSGETCLEARINGHOUSE 3382 . 3667)) (4011 6678 (NOXNSNSMAIL.NEW.AUTHENTICATE 4021 . 5192) (
NOXNSNSMAIL.MAKEANSWERFORM 5194 . 5698) (NOXNSNSMAIL.NEW.SEND 5700 . 6192) (NOXNSNSMAIL.NEW.SEND.PARSE
 6194 . 6676)))))
STOP
\ No newline at end of file
diff --git a/library/lafite/NOXNSPATCH.LCOM b/library/lafite/NOXNSPATCH.LCOM
deleted file mode 100644
index 162c82cb..00000000
Binary files a/library/lafite/NOXNSPATCH.LCOM and /dev/null differ
diff --git a/library/lafite/NSMAIL.LCOM b/library/lafite/NSMAIL.LCOM
deleted file mode 100644
index 42c4adf5..00000000
Binary files a/library/lafite/NSMAIL.LCOM and /dev/null differ
diff --git a/library/lafite/NSMAIL.TEDIT b/library/lafite/NSMAIL.TEDIT
deleted file mode 100644
index 28f66464..00000000
Binary files a/library/lafite/NSMAIL.TEDIT and /dev/null differ
diff --git a/library/lafite/UNIXMAIL.DFASL b/library/lafite/UNIXMAIL.DFASL
deleted file mode 100644
index b24786b3..00000000
Binary files a/library/lafite/UNIXMAIL.DFASL and /dev/null differ
diff --git a/library/tedit/TEDIT-PAGE b/library/tedit/TEDIT-PAGE
index 1183fb5a..e99f067d 100644
--- a/library/tedit/TEDIT-PAGE
+++ b/library/tedit/TEDIT-PAGE
@@ -1,12 +1,14 @@
 (DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
 
-(FILECREATED " 7-Mar-2024 09:55:14" {WMEDLEY}<library>TEDIT>TEDIT-PAGE.;154 111276 
+(FILECREATED "13-Mar-2024 17:12:34" {WMEDLEY}<library>TEDIT>TEDIT-PAGE.;163 112427 
 
       :EDIT-BY rmk
 
-      :CHANGES-TO (FNS TEDIT.FORMAT.HARDCOPY)
+      :CHANGES-TO (FNS TEDIT.FORMATBOX \TEDIT.FORMAT.FOOTNOTE)
+                  (RECORDS PAGEFORMATTINGSTATE PAGEREGION)
+                  (MACROS GETPFS SETPFS)
 
-      :PREVIOUS-DATE " 7-Mar-2024 00:14:19" {WMEDLEY}<library>TEDIT>TEDIT-PAGE.;152)
+      :PREVIOUS-DATE "13-Mar-2024 10:28:14" {WMEDLEY}<library>tedit>TEDIT-PAGE.;157)
 
 
 (PRETTYCOMPRINT TEDIT-PAGECOMS)
@@ -559,7 +561,7 @@
 
 (TEDIT.FORMAT.HARDCOPY
   [LAMBDA (TEXTSTREAM FILE DONTSEND BREAKPAGETITLE SERVER PRINTOPTIONS IMAGETYPE FIRSTPG# STARTPG 
-                 ENDPG)                                      (* ; "Edited  7-Mar-2024 09:55 by rmk")
+                 ENDPG)                                      (* ; "Edited  7-Mar-2024 12:34 by rmk")
                                                              (* ; "Edited 19-Jan-2024 23:39 by rmk")
                                                              (* ; "Edited 24-Dec-2023 14:10 by rmk")
                                                              (* ; "Edited 15-Nov-2023 23:56 by rmk")
@@ -577,9 +579,9 @@
         (SETQ TEXTSTREAM (if (TEXTSTREAM TEXTSTREAM T)
                            elseif (TEDIT.FORMATTEDFILEP TEXTSTREAM)
                              then (CL:UNLESS (\GETSTREAM TEXTSTREAM 'INPUT T)
-                                      [RESETSAVE (SETQ TEXTSTREAM (OPENSTREAM TEXTSTREAM 'INPUT))
+                                      [RESETSAVE (SETQ TEXTSTREAM (OPENTEXTSTREAM TEXTSTREAM))
                                              `(PROGN (CLOSEF? OLDVALUE])
-                                  (OPENTEXTSTREAM TEXTSTREAM)
+                                  TEXTSTREAM
                            else (ERROR TEXTSTREAM "is not a Tedit stream")))
         (PROG ((TEXTOBJ (fetch (TEXTSTREAM TEXTOBJ) of TEXTSTREAM))
                [FORMATTINGSTATE (create PAGEFORMATTINGSTATE
@@ -705,6 +707,7 @@
 
 (TEDIT.FORMATBOX
   [LAMBDA (TEXTOBJ PRSTREAM STARTINGCHNO PAGEREGION FORMATTINGSTATE)
+                                                             (* ; "Edited 13-Mar-2024 17:09 by rmk")
                                                              (* ; "Edited 20-Jan-2024 12:16 by rmk")
                                                              (* ; "Edited 28-Jun-2023 15:54 by rmk")
                                                              (* ; "Edited 22-Jun-2023 21:50 by rmk")
@@ -820,32 +823,36 @@
                                                              "For now, draw a box around it, too.")
                   )
              NIL)
-         (for LINE in LINES when LINE do                     (* ; 
+         (for LINE LTEXTOBJ in LINES when LINE do            (* ; 
                                                             "Run thru the lines displaying them all.")
-                                         (BLOCK)
-                                         (CL:WHEN (OR (NOT (GETPFS FORMATTINGSTATE MINPAGE#))
-                                                      (IGEQ (GETPFS FORMATTINGSTATE PAGE#)
-                                                            (GETPFS FORMATTINGSTATE MINPAGE#)))
+                                                  (BLOCK)
+                                                  (SETQ LTEXTOBJ (fetch (TEXTSTREAM TEXTOBJ)
+                                                                    of (FGETLD LINE LTEXTSTREAM)))
+                                                  (CL:WHEN (OR (NOT (GETPFS FORMATTINGSTATE MINPAGE#)
+                                                                    )
+                                                               (IGEQ (GETPFS FORMATTINGSTATE PAGE#)
+                                                                     (GETPFS FORMATTINGSTATE MINPAGE#
+                                                                            )))
                                                              (* ; 
                                     "We're beyond the min page number -- go ahead and print the line")
-                                             (\TEDIT.HARDCOPY.DISPLAYLINE (GETLD LINE LTEXTOBJ)
-                                                    LINE
-                                                    (SCALEREGION (DSPSCALE NIL PRSTREAM)
-                                                           REGION)
-                                                    PRSTREAM FORMATTINGSTATE))
-                                         (CL:WHEN (EQ TEXTOBJ (GETLD LINE LTEXTOBJ))
+                                                      (\TEDIT.HARDCOPY.DISPLAYLINE
+                                                       LTEXTOBJ LINE (SCALEREGION (DSPSCALE NIL 
+                                                                                         PRSTREAM)
+                                                                            REGION)
+                                                       PRSTREAM FORMATTINGSTATE))
+                                                  (CL:WHEN (EQ TEXTOBJ LTEXTOBJ)
 
-                                             (* ;; 
+                                                      (* ;; 
                         "This line refers back to the main text, so update the current-char pointer.")
 
-                                             (* ;; 
+                                                      (* ;; 
                      "[NB that footnotes could cause the count to be non-monotonic; hence the IMAX.]")
 
-                                             [SETQ CHNO (IMAX (OR CHNO 0)
-                                                              (ADD1 (GETLD LINE LCHARLIM])
-                                         (push (GETPFS FORMATTINGSTATE PAGELINECACHE)
-                                               LINE)
-                                         (SETLD LINE LTEXTOBJ NIL))
+                                                      [SETQ CHNO (IMAX (OR CHNO 0)
+                                                                       (ADD1 (FGETLD LINE LCHARLIM])
+                                                  (push (GETPFS FORMATTINGSTATE PAGELINECACHE)
+                                                        LINE)
+                                                  (FSETLD LINE LTEXTSTREAM NIL))
          (COND
             (LAST-CHNO                                       (* ; 
                                                     "We got a definite last chno from FORMATTEXTBOX.")
@@ -855,7 +862,8 @@
                   (SETPFS FORMATTINGSTATE CHNO CHNO])
 
 (TEDIT.FORMATHEADING
-  [LAMBDA (TEXTOBJ PRSTREAM FORMATTINGSTATE PAGEREGION)      (* ; "Edited  6-Mar-2024 13:09 by rmk")
+  [LAMBDA (TEXTOBJ PRSTREAM FORMATTINGSTATE PAGEREGION)      (* ; "Edited 13-Mar-2024 09:00 by rmk")
+                                                             (* ; "Edited  6-Mar-2024 13:09 by rmk")
                                                              (* ; "Edited 15-Feb-2024 22:02 by rmk")
                                                              (* ; "Edited 19-Jan-2024 23:20 by rmk")
                                                              (* ; "Edited  9-Sep-2023 22:17 by rmk")
@@ -868,15 +876,17 @@
     (LET ((REGION (SCALEREGION (DSPSCALE NIL PRSTREAM)
                          (fetch (PAGEREGION REGIONSPEC) of PAGEREGION)))
           (LOCALINFO (fetch (PAGEREGION REGIONLOCALINFO) of PAGEREGION))
-          HEADINGTEXTOBJ FORCENEXTPAGE HEADING)
+          HEADINGTEXTOBJ HEADINGSTREAM FORCENEXTPAGE HEADING)
          (CL:WHEN [AND (for FORM inside (LISTGET LOCALINFO 'PRECONDITIONS) always (EVAL FORM))
                        (SETQ HEADING (LISTGET (GETPFS FORMATTINGSTATE PAGEHEADINGS)
                                             (LISTGET LOCALINFO 'HEADINGTYPE]
-             [SETQ HEADINGTEXTOBJ (fetch (TEXTSTREAM TEXTOBJ)
-                                     of (OPENTEXTSTREAM
-                                         NIL NIL NIL NIL
-                                         `(PARALOOKS ,(PPARALOOKS (fetch (SELPIECES SPFIRST)
-                                                                     of HEADING]
+
+             (* ;; "Bind the stream to make sure it isn't collected.")
+
+             [SETQ HEADINGSTREAM (OPENTEXTSTREAM NIL NIL NIL NIL
+                                        `(PARALOOKS ,(PPARALOOKS (fetch (SELPIECES SPFIRST)
+                                                                    of HEADING]
+             (SETQ HEADINGTEXTOBJ (fetch (TEXTSTREAM TEXTOBJ) of HEADINGSTREAM))
 
              (* ;; "Insert the heading pieces into HEADINGTEXTOBJ")
 
@@ -912,7 +922,8 @@
                       LINE))])
 
 (TEDIT.FORMATPAGE
-  [LAMBDA (TEXTOBJ PRSTREAM CHNO PAGEREGION FORMATTINGSTATE) (* ; "Edited 19-Jan-2024 23:10 by rmk")
+  [LAMBDA (TEXTOBJ PRSTREAM CHNO PAGEREGION FORMATTINGSTATE) (* ; "Edited 13-Mar-2024 10:28 by rmk")
+                                                             (* ; "Edited 19-Jan-2024 23:10 by rmk")
                                                              (* ; "Edited 11-Dec-2023 22:02 by rmk")
                                                              (* ; "Edited 13-Nov-2023 00:15 by rmk")
                                                              (* ; "Edited 22-Sep-2023 20:37 by rmk")
@@ -997,7 +1008,7 @@
 
          (* ;; "We now fill up the next complete page. Afterwards, we either continue to the next page (DPSNEWPAGE) or finish up.  TEDIT.FORMATBOX is responsible for setting up NEWPAGEBEFORFE and NEWPAGEAFTER")
 
-              (SETPFS FORMATTINGSTATE CHNO CHNO with CHNO)
+              (SETPFS FORMATTINGSTATE CHNO CHNO)
               (for SUBREGION in (fetch (PAGEREGION REGIONSUBBOXES) of PAGEREGION)
                  while (ILEQ (GETPFS FORMATTINGSTATE CHNO)
                              TEXTLEN) do 
@@ -1269,7 +1280,8 @@
                 FORMATTINGSTATE FINAL-CHNO)))])
 
 (TEDIT.FORMATFOLIO
-  [LAMBDA (TEXTOBJ PRSTREAM FORMATTINGSTATE PAGEREGION)      (* ; "Edited 19-Jan-2024 23:28 by rmk")
+  [LAMBDA (TEXTOBJ PRSTREAM FORMATTINGSTATE PAGEREGION)      (* ; "Edited 13-Mar-2024 09:00 by rmk")
+                                                             (* ; "Edited 19-Jan-2024 23:28 by rmk")
                                                              (* ; "Edited 18-Jan-2024 17:04 by rmk")
                                                              (* ; "Edited 13-Nov-2023 00:24 by rmk")
                                                              (* ; "Edited  1-Jun-2023 00:12 by rmk")
@@ -1281,7 +1293,7 @@
     (LET ((REGION (SCALEREGION (DSPSCALE NIL PRSTREAM)
                          (fetch (PAGEREGION REGIONSPEC) of PAGEREGION)))
           (FOLIOINFO (fetch (PAGEREGION REGIONLOCALINFO) of PAGEREGION))
-          FOLIOTEXTOBJ PAGE# FOLIOFORMAT PRETEXT POSTTEXT INFOLIST)
+          FOLIOSTREAM FOLIOTEXTOBJ PAGE# FOLIOFORMAT PRETEXT POSTTEXT INFOLIST)
          (CL:UNLESS (AND (GETPFS FORMATTINGSTATE FIRSTPAGE)
                          (LISTGET FOLIOINFO 'NOFIRSTPAGE))   (* ; 
        "If this isn't the first page, OR we want a page # on the first page, go ahead and format it.")
@@ -1300,10 +1312,14 @@
                                    (UPPERROMAN (ROMANNUMERALS (GETPFS FORMATTINGSTATE PAGE#)
                                                       T))
                                    (MKSTRING (GETPFS FORMATTINGSTATE PAGE#]
-             [SETQ FOLIOTEXTOBJ (TEXTOBJ (OPENTEXTSTREAM NIL NIL NIL NIL
-                                                `(PARALOOKS ,(LISTGET FOLIOINFO 'PARALOOKS)
-                                                        LOOKS
-                                                        ,(LISTGET FOLIOINFO 'CHARLOOKS]
+
+             (* ;; "Bind the stream to make sure it isn't collected.")
+
+             [SETQ FOLIOSTREAM (OPENTEXTSTREAM NIL NIL NIL NIL
+                                      `(PARALOOKS ,(LISTGET FOLIOINFO 'PARALOOKS)
+                                              LOOKS
+                                              ,(LISTGET FOLIOINFO 'CHARLOOKS]
+             (SETQ FOLIOTEXTOBJ (fetch (TEXTSTREAM TEXTOBJ) of FOLIOSTREAM))
              (TEDIT.INSERT FOLIOTEXTOBJ (CONCAT PRETEXT PAGE# POSTTEXT)
                     1 NIL T)
              (bind LINE YBOT FORCENEXTPAGE (TEXTLEN _ (TEXTLEN FOLIOTEXTOBJ))
@@ -1745,7 +1761,8 @@
 (DEFINEQ
 
 (\TEDIT.FORMAT.FOOTNOTE
-  [LAMBDA (TEXTOBJ PRSTREAM LINE REGION FORMATTINGSTATE)     (* ; "Edited 19-Jan-2024 23:30 by rmk")
+  [LAMBDA (TEXTOBJ PRSTREAM LINE REGION FORMATTINGSTATE)     (* ; "Edited 13-Mar-2024 17:00 by rmk")
+                                                             (* ; "Edited 19-Jan-2024 23:30 by rmk")
                                                              (* ; "Edited  6-May-2023 20:38 by rmk")
                                                              (* ; "Edited  7-Mar-2023 13:11 by rmk")
                                                              (* ; "Edited 30-May-91 12:52 by jds")
@@ -1766,8 +1783,6 @@
                                REGION PRSTREAM FORMATTINGSTATE)) 
                                                              (* ; 
                                                              "Format the line, noting any form-feeds")
-             (SETLD LINE LTEXTOBJ TEXTOBJ)                   (* ; 
-                                                            "And remember the document it came from.")
              (add (FGETLD LINE LEFTMARGIN)
                   LEFT)
              (add (FGETLD LINE RIGHTMARGIN)
@@ -1780,14 +1795,14 @@
                         (RETURN (DREMOVE NIL $$VAL])
 )
 (DECLARE%: DONTCOPY
-  (FILEMAP (NIL (11921 15254 (\TEDIT.PARSE.PAGEFRAMES 11931 . 13431) (\TEDIT.PUT.PAGEFRAMES 13433 . 
-14257) (\TEDIT.UNPARSE.PAGEFRAMES 14259 . 15252)) (15317 31779 (TEDIT.SINGLE.PAGEFORMAT 15327 . 25545)
- (TEDIT.COMPOUND.PAGEFORMAT 25547 . 26526) (TEDIT.PAGEFORMAT 26528 . 31777)) (31866 90148 (
-TEDIT.FORMAT.HARDCOPY 31876 . 42886) (TEDIT.FORMATBOX 42888 . 55048) (TEDIT.FORMATHEADING 55050 . 
-58664) (TEDIT.FORMATPAGE 58666 . 66869) (TEDIT.FORMATTEXTBOX 66871 . 81654) (TEDIT.FORMATFOLIO 81656
- . 86040) (\TEDIT.FORMAT.FOUNDBOX? 86042 . 88081) (TEDIT.SKIP.SPECIALCOND 88083 . 90146)) (90228 92509
- (TEDIT.HARDCOPY.PAGEHEADINGS 90238 . 92507)) (92618 99801 (TEDIT.HARDCOPY-COLUMN-END 92628 . 99799)) 
-(99846 104787 (SCALEPAGEUNITS 99856 . 100997) (SCALEPAGEXUNITS 100999 . 101769) (SCALEPAGEYUNITS 
-101771 . 102542) (\TEDIT.PAPERHEIGHT 102544 . 103479) (\TEDIT.PAPERWIDTH 103481 . 104785)) (105203 
-108771 (ROMANNUMERALS 105213 . 108769)) (108807 111253 (\TEDIT.FORMAT.FOOTNOTE 108817 . 111251)))))
+  (FILEMAP (NIL (12038 15371 (\TEDIT.PARSE.PAGEFRAMES 12048 . 13548) (\TEDIT.PUT.PAGEFRAMES 13550 . 
+14374) (\TEDIT.UNPARSE.PAGEFRAMES 14376 . 15369)) (15434 31896 (TEDIT.SINGLE.PAGEFORMAT 15444 . 25662)
+ (TEDIT.COMPOUND.PAGEFORMAT 25664 . 26643) (TEDIT.PAGEFORMAT 26645 . 31894)) (31983 91368 (
+TEDIT.FORMAT.HARDCOPY 31993 . 42983) (TEDIT.FORMATBOX 42985 . 55757) (TEDIT.FORMATHEADING 55759 . 
+59542) (TEDIT.FORMATPAGE 59544 . 67846) (TEDIT.FORMATTEXTBOX 67848 . 82631) (TEDIT.FORMATFOLIO 82633
+ . 87260) (\TEDIT.FORMAT.FOUNDBOX? 87262 . 89301) (TEDIT.SKIP.SPECIALCOND 89303 . 91366)) (91448 93729
+ (TEDIT.HARDCOPY.PAGEHEADINGS 91458 . 93727)) (93838 101021 (TEDIT.HARDCOPY-COLUMN-END 93848 . 101019)
+) (101066 106007 (SCALEPAGEUNITS 101076 . 102217) (SCALEPAGEXUNITS 102219 . 102989) (SCALEPAGEYUNITS 
+102991 . 103762) (\TEDIT.PAPERHEIGHT 103764 . 104699) (\TEDIT.PAPERWIDTH 104701 . 106005)) (106423 
+109991 (ROMANNUMERALS 106433 . 109989)) (110027 112404 (\TEDIT.FORMAT.FOOTNOTE 110037 . 112402)))))
 STOP
diff --git a/library/tedit/TEDIT-PAGE.LCOM b/library/tedit/TEDIT-PAGE.LCOM
index 68bd0a71..9c31e894 100644
Binary files a/library/tedit/TEDIT-PAGE.LCOM and b/library/tedit/TEDIT-PAGE.LCOM differ
diff --git a/library/tedit/TEDIT-SCREEN b/library/tedit/TEDIT-SCREEN
index 71baf30e..d8fd641a 100644
--- a/library/tedit/TEDIT-SCREEN
+++ b/library/tedit/TEDIT-SCREEN
@@ -1,12 +1,17 @@
 (DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
 
-(FILECREATED " 4-Mar-2024 22:50:24" {WMEDLEY}<library>tedit>TEDIT-SCREEN.;612 184763 
+(FILECREATED "14-Mar-2024 12:53:18" {WMEDLEY}<library>tedit>TEDIT-SCREEN.;618 186031 
 
       :EDIT-BY rmk
 
-      :CHANGES-TO (FNS \TEDIT.MARK.LINES.DIRTY)
+      :CHANGES-TO (FNS \FORMATLINE \TEDIT.CREATEPLINE)
+                  (I.S.OPRS inlines backlines incharslots backcharslots)
+                  (RECORDS THISLINE LINECACHE LINEDESCRIPTOR CHARSLOT)
+                  (MACROS GETLD FGETLD SETLD FSETLD SETYPOS LINKLD HCSCALE HCUNSCALE CHAR CHARW 
+                         PREVCHARSLOT PREVCHARSLOT! NEXTCHARSLOT FIRSTCHARSLOT NTHCHARSLOT 
+                         LASTCHARSLOT FILLCHARSLOT BACKCHARS PUSHCHAR POPCHAR CHARSLOTP DIACRITICP)
 
-      :PREVIOUS-DATE " 2-Mar-2024 07:40:06" {WMEDLEY}<library>tedit>TEDIT-SCREEN.;611)
+      :PREVIOUS-DATE "13-Mar-2024 14:40:10" {WMEDLEY}<library>tedit>TEDIT-SCREEN.;613)
 
 
 (PRETTYCOMPRINT TEDIT-SCREENCOMS)
@@ -146,7 +151,7 @@
            NEXTLINE                                          (* ; "Next line chain pointer")
            (PREVLINE FULLXPOINTER)                           (* ; "Previous line chain pointer")
            LMARK                                             (* ; "One of SOLID, GREY, NIL.  Tells what kind of special-line marker should be put in the left margin for this paragraph.  (For hardcopy, can also be an indicator for special processing?)")
-           LTEXTOBJ                                          (* ; "A cached TEXTOBJ that this line took its text from.  Used only in hardcopy to disambiguate when chno's should be updated.")
+           LTEXTSTREAM                                       (* ; "A cached textstream that this line took its text from.  Filled in by \TEDIT.FORMATLINE only in hardcopy, used temporarily and the cleared by \TEDIT.FORMATBOX to avoid the circularity.")
            NIL                                               (* ; "Was CACHE: A cached THISLINE, for keeping hardcopy info around while we crunch with the line descriptors to make things fit.  Now:  THISLINE comes from TEXTOBJ")
            NIL                                               (* ; 
                       "Was LDOBJ: The object which lies behind this line of text, for updating, etc.")
@@ -616,6 +621,7 @@
 
 (\FORMATLINE
   [LAMBDA (TEXTOBJ CH#1 LINE REGION IMAGESTREAM FORMATTINGSTATE)
+                                                             (* ; "Edited 14-Mar-2024 12:53 by rmk")
                                                              (* ; "Edited  2-Mar-2024 07:39 by rmk")
                                                              (* ; "Edited  5-Feb-2024 09:35 by rmk")
                                                              (* ; "Edited 26-Jan-2024 11:01 by rmk")
@@ -1072,6 +1078,14 @@
                                     (* ;; 
          "Ran out of TEXTLEN (and paragraph). Back up and force a break. Are ASCENT/DESCENT correct?")
 
+                                    (CL:WHEN (AND (EQ PREVSP (PREVCHARSLOT CHARSLOT))
+                                                  (NULL (CHAR PREVSP)))
+
+                                 (* ;; "The line ended in a space that needs to be resolved.  If we coded the end of a space-chain as (CHARCODE SPACE) instead of NIL, maybe this wouldn't be necessary.")
+
+                                        (FILLCHARSLOT PREVSP (CHARCODE SPACE)
+                                               (CHARW PREVSP))
+                                        (SETQ PREVSP NIL))
                                     (SETQ CHARSLOT (PREVCHARSLOT! CHARSLOT))
                                     (add CHNO -1)
                                     (SETQ DX 0)              (* ; "TX is already correct")
@@ -1142,10 +1156,13 @@
      (* ;; "")
 
           (FSETLD LINE LFMTSPEC FMTSPEC)
-          (FSETLD LINE LTEXTOBJ TEXTOBJ)                     (* ; 
-                                                             "XPOINTER, valid if TEXTOBJ is held")
+          (CL:WHEN (EQ LINETYPE 'TRUEHARDCOPY)
+
+              (* ;; "Used temporarily and cleared by \TEDIT.FORMATBOX; not an XPOINTER")
+
+              (FSETLD LINE LTEXTSTREAM TSTREAM))
           (freplace (THISLINE DESC) of THISLINE with LINE)
-          (\TEDIT.FORMATLINE.VERTICAL LINE TEXTOBJ)
+          (\TEDIT.FORMATLINE.VERTICAL LINE TSTREAM)
           (\TEDIT.FORMATLINE.HORIZONTAL LINE THISLINE PREVSP SPACELEFT OVERHANG LINETYPE)
 
      (* ;; "Finally translate to the left edge, perhsps a specialx if true hardcopy.")
@@ -2347,7 +2364,8 @@
         (FSETTOBJ TEXTOBJ TXTNEEDSUPDATE NIL))])
 
 (\TEDIT.CREATEPLINE
-  [LAMBDA (TEXTOBJ PANE FIRSTLINE)                           (* ; "Edited 21-Feb-2024 23:36 by rmk")
+  [LAMBDA (TEXTOBJ PANE FIRSTLINE)                           (* ; "Edited 13-Mar-2024 17:02 by rmk")
+                                                             (* ; "Edited 21-Feb-2024 23:36 by rmk")
                                                              (* ; "Edited  2-Jan-2024 13:04 by rmk")
                                                              (* ; "Edited 29-Dec-2023 15:48 by rmk")
 
@@ -2377,8 +2395,7 @@
                  LTRUEDESCENT _ 0
                  LFMTSPEC _ TEDIT.DEFAULT.FMTSPEC
                  1STLN _ NIL
-                 LSTLN _ NIL
-                 LTEXTOBJ _ TEXTOBJ))
+                 LSTLN _ NIL))
          (replace (TEXTWINDOW PLINES) of PANE with DUMMYLINE)(* ; "Install PANE's new dummy line")
          (LINKLD DUMMYLINE FIRSTLINE)                        (* ; "Link the possible first line")
          DUMMYLINE])
@@ -2928,21 +2945,21 @@
                                                          (SETQ TAILLINE NIL))))])
 )
 (DECLARE%: DONTCOPY
-  (FILEMAP (NIL (24320 25729 (\TEDIT.LINEDESCRIPTOR.DEFPRINT 24330 . 25727)) (33226 109797 (\FORMATLINE 
-33236 . 67170) (\FORMATLINE.SETUP 67172 . 70557) (\TEDIT.FORMATLINE.HORIZONTAL 70559 . 74834) (
-\TEDIT.FORMATLINE.VERTICAL 74836 . 76805) (\FORMATLINE.JUSTIFY 76807 . 82741) (\FORMATLINE.TABS 82743
- . 90224) (\FORMATLINE.SCALETABS 90226 . 91223) (\FORMATLINE.PURGE.SPACES 91225 . 92529) (
-\FORMATLINE.EMPTY 92531 . 97234) (\FORMATLINE.UPDATELOOKS 97236 . 104181) (\FORMATLINE.LASTLEGAL 
-104183 . 107659) (\FORMATBLOCK 107661 . 109795)) (109914 112220 (\CLEARTHISLINE 109924 . 110593) (
-\TLVALIDATE 110595 . 112218)) (112414 132131 (\DISPLAYLINE 112424 . 124536) (\DISPLAYLINE.TABS 124538
- . 127155) (\TEDIT.LINECACHE 127157 . 127885) (\TEDIT.CREATE.LINECACHE 127887 . 128723) (
-\TEDIT.BLTCHAR 128725 . 131246) (\TEDIT.DIACRITIC.SHIFT 131248 . 132129)) (132746 184740 (
-TEDIT.UPDATE.SCREEN 132756 . 134395) (\BACKFORMAT 134397 . 136151) (\TEDIT.PREVIOUS.LINEBREAK 136153
- . 138341) (\FILLPANE 138343 . 140662) (\TEDIT.UPDATE.LINES 140664 . 145543) (\TEDIT.CREATEPLINE 
-145545 . 147315) (\TEDIT.FIND.DIRTYCHARS 147317 . 149329) (\TEDIT.FORMATLINES 149331 . 152680) (
-\FORMAT.GAP.LINES 152682 . 156546) (\TEDIT.LOWER.LINES 156548 . 160800) (\TEDIT.RAISE.LINES 160802 . 
-164127) (\TEDIT.VALID.LINES 164129 . 173413) (\TEDIT.CLEARPANE.BELOW.LINE 173415 . 174733) (
-\TEDIT.INSERTLINE 174735 . 175993) (\TEDIT.INSURE.TRAILING.LINE 175995 . 177183) (
-\TEDIT.MARK.LINES.DIRTY 177185 . 179896) (\TEDIT.LINE.BOTTOM 179898 . 182738) (\TEDIT.NCONC.LINES 
-182740 . 184738)))))
+  (FILEMAP (NIL (24822 26231 (\TEDIT.LINEDESCRIPTOR.DEFPRINT 24832 . 26229)) (33728 110992 (\FORMATLINE 
+33738 . 68365) (\FORMATLINE.SETUP 68367 . 71752) (\TEDIT.FORMATLINE.HORIZONTAL 71754 . 76029) (
+\TEDIT.FORMATLINE.VERTICAL 76031 . 78000) (\FORMATLINE.JUSTIFY 78002 . 83936) (\FORMATLINE.TABS 83938
+ . 91419) (\FORMATLINE.SCALETABS 91421 . 92418) (\FORMATLINE.PURGE.SPACES 92420 . 93724) (
+\FORMATLINE.EMPTY 93726 . 98429) (\FORMATLINE.UPDATELOOKS 98431 . 105376) (\FORMATLINE.LASTLEGAL 
+105378 . 108854) (\FORMATBLOCK 108856 . 110990)) (111109 113415 (\CLEARTHISLINE 111119 . 111788) (
+\TLVALIDATE 111790 . 113413)) (113609 133326 (\DISPLAYLINE 113619 . 125731) (\DISPLAYLINE.TABS 125733
+ . 128350) (\TEDIT.LINECACHE 128352 . 129080) (\TEDIT.CREATE.LINECACHE 129082 . 129918) (
+\TEDIT.BLTCHAR 129920 . 132441) (\TEDIT.DIACRITIC.SHIFT 132443 . 133324)) (133941 186008 (
+TEDIT.UPDATE.SCREEN 133951 . 135590) (\BACKFORMAT 135592 . 137346) (\TEDIT.PREVIOUS.LINEBREAK 137348
+ . 139536) (\FILLPANE 139538 . 141857) (\TEDIT.UPDATE.LINES 141859 . 146738) (\TEDIT.CREATEPLINE 
+146740 . 148583) (\TEDIT.FIND.DIRTYCHARS 148585 . 150597) (\TEDIT.FORMATLINES 150599 . 153948) (
+\FORMAT.GAP.LINES 153950 . 157814) (\TEDIT.LOWER.LINES 157816 . 162068) (\TEDIT.RAISE.LINES 162070 . 
+165395) (\TEDIT.VALID.LINES 165397 . 174681) (\TEDIT.CLEARPANE.BELOW.LINE 174683 . 176001) (
+\TEDIT.INSERTLINE 176003 . 177261) (\TEDIT.INSURE.TRAILING.LINE 177263 . 178451) (
+\TEDIT.MARK.LINES.DIRTY 178453 . 181164) (\TEDIT.LINE.BOTTOM 181166 . 184006) (\TEDIT.NCONC.LINES 
+184008 . 186006)))))
 STOP
diff --git a/library/tedit/TEDIT-SCREEN.LCOM b/library/tedit/TEDIT-SCREEN.LCOM
index 45794b22..f79d8277 100644
Binary files a/library/tedit/TEDIT-SCREEN.LCOM and b/library/tedit/TEDIT-SCREEN.LCOM differ
diff --git a/library/tedit/TEDIT-STRESS b/library/tedit/TEDIT-STRESS
new file mode 100644
index 00000000..9c3ce7af
--- /dev/null
+++ b/library/tedit/TEDIT-STRESS
@@ -0,0 +1,260 @@
+(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
+
+(FILECREATED "14-Mar-2024 15:16:05" {WMEDLEY}<library>tedit>TEDIT-STRESS.;49 12388  
+
+      :EDIT-BY rmk
+
+      :CHANGES-TO (FNS STRESSHC)
+
+      :PREVIOUS-DATE "13-Mar-2024 00:24:06" {WMEDLEY}<library>tedit>TEDIT-STRESS.;48)
+
+
+(PRETTYCOMPRINT TEDIT-STRESSCOMS)
+
+(RPAQQ TEDIT-STRESSCOMS (                                    (* ; "Preload typical image objects")
+                         (FILES SKETCH DATEFORMAT-EDITOR)
+                         (FNS STRESSHC STRESSRAND STRESSPUT STRESSOPEN STRESSREAD)
+                         (FNS EQTEXTSTREAM SYSOUTRING COPYTOCORE)))
+
+
+
+(* ; "Preload typical image objects")
+
+
+(FILESLOAD SKETCH DATEFORMAT-EDITOR)
+(DEFINEQ
+
+(STRESSHC
+  [LAMBDA (FILES NSYSOUTS REPS NOERROR SEPARATEOUT PDF SYSOUTNAME SINGLESTEP)
+                                                             (* ; "Edited 14-Mar-2024 15:15 by rmk")
+                                                             (* ; "Edited 13-Mar-2024 00:23 by rmk")
+    (DECLARE (SPECVARS SINGLESTEP))
+
+    (* ;; "If all arguments are defaulted, runs through all TEDIT files in the current directory until it fails, doing SAVEVM before each file.  The HC files are made as {CORE}FOO.PS.")
+
+    (CL:UNLESS FILES
+        (SETQ FILES (FILDIR '*.TEDIT;)))
+    (SETQ REPS (SELECTQ REPS
+                   (NIL MAX.SMALLP)
+                   REPS))
+    (SETQ NOERROR T)
+    (CL:UNLESS NSYSOUTS
+        (SETQ NSYSOUTS 'SAVEVM))
+    [SETQ SYSOUTNAME (PACKFILENAME 'VERSION NIL 'BODY (OR SYSOUTNAME (PACKFILENAME 'DIRECTORY 
+                                                                            MEDLEYDIR 'NAME 
+                                                                            "STRESSHC" 'EXTENSION
+                                                                            'SYSOUT]
+    (PRINTOUT T REPS " reps of " (LENGTH FILES)
+           " files saving "
+           (if (EQ NSYSOUTS 0)
+               then "no sysouts"
+             elseif (EQ NSYSOUTS 'SAVEVM)
+               then " the virtual memory"
+             else (PRINTOUT NIL NSYSOUTS " sysouts on " 3)
+                  SYSOUTNAME)
+           T)
+    (PRINTOUT T "First file is " (CAR FILES)
+           T T)
+    (BKSYSBUF " ")
+    (for R SYSOUTS (ITYPE _ (CL:IF PDF
+                                'pdf
+                                'ps))
+         (N _ 0) from 1 to REPS
+       do (PRINTOUT T "Rep " R T)
+          (if (EQ NSYSOUTS 'SAVEVM)
+              then (SAVEVM)
+            else (SETQ SYSOUTS (SYSOUTRING NSYSOUTS SYSOUTNAME SYSOUTS)))
+          [for F TS HCFILE inside FILES
+             do (PROMPTPRINT F)
+                (SETQ HCFILE (CL:IF SEPARATEOUT
+                                 (OUTFILEP (PACKFILENAME 'EXTENSION ITYPE 'VERSION 1 'BODY F))
+                                 (CL:IF PDF
+                                     "{CORE}FOO.PDF;1"
+                                     "{CORE}FOO.PS;1")))
+                (if [if NOERROR
+                        then [NLSETQ (SETQ TS (OPENTEXTSTREAM F))
+                                    (TEDIT.FORMAT.HARDCOPY TS HCFILE T NIL NIL NIL
+                                           (CL:IF PDF
+                                               'PDF
+                                               'POSTSCRIPT)]
+                      else (SETQ TS (OPENTEXTSTREAM F))
+                           (TEDIT.FORMAT.HARDCOPY TS HCFILE T NIL NIL NIL (CL:IF PDF
+                                                                              'PDF
+                                                                              'POSTSCRIPT)]
+                    then (add N 1)
+                  else (PRINTOUT T "  Error for " (PACKFILENAME 'HOST NIL 'DIRECTORY NIL 'BODY F)
+                              T))
+                (CLOSEF? TS)
+                (CL:WHEN SINGLESTEP
+                    (HELP (CONCAT "Just hardcopied " F " to " HCFILE)))]
+          (PRINTOUT T "  Hardcopied " N " files without failure" T)
+       finally (RETURN (LIST R N])
+
+(STRESSRAND
+  [LAMBDA (FILES REPS NOERROR PROBESPERFILE)                 (* ; "Edited 12-Mar-2024 09:47 by rmk")
+
+    (* ;; "Opens, fetches random characters")
+
+    (CL:UNLESS FILES
+        (SETQ FILES (FILDIR '*.TEDIT;)))
+    (SETQ REPS (SELECTQ REPS
+                   (T MAX.SMALLP)
+                   (NIL 1)
+                   REPS))
+    (CL:UNLESS PROBESPERFILE (SETQ PROBESPERFILE 100))
+    (PRINTOUT T REPS " reps of " (LENGTH FILES)
+           " files with " PROBESPERFILE " probes per file" T)
+    (for R (N _ 0) from 1 to REPS
+       do (PRINTOUT T R " ")
+          (for F TS inside FILES
+             do (if [if NOERROR
+                        then [NLSETQ (SETQ TS (OPENTEXTSTREAM F))
+                                    (for I (LEN _ (TEDIT.NCHARS TS)) from 1 to PROBESPERFILE
+                                       do (TEDIT.NTHCHARCODE TS (RAND 1 LEN]
+                      else (SETQ TS (OPENTEXTSTREAM F))
+                           (for I (LEN _ (TEDIT.NCHARS TS)) from 1 to PROBESPERFILE
+                              do (TEDIT.NTHCHARCODE TS (RAND 1 LEN]
+                    then (CLOSEF TS)
+                         (add N 1)
+                  else (PRINTOUT T T "Error for " (PACKFILENAME 'HOST NIL 'DIRECTORY NIL 'BODY F)
+                              T))) finally (RETURN (LIST R N])
+
+(STRESSPUT
+  [LAMBDA (FILES REPS NOERROR CHECKEQUIV STOP)               (* ; "Edited 12-Mar-2024 09:48 by rmk")
+
+    (* ;; "Opens, puts, reopens and tests for equivalence")
+
+    (CL:UNLESS FILES
+        (SETQ FILES (FILDIR '*.TEDIT;)))
+    (SETQ REPS (SELECTQ REPS
+                   (T MAX.SMALLP)
+                   (NIL 1)
+                   REPS))
+    (PRINTOUT T REPS " reps of " (LENGTH FILES)
+           " files" T)
+    (for R (N _ 0) from 1 to REPS
+       do (PRINTOUT T R " ")
+          (for F TS TSP inside FILES
+             do (if (if NOERROR
+                        then (NLSETQ (SETQ TS (OPENTEXTSTREAM F))
+                                    (TEDIT.PUT TS "{CORE}FOO.TEDIT;1")
+                                    (SETQ TSP (OPENTEXTSTREAM "{CORE}FOO.TEDIT;1"))
+                                    (CL:WHEN (AND CHECKEQUIV (NOT (EQTEXTSTREAM TS TSP STOP)))
+                                           (HELP "Get of put not equivalent" F))
+                                    (CLOSEF TSP))
+                      else (SETQ TS (OPENTEXTSTREAM F))
+                           (TEDIT.PUT TS "{CORE}FOO.TEDIT;1")
+                           (SETQ TSP (OPENTEXTSTREAM "{CORE}FOO.TEDIT;1"))
+                           (CL:WHEN (AND CHECKEQUIV (NOT (EQTEXTSTREAM TS TSP STOP)))
+                                  (HELP "Get of put not equivalent" F))
+                           (CLOSEF TSP))
+                    then (CLOSEF TS)
+                         (add N 1)
+                  else (PRINTOUT T T "Error for " (PACKFILENAME 'HOST NIL 'DIRECTORY NIL 'BODY F)
+                              T))) finally (RETURN (LIST R N])
+
+(STRESSOPEN
+  [LAMBDA (FILES REPS NOERROR)                               (* ; "Edited 12-Mar-2024 09:48 by rmk")
+                                                             (* ; "Edited 11-Mar-2024 09:15 by rmk")
+    (CL:UNLESS FILES
+        (SETQ FILES (FILDIR '*.TEDIT;)))
+    (SETQ REPS (SELECTQ REPS
+                   (T MAX.SMALLP)
+                   (NIL 1)
+                   REPS))
+    (PRINTOUT T REPS " reps of " (LENGTH FILES)
+           " files" T)
+    (for R (N _ 0) from 1 to REPS
+       do (PRINTOUT T R " ")
+          (for F TS inside FILES do (if (if NOERROR
+                                            then (NLSETQ (SETQ TS (OPENTEXTSTREAM F)))
+                                          else (SETQ TS (OPENTEXTSTREAM F)))
+                                        then (CLOSEF TS)
+                                             (add N 1)
+                                      else (PRINTOUT T T "Error for " (PACKFILENAME 'HOST NIL
+                                                                             'DIRECTORY NIL
+                                                                             'BODY F)
+                                                  T))) finally (RETURN (LIST R N])
+
+(STRESSREAD
+  [LAMBDA (FILES REPS NOERROR)                               (* ; "Edited 12-Mar-2024 09:48 by rmk")
+                                                             (* ; "Edited 11-Mar-2024 09:13 by rmk")
+    (CL:UNLESS FILES
+        (SETQ FILES (FILDIR '*.TEDIT;)))
+    (SETQ REPS (SELECTQ REPS
+                   (T MAX.SMALLP)
+                   (NIL 1)
+                   REPS))
+    (PRINTOUT T REPS " reps of " (LENGTH FILES)
+           " files" T)
+    (for R (N _ 0) from 1 to REPS
+       do (PRINTOUT T R " ")
+          (for F TS inside FILES
+             do (if (if NOERROR
+                        then (NLSETQ (SETQ TS (OPENTEXTSTREAM F))
+                                    (for I from 1 while (TEDIT.NTHCHARCODE TS I)))
+                      else (SETQ TS (OPENTEXTSTREAM F))
+                           (for I from 1 while (TEDIT.NTHCHARCODE TS I)))
+                    then (CLOSEF TS)
+                         (add N 1)
+                  else (PRINTOUT T T "Error for " (PACKFILENAME 'HOST NIL 'DIRECTORY NIL 'BODY F)
+                              T))) finally (RETURN (LIST R N])
+)
+(DEFINEQ
+
+(EQTEXTSTREAM
+  [LAMBDA (TS1 TS2 STOP)                                     (* ; "Edited 11-Mar-2024 16:53 by rmk")
+    (AND (IEQP (TEDIT.NCHARS TS1)
+               (TEDIT.NCHARS TS2))
+         (OR (for I C1 C2 from 1 to (TEDIT.NCHARS TS1) eachtime (SETQ C1 (TEDIT.NTHCHARCODE TS1 I))
+                                                             (SETQ C2 (TEDIT.NTHCHARCODE TS2 I))
+                unless (OR (EQ C1 C2)
+                           (AND (EQ C1 10)
+                                (EQ C2 13))
+                           (AND (EQ C1 13)
+                                (EQ C2 10))
+                           (AND (IMAGEOBJP C1)
+                                (IMAGEOBJP C2)
+                                (EQUALALL C1 C2))) do (CL:WHEN STOP
+                                                          (HELP "Different characters: "
+                                                                (LIST I C1 C2)))
+                                                      (RETURN NIL) finally (RETURN T])
+
+(SYSOUTRING
+  [LAMBDA (NSYSOUTS SYSOUTNAME SYSOUTS)                      (* ; "Edited 12-Mar-2024 17:52 by rmk")
+
+    (* ;; "SYSOUTS is the list of names of sysouts that currently exist.")
+
+    (DECLARE (USEDFREE SINGLESTEP))
+    (CL:WHEN (IGREATERP NSYSOUTS 0)                          (* ; 
+                                                      "Keep NSYSOUT sysouts with increasing versions")
+        (CL:WHEN (IGEQ (LENGTH SYSOUTS)
+                       NSYSOUTS)
+            (DELFILE (pop SYSOUTS)))                         (* ; 
+                                                  "Drop the firstr (oldest), new one goes at the end")
+        (SETQ SYSOUTNAME (SYSOUT SYSOUTNAME))
+        (CL:WHEN (LISTP SYSOUTNAME)                          (* ; "Restarting")
+            (SETQ SINGLESTEP T))
+        (NCONC1 SYSOUTS SYSOUTNAME))])
+
+(COPYTOCORE
+  [LAMBDA (FILES NORECLAIM)                                  (* ; "Edited 12-Mar-2024 22:45 by rmk")
+
+    (* ;; "Copy FILES to {CORE}, defaulting to TEDIT files in connected directory")
+
+    (CL:UNLESS (LISTP FILES)
+        (SETQ FILES (FILDIR (OR FILES "*.TEDIT;"))))
+    (PRINTOUT T "Copying " (LENGTH FILES)
+           " files to {CORE} "
+           (CL:IF NORECLAIM
+               "without "
+               "with ")
+           "reclaiming" T)
+    (for F in FILES collect (COPYFILE F (PACKFILENAME 'HOST 'CORE 'DIRECTORY NIL 'BODY F))
+       finally (CL:UNLESS NORECLAIM (RECLAIM])
+)
+(DECLARE%: DONTCOPY
+  (FILEMAP (NIL (742 9789 (STRESSHC 752 . 4159) (STRESSRAND 4161 . 5577) (STRESSPUT 5579 . 7289) (
+STRESSOPEN 7291 . 8579) (STRESSREAD 8581 . 9787)) (9790 12365 (EQTEXTSTREAM 9800 . 10851) (SYSOUTRING 
+10853 . 11733) (COPYTOCORE 11735 . 12363)))))
+STOP
diff --git a/library/tedit/TEDIT-STRESS.LCOM b/library/tedit/TEDIT-STRESS.LCOM
new file mode 100644
index 00000000..3436fc4a
Binary files /dev/null and b/library/tedit/TEDIT-STRESS.LCOM differ
diff --git a/lispusers/GREP b/lispusers/GREP
index 5d591d3a..489fae23 100644
--- a/lispusers/GREP
+++ b/lispusers/GREP
@@ -1,32 +1,33 @@
 (DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
 
-(FILECREATED "19-Jul-2022 22:26:08" 
-{DSK}<Users>kaplan>Local>medley3.5>working-medley>lispusers>GREP.;11 4725   
+(FILECREATED "16-Mar-2024 11:16:38" {WMEDLEY}<lispusers>GREP.;31 6115   
+
+      :EDIT-BY rmk
 
       :CHANGES-TO (FNS DOGREP)
 
-      :PREVIOUS-DATE "26-Jun-2022 14:36:21" 
-{DSK}<Users>kaplan>Local>medley3.5>working-medley>lispusers>GREP.;9)
+      :PREVIOUS-DATE "15-Mar-2024 16:28:09" {WMEDLEY}<lispusers>GREP.;29)
 
 
-(* ; "
-Copyright (c) 1984-1986 by Xerox Corporation.
-")
-
 (PRETTYCOMPRINT GREPCOMS)
 
-(RPAQQ GREPCOMS ((FNS DOGREP GREP PHONE)
-                 (INITVARS (PHONELISTFILES))))
+(RPAQQ GREPCOMS [(FNS DOGREP GREP TGREP)
+                 (P (MOVD? 'NILL 'TEDIT.FORMATTEDFILEP))
+                 (COMS (FNS PHONE)
+                       (INITVARS (PHONELISTFILES])
 (DEFINEQ
 
 (DOGREP
   [LAMBDA (STRS FILES OUTSTREAM)
 
+    (* ;; "Edited 16-Mar-2024 11:16 by rmk")
+
+    (* ;; "Edited 20-Jan-2024 13:12 by rmk")
+
     (* ;; "Edited 19-Jul-2022 22:26 by rmk")
 
     (* ;; "Edited 26-Jun-2022 14:36 by rmk")
-
-    (* ;; "Edited 18-Jun-2022 10:38 by rmk: Search for linebreaks directly, without calling BFILEPOS or FILEPOS just for EOL character.  Also now compatible with external formats (if FFILEPOS is), and upgraded to full directory specification")
+                                                             (* Newman "14-May-86 08:04")
                                                              (* Newman "14-May-86 08:04")
 
 (* ;;; "Originally coded by Larry Masinter.")
@@ -46,50 +47,81 @@ Copyright (c) 1984-1986 by Xerox Corporation.
               (STREAM (OR (FINDFILE FILES T)
                           FILES)
                      :DIRECTION :INPUT)
-              (bind FOUND for STR inside STRS first (SETFILEINFO STREAM 'ENDOFSTREAMOP
-                                                           (FUNCTION NILL))
+              (for STR FOUND FILENAME inside STRS first (SETQ FILENAME (FULLNAME STREAM))
+                                                        (CL:WHEN (TEDIT.FORMATTEDFILEP STREAM)
+                                                            [SETQ STREAM (OPENTEXTSTREAM
+                                                                          STREAM NIL NIL NIL
+                                                                          '(OBJECTBYTE 0])
+                                                        (SETFILEINFO STREAM 'ENDOFSTREAMOP
+                                                               (FUNCTION NILL))
                  do (SETFILEPTR STREAM 0)
-                    (bind POS while (SETQ POS (FFILEPOS STR STREAM NIL NIL NIL NIL UPPERCASEARRAY))
-                       do (OR FOUND (PROGN (PRINTOUT OUTSTREAM T .FONT COMMENTFONT "(from "
-                                                  (FULLNAME STREAM)
-                                                  ")" .FONT DEFAULTFONT T)
-                                           (SETQ FOUND T))) 
+                    (bind POS STARTPOS while (SETQ POS (FFILEPOS STR STREAM NIL NIL NIL NIL 
+                                                              UPPERCASEARRAY))
+                       do (CL:UNLESS FOUND
+                              (PRINTOUT OUTSTREAM T T .FONT BOLDFONT "(from " FILENAME ")" .FONT 
+                                     DEFAULTFONT T)
+                              (SETQ FOUND T)) 
 
                           (* ;; "Copying from the beginning of this line. Originally this used BFILEPOS (backwards FILEPOS?), which did repeated calls to forward FFILEPOS in what appears to be a binary set of probes.  But FFILEPOS is really SLOW-POS for a single character, and the last line-start is presumaby not that far back.  So just walk backwards.")
 
-                          (COPYCHARS STREAM OUTSTREAM (DO (SELCHARQ (\BACKCCODE.EOLC STREAM
-                                                                           'ANY)
-                                                               (EOL (\INCCODE.EOLC STREAM)
-                                                                    (RETURN (GETFILEPTR STREAM)))
-                                                               (NIL (RETURN 0))
-                                                               NIL))
-                                 POS)
+                          (SETQ STARTPOS (DO (SELCHARQ (\BACKCCODE.EOLC STREAM 'ANY)
+                                                  (EOL (\INCCODE.EOLC STREAM)
+                                                       (RETURN (GETFILEPTR STREAM)))
+                                                  (NIL (RETURN 0))
+                                                  NIL)))
+                          (FOR I C FROM 1 TO (IDIFFERENCE POS STARTPOS)
+                             DO (SETQ C (\INCCODE.EOLC STREAM 'ANY))
+                                (CL:UNLESS (ILESSP C (CHARCODE TAB))
+                                       (PRINTCCODE C OUTSTREAM)))
                           (DSPFONT BOLDFONT OUTSTREAM)
                           (COPYCHARS STREAM OUTSTREAM POS (ADD POS (NCHARS STR)))
                           (DSPFONT DEFAULTFONT OUTSTREAM) 
 
                           (* ;; "Copying to the end of this line (or end of file)")
 
-                          (BIND C DO (SELCHARQ (SETQ C (\INCCODE.EOLC STREAM 'ANY))
+                          [BIND C DO (SELCHARQ (SETQ C (\INCCODE.EOLC STREAM 'ANY))
                                           ((EOL NIL) 
                                                (RETURN))
-                                          (PRINTCCODE C OUTSTREAM)))
+                                          (CL:UNLESS (ILESSP C (CHARCODE TAB))
+                                                 (PRINTCCODE C OUTSTREAM]
                           (TERPRI OUTSTREAM])
 
 (GREP
   [LAMBDA (STRS FILES OUTSTREAM)
 
+    (* ;; "Edited 14-Oct-2023 14:43 by rmk")
+
+    (* ;; "Edited  1-Sep-2023 00:16 by rmk")
+
+    (* ;; "Edited 23-Jul-2023 19:55 by rmk")
+
     (* ;; "Edited 26-Jun-2022 13:28 by rmk: added OUTSTREAM")
 
     (* ;; "Edited 26-Jun-2022 13:25 by rmk")
-
-    (* ;; "Edited 18-Jun-2022 09:50 by rmk")
-
-    (CL:UNLESS OUTSTREAM (SETQ OUTSTREAM T))                 (* lmm " 1-Apr-85 15:27")
+                                                             (* lmm " 1-Apr-85 15:27")
+                                                             (* lmm " 1-Apr-85 15:27")
     (RESETLST
+        [SELECTQ OUTSTREAM
+            (NIL (SETQ OUTSTREAM T))
+            (T)
+            (CL:UNLESS (GETSTREAM OUTSTREAM 'OUTPUT T)
+                [RESETSAVE (SETQ OUTSTREAM (OPENSTREAM OUTSTREAM 'OUTPUT 'NEW))
+                       `(PROGN (CLOSEF? OLDVALUE])]
         [RESETSAVE NIL `(PROGN (DSPFONT ,(DSPFONT NIL OUTSTREAM)
                                       ,OUTSTREAM]
-        (DOGREP STRS FILES T OUTSTREAM))])
+        [RESETSAVE (LINELENGTH T OUTSTREAM)
+               `(PROGN (LINELENGTH OLDVALUE ,OUTSTREAM]
+        (DOGREP STRS FILES OUTSTREAM)
+        OUTSTREAM)])
+
+(TGREP
+  [LAMBDA (STRS FILES)                                       (* ; "Edited 20-Jan-2024 14:14 by rmk")
+    (TEXTSTREAM (TEDIT (GREP STRS FILES (OPENTEXTSTREAM))
+                       'TGREP NIL '(READONLY T])
+)
+
+(MOVD? 'NILL 'TEDIT.FORMATTEDFILEP)
+(DEFINEQ
 
 (PHONE
   [LAMBDA (NAME)                                             (* lmm " 5-Mar-86 12:14")
@@ -97,7 +129,7 @@ Copyright (c) 1984-1986 by Xerox Corporation.
 )
 
 (RPAQ? PHONELISTFILES )
-(PUTPROPS GREP COPYRIGHT ("Xerox Corporation" 1984 1985 1986))
 (DECLARE%: DONTCOPY
-  (FILEMAP (NIL (518 4610 (DOGREP 528 . 3944) (GREP 3946 . 4423) (PHONE 4425 . 4608)))))
+  (FILEMAP (NIL (496 5830 (DOGREP 506 . 4544) (GREP 4546 . 5596) (TGREP 5598 . 5828)) (5868 6063 (PHONE 
+5878 . 6061)))))
 STOP
diff --git a/lispusers/GREP.LCOM b/lispusers/GREP.LCOM
index d738a87e..1a87767d 100644
Binary files a/lispusers/GREP.LCOM and b/lispusers/GREP.LCOM differ
diff --git a/lispusers/GREP.TEDIT b/lispusers/GREP.TEDIT
index 8312fdad..7d158344 100644
Binary files a/lispusers/GREP.TEDIT and b/lispusers/GREP.TEDIT differ
diff --git a/sources/ADIR b/sources/ADIR
index a754f300..2000ef9a 100644
--- a/sources/ADIR
+++ b/sources/ADIR
@@ -1,12 +1,12 @@
 (DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
 
-(FILECREATED "13-Nov-2023 20:28:57" {WMEDLEY}<sources>ADIR.;31 67473  
+(FILECREATED " 9-Mar-2024 10:24:39" {WMEDLEY}<sources>ADIR.;38 67777  
 
       :EDIT-BY rmk
 
-      :CHANGES-TO (FNS UNPACKFILENAME.STRING)
+      :CHANGES-TO (FNS UNPACKFILENAME.STRING FILENAMEFIELD FILENAMEFIELD.STRING \UPF.DIRECTORY)
 
-      :PREVIOUS-DATE "14-Sep-2023 23:20:17" {WMEDLEY}<sources>ADIR.;30)
+      :PREVIOUS-DATE "13-Nov-2023 20:28:57" {WMEDLEY}<sources>ADIR.;31)
 
 
 (PRETTYCOMPRINT ADIRCOMS)
@@ -317,7 +317,8 @@
 (DEFINEQ
 
 (UNPACKFILENAME.STRING
-  [LAMBDA (FILE ONEFIELDFLG DIRFLG OSTYPE PACKFLG CLFLG)     (* ; "Edited 13-Nov-2023 20:28 by rmk")
+  [LAMBDA (FILE ONEFIELDFLG DIRFLG OSTYPE PACKFLG CLFLG)     (* ; "Edited  9-Mar-2024 10:23 by rmk")
+                                                             (* ; "Edited 13-Nov-2023 20:28 by rmk")
                                                              (* ; "Edited 28-Apr-2022 11:40 by rmk")
                                                              (* ; "Edited 24-Apr-2022 14:11 by rmk")
 
@@ -367,6 +368,12 @@
 
     (* ;; "")
 
+    (* ;; "These coercions were formerly in FILENAMEFIELD and FILENAMEFIELD.STRING.  But they presumably should work everywhere.")
+
+    (SELECTQ ONEFIELDFLG
+        (STRUCTURE (SETQ ONEFIELDFLG 'DEVICE))
+        (GENERATION (SETQ ONEFIELDFLG 'VERSION))
+        NIL)
     (PROG NIL
           (COND
              ((NULL FILE)
@@ -386,6 +393,9 @@
                                                         FILE)
                                                    (LIST 'NAME FILE))]
              (T (\ILLEGAL.ARG FILE)))
+          (CL:WHEN (EQ (NCHARS FILE)
+                       0)
+                 (RETURN NIL))
 
      (* ;; 
  "Parse the string to find marker positions. The format (parens mean optional, [ ] group, | disjoins")
@@ -583,11 +593,12 @@
 
                     (* ;; "")
 
-                    (* ;; " DIRFLG is RETURN on calls (\UPFDirectoryNameP CL:USER-HOMEDIR-PATHNAME) where FILE is known to have no more than a directory, but the directory might not end with / or > (e.g. %"{DSK}/Users/kaplan%".  If we don't do something, %"kaplan%" would be seen as the NAME.  ")
+                    (* ;; " DIRFLG is RETURN on calls (\UFSDirectoryNameP CL:USER-HOMEDIR-PATHNAME) where FILE is known to have no more than a directory, but the directory might not end with / or > (e.g. %"{DSK}/Users/kaplan%".  If we don't do something, %"kaplan%" would be seen as the NAME.  ")
 
                     (CL:WHEN [AND (EQ DIRFLG 'RETURN)
-                                  (NOT (FMEMB (\GETBASECHAR $$FATP $$BASE $$END)
-                                              (CHARCODE (> / <]
+                                  (OR (ILESSP $$END $$OFFSET)
+                                      (NOT (FMEMB (\GETBASECHAR $$FATP $$BASE $$END)
+                                                  (CHARCODE (> / <]
                         (SETQ DIRSTART STARTPOS)
                         (SETQ DIREND (ADD1 $$END))
                         (SETQ DIRDIRTY T)
@@ -651,7 +662,8 @@
                                                   (PUSH $$VAL F FVAL])
 
 (\UPF.DIRECTORY
-  [LAMBDA (DIRSTART DIREND DIRDIRTY $$BASE $$FATP $$READONLY)(* ; "Edited 28-Apr-2022 09:15 by rmk")
+  [LAMBDA (DIRSTART DIREND DIRDIRTY $$BASE $$FATP $$READONLY)(* ; "Edited  8-Mar-2024 23:03 by rmk")
+                                                             (* ; "Edited 28-Apr-2022 09:15 by rmk")
                                                              (* ; "Edited 27-Apr-2022 08:50 by rmk")
                                                              (* ; "Edited 23-Apr-2022 17:09 by rmk")
 
@@ -666,9 +678,9 @@
                         NIL)))
          (IF (EQ DIREND DIRSTART)
              THEN 
-                  (* ;; "If EQ, the directory is just the bracket, the rest is must be the name.")
+                  (* ;; "If EQ, the directory is is empty.")
 
-                  BRACKET
+                  (MKSTRING "")
            ELSE (CL:WHEN BRACKET                             (* ; "Skip the < or /")
                     (ADD DIRSTART 1)) 
 
@@ -753,25 +765,15 @@
           (RETURN RESULT])
 
 (FILENAMEFIELD
-  [LAMBDA (FILE FIELDNAME)                               (* ; "Edited  6-Mar-90 19:38 by nm")
-    (UNPACKFILENAME.STRING FILE (SELECTQ FIELDNAME
-                                        ((VERSION GENERATION) 
-                                             'VERSION)
-                                        ((DEVICE STRUCTURE) 
-                                             'DEVICE)
-                                        FIELDNAME)
-           'FIELD NIL T])
+  [LAMBDA (FILE FIELDNAME)                                   (* ; "Edited  9-Mar-2024 10:24 by rmk")
+                                                             (* ; "Edited  6-Mar-90 19:38 by nm")
+    (UNPACKFILENAME.STRING FILE FIELDNAME 'FIELD NIL T])
 
 (FILENAMEFIELD.STRING
-  [LAMBDA (FILE FIELDNAME)                                   (* ; "Edited 26-Mar-2022 09:38 by rmk")
+  [LAMBDA (FILE FIELDNAME)                                   (* ; "Edited  9-Mar-2024 10:24 by rmk")
+                                                             (* ; "Edited 26-Mar-2022 09:38 by rmk")
                                                              (* ; "Edited  6-Mar-90 19:38 by nm")
-    (UNPACKFILENAME.STRING FILE (SELECTQ FIELDNAME
-                                    ((VERSION GENERATION) 
-                                         'VERSION)
-                                    ((DEVICE STRUCTURE) 
-                                         'DEVICE)
-                                    FIELDNAME)
-           'FIELD])
+    (UNPACKFILENAME.STRING FILE FIELDNAME 'FIELD])
 
 (PACKFILENAME
   [LAMBDA N                                              (* bvm%: " 5-Jul-85 15:40")
@@ -1252,14 +1254,14 @@
 (ADDTOVAR LAMA PACKFILENAME.STRING PACKFILENAME)
 )
 (DECLARE%: DONTCOPY
-  (FILEMAP (NIL (3119 15776 (DELFILE 3129 . 3290) (FULLNAME 3292 . 3659) (INFILE 3661 . 3920) (INFILEP 
-3922 . 4057) (IOFILE 4059 . 4310) (OPENFILE 4312 . 4615) (OPENSTREAM 4617 . 8957) (OUTFILE 8959 . 9221
-) (OUTFILEP 9223 . 9359) (RENAMEFILE 9361 . 9667) (SIMPLE.FINDFILE 9669 . 10079) (VMEMSIZE 10081 . 
-10248) (\COPYSYS 10250 . 14495) (\FLUSHVM 14497 . 15569) (\LOGOUT0 15571 . 15774)) (16234 38302 (
-UNPACKFILENAME.STRING 16244 . 35681) (\UPF.DIRECTORY 35683 . 38300)) (39830 42502 (UNPACKFILENAME 
-39840 . 40026) (LASTCHPOS 40028 . 40722) (FILENAMEFIELD 40724 . 41209) (FILENAMEFIELD.STRING 41211 . 
-41790) (PACKFILENAME 41792 . 42135) (PACKFILENAME.STRING 42137 . 42500)) (56972 57885 (
-FILEDIRCASEARRAY 56982 . 57883)) (58052 65232 (LOGOUT 58062 . 58979) (MAKESYS 58981 . 60610) (SYSOUT 
-60612 . 62164) (SAVEVM 62166 . 62966) (HERALD 62968 . 63128) (INTERPRET.REM.CM 63130 . 64855) (
-\USEREVENT 64857 . 65230)) (65414 67141 (USERNAME 65424 . 66380) (SETUSERNAME 66382 . 67139)))))
+  (FILEMAP (NIL (3169 15826 (DELFILE 3179 . 3340) (FULLNAME 3342 . 3709) (INFILE 3711 . 3970) (INFILEP 
+3972 . 4107) (IOFILE 4109 . 4360) (OPENFILE 4362 . 4665) (OPENSTREAM 4667 . 9007) (OUTFILE 9009 . 9271
+) (OUTFILEP 9273 . 9409) (RENAMEFILE 9411 . 9717) (SIMPLE.FINDFILE 9719 . 10129) (VMEMSIZE 10131 . 
+10298) (\COPYSYS 10300 . 14545) (\FLUSHVM 14547 . 15619) (\LOGOUT0 15621 . 15824)) (16284 38972 (
+UNPACKFILENAME.STRING 16294 . 36274) (\UPF.DIRECTORY 36276 . 38970)) (40500 42806 (UNPACKFILENAME 
+40510 . 40696) (LASTCHPOS 40698 . 41392) (FILENAMEFIELD 41394 . 41688) (FILENAMEFIELD.STRING 41690 . 
+42094) (PACKFILENAME 42096 . 42439) (PACKFILENAME.STRING 42441 . 42804)) (57276 58189 (
+FILEDIRCASEARRAY 57286 . 58187)) (58356 65536 (LOGOUT 58366 . 59283) (MAKESYS 59285 . 60914) (SYSOUT 
+60916 . 62468) (SAVEVM 62470 . 63270) (HERALD 63272 . 63432) (INTERPRET.REM.CM 63434 . 65159) (
+\USEREVENT 65161 . 65534)) (65718 67445 (USERNAME 65728 . 66684) (SETUSERNAME 66686 . 67443)))))
 STOP
diff --git a/sources/ADIR.LCOM b/sources/ADIR.LCOM
index b1836308..46046aa7 100644
Binary files a/sources/ADIR.LCOM and b/sources/ADIR.LCOM differ
diff --git a/sources/CMLSPECIALFORMS b/sources/CMLSPECIALFORMS
index 8df849ed..d75213bc 100644
--- a/sources/CMLSPECIALFORMS
+++ b/sources/CMLSPECIALFORMS
@@ -1,20 +1,20 @@
-(DEFINE-FILE-INFO READTABLE "XCL" PACKAGE "LISP")
-(IL:FILECREATED "16-May-90 14:43:08" IL:|{DSK}<usr>local>lde>lispcore>sources>CMLSPECIALFORMS.;2| 20313  
+(DEFINE-FILE-INFO PACKAGE "LISP" READTABLE "XCL" BASE 10)
 
-      IL:|changes| IL:|to:|  (IL:VARS IL:CMLSPECIALFORMSCOMS)
+(IL:FILECREATED "15-Mar-2024 20:39:04" IL:|{DSK}<home>larry>il>medley>sources>CMLSPECIALFORMS.;4| 19873  
 
-      IL:|previous| IL:|date:| "13-Jun-88 18:25:25" 
-IL:|{DSK}<usr>local>lde>lispcore>sources>CMLSPECIALFORMS.;1|)
+      :EDIT-BY "lmm"
 
+      :CHANGES-TO (IL:VARS IL:CMLSPECIALFORMSCOMS)
+
+      :PREVIOUS-DATE "15-Mar-2024 10:39:44" IL:|{DSK}<home>larry>il>medley>sources>CMLSPECIALFORMS.;2|
+)
 
-; Copyright (c) 1983, 1984, 1985, 1986, 1987, 1988, 1990 by Venue & Xerox Corporation.  All rights reserved.
 
 (IL:PRETTYCOMPRINT IL:CMLSPECIALFORMSCOMS)
 
 (IL:RPAQQ IL:CMLSPECIALFORMSCOMS
-          ((IL:COMS (IL:FUNCTIONS LOOP)
-                  (IL:COMS (IL:FUNCTIONS IDENTITY)
-                         (XCL:OPTIMIZERS IDENTITY))
+          ((IL:COMS (IL:COMS (IL:FUNCTIONS IDENTITY)
+                           (XCL:OPTIMIZERS IDENTITY))
                   (IL:FUNCTIONS UNLESS WHEN))
            (IL:FUNCTIONS FLET LABELS IL:SELECTQ)
            (IL:COMS 
@@ -31,8 +31,7 @@ IL:|{DSK}<usr>local>lde>lispcore>sources>CMLSPECIALFORMS.;1|)
 
                   (IL:COMS 
 
-                         (IL:* IL:|;;| 
-                       "Hacks for Interlisp NLAMBDAs that should look like functions")
+                         (IL:* IL:|;;| "Hacks for Interlisp NLAMBDAs that should look like functions")
 
                          (IL:PROP IL:MACRO IL:FRPTQ IL:SETN IL:SUB1VAR IL:*))
                   (IL:COMS (IL:FNS IL:BQUOTIFY)
@@ -53,13 +52,6 @@ IL:|{DSK}<usr>local>lde>lispcore>sources>CMLSPECIALFORMS.;1|)
                                                                                          (IL:NLAML)
                                                                                          (IL:LAMA)))))
 
-(DEFMACRO LOOP (&REST FORMS)
-   (LET ((TAG (GENSYM)))
-        `(PROG NIL
-               ,TAG
-               ,@FORMS
-               (GO ,TAG))))
-
 (DEFUN IDENTITY (THING)
 
    (IL:* IL:|;;| "Returns what was passed to it.  Default for :key options.")
@@ -67,7 +59,7 @@ IL:|{DSK}<usr>local>lde>lispcore>sources>CMLSPECIALFORMS.;1|)
    THING)
 
 (XCL:DEFOPTIMIZER IDENTITY (X)
-                               X)
+                           X)
 
 (DEFMACRO UNLESS (TEST &BODY BODY)
    `(COND
@@ -223,10 +215,10 @@ IL:|{DSK}<usr>local>lde>lispcore>sources>CMLSPECIALFORMS.;1|)
 
 
 (DEFMACRO DO (VARS END-TEST &BODY BODY &ENVIRONMENT ENV)
-   (%DO-TRANSLATE VARS END-TEST BODY NIL ENV))
+   (%DO-TRANSLATE VARS END-TEST BODY NIL ENV))
 
 (DEFMACRO DO* (BINDS END-TEST &REST BODY &ENVIRONMENT ENV)
-   (%DO-TRANSLATE BINDS END-TEST BODY T ENV))
+   (%DO-TRANSLATE BINDS END-TEST BODY T ENV))
 
 (DEFUN %DO-TRANSLATE (VARS END-TEST BODY SEQUENTIALP ENV)
    (LET ((VARS-AND-INITIAL-VALUES (MAPCAR #'(LAMBDA (X)
@@ -263,7 +255,7 @@ IL:|{DSK}<usr>local>lde>lispcore>sources>CMLSPECIALFORMS.;1|)
                  (GO ,TAG)))))
 
 (DEFMACRO DOLIST ((VAR LISTFORM &OPTIONAL RESULTFORM)
-                      &BODY BODY &ENVIRONMENT ENV)
+                  &BODY BODY &ENVIRONMENT ENV)
    (LET ((TAIL (GENSYM)))
         (MULTIPLE-VALUE-BIND
          (BODY DECL)
@@ -278,7 +270,7 @@ IL:|{DSK}<usr>local>lde>lispcore>sources>CMLSPECIALFORMS.;1|)
                        (SETQ ,TAIL (CDR ,TAIL)))))))
 
 (DEFMACRO DOTIMES ((VAR COUNTFORM &OPTIONAL RESULTFORM)
-                       &BODY BODY &ENVIRONMENT ENV)
+                   &BODY BODY &ENVIRONMENT ENV)
    (LET ((MAX (GENSYM)))
         (MULTIPLE-VALUE-BIND (BODY DECLS)
                (XCL:PARSE-BODY BODY ENV)
@@ -298,7 +290,7 @@ IL:|{DSK}<usr>local>lde>lispcore>sources>CMLSPECIALFORMS.;1|)
      (CLAUSES
       (MAPCAR
        #'(LAMBDA
-          (CASE)
+          (CASE)
           (LET ((KEY-LIST (CAR CASE))
                 (CONSEQUENTS (OR (CDR CASE)
                                  (LIST NIL))))
@@ -341,10 +333,10 @@ IL:|{DSK}<usr>local>lde>lispcore>sources>CMLSPECIALFORMS.;1|)
 (IL:PUTPROPS IL:SETN IL:MACRO (= . IL:SETQ))
 
 (IL:PUTPROPS IL:SUB1VAR IL:MACRO ((IL:X)
-                                          (IL:SETQ IL:X (IL:SUB1 IL:X))))
+                                  (IL:SETQ IL:X (IL:SUB1 IL:X))))
 
 (IL:PUTPROPS IL:* IL:MACRO ((IL:X . IL:Y)
-                                    'IL:X))
+                            'IL:X))
 (IL:DEFINEQ
 
 (il:bquotify
@@ -479,9 +471,11 @@ IL:|{DSK}<usr>local>lde>lispcore>sources>CMLSPECIALFORMS.;1|)
 
 (IL:ADDTOVAR IL:LAMA )
 )
-(IL:PUTPROPS IL:CMLSPECIALFORMS IL:COPYRIGHT ("Venue & Xerox Corporation" 1983 1984 1985 1986 1987 
-1988 1990))
 (IL:DECLARE\: IL:DONTCOPY
-  (IL:FILEMAP (NIL (13354 18024 (IL:BQUOTIFY 13367 . 18022)) (19227 19633 (IL:CLEAR-CLISPARRAY 19240 . 
-19631)))))
+  (IL:FILEMAP (NIL (2492 2613 (IDENTITY 2492 . 2613)) (2681 2773 (UNLESS 2681 . 2773)) (2775 2845 (WHEN 
+2775 . 2845)) (2847 4614 (FLET 2847 . 4614)) (4616 6669 (LABELS 4616 . 6669)) (6671 8466 (IL:SELECTQ 
+6671 . 8466)) (8513 8624 (DO 8513 . 8624)) (8626 8738 (DO* 8626 . 8738)) (8740 10291 (%DO-TRANSLATE 
+8740 . 10291)) (10293 10883 (DOLIST 10293 . 10883)) (10885 11388 (DOTIMES 10885 . 11388)) (11390 12562
+ (CASE 11390 . 12562)) (13026 17696 (IL:BQUOTIFY 13039 . 17694)) (18899 19305 (IL:CLEAR-CLISPARRAY 
+18912 . 19303)))))
 IL:STOP
diff --git a/sources/CMLSPECIALFORMS.LCOM b/sources/CMLSPECIALFORMS.LCOM
index 6c63702b..bcd68bff 100644
Binary files a/sources/CMLSPECIALFORMS.LCOM and b/sources/CMLSPECIALFORMS.LCOM differ
diff --git a/sources/PACKAGE-STARTUP b/sources/PACKAGE-STARTUP
index 8f6c1055..24d8e66c 100644
--- a/sources/PACKAGE-STARTUP
+++ b/sources/PACKAGE-STARTUP
@@ -1,24 +1,24 @@
-(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "XCL" BASE 10 FORMAT XCCS)
-(FILECREATED " 1-Aug-2021 18:08:23" 
-|{DSK}<Users>kaplan>Local>medley3.5>git-medley>sources>PACKAGE-STARTUP.;9| 36725  
+(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "XCL" BASE 10)
 
-      |changes| |to:|  (FUNCTIONS PACKAGE-ENABLE)
+(FILECREATED "16-Mar-2024 08:28:55" |{DSK}<home>larry>il>medley>sources>PACKAGE-STARTUP.;2| 36546  
 
-      |previous| |date:| "29-Jul-2021 20:33:07" 
-|{DSK}<Users>kaplan>Local>medley3.5>git-medley>sources>PACKAGE-STARTUP.;8|)
+      :EDIT-BY "lmm"
 
+      :CHANGES-TO (VARIABLES CMLSYMBOLS.MACROS)
+
+      :PREVIOUS-DATE " 1-Aug-2021 18:08:23" |{DSK}<home>larry>il>medley>sources>PACKAGE-STARTUP.;1|
+)
 
-; Copyright (c) 1986-1988, 1990-1991, 2021 by Venue & Xerox Corporation.
 
 (PRETTYCOMPRINT PACKAGE-STARTUPCOMS)
 
 (RPAQQ PACKAGE-STARTUPCOMS
        (
 
-(* |;;;| "Initialize the package system (LLPACKAGE must be loaded)")
+(* |;;;| "Initialize the package system (LLPACKAGE must be loaded)")
 
         
-        (* |;;| "Simple definitions for the init.  Improved in CMLPACKAGE")
+        (* |;;| "Simple definitions for the init.  Improved in CMLPACKAGE")
 
         (FUNCTIONS RETURN-FIRST-OF-THREE ERROR-MISSING-EXTERNAL-SYMBOL)
         (P (MOVD? 'ERROR-MISSING-EXTERNAL-SYMBOL 'RESOLVE-MISSING-EXTERNAL-SYMBOL)
@@ -29,20 +29,20 @@
            (MOVD? 'ERROR 'RESOLVE-IMPORT-CONFLICT)
            (MOVD? 'ERROR 'RESOLVE-UNINTERN-CONFLICT)
            (MOVD? 'RETURN-FIRST-OF-THREE 'RESOLVE-READER-CONFLICT)
-                                                             (* \; 
-        "In pre-package init all symbols are prefixed, thus the INTERLISP symbol is always default")
+                                                             (* \; 
+          "In pre-package init all symbols are prefixed, thus the INTERLISP symbol is always default")
            )
         
-        (* |;;| "Reader changes")
+        (* |;;| "Reader changes")
 
         (FUNCTIONS CHECK-SYMBOL-NAMESTRING \\NEW.READ.SYMBOL \\NEW.MKATOM)
         (VARIABLES LITATOM-PACKAGE-CONVERSION-ENABLED)
         
-        (* |;;| "Initialization tables and functions")
+        (* |;;| "Initialization tables and functions")
 
         (VARIABLES CMLSYMBOLS.VARS CMLSYMBOLS.FNNAMES CMLSYMBOLS.DECLARATORS CMLSYMBOLS.TYPENAMES 
                CMLSYMBOLS.MACROS CMLSYMBOLS.SPECIALFORMS CMLSYMBOLS.LAMBDA.LIST.KEYWORDS)
-        (VARIABLES                                           (* \; "Be very careful with this.")
+        (VARIABLES                                           (* \; "Be very careful with this.")
                CMLSYMBOLS.SHARED)
         (FUNCTIONS LITATOM.EXISTS)
         (VARIABLES LITATOM-PACKAGE-CONVERSION-TABLE)
@@ -51,13 +51,13 @@
         (FUNCTIONS PACKAGE-INIT PACKAGE-CLEAR PACKAGE-MAKE PACKAGE-HIERARCHY-INIT PACKAGE-ENABLE 
                PACKAGE-DISABLE)
         
-        (* |;;| "A hack for initialization")
+        (* |;;| "A hack for initialization")
 
         (FUNCTIONS ID)
         (PROP (FILETYPE MAKEFILE-ENVIRONMENT)
               PACKAGE-STARTUP)
         
-        (* |;;| "Initialize package system, plus functions needed in llpackage at init time")
+        (* |;;| "Initialize package system, plus functions needed in llpackage at init time")
 
         (DECLARE\: DONTEVAL@LOAD DOCOPY (P (MOVD? 'EQ 'EQL)
                                            (MOVD? 'LENGTH 'CL:LENGTH)
@@ -98,8 +98,8 @@
 
 (MOVD? 'RETURN-FIRST-OF-THREE 'RESOLVE-READER-CONFLICT)
 
-                                                             (* \; 
-        "In pre-package init all symbols are prefixed, thus the INTERLISP symbol is always default")
+                                                             (* \; 
+          "In pre-package init all symbols are prefixed, thus the INTERLISP symbol is always default")
 
 
 
@@ -126,12 +126,12 @@
 
 (CL:DEFUN \\NEW.READ.SYMBOL (BASE OFFSET LEN FATP PACKAGE EXTERNALP NONNUMERICP)
    "Read a number or symbol from the string defined by BASE OFFSET LEN FATP PACKAGE is NIL if no package was specified, a package object or a string if an unknown package was typed (causes error).  EXTERNALP is true if symbol was typed with one colon, which requires that the symbol exist and be external (unless it was a keyword).  NONNUMERICP is true if we know the symbol is not a number, e.g., some characters in it were escaped."
-   (DECLARE (CL:SPECIAL LITATOM-PACKAGE-CONVERSION-ENABLED *READTABLE* FILERDTBL CODERDTBL 
-                       *PACKAGE* *LISP-PACKAGE* *INTERLISP-PACKAGE*))
+   (DECLARE (CL:SPECIAL LITATOM-PACKAGE-CONVERSION-ENABLED *READTABLE* FILERDTBL CODERDTBL *PACKAGE*
+                   *LISP-PACKAGE* *INTERLISP-PACKAGE*))
    (OR (AND (NOT NONNUMERICP)
             (\\PARSE.NUMBER BASE OFFSET LEN FATP))
        (AND 
-            (* |;;| "The reader conversion feature is contained in this expression")
+            (* |;;| "The reader conversion feature is contained in this expression")
 
             LITATOM-PACKAGE-CONVERSION-ENABLED
             (NULL PACKAGE)
@@ -142,13 +142,13 @@
                        (FIND-SYMBOL* BASE OFFSET LEN FATP *LISP-PACKAGE*)
                        (LET ((ILSYM (FIND-SYMBOL* BASE OFFSET LEN FATP *INTERLISP-PACKAGE*)))
                             (COND
-                               ((NULL ILSYM)                 (* \; "No IL symbol, try CL")
+                               ((NULL ILSYM)                 (* \; "No IL symbol, try CL")
                                 CLSYM)
-                               ((NULL CLSYM)                 (* \; "No CL symbol, use IL")
+                               ((NULL CLSYM)                 (* \; "No CL symbol, use IL")
                                 ILSYM)
-                               ((EQ ILSYM CLSYM)             (* \; "SAME")
+                               ((EQ ILSYM CLSYM)             (* \; "SAME")
                                 ILSYM)
-                               (T                            (* \; "Both symbols exist, resolve.  During the INIT where packages are turned off this is defined to return its first argument.")
+                               (T                            (* \; "Both symbols exist, resolve.  During the INIT where packages are turned off this is defined to return its first argument.")
                                   (RESOLVE-READER-CONFLICT ILSYM CLSYM CLSYMWHERE)))))))
        (COND
           ((STRINGP PACKAGE)
@@ -164,8 +164,8 @@
                     (COND
                        ((EQ ACCESSIBLE :EXTERNAL)
                         CL:SYMBOL)
-                       ((CL::%PACKAGE-EXTERNAL-ONLY PACKAGE) (* \; 
-                             "External only packages don't error creating external symbols on read")
+                       ((CL::%PACKAGE-EXTERNAL-ONLY PACKAGE) (* \; 
+                               "External only packages don't error creating external symbols on read")
                         (INTERN* BASE OFFSET LEN FATP (\\FATCHARSEENP BASE OFFSET LEN FATP)
                                (OR PACKAGE *PACKAGE*)
                                T))
@@ -182,20 +182,20 @@
          (UNLESSRDSYS (COND
                          ((AND (EQ LEN 1)
                                (ILEQ FIRSTCHAR \\MAXTHINCHAR)
-                               |\\OneCharAtomBase|)          (* \; 
-                               "The one-character atoms live in well known places, no need to hash")
+                               |\\OneCharAtomBase|)          (* \; 
+                                 "The one-character atoms live in well known places, no need to hash")
                           (RETURN (COND
                                      ((IGREATERP FIRSTCHAR (CHARCODE "9"))
                                       (\\ADDBASE |\\OneCharAtomBase| (IDIFFERENCE FIRSTCHAR 10)))
                                      ((IGEQ FIRSTCHAR (CHARCODE "0"))
-                                                             (* \; 
-                                                           "These one-character atoms are integers")
+                                                             (* \; 
+                                                             "These one-character atoms are integers")
                                       (IDIFFERENCE FIRSTCHAR (CHARCODE "0")))
                                      (T (\\ADDBASE |\\OneCharAtomBase| FIRSTCHAR)))))
                          ((AND (ILEQ FIRSTCHAR (CHARCODE "9"))
                                (SETQ TEMP (\\PARSE.NUMBER BASE OFFST LEN FATP)))
 
-                          (* |;;| "\\PARSE.NUMBER returns a number or NIL")
+                          (* |;;| "\\PARSE.NUMBER returns a number or NIL")
 
                           (RETURN TEMP))))
          (RETURN (CL:VALUES (INTERN* BASE OFFST LEN FATP FATCHARSEENP *INTERLISP-PACKAGE* T)))))
@@ -312,7 +312,7 @@
          "WRITE-STRING" "WRITE-TO-STRING" "Y-OR-N-P" "YES-OR-NO-P" "ZEROP"))
 
 (CL:DEFPARAMETER CMLSYMBOLS.DECLARATORS '("DECLARATION" "FTYPE" "FUNCTION" "IGNORE" "INLINE" 
-                                                    "NOTINLINE" "OPTIMIZE" "SPECIAL" "TYPE"))
+                                                "NOTINLINE" "OPTIMIZE" "SPECIAL" "TYPE"))
 
 (CL:DEFPARAMETER CMLSYMBOLS.TYPENAMES
    '("ARRAY" "ATOM" "BIGNUM" "BIT" "BIT-VECTOR" "CHARACTER" "COMMON" "COMPILED-FUNCTION" "COMPLEX" 
@@ -326,20 +326,19 @@
    '("AND" "ASSERT" "CASE" "CCASE" "CHECK-TYPE" "COND" "CTYPECASE" "DECF" "DEFCONSTANT" 
            "DEFINE-MODIFY-MACRO" "DEFINE-SETF-METHOD" "DEFMACRO" "DEFPARAMETER" "DEFSETF" "DEFSTRUCT"
            "DEFTYPE" "DEFUN" "DEFVAR" "DO" "DO*" "DO-ALL-SYMBOLS" "DO-EXTERNAL-SYMBOLS" "DO-SYMBOLS"
-           "DOLIST" "DOTIMES" "ECASE" "ETYPECASE" "INCF" "LOCALLY" "LOOP" "MULTIPLE-VALUE-BIND" 
-           "MULTIPLE-VALUE-LIST" "MULTIPLE-VALUE-SETQ" "OR" "POP" "PROG" "PROG*" "PROG1" "PROG2" 
-           "PSETF" "PSETQ" "PUSH" "PUSHNEW" "REMF" "RETURN" "ROTATEF" "SETF" "SHIFTF" "STEP" "TIME" 
-           "TRACE" "TYPECASE" "UNLESS" "UNTRACE" "WHEN" "WITH-INPUT-FROM-STRING" "WITH-OPEN-FILE" 
-           "WITH-OPEN-STREAM" "WITH-OUTPUT-TO-STRING"))
+           "DOLIST" "DOTIMES" "ECASE" "ETYPECASE" "INCF" "LOCALLY" "LOOP" "LOOP-FINISH" 
+           "MULTIPLE-VALUE-BIND" "MULTIPLE-VALUE-LIST" "MULTIPLE-VALUE-SETQ" "OR" "POP" "PROG" 
+           "PROG*" "PROG1" "PROG2" "PSETF" "PSETQ" "PUSH" "PUSHNEW" "REMF" "RETURN" "ROTATEF" "SETF"
+           "SHIFTF" "STEP" "TIME" "TRACE" "TYPECASE" "UNLESS" "UNTRACE" "WHEN" 
+           "WITH-INPUT-FROM-STRING" "WITH-OPEN-FILE" "WITH-OPEN-STREAM" "WITH-OUTPUT-TO-STRING"))
 
 (CL:DEFPARAMETER CMLSYMBOLS.SPECIALFORMS
    '("BLOCK" "CATCH" "COMPILER-LET" "DECLARE" "EVAL-WHEN" "FLET" "FUNCTION" "GO" "IF" "LABELS" 
            "LAMBDA" "LET" "LET*" "MACROLET" "MULTIPLE-VALUE-CALL" "MULTIPLE-VALUE-PROG1" "PROGN" 
            "PROGV" "QUOTE" "RETURN-FROM" "SETQ" "TAGBODY" "THE" "THROW" "UNWIND-PROTECT"))
 
-(CL:DEFPARAMETER CMLSYMBOLS.LAMBDA.LIST.KEYWORDS '("&ALLOW-OTHER-KEYS" "&AUX" "&BODY" 
-                                                             "&ENVIRONMENT" "&KEY" "&OPTIONAL" 
-                                                             "&REST" "&WHOLE"))
+(CL:DEFPARAMETER CMLSYMBOLS.LAMBDA.LIST.KEYWORDS '("&ALLOW-OTHER-KEYS" "&AUX" "&BODY" "&ENVIRONMENT"
+                                                         "&KEY" "&OPTIONAL" "&REST" "&WHOLE"))
 
 (CL:DEFPARAMETER CMLSYMBOLS.SHARED
    '("+" "-" "/" "<" "<=" "=" ">" ">=" "&ALLOW-OTHER-KEYS" "&AUX" "&BODY" "&ENVIRONMENT" "&KEY" 
@@ -361,7 +360,7 @@
          "RPLACA" "RPLACD" "SATISFIES" "SEQUENCE" "SET" "STRING" "STRING-EQUAL" "STREAM" "STREAMP" 
          "T" "TAILP" "THE" "TIME" "TRACE" "TYPE" "TYPEP" "UNTRACE" "WRITE")
 
-(* |;;;| "Symbols shared by the Interlisp and Lisp packages.")
+(* |;;;| "Symbols shared by the Interlisp and Lisp packages.")
 
    )
 
@@ -388,7 +387,7 @@
 
 (CL:DEFUN NAMESTRING-CONVERSION-CLAUSE (BASE OFFSET LEN FATP)
 
-(* |;;;| "Check whether a given namestring has a prefix that would indicate membership in a package.  If so, return the first clause out of the conversion table that matched.  Otherwise, return NIL.")
+(* |;;;| "Check whether a given namestring has a prefix that would indicate membership in a package.  If so, return the first clause out of the conversion table that matched.  Otherwise, return NIL.")
 
    (DECLARE (CL:SPECIAL LITATOM-PACKAGE-CONVERSION-TABLE))
    (CL:DOLIST (CONVERSION-LIST LITATOM-PACKAGE-CONVERSION-TABLE NIL)
@@ -399,13 +398,13 @@
              (COND
                 ((AND (IGREATERP LEN PREFIX-LENGTH)
                       (\\STRING-EQUALBASE PREFIX BASE OFFSET PREFIX-LENGTH FATP)
-                      (NOT (|for| X |in| EXCEPTIONS
-                              |suchthat| (\\STRING-EQUALBASE X BASE OFFSET LEN FATP))))
+                      (NOT (|for| X |in| EXCEPTIONS |suchthat| (\\STRING-EQUALBASE X BASE OFFSET LEN
+                                                                      FATP))))
                  (RETURN CONVERSION-LIST))))))
 
 (CL:DEFUN CONVERT-LITATOM (ATOM)
 
-   (* |;;| "Conditionally move an INTERLISP litatom into a package based on the naming conventions in LITATOM-PACKAGE-CONVERSION-TABLE.")
+   (* |;;| "Conditionally move an INTERLISP litatom into a package based on the naming conventions in LITATOM-PACKAGE-CONVERSION-TABLE.")
 
    (LET* ((BASE (|ffetch| (CL:SYMBOL PNAMEBASE) |of| ATOM))
           (LEN (|ffetch| (CL:SYMBOL PNAMELENGTH) |of| ATOM))
@@ -417,17 +416,17 @@
           (WHERE (CL:FOURTH CLAUSE))
           (PREFIX-LENGTH (|ffetch| (STRINGP LENGTH)
                                 PREFIX)))
-         (\\LITATOM.EATCHARS ATOM PREFIX-LENGTH)         (* \; "Take off the pseudo-package prefix.  This makes the symbol inaccessible in INTERLISP (because not rehashed).")
+         (\\LITATOM.EATCHARS ATOM PREFIX-LENGTH)             (* \; "Take off the pseudo-package prefix.  This makes the symbol inaccessible in INTERLISP (because not rehashed).")
          (COND
-            (CL:PACKAGE-NAME                                 (* \; 
-                                                      " Symbol is interned, put it in the package.")
+            (CL:PACKAGE-NAME                                 (* \; 
+                                                        " Symbol is interned, put it in the package.")
                    (INTERN-LITATOM ATOM (CL:FIND-PACKAGE CL:PACKAGE-NAME)
                           :WHERE WHERE)))
          T))
 
 (CL:DEFUN CONCOCT-SYMBOL (STRING)
 
-   (* |;;| "Create a symbol in the LISP package.  Conflicting symbols must already have been converted and defined by CONVERT-LITATOM.  Given a string, if a symbol by that name exists in INTERLISP (and doesn't conflict) we INTERN-LITATOM it into the LISP package, making that its home.  Otherwise, we create a new one.")
+   (* |;;| "Create a symbol in the LISP package.  Conflicting symbols must already have been converted and defined by CONVERT-LITATOM.  Given a string, if a symbol by that name exists in INTERLISP (and doesn't conflict) we INTERN-LITATOM it into the LISP package, making that its home.  Otherwise, we create a new one.")
 
    (DECLARE (CL:SPECIAL *LISP-PACKAGE* *INTERLISP-PACKAGE* CMLSYMBOLS.SHARED))
    (LET (ILSYM CLSYM)
@@ -437,27 +436,27 @@
                    (CL:WHEN (EQ WHERE :INTERNAL)
                           (EXPORT SYM *LISP-PACKAGE*))
                    (SETQ CLSYM SYM)
-                   WHERE)                                    (* \; 
-    "The CL symbol already exists.  Make it external.  If the symbol is shared, import it into IL.")
+                   WHERE)                                    (* \; 
+      "The CL symbol already exists.  Make it external.  If the symbol is shared, import it into IL.")
             (CL:WHEN (CL:MEMBER STRING CMLSYMBOLS.SHARED :TEST 'STREQUAL)
                    (IMPORT CLSYM *INTERLISP-PACKAGE*)))
 
-           (* |;;| "From this point down, the CL symbol doesn't yet exist.")
+           (* |;;| "From this point down, the CL symbol doesn't yet exist.")
 
            ((CL:MEMBER STRING CMLSYMBOLS.SHARED :TEST 'STREQUAL)
-                                                             (* \; "The symbol is shared.  Create it in CL and import it to IL.  NOTE that the symbol should never be found in IL.")
+                                                             (* \; "The symbol is shared.  Create it in CL and import it to IL.  NOTE that the symbol should never be found in IL.")
             (COND
                ((CL:FIND-SYMBOL STRING *INTERLISP-PACKAGE*)
                 (CL:ERROR "Shared symbol found in IL: ~S" STRING)
 
-                (* |;;| "(intern-litatom ilsym *lisp-package* :where :external)")
+                (* |;;| "(intern-litatom ilsym *lisp-package* :where :external)")
 
                 )
                (T (LET ((SYM (CL:INTERN STRING *LISP-PACKAGE*)))
                        (EXPORT SYM *LISP-PACKAGE*)
                        (IMPORT SYM *INTERLISP-PACKAGE*)))))
-           (T                                                (* \; 
-                                                 "Symbol doesn't exist, so just create it in LISP.")
+           (T                                                (* \; 
+                                                   "Symbol doesn't exist, so just create it in LISP.")
               (EXPORT (CL:INTERN STRING *LISP-PACKAGE*)
                      *LISP-PACKAGE*)))))
 
@@ -491,8 +490,8 @@
          (COND
             ((|fetch| (LITATOM FATPNAMEP) |of| LITATOM)
              (ERROR (CONCAT "Can't move fat LITATOM |" LITATOM "| into LISP package")))
-            (T (|for| I |from| 0 |to| LEN |as| J |from| N
-                  |do| (\\PUTBASETHIN PNBASE I (\\GETBASETHIN PNBASE J)))))
+            (T (|for| I |from| 0 |to| LEN |as| J |from| N |do| (\\PUTBASETHIN PNBASE I
+                                                                      (\\GETBASETHIN PNBASE J)))))
          (|replace| (PNAMEBASE PNAMELENGTH) |of| PNBASE |with| LEN))
    LITATOM)
 
@@ -507,7 +506,7 @@
 (CL:DEFUN PACKAGE-CLEAR ()
    "Clear the global package data (used by FIND-PACKAGE) and reset the globals that hold the existing packages."
    (DECLARE (CL:SPECIAL *PACKAGE-FROM-NAME* *PACKAGE-FROM-INDEX* *PACKAGE* *LISP-PACKAGE* 
-                       *KEYWORD-PACKAGE* *INTERLISP-PACKAGE*))
+                   *KEYWORD-PACKAGE* *INTERLISP-PACKAGE*))
    (CLRHASH *PACKAGE-FROM-NAME*)
    (CL:DOTIMES (I (ADD1 *TOTAL-PACKAGES-LIMIT*))
        (CL:SETF (CL:AREF *PACKAGE-FROM-INDEX* I)
@@ -521,7 +520,7 @@
 (CL:DEFUN PACKAGE-MAKE ()
    "Create, but do not fill with symbols, the base packages that need to exist.  Also enables the package qualifier characters in the readtables and saves the old definitions of \\READ.SYMBOL and \\MKATOM."
    (DECLARE (CL:SPECIAL *LISP-PACKAGE* *KEYWORD-PACKAGE* *INTERLISP-PACKAGE* *PACKAGE* 
-                       HASHTABLE-SIZE-LIMIT))
+                   HASHTABLE-SIZE-LIMIT))
    (SETQ *INTERLISP-PACKAGE* (CL:MAKE-PACKAGE "INTERLISP" :USE NIL :NICKNAMES '("IL")
                                     :PREFIX-NAME "IL" :EXTERNAL-ONLY T :EXTERNAL-SYMBOLS 32749))
    (SETQ *LISP-PACKAGE* (CL:MAKE-PACKAGE "LISP" :USE NIL :NICKNAMES '("CL" "COMMON-LISP")
@@ -545,20 +544,20 @@
 
 (CL:DEFUN PACKAGE-HIERARCHY-INIT (&OPTIONAL (CONVERT? NIL))
 
-(* |;;;| "Fill all the initial system packages with their proper symbols, moving litatoms into appropriate places and such.  If convert? is non-nil then symbols whose pnames have fake package qualifiers, like cl:length, will be converted IN PLACE to remove the qualifier.  If conversion takes place you cannot fully disable the package system.")
+(* |;;;| "Fill all the initial system packages with their proper symbols, moving litatoms into appropriate places and such.  If convert? is non-nil then symbols whose pnames have fake package qualifiers, like cl:length, will be converted IN PLACE to remove the qualifier.  If conversion takes place you cannot fully disable the package system.")
 
    (DECLARE (CL:SPECIAL *INTERLISP-PACKAGE* *KEYWORD-PACKAGE* CMLSYMBOLS.LAMBDA.LIST.KEYWORDS 
-                       CMLSYMBOLS.SPECIALFORMS CMLSYMBOLS.MACROS CMLSYMBOLS.TYPENAMES 
-                       CMLSYMBOLS.FNNAMES CMLSYMBOLS.DECLARATORS CMLSYMBOLS.VARS))
+                   CMLSYMBOLS.SPECIALFORMS CMLSYMBOLS.MACROS CMLSYMBOLS.TYPENAMES CMLSYMBOLS.FNNAMES
+                   CMLSYMBOLS.DECLARATORS CMLSYMBOLS.VARS))
 
-   (* |;;| "Fill the INTERLISP package with its symbols.")
+   (* |;;| "Fill the INTERLISP package with its symbols.")
 
    (MAPATOMS #'(CL:LAMBDA (ATOM)
                       (CL:IF (OR (NULL CONVERT?)
                                  (NULL (CONVERT-LITATOM ATOM)))
                              (INTERN-LITATOM ATOM *INTERLISP-PACKAGE* :WHERE :EXTERNAL))))
 
-   (* |;;| "Fill the LISP package with its symbols.")
+   (* |;;| "Fill the LISP package with its symbols.")
 
    (CL:DOLIST (I (APPEND CMLSYMBOLS.VARS CMLSYMBOLS.FNNAMES CMLSYMBOLS.DECLARATORS 
                         CMLSYMBOLS.TYPENAMES CMLSYMBOLS.MACROS CMLSYMBOLS.SPECIALFORMS 
@@ -569,7 +568,7 @@
 (CL:DEFUN PACKAGE-ENABLE (&OPTIONAL (PACKAGE *INTERLISP-PACKAGE*))
    "Turn on the package system, making PACKAGE the current one and redefining \\READ.SYMBOL and \\MKATOM appropriatly."
    (DECLARE (CL:SPECIAL *INTERLISP-PACKAGE* *PACKAGE* *OLD-INTERLISP-READ-ENVIRONMENT* 
-                       *PER-EXEC-VARIABLES*))
+                   *PER-EXEC-VARIABLES*))
    (|replace| REPACKAGE |of| *OLD-INTERLISP-READ-ENVIRONMENT* |with| *INTERLISP-PACKAGE*)
    (|replace| REPACKAGE |of| *DEFINE-FILE-INFO-ENV* |with| *INTERLISP-PACKAGE*)
    (COND
@@ -643,16 +642,15 @@
 
 (PACKAGE-INIT)
 )
-(PUTPROPS PACKAGE-STARTUP COPYRIGHT ("Venue & Xerox Corporation" 1986 1987 1988 1990 1991 2021))
 (DECLARE\: DONTCOPY
-  (FILEMAP (NIL (3123 3218 (RETURN-FIRST-OF-THREE 3123 . 3218)) (3220 3358 (
-ERROR-MISSING-EXTERNAL-SYMBOL 3220 . 3358)) (3963 4931 (CHECK-SYMBOL-NAMESTRING 3963 . 4931)) (4933 
-8094 (\\NEW.READ.SYMBOL 4933 . 8094)) (8096 9802 (\\NEW.MKATOM 8096 . 9802)) (23600 23682 (
-LITATOM.EXISTS 23600 . 23682)) (24362 25328 (NAMESTRING-CONVERSION-CLAUSE 24362 . 25328)) (25330 26579
- (CONVERT-LITATOM 25330 . 26579)) (26581 28650 (CONCOCT-SYMBOL 26581 . 28650)) (28652 28946 (
-TRANSFER-SYMBOL 28652 . 28946)) (28948 29656 (INTERN-LITATOM 28948 . 29656)) (29658 30285 (
-\\LITATOM.EATCHARS 29658 . 30285)) (30287 30564 (PACKAGE-INIT 30287 . 30564)) (30566 31143 (
-PACKAGE-CLEAR 30566 . 31143)) (31145 32540 (PACKAGE-MAKE 31145 . 32540)) (32542 33863 (
-PACKAGE-HIERARCHY-INIT 32542 . 33863)) (33865 35478 (PACKAGE-ENABLE 33865 . 35478)) (35480 36123 (
-PACKAGE-DISABLE 35480 . 36123)) (36170 36196 (ID 36170 . 36196)))))
+  (FILEMAP (NIL (3015 3110 (RETURN-FIRST-OF-THREE 3015 . 3110)) (3112 3250 (
+ERROR-MISSING-EXTERNAL-SYMBOL 3112 . 3250)) (3857 4825 (CHECK-SYMBOL-NAMESTRING 3857 . 4825)) (4827 
+7985 (\\NEW.READ.SYMBOL 4827 . 7985)) (7987 9697 (\\NEW.MKATOM 7987 . 9697)) (23437 23519 (
+LITATOM.EXISTS 23437 . 23519)) (24199 25205 (NAMESTRING-CONVERSION-CLAUSE 24199 . 25205)) (25207 26462
+ (CONVERT-LITATOM 25207 . 26462)) (26464 28537 (CONCOCT-SYMBOL 26464 . 28537)) (28539 28833 (
+TRANSFER-SYMBOL 28539 . 28833)) (28835 29543 (INTERN-LITATOM 28835 . 29543)) (29545 30224 (
+\\LITATOM.EATCHARS 29545 . 30224)) (30226 30503 (PACKAGE-INIT 30226 . 30503)) (30505 31078 (
+PACKAGE-CLEAR 30505 . 31078)) (31080 32471 (PACKAGE-MAKE 31080 . 32471)) (32473 33785 (
+PACKAGE-HIERARCHY-INIT 32473 . 33785)) (33787 35396 (PACKAGE-ENABLE 33787 . 35396)) (35398 36041 (
+PACKAGE-DISABLE 35398 . 36041)) (36088 36114 (ID 36088 . 36114)))))
 STOP
diff --git a/sources/PACKAGE-STARTUP.LCOM b/sources/PACKAGE-STARTUP.LCOM
index 5bae00ca..65dd880d 100644
Binary files a/sources/PACKAGE-STARTUP.LCOM and b/sources/PACKAGE-STARTUP.LCOM differ
diff --git a/sources/XCL-LOOP b/sources/XCL-LOOP
new file mode 100644
index 00000000..99a519fa
--- /dev/null
+++ b/sources/XCL-LOOP
@@ -0,0 +1,1465 @@
+(DEFINE-FILE-INFO PACKAGE (DEFPACKAGE "LOOP" (USE "LISP" "XCL")) READTABLE "XCL" BASE 10)
+
+(il:filecreated "16-Mar-2024 17:53:42" il:|{DSK}<home>larry>il>medley>sources>XCL-LOOP.;23| 61443  
+
+      :edit-by "lmm"
+
+      :changes-to (il:functions with-temporaries)
+
+      :previous-date "16-Mar-2024 11:13:11" il:|{DSK}<home>larry>il>medley>sources>XCL-LOOP.;22|)
+
+
+(il:prettycomprint il:xcl-loopcoms)
+
+(il:rpaqq il:xcl-loopcoms
+          ((file-environments il:loop)
+           (il:structures simple-program-error)
+           (il:variables *accumulators* *anonymous-accumulator* *boolean-terminator* *current-clause*
+                  *current-keyword* *environment* *for-as-components* *for-as-subclauses* 
+                  *hash-group* *for-as-prepositions* *ignorable* *it-symbol* *it-visible-p* 
+                  *list-end-test* *loop-clauses* *loop-components* *loop-name* *loop-tokens* 
+                  *message-prefix* *symbol-group* *temporaries*)
+           (il:functions %keyword %list accumulate-in-list accumulation-clause accumulator-kind 
+                  accumulator-spec along-with always-never-thereis-clause ambiguous-loop-result-error
+                  append-context appendf bindings bound-variables by-step-fun car-type cdr-type 
+                  check-multiple-bindings cl-external-p clause* clause1 compound-forms* 
+                  compound-forms+ conditional-clause constant-bindings constant-function-p 
+                  constant-vector constant-vector-p d-var-spec-p d-var-spec1 d-var-type-spec 
+                  declarations default-binding default-bindings default-type default-value 
+                  destructuring-multiple-value-bind destructuring-multiple-value-setq 
+                  dispatch-for-as-subclause do-clause empty-p enumerate extended-loop fill-in 
+                  finally-clause for for-as-across-subclause for-as-arithmetic-possible-prepositions
+                  for-as-arithmetic-step-and-test-functions for-as-arithmetic-subclause 
+                  for-as-being-subclause for-as-clause for-as-equals-then-subclause for-as-fill-in 
+                  for-as-hash-subclause for-as-in-list-subclause for-as-on-list-subclause 
+                  for-as-package-subclause for-as-parallel-p form-or-it form1 gensym-ignorable 
+                  globally-special-p hash-d-var-spec initially-clause 
+                  invalid-accumulator-combination-error keyword1 keyword? let-form loop-error 
+                  loop-finish-test-forms loop-warn lp main-clause* mapappend 
+                  multiple-value-list-argument-form multiple-value-list-form-p name-clause? one 
+                  ordinary-bindings preposition1 preposition? psetq-forms quoted-form-p quoted-object
+                  reduce-redundant-code repeat-clause return-clause selectable-clause simple-loop 
+                  simple-var-p simple-var1 stray-of-type-error type-spec? until-clause 
+                  using-other-var variable-clause* while-clause with with-accumulators 
+                  with-binding-forms with-clause with-iterator-forms with-list-accumulator 
+                  with-loop-context with-numeric-accumulator with-temporaries zero)
+           (il:functions loop)
+           (il:prop (il:filetype il:makefile-environment il:copyright il:license)
+                  il:xcl-loop)))
+
+(define-file-environment il:loop :package (defpackage "LOOP" (:use "LISP" "XCL"))
+   :readtable "XCL")
+
+(define-condition simple-program-error (simple-condition program-error)
+   nil)
+
+(defvar *accumulators* nil)
+
+(defvar *anonymous-accumulator* nil)
+
+(defvar *boolean-terminator* nil)
+
+(defvar *current-clause* nil)
+
+(defvar *current-keyword* nil)
+
+(defvar *environment*)
+
+(defvar *for-as-components*)
+
+(defvar *for-as-subclauses*
+   (let ((table (make-hash-table)))
+        (mapc #'(lambda (spec)
+                       (destructuring-bind (subclause-name . keywords)
+                              spec
+                              (dolist (key keywords)
+                                  (setf (gethash key table)
+                                        subclause-name))))
+              '((for-as-arithmetic-subclause :from :downfrom :upfrom :to :downto :upto :below :above
+                       :by)
+                (for-as-in-list-subclause :in)
+                (for-as-on-list-subclause :on)
+                (for-as-equals-then-subclause :=)
+                (for-as-across-subclause :across)
+                (for-as-being-subclause :being)))
+        table)
+   "A table mapping for-as prepositions to their processor function-designator.")
+
+(defvar *hash-group* '(:hash-key :hash-keys :hash-value :hash-values))
+
+(defvar *for-as-prepositions*
+   (let ((prepositions nil))
+        (maphash #'(lambda (key value)
+                          (declare (ignore value))
+                          (push key prepositions))
+               *for-as-subclauses*)
+        prepositions))
+
+(defvar *ignorable* nil
+   "Ignorable temporary variables in *temporaries*.")
+
+(defvar *it-symbol* nil)
+
+(defvar *it-visible-p* nil)
+
+(defvar *list-end-test* 'atom)
+
+(defvar *loop-clauses*
+   (let ((table (make-hash-table)))
+        (mapc #'(lambda (spec)
+                       (destructuring-bind (clause-name . keywords)
+                              spec
+                              (dolist (key keywords)
+                                  (setf (gethash key table)
+                                        clause-name))))
+              '((for-as-clause :for :as)
+                (with-clause :with)
+                (do-clause :do :doing)
+                (return-clause :return)
+                (initially-clause :initially)
+                (finally-clause :finally)
+                (accumulation-clause :collect :collecting :append :appending :nconc :nconcing :count
+                       :counting :sum :summing :maximize :maximizing :minimize :minimizing)
+                (conditional-clause :if :when :unless)
+                (repeat-clause :repeat)
+                (always-never-thereis-clause :always :never :thereis)
+                (while-clause :while)
+                (until-clause :until)))
+        table)
+   "A table mapping loop keywords to their processor function-designator.")
+
+(defvar *loop-components* nil)
+
+(defvar *loop-name* nil)
+
+(defvar *loop-tokens*)
+
+(defvar *message-prefix* "")
+
+(defvar *symbol-group* '(:symbol :symbols :present-symbol :present-symbols :external-symbol 
+                               :external-symbols))
+
+(defvar *temporaries* nil
+   "Temporary variables used in with-clauses and for-as-clauses.")
+
+(defun %keyword (designator)
+   (intern (string designator)
+          "KEYWORD"))
+
+(defun %list (designator)                             (il:* il:\; "Edited 14-Mar-2024 11:46 by lmm")
+   (if (listp designator)
+       designator
+       (list designator)))
+
+(defun accumulate-in-list (form accumulator-spec)
+   (destructuring-bind (name &key var splice &allow-other-keys)
+          accumulator-spec
+          (declare (ignore name))
+          (let* ((copy-f (ecase *current-keyword*
+                             ((:collect :collecting) 'list)
+                             ((:append :appending) 'copy-list)
+                             ((:nconc :nconcing) 'identity)))
+                 (collecting-p (member *current-keyword* '(:collect :collecting)))
+                 (last-f (if collecting-p
+                             'cdr
+                             'last))
+                 (splicing-form (if collecting-p
+                                    `(rplacd ,splice (setq ,splice (list ,form)))
+                                    `(setf (cdr ,splice)
+                                           (,copy-f ,form)
+                                           ,splice
+                                           (,last-f ,splice)))))
+                (if (globally-special-p var)
+                    (lp :do `(if ,splice
+                                 ,splicing-form
+                                 (setq ,splice (,last-f (setq ,var (,copy-f ,form))))))
+                    (lp :do splicing-form)))))
+
+(defun accumulation-clause ()
+   (let* ((form (form-or-it))
+          (name (if (preposition? :into)
+                    (simple-var1)
+                    (progn (setq *anonymous-accumulator* *current-keyword*)
+                           (when *boolean-terminator* (ambiguous-loop-result-error))
+                           nil)))
+          (accumulator-spec (accumulator-spec name)))
+         (destructuring-bind (name &rest plist &key var &allow-other-keys)
+                accumulator-spec
+                (declare (ignore name))
+                (ecase *current-keyword*
+                    ((:collect :collecting :append :appending :nconc :nconcing) (accumulate-in-list
+                                                                                 form 
+                                                                                 accumulator-spec))
+                    ((:count :counting) (lp :if form :do `(incf ,var)))
+                    ((:sum :summing) (lp :do `(incf ,var ,form)))
+                    ((:maximize :maximizing :minimize :minimizing) 
+                       (let ((first-p (getf plist :first-p))
+                             (fun (if (member *current-keyword* '(:maximize :maximizing))
+                                      '<
+                                      '>)))
+                            (lp :do `(let ((value ,form))
+                                          (cond
+                                             (,first-p (setq ,first-p nil ,var value))
+                                             ((,fun ,var value)
+                                              (setq ,var value)))))))))))
+
+(defun accumulator-kind (key)
+   (ecase key
+       ((:collect :collecting :append :appending :nconc :nconcing) :list)
+       ((:sum :summing :count :counting) :total)
+       ((:maximize :maximizing :minimize :minimizing) :limit)))
+
+(defun accumulator-spec (name)
+   (let* ((kind (accumulator-kind *current-keyword*))
+          (spec (assoc name *accumulators*))
+          (plist (cdr spec)))
+         (if spec
+             (if (not (eq kind (getf plist :kind)))
+                 (invalid-accumulator-combination-error (reverse (getf plist :keys)))
+                 (progn (pushnew *current-keyword* (getf plist :keys))
+                        (when (member kind '(:total :limit))
+                            (multiple-value-bind (type supplied-p)
+                                   (type-spec?)
+                                   (when supplied-p
+                                       (push type (getf plist :types)))))))
+             (let ((var (or name (gensym "ACCUMULATOR-"))))
+                  (setq plist `(:var ,var :kind ,kind :keys (,*current-keyword*)))
+                  (ecase kind
+                      (:list 
+                         (setf (getf plist :splice)
+                               (gensym "SPLICE-"))
+                         (unless name
+                             (fill-in :results `((cdr ,var)))))
+                      ((:total :limit) 
+                         (multiple-value-bind (type supplied-p)
+                                (type-spec?)
+                                (when supplied-p
+                                    (push type (getf plist :types))))
+                         (when (eq kind :limit)
+                             (let ((first-p (gensym "FIRST-P-")))
+                                  (setf (getf plist :first-p)
+                                        first-p)
+                                  (with first-p t := t)))
+                         (unless name
+                             (fill-in :results `(,var)))))
+                  (push (setq spec `(,name ,@plist))
+                        *accumulators*)))
+         spec))
+
+(defun along-with (var type &key equals (then equals))
+   (for-as-fill-in :bindings (apply #'bindings type var (when (quoted-form-p equals)
+                                                            `(,equals))))
+   (unless (quoted-form-p equals)
+       (for-as-fill-in :after-head `((setq ,@(mapappend #'cdr (bindings type var equals))))))
+   (for-as-fill-in :after-tail `((setq ,@(mapappend #'cdr (bindings type var then))))))
+
+(defun always-never-thereis-clause ()
+   (setq *boolean-terminator* *current-keyword*)
+   (when *anonymous-accumulator* (ambiguous-loop-result-error))
+   (ecase *current-keyword*
+       (:always 
+          (lp :unless (form1)
+              :return nil :end)
+          (fill-in :results '(t)))
+       (:never (lp :always `(not ,(form1))))
+       (:thereis 
+          (lp :if (form1)
+              :return :it :end)
+          (fill-in :results '(nil)))))
+
+(defun ambiguous-loop-result-error ()
+   (error 'simple-program-error :format-control (append-context 
+                                               "~S cannot be used without `into' preposition with ~S"
+                                                       )
+          :format-arguments
+          `(,*anonymous-accumulator* ,*boolean-terminator*)))
+
+(defun append-context (message)
+   (concatenate 'string message (let ((clause (ldiff *current-clause* *loop-tokens*)))
+                                     (format nil "~%Current LOOP context:~{ ~S~}" clause))))
+
+(define-modify-macro appendf (&rest args) append
+   "Append onto list")
+
+(defun bindings (d-type-spec d-var-spec &optional (value-form "NEVER USED" value-form-p))
+   (cond
+      ((null value-form-p)
+       (default-bindings d-type-spec d-var-spec))
+      ((quoted-form-p value-form)
+       (constant-bindings d-type-spec d-var-spec (quoted-object value-form)))
+      (t (ordinary-bindings d-type-spec d-var-spec value-form))))
+
+(defun bound-variables (binding-form)
+   (let ((operator (first binding-form))
+         (second (second binding-form)))
+        (ecase operator
+            ((let let* symbol-macrolet) (mapcar #'first second))
+            ((multiple-value-bind) second)
+            ((with-package-iterator with-hash-table-iterator) `(,(first second))))))
+
+(defun by-step-fun ()
+   (if (preposition? :by)
+       (form1)
+       '#'cdr))
+
+(defun car-type (d-type-spec)
+   (if (consp d-type-spec)
+       (car d-type-spec)
+       d-type-spec))
+
+(defun cdr-type (d-type-spec)
+   (if (consp d-type-spec)
+       (cdr d-type-spec)
+       d-type-spec))
+
+(defun check-multiple-bindings (variables)
+   (mapl #'(lambda (vars)
+                  (when (member (first vars)
+                               (rest vars))
+                      (loop-error 'simple-program-error :format-control 
+                             "Variable ~S is bound more than once." :format-arguments
+                             (list (first vars)))))
+         variables))
+
+(defun cl-external-p (symbol)
+   (multiple-value-bind (cl-symbol status)
+          (find-symbol (symbol-name symbol)
+                 "CL")
+          (and (eq symbol cl-symbol)
+               (eq status :external))))
+
+(defun clause* ()
+   (loop (let ((key (keyword?)))
+              (unless key (return))
+              (clause1))))
+
+(defun clause1 ()
+   (multiple-value-bind (clause-function-designator present-p)
+          (gethash *current-keyword* *loop-clauses*)
+          (unless present-p
+              (loop-error "Unknown loop keyword ~S encountered." (car *current-clause*)))
+          (let ((*message-prefix* (format nil "LOOP ~A clause: " *current-keyword*)))
+               (funcall clause-function-designator))))
+
+(defun compound-forms* ()
+   (when (and *loop-tokens* (consp (car *loop-tokens*)))
+       (cons (pop *loop-tokens*)
+             (compound-forms*))))
+
+(defun compound-forms+ ()
+   (or (compound-forms*)
+       (loop-error "At least one compound form is needed.")))
+
+(defun conditional-clause ()
+   (let* ((*it-symbol* nil)
+          (middle (gensym "MIDDLE-"))
+          (bottom (gensym "BOTTOM-"))
+          (test-form (if (eq *current-keyword* :unless)
+                         `(not ,(form1))
+                         (form1)))
+          (condition-form `(unless ,test-form
+                               (go ,middle))))
+         (lp :do condition-form)
+         (let ((*it-visible-p* t))
+              (selectable-clause))
+         (loop (unless (preposition? :and)
+                      (return))
+               (selectable-clause))
+         (cond
+            ((preposition? :else)
+             (lp :do `(go ,bottom))
+             (fill-in :body `(,middle))
+             (let ((*it-visible-p* t))
+                  (selectable-clause))
+             (loop (unless (preposition? :and)
+                          (return))
+                   (selectable-clause))
+             (fill-in :body `(,bottom)))
+            (t (fill-in :body `(,middle))))
+         (preposition? :end)
+         (when *it-symbol*
+             (with *it-symbol*)
+             (setf (second condition-form)
+                   `(setq ,*it-symbol* ,(second condition-form))))))
+
+(defun constant-bindings (d-type-spec d-var-spec value)
+   (let ((bindings nil))
+        (labels ((dig (type var value)
+                      (cond
+                         ((null var)
+                          nil)
+                         ((simple-var-p var)
+                          (appendf bindings `((,type ,var ',value))))
+                         (t (dig (car-type type)
+                                 (car var)
+                                 (car value))
+                            (dig (cdr-type type)
+                                 (cdr var)
+                                 (cdr value))))))
+               (dig d-type-spec d-var-spec value)
+               bindings)))
+
+(defun constant-function-p (form)
+   (let ((expansion (macroexpand form *environment*)))
+        (and (consp expansion)
+             (eq (first expansion)
+                 'function)
+             (symbolp (second expansion))
+             (let ((symbol (second expansion)))
+                  (and (cl-external-p symbol)
+                       (fboundp symbol))))))
+
+(defun constant-vector (form)
+   (cond
+      ((quoted-form-p form)
+       (quoted-object form))
+      ((vectorp form)
+       form)
+      (t (error "~S is not a vector form." form))))
+
+(defun constant-vector-p (form)
+   (or (quoted-form-p form)
+       (vectorp form)))
+
+(defun d-var-spec-p (spec)
+   (or (simple-var-p spec)
+       (null spec)
+       (and (consp spec)
+            (d-var-spec-p (car spec))
+            (d-var-spec-p (cdr spec)))))
+
+(defun d-var-spec1 ()
+   (unless (and *loop-tokens* (d-var-spec-p (car *loop-tokens*)))
+          (loop-error "A destructured-variable-spec is missing."))
+   (let ((d-var-spec (pop *loop-tokens*)))
+        d-var-spec))
+
+(defun d-var-type-spec ()
+   (let ((var (d-var-spec1))
+         (type (type-spec?)))
+        (when (empty-p var)
+            (unless (member type '(nil t))
+                   (loop-warn "Type spec ~S is ignored." type))
+            (setq var (gensym)
+                  type t))
+        (values var type)))
+
+(defun declarations (bindings)
+   (let ((declarations (mapcan #'(lambda (binding)
+                                        (destructuring-bind (type var . rest)
+                                               binding
+                                               (declare (ignore rest))
+                                               (unless (eq type 't)
+                                                   `((type ,type ,var)))))
+                              bindings)))
+        (when declarations
+            `((declare ,@declarations)))))
+
+(defun default-binding (type var)
+   `(,(default-type type)
+     ,var
+     ,(default-value type)))
+
+(defun default-bindings (d-type-spec d-var-spec)
+   (let ((bindings nil))
+        (labels ((dig (type var)
+                      (cond
+                         ((null var)
+                          nil)
+                         ((simple-var-p var)
+                          (appendf bindings `(,(default-binding type var))))
+                         (t (dig (car-type type)
+                                 (car var))
+                            (dig (cdr-type type)
+                                 (cdr var))))))
+               (dig d-type-spec d-var-spec)
+               bindings)))
+
+(defun default-type (type)
+   (if (eq type t)
+       t
+       (let ((value (default-value type)))
+            (if (typep value type)
+                type
+                (let ((default-type (type-of value)))
+                     (if (subtypep type default-type)
+                         default-type
+                         (if (null value)
+                             `(or null ,type)
+                             `(or ,default-type ,type))))))))
+
+(defun default-value (type)
+   (cond
+      ((subtypep type 'bignum)
+       (1+ most-positive-fixnum))
+      ((subtypep type 'integer)
+       0)
+      ((subtypep type 'ratio)
+       1/10)
+      ((subtypep type 'float)
+       0.0)
+      ((subtypep type 'number)
+       0)
+      ((subtypep type 'character)
+       #\Space)
+      ((subtypep type 'string)
+       "")
+      ((subtypep type 'bit-vector)
+       #*0)
+      ((subtypep type 'vector)
+       #())
+      ((subtypep type 'package)
+       *package*)
+      (t nil)))
+
+(defun destructuring-multiple-value-bind (d-type-spec d-var-spec value-form)
+   (let ((mv-bindings nil)
+         (d-bindings nil)
+         (padding-temps nil)
+         temp)
+        (do ((vars d-var-spec (cdr vars))
+             (types d-type-spec (cdr-type types)))
+            ((endp vars))
+          (if (listp (car vars))
+              (progn (setq temp (gensym))
+                     (appendf mv-bindings `((t ,temp)))
+                     (appendf d-bindings `((,(car-type types)
+                                            ,(car vars)
+                                            ,temp)))
+                     (when (empty-p (car vars))
+                           (push temp padding-temps)))
+              (appendf mv-bindings `((,(car-type types)
+                                      ,(car vars))))))
+        (fill-in :binding-forms
+               `((multiple-value-bind ,(mapcar #'second mv-bindings)
+                        ,(multiple-value-list-argument-form value-form)
+                        ,@(declarations mv-bindings)
+                        ,@(when padding-temps
+                              `((declare (ignore ,@padding-temps)))))))
+        (let ((bindings (mapappend #'(lambda (d-binding)
+                                            (apply #'bindings d-binding))
+                               d-bindings)))
+             (when bindings
+                 (fill-in :binding-forms `(,(let-form bindings)))))))
+
+(defun destructuring-multiple-value-setq (d-var-spec value-form &key iterator-p)
+   (let (d-bindings mv-vars temp)
+        (do ((vars d-var-spec (cdr vars)))
+            ((endp vars))
+          (if (listp (car vars))
+              (progn (setq temp (or (pop *temporaries*)
+                                    (gensym-ignorable)))
+                     (appendf mv-vars `(,temp))
+                     (appendf d-bindings `((t ,(car vars)
+                                              ,temp))))
+              (appendf mv-vars `(,(car vars)))))
+        (let ((mv-setq-form `(multiple-value-setq ,mv-vars ,value-form))
+              (bindings nil))
+             (do ((d-bindings d-bindings (cdr d-bindings)))
+                 ((endp d-bindings))
+               (destructuring-bind (type var temp)
+                      (car d-bindings)
+                      (declare (ignore type var))
+                      (push temp *temporaries*)
+                      (appendf bindings (apply #'bindings (car d-bindings)))))
+             (when iterator-p
+                 (setq mv-setq-form `(unless ,mv-setq-form (loop-finish))))
+             (if bindings
+                 `(progn ,mv-setq-form (setq ,@(mapappend #'cdr bindings)))
+                 mv-setq-form))))
+
+(defun dispatch-for-as-subclause (var type)
+   (unless *loop-tokens* (loop-error "A preposition is missing."))
+   (let ((preposition (preposition1 *for-as-prepositions*)))
+        (multiple-value-bind (subclause-function-designator present-p)
+               (gethash preposition *for-as-subclauses*)
+               (unless present-p (loop-error "Unknown preposition ~S is supplied." preposition))
+               (push preposition *loop-tokens*)
+               (funcall subclause-function-designator var type))))
+
+(defun do-clause ()
+   (fill-in :body (compound-forms+)))
+
+(defun empty-p (d-var-spec)
+   (or (null d-var-spec)
+       (and (consp d-var-spec)
+            (empty-p (car d-var-spec))
+            (empty-p (cdr d-var-spec)))))
+
+(defun enumerate (items)
+   (case (length items)
+       (1 (format nil "~S" (first items)))
+       (2 (format nil "~S and ~S" (first items)
+                 (second items)))
+       (t (format nil "~{~S, ~}and ~S" (butlast items)
+                 (first (last items))))))
+
+(defmacro extended-loop (&rest tokens &environment environment)
+   (let
+    ((*environment* environment))
+    (with-loop-context
+     tokens
+     (let
+      ((body-tag (gensym "LOOP-BODY-"))
+       (epilogue-tag (gensym "LOOP-EPILOGUE-")))
+      (name-clause?)
+      (variable-clause*)
+      (main-clause*)
+      (when *loop-tokens* (error "Loop form tail ~S remained unprocessed." *loop-tokens*))
+      (reduce-redundant-code)
+      (destructuring-bind
+       (&key binding-forms iterator-forms initially head neck body tail finally results)
+       *loop-components*
+       (check-multiple-bindings (append *temporaries* (mapappend #'bound-variables binding-forms)
+                                       (mapcar #'(lambda (spec)
+                                                        (getf (cdr spec)
+                                                              :var))
+                                              *accumulators*)))
+       `(block ,*loop-name*
+            ,(with-temporaries
+              `(,*temporaries* :ignorable ,*ignorable*)
+              (with-accumulators
+               *accumulators*
+               (with-binding-forms
+                binding-forms
+                (with-iterator-forms
+                 iterator-forms
+                 `(macrolet ((loop-finish nil '(go ,epilogue-tag)))
+                         (tagbody ,@head ,@initially ,body-tag ,@neck ,@body ,@tail
+                                (go ,body-tag)
+                                ,epilogue-tag
+                                ,@finally
+                                ,@(when results
+                                      `((return-from ,*loop-name* ,(car results))))))))))))))))
+
+(defun fill-in (&rest args)
+   (when args
+       (appendf (getf *loop-components* (first args))
+              (second args))
+       (apply #'fill-in (cddr args))))
+
+(defun finally-clause ()
+   (fill-in :finally (compound-forms+)))
+
+(defun for (var type &rest rest)
+   (let ((*loop-tokens* rest))
+        (dispatch-for-as-subclause var type)))
+
+(defun for-as-across-subclause (var type)
+   (preposition1 :across)
+   (let* ((form (form1))
+          (vector (if (constant-vector-p form)
+                      form
+                      (gensym "VECTOR-")))
+          (length (if (constant-vector-p form)
+                      (length (constant-vector form))
+                      (gensym "LENGTH-")))
+          (i (gensym "INDEX-"))
+          (at-least-one-iteration-p (and (constant-vector-p form)
+                                         (plusp length))))
+         (unless (constant-vector-p form)
+             (for-as-fill-in :bindings `((t ,vector ,form))
+                    :bindings2
+                    `((fixnum ,length (length ,vector)))))
+         (for-as-fill-in :bindings `((fixnum ,i 0))
+                :head-tests
+                (unless at-least-one-iteration-p
+                    `((= ,i ,length)))
+                :tail-psetq
+                `(,i (1+ ,i))
+                :tail-tests
+                `((= ,i ,length)))
+         (along-with var type :equals (if at-least-one-iteration-p
+                                          `',(aref (constant-vector form)
+                                                   0)
+                                          `(aref ,vector ,i))
+                :then
+                `(aref ,vector ,i))))
+
+(defun for-as-arithmetic-possible-prepositions (used-prepositions)
+   (append (cond
+              ((intersection '(:from :downfrom :upfrom)
+                      used-prepositions)
+               nil)
+              ((intersection '(:downto :above)
+                      used-prepositions)
+               '(:from :downfrom))
+              ((intersection '(:upto :below)
+                      used-prepositions)
+               '(:from :upfrom))
+              (t '(:from :downfrom :upfrom)))
+          (cond
+             ((intersection '(:to :downto :upto :below :above)
+                     used-prepositions)
+              nil)
+             ((find :upfrom used-prepositions)
+              '(:to :upto :below))
+             ((find :downfrom used-prepositions)
+              '(:to :downto :above))
+             (t '(:to :downto :upto :below :above)))
+          (unless (find :by used-prepositions)
+              '(:by))))
+
+(defun for-as-arithmetic-step-and-test-functions (used-prepositions)
+   (let ((up-p (subsetp used-prepositions '(:below :upto :upfrom :from :to :by))))
+        (values (if up-p
+                    '+
+                    '-)
+               (cond
+                  ((member :to used-prepositions)
+                   (if up-p
+                       '>
+                       '<))
+                  ((member :upto used-prepositions)
+                   '>)
+                  ((member :below used-prepositions)
+                   '>=)
+                  ((member :downto used-prepositions)
+                   '<)
+                  ((member :above used-prepositions)
+                   '<=)
+                  (t nil)))))
+
+(defun for-as-arithmetic-subclause (var type)
+   (unless (simple-var-p var)
+          (loop-error "Destructuring on a number is invalid."))
+   (multiple-value-bind (subtype-p valid-p)
+          (subtypep type 'real)
+          (when (and (not subtype-p)
+                     valid-p)
+              (setq type 'real)))
+   (let (from to by preposition used candidates bindings)
+        (loop (setq candidates (or (for-as-arithmetic-possible-prepositions used)
+                                   (return)))
+              (push (or (setq preposition (preposition? candidates))
+                        (return))
+                    used)
+              (let ((value-form (form1)))
+                   (if (member preposition '(:from :downfrom :upfrom))
+                       (progn (setq from value-form)
+                              (appendf bindings `((,type ,var ,from))))
+                       (progn (when (not (constantp value-form *environment*))
+                                  (let ((temp (gensym)))
+                                       (appendf bindings `((number ,temp ,value-form)))
+                                       (setq value-form temp)))
+                              (ecase preposition
+                                  ((:to :downto :upto :below :above) (setq to value-form))
+                                  (:by (setq by value-form)))))))
+        (unless (intersection used '(:from :downfrom :upfrom))
+            (appendf bindings `((,type ,var ,(zero type)))))
+        (multiple-value-bind (step test)
+               (for-as-arithmetic-step-and-test-functions used)
+               (let ((tests (when test
+                                `((,test ,var ,to)))))
+                    (for-as-fill-in :bindings bindings :head-tests tests :tail-psetq
+                           `(,var (,step ,var ,(or by (one type))))
+                           :tail-tests tests)))))
+
+(defun for-as-being-subclause (var type)
+   (preposition1 :being)
+   (preposition1 '(:each :the))
+   (let* ((kind (preposition1 (append *hash-group* *symbol-group*))))
+         (cond
+            ((find kind *hash-group*)
+             (for-as-hash-subclause var type kind))
+            ((find kind *symbol-group*)
+             (for-as-package-subclause var type kind))
+            (t (loop-error "Internal logic error")))))
+
+(defun for-as-clause ()
+   (let ((*for-as-components* nil))
+        (loop (multiple-value-bind (var type)
+                     (d-var-type-spec)
+                     (dispatch-for-as-subclause var type))
+              (unless (preposition? :and)
+                     (return)))
+        (destructuring-bind (&key bindings bindings2 before-head head-psetq head-tests after-head 
+                                  before-tail tail-psetq tail-tests after-tail)
+               *for-as-components*
+               (fill-in :binding-forms `(,@(when bindings
+                                               `(,(let-form bindings)))
+                                         ,@(when bindings2
+                                               `(,(let-form bindings2))))
+                      :head
+                      `(,@before-head ,@(psetq-forms head-psetq)
+                              ,@(loop-finish-test-forms head-tests)
+                              ,@after-head)
+                      :tail
+                      `(,@before-tail ,@(psetq-forms tail-psetq)
+                              ,@(loop-finish-test-forms tail-tests)
+                              ,@after-tail)))))
+
+(defun for-as-equals-then-subclause (var type)
+   (preposition1 :=)
+   (let* ((first (form1))
+          (then (if (preposition? :then)
+                    (form1)
+                    first))
+          (parallel-p (for-as-parallel-p)))
+         (for-as-fill-in :bindings (apply #'bindings type var (when (quoted-form-p first)
+                                                                  `(,first))))
+         (if (and (not parallel-p)
+                  (consp var)
+                  (multiple-value-list-form-p first))
+             (for-as-fill-in :before-head `(,(destructuring-multiple-value-setq var (
+                                                                    multiple-value-list-argument-form
+                                                                                     first))))
+             (unless (quoted-form-p first)
+                 (for-as-fill-in :head-psetq (mapappend #'cdr (bindings type var first)))))
+         (if (and (not parallel-p)
+                  (consp var)
+                  (multiple-value-list-form-p then))
+             (for-as-fill-in :before-tail `(,(destructuring-multiple-value-setq var (
+                                                                    multiple-value-list-argument-form
+                                                                                     then))))
+             (for-as-fill-in :tail-psetq (mapappend #'cdr (bindings type var then))))))
+
+(defun for-as-fill-in (&rest key-list-pairs)
+   (when key-list-pairs
+       (destructuring-bind (key list . rest)
+              key-list-pairs
+              (appendf (getf *for-as-components* key)
+                     list)
+              (apply #'for-as-fill-in rest))))
+
+(defun for-as-hash-subclause (var type kind)
+   (let* ((hash-table (progn (preposition1 '(:in :of))
+                             (form1)))
+          (other-var (using-other-var kind))
+          (for-as-parallel-p (for-as-parallel-p))
+          (returned-p (or (pop *temporaries*)
+                          (gensym-ignorable)))
+          (iterator (gensym))
+          narrow-typed-var narrow-type)
+         (when (and (simple-var-p var)
+                    (not (typep 'nil type)))
+             (setq narrow-typed-var var narrow-type type)
+             (setq var (gensym)
+                   type
+                   `(or null ,type))
+             (for-as-fill-in :bindings `(,(default-binding narrow-type narrow-typed-var))))
+         (flet ((iterator-form nil `(with-hash-table-iterator (,iterator ,hash-table))))
+               (if for-as-parallel-p
+                   (progn (unless (constantp hash-table *environment*)
+                              (let ((temp (gensym "HASH-TABLE-")))
+                                   (for-as-fill-in :bindings `((t ,temp ,hash-table)))
+                                   (setq hash-table temp)))
+                          (fill-in :iterator-forms `(,(iterator-form))))
+                   (fill-in :binding-forms `(,(iterator-form)))))
+         (let* ((d-var-spec (hash-d-var-spec returned-p var other-var kind))
+                (d-mv-setq (destructuring-multiple-value-setq d-var-spec `(,iterator)
+                                  :iterator-p t))
+                (setters `(,d-mv-setq ,@(when narrow-typed-var
+                                            `((setq ,narrow-typed-var ,var))))))
+               (push returned-p *temporaries*)
+               (for-as-fill-in :bindings `(,@(bindings type var)
+                                           ,@(when other-var (bindings t other-var)))
+                      :after-head setters :after-tail setters))))
+
+(defun for-as-in-list-subclause (var type)
+   (preposition1 :in)
+   (let ((*list-end-test* 'endp))
+        (for `(,var)
+             `(,type)
+             :on
+             (form1)
+             :by
+             (by-step-fun))))
+
+(defun for-as-on-list-subclause (var type)
+   (preposition1 :on)
+   (let* ((form (form1))
+          (by-step-fun (by-step-fun))
+          (test *list-end-test*)
+          (list-var (if (simple-var-p var)
+                        var
+                        (gensym "LIST-")))
+          (list-type (if (simple-var-p var)
+                         type
+                         t))
+          (at-least-one-iteration-p (and (quoted-form-p form)
+                                         (not (funcall test (quoted-object form))))))
+         (for-as-fill-in :bindings `((,list-type ,list-var ,form)
+                                     ,@(unless (constant-function-p by-step-fun)
+                                           (let ((temp (gensym "STEPPER-")))
+                                                (prog1 `((t ,temp ,by-step-fun))
+                                                       (setq by-step-fun temp)))))
+                :head-tests
+                (unless at-least-one-iteration-p
+                    `((,test ,list-var)))
+                :tail-psetq
+                `(,list-var (funcall ,by-step-fun ,list-var))
+                :tail-tests
+                `((,test ,list-var)))
+         (unless (simple-var-p var)
+             (along-with var type :equals (if at-least-one-iteration-p
+                                              form
+                                              list-var)
+                    :then list-var))))
+
+(defun for-as-package-subclause (var type kind)
+   (let* ((package (if (preposition? '(:in :of))
+                       (form1)
+                       '*package*))
+          (for-as-parallel-p (for-as-parallel-p))
+          (returned-p (or (pop *temporaries*)
+                          (gensym-ignorable)))
+          (iterator (gensym))
+          (kinds (ecase kind
+                     ((:symbol :symbols) '(:internal :external :inherited))
+                     ((:present-symbol :present-symbols) '(:internal :external))
+                     ((:external-symbol :external-symbols) '(:external)))))
+         (unless (typep 'nil type)
+             (setq type `(or null ,type)))
+         (flet ((iterator-form nil `(with-package-iterator (,iterator ,package ,@kinds))))
+               (if for-as-parallel-p
+                   (progn (unless (constantp package *environment*)
+                              (let ((temp (gensym "PACKAGE-")))
+                                   (for-as-fill-in :bindings `((t ,temp ,package)))
+                                   (setq package temp)))
+                          (fill-in :iterator-forms `(,(iterator-form))))
+                   (fill-in :binding-forms `(,(iterator-form)))))
+         (let* ((d-var-spec `(,returned-p ,var))
+                (d-mv-setq (destructuring-multiple-value-setq d-var-spec `(,iterator)
+                                  :iterator-p t)))
+               (push returned-p *temporaries*)
+               (for-as-fill-in :bindings (bindings type var)
+                      :after-head
+                      `(,d-mv-setq)
+                      :after-tail
+                      `(,d-mv-setq)))))
+
+(defun for-as-parallel-p ()
+   (or *for-as-components* (and *loop-tokens* (symbolp (car *loop-tokens*))
+                                (string= (symbol-name (car *loop-tokens*))
+                                       "AND"))))
+
+(defun form-or-it ()
+   (if (and *it-visible-p* (preposition? :it))
+       (or *it-symbol* (setq *it-symbol* (gensym)))
+       (form1)))
+
+(defun form1 ()
+   (unless *loop-tokens* (loop-error "A normal lisp form is missing."))
+   (pop *loop-tokens*))
+
+(defun gensym-ignorable ()
+   (let ((var (gensym)))
+        (push var *ignorable*)
+        var))
+
+(defun globally-special-p (symbol)
+   (assert (symbolp symbol))
+   (il:variable-globally-special-p symbol))
+
+(defun hash-d-var-spec (returned-p var other-var kind)
+   (if (find kind '(:hash-key :hash-keys))
+       `(,returned-p ,var ,other-var)
+       `(,returned-p ,other-var ,var)))
+
+(defun initially-clause ()
+   (fill-in :initially (compound-forms+)))
+
+(defun invalid-accumulator-combination-error (keys)
+   (loop-error "Accumulator ~S cannot be mixed with ~S." *current-keyword* (enumerate keys)))
+
+(defun keyword1 (keyword-list-designator &key prepositionp)
+   (let ((keywords (%list keyword-list-designator)))
+        (or (keyword? keywords)
+            (let ((length (length keywords))
+                  (kind (if prepositionp
+                            "preposition"
+                            "keyword")))
+                 (case length
+                     (0 (loop-error "A loop ~A is missing." kind))
+                     (1 (loop-error "Loop ~A ~S is missing." kind (car keywords)))
+                     (t (loop-error "One of the loop ~As ~S must be supplied." kind keywords)))))))
+
+(defun keyword? (&optional keyword-list-designator)
+   (and *loop-tokens* (symbolp (car *loop-tokens*))
+        (let ((keyword-list (%list keyword-list-designator))
+              (keyword (%keyword (car *loop-tokens*))))
+             (and (or (null keyword-list)
+                      (find keyword keyword-list))
+                  (setq *current-clause* *loop-tokens* *loop-tokens* (rest *loop-tokens*)
+                        *current-keyword* keyword)))))
+
+(defun let-form (bindings)
+   `(let ,(mapcar #'cdr bindings)
+         ,@(declarations bindings)))
+
+(defun loop-error (datum &rest arguments)
+   (when (stringp datum)
+       (setq datum (append-context datum)))
+   (apply #'error datum arguments))
+
+(defun loop-finish-test-forms (tests)
+   (case (length tests)
+       (0 nil)
+       (1 `((when ,@tests (loop-finish))))
+       (t `((when (or ,@tests)
+                  (loop-finish))))))
+
+(defun loop-warn (datum &rest arguments)
+   (when (stringp datum)
+       (setq datum (append-context datum)))
+   (apply #'warn datum arguments))
+
+(defun lp (&rest tokens)
+   (let ((*loop-tokens* tokens)
+         *current-keyword* *current-clause*)
+        (clause*)
+        (when *loop-tokens* (error "~S remained after lp." *loop-tokens*))))
+
+(defun main-clause* ()
+   (loop (if (keyword? '(:do :doing :return :if :when :unless :initially :finally :while :until 
+                             :repeat :always :never :thereis :collect :collecting :append :appending
+                             :nconc :nconcing :count :counting :sum :summing :maximize :maximizing 
+                             :minimize :minimizing))
+             (clause1)
+             (return))))
+
+(defun mapappend (function &rest lists)
+   (apply #'append (apply #'mapcar function lists)))
+
+(defun multiple-value-list-argument-form (form)
+   (let ((expansion form)
+         (expanded-p nil))
+        (loop (when (and (consp expansion)
+                         (eq (first expansion)
+                             'multiple-value-list))
+                  (return (second expansion)))
+              (multiple-value-setq (expansion expanded-p)
+                     (macroexpand-1 expansion *environment*))
+              (unless expanded-p (error "~S is not expanded into a multiple-value-list form." form)))
+        ))
+
+(defun multiple-value-list-form-p (form)
+   (let (expanded-p)
+        (loop (when (and (consp form)
+                         (eq (first form)
+                             'multiple-value-list))
+                    (return t))
+              (multiple-value-setq (form expanded-p)
+                     (macroexpand-1 form *environment*))
+              (unless expanded-p (return nil)))))
+
+(defun name-clause? ()
+   (when (keyword? :named)
+       (unless *loop-tokens* (loop-error "A loop name is missing."))
+       (let ((name (pop *loop-tokens*)))
+            (unless (symbolp name)
+                   (loop-error "~S cannot be a loop name which must be a symbol." name))
+            (setq *loop-name* name))))
+
+(defun one (type)
+   (cond
+      ((subtypep type 'short-float)
+       1.0)
+      ((subtypep type 'single-float)
+       1.0)
+      ((subtypep type 'double-float)
+       1.0)
+      ((subtypep type 'long-float)
+       1.0)
+      ((subtypep type 'float)
+       1.0)
+      (t 1)))
+
+(defun ordinary-bindings (d-type-spec d-var-spec value-form)
+   (let ((temporaries *temporaries*)
+         (bindings nil))
+        (labels ((dig (type var form temp)
+                      (cond
+                         ((empty-p var)
+                          nil)
+                         ((simple-var-p var)
+                          (when temp (push temp temporaries))
+                          (appendf bindings `((,type ,var ,form))))
+                         ((empty-p (car var))
+                          (dig (cdr-type type)
+                               (cdr var)
+                               `(cdr ,form)
+                               temp))
+                         ((empty-p (cdr var))
+                          (when temp (push temp temporaries))
+                          (dig (car-type type)
+                               (car var)
+                               `(car ,form)
+                               nil))
+                         (t (unless temp
+                                (setq temp (or (pop temporaries)
+                                               (gensym))))
+                            (dig (car-type type)
+                                 (car var)
+                                 `(car (setq ,temp ,form))
+                                 nil)
+                            (dig (cdr-type type)
+                                 (cdr var)
+                                 `(cdr ,temp)
+                                 temp)))))
+               (dig d-type-spec d-var-spec value-form nil)
+               (setq *temporaries* temporaries)
+               bindings)))
+
+(defun preposition1 (&optional keyword-list-designator)
+   (let ((*current-keyword* *current-keyword*)
+         (*current-clause* *current-clause*))
+        (keyword1 keyword-list-designator :prepositionp t)))
+
+(defun preposition? (&optional keyword-list-designator)
+   (let ((*current-keyword* *current-keyword*)
+         (*current-clause* *current-clause*))
+        (keyword? keyword-list-designator)))
+
+(defun psetq-forms (args)
+   (assert (evenp (length args)))
+   (case (length args)
+       (0 nil)
+       (2 `((setq ,@args)))
+       (t `((psetq ,@args)))))
+
+(defun quoted-form-p (form)
+   (let ((expansion (macroexpand form *environment*)))
+        (and (consp expansion)
+             (eq (first expansion)
+                 'quote))))
+
+(defun quoted-object (form)
+   (let ((expansion (macroexpand form *environment*)))
+        (destructuring-bind (quote-special-operator object)
+               expansion
+               (assert (eq quote-special-operator 'quote))
+               object)))
+
+(defun reduce-redundant-code ()
+   (when (null (getf *loop-components* :initially))
+       (let ((rhead (reverse (getf *loop-components* :head)))
+             (rtail (reverse (getf *loop-components* :tail)))
+             (neck nil))
+            (loop (when (or (null rhead)
+                            (null rtail)
+                            (not (equal (car rhead)
+                                        (car rtail))))
+                        (return))
+                  (push (pop rhead)
+                        neck)
+                  (pop rtail))
+            (setf (getf *loop-components* :head)
+                  (nreverse rhead)
+                  (getf *loop-components* :neck)
+                  neck
+                  (getf *loop-components* :tail)
+                  (nreverse rtail)))))
+
+(defun repeat-clause ()
+   (let* ((form (form1))
+          (type (typecase (if (quoted-form-p form)
+                              (quoted-object form)
+                              form)
+                    (fixnum 'fixnum)
+                    (t 'real))))
+         (lp :for (gensym)
+             :of-type type :downfrom form :to 1)))
+
+(defun return-clause ()
+   (lp :do `(return-from ,*loop-name* ,(form-or-it))))
+
+(defun selectable-clause ()
+   (let ((*current-keyword* *current-keyword*)
+         (*current-clause* *current-clause*))
+        (unless (keyword? '(:if :when :unless :do :doing :return :collect :collecting :append 
+                                :appending :nconc :nconcing :count :counting :sum :summing :maximize
+                                :maximizing :minimize :minimizing))
+               (loop-error "A selectable-clause is missing."))
+        (ecase *current-keyword*
+            ((:if :when :unless) (conditional-clause))
+            ((:do :doing) (do-clause))
+            ((:return) (return-clause))
+            ((:collect :collecting :append :appending :nconc :nconcing :count :counting :sum :summing
+                    :maximize :maximizing :minimize :minimizing) (accumulation-clause)))))
+
+(defmacro simple-loop (&rest compound-forms)
+   (let ((top (gensym)))
+        `(block nil
+             (tagbody ,top ,@compound-forms (go ,top)))))
+
+(defun simple-var-p (var)
+   (and (not (null var))
+        (symbolp var)))
+
+(defun simple-var1 ()
+   (unless (and *loop-tokens* (simple-var-p (car *loop-tokens*)))
+          (loop-error "A simple variable name is missing."))
+   (pop *loop-tokens*))
+
+(defun stray-of-type-error ()
+   (loop-error "OF-TYPE keyword should be followed by a type spec."))
+
+(defun type-spec? ()
+   (let ((type t)
+         (supplied-p nil))
+        (when (or (and (preposition? :of-type)
+                       (or *loop-tokens* (stray-of-type-error)))
+                  (and *loop-tokens* (member (car *loop-tokens*)
+                                            '(fixnum float t nil))))
+            (setq type (pop *loop-tokens*)
+                  supplied-p t))
+        (values type supplied-p)))
+
+(defun until-clause ()
+   (lp :while `(not ,(form1))))
+
+(defun using-other-var (kind)
+   (let ((using-phrase (when (preposition? :using)
+                             (pop *loop-tokens*)))
+         (other-key-name (if (find kind '(:hash-key :hash-keys))
+                             "HASH-VALUE"
+                             "HASH-KEY")))
+        (when using-phrase
+            (destructuring-bind (other-key other-var)
+                   using-phrase
+                   (unless (string= other-key other-key-name)
+                          (loop-error "Keyword ~A is missing." other-key-name))
+                   other-var))))
+
+(defun variable-clause* ()
+   (loop (let ((key (keyword? '(:with :initially :finally :for :as))))
+              (if key
+                  (clause1)
+                  (return)))))
+
+(defun while-clause ()
+   (lp :unless (form1)
+       :do
+       '(loop-finish)
+       :end))
+
+(defun with (var &optional (type t)
+                 &key
+                 (= (default-value type)))
+   (fill-in :binding-forms `(,(let-form `((,type ,var ,=))))))
+
+(defun with-accumulators (accumulator-specs form)
+   (if (null accumulator-specs)
+       form
+       (destructuring-bind (spec . rest)
+              accumulator-specs
+              (ecase (getf (cdr spec)
+                           :kind)
+                  (:list (with-list-accumulator spec (with-accumulators rest form)))
+                  ((:total :limit) (with-numeric-accumulator spec (with-accumulators rest form)))))))
+
+(defun with-binding-forms (binding-forms form)
+   (if (null binding-forms)
+       form
+       (destructuring-bind (binding-form0 . rest)
+              binding-forms
+              (append binding-form0 (list (with-binding-forms rest form))))))
+
+(defun with-clause ()
+   (let ((d-bindings nil))
+        (loop (multiple-value-bind (var type)
+                     (d-var-type-spec)
+                     (let ((rest (when (preposition? :=)
+                                     `(,(form1)))))
+                          (appendf d-bindings `((,type ,var ,@rest)))))
+              (unless (preposition? :and)
+                     (return)))
+        (destructuring-bind (d-binding0 . rest)
+               d-bindings
+               (if (and (null rest)
+                        (cddr d-binding0)
+                        (destructuring-bind (type var form)
+                               d-binding0
+                               (declare (ignore type))
+                               (and (consp var)
+                                    (multiple-value-list-form-p form))))
+                   (apply #'destructuring-multiple-value-bind d-binding0)
+                   (let ((bindings (mapappend #'(lambda (d-binding)
+                                                       (apply #'bindings d-binding))
+                                          d-bindings)))
+                        (fill-in :binding-forms `(,(let-form bindings))))))))
+
+(defun with-iterator-forms (iterator-forms form)
+   (if (null iterator-forms)
+       form
+       (destructuring-bind ((iterator-macro spec) . rest)
+              iterator-forms
+              `(,iterator-macro ,spec ,(with-iterator-forms rest form)))))
+
+(defun with-list-accumulator (accumulator-spec form)
+   (destructuring-bind (name &key var splice &allow-other-keys)
+          accumulator-spec
+          (let* ((anonymous-p (null name))
+                 (list-var (if (or anonymous-p (globally-special-p var))
+                               var
+                               (gensym "LIST-")))
+                 (value-form (if (and (not anonymous-p)
+                                      (globally-special-p var))
+                                 nil
+                                 '(list nil)))
+                 (form (if (and (not anonymous-p)
+                                (not (globally-special-p var)))
+                           `(symbol-macrolet ((,var (cdr ,list-var)))
+                                   ,form)
+                           form)))
+                `(let ((,list-var ,value-form))
+                      (declare (type list ,list-var))
+                      (let ((,splice ,list-var))
+                           (declare (type list ,splice))
+                           ,form)))))
+
+(defmacro with-loop-context (tokens &body body)
+   `(let ((*loop-tokens* ,tokens)
+          (*loop-name* nil)
+          (*current-keyword* nil)
+          (*current-clause* nil)
+          (*loop-components* nil)
+          (*temporaries* nil)
+          (*ignorable* nil)
+          (*accumulators* nil)
+          (*anonymous-accumulator* nil)
+          (*boolean-terminator* nil)
+          (*message-prefix* "LOOP: "))
+         ,@body))
+
+(defun with-numeric-accumulator (accumulator-spec form)
+   (destructuring-bind (name &key var types &allow-other-keys)
+          accumulator-spec
+          (labels ((type-eq (a b)
+                          (and (subtypep a b)
+                               (subtypep b a))))
+                 (when (null types)
+                     (setq types '(number)))
+                 (destructuring-bind (type0 . rest)
+                        types
+                        (when (and rest (notevery #'(lambda (type)
+                                                           (type-eq type0 type))
+                                               types))
+                            (warn "Different types ~A are declared for ~A accumulator." (enumerate
+                                                                                         types)
+                                  (or name "the anonymous")))
+                        (let ((type (if rest
+                                        `(or ,type0 ,@rest)
+                                        type0)))
+                             `(let ((,var ,(zero type)))
+                                   (declare (type ,type ,var))
+                                   ,form))))))
+
+(defun with-temporaries (temporary-specs form)        (il:* il:\; "Edited 16-Mar-2024 14:22 by lmm")
+   (destructuring-bind (temporaries &key ((:ignorable ignorable-vars)))
+          temporary-specs
+          (if temporaries
+              `(let ,temporaries ,@(when ignorable
+                                       `((declare (ignorable ,@ignorable))))
+                    ,form)
+              form)))
+
+(defun zero (type)
+   (cond
+      ((subtypep type 'short-float)
+       0.0)
+      ((subtypep type 'single-float)
+       0.0)
+      ((subtypep type 'double-float)
+       0.0)
+      ((subtypep type 'long-float)
+       0.0)
+      ((subtypep type 'float)
+       0.0)
+      (t 0)))
+
+(defmacro loop (&rest forms)
+   (if (every #'consp forms)
+       `(simple-loop ,@forms)
+       `(extended-loop ,@forms)))
+
+(il:putprops il:xcl-loop il:filetype :compile-file)
+
+(il:putprops il:xcl-loop il:makefile-environment (:readtable "XCL" :package (defpackage "LOOP"
+                                                                                   (:use "LISP" "XCL"
+                                                                                         ))))
+
+(il:putprops il:xcl-loop il:copyright (("Interlisp.org" 2004)
+                                       ("Yuji Minejima <ggb01164@nifty.ne.jp>")
+                                       2002 2004))
+
+(il:putprops il:xcl-loop il:license "See COPYRIGHT and LICENSE in the repository
+;; $Id: loop.lisp,v 1.38 2005/04/16 07:34:27 yuji Exp $
+;;
+;; Redistribution and use in source and binary forms, with or without
+;; modification, are permitted provided that the following conditions
+;; are met:
+;;
+;;  * Redistributions of source code must retain the above copyright
+;;    notice, this list of conditions and the following disclaimer.
+;;  * Redistributions in binary form must reproduce the above copyright
+;;    notice, this list of conditions and the following disclaimer in
+;;    the documentation and/or other materials provided with the
+;;    distribution.
+;;
+;; THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
+;; 'AS IS' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
+;; LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR
+;; A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT
+;; OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
+;; SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT
+;; LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,
+;; DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY
+;; THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
+;; (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
+;; OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.")
+(il:declare\: il:dontcopy
+  (il:filemap (nil (6736 6821 (%keyword 6736 . 6821)) (6823 7006 (%list 6823 . 7006)) (7008 8265 (
+accumulate-in-list 7008 . 8265)) (8267 9947 (accumulation-clause 8267 . 9947)) (9949 10183 (
+accumulator-kind 9949 . 10183)) (10185 12074 (accumulator-spec 10185 . 12074)) (12076 12545 (
+along-with 12076 . 12545)) (12547 13039 (always-never-thereis-clause 12547 . 13039)) (13041 13400 (
+ambiguous-loop-result-error 13041 . 13400)) (13402 13617 (append-context 13402 . 13617)) (13696 14073 
+(bindings 13696 . 14073)) (14075 14415 (bound-variables 14075 . 14415)) (14417 14507 (by-step-fun 
+14417 . 14507)) (14509 14615 (car-type 14509 . 14615)) (14617 14723 (cdr-type 14617 . 14723)) (14725 
+15122 (check-multiple-bindings 14725 . 15122)) (15124 15344 (cl-external-p 15124 . 15344)) (15346 
+15475 (clause* 15346 . 15475)) (15477 15877 (clause1 15477 . 15877)) (15879 16036 (compound-forms* 
+15879 . 16036)) (16038 16162 (compound-forms+ 16038 . 16162)) (16164 17422 (conditional-clause 16164
+ . 17422)) (17424 18135 (constant-bindings 17424 . 18135)) (18137 18508 (constant-function-p 18137 . 
+18508)) (18510 18704 (constant-vector 18510 . 18704)) (18706 18797 (constant-vector-p 18706 . 18797)) 
+(18799 18991 (d-var-spec-p 18799 . 18991)) (18993 19223 (d-var-spec1 18993 . 19223)) (19225 19550 (
+d-var-type-spec 19225 . 19550)) (19552 20112 (declarations 19552 . 20112)) (20114 20224 (
+default-binding 20114 . 20224)) (20226 20839 (default-bindings 20226 . 20839)) (20841 21302 (
+default-type 20841 . 21302)) (21304 21825 (default-value 21304 . 21825)) (21827 23317 (
+destructuring-multiple-value-bind 21827 . 23317)) (23319 24604 (destructuring-multiple-value-setq 
+23319 . 24604)) (24606 25133 (dispatch-for-as-subclause 24606 . 25133)) (25135 25204 (do-clause 25135
+ . 25204)) (25206 25382 (empty-p 25206 . 25382)) (25384 25658 (enumerate 25384 . 25658)) (25660 27386 
+(extended-loop 25660 . 27386)) (27388 27559 (fill-in 27388 . 27559)) (27561 27638 (finally-clause 
+27561 . 27638)) (27640 27758 (for 27640 . 27758)) (27760 29116 (for-as-across-subclause 27760 . 29116)
+) (29118 30040 (for-as-arithmetic-possible-prepositions 29118 . 30040)) (30042 30758 (
+for-as-arithmetic-step-and-test-functions 30042 . 30758)) (30760 32705 (for-as-arithmetic-subclause 
+30760 . 32705)) (32707 33157 (for-as-being-subclause 32707 . 33157)) (33159 34375 (for-as-clause 33159
+ . 34375)) (34377 35905 (for-as-equals-then-subclause 34377 . 35905)) (35907 36185 (for-as-fill-in 
+35907 . 36185)) (36187 38153 (for-as-hash-subclause 36187 . 38153)) (38155 38401 (
+for-as-in-list-subclause 38155 . 38401)) (38403 39896 (for-as-on-list-subclause 38403 . 39896)) (39898
+ 41600 (for-as-package-subclause 39898 . 41600)) (41602 41833 (for-as-parallel-p 41602 . 41833)) (
+41835 41983 (form-or-it 41835 . 41983)) (41985 42104 (form1 41985 . 42104)) (42106 42206 (
+gensym-ignorable 42106 . 42206)) (42208 42319 (globally-special-p 42208 . 42319)) (42321 42500 (
+hash-d-var-spec 42321 . 42500)) (42502 42583 (initially-clause 42502 . 42583)) (42585 42742 (
+invalid-accumulator-combination-error 42585 . 42742)) (42744 43361 (keyword1 42744 . 43361)) (43363 
+43833 (keyword? 43363 . 43833)) (43835 43944 (let-form 43835 . 43944)) (43946 44100 (loop-error 43946
+ . 44100)) (44102 44293 (loop-finish-test-forms 44102 . 44293)) (44295 44447 (loop-warn 44295 . 44447)
+) (44449 44653 (lp 44449 . 44653)) (44655 45092 (main-clause* 44655 . 45092)) (45094 45190 (mapappend 
+45094 . 45190)) (45192 45722 (multiple-value-list-argument-form 45192 . 45722)) (45724 46117 (
+multiple-value-list-form-p 45724 . 46117)) (46119 46457 (name-clause? 46119 . 46457)) (46459 46738 (
+one 46459 . 46738)) (46740 48385 (ordinary-bindings 46740 . 48385)) (48387 48604 (preposition1 48387
+ . 48604)) (48606 48807 (preposition? 48606 . 48807)) (48809 48969 (psetq-forms 48809 . 48969)) (48971
+ 49151 (quoted-form-p 48971 . 49151)) (49153 49408 (quoted-object 49153 . 49408)) (49410 50214 (
+reduce-redundant-code 49410 . 50214)) (50216 50570 (repeat-clause 50216 . 50570)) (50572 50662 (
+return-clause 50572 . 50662)) (50664 51499 (selectable-clause 50664 . 51499)) (51501 51652 (
+simple-loop 51501 . 51652)) (51654 51732 (simple-var-p 51654 . 51732)) (51734 51918 (simple-var1 51734
+ . 51918)) (51920 52027 (stray-of-type-error 51920 . 52027)) (52029 52463 (type-spec? 52029 . 52463)) 
+(52465 52531 (until-clause 52465 . 52531)) (52533 53114 (using-other-var 52533 . 53114)) (53116 53310 
+(variable-clause* 53116 . 53310)) (53312 53416 (while-clause 53312 . 53416)) (53418 53597 (with 53418
+ . 53597)) (53599 54044 (with-accumulators 53599 . 54044)) (54046 54296 (with-binding-forms 54046 . 
+54296)) (54298 55529 (with-clause 54298 . 55529)) (55531 55790 (with-iterator-forms 55531 . 55790)) (
+55792 56875 (with-list-accumulator 55792 . 56875)) (56877 57314 (with-loop-context 56877 . 57314)) (
+57316 58554 (with-numeric-accumulator 57316 . 58554)) (58556 58973 (with-temporaries 58556 . 58973)) (
+58975 59255 (zero 58975 . 59255)) (59257 59390 (loop 59257 . 59390)))))
+il:stop
diff --git a/sources/XCL-LOOP.DFASL b/sources/XCL-LOOP.DFASL
new file mode 100644
index 00000000..b2bb4c40
Binary files /dev/null and b/sources/XCL-LOOP.DFASL differ
