diff --git a/lispusers/COMPAREDIRECTORIES b/lispusers/COMPAREDIRECTORIES
index 3d21c8f8..32658929 100644
--- a/lispusers/COMPAREDIRECTORIES
+++ b/lispusers/COMPAREDIRECTORIES
@@ -1 +1 @@
-(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
(FILECREATED "23-Oct-2020 12:29:12" 
{DSK}<Users>kaplan>Local>medley3.5>lispcore>lispusers>COMPAREDIRECTORIES.;271 62619  

      changes to%:  (FNS SOURCE-FOR-COMPILED-P)

      previous date%: "16-Oct-2020 13:45:01" 
{DSK}<Users>kaplan>Local>medley3.5>lispcore>lispusers>COMPAREDIRECTORIES.;270)


(* ; "
Copyright (c) 1985, 1986, 1987, 1988, 1990, 1994, 1998, 2018, 2020 by Venue & Xerox Corporation.  All rights reserved.
")

(PRETTYCOMPRINT COMPAREDIRECTORIESCOMS)

(RPAQQ COMPAREDIRECTORIESCOMS
       (
        (* ;; "Compare the contents of two directories.")

        (FNS COMPAREDIRECTORIES CDFILES COMPAREDIRECTORIES.INFOS MATCHNAME)
        (FNS CDPRINT CDPRINT.LINE)
        (FNS CDMAP CDENTRY CDSUBSET)
        (FNS BINCOMP EOLTYPE)
        (RECORDS CDENTRY CDINFO)
        
        (* ;; "look for compiled files older than the sources")

        (FNS FIND-UNCOMPILED-FILES FIND-UNSOURCED-FILES FIND-SOURCE-FILES FIND-COMPILED-FILES 
             FIND-UNLOADED-FILES FIND-LOADED-FILES FIND-MULTICOMPILED-FILES)
        (FNS CREATED-AS SOURCE-FOR-COMPILED-P COMPILE-SOURCE-DATE-DIFF)
        (FNS FIX-DIRECTORY-DATES FIX-EQUIV-DATES COPY-COMPARED-FILES COPY-MISSING-FILES 
             COMPILED-ON-SAME-SOURCE)
        [VARS (ONESECOND (IDIFFERENCE (IDATE "1-Jan-2020 12:00:01")
                                (IDATE "1-Jan-2020 12:00:00"]
        (INITVARS (LASTCDENTRIES NIL))
        (COMS (FNS COMPARE-ENTRY-SOURCE-FILES)
              (FILES COMPARESOURCES))))



(* ;; "Compare the contents of two directories.")

(DEFINEQ

(COMPAREDIRECTORIES
  [LAMBDA (DIR1 DIR2 SELECT FILEPATTERNS EXTENSIONSTOAVOID USEDIRECTORYDATE OUTPUTFILE ALLVERSIONS)
                                                            (* ; "Edited 14-Oct-2020 21:15 by rmk:")

    (* ;; "Compare the contents of two directories, e.g., for change-control purposes.  Compares files matching FILEPATTERN (or *.*;) on DIR1 and DIR2, listing which is newer, or when one is not found on the other.  If SELECT is or contains SAME/=, BEFORE/<, AFTER/>, then files where DIR1 is the same as, earlier than, or later than DIR2 are selected. SELECT= NIL is the same as (<  >), T is the same as (< > =).  Also allows selection based on file-length criteria.")

    (* ;; "")

    (* ;; "Unless USEDIRECTORYDATE, comparison is with respect to the the LISP filecreated dates if evailable.")

    (* ;; "")

    (* ;; "If OUTPUTFILE is NIL, the list of compared entries is returned.  Otherwise the selected entries are printed on OUTPUTFILE (T for the display).")

    [SETQ SELECT (SELECTQ SELECT
                     (NIL '(< > -* *-))
                     (T '(< > -* *- =))
                     (FOR S IN (MKLIST SELECT) COLLECT (SELECTQ S
                                                                       ((AFTER >) 
                                                                            '>)
                                                                       ((BEFORE <) 
                                                                            '<)
                                                                       ((SAME SAMEDATE =) 
                                                                            '=)
                                                                       (AUTHOR 'AUTHOR)
                                                                       (-* '-*)
                                                                       (*- '*-)
                                                                       (ERROR 
                                                                      "UNRECOGNIZED SELECT PARAMETER"
                                                                              S]
    (PROG (INFOS1 INFOS2 CANDIDATES SELECTED COMPAREDATE DEPTH1 DEPTH2)
          [SETQ COMPAREDATE (INTERSECTION SELECT '(< > =]

     (* ;; "DIRECTORYNAME here to get unrelativized specifications for header.")

     (* ;; "Allow all subdirectories if a directory ends in *, but peel it off for the resolution")

          (CL:WHEN (EQ '* (NTHCHAR DIR1 -1))
              (SETQ DEPTH1 T)
              (SETQ DIR1 (SUBSTRING DIR1 1 -2)))
          (CL:WHEN (EQ '* (NTHCHAR DIR2 -1))
              (SETQ DEPTH2 T)
              (SETQ DIR2 (SUBSTRING DIR2 1 -2)))
          (SETQ DIR1 (OR (DIRECTORYNAME (OR DIR1 T))
                         (ERROR "DIRECTORY DOES NOT EXIST" DIR1)))
          (SETQ DIR2 (OR (DIRECTORYNAME (OR DIR2 T))
                         (ERROR "DIRECTORY DOES NOT EXIST" DIR2)))
          (PRINTOUT T "Comparing " DIR1 6 "vs. " DIR2 T "as of " (DATE)
                 " selecting " SELECT " ... ")
          (SETQ INFOS1 (COMPAREDIRECTORIES.INFOS (CDFILES DIR1 FILEPATTERNS EXTENSIONSTOAVOID
                                                            ALLVERSIONS DEPTH1)
                              USEDIRECTORYDATE))
          (SETQ INFOS2 (COMPAREDIRECTORIES.INFOS (CDFILES DIR2 FILEPATTERNS EXTENSIONSTOAVOID
                                                            ALLVERSIONS DEPTH2)
                              USEDIRECTORYDATE))
          (CL:UNLESS (AND INFOS2 INFOS1)
                 (RETURN))

     (* ;; "At this point the CAR of each info is the atomic match-name. Peel it off to produce candidate entries.")

     (* ;; 
   "Look through all of the I2's because multiple versions (if VERSIONS) have the same matchname")

          [SETQ CANDIDATES (FOR I1 IN INFOS1
                              JOIN (IF ALLVERSIONS
                                           THEN (OR (FOR I2 IN INFOS2
                                                           WHEN (EQ (CAR I2)
                                                                        (CAR I1))
                                                           COLLECT (LIST (CAR I1)
                                                                             (CDR I1)
                                                                             (CDR I2)))
                                                        (CONS (LIST (CAR I1)
                                                                    (CDR I1)
                                                                    NIL)))
                                         ELSE (CONS (LIST (CAR I1)
                                                              (CDR I1)
                                                              (CDR (ASSOC (CAR I1)
                                                                          INFOS2]

     (* ;; "Could be some 2's without 1's")

          (SORT [NCONC CANDIDATES (FOR I2 IN INFOS2 UNLESS (ASSOC (CAR I2)
                                                                              CANDIDATES)
                                     COLLECT (LIST (CAR I2)
                                                       NIL
                                                       (CDR I2]
                T)

     (* ;; "CANDIDATES is now a sorted list of the form (matchname entry1 entry2) where an entry consists of (fullname date length author)")

     (* ;; "Do the SELECT filtering and insert the date relation.")

          [SETQ SELECTED
           (FOR C MATCHNAME INFO1 INFO2 IDATE1 IDATE2 DATEREL BINCOMP IN CANDIDATES
              EACHTIME (SETQ MATCHNAME (POP C))
                    (SETQ INFO1 (POP C))
                    (SETQ INFO2 (POP C))
                    (IF (AND INFO1 INFO2)
                        THEN (SETQ IDATE1 (IDATE (FETCH DATE OF INFO1)))
                              (SETQ IDATE2 (IDATE (FETCH DATE OF INFO2)))
                              (SETQ DATEREL (IF (IGREATERP IDATE1 IDATE2)
                                                THEN '>
                                              ELSEIF (ILESSP IDATE1 IDATE2)
                                                THEN '<
                                              ELSE '=))
                      ELSE 

                            (* ;; "Just for printing--no comparison")

                            (SETQ DATEREL '*))
              WHEN (IF (AND INFO1 INFO2)
                           THEN (OR (NULL COMPAREDATE)
                                        (SELECTQ DATEREL
                                            (> (MEMB '> SELECT))
                                            (< (MEMB '< SELECT))
                                            (= (MEMB '= SELECT))
                                            (SHOULDNT)))
                         ELSEIF INFO1
                           THEN 

                                 (* ;; "OK if INFO2 is missing?")

                                 (MEMB '*- SELECT)
                         ELSE 

                               (* ;; "OK if INFO1 is missing?")

                               (MEMB '-* SELECT))
              COLLECT (CREATE CDENTRY
                                 MATCHNAME _ MATCHNAME
                                 INFO1 _ INFO1
                                 DATEREL _ DATEREL
                                 INFO2 _ INFO2
                                 EQUIV _ (CL:UNLESS (EQ DATEREL '*)
                                             (BINCOMP (FETCH FULLNAME OF INFO1)
                                                    (FETCH FULLNAME OF INFO2)
                                                    T
                                                    (FETCH EOL OF INFO1)
                                                    (FETCH EOL OF INFO2)))]
          (PRINTOUT T (LENGTH SELECTED)
                 " entries" T)
          (PUSH SELECTED (LIST DIR1 DIR2 SELECT (DATE)))
          (SETQ LASTCDENTRIES SELECTED)
          (CL:UNLESS OUTPUTFILE (RETURN SELECTED))
          (RETURN (CDPRINT SELECTED OUTPUTFILE (MEMB 'AUTHOR SELECT SELECT])

(CDFILES
  [LAMBDA (DIR FILEPATTERNS EXTENSIONSTOAVOID ALLVERSIONS DEPTH)
                                                            (* ; "Edited 16-Oct-2020 13:42 by rmk:")

    (* ;; "Returns a list of fullnames for files that satisfy the criteria")

    (* ;; "For each name returned by (DIRECTORY DIR), assumes that FILEPATTERNS applies to the suffix after the directory (i.e. after NAMEPOS).  That includes possibly subdirectories, dotted files in ultimate file names, and versions.")

    (* ;; "     Exclude subdirectories unless FILEPATTERNS includes *>*")

    (* ;; "     Exclude dotted files (.xxx) unless FILEPATTERNS includes .*")

    (* ;; "     Exclude files with extensions in EXTENSIONSTOAVOID (*=NIL does no filtering)")

    (* ;; "     Exclude older versions unless ALLVERSIONS=T")

    (* ;; "  DEPTH is the number of subdirectories below the ones specified in DIR (NIL top-level of DIR only, T = any depth)")

    (* ;; "Resolve relative directories, so we can suppress subdirectory matches.   ")

    (SETQ EXTENSIONSTOAVOID (MKLIST (U-CASE EXTENSIONSTOAVOID)))
    [SETQ FILEPATTERNS (MKLIST (OR FILEPATTERNS '*]
    (FOR FP FN FPNAME FPEXT EXCLUDEDOTTED (TOPDIR _ (DIRECTORYNAME (OR DIR T))) IN 
                                                                                         FILEPATTERNS
       JOIN [SETQ FPNAME (U-CASE (FILENAMEFIELD FP 'NAME]
             [SETQ FPEXT (U-CASE (FILENAMEFIELD FP 'EXTENSION]
             (CL:UNLESS FPNAME
                 (IF FPEXT
                     THEN 

                           (* ;; ".XY")

                           (SETQ FPNAME (PACK* "." FPEXT))
                   ELSE (SETQ FPNAME '*)))
             (CL:UNLESS FPEXT
                 (SETQ FPEXT '*))
             (SETQ EXCLUDEDOTTED (NEQ (CHARCODE %.)
                                      (CHCON1 FPNAME)))
             (SETQ FN (PACKFILENAME.STRING 'VERSION (CL:IF ALLVERSIONS
                                                        '*
                                                        "")
                             'DIRECTORY TOPDIR 'NAME '* 'EXTENSION '*)) 

             (* ;; "DEPTH is the number of internal %">%"")

             [IF (EQ DEPTH T)
                 THEN (SETQ DEPTH MAX.SMALLP)
               ELSEIF DEPTH
               ELSE (SETQ DEPTH (BIND (CNT _ 0)
                                           (POS _ 0)
                                           (FNDIR _ (FILENAMEFIELD FN 'DIRECTORY))
                                       WHILE (SETQ POS (STRPOS ">" FNDIR (ADD1 POS)))
                                       DO (ADD CNT 1) FINALLY (RETURN CNT]
             (FOR FULLNAME NAME EXT THISDEPTH IN (DIRECTORY FN)
                EACHTIME [SETQ NAME (U-CASE (FILENAMEFIELD FULLNAME 'NAME]
                      [SETQ EXT (U-CASE (FILENAMEFIELD FULLNAME 'EXTENSION]
                      (CL:UNLESS NAME
                          (IF EXT
                              THEN 

                                    (* ;; ".XY")

                                    (SETQ NAME (PACK* "." EXT))
                                    (SETQ EXT NIL)))
                      (CL:WHEN (AND EXCLUDEDOTTED (EQ (CHARCODE %.)
                                                      (CHCON1 NAME)))
                             (GO $$ITERATE))
                      (SETQ THISDEPTH (BIND (CNT _ 0)
                                             (POS _ 0)
                                             (FNDIR _ (FILENAMEFIELD FULLNAME 'DIRECTORY))
                                         WHILE (SETQ POS (STRPOS ">" FNDIR (ADD1 POS)))
                                         DO (ADD CNT 1) FINALLY (RETURN CNT))) 

                      (* ;; "An empty subdirectory may appear without name or extensions")
 WHEN (AND (OR NAME EXT)
               (OR (EQ FPNAME '*)
                   (EQ FPNAME NAME))
               (OR (EQ FPEXT '*)
                   (EQ FPEXT EXT))) UNLESS [OR (IGREATERP THISDEPTH DEPTH)
                                                   (AND EXT (OR (MEMB '* EXTENSIONSTOAVOID)
                                                                (MEMB EXT EXTENSIONSTOAVOID]
                COLLECT FULLNAME) FINALLY (CL:UNLESS $$VAL (PRINTOUT T 
                                                                          "No relevant files in " 
                                                                          TOPDIR T])

(COMPAREDIRECTORIES.INFOS
  [LAMBDA (FILES USEDIRECTORYDATE)                      (* ; "Edited 13-Oct-2020 08:42 by rmk:")

    (* ;; "Value is a list of CDINFOS with the match-name consed on to the front")

    (FOR FULLNAME TYPE LDATE IN FILES
       COLLECT 

             (* ;; "GDATE/IDATE in case Y2K")

             (SETQ LDATE (FILEDATE FULLNAME))                (* ; "Is it a Lisp file?")
             (CONS (MATCHNAME FULLNAME)
                   (CREATE CDINFO
                          FULLNAME _ FULLNAME
                          DATE _ [GDATE (IDATE (IF USEDIRECTORYDATE
                                                   THEN (GETFILEINFO FULLNAME 'CREATIONDATE)
                                                 ELSEIF (OR LDATE (GETFILEINFO FULLNAME
                                                                             'CREATIONDATE]
                          LENGTH _ (GETFILEINFO FULLNAME 'LENGTH)
                          AUTHOR _ (GETFILEINFO FULLNAME 'AUTHOR)
                          TYPE _ (IF LDATE
                                     THEN (CL:IF (MEMB (FILENAMEFIELD FULLNAME 'EXTENSION)
                                                           *COMPILED-EXTENSIONS*)
                                                  'COMPILED
                                                  'SOURCE)
                                   ELSE (PRINTFILETYPE FULLNAME))
                          EOL _ (EOLTYPE FULLNAME])

(MATCHNAME
  [LAMBDA (NAME)                                        (* ; "Edited  5-Sep-2020 13:41 by rmk:")

    (* ;; "The NAME.DIR for matching related files")

    (LET ((M (PACKFILENAME 'HOST NIL 'VERSION NIL 'DIRECTORY NIL 'BODY NAME)))

         (* ;; "Strip off the nuisance period")

         (CL:IF (EQ (CHARCODE %.)
                    (NTHCHARCODE M -1))
             (SUBATOM M 1 -2)
             M)])
)
(DEFINEQ

(CDPRINT
  [LAMBDA (CDENTRIES FILE PRINTAUTHOR)                  (* ; "Edited 13-Oct-2020 08:38 by rmk:")

    (* ;; "Typically CDENTRIES will have a header.  If not, we fake one up, at least for the directories and today's date.")

    (CL:UNLESS CDENTRIES
        (PRINTOUT T T "Note:  Using LASTCDENTRIES" T T)
        (SETQ CDENTRIES LASTCDENTRIES))
    (RESETLST
        (LET (INFO1 TEXT STREAM DATE1POS ENDDATE1 DIR1 DIR2 (HEADER (CAR CDENTRIES))
                    NCHARSDIR1)
             (CL:UNLESS (STRINGP (CADR HEADER))
                 (SETQ HEADER (LIST [FOR E IN CDENTRIES WHEN (FETCH INFO1
                                                                            OF E)
                                       DO (RETURN (PACKFILENAME 'NAME NIL 'EXTENSION NIL
                                                             'VERSION NIL 'BODY
                                                             (FETCH FULLNAME
                                                                OF (FETCH INFO1 OF E]
                                    [FOR E IN CDENTRIES WHEN (FETCH INFO2
                                                                            OF E)
                                       DO (RETURN (PACKFILENAME 'NAME NIL 'EXTENSION NIL
                                                             'VERSION NIL 'BODY
                                                             (FETCH FULLNAME
                                                                OF (FETCH INFO2 OF E]
                                    NIL
                                    (DATE)))
                 (PUSH CDENTRIES HEADER))
             (SETQ DIR1 (CAR HEADER))
             (SETQ NCHARSDIR1 (NCHARS DIR1))
             (SETQ DIR2 (CADR HEADER))
             (CL:UNLESS (SETQ STREAM (GETSTREAM FILE 'OUTPUT T))
                 [RESETSAVE (SETQ STREAM (OPENSTREAM (PACKFILENAME 'EXTENSION 'TXT 'BODY FILE)
                                                'OUTPUT
                                                'NEW))
                        '(PROGN (CLOSEF? OLDVALUE])
             (CL:WHEN DIR1
                 (PRINTOUT STREAM "Comparing " DIR1 6 "vs. " DIR2 T "as of " (CADDDR HEADER))
                 (CL:WHEN (CADDR HEADER)
                     (PRINTOUT STREAM " selecting " (CADDR HEADER)))
                 (PRINTOUT STREAM -2 (LENGTH (CDR CDENTRIES))
                        " entries" T T))
             (LINELENGTH 1000 STREAM)                        (* ; "Don't wrap")

             (* ;; "DATE1POS is the position of the first character of INFO1's date, used for tabbing.  We have to measure the filename, date, size, and author if desired")

             (IF (CDR CDENTRIES)
                 THEN (FOR E INFO1 (MAXDATE1WIDTH _ 0)
                                 (SPACEWIDTH _ 1)
                                 (PARENWIDTH _ 2) IN (CDR CDENTRIES)
                             WHEN (SETQ INFO1 (FETCH INFO1 OF E))
                             LARGEST [SETQ MAXDATE1WIDTH (IMAX MAXDATE1WIDTH
                                                                   (NCHARS (FETCH DATE
                                                                              OF INFO1]
                                   (IPLUS (- (NCHARS (FETCH FULLNAME OF INFO1))
                                             NCHARSDIR1)
                                          (NCHARS (FETCH LENGTH OF INFO1))
                                          (CL:IF PRINTAUTHOR
                                              (IPLUS SPACEWIDTH PARENWIDTH
                                                     (NCHARS (FETCH AUTHOR OF INFO1)))
                                              0)) FINALLY 

                                                        (* ;; 
                            "First 4 for width of equiv.  $$EXTREME is NIL if there are no INFO1's")

                                                        (SETQ DATE1POS (IPLUS (OR $$EXTREME 10)
                                                                              4
                                                                              (ITIMES 3 SPACEWIDTH)))
                                                        (SETQ ENDDATE1 (IPLUS DATE1POS MAXDATE1WIDTH)
                                                         ))
                       (FOR E IN (CDR CDENTRIES)
                          DO (CDPRINT.LINE STREAM E PRINTAUTHOR DATE1POS ENDDATE1 NCHARSDIR1
                                        (NCHARS DIR2)))
               ELSE (PRINTOUT T "CDENTRIES is empty" T))
             (AND STREAM (CLOSEF? STREAM))))])

(CDPRINT.LINE
  [LAMBDA (STREAM ENTRY PRINTAUTHOR DATE1POS ENDDATE1 NCHARSDIR1 NCHARSDIR2)
                                                            (* ; "Edited 13-Oct-2020 08:51 by rmk:")

    (* ;; "Format one line of the directory comparison listing.  If PRINTAUTHOR and AUTHOR1 or AUTHOR2 are non-NIL, list the author in parens; otherwise omit it.")

    (LET ((INFO1 (FETCH INFO1 OF ENTRY))
          (INFO2 (FETCH INFO2 OF ENTRY)))
         (PRINTOUT STREAM (SELECTQ (FETCH EQUIV OF ENTRY)
                              (T "==")
                              (NIL "  ")
                              (PROGN (SELECTQ (FETCH EOL OF INFO1)
                                         (CR 'C)
                                         (LF 'L)
                                         (CRLF 2)
                                         " ")
                                     (SELECTQ (FETCH EOL OF INFO2)
                                         (CR 'C)
                                         (LF 'L)
                                         (CRLF 2)
                                         " ")))
                " ")
         (CL:WHEN INFO1
             (PRINTOUT STREAM (SUBSTRING (FETCH FULLNAME OF INFO1)
                                     (ADD1 NCHARSDIR1)
                                     NIL
                                     (CONSTANT (CONCAT)))
                    " ")
             (CL:WHEN PRINTAUTHOR
                 (PRINTOUT STREAM "(" (FETCH AUTHOR OF INFO1)
                        ") "))
             (PRINTOUT STREAM (FETCH LENGTH OF INFO1)
                    .TAB0 DATE1POS (FETCH DATE OF INFO1)))
         (PRINTOUT STREAM .TAB0 ENDDATE1 "  " (FETCH DATEREL OF ENTRY)
                "  ")
         (CL:WHEN INFO2
             (PRINTOUT STREAM (FETCH DATE OF INFO2)
                    "   "
                    (SUBSTRING (FETCH FULLNAME OF INFO2)
                           (ADD1 NCHARSDIR2)
                           NIL
                           (CONSTANT (CONCAT)))
                    " ")
             (CL:WHEN PRINTAUTHOR
                 (PRINTOUT STREAM "(" (FETCH AUTHOR OF INFO2)
                        ") "))
             (PRINTOUT STREAM (FETCH LENGTH OF INFO2)))
         (TERPRI STREAM])
)
(DEFINEQ

(CDMAP
  [LAMBDA (CDENTRIES FN)                                (* ; "Edited  6-Sep-2020 15:58 by rmk:")
    (CL:UNLESS CDENTRIES
        (PRINTOUT T T "Note:  Using LASTCDENTRIES" T T)
        (SETQ CDENTRIES LASTCDENTRIES))
    (FOR CDE MATCHNAME INFO1 DATEREL INFO2 EQUIV IN (CDR CDENTRIES)
       DECLARE (SPECVARS MATCHNAME INFO1 DATEREL INFO2 EQUIV)
       EACHTIME (SETQ MATCHNAME (FETCH MATCHNAME OF CDE))
             (SETQ INFO1 (FETCH INFO1 OF CDE))
             (SETQ DATEREL (FETCH DATEREL OF CDE))
             (SETQ INFO2 (FETCH INFO2 OF CDE))
             (SETQ EQUIV (FETCH EQUIV OF CDE)) DO (APPLY* FN CDE])

(CDENTRY
  [LAMBDA (MATCHNAME CDENTRIES)                     (* ; "Edited  5-Sep-2020 21:09 by rmk:")
    (ASSOC MATCHNAME (OR CDENTRIES LASTCDENTRIES])

(CDSUBSET
  [LAMBDA (CDENTRIES FN)                                (* ; "Edited 15-Sep-2020 13:49 by rmk:")
    (CL:UNLESS CDENTRIES
        (PRINTOUT T T "Note:  Using LASTCDENTRIES" T T)
        (SETQ CDENTRIES LASTCDENTRIES))
    (CONS (CAR CDENTRIES)
          (FOR CDE MATCHNAME INFO1 DATEREL INFO2 EQUIV IN (CDR CDENTRIES)
             DECLARE (SPECVARS MATCHNAME INFO1 DATEREL INFO2 EQUIV)
             EACHTIME (SETQ MATCHNAME (FETCH MATCHNAME OF CDE))
                   (SETQ INFO1 (FETCH INFO1 OF CDE))
                   (SETQ DATEREL (FETCH DATEREL OF CDE))
                   (SETQ INFO2 (FETCH INFO2 OF CDE))
                   (SETQ EQUIV (FETCH EQUIV OF CDE)) WHEN (APPLY* FN CDE) COLLECT
                                                                                      CDE])
)
(DEFINEQ

(BINCOMP
  [LAMBDA (FILE1 FILE2 EOLDIFFOK EOL1 EOL2)             (* ; "Edited 13-Oct-2020 08:53 by rmk:")

    (* ;; "Returns T if FILE1 and FILE2 are byte-equivalent.  Returns EOLDIFF if they are byte equivalent except for CR/LF/CRLF exchanges.  ")

    (* ;; "If EOLDIFFOK, return indicates that the files are the same except for EOL mappings.  If EOL1 and EOL2 are not provided, they are computed here.")

    (IF (IEQP (GETFILEINFO FILE1 'LENGTH)
                  (GETFILEINFO FILE2 'LENGTH))
        THEN [CL:WITH-OPEN-FILE
                  (STREAM1 FILE1 :DIRECTION :INPUT)
                  (CL:WITH-OPEN-FILE
                   (STREAM2 FILE2 :DIRECTION :INPUT)
                   (SETFILEINFO STREAM1 'ENDOFSTREAMOP (FUNCTION NILL))

                   (* ;; "Simpler code to recompute eol's even if provided")

                   (BIND B1 B2 EOL1 EOL2 EOLDIFF WHILE (SETQ B1 (\BIN STREAM1))
                      UNLESS (EQ B1 (SETQ B2 (\BIN STREAM2)))
                      DO (CL:UNLESS (AND EOLDIFFOK (SELCHARQ B1
                                                            (CR (CL:WHEN (EQ EOL1 'LF)
                                                                       (RETURN NIL))
                                                                (SETQ EOL1 'CR)
                                                                (SETQ EOL2 'LF)
                                                                (EQ B2 (CHARCODE LF)))
                                                            (LF (CL:WHEN (EQ EOL1 'CR)
                                                                       (RETURN NIL))
                                                                (SETQ EOL1 'LF)
                                                                (SETQ EOL2 'CR)
                                                                (EQ B2 (CHARCODE CR)))
                                                            NIL))
                                    (RETURN NIL))
                            (CL:UNLESS EOLDIFF
                                (SETQ EOLDIFF (LIST EOL1 EOL2))) FINALLY (RETURN (OR EOLDIFF T]
      ELSEIF EOLDIFFOK
        THEN 

              (* ;; "Lengths are different possibly because of CRLF to CR/LF substitutions.")

              (* ;; 
        "More complex code could detect the EOLTYPE incrementally without separate passes, but ...")

              (CL:UNLESS EOL1
                  (SETQ EOL1 (EOLTYPE FILE1)))
              (CL:UNLESS EOL2
                  (SETQ EOL2 (EOLTYPE FILE2)))
              (CL:WHEN (IF [AND (EQ EOL1 'CRLF)
                                    (MEMB EOL2 '(LF CR]
                         ELSEIF [AND (EQ EOL2 'CRLF)
                                         (MEMB EOL1 '(LF CR]
                           THEN (SWAP FILE1 FILE2))

                  (* ;; "FILE1 is now CRLF, FILE2 is not.  If FILE1 isn't longer, it can't have a CRLF that corresponds to a CR or LF.")

                  (CL:WHEN (IGREATERP (GETFILEINFO FILE1 'LENGTH)
                                  (GETFILEINFO FILE2 'LENGTH))
                      [CL:WITH-OPEN-FILE (STREAM1 FILE1 :DIRECTION :INPUT)
                             (CL:WITH-OPEN-FILE (STREAM2 FILE2 :DIRECTION :INPUT)
                                    (SETFILEINFO STREAM1 'ENDOFSTREAMOP (FUNCTION NILL))
                                    (BIND B1 B2 EOLDIFF WHILE (SETQ B1 (\BIN STREAM1))
                                       UNLESS (EQ B1 (SETQ B2 (\BIN STREAM2)))
                                       DO (CL:UNLESS [AND (EQ (CHARCODE CR)
                                                                  B1)
                                                              (EQ (CHARCODE LF)
                                                                  (\BIN STREAM1))
                                                              (MEMB B2 (CHARCODE (CR LF]
                                                     (RETURN NIL))
                                             (CL:UNLESS EOLDIFF
                                                 (SETQ EOLDIFF (LIST EOL1 EOL2)))
                                       FINALLY (RETURN (OR EOLDIFF T]))])

(EOLTYPE
  [LAMBDA (FILE)                                        (* ; "Edited  3-Sep-2020 17:05 by rmk:")

    (* ;; "Returns the EOLCONVENTION of FILE if it only sees one kind, NIL if it can't decide.")

    (CL:WITH-OPEN-FILE (STREAM FILE :DIRECTION :INPUT)
           (SETFILEINFO STREAM 'ENDOFSTREAMOP (FUNCTION NILL))
           (BIND EOLTYPE
              DO (SELCHARQ (OR (\BIN STREAM)
                                   (RETURN EOLTYPE))
                          (CR (IF (EQ (CHARCODE LF)
                                          (\PEEKBIN STREAM T))
                                  THEN (CL:WHEN (MEMB EOLTYPE '(LF CR))
                                                  (RETURN NIL))
                                        (\BIN STREAM)
                                        (SETQ EOLTYPE 'CRLF)
                                ELSEIF (MEMB EOLTYPE '(LF CRLF))
                                  THEN (RETURN NIL)
                                ELSE (SETQ EOLTYPE 'CR)))
                          (LF (CL:WHEN (MEMB EOLTYPE '(CR CRLF))
                                     (RETURN NIL))
                              (SETQ EOLTYPE 'LF))
                          NIL])
)
(DECLARE%: EVAL@COMPILE

(RECORD CDENTRY (MATCHNAME INFO1 DATEREL INFO2 . EQUIV))

(RECORD CDINFO (FULLNAME DATE LENGTH AUTHOR TYPE EOL))
)



(* ;; "look for compiled files older than the sources")

(DEFINEQ

(FIND-UNCOMPILED-FILES
  [LAMBDA (FILES DFASLMARGIN COMPILEEXTS)               (* ; "Edited 20-Sep-2020 23:04 by rmk:")
                                                             (* ; "Edited  3-Nov-94 15:17 by jds")

    (* ;; "Produces a list of the source files in FILES that have no corresponding compiled file")

    (* ;; "This determines whether there is at least one compiled file.  If there are two or more, that's a problem")

    (* ;; "We want the most recent version only")

    (* ;; "Source files have a 2-element created-as with a non-NIL date")

    (SETQ FILES (FOR F IN (OR (LISTP FILES)
                                      (FILDIR FILES)) UNLESS (MEMB (SETQ F (PACKFILENAME
                                                                                'VERSION NIL
                                                                                'BODY F))
                                                                       $$VAL) COLLECT F))
    (FOR F SCREATION FILES IN FILES WHEN (AND (CADR (SETQ SCREATION (CREATED-AS
                                                                                 F)))
                                                          (NOT (CDDR SCREATION)))
       WHEN [SETQ FILES
                 (FOR CEXT CF IN (OR COMPILEEXTS *COMPILED-EXTENSIONS*)
                    WHEN (SETQ CF (INFILEP (PACKFILENAME 'EXTENSION CEXT 'VERSION NIL
                                                      'BODY F)))
                    COLLECT (CL:WHEN (SOURCE-FOR-COMPILED-P SCREATION CF DFASLMARGIN)
                                       (RETURN NIL))
                          CF
                    FINALLY 

                          (* ;; "If we found some compiled files, they weren't on this source.  If there weren't any compiled files to check, maybe there weren't any functions.")

                          (* ;; 
      "NLSETQ because we don't want to stop if there is an error, typically from a package problem")

                          (RETURN (OR $$VAL (LET [(FCOMS (CAR (NLSETQ (GETDEF (FILECOMS F)
                                                                             'VARS F]
                                                 (IF (NULL FCOMS)
                                                     THEN 

                                                           (* ;; 
                                               "GETDEF caused an error.  Maybe a package problem. ")

                                                           (AND NIL 'NOCOMMANDS)
                                                   ELSEIF (INFILECOMS? NIL '(FUNCTIONS FNS)
                                                                     FCOMS)
                                                     THEN T]
       COLLECT (CONS F (SELECTQ FILES
                               (T NIL)
                               (NOCOMMANDS (CONS "No commands"))
                               (FOR CF IN FILES COLLECT 

                                                        (* ;; 
           "Positive means that compiled is later than source, normal order but maybe by too much.")

                                                              (* ;; 
                                            "Negative means that compiled came before source.  Odd")

                                                              (LIST CF (COMPILE-SOURCE-DATE-DIFF
                                                                        CF SCREATION])

(FIND-UNSOURCED-FILES
  [LAMBDA (FILES DFASLMARGIN COMPILEEXTS)               (* ; "Edited 15-Sep-2020 15:32 by rmk:")
                                                             (* ; "Edited  3-Nov-94 15:17 by jds")

    (* ;; 
  "Produces a list of compiled FILES for which no source file can be found in the same directory.")

    (* ;; "The source date in at least one DFASL was off by a second, maybe some sort of IDATE rounding?  So, give a margin.")

    (* ;; 
"We want the most recent version only.  Check CREATED-AS to make sure it really is a compiled file.")

    (* ;; "Sort to get lcoms and dfasls next to each other.")

    (LET (CCREATEDS)
         (SETQ CCREATEDS (FOR CEXT FOUND CCREATED INSIDE (OR COMPILEEXTS 
                                                                     *COMPILED-EXTENSIONS*)
                            JOIN (FOR CF IN [OR (LISTP FILES)
                                                            (FILDIR (PACKFILENAME 'EXTENSION CEXT
                                                                           'VERSION "" 'BODY
                                                                           '*]
                                        WHEN (CDDR (SETQ CCREATED (CREATED-AS CF)))
                                        UNLESS (MEMBER CCREATED $$VAL) COLLECT CCREATED)))

         (* ;; "CCREATEDS is now a list of CREATED-AS items")

         (FOR CC SF IN CCREATEDS UNLESS (AND [SETQ SF (INFILEP (PACKFILENAME 'EXTENSION 
                                                                                  NIL 'VERSION NIL
                                                                                  'BODY
                                                                                  (CAR CC]
                                                         (SOURCE-FOR-COMPILED-P (SETQ SF
                                                                                     (CREATED-AS
                                                                                      SF))
                                                                CC DFASLMARGIN))
            COLLECT [LIST (CAR CC)
                              (AND SF (LIST (CAR SF)
                                            (ROUND (COMPILE-SOURCE-DATE-DIFF CC SF]
            FINALLY (RETURN (SORT $$VAL (FUNCTION (LAMBDA (CF1 CF2)
                                                        (ALPHORDER (FILENAMEFIELD (CAR CF1)
                                                                          'NAME)
                                                               (FILENAMEFIELD (CAR CF2)
                                                                      'NAME])

(FIND-SOURCE-FILES
  [LAMBDA (CFILES SDIRS DFASLMARGIN)                    (* ; "Edited  9-Sep-2020 12:26 by rmk:")

    (* ;; "Returns (CFILE . SFILES) pairs where CFILE is a Lisp compiled file in CFILES SFILES is a list of source files in SDIRS that CFILE was compiled on.")

    (* ;; "This suggests that one of CFILES should be copied to the SFILE directory.")

    (SETQ SDIRS (FOR SD INSIDE (OR SDIRS T) COLLECT (DIRECTORYNAME SD)))
    (SORT (FOR CF SFILES CNAME CCREATED IN (OR (LISTP CFILES)
                                                       (FILDIR CFILES))
             WHEN (AND (SETQ CNAME (INFILEP CF))
                           (CDDR (SETQ CCREATED (CREATED-AS CF)))
                           (SETQ SFILES (FOR SD SF IN SDIRS
                                           WHEN (AND (SETQ SF (INFILEP (PACKFILENAME
                                                                            'NAME
                                                                            (FILENAMEFIELD
                                                                             CF
                                                                             'NAME)
                                                                            'BODY SD)))
                                                         (SOURCE-FOR-COMPILED-P SF CCREATED 
                                                                DFASLMARGIN)) COLLECT SF)))
             COLLECT (CONS CNAME SFILES))
          (FUNCTION (LAMBDA (P1 P2)
                      (ALPHORDER (FILENAMEFIELD (CAR P1))
                             (FILENAMEFIELD (CAR P2])

(FIND-COMPILED-FILES
  [LAMBDA (SFILES CDIRS DFASLMARGIN)                    (* ; "Edited  9-Sep-2020 12:26 by rmk:")

    (* ;; "Returns (SFILE . CFILES) pairs where SFILE is a Lisp source file in SFILES CFILES is a list of compiled files in CDIRS that were compiled on SFILE.")

    (* ;; "FILEDATE is true for source files and compiled files")

    (* ;; "This suggests that one of CFILES should be copied to the SFILE directory.")

    (SETQ CDIRS (FOR CD INSIDE (OR CDIRS T) COLLECT (DIRECTORYNAME CD)))
    (SORT (FOR SF CFILES SNAME SCREATED IN (OR (LISTP SFILES)
                                                       (FILDIR SFILES))
             WHEN [AND (SETQ SNAME (INFILEP SF))
                           (SETQ SCREATED (CREATED-AS SF))
                           (NOT (CDDR SCREATED))
                           (SETQ CFILES (FOR CEXT (ROOT _ (FILENAMEFIELD SNAME 'NAME))
                                           IN *COMPILED-EXTENSIONS*
                                           JOIN (FOR CD CF IN CDIRS
                                                       WHEN (AND (SETQ CF
                                                                      (INFILEP (PACKFILENAME
                                                                                'NAME ROOT
                                                                                'EXTENSION CEXT
                                                                                'BODY CD)))
                                                                     (SOURCE-FOR-COMPILED-P
                                                                      SCREATED CF DFASLMARGIN))
                                                       COLLECT CF] COLLECT (CONS SNAME CFILES
                                                                                         ))
          (FUNCTION (LAMBDA (P1 P2)
                      (ALPHORDER (FILENAMEFIELD (CAR P1))
                             (FILENAMEFIELD (CAR P2])

(FIND-UNLOADED-FILES
  [LAMBDA (FILES)                                       (* ; "Edited  9-Sep-2020 19:35 by rmk:")

    (* ;; "Returns the files in FILES that don't have FILECREATED properties and presumably are therefore not loaded in the current sysout.")

    (FOR F IN (OR (LISTP FILES)
                          (FILDIR FILES)) WHEN (AND (SETQ F (INFILEP (CL:IF (LISTP F)
                                                                             (CAR F)
                                                                             F)))
                                                        (FILEDATE F))
       UNLESS (GETP (FILENAMEFIELD F 'NAME)
                        'FILEDATES) COLLECT F])

(FIND-LOADED-FILES
  [LAMBDA (ROOTFILENAMES)                               (* ; "Edited 19-Sep-2020 07:20 by rmk:")
    (FOR RN INSIDE ROOTFILENAMES WHEN (GETP RN 'FILEDATES)
       COLLECT (CONS RN (FOR F IN LOADEDFILELST WHEN (EQ RN (FILENAMEFIELD
                                                                             F
                                                                             'NAME)) COLLECT
                                                                                     F])

(FIND-MULTICOMPILED-FILES
  [LAMBDA (FILES SHOWINFO)                              (* ; "Edited 20-Sep-2020 20:57 by rmk:")

    (* ;; "Returns a list of names for files in FILES that have multiple compilations")

    (LET (SFILES)
         (FOR F EXT NAME IN (OR (LISTP FILES)
                                        (FILDIR FILES)) WHEN (MEMB (SETQ EXT (FILENAMEFIELD
                                                                                  F
                                                                                  'EXTENSION))
                                                                       *COMPILED-EXTENSIONS*)
            DO (SETQ NAME (FILENAMEFIELD F 'NAME)) 

                  (* ;; "PUSHNEW because we haven't filtered out versions")

                  (PUSHNEW [CDR (OR (ASSOC NAME SFILES)
                                        (CAR (PUSH SFILES (CONS NAME]
                         EXT))
         (FOR S IN SFILES WHEN (CDDR S)
            COLLECT (IF SHOWINFO
                            THEN `[,(CAR S)
                                       ,(CADAR (FIND-LOADED-FILES (CAR S)))
                                       ,(CREATED-AS (CAR S))
                                       ,@(FOR EXT IN (SORT (CDR S))
                                            COLLECT (CREATED-AS (PACKFILENAME 'EXTENSION EXT
                                                                               'BODY
                                                                               (CAR S]
                          ELSE (CAR S])
)
(DEFINEQ

(CREATED-AS
  [LAMBDA (FILE)                                        (* ; "Edited 20-Sep-2020 23:06 by rmk:")

    (* ;; "For lisp source files, returns (filecreatename filecreateddate)")

    (* ;; "For lisp compiled files, returns (cfilename cfiledate sfilecreatename sfilecreateddate)")

    (* ;; "For other files, (fullfilename NIL)")

    (* ;; "The cfilename is just the current directory name for DFASLs.")

    (* ;; "So:  (CADR value) is non-NIL for Lisp files.  Of those, (CDDR value) is non-NIL for compiled files.")

    (* ;; "We disable the package delimiter because the atoms in changes may have a packages that we don't know.")

    (CL:WITH-OPEN-FILE
     (STREAM FILE :DIRECTION :INPUT)
     (LET
      (FILEDATE FILENAME SOURCEDATE SOURCENAME LINE POS)
      [IF (EQ (CHARCODE %()
                  (SKIPSEPRCODES STREAM))
          THEN                                           (* ; "Managed source or LCOM")
          (RESETLST
              [LET (FORM SFORM (RDTBL (FIND-READTABLE "OLD-INTERLISP-FILE")))
                   (SETQ POS (GETFILEPTR STREAM))
                   (READCCODE STREAM)
                   (IF (EQ 'DEFINE-FILE-INFO (RATOM STREAM RDTBL))
                       THEN 

                             (* ;; "Reading is package-safe")

                             (SETFILEPTR STREAM POS)
                             (SETQ FORM (READ STREAM RDTBL))
                             (SETQ RDTBL (FIND-READTABLE (LISTGET (CDR FORM)
                                                                :READTABLE)))
                     ELSE (SETFILEPTR STREAM POS))
                   (CL:WHEN (EQ 'PACKAGEDELIM (GETSYNTAX '%: RDTBL))
                       [RESETSAVE (SETSYNTAX '%: 'OTHER RDTBL)
                              `(SETSYNTAX %: PACKAGEDELIM ,RDTBL])

                   (* ;; "One way or the other, we're ready for the filecreated")

                   (CL:WHEN (EQ (CHARCODE %()
                                (SKIPSEPRCODES STREAM))
                       (SETQ FORM (READ STREAM RDTBL))
                       (CL:WHEN (MEMB (U-CASE (CAR FORM))
                                      '(FILECREATED IL%:FILECREATED))

                           (* ;; "IL%%:FILECREATED because we screwed the readtable.")

                           (IF [STREQUAL "compiled on " (CAR (LISTP (CADDR FORM]
                               THEN                      (* ; "LCOM, get source info")
                                     (IF [AND (EQ (CHARCODE %()
                                                      (SKIPSEPRCODES STREAM))
                                                  (MEMB [U-CASE (CAR (SETQ SFORM (READ STREAM RDTBL]
                                                        '(FILECREATED IL%:FILECREATED]
                                         THEN (SETQ FILENAME (FULLNAME STREAM))
                                               (SETQ FILEDATE (CADR FORM))
                                               (SETQ SOURCENAME (CADDR SFORM))
                                               (SETQ SOURCEDATE (CADR SFORM))
                                       ELSE (SETQ FILENAME (FULLNAME STREAM))
                                             (SETQ FILEDATE (CADR FORM)))
                             ELSE (SETQ FILENAME (CADDR FORM))
                                   (SETQ FILEDATE (CADR FORM)))))])
        ELSEIF (SETQ POS (STRPOS "XCL Compiler output for source file " (SETQ LINE (CL:READ-LINE
                                                                                        STREAM))
                                    1 NIL NIL T))
          THEN                                           (* ; "DFASL compiled?")
                (SETQ SOURCENAME (SUBATOM LINE POS))
                (CL:WHEN (SETQ POS (STRPOS "Source file created " (SETQ LINE (CL:READ-LINE STREAM))
                                          1 NIL NIL T))
                    [SETQ SOURCEDATE (GDATE (IDATE (SUBSTRING LINE POS]
                    (CL:WHEN (SETQ POS (STRPOS "FASL file created " (SETQ LINE (CL:READ-LINE STREAM))
                                              1 NIL NIL T))
                        [SETQ FILEDATE (GDATE (IDATE (SUBSTRING LINE POS]))]

      (* ;; "Revert filenames to Interlisp package if needed:")

      (CL:WHEN (STRPOS "IL:" FILENAME)
          (SETQ FILENAME (SUBATOM FILENAME 4)))
      (CL:WHEN (STRPOS "IL:" SOURCENAME)
          (SETQ SOURCENAME (MKATOM SOURCENAME 4)))

      (* ;; "Return DATE NIL if file is not a Lisp file")

      `(,(OR FILENAME (FULLNAME STREAM))
        ,(AND FILEDATE (GDATE (IDATE FILEDATE)))
        ,@(CL:WHEN SOURCENAME
              (LIST SOURCENAME (GDATE (IDATE SOURCEDATE))))])

(SOURCE-FOR-COMPILED-P
  [LAMBDA (SOURCE COMPILED DFASLMARGIN)                 (* ; "Edited 23-Oct-2020 12:13 by rmk:")

    (* ;; "There seems to be some variation between the source dates in dfasl files and the filecreated date in the sources, they often don't match exactly.  But if they are within DFASLMARGIN, we assume a match.  We require exact date match for LCOMS")

    (* ;; "This is needed for dfasl files created before they recorded the source filecreated name and date instead of the directory source name and date when compile took place.")

    (* ;; "")

    (* ;; "DFASLMARGIN is a pair (after before) where we assume a match if the compiled date is no more than after minutes after the source date and no more than before minuts before (the diff is negative then).")

    (* ;; "A single positive integer x is interpreted as (x 0).  A single negative integer x is interpreted as (-x x) (before or after x).")

    (* ;; "Default is (20 0).")

    (* ;; "T is positive or negative infinity")

    (CL:UNLESS (LISTP SOURCE)
        (SETQ SOURCE (CREATED-AS SOURCE)))
    (CL:UNLESS (LISTP COMPILED)
        (SETQ COMPILED (CREATED-AS COMPILED)))
    (SETQ DFASLMARGIN (IF (NULL DFASLMARGIN)
                          THEN 

                                (* ;; 
                       "If compiled is later than source by less than 20 minutes, it's probably OK")

                                '(20 0)
                        ELSEIF (EQ T DFASLMARGIN)
                          THEN '(T 0)
                        ELSE (LISTP DFASLMARGIN)
                        ELSEIF (IGREATERP DFASLMARGIN 0)
                          THEN (LIST DFASLMARGIN 0)
                        ELSEIF (MINUSP DFASLMARGIN)
                          THEN (LIST (MINUS DFASLMARGIN)
                                         DFASLMARGIN)))
    (OR (EQUAL (CAR SOURCE)
               (CADDR COMPILED))
        (EQUAL (CADR SOURCE)
               (CADDDR COMPILED))
        (AND [EQ 'DFASL (U-CASE (FILENAMEFIELD (CAR COMPILED)
                                       'EXTENSION]
             (LET ((TIMEDIFF (COMPILE-SOURCE-DATE-DIFF COMPILED SOURCE)))

                  (* ;; "If compiled was no more than 20 minutes later, it's probably OK.  Of no more than DFASLMARGIN earlier, if it is negative.")

                  (AND (OR (EQ T (CAR DFASLMARGIN))
                           (LEQ TIMEDIFF (CAR DFASLMARGIN)))
                       (OR (EQ T (CADR DFASLMARGIN))
                           (GEQ TIMEDIFF (CADR DFASLMARGIN])

(COMPILE-SOURCE-DATE-DIFF
  [LAMBDA (CFILE SFILE)                                 (* ; "Edited 20-Sep-2020 22:59 by rmk:")

    (* ;; "Positive means that compiled is later than source, normal order but maybe by too much. Negative means that compiled came before source, i.e., compiled on a source that didn't yet exist.")

    (* ;; "Value is in minutes")

    (ROUND (FQUOTIENT [IDIFFERENCE [IDATE (CADDDR (OR (LISTP CFILE)
                                                      (CREATED-AS CFILE]
                             (IDATE (CADR (OR (LISTP SFILE)
                                              (CREATED-AS SFILE]
                  (TIMES 60 ONESECOND])
)
(DEFINEQ

(FIX-DIRECTORY-DATES
  [LAMBDA (FILES)                                       (* ; "Edited  6-Sep-2020 15:08 by rmk:")

    (* ;; "For Lisp source and compiled files, ensures that the directory file date corresponds to the  filecreated date. Returns the list of files whose dates were changed.")

    (* ;; "This allows for the fact that directory dates that  are no later than, say, 30 seconds of the filecreated date are probably OK--the directory date may be set when the file is closed.")

    (* ;; "Use IDATEs in case FDCDATE is not Y2K.")

    (* ;; "Stop if directory date is more than 2 minutes earlier than the filecreated date.  Earlier could be because the dates are asserted at different points in the filing process.  But 2 minutes is worth thinking about.  Returning from HELP will get them aligned.")

    (FOR F DIDATE FCDATE IN (OR (LISTP FILES)
                                        (FILDIR FILES)) WHEN (SETQ FCDATE (FILEDATE F))
       UNLESS (IEQP (SETQ DIDATE (GETFILEINFO F 'ICREATIONDATE))
                        (SETQ FCDATE (IDATE FCDATE))) COLLECT (CL:WHEN (IGREATERP (IDIFFERENCE
                                                                                       FCDATE DIDATE)
                                                                                  (ITIMES 120 
                                                                                         ONESECOND))
                                                                      (HELP 
                                                       "DIRECTORY DATE EARLIER THAN FILECREATED DATE"
                                                                            (LIST F (GDATE DIDATE)
                                                                                  (GDATE FCDATE))))
                                                            (SETFILEINFO F 'ICREATIONDATE FCDATE)
                                                            F])

(FIX-EQUIV-DATES
  [LAMBDA (CDENTRIES)                                   (* ; "Edited  1-Sep-2020 16:21 by rmk:")

    (* ;; "For every entry whose files are EQUIVALENT and whose filedates are different, sets the directory of the file with the later date to be the date of the one with the earlier date.  This preumes that the later one must have been a copy. ")

    (CL:UNLESS CDENTRIES
        (PRINTOUT T "Note:  Using LASTCDENTRIES" T)
        (SETQ CDENTRIES LASTCDENTRIES))
    (FOR CDE EARLY LATE IN (CDR CDENTRIES) WHEN (FETCH EQUIV OF CDE)
       UNLESS (EQ '= (FETCH DATEREL OF CDE))
       COLLECT (SELECTQ (FETCH DATEREL OF CDE)
                       (> (SETQ EARLY (FETCH INFO2 OF CDE))
                          (SETQ LATE (FETCH INFO1 OF CDE)))
                       (< (SETQ EARLY (FETCH INFO1 OF CDE))
                          (SETQ LATE (FETCH INFO2 OF CDE)))
                       (SHOULDNT))
             (SETFILEINFO (FETCH FULLNAME OF LATE)
                    'ICREATIONDATE
                    (GETFILEINFO (FETCH FULLNAME OF EARLY)
                           'ICREATIONDATE))
             (FETCH FULLNAME OF LATE])

(COPY-COMPARED-FILES
  [LAMBDA (CDENTRIES TARGET MATCHNAMES)                 (* ; "Edited  1-Sep-2020 16:20 by rmk:")

    (* ;; "Copies source files to target files whose matchname belongs to MATCHNAMES, if given.")

    (* ;; "TARGET is 1 or 2, indicating which side of the CD entry is the target.  Value is the list of matchnames whose files have been copied.")

    (* ;; "Directory filedates and other properties are preserved.")

    (CL:UNLESS (MEMB TARGET '(1 2))
           (ERROR "INVALID TARGET" TARGET))
    (CL:UNLESS CDENTRIES
        (PRINTOUT T "Note:  Using LASTCDENTRIES" T)
        (SETQ CDENTRIES LASTCDENTRIES))
    (SETQ MATCHNAMES (MKLIST MATCHNAMES))
    (FOR CDE SINFO TINFO MATCHNAME IN (CDR CDENTRIES) EACHTIME (SETQ SINFO
                                                                            (FETCH INFO1
                                                                               OF CDE))
                                                                    (SETQ TINFO (FETCH INFO2
                                                                                   OF CDE))
                                                                    (CL:WHEN (EQ TARGET 1)
                                                                           (SWAP SINFO TINFO))
                                                                    (SETQ MATCHNAME
                                                                     (FETCH MATCHNAME
                                                                        OF CDE))
       WHEN (AND (FETCH FULLNAME OF SINFO)
                     (FETCH FULLNAME OF TINFO)) UNLESS (AND MATCHNAMES
                                                                        (NOT (MEMB MATCHNAME 
                                                                                   MATCHNAMES)))
       COLLECT (COPYFILE (FETCH FULLNAME OF SINFO)
                          (PACKFILENAME 'VERSION NIL 'BODY (FETCH FULLNAME OF TINFO)))
             MATCHNAME])

(COPY-MISSING-FILES
  [LAMBDA (CDENTRIES TARGET MATCHNAMES)                 (* ; "Edited  1-Sep-2020 16:21 by rmk:")

    (* ;; "Copies source files to target files whose matchname belongs to MATCHNAMES, if given.")

    (* ;; "TARGET is 1 or 2, indicating which side of the CD entry is the target.  Value is the list of matchnames whose files have been copied.")

    (* ;; "Directory filedates and other properties are preserved.")

    (CL:UNLESS (MEMB TARGET '(1 2))
           (ERROR "INVALID TARGET" TARGET))
    (CL:UNLESS CDENTRIES
        (PRINTOUT T "Note:  Using LASTCDENTRIES" T)
        (SETQ CDENTRIES LASTCDENTRIES))
    (CL:UNLESS (STRINGP (CADR (CAR CDENTRIES)))
        (ERROR "(CAR CDENTRIES) IS NOT A VALID PARAMETER LIST" (CAR CDENTRIES)))
    (SETQ MATCHNAMES (MKLIST MATCHNAMES))
    (FOR CDE SINFO TINFO TDIR MATCHNAME (TDIR _ (CL:IF (EQ TARGET 1)
                                                        (CAAR CDENTRIES)
                                                        (CADAR CDENTRIES))) IN (CDR CDENTRIES)
       EACHTIME (SETQ MATCHNAME (FETCH MATCHNAME OF CDE))
             (SETQ SINFO (FETCH INFO1 OF CDE))
             (SETQ TINFO (FETCH INFO2 OF CDE))
             (CL:WHEN (EQ TARGET 1)
                    (SWAP SINFO TINFO)) WHEN (AND (FETCH FULLNAME OF SINFO)
                                                          (NOT (FETCH FULLNAME OF TINFO)))
       UNLESS (AND MATCHNAMES (NOT (MEMB MATCHNAME MATCHNAMES)))
       COLLECT 

             (* ;; "Using the source fullname in the target should preserve the version number")

             (COPYFILE (FETCH FULLNAME OF SINFO)
                    (PACKFILENAME 'BODY TDIR 'BODY (FETCH FULLNAME OF SINFO)))
             MATCHNAME])

(COMPILED-ON-SAME-SOURCE
  [LAMBDA (CDENTRIES)                                   (* ; "Edited  9-Sep-2020 13:00 by rmk:")

    (* ;; "Returms a subset of CDENTRIES consisting of files that are compiled on the same source (i.e. their source names or dates are the same). Preserves the header.")

    (CDSUBSET CDENTRIES (FUNCTION (LAMBDA (CDE)
                                        (DECLARE (USEDFREE INFO1 INFO2))
                                        (LET (CREATED1 CREATED2)
                                             (CL:WHEN [AND (EQ 'COMPILED (FETCH TYPE OF
                                                                                         INFO1))
                                                           (EQ 'COMPILED (FETCH TYPE OF
                                                                                         INFO2))
                                                           [CDDR (SETQ CREATED1
                                                                  (CREATED-AS (FETCH FULLNAME
                                                                                     OF INFO1]
                                                           (CDDR (SETQ CREATED2
                                                                  (CREATED-AS (FETCH FULLNAME
                                                                                     OF INFO2]
                                                 (OR (EQUAL (CADDR CREATED1)
                                                            (CADDR CREATED2))
                                                     (EQUAL (CADDDR CREATED1)
                                                            (CADDDR CREATED2))))])
)

(RPAQ ONESECOND (IDIFFERENCE (IDATE "1-Jan-2020 12:00:01")
                           (IDATE "1-Jan-2020 12:00:00")))

(RPAQ? LASTCDENTRIES NIL)
(DEFINEQ

(COMPARE-ENTRY-SOURCE-FILES
  [LAMBDA (CDENTRY LISTSTREAM EXAMINE DW?)              (* ; "Edited 30-Aug-2020 12:22 by rmk:")

    (* ;; "Wrapper to call COMPARESOURCES on the Lisp source files of CDENTRY")

    (CL:WHEN [AND (EQ 'SOURCE (FETCH TYPE OF (FETCH INFO1 OF CDENTRY)))
                  (EQ 'SOURCE (FETCH TYPE OF (FETCH INFO2 OF CDENTRY]
        (COMPARESOURCES (FETCH FULLNAME OF (FETCH INFO1 OF CDENTRY))
               (FETCH FULLNAME OF (FETCH INFO2 OF CDENTRY))
               EXAMINE DW? LISTSTREAM))])
)

(FILESLOAD COMPARESOURCES)
(PUTPROPS COMPAREDIRECTORIES COPYRIGHT ("Venue & Xerox Corporation" 1985 1986 1987 1988 1990 1994 1998
 2018 2020))
(DECLARE%: DONTCOPY
  (FILEMAP (NIL (1629 16660 (COMPAREDIRECTORIES 1639 . 10129) (CDFILES 10131 . 14706) (
COMPAREDIRECTORIES.INFOS 14708 . 16223) (MATCHNAME 16225 . 16658)) (16661 23846 (CDPRINT 16671 . 21471
) (CDPRINT.LINE 21473 . 23844)) (23847 25599 (CDMAP 23857 . 24553) (CDENTRY 24555 . 24723) (CDSUBSET 
24725 . 25597)) (25600 31131 (BINCOMP 25610 . 29899) (EOLTYPE 29901 . 31129)) (31344 44551 (
FIND-UNCOMPILED-FILES 31354 . 34997) (FIND-UNSOURCED-FILES 34999 . 37808) (FIND-SOURCE-FILES 37810 . 
39514) (FIND-COMPILED-FILES 39516 . 41594) (FIND-UNLOADED-FILES 41596 . 42340) (FIND-LOADED-FILES 
42342 . 42896) (FIND-MULTICOMPILED-FILES 42898 . 44549)) (44552 52678 (CREATED-AS 44562 . 49359) (
SOURCE-FOR-COMPILED-P 49361 . 51983) (COMPILE-SOURCE-DATE-DIFF 51985 . 52676)) (52679 61686 (
FIX-DIRECTORY-DATES 52689 . 54685) (FIX-EQUIV-DATES 54687 . 55947) (COPY-COMPARED-FILES 55949 . 58073)
 (COPY-MISSING-FILES 58075 . 59914) (COMPILED-ON-SAME-SOURCE 59916 . 61684)) (61841 62452 (
COMPARE-ENTRY-SOURCE-FILES 61851 . 62450)))))
STOP
\ No newline at end of file
+(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
(FILECREATED "31-Oct-2020 09:13:05" 
{DSK}<Users>kaplan>Local>medley3.5>lispcore>lispusers>COMPAREDIRECTORIES.;274 62687  

      changes to%:  (FNS SOURCE-FOR-COMPILED-P FIX-DIRECTORY-DATES)

      previous date%: "23-Oct-2020 12:29:12" 
{DSK}<Users>kaplan>Local>medley3.5>lispcore>lispusers>COMPAREDIRECTORIES.;271)


(* ; "
Copyright (c) 1985, 1986, 1987, 1988, 1990, 1994, 1998, 2018, 2020 by Venue & Xerox Corporation.  All rights reserved.
")

(PRETTYCOMPRINT COMPAREDIRECTORIESCOMS)

(RPAQQ COMPAREDIRECTORIESCOMS
       (
        (* ;; "Compare the contents of two directories.")

        (FNS COMPAREDIRECTORIES CDFILES COMPAREDIRECTORIES.INFOS MATCHNAME)
        (FNS CDPRINT CDPRINT.LINE)
        (FNS CDMAP CDENTRY CDSUBSET)
        (FNS BINCOMP EOLTYPE)
        (RECORDS CDENTRY CDINFO)
        
        (* ;; "look for compiled files older than the sources")

        (FNS FIND-UNCOMPILED-FILES FIND-UNSOURCED-FILES FIND-SOURCE-FILES FIND-COMPILED-FILES 
             FIND-UNLOADED-FILES FIND-LOADED-FILES FIND-MULTICOMPILED-FILES)
        (FNS CREATED-AS SOURCE-FOR-COMPILED-P COMPILE-SOURCE-DATE-DIFF)
        (FNS FIX-DIRECTORY-DATES FIX-EQUIV-DATES COPY-COMPARED-FILES COPY-MISSING-FILES 
             COMPILED-ON-SAME-SOURCE)
        [VARS (ONESECOND (IDIFFERENCE (IDATE "1-Jan-2020 12:00:01")
                                (IDATE "1-Jan-2020 12:00:00"]
        (INITVARS (LASTCDENTRIES NIL))
        (COMS (FNS COMPARE-ENTRY-SOURCE-FILES)
              (FILES COMPARESOURCES))))



(* ;; "Compare the contents of two directories.")

(DEFINEQ

(COMPAREDIRECTORIES
  [LAMBDA (DIR1 DIR2 SELECT FILEPATTERNS EXTENSIONSTOAVOID USEDIRECTORYDATE OUTPUTFILE ALLVERSIONS)
                                                            (* ; "Edited 14-Oct-2020 21:15 by rmk:")

    (* ;; "Compare the contents of two directories, e.g., for change-control purposes.  Compares files matching FILEPATTERN (or *.*;) on DIR1 and DIR2, listing which is newer, or when one is not found on the other.  If SELECT is or contains SAME/=, BEFORE/<, AFTER/>, then files where DIR1 is the same as, earlier than, or later than DIR2 are selected. SELECT= NIL is the same as (<  >), T is the same as (< > =).  Also allows selection based on file-length criteria.")

    (* ;; "")

    (* ;; "Unless USEDIRECTORYDATE, comparison is with respect to the the LISP filecreated dates if evailable.")

    (* ;; "")

    (* ;; "If OUTPUTFILE is NIL, the list of compared entries is returned.  Otherwise the selected entries are printed on OUTPUTFILE (T for the display).")

    [SETQ SELECT (SELECTQ SELECT
                     (NIL '(< > -* *-))
                     (T '(< > -* *- =))
                     (FOR S IN (MKLIST SELECT) COLLECT (SELECTQ S
                                                                       ((AFTER >) 
                                                                            '>)
                                                                       ((BEFORE <) 
                                                                            '<)
                                                                       ((SAME SAMEDATE =) 
                                                                            '=)
                                                                       (AUTHOR 'AUTHOR)
                                                                       (-* '-*)
                                                                       (*- '*-)
                                                                       (ERROR 
                                                                      "UNRECOGNIZED SELECT PARAMETER"
                                                                              S]
    (PROG (INFOS1 INFOS2 CANDIDATES SELECTED COMPAREDATE DEPTH1 DEPTH2)
          [SETQ COMPAREDATE (INTERSECTION SELECT '(< > =]

     (* ;; "DIRECTORYNAME here to get unrelativized specifications for header.")

     (* ;; "Allow all subdirectories if a directory ends in *, but peel it off for the resolution")

          (CL:WHEN (EQ '* (NTHCHAR DIR1 -1))
              (SETQ DEPTH1 T)
              (SETQ DIR1 (SUBSTRING DIR1 1 -2)))
          (CL:WHEN (EQ '* (NTHCHAR DIR2 -1))
              (SETQ DEPTH2 T)
              (SETQ DIR2 (SUBSTRING DIR2 1 -2)))
          (SETQ DIR1 (OR (DIRECTORYNAME (OR DIR1 T))
                         (ERROR "DIRECTORY DOES NOT EXIST" DIR1)))
          (SETQ DIR2 (OR (DIRECTORYNAME (OR DIR2 T))
                         (ERROR "DIRECTORY DOES NOT EXIST" DIR2)))
          (PRINTOUT T "Comparing " DIR1 6 "vs. " DIR2 T "as of " (DATE)
                 " selecting " SELECT " ... ")
          (SETQ INFOS1 (COMPAREDIRECTORIES.INFOS (CDFILES DIR1 FILEPATTERNS EXTENSIONSTOAVOID
                                                            ALLVERSIONS DEPTH1)
                              USEDIRECTORYDATE))
          (SETQ INFOS2 (COMPAREDIRECTORIES.INFOS (CDFILES DIR2 FILEPATTERNS EXTENSIONSTOAVOID
                                                            ALLVERSIONS DEPTH2)
                              USEDIRECTORYDATE))
          (CL:UNLESS (AND INFOS2 INFOS1)
                 (RETURN))

     (* ;; "At this point the CAR of each info is the atomic match-name. Peel it off to produce candidate entries.")

     (* ;; 
   "Look through all of the I2's because multiple versions (if VERSIONS) have the same matchname")

          [SETQ CANDIDATES (FOR I1 IN INFOS1
                              JOIN (IF ALLVERSIONS
                                           THEN (OR (FOR I2 IN INFOS2
                                                           WHEN (EQ (CAR I2)
                                                                        (CAR I1))
                                                           COLLECT (LIST (CAR I1)
                                                                             (CDR I1)
                                                                             (CDR I2)))
                                                        (CONS (LIST (CAR I1)
                                                                    (CDR I1)
                                                                    NIL)))
                                         ELSE (CONS (LIST (CAR I1)
                                                              (CDR I1)
                                                              (CDR (ASSOC (CAR I1)
                                                                          INFOS2]

     (* ;; "Could be some 2's without 1's")

          (SORT [NCONC CANDIDATES (FOR I2 IN INFOS2 UNLESS (ASSOC (CAR I2)
                                                                              CANDIDATES)
                                     COLLECT (LIST (CAR I2)
                                                       NIL
                                                       (CDR I2]
                T)

     (* ;; "CANDIDATES is now a sorted list of the form (matchname entry1 entry2) where an entry consists of (fullname date length author)")

     (* ;; "Do the SELECT filtering and insert the date relation.")

          [SETQ SELECTED
           (FOR C MATCHNAME INFO1 INFO2 IDATE1 IDATE2 DATEREL BINCOMP IN CANDIDATES
              EACHTIME (SETQ MATCHNAME (POP C))
                    (SETQ INFO1 (POP C))
                    (SETQ INFO2 (POP C))
                    (IF (AND INFO1 INFO2)
                        THEN (SETQ IDATE1 (IDATE (FETCH DATE OF INFO1)))
                              (SETQ IDATE2 (IDATE (FETCH DATE OF INFO2)))
                              (SETQ DATEREL (IF (IGREATERP IDATE1 IDATE2)
                                                THEN '>
                                              ELSEIF (ILESSP IDATE1 IDATE2)
                                                THEN '<
                                              ELSE '=))
                      ELSE 

                            (* ;; "Just for printing--no comparison")

                            (SETQ DATEREL '*))
              WHEN (IF (AND INFO1 INFO2)
                           THEN (OR (NULL COMPAREDATE)
                                        (SELECTQ DATEREL
                                            (> (MEMB '> SELECT))
                                            (< (MEMB '< SELECT))
                                            (= (MEMB '= SELECT))
                                            (SHOULDNT)))
                         ELSEIF INFO1
                           THEN 

                                 (* ;; "OK if INFO2 is missing?")

                                 (MEMB '*- SELECT)
                         ELSE 

                               (* ;; "OK if INFO1 is missing?")

                               (MEMB '-* SELECT))
              COLLECT (CREATE CDENTRY
                                 MATCHNAME _ MATCHNAME
                                 INFO1 _ INFO1
                                 DATEREL _ DATEREL
                                 INFO2 _ INFO2
                                 EQUIV _ (CL:UNLESS (EQ DATEREL '*)
                                             (BINCOMP (FETCH FULLNAME OF INFO1)
                                                    (FETCH FULLNAME OF INFO2)
                                                    T
                                                    (FETCH EOL OF INFO1)
                                                    (FETCH EOL OF INFO2)))]
          (PRINTOUT T (LENGTH SELECTED)
                 " entries" T)
          (PUSH SELECTED (LIST DIR1 DIR2 SELECT (DATE)))
          (SETQ LASTCDENTRIES SELECTED)
          (CL:UNLESS OUTPUTFILE (RETURN SELECTED))
          (RETURN (CDPRINT SELECTED OUTPUTFILE (MEMB 'AUTHOR SELECT SELECT])

(CDFILES
  [LAMBDA (DIR FILEPATTERNS EXTENSIONSTOAVOID ALLVERSIONS DEPTH)
                                                            (* ; "Edited 16-Oct-2020 13:42 by rmk:")

    (* ;; "Returns a list of fullnames for files that satisfy the criteria")

    (* ;; "For each name returned by (DIRECTORY DIR), assumes that FILEPATTERNS applies to the suffix after the directory (i.e. after NAMEPOS).  That includes possibly subdirectories, dotted files in ultimate file names, and versions.")

    (* ;; "     Exclude subdirectories unless FILEPATTERNS includes *>*")

    (* ;; "     Exclude dotted files (.xxx) unless FILEPATTERNS includes .*")

    (* ;; "     Exclude files with extensions in EXTENSIONSTOAVOID (*=NIL does no filtering)")

    (* ;; "     Exclude older versions unless ALLVERSIONS=T")

    (* ;; "  DEPTH is the number of subdirectories below the ones specified in DIR (NIL top-level of DIR only, T = any depth)")

    (* ;; "Resolve relative directories, so we can suppress subdirectory matches.   ")

    (SETQ EXTENSIONSTOAVOID (MKLIST (U-CASE EXTENSIONSTOAVOID)))
    [SETQ FILEPATTERNS (MKLIST (OR FILEPATTERNS '*]
    (FOR FP FN FPNAME FPEXT EXCLUDEDOTTED (TOPDIR _ (DIRECTORYNAME (OR DIR T))) IN 
                                                                                         FILEPATTERNS
       JOIN [SETQ FPNAME (U-CASE (FILENAMEFIELD FP 'NAME]
             [SETQ FPEXT (U-CASE (FILENAMEFIELD FP 'EXTENSION]
             (CL:UNLESS FPNAME
                 (IF FPEXT
                     THEN 

                           (* ;; ".XY")

                           (SETQ FPNAME (PACK* "." FPEXT))
                   ELSE (SETQ FPNAME '*)))
             (CL:UNLESS FPEXT
                 (SETQ FPEXT '*))
             (SETQ EXCLUDEDOTTED (NEQ (CHARCODE %.)
                                      (CHCON1 FPNAME)))
             (SETQ FN (PACKFILENAME.STRING 'VERSION (CL:IF ALLVERSIONS
                                                        '*
                                                        "")
                             'DIRECTORY TOPDIR 'NAME '* 'EXTENSION '*)) 

             (* ;; "DEPTH is the number of internal %">%"")

             [IF (EQ DEPTH T)
                 THEN (SETQ DEPTH MAX.SMALLP)
               ELSEIF DEPTH
               ELSE (SETQ DEPTH (BIND (CNT _ 0)
                                           (POS _ 0)
                                           (FNDIR _ (FILENAMEFIELD FN 'DIRECTORY))
                                       WHILE (SETQ POS (STRPOS ">" FNDIR (ADD1 POS)))
                                       DO (ADD CNT 1) FINALLY (RETURN CNT]
             (FOR FULLNAME NAME EXT THISDEPTH IN (DIRECTORY FN)
                EACHTIME [SETQ NAME (U-CASE (FILENAMEFIELD FULLNAME 'NAME]
                      [SETQ EXT (U-CASE (FILENAMEFIELD FULLNAME 'EXTENSION]
                      (CL:UNLESS NAME
                          (IF EXT
                              THEN 

                                    (* ;; ".XY")

                                    (SETQ NAME (PACK* "." EXT))
                                    (SETQ EXT NIL)))
                      (CL:WHEN (AND EXCLUDEDOTTED (EQ (CHARCODE %.)
                                                      (CHCON1 NAME)))
                             (GO $$ITERATE))
                      (SETQ THISDEPTH (BIND (CNT _ 0)
                                             (POS _ 0)
                                             (FNDIR _ (FILENAMEFIELD FULLNAME 'DIRECTORY))
                                         WHILE (SETQ POS (STRPOS ">" FNDIR (ADD1 POS)))
                                         DO (ADD CNT 1) FINALLY (RETURN CNT))) 

                      (* ;; "An empty subdirectory may appear without name or extensions")
 WHEN (AND (OR NAME EXT)
               (OR (EQ FPNAME '*)
                   (EQ FPNAME NAME))
               (OR (EQ FPEXT '*)
                   (EQ FPEXT EXT))) UNLESS [OR (IGREATERP THISDEPTH DEPTH)
                                                   (AND EXT (OR (MEMB '* EXTENSIONSTOAVOID)
                                                                (MEMB EXT EXTENSIONSTOAVOID]
                COLLECT FULLNAME) FINALLY (CL:UNLESS $$VAL (PRINTOUT T 
                                                                          "No relevant files in " 
                                                                          TOPDIR T])

(COMPAREDIRECTORIES.INFOS
  [LAMBDA (FILES USEDIRECTORYDATE)                      (* ; "Edited 13-Oct-2020 08:42 by rmk:")

    (* ;; "Value is a list of CDINFOS with the match-name consed on to the front")

    (FOR FULLNAME TYPE LDATE IN FILES
       COLLECT 

             (* ;; "GDATE/IDATE in case Y2K")

             (SETQ LDATE (FILEDATE FULLNAME))                (* ; "Is it a Lisp file?")
             (CONS (MATCHNAME FULLNAME)
                   (CREATE CDINFO
                          FULLNAME _ FULLNAME
                          DATE _ [GDATE (IDATE (IF USEDIRECTORYDATE
                                                   THEN (GETFILEINFO FULLNAME 'CREATIONDATE)
                                                 ELSEIF (OR LDATE (GETFILEINFO FULLNAME
                                                                             'CREATIONDATE]
                          LENGTH _ (GETFILEINFO FULLNAME 'LENGTH)
                          AUTHOR _ (GETFILEINFO FULLNAME 'AUTHOR)
                          TYPE _ (IF LDATE
                                     THEN (CL:IF (MEMB (FILENAMEFIELD FULLNAME 'EXTENSION)
                                                           *COMPILED-EXTENSIONS*)
                                                  'COMPILED
                                                  'SOURCE)
                                   ELSE (PRINTFILETYPE FULLNAME))
                          EOL _ (EOLTYPE FULLNAME])

(MATCHNAME
  [LAMBDA (NAME)                                        (* ; "Edited  5-Sep-2020 13:41 by rmk:")

    (* ;; "The NAME.DIR for matching related files")

    (LET ((M (PACKFILENAME 'HOST NIL 'VERSION NIL 'DIRECTORY NIL 'BODY NAME)))

         (* ;; "Strip off the nuisance period")

         (CL:IF (EQ (CHARCODE %.)
                    (NTHCHARCODE M -1))
             (SUBATOM M 1 -2)
             M)])
)
(DEFINEQ

(CDPRINT
  [LAMBDA (CDENTRIES FILE PRINTAUTHOR)                  (* ; "Edited 13-Oct-2020 08:38 by rmk:")

    (* ;; "Typically CDENTRIES will have a header.  If not, we fake one up, at least for the directories and today's date.")

    (CL:UNLESS CDENTRIES
        (PRINTOUT T T "Note:  Using LASTCDENTRIES" T T)
        (SETQ CDENTRIES LASTCDENTRIES))
    (RESETLST
        (LET (INFO1 TEXT STREAM DATE1POS ENDDATE1 DIR1 DIR2 (HEADER (CAR CDENTRIES))
                    NCHARSDIR1)
             (CL:UNLESS (STRINGP (CADR HEADER))
                 (SETQ HEADER (LIST [FOR E IN CDENTRIES WHEN (FETCH INFO1
                                                                            OF E)
                                       DO (RETURN (PACKFILENAME 'NAME NIL 'EXTENSION NIL
                                                             'VERSION NIL 'BODY
                                                             (FETCH FULLNAME
                                                                OF (FETCH INFO1 OF E]
                                    [FOR E IN CDENTRIES WHEN (FETCH INFO2
                                                                            OF E)
                                       DO (RETURN (PACKFILENAME 'NAME NIL 'EXTENSION NIL
                                                             'VERSION NIL 'BODY
                                                             (FETCH FULLNAME
                                                                OF (FETCH INFO2 OF E]
                                    NIL
                                    (DATE)))
                 (PUSH CDENTRIES HEADER))
             (SETQ DIR1 (CAR HEADER))
             (SETQ NCHARSDIR1 (NCHARS DIR1))
             (SETQ DIR2 (CADR HEADER))
             (CL:UNLESS (SETQ STREAM (GETSTREAM FILE 'OUTPUT T))
                 [RESETSAVE (SETQ STREAM (OPENSTREAM (PACKFILENAME 'EXTENSION 'TXT 'BODY FILE)
                                                'OUTPUT
                                                'NEW))
                        '(PROGN (CLOSEF? OLDVALUE])
             (CL:WHEN DIR1
                 (PRINTOUT STREAM "Comparing " DIR1 6 "vs. " DIR2 T "as of " (CADDDR HEADER))
                 (CL:WHEN (CADDR HEADER)
                     (PRINTOUT STREAM " selecting " (CADDR HEADER)))
                 (PRINTOUT STREAM -2 (LENGTH (CDR CDENTRIES))
                        " entries" T T))
             (LINELENGTH 1000 STREAM)                        (* ; "Don't wrap")

             (* ;; "DATE1POS is the position of the first character of INFO1's date, used for tabbing.  We have to measure the filename, date, size, and author if desired")

             (IF (CDR CDENTRIES)
                 THEN (FOR E INFO1 (MAXDATE1WIDTH _ 0)
                                 (SPACEWIDTH _ 1)
                                 (PARENWIDTH _ 2) IN (CDR CDENTRIES)
                             WHEN (SETQ INFO1 (FETCH INFO1 OF E))
                             LARGEST [SETQ MAXDATE1WIDTH (IMAX MAXDATE1WIDTH
                                                                   (NCHARS (FETCH DATE
                                                                              OF INFO1]
                                   (IPLUS (- (NCHARS (FETCH FULLNAME OF INFO1))
                                             NCHARSDIR1)
                                          (NCHARS (FETCH LENGTH OF INFO1))
                                          (CL:IF PRINTAUTHOR
                                              (IPLUS SPACEWIDTH PARENWIDTH
                                                     (NCHARS (FETCH AUTHOR OF INFO1)))
                                              0)) FINALLY 

                                                        (* ;; 
                            "First 4 for width of equiv.  $$EXTREME is NIL if there are no INFO1's")

                                                        (SETQ DATE1POS (IPLUS (OR $$EXTREME 10)
                                                                              4
                                                                              (ITIMES 3 SPACEWIDTH)))
                                                        (SETQ ENDDATE1 (IPLUS DATE1POS MAXDATE1WIDTH)
                                                         ))
                       (FOR E IN (CDR CDENTRIES)
                          DO (CDPRINT.LINE STREAM E PRINTAUTHOR DATE1POS ENDDATE1 NCHARSDIR1
                                        (NCHARS DIR2)))
               ELSE (PRINTOUT T "CDENTRIES is empty" T))
             (AND STREAM (CLOSEF? STREAM))))])

(CDPRINT.LINE
  [LAMBDA (STREAM ENTRY PRINTAUTHOR DATE1POS ENDDATE1 NCHARSDIR1 NCHARSDIR2)
                                                            (* ; "Edited 13-Oct-2020 08:51 by rmk:")

    (* ;; "Format one line of the directory comparison listing.  If PRINTAUTHOR and AUTHOR1 or AUTHOR2 are non-NIL, list the author in parens; otherwise omit it.")

    (LET ((INFO1 (FETCH INFO1 OF ENTRY))
          (INFO2 (FETCH INFO2 OF ENTRY)))
         (PRINTOUT STREAM (SELECTQ (FETCH EQUIV OF ENTRY)
                              (T "==")
                              (NIL "  ")
                              (PROGN (SELECTQ (FETCH EOL OF INFO1)
                                         (CR 'C)
                                         (LF 'L)
                                         (CRLF 2)
                                         " ")
                                     (SELECTQ (FETCH EOL OF INFO2)
                                         (CR 'C)
                                         (LF 'L)
                                         (CRLF 2)
                                         " ")))
                " ")
         (CL:WHEN INFO1
             (PRINTOUT STREAM (SUBSTRING (FETCH FULLNAME OF INFO1)
                                     (ADD1 NCHARSDIR1)
                                     NIL
                                     (CONSTANT (CONCAT)))
                    " ")
             (CL:WHEN PRINTAUTHOR
                 (PRINTOUT STREAM "(" (FETCH AUTHOR OF INFO1)
                        ") "))
             (PRINTOUT STREAM (FETCH LENGTH OF INFO1)
                    .TAB0 DATE1POS (FETCH DATE OF INFO1)))
         (PRINTOUT STREAM .TAB0 ENDDATE1 "  " (FETCH DATEREL OF ENTRY)
                "  ")
         (CL:WHEN INFO2
             (PRINTOUT STREAM (FETCH DATE OF INFO2)
                    "   "
                    (SUBSTRING (FETCH FULLNAME OF INFO2)
                           (ADD1 NCHARSDIR2)
                           NIL
                           (CONSTANT (CONCAT)))
                    " ")
             (CL:WHEN PRINTAUTHOR
                 (PRINTOUT STREAM "(" (FETCH AUTHOR OF INFO2)
                        ") "))
             (PRINTOUT STREAM (FETCH LENGTH OF INFO2)))
         (TERPRI STREAM])
)
(DEFINEQ

(CDMAP
  [LAMBDA (CDENTRIES FN)                                (* ; "Edited  6-Sep-2020 15:58 by rmk:")
    (CL:UNLESS CDENTRIES
        (PRINTOUT T T "Note:  Using LASTCDENTRIES" T T)
        (SETQ CDENTRIES LASTCDENTRIES))
    (FOR CDE MATCHNAME INFO1 DATEREL INFO2 EQUIV IN (CDR CDENTRIES)
       DECLARE (SPECVARS MATCHNAME INFO1 DATEREL INFO2 EQUIV)
       EACHTIME (SETQ MATCHNAME (FETCH MATCHNAME OF CDE))
             (SETQ INFO1 (FETCH INFO1 OF CDE))
             (SETQ DATEREL (FETCH DATEREL OF CDE))
             (SETQ INFO2 (FETCH INFO2 OF CDE))
             (SETQ EQUIV (FETCH EQUIV OF CDE)) DO (APPLY* FN CDE])

(CDENTRY
  [LAMBDA (MATCHNAME CDENTRIES)                     (* ; "Edited  5-Sep-2020 21:09 by rmk:")
    (ASSOC MATCHNAME (OR CDENTRIES LASTCDENTRIES])

(CDSUBSET
  [LAMBDA (CDENTRIES FN)                                (* ; "Edited 15-Sep-2020 13:49 by rmk:")
    (CL:UNLESS CDENTRIES
        (PRINTOUT T T "Note:  Using LASTCDENTRIES" T T)
        (SETQ CDENTRIES LASTCDENTRIES))
    (CONS (CAR CDENTRIES)
          (FOR CDE MATCHNAME INFO1 DATEREL INFO2 EQUIV IN (CDR CDENTRIES)
             DECLARE (SPECVARS MATCHNAME INFO1 DATEREL INFO2 EQUIV)
             EACHTIME (SETQ MATCHNAME (FETCH MATCHNAME OF CDE))
                   (SETQ INFO1 (FETCH INFO1 OF CDE))
                   (SETQ DATEREL (FETCH DATEREL OF CDE))
                   (SETQ INFO2 (FETCH INFO2 OF CDE))
                   (SETQ EQUIV (FETCH EQUIV OF CDE)) WHEN (APPLY* FN CDE) COLLECT
                                                                                      CDE])
)
(DEFINEQ

(BINCOMP
  [LAMBDA (FILE1 FILE2 EOLDIFFOK EOL1 EOL2)             (* ; "Edited 13-Oct-2020 08:53 by rmk:")

    (* ;; "Returns T if FILE1 and FILE2 are byte-equivalent.  Returns EOLDIFF if they are byte equivalent except for CR/LF/CRLF exchanges.  ")

    (* ;; "If EOLDIFFOK, return indicates that the files are the same except for EOL mappings.  If EOL1 and EOL2 are not provided, they are computed here.")

    (IF (IEQP (GETFILEINFO FILE1 'LENGTH)
                  (GETFILEINFO FILE2 'LENGTH))
        THEN [CL:WITH-OPEN-FILE
                  (STREAM1 FILE1 :DIRECTION :INPUT)
                  (CL:WITH-OPEN-FILE
                   (STREAM2 FILE2 :DIRECTION :INPUT)
                   (SETFILEINFO STREAM1 'ENDOFSTREAMOP (FUNCTION NILL))

                   (* ;; "Simpler code to recompute eol's even if provided")

                   (BIND B1 B2 EOL1 EOL2 EOLDIFF WHILE (SETQ B1 (\BIN STREAM1))
                      UNLESS (EQ B1 (SETQ B2 (\BIN STREAM2)))
                      DO (CL:UNLESS (AND EOLDIFFOK (SELCHARQ B1
                                                            (CR (CL:WHEN (EQ EOL1 'LF)
                                                                       (RETURN NIL))
                                                                (SETQ EOL1 'CR)
                                                                (SETQ EOL2 'LF)
                                                                (EQ B2 (CHARCODE LF)))
                                                            (LF (CL:WHEN (EQ EOL1 'CR)
                                                                       (RETURN NIL))
                                                                (SETQ EOL1 'LF)
                                                                (SETQ EOL2 'CR)
                                                                (EQ B2 (CHARCODE CR)))
                                                            NIL))
                                    (RETURN NIL))
                            (CL:UNLESS EOLDIFF
                                (SETQ EOLDIFF (LIST EOL1 EOL2))) FINALLY (RETURN (OR EOLDIFF T]
      ELSEIF EOLDIFFOK
        THEN 

              (* ;; "Lengths are different possibly because of CRLF to CR/LF substitutions.")

              (* ;; 
        "More complex code could detect the EOLTYPE incrementally without separate passes, but ...")

              (CL:UNLESS EOL1
                  (SETQ EOL1 (EOLTYPE FILE1)))
              (CL:UNLESS EOL2
                  (SETQ EOL2 (EOLTYPE FILE2)))
              (CL:WHEN (IF [AND (EQ EOL1 'CRLF)
                                    (MEMB EOL2 '(LF CR]
                         ELSEIF [AND (EQ EOL2 'CRLF)
                                         (MEMB EOL1 '(LF CR]
                           THEN (SWAP FILE1 FILE2))

                  (* ;; "FILE1 is now CRLF, FILE2 is not.  If FILE1 isn't longer, it can't have a CRLF that corresponds to a CR or LF.")

                  (CL:WHEN (IGREATERP (GETFILEINFO FILE1 'LENGTH)
                                  (GETFILEINFO FILE2 'LENGTH))
                      [CL:WITH-OPEN-FILE (STREAM1 FILE1 :DIRECTION :INPUT)
                             (CL:WITH-OPEN-FILE (STREAM2 FILE2 :DIRECTION :INPUT)
                                    (SETFILEINFO STREAM1 'ENDOFSTREAMOP (FUNCTION NILL))
                                    (BIND B1 B2 EOLDIFF WHILE (SETQ B1 (\BIN STREAM1))
                                       UNLESS (EQ B1 (SETQ B2 (\BIN STREAM2)))
                                       DO (CL:UNLESS [AND (EQ (CHARCODE CR)
                                                                  B1)
                                                              (EQ (CHARCODE LF)
                                                                  (\BIN STREAM1))
                                                              (MEMB B2 (CHARCODE (CR LF]
                                                     (RETURN NIL))
                                             (CL:UNLESS EOLDIFF
                                                 (SETQ EOLDIFF (LIST EOL1 EOL2)))
                                       FINALLY (RETURN (OR EOLDIFF T]))])

(EOLTYPE
  [LAMBDA (FILE)                                        (* ; "Edited  3-Sep-2020 17:05 by rmk:")

    (* ;; "Returns the EOLCONVENTION of FILE if it only sees one kind, NIL if it can't decide.")

    (CL:WITH-OPEN-FILE (STREAM FILE :DIRECTION :INPUT)
           (SETFILEINFO STREAM 'ENDOFSTREAMOP (FUNCTION NILL))
           (BIND EOLTYPE
              DO (SELCHARQ (OR (\BIN STREAM)
                                   (RETURN EOLTYPE))
                          (CR (IF (EQ (CHARCODE LF)
                                          (\PEEKBIN STREAM T))
                                  THEN (CL:WHEN (MEMB EOLTYPE '(LF CR))
                                                  (RETURN NIL))
                                        (\BIN STREAM)
                                        (SETQ EOLTYPE 'CRLF)
                                ELSEIF (MEMB EOLTYPE '(LF CRLF))
                                  THEN (RETURN NIL)
                                ELSE (SETQ EOLTYPE 'CR)))
                          (LF (CL:WHEN (MEMB EOLTYPE '(CR CRLF))
                                     (RETURN NIL))
                              (SETQ EOLTYPE 'LF))
                          NIL])
)
(DECLARE%: EVAL@COMPILE

(RECORD CDENTRY (MATCHNAME INFO1 DATEREL INFO2 . EQUIV))

(RECORD CDINFO (FULLNAME DATE LENGTH AUTHOR TYPE EOL))
)



(* ;; "look for compiled files older than the sources")

(DEFINEQ

(FIND-UNCOMPILED-FILES
  [LAMBDA (FILES DFASLMARGIN COMPILEEXTS)               (* ; "Edited 20-Sep-2020 23:04 by rmk:")
                                                             (* ; "Edited  3-Nov-94 15:17 by jds")

    (* ;; "Produces a list of the source files in FILES that have no corresponding compiled file")

    (* ;; "This determines whether there is at least one compiled file.  If there are two or more, that's a problem")

    (* ;; "We want the most recent version only")

    (* ;; "Source files have a 2-element created-as with a non-NIL date")

    (SETQ FILES (FOR F IN (OR (LISTP FILES)
                                      (FILDIR FILES)) UNLESS (MEMB (SETQ F (PACKFILENAME
                                                                                'VERSION NIL
                                                                                'BODY F))
                                                                       $$VAL) COLLECT F))
    (FOR F SCREATION FILES IN FILES WHEN (AND (CADR (SETQ SCREATION (CREATED-AS
                                                                                 F)))
                                                          (NOT (CDDR SCREATION)))
       WHEN [SETQ FILES
                 (FOR CEXT CF IN (OR COMPILEEXTS *COMPILED-EXTENSIONS*)
                    WHEN (SETQ CF (INFILEP (PACKFILENAME 'EXTENSION CEXT 'VERSION NIL
                                                      'BODY F)))
                    COLLECT (CL:WHEN (SOURCE-FOR-COMPILED-P SCREATION CF DFASLMARGIN)
                                       (RETURN NIL))
                          CF
                    FINALLY 

                          (* ;; "If we found some compiled files, they weren't on this source.  If there weren't any compiled files to check, maybe there weren't any functions.")

                          (* ;; 
      "NLSETQ because we don't want to stop if there is an error, typically from a package problem")

                          (RETURN (OR $$VAL (LET [(FCOMS (CAR (NLSETQ (GETDEF (FILECOMS F)
                                                                             'VARS F]
                                                 (IF (NULL FCOMS)
                                                     THEN 

                                                           (* ;; 
                                               "GETDEF caused an error.  Maybe a package problem. ")

                                                           (AND NIL 'NOCOMMANDS)
                                                   ELSEIF (INFILECOMS? NIL '(FUNCTIONS FNS)
                                                                     FCOMS)
                                                     THEN T]
       COLLECT (CONS F (SELECTQ FILES
                               (T NIL)
                               (NOCOMMANDS (CONS "No commands"))
                               (FOR CF IN FILES COLLECT 

                                                        (* ;; 
           "Positive means that compiled is later than source, normal order but maybe by too much.")

                                                              (* ;; 
                                            "Negative means that compiled came before source.  Odd")

                                                              (LIST CF (COMPILE-SOURCE-DATE-DIFF
                                                                        CF SCREATION])

(FIND-UNSOURCED-FILES
  [LAMBDA (FILES DFASLMARGIN COMPILEEXTS)               (* ; "Edited 15-Sep-2020 15:32 by rmk:")
                                                             (* ; "Edited  3-Nov-94 15:17 by jds")

    (* ;; 
  "Produces a list of compiled FILES for which no source file can be found in the same directory.")

    (* ;; "The source date in at least one DFASL was off by a second, maybe some sort of IDATE rounding?  So, give a margin.")

    (* ;; 
"We want the most recent version only.  Check CREATED-AS to make sure it really is a compiled file.")

    (* ;; "Sort to get lcoms and dfasls next to each other.")

    (LET (CCREATEDS)
         (SETQ CCREATEDS (FOR CEXT FOUND CCREATED INSIDE (OR COMPILEEXTS 
                                                                     *COMPILED-EXTENSIONS*)
                            JOIN (FOR CF IN [OR (LISTP FILES)
                                                            (FILDIR (PACKFILENAME 'EXTENSION CEXT
                                                                           'VERSION "" 'BODY
                                                                           '*]
                                        WHEN (CDDR (SETQ CCREATED (CREATED-AS CF)))
                                        UNLESS (MEMBER CCREATED $$VAL) COLLECT CCREATED)))

         (* ;; "CCREATEDS is now a list of CREATED-AS items")

         (FOR CC SF IN CCREATEDS UNLESS (AND [SETQ SF (INFILEP (PACKFILENAME 'EXTENSION 
                                                                                  NIL 'VERSION NIL
                                                                                  'BODY
                                                                                  (CAR CC]
                                                         (SOURCE-FOR-COMPILED-P (SETQ SF
                                                                                     (CREATED-AS
                                                                                      SF))
                                                                CC DFASLMARGIN))
            COLLECT [LIST (CAR CC)
                              (AND SF (LIST (CAR SF)
                                            (ROUND (COMPILE-SOURCE-DATE-DIFF CC SF]
            FINALLY (RETURN (SORT $$VAL (FUNCTION (LAMBDA (CF1 CF2)
                                                        (ALPHORDER (FILENAMEFIELD (CAR CF1)
                                                                          'NAME)
                                                               (FILENAMEFIELD (CAR CF2)
                                                                      'NAME])

(FIND-SOURCE-FILES
  [LAMBDA (CFILES SDIRS DFASLMARGIN)                    (* ; "Edited  9-Sep-2020 12:26 by rmk:")

    (* ;; "Returns (CFILE . SFILES) pairs where CFILE is a Lisp compiled file in CFILES SFILES is a list of source files in SDIRS that CFILE was compiled on.")

    (* ;; "This suggests that one of CFILES should be copied to the SFILE directory.")

    (SETQ SDIRS (FOR SD INSIDE (OR SDIRS T) COLLECT (DIRECTORYNAME SD)))
    (SORT (FOR CF SFILES CNAME CCREATED IN (OR (LISTP CFILES)
                                                       (FILDIR CFILES))
             WHEN (AND (SETQ CNAME (INFILEP CF))
                           (CDDR (SETQ CCREATED (CREATED-AS CF)))
                           (SETQ SFILES (FOR SD SF IN SDIRS
                                           WHEN (AND (SETQ SF (INFILEP (PACKFILENAME
                                                                            'NAME
                                                                            (FILENAMEFIELD
                                                                             CF
                                                                             'NAME)
                                                                            'BODY SD)))
                                                         (SOURCE-FOR-COMPILED-P SF CCREATED 
                                                                DFASLMARGIN)) COLLECT SF)))
             COLLECT (CONS CNAME SFILES))
          (FUNCTION (LAMBDA (P1 P2)
                      (ALPHORDER (FILENAMEFIELD (CAR P1))
                             (FILENAMEFIELD (CAR P2])

(FIND-COMPILED-FILES
  [LAMBDA (SFILES CDIRS DFASLMARGIN)                    (* ; "Edited  9-Sep-2020 12:26 by rmk:")

    (* ;; "Returns (SFILE . CFILES) pairs where SFILE is a Lisp source file in SFILES CFILES is a list of compiled files in CDIRS that were compiled on SFILE.")

    (* ;; "FILEDATE is true for source files and compiled files")

    (* ;; "This suggests that one of CFILES should be copied to the SFILE directory.")

    (SETQ CDIRS (FOR CD INSIDE (OR CDIRS T) COLLECT (DIRECTORYNAME CD)))
    (SORT (FOR SF CFILES SNAME SCREATED IN (OR (LISTP SFILES)
                                                       (FILDIR SFILES))
             WHEN [AND (SETQ SNAME (INFILEP SF))
                           (SETQ SCREATED (CREATED-AS SF))
                           (NOT (CDDR SCREATED))
                           (SETQ CFILES (FOR CEXT (ROOT _ (FILENAMEFIELD SNAME 'NAME))
                                           IN *COMPILED-EXTENSIONS*
                                           JOIN (FOR CD CF IN CDIRS
                                                       WHEN (AND (SETQ CF
                                                                      (INFILEP (PACKFILENAME
                                                                                'NAME ROOT
                                                                                'EXTENSION CEXT
                                                                                'BODY CD)))
                                                                     (SOURCE-FOR-COMPILED-P
                                                                      SCREATED CF DFASLMARGIN))
                                                       COLLECT CF] COLLECT (CONS SNAME CFILES
                                                                                         ))
          (FUNCTION (LAMBDA (P1 P2)
                      (ALPHORDER (FILENAMEFIELD (CAR P1))
                             (FILENAMEFIELD (CAR P2])

(FIND-UNLOADED-FILES
  [LAMBDA (FILES)                                       (* ; "Edited  9-Sep-2020 19:35 by rmk:")

    (* ;; "Returns the files in FILES that don't have FILECREATED properties and presumably are therefore not loaded in the current sysout.")

    (FOR F IN (OR (LISTP FILES)
                          (FILDIR FILES)) WHEN (AND (SETQ F (INFILEP (CL:IF (LISTP F)
                                                                             (CAR F)
                                                                             F)))
                                                        (FILEDATE F))
       UNLESS (GETP (FILENAMEFIELD F 'NAME)
                        'FILEDATES) COLLECT F])

(FIND-LOADED-FILES
  [LAMBDA (ROOTFILENAMES)                               (* ; "Edited 19-Sep-2020 07:20 by rmk:")
    (FOR RN INSIDE ROOTFILENAMES WHEN (GETP RN 'FILEDATES)
       COLLECT (CONS RN (FOR F IN LOADEDFILELST WHEN (EQ RN (FILENAMEFIELD
                                                                             F
                                                                             'NAME)) COLLECT
                                                                                     F])

(FIND-MULTICOMPILED-FILES
  [LAMBDA (FILES SHOWINFO)                              (* ; "Edited 20-Sep-2020 20:57 by rmk:")

    (* ;; "Returns a list of names for files in FILES that have multiple compilations")

    (LET (SFILES)
         (FOR F EXT NAME IN (OR (LISTP FILES)
                                        (FILDIR FILES)) WHEN (MEMB (SETQ EXT (FILENAMEFIELD
                                                                                  F
                                                                                  'EXTENSION))
                                                                       *COMPILED-EXTENSIONS*)
            DO (SETQ NAME (FILENAMEFIELD F 'NAME)) 

                  (* ;; "PUSHNEW because we haven't filtered out versions")

                  (PUSHNEW [CDR (OR (ASSOC NAME SFILES)
                                        (CAR (PUSH SFILES (CONS NAME]
                         EXT))
         (FOR S IN SFILES WHEN (CDDR S)
            COLLECT (IF SHOWINFO
                            THEN `[,(CAR S)
                                       ,(CADAR (FIND-LOADED-FILES (CAR S)))
                                       ,(CREATED-AS (CAR S))
                                       ,@(FOR EXT IN (SORT (CDR S))
                                            COLLECT (CREATED-AS (PACKFILENAME 'EXTENSION EXT
                                                                               'BODY
                                                                               (CAR S]
                          ELSE (CAR S])
)
(DEFINEQ

(CREATED-AS
  [LAMBDA (FILE)                                        (* ; "Edited 20-Sep-2020 23:06 by rmk:")

    (* ;; "For lisp source files, returns (filecreatename filecreateddate)")

    (* ;; "For lisp compiled files, returns (cfilename cfiledate sfilecreatename sfilecreateddate)")

    (* ;; "For other files, (fullfilename NIL)")

    (* ;; "The cfilename is just the current directory name for DFASLs.")

    (* ;; "So:  (CADR value) is non-NIL for Lisp files.  Of those, (CDDR value) is non-NIL for compiled files.")

    (* ;; "We disable the package delimiter because the atoms in changes may have a packages that we don't know.")

    (CL:WITH-OPEN-FILE
     (STREAM FILE :DIRECTION :INPUT)
     (LET
      (FILEDATE FILENAME SOURCEDATE SOURCENAME LINE POS)
      [IF (EQ (CHARCODE %()
                  (SKIPSEPRCODES STREAM))
          THEN                                           (* ; "Managed source or LCOM")
          (RESETLST
              [LET (FORM SFORM (RDTBL (FIND-READTABLE "OLD-INTERLISP-FILE")))
                   (SETQ POS (GETFILEPTR STREAM))
                   (READCCODE STREAM)
                   (IF (EQ 'DEFINE-FILE-INFO (RATOM STREAM RDTBL))
                       THEN 

                             (* ;; "Reading is package-safe")

                             (SETFILEPTR STREAM POS)
                             (SETQ FORM (READ STREAM RDTBL))
                             (SETQ RDTBL (FIND-READTABLE (LISTGET (CDR FORM)
                                                                :READTABLE)))
                     ELSE (SETFILEPTR STREAM POS))
                   (CL:WHEN (EQ 'PACKAGEDELIM (GETSYNTAX '%: RDTBL))
                       [RESETSAVE (SETSYNTAX '%: 'OTHER RDTBL)
                              `(SETSYNTAX %: PACKAGEDELIM ,RDTBL])

                   (* ;; "One way or the other, we're ready for the filecreated")

                   (CL:WHEN (EQ (CHARCODE %()
                                (SKIPSEPRCODES STREAM))
                       (SETQ FORM (READ STREAM RDTBL))
                       (CL:WHEN (MEMB (U-CASE (CAR FORM))
                                      '(FILECREATED IL%:FILECREATED))

                           (* ;; "IL%%:FILECREATED because we screwed the readtable.")

                           (IF [STREQUAL "compiled on " (CAR (LISTP (CADDR FORM]
                               THEN                      (* ; "LCOM, get source info")
                                     (IF [AND (EQ (CHARCODE %()
                                                      (SKIPSEPRCODES STREAM))
                                                  (MEMB [U-CASE (CAR (SETQ SFORM (READ STREAM RDTBL]
                                                        '(FILECREATED IL%:FILECREATED]
                                         THEN (SETQ FILENAME (FULLNAME STREAM))
                                               (SETQ FILEDATE (CADR FORM))
                                               (SETQ SOURCENAME (CADDR SFORM))
                                               (SETQ SOURCEDATE (CADR SFORM))
                                       ELSE (SETQ FILENAME (FULLNAME STREAM))
                                             (SETQ FILEDATE (CADR FORM)))
                             ELSE (SETQ FILENAME (CADDR FORM))
                                   (SETQ FILEDATE (CADR FORM)))))])
        ELSEIF (SETQ POS (STRPOS "XCL Compiler output for source file " (SETQ LINE (CL:READ-LINE
                                                                                        STREAM))
                                    1 NIL NIL T))
          THEN                                           (* ; "DFASL compiled?")
                (SETQ SOURCENAME (SUBATOM LINE POS))
                (CL:WHEN (SETQ POS (STRPOS "Source file created " (SETQ LINE (CL:READ-LINE STREAM))
                                          1 NIL NIL T))
                    [SETQ SOURCEDATE (GDATE (IDATE (SUBSTRING LINE POS]
                    (CL:WHEN (SETQ POS (STRPOS "FASL file created " (SETQ LINE (CL:READ-LINE STREAM))
                                              1 NIL NIL T))
                        [SETQ FILEDATE (GDATE (IDATE (SUBSTRING LINE POS]))]

      (* ;; "Revert filenames to Interlisp package if needed:")

      (CL:WHEN (STRPOS "IL:" FILENAME)
          (SETQ FILENAME (SUBATOM FILENAME 4)))
      (CL:WHEN (STRPOS "IL:" SOURCENAME)
          (SETQ SOURCENAME (MKATOM SOURCENAME 4)))

      (* ;; "Return DATE NIL if file is not a Lisp file")

      `(,(OR FILENAME (FULLNAME STREAM))
        ,(AND FILEDATE (GDATE (IDATE FILEDATE)))
        ,@(CL:WHEN SOURCENAME
              (LIST SOURCENAME (GDATE (IDATE SOURCEDATE))))])

(SOURCE-FOR-COMPILED-P
  [LAMBDA (SOURCE COMPILED DFASLMARGIN)                 (* ; "Edited 31-Oct-2020 09:12 by rmk:")

    (* ;; "There seems to be some variation between the source dates in dfasl files and the filecreated date in the sources, they often don't match exactly.  But if they are within DFASLMARGIN, we assume a match.  We require exact date match for LCOMS")

    (* ;; "This is needed for dfasl files created before they recorded the source filecreated name and date instead of the directory source name and date when compile took place.")

    (* ;; "")

    (* ;; "DFASLMARGIN is a pair (after before) where we assume a match if the compiled date is no more than after minutes after the source date and no more than before minuts before (the diff is negative then).")

    (* ;; "A single positive integer x is interpreted as (x 0).  A single negative integer x is interpreted as (-x x) (before or after x).")

    (* ;; "Default is (20 0).")

    (* ;; "T is positive or negative infinity")

    (CL:UNLESS (LISTP SOURCE)
        (SETQ SOURCE (CREATED-AS SOURCE)))
    (CL:UNLESS (LISTP COMPILED)
        (SETQ COMPILED (CREATED-AS COMPILED)))
    (SETQ DFASLMARGIN (IF (NULL DFASLMARGIN)
                          THEN 

                                (* ;; 
                       "If compiled is later than source by less than 20 minutes, it's probably OK")

                                '(20 0)
                        ELSEIF (EQ T DFASLMARGIN)
                          THEN '(T 0)
                        ELSEIF (LISTP DFASLMARGIN)
                        ELSEIF (NOT (FIXP DFASLMARGIN))
                          THEN (ERROR "ILLEGAL DFASLMARGIN" DFASLMARGIN)
                        ELSEIF (MINUSP DFASLMARGIN)
                          THEN (LIST (MINUS DFASLMARGIN)
                                         DFASLMARGIN)
                        ELSE (LIST DFASLMARGIN 0)))
    (OR (EQUAL (CAR SOURCE)
               (CADDR COMPILED))
        (EQUAL (CADR SOURCE)
               (CADDDR COMPILED))
        (AND [EQ 'DFASL (U-CASE (FILENAMEFIELD (CAR COMPILED)
                                       'EXTENSION]
             (LET ((TIMEDIFF (COMPILE-SOURCE-DATE-DIFF COMPILED SOURCE)))

                  (* ;; "If compiled was no more than 20 minutes later, it's probably OK.  Of no more than DFASLMARGIN earlier, if it is negative.")

                  (AND (OR (EQ T (CAR DFASLMARGIN))
                           (LEQ TIMEDIFF (CAR DFASLMARGIN)))
                       (OR (EQ T (CADR DFASLMARGIN))
                           (GEQ TIMEDIFF (CADR DFASLMARGIN])

(COMPILE-SOURCE-DATE-DIFF
  [LAMBDA (CFILE SFILE)                                 (* ; "Edited 20-Sep-2020 22:59 by rmk:")

    (* ;; "Positive means that compiled is later than source, normal order but maybe by too much. Negative means that compiled came before source, i.e., compiled on a source that didn't yet exist.")

    (* ;; "Value is in minutes")

    (ROUND (FQUOTIENT [IDIFFERENCE [IDATE (CADDDR (OR (LISTP CFILE)
                                                      (CREATED-AS CFILE]
                             (IDATE (CADR (OR (LISTP SFILE)
                                              (CREATED-AS SFILE]
                  (TIMES 60 ONESECOND])
)
(DEFINEQ

(FIX-DIRECTORY-DATES
  [LAMBDA (FILES MARGIN)                                (* ; "Edited 30-Oct-2020 22:01 by rmk:")

    (* ;; "For Lisp source and compiled files, ensures that the directory file date corresponds to the  filecreated date. Returns the list of files whose dates were changed.")

    (* ;; "This allows for the fact that directory dates that  are no later than, say, 30 seconds of the filecreated date are probably OK--the directory date may be set when the file is closed.")

    (* ;; "Use IDATEs in case FDCDATE is not Y2K.")

    (* ;; "Stop if directory date is more than 2 minutes earlier than the filecreated date.  Earlier could be because the dates are asserted at different points in the filing process.  But 2 minutes is worth thinking about.  Returning from HELP will get them aligned.")

    (SETQ MARGIN (ITIMES (OR MARGIN 2)
                        60 ONESECOND))
    (FOR F DIDATE FCDATE IN (OR (LISTP FILES)
                                        (FILDIR FILES)) WHEN (SETQ FCDATE (FILEDATE F))
       UNLESS (IEQP (SETQ DIDATE (GETFILEINFO F 'ICREATIONDATE))
                        (SETQ FCDATE (IDATE FCDATE))) COLLECT (CL:WHEN (IGREATERP (IDIFFERENCE
                                                                                       FCDATE DIDATE)
                                                                                  MARGIN)
                                                                      (HELP 
                                                       "DIRECTORY DATE EARLIER THAN FILECREATED DATE"
                                                                            (LIST F (GDATE DIDATE)
                                                                                  (GDATE FCDATE))))
                                                            (SETFILEINFO F 'ICREATIONDATE FCDATE)
                                                            F])

(FIX-EQUIV-DATES
  [LAMBDA (CDENTRIES)                                   (* ; "Edited  1-Sep-2020 16:21 by rmk:")

    (* ;; "For every entry whose files are EQUIVALENT and whose filedates are different, sets the directory of the file with the later date to be the date of the one with the earlier date.  This preumes that the later one must have been a copy. ")

    (CL:UNLESS CDENTRIES
        (PRINTOUT T "Note:  Using LASTCDENTRIES" T)
        (SETQ CDENTRIES LASTCDENTRIES))
    (FOR CDE EARLY LATE IN (CDR CDENTRIES) WHEN (FETCH EQUIV OF CDE)
       UNLESS (EQ '= (FETCH DATEREL OF CDE))
       COLLECT (SELECTQ (FETCH DATEREL OF CDE)
                       (> (SETQ EARLY (FETCH INFO2 OF CDE))
                          (SETQ LATE (FETCH INFO1 OF CDE)))
                       (< (SETQ EARLY (FETCH INFO1 OF CDE))
                          (SETQ LATE (FETCH INFO2 OF CDE)))
                       (SHOULDNT))
             (SETFILEINFO (FETCH FULLNAME OF LATE)
                    'ICREATIONDATE
                    (GETFILEINFO (FETCH FULLNAME OF EARLY)
                           'ICREATIONDATE))
             (FETCH FULLNAME OF LATE])

(COPY-COMPARED-FILES
  [LAMBDA (CDENTRIES TARGET MATCHNAMES)                 (* ; "Edited  1-Sep-2020 16:20 by rmk:")

    (* ;; "Copies source files to target files whose matchname belongs to MATCHNAMES, if given.")

    (* ;; "TARGET is 1 or 2, indicating which side of the CD entry is the target.  Value is the list of matchnames whose files have been copied.")

    (* ;; "Directory filedates and other properties are preserved.")

    (CL:UNLESS (MEMB TARGET '(1 2))
           (ERROR "INVALID TARGET" TARGET))
    (CL:UNLESS CDENTRIES
        (PRINTOUT T "Note:  Using LASTCDENTRIES" T)
        (SETQ CDENTRIES LASTCDENTRIES))
    (SETQ MATCHNAMES (MKLIST MATCHNAMES))
    (FOR CDE SINFO TINFO MATCHNAME IN (CDR CDENTRIES) EACHTIME (SETQ SINFO
                                                                            (FETCH INFO1
                                                                               OF CDE))
                                                                    (SETQ TINFO (FETCH INFO2
                                                                                   OF CDE))
                                                                    (CL:WHEN (EQ TARGET 1)
                                                                           (SWAP SINFO TINFO))
                                                                    (SETQ MATCHNAME
                                                                     (FETCH MATCHNAME
                                                                        OF CDE))
       WHEN (AND (FETCH FULLNAME OF SINFO)
                     (FETCH FULLNAME OF TINFO)) UNLESS (AND MATCHNAMES
                                                                        (NOT (MEMB MATCHNAME 
                                                                                   MATCHNAMES)))
       COLLECT (COPYFILE (FETCH FULLNAME OF SINFO)
                          (PACKFILENAME 'VERSION NIL 'BODY (FETCH FULLNAME OF TINFO)))
             MATCHNAME])

(COPY-MISSING-FILES
  [LAMBDA (CDENTRIES TARGET MATCHNAMES)                 (* ; "Edited  1-Sep-2020 16:21 by rmk:")

    (* ;; "Copies source files to target files whose matchname belongs to MATCHNAMES, if given.")

    (* ;; "TARGET is 1 or 2, indicating which side of the CD entry is the target.  Value is the list of matchnames whose files have been copied.")

    (* ;; "Directory filedates and other properties are preserved.")

    (CL:UNLESS (MEMB TARGET '(1 2))
           (ERROR "INVALID TARGET" TARGET))
    (CL:UNLESS CDENTRIES
        (PRINTOUT T "Note:  Using LASTCDENTRIES" T)
        (SETQ CDENTRIES LASTCDENTRIES))
    (CL:UNLESS (STRINGP (CADR (CAR CDENTRIES)))
        (ERROR "(CAR CDENTRIES) IS NOT A VALID PARAMETER LIST" (CAR CDENTRIES)))
    (SETQ MATCHNAMES (MKLIST MATCHNAMES))
    (FOR CDE SINFO TINFO TDIR MATCHNAME (TDIR _ (CL:IF (EQ TARGET 1)
                                                        (CAAR CDENTRIES)
                                                        (CADAR CDENTRIES))) IN (CDR CDENTRIES)
       EACHTIME (SETQ MATCHNAME (FETCH MATCHNAME OF CDE))
             (SETQ SINFO (FETCH INFO1 OF CDE))
             (SETQ TINFO (FETCH INFO2 OF CDE))
             (CL:WHEN (EQ TARGET 1)
                    (SWAP SINFO TINFO)) WHEN (AND (FETCH FULLNAME OF SINFO)
                                                          (NOT (FETCH FULLNAME OF TINFO)))
       UNLESS (AND MATCHNAMES (NOT (MEMB MATCHNAME MATCHNAMES)))
       COLLECT 

             (* ;; "Using the source fullname in the target should preserve the version number")

             (COPYFILE (FETCH FULLNAME OF SINFO)
                    (PACKFILENAME 'BODY TDIR 'BODY (FETCH FULLNAME OF SINFO)))
             MATCHNAME])

(COMPILED-ON-SAME-SOURCE
  [LAMBDA (CDENTRIES)                                   (* ; "Edited  9-Sep-2020 13:00 by rmk:")

    (* ;; "Returms a subset of CDENTRIES consisting of files that are compiled on the same source (i.e. their source names or dates are the same). Preserves the header.")

    (CDSUBSET CDENTRIES (FUNCTION (LAMBDA (CDE)
                                        (DECLARE (USEDFREE INFO1 INFO2))
                                        (LET (CREATED1 CREATED2)
                                             (CL:WHEN [AND (EQ 'COMPILED (FETCH TYPE OF
                                                                                         INFO1))
                                                           (EQ 'COMPILED (FETCH TYPE OF
                                                                                         INFO2))
                                                           [CDDR (SETQ CREATED1
                                                                  (CREATED-AS (FETCH FULLNAME
                                                                                     OF INFO1]
                                                           (CDDR (SETQ CREATED2
                                                                  (CREATED-AS (FETCH FULLNAME
                                                                                     OF INFO2]
                                                 (OR (EQUAL (CADDR CREATED1)
                                                            (CADDR CREATED2))
                                                     (EQUAL (CADDDR CREATED1)
                                                            (CADDDR CREATED2))))])
)

(RPAQ ONESECOND (IDIFFERENCE (IDATE "1-Jan-2020 12:00:01")
                           (IDATE "1-Jan-2020 12:00:00")))

(RPAQ? LASTCDENTRIES NIL)
(DEFINEQ

(COMPARE-ENTRY-SOURCE-FILES
  [LAMBDA (CDENTRY LISTSTREAM EXAMINE DW?)              (* ; "Edited 30-Aug-2020 12:22 by rmk:")

    (* ;; "Wrapper to call COMPARESOURCES on the Lisp source files of CDENTRY")

    (CL:WHEN [AND (EQ 'SOURCE (FETCH TYPE OF (FETCH INFO1 OF CDENTRY)))
                  (EQ 'SOURCE (FETCH TYPE OF (FETCH INFO2 OF CDENTRY]
        (COMPARESOURCES (FETCH FULLNAME OF (FETCH INFO1 OF CDENTRY))
               (FETCH FULLNAME OF (FETCH INFO2 OF CDENTRY))
               EXAMINE DW? LISTSTREAM))])
)

(FILESLOAD COMPARESOURCES)
(PUTPROPS COMPAREDIRECTORIES COPYRIGHT ("Venue & Xerox Corporation" 1985 1986 1987 1988 1990 1994 1998
 2018 2020))
(DECLARE%: DONTCOPY
  (FILEMAP (NIL (1649 16680 (COMPAREDIRECTORIES 1659 . 10149) (CDFILES 10151 . 14726) (
COMPAREDIRECTORIES.INFOS 14728 . 16243) (MATCHNAME 16245 . 16678)) (16681 23866 (CDPRINT 16691 . 21491
) (CDPRINT.LINE 21493 . 23864)) (23867 25619 (CDMAP 23877 . 24573) (CDENTRY 24575 . 24743) (CDSUBSET 
24745 . 25617)) (25620 31151 (BINCOMP 25630 . 29919) (EOLTYPE 29921 . 31149)) (31364 44571 (
FIND-UNCOMPILED-FILES 31374 . 35017) (FIND-UNSOURCED-FILES 35019 . 37828) (FIND-SOURCE-FILES 37830 . 
39534) (FIND-COMPILED-FILES 39536 . 41614) (FIND-UNLOADED-FILES 41616 . 42360) (FIND-LOADED-FILES 
42362 . 42916) (FIND-MULTICOMPILED-FILES 42918 . 44569)) (44572 52774 (CREATED-AS 44582 . 49379) (
SOURCE-FOR-COMPILED-P 49381 . 52079) (COMPILE-SOURCE-DATE-DIFF 52081 . 52772)) (52775 61754 (
FIX-DIRECTORY-DATES 52785 . 54753) (FIX-EQUIV-DATES 54755 . 56015) (COPY-COMPARED-FILES 56017 . 58141)
 (COPY-MISSING-FILES 58143 . 59982) (COMPILED-ON-SAME-SOURCE 59984 . 61752)) (61909 62520 (
COMPARE-ENTRY-SOURCE-FILES 61919 . 62518)))))
STOP
\ No newline at end of file
diff --git a/lispusers/COMPAREDIRECTORIES.LCOM b/lispusers/COMPAREDIRECTORIES.LCOM
index c63c4948..5cc3ff18 100644
Binary files a/lispusers/COMPAREDIRECTORIES.LCOM and b/lispusers/COMPAREDIRECTORIES.LCOM differ
diff --git a/basics/full.sysout b/loadups/full.venuesysout
similarity index 100%
rename from basics/full.sysout
rename to loadups/full.venuesysout
diff --git a/basics/lisp.sysout b/loadups/lisp.venuesysout
similarity index 100%
rename from basics/lisp.sysout
rename to loadups/lisp.venuesysout
diff --git a/loadups/xfull35.dribble b/loadups/xfull35.dribble
index e9a4592c..e8fc96f2 100644
--- a/loadups/xfull35.dribble
+++ b/loadups/xfull35.dribble
@@ -1 +1 @@
-
Full loadup started at 23-Oct-2020 23:56:23 while connected to 
{DSK}<Users>kaplan>Local>medley3.5>lispcore>


{DSK}<Users>kaplan>Local>medley3.5>lispcore>library>POSTSCRIPTSTREAM.LCOM;1
compiled on 14-May-2018 10:53:32
File created 14-May-2018 10:52:48
POSTSCRIPTSTREAMCOMS
Loading FULL fonts...
  Loading CLASSIC 8 10 12 
  Loading MODERN 8 10 12 
  Loading TERMINAL 8 10 12 
  Loading postscript fonts
FULL fonts loaded

{DSK}<Users>kaplan>Local>medley3.5>lispcore>library>CHAT.LCOM;1
compiled on 25-Oct-93 12:23:25
File created 20-Jan-93 13:46:52
CHATCOMS

{DSK}<Users>kaplan>Local>medley3.5>lispcore>library>DMCHAT.LCOM;1
compiled on 25-Feb-93 18:08:53
File created 20-Jan-93 13:49:09
DMCHATCOMS

{DSK}<Users>kaplan>Local>medley3.5>lispcore>library>CHATTERMINAL.LCOM;1
compiled on 24-Feb-93 19:37:23
File created  4-Jul-90 02:21:01
CHATTERMINALCOMS

{DSK}<Users>kaplan>Local>medley3.5>lispcore>library>NSCHAT.LCOM;1
compiled on 18-Jul-94 10:13:24
File created 12-Sep-91 18:26:50
NSCHATCOMS

{DSK}<Users>kaplan>Local>medley3.5>lispcore>library>TEDIT.LCOM;1
compiled on 18-May-2018 09:16:24
File created 19-Apr-2018 12:22:03
TEDITCOMS

{DSK}<Users>kaplan>Local>medley3.5>lispcore>library>TEDITDCL.LCOM;1
compiled on 18-May-2018 09:17:04
File created 25-Aug-94 10:53:00
TEDITDCLCOMS

{DSK}<Users>kaplan>Local>medley3.5>lispcore>library>PCTREE.LCOM;1
compiled on 18-May-2018 09:19:35
File created 19-Apr-2018 12:19:49
PCTREECOMS

{DSK}<Users>kaplan>Local>medley3.5>lispcore>library>TEXTOFD.LCOM;1
compiled on 11-Feb-2001 12:06:43
File created 11-Feb-2001 12:06:42
TEXTOFDCOMS

{DSK}<Users>kaplan>Local>medley3.5>lispcore>library>TEDITCOMMAND.LCOM;1
compiled on 18-May-2018 09:16:59
File created 20-Apr-2018 08:07:35
TEDITCOMMANDCOMS

{DSK}<Users>kaplan>Local>medley3.5>lispcore>library>TEDITSCREEN.LCOM;1
compiled on 18-May-2018 09:18:38
File created 25-Aug-94 13:26:23
TEDITSCREENCOMS

{DSK}<Users>kaplan>Local>medley3.5>lispcore>library>TEDITABBREV.LCOM;1
compiled on  6-Aug-2020 14:52:14
File created  6-Aug-2020 14:52:14
TEDITABBREVCOMS

{DSK}<Users>kaplan>Local>medley3.5>lispcore>library>TEDITLOOKS.LCOM;1
compiled on 18-May-2018 09:17:44
File created 29-Jan-99 17:33:35
TEDITLOOKSCOMS

{DSK}<Users>kaplan>Local>medley3.5>lispcore>library>TEDITFIND.LCOM;1
compiled on 18-May-2018 09:17:21
File created  6-May-2018 17:34:44
TEDITFINDCOMS

{DSK}<Users>kaplan>Local>medley3.5>lispcore>library>TEDITHISTORY.LCOM;1
compiled on 18-May-2018 09:17:41
File created 29-Jan-99 17:34:39
TEDITHISTORYCOMS

{DSK}<Users>kaplan>Local>medley3.5>lispcore>library>TEDITFILE.LCOM;1
compiled on 18-May-2018 09:17:06
File created 19-May-2001 11:45:53
TEDITFILECOMS

{DSK}<Users>kaplan>Local>medley3.5>lispcore>library>TEDITWINDOW.LCOM;1
compiled on 18-May-2018 09:18:51
File created 21-Jun-99 20:00:42
TEDITWINDOWCOMS

{DSK}<Users>kaplan>Local>medley3.5>lispcore>library>TEDITSELECTION.LCOM;1
compiled on 18-May-2018 09:18:43
File created 25-Aug-94 10:56:07
TEDITSELECTIONCOMS

{DSK}<Users>kaplan>Local>medley3.5>lispcore>library>IMAGEOBJ.LCOM;1
compiled on  8-Feb-97 11:26:32
File created  7-Dec-95 13:21:56
IMAGEOBJCOMS

{DSK}<Users>kaplan>Local>medley3.5>lispcore>library>EDITBITMAP.LCOM;1
compiled on 25-Feb-93 18:10:27
File created 11-Jun-90 15:42:25
EDITBITMAPCOMS

{DSK}<Users>kaplan>Local>medley3.5>lispcore>library>READNUMBER.LCOM;1
compiled on 16-Aug-95 11:18:52
File created 25-May-93 00:28:30
READNUMBERCOMS

{DSK}<Users>kaplan>Local>medley3.5>lispcore>library>TFBRAVO.LCOM;1
compiled on 19-Apr-2018 12:19:55
File created 19-Apr-2018 12:19:55
TFBRAVOCOMS

{DSK}<Users>kaplan>Local>medley3.5>lispcore>library>TEDITHCPY.LCOM;1
compiled on 18-May-2018 09:17:32
File created 25-Aug-94 10:54:07
TEDITHCPYCOMS

{DSK}<Users>kaplan>Local>medley3.5>lispcore>library>TEDITPAGE.LCOM;1
compiled on 18-May-2018 09:18:32
File created 25-Aug-94 10:55:28
TEDITPAGECOMS

{DSK}<Users>kaplan>Local>medley3.5>lispcore>library>TEDITMENU.LCOM;1
compiled on 18-May-2018 09:18:07
File created 24-Apr-95 12:05:29
TEDITMENUCOMS

{DSK}<Users>kaplan>Local>medley3.5>lispcore>library>TEDITFNKEYS.LCOM;1
compiled on 18-May-2018 09:17:25
File created  6-May-2018 17:15:13
TEDITFNKEYSCOMS

{DSK}<Users>kaplan>Local>medley3.5>lispcore>library>HRULE.LCOM;1
compiled on 26-Feb-93 11:26:19
File created  8-Oct-92 16:50:21
HRULECOMS

{DSK}<Users>kaplan>Local>medley3.5>lispcore>library>TEDITCHAT.LCOM;1
compiled on 18-May-2018 09:16:55
File created 28-Mar-94 16:05:24
IL:TEDITCHATCOMS

{DSK}<Users>kaplan>Local>medley3.5>lispcore>library>FILEBROWSER.LCOM;1
compiled on 11-Sep-2001 09:26:17
File created 11-Sep-2001 09:26:14

{DSK}<Users>kaplan>Local>medley3.5>lispcore>library>TABLEBROWSER.LCOM;1
compiled on  1-Dec-2018 17:25:13
File created  1-Dec-2018 17:25:13
TABLEBROWSERCOMS

{DSK}<Users>kaplan>Local>medley3.5>lispcore>lispusers>THINFILES.LCOM;1
compiled on 26-Jun-99 00:47:00
File created  1-May-92 16:49:39
THINFILESCOMS

{DSK}<Users>kaplan>Local>medley3.5>lispcore>library>GRAPHER.LCOM;1
compiled on 14-May-2018 10:24:43
File created 14-May-2018 10:24:38
GRAPHERCOMS

{DSK}<Users>kaplan>Local>medley3.5>lispcore>library>SPY.LCOM;1
compiled on 23-Aug-94 16:33:38
File created 29-Apr-94 14:13:52
SPYCOMS

{DSK}<Users>kaplan>Local>medley3.5>lispcore>library>WHERE-IS.DFASL;1
XCL Compiler output for source file {DSK}<python>lde>lispcore>library>WHERE-IS.;1
Source file created Wednesday, 13 June 1990, 1:16:15.
FASL file created Thursday, 21 January 1993, 18:52:55.


{DSK}<Users>kaplan>Local>medley3.5>lispcore>library>HASH-FILE.dfasl;1
XCL Compiler output for source file {PELE:MV:ENVOS}<LISPCORE>LIBRARY>HASH-FILE.;2
Source file created Monday, 11 June 1990, 16:16:54.
FASL file created Friday, 26 February 1993, 11:23:40.


{DSK}<Users>kaplan>Local>medley3.5>lispcore>library>CASH-FILE.DFASL;4
XCL Compiler output for source file {DSK}<usr>local>lde>lispcore>library>CASH-FILE.;2
Source file created 11-Jun-90 14:33:44
FASL file created Saturday, 19 September 2020, 22:04:31


{DSK}<Users>kaplan>Local>medley3.5>lispcore>library>COPYFILES.LCOM;1
compiled on  6-Apr-2018 21:14:29
File created  6-Apr-2018 21:14:29
COPYFILESCOMS

{DSK}<Users>kaplan>Local>medley3.5>lispcore>library>MSANALYZE.DFASL;1
XCL Compiler output for source file {PELE:MV:ENVOS}<LISPCORE>LIBRARY>MSANALYZE.;5
Source file created Wednesday, 15 August 1990, 13:11:23.
FASL file created Sunday, 28 February 1993, 23:16:46.


{DSK}<Users>kaplan>Local>medley3.5>lispcore>library>MSPARSE.DFASL;1
XCL Compiler output for source file {PELE:MV:ENVOS}<LISPCORE>LIBRARY>MSPARSE.;5
Source file created Wednesday, 15 August 1990, 13:00:12.
FASL file created Sunday, 28 February 1993, 23:24:50.


{DSK}<Users>kaplan>Local>medley3.5>lispcore>library>MASTERSCOPE.DFASL;3
XCL Compiler output for source file {DSK}<Users>kaplan>Local>medley3.5>lispcore>library>MASTERSCOPE.;4
Source file created Saturday, 19 September 2020, 9:54:51.
FASL file created Saturday, 19 September 2020, 9:54:51.


{DSK}<Users>kaplan>Local>medley3.5>lispcore>library>MSCOMMON.DFASL;1
XCL Compiler output for source file {PELE:MV:ENVOS}<LISPCORE>LIBRARY>MSCOMMON.;3
Source file created Monday, 4 May 1992, 13:19:40.
FASL file created Sunday, 28 February 1993, 23:23:14.


{DSK}<Users>kaplan>Local>medley3.5>lispcore>library>UNIXPRINT.DFASL;1
XCL Compiler output for source file {DSK}<Users>kaplan>Local>medley3.5>lispcore>library>UNIXPRINT.;8
Source file created Friday, 4 May 2018, 17:18:00.
FASL file created Friday, 4 May 2018, 17:18:00.


{DSK}<Users>kaplan>Local>medley3.5>lispcore>library>UNIXCOMM.LCOM;1
compiled on 25-Apr-2018 07:31:56
File created 25-Apr-2018 07:31:56
UNIXCOMMCOMS

{DSK}<Users>kaplan>Local>medley3.5>lispcore>library>UNICODE.LCOM;17
compiled on 17-Aug-2020 08:48:36
File created 17-Aug-2020 08:48:36
UNICODECOMS

{DSK}<Users>kaplan>Local>medley3.5>lispcore>lispusers>iso8859io.LCOM;4
compiled on  9-Mar-99 18:20:33
File created  9-Mar-99 18:20:26
ISO8859IOCOMS

{DSK}<Users>kaplan>Local>medley3.5>lispcore>library>CLIPBOARD.LCOM;1
compiled on  8-Aug-2020 15:48:08
File created  8-Aug-2020 15:48:08
CLIPBOARDCOMS

{DSK}<Users>kaplan>Local>medley3.5>lispcore>lispusers>MACINTERFACE.LCOM;46
compiled on  8-Aug-2020 15:48:17
File created  8-Aug-2020 15:48:17
MACINTERFACECOMS

{DSK}<Users>kaplan>Local>medley3.5>lispcore>lispusers>PRETTYFILEINDEX.LCOM;2
compiled on 28-Jun-99 17:13:58
File created 28-Jun-99 17:13:51
PRETTYFILEINDEXCOMS

{DSK}<Users>kaplan>Local>medley3.5>lispcore>lispusers>WHO-LINE.LCOM;1
compiled on 19-Feb-2001 11:57:34
File created 19-Feb-2001 11:53:32
WHO-LINECOMS

{DSK}<Users>kaplan>Local>medley3.5>lispcore>lispusers>NSCOPYFILE.LCOM;1
compiled on  8-Jun-94 17:54:54
File created 10-Dec-87 11:40:53
NSCOPYFILECOMS

{DSK}<Users>kaplan>Local>medley3.5>lispcore>library>UNIXCHAT.LCOM;1
compiled on 21-Jan-93 18:45:15
File created 15-Aug-90 11:05:53
UNIXCHATCOMS

{DSK}<Users>kaplan>Local>medley3.5>lispcore>library>UNIXTELNET.LCOM;1
compiled on 18-Jul-94 23:29:48
File created 16-Feb-90 17:00:31
UNIXTELNETCOMS

{DSK}<Users>kaplan>Local>medley3.5>lispcore>lispusers>SETDEFAULTPRINTER.LCOM;2
compiled on 12-Nov-98 17:41:28
File created  7-Jun-93 15:34:58
SETDEFAULTPRINTERCOMS

{DSK}<Users>kaplan>Local>medley3.5>lispcore>lispusers>DEFAULTSUBITEMFN.LCOM;1
compiled on  8-Sep-94 20:23:23
File created  4-Mar-87 15:59:01
DEFAULTSUBITEMFNCOMS

{DSK}<Users>kaplan>Local>medley3.5>lispcore>lispusers>LoadPatches.;1
File created 16-Nov-88 14:11:42
LOADPATCHESCOMS

{DSK}<Users>kaplan>Local>medley3.5>lispcore>patches>NOXNSPATCH.LCOM;1
compiled on 31-Mar-99 17:08:42
File created 31-Mar-99 17:08:40
NOXNSPATCHCOMS

{DSK}<Users>kaplan>Local>medley3.5>lispcore>patches>LLREADPATCH.LCOM;5
compiled on  1-Aug-2020 18:52:48
File created  1-Aug-2020 18:52:48
LLREADPATCHCOMS

{DSK}<Users>kaplan>Local>medley3.5>lispcore>patches>MACHINEINDEPENDENTPATCH.LCOM;2
compiled on 19-Sep-2020 21:18:45
File created 19-Sep-2020 20:56:09
MACHINEINDEPENDENTPATCHCOMS
About to end loadup
Creating FULL sysout on 
{DSK}<Users>kaplan>Local>medley3.5>lispcore>/loadups/xfull35.sysout
\ No newline at end of file
+
Full loadup started at 27-Oct-2020 15:43:11 while connected to 
{DSK}<Users>kaplan>Local>medley3.5>lispcore>


{DSK}<Users>kaplan>Local>medley3.5>lispcore>library>POSTSCRIPTSTREAM.LCOM;1
compiled on 14-May-2018 10:53:32
File created 14-May-2018 10:52:48
POSTSCRIPTSTREAMCOMS
Loading FULL fonts...
  Loading CLASSIC 8 10 12 
  Loading MODERN 8 10 12 
  Loading TERMINAL 8 10 12 
  Loading postscript fonts
FULL fonts loaded

{DSK}<Users>kaplan>Local>medley3.5>lispcore>library>CHAT.LCOM;1
compiled on 25-Oct-93 12:23:25
File created 20-Jan-93 13:46:52
CHATCOMS

{DSK}<Users>kaplan>Local>medley3.5>lispcore>library>DMCHAT.LCOM;1
compiled on 25-Feb-93 18:08:53
File created 20-Jan-93 13:49:09
DMCHATCOMS

{DSK}<Users>kaplan>Local>medley3.5>lispcore>library>CHATTERMINAL.LCOM;1
compiled on 24-Feb-93 19:37:23
File created  4-Jul-90 02:21:01
CHATTERMINALCOMS

{DSK}<Users>kaplan>Local>medley3.5>lispcore>library>NSCHAT.LCOM;1
compiled on 18-Jul-94 10:13:24
File created 12-Sep-91 18:26:50
NSCHATCOMS

{DSK}<Users>kaplan>Local>medley3.5>lispcore>library>TEDIT.LCOM;1
compiled on 18-May-2018 09:16:24
File created 19-Apr-2018 12:22:03
TEDITCOMS

{DSK}<Users>kaplan>Local>medley3.5>lispcore>library>TEDITDCL.LCOM;1
compiled on 18-May-2018 09:17:04
File created 25-Aug-94 10:53:00
TEDITDCLCOMS

{DSK}<Users>kaplan>Local>medley3.5>lispcore>library>PCTREE.LCOM;1
compiled on 18-May-2018 09:19:35
File created 19-Apr-2018 12:19:49
PCTREECOMS

{DSK}<Users>kaplan>Local>medley3.5>lispcore>library>TEXTOFD.LCOM;1
compiled on 11-Feb-2001 12:06:43
File created 11-Feb-2001 12:06:42
TEXTOFDCOMS

{DSK}<Users>kaplan>Local>medley3.5>lispcore>library>TEDITCOMMAND.LCOM;1
compiled on 18-May-2018 09:16:59
File created 20-Apr-2018 08:07:35
TEDITCOMMANDCOMS

{DSK}<Users>kaplan>Local>medley3.5>lispcore>library>TEDITSCREEN.LCOM;1
compiled on 18-May-2018 09:18:38
File created 25-Aug-94 13:26:23
TEDITSCREENCOMS

{DSK}<Users>kaplan>Local>medley3.5>lispcore>library>TEDITABBREV.LCOM;1
compiled on  6-Aug-2020 14:52:14
File created  6-Aug-2020 14:52:14
TEDITABBREVCOMS

{DSK}<Users>kaplan>Local>medley3.5>lispcore>library>TEDITLOOKS.LCOM;1
compiled on 18-May-2018 09:17:44
File created 29-Jan-99 17:33:35
TEDITLOOKSCOMS

{DSK}<Users>kaplan>Local>medley3.5>lispcore>library>TEDITFIND.LCOM;1
compiled on 18-May-2018 09:17:21
File created  6-May-2018 17:34:44
TEDITFINDCOMS

{DSK}<Users>kaplan>Local>medley3.5>lispcore>library>TEDITHISTORY.LCOM;1
compiled on 18-May-2018 09:17:41
File created 29-Jan-99 17:34:39
TEDITHISTORYCOMS

{DSK}<Users>kaplan>Local>medley3.5>lispcore>library>TEDITFILE.LCOM;1
compiled on 18-May-2018 09:17:06
File created 19-May-2001 11:45:53
TEDITFILECOMS

{DSK}<Users>kaplan>Local>medley3.5>lispcore>library>TEDITWINDOW.LCOM;1
compiled on 18-May-2018 09:18:51
File created 21-Jun-99 20:00:42
TEDITWINDOWCOMS

{DSK}<Users>kaplan>Local>medley3.5>lispcore>library>TEDITSELECTION.LCOM;1
compiled on 18-May-2018 09:18:43
File created 25-Aug-94 10:56:07
TEDITSELECTIONCOMS

{DSK}<Users>kaplan>Local>medley3.5>lispcore>library>IMAGEOBJ.LCOM;1
compiled on  8-Feb-97 11:26:32
File created  7-Dec-95 13:21:56
IMAGEOBJCOMS

{DSK}<Users>kaplan>Local>medley3.5>lispcore>library>EDITBITMAP.LCOM;1
compiled on 25-Feb-93 18:10:27
File created 11-Jun-90 15:42:25
EDITBITMAPCOMS

{DSK}<Users>kaplan>Local>medley3.5>lispcore>library>READNUMBER.LCOM;1
compiled on 16-Aug-95 11:18:52
File created 25-May-93 00:28:30
READNUMBERCOMS

{DSK}<Users>kaplan>Local>medley3.5>lispcore>library>TFBRAVO.LCOM;1
compiled on 19-Apr-2018 12:19:55
File created 19-Apr-2018 12:19:55
TFBRAVOCOMS

{DSK}<Users>kaplan>Local>medley3.5>lispcore>library>TEDITHCPY.LCOM;1
compiled on 18-May-2018 09:17:32
File created 25-Aug-94 10:54:07
TEDITHCPYCOMS

{DSK}<Users>kaplan>Local>medley3.5>lispcore>library>TEDITPAGE.LCOM;1
compiled on 18-May-2018 09:18:32
File created 25-Aug-94 10:55:28
TEDITPAGECOMS

{DSK}<Users>kaplan>Local>medley3.5>lispcore>library>TEDITMENU.LCOM;1
compiled on 18-May-2018 09:18:07
File created 24-Apr-95 12:05:29
TEDITMENUCOMS

{DSK}<Users>kaplan>Local>medley3.5>lispcore>library>TEDITFNKEYS.LCOM;1
compiled on 18-May-2018 09:17:25
File created  6-May-2018 17:15:13
TEDITFNKEYSCOMS

{DSK}<Users>kaplan>Local>medley3.5>lispcore>library>HRULE.LCOM;1
compiled on 26-Feb-93 11:26:19
File created  8-Oct-92 16:50:21
HRULECOMS

{DSK}<Users>kaplan>Local>medley3.5>lispcore>library>TEDITCHAT.LCOM;1
compiled on 18-May-2018 09:16:55
File created 28-Mar-94 16:05:24
IL:TEDITCHATCOMS

{DSK}<Users>kaplan>Local>medley3.5>lispcore>library>FILEBROWSER.LCOM;1
compiled on 11-Sep-2001 09:26:17
File created 11-Sep-2001 09:26:14

{DSK}<Users>kaplan>Local>medley3.5>lispcore>library>TABLEBROWSER.LCOM;1
compiled on  1-Dec-2018 17:25:13
File created  1-Dec-2018 17:25:13
TABLEBROWSERCOMS

{DSK}<Users>kaplan>Local>medley3.5>lispcore>lispusers>THINFILES.LCOM;1
compiled on 26-Jun-99 00:47:00
File created  1-May-92 16:49:39
THINFILESCOMS

{DSK}<Users>kaplan>Local>medley3.5>lispcore>library>GRAPHER.LCOM;1
compiled on 14-May-2018 10:24:43
File created 14-May-2018 10:24:38
GRAPHERCOMS

{DSK}<Users>kaplan>Local>medley3.5>lispcore>library>SPY.LCOM;1
compiled on 23-Aug-94 16:33:38
File created 29-Apr-94 14:13:52
SPYCOMS

{DSK}<Users>kaplan>Local>medley3.5>lispcore>library>WHERE-IS.DFASL;1
XCL Compiler output for source file {DSK}<python>lde>lispcore>library>WHERE-IS.;1
Source file created Wednesday, 13 June 1990, 1:16:15.
FASL file created Thursday, 21 January 1993, 18:52:55.


{DSK}<Users>kaplan>Local>medley3.5>lispcore>library>HASH-FILE.dfasl;1
XCL Compiler output for source file {PELE:MV:ENVOS}<LISPCORE>LIBRARY>HASH-FILE.;2
Source file created Monday, 11 June 1990, 16:16:54.
FASL file created Friday, 26 February 1993, 11:23:40.


{DSK}<Users>kaplan>Local>medley3.5>lispcore>library>CASH-FILE.DFASL;4
XCL Compiler output for source file {DSK}<usr>local>lde>lispcore>library>CASH-FILE.;2
Source file created 11-Jun-90 14:33:44
FASL file created Saturday, 19 September 2020, 22:04:31


{DSK}<Users>kaplan>Local>medley3.5>lispcore>library>COPYFILES.LCOM;1
compiled on  6-Apr-2018 21:14:29
File created  6-Apr-2018 21:14:29
COPYFILESCOMS

{DSK}<Users>kaplan>Local>medley3.5>lispcore>library>MSANALYZE.DFASL;1
XCL Compiler output for source file {PELE:MV:ENVOS}<LISPCORE>LIBRARY>MSANALYZE.;5
Source file created Wednesday, 15 August 1990, 13:11:23.
FASL file created Sunday, 28 February 1993, 23:16:46.


{DSK}<Users>kaplan>Local>medley3.5>lispcore>library>MSPARSE.DFASL;1
XCL Compiler output for source file {PELE:MV:ENVOS}<LISPCORE>LIBRARY>MSPARSE.;5
Source file created Wednesday, 15 August 1990, 13:00:12.
FASL file created Sunday, 28 February 1993, 23:24:50.


{DSK}<Users>kaplan>Local>medley3.5>lispcore>library>MASTERSCOPE.DFASL;3
XCL Compiler output for source file {DSK}<Users>kaplan>Local>medley3.5>lispcore>library>MASTERSCOPE.;4
Source file created Saturday, 19 September 2020, 9:54:51.
FASL file created Saturday, 19 September 2020, 9:54:51.


{DSK}<Users>kaplan>Local>medley3.5>lispcore>library>MSCOMMON.DFASL;1
XCL Compiler output for source file {PELE:MV:ENVOS}<LISPCORE>LIBRARY>MSCOMMON.;3
Source file created Monday, 4 May 1992, 13:19:40.
FASL file created Sunday, 28 February 1993, 23:23:14.


{DSK}<Users>kaplan>Local>medley3.5>lispcore>library>UNIXPRINT.DFASL;1
XCL Compiler output for source file {DSK}<Users>kaplan>Local>medley3.5>lispcore>library>UNIXPRINT.;8
Source file created Friday, 4 May 2018, 17:18:00.
FASL file created Friday, 4 May 2018, 17:18:00.


{DSK}<Users>kaplan>Local>medley3.5>lispcore>library>UNIXCOMM.LCOM;1
compiled on 25-Apr-2018 07:31:56
File created 25-Apr-2018 07:31:56
UNIXCOMMCOMS

{DSK}<Users>kaplan>Local>medley3.5>lispcore>library>UNICODE.LCOM;17
compiled on 17-Aug-2020 08:48:36
File created 17-Aug-2020 08:48:36
UNICODECOMS

{DSK}<Users>kaplan>Local>medley3.5>lispcore>lispusers>iso8859io.LCOM;4
compiled on  9-Mar-99 18:20:33
File created  9-Mar-99 18:20:26
ISO8859IOCOMS

{DSK}<Users>kaplan>Local>medley3.5>lispcore>library>CLIPBOARD.LCOM;1
compiled on  8-Aug-2020 15:48:08
File created  8-Aug-2020 15:48:08
CLIPBOARDCOMS

{DSK}<Users>kaplan>Local>medley3.5>lispcore>lispusers>MACINTERFACE.LCOM;46
compiled on  8-Aug-2020 15:48:17
File created  8-Aug-2020 15:48:17
MACINTERFACECOMS

{DSK}<Users>kaplan>Local>medley3.5>lispcore>lispusers>PRETTYFILEINDEX.LCOM;2
compiled on 28-Jun-99 17:13:58
File created 28-Jun-99 17:13:51
PRETTYFILEINDEXCOMS

{DSK}<Users>kaplan>Local>medley3.5>lispcore>lispusers>WHO-LINE.LCOM;1
compiled on 19-Feb-2001 11:57:34
File created 19-Feb-2001 11:53:32
WHO-LINECOMS

{DSK}<Users>kaplan>Local>medley3.5>lispcore>lispusers>NSCOPYFILE.LCOM;1
compiled on  8-Jun-94 17:54:54
File created 10-Dec-87 11:40:53
NSCOPYFILECOMS

{DSK}<Users>kaplan>Local>medley3.5>lispcore>library>UNIXCHAT.LCOM;1
compiled on 21-Jan-93 18:45:15
File created 15-Aug-90 11:05:53
UNIXCHATCOMS

{DSK}<Users>kaplan>Local>medley3.5>lispcore>library>UNIXTELNET.LCOM;1
compiled on 18-Jul-94 23:29:48
File created 16-Feb-90 17:00:31
UNIXTELNETCOMS

{DSK}<Users>kaplan>Local>medley3.5>lispcore>lispusers>SETDEFAULTPRINTER.LCOM;2
compiled on 12-Nov-98 17:41:28
File created  7-Jun-93 15:34:58
SETDEFAULTPRINTERCOMS

{DSK}<Users>kaplan>Local>medley3.5>lispcore>lispusers>DEFAULTSUBITEMFN.LCOM;1
compiled on  8-Sep-94 20:23:23
File created  4-Mar-87 15:59:01
DEFAULTSUBITEMFNCOMS

{DSK}<Users>kaplan>Local>medley3.5>lispcore>lispusers>LoadPatches.;1
File created 16-Nov-88 14:11:42
LOADPATCHESCOMS

{DSK}<Users>kaplan>Local>medley3.5>lispcore>patches>NOXNSPATCH.LCOM;1
compiled on 31-Mar-99 17:08:42
File created 31-Mar-99 17:08:40
NOXNSPATCHCOMS

{DSK}<Users>kaplan>Local>medley3.5>lispcore>patches>LLREADPATCH.LCOM;5
compiled on  1-Aug-2020 18:52:48
File created  1-Aug-2020 18:52:48
LLREADPATCHCOMS

{DSK}<Users>kaplan>Local>medley3.5>lispcore>patches>MACHINEINDEPENDENTPATCH.LCOM;2
compiled on 19-Sep-2020 21:18:45
File created 19-Sep-2020 20:56:09
MACHINEINDEPENDENTPATCHCOMS
About to end loadup
Creating FULL sysout on 
{DSK}<Users>kaplan>Local>medley3.5>lispcore>/loadups/xfull35.sysout
\ No newline at end of file
diff --git a/loadups/xfull35.sysout b/loadups/xfull35.sysout
index 56254e0e..cba36507 100644
Binary files a/loadups/xfull35.sysout and b/loadups/xfull35.sysout differ
diff --git a/loadups/xlisp.dribble b/loadups/xlisp.dribble
index 998a6761..039c7c5d 100644
--- a/loadups/xlisp.dribble
+++ b/loadups/xlisp.dribble
@@ -1,5 +1,5 @@
 
-Synchronizing Lisp sysout at 23-Oct-2020 23:55:43 while connected to 
+Synchronizing Lisp sysout at 20-Nov-2020 23:12:24 while connected to 
 {DSK}<Users>kaplan>Local>medley3.5>lispcore>
      {DSK}<Users>kaplan>Local>medley3.5>lispcore>makesysout>SYNCLISPFILES.;48
      created 23-Oct-2020 23:51:41
@@ -92,9 +92,9 @@ compiled on 16-Apr-2018 17:38:16
 File created 16-Apr-2018 17:38:16
 LOADFNSCOMS
 
-{DSK}<Users>kaplan>Local>medley3.5>lispcore>sources>FILEPKG.LCOM;12
-compiled on 10-Aug-2020 21:24:59
-File created 10-Aug-2020 21:24:58
+{DSK}<Users>kaplan>Local>medley3.5>lispcore>sources>FILEPKG.LCOM;13
+compiled on 27-Oct-2020 15:40:33
+File created 27-Oct-2020 15:40:32
 FILEPKGCOMS
 
 {DSK}<Users>kaplan>Local>medley3.5>lispcore>sources>ASKUSER.LCOM;5
@@ -181,4 +181,4 @@ NOXNSPATCHCOMS
 
 3 files loaded
 Creating updated LISP sysout on 
-{DSK}<Users>kaplan>Local>medley3.5>lispcore>loadups>xlisp.sysout;1
+{DSK}<Users>kaplan>Local>medley3.5>lispcore>loadups>xlisp.sysout;3
diff --git a/loadups/xlisp.sysout b/loadups/xlisp.sysout
index 5a298adb..b432811a 100644
Binary files a/loadups/xlisp.sysout and b/loadups/xlisp.sysout differ
diff --git a/sources/FILEPKG b/sources/FILEPKG
index 452adc78..cafb9363 100644
--- a/sources/FILEPKG
+++ b/sources/FILEPKG
@@ -1 +1 @@
-(DEFINE-FILE-INFO READTABLE "INTERLISP" PACKAGE "INTERLISP")
(FILECREATED "10-Aug-2020 21:24:58" 
{DSK}<Users>kaplan>Local>medley3.5>lispcore>sources>FILEPKG.;11 284888 

      changes to%:  (VARS FILEPKGCOMS)
                    (FNS ADDTOFILES?)

      previous date%: " 8-Aug-2020 17:33:31" 
{DSK}<Users>kaplan>Local>medley3.5>lispcore>sources>FILEPKG.;9)


(* ; "
Copyright (c) 1982, 1983, 1984, 1985, 1986, 1987, 1988, 1989, 1990, 1991, 1992, 1993, 1995, 2018, 2020 by Venue & Xerox Corporation.  All rights reserved.
The following program was created in 1982 but has not been published
within the meaning of the copyright law, is furnished under license,
and may not be used, copied and/or disclosed except in accordance
with the terms of said license.
")

(PRETTYCOMPRINT FILEPKGCOMS)

(RPAQQ FILEPKGCOMS
       [(COMS                                                (* ; 
            "standard records for accessing file  package type/command parts.  Exported for PRETTY")
              (VARS FILEPKGTYPEPROPS)
              (EXPORT (DECLARE%: EVAL@COMPILE DONTCOPY (RECORDS * FILEPKGRECORDS)))
              (FNS SEARCHPRETTYTYPELST PRETTYDEFMACROS FILEPKGCOMPROPS)
              (INITRECORDS * FILEPKGRECORDS))
        [DECLARE%: EVAL@COMPILE DOCOPY 

               (* ;; "Proclaim SPECIAL those variables that are used freely in a lot of code.")

               (P (CL:PROCLAIM '(CL:SPECIAL PRETTYDEFMACROS PRETTYTYPELST FILEPKGTYPES 
                                       PRETTYPRINTMACROS *DEFAULT-CLEANUP-COMPILER* MARKASCHANGEDFNS
                                       PRETTYFLG))
                  (CL:PROCLAIM '(GLOBAL FILELST SYSFILES LOADEDFILELST NOTLISTEDFILES 
                                       NOTCOMPILEDFILES MAKEFILEFORMS CLEANUPOPTIONS]
        (INITVARS (MSDATABASELST))
        [COMS 
              (* ;; "making, adding, listing, compiling files")

              (FNS CLEANUP COMPILEFILES COMPILEFILES0 CONTINUEDIT MAKEFILE FILECHANGES 
                   FILEPKG.MERGECHANGES FILEPKG.CHANGEDFNS MAKEFILE1 COMPILE-FILE? MAKEFILES ADDFILE
                   ADDFILE0 LISTFILES)
              (INITVARS (*DEFAULT-CLEANUP-COMPILER* 'CL:COMPILE-FILE)
                     (FILELST)
                     (LOADEDFILELST)
                     (NOTLISTEDFILES)
                     (NOTCOMPILEDFILES)
                     (MAKEFILEFORMS)
                     (NILCOMS))
              (ADDVARS (MAKEFILEOPTIONS RC C LIST FAST CLISP CLISPIFY NIL REMAKE NEW NOCLISP CLISP% 
                              F ST STF (REC . RC)
                              (BREC . RC)
                              (TC . C)
                              (BC . C)
                              (TCOMPL . C)
                              (BCOMPL . C)))
              (INITVARS (MAKEFILEREMAKEFLG T)
                     (CLEANUPOPTIONS '(RC]
        (COMS 
              (* ;; "scanning file coms")

              (FNS FILEPKGCHANGES GETFILEPKGTYPE MARKASCHANGED FILECOMS WHEREIS SMASHFILECOMS 
                   FILEFNSLST FILECOMSLST UPDATEFILES INFILECOMS? INFILECOMTAIL INFILECOMS INFILECOM
                   INFILECOMSVALS INFILECOMSVAL INFILECOMSPROP IFCPROPS IFCEXPRTYPE IFCPROPSCAN 
                   IFCDECLARE INFILEPAIRS INFILECOMSMACRO))
        (COMS 
              (* ;; "adding to a file")

              (FNS FILES? FILES?1 FILES?PRINTLST ADDTOFILES? ADDTOFILE WHATIS ADDTOCOMS ADDTOCOM 
                   ADDTOCOM1 ADDNEWCOM MAKENEWCOM DEFAULTMAKENEWCOM)
              (INITVARS (DEFAULTCOMHASFILEFLG))
              (ADDVARS (MARKASCHANGEDFNS))
              (FNS MERGEINSERT MERGEINSERT1)
              
              (* ;; "RMK: Changed INITVARS to VARS, so = addition is a synonym for untypable LF, and also suppress appearance of raw CR and LF in the file")

              (VARS [ADDTOFILEKEYLST `(("[" "" EXPLAINSTRING 
                                           "[ -- prettyprint the item to terminal and then ask again"
                                            NOECHOFLG T)
                                       (= "" EXPLAINSTRING "= - same as previous response" NOECHOFLG
                                          T)
                                       (,(CHARACTER (CHARCODE LF))
                                        "" EXPLAINSTRING "{line-feed} - same as previous response" 
                                        NOECHOFLG T)
                                       (" " ,(CONCATCODES (LIST (CHARCODE SPACE)
                                                                (CHARCODE EOL)))
                                            EXPLAINSTRING "{space} - no action" NOECHOFLG T)
                                       ("]" ,(CONCAT "Nowhere" (CHARACTER (CHARCODE EOL)))
                                            EXPLAINSTRING
                                            ,(CONCAT "] - nowhere, item is marked as a dummy"
                                                    (CHARACTER (CHARCODE EOL)))
                                            NOECHOFLG T)
                                       ["(" "List:  (" EXPLAINSTRING "(list name)" NOECHOFLG T KEYLST
                                            (( "" CONFIRMFG [%) %] ,(CHARACTER (CHARCODE SPACE))
                                                                 ,(CHARACTER (CHARCODE EOL]
                                                RETURN
                                                (CDR ANSWER]
                                       (@ "Near: " EXPLAINSTRING 
                                          "@ other-item   -- put the item near the other item" 
                                          NOECHOFLG T KEYLST (( "" CONFIRMFLG
                                                                 [,(CHARACTER (CHARCODE EOL]
                                                                 RETURN ANSWER)))
                                       [,(CHARACTER (CHARCODE CR))
                                        "" RETURN ,(CHARACTER (CHARCODE SPACE]
                                       ("" "File name: " EXPLAINSTRING "a file name" KEYLST (]
                    (LASTFILE)))
        (COMS 
              (* ;; "deleting an item from a file")

              (FNS DELFROMFILES DELFROMCOMS DELFROMCOM DELFROMCOM1 REMOVEITEM MOVETOFILE)
              (P (MOVD? 'DELFROMFILES 'DELFROMFILE NIL T)
                 (MOVD? 'MOVETOFILE 'MOVEITEM NIL T))
              (ADDVARS (SYSPROPS PROPTYPE VARTYPE)))
        [COMS                                                (* ; 
                      "functions for doing things and marking them changed and auxiliary functions")
              (FNS SAVEPUT)
              [DECLARE%: DONTEVAL@LOAD DOCOPY (P (OR (CHANGENAME 'PUTPROPS 'PUTPROP 'SAVEPUT)
                                                     (CHANGENAME 'PUTPROPS '/PUT 'SAVEPUT]
              (FNS UNMARKASCHANGED PREEDITFN POSTEDITPROPS POSTEDITALISTS)
              (ADDVARS (LISPXFNS (PUT . SAVEPUT)
                              (PUTPROP . SAVEPUT]
        (COMS                                                (* ; 
                                                  "sub-functions for file package commands & types")
              (FNS ALISTS.GETDEF ALISTS.WHENCHANGED CLEARCLISPARRAY EXPRESSIONS.WHENCHANGED 
                   MAKEALISTCOMS MAKEFILESCOMS MAKELISPXMACROSCOMS MAKEPROPSCOMS MAKEUSERMACROSCOMS 
                   PROPS.WHENCHANGED FILEGETDEF.LISPXMACROS FILEGETDEF.ALISTS FILEGETDEF.RECORDS 
                   FILEGETDEF.PROPS FILEGETDEF.MACROS FILEGETDEF.VARS FILEGETDEF.FNS 
                   FILEPKGCOMS.PUTDEF FILES.PUTDEF VARS.PUTDEF FILES.WHENCHANGED)
              (ADDVARS (MACROPROPS MACRO BYTEMACRO DMACRO)
                     (SYSPROPS PROPTYPE))
              (PROP PROPTYPE I.S.OPR SUBR LIST CODE FILEDATES FILE FILEMAP EXPR VALUE COPYRIGHT 
                    FILETYPE)
              (PROP VARTYPE BAKTRACELST BREAKMACROS COMPILETYPELST EDITMACROS ERRORTYPELST FONTDEFS 
                    LISPXHISTORYMACROS LISPXMACROS PRETTYDEFMACROS PRETTYEQUIVLST PRETTYPRINTMACROS 
                    PRETTYPRINTYPEMACROS USERMACROS))
        (COMS                                                (* ; 
                    "Define the commands below AFTER the various properties have been established.")
              (USERMACROS M))
        (COMS                                                (* ; "GETDEF methods")
              (FNS RENAME CHANGECALLERS)
              (FNS SHOWDEF COPYDEF GETDEF GETDEFCOM GETDEFCOM0 GETDEFCURRENT GETDEFERR GETDEFFROMFILE
                   GETDEFSAVED PUTDEF EDITDEF DEFAULT.EDITDEF EDITDEF.FILES LOADDEF DWIMDEF DELDEF 
                   DELFROMLIST HASDEF GETFILEDEF SAVEDEF UNSAVEDEF COMPAREDEFS COMPARE TYPESOF)
              (INITVARS (WHEREIS.HASH)))
                                                             (* ; "Must come after PUTDEF")
        (FNS FIXEDITDATE EDITDATE?)
                                                             (* ; 
                                  "Edit date support for all kinds of definers (from PARC 6/10/92)")
        [VARS (EDITDATE-ARGLIST-DEFINERS '(FUNCTIONS TYPES))
              (EDITDATE-NAME-DEFINERS '(STRUCTURES VARIABLES]
        (GLOBALVARS EDITDATE-ARGLIST-DEFINERS EDITDATE-NAME-DEFINERS)
        (COMS 
              (* ;; "how to dump FILEPKGCOMS. The SPLST must be initialized to contain FILEPKGCOMS in order to get started.")

              (FNS FILEPKGCOM FILEPKGTYPE)
              (PROP ARGNAMES FILEPKGCOM)
              (ADDVARS (FILEPKGCOMSPLST FILEPKGCOMS)
                     (FILEPKGTYPES FILEPKGCOMS))
              (FILEPKGCOMS FILEPKGCOMS)
              (FILEPKGCOMS ALISTS DEFS EDITMACROS EXPRESSIONS FIELDS FILEPKGTYPES FILES FILEVARS FNS
                     INITRECORDS INITVARS LISPXCOMS LISPXMACROS MACROS PRETTYDEFMACROS PROPS RECORDS
                     OLDRECORDS SYSRECORDS USERMACROS VARS * CONSTANTS))
        (ADDVARS (SHADOW-TYPES (FUNCTIONS FNS)
                        (VARIABLES VARS CONSTANTS)))
        (INITVARS (SAVEDDEFS))
        (COMS                                                (* ; "EDITCALLERS")
              (FNS FINDCALLERS EDITCALLERS EDITFROMFILE FINDATS LOOKIN)
              (FNS SEPRCASE)
              [INITVARS (DEFAULTRENAMEMETHOD '(EDITCALLERS CAREFUL]
              (INITVARS (SEPRCASEARRAYS)
                     (CLISPCASEARRAYS))
              (P (MOVD? 'INFILEP 'FINDFILE)
                                                             (* ; "or else from SPELLFILE"))
              (BLOCKS (EDITFROMFILE EDITFROMFILE LOOKIN (GLOBALVARS EDITLOADFNSFLG)
                             (NOLINKFNS LOADFROM)))
              (GLOBALVARS SYSFILES CLISPCASEARRAYS SEPRCASEARRAYS CLISPCHARS))
        (COMS                                                (* ; "EXPORT")
              (FNS IMPORTFILE IMPORTEVAL IMPORTFILESCAN CHECKIMPORTS GATHEREXPORTS \DUMPEXPORTS)
              (FILEPKGCOMS EXPORT)
              [INITVARS (BEGINEXPORTDEFSTRING "* %"FOLLOWING DEFINITIONS EXPORTED%")")
                     (ENDEXPORTDEFFORM '(* "END EXPORTED DEFINITIONS"]
              (GLOBALVARS BEGINEXPORTDEFSTRING ENDEXPORTDEFFORM))
        (COMS                                                (* ; "for GAINSPACE")
              (FNS CLEARFILEPKG)
              [ADDVARS (GAINSPACEFORMS (FILELST "erase filepkg information" (CLEARFILEPKG RESPONSE)
                                              ((Y "es")
                                               (N "o")
                                               (E . "verything")
                                               (F "ilemaps only
"]
              (GLOBALVARS SMASHPROPSLST1))
        (GLOBALVARS %#UNDOSAVES ADDTOFILEKEYLST CLEANUPOPTIONS CLISPIFYPRETTYFLG COMPILE.EXT 
               DECLARETAGSLST DEFAULTRENAMEMETHOD FILEPKGCOMSPLST FILERDTBL HISTORYCOMS HISTSTR0 
               I.S.OPRLST LISPXCOMS LISPXHISTORY LISPXHISTORYMACROS LISPXMACROS MACROPROPS 
               MAKEFILEOPTIONS MAKEFILEREMAKEFLG MSDATABASELST PRETTYHEADER PRETTYTRANFLG SAVEDDEFS 
               SYSPROPS USERMACROS USERRECLST USERWORDS FILEPKGTYPEPROPS)
        (BLOCKS (DELFROMCOMS DELFROMCOMS DELFROMCOM DELFROMCOM1 REMOVEITEM (NOLINKFNS . T)
                       (SPECVARS COMSNAME))
               (ADDTOFILEBLOCK ADDTOFILES? ADDTOFILE WHATIS ADDTOCOMS ADDTOCOM ADDTOCOM1 ADDNEWCOM
                      (NOLINKFNS . T)
                      (SPECVARS COMSNAME)
                      (ENTRIES ADDTOFILE ADDTOCOMS ADDTOFILES? ADDTOCOM1))
               (INFILECOMS? INFILECOMS? INFILECOMTAIL INFILECOMS INFILECOM INFILECOMSVAL 
                      INFILECOMSVALS INFILEPAIRS INFILECOMSMACRO IFCPROPS IFCEXPRTYPE IFCPROPSCAN 
                      IFCDECLARE (LOCALFREEVARS NAME LITERALS VAL TYPE ONFILETYPE ORIGFLG)
                      INFILECOMSPROP)
               (NIL MAKEFILE (LOCALVARS . T)
                    (SPECVARS FILE OPTIONS REPRINTFNS SOURCEFILE FILETYPE FILEDATES CHANGES))
               (ADDFILE ADDFILE ADDFILE0)
               (FILEPKGCHANGES FILEPKGCHANGES (NOLINKFNS . T))
               (NIL ALISTS.WHENCHANGED CHANGECALLERS CLEANUP CLEARCLISPARRAY COMPARE COMPAREDEFS 
                    COMPILEFILES COMPILEFILES0 CONTINUEDIT COPYDEF DEFAULTMAKENEWCOM DELFROMFILES 
                    EDITDEF EXPRESSIONS.WHENCHANGED FILECOMS FILECOMSLST FILEFNSLST FILEPKGCOM 
                    FILEPKGCOMPROPS FILEPKGTYPE FILES? FILES?1 GETFILEPKGTYPE HASDEF INFILECOMTAIL 
                    LOADDEF MAKEALISTCOMS MAKEFILE1 MAKEFILES MAKEFILESCOMS MAKELISPXMACROSCOMS 
                    MAKENEWCOM MAKEPROPSCOMS MAKEUSERMACROSCOMS MARKASCHANGED MOVETOFILE 
                    POSTEDITPROPS PREEDITFN PRETTYDEFMACROS PROPS.WHENCHANGED PUTDEF RENAME SAVEDEF 
                    SAVEPUT SEARCHPRETTYTYPELST SHOWDEF SMASHFILECOMS TYPESOF UNMARKASCHANGED 
                    UNSAVEDEF UPDATEFILES (GLOBALVARS %#UNDOSAVES SYSFILES MARKASCHANGEDSTATS 
                                                 COMPILE.EXT EDITMACROS EDITLOADFNSFLG LOADOPTIONS)
                    (LOCALVARS . T))
               (DELDEF DELDEF DELFROMLIST (NOLINKFNS . T))
               (GETDEF GETDEF DWIMDEF GETDEFCOM GETDEFCOM0 GETDEFERR GETDEFCURRENT GETDEFFROMFILE 
                      GETDEFSAVED (RETFNS GETDEFCOM)
                      (NOLINKFNS . T)
                      (GLOBALVARS NOT-FOUNDTAG)))
        (DECLARE%: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY COMPILERVARS
               (ADDVARS (NLAMA \DUMPEXPORTS MAKEUSERMACROSCOMS MAKEPROPSCOMS MAKELISPXMACROSCOMS 
                               MAKEFILESCOMS MAKEALISTCOMS LISTFILES COMPILEFILES CLEANUP 
                               FILEPKGCOMPROPS PRETTYDEFMACROS)
                      (NLAML)
                      (LAMA FILEPKGTYPE FILEPKGCOM FILEPKGCHANGES])



(* ; "standard records for accessing file  package type/command parts.  Exported for PRETTY")


(RPAQQ FILEPKGTYPEPROPS (NEWCOM WHENFILED WHENUNFILED GETDEF NULLDEF DELDEF PUTDEF WHENCHANGED 
                                   HASDEF EDITDEF CANFILEDEF FILEGETDEF))
(* "FOLLOWING DEFINITIONS EXPORTED")(DECLARE%: EVAL@COMPILE DONTCOPY 

(RPAQQ FILEPKGRECORDS (FILEPKGCOM FILEPKGTYPE FILE FILEDATEPAIR FILEPROP))
(DECLARE%: EVAL@COMPILE

(ACCESSFNS FILEPKGCOM [[ADD (GETPROP DATUM 'ADDTOPRETTYCOM)
                                  (UNDOABLE (COND
                                               (NEWVALUE (/PUTPROP DATUM 'ADDTOPRETTYCOM NEWVALUE))
                                               (T (/REMPROP DATUM 'ADDTOPRETTYCOM]
                           [DELETE (GETPROP DATUM 'DELFROMPRETTYCOM)
                                  (UNDOABLE (COND
                                               (NEWVALUE (/PUTPROP DATUM 'DELFROMPRETTYCOM NEWVALUE))
                                               (T (/REMPROP DATUM 'DELFROMPRETTYCOM]
                           [PRETTYTYPE (GETPROP DATUM 'PRETTYTYPE)
                                  (UNDOABLE (COND
                                               (NEWVALUE (/PUTPROP DATUM 'PRETTYTYPE NEWVALUE))
                                               (T (/REMPROP DATUM 'PRETTYTYPE]
                           [CONTENTS (GETPROP DATUM 'FILEPKGCONTENTS)
                                  (UNDOABLE (COND
                                               (NEWVALUE (/PUTPROP DATUM 'FILEPKGCONTENTS NEWVALUE))
                                               (T (/REMPROP DATUM 'FILEPKGCONTENTS]
                           (MACRO [CDR (FASSOC DATUM (GETTOPVAL 'PRETTYDEFMACROS]
                                  (STANDARD [COND
                                               [NEWVALUE (PUTASSOC DATUM NEWVALUE
                                                                (OR (LISTP (GETTOPVAL 
                                                                                  'PRETTYDEFMACROS))
                                                                    (SETTOPVAL 'PRETTYDEFMACROS
                                                                           (LIST (LIST DATUM]
                                               (T (SETTOPVAL 'PRETTYDEFMACROS
                                                         (REMOVE (FASSOC DATUM (GETTOPVAL
                                                                                'PRETTYDEFMACROS))
                                                                (GETTOPVAL 'PRETTYDEFMACROS]
                                         UNDOABLE
                                         (COND
                                            [NEWVALUE (/PUTASSOC DATUM NEWVALUE
                                                             (OR (LISTP (GETTOPVAL 'PRETTYDEFMACROS))
                                                                 (/SETTOPVAL 'PRETTYDEFMACROS
                                                                        (LIST (LIST DATUM]
                                            (T (/SETTOPVAL 'PRETTYDEFMACROS
                                                      (REMOVE (FASSOC DATUM (GETTOPVAL 
                                                                                   'PRETTYDEFMACROS))
                                                             (GETTOPVAL 'PRETTYDEFMACROS]
                                                             (* Not an atom record cause want 
                                                           REMPROP on NILs.)
                                                             (* NOTE%: PRETTCOM on PRETTY has 
                                                           open-coded access to the MACRO 
                                                           property.)
                          (INIT (FILEPKGCOMPROPS ADDTOPRETTYCOM DELFROMPRETTYCOM PRETTYTYPE 
                                       FILEPKGCONTENTS)))

(ATOMRECORD FILEPKGTYPE (NEWCOM WHENFILED WHENUNFILED GETDEF NULLDEF DELDEF PUTDEF WHENCHANGED 
                                   HASDEF EDITDEF FILEGETDEF CANFILEDEF)
                            (ACCESSFNS FILEPKGTYPE [(CHANGEDLST (CAR (SEARCHPRETTYTYPELST DATUM))
                                                           (CAR (SEARCHPRETTYTYPELST DATUM NEWVALUE))
                                                           )
                                                    (CHANGED (GETTOPVAL (CAR (SEARCHPRETTYTYPELST
                                                                              DATUM)))
                                                           (STANDARD (SETTOPVAL (CAR (
                                                                                  SEARCHPRETTYTYPELST
                                                                                      DATUM NEWVALUE)
                                                                                     )
                                                                            NEWVALUE)
                                                                  UNDOABLE
                                                                  (/SETTOPVAL (CAR (
                                                                                  SEARCHPRETTYTYPELST
                                                                                    DATUM NEWVALUE))
                                                                         NEWVALUE)))
                                                    (DESCRIPTION (CAR (CDDR (SEARCHPRETTYTYPELST
                                                                             DATUM)))
                                                           (CAR (RPLACA (CDDR (SEARCHPRETTYTYPELST
                                                                               DATUM NEWVALUE))
                                                                       NEWVALUE)))
                                                    (ALLFIELDS NIL (/SETTOPVAL
                                                                    'PRETTYTYPELST
                                                                    (REMOVE (SEARCHPRETTYTYPELST
                                                                             DATUM)
                                                                           (GETTOPVAL 'PRETTYTYPELST]
                                                             (* NOTE%: PRETTYCOM on PRETTY has 
                                                           open-coded access to GETDEF property)
                                   (INIT [PROGN (SETQ SYSPROPS (UNION FILEPKGTYPEPROPS SYSPROPS))
                                                (MAPC FILEPKGTYPEPROPS (FUNCTION (LAMBDA (X)
                                                                                   (PUT X
                                                                                        'PROPTYPE
                                                                                        'FILEPKGCOMS]
                                         (ADDTOVAR PRETTYTYPELST ))))

(ATOMRECORD FILE (FILECHANGES FILEDATES FILEMAP)
                     [ACCESSFNS FILE ((FILEPROP (GETPROP DATUM 'FILE)
                                             (STANDARD (PUTPROP DATUM 'FILE NEWVALUE)
                                                    UNDOABLE
                                                    (/PUTPROP DATUM 'FILE NEWVALUE])

(RECORD FILEDATEPAIR (FILEDATE . DATEFILENAME))

(RECORD FILEPROP ((COMSNAME . LOADTYPE) . TOBEDUMPED))
)

(FILEPKGCOMPROPS ADDTOPRETTYCOM DELFROMPRETTYCOM PRETTYTYPE FILEPKGCONTENTS)

[PROGN (SETQ SYSPROPS (UNION FILEPKGTYPEPROPS SYSPROPS))
       (MAPC FILEPKGTYPEPROPS (FUNCTION (LAMBDA (X)
                                          (PUT X 'PROPTYPE 'FILEPKGCOMS]

(ADDTOVAR PRETTYTYPELST )
)

(* "END EXPORTED DEFINITIONS")

(DEFINEQ

(SEARCHPRETTYTYPELST
  [LAMBDA (TYPE FLG)                                     (* rmk%: " 3-JAN-82 22:55")
                                                             (* ; 
                                                           "access functions used by the records")
    (AND (LITATOM TYPE)
         (OR (find X in PRETTYTYPELST suchthat (EQ (CADR X)
                                                               TYPE))
             (COND
                (FLG [/SETTOPVAL 'PRETTYTYPELST (CONS (SETQ FLG (LIST (PACK* 'CHANGED TYPE
                                                                             'LST)
                                                                      TYPE NIL))
                                                      (GETTOPVAL 'PRETTYTYPELST]
                     (OR (LISTP (GETTOPVAL (CAR FLG)))
                         (/SETTOPVAL (CAR FLG)
                                NIL))
                     FLG])

(PRETTYDEFMACROS
  [NLAMBDA ARGS                                          (* lmm " 5-SEP-78 16:16")
                                                             (* ; 
                                                 "included so that old files will continue to load")
    (for X in ARGS collect (FILEPKGCOM (CAR X)
                                              'MACRO
                                              (CDR X])

(FILEPKGCOMPROPS
  [NLAMBDA PROPS
    (MAPC PROPS (FUNCTION (LAMBDA (Y)
                            (OR (MEMB Y SYSPROPS)
                                (SETQ SYSPROPS (CONS Y SYSPROPS)))
                            (PUT Y 'PROPTYPE 'FILEPKGCOMS])
)

(RPAQQ FILEPKGRECORDS (FILEPKGCOM FILEPKGTYPE FILE FILEDATEPAIR FILEPROP))

(FILEPKGCOMPROPS ADDTOPRETTYCOM DELFROMPRETTYCOM PRETTYTYPE FILEPKGCONTENTS)

[PROGN (SETQ SYSPROPS (UNION FILEPKGTYPEPROPS SYSPROPS))
       (MAPC FILEPKGTYPEPROPS (FUNCTION (LAMBDA (X)
                                          (PUT X 'PROPTYPE 'FILEPKGCOMS]

(ADDTOVAR PRETTYTYPELST )
(DECLARE%: EVAL@COMPILE DOCOPY 

(CL:PROCLAIM '(CL:SPECIAL PRETTYDEFMACROS PRETTYTYPELST FILEPKGTYPES PRETTYPRINTMACROS 
                     *DEFAULT-CLEANUP-COMPILER* MARKASCHANGEDFNS PRETTYFLG))

(CL:PROCLAIM '(GLOBAL FILELST SYSFILES LOADEDFILELST NOTLISTEDFILES NOTCOMPILEDFILES MAKEFILEFORMS 
                     CLEANUPOPTIONS))
)

(RPAQ? MSDATABASELST )



(* ;; "making, adding, listing, compiling files")

(DEFINEQ

(CLEANUP
  [NLAMBDA FILES                                         (* lmm "14-Aug-84 19:17")
    (PROG (TEM1 TEM2 OPTIONS)
          (COND
             ([LISTP (CAR (SETQ FILES (NLAMBDA.ARGS FILES]
              (SETQ OPTIONS (CAR FILES))
              (SETQ FILES (CDR FILES)))
             (T (SETQ OPTIONS CLEANUPOPTIONS)))
          (RETURN (APPEND (MAKEFILES OPTIONS FILES)
                         (COND
                            ((NOT (MEMB 'LIST OPTIONS))
                             NIL)
                            ((NULL FILES)
                             (LISTFILES))
                            ((SETQ TEM1 (INTERSECTION FILES NOTLISTEDFILES))
                                                             (* ; 
            "Intersection check because LISTFILES applied to NIL means list all of NOTLISTEDFILES.")
                             (APPLY 'LISTFILES TEM1)))
                         (COND
                            [(NULL (SETQ TEM1 (MEMB 'RC OPTIONS]
                            ((NULL FILES)
                             (COMPILEFILES0 (SETQ TEM2 NOTCOMPILEDFILES)
                                    (CDR TEM1))
                             TEM2)
                            ((SETQ TEM2 (INTERSECTION FILES NOTCOMPILEDFILES))
                             (COMPILEFILES0 TEM2 (CDR TEM1))
                             TEM2])

(COMPILEFILES
  [NLAMBDA FILES                                         (* lmm "14-Aug-84 19:17")
    (COND
       ([LISTP (CAR (SETQ FILES (NLAMBDA.ARGS FILES]
        (COMPILEFILES0 (CDR FILES)
               (CAR FILES)))
       (T (COMPILEFILES0 FILES])

(COMPILEFILES0
  [LAMBDA (FILES OPTIONS)                                (* rmk%: "19-FEB-83 21:59")
    (for X OPTS (RCFLG _ T) on (OR FILES NOTCOMPILEDFILES)
       first (SETQ OPTS (SELECTQ (CAR (LISTP OPTIONS))
                                (C (SETQ RCFLG NIL)
                                   (CDR OPTIONS))
                                (RC (CDR OPTIONS))
                                OPTIONS)) do (MAKEFILE1 (OR (MISSPELLED? (CAR X)
                                                                           70 FILELST NIL X)
                                                                    (CAR X))
                                                        RCFLG OPTS X])

(CONTINUEDIT
  [LAMBDA (FILE)                                         (* bvm%: "30-Aug-86 15:09")
    (PROG (STREAM FL TEM FC ENV)
          (RESETLST
              [RESETSAVE NIL (LIST 'CLOSEF (SETQ STREAM (OPENSTREAM FILE 'INPUT]
              (SETQ FILE (FULLNAME STREAM))
              (SETFILEPTR STREAM 0)
              (CL:MULTIPLE-VALUE-SETQ (ENV FC)
                     (\PARSE-FILE-HEADER STREAM 'RETURN)))
          (COND
             ([NOT (fetch FILEPROP of (SETQ FL (ROOTFILENAME FILE]
              (LOADFROM FILE)                                (* ; 
                                                           "also calls addfile to notice the file.")
              ))
          (/replace FILECHANGES of FL with (FILECHANGES FC))
          [/replace FILEDATES of FL with
                                            (LIST (create FILEDATEPAIR
                                                         FILEDATE _ (CADR FC)
                                                         DATEFILENAME _ FILE)
                                                  (create FILEDATEPAIR
                                                         FILEDATE _
                                                         [CAR (SETQ TEM (CDR (MEMB 'date%: FC]
                                                         DATEFILENAME _ (CADR TEM]
          (RETURN FILE])

(MAKEFILE
  [LAMBDA (FILE OPTIONS REPRINTFNS SOURCEFILE)           (* ; "Edited 29-Aug-89 11:46 by bvm")

    (* ;; "OPTIONS: FAST means dump with PRETTYFLG set to NIL;  LIST means list the FILE;  RC means RECOMPILE, C means COMPILEL;  --- for C AND RC assume ST unless next option is F.")

    (PROG ((PRETTYFLG (AND [NOT (MEMB 'FAST (SETQ OPTIONS (MKLIST OPTIONS]
                           PRETTYFLG))
           (*PRINT-BASE* (if (EQ *PRINT-BASE* 8)
                             then 8
                           else                          (* ; "make sure radix is either 8 or 10, because all others don't read in like they print.  Maybe obsolete now with makefile environments")
                                 10))
           FILETYPE ROOTNAME FILEPROP CHANGES FILEDATES (Z (ADDFILE FILE)))
          (DECLARE (CL:SPECIAL PRETTYFLG))
          (SETQ FILE (CAR Z))                                (* ; 
                                               "Necessary because FILE might have been misspelled.")
          (SETQ ROOTNAME (CADR Z))                           (* ; "result of (ROOTFILENAME FILE), or if FILE is corrected, result of applying ROOTFILENAME to correct value.")
          (SETQ FILEPROP (CDDR Z))
          (UPDATEFILES)                                  (* ; "Want updating done after file is added to filelst, so any functions that are being dumped are marked as having been dumped.")
          (SETQ CHANGES (fetch TOBEDUMPED of FILEPROP))
          (SETQ FILEDATES (LISTP (fetch FILEDATES of ROOTNAME)))
          (SETQ FILETYPE (GETPROP ROOTNAME 'FILETYPE))
      LP0 (if (AND (NULL (fetch LOADTYPE of FILEPROP))
                       (NULL FILEDATES))
              then                                       (* ; 
                   "File has never been loaded and never dumped i.e. user just set up COMS in core")
            elseif [OR (EQMEMB 'NEW OPTIONS)
                           (AND (NULL MAKEFILEREMAKEFLG)
                                (NOT (MEMB 'REMAKE OPTIONS]
              then (COND
                          ((AND (fetch LOADTYPE of FILEPROP)
                                (NEQ T (fetch LOADTYPE of FILEPROP)))
                           (LISPXPRIN2 FILE T T)
                           (LISPXPRIN1 (SELECTQ (fetch LOADTYPE of FILEPROP)
                                           (LOADCOMP 
                                                  "the file was loaded for compilation purposes only")
                                           ((compiled Compiled COMPILED) 
                                                " -- only the compiled file has been loaded
")
                                           ((loadfns LOADFNS) 
                                                " -- only some of its symbolics have been loaded
")
                                           (SHOULDNT))
                                  T)
                           (COND
                              ((NEQ (ASKUSER DWIMWAIT 'Y "Go ahead and MAKEFILE anyway? ")
                                    'Y)                      (* ; 
            "E.g. user loads a .com file and then resets the COMS or defines the functons by hand.")
                               (GO OUT)))
                           (/replace LOADTYPE of FILEPROP with NIL)))
                    (SETQ SOURCEFILE NIL)
                    (SETQ REPRINTFNS NIL)
            elseif SOURCEFILE
              then                                       (* ; "source file given")
            elseif [AND FILEDATES (OR [AND (SETQ SOURCEFILE (FINDFILE ROOTNAME T))
                                               (EQUAL (FILEDATE SOURCEFILE)
                                                      (fetch FILEDATE of (CAR FILEDATES]
                                          (AND [NOT (STRING-EQUAL SOURCEFILE (SETQ SOURCEFILE
                                                                              (fetch DATEFILENAME
                                                                                 of (CAR 
                                                                                            FILEDATES
                                                                                             ]
                                               (INFILEP SOURCEFILE)
                                               (EQUAL (FILEDATE SOURCEFILE)
                                                      (fetch FILEDATE of (CAR FILEDATES]
              then (/replace DATEFILENAME of (CAR FILEDATES) with SOURCEFILE)
                    (OR REPRINTFNS (SETQ REPRINTFNS (FILEPKG.CHANGEDFNS CHANGES)))
            elseif [AND (CDR FILEDATES)
                            [SETQ SOURCEFILE (INFILEP (fetch DATEFILENAME of (CADR FILEDATES]
                            (EQUAL (FILEDATE SOURCEFILE)
                                   (fetch FILEDATE of (CADR FILEDATES]
              then 

                    (* ;; "prevous version file is gone, drop back to original daddy file and dump everything that has been changed.")

                    (SETQ CHANGES (FILEPKG.MERGECHANGES (fetch TOBEDUMPED of FILEPROP)
                                         (fetch FILECHANGES of ROOTNAME)))
                    (SETQ REPRINTFNS (FILEPKG.CHANGEDFNS CHANGES))
            else (LISPXPRIN1 
                            '"can't find either the previous version or the original version of 
" T)
                  (LISPXPRIN2 FILE T T)
                  (LISPXPRIN1 '", so it will have to be written anew
" T)
                  (SETQ SOURCEFILE NIL)
                  (SETQ REPRINTFNS NIL)
                  (push OPTIONS 'NEW)
                  (SETQ CHANGES (fetch FILECHANGES of ROOTNAME))
                  (GO LP0))
          (COND
             ((AND SOURCEFILE (SETQ Z (SELECTQ (fetch LOADTYPE of FILEPROP)
                                          (LOADCOMP          (* ; 
                                                   "only loaded via LOADCOMP.  Need to do LOADFROM")
                                                    (LIST 'N SOURCEFILE "was loaded with LOADCOMP"
                                                          '- "LOADFROM it to obtain VARS/COMS"))
                                          (Compiled (AND (INFILECOMS? 'DONTCOPY 'DECLARE%:
                                                                (fetch COMSNAME of FILEPROP))
                                                         (LIST 'Y "only compiled version of" ROOTNAME
                                                               
                                        "was loaded; LOADVARS the (DECLARE .. DONTCOPY ) expressions"
                                                               )))
                                          ((compiled loadfns) 
                                               (LIST 'N "Only some functions from" SOURCEFILE 
                                             "loaded via LOADFNS. Load all other expressions from it"
                                                     ))
                                          NIL)))
              (SELECTQ [ASKUSER DWIMWAIT (CAR Z)
                              (CDR Z)
                              '((Y "es
")
                                (N "o
")
                                (A "bort MAKEFILE
"]
                  (Y (SELECTQ (fetch LOADTYPE of FILEPROP)
                         (LOADCOMP                           (* ; 
                               "file was never actually loaded, just loadcomped.  thus no filecoms")
                                   (LOADFROM SOURCEFILE))
                         (Compiled 

                                 (* ;; "This is going to be a remake.  If it was originally loaded as a compiled file, must first do a LOADFROM in order to get the properties set up by declare: etc.")

                                   (LOADVARS 'DONTCOPY SOURCEFILE)
                                   (/replace LOADTYPE of FILEPROP with 'COMPILED)
                                                             (* ; "So wont have to be done again.")

                                 (* ;; "These are the only DECLARE:'s that are not also on the compiled file.  Note that a DECLARE: DONTEVAL@LOAD will be found and evaluated, but the corresponding expressions won't be evaluated from within the DECLARE:  Not worthwhile to bother setting up a complicated edit pattern to screen these out, especially if you consider expressions like (DECLARE: -- DONTEVAL@LOAD -- DOEVAL@LOAD --)")

                                   )
                         ((loadfns compiled) 

                                 (* ;; "This is going to be a remake, but the original call to LOADFNS didnt specify all the VARS, so some expressions may not have been loaded.")

                              (LOADVARS T SOURCEFILE))
                         NIL))
                  (A (GO OUT))
                  NIL)))
          (RESETLST
              [COND
                 ((MEMB 'NOCLISP OPTIONS)
                  (RESETSAVE PRETTYTRANFLG T))
                 ((MEMB 'CLISP%  OPTIONS)
                  (RESETSAVE PRETTYTRANFLG 'BOTH]
              (RESETSAVE %#UNDOSAVES)
              [COND
                 ((OR (MEMB 'CLISPIFY OPTIONS)
                      (MEMB 'CLISP OPTIONS))
                  (RESETSAVE CLISPIFYPRETTYFLG T))
                 ((OR (EQ FILETYPE 'CLISP)
                      (MEMB 'CLISP (LISTP FILETYPE)))
                  (RESETSAVE CLISPIFYPRETTYFLG 'CHANGES]
              (for X in MAKEFILEFORMS do (ERSETQ (EVAL X)))
              (SETQ FILE (PRETTYDEF NIL FILE (fetch COMSNAME of FILEPROP)
                                REPRINTFNS SOURCEFILE CHANGES)))
          (SETQ LASTFILE ROOTNAME)
          (/replace TOBEDUMPED of FILEPROP with NIL)
          (COND
             ((NOT (EQMEMB 'DON'TLIST FILETYPE))
              (pushnew NOTLISTEDFILES ROOTNAME)))
          (COND
             ((NOT (EQMEMB 'DON'TCOMPILE FILETYPE))
              (pushnew NOTCOMPILEDFILES ROOTNAME)))
          [for TAIL OPT on OPTIONS do (SETQ OPT (CAR TAIL))
                                                 (SELECTQ OPT
                                                     (RC (AND (MEMB ROOTNAME NOTCOMPILEDFILES)
                                                              (MAKEFILE1 FILE T (CDR TAIL))))
                                                     (C (AND (MEMB ROOTNAME NOTCOMPILEDFILES)
                                                             (MAKEFILE1 FILE NIL (CDR TAIL))))
                                                     (LIST (AND (MEMB ROOTNAME NOTLISTEDFILES)
                                                                (APPLY 'LISTFILES (LIST FILE))))
                                                     (COND
                                                        ((MEMB OPT MAKEFILEOPTIONS))
                                                        ((FIXSPELL OPT NIL MAKEFILEOPTIONS NIL 
                                                                OPTIONS)
                                                         (GO $$LP))
                                                        (T (ERROR "Unrecognized MAKEFILE option" OPT]
          (RETURN FILE)
      OUT (RETURN (LIST FILE "-- MAKEFILE not performed."])

(FILECHANGES
  [LAMBDA (FILE TYPE)                                    (* bvm%: "30-Aug-86 15:08")

    (* ;; "If FILE is a list, it is assumed to be a file-created expressions;  otherwise, the filecreated expression is read from FILE.  If TYPE, returns the list of changed items of that type from the changes expression.  If TYPE=NIL, returns the whole list of typed change-lists")

    (PROG ([FCEXPR (OR (LISTP FILE)
                       (AND FILE (RESETLST
                                     (LET (OLDPTR STREAM)
                                          [if (SETQ STREAM (OPENP FILE 'INPUT))
                                              then (SETQ OLDPTR (GETFILEPTR STREAM))
                                                    (SETFILEPTR STREAM 0)
                                            else (RESETSAVE NIL (LIST 'CLOSEF
                                                                          (SETQ STREAM
                                                                           (OPENSTREAM FILE
                                                                                  'INPUT]
                                          (CL:MULTIPLE-VALUE-BIND (ENV FC)
                                                 (\PARSE-FILE-HEADER STREAM 'RETURN)
                                                 (if OLDPTR
                                                     then (SETFILEPTR STREAM OLDPTR))
                                                 FC)))]
           FNS CHANGES)
          (SETQ CHANGES (LDIFF (SETQ CHANGES (CDR (MEMB 'to%: FCEXPR)))
                               (MEMB 'previous CHANGES)))
          [if (AND TYPE (NEQ TYPE 'FNS))
              then (RETURN (CDR (ASSOC TYPE CHANGES]
          (SETQ FNS (SUBSET CHANGES (FUNCTION LITATOM)))     (* ; 
                         "Old style changes expression listed FNS by name and other things by type")
          (RETURN (if TYPE
                      then                               (* ; "TYPE=FNS cause of test above.")
                            (NCONC FNS (CDR (ASSOC 'FNS CHANGES)))
                    elseif FNS
                      then (CONS (CONS 'FNS FNS)
                                     (SUBSET CHANGES (FUNCTION LISTP)))
                    else CHANGES])

(FILEPKG.MERGECHANGES
  [LAMBDA (C1 C2)                                        (* rmk%: "24-MAY-82 23:09")

    (* ;; "Merges 2 changes lists into a single one.  Treat LITATOM's as FNS, to accomodate old-style format on files.")

    (for E2 TEMP (VAL _ (for E1 in C1 when (CDR (LISTP E1)) collect (APPEND
                                                                                         E1)))
       in C2 do [COND
                           ((SETQ TEMP (ASSOC (CAR E2)
                                              VAL))
                            (NCONC TEMP (for X in (CDR E2) unless (MEMBER X (CDR TEMP))
                                           collect X)))
                           (T (SETQ VAL (NCONC1 VAL (APPEND E2] finally (RETURN VAL])

(FILEPKG.CHANGEDFNS
  [LAMBDA (CHANGES)                                      (* rmk%: "20-MAY-82 22:00")

    (* ;; "Returns list of function names from a file-changes list.  Interprets old format (functions are atoms) and new format (with explicit type headers)")

    (CDR (ASSOC 'FNS CHANGES])

(MAKEFILE1
  [LAMBDA (FILE RECOMPFLG OPTIONS OTHERFILES)            (* ; "Edited 29-Aug-89 11:46 by bvm")
    (PROG* ((ROOTNAME (ROOTFILENAME FILE))
            (COMPILER (COMPILE-FILE? ROOTNAME))
            GROUP)
           (COND
              ((AND (OR (EQ COMPILER 'BCOMPL)
                        (EQ COMPILER 'TCOMPL))
                    (NOT (FILEFNSLST ROOTNAME)))         (* ; 
                 "No FNS on this file, and we're told to use Interlisp compiler, so nothing to do.")
               (/SETTOPVAL 'NOTCOMPILEDFILES (REMOVE ROOTNAME NOTCOMPILEDFILES))
               (RETURN NIL)))
           (COND
              ([find X in (SETQ GROUP (GETPROP ROOTNAME 'FILEGROUP))
                  suchthat (AND (NEQ X ROOTNAME)
                                    (OR (fetch TOBEDUMPED of (fetch FILEPROP of
                                                                                         X))
                                        (MEMB X OTHERFILES]

               (* ;; "The file in question must be recompiled with other files, and one of the remaining files still needs to be dumped, or else one of the other file is further down the list of files being compiled.  Wait.")

               (RETURN)))
           (LISPXPRIN1 '"
compiling " T)
           (LISPXPRINT (OR GROUP FILE)
                  T T)
           (LISPXPRINT (LET [[REDEFINE? (OR (EQ (CAR OPTIONS)
                                                'ST)
                                            (EQ (CAR OPTIONS)
                                                'STF]
                             (FORGET-EXPRS? (EQ (CAR OPTIONS)
                                                'STF]
                            (SELECTQ COMPILER
                                ((FAKE-COMPILE-FILE)         (* ; 
                                               "The old CommonLispy interface to the ByteCompiler.")
                                     (FAKE-COMPILE-FILE FILE :REDEFINE REDEFINE? :SAVE-EXPRS
                                            (AND REDEFINE? (NOT FORGET-EXPRS?))))
                                ((CL:COMPILE-FILE)           (* ; "The new, improved (?) compiler")
                                     (CL:COMPILE-FILE FILE :LOAD (COND
                                                                    ((AND REDEFINE? (NOT 
                                                                                        FORGET-EXPRS?
                                                                                         ))
                                                                     :SAVE)
                                                                    (REDEFINE? T)
                                                                    (T NIL))))
                                ((TCOMPL BCOMPL)             (* ; "The old ByteCompiler")
                                     [IF (MEMB (CAR OPTIONS)
                                                   '(ST F S STF))
                                         THEN (LISPXUNREAD (LIST (CAR OPTIONS]
                                     [IF GROUP
                                         THEN 

                                               (* ;; 
                                   "File contained in FILEGROUP.  Therefore must be blockcompiled.")

                                               (IF RECOMPFLG
                                                   THEN (BRECOMPILE GROUP)
                                                 ELSE (BCOMPL GROUP))
                                       ELSEIF (EQ COMPILER 'TCOMPL)
                                         THEN (IF RECOMPFLG
                                                      THEN (RECOMPILE FILE)
                                                    ELSE (TCOMPL (LIST FILE)))
                                       ELSE (IF RECOMPFLG
                                                    THEN (BRECOMPILE FILE)
                                                  ELSE (BCOMPL (LIST FILE])
                                (SHOULDNT "Non-existent compiler returned from COMPILE-FILE?...")))
                  T T])

(COMPILE-FILE?
  [LAMBDA (ROOTNAME)                                     (* ; "Edited 19-Jan-87 21:12 by Pavel")

(* ;;; "Which compiler should CLEANUP use?")

    (LET ((TYPE (GET ROOTNAME 'FILETYPE))
          (UNKNOWN NIL))
         (FOR X INSIDE TYPE DO (SELECTQ X
                                               ((TCOMPL :TCOMPL) 
                                                    (RETURN 'TCOMPL))
                                               ((BCOMPL :BCOMPL) 
                                                    (RETURN 'BCOMPL))
                                               ((:FAKE-COMPILE-FILE CL:COMPILE-FILE COMPILE-FILE) 
                                                    (RETURN 'FAKE-COMPILE-FILE))
                                               ((:COMPILE-FILE :XCL-COMPILE-FILE) 
                                                    (RETURN 'CL:COMPILE-FILE))
                                               ((CLISP) 
                                                    NIL)
                                               (SETQ UNKNOWN T))
            FINALLY (IF UNKNOWN
                            THEN (CL:FORMAT T "~2%%**Warning: unknown FILETYPE value ~S~2%%" TYPE
                                            ))
                  (RETURN *DEFAULT-CLEANUP-COMPILER*])

(MAKEFILES
  [LAMBDA (OPTIONS FILES)                                (* rmk%: "23-FEB-83 21:20")
    (RESETVARS (%#UNDOSAVES)                                 (* ; 
                                                   "Willing to save arbitrary amounts of undo info")
               (UPDATEFILES)
               [COND
                  ((NULL FILES)
                   (for TYPE FLG in FILEPKGTYPES when [FILES?1 TYPE
                                                                         (COND
                                                                            ((NULL FLG)
                                                             (* ; "Gets printed the first time")
                                                                             
                                                                             '
                                        "****NOTE: the following are not contained on any file:
    ")
                                                                            (T '"    "]
                      do (SETQ FLG T) finally (AND FLG (ADDTOFILES?]
               (SETQ OPTIONS (MKLIST OPTIONS))
               (RETURN (for FILE inside (OR FILES FILELST)
                          when [fetch TOBEDUMPED of (LISTP (fetch FILEPROP
                                                                          of (ROOTFILENAME FILE]
                          collect (LISPXPRIN2 FILE T T)
                                (LISPXPRIN1 '|...| T)
                                (PROG1 (MAKEFILE FILE OPTIONS)
                                       (LISPXTERPRI T])

(ADDFILE
  [LAMBDA (FILE LOADTYPE PRLST FCLST)                    (* bvm%: "29-Aug-86 12:22")

    (* ;; "PRLST is the FILEPKGCHANGES prior to this file operation, FCLST is a list of file-created arguments, a singleton for a symbolic file, and a list whose car represents the compiled file and whose cdr represent symbolic files compiled into it, for compiled files.")

    (PROG ((ROOTNAME (ROOTFILENAME FILE))
           FLST VAL)
          [COND
             ((NOT FCLST)
              (SETQ VAL (ADDFILE0 ROOTNAME LOADTYPE FILE)))
             [(NULL (CDR FCLST))                             (* ; "A simple symbolic file")
              (SETQ FCLST (CAR FCLST))
              (SETQ VAL (ADDFILE0 (COND
                                         ((LITATOM (CADR FCLST))
                                          (ROOTFILENAME (CADR FCLST)))
                                         (T ROOTNAME))
                               LOADTYPE FILE (CAR FCLST]
             (T 
                (* ;; "A compiled file, skip the first expression representing the compiled file itself, look at the cdr representing the symbolic files.")

                (SELECTQ LOADTYPE
                    ((T LOADFNS) 
                         (SETQ LOADTYPE 'Compiled))
                    (loadfns (SETQ LOADTYPE 'compiled))
                    (LOADCOMP                                (* ; 
                   "loadcomp on compiled file.  Don't notice since we don't know what its state is")
                              NIL)
                    (SHOULDNT))
                (for X in (CDR FCLST) when (LITATOM (CADR X))
                   do (push FLST (CADR X))
                         (OR (EQ LOADTYPE 'LOADCOMP)
                             (ADDFILE0 (ROOTFILENAME (CADR X))
                                    LOADTYPE
                                    (CADR X)
                                    (CAR X]
          (UPDATEFILES PRLST (OR FLST (LIST FILE)))
          [AND LOADTYPE (for TYPE CHANGED in FILEPKGTYPES
                           when (AND (LITATOM TYPE)
                                         (SETQ CHANGED (fetch CHANGED of TYPE)))
                           do (/replace CHANGED of TYPE
                                     with (INTERSECTION (CDR (ASSOC TYPE PRLST))
                                                     CHANGED]
          (AND ADDSPELLFLG (ADDSPELL ROOTNAME USERWORDS))
          (RETURN VAL])

(ADDFILE0
  [LAMBDA (ROOTNAME LOADTYPE FULLNAME DAT)               (* lmm "28-Nov-84 16:47")
    (PROG (COMS X FILEPROP FLG TEM)
      TOP (SETQ COMS (FILECOMS ROOTNAME))
          [COND
             ((SETQ FILEPROP (fetch FILEPROP of ROOTNAME))
              (COND
                 ([AND LOADTYPE (FMEMB LOADTYPE
                                       (CDR (FMEMB (fetch LOADTYPE of FILEPROP)
                                                   '(LOADCOMP loadfns compiled Compiled LOADFNS 
                                                           COMPILED NIL T]
                  (/replace LOADTYPE of FILEPROP with LOADTYPE)

                  (* ;; "This call to ADDFILE reflects a 'higher' degree of loading, so upgrade property.  'loadfns' means just some information from file, if go to do makefile, must do loadfrom, 'compiled' is like 'loadfns' but for compiled files e.g. user does LOADFNS on compiled file.  'Compiled' means all but DECLARE: expressions are in.  e.g. user does LOAD of a compiled file.  COMPILED means everything is in, e.g. user does LOADDFROM a compiled file.  LOADFNS means everything in, e.g. user des LOADFROM symbolic file.  COMPILED and LOADFNS are equivalent in that means dont have to do any more loading when go to do a makefile but makefile NEW isnt permitted.  NIL is a makefile when coms were set up in core.  T is full load of symbolic file.  The check on TYPE=NIL is bcause dont want to upgrade as result of call from makefile, i.e. no new information there.")

                  (* ;; "LOADCOMP means file was loadcomp'ed.  note that the actual structure is a tree, not a list, and the above is only an approximation.  if you do a loadcomp, and then load the compiled file, the state will be left with latter, but then loadcomp? will loadcomp again because compiled files might not contain all the declare: EVAL@COMPILE expressions, e.g. macros, records etc.  however, in most cases, loadcomp is used independently of other loading, e.g. for compilation purposes only, so this will at least permit loadcomp? to work.")

                  (GO OUT))
                 (T (GO OUT1]
          (COND
             [(OR LOADTYPE (LISTP (GETTOPVAL COMS)))
              (SETQ FILEPROP (/replace FILEPROP of ROOTNAME
                                with (create FILEPROP
                                                COMSNAME _ COMS
                                                LOADTYPE _ LOADTYPE]
             (FLG (GO ERROR))
             ((AND DWIMFLG (EQ ROOTNAME FULLNAME)
                   (SETQ ROOTNAME (MISSPELLED? ROOTNAME 70 FILELST T)))

              (* ;; "The EQ check is so as not to try correcting if the user has specified a version number or directory, as it is too messy trying to take them out, and then put them back in on the corrected root name.")

              (SETQ FULLNAME ROOTNAME)
              (SETQ FLG T)                                   (* ; 
                                         "so wont try to spelling correct again if file isnt there")
              (GO TOP))
             (T (GO ERROR)))
      OUT [AND LOADTYPE DAT (/replace FILEDATES of ROOTNAME
                               with (LIST (create FILEDATEPAIR
                                                     FILEDATE _ DAT
                                                     DATEFILENAME _ FULLNAME]
          (AND (EQ LOADTYPE T)
               (/replace TOBEDUMPED of FILEPROP with NIL))
      OUT1
          [COND
             ([AND (LISTP (GETTOPVAL COMS))
                   (NOT (FMEMB ROOTNAME (GETTOPVAL 'FILELST] (* ; 
                                                          "coms wuld not be set up on a loadccomp.")
              (/SETTOPVAL 'FILELST (CONS ROOTNAME (GETTOPVAL 'FILELST]
          (RETURN (COND
                     ((NULL LOADTYPE)                        (* ; "call from makefile.")
                      (CONS FULLNAME (CONS ROOTNAME FILEPROP)))
                     (T FILEPROP)))
      ERROR
          (ERROR FULLNAME "not file name." T])

(LISTFILES
  [NLAMBDA FILES                                         (* rmk%: " 3-Dec-84 08:58")
    (DECLARE (GLOBALVARS NOTLISTEDFILES))                (* ; "LISTFILES1 is machinedependent")
    (for FILE FULLNAME OPTIONS in (COND
                                             (FILES (SETQ FILES (NLAMBDA.ARGS FILES)))
                                             (T NOTLISTEDFILES))
       when (COND
                   ((LISTP FILE)
                    (SETQ OPTIONS (APPEND FILE OPTIONS))
                    NIL)
                   ((SETQ FULLNAME (FINDFILE FILE))
                    FULLNAME)
                   (T (printout T FILE " not found." T)
                      NIL)) collect [COND
                                           ((LISTFILES1 FULLNAME OPTIONS)
                                            (SETQ NOTLISTEDFILES (REMOVE (NAMEFIELD FULLNAME T)
                                                                        NOTLISTEDFILES]
                                  FULLNAME])
)

(RPAQ? *DEFAULT-CLEANUP-COMPILER* 'CL:COMPILE-FILE)

(RPAQ? FILELST )

(RPAQ? LOADEDFILELST )

(RPAQ? NOTLISTEDFILES )

(RPAQ? NOTCOMPILEDFILES )

(RPAQ? MAKEFILEFORMS )

(RPAQ? NILCOMS )

(ADDTOVAR MAKEFILEOPTIONS RC C LIST FAST CLISP CLISPIFY NIL REMAKE NEW NOCLISP CLISP%  F ST STF
                                 (REC . RC)
                                 (BREC . RC)
                                 (TC . C)
                                 (BC . C)
                                 (TCOMPL . C)
                                 (BCOMPL . C))

(RPAQ? MAKEFILEREMAKEFLG T)

(RPAQ? CLEANUPOPTIONS '(RC))



(* ;; "scanning file coms")

(DEFINEQ

(FILEPKGCHANGES
  [LAMBDA N                                              (* Pavel " 7-Oct-86 19:22")
    (COND
       [(EQ N 0)
        (PROG (TEM)
              (RETURN (for X in FILEPKGTYPES when (AND (LITATOM X)
                                                                   (SETQ TEM (FILEPKGCHANGES
                                                                              X)))
                         collect (CONS X TEM]
       [(EQ (ARG N 1)
            T)
        (for X in FILEPKGTYPES when (LITATOM X) collect (CONS X (FILEPKGCHANGES
                                                                                 X]
       [(EQ N 1)
        (COND
           [(LISTP (ARG N 1))
            (for X in (ARG N 1) when (FMEMB (CAR X)
                                                        FILEPKGTYPES)
               do (/replace CHANGED of (CAR X) with (CDR X]
           (T (for Y on (fetch CHANGED of (ARG N 1))
                 when [AND (CAR Y)
                               (NOT (for Z in (CDR Y) thereis (CL:EQUAL (CAR Y)
                                                                                 Z]
                 collect (CAR Y]
       (T (/replace CHANGED of (ARG N 1) with (ARG N 2])

(GETFILEPKGTYPE
  [LAMBDA (TYPE ONLY NOERROR NAME)                       (* lmm "20-Nov-86 23:10")

    (* ;; "Coerce TYPE to a well defined definition type (FILEPKG type) or a command. ONLY is an indicator of which is acceptable; if NIL, either one is acceptable, if COMS, only commands are acceptable, and if TYPES, only types should be returned. If none is found, will signal an error if NOERROR is NIL, otherwise return NIL. ")

    (COND
       [(LISTP TYPE)

        (* ;; " given a list of types, coerce them all or return NIL")

        (for X in TYPE collect (OR (GETFILEPKGTYPE X ONLY NOERROR NAME)
                                               (RETURN]
       ((EQ TYPE '?)

        (* ;; "odd case, may be obsolete: if given IL:?, return all known types of NAME. Maybe used by EDITDEF(NAME ?)?? ")

        (AND NAME (TYPESOF NAME)))
       [(AND (NEQ ONLY 'COMS)
             (OR (SELECTQ TYPE
                     (NIL 'FNS)
                     (T 'VARS)
                     NIL)
                 (for X in FILEPKGTYPES do (if (EQ TYPE X)
                                                           then 

                                                                 (* ;; "type matched exactly")

                                                                 (RETURN TYPE)
                                                         elseif (AND (LISTP X)
                                                                         (EQ TYPE (CAR X)))
                                                           then (RETURN (CDR X]
       [(AND (NEQ ONLY 'TYPE)
             (LITATOM TYPE)
             (PROG1 (CAR (FMEMB TYPE FILEPKGCOMSPLST))       (* ; "Prefer an exact match quickly")
                    ]
       [(AND (NEQ ONLY 'COMS)
             (LITATOM TYPE)
             (for X in FILEPKGTYPES bind NAME
                do (SETQ NAME (if (NLISTP X)
                                      then X
                                    else (CAR X))) 

                      (* ;; "see if spelled the same or 1 char shorter; assume all FILEPKGTYPE names end with S. This handles package conversions and also pluralization")

                      (AND (<= 0 (- (NCHARS NAME)
                                    (NCHARS TYPE))
                               1)
                           (STRPOS TYPE NAME)
                           (RETURN (if (EQ X NAME)
                                       then X
                                     else (CDR X]
       [(FIXSPELL TYPE NIL (SELECTQ ONLY
                               (TYPE FILEPKGTYPES)
                               (COMS FILEPKGCOMSPLST)
                               (UNION FILEPKGTYPES FILEPKGCOMSPLST]
       ((NOT NOERROR)
        (ERROR (SELECTQ ONLY
                   (TYPE "unrecognized manager definition type")
                   (COMS "unrecognized manager command")
                   "unrecognized manager definition-type/command")
               TYPE])

(MARKASCHANGED
  [LAMBDA (NAME TYPE REASON)                             (* ; "Edited 25-May-88 15:37 by drc:")
    (COND
       (FILEPKGFLG (SETQ REASON (SELECTQ REASON
                                    ((CLISP LOAD CHANGED DEFINED DELETED) 
                                         REASON)
                                    (NIL 'CHANGED)
                                    (T 'DEFINED)
                                    (ERROR "bad REASON in MARKASCHANGED" REASON)))
              (SETQ TYPE (GETFILEPKGTYPE TYPE 'TYPE))
              (for FN inside (fetch WHENCHANGED of TYPE)
                 do (APPLY* FN NAME TYPE REASON))
              (for FN in MARKASCHANGEDFNS do (APPLY* FN NAME TYPE REASON))
              [COND
                 ((EQ REASON 'DELETED)
                  (for L on (fetch CHANGED of TYPE) when (EQUAL (CAR L)
                                                                                    NAME)
                     do (/RPLACA L NIL))                 (* ; 
                                                          "unmark as changed and remove from files")
                  (DELFROMFILES NAME TYPE))
                 (T (LET ((LST (push (fetch CHANGED of TYPE)
                                      NAME)))
                         (AND LISPXHIST (UNDOSAVE (LIST '/RPLACA LST)
                                               LISPXHIST))   (* ; 
                             "UNDO by smashing with NIL;  makes calls to MARKASCHANGED independent")
                         ]
              NAME])

(FILECOMS
  [LAMBDA (FILE X)                                       (* rmk%: "19-FEB-83 13:55")
    (COND
       ((AND (NULL FILE)
             (NULL X))
        'NILCOMS)
       [(AND (OR (NULL X)
                 (EQ X 'COMS))
             (fetch COMSNAME of (LISTP (fetch FILEPROP of FILE]
       (T (PACK* (NAMEFIELD FILE)
                 (OR X 'COMS])

(WHEREIS
  [LAMBDA (NAME TYPE FILES FN)                        (* ; "Edited 12-Jul-88 17:14 by MASINTER")

    (* ;; "T as a NAME has a special meaning to INFILECOMS?  so don't pass through.")

    (CL:UNLESS (EQ NAME T)
        (LET [(IN-FILES (UNION [SUBSET (OR (LISTP FILES)
                                           FILELST)
                                      (FUNCTION (LAMBDA (FILE)
                                                  (INFILECOMS? NAME TYPE (FILECOMS FILE]
                               (AND (EQ FILES T)
                                    (CL:FBOUNDP 'XCL::HASH-FILE-WHERE-IS)
                                    (LET ((FILES NIL))
                                         (for TY inside TYPE
                                            do (for FILE-NAME
                                                      in (XCL::HASH-FILE-WHERE-IS NAME
                                                                    (GETFILEPKGTYPE TYPE))
                                                      do (CL:PUSHNEW (MKATOM (U-CASE FILE-NAME))
                                                                    FILES)))
                                         (REVERSE FILES]
             (CL:IF FN
                 [MAPC IN-FILES (FUNCTION (LAMBDA (FILE)
                                            (APPLY* FN NAME FILE]
                 IN-FILES)))])

(SMASHFILECOMS
  [LAMBDA (FILE)                                         (* rmk%: "19-FEB-83 22:15")
    (for X in (FILECOMSLST FILE 'FILEVARS) when (LITATOM X)
       do (SETTOPVAL X 'NOBIND))
    FILE])

(FILEFNSLST
  [LAMBDA (FILE)                                         (* ; "Edited 14-Jun-90 19:30 by jds")
    (FILECOMSLST FILE '(FUNCTIONS FNS])

(FILECOMSLST
  [LAMBDA (FILE TYPE FLG)                                (* JonL "24-Jul-84 19:48")
                                                             (* ; 
                                                    "TYPE is coerced in the innards of INFILECOMS?")
    (COND
       ((EQ FLG 'UPDATE)
        (CDR (INFILECOMS? NIL TYPE (FILECOMS FILE)
                    FLG)))
       (T (INFILECOMS? NIL TYPE (FILECOMS FILE)
                 FLG])

(UPDATEFILES
  [LAMBDA (PRLST FLST)                                   (* rmk%: "19-FEB-83 14:27")

    (* ;; "PRLST may be the value of FILEPKGCHANGES before some operation (e.g.  LOAD, LOADFNS) involving the files in FLST began.")

    (for TYPE CHANGED in FILEPKGTYPES when (SETQ CHANGED (fetch CHANGED of TYPE))
       do (COND
                 ((NULL (SETQ CHANGED (FILEPKGCHANGES TYPE)))
                                                             (* ; 
                                                           "FILEPKGCHANGES eliminates duplicates")
                  (/replace CHANGED of TYPE with NIL))
                 (T (for FILE FOUND FILEPROP COMS LST TYPEDPROP PCHANGES
                           (PREVITEMS _ (CDR (ASSOC TYPE PRLST))) in FILELST
                       first (SETQ LST (INFILECOMS? CHANGED TYPE 'NILCOMS 'UPDATE)) 

                             (* ;; "First check NIL=Nowhere.  LST:1 contains variables whose values are on the file literally.  These are `found' but not marked.  LST::1 contains all other items.")

                             (SETQ FOUND (NCONC (CAR LST)
                                                (CDR LST)
                                                FOUND))
                       do (SETQ PCHANGES (COND
                                                ((FMEMB (fetch DATEFILENAME
                                                           of (CAR (fetch FILEDATES
                                                                          of FILE)))
                                                        FLST)

                                 (* ;; "PREVITEMS are changed items that were previously on the changed list, before PRLST was computed as this LOAD/LOADFNS began.  Thus, by this intersection we only worry about items that were previously changed;  any items that were only changed during this operation are ignored.")

                                                 (INTERSECTION CHANGED PREVITEMS))
                                                (T CHANGED)))
                             [COND
                                ([AND PCHANGES [SETQ COMS (fetch COMSNAME
                                                             of (SETQ FILEPROP
                                                                     (LISTP (fetch FILEPROP
                                                                               of FILE]
                                      (SETQ LST (INFILECOMS? PCHANGES TYPE COMS 'UPDATE]

                                 (* ;; "LST:1 is a list of the times that literally appear on this file, LST::1 is a list of those whose literal values are not in the coms")

                                 [COND
                                    ((CDR LST)               (* ; "CDR items must be distributed")
                                     [COND
                                        ((NULL (fetch TOBEDUMPED of FILEPROP))

                                         (* ;; "Only finagle global lists the first time an item is added to PROP, when PROP::1 goes from NIL to non-NIL")

                                         [/SETTOPVAL 'NOTLISTEDFILES (REMOVE FILE (GETTOPVAL
                                                                                   'NOTLISTEDFILES]
                                         (/SETTOPVAL 'NOTCOMPILEDFILES (REMOVE FILE
                                                                              (GETTOPVAL 
                                                                                     '
                                                                                     NOTCOMPILEDFILES
                                                                                     ]
                                                             (* ; 
                                                   "Get the (possibly new) TYPE item list to smash")
                                     [COND
                                        [(SETQ TYPEDPROP (ASSOC TYPE (fetch TOBEDUMPED
                                                                        of FILEPROP]
                                        (T (/NCONC1 FILEPROP (SETQ TYPEDPROP (CONS TYPE]
                                                             (* ; 
                                                        "Now distribute items to the file property")
                                     (for Y in (CDR LST) unless (MEMBER Y (CDR TYPEDPROP)
                                                                                   )
                                        do (/NCONC1 TYPEDPROP Y]
                                 (SETQ FOUND (NCONC (CAR LST)
                                                    (CDR LST)
                                                    FOUND] finally (/replace CHANGED
                                                                          of TYPE
                                                                          with (LDIFFERENCE
                                                                                    CHANGED FOUND])

(INFILECOMS?
  [LAMBDA (NAME TYPE COMS ONFILETYPE)                 (* ; "Edited 12-Jul-88 17:42 by MASINTER")

    (* ;; "Returns T if NAME is 'CONTAINED' in COMS.  If NAME is NIL, then value is a list of all of the functions contained in COMS.  If NAME=T, value is T if there are any elements of type TYPE, otherwise NIL (this feature is used for deciding whether or not (and how) to compile files.)  Called by FILEFNSLST (which is used by BRECOMPILE) and by NEWFILE1.  while elements are the subset of NAME which are on the file in other case")

    (* ;; "if ONFILETYPE is UPDATE, then NAME is a list of elements, and INFILECOMS?  returns the dotted pair of (literals  . elements) where literals are those which are `literally' on the file (e.g.  (VARS (X 3))) --- if ONEFILETYPE is EDIT, then NAME is interpreted as for ONFILETYPE=NIL, but only those elements which are not on the file literally and which are not subparts of other types are returned")

    (* ;; "if ONFILETYPE is TYPESOF, type can be a list of types, and returns a list of types suitable for EDITDEF ")

    (PROG (VAL LITERALS ORIGFLG)
          (SETQ TYPE (GETFILEPKGTYPE TYPE))
          (SELECTQ ONFILETYPE
              (EDIT (SELECTQ TYPE
                        (FILEVARS (RETURN))
                        NIL))
              NIL)
          [COND
             ((LITATOM COMS)
              (SELECTQ TYPE
                  ((VARS FILEVARS)                           (* ; 
                                                           "the COMS of a file are also on it")
                       (INFILECOMSVAL COMS))
                  NIL)
              (SETQ COMS (EVALV COMS]
          (INFILECOMS COMS)
          (SETQ VAL (DREVERSE VAL))
          (RETURN (COND
                     ((EQ ONFILETYPE 'UPDATE)
                      (CONS LITERALS VAL))
                     (T VAL])

(INFILECOMTAIL
  [LAMBDA (COM FLG)                                   (* ; "Edited  2-Aug-88 02:15 by masinter")
    [SETQ COM (COND
                 ((EQ (CADR COM)
                      '*)
                  (COND
                     [(LITATOM (CADDR COM))
                      (LISTP (EVALV (CADDR COM]
                     (T [RESETVARS (DWIMLOADFNSFLG)
                                   (NLSETQ (SETQ COM (EVAL (CADDR COM]
                        COM)))
                 (T (CDR COM]
    (if (NOT FLG)
        then (for X in COM
                    do [if (AND (LISTP X)
                                        (EQ (CAR X)
                                            COMMENTFLG))
                               then (RETURN (SUBSET COM (FUNCTION (LAMBDA (X)
                                                                        (OR (NLISTP X)
                                                                            (NEQ (CAR X)
                                                                                 COMMENTFLG]
                    finally (RETURN COM))
      else COM])

(INFILECOMS
  [LAMBDA (COMS)                                         (* rmk%: "19-FEB-83 22:17")
    (for X in COMS do (INFILECOM X])

(INFILECOM
  [LAMBDA (COM)                                       (* ; "Edited  2-Aug-88 02:27 by masinter")
    (COND
       [(NLISTP COM)
        (COND
           ((EQ TYPE 'VARS)
            (INFILECOMSVAL COM]
       ((EQ (CAR COM)
            COMMENTFLG)

        (* ;; 
"must be special case'd first so that (* * values) doesn't make it look like `values' is a variable")
                                                             (* ; 
  "don't know why I should bother, but someone might want to know all of the comments on a file???")
        (COND
           ((EQ TYPE COMMENTFLG)
            (INFILECOMSVAL COM T)))
        NIL)
       (T
        (PROG ((COMNAME (CAR COM))
               (TAIL (CDR COM))
               CFN TEM)
              (COND
                 [[COND
                     ((SETQ CFN (fetch (FILEPKGCOM CONTENTS) of COMNAME))
                      (SETQ TEM (APPLY* CFN COM (COND
                                                   ((AND (NULL ONFILETYPE)
                                                         (NOT (CL:SYMBOLP NAME)))
                                                             (* ; 
                                                "call from WHEREIS of a name which is not a symbol")
                                                    (LIST NAME))
                                                   (T NAME))
                                       TYPE ONFILETYPE)))
                     ((SETQ CFN (fetch (FILEPKGCOM PRETTYTYPE) of COMNAME))
                                                             (* ; "for compatability")
                      (SETQ TEM (APPLY* CFN COM TYPE NAME]
                  (COND
                     [(NLISTP TEM)
                      (COND
                         ((EQ TEM T)
                          (COND
                             ((OR (EQ NAME T)
                                  (NULL ONFILETYPE))
                              (RETFROM 'INFILECOMS? T]
                     (T (INFILECOMSVALS TEM]
                 ((LISTP TAIL)

                  (* ;; "this SELECTQ handles the `exceptional cases' for the built in types.  There is an explicit RETURN in the SELECTQ clause if the default is handled")

                  (SELECTQ COMNAME
                      ((PROP IFPROP) 
                           (SETQ TAIL (CDR TAIL)))
                      NIL)
                  [COND
                     ((EQ (CAR TAIL)
                          '*)
                      (COND
                         ((LITATOM (CADR TAIL))
                          (SELECTQ TYPE
                              ((VARS FILEVARS) 
                                   (INFILECOMSVAL (CADR TAIL)))
                              NIL))
                         ((AND (LISTP (CADR TAIL))
                               (EQ ONFILETYPE 'UPDATE)
                               (EQ TYPE 'VARS)
                               (EQ (CAADR TAIL)
                                   'PROGN)
                               (FMEMB (CAR (LAST (CADR TAIL)))
                                      NAME))
                          (SETQ VAL (CONS (CADR TAIL)
                                          VAL]
                  (SELECTQ COMNAME
                      ((COMS EXPORT) 
                           (INFILECOMS (INFILECOMTAIL COM T)))
                      (CL:EVAL-WHEN (INFILECOMS (INFILECOMTAIL (CDR COM)
                                                           T)))
                      (DECLARE%:                             (* ; "skip over DECLARE: tags")
                                 [RETURN (AND (NOT (FMEMB 'COMPILERVARS COM))
                                              (IFCDECLARE (INFILECOMTAIL COM)
                                                     (EQ TYPE 'DECLARE%:])
                      (ORIGINAL                              (* ; "dont expand macros")
                                (PROG ((ORIGFLG T))
                                      (INFILECOMS (INFILECOMTAIL COM T))))
                      ((PROP IFPROP)                         (* ; 
                                       "this currently does not handle `pseudo-types' of PROPNAMES")
                           (SELECTQ TYPE
                               (PROPS (IFCPROPSCAN (INFILECOMTAIL (CDR COM)
                                                              T)
                                             (CADR COM)))
                               (MACROS (INFILECOMSMACRO (INFILECOMTAIL (CDR COM))
                                              (CADR COM)))
                               NIL))
                      (PROPS (RETURN (IFCPROPS COM)))
                      (MACROS (RETURN (SELECTQ TYPE
                                          (PROPS (IFCPROPSCAN (INFILECOMTAIL COM T)
                                                        MACROPROPS))
                                          (MACROS (INFILECOMSVALS (INFILECOMTAIL COM T)))
                                          NIL)))
                      (ALISTS                                (* ; 
                      "sigh.  This should probably also `coerce' when asking for LISPXMACROS, etc.")
                              (RETURN (SELECTQ TYPE
                                          (ALISTS (INFILEPAIRS (INFILECOMTAIL COM)))
                                          NIL)))
                      (P [RETURN (SELECTQ TYPE
                                     ((EXPRESSIONS P) 
                                          (INFILECOMSVALS (INFILECOMTAIL COM T)
                                                 T))
                                     (COND
                                        ((NULL ONFILETYPE)   (* ; "for WHEREIS and FILECOMSLST")
                                         (SELECTQ TYPE
                                             (I.S.OPRS (IFCEXPRTYPE COM 'I.S.OPR))
                                             (TEMPLATES (IFCEXPRTYPE COM 'SETTEMPLATE))
                                             NIL])
                      ((ADDVARS APPENDVARS) 
                           (SELECTQ TYPE
                               (VARS [RETURN (AND (NULL ONFILETYPE)
                                                  (for X in (INFILECOMTAIL COM T)
                                                     do (INFILECOMSVAL (CAR X)
                                                                   T])
                               (ALISTS [RETURN (for X in (INFILECOMTAIL COM T)
                                                  when (EQMEMB 'ALIST (GETPROP (CAR X)
                                                                                 'VARTYPE))
                                                  do (for Z in (CDR X)
                                                            do (INFILECOMSVAL
                                                                    (LIST (CAR X)
                                                                          (CAR Z))
                                                                    T])
                               (OR (EQ TYPE COMNAME)
                                   (RETURN))))
                      ((VARS INITVARS FILEVARS UGLYVARS HORRIBLEVARS CONSTANTS ARRAY) 
                           [RETURN (COND
                                      ((EQ TYPE 'EXPRESSIONS)
                                       (for X in (INFILECOMTAIL COM T)
                                          when (AND (LISTP X)
                                                        (NEQ (CAR X)
                                                             COMMENTFLG))
                                          do (INFILECOMSVAL (CONS 'SETQ X)
                                                        T)))
                                      ((OR (EQ TYPE 'VARS)
                                           (EQ TYPE COMNAME))(* ; 
                   "either want all VARS, or else want all FILEVARS and this is a FILEVARS command")
                                       (for X in (INFILECOMTAIL COM T)
                                          do (COND
                                                    ((LISTP X)
                                                     (AND (CAR X)
                                                          (NEQ (CAR X)
                                                               COMMENTFLG)
                                                          (INFILECOMSVAL (CAR X)
                                                                 T)))
                                                    (X (INFILECOMSVAL X (EQ COMNAME 'INITVARS])
                      (DEFS [RETURN (for X in (INFILECOMTAIL COM T)
                                       when (EQ TYPE (CAR X)) do (INFILECOMSVALS
                                                                          (CDR X])
                      (FILES (RETURN))
                      NIL)

                  (* ;; "Exceptional cases now handled.  If TYPE matches (CAR COM) then scan the tail as usual.  Else expand the com's MACRO, if it has one, unless there was a CONTENTS function")

                  (COND
                     ((EQ COMNAME TYPE)
                      (INFILECOMSVALS (INFILECOMTAIL COM T)))
                     [(AND (LISTP TYPE)
                           (FMEMB COMNAME TYPE))
                      (LET ((TYPE COMNAME))
                           (INFILECOMSVALS (INFILECOMTAIL COM T]
                     ((AND (OR (NULL CFN)
                               (AND (EQ CFN T)
                                    (NULL ONFILETYPE)))
                           (NULL ORIGFLG)
                           (SETQ TEM (fetch (FILEPKGCOM MACRO) of COMNAME)))
                      (INFILECOMS (SUBPAIR (CAR TEM)
                                             (INFILECOMTAIL COM T)
                                             (CDR TEM])

(INFILECOMSVALS
  [LAMBDA (X FLG)                                     (* ; "Edited  2-Aug-88 02:21 by masinter")
    (for Y in X when (NOT (AND (LISTP Y)
                                           (EQ (CAR Y)
                                               COMMENTFLG))) do (INFILECOMSVAL Y FLG])

(INFILECOMSVAL
  [LAMBDA (X FLG)                                     (* ; "Edited 12-Jul-88 17:56 by MASINTER")
    (COND
       [(EQ ONFILETYPE 'UPDATE)
        (AND (OR (NULL NAME)
                 (MEMBER X NAME))
             (COND
                (FLG (SETQ LITERALS (CONS X LITERALS)))
                (T (SETQ VAL (CONS X VAL]
       ((AND (EQ ONFILETYPE 'EDIT)
             FLG)                                            (* ; 
                                        "literals should not be edited as they are on the fileCOMS")
        NIL)
       ((EQ ONFILETYPE 'TYPESOF)
        (AND (COND
                ((LITATOM NAME)
                 (EQ NAME X))
                (T (EQUAL NAME X)))
             (CL:PUSHNEW TYPE VAL)))
       ([OR (EQ NAME T)
            (COND
               ((LITATOM NAME)
                (EQ NAME X))
               (T (EQUAL NAME X]
        (RETFROM (FUNCTION INFILECOMS?)
               T))
       ((NULL NAME)
        (SETQ VAL (CONS X VAL])

(INFILECOMSPROP
  [LAMBDA (AT PROP)                                      (* lmm "25-SEP-81 17:15")
    (COND
       [(EQ ONFILETYPE 'UPDATE)
        (AND [OR (NULL NAME)
                 (find X in NAME suchthat (AND (EQ (CAR X)
                                                               AT)
                                                           (EQ (CADR X)
                                                               PROP]
             (SETQ VAL (CONS (LIST AT PROP)
                             VAL]
       ((OR (EQ NAME T)
            (AND (EQ (CAR NAME)
                     AT)
                 (EQ (CADR NAME)
                     PROP)))
        (RETFROM (FUNCTION INFILECOMS?)
               T))
       ((NULL NAME)
        (SETQ VAL (CONS (LIST AT PROP)
                        VAL])

(IFCPROPS
  [LAMBDA (COM)                                          (* bvm%: " 2-Dec-83 14:24")

(* ;;; "Examine a PROPS com for objects of specified TYPE")

    (SELECTQ TYPE
        (PROPS                                               (* ; 
                                       "the PROPS command can actually take (PROPNAME at1 at2 ...)")
               (INFILEPAIRS (INFILECOMTAIL COM)))
        (PROP                                                (* ; 
                                                "return the atoms which have any properties at all")
              (for PAIR in (INFILECOMTAIL COM) do (for ATNAME
                                                                     inside (CAR PAIR)
                                                                     do (INFILECOMSVAL ATNAME
                                                                                   ))))
        (MACROS                                              (* ; "only MACRO properties")
                (for PAIR in (INFILECOMTAIL COM) do (INFILECOMSMACRO (CAR PAIR)
                                                                           (CDR PAIR))))
        NIL])

(IFCEXPRTYPE
  [LAMBDA (COM FN)                                       (* ; "Edited  6-Apr-87 20:20 by Pavel")

(* ;;; "Recognizes expressions in COM (a P com) that are calls to function FN")

    (for SUBCOM in (INFILECOMTAIL COM)
       when (AND (EQ (CAR SUBCOM)
                         FN)
                     (EQ (CAR (LISTP (CADR SUBCOM)))
                         'QUOTE)) do (INFILECOMSVAL (CADR (CADR SUBCOM))
                                                T])

(IFCPROPSCAN
  [LAMBDA (ATOMS PROPNAMES)                           (* ; "Edited  2-Aug-88 02:20 by masinter")

(* ;;; 
"Recognizes members of ATOMS as being names (atom prop) of type PROPS for any prop in PROPNAMES")

    (for AT in ATOMS WHEN (LITATOM AT) unless [COND
                                                                 [(EQ ONFILETYPE 'UPDATE)
                                                                  (COND
                                                                     (NAME (NOT (ASSOC AT NAME]
                                                                 ((LISTP NAME)
                                                                  (NEQ AT (CAR NAME]
       do (COND
                 ((EQ PROPNAMES 'ALL)
                  (for PROP in (GETPROPLIST AT) by (CDDR PROP)
                     when (NOT (FMEMB PROP SYSPROPS)) collect (INFILECOMSPROP AT PROP)))
                 (T (for PROP inside PROPNAMES do (INFILECOMSPROP AT PROP])

(IFCDECLARE
  [LAMBDA (TAIL WANTDECLARE)                          (* ; "Edited  8-Jun-90 18:11 by teruuchi")
    (PROG ((TAIL TAIL))
      LP  (COND
             ((LISTP TAIL)
              [SELECTQ (CAR TAIL)
                  ((EVAL@LOADWHEN EVAL@COMPILEWHEN COPYWHEN) 
                       [AND WANTDECLARE (INFILECOMSVAL (LIST (CAR TAIL)
                                                                 (CADR TAIL]
                       (SETQ TAIL (CDR TAIL)))
                  (DONTEVAL@LOAD [COND
                                    ((OR (\STKSCAN 'DOFILESLOAD)
                                         (\STKSCAN 'LOAD))
                                                  (* ; "Edited by TT (8-June-90 : for AR#9376) In loading, discard the following contents in DECLARE tag %"DONTEVAL@LOAD%"")
                                     (RETURN))
                                    (WANTDECLARE (INFILECOMSVAL (CAR TAIL])
                  (COMPILERVARS (RETURN))
                  (COND
                     [(FMEMB (CAR TAIL)
                             DECLARETAGSLST)
                      (COND
                         (WANTDECLARE (INFILECOMSVAL (CAR TAIL]
                     (T (INFILECOM (CAR TAIL]
              (SETQ TAIL (CDR TAIL))
              (GO LP])

(INFILEPAIRS
  [LAMBDA (LST)                                          (* lmm " 4-DEC-78 09:51")
    (for LL in LST do (for X inside (CAR LL)
                                     do (for Y inside (CDR LL)
                                               do (INFILECOMSVAL (LIST X Y])

(INFILECOMSMACRO
  [LAMBDA (ATS PROPS)                                    (* lmm "28-SEP-78 18:35")

    (* ;; "this function is used, given a PROP or PROPS command, to tell which MACROS are contained in it.  --- Normally (e.g.  for WHEREIS and FILECOMSLST) it wants to return if the command contains any of the MACROPROPS for the given atom.  However, for UPDATE, it only wants a `hit' if the command contains ALL of the macro properties")

    (for AT inside ATS do (AND [OR (NEQ ONFILETYPE 'UPDATE)
                                               (EVERY (PROPNAMES AT)
                                                      (FUNCTION (LAMBDA (X)
                                                                  (OR (NOT (FMEMB X MACROPROPS))
                                                                      (EQMEMB X PROPS]
                                           [SOME MACROPROPS (FUNCTION (LAMBDA (PROP)
                                                                        (EQMEMB PROP PROPS]
                                           (INFILECOMSVAL AT])
)



(* ;; "adding to a file")

(DEFINEQ

(FILES?
  [LAMBDA NIL                                            (* bvm%: "27-Oct-86 18:14")

(* ;;; 
"Display each file needing dumping, etc.  For files needing dumping, display details of why.")

    (UPDATEFILES)
    (LET (FILES CHANGES PRINTED)
         (for FILE in FILELST when [SETQ CHANGES (fetch TOBEDUMPED
                                                                of (LISTP (fetch FILEPROP
                                                                                 of FILE]
            do (if (NOT PRINTED)
                       then (LISPXPRIN1 "To be dumped:
" T)
                             (SETQ PRINTED T))
                  (LISPXPRIN2 FILE T)
                  (LISPXPRIN1 " ...changes to " T)
                  [for CH in CHANGES bind TB
                     do (COND
                               ((LISTP CH)
                                [COND
                                   (TB (LISPXTAB TB NIL T))
                                   (T (SETQ TB (POSITION T]
                                (LISPXPRIN2 (CAR CH)
                                       T)
                                (FILES?PRINTLST (CDR CH)))
                               (T                            (* ; "old style")
                                  (LISPXPRIN2 CH T)
                                  (LISPXSPACES 1 T]
                  (LISPXTERPRI T))
         (for TYPE FLG in FILEPKGTYPES when (FILES?1 TYPE (AND PRINTED "    plus "))
            do (SETQ FLG T) finally (if FLG
                                                then (OR PRINTED (LISPXPRIN1 "...to be dumped.  "
                                                                            T))
                                                      (ADDTOFILES?)))
         (if (SETQ FILES NOTCOMPILEDFILES)
             then (FILES?PRINTLST FILES "To be compiled: ")
                   (LISPXTERPRI T))
         (if (SETQ FILES NOTLISTEDFILES)
             then (FILES?PRINTLST FILES "To be listed: ")
                   (LISPXTERPRI T))
         (CL:VALUES])

(FILES?1
  [LAMBDA (TYPE FIRST)                                   (* bvm%: "27-Oct-86 18:17")

    (* ;; "If there are changed objects of TYPE, then print them out, preceded by FIRST (if given) plus a descriptive string, and return T.")

    (LET (STR LST)
         (COND
            ([AND (LITATOM TYPE)
                  (SETQ STR (fetch DESCRIPTION of TYPE))
                  (LISTP (SETQ LST (fetch CHANGED of TYPE]
             (AND FIRST (LISPXPRIN1 FIRST T))
             (LISPXPRIN1 '"the " T)
             (LISPXPRIN1 STR T)
             (FILES?PRINTLST LST)
             (LISPXTERPRI T)
             T])

(FILES?PRINTLST
  [LAMBDA (LST STR)                                      (* bvm%: "27-Oct-86 18:15")

    (* ;; "Print elements of LST separated by commas and indenting new lines a bunch.  If MAPRINT had a left margin arg, this would be simpler.")

    (MAPRINT LST T (OR STR ": ")
           NIL ", " [FUNCTION (LAMBDA (STR)
                                (COND
                                   ((> (+ (POSITION T)
                                          (NCHARS STR T T)
                                          3)
                                       (LINELENGTH NIL T))
                                    (LISPXTERPRI T)
                                    (LISPXPRIN1 "         " T)))
                                (LISPXPRIN2 STR T T]
           T])

(ADDTOFILES?
  [LAMBDA (NOASKSTR)                                    (* ; "Edited 10-Aug-2020 21:18 by rmk:")
                                                             (* ; "Edited 21-Aug-91 10:13 by jds")

    (* ;; "ask user about all of the things that need to be dumped, and distribute them to the files that he says")

    (* ;; "RMK: Eliminated literal CR's in the key list.")

    (ERSETQ
     (PROG [BUFS (VARSCHANGES (fetch (FILEPKGTYPE CHANGED) of 'VARS]

      (* ;; "Save VARS list at the beginning, so that changes that might occur from adding things to files (e.g.  changing NILCOMS) will not be processed differently depending on the order of elements in FILEPKGTYPES")

           [COND
              (NOASKSTR (PRIN1 NOASKSTR T))
              (T (DOBE)
                 (SETQ BUFS (READP T))
                 (SELECTQ (ASKUSER DWIMWAIT 'N '("want to say where the above go")
                                 `([Y ,(CONCAT "es" (CHARACTER (CHARCODE EOL]
                                   [N ,(CONCAT "o" (CHARACTER (CHARCODE EOL]
                                   (%] ,(CONCAT "Nowhere" (CHARACTER (CHARCODE EOL)))
                                       EXPLAINSTRING 
                                       "] - nowhere, all items will be marked as dummy
" NOECHOFLG T))
                                 T)
                     (N (RETURN))
                     (%]                                     (* ; "Nowhere")
                         (for TYPE in FILEPKGTYPES
                            do (for NAME in (fetch (FILEPKGTYPE CHANGED)
                                                           of TYPE)
                                      do (ADDTOFILE NAME TYPE NIL)))
                         (RETURN))
                     NIL)                                    (* ; 
                              "if there was type-ahead BEFORE the askuser, then don't allow it now")
                 (COND
                    (BUFS (SETQ BUFS (COND
                                        ((READP T)
                                         (LINBUF)
                                         (SYSBUF)
                                         (SETQ BUFS (CLBUFS NIL T READBUF]
           [for TYPE STR LST in FILEPKGTYPES
              when [AND (SETQ STR (fetch DESCRIPTION of TYPE))
                            (LISTP (SETQ LST (COND
                                                ((EQ TYPE 'VARS)
                                                 VARSCHANGES)
                                                (T (fetch (FILEPKGTYPE CHANGED) of TYPE]
              do
              (printout T "(" STR ")" T)
              (for NAME TEM FILE in LST when NAME
                 do
                 (PROG NIL
                   LP  (PRIN2 NAME T)
                       (SPACES 2 T)

                  (* ;; "if user typed ahead before entering addtofiles??  then dont allow typeahead here, because it will justgobble his earlier typeahead.")

                  (* ;; "SELCHARQ to avoid literal CR")

                       (SELCHARQ (CHCON1 (SETQ TEM (ASKUSER NIL NIL NIL ADDTOFILEKEYLST T)))
                            (%[ (ERSETQ (PROGN (SHOWDEF NAME TYPE T)

                                 (* ;; "the DOBE is so that if the user control-E's after the printout is done but before it appears on the screen that the control-E will merely clear output buffer")

                                               (DOBE)))
                                (GO LP))
                            (%]                              (* ; "Nowhere")
                                (SETQ FILE))
                            (SPACE                           (* ; "No action")
                                   (RETURN))
                            ((LF =) 
                                 (PRINT (OR (SETQ FILE LASTFILE)
                                            'Nowhere)
                                        T))
                            (SETQ FILE TEM))
                       (OR (ERSETQ (PROG (TEM COMSNAME PLACE LISTNAME NEAR)
                                         (SETQ PLACE (WHATIS FILE NIL TYPE))
                                         [COND
                                            ((LITATOM PLACE) (* ; "file name")
                                             (SETQ FILE PLACE)
                                             (OR (ADDTOCOMS (SETQ COMSNAME (FILECOMS FILE))
                                                        NAME TYPE NEAR LISTNAME)
                                                 (ADDNEWCOM COMSNAME NAME TYPE NIL FILE))
                                             (for F in (fetch WHENFILED of TYPE)
                                                do (APPLY* F NAME TYPE FILE))

                                          (* ;; "This isn't factored to the end, cause ADDTOLISTNAME might have to deal with a set of old elements on the listname.")

                                             )
                                            ((EQ (CAR PLACE)
                                                 'Near%:)
                                             (SETQ NEAR (CADR PLACE))
                                             (COND
                                                ([SOME FILELST (FUNCTION (LAMBDA (FL)
                                                                           (ADDTOCOMS
                                                                            (FILECOMS (SETQ FILE
                                                                                           FL))
                                                                            NAME TYPE NEAR LISTNAME]
                                                 (PRINT (LIST 'on FILE)
                                                        T T))
                                                (T (PRINT (LIST (CADR PLACE)
                                                                'not
                                                                'found)
                                                          T T)
                                                   (ERROR!)))
                                             (for F in (fetch WHENFILED of TYPE)
                                                do (APPLY* F NAME TYPE FILE)))
                                            ([OR [UNDONLSETQ (PROGN (SAVESET
                                                                     (SETQ LISTNAME (CAR PLACE))
                                                                     (MERGEINSERT
                                                                      NAME
                                                                      (LISTP (GETTOPVAL LISTNAME))
                                                                      T)
                                                                     T
                                                                     'NOPRINT)
                                                                    (OR (SETQ FILE
                                                                         (CAR (WHEREIS NAME TYPE
                                                                                     FILELST)))
                                                                        (ERROR!]
                                                 (SOME FILELST (FUNCTION (LAMBDA (X)
                                                                           (ADDTOCOMS
                                                                            (FILECOMS (SETQ FILE
                                                                                           X))
                                                                            NAME TYPE NEAR LISTNAME]
                                             (PRIN1 "  value is filed on " T)
                                             (PRINT FILE T T)
                                             (for F in (fetch WHENFILED of TYPE)
                                                do (APPLY* F NAME TYPE FILE))

                                 (* ;; "Only have to notice the single new item here, unlike the case in ADDNEWCOM below, cause other items on the list already belong and were previously noticed")

                                             )
                                            (T (PRIN1 "    put list " T)
                                               (PRIN2 (CAR PLACE)
                                                      T T)
                                               (SETQ FILE
                                                (WHATIS (ASKUSER NIL NIL " on file: "
                                                                   '(("" "" EXPLAINSTRING 
                                                                         "a file name" KEYLST ()))
                                                                   T)
                                                       'FILE))
                                               (SAVESET (CAR PLACE)
                                                      (MERGEINSERT NAME
                                                             (LISTP (GETTOPVAL (CAR PLACE)))
                                                             T)
                                                      T
                                                      'NOPRINT)

                                     (* ;; "Add new item before new command, so that user's new command function can inspect (CAR PLACE) and see all the items involved.")

                                               (ADDNEWCOM (FILECOMS FILE)
                                                      NAME TYPE (CAR PLACE)
                                                      FILE)
                                               (for F in (fetch WHENFILED of TYPE)
                                                  do (for I in (GETTOPVAL (CAR PLACE))
                                                            do (APPLY* F I TYPE FILE]
                                         (AND FILE (ADDFILE FILE))
                                         (SETQ LASTFILE PLACE)))
                           (GO LP]
           (AND BUFS (BKBUFS BUFS))
           (UPDATEFILES])

(ADDTOFILE
  [LAMBDA (NAME TYPE FILE NEAR LISTNAME)                 (* lmm "21-Nov-84 11:43")
                                                             (* ; "adds NAME to the file FILE")
    (PROG (TEM COMSNAME)
          [SETQ TYPE (OR (GETFILEPKGTYPE TYPE NIL T)
                         (COND
                            ((FMEMB TYPE FILELST)
                             (GETFILEPKGTYPE (swap TYPE FILE)))
                            (T (GETFILEPKGTYPE TYPE]
          (SETQ FILE (WHATIS FILE 'FILE))
          (OR (ADDTOCOMS (SETQ COMSNAME (FILECOMS FILE))
                     NAME TYPE NEAR LISTNAME)
              (ADDNEWCOM COMSNAME NAME TYPE NIL FILE))
          (for F in (fetch WHENFILED of TYPE) do (APPLY* F NAME TYPE FILE))
          (AND FILE (NOT (FMEMB FILE FILELST))
               (ADDFILE FILE))
          (RETURN FILE])

(WHATIS
  [LAMBDA (USERINPUT ONLY)                               (* lmm "28-Nov-84 16:49")

    (* ;; "decides whether USERINPUT is a file or a list name --- if ONLY is nil, means either a listname or a filename is accepatble;  if ONLY is LIST then only a listname is acceptable and if ONLY is FILE then only a file name is acceptable")

    (PROG (TEM UCASE)
          (RETURN (COND
                     ((NULL USERINPUT)                       (* ; "nowhere")
                      NIL)
                     [(LISTP USERINPUT)
                      (COND
                         (ONLY (ERROR!))
                         (T (SELECTQ (CAR USERINPUT)
                                ((@ Near%:) 
                                     (CONS 'Near%: (CDR USERINPUT)))
                                (WHATIS (CAR USERINPUT)
                                       'LIST]
                     ([AND (NEQ ONLY 'LIST)
                           (OR (FMEMB (SETQ TEM (SETQ UCASE (U-CASE USERINPUT)))
                                      FILELST)
                               (LISTP (GETTOPVAL (FILECOMS UCASE)))
                               (SETQ TEM (FIXSPELL UCASE NIL FILELST T]
                      TEM)
                     ((AND (NEQ ONLY 'FILE)
                           (LISTP (GETTOPVAL USERINPUT)))
                      (LIST USERINPUT))
                     ((AND (NEQ ONLY 'LIST)
                           (EQ (ASKUSER NIL NIL (LIST "create new file" UCASE)
                                      NIL T)
                               'Y))
                      UCASE)
                     ((AND (NEQ ONLY 'FILE)
                           (EQ (ASKUSER NIL NIL (LIST "create new list" USERINPUT)
                                      NIL T)
                               'Y))
                      (LIST USERINPUT))
                     (T                                      (* ; "none of above")
                        (ERROR!])

(ADDTOCOMS
  [LAMBDA (COMS NAME TYPE NEAR LISTNAME)                 (* rmk%: "10-JUN-82 22:53")

    (* ;; "try to insert NAME of type TYPE command list COMS (either a coms name, or a just a list of coms);  return NIL if unsuccessful.  If LISTNAME is given, then only insert by adding to LISTNAME.  If NEAR is given, only insert near it")

    (COND
       ((NULL COMS)
        NIL)
       [(LITATOM COMS)                                       (* ; 
      "given a name of a command;  rebind COMSNAME to current variable and try to add to its value")
        (OR [PROG ((COMSNAME COMS))
                  (RETURN (ADDTOCOMS (LISTP (GETTOPVAL COMSNAME))
                                 NAME TYPE NEAR (AND (NEQ COMS LISTNAME)
                                                     LISTNAME]
            (AND (EQ COMS LISTNAME)
                 (ADDNEWCOM COMS NAME TYPE]
       (T (SETQ TYPE (GETFILEPKGTYPE TYPE))
          (for TAIL on COMS do (COND
                                              [(LISTP (CAR TAIL))
                                               (COND
                                                  ((ADDTOCOM (CAR TAIL)
                                                          NAME TYPE NEAR LISTNAME)
                                                   (RETURN T]
                                              (T (SELECTQ (CAR TAIL)
                                                     ((EVAL@LOADWHEN EVAL@COMPILEWHEN COPYWHEN) 
                                                          (SETQ TAIL (CDR TAIL)))
                                                     NIL])

(ADDTOCOM
  [LAMBDA (COM NAME TYPE NEAR LISTNAME)                  (* ; "Edited  2-May-87 19:04 by Pavel")
                                                             (* ; 
                        "tries to insert NAME into the prettycom COM;  returns NIL if unsuccessful")
    (PROG (TEM)
          (COND
             ([AND NEAR (NOT (INFILECOMS? NEAR TYPE (LIST COM]
              (RETURN)))
          [COND
             ((SETQ TEM (fetch ADD of (CAR COM)))
              (RETURN (COND
                         ((OR (NULL LISTNAME)
                              (INFILECOMS? LISTNAME 'FILEVARS (LIST COM)))
                          (AND (SETQ TEM (APPLY* TEM COM NAME TYPE NEAR))
                               (MARKASCHANGED COMSNAME 'VARS))
                          TEM]
          (RETURN
           (SELECTQ (CAR COM)
               (FNS (AND (EQ TYPE 'FNS)
                         (ADDTOCOM1 COM NAME NEAR LISTNAME)))
               ((VARS INITVARS) 
                    (COND
                       ((OR (EQ (CAR COM)
                                'VARS)
                            NEAR LISTNAME)                   (* ; 
                                  "Don't stick on INITVARS unless NEAR or LISTNAME says we should.")
                        (SELECTQ TYPE
                            (EXPRESSIONS (COND
                                            ((EQ (CAR NAME)
                                                 'SETQ)
                                             (ADDTOCOM1 COM (CDR NAME)
                                                    NEAR LISTNAME))))
                            (VARS (ADDTOCOM1 COM NAME NEAR LISTNAME))
                            NIL))))
               (COMS (ADDTOCOMS (COND
                                       [(EQ (CADR COM)
                                            '*)
                                        (COND
                                           ((LITATOM (CADDR COM))
                                            (CADDR COM))
                                           (T (RETURN]
                                       (T (CDR COM)))
                            NAME TYPE NEAR LISTNAME))
               (DECLARE%: (AND (OR LISTNAME NEAR)
                               (ADDTOCOMS (COND
                                                 [(EQ (CADR COM)
                                                      '*)
                                                  (COND
                                                     ((LITATOM (CADDR COM))
                                                      (CADDR COM))
                                                     (T (RETURN]
                                                 (T (CDR COM)))
                                      NAME TYPE NEAR LISTNAME)))
               (CL:EVAL-WHEN (AND (OR LISTNAME NEAR)
                                  (ADDTOCOMS (COND
                                                    [(EQ (CL:THIRD COM)
                                                         '*)
                                                     (COND
                                                        ((LITATOM (CL:FOURTH COM))
                                                         (CL:FOURTH COM))
                                                        (T (RETURN]
                                                    (T (CDDR COM)))
                                         NAME TYPE NEAR LISTNAME)))
               ((PROP IFPROP) 
                    (SELECTQ TYPE
                        (PROPS (COND
                                  ((EQ (CADR COM)
                                       (CADR NAME))
                                   (ADDTOCOM1 (CDR COM)
                                          (CAR NAME)
                                          NEAR LISTNAME))
                                  ((AND (EQ (CAR NAME)
                                            (CADDR COM))
                                        (NULL (CDDDR COM)))
                                   [/RPLACA (CDR COM)
                                          (UNION (MKLIST (CDR NAME))
                                                 (MKLIST (CADR COM]
                                   (MARKASCHANGED COMSNAME 'VARS)
                                   T)))
                        (MACROS (COND
                                   ([AND (for PROP inside (CADR COM)
                                            always (EQMEMB PROP MACROPROPS))
                                         (for PROP in MACROPROPS
                                            always (OR (EQMEMB PROP (CADR COM))
                                                           (NOT (GETPROP NAME PROP]

                                    (* ;; "every property in the command is a macro prop and, either this is an IFPROP or else the MACROS are changed")

                                    (ADDTOCOM1 (CDR COM)
                                           NAME NEAR LISTNAME))))
                        NIL))
               ((PROPS ALISTS) 
                    (AND (EQ TYPE (CAR COM))
                         (ADDTOCOM1
                          COM
                          (/NCONC1 (OR [ASSOC (CAR NAME)
                                              (COND
                                                 [(EQ (CADR COM)
                                                      '*)
                                                  (COND
                                                     [(LITATOM (CADDR COM))
                                                      (AND (OR (NULL LISTNAME)
                                                               (EQ (CADDR COM)
                                                                   LISTNAME))
                                                           (GETTOPVAL (CADDR COM]
                                                     (T (RETURN]
                                                 (T (CDR COM]
                                       (LIST (CAR NAME)))
                                 (CADR NAME))
                          NEAR LISTNAME)))
               (P (COND
                     ((AND (EQ TYPE 'EXPRESSIONS)
                           (NEQ (CAR NAME)
                                'SETQ))
                      (ADDTOCOM1 COM NAME NEAR LISTNAME))))
               (AND (EQ (CAR COM)
                        TYPE)
                    (ADDTOCOM1 COM NAME NEAR LISTNAME])

(ADDTOCOM1
  [LAMBDA (COM NAME NEAR LISTNAME)                       (* rmk%: " 3-JAN-82 22:53")
    (COND
       [(EQ (CADR COM)
            '*)                                              (* ; "add to list name")
        (AND [COND
                (LISTNAME (EQ (CADDR COM)
                              LISTNAME))
                (T (LITATOM (CADDR COM]
             (SAVESET (CADDR COM)
                    [PROGN [SETQ COM (LISTP (GETTOPVAL (CADDR COM]
                           (COND
                              ((AND NEAR (SETQ NEAR (MEMBER NEAR COM)))
                               (/RPLACD NEAR (CONS NAME (CDR NEAR)))
                               COM)
                              (T (MERGEINSERT NAME COM T]
                    T
                    'NOPRINT]
       ((NULL LISTNAME)                                      (* ; "add to standard com")
        [AND (NOT (MEMBER NAME (CDR COM)))
             (COND
                [(SETQ NEAR (MEMBER NEAR COM))
                 (/RPLACD NEAR (CONS NAME (CDR NEAR]
                (T (/RPLACD COM (MERGEINSERT NAME (CDR COM]
        (MARKASCHANGED COMSNAME 'VARS)
        T])

(ADDNEWCOM
  [LAMBDA (COMSNAME NAME TYPE LISTNAME FILE)             (* rmk%: " 3-JAN-82 22:53")

    (* ;; "Adds to COMSNAME a new command that will dump NAME as a TYPE on FILE.  --- if LISTNAME is given, then use it as the listname")

    (PROG (NEWCOM OLDCOM TAIL)
          (SETQ NEWCOM (MAKENEWCOM NAME TYPE LISTNAME FILE))
          [COND
             ((NLISTP (SETQ TAIL (GETTOPVAL COMSNAME)))
              (RETURN (SAVESET COMSNAME (LIST NEWCOM)
                             T
                             'NOPRINT]
      LP  [COND
             ((OR (NLISTP (SETQ OLDCOM (CAR TAIL)))
                  (SELECTQ (CAR OLDCOM)
                      ((LOCALVARS SPECVARS BLOCKS) 
                           T)
                      (DECLARE%: (FMEMB 'COMPILERVARS (CDR OLDCOM)))
                      NIL))
              (/ATTACH NEWCOM TAIL))
             ((LISTP (CDR TAIL))
              (SETQ TAIL (CDR TAIL))
              (GO LP))
             (T (/RPLACD TAIL (LIST NEWCOM]
          (MARKASCHANGED COMSNAME 'VARS])

(MAKENEWCOM
  [LAMBDA (NAME TYPE LISTNAME FILE)                      (* ; "Edited  8-Apr-87 14:55 by Pavel")
    (SETQ TYPE (GETFILEPKGTYPE TYPE))
    (PROG (TEM)

     (* ;; "the user function MUST (a) check if FILE = T and not do anything destructive (since this is only for showdef) and (b) if LISTNAME is given, then use it rather than generating a different listname")

          (AND (LISTP NAME)
               (SETQ NAME (COPY NAME)))
          (RETURN (OR (AND (SETQ TEM (fetch NEWCOM of TYPE))
                           (APPLY* TEM NAME TYPE LISTNAME FILE))
                      (SELECTQ TYPE
                          (PROPS [AND (NULL LISTNAME)
                                      (CONS 'PROP (CONS (COND
                                                           ((AND (LISTP (CDR NAME))
                                                                 (NULL (CDDR NAME)))
                                                            (CADR NAME))
                                                           (T (CDR NAME)))
                                                        (OR (LISTP (CAR NAME))
                                                            (LIST (CAR NAME])
                          (EXPRESSIONS [COND
                                          ((EQ (CAR NAME)
                                               'SETQ)
                                           (MAKENEWCOM (CDR NAME)
                                                  'VARS LISTNAME FILE))
                                          (T (CONS 'P (COND
                                                         (LISTNAME (LIST '* LISTNAME))
                                                         (T (LIST NAME])
                          NIL)
                      (DEFAULTMAKENEWCOM NAME TYPE LISTNAME FILE])

(DEFAULTMAKENEWCOM
  [LAMBDA (NAME TYPE LISTNAME FILE)                      (* lmm "20-OCT-82 22:48")
    (COND
       ((NOT (OR (FMEMB TYPE FILEPKGCOMSPLST)
                 (fetch MACRO of TYPE)
                 (fetch GETDEF of TYPE)))
        (ERROR "no defined way to dump or obtain the definition of " (OR (fetch DESCRIPTION
                                                                            of TYPE)
                                                                         TYPE)
               T))
       ((NULL DEFAULTCOMHASFILEFLG)                          (* ; "disable FOOFNS FOOVARS junk")
        (LIST TYPE NAME))
       ((EQ FILE T)                                          (* ; 
                                                           "FILE=T only when called from SHOWDEF")
        (LIST TYPE NAME))
       ([OR LISTNAME (AND FILE (SAVESET (SETQ LISTNAME (FILECOMS FILE TYPE))
                                      (MERGEINSERT NAME (LISTP (GETTOPVAL LISTNAME))
                                             T)
                                      T
                                      'NOPRINT]              (* ; "The check (AND FILE --) is so that it will not bother with making listnames just for deleting items")
        (LIST TYPE '* LISTNAME))
       (T (LIST TYPE NAME])
)

(RPAQ? DEFAULTCOMHASFILEFLG )

(ADDTOVAR MARKASCHANGEDFNS )
(DEFINEQ

(MERGEINSERT
  [LAMBDA (NEW LST ONEFLG)                               (* lmm "30-Jun-86 18:11")

    (* ;; "searches LST to find the most reasonable place to insert NEW.  Does nothing if ONEFLG is T and NEW is already a member of LST")

    (COND
       ((AND ONEFLG (MEMBER NEW LST))
        LST)
       ((LISTP NEW)
        (/NCONC1 LST NEW))
       (T (PROG ((N 0)
                 LST1 PLACE TEM)
                (SETQ LST1 LST)
            LP  

           (* ;; "finds the function with the longest leading common substring.  The idea is that if the list is only paatially sorted, want to insert the new thing in among those function that look like they are related.")

                (COND
                   ((NULL LST1)
                    (GO OUT))
                   ((OR (LISTP (CAR LST1))
                        (SETQ TEM (STRPOS (CAR LST1)
                                         NEW 1 NIL T T)))

                    (* ;; "this takes precedence over even a longer string so that for example in the list (ADDTOFILES? ADDTOFILE), ADDTOFILE1 will be inserted aater ADDTOFILE")

                    (SETQ PLACE LST1)
                    (GO OUT))
                   ((IGREATERP (SETQ TEM (MERGEINSERT1 (CAR LST1)
                                                NEW))
                           N)
                    (SETQ N TEM)
                    (SETQ PLACE LST1)))
                (SETQ LST1 (CDR LST1))
                (GO LP)
            OUT (SETQ TEM (CAR PLACE))
                (OR [SOME (OR PLACE LST)
                          (FUNCTION (LAMBDA (X LST)
                                      (COND
                                         ([OR (ALPHORDER NEW X)
                                              (AND PLACE (NOT (ALPHORDER TEM X]

                                 (* ;; "for example, if the FNS list is something like (...  FOO FOO1 ...) where the ...  may or may not be in order, e.g.  (ZAP FOO FOO1 BLAH), then want to insert FOO2 after FOO1, i.e. before BLAH, even though FOO2 wold not come before BLAH in a sorted list.")

                                          (/ATTACH NEW LST))
                                         (T (SETQ TEM X)
                                            NIL]
                    (SETQ LST (/NCONC1 LST NEW)))
                (RETURN LST])

(MERGEINSERT1
  [LAMBDA (X Y)                                          (* rmk%: "24-MAY-82 00:05")

    (* ;; "value is the number of leading characters of X and Y that agree.")

    (PROG ((N 1)
           C1 C2)
      LP  [COND
             ((OR (NULL (SETQ C1 (NTHCHARCODE X N)))
                  (NULL (SETQ C2 (NTHCHARCODE Y N)))
                  (NEQ C1 C2))
              (RETURN (SUB1 N]
          (SETQ N (ADD1 N))
          (GO LP])
)



(* ;; 
"RMK: Changed INITVARS to VARS, so = addition is a synonym for untypable LF, and also suppress appearance of raw CR and LF in the file"
)


(RPAQ ADDTOFILEKEYLST
      `(("[" "" EXPLAINSTRING "[ -- prettyprint the item to terminal and then ask again" NOECHOFLG T)
        (= "" EXPLAINSTRING "= - same as previous response" NOECHOFLG T)
        (,(CHARACTER (CHARCODE LF))
         "" EXPLAINSTRING "{line-feed} - same as previous response" NOECHOFLG T)
        (" " ,(CONCATCODES (LIST (CHARCODE SPACE)
                                 (CHARCODE EOL)))
             EXPLAINSTRING "{space} - no action" NOECHOFLG T)
        ("]" ,(CONCAT "Nowhere" (CHARACTER (CHARCODE EOL)))
             EXPLAINSTRING
             ,(CONCAT "] - nowhere, item is marked as a dummy" (CHARACTER (CHARCODE EOL)))
             NOECHOFLG T)
        ["(" "List:  (" EXPLAINSTRING "(list name)" NOECHOFLG T KEYLST
             (( "" CONFIRMFG [%) %] ,(CHARACTER (CHARCODE SPACE))
                                  ,(CHARACTER (CHARCODE EOL]
                 RETURN
                 (CDR ANSWER]
        (@ "Near: " EXPLAINSTRING "@ other-item   -- put the item near the other item" NOECHOFLG T 
           KEYLST (( "" CONFIRMFLG [,(CHARACTER (CHARCODE EOL]
                      RETURN ANSWER)))
        [,(CHARACTER (CHARCODE CR))
         "" RETURN ,(CHARACTER (CHARCODE SPACE]
        ("" "File name: " EXPLAINSTRING "a file name" KEYLST ())))

(RPAQQ LASTFILE NIL)



(* ;; "deleting an item from a file")

(DEFINEQ

(DELFROMFILES
  [LAMBDA (NAME TYPE FILES)                              (* rmk%: " 6-MAR-82 13:16")

    (* ;; "Eliminates NAME as an item of type TYPE in COMS.")

    (PROG (COMS)
          (SETQ TYPE (GETFILEPKGTYPE TYPE))
          (RETURN (for FILE inside (OR FILES FILELST)
                     when (PROG1 (DELFROMCOMS (SETQ COMS (FILECOMS FILE))
                                            NAME TYPE)
                                  (COND
                                     ((INFILECOMS? NAME TYPE COMS)
                                      (printout T "(could not delete " NAME " from " FILE ")" T))))
                     collect (for FN in (fetch WHENUNFILED of TYPE)
                                    do (APPLY* FN NAME TYPE FILE))
                           FILE])

(DELFROMCOMS
  [LAMBDA (COMS NAME TYPE)                               (* bvm%: " 1-Oct-86 22:02")

    (* ;; "delete NAME of type TYPE from the coms COMS (either the name of some coms or a list).  Returns T if it does anything")

    (* ;; "If COMS is not a symbol, caller is required to bind COMSNAME to the symbol whose value we are deleting from, for benefit of marking it changed.")

    (COND
       [(LITATOM COMS)
        (LET ((COMSNAME COMS))
             (DECLARE (SPECVARS COMS))
             (AND (LISTP (SETQ COMS (GETTOPVAL COMSNAME)))
                  (DELFROMCOMS COMS NAME TYPE]
       (T (PROG (DONE)
                (SETQ TYPE (GETFILEPKGTYPE TYPE))
            LP  (COND
                   ((NLISTP COMS)
                    (RETURN DONE)))
                [COND
                   ((LISTP (CAR COMS))
                    (SELECTQ (DELFROMCOM (CAR COMS)
                                    NAME TYPE)
                        (ALL (/RPLNODE2 COMS (CDR COMS))
                             (SETQQ DONE ALL)
                             (GO LP))
                        (NIL)
                        (SETQ DONE T)))
                   (T (SELECTQ (CAR COMS)
                          ((EVAL@LOADWHEN EVAL@COMPILEWHEN COPYWHEN) 
                               (SETQ COMS (CDR COMS)))
                          (COND
                             ((AND (EQ TYPE 'VARS)
                                   (EQ NAME (CAR COMS)))
                              (/RPLNODE2 COMS (CDR COMS))
                              (SETQ DONE T)
                              (GO LP]
                (SETQ COMS (CDR COMS))
                (GO LP])

(DELFROMCOM
  [LAMBDA (COM NAME TYPE)                                (* ; "Edited  2-May-87 19:02 by Pavel")
                                                             (* ; "Tries to delete NAME from COM")
    (PROG (TEM VAR NEW)
          (COND
             ((SETQ TEM (fetch DELETE of (CAR COM)))
              (AND (SETQ TEM (APPLY* TEM COM NAME TYPE))
                   (MARKASCHANGED COMSNAME 'VARS))
              (RETURN TEM)))
          (RETURN (SELECTQ (CAR COM)
                      ((DECLARE%: COMS) 
                           (DELFROMCOMS (COND
                                               [(EQ (CADR COM)
                                                    '*)
                                                (COND
                                                   ((LITATOM (CADDR COM))
                                                    (CADDR COM))
                                                   (T (RETURN]
                                               (T (CDR COM)))
                                  NAME TYPE))
                      ((CL:EVAL-WHEN) 
                           (DELFROMCOMS (COND
                                               [(EQ (CL:THIRD COM)
                                                    '*)
                                                (COND
                                                   ((LITATOM (CL:FOURTH COM))
                                                    (CL:FOURTH COM))
                                                   (T (RETURN]
                                               (T (CDDR COM)))
                                  NAME TYPE))
                      ((ALISTS PROPS) 
                           (AND (EQ TYPE (CAR COM))
                                (COND
                                   ((EQ (CADR COM)
                                        '*)
                                    (COND
                                       ([AND (LITATOM (SETQ VAR (CADDR COM)))
                                             (SETQ TEM (ASSOC (CAR NAME)
                                                              (GETTOPVAL VAR)))
                                             (NEQ (CDR TEM)
                                                  (SETQ TEM (REMOVEITEM (CADR NAME)
                                                                   (CDR TEM]
                                        (SAVESET VAR TEM T 'NOPRINT)
                                        T)))
                                   ([AND [CDR (SETQ TEM (ASSOC (CAR NAME)
                                                               (CDR COM]
                                         (NEQ (CDR TEM)
                                              (SETQ NEW (REMOVEITEM (CADR NAME)
                                                               (CDR TEM]
                                    (/RPLACD TEM NEW)
                                    (MARKASCHANGED COMSNAME 'VARS)
                                    T))))
                      (BLOCKS 
                              (* ;; "Remove function name from blocks declarations.  This isn't entirely correctly, since in removing the name from the block variables, it will hit homonyms in globalvars, specvars, etc.")

                              [AND (EQ TYPE 'FNS)
                                   (for BLOCK in (INFILECOMTAIL COM T)
                                      do (AND (MEMB NAME BLOCK)
                                                  (/DREMOVE NAME BLOCK))
                                            (for X in BLOCK
                                               when (AND (LISTP X)
                                                             (MEMB NAME (CDR X)))
                                               do (/RPLACD X (REMOVE NAME (CDR X])
                      ((PROP IFPROP) 
                           [SELECTQ TYPE
                               (PROPS (RETURN (COND
                                                 ((EQ (CADR COM)
                                                      (CADR NAME))
                                                  (DELFROMCOM1 (CDR COM)
                                                         (CAR NAME)))
                                                 ((AND (EQMEMB (CADR NAME)
                                                              (CADR COM))
                                                       [NULL (CDR (SETQ TEM (PRETTYCOM1 (CDR COM]
                                                       (EQ (CAR TEM)
                                                           (CAR NAME)))
                                                  [/RPLACA (CDR COM)
                                                         (REMOVE (CADR NAME)
                                                                (MKLIST (CADR COM]
                                                  (MARKASCHANGED COMSNAME 'VARS)
                                                  T))))
                               (COND
                                  ([for PROP inside (CADR COM)
                                      always (EQ TYPE (GETPROP PROP 'PROPTYPE]
                                   (DELFROMCOM1 (CDR COM)
                                          NAME])
                      ((RECORDS INITRECORDS SYSRECORDS) 
                           (AND (EQ TYPE 'RECORDS)
                                (DELFROMCOM1 COM NAME)))
                      (P (AND (EQ TYPE 'EXPRESSIONS)
                              (DELFROMCOM1 COM NAME)))
                      ((VARS INITVARS) 
                           (AND (EQ TYPE 'VARS)
                                (DELFROMCOM1 COM NAME T)))
                      (AND (EQ TYPE (CAR COM))
                           (DELFROMCOM1 COM NAME])

(DELFROMCOM1
  [LAMBDA (COM NAME FLG)                                 (* rmk%: "10-JUN-82 22:44")

    (* ;; 
  "FLG is passed on to REMOVEITEM, determines whether lists whose CAR is NAME will be removed")

    (LET (TEM VAL)
         (COND
            ((EQ (CADR COM)
                 '*)
             (COND
                ([AND (LITATOM (SETQ TEM (CADDR COM)))
                      (NEQ (SETQ VAL (GETTOPVAL TEM))
                           (SETQ VAL (REMOVEITEM NAME VAL FLG]
                 (SAVESET TEM VAL T 'NOPRINT)
                 T)))
            ((NEQ (CDR COM)
                  (SETQ TEM (REMOVEITEM NAME (CDR COM)
                                   FLG)))
             (/RPLACD COM TEM)
             (MARKASCHANGED COMSNAME 'VARS)
             T])

(REMOVEITEM
  [LAMBDA (X LST FLG)                                    (* ; "Edited 25-May-88 17:52 by drc:")
                                                             (* lmm "10-FEB-78 17:29")

    (* ;; 
  "returns a subset of LST with X deleted;  if FLG is set, also remove elements whose CAR is X")

    (COND
       [[OR (MEMBER X LST)
            (AND FLG (SOME LST (FUNCTION (LAMBDA (Y)
                                           (EQUAL (CAR (LISTP Y))
                                                  X]
        (SUBSET LST (FUNCTION (LAMBDA (Y)
                                (AND (NOT (EQUAL Y X))
                                     (OR (NOT FLG)
                                         (NLISTP Y)
                                         (NOT (EQUAL (CAR Y)
                                                     X]
       (T LST])

(MOVETOFILE
  [LAMBDA (TOFILE NAME TYPE FROMFILE)                    (* rmk%: "18-OCT-79 19:51")
                                                             (* ; "To move items between files")
    (SETQ TYPE (GETFILEPKGTYPE TYPE))
    [COND
       ((OR (EQ TYPE 'FNS)
            FROMFILE)                                        (* ; 
       "FNS definition can reside on file if LOADFNS was done.  This guarantees that it is loaded.")
        (PUTDEF NAME TYPE (GETDEF NAME TYPE FROMFILE '(NOCOPY NODWIM]
    (AND (EQ TYPE 'FNS)
         (MARKASCHANGED NAME TYPE))                      (* ; 
                                                   "FNS won't get dumped unless they are `changed'")
    (DELFROMFILES NAME TYPE FROMFILE)
    (ADDTOFILE NAME TYPE TOFILE])
)

(MOVD? 'DELFROMFILES 'DELFROMFILE NIL T)

(MOVD? 'MOVETOFILE 'MOVEITEM NIL T)

(ADDTOVAR SYSPROPS PROPTYPE VARTYPE)



(* ; "functions for doing things and marking them changed and auxiliary functions")

(DEFINEQ

(SAVEPUT
  [LAMBDA (ATM PROP VAL)                                 (* lmm " 7-May-84 16:56")

    (* ;; "analogous to SAVESET but also marks changed property lists;  LISPXFNS are marked to change PUT and PUTPROP to SAVEPUT")

    [COND
       ((NOT (LITATOM ATM))
        (ERRORX (LIST 14 ATM]
    (PROG ((X (GETPROPLIST ATM))
           X0 TEM OLDFLG)
      LOOP
          (COND
             ((NLISTP X)
              (COND
                 ((AND (NULL X)
                       X0)                                   (* ; 
                "typical case.  property list ran out on an even parity position.  e.g.  (A B C D)")
                  (SETQ TEM (LIST PROP VAL))
                  (AND LISPXHIST (UNDOSAVE (LIST '/PUT-1 ATM TEM)
                                        LISPXHIST))
                  (FRPLACD (CDR X0)
                         TEM)
                  (GO RET)))

              (* ;; "property list was initially NIL or a non-list, or else it ended in a non-list following an even parity position, e.g. (A B . C) fall through and add new property at beginning")

              )
             ((NLISTP (CDR X))

              (* ;; "property list runs out on an odd parity, or ends in an odd list following an odd parity, e.g.  (A B C) or (A B C . D) fall through and add at beginning.")

              )
             [(EQ (CAR X)
                  PROP)
              (SETQ OLDFLG (NEQ (EQUALN (CADR X)
                                       VAL 400)
                                T))                          (* ; "i.e. it probably changed")
              (/RPLACA (CDR X)
                     VAL)
              (COND
                 ((NOT OLDFLG)
                  (GO RET1))
                 (T (OR (EQ DFNFLG T)
                        (LISPXPRINT (LIST 'new PROP 'property 'for ATM)
                               T T))
                    (GO RET]
             (T (SETQ X (CDDR (SETQ X0 X)))
                (GO LOOP)))
          [SETQ TEM (CONS PROP (CONS VAL (GETPROPLIST ATM]
          (SETPROPLIST ATM TEM)
          (AND LISPXHIST (UNDOSAVE (LIST '/PUT-1 ATM TEM)
                                LISPXHIST))
      RET (MARKASCHANGED (LIST ATM PROP)
                 'PROPS
                 (NOT OLDFLG))
      RET1
          (AND ADDSPELLFLG (ADDSPELL ATM 0))
          (RETURN VAL])
)
(DECLARE%: DONTEVAL@LOAD DOCOPY 

(OR (CHANGENAME 'PUTPROPS 'PUTPROP 'SAVEPUT)
    (CHANGENAME 'PUTPROPS '/PUT 'SAVEPUT))
)
(DEFINEQ

(UNMARKASCHANGED
  [LAMBDA (NAME TYPE)                                    (* JonL "24-Jul-84 19:59")

    (* ;; "says to remove NAME from TYPE's changedlst, and also to remove it from any FILE properties.  Value is name if anything is done")

    (PROG (ANYFLG)
          (bind TAIL [CHANGED _ (fetch CHANGED of (SETQ TYPE (GETFILEPKGTYPE
                                                                          TYPE
                                                                          'TYPE]
             while (SETQ TAIL (MEMBER NAME CHANGED)) do (/RPLACA TAIL)
                                                               (SETQ ANYFLG T))
          [for F TAIL PROP TYPEDPROP in FILELST
             when [SETQ TAIL (MEMBER NAME (CDR (SETQ TYPEDPROP
                                                    (ASSOC TYPE (fetch TOBEDUMPED
                                                                   of (SETQ PROP
                                                                           (fetch FILEPROP
                                                                              of F]
             do (SETQ ANYFLG T)
                   (COND
                      ((SETQ TAIL (REMOVE (CAR TAIL)
                                         (CDR TYPEDPROP)))
                       (/RPLACD TYPEDPROP TAIL))
                      (T (/replace TOBEDUMPED of PROP with (REMOVE TYPEDPROP
                                                                              (fetch TOBEDUMPED
                                                                                 of PROP]
          (RETURN (AND ANYFLG NAME])

(PREEDITFN
  [LAMBDA (ATM TYPE EDITCHANGES)                         (* rmk%: "18-FEB-82 21:49")
                                                             (* ; 
                                           "EDITL is advised to call this before editing something")
    (AND FILEPKGFLG (SELECTQ TYPE
                        (PROPLST [AND (OR CLISPARRAY (PROGN (CLISPTRAN (CONS)
                                                                   (CONS))
                                                            CLISPARRAY))
                                      (for X in (GETPROPLIST ATM)
                                         do (OR (NLISTP X)
                                                    (GETHASH X CLISPARRAY)
                                                    (PUTHASH X (CONS (CAR X)
                                                                     (CDR X))
                                                           CLISPARRAY]

                                 (* ;; "note that if CLISPARRAY is disabled that ALL properties of an edited prop list will get marked as changed if any destructive edit is made")

                                 [RESETSAVE NIL (LIST (FUNCTION POSTEDITPROPS)
                                                      EDITCHANGES
                                                      (APPEND (GETPROPLIST ATM])
                        (VARS [COND
                                 ((EQMEMB 'ALIST (GETPROP ATM 'VARTYPE))
                                  [AND (OR CLISPARRAY (PROGN (CLISPTRAN (CONS)
                                                                    (CONS))
                                                             CLISPARRAY))
                                       (for X in (EVALV ATM)
                                          do (OR (NLISTP X)
                                                     (GETHASH X CLISPARRAY)
                                                     (PUTHASH X (CONS (CAR X)
                                                                      (CDR X))
                                                            CLISPARRAY]
                                  (RESETSAVE NIL (LIST (FUNCTION POSTEDITALISTS)
                                                       EDITCHANGES
                                                       (for X in (EVALV ATM)
                                                          collect (CAR X])
                        NIL])

(POSTEDITPROPS
  [LAMBDA (EDITCHANGES OLDPROPS)                         (* rmk%: "18-FEB-82 21:50")
                                                             (* ; "was RESETSAVE'd from PREEDITFN")
    (PROG (OV FOUNDCHANGE)
          (OR FILEPKGFLG (RETURN))
          (COND
             ((CADR EDITCHANGES)
              (for NEWPROP on (GETPROPLIST (CAR EDITCHANGES)) by (CDDR NEWPROP)
                 when (for OLDPROP on OLDPROPS by (CDDR OLDPROP)
                             do (COND
                                       ((EQ (CAR OLDPROP)
                                            (CAR NEWPROP))   (* ; "Found the property")
                                        [AND (EQ (CADR OLDPROP)
                                                 (CADR NEWPROP))
                                             (COND
                                                ((NLISTP (CADR OLDPROP))
                                                             (* ; "value is same")
                                                 (RETURN))
                                                ((AND CLISPARRAY (SETQ OV (GETHASH (CADR NEWPROP)
                                                                                 CLISPARRAY))
                                                      (EQ (CAADR NEWPROP)
                                                          (CAR OV))
                                                      (EQ (CDADR NEWPROP)
                                                          (CDR OV)))
                                                 (PUTHASH (CADR NEWPROP)
                                                        NIL CLISPARRAY)
                                                             (* ; 
                                         "value has been edited (CLISPARRAY translation went away)")
                                                 (RETURN]
                                        (RETURN T))) finally 
                                                             (* ; "didn't find the property")
                                                           (RETURN T))
                 do (MARKASCHANGED (LIST (CAR EDITCHANGES)
                                                 (CAR NEWPROP))
                               'PROPS NIL)
                       (SETQ FOUNDCHANGE T))
              (AND FOUNDCHANGE (RPLACA (CDR EDITCHANGES)
                                      NIL])

(POSTEDITALISTS
  [LAMBDA (EDITCHANGES OLDTOKENS)                        (* rmk%: " 4-JAN-82 10:14")
    (PROG [OV FOUNDCHANGE (NEWENTRIES (GETTOPVAL (CAR EDITCHANGES]
                                                             (* ; 
                                                           "called after an ALIST has been edited")
          (OR FILEPKGFLG (RETURN))
          (COND
             ((CADR EDITCHANGES)
              (for X in OLDTOKENS when (NOT (FASSOC X NEWENTRIES))
                 do (MARKASCHANGED (LIST (CAR EDITCHANGES)
                                                 X)
                               'ALISTS NIL)
                       (SETQ FOUNDCHANGE T))
              [for NEWENTRY in NEWENTRIES
                 do (COND
                           ([AND (LISTP NEWENTRY)
                                 (NOT (AND CLISPARRAY (SETQ OV (GETHASH NEWENTRY CLISPARRAY))
                                           (EQ (CAR NEWENTRY)
                                               (CAR OV))
                                           (EQ (CDR NEWENTRY)
                                               (CDR OV]
                            (PUTHASH NEWENTRY NIL CLISPARRAY)
                            (MARKASCHANGED (LIST (CAR EDITCHANGES)
                                                     (CAR NEWENTRY))
                                   'ALISTS NIL)
                            (SETQ FOUNDCHANGE T]
              (AND FOUNDCHANGE (RPLACA (CDR EDITCHANGES)
                                      NIL])
)

(ADDTOVAR LISPXFNS (PUT . SAVEPUT)
                       (PUTPROP . SAVEPUT))



(* ; "sub-functions for file package commands & types")

(DEFINEQ

(ALISTS.GETDEF
  [LAMBDA (NAME TYPE OPTIONS)                            (* Pavel " 7-Oct-86 17:24")
    (AND (LISTP NAME)
         (CL:SYMBOLP (CAR NAME))
         (LET [(ASSOCIATION (ASSOC (CADR NAME)
                                   (GETTOPVAL (CAR NAME]
              (AND ASSOCIATION (LIST 'ADDTOVAR (CAR NAME)
                                     ASSOCIATION])

(ALISTS.WHENCHANGED
  [LAMBDA (NAME TYPE NEWFLG)                             (* lmm "16-OCT-78 20:02")
                                                             (* ; 
                                          "called by MARKASCHANGED when an ALIST entry has changed")
    (PROG [(VARTYPE (GETPROP (CAR NAME)
                           'VARTYPE]
          (AND (LISTP VARTYPE)
               (EQ (CAR VARTYPE)
                   'ALIST)
               (RETFROM 'MARKASCHANGED (MARKASCHANGED (CADR NAME)
                                              (CADR VARTYPE)
                                              NEWFLG])

(CLEARCLISPARRAY
  [LAMBDA (NAME TYPE REASON)
    (DECLARE (SPECVARS NAME TYPE REASON))            (* lmm "14-Aug-84 15:03")
    (AND CLISPARRAY (MAPHASH CLISPARRAY (COND
                                           [(EQ TYPE 'I.S.OPRS)
                                            (FUNCTION (LAMBDA (TRAN FORM)
                                                        (AND (MEMB NAME FORM)
                                                             (PUTHASH FORM NIL CLISPARRAY]
                                           (T                (* ; "MACRO changed")
                                              (FUNCTION (LAMBDA (TRAN FORM)
                                                          (COND
                                                             ((OR (EQ NAME (CAR FORM))
                                                                  (EQ (CAR (GETPROP (CAR FORM)
                                                                                  'CLISPWORD))
                                                                      'CHANGETRAN))
                                                              (PUTHASH FORM NIL CLISPARRAY])

(EXPRESSIONS.WHENCHANGED
  [LAMBDA (EXPR)                                         (* ; "Edited  6-Apr-87 20:21 by Pavel")
    (SELECTQ (CAR EXPR)
        ((SETQ SETQQ) 
             (UNMARKASCHANGED (CADR EXPR)
                    'VARS))
        ((PROGN PROG) 
             (for X in (CDR EXPR) do (EXPRESSIONS.WHENCHANGED X)))
        NIL])

(MAKEALISTCOMS
  [NLAMBDA X                                             (* rmk%: "14-OCT-83 13:34")

    (* ;; "make command to dump prettydefmacros")

    (LIST
     (CONS 'ADDVARS
           (for PR in X
              join (for ALISTNAME inside (CAR PR)
                          collect (CONS ALISTNAME
                                            (for ATNAME inside (CDR PR) bind ENTRY
                                               when (SETQ ENTRY
                                                         (OR (SASSOC ATNAME (GETTOPVAL ALISTNAME))
                                                             (PROGN (LISPXPRINT (LIST 'no ATNAME
                                                                                      'entry
                                                                                      'on ALISTNAME)
                                                                           T T)
                                                                    NIL))) collect ENTRY])

(MAKEFILESCOMS
  [NLAMBDA FILES                                         (* JonL "12-FEB-83 19:02")

    (* ;; "This scans the command just to warn the user about any errors.  Must match up with the big SELECTQ in FILESLOAD NIL")

    [for FILE in FILES
       do
       (OR
        (LITATOM FILE)
        (while (LISTP FILE)
           do (SELECTQ (CAR (OR (LISTP FILE)
                                    (RETURN)))
                      ((LOADCOMP LOADFROM))
                      (FROM (pop FILE)
                            (if (OR (EQ (CAR FILE)
                                            'VALUEOF)
                                        (if (AND (EQ (CAR FILE)
                                                         'VALUE)
                                                     (EQ (CADR FILE)
                                                         'OF))
                                            then (pop FILE)))
                                then (pop FILE)))
                      ((COMPILED LOAD EXTENSION EXT SOURCE SYMBOLIC IMPORT NOERROR))
                      (OR (FMEMB (CAR FILE)
                                 LOADOPTIONS)
                          (PRINT (CONS (CAR FILE)
                                       '(-- unrecognized FILES option))
                                 T)))
                 (pop FILE]
    (CONS 'FILESLOAD FILES])

(MAKELISPXMACROSCOMS
  [NLAMBDA X                                             (* lmm " 5-SEP-78 23:15")
    (PROG (TEM TEM2)
          (RETURN (CONS [CONS 'ALISTS (SETQ TEM (NCONC (AND [SETQ TEM (SUBSET X
                                                                             (FUNCTION (LAMBDA (Z)
                                                                                         (FASSOC
                                                                                          Z 
                                                                                   LISPXHISTORYMACROS
                                                                                          ]
                                                            (LIST (CONS 'LISPXHISTORYMACROS TEM)))
                                                       (AND [SETQ TEM (SUBSET X
                                                                             (FUNCTION (LAMBDA (Z)
                                                                                         (FASSOC
                                                                                          Z 
                                                                                          LISPXMACROS
                                                                                          ]
                                                            (LIST (CONS 'LISPXMACROS TEM]
                        (SETQ TEM2 (NCONC [AND [SETQ TEM2 (SUBSET X (FUNCTION (LAMBDA (Z)
                                                                                (FMEMB Z LISPXCOMS]
                                               (LIST (LIST 'ADDVARS (CONS 'LISPXCOMS TEM2]
                                          (AND [SETQ TEM2 (SUBSET X (FUNCTION (LAMBDA (Z)
                                                                                (FMEMB Z HISTORYCOMS]
                                               (LIST (LIST 'ADDVARS (CONS 'HISTORYCOMS TEM2])

(MAKEPROPSCOMS
  [NLAMBDA X                                             (* lmm "26-FEB-78 17:10")

    (* ;; "make command to dump PROPS")

    (for PAIR in X collect (CONS 'PROP (CONS (COND
                                                            ((AND (LISTP (CDR PAIR))
                                                                  (NULL (CDDR PAIR)))
                                                             (CADR PAIR))
                                                            (T (CDR PAIR)))
                                                         (OR (LISTP (CAR PAIR))
                                                             (LIST (CAR PAIR])

(MAKEUSERMACROSCOMS
  [NLAMBDA X                                             (* rmk%: " 3-JAN-82 23:20")
    (PROG (TEM)
          [COND
             [X (for Y in X
                   do (OR (FASSOC Y USERMACROS)
                              (FASSOC Y EDITMACROS)
                              (LISPXPRINT (CONS Y '(-- no entry on USERMACROS))
                                     T T]
             (T (SETQ X (INTERSECTION (SETQ X (MAPCAR USERMACROS 'CAR))
                               X]
          (RETURN (LIST (CONS 'ADDVARS
                              (NCONC (for VAR in '(USERMACROS EDITMACROS)
                                        when (SETQ TEM (for Y in (GETTOPVAL VAR)
                                                              when (FMEMB (CAR Y)
                                                                              X) collect Y))
                                        collect (CONS VAR TEM))
                                     (for LST in '(EDITCOMSA EDITCOMSL COMPACTHISTORYCOMS 
                                                                 DONTSAVEHISTORYCOMS)
                                        when [SETQ TEM
                                                  (SUBSET (GETTOPVAL LST)
                                                         (FUNCTION (LAMBDA (Y)
                                                                     (OR (FMEMB Y X)
                                                                         (AND (LISTP Y)
                                                                              (FMEMB (CAR Y)
                                                                                     X]
                                        collect (CONS LST TEM])

(PROPS.WHENCHANGED
  [LAMBDA (NAME TYPE NEWFLG)                             (* lmm " 7-SEP-78 22:08")
    (PROG [(PROPTYPE (GETPROP (CADR NAME)
                            'PROPTYPE]
          (COND
             [PROPTYPE (RETFROM 'MARKASCHANGED (COND
                                                  ((NEQ PROPTYPE 'IGNORE)
                                                   (MARKASCHANGED (CAR NAME)
                                                          PROPTYPE NEWFLG]
             (T (SELECTQ (CADR NAME)
                    (CLISPWORD (CLEARCLISPARRAY (CAR NAME)))
                    NIL])

(FILEGETDEF.LISPXMACROS
  [LAMBDA (NAME TYPE SOURCE OPTIONS)                     (* lmm " 4-Jul-85 15:12")
    (MKPROGN (for X in [LOADFNS NIL SOURCE 'GETDEF '(LAMBDA (FIRST SECOND)
                                                              (AND (EQ FIRST 'ADDTOVAR)
                                                                   (MEMB SECOND '(LISPXMACROS 
                                                                                        LISPXCOMS))
                                                                   T]
                when (SELECTQ (CADR X)
                             (LISPXMACROS                    (* ; 
                      "Rebuild the expressions cause there might be other elements in the ADDTOVAR")
                                          (AND (SETQ X (ASSOC NAME (CDDR X)))
                                               (SETQ X (LIST 'ADDTOVAR 'LISPXMACROS X))))
                             (LISPXCOMS [COND
                                           ((MEMB NAME (CDDR X))
                                            (SETQ X (LIST 'ADDTOVAR 'LISPXCOMS NAME)))
                                           ((SETQ X (ASSOC NAME (CDDR X)))
                                                             (* ; "For synonym pairs")
                                            (SETQ X (LIST 'ADDTOVAR 'LISPXCOMS X])
                             NIL) collect X])

(FILEGETDEF.ALISTS
  [LAMBDA (NAME TYPE SOURCE OPTIONS)                     (* lmm " 4-Jul-85 15:13")
    (for X in [LOADFNS NIL SOURCE 'GETDEF '(LAMBDA (FIRST SECOND)
                                                     (AND (EQ FIRST 'ADDTOVAR)
                                                          (EQ SECOND (CAR NAME]
       when (SETQ X (ASSOC (CADR NAME)
                               (CDDR X))) collect X
       finally (RETURN (COND
                              ($$VAL (CONS 'ADDTOVAR (CONS (CAR NAME)
                                                           $$VAL])

(FILEGETDEF.RECORDS
  [LAMBDA (NAME TYPE SOURCE OPTIONS NOTFOUND)            (* lmm "26-Jun-86 15:56")
    (LET [(VAL (LOADFNS NIL SOURCE 'GETDEF '(LAMBDA (FIRST SECOND)
                                              (AND (MEMB FIRST CLISPRECORDTYPES)
                                                   (OR (EQ SECOND NAME)
                                                       (AND (MEMB SECOND '(%( %[))
                                                            (PROGN (RATOM)
                                                                   (RATOM)
                                                                   (RATOM)
                                                                   (EQ NAME (RATOM]
         (if (EQ (CAAR VAL)
                     'NOT-FOUND%:)
             then NOTFOUND
           elseif (CDR VAL)
             then (CONS 'PROGN VAL)
           else (CAR VAL])

(FILEGETDEF.PROPS
  [LAMBDA (NAME TYPE SOURCE OPTIONS)                     (* lmm " 4-Jul-85 15:13")
    (for X in [LOADFNS NIL SOURCE 'GETDEF '(LAMBDA (FIRST SECOND)
                                                     (AND (EQ FIRST 'PUTPROPS)
                                                          (EQ SECOND (CAR NAME]
       join (for TAIL on (CDDR X) by (CDDR TAIL) when (EQ (CAR TAIL)
                                                                              (CADR NAME))
                   join (LIST (CAR TAIL)
                                  (CADR TAIL)))
       finally (RETURN (COND
                              ($$VAL (CONS 'PUTPROPS (CONS (CAR NAME)
                                                           $$VAL])

(FILEGETDEF.MACROS
  [LAMBDA (NAME TYPE SOURCE OPTIONS)                     (* lmm "28-May-86 09:51")
    (MKPROGN (for X in [LOADFNS NIL SOURCE 'GETDEF '(LAMBDA (FIRST SECOND)
                                                              (AND (FMEMB FIRST '(PUTPROPS DEFMACRO))
                                                                   (EQ SECOND NAME]
                join (if (EQ (CAR X)
                                     'DEFMACRO)
                             then (LIST X)
                           else (for TAIL on (CDDR X) by (CDDR TAIL)
                                       when (FMEMB (CAR TAIL)
                                                       MACROPROPS) collect (LIST 'PUTPROPS
                                                                                     (CADR X)
                                                                                     (CAR TAIL)
                                                                                     (CADR TAIL])

(FILEGETDEF.VARS
  [LAMBDA (NAME TYPE SOURCE OPTIONS)                     (* lmm " 4-Jul-85 15:14")
    (for X in (LOADFNS NIL SOURCE 'GETDEF NAME)
       do (SELECTQ (CAR X)
                  ((RPAQQ SETQQ) 
                       (RETURN (CADDR X)))
                  ((RPAQ SETQ RPAQ?) 
                       (RETURN (EVAL (CADDR X))))
                  NIL) finally (RETURN 'NOBIND])

(FILEGETDEF.FNS
  [LAMBDA (NAME TYPE SOURCE OPTIONS)                     (* bvm%: "29-Aug-86 22:30")
    (LET (MAP ENV)
         (COND
            [(AND (EQMEMB 'FAST OPTIONS)
                  (PROGN (CL:MULTIPLE-VALUE-SETQ (ENV MAP)
                                (GET-ENVIRONMENT-AND-FILEMAP SOURCE))
                         MAP))
             (for PAIR MAPLOC in (CDR MAP) when [SETQ MAPLOC (CADR (ASSOC NAME
                                                                                      (CDDR PAIR]
                do [OR (OPENP SOURCE)
                           (RESETSAVE NIL (LIST 'CLOSEF? (SETQ SOURCE (OPENSTREAM SOURCE 'INPUT
                                                                             'OLD]
                      (SETFILEPTR SOURCE MAPLOC)
                      (RETURN (WITH-READER-ENVIRONMENT ENV
                                  [COND
                                     ((EQMEMB 'ARGLIST OPTIONS)
                                      (RATOM SOURCE)
                                      (READ SOURCE)
                                      (RATOM SOURCE)
                                      (LIST (READ SOURCE)
                                            (READ SOURCE)))
                                     (T (CADR (READ SOURCE])]
            (T (CADR (FASSOC NAME (LOADEFS NAME SOURCE])

(FILEPKGCOMS.PUTDEF
  [LAMBDA (NAME TYPE DEFINITION REASON)                  (* lmm "15-Jul-85 11:29")
    (PROG (COM TYP)
          [SELECTQ (CAR (LISTP DEFINITION))
              (COM (SETQ COM (CDR DEFINITION)))
              (TYPE (SETQ TYP (CDR DEFINITION)))
              (PROGN (SETQ COM (CDR (ASSOC 'COM DEFINITION)))
                     (SETQ TYP (CDR (ASSOC 'TYPE DEFINITION]

     (* ;; "Check properties first, so that we don't smash some and then get an error in a later call to FILEPKGCOM/TYPE")

          (for I in COM by (CDDR I) do (SELECTQ I
                                                           ((ADD DELETE MACRO CONTENTS CONTAIN COM))
                                                           (ERROR I 
                                                                  "not file package command property"
                                                                  )))
                                                             (* ; 
                                                   "COM merely adds to spelling list, for builtins")
          [FILEPKGCOM NAME 'CONTENTS (OR (LISTGET COM 'CONTENTS)
                                             (LISTGET COM 'CONTAIN]
                                                             (* ; "Until CONTAIN is de-documented.")
          (for PROP in '(ADD DELETE MACRO COM) do (FILEPKGCOM NAME PROP
                                                                         (LISTGET COM PROP)))
          [for I in TYP by (CDDR I) do (OR (FMEMB I FILEPKGTYPEPROPS)
                                                           (SELECTQ I
                                                               ((DESCRIPTION TYPE))
                                                               (ERROR I 
                                                             "not file package type/command property"
                                                                      ]
                                                             (* ; 
                                                  "TYPE merely adds to spelling list, for builtins")
          (for PROP in (UNION '(DESCRIPTION TYPE)
                                      FILEPKGTYPEPROPS) do (FILEPKGTYPE NAME PROP
                                                                      (LISTGET TYP PROP])

(FILES.PUTDEF
  [LAMBDA (NAME TYPE DEFINITION REASON)                  (* lmm "15-Jul-85 17:13")
    (PROGN (PUTDEF (FILECOMS NAME)
                  'VARS
                  (CAR DEFINITION)
                  REASON)                                    (* ; "DEFINE THE COMS")
           (ADDFILE NAME)                                (* ; 
                                                           "MAKE SURE IT IS A FILE PACKAGE ENTITY")
           [/replace TOBEDUMPED of (fetch FILEPROP of NAME)
                                          (FILEPKG.MERGECHANGES (CADR DEFINITION)
                                                 (fetch TOBEDUMPED of (fetch FILEPROP
                                                                                 of NAME]
           (OR (fetch FILEDATES of NAME)
               (/replace FILEDATES of NAME with (CADDR DEFINITION])

(VARS.PUTDEF
  [LAMBDA (NAME TYPE DEFINITION REASON)                  (* lmm "29-Jul-85 20:59")
    (/SETTOPVAL NAME DEFINITION T])

(FILES.WHENCHANGED
  [LAMBDA (NAME TYPE REASON)
    (MARKASCHANGED (FILECOMS NAME)
           'VARS REASON])
)

(ADDTOVAR MACROPROPS MACRO BYTEMACRO DMACRO)

(ADDTOVAR SYSPROPS PROPTYPE)

(PUTPROPS I.S.OPR PROPTYPE I.S.OPRS)

(PUTPROPS SUBR PROPTYPE IGNORE)

(PUTPROPS LIST PROPTYPE IGNORE)

(PUTPROPS CODE PROPTYPE IGNORE)

(PUTPROPS FILEDATES PROPTYPE IGNORE)

(PUTPROPS FILE PROPTYPE IGNORE)

(PUTPROPS FILEMAP PROPTYPE IGNORE)

(PUTPROPS EXPR PROPTYPE FNS)

(PUTPROPS VALUE PROPTYPE VARS)

(PUTPROPS COPYRIGHT PROPTYPE FILES)

(PUTPROPS FILETYPE PROPTYPE FILES)

(PUTPROPS BAKTRACELST VARTYPE ALIST)

(PUTPROPS BREAKMACROS VARTYPE ALIST)

(PUTPROPS COMPILETYPELST VARTYPE ALIST)

(PUTPROPS EDITMACROS VARTYPE (ALIST USERMACROS))

(PUTPROPS ERRORTYPELST VARTYPE ALIST)

(PUTPROPS FONTDEFS VARTYPE ALIST)

(PUTPROPS LISPXHISTORYMACROS VARTYPE (ALIST LISPXMACROS))

(PUTPROPS LISPXMACROS VARTYPE (ALIST LISPXMACROS))

(PUTPROPS PRETTYDEFMACROS VARTYPE (ALIST FILEPKGCOMS))

(PUTPROPS PRETTYEQUIVLST VARTYPE ALIST)

(PUTPROPS PRETTYPRINTMACROS VARTYPE ALIST)

(PUTPROPS PRETTYPRINTYPEMACROS VARTYPE ALIST)

(PUTPROPS USERMACROS VARTYPE (ALIST USERMACROS))



(* ; "Define the commands below AFTER the various properties have been established.")


(ADDTOVAR USERMACROS
          (M NIL (MAKE FILE FILE))
          (M (X . Y)
             (E (MARKASCHANGED (COND ((LISTP 'X)
                                      (CAR 'X))
                                     (T 'X))
                       'USERMACROS)
                T)
             (ORIGINAL (M X . Y))))

(ADDTOVAR EDITMACROS
          (M (X . Y)
             (E (MARKASCHANGED (COND ((LISTP 'X)
                                      (CAR 'X))
                                     (T 'X))
                       'USERMACROS)
                T)
             (ORIGINAL (M X . Y))))

(ADDTOVAR EDITCOMSA M)

(ADDTOVAR EDITCOMSL M)



(* ; "GETDEF methods")

(DEFINEQ

(RENAME
  [LAMBDA (OLD NEW TYPES FILES METHOD)               (* JonL "24-Jul-84 20:01")
    (PROG ((TYPES (GETFILEPKGTYPE TYPES 'TYPE NIL OLD)))

     (* ;; "special kludge: change the callers BEFORE if we are changing a field;  this is so the CHANGECALLERS won't get an UNABLE TO DWIMIFY message")

          [for TYPE inside TYPES when (NEQ TYPE 'FIELDS)
             do (COPYDEF OLD NEW TYPE NIL (COND
                                                     ((EQ TYPE 'VARS)
                                                      'NOERROR]
          (CHANGECALLERS OLD NEW TYPES FILES METHOD)
          [for TYPE inside TYPES do (COND
                                                   ((AND (EQ TYPE 'FIELDS)
                                                         (HASDEF OLD 'FIELDS))

                                 (* ;; "The HASDEF test is because the rename might already have been done in EDITFROMFILE in the CHANGECALLERS, if it found a record with the field on a file.  Otherwise, COPYDEF essentially will just do the necessary substitution in the existing record declarations, given that definitions for FIELDS are mutually exclusive.")

                                                    (COPYDEF OLD NEW 'FIELDS))
                                                   (T (DELDEF OLD TYPE]
          (RETURN NEW])

(CHANGECALLERS
  [LAMBDA (OLD NEW AS-TYPES FILES METHOD)            (* ; "Edited  6-Dec-86 01:25 by lmm")
    (PROG ((AS-TYPES (GETFILEPKGTYPE AS-TYPES))
           REL TEM EDITCOMS FNS)
          (OR METHOD (SETQ METHOD DEFAULTRENAMEMETHOD))
          [SETQ EDITCOMS
           (LIST (COND
                    [(OR (EQMEMB 'CAREFUL METHOD)
                         (PROGN (SETQ TEM (TYPESOF OLD NIL AS-TYPES))
                                (printout T "Warning --" OLD " is also defined as " TEM T)))

                     (* ;; "This creates a `command' that searches like EXAM, but interrogates the user about whether to do the Rename.  Y means do it, No means skip, anything else goes into TTY.")

                     (SUBPAIR '(OLD NEW)
                            (LIST OLD NEW)
                            '(BIND (LPQ (F OLD N)
                                            (MARK %#1)
                                            (ORR (1 !0 P)
                                                 NIL)
                                            (MARK %#2)
                                            (COMS (SELECTQ (ASKUSER NIL NIL "   Replace ? "
                                                                  '((Y "Yes
")
                                                                    (N "No
")
                                                                    (%
 "")
                                                                    (%  "")
                                                                    (%
 "")
                                                                    (& ""))
                                                                  NIL NIL '(NOECHOFLG T))
                                                      (Y '(R1 OLD NEW))
                                                      (N NIL)
                                                      'TTY%:))
                                            (MARK %#3)
                                            (IF (EQ (%## (\ %#3))
                                                        (%## (\ %#2)))
                                                   ((\ %#1))
                                                   NIL]
                    (T (LIST 'R OLD NEW]
          (SELECTQ (COND
                      ((AND (EQMEMB 'MASTERSCOPE METHOD)
                            MSDATABASELST
                            (for TYPE inside AS-TYPES
                               do [COND
                                         ((SETQ TEM (SELECTQ TYPE
                                                        ((FNS FUNCTIONS SPECIAL-FORMS OPTIMIZERS) 
                                                             'CALL)
                                                        (MACROS '(CALL DIRECTLY))
                                                        ((VARS VARIABLES) 
                                                             '(USE OR BIND))
                                                        ((RECORDS FIELDS I.S.OPRS) 
                                                             (LIST 'USE 'AS TYPE))
                                                        (RETURN NIL)))
                                          (COND
                                             (REL (SETQ REL (LIST TEM 'OR REL)))
                                             (T (SETQ REL TEM] FINALLY (RETURN REL)))

                       (* ;; "can only use masterscope if (a) we say to, (b) something's been analyzed, and (c) the types the function is are known")

                       'MASTERSCOPE)
                      ((EQMEMB 'EDITCALLERS METHOD)
                       'EDITCALLERS)
                      (T 'SEARCH))
              (MASTERSCOPE (MAPC [SETQ FNS (NCONC [COND
                                                     ((NULL FILES)
                                                      (UPDATEFILES)
                                                      (FILEPKGCHANGES 'FNS]
                                                  (for FILE inside (OR FILES FILELST)
                                                     join (FILEFNSLST FILE]
                                 (FUNCTION UPDATEFN))
                           (SETQ FNS (INTERSECTION (GETRELATION OLD (SETQ REL (PARSERELATION REL))
                                                          T)
                                            FNS)))
              (EDITCALLERS (SETQ FILES (for X inside (OR FILES FILELST)
                                          when (SETQ TEM (EDITCALLERS OLD X T))
                                          collect (PROGN (SETQ FNS (NCONC FNS (CDR TEM)))
                                                             X))))
              (SEARCH (SETQ FNS (for X inside (OR FILES FILELST) join (FILEFNSLST
                                                                                   X))))
              (ERROR "UNRECOGNIZED RENAME METHOD" METHOD))
          (AND (EQMEMB 'FNS AS-TYPES)
               (FMEMB OLD FNS)
               (SETQ FNS (REMOVE OLD FNS)))
          (EDITFROMFILE FNS FILES OLD EDITCOMS)
          [for TYPE inside AS-TYPES
             do (for FILE in (WHEREIS OLD TYPE FILES)
                       do (AND (ADDTOFILE NEW TYPE FILE)
                                   (DELFROMFILES OLD TYPE FILE)
                                   (printout T OLD " changed to " NEW " on " FILE)))
                   (COND
                      ((SETQ TEM (WHEREIS OLD TYPE FILES))
                       (printout T "Couldn't change " OLD " to " NEW " as " TYPE " on " TEM]
          (COND
             (REL (UPDATECHANGED)
                  (COND
                     ((AND (SETQ TEM (GETRELATION OLD REL T))
                           (WHEREIS TEM 'FNS FILES))
                      (printout T "Couldn't find where " OLD " is referenced in " TEM T])
)
(DEFINEQ

(SHOWDEF
  [LAMBDA (NAME TYPE FILE)                              (* ; "Edited 16-Apr-2018 21:35 by rmk:")
                                                             (* ; 
                                                 "prettyprint NAME as it would be dumped as a TYPE")
    (RESETLST
        (PROG (ORIGFLG FNSLST FL PRETTYCOMSLST NEWFILEMAP)
              (DECLARE (SPECVARS . T))
              [AND FILE (NEQ FILE (OUTPUT))
                   (if (SETQ FL (OPENP FILE 'OUTPUT))
                       then (RESETSAVE (OUTPUT FL))
                     else (OUTFILE FILE)
                           (RESETSAVE NIL (LIST (FUNCTION CLOSEF?)
                                                (OUTPUT]
              (PRETTYCOM (MAKENEWCOM NAME TYPE))))])

(COPYDEF
  [LAMBDA (OLD NEW TYPE SOURCE OPTIONS)              (* lmm "14-Aug-84 18:38")
                                                             (* ; "like MOVD, but takes a type.")
    (PROG (TEM DEF)
          (SETQ TYPE (GETFILEPKGTYPE TYPE 'TYPE))
          [SETQ DEF (GETDEF OLD TYPE SOURCE (COND
                                                   ((EQ OPTIONS 'NOCOPY)
                                                    NIL)
                                                   (T (REMOVE 'NOCOPY (MKLIST OPTIONS]
                                                             (* ; 
      "The default is for GETDEF to return a COPY.  Make sure that NOCOPY isn't in options though.")
          (SELECTQ TYPE
              (VARS)
              (FILES [for X in (CAR DEF)
                        do                               (* ; 
                                          "change all the listnames which are of form filenameTYPE")
                              (SELECTQ (CAR X)
                                  ((PROP IFPROP) 
                                       (SETQ X (CDR X)))
                                  NIL)
                              (COND
                                 ((EQ (CADR X)
                                      '*)
                                  (SETQ X (CDDR X))
                                  (COND
                                     ((AND (LITATOM (CAR X))
                                           (SETQ TEM (STRPOS OLD (CAR X)
                                                            1 NIL T T)))
                                      (SAVESET (SETQ TEM (PACK* NEW (SUBATOM (CAR X)
                                                                           TEM -1)))
                                             (COPY (GETTOPVAL (CAR X)))
                                             T)
                                      (FRPLACA X TEM])
              ((PROPS ALISTS) 
                   (OR (EQ (CAR NEW)
                           (CAR OLD))
                       (DSUBST (CAR NEW)
                              (CAR OLD)
                              DEF))
                   (OR (EQ (CADR NEW)
                           (CADR OLD))
                       (DSUBST (CADR NEW)
                              (CADR OLD)
                              DEF)))
              (DSUBST NEW OLD DEF))
          (PUTDEF NEW TYPE DEF)
          (RETURN NEW])

(GETDEF
  [LAMBDA (NAME TYPE SOURCE OPTIONS)                     (* lmm "13-Jul-85 04:10")

    (* ;; "returns the definition of NAME as a TYPE from SOURCE;  cause ERROR if not found unless OPTIONS is NOERROR --- usually returns a copy unless OPTIONS is NOCOPY in which case it tries not to return a copy --- FLG=NOCOPY is currently only used from SAVEDEF where SOURCE is always 0 --- If options is or contains a string, returns that string instead of causing error if no def found.  The caller can figure out what happened, even for types for which NIL/NOBIND might have defs.")

    (PROG (DEF TEM (NOCOPY (EQMEMB 'NOCOPY OPTIONS)))
          (DECLARE (SPECVARS NOCOPY))
          (SELECTQ OPTIONS
              (0 (SETQQ OPTIONS (NOERROR NODWIM))
                 (SETQ NOCOPY T))
              (1 (SETQQ OPTIONS (NOERROR NODWIM FAST ARGLIST))
                 (SETQ NOCOPY T))
              (T (SETQQ OPTIONS SPELL))
              NIL)
          (SETQ TYPE (GETFILEPKGTYPE TYPE 'TYPE))
          (SELECTQ SOURCE
              (0 (SETQQ SOURCE CURRENT))
              (T (SETQQ SOURCE SAVED))
              (NIL (SETQQ SOURCE ?))
              NIL)
          [SELECTQ SOURCE
              (CURRENT (SETQ DEF (GETDEFCURRENT NAME TYPE OPTIONS)))
              (? [LET [(NOERROR (CONS 'NOERROR (MKLIST OPTIONS]
                      (OR (NEQ (SETQ DEF (GETDEFCURRENT NAME TYPE NOERROR))
                               (fetch NULLDEF of TYPE))
                          (NEQ (SETQ DEF (GETDEFSAVED NAME TYPE NOERROR))
                               (fetch NULLDEF of TYPE))
                          (SETQ DEF (GETDEFFROMFILE NAME TYPE 'FILE OPTIONS])
              (SAVED (SETQ DEF (GETDEFSAVED NAME TYPE OPTIONS)))
              (COND
                 ((AND (LISTP SOURCE)
                       (EQ (CAR SOURCE)
                           '=))
                  (SETQ DEF (CDR SOURCE)))
                 (T (SETQ DEF (GETDEFFROMFILE NAME TYPE SOURCE OPTIONS))
                    (SETQ NOCOPY T]
          (OR NOCOPY (SETQ DEF (COPY DEF)))
          (COND
             ((AND (EQ TYPE 'FNS)
                   (NOT (EQMEMB 'NODWIM OPTIONS)))
              (DWIMDEF DEF NAME SOURCE)))
          (RETURN DEF])

(GETDEFCOM
  [LAMBDA (X)                                            (* lmm " 4-Jul-85 13:31")

    (* ;; "In the case where GETDEF doesn't know how to get the definition of something, it resorts to asking the file package to print it out to a file and then reading the file back in.  Actually, though, that is a two stage process where the `command' to print out the datum is first macro expanded and then executed.  --- In some cases, you can tell what would be printed without printing it by looking at the prettydef-macro expansion.  That is what GETDEFCOM does: it takes a list of prettydef commands and returns what Would be printed by those commands (or NIL if it is `too hard' to figure out.) --- A few of the commands are special-cased inside GETDEFCOM0 because they occur frequently or are simple.")
                                                             (* ; "a RETFROM point")
    (for Y in X join (GETDEFCOM0 Y])

(GETDEFCOM0
  [LAMBDA (COM)                                          (* wt%: " 7-FEB-79 23:28")
    (PROG (TEM)
          (RETURN (COND
                     ((SETQ TEM (fetch MACRO of (CAR COM)))
                                                             (* COND ((fetch CONTENTS of
                                                           (CAR COM)) (* ; 
                        "if it has a CONTENTS function, generally means it is not safe to evaluate")
                                                           (RETFROM (QUOTE GETDEFCOM))))
                      (for Y in (SUBPAIR (CAR TEM)
                                               (PRETTYCOM1 COM)
                                               (CDR TEM)) join (GETDEFCOM0 Y)))
                     (T (SELECTQ (CAR COM)
                            (COMS (for X in (PRETTYCOM1 COM) join (GETDEFCOM0 X)))
                            (ADDVARS (for Y in (PRETTYCOM1 COM)
                                        collect (CONS 'ADDTOVAR Y)))
                            (APPENDVARS (for Y in (PRETTYCOM1 COM)
                                           collect (CONS 'APPENDTOVAR Y)))
                            (P (APPEND (PRETTYCOM1 COM)))
                            (RETFROM 'GETDEFCOM])

(GETDEFCURRENT
  [LAMBDA (NAME TYPE OPTIONS)                            (* ; "Edited  2-May-87 19:00 by Pavel")
                                                             (* ; 
                                                           "Gets the current definition--source=0")
    (LET
     (DEF)
     (COND
        ((AND (SETQ DEF (fetch GETDEF of TYPE))
              (NEQ DEF T))

         (* ;; "We assign T to types whose GETDEF is normally handled in the SELECTQ below but whose MACRO is to be defaulted to the PUTDEF/GETDEF in PRETTYCOM.")

         (OR (NEQ (SETQ DEF (APPLY* DEF NAME TYPE OPTIONS))
                  (fetch NULLDEF of TYPE))
             (GETDEFERR NAME TYPE OPTIONS))
         DEF)
        (T
         (OR
          (NEQ
           [SETQ DEF
            (SELECTQ TYPE
                (FNS (AND (LITATOM NAME)
                          (EXPRP (SETQ DEF (VIRGINFN NAME)))
                          DEF))
                (VARS (if (LITATOM NAME)
                          then (GETTOPVAL NAME)
                        else 'NOBIND))
                ((FIELDS RECORDS) 
                     (if (LITATOM NAME)
                         then [SETQ DEF (SELECTQ TYPE
                                                (RECORDS (RECLOOK NAME))
                                                (MKPROGN (FIELDLOOK NAME]
                               (if (EQMEMB 'EDIT OPTIONS)
                                   then (COPY DEF)
                                 else DEF)))
                (FILES                                       (* ; 
              "what is the `definition' of a file?  -- I guess the COMS which say what it contains")
                       [if (LITATOM NAME)
                           then (if (SETQ DEF (GETFILEDEF NAME))
                                        then (UPDATEFILES)
                                              (LIST (LISTP (GETTOPVAL (FILECOMS DEF)))
                                                    (fetch TOBEDUMPED
                                                       of (fetch FILEPROP of DEF))
                                                    (LISTP (fetch FILEDATES of DEF])
                (TEMPLATES (if (AND (LITATOM NAME)
                                        (SETQ DEF (GETTEMPLATE NAME)))
                               then (LIST 'SETTEMPLATE (KWOTE NAME)
                                              (KWOTE DEF))))
                (MACROS [if [AND (LITATOM NAME)
                                     (SETQ DEF (for X on (GETPROPLIST NAME)
                                                  by (CDDR X) when (FMEMB (CAR X)
                                                                                  MACROPROPS)
                                                  join (LIST (CAR X)
                                                                 (CADR X]
                            then `(PUTPROPS ,NAME ,@DEF])
                (EXPRESSIONS (LISTP NAME))
                (PROPS [AND (LISTP NAME)
                            (AND (SETQ DEF (SOME (GETPROPLIST (CAR NAME))
                                                 [FUNCTION (LAMBDA (X)
                                                             (EQ X (CADR NAME]
                                                 (FUNCTION CDDR)))
                                 (LIST 'PUTPROPS (CAR NAME)
                                       (CADR NAME)
                                       (CADR DEF])
                (FILEPKGCOMS [AND (LITATOM NAME)
                                  (PROG ((COM (FILEPKGCOM NAME))
                                         (TYP (FILEPKGTYPE NAME)))
                                        (RETURN (COND
                                                   ((AND COM TYP)
                                                    (LIST (CONS 'COM COM)
                                                          (CONS 'TYPE TYP)))
                                                   (COM (LIST (CONS 'COM COM)))
                                                   (TYP (LIST (CONS 'TYPE TYP])
                (FILEVARS (COND
                             ((AND (LITATOM NAME)
                                   (LISTP (SETQ DEF (GETTOPVAL NAME)))
                                   (WHEREIS NAME 'FILEVARS))
                              DEF)
                             (T 'NOBIND)))
                (LET
                 ((COMS (LIST (MAKENEWCOM NAME TYPE)))
                  FILE)
                 [COND
                    ((NOT (SETQ DEF (GETDEFCOM COMS)))
                     (WITH-READER-ENVIRONMENT *OLD-INTERLISP-READ-ENVIRONMENT*
                         (RESETLST
                             (RESETSAVE PRETTYFLG)
                             (RESETSAVE FONTCHANGEFLG)
                             [RESETSAVE (OUTPUT (SETQ FILE (OPENSTREAM '{NODIRCORE} 'BOTH]
                             (PRETTYDEFCOMS COMS)
                             (SETFILEPTR FILE 0)
                             [SETQ DEF
                              (for X in (READFILE FILE)
                                 join
                                 (SELECTQ (CAR X)
                                     ((*) 
                                          NIL)
                                     (DECLARE%: (for Y on (CDR X)
                                                   unless (SELECTQ (CAR Y)
                                                                  ((COPYWHEN EVAL@LOADWHEN 
                                                                          EVAL@COMPILEWHEN) 
                                                                       (RETURN (LIST Y)))
                                                                  (FMEMB (CAR Y)
                                                                         DECLARETAGSLST))
                                                   collect (CAR Y)))
                                     (CL:EVAL-WHEN (CDDR X))
                                     (PROGN (CDR X))
                                     (LIST X]
                             (SETQ NOCOPY T)))]
                 (MKPROGN DEF]
           (fetch NULLDEF of TYPE))
          (GETDEFERR NAME TYPE OPTIONS))
         DEF])

(GETDEFERR
  [LAMBDA (NAME TYPE OPTIONS MSG)                        (* lmm "13-Jul-85 04:11")
    (DECLARE (USEDFREE NODEF))                           (* ; 
                                       "Message non-null if looking for saved or filed definition.")
    (PROG (TEM)
          (RETURN (COND
                     ((EQMEMB 'NOERROR OPTIONS)              (* ; 
                                               "We want to do the string search in the HASDEF case")
                      (RETURN (fetch NULLDEF of TYPE)))
                     [(AND (NULL MSG)
                           (EQMEMB 'SPELL OPTIONS)
                           (SETQ TEM (HASDEF NAME TYPE NIL (OR (LISTGET1 (LISTP OPTIONS)
                                                                          'SPELL)
                                                                   T)))
                           (NEQ TEM NAME))
                      (RETFROM 'GETDEF (GETDEF TEM TYPE '? (CONS 'NOERROR (MKLIST OPTIONS]
                     (T (for O inside OPTIONS when (STRINGP O)
                           do (RETFROM 'GETDEF O)
                           finally (ERROR NAME (CONS TYPE '(definition not found))
                                              T])

(GETDEFFROMFILE
  [LAMBDA (NAME TYPE SOURCE OPTIONS)                     (* bvm%: " 1-Oct-86 22:10")

    (* ;; "Tries to get definition from source file.  If successful, returns the definition.  Otherwise returns the NULLDEF of the type if OPTIONS contains NOERROR.")

    (DECLARE (SPECVARS NAME))
    (bind (NOTFOUND _ "not found")
           DEF SOURCE TEM2 for FILE inside (COND
                                                      ((EQ SOURCE 'FILE)
                                                       (WHEREIS NAME TYPE T))
                                                      (T SOURCE))
       when
       (AND
        (SETQ SOURCE (FINDFILE FILE T))
        (NEQ
         [SETQ DEF
          (COND
             ((SETQ TEM2 (fetch FILEGETDEF of TYPE))
              (APPLY* TEM2 NAME TYPE SOURCE OPTIONS NOTFOUND))
             (T
              (SELECTQ TYPE
                  (FNS (FILEGETDEF.FNS NAME TYPE SOURCE OPTIONS NOTFOUND))
                  ((VARS FILEVARS) 
                       (FILEGETDEF.VARS NAME TYPE SOURCE OPTIONS NOTFOUND))
                  (MACROS (FILEGETDEF.MACROS NAME TYPE SOURCE OPTIONS NOTFOUND))
                  (PROPS (FILEGETDEF.PROPS NAME TYPE SOURCE OPTIONS NOTFOUND))
                  (RECORDS (FILEGETDEF.RECORDS NAME TYPE SOURCE OPTIONS NOTFOUND))
                  (ALISTS (FILEGETDEF.ALISTS NAME TYPE SOURCE OPTIONS NOTFOUND))
                  (LISPXMACROS (FILEGETDEF.LISPXMACROS NAME TYPE SOURCE OPTIONS NOTFOUND))
                  (COND
                     [(SETQ DEF (GET TYPE 'DEFINERS))
                      (LET [(VAL (LOADFNS NIL SOURCE 'GETDEF
                                        `(LAMBDA (FIRST SECOND)
                                           (AND (MEMB FIRST ',DEF)
                                                (OR (EQ SECOND NAME)
                                                    (AND (MEMB SECOND '(%( %[))
                                                         (PROGN (RATOM)
                                                                (RATOM)
                                                                (RATOM)
                                                                (EQ NAME (RATOM]
                                                             (* ; "ick!  Should use real closure")
                           (if (EQ (CAAR VAL)
                                       'NOT-FOUND)
                               then NOTFOUND
                             elseif (CDR VAL)
                               then (CONS 'PROGN VAL)
                             else (CAR VAL]
                     (T (RESETLST
                            (RESETSAVE (RESETUNDO))
                            [LET (LOAD-VERBOSE-STREAM)
                                 (DECLARE (SPECVARS LOAD-VERBOSE-STREAM))
                                                             (* ; 
                                                     "just in case we get a PRETTYCOMPRINT in here")
                                 (LOADFNS NIL SOURCE 'PROP (COND
                                                              ((LITATOM NAME)
                                                             (* ; 
                                         "If an atom, only bother with expressions that contain it")
                                                               (CONS (LIST '& '|..| NAME)))
                                                              (T T]
                            (GETDEFCURRENT NAME TYPE (CONS 'NOERROR (MKLIST OPTIONS))))]
         NOTFOUND)) do (AND (EQ SOURCE 'FILE)
                                (OR (FMEMB FILE FILELST)
                                    (CL:FORMAT T "(from ~A)~%%" SOURCE))) 
                                                             (* ; 
                                                        "Copying and dwimifying are done in GETDEF")
                          (RETURN DEF) finally (RETURN (GETDEFERR NAME TYPE OPTIONS
                                                                  (APPEND '(no definition on)
                                                                         (MKLIST SOURCE])

(GETDEFSAVED
  [LAMBDA (NAME TYPE OPTIONS)                          (* ; "Edited 11-Aug-87 18:14 by cutting")
                                                             (* ; 
                                                           "Gets the `saved' definition--source=T")
    (SELECTQ TYPE
        (FNS (OR (GETPROP NAME 'EXPR)
                 (GETDEFERR NAME TYPE OPTIONS "no saved definition for")))
        (VARS                                                (* ; 
                               "The value of a variable is never substituted into and never COPIED")
              (for X on (GETPROPLIST NAME) by (CDDR X) when (EQ (CAR X)
                                                                                'VALUE)
                 do (RETURN (CADR X)) finally (RETURN (GETDEFERR NAME TYPE OPTIONS 
                                                                     "no saved value for "))))
        (OR (CDR (SASSOC NAME (FASSOC TYPE SAVEDDEFS)))
            (GETDEFERR NAME TYPE OPTIONS "no saved definition for "])

(PUTDEF
  [LAMBDA (NAME TYPE DEFINITION REASON)                  (* ; "Edited  8-Apr-87 12:52 by Pavel")
    (SETQ TYPE (GETFILEPKGTYPE TYPE 'TYPE))
    (LET ((PUTDEF.METHOD (fetch PUTDEF of TYPE)))
         (COND
            (PUTDEF.METHOD (APPLY* PUTDEF.METHOD NAME TYPE DEFINITION REASON))
            (T (SELECTQ TYPE
                   (FNS (FNS.PUTDEF NAME TYPE DEFINITION REASON))
                   (VARS (VARS.PUTDEF NAME TYPE DEFINITION REASON))
                   (FILES (FILES.PUTDEF NAME TYPE DEFINITION REASON))
                   (FILEPKGCOMS (FILEPKGCOMS.PUTDEF NAME TYPE DEFINITION REASON))
                   (EVAL DEFINITION))
               NAME])

(EDITDEF
  [LAMBDA (NAME TYPE SOURCE EDITCOMS OPTIONS)
    (DECLARE (LOCALVARS . T)
           (SPECVARS SOURCE))                          (* ; "Edited 27-Jul-87 11:04 by cutting")

    (* ;; "lets you edit anything.  Given name and type, call editor on the definition (loading it in from SOURCE if necessary).  If you change it, then the definition gets unsaved.  OPTIONS is passed through from ED to the editor.")

    (SETQ TYPE (GETFILEPKGTYPE TYPE 'TYPE))
    (COND
       ((AND (fetch EDITDEF of TYPE)
             (APPLY* (fetch EDITDEF of TYPE)
                    NAME TYPE SOURCE EDITCOMS OPTIONS)))
       ((AND (EQ TYPE 'FNS)
             (NULL SOURCE))                                  (* ; 
                                "special hack for EDITDEF of FNS because of ability to EDITLOADFNS")
        (EDITDEF.FNS NAME EDITCOMS OPTIONS))
       (T (DEFAULT.EDITDEF NAME TYPE SOURCE EDITCOMS OPTIONS)))
    NAME])

(DEFAULT.EDITDEF
  [LAMBDA (NAME TYPE SOURCE EDITCOMS OPTIONS)            (* ; "Edited 11-Jun-92 16:26 by cat")
    (PROG [(DEF (COND
                   [SOURCE (GETDEF NAME TYPE SOURCE '(EDIT NOCOPY]
                   [(GETDEF NAME TYPE 'CURRENT '(EDIT NOCOPY NOERROR]
                   [(GETDEF NAME TYPE 'SAVED '(EDIT NOCOPY NOERROR]
                   (T (LET ((FILES (WHEREIS NAME TYPE T)))
                           (CL:IF (NULL FILES)
                               (CL:FORMAT T "~S has no ~A definition.~%%" NAME TYPE)
                               [LET [(FILE (PROGN (CL:FORMAT T "~S is contained on~{ ~S~}.~%%" NAME 
                                                         FILES)
                                                  (CL:IF (CL:ENDP (CDR FILES))
                                                      (CL:IF (CL:Y-OR-N-P 
                                                                    "Shall I load this file PROP? ")
                                                             (CAR FILES))
                                                      (ASKUSER NIL NIL 
                                                             "indicate which file to load PROP: "
                                                             (MAKEKEYLST FILES)
                                                             T))]
                                    (CL:WHEN FILE
                                        (LOAD FILE 'PROP)
                                        (GETDEF NAME TYPE '? '(EDIT NOCOPY)))])]

     (* ;; "the EDIT option says to return a COPY if editing this structure isn't enough, and some installation is necessary.")

          (DECLARE (SPECVARS RETRY))

     (* ;; "what is RETRY ???")

          (SETQ RETRY)
          (CL:WHEN DEF
              (EDITE DEF EDITCOMS NAME TYPE [FUNCTION (LAMBDA (NAME DEF TYPE EXITFLG)
                                                             (* ; 
                                             "this function is called when there were changes made")
                                                        (FIXEDITDATE DEF)
                                                             (* ; "fix the edit date first - jtm")
                                                        (PUTDEF NAME TYPE DEF)
                                                        (MARKASCHANGED NAME TYPE 'CHANGED)

                                 (* ;; "woz 1/25/91 MARKASCHANGED must be called after PUTDEF, so sedit's markaschangedfn will see the new definition.  doc for PUTDEF says it calls MARKASCHANGED, but it doesn't always, so do it here.  this sometimes results in MARKASCHANGED getting called twice.")

                                                        ]
                     OPTIONS))])

(EDITDEF.FILES
  [LAMBDA (NAME TYPE SOURCE EDITCOMS OPTIONS)            (* ; "Edited 18-Mar-87 16:07 by woz")
    (EDITDEF (FILECOMS NAME)
           'VARS SOURCE EDITCOMS OPTIONS])

(LOADDEF
  [LAMBDA (NAME TYPE SOURCE)                             (* lmm "13-SEP-78 01:34")
    (PUTDEF NAME TYPE (GETDEF NAME TYPE SOURCE '(NODWIM NOCOPY])

(DWIMDEF
  [LAMBDA (DEF FN SOURCE)                                (* lmm " 6-Jun-86 17:23")
    (AND [OR (EQ DWIMIFYCOMPFLG T)
             (EQ CLISPIFYPRETTYFLG T)
             (EQ (CAR (CADDR DEF))
                 'CLISP%:)
             (SELECTQ SOURCE
                 ((CURRENT SAVED FILE ?) 
                      NIL)
                 (AND (LITATOM SOURCE)
                      (EQMEMB 'CLISP (GETPROP SOURCE 'FILETYPE]
         (LET ((NOSPELLFLG T)
               (DWIMESSGAG T)
               FILEPKGFLG LISPXHIST)
              (DECLARE (CL:SPECIAL NOSPELLFLG DWIMESSGAG FILEPKGFLG LISPXHIST))
              (DWIMIFY0 DEF (COND
                               ((OR (LISTP FN)
                                    (NULL FN))
                                '?)
                               (T FN))
                     NIL DEF])

(DELDEF
  [LAMBDA (NAME TYPE)                                    (* ; "Edited  5-Dec-86 06:20 by lmm")
    (PROG (TEM)
          (SETQ TYPE (GETFILEPKGTYPE TYPE 'TYPE))
      LP  [COND
             ((SETQ TEM (fetch DELDEF of TYPE))
              (APPLY* TEM NAME TYPE))
             (T (SELECTQ TYPE
                    (FNS                                     (* ; 
  "special because GETDEF of a FNS is only its EXPR definition, and DELDEF should only remove such")
                         (AND (EXPRP NAME)
                              (/PUTD NAME))
                         (REMPROP NAME 'EXPR)
                         [AND MSDATABASELST (MASTERSCOPE (LIST 'ERASE (KWOTE NAME])
                    (VARS (/SETTOPVAL NAME 'NOBIND))
                    (FILES [for LST in '(FILELST NOTCOMPILEDFILES NOTLISTEDFILES)
                              do (/SETTOPVAL LST (REMOVE NAME (GETTOPVAL LST]
                           (/replace FILEPROP of NAME with NIL)
                           (/replace FILECHANGES of NAME with NIL)
                           (/replace FILEDATES of NAME with NIL)
                           (FLUSHFILEMAPS NAME))
                    (FILEPKGCOMS (DELFROMLIST 'FILEPKGCOMSPLST NAME)
                                 (DELFROMLIST 'FILEPKGTYPES NAME)
                                 (for FIELD on (FILEPKGCOM NAME)
                                    by (CDDR FIELD) do (FILEPKGCOM NAME (CAR FIELD)
                                                                      NIL))
                                 (for FIELD on (FILEPKGTYPE NAME)
                                    by (CDDR FIELD) do (FILEPKGTYPE NAME (CAR FIELD)
                                                                      NIL))
                                 (/replace ALLFIELDS of NAME with NIL))
                    (ALISTS [AND (LISTP NAME)
                                 (DELFROMLIST (CAR NAME)
                                        (FASSOC (CADR NAME)
                                               (GETTOPVAL (CAR NAME])
                    (MACROS (for P in MACROPROPS do (/REMPROP NAME P)))
                    (PROPS (AND (LISTP NAME)
                                (/REMPROP (CAR NAME)
                                       (CADR NAME))))
                    (LISPXMACROS (DELFROMLIST 'LISPXMACROS (FASSOC NAME LISPXMACROS))
                                 (DELFROMLIST 'LISPXHISTORYMACROS (FASSOC NAME LISPXHISTORYMACROS
                                                                             ))
                                 (DELFROMLIST 'LISPXCOMS NAME)
                                 (DELFROMLIST 'HISTORYCOMS NAME))
                    (PRIN1 (LIST "Note: deleting" TYPE "not implemented yet")
                           T]
          (MARKASCHANGED NAME TYPE 'DELETED)
          (RETURN NAME])

(DELFROMLIST
  [LAMBDA (VAR VAL)                                      (* rmk%: " 3-JAN-82 23:22")
    (AND (FMEMB VAL (GETTOPVAL VAR))
         (/SETTOPVAL VAR (SUBSET (GETTOPVAL VAR)
                                (FUNCTION (LAMBDA (X)
                                            (AND (NEQ X VAL)
                                                 (OR (NLISTP X)
                                                     (NEQ (CDR X)
                                                          VAL])

(HASDEF
  [LAMBDA (NAME TYPE SOURCE SPELLFLG)                    (* ; "Edited 31-Aug-87 18:02 by drc:")

    (* ;; "is NAME the name of something of type TYPE?  NIL SOURCE means 0, not ?")

    (DECLARE (SPECVARS TYPE))
    (COND
       [[OR (LISTP TYPE)
            (LISTP (SETQ TYPE (GETFILEPKGTYPE TYPE 'TYPE](* ; "ignore SPELLFLG")
        (for TY in TYPE do (AND (SETQ $$VAL (HASDEF NAME TY SOURCE))
                                            (RETURN $$VAL]
       (T
        (PROG [(NODEF (fetch NULLDEF of TYPE))
               (OPTS '(NODWIM NOCOPY NOERROR HASDEF]
              (COND
                 ((NULL SOURCE)
                  (SETQQ SOURCE CURRENT)))
              (RETURN
               (SELECTQ SOURCE
                   ((CURRENT 0) 
                        [COND
                           ([OR
                             (MEMBER NAME (fetch CHANGED of TYPE))
                             (LET ((TM (fetch HASDEF of TYPE)))
                                  (COND
                                     (TM (APPLY* TM NAME TYPE SOURCE))
                                     [(NOT (LITATOM NAME))
                                      (SELECTQ TYPE
                                          (PROPS (AND (LISTP NAME)
                                                      (GETPROP (CAR NAME)
                                                             (CADR NAME))))
                                          ((FILES TEMPLATES MACROS LISPXMACROS VARS I.S.OPRS FNS 
                                                  FIELDS USERMACROS FILEVARS FILEPKGCOMS) 
                                               NIL)
                                          (NEQ NODEF (GETDEF NAME TYPE 'CURRENT OPTS]
                                     (T 
                                        (* ;; "symbol definitions")

                                        (SELECTQ TYPE
                                            (FILES (LET ((SYMBOL (CL:FIND-SYMBOL (CONCAT NAME "COMS")
                                                                        "INTERLISP")))
                                                        (AND SYMBOL (BOUNDP SYMBOL))))
                                            (TEMPLATES (GETTEMPLATE NAME))
                                            (MACROS (GETLIS NAME MACROPROPS))
                                            (LISPXMACROS (OR (FASSOC NAME LISPXMACROS)
                                                             (FASSOC NAME LISPXHISTORYMACROS)))
                                            (VARS (AND (NOT (CL:KEYWORDP NAME))
                                                       (NEQ (GETTOPVAL NAME)
                                                            'NOBIND)))
                                            (RECORDS (RECLOOK NAME))
                                            (I.S.OPRS [PROG [(TEM (GETPROP NAME 'CLISPWORD]
                                                            (RETURN (AND TEM (EQ (CAR TEM)
                                                                                 'FORWORD)
                                                                         (GETPROP (CDR TEM)
                                                                                'I.S.OPR])
                                            (FNS (AND (OR (AND (GETD NAME)
                                                               (EXPRP (GETD NAME)))
                                                          (GET NAME 'EXPR))
                                                      (NOT (HASDEF NAME 'FUNCTIONS SOURCE))))
                                            (FIELDS (RECORDFIELD? NAME))
                                            (USERMACROS (FASSOC NAME USERMACROS))
                                            (FILEVARS)
                                            ((PROPS ALISTS DEFS EXPRESSIONS) 
                                                 NIL)
                                            (FILEPKGCOMS (OR (FMEMB NAME FILEPKGCOMSPLST)
                                                             (FMEMB NAME FILEPKGTYPES)))
                                            (NEQ NODEF (GETDEF NAME TYPE 'CURRENT OPTS]
                            (OR NAME T))
                           (SPELLFLG (CL:WHEN (CL:SYMBOLP NAME)
                                         (FIXSPELL NAME NIL
                                                (SELECTQ TYPE
                                                    (FILES FILELST)
                                                    (FILEPKGCOMS (UNION FILEPKGCOMSPLST FILEPKGTYPES))
                                                    (FIELDS (for X in USERRECLST
                                                               join (APPEND (RECORDFIELDNAMES
                                                                                 X))))
                                                    (RECORDS (for X in USERRECLST
                                                                when (LITATOM (CADR X))
                                                                collect (CADR X)))
                                                    (LISPXMACROS LISPXCOMS)
                                                    (I.S.OPRS I.S.OPRLST)
                                                    (USERMACROS (MAPCAR USERMACROS
                                                                       (FUNCTION CAR)))
                                                    USERWORDS)
                                                NIL
                                                (LISTP SPELLFLG)
                                                [FUNCTION (LAMBDA (X)
                                                            (HASDEF X TYPE 'CURRENT]
                                                NIL T))])
                   (? (OR (HASDEF NAME TYPE 'CURRENT)
                          (AND (LITATOM NAME)
                               (HASDEF NAME TYPE 'SAVED SPELLFLG))
                          (WHEREIS NAME TYPE T)))
                   ((SAVED T) 
                        (NEQ NODEF (GETDEF NAME TYPE 'SAVED OPTS)))
                   (NEQ NODEF (GETDEF NAME TYPE SOURCE OPTS])

(GETFILEDEF
  [LAMBDA (FILENAME)                                     (* lmm " 4-Jul-85 13:25")

    (* ;; 
  "returns the official file name from a file name if NAME is FOO, look for FOO.LSP on FILELST")

    (COND
       ((FMEMB FILENAME FILELST)
        FILENAME)
       (T (for FILE in FILELST when (STRPOS FILENAME FILE 1 NIL T)
             do (COND
                       ((EQ (FILENAMEFIELD FILE 'NAME)
                            FILENAME)
                        (RETURN FILE])

(SAVEDEF
  [LAMBDA (NAME TYPE DEFINITION)                         (* JonL "24-Jul-84 20:11")
    (COND
       [(AND (LISTP NAME)
             (NULL TYPE))
        (MAPCAR NAME (FUNCTION (LAMBDA (I)
                                 (SAVEDEF I 'FNS]
       (T [SELECTQ (SETQ TYPE (GETFILEPKGTYPE TYPE 'TYPE))
              (FNS (AND (OR DEFINITION (SETQ DEFINITION (GETD NAME)))
                        (/PUT NAME [SETQ TYPE (COND
                                                 ((SUBRP DEFINITION)
                                                  'SUBR)
                                                 ((EXPRP DEFINITION)
                                                  'EXPR)
                                                 ((CCODEP DEFINITION)
                                                  'CODE)
                                                 (T 'LIST]
                              DEFINITION)))
              (VARS (AND (NEQ (OR DEFINITION (SETQ DEFINITION (GETTOPVAL NAME)))
                              'NOBIND)
                         (EQ DEFINITION (GETTOPVAL NAME))
                         (/PUT NAME (SETQ TYPE 'VALUE)
                               DEFINITION)))
              (AND [OR DEFINITION (SETQ DEFINITION (GETDEF NAME TYPE 'CURRENT
                                                          '(NOCOPY NOERROR NODWIM]
                   (/PUTASSOC NAME DEFINITION (OR (CDR (FASSOC TYPE SAVEDDEFS))
                                                  (CAR (SETQ SAVEDDEFS (CONS (LIST TYPE (CONS NAME))
                                                                             SAVEDDEFS]
          TYPE])

(UNSAVEDEF
  [LAMBDA (NAME TYPE DEF)                                (* lmm " 6-Jun-86 17:24")
    (SELECTQ TYPE
        ((NIL EXPR CODE SUBR LIST) 
             (COND
                [(LISTP NAME)                                (* ; "for compatibility")
                 (MAPCAR NAME (FUNCTION (LAMBDA (X)
                                          (UNSAVED1 X TYPE]
                (T (UNSAVED1 NAME TYPE))))
        (PROG NIL
              [OR DEF (SETQ DEF (GETDEF NAME (SETQ TYPE (GETFILEPKGTYPE TYPE 'TYPE))
                                       'SAVED 0))
                  (RETURN (CONS TYPE '(not found]
              (COND
                 ((NEQ DFNFLG T)
                  (SAVEDEF NAME TYPE)
                  (LET ((DFNFLG T))
                       (PUTDEF NAME TYPE DEF)))
                 (T (PUTDEF NAME TYPE DEF)))
              (RETURN TYPE])

(COMPAREDEFS
  [LAMBDA (NAME TYPE SOURCES)                            (* lmm " 4-Jul-85 14:37")
    (COND
       ((AND (LISTP TYPE)
             (GETFILEPKGTYPE SOURCES NIL T))
        (swap TYPE SOURCES)))
    (SETQ TYPE (GETFILEPKGTYPE TYPE 'TYPE))
    (PROG [DEF DEFS (SRCS (OR SOURCES (WHEREIS NAME TYPE T]
          [COND
             ((NULL SOURCES)
              (AND [OR (MEMBER NAME (FILEPKGCHANGES TYPE))
                       (SOME SRCS (FUNCTION (LAMBDA (FILE)
                                              (MEMBER NAME (CDR (ASSOC TYPE
                                                                       (fetch TOBEDUMPED
                                                                          of (fetch FILEPROP
                                                                                    of FILE]
                   (push SRCS 'CURRENT]
          (SETQ SRCS (for SRC in SRCS
                        when (COND
                                    ((NEQ [SETQ DEF (GETDEF NAME TYPE SRC '(NOERROR NOCOPY]
                                          (fetch NULLDEF of TYPE))
                                     (OR [SOME DEFS (FUNCTION (LAMBDA (DP)
                                                                (COMPARELST DEF (CDR DP]
                                         (push DEFS (CONS SRC DEF)))
                                     T)
                                    (T (PRINTOUT T "No " SRC " definition found for " NAME T)
                                       NIL)) collect SRC))
          (RETURN (COND
                     ((NULL SRCS)
                      '(no definitions found))
                     ((NULL (CDR SRCS))
                      '(only one definition found))
                     ((CDR DEFS)
                      [for S1 on (DREVERSE DEFS)
                         do (for S2 on (CDR S1) do (PRIN2 NAME T T)
                                                                  (AND (CAAR S1)
                                                                       (PRIN1 " from " T)
                                                                       (PRIN2 (CAAR S1)
                                                                              T T))
                                                                  (PRIN1 " and " T)
                                                                  (PRIN2 NAME T T)
                                                                  (COND
                                                                     ((CAAR S2)
                                                                      (PRIN1 " from " T)
                                                                      (PRIN2 (CAAR S2)
                                                                             T T)))
                                                                  (PRIN1 " differ:" T)
                                                                  (TERPRI T)
                                                                  (COMPARELISTS (CDAR S1)
                                                                         (CDAR S2]
                      'DIFFERENT)
                     (T 'SAME])

(COMPARE
  [LAMBDA (NAME1 NAME2 TYPE SOURCE1 SOURCE2)             (* lmm " 5-SEP-78 13:37")
    (PROG [[DEF1 (GETDEF NAME1 TYPE SOURCE1 '(NOERROR NOCOPY]
           (DEF2 (GETDEF NAME2 TYPE SOURCE2 '(NOERROR NOCOPY]
          (COND
             ((COMPARELST DEF1 DEF2)
              (RETURN)))
          (PRIN2 NAME1 T T)
          (COND
             (SOURCE1 (PRIN1 " from " T)
                    (PRIN2 SOURCE1 T T)))
          (PRIN1 " and " T)
          (PRIN2 NAME2 T T)
          (COND
             (SOURCE2 (PRIN1 " from " T)
                    (PRIN2 SOURCE2 T T)))
          (PRIN1 " differ:" T)
          (TERPRI T)
          (COMPARELISTS DEF1 DEF2)
          (RETURN T])

(TYPESOF
  [LAMBDA (NAME POSSIBLETYPES IMPOSSIBLETYPES SOURCE FILTER)
                                                          (* ; "Edited  2-Aug-88 02:08 by masinter")

    (* ;; "return list of all known types which NAME names")

    (LET
     (FOUND SHADOWED)
     (if (FMEMB SOURCE '(? NIL))
         then (CL:FLET [(RSHADOW NIL (for X in FOUND
                                            do (for Y in (CDR (FASSOC X SHADOW-TYPES))
                                                      do (if (FMEMB Y FOUND)
                                                                 then 
                                                             (* ; "shadower found before shadowed")
                                                                       (SETQ FOUND (REMOVE Y FOUND]
                         (LET (NOTFOUND NEWTYPES)
                              (for TYPE inside (OR POSSIBLETYPES FILEPKGTYPES)
                                 when [AND (LITATOM TYPE)
                                               (NOT (EQMEMB TYPE IMPOSSIBLETYPES))
                                               (OR (NULL FILTER)
                                                   (CL:FUNCALL FILTER TYPE))
                                               (NOT (find X in FOUND
                                                       suchthat (FMEMB TYPE
                                                                           (CDR (FASSOC X 
                                                                                       SHADOW-TYPES]
                                 do (if [OR (HASDEF NAME TYPE 'CURRENT)
                                                    (AND (LITATOM NAME)
                                                         (HASDEF NAME TYPE 'SAVED]
                                            then (push FOUND TYPE)
                                          else (push NOTFOUND TYPE)))
                              (RSHADOW)
                              [for FILE in FILELST while NOTFOUND
                                 when [NEQ T (fetch LOADTYPE of (GETPROP FILE
                                                                                   'FILE]
                                 do (if (SETQ NEWTYPES (INFILECOMS? NAME NOTFOUND
                                                                      (FILECOMS FILE)
                                                                      'TYPESOF))
                                            then [bind X for TYPE in NEWTYPES
                                                        when (FMEMB TYPE NOTFOUND)
                                                        do (push FOUND TYPE)
                                                              (if (SETQ X (FASSOC TYPE 
                                                                                     SHADOW-TYPES))
                                                                  then (SETQ NOTFOUND
                                                                            (LDIFFERENCE NOTFOUND X))
                                                                else (SETQ NOTFOUND
                                                                          (REMOVE TYPE NOTFOUND]
                                                  (SETQ NOTFOUND (LDIFFERENCE NOTFOUND NEWTYPES]
                              (if (AND NOTFOUND (GETD 'XCL::HASH-FILE-TYPES-OF))
                                  then (SETQ NEWTYPES (XCL::HASH-FILE-TYPES-OF NAME NOTFOUND))
                                        (SETQ FOUND (UNION NEWTYPES FOUND)))
                              (RSHADOW)
                              FOUND))
       else (for TYPE inside (OR POSSIBLETYPES FILEPKGTYPES)
                   when (AND (LITATOM TYPE)
                                 (NOT (EQMEMB TYPE IMPOSSIBLETYPES))
                                 (OR (NULL FILTER)
                                     (CL:FUNCALL FILTER TYPE))
                                 (HASDEF NAME TYPE SOURCE)) do (push FOUND TYPE)))
     FOUND])
)

(RPAQ? WHEREIS.HASH )



(* ; "Must come after PUTDEF")

(DEFINEQ

(FIXEDITDATE
  [LAMBDA (EXPR)                                         (* ; "Edited 17-Jul-89 11:13 by jtm:")
                                                             (* NOBIND "18-JUL-78 21:11")
                                                             (* Inserts or replaces previous edit 
                                                           date)
    (AND INITIALS (LISTP EXPR)
         (LISTP (CDR EXPR))
         (PROG (E)
               (COND
                  ((FMEMB (CAR EXPR)
                          LAMBDASPLST)

                   (* ;; "insert the edit date after the argument list")

                   (SETQ E (CDDR EXPR)))
                  [(FMEMB (GETPROP (CAR EXPR)
                                 ':DEFINER-FOR)
                          EDITDATE-ARGLIST-DEFINERS)

                   (* ;; "insert the edit date after the argument list")

                   (SETQ E (CDDR EXPR))
                   (while (NOT (CL:LISTP (CAR E))) do (SETQ E (CDR E))
                      finally (SETQ E (CDR E]
                  ((FMEMB (GETPROP (CAR EXPR)
                                 ':DEFINER-FOR)
                          EDITDATE-NAME-DEFINERS)

                   (* ;; "insert the edit date after the name")

                   (SETQ E (CDDR EXPR)))
                  (T (RETURN)))
           RETRY
               [COND
                  ((NLISTP E)
                   (RETURN))
                  ((LISTP (CAR E))
                   (SELECTQ (CAAR E)
                       ((CLISP%: DECLARE) 
                            (SETQ E (CDR E))
                            (GO RETRY))
                       (BREAK1 (COND
                                  ((EQ (CAR (CADAR E))
                                       'PROGN)
                                   (SETQ E (CDR (CADAR E)))
                                   (GO RETRY))))
                       (ADV-PROG                             (* No easy way to mark cleanly the 
                                                           date of an advised function)
                                 (RETURN))
                       (COND
                          ((AND (EQ (CAAR E)
                                    COMMENTFLG)
                                (EQ (CADAR E)
                                    'DECLARATIONS%:))
                           (SETQ E (CDR E))
                           (GO RETRY]
               (COND
                  ([for TAIL on E while (AND (LISTP (CAR TAIL))
                                                         (EQ (CAAR TAIL)
                                                             COMMENTFLG))
                      do (COND
                                ((AND (LISTP (CDR TAIL))
                                      (EDITDATE? (CAR TAIL)))
                                 (/RPLACA TAIL (EDITDATE (CAR TAIL)
                                                      INITIALS))
                                 (RETURN T]                  (* scans the comments for a 
                                                           timestamp for this user.)
                   NIL)
                  (T                                         (* attach the new timestamp at the 
                                                           beginning of the comments.)
                     (/ATTACH (EDITDATE NIL INITIALS)
                            E)))
               (RETURN EXPR])

(EDITDATE?
  [LAMBDA (COMMENT)                                      (* ; "Edited 11-Jun-92 16:44 by cat")
                                                             (* ; "Edited 13-Jul-89 09:30 by jtm:")
                                                             (* lmm "21-Mar-85 08:45")

         (* Tests to see if a given common is in fact an edit date --
       this has to be general enough to recognize the most comment comment forms while 
       specific enough to not recognize things that are not edit dates)

    (DECLARE (LOCALVARS . T))                            (* jtm%: changed test so that it 
                                                           creates one timestamp per user.)
    (COND
       [(LISTP COMMENT)
        (COND
           ((EQ (CAR COMMENT)
                COMMENTFLG)
            [COND
               (NIL (NULL NORMALCOMMENTSFLG)
                    (SETQ COMMENT (GETCOMMENT COMMENT]
            (COND
               ([OR (NOT (LISTP (CDR COMMENT)))
                    (NOT (LISTP (CDDR COMMENT]
                NIL)
               [(EQ (CADR COMMENT)
                    ';)                                      (* ; "CL style comment")
                (STRPOS INITIALS (CADDR COMMENT)
                       (IMINUS (NCHARS INITIALS]
               (T                                            (* ; "IL style comment")
                  (EQ (CADR COMMENT)
                      INITIALS]
       ((STRINGP COMMENT])
)



(* ; "Edit date support for all kinds of definers (from PARC 6/10/92)")


(RPAQQ EDITDATE-ARGLIST-DEFINERS (FUNCTIONS TYPES))

(RPAQQ EDITDATE-NAME-DEFINERS (STRUCTURES VARIABLES))
(DECLARE%: DOEVAL@COMPILE DONTCOPY

(GLOBALVARS EDITDATE-ARGLIST-DEFINERS EDITDATE-NAME-DEFINERS)
)



(* ;; 
"how to dump FILEPKGCOMS. The SPLST must be initialized to contain FILEPKGCOMS in order to get started."
)

(DEFINEQ

(FILEPKGCOM
  [LAMBDA N                                              (* JonL "10-Jul-84 19:38")
    (PROG (TEM (COM (ARG N 1)))
          (RETURN (COND
                     [(EQ N 1)
                      (OR (for FIELD in '(MACRO CONTENTS DELETE ADD)
                             when (SETQ TEM (FILEPKGCOM COM FIELD))
                             join (LIST FIELD TEM))
                          (AND (FMEMB COM (GETTOPVAL 'FILEPKGCOMSPLST))
                               (LIST 'COM T))
                          (AND [SETQ TEM (CDR (ASSOC COM (GETTOPVAL 'FILEPKGCOMSPLST]
                               (LIST 'COM TEM]
                     ((EQ N 2)
                      (SELECTQ (ARG N 2)
                          (ADD (fetch ADD of COM))
                          (DELETE (fetch DELETE of COM))
                          (MACRO (fetch MACRO of COM))
                          ((CONTENTS CONTAIN) 
                               [OR (fetch (FILEPKGCOM CONTENTS) of COM)
                                   (COND
                                      ((SETQ COM (fetch (FILEPKGCOM PRETTYTYPE) of COM))
                                       (COND
                                          ((EQ COM 'NILL)
                                           COM)
                                          [(EQ (CAR COM)
                                               'LAMBDA)
                                           (CONS (CAR COM)
                                                 (CONS [CONS (CAADR COM)
                                                             (CONS (OR (CADDR (CADR COM))
                                                                       'NAME)
                                                                   (CONS (CADR (CADR COM))
                                                                         (CDDDR (CADR COM]
                                                       (SUBST 'INFILECOMTAIL 'PRETTYCOM1 (CDDR COM]
                                          (T (LIST 'LAMBDA '(COM TYPE NAME)
                                                   (CONS COM '(COM TYPE NAME])
                          (COM [OR (AND (FMEMB COM (GETTOPVAL 'FILEPKGCOMSPLST))
                                        T)
                                   (CDR (ASSOC COM (GETTOPVAL 'FILEPKGCOMSPLST])
                          (ERROR (ARG N 2)
                                 "not file package command property")))
                     (T [for I TEM2 from 2 to N by 2
                           do (SETQ TEM (ARG N (ADD1 I)))
                                 (COND
                                    [(EQ (ARG N I)
                                         'COM)
                                     (SELECTQ TEM
                                         (NIL)
                                         (T [OR (FMEMB COM (GETTOPVAL 'FILEPKGCOMSPLST))
                                                (/SETTOPVAL 'FILEPKGCOMSPLST
                                                       (CONS COM (GETTOPVAL 'FILEPKGCOMSPLST])
                                         (COND
                                            ([SETQ TEM2 (ASSOC COM (GETTOPVAL 'FILEPKGCOMSPLST]
                                             (/RPLACD TEM2 TEM))
                                            (T (/SETTOPVAL 'FILEPKGCOMSPLST
                                                      (CONS (CONS COM TEM)
                                                            (GETTOPVAL 'FILEPKGCOMSPLST]
                                    (T [AND TEM (OR (FMEMB COM (GETTOPVAL 'FILEPKGCOMSPLST))
                                                    (/SETTOPVAL 'FILEPKGCOMSPLST
                                                           (CONS COM (GETTOPVAL 'FILEPKGCOMSPLST]
                                       (SELECTQ (ARG N I)
                                           (ADD (/replace (FILEPKGCOM ADD) of COM
                                                   with TEM))
                                           (DELETE (/replace (FILEPKGCOM DELETE) of
                                                                                         COM
                                                      with TEM))
                                           (MACRO (/replace (FILEPKGCOM MACRO) of COM
                                                     with TEM))
                                           ((CONTENTS CONTAIN) 
                                                (/replace (FILEPKGCOM CONTENTS) of COM
                                                   with TEM))
                                           (ERROR (ARG N I)
                                                  "not file package command property"]
                        (MARKASCHANGED COM 'FILEPKGCOMS])

(FILEPKGTYPE
  [LAMBDA N                                              (* lmm " 5-Jul-85 09:07")
    (PROG ((TYPE (ARG N 1))
           TEM)
          (RETURN (COND
                     [(EQ N 1)
                      (OR (for FIELD in (UNION '(DESCRIPTION)
                                                       FILEPKGTYPEPROPS)
                             when (SETQ TEM (FILEPKGTYPE TYPE FIELD))
                             join (LIST FIELD TEM))
                          (AND (FMEMB TYPE (GETTOPVAL 'FILEPKGTYPES))
                               (LIST 'TYPE T))
                          (AND [SETQ TEM (CDR (ASSOC TYPE (GETTOPVAL 'FILEPKGTYPES]
                               (LIST 'TYPE TEM]
                     [(EQ N 2)
                      (if (FMEMB (ARG N 2)
                                     FILEPKGTYPEPROPS)
                          then (GETPROP TYPE (ARG N 2))
                        else (SELECTQ (ARG N 2)
                                     (DESCRIPTION (fetch DESCRIPTION of TYPE))
                                     (TYPE [OR (AND (FMEMB TYPE (GETTOPVAL 'FILEPKGTYPES))
                                                    T)
                                               (CDR (ASSOC TYPE (GETTOPVAL 'FILEPKGTYPES])
                                     (ERROR (ARG N 2)
                                            "not file package type property"]
                     (T [for I TEM2 from 2 to N by 2
                           do (SETQ TEM (ARG N (ADD1 I)))
                                 (COND
                                    [(EQ (ARG N I)
                                         'TYPE)
                                     (SELECTQ TEM
                                         (NIL)
                                         (T (OR (FMEMB TYPE FILEPKGTYPES)
                                                (/SETTOPVAL 'FILEPKGTYPES (CONS TYPE FILEPKGTYPES))))
                                         (COND
                                            ((SETQ TEM2 (ASSOC TYPE FILEPKGTYPES))
                                             (/RPLACD TEM2 TEM))
                                            (T (/SETTOPVAL 'FILEPKGTYPES (CONS (CONS TYPE TEM)
                                                                               FILEPKGTYPES]
                                    (T [AND TEM (OR (FMEMB TYPE FILEPKGTYPES)
                                                    (/SETTOPVAL 'FILEPKGTYPES (CONS TYPE FILEPKGTYPES
                                                                                    ]
                                       (if (FMEMB (ARG N I)
                                                      FILEPKGTYPEPROPS)
                                           then (if TEM
                                                        then (/PUTPROP TYPE (ARG N I)
                                                                        TEM)
                                                      else (/REMPROP TYPE (ARG N I)))
                                         else (SELECTQ (ARG N I)
                                                      (DESCRIPTION (/replace DESCRIPTION
                                                                      of TYPE with TEM))
                                                      (ERROR (ARG N I)
                                                             "not file package command/type property"
                                                             ]
                        (MARKASCHANGED TYPE 'FILEPKGCOMS])
)

(PUTPROPS FILEPKGCOM ARGNAMES (COMMANDNAME (KEYWORDS%: MACRO ADD DELETE CONTENTS)))

(ADDTOVAR FILEPKGCOMSPLST FILEPKGCOMS)

(ADDTOVAR FILEPKGTYPES FILEPKGCOMS)
(PUTDEF (QUOTE FILEPKGCOMS) (QUOTE FILEPKGCOMS) '([COM CONTENTS (LAMBDA (COM NAME TYPE)
                                                                       (* Revert to NILL when no 
                                                                          longer coercing 
                                                                          PRETTYDEFMACROS to 
                                                                          FILEPKGCOMS)
                                                                       (AND (EQ TYPE 'FILEPKGCOMS)
                                                                            (INFILECOMTAIL COM]
                                                  (TYPE DESCRIPTION "file package commands/types" 
                                                        GETDEF T PUTDEF FILEPKGCOMS.PUTDEF)))
(PUTDEF (QUOTE ALISTS) (QUOTE FILEPKGCOMS) '([COM MACRO (X (COMS * (MAKEALISTCOMS . X]
                                             (TYPE DESCRIPTION "alist entries" GETDEF ALISTS.GETDEF 
                                                   WHENCHANGED (ALISTS.WHENCHANGED))))
(PUTDEF (QUOTE DEFS) (QUOTE FILEPKGCOMS) '[(COM MACRO (X (COMS . X])
(PUTDEF (QUOTE EDITMACROS) (QUOTE FILEPKGCOMS) '((TYPE TYPE USERMACROS)))
(PUTDEF (QUOTE EXPRESSIONS) (QUOTE FILEPKGCOMS) '((TYPE DESCRIPTION "expressions" WHENCHANGED (
                                                                              EXPRESSIONS.WHENCHANGED
                                                                                               )
                                                        EDITDEF NILL)))
(PUTDEF (QUOTE FIELDS) (QUOTE FILEPKGCOMS) '((TYPE EDITDEF NILL)))
(PUTDEF (QUOTE FILEPKGTYPES) (QUOTE FILEPKGCOMS) '((COM COM FILEPKGCOMS)
                                                   (TYPE TYPE FILEPKGCOMS)))
(PUTDEF (QUOTE FILES) (QUOTE FILEPKGCOMS) '([COM MACRO [X (P * (CONS (MAKEFILESCOMS . X]
                                                 CONTENTS
                                                 (LAMBDA (COM NAME TYPE)
                                                        (AND (EQ TYPE 'FILES)
                                                             (SUBSET (INFILECOMTAIL COM)
                                                                    (FUNCTION LITATOM]
                                            (TYPE PUTDEF FILES.PUTDEF WHENCHANGED (FILES.WHENCHANGED)
                                                  EDITDEF EDITDEF.FILES)))
(PUTDEF (QUOTE FILEVARS) (QUOTE FILEPKGCOMS) '((COM MACRO (X (VARS . X)))
                                               (TYPE NULLDEF NOBIND EDITDEF NILL)))
(PUTDEF (QUOTE FNS) (QUOTE FILEPKGCOMS) '((COM MACRO
                                               (X [E (MAPC 'X (FUNCTION (LAMBDA
                                                                         (FN)
                                                                         (AND (GETPROP FN
                                                                                     'FUNCTIONS)
                                                                              (CL:WARN 
                                                                      "~A has a FUNCTIONS definition"
                                                                                     FN]
                                                  (ORIGINAL (FNS . X)))
                                               CONTENTS NILL)
                                          (TYPE DESCRIPTION "functions" PUTDEF FNS.PUTDEF CANFILEDEF
                                                T)))
(PUTDEF (QUOTE INITRECORDS) (QUOTE FILEPKGCOMS) '[(COM MACRO (X (P * (RECORDALLOCATIONS . X)))
                                                       CONTENTS
                                                       (LAMBDA (COM NAME TYPE ONFILETYPE)
                                                              (AND (NULL ONFILETYPE)
                                                                   (EQ TYPE 'RECORDS)
                                                                   (INFILECOMTAIL COM])
(PUTDEF (QUOTE INITVARS) (QUOTE FILEPKGCOMS) '((COM COM T)))
(PUTDEF (QUOTE LISPXCOMS) (QUOTE FILEPKGCOMS) '((TYPE TYPE LISPXMACROS)))
(PUTDEF (QUOTE LISPXMACROS) (QUOTE FILEPKGCOMS) '((COM MACRO (X (COMS * (MAKELISPXMACROSCOMS . X)))
                                                       CONTENTS NILL)
                                                  (TYPE DESCRIPTION "LISPX commands")))
(PUTDEF (QUOTE MACROS) (QUOTE FILEPKGCOMS) '((COM
                                              MACRO
                                              [X
                                               (DECLARE%:
                                                EVAL@COMPILE
                                                (P
                                                 *
                                                 (MAPCAR
                                                  'X
                                                  (FUNCTION
                                                   (LAMBDA (Y)
                                                          (LET [[FNDEF (GETDEF Y 'FUNCTIONS
                                                                              'CURRENT
                                                                              '(NOCOPY NOERROR]
                                                                (MACDEF (GETDEF Y 'MACROS
                                                                               'CURRENT
                                                                               '(NOCOPY NOERROR]
                                                               (COND
                                                                ((AND FNDEF (EQ (CAR FNDEF)
                                                                                'DEFMACRO))
                                                                 (CL:WARN 
                           "Need to change MACROS to FUNCTIONS for writing out Common Lisp macro ~S."
                                                                        FNDEF)
                                                                 (LIST 'PROGN FNDEF MACDEF))
                                                                (T (OR MACDEF (CL:CERROR 
                                                          "Go ahead and finish writing out the file."
                                                                                     
                                                                       "No MACROS definition for ~A."
                                                                                     Y)
                                                                       (GETDEF Y 'MACROS 'CURRENT]
                                              CONTENTS NILL)
                                             (TYPE DESCRIPTION "Interlisp macros" GETDEF 
                                                   MACROS.GETDEF WHENCHANGED (CLEARCLISPARRAY))))
(PUTDEF (QUOTE PRETTYDEFMACROS) (QUOTE FILEPKGCOMS) '((COM COM FILEPKGCOMS)))
(PUTDEF (QUOTE PROPS) (QUOTE FILEPKGCOMS) '([COM MACRO (X (COMS * (MAKEPROPSCOMS . X]
                                            (TYPE DESCRIPTION "property lists" WHENCHANGED (
                                                                                    PROPS.WHENCHANGED
                                                                                            ))))
(PUTDEF (QUOTE RECORDS) (QUOTE FILEPKGCOMS) '[[COM
                                               MACRO
                                               (X [E (MAPC 'X (FUNCTION (LAMBDA
                                                                         (RECORD)
                                                                         (AND (GETPROP RECORD
                                                                                     'STRUCTURES)
                                                                              (CL:WARN 
                                                                     "~A has a STRUCTURES definition"
                                                                                     RECORD]
                                                  (E (RECORDECLARATIONS . X))
                                                  (INITRECORDS . X))
                                               CONTENTS
                                               (LAMBDA (COM NAME TYPE ONFILETYPE)
                                                      (AND (EQ TYPE 'FIELDS)
                                                           (NULL ONFILETYPE)
                                                           (MAPCONC (INFILECOMTAIL COM)
                                                                  (FUNCTION (LAMBDA
                                                                             (X)
                                                                             (APPEND (
                                                                                     RECORDFIELDNAMES
                                                                                      X]
                                              (TYPE DESCRIPTION "records" DELDEF
                                                    (LAMBDA (X)
                                                           (/SETTOPVAL 'USERRECLST
                                                                  (REMOVE (RECLOOK X)
                                                                         USERRECLST])
(PUTDEF (QUOTE OLDRECORDS) (QUOTE FILEPKGCOMS) '((COM COM T)))
(PUTDEF (QUOTE SYSRECORDS) (QUOTE FILEPKGCOMS) '[(COM MACRO (X (E (SAVEONSYSRECLST . X)))
                                                      CONTENTS
                                                      (LAMBDA (COM NAME TYPE ONFILETYPE)
                                                             (AND (NULL ONFILETYPE)
                                                                  (EQ TYPE 'RECORDS)
                                                                  (INFILECOMTAIL COM])
(PUTDEF (QUOTE USERMACROS) (QUOTE FILEPKGCOMS) '((COM MACRO (X (COMS * (MAKEUSERMACROSCOMS . X)))
                                                      CONTENTS NILL)
                                                 (TYPE DESCRIPTION "edit macros")))
(PUTDEF (QUOTE VARS) (QUOTE FILEPKGCOMS) '((COM MACRO
                                                (X [E (MAPC 'X (FUNCTION (LAMBDA
                                                                          (VAR)
                                                                          (AND (GETPROP VAR
                                                                                      'VARIABLES)
                                                                               (CL:WARN 
                                                                 "~A also has a VARIABLES definition"
                                                                                      VAR]
                                                   (ORIGINAL (VARS . X)))
                                                CONTENTS NILL)
                                           (TYPE DESCRIPTION "variables" NULLDEF NOBIND PUTDEF 
                                                 VARS.PUTDEF)))
(PUTDEF (QUOTE *) (QUOTE FILEPKGCOMS) '((COM CONTENTS NILL)))
(PUTDEF (QUOTE CONSTANTS) (QUOTE FILEPKGCOMS) '[(COM MACRO (X (DECLARE%: EVAL@COMPILE (VARS . X)
                                                                     (P (CONSTANTS . X])

(ADDTOVAR SHADOW-TYPES (FUNCTIONS FNS)
                           (VARIABLES VARS CONSTANTS))

(RPAQ? SAVEDDEFS )



(* ; "EDITCALLERS")

(DEFINEQ

(FINDCALLERS
  [LAMBDA (ATOMS FILES)                                  (* lmm "30-SEP-78 01:36")
    (PROG ((X (EDITCALLERS ATOMS FILES T)))
          (RETURN (NCONC (DREVERSE (CDR X))
                         (AND (CAR X)
                              (LIST (CONS (COND
                                             ((CDR X)
                                              '"plus other places on")
                                             (T 'on))
                                          (CAR X])

(EDITCALLERS
  [LAMBDA (ATOMS FILES COMS)                            (* ; "Edited  8-Aug-2020 17:32 by rmk:")
                                                             (* bvm%: " 3-Nov-86 17:30")
    (LET
     (FFILEPOSPATTERNS FNS OTHERSFILES EDITPATTERN)
     [SETQ EDITPATTERN (EDITFPAT (CONS '*ANY* (SETQ ATOMS (MKLIST ATOMS]
     [for FILE in (COND
                             ((NULL FILES)
                              FILELST)
                             ((EQ FILES T)
                              (UNION SYSFILES FILELST))
                             ((LISTP FILES)
                              FILES)
                             (T (LIST FILES)))
        do
        (RESETLST
            [PROG (PATTERNS CA RDTBL MAP NOMAPFLG FULL FILESTREAM PRINTFLG ENV DUMMY TOP I)
                  (OR (SETQ FULL (FINDFILE FILE))
                      (RETURN (LISPXPRINT (CONS FILE '(not found))
                                     T T)))
                  [RESETSAVE NIL (LIST (FUNCTION CLOSEF?)
                                       (SETQ FILESTREAM (OPENSTREAM FULL 'INPUT]
                  (CL:FORMAT T "~A: " (SETQ FULL (FULLNAME FILESTREAM)))
                  (CL:MULTIPLE-VALUE-SETQ (ENV MAP TOP)
                         (OR (GET-ENVIRONMENT-AND-FILEMAP FULL)
                             (\PARSE-FILE-HEADER FILESTREAM)))

             (* ;; "Get reader environment of file.  The call to GET-ENVIRONMENT-AND-FILEMAP with the filename will get cached info if it exists.  Otherwise, read the top of the file")

                  (SETQ RDTBL (AND ENV (fetch (READER-ENVIRONMENT REREADTABLE) of ENV)))
                  (SETQ CA (SEPRCASE DWIMIFYCOMPFLG RDTBL))
                  [OR (SETQ PATTERNS (CDR (ASSOC RDTBL FFILEPOSPATTERNS)))
                      (push FFILEPOSPATTERNS
                             (CONS RDTBL (SETQ PATTERNS
                                          (for ATOM in ATOMS
                                             collect (CONCAT
                                                          (COND
                                                             ((EQ (CHCON1 ATOM)
                                                                  (CHARCODE ESCAPE))
                                                              (SETQ ATOM (SUBSTRING ATOM 2 -1))
                                                              "")
                                                             (T " "))
                                                          [COND
                                                             ((SETQ I (STRPOS ' ATOM))
                                                              (SUBSTRING ATOM 1 (SUB1 I)))
                                                             ((STRINGP ATOM))
                                                             (T (LET ((*PACKAGE* (CL:SYMBOL-PACKAGE
                                                                                  ATOM)))
                                                             (* ; 
                                                           "Keep MKSTRING from putting a prefix on")
                                                                     (MKSTRING ATOM T RDTBL]
                                                          (COND
                                                             (I "")
                                                             (T " "]
                  (for PATTERN in PATTERNS
                     do
                     (SETFILEPTR FILESTREAM (SETQ I (OR TOP 0)))
                     (while (SETQ I (FFILEPOS PATTERN FILESTREAM I NIL NIL T CA))
                        do
                        (COND
                           ((NULL PRINTFLG)                  (* ; 
                                   "cause the printing of the filename to be saved on history list")
                            (SETQ PRINTFLG T)
                            (LISPXPRIN2 FULL T T T)

                            (* ;; "print with NODOFLG=T means just to record the printing;  the idea is that only those files in which something is found will be remembered on the history list")

                            (LISPXPRIN1 ": " T NIL T)))
                        [OR
                         [AND (NEQ MAP T)
                              (for X in (CDR (OR MAP [PROGN (SETFILEPTR FILESTREAM 0)
                                                                    (SETQ MAP (OR (GETFILEMAP 
                                                                                         FILESTREAM)
                                                                                  (LOADFILEMAP 
                                                                                         FILESTREAM]
                                                         (PROGN 
                                                             (* ; "file has no filemap")
                                                                (SETQ MAP (SETQ NOMAPFLG T))
                                                                (LISPXPRIN1 " no filemap!" T)
                                                                NIL)))
                                 thereis (AND (ILESSP (CAR X)
                                                         I)
                                                  (IGREATERP (CADR X)
                                                         I)
                                                  (for Z in (CDDR X)
                                                     thereis (COND
                                                                    ((AND (ILESSP (CADR Z)
                                                                                 I)
                                                                          (IGREATERP (CDDR Z)
                                                                                 I))
                                                                     [COND
                                                                        ((NOT (FMEMB (CAR Z)
                                                                                     FNS))
                                                                         (SETQ FNS
                                                                          (CONS (LISPXPRIN2
                                                                                 (CAR Z)
                                                                                 T T)
                                                                                FNS]
                                                                     (SETQ I (CDDR Z))
                                                                     T]
                         (PROGN (LISPXPRIN2 I T T)
                                (OR (FMEMB FILE OTHERSFILES)
                                    (SETQ OTHERSFILES (CONS FILE OTHERSFILES]
                        (LISPXSPACES 1 T)))
                  (COND
                     (PRINTFLG (LISPXTERPRI T))
                     (T (TERPRI T)))
                  (COND
                     ((NEQ COMS T)
                      (COND
                         ((OR FNS OTHERSFILES)
                          (EDITFROMFILE (OR NOMAPFLG (DREVERSE FNS))
                                 FULL EDITPATTERN COMS (NULL OTHERSFILES))
                          (SETQ OTHERSFILES)
                          (SETQ FNS])]
     (COND
        ((EQ COMS T)
         (CONS OTHERSFILES FNS])

(EDITFROMFILE
  [LAMBDA (FNS FILES EDITPATTERN EDITCOMS ONLYTYPES)     (* rmk%: "14-Mar-85 21:51")
    (RESETVARS [(EDITLOADFNSFLG (COND
                                   ((EQ EDITLOADFNSFLG T)
                                    '(T . NO))
                                   (T EDITLOADFNSFLG]
               (PROG NIL
                     [OR EDITCOMS (SETQ EDITCOMS (LIST (LIST 'EXAM EDITPATTERN]
                     (AND
                      (SETQ FILES (for FILE inside (OR FILES FILELST)
                                     when (OR (AND EDITLOADFNSFLG (FMEMB (ROOTFILENAME FILE)
                                                                             FILELST))
                                                  (COND
                                                     ((EQ 'Y (ASKUSER DWIMWAIT 'Y (LIST "load from" 
                                                                                        FILE)
                                                                    NIL T))
                                                      (LOADFROM FILE FNS 'ALLPROP)
                                                      T))) collect FILE))
                      (for TYPE in [COND
                                              ((LISTP ONLYTYPES))
                                              (ONLYTYPES '(FNS))
                                              (T 

                                 (* ;; "Move FNS to the front.  This means that all the fns will be dwimified and edited before anything else (like a rename of fields) is done.")

                                                 (CONS 'FNS (REMOVE 'FNS FILEPKGTYPES]
                         when (AND (LITATOM TYPE)
                                       (NEQ (fetch EDITDEF of TYPE)
                                            'NILL))
                         do
                         (PROG (SEEN)
                               (for FILE inside FILES
                                  do
                                  (for NAME in [COND
                                                          ((AND (EQ TYPE 'FNS)
                                                                (NEQ FNS T))
                                                             (* ; 
                                                    "for this type, we are given the list of items")
                                                           (PROG1 FNS (SETQ FNS NIL)))
                                                          (T (* ; 
                             "only want the values of `TYPE' which are not part of some other type")
                                                             (FILECOMSLST FILE TYPE 'EDIT]
                                     unless (MEMBER NAME SEEN)
                                     do
                                     (ERSETQ
                                      (PROG [(DEF (OR (GETDEF NAME TYPE 'CURRENT
                                                             '(NOCOPY NOERROR))
                                                      (GETDEF NAME TYPE 'SAVED
                                                             '(NOCOPY NOERROR]

                                 (* ;; "If definition has been loaded, it may have been editted.  Work on that explicitly instead of bringing in a file definition to smash the users previous changes.  Perhaps we should query the user about this, but until the interaction is worked out, it is better to avoid trashing his in core edits, given that he can always get the file definition from permanent storage with LOADFNS.  --- We might also be more discriminating about this: if the user specified a root file name, then he means the definition from the definition group, not the physical file.  But ...  rmk")

                                            (COND
                                               ((OR (AND (EQ TYPE 'FNS)
                                                         (NEQ FNS T))
                                                    (AND (LISTP DEF)
                                                         (LOOKIN DEF EDITPATTERN)))
                                                (COND
                                                   ((NULL SEEN)
                                                    (LISPXPRIN1 "editing the " T)
                                                    (LISPXPRIN1 (OR (fetch DESCRIPTION
                                                                       of TYPE)
                                                                    TYPE)
                                                           T)
                                                    (LISPXSPACES 1 T)))
                                                (SETQ SEEN (CONS NAME SEEN))
                                                (LISPXPRIN2 NAME T T)
                                                (LISPXPRIN1 ":
" T)
                                                (COND
                                                   ((NOT
                                                     (ERSETQ (EDITDEF
                                                              NAME TYPE
                                                              (OR (AND DEF (CONS '= DEF))
                                                                  FILE)
                                                              EDITCOMS)))
                                                    (LISPXPRIN1 "failed" T)))
                                                (LISPXTERPRI T])

(FINDATS
  [LAMBDA (X L)                                          (* lmm "11-FEB-78 16:03")
    (COND
       ((NLISTP X)
        (FMEMB X L))
       (T (OR (FINDATS (CAR X)
                     L)
              (FINDATS (CDR X)
                     L])

(LOOKIN
  [LAMBDA (X PAT)                                        (* lmm "11-MAR-78 14:20")
    (COND
       ([AND (EQ (CAR PAT)
                 '*ANY*)
             (EVERY (CDR PAT)
                    (FUNCTION (LAMBDA (X)
                                (AND (LITATOM X)
                                     (NOT (STRPOS ' X]
        (FINDATS X (CDR PAT)))
       (T (EDITFINDP X PAT T])
)
(DEFINEQ

(SEPRCASE
  [LAMBDA (CLFLG RDTBL)                                  (* bvm%: "24-Oct-86 18:16")

    (* ;; "make a case array for FFILEPOS in which all of the seprs, breaks, and (possibly) clisp chars are all equivalent.  Based on FILERDTBL, but others are close with respect to breaks and seprs")

    (OR RDTBL (SETQ RDTBL FILERDTBL))
    (OR [ARRAYP (CDR (ASSOC RDTBL (COND
                                     (CLFLG CLISPCASEARRAYS)
                                     (T SEPRCASEARRAYS]
        (LET ((CA (CASEARRAY)))
             [if (READTABLEPROP RDTBL 'CASEINSENSITIVE)
                 then                                    (* ; "map upper into lower case")
                       (for I from (CHARCODE A) to (CHARCODE Z)
                          do (SETCASEARRAY CA I (+ I (- (CHARCODE a)
                                                            (CHARCODE A]
             (for X in (NCONC (AND CLFLG (for Y in CLISPCHARS
                                                    collect (CHCON1 Y)))
                                      (GETSEPR RDTBL)
                                      (GETBRK RDTBL)) do (SETCASEARRAY CA X 0))
             (if *PACKAGE*
                 then                                    (* ; 
                               "symbols qualified with package prefix will otherwise be unfindable")
                       (SETCASEARRAY CA (READTABLEPROP RDTBL 'PACKAGECHAR)
                              0))
             (SETQ CA (CONS RDTBL CA))
             (COND
                (CLFLG (push CLISPCASEARRAYS CA))
                (T (push SEPRCASEARRAYS CA)))
             (CDR CA])
)

(RPAQ? DEFAULTRENAMEMETHOD '(EDITCALLERS CAREFUL))

(RPAQ? SEPRCASEARRAYS )

(RPAQ? CLISPCASEARRAYS )

(MOVD? 'INFILEP 'FINDFILE)

                                                             (* ; "or else from SPELLFILE")
(DECLARE%: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY

(BLOCK%: EDITFROMFILE EDITFROMFILE LOOKIN (GLOBALVARS EDITLOADFNSFLG)
       (NOLINKFNS LOADFROM))
)
(DECLARE%: DOEVAL@COMPILE DONTCOPY

(GLOBALVARS SYSFILES CLISPCASEARRAYS SEPRCASEARRAYS CLISPCHARS)
)



(* ; "EXPORT")

(DEFINEQ

(IMPORTFILE
  [LAMBDA (FILE RETURNFLG)                               (* lmm " 6-Jun-86 17:43")
    (RESETLST
        [RESETSAVE NIL (LIST 'CLOSEF (SETQ FILE (OPENSTREAM FILE 'INPUT]
        (RESETSAVE (INPUT FILE))                             (* ; 
                "Reset INPUT in case some form on the file's action is to read the next expression")
        (NCONC [COND
                  ((EQ RETURNFLG T)                          (* ; 
                                           "Just creating EXPORTS.ALL, don't side-effect the world")
                   (IMPORTFILESCAN FILE RETURNFLG))
                  (T (LET (FILEPKGFLG DFNFLG)
                          (IMPORTFILESCAN FILE RETURNFLG]
               (IMPORTEVAL [LIST 'PUTPROP (KWOTE (ROOTFILENAME FILE))
                                     ''IMPORTDATE
                                     (LIST 'IDATE (GETFILEINFO FILE 'CREATIONDATE]
                      RETURNFLG)))])

(IMPORTEVAL
  [LAMBDA (FORM RETURNFLG)                               (* ; "Edited  2-May-87 18:57 by Pavel")

    (* ;; "Ignore DONTEVAL@LOAD'S --- If RETURNFLG is on, return list of forms")

    (AND (LISTP FORM)
         (SELECTQ (CAR FORM)
             (DECLARE%: (FOR Z IN (CDR FORM) JOIN (IMPORTEVAL Z RETURNFLG)))
             (CL:EVAL-WHEN (FOR Z IN (CDDR FORM) JOIN (IMPORTEVAL Z RETURNFLG)))
             (/DECLAREDATATYPE                               (* ; 
                    "Ignore datatype initializations -- we only need the record declaration itself")
                  NIL)
             (PROGN                                          (* ; "default: eval and/or return it")
                    (AND (NEQ RETURNFLG T)
                         (EVAL FORM))
                    (AND RETURNFLG (LIST FORM])

(IMPORTFILESCAN
  [LAMBDA (FILE RETURNFLG)                               (* bvm%: "24-Oct-86 19:31")
    (WITH-READER-ENVIRONMENT (GET-ENVIRONMENT-AND-FILEMAP FILE)
        (while (FFILEPOS BEGINEXPORTDEFSTRING FILE NIL NIL NIL T) bind DEF
           join (until (EQUAL (SETQ DEF (READ FILE))
                                      ENDEXPORTDEFFORM) join (IMPORTEVAL DEF RETURNFLG))))])

(CHECKIMPORTS
  [LAMBDA (FILES NOASKFLG)                               (* rmk%: "19-FEB-83 16:31")
                                                             (* ; 
                                           "Loads exported definitions from new versions of FILES.")
    (COND
       ((AND (SETQ FILES (for FILE inside FILES bind FULLFILENAME DATE
                            when [AND (SETQ FULLFILENAME (FINDFILE FILE T))
                                          (OR [NOT (SETQ DATE (GETPROP (ROOTFILENAME FILE)
                                                                     'IMPORTDATE]
                                              (NOT (IEQP DATE (GETFILEINFO FULLFILENAME 
                                                                     'ICREATIONDATE]
                            collect (LIST FILE FULLFILENAME)))
             (OR NOASKFLG (SELECTQ (ASKUSER 5 'Y (LIST "load new exports from "
                                                       (MAPCAR FILES (FUNCTION CAR)))
                                          '((Y "es
")
                                            (N "o
"))
                                          T)
                              (N NIL)
                              T)))
        (for FILE in FILES do (IMPORTFILE (CADR FILE])

(GATHEREXPORTS
  [LAMBDA (FROMFILES TOFILE FLG)                         (* bvm%: "14-Oct-86 23:12")
                                                             (* ; 
                                        "Copies all exported definitions from FROMFILES to TOFILE.")
    (RESETLST
        [RESETSAVE NIL (LIST (FUNCTION CLOSE-AND-MAYBE-DELETE)
                             (SETQ TOFILE (OPENSTREAM TOFILE 'OUTPUT]
        (RESETSAVE (OUTPUT TOFILE))
        (LET ((ENV *DEFAULT-MAKEFILE-ENVIRONMENT*))
             (SETQ ENV (if ENV
                           then (\DO-DEFINE-FILE-INFO NIL ENV)
                         else *OLD-INTERLISP-READ-ENVIRONMENT*))
             (WITH-READER-ENVIRONMENT ENV
                 (PRINT-READER-ENVIRONMENT ENV)
                 (printout NIL "(LISPXPRIN1 %"EXPORTS GATHERED FROM " (DIRECTORYNAME T)
                        " ON "
                        (DATE)
                        "%"  T)" T "(LISPXTERPRI T)" T)
                 (for F inside FROMFILES do (MAPC (IMPORTFILE F (OR FLG T))
                                                              (FUNCTION PRINT))
                                                       (TERPRI))
                 (PRINT 'STOP)
                 (TERPRI)
                 (FULLNAME TOFILE))))])

(\DUMPEXPORTS
  [NLAMBDA COMS                                          (* bvm%: "24-Oct-86 19:42")

(* ;;; "Dumps an EXPORT form.  IMPORTFILE looks for a string announcing imports, but we must print it in a way that lets the file be loaded ok.")

    (PRIN1 "(")
    (PRIN2 '*)
    (PRIN1 (SUBSTRING BEGINEXPORTDEFSTRING 2))               (* ; 
                                   "BEGINEXPORTDEFSTRING starts with a * for benefit of IMPORTFILE")
    (for TAIL on COMS do (PRETTYCOM (CAR TAIL)))
    (TERPRI)
    (PRINT ENDEXPORTDEFFORM)
    (TERPRI])
)
(PUTDEF (QUOTE EXPORT) (QUOTE FILEPKGCOMS) '[(COM MACRO (X (E (\DUMPEXPORTS . X])

(RPAQ? BEGINEXPORTDEFSTRING "* %"FOLLOWING DEFINITIONS EXPORTED%")")

(RPAQ? ENDEXPORTDEFFORM '(* "END EXPORTED DEFINITIONS"))
(DECLARE%: DOEVAL@COMPILE DONTCOPY

(GLOBALVARS BEGINEXPORTDEFSTRING ENDEXPORTDEFFORM)
)



(* ; "for GAINSPACE")

(DEFINEQ

(CLEARFILEPKG
  [LAMBDA (FLG)                                          (* bvm%: "29-Aug-86 13:02")
    (PROG NIL
          (COND
             ((SELECTQ FLG
                  ((E T) 
                       T)
                  (Y (TERPRI T)
                     (PRIN1 "you can delete just the filemaps -
" T)
                     (PROG1 [ASKUSER NIL NIL "are you sure you want to delete EVERYTHING ? "
                                   '((Y "es - everything" RETURN T)
                                     (N "o - just the filemaps" RETURN NIL)
                                     (E "verything" RETURN T)
                                     (F "ilemaps only" RETURN NIL]
                            (TERPRI T)))
                  NIL)
              (UPDATEFILES)
              [SETQ FILELST (SUBSET FILELST (FUNCTION (LAMBDA (FILE)
                                                        (COND
                                                           ((fetch TOBEDUMPED
                                                               of (fetch FILEPROP
                                                                         of FILE))
                                                            (PRINT FILE T T)
                                                            (PRIN1 " has changes, not wiped." T)
                                                            (TERPRI T)
                                                            T)
                                                           (T (replace FILEPROP of FILE
                                                                 with NIL)
                                                              (replace FILECHANGES of FILE
                                                                 with NIL)
                                                              (SMASHFILECOMS FILE)
                                                              (NCONC1 SYSFILES FILE)
                                                              NIL]
              (SETQ LOADEDFILELST)))
          (SELECTQ FLG
              ((NIL T))
              (CLRHASH *FILEMAP-HASH*])
)

(ADDTOVAR GAINSPACEFORMS (FILELST "erase filepkg information" (CLEARFILEPKG RESPONSE)
                                    ((Y "es")
                                     (N "o")
                                     (E . "verything")
                                     (F "ilemaps only
"))))
(DECLARE%: DOEVAL@COMPILE DONTCOPY

(GLOBALVARS SMASHPROPSLST1)
)
(DECLARE%: DOEVAL@COMPILE DONTCOPY

(GLOBALVARS %#UNDOSAVES ADDTOFILEKEYLST CLEANUPOPTIONS CLISPIFYPRETTYFLG COMPILE.EXT DECLARETAGSLST 
       DEFAULTRENAMEMETHOD FILEPKGCOMSPLST FILERDTBL HISTORYCOMS HISTSTR0 I.S.OPRLST LISPXCOMS 
       LISPXHISTORY LISPXHISTORYMACROS LISPXMACROS MACROPROPS MAKEFILEOPTIONS MAKEFILEREMAKEFLG 
       MSDATABASELST PRETTYHEADER PRETTYTRANFLG SAVEDDEFS SYSPROPS USERMACROS USERRECLST USERWORDS 
       FILEPKGTYPEPROPS)
)
(DECLARE%: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY

(BLOCK%: DELFROMCOMS DELFROMCOMS DELFROMCOM DELFROMCOM1 REMOVEITEM (NOLINKFNS . T)
       (SPECVARS COMSNAME))

(BLOCK%: ADDTOFILEBLOCK ADDTOFILES? ADDTOFILE WHATIS ADDTOCOMS ADDTOCOM ADDTOCOM1 ADDNEWCOM
       (NOLINKFNS . T)
       (SPECVARS COMSNAME)
       (ENTRIES ADDTOFILE ADDTOCOMS ADDTOFILES? ADDTOCOM1))

(BLOCK%: INFILECOMS? INFILECOMS? INFILECOMTAIL INFILECOMS INFILECOM INFILECOMSVAL INFILECOMSVALS 
       INFILEPAIRS INFILECOMSMACRO IFCPROPS IFCEXPRTYPE IFCPROPSCAN IFCDECLARE
       (LOCALFREEVARS NAME LITERALS VAL TYPE ONFILETYPE ORIGFLG)
       INFILECOMSPROP)

(BLOCK%: NIL MAKEFILE (LOCALVARS . T)
       (SPECVARS FILE OPTIONS REPRINTFNS SOURCEFILE FILETYPE FILEDATES CHANGES))

(BLOCK%: ADDFILE ADDFILE ADDFILE0)

(BLOCK%: FILEPKGCHANGES FILEPKGCHANGES (NOLINKFNS . T))

(BLOCK%: NIL ALISTS.WHENCHANGED CHANGECALLERS CLEANUP CLEARCLISPARRAY COMPARE COMPAREDEFS 
       COMPILEFILES COMPILEFILES0 CONTINUEDIT COPYDEF DEFAULTMAKENEWCOM DELFROMFILES EDITDEF 
       EXPRESSIONS.WHENCHANGED FILECOMS FILECOMSLST FILEFNSLST FILEPKGCOM FILEPKGCOMPROPS FILEPKGTYPE
       FILES? FILES?1 GETFILEPKGTYPE HASDEF INFILECOMTAIL LOADDEF MAKEALISTCOMS MAKEFILE1 MAKEFILES 
       MAKEFILESCOMS MAKELISPXMACROSCOMS MAKENEWCOM MAKEPROPSCOMS MAKEUSERMACROSCOMS MARKASCHANGED 
       MOVETOFILE POSTEDITPROPS PREEDITFN PRETTYDEFMACROS PROPS.WHENCHANGED PUTDEF RENAME SAVEDEF 
       SAVEPUT SEARCHPRETTYTYPELST SHOWDEF SMASHFILECOMS TYPESOF UNMARKASCHANGED UNSAVEDEF 
       UPDATEFILES (GLOBALVARS %#UNDOSAVES SYSFILES MARKASCHANGEDSTATS COMPILE.EXT EDITMACROS 
                          EDITLOADFNSFLG LOADOPTIONS)
       (LOCALVARS . T))

(BLOCK%: DELDEF DELDEF DELFROMLIST (NOLINKFNS . T))

(BLOCK%: GETDEF GETDEF DWIMDEF GETDEFCOM GETDEFCOM0 GETDEFERR GETDEFCURRENT GETDEFFROMFILE 
       GETDEFSAVED (RETFNS GETDEFCOM)
       (NOLINKFNS . T)
       (GLOBALVARS NOT-FOUNDTAG))
)
(DECLARE%: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY COMPILERVARS 

(ADDTOVAR NLAMA \DUMPEXPORTS MAKEUSERMACROSCOMS MAKEPROPSCOMS MAKELISPXMACROSCOMS MAKEFILESCOMS 
                          MAKEALISTCOMS LISTFILES COMPILEFILES CLEANUP FILEPKGCOMPROPS 
                          PRETTYDEFMACROS)

(ADDTOVAR NLAML )

(ADDTOVAR LAMA FILEPKGTYPE FILEPKGCOM FILEPKGCHANGES)
)
(PUTPROPS FILEPKG COPYRIGHT ("Venue & Xerox Corporation" T 1982 1983 1984 1985 1986 1987 1988 1989 
1990 1991 1992 1993 1995 2018 2020))
(DECLARE%: DONTCOPY
  (FILEMAP (NIL (22908 24613 (SEARCHPRETTYTYPELST 22918 . 23897) (PRETTYDEFMACROS 23899 . 24357) (
FILEPKGCOMPROPS 24359 . 24611)) (25415 59356 (CLEANUP 25425 . 26813) (COMPILEFILES 26815 . 27091) (
COMPILEFILES0 27093 . 27813) (CONTINUEDIT 27815 . 29235) (MAKEFILE 29237 . 40879) (FILECHANGES 40881
 . 43216) (FILEPKG.MERGECHANGES 43218 . 44041) (FILEPKG.CHANGEDFNS 44043 . 44355) (MAKEFILE1 44357 . 
48627) (COMPILE-FILE? 48629 . 49961) (MAKEFILES 49963 . 51656) (ADDFILE 51658 . 54179) (ADDFILE0 54181
 . 58317) (LISTFILES 58319 . 59354)) (60044 95284 (FILEPKGCHANGES 60054 . 61404) (GETFILEPKGTYPE 61406
 . 64479) (MARKASCHANGED 64481 . 66118) (FILECOMS 66120 . 66504) (WHEREIS 66506 . 67926) (
SMASHFILECOMS 67928 . 68163) (FILEFNSLST 68165 . 68327) (FILECOMSLST 68329 . 68813) (UPDATEFILES 68815
 . 74115) (INFILECOMS? 74117 . 76020) (INFILECOMTAIL 76022 . 77162) (INFILECOMS 77164 . 77325) (
INFILECOM 77327 . 87536) (INFILECOMSVALS 87538 . 87865) (INFILECOMSVAL 87867 . 88869) (INFILECOMSPROP 
88871 . 89700) (IFCPROPS 89702 . 90963) (IFCEXPRTYPE 90965 . 91476) (IFCPROPSCAN 91478 . 92531) (
IFCDECLARE 92533 . 93844) (INFILEPAIRS 93846 . 94178) (INFILECOMSMACRO 94180 . 95282)) (95319 126095 (
FILES? 95329 . 97522) (FILES?1 97524 . 98174) (FILES?PRINTLST 98176 . 98958) (ADDTOFILES? 98960 . 
109562) (ADDTOFILE 109564 . 110480) (WHATIS 110482 . 112458) (ADDTOCOMS 112460 . 114104) (ADDTOCOM 
114106 . 120653) (ADDTOCOM1 120655 . 121826) (ADDNEWCOM 121828 . 122878) (MAKENEWCOM 122880 . 124723) 
(DEFAULTMAKENEWCOM 124725 . 126093)) (126165 128982 (MERGEINSERT 126175 . 128518) (MERGEINSERT1 128520
 . 128980)) (130501 141413 (DELFROMFILES 130511 . 131361) (DELFROMCOMS 131363 . 133042) (DELFROMCOM 
133044 . 138912) (DELFROMCOM1 138914 . 139711) (REMOVEITEM 139713 . 140587) (MOVETOFILE 140589 . 
141411)) (141627 143996 (SAVEPUT 141637 . 143994)) (144121 152445 (UNMARKASCHANGED 144131 . 145839) (
PREEDITFN 145841 . 148352) (POSTEDITPROPS 148354 . 150855) (POSTEDITALISTS 150857 . 152443)) (152594 
173148 (ALISTS.GETDEF 152604 . 152983) (ALISTS.WHENCHANGED 152985 . 153629) (CLEARCLISPARRAY 153631 . 
154805) (EXPRESSIONS.WHENCHANGED 154807 . 155181) (MAKEALISTCOMS 155183 . 156256) (MAKEFILESCOMS 
156258 . 157695) (MAKELISPXMACROSCOMS 157697 . 159715) (MAKEPROPSCOMS 159717 . 160415) (
MAKEUSERMACROSCOMS 160417 . 162217) (PROPS.WHENCHANGED 162219 . 162840) (FILEGETDEF.LISPXMACROS 162842
 . 164284) (FILEGETDEF.ALISTS 164286 . 164905) (FILEGETDEF.RECORDS 164907 . 165838) (FILEGETDEF.PROPS 
165840 . 166632) (FILEGETDEF.MACROS 166634 . 167694) (FILEGETDEF.VARS 167696 . 168112) (FILEGETDEF.FNS
 168114 . 169478) (FILEPKGCOMS.PUTDEF 169480 . 171920) (FILES.PUTDEF 171922 . 172879) (VARS.PUTDEF 
172881 . 173024) (FILES.WHENCHANGED 173026 . 173146)) (175170 182603 (RENAME 175180 . 176581) (
CHANGECALLERS 176583 . 182601)) (182604 230552 (SHOWDEF 182614 . 183407) (COPYDEF 183409 . 185883) (
GETDEF 185885 . 188161) (GETDEFCOM 188163 . 189129) (GETDEFCOM0 189131 . 190477) (GETDEFCURRENT 190479
 . 196899) (GETDEFERR 196901 . 198202) (GETDEFFROMFILE 198204 . 202484) (GETDEFSAVED 202486 . 203590) 
(PUTDEF 203592 . 204295) (EDITDEF 204297 . 205274) (DEFAULT.EDITDEF 205276 . 208112) (EDITDEF.FILES 
208114 . 208315) (LOADDEF 208317 . 208493) (DWIMDEF 208495 . 209349) (DELDEF 209351 . 212365) (
DELFROMLIST 212367 . 212871) (HASDEF 212873 . 219195) (GETFILEDEF 219197 . 219719) (SAVEDEF 219721 . 
221380) (UNSAVEDEF 221382 . 222278) (COMPAREDEFS 222280 . 225582) (COMPARE 225584 . 226288) (TYPESOF 
226290 . 230550)) (230619 235662 (FIXEDITDATE 230629 . 234132) (EDITDATE? 234134 . 235660)) (236081 
244667 (FILEPKGCOM 236091 . 241024) (FILEPKGTYPE 241026 . 244665)) (256704 271256 (FINDCALLERS 256714
 . 257229) (EDITCALLERS 257231 . 264889) (EDITFROMFILE 264891 . 270571) (FINDATS 270573 . 270845) (
LOOKIN 270847 . 271254)) (271257 272984 (SEPRCASE 271267 . 272982)) (273501 279043 (IMPORTFILE 273511
 . 274485) (IMPORTEVAL 274487 . 275367) (IMPORTFILESCAN 275369 . 275790) (CHECKIMPORTS 275792 . 277128
) (GATHEREXPORTS 277130 . 278453) (\DUMPEXPORTS 278455 . 279041)) (279381 281589 (CLEARFILEPKG 279391
 . 281587)))))
STOP
\ No newline at end of file
+(DEFINE-FILE-INFO READTABLE "INTERLISP" PACKAGE "INTERLISP")
(FILECREATED "27-Oct-2020 15:40:32" 
{DSK}<Users>kaplan>Local>medley3.5>lispcore>sources>FILEPKG.;12 285044 

      changes to%:  (FNS MAKEFILE1 COMPILE-FILE?)

      previous date%: "10-Aug-2020 21:24:58" 
{DSK}<Users>kaplan>Local>medley3.5>lispcore>sources>FILEPKG.;11)


(* ; "
Copyright (c) 1982, 1983, 1984, 1985, 1986, 1987, 1988, 1989, 1990, 1991, 1992, 1993, 1995, 2018, 2020 by Venue & Xerox Corporation.  All rights reserved.
The following program was created in 1982 but has not been published
within the meaning of the copyright law, is furnished under license,
and may not be used, copied and/or disclosed except in accordance
with the terms of said license.
")

(PRETTYCOMPRINT FILEPKGCOMS)

(RPAQQ FILEPKGCOMS
       [(COMS                                                (* ; 
            "standard records for accessing file  package type/command parts.  Exported for PRETTY")
              (VARS FILEPKGTYPEPROPS)
              (EXPORT (DECLARE%: EVAL@COMPILE DONTCOPY (RECORDS * FILEPKGRECORDS)))
              (FNS SEARCHPRETTYTYPELST PRETTYDEFMACROS FILEPKGCOMPROPS)
              (INITRECORDS * FILEPKGRECORDS))
        [DECLARE%: EVAL@COMPILE DOCOPY 

               (* ;; "Proclaim SPECIAL those variables that are used freely in a lot of code.")

               (P (CL:PROCLAIM '(CL:SPECIAL PRETTYDEFMACROS PRETTYTYPELST FILEPKGTYPES 
                                       PRETTYPRINTMACROS *DEFAULT-CLEANUP-COMPILER* MARKASCHANGEDFNS
                                       PRETTYFLG))
                  (CL:PROCLAIM '(GLOBAL FILELST SYSFILES LOADEDFILELST NOTLISTEDFILES 
                                       NOTCOMPILEDFILES MAKEFILEFORMS CLEANUPOPTIONS]
        (INITVARS (MSDATABASELST))
        [COMS 
              (* ;; "making, adding, listing, compiling files")

              (FNS CLEANUP COMPILEFILES COMPILEFILES0 CONTINUEDIT MAKEFILE FILECHANGES 
                   FILEPKG.MERGECHANGES FILEPKG.CHANGEDFNS MAKEFILE1 COMPILE-FILE? MAKEFILES ADDFILE
                   ADDFILE0 LISTFILES)
              (INITVARS (*DEFAULT-CLEANUP-COMPILER* 'CL:COMPILE-FILE)
                     (FILELST)
                     (LOADEDFILELST)
                     (NOTLISTEDFILES)
                     (NOTCOMPILEDFILES)
                     (MAKEFILEFORMS)
                     (NILCOMS))
              (ADDVARS (MAKEFILEOPTIONS RC C LIST FAST CLISP CLISPIFY NIL REMAKE NEW NOCLISP CLISP% 
                              F ST STF (REC . RC)
                              (BREC . RC)
                              (TC . C)
                              (BC . C)
                              (TCOMPL . C)
                              (BCOMPL . C)))
              (INITVARS (MAKEFILEREMAKEFLG T)
                     (CLEANUPOPTIONS '(RC]
        (COMS 
              (* ;; "scanning file coms")

              (FNS FILEPKGCHANGES GETFILEPKGTYPE MARKASCHANGED FILECOMS WHEREIS SMASHFILECOMS 
                   FILEFNSLST FILECOMSLST UPDATEFILES INFILECOMS? INFILECOMTAIL INFILECOMS INFILECOM
                   INFILECOMSVALS INFILECOMSVAL INFILECOMSPROP IFCPROPS IFCEXPRTYPE IFCPROPSCAN 
                   IFCDECLARE INFILEPAIRS INFILECOMSMACRO))
        (COMS 
              (* ;; "adding to a file")

              (FNS FILES? FILES?1 FILES?PRINTLST ADDTOFILES? ADDTOFILE WHATIS ADDTOCOMS ADDTOCOM 
                   ADDTOCOM1 ADDNEWCOM MAKENEWCOM DEFAULTMAKENEWCOM)
              (INITVARS (DEFAULTCOMHASFILEFLG))
              (ADDVARS (MARKASCHANGEDFNS))
              (FNS MERGEINSERT MERGEINSERT1)
              
              (* ;; "RMK: Changed INITVARS to VARS, so = addition is a synonym for untypable LF, and also suppress appearance of raw CR and LF in the file")

              (VARS [ADDTOFILEKEYLST `(("[" "" EXPLAINSTRING 
                                           "[ -- prettyprint the item to terminal and then ask again"
                                            NOECHOFLG T)
                                       (= "" EXPLAINSTRING "= - same as previous response" NOECHOFLG
                                          T)
                                       (,(CHARACTER (CHARCODE LF))
                                        "" EXPLAINSTRING "{line-feed} - same as previous response" 
                                        NOECHOFLG T)
                                       (" " ,(CONCATCODES (LIST (CHARCODE SPACE)
                                                                (CHARCODE EOL)))
                                            EXPLAINSTRING "{space} - no action" NOECHOFLG T)
                                       ("]" ,(CONCAT "Nowhere" (CHARACTER (CHARCODE EOL)))
                                            EXPLAINSTRING
                                            ,(CONCAT "] - nowhere, item is marked as a dummy"
                                                    (CHARACTER (CHARCODE EOL)))
                                            NOECHOFLG T)
                                       ["(" "List:  (" EXPLAINSTRING "(list name)" NOECHOFLG T KEYLST
                                            (( "" CONFIRMFG [%) %] ,(CHARACTER (CHARCODE SPACE))
                                                                 ,(CHARACTER (CHARCODE EOL]
                                                RETURN
                                                (CDR ANSWER]
                                       (@ "Near: " EXPLAINSTRING 
                                          "@ other-item   -- put the item near the other item" 
                                          NOECHOFLG T KEYLST (( "" CONFIRMFLG
                                                                 [,(CHARACTER (CHARCODE EOL]
                                                                 RETURN ANSWER)))
                                       [,(CHARACTER (CHARCODE CR))
                                        "" RETURN ,(CHARACTER (CHARCODE SPACE]
                                       ("" "File name: " EXPLAINSTRING "a file name" KEYLST (]
                    (LASTFILE)))
        (COMS 
              (* ;; "deleting an item from a file")

              (FNS DELFROMFILES DELFROMCOMS DELFROMCOM DELFROMCOM1 REMOVEITEM MOVETOFILE)
              (P (MOVD? 'DELFROMFILES 'DELFROMFILE NIL T)
                 (MOVD? 'MOVETOFILE 'MOVEITEM NIL T))
              (ADDVARS (SYSPROPS PROPTYPE VARTYPE)))
        [COMS                                                (* ; 
                      "functions for doing things and marking them changed and auxiliary functions")
              (FNS SAVEPUT)
              [DECLARE%: DONTEVAL@LOAD DOCOPY (P (OR (CHANGENAME 'PUTPROPS 'PUTPROP 'SAVEPUT)
                                                     (CHANGENAME 'PUTPROPS '/PUT 'SAVEPUT]
              (FNS UNMARKASCHANGED PREEDITFN POSTEDITPROPS POSTEDITALISTS)
              (ADDVARS (LISPXFNS (PUT . SAVEPUT)
                              (PUTPROP . SAVEPUT]
        (COMS                                                (* ; 
                                                  "sub-functions for file package commands & types")
              (FNS ALISTS.GETDEF ALISTS.WHENCHANGED CLEARCLISPARRAY EXPRESSIONS.WHENCHANGED 
                   MAKEALISTCOMS MAKEFILESCOMS MAKELISPXMACROSCOMS MAKEPROPSCOMS MAKEUSERMACROSCOMS 
                   PROPS.WHENCHANGED FILEGETDEF.LISPXMACROS FILEGETDEF.ALISTS FILEGETDEF.RECORDS 
                   FILEGETDEF.PROPS FILEGETDEF.MACROS FILEGETDEF.VARS FILEGETDEF.FNS 
                   FILEPKGCOMS.PUTDEF FILES.PUTDEF VARS.PUTDEF FILES.WHENCHANGED)
              (ADDVARS (MACROPROPS MACRO BYTEMACRO DMACRO)
                     (SYSPROPS PROPTYPE))
              (PROP PROPTYPE I.S.OPR SUBR LIST CODE FILEDATES FILE FILEMAP EXPR VALUE COPYRIGHT 
                    FILETYPE)
              (PROP VARTYPE BAKTRACELST BREAKMACROS COMPILETYPELST EDITMACROS ERRORTYPELST FONTDEFS 
                    LISPXHISTORYMACROS LISPXMACROS PRETTYDEFMACROS PRETTYEQUIVLST PRETTYPRINTMACROS 
                    PRETTYPRINTYPEMACROS USERMACROS))
        (COMS                                                (* ; 
                    "Define the commands below AFTER the various properties have been established.")
              (USERMACROS M))
        (COMS                                                (* ; "GETDEF methods")
              (FNS RENAME CHANGECALLERS)
              (FNS SHOWDEF COPYDEF GETDEF GETDEFCOM GETDEFCOM0 GETDEFCURRENT GETDEFERR GETDEFFROMFILE
                   GETDEFSAVED PUTDEF EDITDEF DEFAULT.EDITDEF EDITDEF.FILES LOADDEF DWIMDEF DELDEF 
                   DELFROMLIST HASDEF GETFILEDEF SAVEDEF UNSAVEDEF COMPAREDEFS COMPARE TYPESOF)
              (INITVARS (WHEREIS.HASH)))
                                                             (* ; "Must come after PUTDEF")
        (FNS FIXEDITDATE EDITDATE?)
                                                             (* ; 
                                  "Edit date support for all kinds of definers (from PARC 6/10/92)")
        [VARS (EDITDATE-ARGLIST-DEFINERS '(FUNCTIONS TYPES))
              (EDITDATE-NAME-DEFINERS '(STRUCTURES VARIABLES]
        (GLOBALVARS EDITDATE-ARGLIST-DEFINERS EDITDATE-NAME-DEFINERS)
        (COMS 
              (* ;; "how to dump FILEPKGCOMS. The SPLST must be initialized to contain FILEPKGCOMS in order to get started.")

              (FNS FILEPKGCOM FILEPKGTYPE)
              (PROP ARGNAMES FILEPKGCOM)
              (ADDVARS (FILEPKGCOMSPLST FILEPKGCOMS)
                     (FILEPKGTYPES FILEPKGCOMS))
              (FILEPKGCOMS FILEPKGCOMS)
              (FILEPKGCOMS ALISTS DEFS EDITMACROS EXPRESSIONS FIELDS FILEPKGTYPES FILES FILEVARS FNS
                     INITRECORDS INITVARS LISPXCOMS LISPXMACROS MACROS PRETTYDEFMACROS PROPS RECORDS
                     OLDRECORDS SYSRECORDS USERMACROS VARS * CONSTANTS))
        (ADDVARS (SHADOW-TYPES (FUNCTIONS FNS)
                        (VARIABLES VARS CONSTANTS)))
        (INITVARS (SAVEDDEFS))
        (COMS                                                (* ; "EDITCALLERS")
              (FNS FINDCALLERS EDITCALLERS EDITFROMFILE FINDATS LOOKIN)
              (FNS SEPRCASE)
              [INITVARS (DEFAULTRENAMEMETHOD '(EDITCALLERS CAREFUL]
              (INITVARS (SEPRCASEARRAYS)
                     (CLISPCASEARRAYS))
              (P (MOVD? 'INFILEP 'FINDFILE)
                                                             (* ; "or else from SPELLFILE"))
              (BLOCKS (EDITFROMFILE EDITFROMFILE LOOKIN (GLOBALVARS EDITLOADFNSFLG)
                             (NOLINKFNS LOADFROM)))
              (GLOBALVARS SYSFILES CLISPCASEARRAYS SEPRCASEARRAYS CLISPCHARS))
        (COMS                                                (* ; "EXPORT")
              (FNS IMPORTFILE IMPORTEVAL IMPORTFILESCAN CHECKIMPORTS GATHEREXPORTS \DUMPEXPORTS)
              (FILEPKGCOMS EXPORT)
              [INITVARS (BEGINEXPORTDEFSTRING "* %"FOLLOWING DEFINITIONS EXPORTED%")")
                     (ENDEXPORTDEFFORM '(* "END EXPORTED DEFINITIONS"]
              (GLOBALVARS BEGINEXPORTDEFSTRING ENDEXPORTDEFFORM))
        (COMS                                                (* ; "for GAINSPACE")
              (FNS CLEARFILEPKG)
              [ADDVARS (GAINSPACEFORMS (FILELST "erase filepkg information" (CLEARFILEPKG RESPONSE)
                                              ((Y "es")
                                               (N "o")
                                               (E . "verything")
                                               (F "ilemaps only
"]
              (GLOBALVARS SMASHPROPSLST1))
        (GLOBALVARS %#UNDOSAVES ADDTOFILEKEYLST CLEANUPOPTIONS CLISPIFYPRETTYFLG COMPILE.EXT 
               DECLARETAGSLST DEFAULTRENAMEMETHOD FILEPKGCOMSPLST FILERDTBL HISTORYCOMS HISTSTR0 
               I.S.OPRLST LISPXCOMS LISPXHISTORY LISPXHISTORYMACROS LISPXMACROS MACROPROPS 
               MAKEFILEOPTIONS MAKEFILEREMAKEFLG MSDATABASELST PRETTYHEADER PRETTYTRANFLG SAVEDDEFS 
               SYSPROPS USERMACROS USERRECLST USERWORDS FILEPKGTYPEPROPS)
        (BLOCKS (DELFROMCOMS DELFROMCOMS DELFROMCOM DELFROMCOM1 REMOVEITEM (NOLINKFNS . T)
                       (SPECVARS COMSNAME))
               (ADDTOFILEBLOCK ADDTOFILES? ADDTOFILE WHATIS ADDTOCOMS ADDTOCOM ADDTOCOM1 ADDNEWCOM
                      (NOLINKFNS . T)
                      (SPECVARS COMSNAME)
                      (ENTRIES ADDTOFILE ADDTOCOMS ADDTOFILES? ADDTOCOM1))
               (INFILECOMS? INFILECOMS? INFILECOMTAIL INFILECOMS INFILECOM INFILECOMSVAL 
                      INFILECOMSVALS INFILEPAIRS INFILECOMSMACRO IFCPROPS IFCEXPRTYPE IFCPROPSCAN 
                      IFCDECLARE (LOCALFREEVARS NAME LITERALS VAL TYPE ONFILETYPE ORIGFLG)
                      INFILECOMSPROP)
               (NIL MAKEFILE (LOCALVARS . T)
                    (SPECVARS FILE OPTIONS REPRINTFNS SOURCEFILE FILETYPE FILEDATES CHANGES))
               (ADDFILE ADDFILE ADDFILE0)
               (FILEPKGCHANGES FILEPKGCHANGES (NOLINKFNS . T))
               (NIL ALISTS.WHENCHANGED CHANGECALLERS CLEANUP CLEARCLISPARRAY COMPARE COMPAREDEFS 
                    COMPILEFILES COMPILEFILES0 CONTINUEDIT COPYDEF DEFAULTMAKENEWCOM DELFROMFILES 
                    EDITDEF EXPRESSIONS.WHENCHANGED FILECOMS FILECOMSLST FILEFNSLST FILEPKGCOM 
                    FILEPKGCOMPROPS FILEPKGTYPE FILES? FILES?1 GETFILEPKGTYPE HASDEF INFILECOMTAIL 
                    LOADDEF MAKEALISTCOMS MAKEFILE1 MAKEFILES MAKEFILESCOMS MAKELISPXMACROSCOMS 
                    MAKENEWCOM MAKEPROPSCOMS MAKEUSERMACROSCOMS MARKASCHANGED MOVETOFILE 
                    POSTEDITPROPS PREEDITFN PRETTYDEFMACROS PROPS.WHENCHANGED PUTDEF RENAME SAVEDEF 
                    SAVEPUT SEARCHPRETTYTYPELST SHOWDEF SMASHFILECOMS TYPESOF UNMARKASCHANGED 
                    UNSAVEDEF UPDATEFILES (GLOBALVARS %#UNDOSAVES SYSFILES MARKASCHANGEDSTATS 
                                                 COMPILE.EXT EDITMACROS EDITLOADFNSFLG LOADOPTIONS)
                    (LOCALVARS . T))
               (DELDEF DELDEF DELFROMLIST (NOLINKFNS . T))
               (GETDEF GETDEF DWIMDEF GETDEFCOM GETDEFCOM0 GETDEFERR GETDEFCURRENT GETDEFFROMFILE 
                      GETDEFSAVED (RETFNS GETDEFCOM)
                      (NOLINKFNS . T)
                      (GLOBALVARS NOT-FOUNDTAG)))
        (DECLARE%: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY COMPILERVARS
               (ADDVARS (NLAMA \DUMPEXPORTS MAKEUSERMACROSCOMS MAKEPROPSCOMS MAKELISPXMACROSCOMS 
                               MAKEFILESCOMS MAKEALISTCOMS LISTFILES COMPILEFILES CLEANUP 
                               FILEPKGCOMPROPS PRETTYDEFMACROS)
                      (NLAML)
                      (LAMA FILEPKGTYPE FILEPKGCOM FILEPKGCHANGES])



(* ; "standard records for accessing file  package type/command parts.  Exported for PRETTY")


(RPAQQ FILEPKGTYPEPROPS (NEWCOM WHENFILED WHENUNFILED GETDEF NULLDEF DELDEF PUTDEF WHENCHANGED 
                                   HASDEF EDITDEF CANFILEDEF FILEGETDEF))
(* "FOLLOWING DEFINITIONS EXPORTED")(DECLARE%: EVAL@COMPILE DONTCOPY 

(RPAQQ FILEPKGRECORDS (FILEPKGCOM FILEPKGTYPE FILE FILEDATEPAIR FILEPROP))
(DECLARE%: EVAL@COMPILE

(ACCESSFNS FILEPKGCOM [[ADD (GETPROP DATUM 'ADDTOPRETTYCOM)
                                  (UNDOABLE (COND
                                               (NEWVALUE (/PUTPROP DATUM 'ADDTOPRETTYCOM NEWVALUE))
                                               (T (/REMPROP DATUM 'ADDTOPRETTYCOM]
                           [DELETE (GETPROP DATUM 'DELFROMPRETTYCOM)
                                  (UNDOABLE (COND
                                               (NEWVALUE (/PUTPROP DATUM 'DELFROMPRETTYCOM NEWVALUE))
                                               (T (/REMPROP DATUM 'DELFROMPRETTYCOM]
                           [PRETTYTYPE (GETPROP DATUM 'PRETTYTYPE)
                                  (UNDOABLE (COND
                                               (NEWVALUE (/PUTPROP DATUM 'PRETTYTYPE NEWVALUE))
                                               (T (/REMPROP DATUM 'PRETTYTYPE]
                           [CONTENTS (GETPROP DATUM 'FILEPKGCONTENTS)
                                  (UNDOABLE (COND
                                               (NEWVALUE (/PUTPROP DATUM 'FILEPKGCONTENTS NEWVALUE))
                                               (T (/REMPROP DATUM 'FILEPKGCONTENTS]
                           (MACRO [CDR (FASSOC DATUM (GETTOPVAL 'PRETTYDEFMACROS]
                                  (STANDARD [COND
                                               [NEWVALUE (PUTASSOC DATUM NEWVALUE
                                                                (OR (LISTP (GETTOPVAL 
                                                                                  'PRETTYDEFMACROS))
                                                                    (SETTOPVAL 'PRETTYDEFMACROS
                                                                           (LIST (LIST DATUM]
                                               (T (SETTOPVAL 'PRETTYDEFMACROS
                                                         (REMOVE (FASSOC DATUM (GETTOPVAL
                                                                                'PRETTYDEFMACROS))
                                                                (GETTOPVAL 'PRETTYDEFMACROS]
                                         UNDOABLE
                                         (COND
                                            [NEWVALUE (/PUTASSOC DATUM NEWVALUE
                                                             (OR (LISTP (GETTOPVAL 'PRETTYDEFMACROS))
                                                                 (/SETTOPVAL 'PRETTYDEFMACROS
                                                                        (LIST (LIST DATUM]
                                            (T (/SETTOPVAL 'PRETTYDEFMACROS
                                                      (REMOVE (FASSOC DATUM (GETTOPVAL 
                                                                                   'PRETTYDEFMACROS))
                                                             (GETTOPVAL 'PRETTYDEFMACROS]
                                                             (* Not an atom record cause want 
                                                           REMPROP on NILs.)
                                                             (* NOTE%: PRETTCOM on PRETTY has 
                                                           open-coded access to the MACRO 
                                                           property.)
                          (INIT (FILEPKGCOMPROPS ADDTOPRETTYCOM DELFROMPRETTYCOM PRETTYTYPE 
                                       FILEPKGCONTENTS)))

(ATOMRECORD FILEPKGTYPE (NEWCOM WHENFILED WHENUNFILED GETDEF NULLDEF DELDEF PUTDEF WHENCHANGED 
                                   HASDEF EDITDEF FILEGETDEF CANFILEDEF)
                            (ACCESSFNS FILEPKGTYPE [(CHANGEDLST (CAR (SEARCHPRETTYTYPELST DATUM))
                                                           (CAR (SEARCHPRETTYTYPELST DATUM NEWVALUE))
                                                           )
                                                    (CHANGED (GETTOPVAL (CAR (SEARCHPRETTYTYPELST
                                                                              DATUM)))
                                                           (STANDARD (SETTOPVAL (CAR (
                                                                                  SEARCHPRETTYTYPELST
                                                                                      DATUM NEWVALUE)
                                                                                     )
                                                                            NEWVALUE)
                                                                  UNDOABLE
                                                                  (/SETTOPVAL (CAR (
                                                                                  SEARCHPRETTYTYPELST
                                                                                    DATUM NEWVALUE))
                                                                         NEWVALUE)))
                                                    (DESCRIPTION (CAR (CDDR (SEARCHPRETTYTYPELST
                                                                             DATUM)))
                                                           (CAR (RPLACA (CDDR (SEARCHPRETTYTYPELST
                                                                               DATUM NEWVALUE))
                                                                       NEWVALUE)))
                                                    (ALLFIELDS NIL (/SETTOPVAL
                                                                    'PRETTYTYPELST
                                                                    (REMOVE (SEARCHPRETTYTYPELST
                                                                             DATUM)
                                                                           (GETTOPVAL 'PRETTYTYPELST]
                                                             (* NOTE%: PRETTYCOM on PRETTY has 
                                                           open-coded access to GETDEF property)
                                   (INIT [PROGN (SETQ SYSPROPS (UNION FILEPKGTYPEPROPS SYSPROPS))
                                                (MAPC FILEPKGTYPEPROPS (FUNCTION (LAMBDA (X)
                                                                                   (PUT X
                                                                                        'PROPTYPE
                                                                                        'FILEPKGCOMS]
                                         (ADDTOVAR PRETTYTYPELST ))))

(ATOMRECORD FILE (FILECHANGES FILEDATES FILEMAP)
                     [ACCESSFNS FILE ((FILEPROP (GETPROP DATUM 'FILE)
                                             (STANDARD (PUTPROP DATUM 'FILE NEWVALUE)
                                                    UNDOABLE
                                                    (/PUTPROP DATUM 'FILE NEWVALUE])

(RECORD FILEDATEPAIR (FILEDATE . DATEFILENAME))

(RECORD FILEPROP ((COMSNAME . LOADTYPE) . TOBEDUMPED))
)

(FILEPKGCOMPROPS ADDTOPRETTYCOM DELFROMPRETTYCOM PRETTYTYPE FILEPKGCONTENTS)

[PROGN (SETQ SYSPROPS (UNION FILEPKGTYPEPROPS SYSPROPS))
       (MAPC FILEPKGTYPEPROPS (FUNCTION (LAMBDA (X)
                                          (PUT X 'PROPTYPE 'FILEPKGCOMS]

(ADDTOVAR PRETTYTYPELST )
)

(* "END EXPORTED DEFINITIONS")

(DEFINEQ

(SEARCHPRETTYTYPELST
  [LAMBDA (TYPE FLG)                                     (* rmk%: " 3-JAN-82 22:55")
                                                             (* ; 
                                                           "access functions used by the records")
    (AND (LITATOM TYPE)
         (OR (find X in PRETTYTYPELST suchthat (EQ (CADR X)
                                                               TYPE))
             (COND
                (FLG [/SETTOPVAL 'PRETTYTYPELST (CONS (SETQ FLG (LIST (PACK* 'CHANGED TYPE
                                                                             'LST)
                                                                      TYPE NIL))
                                                      (GETTOPVAL 'PRETTYTYPELST]
                     (OR (LISTP (GETTOPVAL (CAR FLG)))
                         (/SETTOPVAL (CAR FLG)
                                NIL))
                     FLG])

(PRETTYDEFMACROS
  [NLAMBDA ARGS                                          (* lmm " 5-SEP-78 16:16")
                                                             (* ; 
                                                 "included so that old files will continue to load")
    (for X in ARGS collect (FILEPKGCOM (CAR X)
                                              'MACRO
                                              (CDR X])

(FILEPKGCOMPROPS
  [NLAMBDA PROPS
    (MAPC PROPS (FUNCTION (LAMBDA (Y)
                            (OR (MEMB Y SYSPROPS)
                                (SETQ SYSPROPS (CONS Y SYSPROPS)))
                            (PUT Y 'PROPTYPE 'FILEPKGCOMS])
)

(RPAQQ FILEPKGRECORDS (FILEPKGCOM FILEPKGTYPE FILE FILEDATEPAIR FILEPROP))

(FILEPKGCOMPROPS ADDTOPRETTYCOM DELFROMPRETTYCOM PRETTYTYPE FILEPKGCONTENTS)

[PROGN (SETQ SYSPROPS (UNION FILEPKGTYPEPROPS SYSPROPS))
       (MAPC FILEPKGTYPEPROPS (FUNCTION (LAMBDA (X)
                                          (PUT X 'PROPTYPE 'FILEPKGCOMS]

(ADDTOVAR PRETTYTYPELST )
(DECLARE%: EVAL@COMPILE DOCOPY 

(CL:PROCLAIM '(CL:SPECIAL PRETTYDEFMACROS PRETTYTYPELST FILEPKGTYPES PRETTYPRINTMACROS 
                     *DEFAULT-CLEANUP-COMPILER* MARKASCHANGEDFNS PRETTYFLG))

(CL:PROCLAIM '(GLOBAL FILELST SYSFILES LOADEDFILELST NOTLISTEDFILES NOTCOMPILEDFILES MAKEFILEFORMS 
                     CLEANUPOPTIONS))
)

(RPAQ? MSDATABASELST )



(* ;; "making, adding, listing, compiling files")

(DEFINEQ

(CLEANUP
  [NLAMBDA FILES                                         (* lmm "14-Aug-84 19:17")
    (PROG (TEM1 TEM2 OPTIONS)
          (COND
             ([LISTP (CAR (SETQ FILES (NLAMBDA.ARGS FILES]
              (SETQ OPTIONS (CAR FILES))
              (SETQ FILES (CDR FILES)))
             (T (SETQ OPTIONS CLEANUPOPTIONS)))
          (RETURN (APPEND (MAKEFILES OPTIONS FILES)
                         (COND
                            ((NOT (MEMB 'LIST OPTIONS))
                             NIL)
                            ((NULL FILES)
                             (LISTFILES))
                            ((SETQ TEM1 (INTERSECTION FILES NOTLISTEDFILES))
                                                             (* ; 
            "Intersection check because LISTFILES applied to NIL means list all of NOTLISTEDFILES.")
                             (APPLY 'LISTFILES TEM1)))
                         (COND
                            [(NULL (SETQ TEM1 (MEMB 'RC OPTIONS]
                            ((NULL FILES)
                             (COMPILEFILES0 (SETQ TEM2 NOTCOMPILEDFILES)
                                    (CDR TEM1))
                             TEM2)
                            ((SETQ TEM2 (INTERSECTION FILES NOTCOMPILEDFILES))
                             (COMPILEFILES0 TEM2 (CDR TEM1))
                             TEM2])

(COMPILEFILES
  [NLAMBDA FILES                                         (* lmm "14-Aug-84 19:17")
    (COND
       ([LISTP (CAR (SETQ FILES (NLAMBDA.ARGS FILES]
        (COMPILEFILES0 (CDR FILES)
               (CAR FILES)))
       (T (COMPILEFILES0 FILES])

(COMPILEFILES0
  [LAMBDA (FILES OPTIONS)                                (* rmk%: "19-FEB-83 21:59")
    (for X OPTS (RCFLG _ T) on (OR FILES NOTCOMPILEDFILES)
       first (SETQ OPTS (SELECTQ (CAR (LISTP OPTIONS))
                                (C (SETQ RCFLG NIL)
                                   (CDR OPTIONS))
                                (RC (CDR OPTIONS))
                                OPTIONS)) do (MAKEFILE1 (OR (MISSPELLED? (CAR X)
                                                                           70 FILELST NIL X)
                                                                    (CAR X))
                                                        RCFLG OPTS X])

(CONTINUEDIT
  [LAMBDA (FILE)                                         (* bvm%: "30-Aug-86 15:09")
    (PROG (STREAM FL TEM FC ENV)
          (RESETLST
              [RESETSAVE NIL (LIST 'CLOSEF (SETQ STREAM (OPENSTREAM FILE 'INPUT]
              (SETQ FILE (FULLNAME STREAM))
              (SETFILEPTR STREAM 0)
              (CL:MULTIPLE-VALUE-SETQ (ENV FC)
                     (\PARSE-FILE-HEADER STREAM 'RETURN)))
          (COND
             ([NOT (fetch FILEPROP of (SETQ FL (ROOTFILENAME FILE]
              (LOADFROM FILE)                                (* ; 
                                                           "also calls addfile to notice the file.")
              ))
          (/replace FILECHANGES of FL with (FILECHANGES FC))
          [/replace FILEDATES of FL with
                                            (LIST (create FILEDATEPAIR
                                                         FILEDATE _ (CADR FC)
                                                         DATEFILENAME _ FILE)
                                                  (create FILEDATEPAIR
                                                         FILEDATE _
                                                         [CAR (SETQ TEM (CDR (MEMB 'date%: FC]
                                                         DATEFILENAME _ (CADR TEM]
          (RETURN FILE])

(MAKEFILE
  [LAMBDA (FILE OPTIONS REPRINTFNS SOURCEFILE)           (* ; "Edited 29-Aug-89 11:46 by bvm")

    (* ;; "OPTIONS: FAST means dump with PRETTYFLG set to NIL;  LIST means list the FILE;  RC means RECOMPILE, C means COMPILEL;  --- for C AND RC assume ST unless next option is F.")

    (PROG ((PRETTYFLG (AND [NOT (MEMB 'FAST (SETQ OPTIONS (MKLIST OPTIONS]
                           PRETTYFLG))
           (*PRINT-BASE* (if (EQ *PRINT-BASE* 8)
                             then 8
                           else                          (* ; "make sure radix is either 8 or 10, because all others don't read in like they print.  Maybe obsolete now with makefile environments")
                                 10))
           FILETYPE ROOTNAME FILEPROP CHANGES FILEDATES (Z (ADDFILE FILE)))
          (DECLARE (CL:SPECIAL PRETTYFLG))
          (SETQ FILE (CAR Z))                                (* ; 
                                               "Necessary because FILE might have been misspelled.")
          (SETQ ROOTNAME (CADR Z))                           (* ; "result of (ROOTFILENAME FILE), or if FILE is corrected, result of applying ROOTFILENAME to correct value.")
          (SETQ FILEPROP (CDDR Z))
          (UPDATEFILES)                                  (* ; "Want updating done after file is added to filelst, so any functions that are being dumped are marked as having been dumped.")
          (SETQ CHANGES (fetch TOBEDUMPED of FILEPROP))
          (SETQ FILEDATES (LISTP (fetch FILEDATES of ROOTNAME)))
          (SETQ FILETYPE (GETPROP ROOTNAME 'FILETYPE))
      LP0 (if (AND (NULL (fetch LOADTYPE of FILEPROP))
                       (NULL FILEDATES))
              then                                       (* ; 
                   "File has never been loaded and never dumped i.e. user just set up COMS in core")
            elseif [OR (EQMEMB 'NEW OPTIONS)
                           (AND (NULL MAKEFILEREMAKEFLG)
                                (NOT (MEMB 'REMAKE OPTIONS]
              then (COND
                          ((AND (fetch LOADTYPE of FILEPROP)
                                (NEQ T (fetch LOADTYPE of FILEPROP)))
                           (LISPXPRIN2 FILE T T)
                           (LISPXPRIN1 (SELECTQ (fetch LOADTYPE of FILEPROP)
                                           (LOADCOMP 
                                                  "the file was loaded for compilation purposes only")
                                           ((compiled Compiled COMPILED) 
                                                " -- only the compiled file has been loaded
")
                                           ((loadfns LOADFNS) 
                                                " -- only some of its symbolics have been loaded
")
                                           (SHOULDNT))
                                  T)
                           (COND
                              ((NEQ (ASKUSER DWIMWAIT 'Y "Go ahead and MAKEFILE anyway? ")
                                    'Y)                      (* ; 
            "E.g. user loads a .com file and then resets the COMS or defines the functons by hand.")
                               (GO OUT)))
                           (/replace LOADTYPE of FILEPROP with NIL)))
                    (SETQ SOURCEFILE NIL)
                    (SETQ REPRINTFNS NIL)
            elseif SOURCEFILE
              then                                       (* ; "source file given")
            elseif [AND FILEDATES (OR [AND (SETQ SOURCEFILE (FINDFILE ROOTNAME T))
                                               (EQUAL (FILEDATE SOURCEFILE)
                                                      (fetch FILEDATE of (CAR FILEDATES]
                                          (AND [NOT (STRING-EQUAL SOURCEFILE (SETQ SOURCEFILE
                                                                              (fetch DATEFILENAME
                                                                                 of (CAR 
                                                                                            FILEDATES
                                                                                             ]
                                               (INFILEP SOURCEFILE)
                                               (EQUAL (FILEDATE SOURCEFILE)
                                                      (fetch FILEDATE of (CAR FILEDATES]
              then (/replace DATEFILENAME of (CAR FILEDATES) with SOURCEFILE)
                    (OR REPRINTFNS (SETQ REPRINTFNS (FILEPKG.CHANGEDFNS CHANGES)))
            elseif [AND (CDR FILEDATES)
                            [SETQ SOURCEFILE (INFILEP (fetch DATEFILENAME of (CADR FILEDATES]
                            (EQUAL (FILEDATE SOURCEFILE)
                                   (fetch FILEDATE of (CADR FILEDATES]
              then 

                    (* ;; "prevous version file is gone, drop back to original daddy file and dump everything that has been changed.")

                    (SETQ CHANGES (FILEPKG.MERGECHANGES (fetch TOBEDUMPED of FILEPROP)
                                         (fetch FILECHANGES of ROOTNAME)))
                    (SETQ REPRINTFNS (FILEPKG.CHANGEDFNS CHANGES))
            else (LISPXPRIN1 
                            '"can't find either the previous version or the original version of 
" T)
                  (LISPXPRIN2 FILE T T)
                  (LISPXPRIN1 '", so it will have to be written anew
" T)
                  (SETQ SOURCEFILE NIL)
                  (SETQ REPRINTFNS NIL)
                  (push OPTIONS 'NEW)
                  (SETQ CHANGES (fetch FILECHANGES of ROOTNAME))
                  (GO LP0))
          (COND
             ((AND SOURCEFILE (SETQ Z (SELECTQ (fetch LOADTYPE of FILEPROP)
                                          (LOADCOMP          (* ; 
                                                   "only loaded via LOADCOMP.  Need to do LOADFROM")
                                                    (LIST 'N SOURCEFILE "was loaded with LOADCOMP"
                                                          '- "LOADFROM it to obtain VARS/COMS"))
                                          (Compiled (AND (INFILECOMS? 'DONTCOPY 'DECLARE%:
                                                                (fetch COMSNAME of FILEPROP))
                                                         (LIST 'Y "only compiled version of" ROOTNAME
                                                               
                                        "was loaded; LOADVARS the (DECLARE .. DONTCOPY ) expressions"
                                                               )))
                                          ((compiled loadfns) 
                                               (LIST 'N "Only some functions from" SOURCEFILE 
                                             "loaded via LOADFNS. Load all other expressions from it"
                                                     ))
                                          NIL)))
              (SELECTQ [ASKUSER DWIMWAIT (CAR Z)
                              (CDR Z)
                              '((Y "es
")
                                (N "o
")
                                (A "bort MAKEFILE
"]
                  (Y (SELECTQ (fetch LOADTYPE of FILEPROP)
                         (LOADCOMP                           (* ; 
                               "file was never actually loaded, just loadcomped.  thus no filecoms")
                                   (LOADFROM SOURCEFILE))
                         (Compiled 

                                 (* ;; "This is going to be a remake.  If it was originally loaded as a compiled file, must first do a LOADFROM in order to get the properties set up by declare: etc.")

                                   (LOADVARS 'DONTCOPY SOURCEFILE)
                                   (/replace LOADTYPE of FILEPROP with 'COMPILED)
                                                             (* ; "So wont have to be done again.")

                                 (* ;; "These are the only DECLARE:'s that are not also on the compiled file.  Note that a DECLARE: DONTEVAL@LOAD will be found and evaluated, but the corresponding expressions won't be evaluated from within the DECLARE:  Not worthwhile to bother setting up a complicated edit pattern to screen these out, especially if you consider expressions like (DECLARE: -- DONTEVAL@LOAD -- DOEVAL@LOAD --)")

                                   )
                         ((loadfns compiled) 

                                 (* ;; "This is going to be a remake, but the original call to LOADFNS didnt specify all the VARS, so some expressions may not have been loaded.")

                              (LOADVARS T SOURCEFILE))
                         NIL))
                  (A (GO OUT))
                  NIL)))
          (RESETLST
              [COND
                 ((MEMB 'NOCLISP OPTIONS)
                  (RESETSAVE PRETTYTRANFLG T))
                 ((MEMB 'CLISP%  OPTIONS)
                  (RESETSAVE PRETTYTRANFLG 'BOTH]
              (RESETSAVE %#UNDOSAVES)
              [COND
                 ((OR (MEMB 'CLISPIFY OPTIONS)
                      (MEMB 'CLISP OPTIONS))
                  (RESETSAVE CLISPIFYPRETTYFLG T))
                 ((OR (EQ FILETYPE 'CLISP)
                      (MEMB 'CLISP (LISTP FILETYPE)))
                  (RESETSAVE CLISPIFYPRETTYFLG 'CHANGES]
              (for X in MAKEFILEFORMS do (ERSETQ (EVAL X)))
              (SETQ FILE (PRETTYDEF NIL FILE (fetch COMSNAME of FILEPROP)
                                REPRINTFNS SOURCEFILE CHANGES)))
          (SETQ LASTFILE ROOTNAME)
          (/replace TOBEDUMPED of FILEPROP with NIL)
          (COND
             ((NOT (EQMEMB 'DON'TLIST FILETYPE))
              (pushnew NOTLISTEDFILES ROOTNAME)))
          (COND
             ((NOT (EQMEMB 'DON'TCOMPILE FILETYPE))
              (pushnew NOTCOMPILEDFILES ROOTNAME)))
          [for TAIL OPT on OPTIONS do (SETQ OPT (CAR TAIL))
                                                 (SELECTQ OPT
                                                     (RC (AND (MEMB ROOTNAME NOTCOMPILEDFILES)
                                                              (MAKEFILE1 FILE T (CDR TAIL))))
                                                     (C (AND (MEMB ROOTNAME NOTCOMPILEDFILES)
                                                             (MAKEFILE1 FILE NIL (CDR TAIL))))
                                                     (LIST (AND (MEMB ROOTNAME NOTLISTEDFILES)
                                                                (APPLY 'LISTFILES (LIST FILE))))
                                                     (COND
                                                        ((MEMB OPT MAKEFILEOPTIONS))
                                                        ((FIXSPELL OPT NIL MAKEFILEOPTIONS NIL 
                                                                OPTIONS)
                                                         (GO $$LP))
                                                        (T (ERROR "Unrecognized MAKEFILE option" OPT]
          (RETURN FILE)
      OUT (RETURN (LIST FILE "-- MAKEFILE not performed."])

(FILECHANGES
  [LAMBDA (FILE TYPE)                                    (* bvm%: "30-Aug-86 15:08")

    (* ;; "If FILE is a list, it is assumed to be a file-created expressions;  otherwise, the filecreated expression is read from FILE.  If TYPE, returns the list of changed items of that type from the changes expression.  If TYPE=NIL, returns the whole list of typed change-lists")

    (PROG ([FCEXPR (OR (LISTP FILE)
                       (AND FILE (RESETLST
                                     (LET (OLDPTR STREAM)
                                          [if (SETQ STREAM (OPENP FILE 'INPUT))
                                              then (SETQ OLDPTR (GETFILEPTR STREAM))
                                                    (SETFILEPTR STREAM 0)
                                            else (RESETSAVE NIL (LIST 'CLOSEF
                                                                          (SETQ STREAM
                                                                           (OPENSTREAM FILE
                                                                                  'INPUT]
                                          (CL:MULTIPLE-VALUE-BIND (ENV FC)
                                                 (\PARSE-FILE-HEADER STREAM 'RETURN)
                                                 (if OLDPTR
                                                     then (SETFILEPTR STREAM OLDPTR))
                                                 FC)))]
           FNS CHANGES)
          (SETQ CHANGES (LDIFF (SETQ CHANGES (CDR (MEMB 'to%: FCEXPR)))
                               (MEMB 'previous CHANGES)))
          [if (AND TYPE (NEQ TYPE 'FNS))
              then (RETURN (CDR (ASSOC TYPE CHANGES]
          (SETQ FNS (SUBSET CHANGES (FUNCTION LITATOM)))     (* ; 
                         "Old style changes expression listed FNS by name and other things by type")
          (RETURN (if TYPE
                      then                               (* ; "TYPE=FNS cause of test above.")
                            (NCONC FNS (CDR (ASSOC 'FNS CHANGES)))
                    elseif FNS
                      then (CONS (CONS 'FNS FNS)
                                     (SUBSET CHANGES (FUNCTION LISTP)))
                    else CHANGES])

(FILEPKG.MERGECHANGES
  [LAMBDA (C1 C2)                                        (* rmk%: "24-MAY-82 23:09")

    (* ;; "Merges 2 changes lists into a single one.  Treat LITATOM's as FNS, to accomodate old-style format on files.")

    (for E2 TEMP (VAL _ (for E1 in C1 when (CDR (LISTP E1)) collect (APPEND
                                                                                         E1)))
       in C2 do [COND
                           ((SETQ TEMP (ASSOC (CAR E2)
                                              VAL))
                            (NCONC TEMP (for X in (CDR E2) unless (MEMBER X (CDR TEMP))
                                           collect X)))
                           (T (SETQ VAL (NCONC1 VAL (APPEND E2] finally (RETURN VAL])

(FILEPKG.CHANGEDFNS
  [LAMBDA (CHANGES)                                      (* rmk%: "20-MAY-82 22:00")

    (* ;; "Returns list of function names from a file-changes list.  Interprets old format (functions are atoms) and new format (with explicit type headers)")

    (CDR (ASSOC 'FNS CHANGES])

(MAKEFILE1
  [LAMBDA (FILE RECOMPFLG OPTIONS OTHERFILES)           (* ; "Edited 27-Oct-2020 15:40 by rmk:")
                                                             (* ; "Edited 29-Aug-89 11:46 by bvm")

    (* ;; "RMK:  Call COMPILE-FILE? with FILE instead of (ROOTFILENAME FILE)")

    (PROG ((ROOTNAME (ROOTFILENAME FILE))
           (COMPILER (COMPILE-FILE? FILE))
           GROUP)
          (COND
             ((AND (OR (EQ COMPILER 'BCOMPL)
                       (EQ COMPILER 'TCOMPL))
                   (NOT (FILEFNSLST ROOTNAME)))          (* ; 
                 "No FNS on this file, and we're told to use Interlisp compiler, so nothing to do.")
              (/SETTOPVAL 'NOTCOMPILEDFILES (REMOVE ROOTNAME NOTCOMPILEDFILES))
              (RETURN NIL)))
          (COND
             ([find X in (SETQ GROUP (GETPROP ROOTNAME 'FILEGROUP))
                 suchthat (AND (NEQ X ROOTNAME)
                                   (OR (fetch TOBEDUMPED of (fetch FILEPROP of X))
                                       (MEMB X OTHERFILES]

              (* ;; "The file in question must be recompiled with other files, and one of the remaining files still needs to be dumped, or else one of the other file is further down the list of files being compiled.  Wait.")

              (RETURN)))
          (LISPXPRIN1 '"
compiling " T)
          (LISPXPRINT (OR GROUP FILE)
                 T T)
          (LISPXPRINT (LET [[REDEFINE? (OR (EQ (CAR OPTIONS)
                                               'ST)
                                           (EQ (CAR OPTIONS)
                                               'STF]
                            (FORGET-EXPRS? (EQ (CAR OPTIONS)
                                               'STF]
                           (SELECTQ COMPILER
                               ((FAKE-COMPILE-FILE)          (* ; 
                                               "The old CommonLispy interface to the ByteCompiler.")
                                    (FAKE-COMPILE-FILE FILE :REDEFINE REDEFINE? :SAVE-EXPRS
                                           (AND REDEFINE? (NOT FORGET-EXPRS?))))
                               ((CL:COMPILE-FILE)            (* ; "The new, improved (?) compiler")
                                    (CL:COMPILE-FILE FILE :LOAD (COND
                                                                   ((AND REDEFINE? (NOT FORGET-EXPRS?
                                                                                        ))
                                                                    :SAVE)
                                                                   (REDEFINE? T)
                                                                   (T NIL))))
                               ((TCOMPL BCOMPL)              (* ; "The old ByteCompiler")
                                    [IF (MEMB (CAR OPTIONS)
                                                  '(ST F S STF))
                                        THEN (LISPXUNREAD (LIST (CAR OPTIONS]
                                    [IF GROUP
                                        THEN 

                                              (* ;; 
                                   "File contained in FILEGROUP.  Therefore must be blockcompiled.")

                                              (IF RECOMPFLG
                                                  THEN (BRECOMPILE GROUP)
                                                ELSE (BCOMPL GROUP))
                                      ELSEIF (EQ COMPILER 'TCOMPL)
                                        THEN (IF RECOMPFLG
                                                     THEN (RECOMPILE FILE)
                                                   ELSE (TCOMPL (LIST FILE)))
                                      ELSE (IF RECOMPFLG
                                                   THEN (BRECOMPILE FILE)
                                                 ELSE (BCOMPL (LIST FILE])
                               (SHOULDNT "Non-existent compiler returned from COMPILE-FILE?...")))
                 T T])

(COMPILE-FILE?
  [LAMBDA (FILE)                                        (* ; "Edited 27-Oct-2020 15:39 by rmk:")
                                                             (* ; "Edited 19-Jan-87 21:12 by Pavel")

    (* ;; "RMK: Argument is FILE instead of ROOTFILENAME, maybe more information")

(* ;;; "Which compiler should CLEANUP use?")

    (LET ((TYPE (GET (ROOTFILENAME FILE)
                     'FILETYPE))
          (UNKNOWN NIL))
         (FOR X INSIDE TYPE DO (SELECTQ X
                                               ((TCOMPL :TCOMPL) 
                                                    (RETURN 'TCOMPL))
                                               ((BCOMPL :BCOMPL) 
                                                    (RETURN 'BCOMPL))
                                               ((:FAKE-COMPILE-FILE CL:COMPILE-FILE COMPILE-FILE) 
                                                    (RETURN 'FAKE-COMPILE-FILE))
                                               ((:COMPILE-FILE :XCL-COMPILE-FILE) 
                                                    (RETURN 'CL:COMPILE-FILE))
                                               ((CLISP) 
                                                    NIL)
                                               (SETQ UNKNOWN T))
            FINALLY (IF UNKNOWN
                            THEN (CL:FORMAT T "~2%%**Warning: unknown FILETYPE value ~S~2%%" TYPE
                                            ))
                  (RETURN *DEFAULT-CLEANUP-COMPILER*])

(MAKEFILES
  [LAMBDA (OPTIONS FILES)                                (* rmk%: "23-FEB-83 21:20")
    (RESETVARS (%#UNDOSAVES)                                 (* ; 
                                                   "Willing to save arbitrary amounts of undo info")
               (UPDATEFILES)
               [COND
                  ((NULL FILES)
                   (for TYPE FLG in FILEPKGTYPES when [FILES?1 TYPE
                                                                         (COND
                                                                            ((NULL FLG)
                                                             (* ; "Gets printed the first time")
                                                                             
                                                                             '
                                        "****NOTE: the following are not contained on any file:
    ")
                                                                            (T '"    "]
                      do (SETQ FLG T) finally (AND FLG (ADDTOFILES?]
               (SETQ OPTIONS (MKLIST OPTIONS))
               (RETURN (for FILE inside (OR FILES FILELST)
                          when [fetch TOBEDUMPED of (LISTP (fetch FILEPROP
                                                                          of (ROOTFILENAME FILE]
                          collect (LISPXPRIN2 FILE T T)
                                (LISPXPRIN1 '|...| T)
                                (PROG1 (MAKEFILE FILE OPTIONS)
                                       (LISPXTERPRI T])

(ADDFILE
  [LAMBDA (FILE LOADTYPE PRLST FCLST)                    (* bvm%: "29-Aug-86 12:22")

    (* ;; "PRLST is the FILEPKGCHANGES prior to this file operation, FCLST is a list of file-created arguments, a singleton for a symbolic file, and a list whose car represents the compiled file and whose cdr represent symbolic files compiled into it, for compiled files.")

    (PROG ((ROOTNAME (ROOTFILENAME FILE))
           FLST VAL)
          [COND
             ((NOT FCLST)
              (SETQ VAL (ADDFILE0 ROOTNAME LOADTYPE FILE)))
             [(NULL (CDR FCLST))                             (* ; "A simple symbolic file")
              (SETQ FCLST (CAR FCLST))
              (SETQ VAL (ADDFILE0 (COND
                                         ((LITATOM (CADR FCLST))
                                          (ROOTFILENAME (CADR FCLST)))
                                         (T ROOTNAME))
                               LOADTYPE FILE (CAR FCLST]
             (T 
                (* ;; "A compiled file, skip the first expression representing the compiled file itself, look at the cdr representing the symbolic files.")

                (SELECTQ LOADTYPE
                    ((T LOADFNS) 
                         (SETQ LOADTYPE 'Compiled))
                    (loadfns (SETQ LOADTYPE 'compiled))
                    (LOADCOMP                                (* ; 
                   "loadcomp on compiled file.  Don't notice since we don't know what its state is")
                              NIL)
                    (SHOULDNT))
                (for X in (CDR FCLST) when (LITATOM (CADR X))
                   do (push FLST (CADR X))
                         (OR (EQ LOADTYPE 'LOADCOMP)
                             (ADDFILE0 (ROOTFILENAME (CADR X))
                                    LOADTYPE
                                    (CADR X)
                                    (CAR X]
          (UPDATEFILES PRLST (OR FLST (LIST FILE)))
          [AND LOADTYPE (for TYPE CHANGED in FILEPKGTYPES
                           when (AND (LITATOM TYPE)
                                         (SETQ CHANGED (fetch CHANGED of TYPE)))
                           do (/replace CHANGED of TYPE
                                     with (INTERSECTION (CDR (ASSOC TYPE PRLST))
                                                     CHANGED]
          (AND ADDSPELLFLG (ADDSPELL ROOTNAME USERWORDS))
          (RETURN VAL])

(ADDFILE0
  [LAMBDA (ROOTNAME LOADTYPE FULLNAME DAT)               (* lmm "28-Nov-84 16:47")
    (PROG (COMS X FILEPROP FLG TEM)
      TOP (SETQ COMS (FILECOMS ROOTNAME))
          [COND
             ((SETQ FILEPROP (fetch FILEPROP of ROOTNAME))
              (COND
                 ([AND LOADTYPE (FMEMB LOADTYPE
                                       (CDR (FMEMB (fetch LOADTYPE of FILEPROP)
                                                   '(LOADCOMP loadfns compiled Compiled LOADFNS 
                                                           COMPILED NIL T]
                  (/replace LOADTYPE of FILEPROP with LOADTYPE)

                  (* ;; "This call to ADDFILE reflects a 'higher' degree of loading, so upgrade property.  'loadfns' means just some information from file, if go to do makefile, must do loadfrom, 'compiled' is like 'loadfns' but for compiled files e.g. user does LOADFNS on compiled file.  'Compiled' means all but DECLARE: expressions are in.  e.g. user does LOAD of a compiled file.  COMPILED means everything is in, e.g. user does LOADDFROM a compiled file.  LOADFNS means everything in, e.g. user des LOADFROM symbolic file.  COMPILED and LOADFNS are equivalent in that means dont have to do any more loading when go to do a makefile but makefile NEW isnt permitted.  NIL is a makefile when coms were set up in core.  T is full load of symbolic file.  The check on TYPE=NIL is bcause dont want to upgrade as result of call from makefile, i.e. no new information there.")

                  (* ;; "LOADCOMP means file was loadcomp'ed.  note that the actual structure is a tree, not a list, and the above is only an approximation.  if you do a loadcomp, and then load the compiled file, the state will be left with latter, but then loadcomp? will loadcomp again because compiled files might not contain all the declare: EVAL@COMPILE expressions, e.g. macros, records etc.  however, in most cases, loadcomp is used independently of other loading, e.g. for compilation purposes only, so this will at least permit loadcomp? to work.")

                  (GO OUT))
                 (T (GO OUT1]
          (COND
             [(OR LOADTYPE (LISTP (GETTOPVAL COMS)))
              (SETQ FILEPROP (/replace FILEPROP of ROOTNAME
                                with (create FILEPROP
                                                COMSNAME _ COMS
                                                LOADTYPE _ LOADTYPE]
             (FLG (GO ERROR))
             ((AND DWIMFLG (EQ ROOTNAME FULLNAME)
                   (SETQ ROOTNAME (MISSPELLED? ROOTNAME 70 FILELST T)))

              (* ;; "The EQ check is so as not to try correcting if the user has specified a version number or directory, as it is too messy trying to take them out, and then put them back in on the corrected root name.")

              (SETQ FULLNAME ROOTNAME)
              (SETQ FLG T)                                   (* ; 
                                         "so wont try to spelling correct again if file isnt there")
              (GO TOP))
             (T (GO ERROR)))
      OUT [AND LOADTYPE DAT (/replace FILEDATES of ROOTNAME
                               with (LIST (create FILEDATEPAIR
                                                     FILEDATE _ DAT
                                                     DATEFILENAME _ FULLNAME]
          (AND (EQ LOADTYPE T)
               (/replace TOBEDUMPED of FILEPROP with NIL))
      OUT1
          [COND
             ([AND (LISTP (GETTOPVAL COMS))
                   (NOT (FMEMB ROOTNAME (GETTOPVAL 'FILELST] (* ; 
                                                          "coms wuld not be set up on a loadccomp.")
              (/SETTOPVAL 'FILELST (CONS ROOTNAME (GETTOPVAL 'FILELST]
          (RETURN (COND
                     ((NULL LOADTYPE)                        (* ; "call from makefile.")
                      (CONS FULLNAME (CONS ROOTNAME FILEPROP)))
                     (T FILEPROP)))
      ERROR
          (ERROR FULLNAME "not file name." T])

(LISTFILES
  [NLAMBDA FILES                                         (* rmk%: " 3-Dec-84 08:58")
    (DECLARE (GLOBALVARS NOTLISTEDFILES))                (* ; "LISTFILES1 is machinedependent")
    (for FILE FULLNAME OPTIONS in (COND
                                             (FILES (SETQ FILES (NLAMBDA.ARGS FILES)))
                                             (T NOTLISTEDFILES))
       when (COND
                   ((LISTP FILE)
                    (SETQ OPTIONS (APPEND FILE OPTIONS))
                    NIL)
                   ((SETQ FULLNAME (FINDFILE FILE))
                    FULLNAME)
                   (T (printout T FILE " not found." T)
                      NIL)) collect [COND
                                           ((LISTFILES1 FULLNAME OPTIONS)
                                            (SETQ NOTLISTEDFILES (REMOVE (NAMEFIELD FULLNAME T)
                                                                        NOTLISTEDFILES]
                                  FULLNAME])
)

(RPAQ? *DEFAULT-CLEANUP-COMPILER* 'CL:COMPILE-FILE)

(RPAQ? FILELST )

(RPAQ? LOADEDFILELST )

(RPAQ? NOTLISTEDFILES )

(RPAQ? NOTCOMPILEDFILES )

(RPAQ? MAKEFILEFORMS )

(RPAQ? NILCOMS )

(ADDTOVAR MAKEFILEOPTIONS RC C LIST FAST CLISP CLISPIFY NIL REMAKE NEW NOCLISP CLISP%  F ST STF
                                 (REC . RC)
                                 (BREC . RC)
                                 (TC . C)
                                 (BC . C)
                                 (TCOMPL . C)
                                 (BCOMPL . C))

(RPAQ? MAKEFILEREMAKEFLG T)

(RPAQ? CLEANUPOPTIONS '(RC))



(* ;; "scanning file coms")

(DEFINEQ

(FILEPKGCHANGES
  [LAMBDA N                                              (* Pavel " 7-Oct-86 19:22")
    (COND
       [(EQ N 0)
        (PROG (TEM)
              (RETURN (for X in FILEPKGTYPES when (AND (LITATOM X)
                                                                   (SETQ TEM (FILEPKGCHANGES
                                                                              X)))
                         collect (CONS X TEM]
       [(EQ (ARG N 1)
            T)
        (for X in FILEPKGTYPES when (LITATOM X) collect (CONS X (FILEPKGCHANGES
                                                                                 X]
       [(EQ N 1)
        (COND
           [(LISTP (ARG N 1))
            (for X in (ARG N 1) when (FMEMB (CAR X)
                                                        FILEPKGTYPES)
               do (/replace CHANGED of (CAR X) with (CDR X]
           (T (for Y on (fetch CHANGED of (ARG N 1))
                 when [AND (CAR Y)
                               (NOT (for Z in (CDR Y) thereis (CL:EQUAL (CAR Y)
                                                                                 Z]
                 collect (CAR Y]
       (T (/replace CHANGED of (ARG N 1) with (ARG N 2])

(GETFILEPKGTYPE
  [LAMBDA (TYPE ONLY NOERROR NAME)                       (* lmm "20-Nov-86 23:10")

    (* ;; "Coerce TYPE to a well defined definition type (FILEPKG type) or a command. ONLY is an indicator of which is acceptable; if NIL, either one is acceptable, if COMS, only commands are acceptable, and if TYPES, only types should be returned. If none is found, will signal an error if NOERROR is NIL, otherwise return NIL. ")

    (COND
       [(LISTP TYPE)

        (* ;; " given a list of types, coerce them all or return NIL")

        (for X in TYPE collect (OR (GETFILEPKGTYPE X ONLY NOERROR NAME)
                                               (RETURN]
       ((EQ TYPE '?)

        (* ;; "odd case, may be obsolete: if given IL:?, return all known types of NAME. Maybe used by EDITDEF(NAME ?)?? ")

        (AND NAME (TYPESOF NAME)))
       [(AND (NEQ ONLY 'COMS)
             (OR (SELECTQ TYPE
                     (NIL 'FNS)
                     (T 'VARS)
                     NIL)
                 (for X in FILEPKGTYPES do (if (EQ TYPE X)
                                                           then 

                                                                 (* ;; "type matched exactly")

                                                                 (RETURN TYPE)
                                                         elseif (AND (LISTP X)
                                                                         (EQ TYPE (CAR X)))
                                                           then (RETURN (CDR X]
       [(AND (NEQ ONLY 'TYPE)
             (LITATOM TYPE)
             (PROG1 (CAR (FMEMB TYPE FILEPKGCOMSPLST))       (* ; "Prefer an exact match quickly")
                    ]
       [(AND (NEQ ONLY 'COMS)
             (LITATOM TYPE)
             (for X in FILEPKGTYPES bind NAME
                do (SETQ NAME (if (NLISTP X)
                                      then X
                                    else (CAR X))) 

                      (* ;; "see if spelled the same or 1 char shorter; assume all FILEPKGTYPE names end with S. This handles package conversions and also pluralization")

                      (AND (<= 0 (- (NCHARS NAME)
                                    (NCHARS TYPE))
                               1)
                           (STRPOS TYPE NAME)
                           (RETURN (if (EQ X NAME)
                                       then X
                                     else (CDR X]
       [(FIXSPELL TYPE NIL (SELECTQ ONLY
                               (TYPE FILEPKGTYPES)
                               (COMS FILEPKGCOMSPLST)
                               (UNION FILEPKGTYPES FILEPKGCOMSPLST]
       ((NOT NOERROR)
        (ERROR (SELECTQ ONLY
                   (TYPE "unrecognized manager definition type")
                   (COMS "unrecognized manager command")
                   "unrecognized manager definition-type/command")
               TYPE])

(MARKASCHANGED
  [LAMBDA (NAME TYPE REASON)                             (* ; "Edited 25-May-88 15:37 by drc:")
    (COND
       (FILEPKGFLG (SETQ REASON (SELECTQ REASON
                                    ((CLISP LOAD CHANGED DEFINED DELETED) 
                                         REASON)
                                    (NIL 'CHANGED)
                                    (T 'DEFINED)
                                    (ERROR "bad REASON in MARKASCHANGED" REASON)))
              (SETQ TYPE (GETFILEPKGTYPE TYPE 'TYPE))
              (for FN inside (fetch WHENCHANGED of TYPE)
                 do (APPLY* FN NAME TYPE REASON))
              (for FN in MARKASCHANGEDFNS do (APPLY* FN NAME TYPE REASON))
              [COND
                 ((EQ REASON 'DELETED)
                  (for L on (fetch CHANGED of TYPE) when (EQUAL (CAR L)
                                                                                    NAME)
                     do (/RPLACA L NIL))                 (* ; 
                                                          "unmark as changed and remove from files")
                  (DELFROMFILES NAME TYPE))
                 (T (LET ((LST (push (fetch CHANGED of TYPE)
                                      NAME)))
                         (AND LISPXHIST (UNDOSAVE (LIST '/RPLACA LST)
                                               LISPXHIST))   (* ; 
                             "UNDO by smashing with NIL;  makes calls to MARKASCHANGED independent")
                         ]
              NAME])

(FILECOMS
  [LAMBDA (FILE X)                                       (* rmk%: "19-FEB-83 13:55")
    (COND
       ((AND (NULL FILE)
             (NULL X))
        'NILCOMS)
       [(AND (OR (NULL X)
                 (EQ X 'COMS))
             (fetch COMSNAME of (LISTP (fetch FILEPROP of FILE]
       (T (PACK* (NAMEFIELD FILE)
                 (OR X 'COMS])

(WHEREIS
  [LAMBDA (NAME TYPE FILES FN)                        (* ; "Edited 12-Jul-88 17:14 by MASINTER")

    (* ;; "T as a NAME has a special meaning to INFILECOMS?  so don't pass through.")

    (CL:UNLESS (EQ NAME T)
        (LET [(IN-FILES (UNION [SUBSET (OR (LISTP FILES)
                                           FILELST)
                                      (FUNCTION (LAMBDA (FILE)
                                                  (INFILECOMS? NAME TYPE (FILECOMS FILE]
                               (AND (EQ FILES T)
                                    (CL:FBOUNDP 'XCL::HASH-FILE-WHERE-IS)
                                    (LET ((FILES NIL))
                                         (for TY inside TYPE
                                            do (for FILE-NAME
                                                      in (XCL::HASH-FILE-WHERE-IS NAME
                                                                    (GETFILEPKGTYPE TYPE))
                                                      do (CL:PUSHNEW (MKATOM (U-CASE FILE-NAME))
                                                                    FILES)))
                                         (REVERSE FILES]
             (CL:IF FN
                 [MAPC IN-FILES (FUNCTION (LAMBDA (FILE)
                                            (APPLY* FN NAME FILE]
                 IN-FILES)))])

(SMASHFILECOMS
  [LAMBDA (FILE)                                         (* rmk%: "19-FEB-83 22:15")
    (for X in (FILECOMSLST FILE 'FILEVARS) when (LITATOM X)
       do (SETTOPVAL X 'NOBIND))
    FILE])

(FILEFNSLST
  [LAMBDA (FILE)                                         (* ; "Edited 14-Jun-90 19:30 by jds")
    (FILECOMSLST FILE '(FUNCTIONS FNS])

(FILECOMSLST
  [LAMBDA (FILE TYPE FLG)                                (* JonL "24-Jul-84 19:48")
                                                             (* ; 
                                                    "TYPE is coerced in the innards of INFILECOMS?")
    (COND
       ((EQ FLG 'UPDATE)
        (CDR (INFILECOMS? NIL TYPE (FILECOMS FILE)
                    FLG)))
       (T (INFILECOMS? NIL TYPE (FILECOMS FILE)
                 FLG])

(UPDATEFILES
  [LAMBDA (PRLST FLST)                                   (* rmk%: "19-FEB-83 14:27")

    (* ;; "PRLST may be the value of FILEPKGCHANGES before some operation (e.g.  LOAD, LOADFNS) involving the files in FLST began.")

    (for TYPE CHANGED in FILEPKGTYPES when (SETQ CHANGED (fetch CHANGED of TYPE))
       do (COND
                 ((NULL (SETQ CHANGED (FILEPKGCHANGES TYPE)))
                                                             (* ; 
                                                           "FILEPKGCHANGES eliminates duplicates")
                  (/replace CHANGED of TYPE with NIL))
                 (T (for FILE FOUND FILEPROP COMS LST TYPEDPROP PCHANGES
                           (PREVITEMS _ (CDR (ASSOC TYPE PRLST))) in FILELST
                       first (SETQ LST (INFILECOMS? CHANGED TYPE 'NILCOMS 'UPDATE)) 

                             (* ;; "First check NIL=Nowhere.  LST:1 contains variables whose values are on the file literally.  These are `found' but not marked.  LST::1 contains all other items.")

                             (SETQ FOUND (NCONC (CAR LST)
                                                (CDR LST)
                                                FOUND))
                       do (SETQ PCHANGES (COND
                                                ((FMEMB (fetch DATEFILENAME
                                                           of (CAR (fetch FILEDATES
                                                                          of FILE)))
                                                        FLST)

                                 (* ;; "PREVITEMS are changed items that were previously on the changed list, before PRLST was computed as this LOAD/LOADFNS began.  Thus, by this intersection we only worry about items that were previously changed;  any items that were only changed during this operation are ignored.")

                                                 (INTERSECTION CHANGED PREVITEMS))
                                                (T CHANGED)))
                             [COND
                                ([AND PCHANGES [SETQ COMS (fetch COMSNAME
                                                             of (SETQ FILEPROP
                                                                     (LISTP (fetch FILEPROP
                                                                               of FILE]
                                      (SETQ LST (INFILECOMS? PCHANGES TYPE COMS 'UPDATE]

                                 (* ;; "LST:1 is a list of the times that literally appear on this file, LST::1 is a list of those whose literal values are not in the coms")

                                 [COND
                                    ((CDR LST)               (* ; "CDR items must be distributed")
                                     [COND
                                        ((NULL (fetch TOBEDUMPED of FILEPROP))

                                         (* ;; "Only finagle global lists the first time an item is added to PROP, when PROP::1 goes from NIL to non-NIL")

                                         [/SETTOPVAL 'NOTLISTEDFILES (REMOVE FILE (GETTOPVAL
                                                                                   'NOTLISTEDFILES]
                                         (/SETTOPVAL 'NOTCOMPILEDFILES (REMOVE FILE
                                                                              (GETTOPVAL 
                                                                                     '
                                                                                     NOTCOMPILEDFILES
                                                                                     ]
                                                             (* ; 
                                                   "Get the (possibly new) TYPE item list to smash")
                                     [COND
                                        [(SETQ TYPEDPROP (ASSOC TYPE (fetch TOBEDUMPED
                                                                        of FILEPROP]
                                        (T (/NCONC1 FILEPROP (SETQ TYPEDPROP (CONS TYPE]
                                                             (* ; 
                                                        "Now distribute items to the file property")
                                     (for Y in (CDR LST) unless (MEMBER Y (CDR TYPEDPROP)
                                                                                   )
                                        do (/NCONC1 TYPEDPROP Y]
                                 (SETQ FOUND (NCONC (CAR LST)
                                                    (CDR LST)
                                                    FOUND] finally (/replace CHANGED
                                                                          of TYPE
                                                                          with (LDIFFERENCE
                                                                                    CHANGED FOUND])

(INFILECOMS?
  [LAMBDA (NAME TYPE COMS ONFILETYPE)                 (* ; "Edited 12-Jul-88 17:42 by MASINTER")

    (* ;; "Returns T if NAME is 'CONTAINED' in COMS.  If NAME is NIL, then value is a list of all of the functions contained in COMS.  If NAME=T, value is T if there are any elements of type TYPE, otherwise NIL (this feature is used for deciding whether or not (and how) to compile files.)  Called by FILEFNSLST (which is used by BRECOMPILE) and by NEWFILE1.  while elements are the subset of NAME which are on the file in other case")

    (* ;; "if ONFILETYPE is UPDATE, then NAME is a list of elements, and INFILECOMS?  returns the dotted pair of (literals  . elements) where literals are those which are `literally' on the file (e.g.  (VARS (X 3))) --- if ONEFILETYPE is EDIT, then NAME is interpreted as for ONFILETYPE=NIL, but only those elements which are not on the file literally and which are not subparts of other types are returned")

    (* ;; "if ONFILETYPE is TYPESOF, type can be a list of types, and returns a list of types suitable for EDITDEF ")

    (PROG (VAL LITERALS ORIGFLG)
          (SETQ TYPE (GETFILEPKGTYPE TYPE))
          (SELECTQ ONFILETYPE
              (EDIT (SELECTQ TYPE
                        (FILEVARS (RETURN))
                        NIL))
              NIL)
          [COND
             ((LITATOM COMS)
              (SELECTQ TYPE
                  ((VARS FILEVARS)                           (* ; 
                                                           "the COMS of a file are also on it")
                       (INFILECOMSVAL COMS))
                  NIL)
              (SETQ COMS (EVALV COMS]
          (INFILECOMS COMS)
          (SETQ VAL (DREVERSE VAL))
          (RETURN (COND
                     ((EQ ONFILETYPE 'UPDATE)
                      (CONS LITERALS VAL))
                     (T VAL])

(INFILECOMTAIL
  [LAMBDA (COM FLG)                                   (* ; "Edited  2-Aug-88 02:15 by masinter")
    [SETQ COM (COND
                 ((EQ (CADR COM)
                      '*)
                  (COND
                     [(LITATOM (CADDR COM))
                      (LISTP (EVALV (CADDR COM]
                     (T [RESETVARS (DWIMLOADFNSFLG)
                                   (NLSETQ (SETQ COM (EVAL (CADDR COM]
                        COM)))
                 (T (CDR COM]
    (if (NOT FLG)
        then (for X in COM
                    do [if (AND (LISTP X)
                                        (EQ (CAR X)
                                            COMMENTFLG))
                               then (RETURN (SUBSET COM (FUNCTION (LAMBDA (X)
                                                                        (OR (NLISTP X)
                                                                            (NEQ (CAR X)
                                                                                 COMMENTFLG]
                    finally (RETURN COM))
      else COM])

(INFILECOMS
  [LAMBDA (COMS)                                         (* rmk%: "19-FEB-83 22:17")
    (for X in COMS do (INFILECOM X])

(INFILECOM
  [LAMBDA (COM)                                       (* ; "Edited  2-Aug-88 02:27 by masinter")
    (COND
       [(NLISTP COM)
        (COND
           ((EQ TYPE 'VARS)
            (INFILECOMSVAL COM]
       ((EQ (CAR COM)
            COMMENTFLG)

        (* ;; 
"must be special case'd first so that (* * values) doesn't make it look like `values' is a variable")
                                                             (* ; 
  "don't know why I should bother, but someone might want to know all of the comments on a file???")
        (COND
           ((EQ TYPE COMMENTFLG)
            (INFILECOMSVAL COM T)))
        NIL)
       (T
        (PROG ((COMNAME (CAR COM))
               (TAIL (CDR COM))
               CFN TEM)
              (COND
                 [[COND
                     ((SETQ CFN (fetch (FILEPKGCOM CONTENTS) of COMNAME))
                      (SETQ TEM (APPLY* CFN COM (COND
                                                   ((AND (NULL ONFILETYPE)
                                                         (NOT (CL:SYMBOLP NAME)))
                                                             (* ; 
                                                "call from WHEREIS of a name which is not a symbol")
                                                    (LIST NAME))
                                                   (T NAME))
                                       TYPE ONFILETYPE)))
                     ((SETQ CFN (fetch (FILEPKGCOM PRETTYTYPE) of COMNAME))
                                                             (* ; "for compatability")
                      (SETQ TEM (APPLY* CFN COM TYPE NAME]
                  (COND
                     [(NLISTP TEM)
                      (COND
                         ((EQ TEM T)
                          (COND
                             ((OR (EQ NAME T)
                                  (NULL ONFILETYPE))
                              (RETFROM 'INFILECOMS? T]
                     (T (INFILECOMSVALS TEM]
                 ((LISTP TAIL)

                  (* ;; "this SELECTQ handles the `exceptional cases' for the built in types.  There is an explicit RETURN in the SELECTQ clause if the default is handled")

                  (SELECTQ COMNAME
                      ((PROP IFPROP) 
                           (SETQ TAIL (CDR TAIL)))
                      NIL)
                  [COND
                     ((EQ (CAR TAIL)
                          '*)
                      (COND
                         ((LITATOM (CADR TAIL))
                          (SELECTQ TYPE
                              ((VARS FILEVARS) 
                                   (INFILECOMSVAL (CADR TAIL)))
                              NIL))
                         ((AND (LISTP (CADR TAIL))
                               (EQ ONFILETYPE 'UPDATE)
                               (EQ TYPE 'VARS)
                               (EQ (CAADR TAIL)
                                   'PROGN)
                               (FMEMB (CAR (LAST (CADR TAIL)))
                                      NAME))
                          (SETQ VAL (CONS (CADR TAIL)
                                          VAL]
                  (SELECTQ COMNAME
                      ((COMS EXPORT) 
                           (INFILECOMS (INFILECOMTAIL COM T)))
                      (CL:EVAL-WHEN (INFILECOMS (INFILECOMTAIL (CDR COM)
                                                           T)))
                      (DECLARE%:                             (* ; "skip over DECLARE: tags")
                                 [RETURN (AND (NOT (FMEMB 'COMPILERVARS COM))
                                              (IFCDECLARE (INFILECOMTAIL COM)
                                                     (EQ TYPE 'DECLARE%:])
                      (ORIGINAL                              (* ; "dont expand macros")
                                (PROG ((ORIGFLG T))
                                      (INFILECOMS (INFILECOMTAIL COM T))))
                      ((PROP IFPROP)                         (* ; 
                                       "this currently does not handle `pseudo-types' of PROPNAMES")
                           (SELECTQ TYPE
                               (PROPS (IFCPROPSCAN (INFILECOMTAIL (CDR COM)
                                                              T)
                                             (CADR COM)))
                               (MACROS (INFILECOMSMACRO (INFILECOMTAIL (CDR COM))
                                              (CADR COM)))
                               NIL))
                      (PROPS (RETURN (IFCPROPS COM)))
                      (MACROS (RETURN (SELECTQ TYPE
                                          (PROPS (IFCPROPSCAN (INFILECOMTAIL COM T)
                                                        MACROPROPS))
                                          (MACROS (INFILECOMSVALS (INFILECOMTAIL COM T)))
                                          NIL)))
                      (ALISTS                                (* ; 
                      "sigh.  This should probably also `coerce' when asking for LISPXMACROS, etc.")
                              (RETURN (SELECTQ TYPE
                                          (ALISTS (INFILEPAIRS (INFILECOMTAIL COM)))
                                          NIL)))
                      (P [RETURN (SELECTQ TYPE
                                     ((EXPRESSIONS P) 
                                          (INFILECOMSVALS (INFILECOMTAIL COM T)
                                                 T))
                                     (COND
                                        ((NULL ONFILETYPE)   (* ; "for WHEREIS and FILECOMSLST")
                                         (SELECTQ TYPE
                                             (I.S.OPRS (IFCEXPRTYPE COM 'I.S.OPR))
                                             (TEMPLATES (IFCEXPRTYPE COM 'SETTEMPLATE))
                                             NIL])
                      ((ADDVARS APPENDVARS) 
                           (SELECTQ TYPE
                               (VARS [RETURN (AND (NULL ONFILETYPE)
                                                  (for X in (INFILECOMTAIL COM T)
                                                     do (INFILECOMSVAL (CAR X)
                                                                   T])
                               (ALISTS [RETURN (for X in (INFILECOMTAIL COM T)
                                                  when (EQMEMB 'ALIST (GETPROP (CAR X)
                                                                                 'VARTYPE))
                                                  do (for Z in (CDR X)
                                                            do (INFILECOMSVAL
                                                                    (LIST (CAR X)
                                                                          (CAR Z))
                                                                    T])
                               (OR (EQ TYPE COMNAME)
                                   (RETURN))))
                      ((VARS INITVARS FILEVARS UGLYVARS HORRIBLEVARS CONSTANTS ARRAY) 
                           [RETURN (COND
                                      ((EQ TYPE 'EXPRESSIONS)
                                       (for X in (INFILECOMTAIL COM T)
                                          when (AND (LISTP X)
                                                        (NEQ (CAR X)
                                                             COMMENTFLG))
                                          do (INFILECOMSVAL (CONS 'SETQ X)
                                                        T)))
                                      ((OR (EQ TYPE 'VARS)
                                           (EQ TYPE COMNAME))(* ; 
                   "either want all VARS, or else want all FILEVARS and this is a FILEVARS command")
                                       (for X in (INFILECOMTAIL COM T)
                                          do (COND
                                                    ((LISTP X)
                                                     (AND (CAR X)
                                                          (NEQ (CAR X)
                                                               COMMENTFLG)
                                                          (INFILECOMSVAL (CAR X)
                                                                 T)))
                                                    (X (INFILECOMSVAL X (EQ COMNAME 'INITVARS])
                      (DEFS [RETURN (for X in (INFILECOMTAIL COM T)
                                       when (EQ TYPE (CAR X)) do (INFILECOMSVALS
                                                                          (CDR X])
                      (FILES (RETURN))
                      NIL)

                  (* ;; "Exceptional cases now handled.  If TYPE matches (CAR COM) then scan the tail as usual.  Else expand the com's MACRO, if it has one, unless there was a CONTENTS function")

                  (COND
                     ((EQ COMNAME TYPE)
                      (INFILECOMSVALS (INFILECOMTAIL COM T)))
                     [(AND (LISTP TYPE)
                           (FMEMB COMNAME TYPE))
                      (LET ((TYPE COMNAME))
                           (INFILECOMSVALS (INFILECOMTAIL COM T]
                     ((AND (OR (NULL CFN)
                               (AND (EQ CFN T)
                                    (NULL ONFILETYPE)))
                           (NULL ORIGFLG)
                           (SETQ TEM (fetch (FILEPKGCOM MACRO) of COMNAME)))
                      (INFILECOMS (SUBPAIR (CAR TEM)
                                             (INFILECOMTAIL COM T)
                                             (CDR TEM])

(INFILECOMSVALS
  [LAMBDA (X FLG)                                     (* ; "Edited  2-Aug-88 02:21 by masinter")
    (for Y in X when (NOT (AND (LISTP Y)
                                           (EQ (CAR Y)
                                               COMMENTFLG))) do (INFILECOMSVAL Y FLG])

(INFILECOMSVAL
  [LAMBDA (X FLG)                                     (* ; "Edited 12-Jul-88 17:56 by MASINTER")
    (COND
       [(EQ ONFILETYPE 'UPDATE)
        (AND (OR (NULL NAME)
                 (MEMBER X NAME))
             (COND
                (FLG (SETQ LITERALS (CONS X LITERALS)))
                (T (SETQ VAL (CONS X VAL]
       ((AND (EQ ONFILETYPE 'EDIT)
             FLG)                                            (* ; 
                                        "literals should not be edited as they are on the fileCOMS")
        NIL)
       ((EQ ONFILETYPE 'TYPESOF)
        (AND (COND
                ((LITATOM NAME)
                 (EQ NAME X))
                (T (EQUAL NAME X)))
             (CL:PUSHNEW TYPE VAL)))
       ([OR (EQ NAME T)
            (COND
               ((LITATOM NAME)
                (EQ NAME X))
               (T (EQUAL NAME X]
        (RETFROM (FUNCTION INFILECOMS?)
               T))
       ((NULL NAME)
        (SETQ VAL (CONS X VAL])

(INFILECOMSPROP
  [LAMBDA (AT PROP)                                      (* lmm "25-SEP-81 17:15")
    (COND
       [(EQ ONFILETYPE 'UPDATE)
        (AND [OR (NULL NAME)
                 (find X in NAME suchthat (AND (EQ (CAR X)
                                                               AT)
                                                           (EQ (CADR X)
                                                               PROP]
             (SETQ VAL (CONS (LIST AT PROP)
                             VAL]
       ((OR (EQ NAME T)
            (AND (EQ (CAR NAME)
                     AT)
                 (EQ (CADR NAME)
                     PROP)))
        (RETFROM (FUNCTION INFILECOMS?)
               T))
       ((NULL NAME)
        (SETQ VAL (CONS (LIST AT PROP)
                        VAL])

(IFCPROPS
  [LAMBDA (COM)                                          (* bvm%: " 2-Dec-83 14:24")

(* ;;; "Examine a PROPS com for objects of specified TYPE")

    (SELECTQ TYPE
        (PROPS                                               (* ; 
                                       "the PROPS command can actually take (PROPNAME at1 at2 ...)")
               (INFILEPAIRS (INFILECOMTAIL COM)))
        (PROP                                                (* ; 
                                                "return the atoms which have any properties at all")
              (for PAIR in (INFILECOMTAIL COM) do (for ATNAME
                                                                     inside (CAR PAIR)
                                                                     do (INFILECOMSVAL ATNAME
                                                                                   ))))
        (MACROS                                              (* ; "only MACRO properties")
                (for PAIR in (INFILECOMTAIL COM) do (INFILECOMSMACRO (CAR PAIR)
                                                                           (CDR PAIR))))
        NIL])

(IFCEXPRTYPE
  [LAMBDA (COM FN)                                       (* ; "Edited  6-Apr-87 20:20 by Pavel")

(* ;;; "Recognizes expressions in COM (a P com) that are calls to function FN")

    (for SUBCOM in (INFILECOMTAIL COM)
       when (AND (EQ (CAR SUBCOM)
                         FN)
                     (EQ (CAR (LISTP (CADR SUBCOM)))
                         'QUOTE)) do (INFILECOMSVAL (CADR (CADR SUBCOM))
                                                T])

(IFCPROPSCAN
  [LAMBDA (ATOMS PROPNAMES)                           (* ; "Edited  2-Aug-88 02:20 by masinter")

(* ;;; 
"Recognizes members of ATOMS as being names (atom prop) of type PROPS for any prop in PROPNAMES")

    (for AT in ATOMS WHEN (LITATOM AT) unless [COND
                                                                 [(EQ ONFILETYPE 'UPDATE)
                                                                  (COND
                                                                     (NAME (NOT (ASSOC AT NAME]
                                                                 ((LISTP NAME)
                                                                  (NEQ AT (CAR NAME]
       do (COND
                 ((EQ PROPNAMES 'ALL)
                  (for PROP in (GETPROPLIST AT) by (CDDR PROP)
                     when (NOT (FMEMB PROP SYSPROPS)) collect (INFILECOMSPROP AT PROP)))
                 (T (for PROP inside PROPNAMES do (INFILECOMSPROP AT PROP])

(IFCDECLARE
  [LAMBDA (TAIL WANTDECLARE)                          (* ; "Edited  8-Jun-90 18:11 by teruuchi")
    (PROG ((TAIL TAIL))
      LP  (COND
             ((LISTP TAIL)
              [SELECTQ (CAR TAIL)
                  ((EVAL@LOADWHEN EVAL@COMPILEWHEN COPYWHEN) 
                       [AND WANTDECLARE (INFILECOMSVAL (LIST (CAR TAIL)
                                                                 (CADR TAIL]
                       (SETQ TAIL (CDR TAIL)))
                  (DONTEVAL@LOAD [COND
                                    ((OR (\STKSCAN 'DOFILESLOAD)
                                         (\STKSCAN 'LOAD))
                                                  (* ; "Edited by TT (8-June-90 : for AR#9376) In loading, discard the following contents in DECLARE tag %"DONTEVAL@LOAD%"")
                                     (RETURN))
                                    (WANTDECLARE (INFILECOMSVAL (CAR TAIL])
                  (COMPILERVARS (RETURN))
                  (COND
                     [(FMEMB (CAR TAIL)
                             DECLARETAGSLST)
                      (COND
                         (WANTDECLARE (INFILECOMSVAL (CAR TAIL]
                     (T (INFILECOM (CAR TAIL]
              (SETQ TAIL (CDR TAIL))
              (GO LP])

(INFILEPAIRS
  [LAMBDA (LST)                                          (* lmm " 4-DEC-78 09:51")
    (for LL in LST do (for X inside (CAR LL)
                                     do (for Y inside (CDR LL)
                                               do (INFILECOMSVAL (LIST X Y])

(INFILECOMSMACRO
  [LAMBDA (ATS PROPS)                                    (* lmm "28-SEP-78 18:35")

    (* ;; "this function is used, given a PROP or PROPS command, to tell which MACROS are contained in it.  --- Normally (e.g.  for WHEREIS and FILECOMSLST) it wants to return if the command contains any of the MACROPROPS for the given atom.  However, for UPDATE, it only wants a `hit' if the command contains ALL of the macro properties")

    (for AT inside ATS do (AND [OR (NEQ ONFILETYPE 'UPDATE)
                                               (EVERY (PROPNAMES AT)
                                                      (FUNCTION (LAMBDA (X)
                                                                  (OR (NOT (FMEMB X MACROPROPS))
                                                                      (EQMEMB X PROPS]
                                           [SOME MACROPROPS (FUNCTION (LAMBDA (PROP)
                                                                        (EQMEMB PROP PROPS]
                                           (INFILECOMSVAL AT])
)



(* ;; "adding to a file")

(DEFINEQ

(FILES?
  [LAMBDA NIL                                            (* bvm%: "27-Oct-86 18:14")

(* ;;; 
"Display each file needing dumping, etc.  For files needing dumping, display details of why.")

    (UPDATEFILES)
    (LET (FILES CHANGES PRINTED)
         (for FILE in FILELST when [SETQ CHANGES (fetch TOBEDUMPED
                                                                of (LISTP (fetch FILEPROP
                                                                                 of FILE]
            do (if (NOT PRINTED)
                       then (LISPXPRIN1 "To be dumped:
" T)
                             (SETQ PRINTED T))
                  (LISPXPRIN2 FILE T)
                  (LISPXPRIN1 " ...changes to " T)
                  [for CH in CHANGES bind TB
                     do (COND
                               ((LISTP CH)
                                [COND
                                   (TB (LISPXTAB TB NIL T))
                                   (T (SETQ TB (POSITION T]
                                (LISPXPRIN2 (CAR CH)
                                       T)
                                (FILES?PRINTLST (CDR CH)))
                               (T                            (* ; "old style")
                                  (LISPXPRIN2 CH T)
                                  (LISPXSPACES 1 T]
                  (LISPXTERPRI T))
         (for TYPE FLG in FILEPKGTYPES when (FILES?1 TYPE (AND PRINTED "    plus "))
            do (SETQ FLG T) finally (if FLG
                                                then (OR PRINTED (LISPXPRIN1 "...to be dumped.  "
                                                                            T))
                                                      (ADDTOFILES?)))
         (if (SETQ FILES NOTCOMPILEDFILES)
             then (FILES?PRINTLST FILES "To be compiled: ")
                   (LISPXTERPRI T))
         (if (SETQ FILES NOTLISTEDFILES)
             then (FILES?PRINTLST FILES "To be listed: ")
                   (LISPXTERPRI T))
         (CL:VALUES])

(FILES?1
  [LAMBDA (TYPE FIRST)                                   (* bvm%: "27-Oct-86 18:17")

    (* ;; "If there are changed objects of TYPE, then print them out, preceded by FIRST (if given) plus a descriptive string, and return T.")

    (LET (STR LST)
         (COND
            ([AND (LITATOM TYPE)
                  (SETQ STR (fetch DESCRIPTION of TYPE))
                  (LISTP (SETQ LST (fetch CHANGED of TYPE]
             (AND FIRST (LISPXPRIN1 FIRST T))
             (LISPXPRIN1 '"the " T)
             (LISPXPRIN1 STR T)
             (FILES?PRINTLST LST)
             (LISPXTERPRI T)
             T])

(FILES?PRINTLST
  [LAMBDA (LST STR)                                      (* bvm%: "27-Oct-86 18:15")

    (* ;; "Print elements of LST separated by commas and indenting new lines a bunch.  If MAPRINT had a left margin arg, this would be simpler.")

    (MAPRINT LST T (OR STR ": ")
           NIL ", " [FUNCTION (LAMBDA (STR)
                                (COND
                                   ((> (+ (POSITION T)
                                          (NCHARS STR T T)
                                          3)
                                       (LINELENGTH NIL T))
                                    (LISPXTERPRI T)
                                    (LISPXPRIN1 "         " T)))
                                (LISPXPRIN2 STR T T]
           T])

(ADDTOFILES?
  [LAMBDA (NOASKSTR)                                    (* ; "Edited 10-Aug-2020 21:18 by rmk:")
                                                             (* ; "Edited 21-Aug-91 10:13 by jds")

    (* ;; "ask user about all of the things that need to be dumped, and distribute them to the files that he says")

    (* ;; "RMK: Eliminated literal CR's in the key list.")

    (ERSETQ
     (PROG [BUFS (VARSCHANGES (fetch (FILEPKGTYPE CHANGED) of 'VARS]

      (* ;; "Save VARS list at the beginning, so that changes that might occur from adding things to files (e.g.  changing NILCOMS) will not be processed differently depending on the order of elements in FILEPKGTYPES")

           [COND
              (NOASKSTR (PRIN1 NOASKSTR T))
              (T (DOBE)
                 (SETQ BUFS (READP T))
                 (SELECTQ (ASKUSER DWIMWAIT 'N '("want to say where the above go")
                                 `([Y ,(CONCAT "es" (CHARACTER (CHARCODE EOL]
                                   [N ,(CONCAT "o" (CHARACTER (CHARCODE EOL]
                                   (%] ,(CONCAT "Nowhere" (CHARACTER (CHARCODE EOL)))
                                       EXPLAINSTRING 
                                       "] - nowhere, all items will be marked as dummy
" NOECHOFLG T))
                                 T)
                     (N (RETURN))
                     (%]                                     (* ; "Nowhere")
                         (for TYPE in FILEPKGTYPES
                            do (for NAME in (fetch (FILEPKGTYPE CHANGED)
                                                           of TYPE)
                                      do (ADDTOFILE NAME TYPE NIL)))
                         (RETURN))
                     NIL)                                    (* ; 
                              "if there was type-ahead BEFORE the askuser, then don't allow it now")
                 (COND
                    (BUFS (SETQ BUFS (COND
                                        ((READP T)
                                         (LINBUF)
                                         (SYSBUF)
                                         (SETQ BUFS (CLBUFS NIL T READBUF]
           [for TYPE STR LST in FILEPKGTYPES
              when [AND (SETQ STR (fetch DESCRIPTION of TYPE))
                            (LISTP (SETQ LST (COND
                                                ((EQ TYPE 'VARS)
                                                 VARSCHANGES)
                                                (T (fetch (FILEPKGTYPE CHANGED) of TYPE]
              do
              (printout T "(" STR ")" T)
              (for NAME TEM FILE in LST when NAME
                 do
                 (PROG NIL
                   LP  (PRIN2 NAME T)
                       (SPACES 2 T)

                  (* ;; "if user typed ahead before entering addtofiles??  then dont allow typeahead here, because it will justgobble his earlier typeahead.")

                  (* ;; "SELCHARQ to avoid literal CR")

                       (SELCHARQ (CHCON1 (SETQ TEM (ASKUSER NIL NIL NIL ADDTOFILEKEYLST T)))
                            (%[ (ERSETQ (PROGN (SHOWDEF NAME TYPE T)

                                 (* ;; "the DOBE is so that if the user control-E's after the printout is done but before it appears on the screen that the control-E will merely clear output buffer")

                                               (DOBE)))
                                (GO LP))
                            (%]                              (* ; "Nowhere")
                                (SETQ FILE))
                            (SPACE                           (* ; "No action")
                                   (RETURN))
                            ((LF =) 
                                 (PRINT (OR (SETQ FILE LASTFILE)
                                            'Nowhere)
                                        T))
                            (SETQ FILE TEM))
                       (OR (ERSETQ (PROG (TEM COMSNAME PLACE LISTNAME NEAR)
                                         (SETQ PLACE (WHATIS FILE NIL TYPE))
                                         [COND
                                            ((LITATOM PLACE) (* ; "file name")
                                             (SETQ FILE PLACE)
                                             (OR (ADDTOCOMS (SETQ COMSNAME (FILECOMS FILE))
                                                        NAME TYPE NEAR LISTNAME)
                                                 (ADDNEWCOM COMSNAME NAME TYPE NIL FILE))
                                             (for F in (fetch WHENFILED of TYPE)
                                                do (APPLY* F NAME TYPE FILE))

                                          (* ;; "This isn't factored to the end, cause ADDTOLISTNAME might have to deal with a set of old elements on the listname.")

                                             )
                                            ((EQ (CAR PLACE)
                                                 'Near%:)
                                             (SETQ NEAR (CADR PLACE))
                                             (COND
                                                ([SOME FILELST (FUNCTION (LAMBDA (FL)
                                                                           (ADDTOCOMS
                                                                            (FILECOMS (SETQ FILE
                                                                                           FL))
                                                                            NAME TYPE NEAR LISTNAME]
                                                 (PRINT (LIST 'on FILE)
                                                        T T))
                                                (T (PRINT (LIST (CADR PLACE)
                                                                'not
                                                                'found)
                                                          T T)
                                                   (ERROR!)))
                                             (for F in (fetch WHENFILED of TYPE)
                                                do (APPLY* F NAME TYPE FILE)))
                                            ([OR [UNDONLSETQ (PROGN (SAVESET
                                                                     (SETQ LISTNAME (CAR PLACE))
                                                                     (MERGEINSERT
                                                                      NAME
                                                                      (LISTP (GETTOPVAL LISTNAME))
                                                                      T)
                                                                     T
                                                                     'NOPRINT)
                                                                    (OR (SETQ FILE
                                                                         (CAR (WHEREIS NAME TYPE
                                                                                     FILELST)))
                                                                        (ERROR!]
                                                 (SOME FILELST (FUNCTION (LAMBDA (X)
                                                                           (ADDTOCOMS
                                                                            (FILECOMS (SETQ FILE
                                                                                           X))
                                                                            NAME TYPE NEAR LISTNAME]
                                             (PRIN1 "  value is filed on " T)
                                             (PRINT FILE T T)
                                             (for F in (fetch WHENFILED of TYPE)
                                                do (APPLY* F NAME TYPE FILE))

                                 (* ;; "Only have to notice the single new item here, unlike the case in ADDNEWCOM below, cause other items on the list already belong and were previously noticed")

                                             )
                                            (T (PRIN1 "    put list " T)
                                               (PRIN2 (CAR PLACE)
                                                      T T)
                                               (SETQ FILE
                                                (WHATIS (ASKUSER NIL NIL " on file: "
                                                                   '(("" "" EXPLAINSTRING 
                                                                         "a file name" KEYLST ()))
                                                                   T)
                                                       'FILE))
                                               (SAVESET (CAR PLACE)
                                                      (MERGEINSERT NAME
                                                             (LISTP (GETTOPVAL (CAR PLACE)))
                                                             T)
                                                      T
                                                      'NOPRINT)

                                     (* ;; "Add new item before new command, so that user's new command function can inspect (CAR PLACE) and see all the items involved.")

                                               (ADDNEWCOM (FILECOMS FILE)
                                                      NAME TYPE (CAR PLACE)
                                                      FILE)
                                               (for F in (fetch WHENFILED of TYPE)
                                                  do (for I in (GETTOPVAL (CAR PLACE))
                                                            do (APPLY* F I TYPE FILE]
                                         (AND FILE (ADDFILE FILE))
                                         (SETQ LASTFILE PLACE)))
                           (GO LP]
           (AND BUFS (BKBUFS BUFS))
           (UPDATEFILES])

(ADDTOFILE
  [LAMBDA (NAME TYPE FILE NEAR LISTNAME)                 (* lmm "21-Nov-84 11:43")
                                                             (* ; "adds NAME to the file FILE")
    (PROG (TEM COMSNAME)
          [SETQ TYPE (OR (GETFILEPKGTYPE TYPE NIL T)
                         (COND
                            ((FMEMB TYPE FILELST)
                             (GETFILEPKGTYPE (swap TYPE FILE)))
                            (T (GETFILEPKGTYPE TYPE]
          (SETQ FILE (WHATIS FILE 'FILE))
          (OR (ADDTOCOMS (SETQ COMSNAME (FILECOMS FILE))
                     NAME TYPE NEAR LISTNAME)
              (ADDNEWCOM COMSNAME NAME TYPE NIL FILE))
          (for F in (fetch WHENFILED of TYPE) do (APPLY* F NAME TYPE FILE))
          (AND FILE (NOT (FMEMB FILE FILELST))
               (ADDFILE FILE))
          (RETURN FILE])

(WHATIS
  [LAMBDA (USERINPUT ONLY)                               (* lmm "28-Nov-84 16:49")

    (* ;; "decides whether USERINPUT is a file or a list name --- if ONLY is nil, means either a listname or a filename is accepatble;  if ONLY is LIST then only a listname is acceptable and if ONLY is FILE then only a file name is acceptable")

    (PROG (TEM UCASE)
          (RETURN (COND
                     ((NULL USERINPUT)                       (* ; "nowhere")
                      NIL)
                     [(LISTP USERINPUT)
                      (COND
                         (ONLY (ERROR!))
                         (T (SELECTQ (CAR USERINPUT)
                                ((@ Near%:) 
                                     (CONS 'Near%: (CDR USERINPUT)))
                                (WHATIS (CAR USERINPUT)
                                       'LIST]
                     ([AND (NEQ ONLY 'LIST)
                           (OR (FMEMB (SETQ TEM (SETQ UCASE (U-CASE USERINPUT)))
                                      FILELST)
                               (LISTP (GETTOPVAL (FILECOMS UCASE)))
                               (SETQ TEM (FIXSPELL UCASE NIL FILELST T]
                      TEM)
                     ((AND (NEQ ONLY 'FILE)
                           (LISTP (GETTOPVAL USERINPUT)))
                      (LIST USERINPUT))
                     ((AND (NEQ ONLY 'LIST)
                           (EQ (ASKUSER NIL NIL (LIST "create new file" UCASE)
                                      NIL T)
                               'Y))
                      UCASE)
                     ((AND (NEQ ONLY 'FILE)
                           (EQ (ASKUSER NIL NIL (LIST "create new list" USERINPUT)
                                      NIL T)
                               'Y))
                      (LIST USERINPUT))
                     (T                                      (* ; "none of above")
                        (ERROR!])

(ADDTOCOMS
  [LAMBDA (COMS NAME TYPE NEAR LISTNAME)                 (* rmk%: "10-JUN-82 22:53")

    (* ;; "try to insert NAME of type TYPE command list COMS (either a coms name, or a just a list of coms);  return NIL if unsuccessful.  If LISTNAME is given, then only insert by adding to LISTNAME.  If NEAR is given, only insert near it")

    (COND
       ((NULL COMS)
        NIL)
       [(LITATOM COMS)                                       (* ; 
      "given a name of a command;  rebind COMSNAME to current variable and try to add to its value")
        (OR [PROG ((COMSNAME COMS))
                  (RETURN (ADDTOCOMS (LISTP (GETTOPVAL COMSNAME))
                                 NAME TYPE NEAR (AND (NEQ COMS LISTNAME)
                                                     LISTNAME]
            (AND (EQ COMS LISTNAME)
                 (ADDNEWCOM COMS NAME TYPE]
       (T (SETQ TYPE (GETFILEPKGTYPE TYPE))
          (for TAIL on COMS do (COND
                                              [(LISTP (CAR TAIL))
                                               (COND
                                                  ((ADDTOCOM (CAR TAIL)
                                                          NAME TYPE NEAR LISTNAME)
                                                   (RETURN T]
                                              (T (SELECTQ (CAR TAIL)
                                                     ((EVAL@LOADWHEN EVAL@COMPILEWHEN COPYWHEN) 
                                                          (SETQ TAIL (CDR TAIL)))
                                                     NIL])

(ADDTOCOM
  [LAMBDA (COM NAME TYPE NEAR LISTNAME)                  (* ; "Edited  2-May-87 19:04 by Pavel")
                                                             (* ; 
                        "tries to insert NAME into the prettycom COM;  returns NIL if unsuccessful")
    (PROG (TEM)
          (COND
             ([AND NEAR (NOT (INFILECOMS? NEAR TYPE (LIST COM]
              (RETURN)))
          [COND
             ((SETQ TEM (fetch ADD of (CAR COM)))
              (RETURN (COND
                         ((OR (NULL LISTNAME)
                              (INFILECOMS? LISTNAME 'FILEVARS (LIST COM)))
                          (AND (SETQ TEM (APPLY* TEM COM NAME TYPE NEAR))
                               (MARKASCHANGED COMSNAME 'VARS))
                          TEM]
          (RETURN
           (SELECTQ (CAR COM)
               (FNS (AND (EQ TYPE 'FNS)
                         (ADDTOCOM1 COM NAME NEAR LISTNAME)))
               ((VARS INITVARS) 
                    (COND
                       ((OR (EQ (CAR COM)
                                'VARS)
                            NEAR LISTNAME)                   (* ; 
                                  "Don't stick on INITVARS unless NEAR or LISTNAME says we should.")
                        (SELECTQ TYPE
                            (EXPRESSIONS (COND
                                            ((EQ (CAR NAME)
                                                 'SETQ)
                                             (ADDTOCOM1 COM (CDR NAME)
                                                    NEAR LISTNAME))))
                            (VARS (ADDTOCOM1 COM NAME NEAR LISTNAME))
                            NIL))))
               (COMS (ADDTOCOMS (COND
                                       [(EQ (CADR COM)
                                            '*)
                                        (COND
                                           ((LITATOM (CADDR COM))
                                            (CADDR COM))
                                           (T (RETURN]
                                       (T (CDR COM)))
                            NAME TYPE NEAR LISTNAME))
               (DECLARE%: (AND (OR LISTNAME NEAR)
                               (ADDTOCOMS (COND
                                                 [(EQ (CADR COM)
                                                      '*)
                                                  (COND
                                                     ((LITATOM (CADDR COM))
                                                      (CADDR COM))
                                                     (T (RETURN]
                                                 (T (CDR COM)))
                                      NAME TYPE NEAR LISTNAME)))
               (CL:EVAL-WHEN (AND (OR LISTNAME NEAR)
                                  (ADDTOCOMS (COND
                                                    [(EQ (CL:THIRD COM)
                                                         '*)
                                                     (COND
                                                        ((LITATOM (CL:FOURTH COM))
                                                         (CL:FOURTH COM))
                                                        (T (RETURN]
                                                    (T (CDDR COM)))
                                         NAME TYPE NEAR LISTNAME)))
               ((PROP IFPROP) 
                    (SELECTQ TYPE
                        (PROPS (COND
                                  ((EQ (CADR COM)
                                       (CADR NAME))
                                   (ADDTOCOM1 (CDR COM)
                                          (CAR NAME)
                                          NEAR LISTNAME))
                                  ((AND (EQ (CAR NAME)
                                            (CADDR COM))
                                        (NULL (CDDDR COM)))
                                   [/RPLACA (CDR COM)
                                          (UNION (MKLIST (CDR NAME))
                                                 (MKLIST (CADR COM]
                                   (MARKASCHANGED COMSNAME 'VARS)
                                   T)))
                        (MACROS (COND
                                   ([AND (for PROP inside (CADR COM)
                                            always (EQMEMB PROP MACROPROPS))
                                         (for PROP in MACROPROPS
                                            always (OR (EQMEMB PROP (CADR COM))
                                                           (NOT (GETPROP NAME PROP]

                                    (* ;; "every property in the command is a macro prop and, either this is an IFPROP or else the MACROS are changed")

                                    (ADDTOCOM1 (CDR COM)
                                           NAME NEAR LISTNAME))))
                        NIL))
               ((PROPS ALISTS) 
                    (AND (EQ TYPE (CAR COM))
                         (ADDTOCOM1
                          COM
                          (/NCONC1 (OR [ASSOC (CAR NAME)
                                              (COND
                                                 [(EQ (CADR COM)
                                                      '*)
                                                  (COND
                                                     [(LITATOM (CADDR COM))
                                                      (AND (OR (NULL LISTNAME)
                                                               (EQ (CADDR COM)
                                                                   LISTNAME))
                                                           (GETTOPVAL (CADDR COM]
                                                     (T (RETURN]
                                                 (T (CDR COM]
                                       (LIST (CAR NAME)))
                                 (CADR NAME))
                          NEAR LISTNAME)))
               (P (COND
                     ((AND (EQ TYPE 'EXPRESSIONS)
                           (NEQ (CAR NAME)
                                'SETQ))
                      (ADDTOCOM1 COM NAME NEAR LISTNAME))))
               (AND (EQ (CAR COM)
                        TYPE)
                    (ADDTOCOM1 COM NAME NEAR LISTNAME])

(ADDTOCOM1
  [LAMBDA (COM NAME NEAR LISTNAME)                       (* rmk%: " 3-JAN-82 22:53")
    (COND
       [(EQ (CADR COM)
            '*)                                              (* ; "add to list name")
        (AND [COND
                (LISTNAME (EQ (CADDR COM)
                              LISTNAME))
                (T (LITATOM (CADDR COM]
             (SAVESET (CADDR COM)
                    [PROGN [SETQ COM (LISTP (GETTOPVAL (CADDR COM]
                           (COND
                              ((AND NEAR (SETQ NEAR (MEMBER NEAR COM)))
                               (/RPLACD NEAR (CONS NAME (CDR NEAR)))
                               COM)
                              (T (MERGEINSERT NAME COM T]
                    T
                    'NOPRINT]
       ((NULL LISTNAME)                                      (* ; "add to standard com")
        [AND (NOT (MEMBER NAME (CDR COM)))
             (COND
                [(SETQ NEAR (MEMBER NEAR COM))
                 (/RPLACD NEAR (CONS NAME (CDR NEAR]
                (T (/RPLACD COM (MERGEINSERT NAME (CDR COM]
        (MARKASCHANGED COMSNAME 'VARS)
        T])

(ADDNEWCOM
  [LAMBDA (COMSNAME NAME TYPE LISTNAME FILE)             (* rmk%: " 3-JAN-82 22:53")

    (* ;; "Adds to COMSNAME a new command that will dump NAME as a TYPE on FILE.  --- if LISTNAME is given, then use it as the listname")

    (PROG (NEWCOM OLDCOM TAIL)
          (SETQ NEWCOM (MAKENEWCOM NAME TYPE LISTNAME FILE))
          [COND
             ((NLISTP (SETQ TAIL (GETTOPVAL COMSNAME)))
              (RETURN (SAVESET COMSNAME (LIST NEWCOM)
                             T
                             'NOPRINT]
      LP  [COND
             ((OR (NLISTP (SETQ OLDCOM (CAR TAIL)))
                  (SELECTQ (CAR OLDCOM)
                      ((LOCALVARS SPECVARS BLOCKS) 
                           T)
                      (DECLARE%: (FMEMB 'COMPILERVARS (CDR OLDCOM)))
                      NIL))
              (/ATTACH NEWCOM TAIL))
             ((LISTP (CDR TAIL))
              (SETQ TAIL (CDR TAIL))
              (GO LP))
             (T (/RPLACD TAIL (LIST NEWCOM]
          (MARKASCHANGED COMSNAME 'VARS])

(MAKENEWCOM
  [LAMBDA (NAME TYPE LISTNAME FILE)                      (* ; "Edited  8-Apr-87 14:55 by Pavel")
    (SETQ TYPE (GETFILEPKGTYPE TYPE))
    (PROG (TEM)

     (* ;; "the user function MUST (a) check if FILE = T and not do anything destructive (since this is only for showdef) and (b) if LISTNAME is given, then use it rather than generating a different listname")

          (AND (LISTP NAME)
               (SETQ NAME (COPY NAME)))
          (RETURN (OR (AND (SETQ TEM (fetch NEWCOM of TYPE))
                           (APPLY* TEM NAME TYPE LISTNAME FILE))
                      (SELECTQ TYPE
                          (PROPS [AND (NULL LISTNAME)
                                      (CONS 'PROP (CONS (COND
                                                           ((AND (LISTP (CDR NAME))
                                                                 (NULL (CDDR NAME)))
                                                            (CADR NAME))
                                                           (T (CDR NAME)))
                                                        (OR (LISTP (CAR NAME))
                                                            (LIST (CAR NAME])
                          (EXPRESSIONS [COND
                                          ((EQ (CAR NAME)
                                               'SETQ)
                                           (MAKENEWCOM (CDR NAME)
                                                  'VARS LISTNAME FILE))
                                          (T (CONS 'P (COND
                                                         (LISTNAME (LIST '* LISTNAME))
                                                         (T (LIST NAME])
                          NIL)
                      (DEFAULTMAKENEWCOM NAME TYPE LISTNAME FILE])

(DEFAULTMAKENEWCOM
  [LAMBDA (NAME TYPE LISTNAME FILE)                      (* lmm "20-OCT-82 22:48")
    (COND
       ((NOT (OR (FMEMB TYPE FILEPKGCOMSPLST)
                 (fetch MACRO of TYPE)
                 (fetch GETDEF of TYPE)))
        (ERROR "no defined way to dump or obtain the definition of " (OR (fetch DESCRIPTION
                                                                            of TYPE)
                                                                         TYPE)
               T))
       ((NULL DEFAULTCOMHASFILEFLG)                          (* ; "disable FOOFNS FOOVARS junk")
        (LIST TYPE NAME))
       ((EQ FILE T)                                          (* ; 
                                                           "FILE=T only when called from SHOWDEF")
        (LIST TYPE NAME))
       ([OR LISTNAME (AND FILE (SAVESET (SETQ LISTNAME (FILECOMS FILE TYPE))
                                      (MERGEINSERT NAME (LISTP (GETTOPVAL LISTNAME))
                                             T)
                                      T
                                      'NOPRINT]              (* ; "The check (AND FILE --) is so that it will not bother with making listnames just for deleting items")
        (LIST TYPE '* LISTNAME))
       (T (LIST TYPE NAME])
)

(RPAQ? DEFAULTCOMHASFILEFLG )

(ADDTOVAR MARKASCHANGEDFNS )
(DEFINEQ

(MERGEINSERT
  [LAMBDA (NEW LST ONEFLG)                               (* lmm "30-Jun-86 18:11")

    (* ;; "searches LST to find the most reasonable place to insert NEW.  Does nothing if ONEFLG is T and NEW is already a member of LST")

    (COND
       ((AND ONEFLG (MEMBER NEW LST))
        LST)
       ((LISTP NEW)
        (/NCONC1 LST NEW))
       (T (PROG ((N 0)
                 LST1 PLACE TEM)
                (SETQ LST1 LST)
            LP  

           (* ;; "finds the function with the longest leading common substring.  The idea is that if the list is only paatially sorted, want to insert the new thing in among those function that look like they are related.")

                (COND
                   ((NULL LST1)
                    (GO OUT))
                   ((OR (LISTP (CAR LST1))
                        (SETQ TEM (STRPOS (CAR LST1)
                                         NEW 1 NIL T T)))

                    (* ;; "this takes precedence over even a longer string so that for example in the list (ADDTOFILES? ADDTOFILE), ADDTOFILE1 will be inserted aater ADDTOFILE")

                    (SETQ PLACE LST1)
                    (GO OUT))
                   ((IGREATERP (SETQ TEM (MERGEINSERT1 (CAR LST1)
                                                NEW))
                           N)
                    (SETQ N TEM)
                    (SETQ PLACE LST1)))
                (SETQ LST1 (CDR LST1))
                (GO LP)
            OUT (SETQ TEM (CAR PLACE))
                (OR [SOME (OR PLACE LST)
                          (FUNCTION (LAMBDA (X LST)
                                      (COND
                                         ([OR (ALPHORDER NEW X)
                                              (AND PLACE (NOT (ALPHORDER TEM X]

                                 (* ;; "for example, if the FNS list is something like (...  FOO FOO1 ...) where the ...  may or may not be in order, e.g.  (ZAP FOO FOO1 BLAH), then want to insert FOO2 after FOO1, i.e. before BLAH, even though FOO2 wold not come before BLAH in a sorted list.")

                                          (/ATTACH NEW LST))
                                         (T (SETQ TEM X)
                                            NIL]
                    (SETQ LST (/NCONC1 LST NEW)))
                (RETURN LST])

(MERGEINSERT1
  [LAMBDA (X Y)                                          (* rmk%: "24-MAY-82 00:05")

    (* ;; "value is the number of leading characters of X and Y that agree.")

    (PROG ((N 1)
           C1 C2)
      LP  [COND
             ((OR (NULL (SETQ C1 (NTHCHARCODE X N)))
                  (NULL (SETQ C2 (NTHCHARCODE Y N)))
                  (NEQ C1 C2))
              (RETURN (SUB1 N]
          (SETQ N (ADD1 N))
          (GO LP])
)



(* ;; 
"RMK: Changed INITVARS to VARS, so = addition is a synonym for untypable LF, and also suppress appearance of raw CR and LF in the file"
)


(RPAQ ADDTOFILEKEYLST
      `(("[" "" EXPLAINSTRING "[ -- prettyprint the item to terminal and then ask again" NOECHOFLG T)
        (= "" EXPLAINSTRING "= - same as previous response" NOECHOFLG T)
        (,(CHARACTER (CHARCODE LF))
         "" EXPLAINSTRING "{line-feed} - same as previous response" NOECHOFLG T)
        (" " ,(CONCATCODES (LIST (CHARCODE SPACE)
                                 (CHARCODE EOL)))
             EXPLAINSTRING "{space} - no action" NOECHOFLG T)
        ("]" ,(CONCAT "Nowhere" (CHARACTER (CHARCODE EOL)))
             EXPLAINSTRING
             ,(CONCAT "] - nowhere, item is marked as a dummy" (CHARACTER (CHARCODE EOL)))
             NOECHOFLG T)
        ["(" "List:  (" EXPLAINSTRING "(list name)" NOECHOFLG T KEYLST
             (( "" CONFIRMFG [%) %] ,(CHARACTER (CHARCODE SPACE))
                                  ,(CHARACTER (CHARCODE EOL]
                 RETURN
                 (CDR ANSWER]
        (@ "Near: " EXPLAINSTRING "@ other-item   -- put the item near the other item" NOECHOFLG T 
           KEYLST (( "" CONFIRMFLG [,(CHARACTER (CHARCODE EOL]
                      RETURN ANSWER)))
        [,(CHARACTER (CHARCODE CR))
         "" RETURN ,(CHARACTER (CHARCODE SPACE]
        ("" "File name: " EXPLAINSTRING "a file name" KEYLST ())))

(RPAQQ LASTFILE NIL)



(* ;; "deleting an item from a file")

(DEFINEQ

(DELFROMFILES
  [LAMBDA (NAME TYPE FILES)                              (* rmk%: " 6-MAR-82 13:16")

    (* ;; "Eliminates NAME as an item of type TYPE in COMS.")

    (PROG (COMS)
          (SETQ TYPE (GETFILEPKGTYPE TYPE))
          (RETURN (for FILE inside (OR FILES FILELST)
                     when (PROG1 (DELFROMCOMS (SETQ COMS (FILECOMS FILE))
                                            NAME TYPE)
                                  (COND
                                     ((INFILECOMS? NAME TYPE COMS)
                                      (printout T "(could not delete " NAME " from " FILE ")" T))))
                     collect (for FN in (fetch WHENUNFILED of TYPE)
                                    do (APPLY* FN NAME TYPE FILE))
                           FILE])

(DELFROMCOMS
  [LAMBDA (COMS NAME TYPE)                               (* bvm%: " 1-Oct-86 22:02")

    (* ;; "delete NAME of type TYPE from the coms COMS (either the name of some coms or a list).  Returns T if it does anything")

    (* ;; "If COMS is not a symbol, caller is required to bind COMSNAME to the symbol whose value we are deleting from, for benefit of marking it changed.")

    (COND
       [(LITATOM COMS)
        (LET ((COMSNAME COMS))
             (DECLARE (SPECVARS COMS))
             (AND (LISTP (SETQ COMS (GETTOPVAL COMSNAME)))
                  (DELFROMCOMS COMS NAME TYPE]
       (T (PROG (DONE)
                (SETQ TYPE (GETFILEPKGTYPE TYPE))
            LP  (COND
                   ((NLISTP COMS)
                    (RETURN DONE)))
                [COND
                   ((LISTP (CAR COMS))
                    (SELECTQ (DELFROMCOM (CAR COMS)
                                    NAME TYPE)
                        (ALL (/RPLNODE2 COMS (CDR COMS))
                             (SETQQ DONE ALL)
                             (GO LP))
                        (NIL)
                        (SETQ DONE T)))
                   (T (SELECTQ (CAR COMS)
                          ((EVAL@LOADWHEN EVAL@COMPILEWHEN COPYWHEN) 
                               (SETQ COMS (CDR COMS)))
                          (COND
                             ((AND (EQ TYPE 'VARS)
                                   (EQ NAME (CAR COMS)))
                              (/RPLNODE2 COMS (CDR COMS))
                              (SETQ DONE T)
                              (GO LP]
                (SETQ COMS (CDR COMS))
                (GO LP])

(DELFROMCOM
  [LAMBDA (COM NAME TYPE)                                (* ; "Edited  2-May-87 19:02 by Pavel")
                                                             (* ; "Tries to delete NAME from COM")
    (PROG (TEM VAR NEW)
          (COND
             ((SETQ TEM (fetch DELETE of (CAR COM)))
              (AND (SETQ TEM (APPLY* TEM COM NAME TYPE))
                   (MARKASCHANGED COMSNAME 'VARS))
              (RETURN TEM)))
          (RETURN (SELECTQ (CAR COM)
                      ((DECLARE%: COMS) 
                           (DELFROMCOMS (COND
                                               [(EQ (CADR COM)
                                                    '*)
                                                (COND
                                                   ((LITATOM (CADDR COM))
                                                    (CADDR COM))
                                                   (T (RETURN]
                                               (T (CDR COM)))
                                  NAME TYPE))
                      ((CL:EVAL-WHEN) 
                           (DELFROMCOMS (COND
                                               [(EQ (CL:THIRD COM)
                                                    '*)
                                                (COND
                                                   ((LITATOM (CL:FOURTH COM))
                                                    (CL:FOURTH COM))
                                                   (T (RETURN]
                                               (T (CDDR COM)))
                                  NAME TYPE))
                      ((ALISTS PROPS) 
                           (AND (EQ TYPE (CAR COM))
                                (COND
                                   ((EQ (CADR COM)
                                        '*)
                                    (COND
                                       ([AND (LITATOM (SETQ VAR (CADDR COM)))
                                             (SETQ TEM (ASSOC (CAR NAME)
                                                              (GETTOPVAL VAR)))
                                             (NEQ (CDR TEM)
                                                  (SETQ TEM (REMOVEITEM (CADR NAME)
                                                                   (CDR TEM]
                                        (SAVESET VAR TEM T 'NOPRINT)
                                        T)))
                                   ([AND [CDR (SETQ TEM (ASSOC (CAR NAME)
                                                               (CDR COM]
                                         (NEQ (CDR TEM)
                                              (SETQ NEW (REMOVEITEM (CADR NAME)
                                                               (CDR TEM]
                                    (/RPLACD TEM NEW)
                                    (MARKASCHANGED COMSNAME 'VARS)
                                    T))))
                      (BLOCKS 
                              (* ;; "Remove function name from blocks declarations.  This isn't entirely correctly, since in removing the name from the block variables, it will hit homonyms in globalvars, specvars, etc.")

                              [AND (EQ TYPE 'FNS)
                                   (for BLOCK in (INFILECOMTAIL COM T)
                                      do (AND (MEMB NAME BLOCK)
                                                  (/DREMOVE NAME BLOCK))
                                            (for X in BLOCK
                                               when (AND (LISTP X)
                                                             (MEMB NAME (CDR X)))
                                               do (/RPLACD X (REMOVE NAME (CDR X])
                      ((PROP IFPROP) 
                           [SELECTQ TYPE
                               (PROPS (RETURN (COND
                                                 ((EQ (CADR COM)
                                                      (CADR NAME))
                                                  (DELFROMCOM1 (CDR COM)
                                                         (CAR NAME)))
                                                 ((AND (EQMEMB (CADR NAME)
                                                              (CADR COM))
                                                       [NULL (CDR (SETQ TEM (PRETTYCOM1 (CDR COM]
                                                       (EQ (CAR TEM)
                                                           (CAR NAME)))
                                                  [/RPLACA (CDR COM)
                                                         (REMOVE (CADR NAME)
                                                                (MKLIST (CADR COM]
                                                  (MARKASCHANGED COMSNAME 'VARS)
                                                  T))))
                               (COND
                                  ([for PROP inside (CADR COM)
                                      always (EQ TYPE (GETPROP PROP 'PROPTYPE]
                                   (DELFROMCOM1 (CDR COM)
                                          NAME])
                      ((RECORDS INITRECORDS SYSRECORDS) 
                           (AND (EQ TYPE 'RECORDS)
                                (DELFROMCOM1 COM NAME)))
                      (P (AND (EQ TYPE 'EXPRESSIONS)
                              (DELFROMCOM1 COM NAME)))
                      ((VARS INITVARS) 
                           (AND (EQ TYPE 'VARS)
                                (DELFROMCOM1 COM NAME T)))
                      (AND (EQ TYPE (CAR COM))
                           (DELFROMCOM1 COM NAME])

(DELFROMCOM1
  [LAMBDA (COM NAME FLG)                                 (* rmk%: "10-JUN-82 22:44")

    (* ;; 
  "FLG is passed on to REMOVEITEM, determines whether lists whose CAR is NAME will be removed")

    (LET (TEM VAL)
         (COND
            ((EQ (CADR COM)
                 '*)
             (COND
                ([AND (LITATOM (SETQ TEM (CADDR COM)))
                      (NEQ (SETQ VAL (GETTOPVAL TEM))
                           (SETQ VAL (REMOVEITEM NAME VAL FLG]
                 (SAVESET TEM VAL T 'NOPRINT)
                 T)))
            ((NEQ (CDR COM)
                  (SETQ TEM (REMOVEITEM NAME (CDR COM)
                                   FLG)))
             (/RPLACD COM TEM)
             (MARKASCHANGED COMSNAME 'VARS)
             T])

(REMOVEITEM
  [LAMBDA (X LST FLG)                                    (* ; "Edited 25-May-88 17:52 by drc:")
                                                             (* lmm "10-FEB-78 17:29")

    (* ;; 
  "returns a subset of LST with X deleted;  if FLG is set, also remove elements whose CAR is X")

    (COND
       [[OR (MEMBER X LST)
            (AND FLG (SOME LST (FUNCTION (LAMBDA (Y)
                                           (EQUAL (CAR (LISTP Y))
                                                  X]
        (SUBSET LST (FUNCTION (LAMBDA (Y)
                                (AND (NOT (EQUAL Y X))
                                     (OR (NOT FLG)
                                         (NLISTP Y)
                                         (NOT (EQUAL (CAR Y)
                                                     X]
       (T LST])

(MOVETOFILE
  [LAMBDA (TOFILE NAME TYPE FROMFILE)                    (* rmk%: "18-OCT-79 19:51")
                                                             (* ; "To move items between files")
    (SETQ TYPE (GETFILEPKGTYPE TYPE))
    [COND
       ((OR (EQ TYPE 'FNS)
            FROMFILE)                                        (* ; 
       "FNS definition can reside on file if LOADFNS was done.  This guarantees that it is loaded.")
        (PUTDEF NAME TYPE (GETDEF NAME TYPE FROMFILE '(NOCOPY NODWIM]
    (AND (EQ TYPE 'FNS)
         (MARKASCHANGED NAME TYPE))                      (* ; 
                                                   "FNS won't get dumped unless they are `changed'")
    (DELFROMFILES NAME TYPE FROMFILE)
    (ADDTOFILE NAME TYPE TOFILE])
)

(MOVD? 'DELFROMFILES 'DELFROMFILE NIL T)

(MOVD? 'MOVETOFILE 'MOVEITEM NIL T)

(ADDTOVAR SYSPROPS PROPTYPE VARTYPE)



(* ; "functions for doing things and marking them changed and auxiliary functions")

(DEFINEQ

(SAVEPUT
  [LAMBDA (ATM PROP VAL)                                 (* lmm " 7-May-84 16:56")

    (* ;; "analogous to SAVESET but also marks changed property lists;  LISPXFNS are marked to change PUT and PUTPROP to SAVEPUT")

    [COND
       ((NOT (LITATOM ATM))
        (ERRORX (LIST 14 ATM]
    (PROG ((X (GETPROPLIST ATM))
           X0 TEM OLDFLG)
      LOOP
          (COND
             ((NLISTP X)
              (COND
                 ((AND (NULL X)
                       X0)                                   (* ; 
                "typical case.  property list ran out on an even parity position.  e.g.  (A B C D)")
                  (SETQ TEM (LIST PROP VAL))
                  (AND LISPXHIST (UNDOSAVE (LIST '/PUT-1 ATM TEM)
                                        LISPXHIST))
                  (FRPLACD (CDR X0)
                         TEM)
                  (GO RET)))

              (* ;; "property list was initially NIL or a non-list, or else it ended in a non-list following an even parity position, e.g. (A B . C) fall through and add new property at beginning")

              )
             ((NLISTP (CDR X))

              (* ;; "property list runs out on an odd parity, or ends in an odd list following an odd parity, e.g.  (A B C) or (A B C . D) fall through and add at beginning.")

              )
             [(EQ (CAR X)
                  PROP)
              (SETQ OLDFLG (NEQ (EQUALN (CADR X)
                                       VAL 400)
                                T))                          (* ; "i.e. it probably changed")
              (/RPLACA (CDR X)
                     VAL)
              (COND
                 ((NOT OLDFLG)
                  (GO RET1))
                 (T (OR (EQ DFNFLG T)
                        (LISPXPRINT (LIST 'new PROP 'property 'for ATM)
                               T T))
                    (GO RET]
             (T (SETQ X (CDDR (SETQ X0 X)))
                (GO LOOP)))
          [SETQ TEM (CONS PROP (CONS VAL (GETPROPLIST ATM]
          (SETPROPLIST ATM TEM)
          (AND LISPXHIST (UNDOSAVE (LIST '/PUT-1 ATM TEM)
                                LISPXHIST))
      RET (MARKASCHANGED (LIST ATM PROP)
                 'PROPS
                 (NOT OLDFLG))
      RET1
          (AND ADDSPELLFLG (ADDSPELL ATM 0))
          (RETURN VAL])
)
(DECLARE%: DONTEVAL@LOAD DOCOPY 

(OR (CHANGENAME 'PUTPROPS 'PUTPROP 'SAVEPUT)
    (CHANGENAME 'PUTPROPS '/PUT 'SAVEPUT))
)
(DEFINEQ

(UNMARKASCHANGED
  [LAMBDA (NAME TYPE)                                    (* JonL "24-Jul-84 19:59")

    (* ;; "says to remove NAME from TYPE's changedlst, and also to remove it from any FILE properties.  Value is name if anything is done")

    (PROG (ANYFLG)
          (bind TAIL [CHANGED _ (fetch CHANGED of (SETQ TYPE (GETFILEPKGTYPE
                                                                          TYPE
                                                                          'TYPE]
             while (SETQ TAIL (MEMBER NAME CHANGED)) do (/RPLACA TAIL)
                                                               (SETQ ANYFLG T))
          [for F TAIL PROP TYPEDPROP in FILELST
             when [SETQ TAIL (MEMBER NAME (CDR (SETQ TYPEDPROP
                                                    (ASSOC TYPE (fetch TOBEDUMPED
                                                                   of (SETQ PROP
                                                                           (fetch FILEPROP
                                                                              of F]
             do (SETQ ANYFLG T)
                   (COND
                      ((SETQ TAIL (REMOVE (CAR TAIL)
                                         (CDR TYPEDPROP)))
                       (/RPLACD TYPEDPROP TAIL))
                      (T (/replace TOBEDUMPED of PROP with (REMOVE TYPEDPROP
                                                                              (fetch TOBEDUMPED
                                                                                 of PROP]
          (RETURN (AND ANYFLG NAME])

(PREEDITFN
  [LAMBDA (ATM TYPE EDITCHANGES)                         (* rmk%: "18-FEB-82 21:49")
                                                             (* ; 
                                           "EDITL is advised to call this before editing something")
    (AND FILEPKGFLG (SELECTQ TYPE
                        (PROPLST [AND (OR CLISPARRAY (PROGN (CLISPTRAN (CONS)
                                                                   (CONS))
                                                            CLISPARRAY))
                                      (for X in (GETPROPLIST ATM)
                                         do (OR (NLISTP X)
                                                    (GETHASH X CLISPARRAY)
                                                    (PUTHASH X (CONS (CAR X)
                                                                     (CDR X))
                                                           CLISPARRAY]

                                 (* ;; "note that if CLISPARRAY is disabled that ALL properties of an edited prop list will get marked as changed if any destructive edit is made")

                                 [RESETSAVE NIL (LIST (FUNCTION POSTEDITPROPS)
                                                      EDITCHANGES
                                                      (APPEND (GETPROPLIST ATM])
                        (VARS [COND
                                 ((EQMEMB 'ALIST (GETPROP ATM 'VARTYPE))
                                  [AND (OR CLISPARRAY (PROGN (CLISPTRAN (CONS)
                                                                    (CONS))
                                                             CLISPARRAY))
                                       (for X in (EVALV ATM)
                                          do (OR (NLISTP X)
                                                     (GETHASH X CLISPARRAY)
                                                     (PUTHASH X (CONS (CAR X)
                                                                      (CDR X))
                                                            CLISPARRAY]
                                  (RESETSAVE NIL (LIST (FUNCTION POSTEDITALISTS)
                                                       EDITCHANGES
                                                       (for X in (EVALV ATM)
                                                          collect (CAR X])
                        NIL])

(POSTEDITPROPS
  [LAMBDA (EDITCHANGES OLDPROPS)                         (* rmk%: "18-FEB-82 21:50")
                                                             (* ; "was RESETSAVE'd from PREEDITFN")
    (PROG (OV FOUNDCHANGE)
          (OR FILEPKGFLG (RETURN))
          (COND
             ((CADR EDITCHANGES)
              (for NEWPROP on (GETPROPLIST (CAR EDITCHANGES)) by (CDDR NEWPROP)
                 when (for OLDPROP on OLDPROPS by (CDDR OLDPROP)
                             do (COND
                                       ((EQ (CAR OLDPROP)
                                            (CAR NEWPROP))   (* ; "Found the property")
                                        [AND (EQ (CADR OLDPROP)
                                                 (CADR NEWPROP))
                                             (COND
                                                ((NLISTP (CADR OLDPROP))
                                                             (* ; "value is same")
                                                 (RETURN))
                                                ((AND CLISPARRAY (SETQ OV (GETHASH (CADR NEWPROP)
                                                                                 CLISPARRAY))
                                                      (EQ (CAADR NEWPROP)
                                                          (CAR OV))
                                                      (EQ (CDADR NEWPROP)
                                                          (CDR OV)))
                                                 (PUTHASH (CADR NEWPROP)
                                                        NIL CLISPARRAY)
                                                             (* ; 
                                         "value has been edited (CLISPARRAY translation went away)")
                                                 (RETURN]
                                        (RETURN T))) finally 
                                                             (* ; "didn't find the property")
                                                           (RETURN T))
                 do (MARKASCHANGED (LIST (CAR EDITCHANGES)
                                                 (CAR NEWPROP))
                               'PROPS NIL)
                       (SETQ FOUNDCHANGE T))
              (AND FOUNDCHANGE (RPLACA (CDR EDITCHANGES)
                                      NIL])

(POSTEDITALISTS
  [LAMBDA (EDITCHANGES OLDTOKENS)                        (* rmk%: " 4-JAN-82 10:14")
    (PROG [OV FOUNDCHANGE (NEWENTRIES (GETTOPVAL (CAR EDITCHANGES]
                                                             (* ; 
                                                           "called after an ALIST has been edited")
          (OR FILEPKGFLG (RETURN))
          (COND
             ((CADR EDITCHANGES)
              (for X in OLDTOKENS when (NOT (FASSOC X NEWENTRIES))
                 do (MARKASCHANGED (LIST (CAR EDITCHANGES)
                                                 X)
                               'ALISTS NIL)
                       (SETQ FOUNDCHANGE T))
              [for NEWENTRY in NEWENTRIES
                 do (COND
                           ([AND (LISTP NEWENTRY)
                                 (NOT (AND CLISPARRAY (SETQ OV (GETHASH NEWENTRY CLISPARRAY))
                                           (EQ (CAR NEWENTRY)
                                               (CAR OV))
                                           (EQ (CDR NEWENTRY)
                                               (CDR OV]
                            (PUTHASH NEWENTRY NIL CLISPARRAY)
                            (MARKASCHANGED (LIST (CAR EDITCHANGES)
                                                     (CAR NEWENTRY))
                                   'ALISTS NIL)
                            (SETQ FOUNDCHANGE T]
              (AND FOUNDCHANGE (RPLACA (CDR EDITCHANGES)
                                      NIL])
)

(ADDTOVAR LISPXFNS (PUT . SAVEPUT)
                       (PUTPROP . SAVEPUT))



(* ; "sub-functions for file package commands & types")

(DEFINEQ

(ALISTS.GETDEF
  [LAMBDA (NAME TYPE OPTIONS)                            (* Pavel " 7-Oct-86 17:24")
    (AND (LISTP NAME)
         (CL:SYMBOLP (CAR NAME))
         (LET [(ASSOCIATION (ASSOC (CADR NAME)
                                   (GETTOPVAL (CAR NAME]
              (AND ASSOCIATION (LIST 'ADDTOVAR (CAR NAME)
                                     ASSOCIATION])

(ALISTS.WHENCHANGED
  [LAMBDA (NAME TYPE NEWFLG)                             (* lmm "16-OCT-78 20:02")
                                                             (* ; 
                                          "called by MARKASCHANGED when an ALIST entry has changed")
    (PROG [(VARTYPE (GETPROP (CAR NAME)
                           'VARTYPE]
          (AND (LISTP VARTYPE)
               (EQ (CAR VARTYPE)
                   'ALIST)
               (RETFROM 'MARKASCHANGED (MARKASCHANGED (CADR NAME)
                                              (CADR VARTYPE)
                                              NEWFLG])

(CLEARCLISPARRAY
  [LAMBDA (NAME TYPE REASON)
    (DECLARE (SPECVARS NAME TYPE REASON))            (* lmm "14-Aug-84 15:03")
    (AND CLISPARRAY (MAPHASH CLISPARRAY (COND
                                           [(EQ TYPE 'I.S.OPRS)
                                            (FUNCTION (LAMBDA (TRAN FORM)
                                                        (AND (MEMB NAME FORM)
                                                             (PUTHASH FORM NIL CLISPARRAY]
                                           (T                (* ; "MACRO changed")
                                              (FUNCTION (LAMBDA (TRAN FORM)
                                                          (COND
                                                             ((OR (EQ NAME (CAR FORM))
                                                                  (EQ (CAR (GETPROP (CAR FORM)
                                                                                  'CLISPWORD))
                                                                      'CHANGETRAN))
                                                              (PUTHASH FORM NIL CLISPARRAY])

(EXPRESSIONS.WHENCHANGED
  [LAMBDA (EXPR)                                         (* ; "Edited  6-Apr-87 20:21 by Pavel")
    (SELECTQ (CAR EXPR)
        ((SETQ SETQQ) 
             (UNMARKASCHANGED (CADR EXPR)
                    'VARS))
        ((PROGN PROG) 
             (for X in (CDR EXPR) do (EXPRESSIONS.WHENCHANGED X)))
        NIL])

(MAKEALISTCOMS
  [NLAMBDA X                                             (* rmk%: "14-OCT-83 13:34")

    (* ;; "make command to dump prettydefmacros")

    (LIST
     (CONS 'ADDVARS
           (for PR in X
              join (for ALISTNAME inside (CAR PR)
                          collect (CONS ALISTNAME
                                            (for ATNAME inside (CDR PR) bind ENTRY
                                               when (SETQ ENTRY
                                                         (OR (SASSOC ATNAME (GETTOPVAL ALISTNAME))
                                                             (PROGN (LISPXPRINT (LIST 'no ATNAME
                                                                                      'entry
                                                                                      'on ALISTNAME)
                                                                           T T)
                                                                    NIL))) collect ENTRY])

(MAKEFILESCOMS
  [NLAMBDA FILES                                         (* JonL "12-FEB-83 19:02")

    (* ;; "This scans the command just to warn the user about any errors.  Must match up with the big SELECTQ in FILESLOAD NIL")

    [for FILE in FILES
       do
       (OR
        (LITATOM FILE)
        (while (LISTP FILE)
           do (SELECTQ (CAR (OR (LISTP FILE)
                                    (RETURN)))
                      ((LOADCOMP LOADFROM))
                      (FROM (pop FILE)
                            (if (OR (EQ (CAR FILE)
                                            'VALUEOF)
                                        (if (AND (EQ (CAR FILE)
                                                         'VALUE)
                                                     (EQ (CADR FILE)
                                                         'OF))
                                            then (pop FILE)))
                                then (pop FILE)))
                      ((COMPILED LOAD EXTENSION EXT SOURCE SYMBOLIC IMPORT NOERROR))
                      (OR (FMEMB (CAR FILE)
                                 LOADOPTIONS)
                          (PRINT (CONS (CAR FILE)
                                       '(-- unrecognized FILES option))
                                 T)))
                 (pop FILE]
    (CONS 'FILESLOAD FILES])

(MAKELISPXMACROSCOMS
  [NLAMBDA X                                             (* lmm " 5-SEP-78 23:15")
    (PROG (TEM TEM2)
          (RETURN (CONS [CONS 'ALISTS (SETQ TEM (NCONC (AND [SETQ TEM (SUBSET X
                                                                             (FUNCTION (LAMBDA (Z)
                                                                                         (FASSOC
                                                                                          Z 
                                                                                   LISPXHISTORYMACROS
                                                                                          ]
                                                            (LIST (CONS 'LISPXHISTORYMACROS TEM)))
                                                       (AND [SETQ TEM (SUBSET X
                                                                             (FUNCTION (LAMBDA (Z)
                                                                                         (FASSOC
                                                                                          Z 
                                                                                          LISPXMACROS
                                                                                          ]
                                                            (LIST (CONS 'LISPXMACROS TEM]
                        (SETQ TEM2 (NCONC [AND [SETQ TEM2 (SUBSET X (FUNCTION (LAMBDA (Z)
                                                                                (FMEMB Z LISPXCOMS]
                                               (LIST (LIST 'ADDVARS (CONS 'LISPXCOMS TEM2]
                                          (AND [SETQ TEM2 (SUBSET X (FUNCTION (LAMBDA (Z)
                                                                                (FMEMB Z HISTORYCOMS]
                                               (LIST (LIST 'ADDVARS (CONS 'HISTORYCOMS TEM2])

(MAKEPROPSCOMS
  [NLAMBDA X                                             (* lmm "26-FEB-78 17:10")

    (* ;; "make command to dump PROPS")

    (for PAIR in X collect (CONS 'PROP (CONS (COND
                                                            ((AND (LISTP (CDR PAIR))
                                                                  (NULL (CDDR PAIR)))
                                                             (CADR PAIR))
                                                            (T (CDR PAIR)))
                                                         (OR (LISTP (CAR PAIR))
                                                             (LIST (CAR PAIR])

(MAKEUSERMACROSCOMS
  [NLAMBDA X                                             (* rmk%: " 3-JAN-82 23:20")
    (PROG (TEM)
          [COND
             [X (for Y in X
                   do (OR (FASSOC Y USERMACROS)
                              (FASSOC Y EDITMACROS)
                              (LISPXPRINT (CONS Y '(-- no entry on USERMACROS))
                                     T T]
             (T (SETQ X (INTERSECTION (SETQ X (MAPCAR USERMACROS 'CAR))
                               X]
          (RETURN (LIST (CONS 'ADDVARS
                              (NCONC (for VAR in '(USERMACROS EDITMACROS)
                                        when (SETQ TEM (for Y in (GETTOPVAL VAR)
                                                              when (FMEMB (CAR Y)
                                                                              X) collect Y))
                                        collect (CONS VAR TEM))
                                     (for LST in '(EDITCOMSA EDITCOMSL COMPACTHISTORYCOMS 
                                                                 DONTSAVEHISTORYCOMS)
                                        when [SETQ TEM
                                                  (SUBSET (GETTOPVAL LST)
                                                         (FUNCTION (LAMBDA (Y)
                                                                     (OR (FMEMB Y X)
                                                                         (AND (LISTP Y)
                                                                              (FMEMB (CAR Y)
                                                                                     X]
                                        collect (CONS LST TEM])

(PROPS.WHENCHANGED
  [LAMBDA (NAME TYPE NEWFLG)                             (* lmm " 7-SEP-78 22:08")
    (PROG [(PROPTYPE (GETPROP (CADR NAME)
                            'PROPTYPE]
          (COND
             [PROPTYPE (RETFROM 'MARKASCHANGED (COND
                                                  ((NEQ PROPTYPE 'IGNORE)
                                                   (MARKASCHANGED (CAR NAME)
                                                          PROPTYPE NEWFLG]
             (T (SELECTQ (CADR NAME)
                    (CLISPWORD (CLEARCLISPARRAY (CAR NAME)))
                    NIL])

(FILEGETDEF.LISPXMACROS
  [LAMBDA (NAME TYPE SOURCE OPTIONS)                     (* lmm " 4-Jul-85 15:12")
    (MKPROGN (for X in [LOADFNS NIL SOURCE 'GETDEF '(LAMBDA (FIRST SECOND)
                                                              (AND (EQ FIRST 'ADDTOVAR)
                                                                   (MEMB SECOND '(LISPXMACROS 
                                                                                        LISPXCOMS))
                                                                   T]
                when (SELECTQ (CADR X)
                             (LISPXMACROS                    (* ; 
                      "Rebuild the expressions cause there might be other elements in the ADDTOVAR")
                                          (AND (SETQ X (ASSOC NAME (CDDR X)))
                                               (SETQ X (LIST 'ADDTOVAR 'LISPXMACROS X))))
                             (LISPXCOMS [COND
                                           ((MEMB NAME (CDDR X))
                                            (SETQ X (LIST 'ADDTOVAR 'LISPXCOMS NAME)))
                                           ((SETQ X (ASSOC NAME (CDDR X)))
                                                             (* ; "For synonym pairs")
                                            (SETQ X (LIST 'ADDTOVAR 'LISPXCOMS X])
                             NIL) collect X])

(FILEGETDEF.ALISTS
  [LAMBDA (NAME TYPE SOURCE OPTIONS)                     (* lmm " 4-Jul-85 15:13")
    (for X in [LOADFNS NIL SOURCE 'GETDEF '(LAMBDA (FIRST SECOND)
                                                     (AND (EQ FIRST 'ADDTOVAR)
                                                          (EQ SECOND (CAR NAME]
       when (SETQ X (ASSOC (CADR NAME)
                               (CDDR X))) collect X
       finally (RETURN (COND
                              ($$VAL (CONS 'ADDTOVAR (CONS (CAR NAME)
                                                           $$VAL])

(FILEGETDEF.RECORDS
  [LAMBDA (NAME TYPE SOURCE OPTIONS NOTFOUND)            (* lmm "26-Jun-86 15:56")
    (LET [(VAL (LOADFNS NIL SOURCE 'GETDEF '(LAMBDA (FIRST SECOND)
                                              (AND (MEMB FIRST CLISPRECORDTYPES)
                                                   (OR (EQ SECOND NAME)
                                                       (AND (MEMB SECOND '(%( %[))
                                                            (PROGN (RATOM)
                                                                   (RATOM)
                                                                   (RATOM)
                                                                   (EQ NAME (RATOM]
         (if (EQ (CAAR VAL)
                     'NOT-FOUND%:)
             then NOTFOUND
           elseif (CDR VAL)
             then (CONS 'PROGN VAL)
           else (CAR VAL])

(FILEGETDEF.PROPS
  [LAMBDA (NAME TYPE SOURCE OPTIONS)                     (* lmm " 4-Jul-85 15:13")
    (for X in [LOADFNS NIL SOURCE 'GETDEF '(LAMBDA (FIRST SECOND)
                                                     (AND (EQ FIRST 'PUTPROPS)
                                                          (EQ SECOND (CAR NAME]
       join (for TAIL on (CDDR X) by (CDDR TAIL) when (EQ (CAR TAIL)
                                                                              (CADR NAME))
                   join (LIST (CAR TAIL)
                                  (CADR TAIL)))
       finally (RETURN (COND
                              ($$VAL (CONS 'PUTPROPS (CONS (CAR NAME)
                                                           $$VAL])

(FILEGETDEF.MACROS
  [LAMBDA (NAME TYPE SOURCE OPTIONS)                     (* lmm "28-May-86 09:51")
    (MKPROGN (for X in [LOADFNS NIL SOURCE 'GETDEF '(LAMBDA (FIRST SECOND)
                                                              (AND (FMEMB FIRST '(PUTPROPS DEFMACRO))
                                                                   (EQ SECOND NAME]
                join (if (EQ (CAR X)
                                     'DEFMACRO)
                             then (LIST X)
                           else (for TAIL on (CDDR X) by (CDDR TAIL)
                                       when (FMEMB (CAR TAIL)
                                                       MACROPROPS) collect (LIST 'PUTPROPS
                                                                                     (CADR X)
                                                                                     (CAR TAIL)
                                                                                     (CADR TAIL])

(FILEGETDEF.VARS
  [LAMBDA (NAME TYPE SOURCE OPTIONS)                     (* lmm " 4-Jul-85 15:14")
    (for X in (LOADFNS NIL SOURCE 'GETDEF NAME)
       do (SELECTQ (CAR X)
                  ((RPAQQ SETQQ) 
                       (RETURN (CADDR X)))
                  ((RPAQ SETQ RPAQ?) 
                       (RETURN (EVAL (CADDR X))))
                  NIL) finally (RETURN 'NOBIND])

(FILEGETDEF.FNS
  [LAMBDA (NAME TYPE SOURCE OPTIONS)                     (* bvm%: "29-Aug-86 22:30")
    (LET (MAP ENV)
         (COND
            [(AND (EQMEMB 'FAST OPTIONS)
                  (PROGN (CL:MULTIPLE-VALUE-SETQ (ENV MAP)
                                (GET-ENVIRONMENT-AND-FILEMAP SOURCE))
                         MAP))
             (for PAIR MAPLOC in (CDR MAP) when [SETQ MAPLOC (CADR (ASSOC NAME
                                                                                      (CDDR PAIR]
                do [OR (OPENP SOURCE)
                           (RESETSAVE NIL (LIST 'CLOSEF? (SETQ SOURCE (OPENSTREAM SOURCE 'INPUT
                                                                             'OLD]
                      (SETFILEPTR SOURCE MAPLOC)
                      (RETURN (WITH-READER-ENVIRONMENT ENV
                                  [COND
                                     ((EQMEMB 'ARGLIST OPTIONS)
                                      (RATOM SOURCE)
                                      (READ SOURCE)
                                      (RATOM SOURCE)
                                      (LIST (READ SOURCE)
                                            (READ SOURCE)))
                                     (T (CADR (READ SOURCE])]
            (T (CADR (FASSOC NAME (LOADEFS NAME SOURCE])

(FILEPKGCOMS.PUTDEF
  [LAMBDA (NAME TYPE DEFINITION REASON)                  (* lmm "15-Jul-85 11:29")
    (PROG (COM TYP)
          [SELECTQ (CAR (LISTP DEFINITION))
              (COM (SETQ COM (CDR DEFINITION)))
              (TYPE (SETQ TYP (CDR DEFINITION)))
              (PROGN (SETQ COM (CDR (ASSOC 'COM DEFINITION)))
                     (SETQ TYP (CDR (ASSOC 'TYPE DEFINITION]

     (* ;; "Check properties first, so that we don't smash some and then get an error in a later call to FILEPKGCOM/TYPE")

          (for I in COM by (CDDR I) do (SELECTQ I
                                                           ((ADD DELETE MACRO CONTENTS CONTAIN COM))
                                                           (ERROR I 
                                                                  "not file package command property"
                                                                  )))
                                                             (* ; 
                                                   "COM merely adds to spelling list, for builtins")
          [FILEPKGCOM NAME 'CONTENTS (OR (LISTGET COM 'CONTENTS)
                                             (LISTGET COM 'CONTAIN]
                                                             (* ; "Until CONTAIN is de-documented.")
          (for PROP in '(ADD DELETE MACRO COM) do (FILEPKGCOM NAME PROP
                                                                         (LISTGET COM PROP)))
          [for I in TYP by (CDDR I) do (OR (FMEMB I FILEPKGTYPEPROPS)
                                                           (SELECTQ I
                                                               ((DESCRIPTION TYPE))
                                                               (ERROR I 
                                                             "not file package type/command property"
                                                                      ]
                                                             (* ; 
                                                  "TYPE merely adds to spelling list, for builtins")
          (for PROP in (UNION '(DESCRIPTION TYPE)
                                      FILEPKGTYPEPROPS) do (FILEPKGTYPE NAME PROP
                                                                      (LISTGET TYP PROP])

(FILES.PUTDEF
  [LAMBDA (NAME TYPE DEFINITION REASON)                  (* lmm "15-Jul-85 17:13")
    (PROGN (PUTDEF (FILECOMS NAME)
                  'VARS
                  (CAR DEFINITION)
                  REASON)                                    (* ; "DEFINE THE COMS")
           (ADDFILE NAME)                                (* ; 
                                                           "MAKE SURE IT IS A FILE PACKAGE ENTITY")
           [/replace TOBEDUMPED of (fetch FILEPROP of NAME)
                                          (FILEPKG.MERGECHANGES (CADR DEFINITION)
                                                 (fetch TOBEDUMPED of (fetch FILEPROP
                                                                                 of NAME]
           (OR (fetch FILEDATES of NAME)
               (/replace FILEDATES of NAME with (CADDR DEFINITION])

(VARS.PUTDEF
  [LAMBDA (NAME TYPE DEFINITION REASON)                  (* lmm "29-Jul-85 20:59")
    (/SETTOPVAL NAME DEFINITION T])

(FILES.WHENCHANGED
  [LAMBDA (NAME TYPE REASON)
    (MARKASCHANGED (FILECOMS NAME)
           'VARS REASON])
)

(ADDTOVAR MACROPROPS MACRO BYTEMACRO DMACRO)

(ADDTOVAR SYSPROPS PROPTYPE)

(PUTPROPS I.S.OPR PROPTYPE I.S.OPRS)

(PUTPROPS SUBR PROPTYPE IGNORE)

(PUTPROPS LIST PROPTYPE IGNORE)

(PUTPROPS CODE PROPTYPE IGNORE)

(PUTPROPS FILEDATES PROPTYPE IGNORE)

(PUTPROPS FILE PROPTYPE IGNORE)

(PUTPROPS FILEMAP PROPTYPE IGNORE)

(PUTPROPS EXPR PROPTYPE FNS)

(PUTPROPS VALUE PROPTYPE VARS)

(PUTPROPS COPYRIGHT PROPTYPE FILES)

(PUTPROPS FILETYPE PROPTYPE FILES)

(PUTPROPS BAKTRACELST VARTYPE ALIST)

(PUTPROPS BREAKMACROS VARTYPE ALIST)

(PUTPROPS COMPILETYPELST VARTYPE ALIST)

(PUTPROPS EDITMACROS VARTYPE (ALIST USERMACROS))

(PUTPROPS ERRORTYPELST VARTYPE ALIST)

(PUTPROPS FONTDEFS VARTYPE ALIST)

(PUTPROPS LISPXHISTORYMACROS VARTYPE (ALIST LISPXMACROS))

(PUTPROPS LISPXMACROS VARTYPE (ALIST LISPXMACROS))

(PUTPROPS PRETTYDEFMACROS VARTYPE (ALIST FILEPKGCOMS))

(PUTPROPS PRETTYEQUIVLST VARTYPE ALIST)

(PUTPROPS PRETTYPRINTMACROS VARTYPE ALIST)

(PUTPROPS PRETTYPRINTYPEMACROS VARTYPE ALIST)

(PUTPROPS USERMACROS VARTYPE (ALIST USERMACROS))



(* ; "Define the commands below AFTER the various properties have been established.")


(ADDTOVAR USERMACROS
          (M NIL (MAKE FILE FILE))
          (M (X . Y)
             (E (MARKASCHANGED (COND ((LISTP 'X)
                                      (CAR 'X))
                                     (T 'X))
                       'USERMACROS)
                T)
             (ORIGINAL (M X . Y))))

(ADDTOVAR EDITMACROS
          (M (X . Y)
             (E (MARKASCHANGED (COND ((LISTP 'X)
                                      (CAR 'X))
                                     (T 'X))
                       'USERMACROS)
                T)
             (ORIGINAL (M X . Y))))

(ADDTOVAR EDITCOMSA M)

(ADDTOVAR EDITCOMSL M)



(* ; "GETDEF methods")

(DEFINEQ

(RENAME
  [LAMBDA (OLD NEW TYPES FILES METHOD)               (* JonL "24-Jul-84 20:01")
    (PROG ((TYPES (GETFILEPKGTYPE TYPES 'TYPE NIL OLD)))

     (* ;; "special kludge: change the callers BEFORE if we are changing a field;  this is so the CHANGECALLERS won't get an UNABLE TO DWIMIFY message")

          [for TYPE inside TYPES when (NEQ TYPE 'FIELDS)
             do (COPYDEF OLD NEW TYPE NIL (COND
                                                     ((EQ TYPE 'VARS)
                                                      'NOERROR]
          (CHANGECALLERS OLD NEW TYPES FILES METHOD)
          [for TYPE inside TYPES do (COND
                                                   ((AND (EQ TYPE 'FIELDS)
                                                         (HASDEF OLD 'FIELDS))

                                 (* ;; "The HASDEF test is because the rename might already have been done in EDITFROMFILE in the CHANGECALLERS, if it found a record with the field on a file.  Otherwise, COPYDEF essentially will just do the necessary substitution in the existing record declarations, given that definitions for FIELDS are mutually exclusive.")

                                                    (COPYDEF OLD NEW 'FIELDS))
                                                   (T (DELDEF OLD TYPE]
          (RETURN NEW])

(CHANGECALLERS
  [LAMBDA (OLD NEW AS-TYPES FILES METHOD)            (* ; "Edited  6-Dec-86 01:25 by lmm")
    (PROG ((AS-TYPES (GETFILEPKGTYPE AS-TYPES))
           REL TEM EDITCOMS FNS)
          (OR METHOD (SETQ METHOD DEFAULTRENAMEMETHOD))
          [SETQ EDITCOMS
           (LIST (COND
                    [(OR (EQMEMB 'CAREFUL METHOD)
                         (PROGN (SETQ TEM (TYPESOF OLD NIL AS-TYPES))
                                (printout T "Warning --" OLD " is also defined as " TEM T)))

                     (* ;; "This creates a `command' that searches like EXAM, but interrogates the user about whether to do the Rename.  Y means do it, No means skip, anything else goes into TTY.")

                     (SUBPAIR '(OLD NEW)
                            (LIST OLD NEW)
                            '(BIND (LPQ (F OLD N)
                                            (MARK %#1)
                                            (ORR (1 !0 P)
                                                 NIL)
                                            (MARK %#2)
                                            (COMS (SELECTQ (ASKUSER NIL NIL "   Replace ? "
                                                                  '((Y "Yes
")
                                                                    (N "No
")
                                                                    (%
 "")
                                                                    (%  "")
                                                                    (%
 "")
                                                                    (& ""))
                                                                  NIL NIL '(NOECHOFLG T))
                                                      (Y '(R1 OLD NEW))
                                                      (N NIL)
                                                      'TTY%:))
                                            (MARK %#3)
                                            (IF (EQ (%## (\ %#3))
                                                        (%## (\ %#2)))
                                                   ((\ %#1))
                                                   NIL]
                    (T (LIST 'R OLD NEW]
          (SELECTQ (COND
                      ((AND (EQMEMB 'MASTERSCOPE METHOD)
                            MSDATABASELST
                            (for TYPE inside AS-TYPES
                               do [COND
                                         ((SETQ TEM (SELECTQ TYPE
                                                        ((FNS FUNCTIONS SPECIAL-FORMS OPTIMIZERS) 
                                                             'CALL)
                                                        (MACROS '(CALL DIRECTLY))
                                                        ((VARS VARIABLES) 
                                                             '(USE OR BIND))
                                                        ((RECORDS FIELDS I.S.OPRS) 
                                                             (LIST 'USE 'AS TYPE))
                                                        (RETURN NIL)))
                                          (COND
                                             (REL (SETQ REL (LIST TEM 'OR REL)))
                                             (T (SETQ REL TEM] FINALLY (RETURN REL)))

                       (* ;; "can only use masterscope if (a) we say to, (b) something's been analyzed, and (c) the types the function is are known")

                       'MASTERSCOPE)
                      ((EQMEMB 'EDITCALLERS METHOD)
                       'EDITCALLERS)
                      (T 'SEARCH))
              (MASTERSCOPE (MAPC [SETQ FNS (NCONC [COND
                                                     ((NULL FILES)
                                                      (UPDATEFILES)
                                                      (FILEPKGCHANGES 'FNS]
                                                  (for FILE inside (OR FILES FILELST)
                                                     join (FILEFNSLST FILE]
                                 (FUNCTION UPDATEFN))
                           (SETQ FNS (INTERSECTION (GETRELATION OLD (SETQ REL (PARSERELATION REL))
                                                          T)
                                            FNS)))
              (EDITCALLERS (SETQ FILES (for X inside (OR FILES FILELST)
                                          when (SETQ TEM (EDITCALLERS OLD X T))
                                          collect (PROGN (SETQ FNS (NCONC FNS (CDR TEM)))
                                                             X))))
              (SEARCH (SETQ FNS (for X inside (OR FILES FILELST) join (FILEFNSLST
                                                                                   X))))
              (ERROR "UNRECOGNIZED RENAME METHOD" METHOD))
          (AND (EQMEMB 'FNS AS-TYPES)
               (FMEMB OLD FNS)
               (SETQ FNS (REMOVE OLD FNS)))
          (EDITFROMFILE FNS FILES OLD EDITCOMS)
          [for TYPE inside AS-TYPES
             do (for FILE in (WHEREIS OLD TYPE FILES)
                       do (AND (ADDTOFILE NEW TYPE FILE)
                                   (DELFROMFILES OLD TYPE FILE)
                                   (printout T OLD " changed to " NEW " on " FILE)))
                   (COND
                      ((SETQ TEM (WHEREIS OLD TYPE FILES))
                       (printout T "Couldn't change " OLD " to " NEW " as " TYPE " on " TEM]
          (COND
             (REL (UPDATECHANGED)
                  (COND
                     ((AND (SETQ TEM (GETRELATION OLD REL T))
                           (WHEREIS TEM 'FNS FILES))
                      (printout T "Couldn't find where " OLD " is referenced in " TEM T])
)
(DEFINEQ

(SHOWDEF
  [LAMBDA (NAME TYPE FILE)                              (* ; "Edited 16-Apr-2018 21:35 by rmk:")
                                                             (* ; 
                                                 "prettyprint NAME as it would be dumped as a TYPE")
    (RESETLST
        (PROG (ORIGFLG FNSLST FL PRETTYCOMSLST NEWFILEMAP)
              (DECLARE (SPECVARS . T))
              [AND FILE (NEQ FILE (OUTPUT))
                   (if (SETQ FL (OPENP FILE 'OUTPUT))
                       then (RESETSAVE (OUTPUT FL))
                     else (OUTFILE FILE)
                           (RESETSAVE NIL (LIST (FUNCTION CLOSEF?)
                                                (OUTPUT]
              (PRETTYCOM (MAKENEWCOM NAME TYPE))))])

(COPYDEF
  [LAMBDA (OLD NEW TYPE SOURCE OPTIONS)              (* lmm "14-Aug-84 18:38")
                                                             (* ; "like MOVD, but takes a type.")
    (PROG (TEM DEF)
          (SETQ TYPE (GETFILEPKGTYPE TYPE 'TYPE))
          [SETQ DEF (GETDEF OLD TYPE SOURCE (COND
                                                   ((EQ OPTIONS 'NOCOPY)
                                                    NIL)
                                                   (T (REMOVE 'NOCOPY (MKLIST OPTIONS]
                                                             (* ; 
      "The default is for GETDEF to return a COPY.  Make sure that NOCOPY isn't in options though.")
          (SELECTQ TYPE
              (VARS)
              (FILES [for X in (CAR DEF)
                        do                               (* ; 
                                          "change all the listnames which are of form filenameTYPE")
                              (SELECTQ (CAR X)
                                  ((PROP IFPROP) 
                                       (SETQ X (CDR X)))
                                  NIL)
                              (COND
                                 ((EQ (CADR X)
                                      '*)
                                  (SETQ X (CDDR X))
                                  (COND
                                     ((AND (LITATOM (CAR X))
                                           (SETQ TEM (STRPOS OLD (CAR X)
                                                            1 NIL T T)))
                                      (SAVESET (SETQ TEM (PACK* NEW (SUBATOM (CAR X)
                                                                           TEM -1)))
                                             (COPY (GETTOPVAL (CAR X)))
                                             T)
                                      (FRPLACA X TEM])
              ((PROPS ALISTS) 
                   (OR (EQ (CAR NEW)
                           (CAR OLD))
                       (DSUBST (CAR NEW)
                              (CAR OLD)
                              DEF))
                   (OR (EQ (CADR NEW)
                           (CADR OLD))
                       (DSUBST (CADR NEW)
                              (CADR OLD)
                              DEF)))
              (DSUBST NEW OLD DEF))
          (PUTDEF NEW TYPE DEF)
          (RETURN NEW])

(GETDEF
  [LAMBDA (NAME TYPE SOURCE OPTIONS)                     (* lmm "13-Jul-85 04:10")

    (* ;; "returns the definition of NAME as a TYPE from SOURCE;  cause ERROR if not found unless OPTIONS is NOERROR --- usually returns a copy unless OPTIONS is NOCOPY in which case it tries not to return a copy --- FLG=NOCOPY is currently only used from SAVEDEF where SOURCE is always 0 --- If options is or contains a string, returns that string instead of causing error if no def found.  The caller can figure out what happened, even for types for which NIL/NOBIND might have defs.")

    (PROG (DEF TEM (NOCOPY (EQMEMB 'NOCOPY OPTIONS)))
          (DECLARE (SPECVARS NOCOPY))
          (SELECTQ OPTIONS
              (0 (SETQQ OPTIONS (NOERROR NODWIM))
                 (SETQ NOCOPY T))
              (1 (SETQQ OPTIONS (NOERROR NODWIM FAST ARGLIST))
                 (SETQ NOCOPY T))
              (T (SETQQ OPTIONS SPELL))
              NIL)
          (SETQ TYPE (GETFILEPKGTYPE TYPE 'TYPE))
          (SELECTQ SOURCE
              (0 (SETQQ SOURCE CURRENT))
              (T (SETQQ SOURCE SAVED))
              (NIL (SETQQ SOURCE ?))
              NIL)
          [SELECTQ SOURCE
              (CURRENT (SETQ DEF (GETDEFCURRENT NAME TYPE OPTIONS)))
              (? [LET [(NOERROR (CONS 'NOERROR (MKLIST OPTIONS]
                      (OR (NEQ (SETQ DEF (GETDEFCURRENT NAME TYPE NOERROR))
                               (fetch NULLDEF of TYPE))
                          (NEQ (SETQ DEF (GETDEFSAVED NAME TYPE NOERROR))
                               (fetch NULLDEF of TYPE))
                          (SETQ DEF (GETDEFFROMFILE NAME TYPE 'FILE OPTIONS])
              (SAVED (SETQ DEF (GETDEFSAVED NAME TYPE OPTIONS)))
              (COND
                 ((AND (LISTP SOURCE)
                       (EQ (CAR SOURCE)
                           '=))
                  (SETQ DEF (CDR SOURCE)))
                 (T (SETQ DEF (GETDEFFROMFILE NAME TYPE SOURCE OPTIONS))
                    (SETQ NOCOPY T]
          (OR NOCOPY (SETQ DEF (COPY DEF)))
          (COND
             ((AND (EQ TYPE 'FNS)
                   (NOT (EQMEMB 'NODWIM OPTIONS)))
              (DWIMDEF DEF NAME SOURCE)))
          (RETURN DEF])

(GETDEFCOM
  [LAMBDA (X)                                            (* lmm " 4-Jul-85 13:31")

    (* ;; "In the case where GETDEF doesn't know how to get the definition of something, it resorts to asking the file package to print it out to a file and then reading the file back in.  Actually, though, that is a two stage process where the `command' to print out the datum is first macro expanded and then executed.  --- In some cases, you can tell what would be printed without printing it by looking at the prettydef-macro expansion.  That is what GETDEFCOM does: it takes a list of prettydef commands and returns what Would be printed by those commands (or NIL if it is `too hard' to figure out.) --- A few of the commands are special-cased inside GETDEFCOM0 because they occur frequently or are simple.")
                                                             (* ; "a RETFROM point")
    (for Y in X join (GETDEFCOM0 Y])

(GETDEFCOM0
  [LAMBDA (COM)                                          (* wt%: " 7-FEB-79 23:28")
    (PROG (TEM)
          (RETURN (COND
                     ((SETQ TEM (fetch MACRO of (CAR COM)))
                                                             (* COND ((fetch CONTENTS of
                                                           (CAR COM)) (* ; 
                        "if it has a CONTENTS function, generally means it is not safe to evaluate")
                                                           (RETFROM (QUOTE GETDEFCOM))))
                      (for Y in (SUBPAIR (CAR TEM)
                                               (PRETTYCOM1 COM)
                                               (CDR TEM)) join (GETDEFCOM0 Y)))
                     (T (SELECTQ (CAR COM)
                            (COMS (for X in (PRETTYCOM1 COM) join (GETDEFCOM0 X)))
                            (ADDVARS (for Y in (PRETTYCOM1 COM)
                                        collect (CONS 'ADDTOVAR Y)))
                            (APPENDVARS (for Y in (PRETTYCOM1 COM)
                                           collect (CONS 'APPENDTOVAR Y)))
                            (P (APPEND (PRETTYCOM1 COM)))
                            (RETFROM 'GETDEFCOM])

(GETDEFCURRENT
  [LAMBDA (NAME TYPE OPTIONS)                            (* ; "Edited  2-May-87 19:00 by Pavel")
                                                             (* ; 
                                                           "Gets the current definition--source=0")
    (LET
     (DEF)
     (COND
        ((AND (SETQ DEF (fetch GETDEF of TYPE))
              (NEQ DEF T))

         (* ;; "We assign T to types whose GETDEF is normally handled in the SELECTQ below but whose MACRO is to be defaulted to the PUTDEF/GETDEF in PRETTYCOM.")

         (OR (NEQ (SETQ DEF (APPLY* DEF NAME TYPE OPTIONS))
                  (fetch NULLDEF of TYPE))
             (GETDEFERR NAME TYPE OPTIONS))
         DEF)
        (T
         (OR
          (NEQ
           [SETQ DEF
            (SELECTQ TYPE
                (FNS (AND (LITATOM NAME)
                          (EXPRP (SETQ DEF (VIRGINFN NAME)))
                          DEF))
                (VARS (if (LITATOM NAME)
                          then (GETTOPVAL NAME)
                        else 'NOBIND))
                ((FIELDS RECORDS) 
                     (if (LITATOM NAME)
                         then [SETQ DEF (SELECTQ TYPE
                                                (RECORDS (RECLOOK NAME))
                                                (MKPROGN (FIELDLOOK NAME]
                               (if (EQMEMB 'EDIT OPTIONS)
                                   then (COPY DEF)
                                 else DEF)))
                (FILES                                       (* ; 
              "what is the `definition' of a file?  -- I guess the COMS which say what it contains")
                       [if (LITATOM NAME)
                           then (if (SETQ DEF (GETFILEDEF NAME))
                                        then (UPDATEFILES)
                                              (LIST (LISTP (GETTOPVAL (FILECOMS DEF)))
                                                    (fetch TOBEDUMPED
                                                       of (fetch FILEPROP of DEF))
                                                    (LISTP (fetch FILEDATES of DEF])
                (TEMPLATES (if (AND (LITATOM NAME)
                                        (SETQ DEF (GETTEMPLATE NAME)))
                               then (LIST 'SETTEMPLATE (KWOTE NAME)
                                              (KWOTE DEF))))
                (MACROS [if [AND (LITATOM NAME)
                                     (SETQ DEF (for X on (GETPROPLIST NAME)
                                                  by (CDDR X) when (FMEMB (CAR X)
                                                                                  MACROPROPS)
                                                  join (LIST (CAR X)
                                                                 (CADR X]
                            then `(PUTPROPS ,NAME ,@DEF])
                (EXPRESSIONS (LISTP NAME))
                (PROPS [AND (LISTP NAME)
                            (AND (SETQ DEF (SOME (GETPROPLIST (CAR NAME))
                                                 [FUNCTION (LAMBDA (X)
                                                             (EQ X (CADR NAME]
                                                 (FUNCTION CDDR)))
                                 (LIST 'PUTPROPS (CAR NAME)
                                       (CADR NAME)
                                       (CADR DEF])
                (FILEPKGCOMS [AND (LITATOM NAME)
                                  (PROG ((COM (FILEPKGCOM NAME))
                                         (TYP (FILEPKGTYPE NAME)))
                                        (RETURN (COND
                                                   ((AND COM TYP)
                                                    (LIST (CONS 'COM COM)
                                                          (CONS 'TYPE TYP)))
                                                   (COM (LIST (CONS 'COM COM)))
                                                   (TYP (LIST (CONS 'TYPE TYP])
                (FILEVARS (COND
                             ((AND (LITATOM NAME)
                                   (LISTP (SETQ DEF (GETTOPVAL NAME)))
                                   (WHEREIS NAME 'FILEVARS))
                              DEF)
                             (T 'NOBIND)))
                (LET
                 ((COMS (LIST (MAKENEWCOM NAME TYPE)))
                  FILE)
                 [COND
                    ((NOT (SETQ DEF (GETDEFCOM COMS)))
                     (WITH-READER-ENVIRONMENT *OLD-INTERLISP-READ-ENVIRONMENT*
                         (RESETLST
                             (RESETSAVE PRETTYFLG)
                             (RESETSAVE FONTCHANGEFLG)
                             [RESETSAVE (OUTPUT (SETQ FILE (OPENSTREAM '{NODIRCORE} 'BOTH]
                             (PRETTYDEFCOMS COMS)
                             (SETFILEPTR FILE 0)
                             [SETQ DEF
                              (for X in (READFILE FILE)
                                 join
                                 (SELECTQ (CAR X)
                                     ((*) 
                                          NIL)
                                     (DECLARE%: (for Y on (CDR X)
                                                   unless (SELECTQ (CAR Y)
                                                                  ((COPYWHEN EVAL@LOADWHEN 
                                                                          EVAL@COMPILEWHEN) 
                                                                       (RETURN (LIST Y)))
                                                                  (FMEMB (CAR Y)
                                                                         DECLARETAGSLST))
                                                   collect (CAR Y)))
                                     (CL:EVAL-WHEN (CDDR X))
                                     (PROGN (CDR X))
                                     (LIST X]
                             (SETQ NOCOPY T)))]
                 (MKPROGN DEF]
           (fetch NULLDEF of TYPE))
          (GETDEFERR NAME TYPE OPTIONS))
         DEF])

(GETDEFERR
  [LAMBDA (NAME TYPE OPTIONS MSG)                        (* lmm "13-Jul-85 04:11")
    (DECLARE (USEDFREE NODEF))                           (* ; 
                                       "Message non-null if looking for saved or filed definition.")
    (PROG (TEM)
          (RETURN (COND
                     ((EQMEMB 'NOERROR OPTIONS)              (* ; 
                                               "We want to do the string search in the HASDEF case")
                      (RETURN (fetch NULLDEF of TYPE)))
                     [(AND (NULL MSG)
                           (EQMEMB 'SPELL OPTIONS)
                           (SETQ TEM (HASDEF NAME TYPE NIL (OR (LISTGET1 (LISTP OPTIONS)
                                                                          'SPELL)
                                                                   T)))
                           (NEQ TEM NAME))
                      (RETFROM 'GETDEF (GETDEF TEM TYPE '? (CONS 'NOERROR (MKLIST OPTIONS]
                     (T (for O inside OPTIONS when (STRINGP O)
                           do (RETFROM 'GETDEF O)
                           finally (ERROR NAME (CONS TYPE '(definition not found))
                                              T])

(GETDEFFROMFILE
  [LAMBDA (NAME TYPE SOURCE OPTIONS)                     (* bvm%: " 1-Oct-86 22:10")

    (* ;; "Tries to get definition from source file.  If successful, returns the definition.  Otherwise returns the NULLDEF of the type if OPTIONS contains NOERROR.")

    (DECLARE (SPECVARS NAME))
    (bind (NOTFOUND _ "not found")
           DEF SOURCE TEM2 for FILE inside (COND
                                                      ((EQ SOURCE 'FILE)
                                                       (WHEREIS NAME TYPE T))
                                                      (T SOURCE))
       when
       (AND
        (SETQ SOURCE (FINDFILE FILE T))
        (NEQ
         [SETQ DEF
          (COND
             ((SETQ TEM2 (fetch FILEGETDEF of TYPE))
              (APPLY* TEM2 NAME TYPE SOURCE OPTIONS NOTFOUND))
             (T
              (SELECTQ TYPE
                  (FNS (FILEGETDEF.FNS NAME TYPE SOURCE OPTIONS NOTFOUND))
                  ((VARS FILEVARS) 
                       (FILEGETDEF.VARS NAME TYPE SOURCE OPTIONS NOTFOUND))
                  (MACROS (FILEGETDEF.MACROS NAME TYPE SOURCE OPTIONS NOTFOUND))
                  (PROPS (FILEGETDEF.PROPS NAME TYPE SOURCE OPTIONS NOTFOUND))
                  (RECORDS (FILEGETDEF.RECORDS NAME TYPE SOURCE OPTIONS NOTFOUND))
                  (ALISTS (FILEGETDEF.ALISTS NAME TYPE SOURCE OPTIONS NOTFOUND))
                  (LISPXMACROS (FILEGETDEF.LISPXMACROS NAME TYPE SOURCE OPTIONS NOTFOUND))
                  (COND
                     [(SETQ DEF (GET TYPE 'DEFINERS))
                      (LET [(VAL (LOADFNS NIL SOURCE 'GETDEF
                                        `(LAMBDA (FIRST SECOND)
                                           (AND (MEMB FIRST ',DEF)
                                                (OR (EQ SECOND NAME)
                                                    (AND (MEMB SECOND '(%( %[))
                                                         (PROGN (RATOM)
                                                                (RATOM)
                                                                (RATOM)
                                                                (EQ NAME (RATOM]
                                                             (* ; "ick!  Should use real closure")
                           (if (EQ (CAAR VAL)
                                       'NOT-FOUND)
                               then NOTFOUND
                             elseif (CDR VAL)
                               then (CONS 'PROGN VAL)
                             else (CAR VAL]
                     (T (RESETLST
                            (RESETSAVE (RESETUNDO))
                            [LET (LOAD-VERBOSE-STREAM)
                                 (DECLARE (SPECVARS LOAD-VERBOSE-STREAM))
                                                             (* ; 
                                                     "just in case we get a PRETTYCOMPRINT in here")
                                 (LOADFNS NIL SOURCE 'PROP (COND
                                                              ((LITATOM NAME)
                                                             (* ; 
                                         "If an atom, only bother with expressions that contain it")
                                                               (CONS (LIST '& '|..| NAME)))
                                                              (T T]
                            (GETDEFCURRENT NAME TYPE (CONS 'NOERROR (MKLIST OPTIONS))))]
         NOTFOUND)) do (AND (EQ SOURCE 'FILE)
                                (OR (FMEMB FILE FILELST)
                                    (CL:FORMAT T "(from ~A)~%%" SOURCE))) 
                                                             (* ; 
                                                        "Copying and dwimifying are done in GETDEF")
                          (RETURN DEF) finally (RETURN (GETDEFERR NAME TYPE OPTIONS
                                                                  (APPEND '(no definition on)
                                                                         (MKLIST SOURCE])

(GETDEFSAVED
  [LAMBDA (NAME TYPE OPTIONS)                          (* ; "Edited 11-Aug-87 18:14 by cutting")
                                                             (* ; 
                                                           "Gets the `saved' definition--source=T")
    (SELECTQ TYPE
        (FNS (OR (GETPROP NAME 'EXPR)
                 (GETDEFERR NAME TYPE OPTIONS "no saved definition for")))
        (VARS                                                (* ; 
                               "The value of a variable is never substituted into and never COPIED")
              (for X on (GETPROPLIST NAME) by (CDDR X) when (EQ (CAR X)
                                                                                'VALUE)
                 do (RETURN (CADR X)) finally (RETURN (GETDEFERR NAME TYPE OPTIONS 
                                                                     "no saved value for "))))
        (OR (CDR (SASSOC NAME (FASSOC TYPE SAVEDDEFS)))
            (GETDEFERR NAME TYPE OPTIONS "no saved definition for "])

(PUTDEF
  [LAMBDA (NAME TYPE DEFINITION REASON)                  (* ; "Edited  8-Apr-87 12:52 by Pavel")
    (SETQ TYPE (GETFILEPKGTYPE TYPE 'TYPE))
    (LET ((PUTDEF.METHOD (fetch PUTDEF of TYPE)))
         (COND
            (PUTDEF.METHOD (APPLY* PUTDEF.METHOD NAME TYPE DEFINITION REASON))
            (T (SELECTQ TYPE
                   (FNS (FNS.PUTDEF NAME TYPE DEFINITION REASON))
                   (VARS (VARS.PUTDEF NAME TYPE DEFINITION REASON))
                   (FILES (FILES.PUTDEF NAME TYPE DEFINITION REASON))
                   (FILEPKGCOMS (FILEPKGCOMS.PUTDEF NAME TYPE DEFINITION REASON))
                   (EVAL DEFINITION))
               NAME])

(EDITDEF
  [LAMBDA (NAME TYPE SOURCE EDITCOMS OPTIONS)
    (DECLARE (LOCALVARS . T)
           (SPECVARS SOURCE))                          (* ; "Edited 27-Jul-87 11:04 by cutting")

    (* ;; "lets you edit anything.  Given name and type, call editor on the definition (loading it in from SOURCE if necessary).  If you change it, then the definition gets unsaved.  OPTIONS is passed through from ED to the editor.")

    (SETQ TYPE (GETFILEPKGTYPE TYPE 'TYPE))
    (COND
       ((AND (fetch EDITDEF of TYPE)
             (APPLY* (fetch EDITDEF of TYPE)
                    NAME TYPE SOURCE EDITCOMS OPTIONS)))
       ((AND (EQ TYPE 'FNS)
             (NULL SOURCE))                                  (* ; 
                                "special hack for EDITDEF of FNS because of ability to EDITLOADFNS")
        (EDITDEF.FNS NAME EDITCOMS OPTIONS))
       (T (DEFAULT.EDITDEF NAME TYPE SOURCE EDITCOMS OPTIONS)))
    NAME])

(DEFAULT.EDITDEF
  [LAMBDA (NAME TYPE SOURCE EDITCOMS OPTIONS)            (* ; "Edited 11-Jun-92 16:26 by cat")
    (PROG [(DEF (COND
                   [SOURCE (GETDEF NAME TYPE SOURCE '(EDIT NOCOPY]
                   [(GETDEF NAME TYPE 'CURRENT '(EDIT NOCOPY NOERROR]
                   [(GETDEF NAME TYPE 'SAVED '(EDIT NOCOPY NOERROR]
                   (T (LET ((FILES (WHEREIS NAME TYPE T)))
                           (CL:IF (NULL FILES)
                               (CL:FORMAT T "~S has no ~A definition.~%%" NAME TYPE)
                               [LET [(FILE (PROGN (CL:FORMAT T "~S is contained on~{ ~S~}.~%%" NAME 
                                                         FILES)
                                                  (CL:IF (CL:ENDP (CDR FILES))
                                                      (CL:IF (CL:Y-OR-N-P 
                                                                    "Shall I load this file PROP? ")
                                                             (CAR FILES))
                                                      (ASKUSER NIL NIL 
                                                             "indicate which file to load PROP: "
                                                             (MAKEKEYLST FILES)
                                                             T))]
                                    (CL:WHEN FILE
                                        (LOAD FILE 'PROP)
                                        (GETDEF NAME TYPE '? '(EDIT NOCOPY)))])]

     (* ;; "the EDIT option says to return a COPY if editing this structure isn't enough, and some installation is necessary.")

          (DECLARE (SPECVARS RETRY))

     (* ;; "what is RETRY ???")

          (SETQ RETRY)
          (CL:WHEN DEF
              (EDITE DEF EDITCOMS NAME TYPE [FUNCTION (LAMBDA (NAME DEF TYPE EXITFLG)
                                                             (* ; 
                                             "this function is called when there were changes made")
                                                        (FIXEDITDATE DEF)
                                                             (* ; "fix the edit date first - jtm")
                                                        (PUTDEF NAME TYPE DEF)
                                                        (MARKASCHANGED NAME TYPE 'CHANGED)

                                 (* ;; "woz 1/25/91 MARKASCHANGED must be called after PUTDEF, so sedit's markaschangedfn will see the new definition.  doc for PUTDEF says it calls MARKASCHANGED, but it doesn't always, so do it here.  this sometimes results in MARKASCHANGED getting called twice.")

                                                        ]
                     OPTIONS))])

(EDITDEF.FILES
  [LAMBDA (NAME TYPE SOURCE EDITCOMS OPTIONS)            (* ; "Edited 18-Mar-87 16:07 by woz")
    (EDITDEF (FILECOMS NAME)
           'VARS SOURCE EDITCOMS OPTIONS])

(LOADDEF
  [LAMBDA (NAME TYPE SOURCE)                             (* lmm "13-SEP-78 01:34")
    (PUTDEF NAME TYPE (GETDEF NAME TYPE SOURCE '(NODWIM NOCOPY])

(DWIMDEF
  [LAMBDA (DEF FN SOURCE)                                (* lmm " 6-Jun-86 17:23")
    (AND [OR (EQ DWIMIFYCOMPFLG T)
             (EQ CLISPIFYPRETTYFLG T)
             (EQ (CAR (CADDR DEF))
                 'CLISP%:)
             (SELECTQ SOURCE
                 ((CURRENT SAVED FILE ?) 
                      NIL)
                 (AND (LITATOM SOURCE)
                      (EQMEMB 'CLISP (GETPROP SOURCE 'FILETYPE]
         (LET ((NOSPELLFLG T)
               (DWIMESSGAG T)
               FILEPKGFLG LISPXHIST)
              (DECLARE (CL:SPECIAL NOSPELLFLG DWIMESSGAG FILEPKGFLG LISPXHIST))
              (DWIMIFY0 DEF (COND
                               ((OR (LISTP FN)
                                    (NULL FN))
                                '?)
                               (T FN))
                     NIL DEF])

(DELDEF
  [LAMBDA (NAME TYPE)                                    (* ; "Edited  5-Dec-86 06:20 by lmm")
    (PROG (TEM)
          (SETQ TYPE (GETFILEPKGTYPE TYPE 'TYPE))
      LP  [COND
             ((SETQ TEM (fetch DELDEF of TYPE))
              (APPLY* TEM NAME TYPE))
             (T (SELECTQ TYPE
                    (FNS                                     (* ; 
  "special because GETDEF of a FNS is only its EXPR definition, and DELDEF should only remove such")
                         (AND (EXPRP NAME)
                              (/PUTD NAME))
                         (REMPROP NAME 'EXPR)
                         [AND MSDATABASELST (MASTERSCOPE (LIST 'ERASE (KWOTE NAME])
                    (VARS (/SETTOPVAL NAME 'NOBIND))
                    (FILES [for LST in '(FILELST NOTCOMPILEDFILES NOTLISTEDFILES)
                              do (/SETTOPVAL LST (REMOVE NAME (GETTOPVAL LST]
                           (/replace FILEPROP of NAME with NIL)
                           (/replace FILECHANGES of NAME with NIL)
                           (/replace FILEDATES of NAME with NIL)
                           (FLUSHFILEMAPS NAME))
                    (FILEPKGCOMS (DELFROMLIST 'FILEPKGCOMSPLST NAME)
                                 (DELFROMLIST 'FILEPKGTYPES NAME)
                                 (for FIELD on (FILEPKGCOM NAME)
                                    by (CDDR FIELD) do (FILEPKGCOM NAME (CAR FIELD)
                                                                      NIL))
                                 (for FIELD on (FILEPKGTYPE NAME)
                                    by (CDDR FIELD) do (FILEPKGTYPE NAME (CAR FIELD)
                                                                      NIL))
                                 (/replace ALLFIELDS of NAME with NIL))
                    (ALISTS [AND (LISTP NAME)
                                 (DELFROMLIST (CAR NAME)
                                        (FASSOC (CADR NAME)
                                               (GETTOPVAL (CAR NAME])
                    (MACROS (for P in MACROPROPS do (/REMPROP NAME P)))
                    (PROPS (AND (LISTP NAME)
                                (/REMPROP (CAR NAME)
                                       (CADR NAME))))
                    (LISPXMACROS (DELFROMLIST 'LISPXMACROS (FASSOC NAME LISPXMACROS))
                                 (DELFROMLIST 'LISPXHISTORYMACROS (FASSOC NAME LISPXHISTORYMACROS
                                                                             ))
                                 (DELFROMLIST 'LISPXCOMS NAME)
                                 (DELFROMLIST 'HISTORYCOMS NAME))
                    (PRIN1 (LIST "Note: deleting" TYPE "not implemented yet")
                           T]
          (MARKASCHANGED NAME TYPE 'DELETED)
          (RETURN NAME])

(DELFROMLIST
  [LAMBDA (VAR VAL)                                      (* rmk%: " 3-JAN-82 23:22")
    (AND (FMEMB VAL (GETTOPVAL VAR))
         (/SETTOPVAL VAR (SUBSET (GETTOPVAL VAR)
                                (FUNCTION (LAMBDA (X)
                                            (AND (NEQ X VAL)
                                                 (OR (NLISTP X)
                                                     (NEQ (CDR X)
                                                          VAL])

(HASDEF
  [LAMBDA (NAME TYPE SOURCE SPELLFLG)                    (* ; "Edited 31-Aug-87 18:02 by drc:")

    (* ;; "is NAME the name of something of type TYPE?  NIL SOURCE means 0, not ?")

    (DECLARE (SPECVARS TYPE))
    (COND
       [[OR (LISTP TYPE)
            (LISTP (SETQ TYPE (GETFILEPKGTYPE TYPE 'TYPE](* ; "ignore SPELLFLG")
        (for TY in TYPE do (AND (SETQ $$VAL (HASDEF NAME TY SOURCE))
                                            (RETURN $$VAL]
       (T
        (PROG [(NODEF (fetch NULLDEF of TYPE))
               (OPTS '(NODWIM NOCOPY NOERROR HASDEF]
              (COND
                 ((NULL SOURCE)
                  (SETQQ SOURCE CURRENT)))
              (RETURN
               (SELECTQ SOURCE
                   ((CURRENT 0) 
                        [COND
                           ([OR
                             (MEMBER NAME (fetch CHANGED of TYPE))
                             (LET ((TM (fetch HASDEF of TYPE)))
                                  (COND
                                     (TM (APPLY* TM NAME TYPE SOURCE))
                                     [(NOT (LITATOM NAME))
                                      (SELECTQ TYPE
                                          (PROPS (AND (LISTP NAME)
                                                      (GETPROP (CAR NAME)
                                                             (CADR NAME))))
                                          ((FILES TEMPLATES MACROS LISPXMACROS VARS I.S.OPRS FNS 
                                                  FIELDS USERMACROS FILEVARS FILEPKGCOMS) 
                                               NIL)
                                          (NEQ NODEF (GETDEF NAME TYPE 'CURRENT OPTS]
                                     (T 
                                        (* ;; "symbol definitions")

                                        (SELECTQ TYPE
                                            (FILES (LET ((SYMBOL (CL:FIND-SYMBOL (CONCAT NAME "COMS")
                                                                        "INTERLISP")))
                                                        (AND SYMBOL (BOUNDP SYMBOL))))
                                            (TEMPLATES (GETTEMPLATE NAME))
                                            (MACROS (GETLIS NAME MACROPROPS))
                                            (LISPXMACROS (OR (FASSOC NAME LISPXMACROS)
                                                             (FASSOC NAME LISPXHISTORYMACROS)))
                                            (VARS (AND (NOT (CL:KEYWORDP NAME))
                                                       (NEQ (GETTOPVAL NAME)
                                                            'NOBIND)))
                                            (RECORDS (RECLOOK NAME))
                                            (I.S.OPRS [PROG [(TEM (GETPROP NAME 'CLISPWORD]
                                                            (RETURN (AND TEM (EQ (CAR TEM)
                                                                                 'FORWORD)
                                                                         (GETPROP (CDR TEM)
                                                                                'I.S.OPR])
                                            (FNS (AND (OR (AND (GETD NAME)
                                                               (EXPRP (GETD NAME)))
                                                          (GET NAME 'EXPR))
                                                      (NOT (HASDEF NAME 'FUNCTIONS SOURCE))))
                                            (FIELDS (RECORDFIELD? NAME))
                                            (USERMACROS (FASSOC NAME USERMACROS))
                                            (FILEVARS)
                                            ((PROPS ALISTS DEFS EXPRESSIONS) 
                                                 NIL)
                                            (FILEPKGCOMS (OR (FMEMB NAME FILEPKGCOMSPLST)
                                                             (FMEMB NAME FILEPKGTYPES)))
                                            (NEQ NODEF (GETDEF NAME TYPE 'CURRENT OPTS]
                            (OR NAME T))
                           (SPELLFLG (CL:WHEN (CL:SYMBOLP NAME)
                                         (FIXSPELL NAME NIL
                                                (SELECTQ TYPE
                                                    (FILES FILELST)
                                                    (FILEPKGCOMS (UNION FILEPKGCOMSPLST FILEPKGTYPES))
                                                    (FIELDS (for X in USERRECLST
                                                               join (APPEND (RECORDFIELDNAMES
                                                                                 X))))
                                                    (RECORDS (for X in USERRECLST
                                                                when (LITATOM (CADR X))
                                                                collect (CADR X)))
                                                    (LISPXMACROS LISPXCOMS)
                                                    (I.S.OPRS I.S.OPRLST)
                                                    (USERMACROS (MAPCAR USERMACROS
                                                                       (FUNCTION CAR)))
                                                    USERWORDS)
                                                NIL
                                                (LISTP SPELLFLG)
                                                [FUNCTION (LAMBDA (X)
                                                            (HASDEF X TYPE 'CURRENT]
                                                NIL T))])
                   (? (OR (HASDEF NAME TYPE 'CURRENT)
                          (AND (LITATOM NAME)
                               (HASDEF NAME TYPE 'SAVED SPELLFLG))
                          (WHEREIS NAME TYPE T)))
                   ((SAVED T) 
                        (NEQ NODEF (GETDEF NAME TYPE 'SAVED OPTS)))
                   (NEQ NODEF (GETDEF NAME TYPE SOURCE OPTS])

(GETFILEDEF
  [LAMBDA (FILENAME)                                     (* lmm " 4-Jul-85 13:25")

    (* ;; 
  "returns the official file name from a file name if NAME is FOO, look for FOO.LSP on FILELST")

    (COND
       ((FMEMB FILENAME FILELST)
        FILENAME)
       (T (for FILE in FILELST when (STRPOS FILENAME FILE 1 NIL T)
             do (COND
                       ((EQ (FILENAMEFIELD FILE 'NAME)
                            FILENAME)
                        (RETURN FILE])

(SAVEDEF
  [LAMBDA (NAME TYPE DEFINITION)                         (* JonL "24-Jul-84 20:11")
    (COND
       [(AND (LISTP NAME)
             (NULL TYPE))
        (MAPCAR NAME (FUNCTION (LAMBDA (I)
                                 (SAVEDEF I 'FNS]
       (T [SELECTQ (SETQ TYPE (GETFILEPKGTYPE TYPE 'TYPE))
              (FNS (AND (OR DEFINITION (SETQ DEFINITION (GETD NAME)))
                        (/PUT NAME [SETQ TYPE (COND
                                                 ((SUBRP DEFINITION)
                                                  'SUBR)
                                                 ((EXPRP DEFINITION)
                                                  'EXPR)
                                                 ((CCODEP DEFINITION)
                                                  'CODE)
                                                 (T 'LIST]
                              DEFINITION)))
              (VARS (AND (NEQ (OR DEFINITION (SETQ DEFINITION (GETTOPVAL NAME)))
                              'NOBIND)
                         (EQ DEFINITION (GETTOPVAL NAME))
                         (/PUT NAME (SETQ TYPE 'VALUE)
                               DEFINITION)))
              (AND [OR DEFINITION (SETQ DEFINITION (GETDEF NAME TYPE 'CURRENT
                                                          '(NOCOPY NOERROR NODWIM]
                   (/PUTASSOC NAME DEFINITION (OR (CDR (FASSOC TYPE SAVEDDEFS))
                                                  (CAR (SETQ SAVEDDEFS (CONS (LIST TYPE (CONS NAME))
                                                                             SAVEDDEFS]
          TYPE])

(UNSAVEDEF
  [LAMBDA (NAME TYPE DEF)                                (* lmm " 6-Jun-86 17:24")
    (SELECTQ TYPE
        ((NIL EXPR CODE SUBR LIST) 
             (COND
                [(LISTP NAME)                                (* ; "for compatibility")
                 (MAPCAR NAME (FUNCTION (LAMBDA (X)
                                          (UNSAVED1 X TYPE]
                (T (UNSAVED1 NAME TYPE))))
        (PROG NIL
              [OR DEF (SETQ DEF (GETDEF NAME (SETQ TYPE (GETFILEPKGTYPE TYPE 'TYPE))
                                       'SAVED 0))
                  (RETURN (CONS TYPE '(not found]
              (COND
                 ((NEQ DFNFLG T)
                  (SAVEDEF NAME TYPE)
                  (LET ((DFNFLG T))
                       (PUTDEF NAME TYPE DEF)))
                 (T (PUTDEF NAME TYPE DEF)))
              (RETURN TYPE])

(COMPAREDEFS
  [LAMBDA (NAME TYPE SOURCES)                            (* lmm " 4-Jul-85 14:37")
    (COND
       ((AND (LISTP TYPE)
             (GETFILEPKGTYPE SOURCES NIL T))
        (swap TYPE SOURCES)))
    (SETQ TYPE (GETFILEPKGTYPE TYPE 'TYPE))
    (PROG [DEF DEFS (SRCS (OR SOURCES (WHEREIS NAME TYPE T]
          [COND
             ((NULL SOURCES)
              (AND [OR (MEMBER NAME (FILEPKGCHANGES TYPE))
                       (SOME SRCS (FUNCTION (LAMBDA (FILE)
                                              (MEMBER NAME (CDR (ASSOC TYPE
                                                                       (fetch TOBEDUMPED
                                                                          of (fetch FILEPROP
                                                                                    of FILE]
                   (push SRCS 'CURRENT]
          (SETQ SRCS (for SRC in SRCS
                        when (COND
                                    ((NEQ [SETQ DEF (GETDEF NAME TYPE SRC '(NOERROR NOCOPY]
                                          (fetch NULLDEF of TYPE))
                                     (OR [SOME DEFS (FUNCTION (LAMBDA (DP)
                                                                (COMPARELST DEF (CDR DP]
                                         (push DEFS (CONS SRC DEF)))
                                     T)
                                    (T (PRINTOUT T "No " SRC " definition found for " NAME T)
                                       NIL)) collect SRC))
          (RETURN (COND
                     ((NULL SRCS)
                      '(no definitions found))
                     ((NULL (CDR SRCS))
                      '(only one definition found))
                     ((CDR DEFS)
                      [for S1 on (DREVERSE DEFS)
                         do (for S2 on (CDR S1) do (PRIN2 NAME T T)
                                                                  (AND (CAAR S1)
                                                                       (PRIN1 " from " T)
                                                                       (PRIN2 (CAAR S1)
                                                                              T T))
                                                                  (PRIN1 " and " T)
                                                                  (PRIN2 NAME T T)
                                                                  (COND
                                                                     ((CAAR S2)
                                                                      (PRIN1 " from " T)
                                                                      (PRIN2 (CAAR S2)
                                                                             T T)))
                                                                  (PRIN1 " differ:" T)
                                                                  (TERPRI T)
                                                                  (COMPARELISTS (CDAR S1)
                                                                         (CDAR S2]
                      'DIFFERENT)
                     (T 'SAME])

(COMPARE
  [LAMBDA (NAME1 NAME2 TYPE SOURCE1 SOURCE2)             (* lmm " 5-SEP-78 13:37")
    (PROG [[DEF1 (GETDEF NAME1 TYPE SOURCE1 '(NOERROR NOCOPY]
           (DEF2 (GETDEF NAME2 TYPE SOURCE2 '(NOERROR NOCOPY]
          (COND
             ((COMPARELST DEF1 DEF2)
              (RETURN)))
          (PRIN2 NAME1 T T)
          (COND
             (SOURCE1 (PRIN1 " from " T)
                    (PRIN2 SOURCE1 T T)))
          (PRIN1 " and " T)
          (PRIN2 NAME2 T T)
          (COND
             (SOURCE2 (PRIN1 " from " T)
                    (PRIN2 SOURCE2 T T)))
          (PRIN1 " differ:" T)
          (TERPRI T)
          (COMPARELISTS DEF1 DEF2)
          (RETURN T])

(TYPESOF
  [LAMBDA (NAME POSSIBLETYPES IMPOSSIBLETYPES SOURCE FILTER)
                                                          (* ; "Edited  2-Aug-88 02:08 by masinter")

    (* ;; "return list of all known types which NAME names")

    (LET
     (FOUND SHADOWED)
     (if (FMEMB SOURCE '(? NIL))
         then (CL:FLET [(RSHADOW NIL (for X in FOUND
                                            do (for Y in (CDR (FASSOC X SHADOW-TYPES))
                                                      do (if (FMEMB Y FOUND)
                                                                 then 
                                                             (* ; "shadower found before shadowed")
                                                                       (SETQ FOUND (REMOVE Y FOUND]
                         (LET (NOTFOUND NEWTYPES)
                              (for TYPE inside (OR POSSIBLETYPES FILEPKGTYPES)
                                 when [AND (LITATOM TYPE)
                                               (NOT (EQMEMB TYPE IMPOSSIBLETYPES))
                                               (OR (NULL FILTER)
                                                   (CL:FUNCALL FILTER TYPE))
                                               (NOT (find X in FOUND
                                                       suchthat (FMEMB TYPE
                                                                           (CDR (FASSOC X 
                                                                                       SHADOW-TYPES]
                                 do (if [OR (HASDEF NAME TYPE 'CURRENT)
                                                    (AND (LITATOM NAME)
                                                         (HASDEF NAME TYPE 'SAVED]
                                            then (push FOUND TYPE)
                                          else (push NOTFOUND TYPE)))
                              (RSHADOW)
                              [for FILE in FILELST while NOTFOUND
                                 when [NEQ T (fetch LOADTYPE of (GETPROP FILE
                                                                                   'FILE]
                                 do (if (SETQ NEWTYPES (INFILECOMS? NAME NOTFOUND
                                                                      (FILECOMS FILE)
                                                                      'TYPESOF))
                                            then [bind X for TYPE in NEWTYPES
                                                        when (FMEMB TYPE NOTFOUND)
                                                        do (push FOUND TYPE)
                                                              (if (SETQ X (FASSOC TYPE 
                                                                                     SHADOW-TYPES))
                                                                  then (SETQ NOTFOUND
                                                                            (LDIFFERENCE NOTFOUND X))
                                                                else (SETQ NOTFOUND
                                                                          (REMOVE TYPE NOTFOUND]
                                                  (SETQ NOTFOUND (LDIFFERENCE NOTFOUND NEWTYPES]
                              (if (AND NOTFOUND (GETD 'XCL::HASH-FILE-TYPES-OF))
                                  then (SETQ NEWTYPES (XCL::HASH-FILE-TYPES-OF NAME NOTFOUND))
                                        (SETQ FOUND (UNION NEWTYPES FOUND)))
                              (RSHADOW)
                              FOUND))
       else (for TYPE inside (OR POSSIBLETYPES FILEPKGTYPES)
                   when (AND (LITATOM TYPE)
                                 (NOT (EQMEMB TYPE IMPOSSIBLETYPES))
                                 (OR (NULL FILTER)
                                     (CL:FUNCALL FILTER TYPE))
                                 (HASDEF NAME TYPE SOURCE)) do (push FOUND TYPE)))
     FOUND])
)

(RPAQ? WHEREIS.HASH )



(* ; "Must come after PUTDEF")

(DEFINEQ

(FIXEDITDATE
  [LAMBDA (EXPR)                                         (* ; "Edited 17-Jul-89 11:13 by jtm:")
                                                             (* NOBIND "18-JUL-78 21:11")
                                                             (* Inserts or replaces previous edit 
                                                           date)
    (AND INITIALS (LISTP EXPR)
         (LISTP (CDR EXPR))
         (PROG (E)
               (COND
                  ((FMEMB (CAR EXPR)
                          LAMBDASPLST)

                   (* ;; "insert the edit date after the argument list")

                   (SETQ E (CDDR EXPR)))
                  [(FMEMB (GETPROP (CAR EXPR)
                                 ':DEFINER-FOR)
                          EDITDATE-ARGLIST-DEFINERS)

                   (* ;; "insert the edit date after the argument list")

                   (SETQ E (CDDR EXPR))
                   (while (NOT (CL:LISTP (CAR E))) do (SETQ E (CDR E))
                      finally (SETQ E (CDR E]
                  ((FMEMB (GETPROP (CAR EXPR)
                                 ':DEFINER-FOR)
                          EDITDATE-NAME-DEFINERS)

                   (* ;; "insert the edit date after the name")

                   (SETQ E (CDDR EXPR)))
                  (T (RETURN)))
           RETRY
               [COND
                  ((NLISTP E)
                   (RETURN))
                  ((LISTP (CAR E))
                   (SELECTQ (CAAR E)
                       ((CLISP%: DECLARE) 
                            (SETQ E (CDR E))
                            (GO RETRY))
                       (BREAK1 (COND
                                  ((EQ (CAR (CADAR E))
                                       'PROGN)
                                   (SETQ E (CDR (CADAR E)))
                                   (GO RETRY))))
                       (ADV-PROG                             (* No easy way to mark cleanly the 
                                                           date of an advised function)
                                 (RETURN))
                       (COND
                          ((AND (EQ (CAAR E)
                                    COMMENTFLG)
                                (EQ (CADAR E)
                                    'DECLARATIONS%:))
                           (SETQ E (CDR E))
                           (GO RETRY]
               (COND
                  ([for TAIL on E while (AND (LISTP (CAR TAIL))
                                                         (EQ (CAAR TAIL)
                                                             COMMENTFLG))
                      do (COND
                                ((AND (LISTP (CDR TAIL))
                                      (EDITDATE? (CAR TAIL)))
                                 (/RPLACA TAIL (EDITDATE (CAR TAIL)
                                                      INITIALS))
                                 (RETURN T]                  (* scans the comments for a 
                                                           timestamp for this user.)
                   NIL)
                  (T                                         (* attach the new timestamp at the 
                                                           beginning of the comments.)
                     (/ATTACH (EDITDATE NIL INITIALS)
                            E)))
               (RETURN EXPR])

(EDITDATE?
  [LAMBDA (COMMENT)                                      (* ; "Edited 11-Jun-92 16:44 by cat")
                                                             (* ; "Edited 13-Jul-89 09:30 by jtm:")
                                                             (* lmm "21-Mar-85 08:45")

         (* Tests to see if a given common is in fact an edit date --
       this has to be general enough to recognize the most comment comment forms while 
       specific enough to not recognize things that are not edit dates)

    (DECLARE (LOCALVARS . T))                            (* jtm%: changed test so that it 
                                                           creates one timestamp per user.)
    (COND
       [(LISTP COMMENT)
        (COND
           ((EQ (CAR COMMENT)
                COMMENTFLG)
            [COND
               (NIL (NULL NORMALCOMMENTSFLG)
                    (SETQ COMMENT (GETCOMMENT COMMENT]
            (COND
               ([OR (NOT (LISTP (CDR COMMENT)))
                    (NOT (LISTP (CDDR COMMENT]
                NIL)
               [(EQ (CADR COMMENT)
                    ';)                                      (* ; "CL style comment")
                (STRPOS INITIALS (CADDR COMMENT)
                       (IMINUS (NCHARS INITIALS]
               (T                                            (* ; "IL style comment")
                  (EQ (CADR COMMENT)
                      INITIALS]
       ((STRINGP COMMENT])
)



(* ; "Edit date support for all kinds of definers (from PARC 6/10/92)")


(RPAQQ EDITDATE-ARGLIST-DEFINERS (FUNCTIONS TYPES))

(RPAQQ EDITDATE-NAME-DEFINERS (STRUCTURES VARIABLES))
(DECLARE%: DOEVAL@COMPILE DONTCOPY

(GLOBALVARS EDITDATE-ARGLIST-DEFINERS EDITDATE-NAME-DEFINERS)
)



(* ;; 
"how to dump FILEPKGCOMS. The SPLST must be initialized to contain FILEPKGCOMS in order to get started."
)

(DEFINEQ

(FILEPKGCOM
  [LAMBDA N                                              (* JonL "10-Jul-84 19:38")
    (PROG (TEM (COM (ARG N 1)))
          (RETURN (COND
                     [(EQ N 1)
                      (OR (for FIELD in '(MACRO CONTENTS DELETE ADD)
                             when (SETQ TEM (FILEPKGCOM COM FIELD))
                             join (LIST FIELD TEM))
                          (AND (FMEMB COM (GETTOPVAL 'FILEPKGCOMSPLST))
                               (LIST 'COM T))
                          (AND [SETQ TEM (CDR (ASSOC COM (GETTOPVAL 'FILEPKGCOMSPLST]
                               (LIST 'COM TEM]
                     ((EQ N 2)
                      (SELECTQ (ARG N 2)
                          (ADD (fetch ADD of COM))
                          (DELETE (fetch DELETE of COM))
                          (MACRO (fetch MACRO of COM))
                          ((CONTENTS CONTAIN) 
                               [OR (fetch (FILEPKGCOM CONTENTS) of COM)
                                   (COND
                                      ((SETQ COM (fetch (FILEPKGCOM PRETTYTYPE) of COM))
                                       (COND
                                          ((EQ COM 'NILL)
                                           COM)
                                          [(EQ (CAR COM)
                                               'LAMBDA)
                                           (CONS (CAR COM)
                                                 (CONS [CONS (CAADR COM)
                                                             (CONS (OR (CADDR (CADR COM))
                                                                       'NAME)
                                                                   (CONS (CADR (CADR COM))
                                                                         (CDDDR (CADR COM]
                                                       (SUBST 'INFILECOMTAIL 'PRETTYCOM1 (CDDR COM]
                                          (T (LIST 'LAMBDA '(COM TYPE NAME)
                                                   (CONS COM '(COM TYPE NAME])
                          (COM [OR (AND (FMEMB COM (GETTOPVAL 'FILEPKGCOMSPLST))
                                        T)
                                   (CDR (ASSOC COM (GETTOPVAL 'FILEPKGCOMSPLST])
                          (ERROR (ARG N 2)
                                 "not file package command property")))
                     (T [for I TEM2 from 2 to N by 2
                           do (SETQ TEM (ARG N (ADD1 I)))
                                 (COND
                                    [(EQ (ARG N I)
                                         'COM)
                                     (SELECTQ TEM
                                         (NIL)
                                         (T [OR (FMEMB COM (GETTOPVAL 'FILEPKGCOMSPLST))
                                                (/SETTOPVAL 'FILEPKGCOMSPLST
                                                       (CONS COM (GETTOPVAL 'FILEPKGCOMSPLST])
                                         (COND
                                            ([SETQ TEM2 (ASSOC COM (GETTOPVAL 'FILEPKGCOMSPLST]
                                             (/RPLACD TEM2 TEM))
                                            (T (/SETTOPVAL 'FILEPKGCOMSPLST
                                                      (CONS (CONS COM TEM)
                                                            (GETTOPVAL 'FILEPKGCOMSPLST]
                                    (T [AND TEM (OR (FMEMB COM (GETTOPVAL 'FILEPKGCOMSPLST))
                                                    (/SETTOPVAL 'FILEPKGCOMSPLST
                                                           (CONS COM (GETTOPVAL 'FILEPKGCOMSPLST]
                                       (SELECTQ (ARG N I)
                                           (ADD (/replace (FILEPKGCOM ADD) of COM
                                                   with TEM))
                                           (DELETE (/replace (FILEPKGCOM DELETE) of
                                                                                         COM
                                                      with TEM))
                                           (MACRO (/replace (FILEPKGCOM MACRO) of COM
                                                     with TEM))
                                           ((CONTENTS CONTAIN) 
                                                (/replace (FILEPKGCOM CONTENTS) of COM
                                                   with TEM))
                                           (ERROR (ARG N I)
                                                  "not file package command property"]
                        (MARKASCHANGED COM 'FILEPKGCOMS])

(FILEPKGTYPE
  [LAMBDA N                                              (* lmm " 5-Jul-85 09:07")
    (PROG ((TYPE (ARG N 1))
           TEM)
          (RETURN (COND
                     [(EQ N 1)
                      (OR (for FIELD in (UNION '(DESCRIPTION)
                                                       FILEPKGTYPEPROPS)
                             when (SETQ TEM (FILEPKGTYPE TYPE FIELD))
                             join (LIST FIELD TEM))
                          (AND (FMEMB TYPE (GETTOPVAL 'FILEPKGTYPES))
                               (LIST 'TYPE T))
                          (AND [SETQ TEM (CDR (ASSOC TYPE (GETTOPVAL 'FILEPKGTYPES]
                               (LIST 'TYPE TEM]
                     [(EQ N 2)
                      (if (FMEMB (ARG N 2)
                                     FILEPKGTYPEPROPS)
                          then (GETPROP TYPE (ARG N 2))
                        else (SELECTQ (ARG N 2)
                                     (DESCRIPTION (fetch DESCRIPTION of TYPE))
                                     (TYPE [OR (AND (FMEMB TYPE (GETTOPVAL 'FILEPKGTYPES))
                                                    T)
                                               (CDR (ASSOC TYPE (GETTOPVAL 'FILEPKGTYPES])
                                     (ERROR (ARG N 2)
                                            "not file package type property"]
                     (T [for I TEM2 from 2 to N by 2
                           do (SETQ TEM (ARG N (ADD1 I)))
                                 (COND
                                    [(EQ (ARG N I)
                                         'TYPE)
                                     (SELECTQ TEM
                                         (NIL)
                                         (T (OR (FMEMB TYPE FILEPKGTYPES)
                                                (/SETTOPVAL 'FILEPKGTYPES (CONS TYPE FILEPKGTYPES))))
                                         (COND
                                            ((SETQ TEM2 (ASSOC TYPE FILEPKGTYPES))
                                             (/RPLACD TEM2 TEM))
                                            (T (/SETTOPVAL 'FILEPKGTYPES (CONS (CONS TYPE TEM)
                                                                               FILEPKGTYPES]
                                    (T [AND TEM (OR (FMEMB TYPE FILEPKGTYPES)
                                                    (/SETTOPVAL 'FILEPKGTYPES (CONS TYPE FILEPKGTYPES
                                                                                    ]
                                       (if (FMEMB (ARG N I)
                                                      FILEPKGTYPEPROPS)
                                           then (if TEM
                                                        then (/PUTPROP TYPE (ARG N I)
                                                                        TEM)
                                                      else (/REMPROP TYPE (ARG N I)))
                                         else (SELECTQ (ARG N I)
                                                      (DESCRIPTION (/replace DESCRIPTION
                                                                      of TYPE with TEM))
                                                      (ERROR (ARG N I)
                                                             "not file package command/type property"
                                                             ]
                        (MARKASCHANGED TYPE 'FILEPKGCOMS])
)

(PUTPROPS FILEPKGCOM ARGNAMES (COMMANDNAME (KEYWORDS%: MACRO ADD DELETE CONTENTS)))

(ADDTOVAR FILEPKGCOMSPLST FILEPKGCOMS)

(ADDTOVAR FILEPKGTYPES FILEPKGCOMS)
(PUTDEF (QUOTE FILEPKGCOMS) (QUOTE FILEPKGCOMS) '([COM CONTENTS (LAMBDA (COM NAME TYPE)
                                                                       (* Revert to NILL when no 
                                                                          longer coercing 
                                                                          PRETTYDEFMACROS to 
                                                                          FILEPKGCOMS)
                                                                       (AND (EQ TYPE 'FILEPKGCOMS)
                                                                            (INFILECOMTAIL COM]
                                                  (TYPE DESCRIPTION "file package commands/types" 
                                                        GETDEF T PUTDEF FILEPKGCOMS.PUTDEF)))
(PUTDEF (QUOTE ALISTS) (QUOTE FILEPKGCOMS) '([COM MACRO (X (COMS * (MAKEALISTCOMS . X]
                                             (TYPE DESCRIPTION "alist entries" GETDEF ALISTS.GETDEF 
                                                   WHENCHANGED (ALISTS.WHENCHANGED))))
(PUTDEF (QUOTE DEFS) (QUOTE FILEPKGCOMS) '[(COM MACRO (X (COMS . X])
(PUTDEF (QUOTE EDITMACROS) (QUOTE FILEPKGCOMS) '((TYPE TYPE USERMACROS)))
(PUTDEF (QUOTE EXPRESSIONS) (QUOTE FILEPKGCOMS) '((TYPE DESCRIPTION "expressions" WHENCHANGED (
                                                                              EXPRESSIONS.WHENCHANGED
                                                                                               )
                                                        EDITDEF NILL)))
(PUTDEF (QUOTE FIELDS) (QUOTE FILEPKGCOMS) '((TYPE EDITDEF NILL)))
(PUTDEF (QUOTE FILEPKGTYPES) (QUOTE FILEPKGCOMS) '((COM COM FILEPKGCOMS)
                                                   (TYPE TYPE FILEPKGCOMS)))
(PUTDEF (QUOTE FILES) (QUOTE FILEPKGCOMS) '([COM MACRO [X (P * (CONS (MAKEFILESCOMS . X]
                                                 CONTENTS
                                                 (LAMBDA (COM NAME TYPE)
                                                        (AND (EQ TYPE 'FILES)
                                                             (SUBSET (INFILECOMTAIL COM)
                                                                    (FUNCTION LITATOM]
                                            (TYPE PUTDEF FILES.PUTDEF WHENCHANGED (FILES.WHENCHANGED)
                                                  EDITDEF EDITDEF.FILES)))
(PUTDEF (QUOTE FILEVARS) (QUOTE FILEPKGCOMS) '((COM MACRO (X (VARS . X)))
                                               (TYPE NULLDEF NOBIND EDITDEF NILL)))
(PUTDEF (QUOTE FNS) (QUOTE FILEPKGCOMS) '((COM MACRO
                                               (X [E (MAPC 'X (FUNCTION (LAMBDA
                                                                         (FN)
                                                                         (AND (GETPROP FN
                                                                                     'FUNCTIONS)
                                                                              (CL:WARN 
                                                                      "~A has a FUNCTIONS definition"
                                                                                     FN]
                                                  (ORIGINAL (FNS . X)))
                                               CONTENTS NILL)
                                          (TYPE DESCRIPTION "functions" PUTDEF FNS.PUTDEF CANFILEDEF
                                                T)))
(PUTDEF (QUOTE INITRECORDS) (QUOTE FILEPKGCOMS) '[(COM MACRO (X (P * (RECORDALLOCATIONS . X)))
                                                       CONTENTS
                                                       (LAMBDA (COM NAME TYPE ONFILETYPE)
                                                              (AND (NULL ONFILETYPE)
                                                                   (EQ TYPE 'RECORDS)
                                                                   (INFILECOMTAIL COM])
(PUTDEF (QUOTE INITVARS) (QUOTE FILEPKGCOMS) '((COM COM T)))
(PUTDEF (QUOTE LISPXCOMS) (QUOTE FILEPKGCOMS) '((TYPE TYPE LISPXMACROS)))
(PUTDEF (QUOTE LISPXMACROS) (QUOTE FILEPKGCOMS) '((COM MACRO (X (COMS * (MAKELISPXMACROSCOMS . X)))
                                                       CONTENTS NILL)
                                                  (TYPE DESCRIPTION "LISPX commands")))
(PUTDEF (QUOTE MACROS) (QUOTE FILEPKGCOMS) '((COM
                                              MACRO
                                              [X
                                               (DECLARE%:
                                                EVAL@COMPILE
                                                (P
                                                 *
                                                 (MAPCAR
                                                  'X
                                                  (FUNCTION
                                                   (LAMBDA (Y)
                                                          (LET [[FNDEF (GETDEF Y 'FUNCTIONS
                                                                              'CURRENT
                                                                              '(NOCOPY NOERROR]
                                                                (MACDEF (GETDEF Y 'MACROS
                                                                               'CURRENT
                                                                               '(NOCOPY NOERROR]
                                                               (COND
                                                                ((AND FNDEF (EQ (CAR FNDEF)
                                                                                'DEFMACRO))
                                                                 (CL:WARN 
                           "Need to change MACROS to FUNCTIONS for writing out Common Lisp macro ~S."
                                                                        FNDEF)
                                                                 (LIST 'PROGN FNDEF MACDEF))
                                                                (T (OR MACDEF (CL:CERROR 
                                                          "Go ahead and finish writing out the file."
                                                                                     
                                                                       "No MACROS definition for ~A."
                                                                                     Y)
                                                                       (GETDEF Y 'MACROS 'CURRENT]
                                              CONTENTS NILL)
                                             (TYPE DESCRIPTION "Interlisp macros" GETDEF 
                                                   MACROS.GETDEF WHENCHANGED (CLEARCLISPARRAY))))
(PUTDEF (QUOTE PRETTYDEFMACROS) (QUOTE FILEPKGCOMS) '((COM COM FILEPKGCOMS)))
(PUTDEF (QUOTE PROPS) (QUOTE FILEPKGCOMS) '([COM MACRO (X (COMS * (MAKEPROPSCOMS . X]
                                            (TYPE DESCRIPTION "property lists" WHENCHANGED (
                                                                                    PROPS.WHENCHANGED
                                                                                            ))))
(PUTDEF (QUOTE RECORDS) (QUOTE FILEPKGCOMS) '[[COM
                                               MACRO
                                               (X [E (MAPC 'X (FUNCTION (LAMBDA
                                                                         (RECORD)
                                                                         (AND (GETPROP RECORD
                                                                                     'STRUCTURES)
                                                                              (CL:WARN 
                                                                     "~A has a STRUCTURES definition"
                                                                                     RECORD]
                                                  (E (RECORDECLARATIONS . X))
                                                  (INITRECORDS . X))
                                               CONTENTS
                                               (LAMBDA (COM NAME TYPE ONFILETYPE)
                                                      (AND (EQ TYPE 'FIELDS)
                                                           (NULL ONFILETYPE)
                                                           (MAPCONC (INFILECOMTAIL COM)
                                                                  (FUNCTION (LAMBDA
                                                                             (X)
                                                                             (APPEND (
                                                                                     RECORDFIELDNAMES
                                                                                      X]
                                              (TYPE DESCRIPTION "records" DELDEF
                                                    (LAMBDA (X)
                                                           (/SETTOPVAL 'USERRECLST
                                                                  (REMOVE (RECLOOK X)
                                                                         USERRECLST])
(PUTDEF (QUOTE OLDRECORDS) (QUOTE FILEPKGCOMS) '((COM COM T)))
(PUTDEF (QUOTE SYSRECORDS) (QUOTE FILEPKGCOMS) '[(COM MACRO (X (E (SAVEONSYSRECLST . X)))
                                                      CONTENTS
                                                      (LAMBDA (COM NAME TYPE ONFILETYPE)
                                                             (AND (NULL ONFILETYPE)
                                                                  (EQ TYPE 'RECORDS)
                                                                  (INFILECOMTAIL COM])
(PUTDEF (QUOTE USERMACROS) (QUOTE FILEPKGCOMS) '((COM MACRO (X (COMS * (MAKEUSERMACROSCOMS . X)))
                                                      CONTENTS NILL)
                                                 (TYPE DESCRIPTION "edit macros")))
(PUTDEF (QUOTE VARS) (QUOTE FILEPKGCOMS) '((COM MACRO
                                                (X [E (MAPC 'X (FUNCTION (LAMBDA
                                                                          (VAR)
                                                                          (AND (GETPROP VAR
                                                                                      'VARIABLES)
                                                                               (CL:WARN 
                                                                 "~A also has a VARIABLES definition"
                                                                                      VAR]
                                                   (ORIGINAL (VARS . X)))
                                                CONTENTS NILL)
                                           (TYPE DESCRIPTION "variables" NULLDEF NOBIND PUTDEF 
                                                 VARS.PUTDEF)))
(PUTDEF (QUOTE *) (QUOTE FILEPKGCOMS) '((COM CONTENTS NILL)))
(PUTDEF (QUOTE CONSTANTS) (QUOTE FILEPKGCOMS) '[(COM MACRO (X (DECLARE%: EVAL@COMPILE (VARS . X)
                                                                     (P (CONSTANTS . X])

(ADDTOVAR SHADOW-TYPES (FUNCTIONS FNS)
                           (VARIABLES VARS CONSTANTS))

(RPAQ? SAVEDDEFS )



(* ; "EDITCALLERS")

(DEFINEQ

(FINDCALLERS
  [LAMBDA (ATOMS FILES)                                  (* lmm "30-SEP-78 01:36")
    (PROG ((X (EDITCALLERS ATOMS FILES T)))
          (RETURN (NCONC (DREVERSE (CDR X))
                         (AND (CAR X)
                              (LIST (CONS (COND
                                             ((CDR X)
                                              '"plus other places on")
                                             (T 'on))
                                          (CAR X])

(EDITCALLERS
  [LAMBDA (ATOMS FILES COMS)                            (* ; "Edited  8-Aug-2020 17:32 by rmk:")
                                                             (* bvm%: " 3-Nov-86 17:30")
    (LET
     (FFILEPOSPATTERNS FNS OTHERSFILES EDITPATTERN)
     [SETQ EDITPATTERN (EDITFPAT (CONS '*ANY* (SETQ ATOMS (MKLIST ATOMS]
     [for FILE in (COND
                             ((NULL FILES)
                              FILELST)
                             ((EQ FILES T)
                              (UNION SYSFILES FILELST))
                             ((LISTP FILES)
                              FILES)
                             (T (LIST FILES)))
        do
        (RESETLST
            [PROG (PATTERNS CA RDTBL MAP NOMAPFLG FULL FILESTREAM PRINTFLG ENV DUMMY TOP I)
                  (OR (SETQ FULL (FINDFILE FILE))
                      (RETURN (LISPXPRINT (CONS FILE '(not found))
                                     T T)))
                  [RESETSAVE NIL (LIST (FUNCTION CLOSEF?)
                                       (SETQ FILESTREAM (OPENSTREAM FULL 'INPUT]
                  (CL:FORMAT T "~A: " (SETQ FULL (FULLNAME FILESTREAM)))
                  (CL:MULTIPLE-VALUE-SETQ (ENV MAP TOP)
                         (OR (GET-ENVIRONMENT-AND-FILEMAP FULL)
                             (\PARSE-FILE-HEADER FILESTREAM)))

             (* ;; "Get reader environment of file.  The call to GET-ENVIRONMENT-AND-FILEMAP with the filename will get cached info if it exists.  Otherwise, read the top of the file")

                  (SETQ RDTBL (AND ENV (fetch (READER-ENVIRONMENT REREADTABLE) of ENV)))
                  (SETQ CA (SEPRCASE DWIMIFYCOMPFLG RDTBL))
                  [OR (SETQ PATTERNS (CDR (ASSOC RDTBL FFILEPOSPATTERNS)))
                      (push FFILEPOSPATTERNS
                             (CONS RDTBL (SETQ PATTERNS
                                          (for ATOM in ATOMS
                                             collect (CONCAT
                                                          (COND
                                                             ((EQ (CHCON1 ATOM)
                                                                  (CHARCODE ESCAPE))
                                                              (SETQ ATOM (SUBSTRING ATOM 2 -1))
                                                              "")
                                                             (T " "))
                                                          [COND
                                                             ((SETQ I (STRPOS ' ATOM))
                                                              (SUBSTRING ATOM 1 (SUB1 I)))
                                                             ((STRINGP ATOM))
                                                             (T (LET ((*PACKAGE* (CL:SYMBOL-PACKAGE
                                                                                  ATOM)))
                                                             (* ; 
                                                           "Keep MKSTRING from putting a prefix on")
                                                                     (MKSTRING ATOM T RDTBL]
                                                          (COND
                                                             (I "")
                                                             (T " "]
                  (for PATTERN in PATTERNS
                     do
                     (SETFILEPTR FILESTREAM (SETQ I (OR TOP 0)))
                     (while (SETQ I (FFILEPOS PATTERN FILESTREAM I NIL NIL T CA))
                        do
                        (COND
                           ((NULL PRINTFLG)                  (* ; 
                                   "cause the printing of the filename to be saved on history list")
                            (SETQ PRINTFLG T)
                            (LISPXPRIN2 FULL T T T)

                            (* ;; "print with NODOFLG=T means just to record the printing;  the idea is that only those files in which something is found will be remembered on the history list")

                            (LISPXPRIN1 ": " T NIL T)))
                        [OR
                         [AND (NEQ MAP T)
                              (for X in (CDR (OR MAP [PROGN (SETFILEPTR FILESTREAM 0)
                                                                    (SETQ MAP (OR (GETFILEMAP 
                                                                                         FILESTREAM)
                                                                                  (LOADFILEMAP 
                                                                                         FILESTREAM]
                                                         (PROGN 
                                                             (* ; "file has no filemap")
                                                                (SETQ MAP (SETQ NOMAPFLG T))
                                                                (LISPXPRIN1 " no filemap!" T)
                                                                NIL)))
                                 thereis (AND (ILESSP (CAR X)
                                                         I)
                                                  (IGREATERP (CADR X)
                                                         I)
                                                  (for Z in (CDDR X)
                                                     thereis (COND
                                                                    ((AND (ILESSP (CADR Z)
                                                                                 I)
                                                                          (IGREATERP (CDDR Z)
                                                                                 I))
                                                                     [COND
                                                                        ((NOT (FMEMB (CAR Z)
                                                                                     FNS))
                                                                         (SETQ FNS
                                                                          (CONS (LISPXPRIN2
                                                                                 (CAR Z)
                                                                                 T T)
                                                                                FNS]
                                                                     (SETQ I (CDDR Z))
                                                                     T]
                         (PROGN (LISPXPRIN2 I T T)
                                (OR (FMEMB FILE OTHERSFILES)
                                    (SETQ OTHERSFILES (CONS FILE OTHERSFILES]
                        (LISPXSPACES 1 T)))
                  (COND
                     (PRINTFLG (LISPXTERPRI T))
                     (T (TERPRI T)))
                  (COND
                     ((NEQ COMS T)
                      (COND
                         ((OR FNS OTHERSFILES)
                          (EDITFROMFILE (OR NOMAPFLG (DREVERSE FNS))
                                 FULL EDITPATTERN COMS (NULL OTHERSFILES))
                          (SETQ OTHERSFILES)
                          (SETQ FNS])]
     (COND
        ((EQ COMS T)
         (CONS OTHERSFILES FNS])

(EDITFROMFILE
  [LAMBDA (FNS FILES EDITPATTERN EDITCOMS ONLYTYPES)     (* rmk%: "14-Mar-85 21:51")
    (RESETVARS [(EDITLOADFNSFLG (COND
                                   ((EQ EDITLOADFNSFLG T)
                                    '(T . NO))
                                   (T EDITLOADFNSFLG]
               (PROG NIL
                     [OR EDITCOMS (SETQ EDITCOMS (LIST (LIST 'EXAM EDITPATTERN]
                     (AND
                      (SETQ FILES (for FILE inside (OR FILES FILELST)
                                     when (OR (AND EDITLOADFNSFLG (FMEMB (ROOTFILENAME FILE)
                                                                             FILELST))
                                                  (COND
                                                     ((EQ 'Y (ASKUSER DWIMWAIT 'Y (LIST "load from" 
                                                                                        FILE)
                                                                    NIL T))
                                                      (LOADFROM FILE FNS 'ALLPROP)
                                                      T))) collect FILE))
                      (for TYPE in [COND
                                              ((LISTP ONLYTYPES))
                                              (ONLYTYPES '(FNS))
                                              (T 

                                 (* ;; "Move FNS to the front.  This means that all the fns will be dwimified and edited before anything else (like a rename of fields) is done.")

                                                 (CONS 'FNS (REMOVE 'FNS FILEPKGTYPES]
                         when (AND (LITATOM TYPE)
                                       (NEQ (fetch EDITDEF of TYPE)
                                            'NILL))
                         do
                         (PROG (SEEN)
                               (for FILE inside FILES
                                  do
                                  (for NAME in [COND
                                                          ((AND (EQ TYPE 'FNS)
                                                                (NEQ FNS T))
                                                             (* ; 
                                                    "for this type, we are given the list of items")
                                                           (PROG1 FNS (SETQ FNS NIL)))
                                                          (T (* ; 
                             "only want the values of `TYPE' which are not part of some other type")
                                                             (FILECOMSLST FILE TYPE 'EDIT]
                                     unless (MEMBER NAME SEEN)
                                     do
                                     (ERSETQ
                                      (PROG [(DEF (OR (GETDEF NAME TYPE 'CURRENT
                                                             '(NOCOPY NOERROR))
                                                      (GETDEF NAME TYPE 'SAVED
                                                             '(NOCOPY NOERROR]

                                 (* ;; "If definition has been loaded, it may have been editted.  Work on that explicitly instead of bringing in a file definition to smash the users previous changes.  Perhaps we should query the user about this, but until the interaction is worked out, it is better to avoid trashing his in core edits, given that he can always get the file definition from permanent storage with LOADFNS.  --- We might also be more discriminating about this: if the user specified a root file name, then he means the definition from the definition group, not the physical file.  But ...  rmk")

                                            (COND
                                               ((OR (AND (EQ TYPE 'FNS)
                                                         (NEQ FNS T))
                                                    (AND (LISTP DEF)
                                                         (LOOKIN DEF EDITPATTERN)))
                                                (COND
                                                   ((NULL SEEN)
                                                    (LISPXPRIN1 "editing the " T)
                                                    (LISPXPRIN1 (OR (fetch DESCRIPTION
                                                                       of TYPE)
                                                                    TYPE)
                                                           T)
                                                    (LISPXSPACES 1 T)))
                                                (SETQ SEEN (CONS NAME SEEN))
                                                (LISPXPRIN2 NAME T T)
                                                (LISPXPRIN1 ":
" T)
                                                (COND
                                                   ((NOT
                                                     (ERSETQ (EDITDEF
                                                              NAME TYPE
                                                              (OR (AND DEF (CONS '= DEF))
                                                                  FILE)
                                                              EDITCOMS)))
                                                    (LISPXPRIN1 "failed" T)))
                                                (LISPXTERPRI T])

(FINDATS
  [LAMBDA (X L)                                          (* lmm "11-FEB-78 16:03")
    (COND
       ((NLISTP X)
        (FMEMB X L))
       (T (OR (FINDATS (CAR X)
                     L)
              (FINDATS (CDR X)
                     L])

(LOOKIN
  [LAMBDA (X PAT)                                        (* lmm "11-MAR-78 14:20")
    (COND
       ([AND (EQ (CAR PAT)
                 '*ANY*)
             (EVERY (CDR PAT)
                    (FUNCTION (LAMBDA (X)
                                (AND (LITATOM X)
                                     (NOT (STRPOS ' X]
        (FINDATS X (CDR PAT)))
       (T (EDITFINDP X PAT T])
)
(DEFINEQ

(SEPRCASE
  [LAMBDA (CLFLG RDTBL)                                  (* bvm%: "24-Oct-86 18:16")

    (* ;; "make a case array for FFILEPOS in which all of the seprs, breaks, and (possibly) clisp chars are all equivalent.  Based on FILERDTBL, but others are close with respect to breaks and seprs")

    (OR RDTBL (SETQ RDTBL FILERDTBL))
    (OR [ARRAYP (CDR (ASSOC RDTBL (COND
                                     (CLFLG CLISPCASEARRAYS)
                                     (T SEPRCASEARRAYS]
        (LET ((CA (CASEARRAY)))
             [if (READTABLEPROP RDTBL 'CASEINSENSITIVE)
                 then                                    (* ; "map upper into lower case")
                       (for I from (CHARCODE A) to (CHARCODE Z)
                          do (SETCASEARRAY CA I (+ I (- (CHARCODE a)
                                                            (CHARCODE A]
             (for X in (NCONC (AND CLFLG (for Y in CLISPCHARS
                                                    collect (CHCON1 Y)))
                                      (GETSEPR RDTBL)
                                      (GETBRK RDTBL)) do (SETCASEARRAY CA X 0))
             (if *PACKAGE*
                 then                                    (* ; 
                               "symbols qualified with package prefix will otherwise be unfindable")
                       (SETCASEARRAY CA (READTABLEPROP RDTBL 'PACKAGECHAR)
                              0))
             (SETQ CA (CONS RDTBL CA))
             (COND
                (CLFLG (push CLISPCASEARRAYS CA))
                (T (push SEPRCASEARRAYS CA)))
             (CDR CA])
)

(RPAQ? DEFAULTRENAMEMETHOD '(EDITCALLERS CAREFUL))

(RPAQ? SEPRCASEARRAYS )

(RPAQ? CLISPCASEARRAYS )

(MOVD? 'INFILEP 'FINDFILE)

                                                             (* ; "or else from SPELLFILE")
(DECLARE%: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY

(BLOCK%: EDITFROMFILE EDITFROMFILE LOOKIN (GLOBALVARS EDITLOADFNSFLG)
       (NOLINKFNS LOADFROM))
)
(DECLARE%: DOEVAL@COMPILE DONTCOPY

(GLOBALVARS SYSFILES CLISPCASEARRAYS SEPRCASEARRAYS CLISPCHARS)
)



(* ; "EXPORT")

(DEFINEQ

(IMPORTFILE
  [LAMBDA (FILE RETURNFLG)                               (* lmm " 6-Jun-86 17:43")
    (RESETLST
        [RESETSAVE NIL (LIST 'CLOSEF (SETQ FILE (OPENSTREAM FILE 'INPUT]
        (RESETSAVE (INPUT FILE))                             (* ; 
                "Reset INPUT in case some form on the file's action is to read the next expression")
        (NCONC [COND
                  ((EQ RETURNFLG T)                          (* ; 
                                           "Just creating EXPORTS.ALL, don't side-effect the world")
                   (IMPORTFILESCAN FILE RETURNFLG))
                  (T (LET (FILEPKGFLG DFNFLG)
                          (IMPORTFILESCAN FILE RETURNFLG]
               (IMPORTEVAL [LIST 'PUTPROP (KWOTE (ROOTFILENAME FILE))
                                     ''IMPORTDATE
                                     (LIST 'IDATE (GETFILEINFO FILE 'CREATIONDATE]
                      RETURNFLG)))])

(IMPORTEVAL
  [LAMBDA (FORM RETURNFLG)                               (* ; "Edited  2-May-87 18:57 by Pavel")

    (* ;; "Ignore DONTEVAL@LOAD'S --- If RETURNFLG is on, return list of forms")

    (AND (LISTP FORM)
         (SELECTQ (CAR FORM)
             (DECLARE%: (FOR Z IN (CDR FORM) JOIN (IMPORTEVAL Z RETURNFLG)))
             (CL:EVAL-WHEN (FOR Z IN (CDDR FORM) JOIN (IMPORTEVAL Z RETURNFLG)))
             (/DECLAREDATATYPE                               (* ; 
                    "Ignore datatype initializations -- we only need the record declaration itself")
                  NIL)
             (PROGN                                          (* ; "default: eval and/or return it")
                    (AND (NEQ RETURNFLG T)
                         (EVAL FORM))
                    (AND RETURNFLG (LIST FORM])

(IMPORTFILESCAN
  [LAMBDA (FILE RETURNFLG)                               (* bvm%: "24-Oct-86 19:31")
    (WITH-READER-ENVIRONMENT (GET-ENVIRONMENT-AND-FILEMAP FILE)
        (while (FFILEPOS BEGINEXPORTDEFSTRING FILE NIL NIL NIL T) bind DEF
           join (until (EQUAL (SETQ DEF (READ FILE))
                                      ENDEXPORTDEFFORM) join (IMPORTEVAL DEF RETURNFLG))))])

(CHECKIMPORTS
  [LAMBDA (FILES NOASKFLG)                               (* rmk%: "19-FEB-83 16:31")
                                                             (* ; 
                                           "Loads exported definitions from new versions of FILES.")
    (COND
       ((AND (SETQ FILES (for FILE inside FILES bind FULLFILENAME DATE
                            when [AND (SETQ FULLFILENAME (FINDFILE FILE T))
                                          (OR [NOT (SETQ DATE (GETPROP (ROOTFILENAME FILE)
                                                                     'IMPORTDATE]
                                              (NOT (IEQP DATE (GETFILEINFO FULLFILENAME 
                                                                     'ICREATIONDATE]
                            collect (LIST FILE FULLFILENAME)))
             (OR NOASKFLG (SELECTQ (ASKUSER 5 'Y (LIST "load new exports from "
                                                       (MAPCAR FILES (FUNCTION CAR)))
                                          '((Y "es
")
                                            (N "o
"))
                                          T)
                              (N NIL)
                              T)))
        (for FILE in FILES do (IMPORTFILE (CADR FILE])

(GATHEREXPORTS
  [LAMBDA (FROMFILES TOFILE FLG)                         (* bvm%: "14-Oct-86 23:12")
                                                             (* ; 
                                        "Copies all exported definitions from FROMFILES to TOFILE.")
    (RESETLST
        [RESETSAVE NIL (LIST (FUNCTION CLOSE-AND-MAYBE-DELETE)
                             (SETQ TOFILE (OPENSTREAM TOFILE 'OUTPUT]
        (RESETSAVE (OUTPUT TOFILE))
        (LET ((ENV *DEFAULT-MAKEFILE-ENVIRONMENT*))
             (SETQ ENV (if ENV
                           then (\DO-DEFINE-FILE-INFO NIL ENV)
                         else *OLD-INTERLISP-READ-ENVIRONMENT*))
             (WITH-READER-ENVIRONMENT ENV
                 (PRINT-READER-ENVIRONMENT ENV)
                 (printout NIL "(LISPXPRIN1 %"EXPORTS GATHERED FROM " (DIRECTORYNAME T)
                        " ON "
                        (DATE)
                        "%"  T)" T "(LISPXTERPRI T)" T)
                 (for F inside FROMFILES do (MAPC (IMPORTFILE F (OR FLG T))
                                                              (FUNCTION PRINT))
                                                       (TERPRI))
                 (PRINT 'STOP)
                 (TERPRI)
                 (FULLNAME TOFILE))))])

(\DUMPEXPORTS
  [NLAMBDA COMS                                          (* bvm%: "24-Oct-86 19:42")

(* ;;; "Dumps an EXPORT form.  IMPORTFILE looks for a string announcing imports, but we must print it in a way that lets the file be loaded ok.")

    (PRIN1 "(")
    (PRIN2 '*)
    (PRIN1 (SUBSTRING BEGINEXPORTDEFSTRING 2))               (* ; 
                                   "BEGINEXPORTDEFSTRING starts with a * for benefit of IMPORTFILE")
    (for TAIL on COMS do (PRETTYCOM (CAR TAIL)))
    (TERPRI)
    (PRINT ENDEXPORTDEFFORM)
    (TERPRI])
)
(PUTDEF (QUOTE EXPORT) (QUOTE FILEPKGCOMS) '[(COM MACRO (X (E (\DUMPEXPORTS . X])

(RPAQ? BEGINEXPORTDEFSTRING "* %"FOLLOWING DEFINITIONS EXPORTED%")")

(RPAQ? ENDEXPORTDEFFORM '(* "END EXPORTED DEFINITIONS"))
(DECLARE%: DOEVAL@COMPILE DONTCOPY

(GLOBALVARS BEGINEXPORTDEFSTRING ENDEXPORTDEFFORM)
)



(* ; "for GAINSPACE")

(DEFINEQ

(CLEARFILEPKG
  [LAMBDA (FLG)                                          (* bvm%: "29-Aug-86 13:02")
    (PROG NIL
          (COND
             ((SELECTQ FLG
                  ((E T) 
                       T)
                  (Y (TERPRI T)
                     (PRIN1 "you can delete just the filemaps -
" T)
                     (PROG1 [ASKUSER NIL NIL "are you sure you want to delete EVERYTHING ? "
                                   '((Y "es - everything" RETURN T)
                                     (N "o - just the filemaps" RETURN NIL)
                                     (E "verything" RETURN T)
                                     (F "ilemaps only" RETURN NIL]
                            (TERPRI T)))
                  NIL)
              (UPDATEFILES)
              [SETQ FILELST (SUBSET FILELST (FUNCTION (LAMBDA (FILE)
                                                        (COND
                                                           ((fetch TOBEDUMPED
                                                               of (fetch FILEPROP
                                                                         of FILE))
                                                            (PRINT FILE T T)
                                                            (PRIN1 " has changes, not wiped." T)
                                                            (TERPRI T)
                                                            T)
                                                           (T (replace FILEPROP of FILE
                                                                 with NIL)
                                                              (replace FILECHANGES of FILE
                                                                 with NIL)
                                                              (SMASHFILECOMS FILE)
                                                              (NCONC1 SYSFILES FILE)
                                                              NIL]
              (SETQ LOADEDFILELST)))
          (SELECTQ FLG
              ((NIL T))
              (CLRHASH *FILEMAP-HASH*])
)

(ADDTOVAR GAINSPACEFORMS (FILELST "erase filepkg information" (CLEARFILEPKG RESPONSE)
                                    ((Y "es")
                                     (N "o")
                                     (E . "verything")
                                     (F "ilemaps only
"))))
(DECLARE%: DOEVAL@COMPILE DONTCOPY

(GLOBALVARS SMASHPROPSLST1)
)
(DECLARE%: DOEVAL@COMPILE DONTCOPY

(GLOBALVARS %#UNDOSAVES ADDTOFILEKEYLST CLEANUPOPTIONS CLISPIFYPRETTYFLG COMPILE.EXT DECLARETAGSLST 
       DEFAULTRENAMEMETHOD FILEPKGCOMSPLST FILERDTBL HISTORYCOMS HISTSTR0 I.S.OPRLST LISPXCOMS 
       LISPXHISTORY LISPXHISTORYMACROS LISPXMACROS MACROPROPS MAKEFILEOPTIONS MAKEFILEREMAKEFLG 
       MSDATABASELST PRETTYHEADER PRETTYTRANFLG SAVEDDEFS SYSPROPS USERMACROS USERRECLST USERWORDS 
       FILEPKGTYPEPROPS)
)
(DECLARE%: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY

(BLOCK%: DELFROMCOMS DELFROMCOMS DELFROMCOM DELFROMCOM1 REMOVEITEM (NOLINKFNS . T)
       (SPECVARS COMSNAME))

(BLOCK%: ADDTOFILEBLOCK ADDTOFILES? ADDTOFILE WHATIS ADDTOCOMS ADDTOCOM ADDTOCOM1 ADDNEWCOM
       (NOLINKFNS . T)
       (SPECVARS COMSNAME)
       (ENTRIES ADDTOFILE ADDTOCOMS ADDTOFILES? ADDTOCOM1))

(BLOCK%: INFILECOMS? INFILECOMS? INFILECOMTAIL INFILECOMS INFILECOM INFILECOMSVAL INFILECOMSVALS 
       INFILEPAIRS INFILECOMSMACRO IFCPROPS IFCEXPRTYPE IFCPROPSCAN IFCDECLARE
       (LOCALFREEVARS NAME LITERALS VAL TYPE ONFILETYPE ORIGFLG)
       INFILECOMSPROP)

(BLOCK%: NIL MAKEFILE (LOCALVARS . T)
       (SPECVARS FILE OPTIONS REPRINTFNS SOURCEFILE FILETYPE FILEDATES CHANGES))

(BLOCK%: ADDFILE ADDFILE ADDFILE0)

(BLOCK%: FILEPKGCHANGES FILEPKGCHANGES (NOLINKFNS . T))

(BLOCK%: NIL ALISTS.WHENCHANGED CHANGECALLERS CLEANUP CLEARCLISPARRAY COMPARE COMPAREDEFS 
       COMPILEFILES COMPILEFILES0 CONTINUEDIT COPYDEF DEFAULTMAKENEWCOM DELFROMFILES EDITDEF 
       EXPRESSIONS.WHENCHANGED FILECOMS FILECOMSLST FILEFNSLST FILEPKGCOM FILEPKGCOMPROPS FILEPKGTYPE
       FILES? FILES?1 GETFILEPKGTYPE HASDEF INFILECOMTAIL LOADDEF MAKEALISTCOMS MAKEFILE1 MAKEFILES 
       MAKEFILESCOMS MAKELISPXMACROSCOMS MAKENEWCOM MAKEPROPSCOMS MAKEUSERMACROSCOMS MARKASCHANGED 
       MOVETOFILE POSTEDITPROPS PREEDITFN PRETTYDEFMACROS PROPS.WHENCHANGED PUTDEF RENAME SAVEDEF 
       SAVEPUT SEARCHPRETTYTYPELST SHOWDEF SMASHFILECOMS TYPESOF UNMARKASCHANGED UNSAVEDEF 
       UPDATEFILES (GLOBALVARS %#UNDOSAVES SYSFILES MARKASCHANGEDSTATS COMPILE.EXT EDITMACROS 
                          EDITLOADFNSFLG LOADOPTIONS)
       (LOCALVARS . T))

(BLOCK%: DELDEF DELDEF DELFROMLIST (NOLINKFNS . T))

(BLOCK%: GETDEF GETDEF DWIMDEF GETDEFCOM GETDEFCOM0 GETDEFERR GETDEFCURRENT GETDEFFROMFILE 
       GETDEFSAVED (RETFNS GETDEFCOM)
       (NOLINKFNS . T)
       (GLOBALVARS NOT-FOUNDTAG))
)
(DECLARE%: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY COMPILERVARS 

(ADDTOVAR NLAMA \DUMPEXPORTS MAKEUSERMACROSCOMS MAKEPROPSCOMS MAKELISPXMACROSCOMS MAKEFILESCOMS 
                          MAKEALISTCOMS LISTFILES COMPILEFILES CLEANUP FILEPKGCOMPROPS 
                          PRETTYDEFMACROS)

(ADDTOVAR NLAML )

(ADDTOVAR LAMA FILEPKGTYPE FILEPKGCOM FILEPKGCHANGES)
)
(PUTPROPS FILEPKG COPYRIGHT ("Venue & Xerox Corporation" T 1982 1983 1984 1985 1986 1987 1988 1989 
1990 1991 1992 1993 1995 2018 2020))
(DECLARE%: DONTCOPY
  (FILEMAP (NIL (22882 24587 (SEARCHPRETTYTYPELST 22892 . 23871) (PRETTYDEFMACROS 23873 . 24331) (
FILEPKGCOMPROPS 24333 . 24585)) (25389 59512 (CLEANUP 25399 . 26787) (COMPILEFILES 26789 . 27065) (
COMPILEFILES0 27067 . 27787) (CONTINUEDIT 27789 . 29209) (MAKEFILE 29211 . 40853) (FILECHANGES 40855
 . 43190) (FILEPKG.MERGECHANGES 43192 . 44015) (FILEPKG.CHANGEDFNS 44017 . 44329) (MAKEFILE1 44331 . 
48558) (COMPILE-FILE? 48560 . 50117) (MAKEFILES 50119 . 51812) (ADDFILE 51814 . 54335) (ADDFILE0 54337
 . 58473) (LISTFILES 58475 . 59510)) (60200 95440 (FILEPKGCHANGES 60210 . 61560) (GETFILEPKGTYPE 61562
 . 64635) (MARKASCHANGED 64637 . 66274) (FILECOMS 66276 . 66660) (WHEREIS 66662 . 68082) (
SMASHFILECOMS 68084 . 68319) (FILEFNSLST 68321 . 68483) (FILECOMSLST 68485 . 68969) (UPDATEFILES 68971
 . 74271) (INFILECOMS? 74273 . 76176) (INFILECOMTAIL 76178 . 77318) (INFILECOMS 77320 . 77481) (
INFILECOM 77483 . 87692) (INFILECOMSVALS 87694 . 88021) (INFILECOMSVAL 88023 . 89025) (INFILECOMSPROP 
89027 . 89856) (IFCPROPS 89858 . 91119) (IFCEXPRTYPE 91121 . 91632) (IFCPROPSCAN 91634 . 92687) (
IFCDECLARE 92689 . 94000) (INFILEPAIRS 94002 . 94334) (INFILECOMSMACRO 94336 . 95438)) (95475 126251 (
FILES? 95485 . 97678) (FILES?1 97680 . 98330) (FILES?PRINTLST 98332 . 99114) (ADDTOFILES? 99116 . 
109718) (ADDTOFILE 109720 . 110636) (WHATIS 110638 . 112614) (ADDTOCOMS 112616 . 114260) (ADDTOCOM 
114262 . 120809) (ADDTOCOM1 120811 . 121982) (ADDNEWCOM 121984 . 123034) (MAKENEWCOM 123036 . 124879) 
(DEFAULTMAKENEWCOM 124881 . 126249)) (126321 129138 (MERGEINSERT 126331 . 128674) (MERGEINSERT1 128676
 . 129136)) (130657 141569 (DELFROMFILES 130667 . 131517) (DELFROMCOMS 131519 . 133198) (DELFROMCOM 
133200 . 139068) (DELFROMCOM1 139070 . 139867) (REMOVEITEM 139869 . 140743) (MOVETOFILE 140745 . 
141567)) (141783 144152 (SAVEPUT 141793 . 144150)) (144277 152601 (UNMARKASCHANGED 144287 . 145995) (
PREEDITFN 145997 . 148508) (POSTEDITPROPS 148510 . 151011) (POSTEDITALISTS 151013 . 152599)) (152750 
173304 (ALISTS.GETDEF 152760 . 153139) (ALISTS.WHENCHANGED 153141 . 153785) (CLEARCLISPARRAY 153787 . 
154961) (EXPRESSIONS.WHENCHANGED 154963 . 155337) (MAKEALISTCOMS 155339 . 156412) (MAKEFILESCOMS 
156414 . 157851) (MAKELISPXMACROSCOMS 157853 . 159871) (MAKEPROPSCOMS 159873 . 160571) (
MAKEUSERMACROSCOMS 160573 . 162373) (PROPS.WHENCHANGED 162375 . 162996) (FILEGETDEF.LISPXMACROS 162998
 . 164440) (FILEGETDEF.ALISTS 164442 . 165061) (FILEGETDEF.RECORDS 165063 . 165994) (FILEGETDEF.PROPS 
165996 . 166788) (FILEGETDEF.MACROS 166790 . 167850) (FILEGETDEF.VARS 167852 . 168268) (FILEGETDEF.FNS
 168270 . 169634) (FILEPKGCOMS.PUTDEF 169636 . 172076) (FILES.PUTDEF 172078 . 173035) (VARS.PUTDEF 
173037 . 173180) (FILES.WHENCHANGED 173182 . 173302)) (175326 182759 (RENAME 175336 . 176737) (
CHANGECALLERS 176739 . 182757)) (182760 230708 (SHOWDEF 182770 . 183563) (COPYDEF 183565 . 186039) (
GETDEF 186041 . 188317) (GETDEFCOM 188319 . 189285) (GETDEFCOM0 189287 . 190633) (GETDEFCURRENT 190635
 . 197055) (GETDEFERR 197057 . 198358) (GETDEFFROMFILE 198360 . 202640) (GETDEFSAVED 202642 . 203746) 
(PUTDEF 203748 . 204451) (EDITDEF 204453 . 205430) (DEFAULT.EDITDEF 205432 . 208268) (EDITDEF.FILES 
208270 . 208471) (LOADDEF 208473 . 208649) (DWIMDEF 208651 . 209505) (DELDEF 209507 . 212521) (
DELFROMLIST 212523 . 213027) (HASDEF 213029 . 219351) (GETFILEDEF 219353 . 219875) (SAVEDEF 219877 . 
221536) (UNSAVEDEF 221538 . 222434) (COMPAREDEFS 222436 . 225738) (COMPARE 225740 . 226444) (TYPESOF 
226446 . 230706)) (230775 235818 (FIXEDITDATE 230785 . 234288) (EDITDATE? 234290 . 235816)) (236237 
244823 (FILEPKGCOM 236247 . 241180) (FILEPKGTYPE 241182 . 244821)) (256860 271412 (FINDCALLERS 256870
 . 257385) (EDITCALLERS 257387 . 265045) (EDITFROMFILE 265047 . 270727) (FINDATS 270729 . 271001) (
LOOKIN 271003 . 271410)) (271413 273140 (SEPRCASE 271423 . 273138)) (273657 279199 (IMPORTFILE 273667
 . 274641) (IMPORTEVAL 274643 . 275523) (IMPORTFILESCAN 275525 . 275946) (CHECKIMPORTS 275948 . 277284
) (GATHEREXPORTS 277286 . 278609) (\DUMPEXPORTS 278611 . 279197)) (279537 281745 (CLEARFILEPKG 279547
 . 281743)))))
STOP
\ No newline at end of file
diff --git a/sources/FILEPKG.LCOM b/sources/FILEPKG.LCOM
index 4ec81efe..c3d5a0d8 100644
Binary files a/sources/FILEPKG.LCOM and b/sources/FILEPKG.LCOM differ
