From 5ee5482dd2133bda579643caa340636b629f4b90 Mon Sep 17 00:00:00 2001 From: Larry Masinter Date: Tue, 13 Sep 2022 13:22:06 -0700 Subject: [PATCH] GETDEF binds variable when getting for edit -- needed by loops rather than a unreliable STKPOS (#926) --- sources/FILEPKG | 2395 ++++++++++++++++++++---------------------- sources/FILEPKG.LCOM | Bin 102652 -> 102633 bytes 2 files changed, 1149 insertions(+), 1246 deletions(-) diff --git a/sources/FILEPKG b/sources/FILEPKG index 8dd01299..c5c8db16 100644 --- a/sources/FILEPKG +++ b/sources/FILEPKG @@ -1,12 +1,11 @@ (DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10) -(FILECREATED "24-Jul-2022 15:45:28"  -{DSK}kaplan>local>medley3.5>working-medley>sources>FILEPKG.;43 281515 +(FILECREATED " 3-Sep-2022 16:46:39" {DSK}larry>medley>sources>FILEPKG.;46 274570 - :CHANGES-TO (FNS SEPRCASE EDITCALLERS) + :CHANGES-TO (FNS GETDEF) + (VARS FILEPKGCOMS) - :PREVIOUS-DATE "24-Jul-2022 08:51:11" -{DSK}kaplan>local>medley3.5>working-medley>sources>FILEPKG.;42) + :PREVIOUS-DATE " 3-Sep-2022 14:14:05" {DSK}larry>medley>sources>FILEPKG.;2) (* ; " @@ -32,7 +31,7 @@ with the terms of said license. (P (CL:PROCLAIM '(CL:SPECIAL PRETTYDEFMACROS PRETTYTYPELST FILEPKGTYPES PRETTYPRINTMACROS *DEFAULT-CLEANUP-COMPILER* MARKASCHANGEDFNS - PRETTYFLG)) + PRETTYFLG FROMEDITOR)) (CL:PROCLAIM '(GLOBAL FILELST SYSFILES LOADEDFILELST NOTLISTEDFILES NOTCOMPILEDFILES MAKEFILEFORMS CLEANUPOPTIONS] (INITVARS (MSDATABASELST)) @@ -309,12 +308,12 @@ with the terms of said license. (DEFINEQ (SEARCHPRETTYTYPELST - [LAMBDA (TYPE FLG) (* rmk%: " 3-JAN-82 22:55") + [LAMBDA (TYPE FLG) (* rmk%: " 3-JAN-82 22:55") (* ; - "access functions used by the records") + "access functions used by the records") (AND (LITATOM TYPE) (OR (find X in PRETTYTYPELST suchthat (EQ (CADR X) - TYPE)) + TYPE)) (COND (FLG [/SETTOPVAL 'PRETTYTYPELST (CONS (SETQ FLG (LIST (PACK* 'CHANGED TYPE 'LST) @@ -326,12 +325,12 @@ with the terms of said license. FLG]) (PRETTYDEFMACROS - [NLAMBDA ARGS (* lmm " 5-SEP-78 16:16") + [NLAMBDA ARGS (* lmm " 5-SEP-78 16:16") (* ; - "included so that old files will continue to load") + "included so that old files will continue to load") (for X in ARGS collect (FILEPKGCOM (CAR X) - 'MACRO - (CDR X]) + 'MACRO + (CDR X]) (FILEPKGCOMPROPS [NLAMBDA PROPS @@ -353,7 +352,7 @@ with the terms of said license. (DECLARE%: EVAL@COMPILE DOCOPY (CL:PROCLAIM '(CL:SPECIAL PRETTYDEFMACROS PRETTYTYPELST FILEPKGTYPES PRETTYPRINTMACROS - *DEFAULT-CLEANUP-COMPILER* MARKASCHANGEDFNS PRETTYFLG)) + *DEFAULT-CLEANUP-COMPILER* MARKASCHANGEDFNS PRETTYFLG FROMEDITOR)) (CL:PROCLAIM '(GLOBAL FILELST SYSFILES LOADEDFILELST NOTLISTEDFILES NOTCOMPILEDFILES MAKEFILEFORMS CLEANUPOPTIONS)) @@ -368,7 +367,7 @@ with the terms of said license. (DEFINEQ (CLEANUP - [NLAMBDA FILES (* lmm "14-Aug-84 19:17") + [NLAMBDA FILES (* lmm "14-Aug-84 19:17") (PROG (TEM1 TEM2 OPTIONS) (COND ([LISTP (CAR (SETQ FILES (NLAMBDA.ARGS FILES] @@ -383,7 +382,7 @@ with the terms of said license. (LISTFILES)) ((SETQ TEM1 (INTERSECTION FILES NOTLISTEDFILES)) (* ; - "Intersection check because LISTFILES applied to NIL means list all of NOTLISTEDFILES.") + "Intersection check because LISTFILES applied to NIL means list all of NOTLISTEDFILES.") (APPLY 'LISTFILES TEM1))) (COND [(NULL (SETQ TEM1 (MEMB 'RC OPTIONS] @@ -396,7 +395,7 @@ with the terms of said license. TEM2]) (COMPILEFILES - [NLAMBDA FILES (* lmm "14-Aug-84 19:17") + [NLAMBDA FILES (* lmm "14-Aug-84 19:17") (COND ([LISTP (CAR (SETQ FILES (NLAMBDA.ARGS FILES] (COMPILEFILES0 (CDR FILES) @@ -404,19 +403,20 @@ with the terms of said license. (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]) + [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") + [LAMBDA (FILE) (* bvm%: "30-Aug-86 15:09") (PROG (STREAM FL TEM FC ENV) (RESETLST [RESETSAVE NIL (LIST 'CLOSEF (SETQ STREAM (OPENSTREAM FILE 'INPUT] @@ -427,116 +427,110 @@ with the terms of said license. (COND ([NOT (fetch FILEPROP of (SETQ FL (ROOTFILENAME FILE] (LOADFROM FILE) (* ; - "also calls addfile to notice the 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] + [/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 10-Oct-2021 20:36 by rmk:") + [LAMBDA (FILE OPTIONS REPRINTFNS SOURCEFILE) (* ; "Edited 10-Oct-2021 20:36 by rmk:") (* ; "Edited 29-Jun-2021 17:24 by rmk:") (* ;; "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.") (* ;; "RMK: OPTIONS can specify external format, either as a pair like (FORMAT :UTF-8) or just :UTF-8 where (FIND-FORMAT :UTF-8) is non NIL.") - [SETQ OPTIONS (FOR OPT INSIDE OPTIONS COLLECT (CL:IF (FIND-FORMAT OPT T) - (LIST 'FORMAT OPT))] + [SETQ OPTIONS (for OPT inside OPTIONS collect (CL:IF (FIND-FORMAT OPT T) + (LIST 'FORMAT OPT))] (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)) + 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.") + "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.") + (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") + (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] + (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 + ((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 + ((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) + (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") + 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] + (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))) + (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] + [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.") - (* ;; "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 + (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 + (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)) + (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") + "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%: @@ -560,7 +554,7 @@ with the terms of said license. "] (Y (SELECTQ (fetch LOADTYPE of FILEPROP) (LOADCOMP (* ; - "file was never actually loaded, just loadcomped. thus no filecoms") + "file was never actually loaded, just loadcomped. thus no filecoms") (LOADFROM SOURCEFILE)) (Compiled @@ -607,22 +601,21 @@ with the terms of said license. ((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 (CL:IF (LISTP OPT) - (CAR OPT) - OPT) - MAKEFILEOPTIONS)) - ((FIXSPELL OPT NIL MAKEFILEOPTIONS NIL - OPTIONS) - (GO $$LP)) - (T (ERROR "Unrecognized MAKEFILE option" OPT] + (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 (CL:IF (LISTP OPT) + (CAR OPT) + 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."]) @@ -669,31 +662,29 @@ with the terms of said license. else CHANGES]) (FILEPKG.MERGECHANGES - [LAMBDA (C1 C2) (* rmk%: "24-MAY-82 23:09") + [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]) + (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") + [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") + [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)") + (* ;; "RMK: Call COMPILE-FILE? with FILE instead of (ROOTFILENAME FILE)") (PROG ((ROOTNAME (ROOTFILENAME FILE)) (COMPILER (COMPILE-FILE? FILE)) @@ -701,17 +692,17 @@ with the terms of said license. (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.") + (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] + (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.") + (* ;; "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 '" @@ -725,96 +716,93 @@ compiling " T) (FORGET-EXPRS? (EQ (CAR OPTIONS) 'STF] (SELECTQ COMPILER - ((FAKE-COMPILE-FILE) (* ; - "The old CommonLispy interface to the ByteCompiler.") + ((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) (* ; "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 + ((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.") - (* ;; - "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]) + (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") + [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") + (* ;; "RMK: Argument is FILE instead of ROOTFILENAME, maybe more information") -(* ;;; "Which compiler should CLEANUP use?") +(* ;;; "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*]) + (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") + [LAMBDA (OPTIONS FILES) (* rmk%: "23-FEB-83 21:20") (RESETVARS (%#UNDOSAVES) (* ; - "Willing to save arbitrary amounts of undo info") + "Willing to save arbitrary amounts of undo info") (UPDATEFILES) [COND ((NULL FILES) - (for TYPE FLG in FILEPKGTYPES when [FILES?1 TYPE - (COND - ((NULL FLG) + (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 '" "] + (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] + 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") + [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.") @@ -826,9 +814,9 @@ compiling " T) [(NULL (CDR FCLST)) (* ; "A simple symbolic file") (SETQ FCLST (CAR FCLST)) (SETQ VAL (ADDFILE0 (COND - ((LITATOM (CADR FCLST)) - (ROOTFILENAME (CADR FCLST))) - (T ROOTNAME)) + ((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.") @@ -838,28 +826,27 @@ compiling " T) (SETQ LOADTYPE 'Compiled)) (loadfns (SETQ LOADTYPE 'compiled)) (LOADCOMP (* ; - "loadcomp on compiled file. Don't notice since we don't know what its state is") + "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] + (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 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") + [LAMBDA (ROOTNAME LOADTYPE FULLNAME DAT) (* lmm "28-Nov-84 16:47") (PROG (COMS X FILEPROP FLG TEM) TOP (SETQ COMS (FILECOMS ROOTNAME)) [COND @@ -881,8 +868,8 @@ compiling " T) [(OR LOADTYPE (LISTP (GETTOPVAL COMS))) (SETQ FILEPROP (/replace FILEPROP of ROOTNAME with (create FILEPROP - COMSNAME _ COMS - LOADTYPE _ LOADTYPE] + COMSNAME _ COMS + LOADTYPE _ LOADTYPE] (FLG (GO ERROR)) ((AND DWIMFLG (EQ ROOTNAME FULLNAME) (SETQ ROOTNAME (MISSPELLED? ROOTNAME 70 FILELST T))) @@ -891,20 +878,20 @@ compiling " T) (SETQ FULLNAME ROOTNAME) (SETQ FLG T) (* ; - "so wont try to spelling correct again if file isnt there") + "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] + 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.") + "coms wuld not be set up on a loadccomp.") (/SETTOPVAL 'FILELST (CONS ROOTNAME (GETTOPVAL 'FILELST] (RETURN (COND ((NULL LOADTYPE) (* ; "call from makefile.") @@ -914,23 +901,23 @@ compiling " T) (ERROR FULLNAME "not file name." T]) (LISTFILES - [NLAMBDA FILES (* rmk%: " 3-Dec-84 08:58") - (DECLARE (GLOBALVARS NOTLISTEDFILES)) (* ; "LISTFILES1 is machinedependent") + [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)) + (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]) + ((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) @@ -966,33 +953,30 @@ compiling " T) (DEFINEQ (FILEPKGCHANGES - [LAMBDA N (* Pavel " 7-Oct-86 19:22") + [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))) + (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] + (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] + 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] + (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") + [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. ") @@ -1002,7 +986,7 @@ compiling " T) (* ;; " given a list of types, coerce them all or return NIL") (for X in TYPE collect (OR (GETFILEPKGTYPE X ONLY NOERROR NAME) - (RETURN] + (RETURN] ((EQ TYPE '?) (* ;; "odd case, may be obsolete: if given IL:?, return all known types of NAME. Maybe used by EDITDEF(NAME ?)?? ") @@ -1014,14 +998,13 @@ compiling " T) (T 'VARS) NIL) (for X in FILEPKGTYPES do (if (EQ TYPE X) - then + then + (* ;; "type matched exactly") - (* ;; "type matched exactly") - - (RETURN TYPE) - elseif (AND (LISTP X) - (EQ TYPE (CAR X))) - then (RETURN (CDR X] + (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") @@ -1030,18 +1013,18 @@ compiling " T) (LITATOM TYPE) (for X in FILEPKGTYPES bind NAME do (SETQ NAME (if (NLISTP X) - then X - else (CAR 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") + (* ;; "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] + (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) @@ -1054,7 +1037,7 @@ compiling " T) TYPE]) (MARKASCHANGED - [LAMBDA (NAME TYPE REASON) (* ; "Edited 25-May-88 15:37 by drc:") + [LAMBDA (NAME TYPE REASON) (* ; "Edited 25-May-88 15:37 by drc:") (COND (FILEPKGFLG (SETQ REASON (SELECTQ REASON ((CLISP LOAD CHANGED DEFINED DELETED) @@ -1063,26 +1046,25 @@ compiling " T) (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 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") + NAME) do (/RPLACA L NIL)) + (* ; + "unmark as changed and remove from files") (DELFROMFILES NAME TYPE)) (T (LET ((LST (push (fetch CHANGED of TYPE) - NAME))) + NAME))) (AND LISPXHIST (UNDOSAVE (LIST '/RPLACA LST) LISPXHIST)) (* ; - "UNDO by smashing with NIL; makes calls to MARKASCHANGED independent") + "UNDO by smashing with NIL; makes calls to MARKASCHANGED independent") ] NAME]) (FILECOMS - [LAMBDA (FILE X) (* rmk%: "19-FEB-83 13:55") + [LAMBDA (FILE X) (* rmk%: "19-FEB-83 13:55") (COND ((AND (NULL FILE) (NULL X)) @@ -1094,7 +1076,8 @@ compiling " T) (OR X 'COMS]) (WHEREIS - [LAMBDA (NAME TYPE FILES FN) (* ; "Edited 12-Jul-88 17:14 by MASINTER") + [LAMBDA (NAME TYPE FILES FN) (* ; "Edited 19-Aug-2022 20:13 by lmm") + (* ; "Edited 12-Jul-88 17:14 by MASINTER") (* ;; "T as a NAME has a special meaning to INFILECOMS? so don't pass through.") @@ -1107,11 +1090,11 @@ compiling " 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))) + do (for FILE-NAME in (XCL::HASH-FILE-WHERE-IS + NAME + (GETFILEPKGTYPE TY)) + do (CL:PUSHNEW (MKATOM (U-CASE FILE-NAME)) + FILES))) (REVERSE FILES] (CL:IF FN [MAPC IN-FILES (FUNCTION (LAMBDA (FILE) @@ -1119,19 +1102,18 @@ compiling " T) IN-FILES)))]) (SMASHFILECOMS - [LAMBDA (FILE) (* rmk%: "19-FEB-83 22:15") - (for X in (FILECOMSLST FILE 'FILEVARS) when (LITATOM X) - do (SETTOPVAL X 'NOBIND)) + [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") + [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") + [LAMBDA (FILE TYPE FLG) (* JonL "24-Jul-84 19:48") (* ; - "TYPE is coerced in the innards of INFILECOMS?") + "TYPE is coerced in the innards of INFILECOMS?") (COND ((EQ FLG 'UPDATE) (CDR (INFILECOMS? NIL TYPE (FILECOMS FILE) @@ -1140,78 +1122,69 @@ compiling " T) FLG]) (UPDATEFILES - [LAMBDA (PRLST FLST) (* rmk%: "19-FEB-83 14:27") + [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)) + ((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.") + (* ;; "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) + (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] + (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") + (* ;; "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)) + [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") + (* ;; "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 - ] + [/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] + "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]) + "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") + [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") @@ -1229,8 +1202,7 @@ compiling " T) [COND ((LITATOM COMS) (SELECTQ TYPE - ((VARS FILEVARS) (* ; - "the COMS of a file are also on it") + ((VARS FILEVARS) (* ; "the COMS of a file are also on it") (INFILECOMSVAL COMS)) NIL) (SETQ COMS (EVALV COMS] @@ -1242,7 +1214,7 @@ compiling " T) (T VAL]) (INFILECOMTAIL - [LAMBDA (COM FLG) (* ; "Edited 2-Aug-88 02:15 by masinter") + [LAMBDA (COM FLG) (* ; "Edited 2-Aug-88 02:15 by masinter") [SETQ COM (COND ((EQ (CADR COM) '*) @@ -1254,23 +1226,22 @@ compiling " T) 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)) + 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") + [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") + [LAMBDA (COM) (* ; "Edited 2-Aug-88 02:27 by masinter") (COND [(NLISTP COM) (COND @@ -1280,9 +1251,9 @@ compiling " T) COMMENTFLG) (* ;; -"must be special case'd first so that (* * values) doesn't make it look like `values' is a variable") + "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???") + "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))) @@ -1298,7 +1269,7 @@ compiling " T) ((AND (NULL ONFILETYPE) (NOT (CL:SYMBOLP NAME))) (* ; - "call from WHEREIS of a name which is not a symbol") + "call from WHEREIS of a name which is not a symbol") (LIST NAME)) (T NAME)) TYPE ONFILETYPE))) @@ -1344,7 +1315,7 @@ compiling " T) ((COMS EXPORT) (INFILECOMS (INFILECOMTAIL COM T))) (CL:EVAL-WHEN (INFILECOMS (INFILECOMTAIL (CDR COM) - T))) + T))) (DECLARE%: (* ; "skip over DECLARE: tags") [RETURN (AND (NOT (FMEMB 'COMPILERVARS COM)) (IFCDECLARE (INFILECOMTAIL COM) @@ -1353,10 +1324,10 @@ compiling " T) (PROG ((ORIGFLG T)) (INFILECOMS (INFILECOMTAIL COM T)))) ((PROP IFPROP) (* ; - "this currently does not handle `pseudo-types' of PROPNAMES") + "this currently does not handle `pseudo-types' of PROPNAMES") (SELECTQ TYPE (PROPS (IFCPROPSCAN (INFILECOMTAIL (CDR COM) - T) + T) (CADR COM))) (MACROS (INFILECOMSMACRO (INFILECOMTAIL (CDR COM)) (CADR COM))) @@ -1368,7 +1339,7 @@ compiling " T) (MACROS (INFILECOMSVALS (INFILECOMTAIL COM T))) NIL))) (ALISTS (* ; - "sigh. This should probably also `coerce' when asking for LISPXMACROS, etc.") + "sigh. This should probably also `coerce' when asking for LISPXMACROS, etc.") (RETURN (SELECTQ TYPE (ALISTS (INFILEPAIRS (INFILECOMTAIL COM))) NIL))) @@ -1387,15 +1358,14 @@ compiling " T) (VARS [RETURN (AND (NULL ONFILETYPE) (for X in (INFILECOMTAIL COM T) do (INFILECOMSVAL (CAR X) - T]) + T]) (ALISTS [RETURN (for X in (INFILECOMTAIL COM T) when (EQMEMB 'ALIST (GETPROP (CAR X) - 'VARTYPE)) + 'VARTYPE)) do (for Z in (CDR X) - do (INFILECOMSVAL - (LIST (CAR X) - (CAR Z)) - T]) + do (INFILECOMSVAL (LIST (CAR X) + (CAR Z)) + T]) (OR (EQ TYPE COMNAME) (RETURN)))) ((VARS INITVARS FILEVARS UGLYVARS HORRIBLEVARS CONSTANTS ARRAY) @@ -1403,25 +1373,24 @@ compiling " T) ((EQ TYPE 'EXPRESSIONS) (for X in (INFILECOMTAIL COM T) when (AND (LISTP X) - (NEQ (CAR X) - COMMENTFLG)) + (NEQ (CAR X) + COMMENTFLG)) do (INFILECOMSVAL (CONS 'SETQ X) - T))) + T))) ((OR (EQ TYPE 'VARS) (EQ TYPE COMNAME))(* ; - "either want all VARS, or else want all FILEVARS and this is a FILEVARS command") + "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]) + ((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) @@ -1440,17 +1409,17 @@ compiling " T) (NULL ORIGFLG) (SETQ TEM (fetch (FILEPKGCOM MACRO) of COMNAME))) (INFILECOMS (SUBPAIR (CAR TEM) - (INFILECOMTAIL COM T) - (CDR TEM]) + (INFILECOMTAIL COM T) + (CDR TEM]) (INFILECOMSVALS - [LAMBDA (X FLG) (* ; "Edited 2-Aug-88 02:21 by masinter") + [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]) + (EQ (CAR Y) + COMMENTFLG))) do (INFILECOMSVAL Y FLG]) (INFILECOMSVAL - [LAMBDA (X FLG) (* ; "Edited 12-Jul-88 17:56 by MASINTER") + [LAMBDA (X FLG) (* ; "Edited 12-Jul-88 17:56 by MASINTER") (COND [(EQ ONFILETYPE 'UPDATE) (AND (OR (NULL NAME) @@ -1460,7 +1429,7 @@ compiling " T) (T (SETQ VAL (CONS X VAL] ((AND (EQ ONFILETYPE 'EDIT) FLG) (* ; - "literals should not be edited as they are on the fileCOMS") + "literals should not be edited as they are on the fileCOMS") NIL) ((EQ ONFILETYPE 'TYPESOF) (AND (COND @@ -1479,14 +1448,14 @@ compiling " T) (SETQ VAL (CONS X VAL]) (INFILECOMSPROP - [LAMBDA (AT PROP) (* lmm "25-SEP-81 17:15") + [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] + AT) + (EQ (CADR X) + PROP] (SETQ VAL (CONS (LIST AT PROP) VAL] ((OR (EQ NAME T) @@ -1501,69 +1470,65 @@ compiling " T) VAL]) (IFCPROPS - [LAMBDA (COM) (* bvm%: " 2-Dec-83 14:24") + [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 ...)") + "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 - )))) + "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)))) + (CDR PAIR)))) NIL]) (IFCEXPRTYPE - [LAMBDA (COM FN) (* ; "Edited 6-Apr-87 20:20 by Pavel") + [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]) + (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") + [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] + (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]) + ((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") + [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] + (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%"") + (\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)) @@ -1577,24 +1542,23 @@ compiling " T) (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]) + [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") + [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]) + (EVERY (PROPNAMES AT) + (FUNCTION (LAMBDA (X) + (OR (NOT (FMEMB X MACROPROPS)) + (EQMEMB X PROPS] + [SOME MACROPROPS (FUNCTION (LAMBDA (PROP) + (EQMEMB PROP PROPS] + (INFILECOMSVAL AT]) ) @@ -1604,52 +1568,48 @@ compiling " T) (DEFINEQ (FILES? - [LAMBDA NIL (* bvm%: "27-Oct-86 18:14") + [LAMBDA NIL (* bvm%: "27-Oct-86 18:14") -(* ;;; -"Display each file needing dumping, etc. For files needing dumping, display details of why.") +(* ;;; "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] + of (LISTP (fetch FILEPROP of FILE] do (if (NOT PRINTED) - then (LISPXPRIN1 "To be dumped: + 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)) + (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?))) + then (OR PRINTED (LISPXPRIN1 "...to be dumped. " T)) + (ADDTOFILES?))) (if (SETQ FILES NOTCOMPILEDFILES) then (FILES?PRINTLST FILES "To be compiled: ") - (LISPXTERPRI T)) + (LISPXTERPRI T)) (if (SETQ FILES NOTLISTEDFILES) then (FILES?PRINTLST FILES "To be listed: ") - (LISPXTERPRI T)) + (LISPXTERPRI T)) (CL:VALUES]) (FILES?1 - [LAMBDA (TYPE FIRST) (* ; "Edited 13-Jun-2021 10:18 by rmk:") + [LAMBDA (TYPE FIRST) (* ; "Edited 13-Jun-2021 10:18 by rmk:") - (* ;; "If there are changed objects of TYPE, then print them out, preceded by FIRST (if given) plus a descriptive string, and return T.") + (* ;; "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 @@ -1664,7 +1624,7 @@ compiling " T) T]) (FILES?PRINTLST - [LAMBDA (LST STR) (* bvm%: "27-Oct-86 18:15") + [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.") @@ -1681,17 +1641,17 @@ compiling " T) T]) (ADDTOFILES? - [LAMBDA (NOASKSTR) (* ; "Edited 13-Jun-2021 10:22 by rmk:") - (* ; "Edited 21-Aug-91 10:13 by jds") + [LAMBDA (NOASKSTR) (* ; "Edited 13-Jun-2021 10:22 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") + (* ;; "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.") + (* ;; "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") + (* ;; "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)) @@ -1706,14 +1666,13 @@ compiling " T) " NOECHOFLG T)) T) (N (RETURN)) - (%] (* ; "Nowhere") - (for TYPE in FILEPKGTYPES - do (for NAME in (fetch (FILEPKGTYPE CHANGED) - of TYPE) - do (ADDTOFILE NAME TYPE NIL))) + (%] (* ; "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") + NIL) (* ; + "if there was type-ahead BEFORE the askuser, then don't allow it now") (COND (BUFS (SETQ BUFS (COND ((READP T) @@ -1722,10 +1681,10 @@ compiling " T) (SETQ BUFS (CLBUFS NIL T READBUF] [for TYPE STR LST in FILEPKGTYPES when [AND (SETQ STR (fetch (FILEPKGTYPE DESCRIPTION) of TYPE)) - (LISTP (SETQ LST (COND - ((EQ TYPE 'VARS) - VARSCHANGES) - (T (fetch (FILEPKGTYPE CHANGED) 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 @@ -1734,20 +1693,20 @@ compiling " T) 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.") + (* ;; "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 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") + (* ;; "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") + (%] (* ; "Nowhere") (SETQ FILE)) - (SPACE (* ; "No action") + (SPACE (* ; "No action") (RETURN)) ((LF =) (PRINT (OR (SETQ FILE LASTFILE) @@ -1757,16 +1716,15 @@ compiling " T) (OR (ERSETQ (PROG (TEM COMSNAME PLACE LISTNAME NEAR) (SETQ PLACE (WHATIS FILE NIL TYPE)) [COND - ((LITATOM PLACE) (* ; "file name") + ((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 (FILEPKGTYPE WHENFILED) - of TYPE) + (for F in (fetch (FILEPKGTYPE 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.") + (* ;; "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) @@ -1775,8 +1733,7 @@ compiling " T) (COND ([SOME FILELST (FUNCTION (LAMBDA (FL) (ADDTOCOMS - (FILECOMS (SETQ FILE - FL)) + (FILECOMS (SETQ FILE FL)) NAME TYPE NEAR LISTNAME] (PRINT (LIST 'on FILE) T T)) @@ -1785,33 +1742,30 @@ compiling " T) 'found) T T) (ERROR!))) - (for F in (fetch (FILEPKGTYPE WHENFILED) - of TYPE) + (for F in (fetch (FILEPKGTYPE WHENFILED) of TYPE) do (APPLY* F NAME TYPE FILE))) ([OR [UNDONLSETQ (PROGN (SAVESET (SETQ LISTNAME (CAR PLACE)) - (MERGEINSERT - NAME - (LISTP (GETTOPVAL LISTNAME)) - T) + (MERGEINSERT NAME + (LISTP (GETTOPVAL + LISTNAME)) + T) T 'NOPRINT) (OR (SETQ FILE - (CAR (WHEREIS NAME TYPE + (CAR (WHEREIS NAME TYPE FILELST))) (ERROR!] (SOME FILELST (FUNCTION (LAMBDA (X) (ADDTOCOMS - (FILECOMS (SETQ FILE - X)) + (FILECOMS (SETQ FILE X)) NAME TYPE NEAR LISTNAME] (PRIN1 " value is filed on " T) (PRINT FILE T T) - (for F in (fetch (FILEPKGTYPE WHENFILED) - of TYPE) + (for F in (fetch (FILEPKGTYPE 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") + (* ;; "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) @@ -1819,27 +1773,25 @@ compiling " T) T T) (SETQ FILE (WHATIS (ASKUSER NIL NIL " on file: " - '(("" "" EXPLAINSTRING - "a file name" KEYLST ())) - T) + '(("" "" EXPLAINSTRING "a file name" + KEYLST ())) + T) 'FILE)) (SAVESET (CAR PLACE) - (MERGEINSERT NAME - (LISTP (GETTOPVAL (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.") + (* ;; "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 (FILEPKGTYPE - WHENFILED) - of TYPE) + (for F in (fetch (FILEPKGTYPE WHENFILED) of TYPE) do (for I in (GETTOPVAL (CAR PLACE)) - do (APPLY* F I TYPE FILE] + do (APPLY* F I TYPE FILE] (AND FILE (ADDFILE FILE)) (SETQ LASTFILE PLACE))) (GO LP] @@ -1847,7 +1799,7 @@ compiling " T) (UPDATEFILES]) (ADDTOFILE - [LAMBDA (NAME TYPE FILE NEAR LISTNAME) (* lmm "21-Nov-84 11:43") + [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) @@ -1865,7 +1817,7 @@ compiling " T) (RETURN FILE]) (WHATIS - [LAMBDA (USERINPUT ONLY) (* lmm "28-Nov-84 16:49") + [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") @@ -1904,7 +1856,7 @@ compiling " T) (ERROR!]) (ADDTOCOMS - [LAMBDA (COMS NAME TYPE NEAR LISTNAME) (* rmk%: "10-JUN-82 22:53") + [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") @@ -1912,7 +1864,7 @@ compiling " T) ((NULL COMS) NIL) [(LITATOM COMS) (* ; - "given a name of a command; rebind COMSNAME to current variable and try to add to its value") + "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) @@ -1921,20 +1873,20 @@ compiling " T) (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]) + [(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") + [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") + "tries to insert NAME into the prettycom COM; returns NIL if unsuccessful") (PROG (TEM) (COND ([AND NEAR (NOT (INFILECOMS? NEAR TYPE (LIST COM] @@ -1956,7 +1908,7 @@ compiling " T) ((OR (EQ (CAR COM) 'VARS) NEAR LISTNAME) (* ; - "Don't stick on INITVARS unless NEAR or LISTNAME says we should.") + "Don't stick on INITVARS unless NEAR or LISTNAME says we should.") (SELECTQ TYPE (EXPRESSIONS (COND ((EQ (CAR NAME) @@ -1966,33 +1918,33 @@ compiling " T) (VARS (ADDTOCOM1 COM NAME NEAR LISTNAME)) NIL)))) (COMS (ADDTOCOMS (COND - [(EQ (CADR COM) - '*) - (COND - ((LITATOM (CADDR COM)) - (CADDR COM)) - (T (RETURN] - (T (CDR COM))) + [(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))) + [(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))) + [(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 @@ -2011,11 +1963,10 @@ compiling " T) (MARKASCHANGED COMSNAME 'VARS) T))) (MACROS (COND - ([AND (for PROP inside (CADR COM) - always (EQMEMB PROP MACROPROPS)) + ([AND (for PROP inside (CADR COM) always (EQMEMB PROP MACROPROPS)) (for PROP in MACROPROPS always (OR (EQMEMB PROP (CADR COM)) - (NOT (GETPROP NAME PROP] + (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") @@ -2024,23 +1975,22 @@ compiling " T) 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))) + (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) @@ -2051,7 +2001,7 @@ compiling " T) (ADDTOCOM1 COM NAME NEAR LISTNAME]) (ADDTOCOM1 - [LAMBDA (COM NAME NEAR LISTNAME) (* rmk%: " 3-JAN-82 22:53") + [LAMBDA (COM NAME NEAR LISTNAME) (* rmk%: " 3-JAN-82 22:53") (COND [(EQ (CADR COM) '*) (* ; "add to list name") @@ -2078,7 +2028,7 @@ compiling " T) T]) (ADDNEWCOM - [LAMBDA (COMSNAME NAME TYPE LISTNAME FILE) (* rmk%: " 3-JAN-82 22:53") + [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") @@ -2104,7 +2054,7 @@ compiling " T) (MARKASCHANGED COMSNAME 'VARS]) (MAKENEWCOM - [LAMBDA (NAME TYPE LISTNAME FILE) (* ; "Edited 8-Apr-87 14:55 by Pavel") + [LAMBDA (NAME TYPE LISTNAME FILE) (* ; "Edited 8-Apr-87 14:55 by Pavel") (SETQ TYPE (GETFILEPKGTYPE TYPE)) (PROG (TEM) @@ -2135,26 +2085,26 @@ compiling " T) (DEFAULTMAKENEWCOM NAME TYPE LISTNAME FILE]) (DEFAULTMAKENEWCOM - [LAMBDA (NAME TYPE LISTNAME FILE) (* ; "Edited 13-Jun-2021 10:24 by rmk:") + [LAMBDA (NAME TYPE LISTNAME FILE) (* ; "Edited 13-Jun-2021 10:24 by rmk:") (COND ((NOT (OR (FMEMB TYPE FILEPKGCOMSPLST) (fetch (FILEPKGCOM MACRO) of TYPE) (fetch (FILEPKGTYPE GETDEF) of TYPE))) - (ERROR "no defined way to dump or obtain the definition of " (OR (fetch (FILEPKGTYPE - DESCRIPTION) + (ERROR "no defined way to dump or obtain the definition of " (OR (fetch (FILEPKGTYPE + DESCRIPTION) of TYPE) TYPE) T)) - ((NULL DEFAULTCOMHASFILEFLG) (* ; "disable FOOFNS FOOVARS junk") + ((NULL DEFAULTCOMHASFILEFLG) (* ; "disable FOOFNS FOOVARS junk") (LIST TYPE NAME)) - ((EQ FILE T) (* ; - "FILE=T only when called from SHOWDEF") + ((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") + '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]) ) @@ -2165,7 +2115,7 @@ compiling " T) (DEFINEQ (MERGEINSERT - [LAMBDA (NEW LST ONEFLG) (* lmm "30-Jun-86 18:11") + [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") @@ -2215,7 +2165,7 @@ compiling " T) (RETURN LST]) (MERGEINSERT1 - [LAMBDA (X Y) (* rmk%: "24-MAY-82 00:05") + [LAMBDA (X Y) (* rmk%: "24-MAY-82 00:05") (* ;; "value is the number of leading characters of X and Y that agree.") @@ -2239,7 +2189,7 @@ compiling " T) (DEFINEQ (ADDTOFILEKEYLST - [LAMBDA NIL (* ; "Edited 12-Feb-2021 17:15 by larry") + [LAMBDA NIL (* ; "Edited 12-Feb-2021 17:15 by larry") `(("[" "" EXPLAINSTRING "[ -- prettyprint the item to terminal and then ask again" NOECHOFLG T) (= "" EXPLAINSTRING "= - same as previous response" NOECHOFLG T) (,(CHARACTER (CHARCODE LF)) @@ -2275,7 +2225,7 @@ compiling " T) (DEFINEQ (DELFROMFILES - [LAMBDA (NAME TYPE FILES) (* rmk%: " 6-MAR-82 13:16") + [LAMBDA (NAME TYPE FILES) (* rmk%: " 6-MAR-82 13:16") (* ;; "Eliminates NAME as an item of type TYPE in COMS.") @@ -2283,16 +2233,16 @@ compiling " T) (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)))) + 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)) + do (APPLY* FN NAME TYPE FILE)) FILE]) (DELFROMCOMS - [LAMBDA (COMS NAME TYPE) (* bvm%: " 1-Oct-86 22:02") + [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") @@ -2331,7 +2281,7 @@ compiling " T) (GO LP]) (DELFROMCOM - [LAMBDA (COM NAME TYPE) (* ; "Edited 2-May-87 19:02 by Pavel") + [LAMBDA (COM NAME TYPE) (* ; "Edited 2-May-87 19:02 by Pavel") (* ; "Tries to delete NAME from COM") (PROG (TEM VAR NEW) (COND @@ -2342,23 +2292,23 @@ compiling " T) (RETURN (SELECTQ (CAR COM) ((DECLARE%: COMS) (DELFROMCOMS (COND - [(EQ (CADR COM) - '*) - (COND - ((LITATOM (CADDR COM)) - (CADDR COM)) - (T (RETURN] - (T (CDR COM))) + [(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))) + [(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)) @@ -2388,11 +2338,10 @@ compiling " T) [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]) + (/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 @@ -2427,10 +2376,10 @@ compiling " T) (DELFROMCOM1 COM NAME]) (DELFROMCOM1 - [LAMBDA (COM NAME FLG) (* rmk%: "10-JUN-82 22:44") + [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") + "FLG is passed on to REMOVEITEM, determines whether lists whose CAR is NAME will be removed") (LET (TEM VAL) (COND @@ -2450,11 +2399,11 @@ compiling " T) T]) (REMOVEITEM - [LAMBDA (X LST FLG) (* ; "Edited 25-May-88 17:52 by drc:") + [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") + "returns a subset of LST with X deleted; if FLG is set, also remove elements whose CAR is X") (COND [[OR (MEMBER X LST) @@ -2470,17 +2419,17 @@ compiling " T) (T LST]) (MOVETOFILE - [LAMBDA (TOFILE NAME TYPE FROMFILE) (* rmk%: "18-OCT-79 19:51") + [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.") + "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'") + (MARKASCHANGED NAME TYPE)) (* ; + "FNS won't get dumped unless they are `changed'") (DELFROMFILES NAME TYPE FROMFILE) (ADDTOFILE NAME TYPE TOFILE]) ) @@ -2498,7 +2447,7 @@ compiling " T) (DEFINEQ (SAVEPUT - [LAMBDA (ATM PROP VAL) (* lmm " 7-May-84 16:56") + [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") @@ -2513,7 +2462,7 @@ compiling " T) (COND ((AND (NULL X) X0) (* ; - "typical case. property list ran out on an even parity position. e.g. (A B C D)") + "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)) @@ -2564,46 +2513,43 @@ compiling " T) (DEFINEQ (UNMARKASCHANGED - [LAMBDA (NAME TYPE) (* JonL "24-Jul-84 19:59") + [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] + (bind TAIL [CHANGED _ (fetch CHANGED of (SETQ TYPE (GETFILEPKGTYPE TYPE 'TYPE] while (SETQ TAIL (MEMBER NAME CHANGED)) do (/RPLACA TAIL) - (SETQ ANYFLG T)) + (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] + 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] + (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") + [LAMBDA (ATM TYPE EDITCHANGES) (* rmk%: "18-FEB-82 21:49") (* ; - "EDITL is advised to call this before editing something") + "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] + (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") @@ -2617,10 +2563,10 @@ compiling " T) CLISPARRAY)) (for X in (EVALV ATM) do (OR (NLISTP X) - (GETHASH X CLISPARRAY) - (PUTHASH X (CONS (CAR X) - (CDR X)) - CLISPARRAY] + (GETHASH X CLISPARRAY) + (PUTHASH X (CONS (CAR X) + (CDR X)) + CLISPARRAY] (RESETSAVE NIL (LIST (FUNCTION POSTEDITALISTS) EDITCHANGES (for X in (EVALV ATM) @@ -2628,7 +2574,7 @@ compiling " T) NIL]) (POSTEDITPROPS - [LAMBDA (EDITCHANGES OLDPROPS) (* rmk%: "18-FEB-82 21:50") + [LAMBDA (EDITCHANGES OLDPROPS) (* rmk%: "18-FEB-82 21:50") (* ; "was RESETSAVE'd from PREEDITFN") (PROG (OV FOUNDCHANGE) (OR FILEPKGFLG (RETURN)) @@ -2636,62 +2582,62 @@ compiling " T) ((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)) + 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) + (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)) + "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)) + (CAR NEWPROP)) + 'PROPS NIL) + (SETQ FOUNDCHANGE T)) (AND FOUNDCHANGE (RPLACA (CDR EDITCHANGES) NIL]) (POSTEDITALISTS - [LAMBDA (EDITCHANGES OLDTOKENS) (* rmk%: " 4-JAN-82 10:14") + [LAMBDA (EDITCHANGES OLDTOKENS) (* rmk%: " 4-JAN-82 10:14") (PROG [OV FOUNDCHANGE (NEWENTRIES (GETTOPVAL (CAR EDITCHANGES] (* ; - "called after an ALIST has been edited") + "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] + 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]) ) @@ -2706,7 +2652,7 @@ compiling " T) (DEFINEQ (ALISTS.GETDEF - [LAMBDA (NAME TYPE OPTIONS) (* Pavel " 7-Oct-86 17:24") + [LAMBDA (NAME TYPE OPTIONS) (* Pavel " 7-Oct-86 17:24") (AND (LISTP NAME) (CL:SYMBOLP (CAR NAME)) (LET [(ASSOCIATION (ASSOC (CADR NAME) @@ -2715,9 +2661,9 @@ compiling " T) ASSOCIATION]) (ALISTS.WHENCHANGED - [LAMBDA (NAME TYPE NEWFLG) (* lmm "16-OCT-78 20:02") + [LAMBDA (NAME TYPE NEWFLG) (* lmm "16-OCT-78 20:02") (* ; - "called by MARKASCHANGED when an ALIST entry has changed") + "called by MARKASCHANGED when an ALIST entry has changed") (PROG [(VARTYPE (GETPROP (CAR NAME) 'VARTYPE] (AND (LISTP VARTYPE) @@ -2729,7 +2675,7 @@ compiling " T) (CLEARCLISPARRAY [LAMBDA (NAME TYPE REASON) - (DECLARE (SPECVARS NAME TYPE REASON)) (* lmm "14-Aug-84 15:03") + (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) @@ -2745,7 +2691,7 @@ compiling " T) (PUTHASH FORM NIL CLISPARRAY]) (EXPRESSIONS.WHENCHANGED - [LAMBDA (EXPR) (* ; "Edited 6-Apr-87 20:21 by Pavel") + [LAMBDA (EXPR) (* ; "Edited 6-Apr-87 20:21 by Pavel") (SELECTQ (CAR EXPR) ((SETQ SETQQ) (UNMARKASCHANGED (CADR EXPR) @@ -2755,7 +2701,7 @@ compiling " T) NIL]) (MAKEALISTCOMS - [NLAMBDA X (* rmk%: "14-OCT-83 13:34") + [NLAMBDA X (* rmk%: "14-OCT-83 13:34") (* ;; "make command to dump prettydefmacros") @@ -2763,18 +2709,17 @@ compiling " T) (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]) + 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") + [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") @@ -2784,28 +2729,28 @@ compiling " T) (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] + (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") + [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) @@ -2829,48 +2774,47 @@ compiling " T) (LIST (LIST 'ADDVARS (CONS 'HISTORYCOMS TEM2]) (MAKEPROPSCOMS - [NLAMBDA X (* lmm "26-FEB-78 17:10") + [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]) + ((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") + [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] + [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)) + 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] + 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") + [LAMBDA (NAME TYPE NEWFLG) (* lmm " 7-SEP-78 22:08") (PROG [(PROPTYPE (GETPROP (CADR NAME) 'PROPTYPE] (COND @@ -2883,38 +2827,37 @@ compiling " T) NIL]) (FILEGETDEF.LISPXMACROS - [LAMBDA (NAME TYPE SOURCE OPTIONS) (* lmm " 4-Jul-85 15:12") + [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] + (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))) + (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]) + (SETQ X (LIST 'ADDTOVAR 'LISPXCOMS X]) + NIL) collect X]) (FILEGETDEF.ALISTS - [LAMBDA (NAME TYPE SOURCE OPTIONS) (* lmm " 4-Jul-85 15:13") + [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] + (AND (EQ FIRST 'ADDTOVAR) + (EQ SECOND (CAR NAME] when (SETQ X (ASSOC (CADR NAME) - (CDDR X))) collect X + (CDDR X))) collect X finally (RETURN (COND - ($$VAL (CONS 'ADDTOVAR (CONS (CAR NAME) - $$VAL]) + ($$VAL (CONS 'ADDTOVAR (CONS (CAR NAME) + $$VAL]) (FILEGETDEF.RECORDS - [LAMBDA (NAME TYPE SOURCE OPTIONS NOTFOUND) (* lmm "26-Jun-86 15:56") + [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) @@ -2924,77 +2867,73 @@ compiling " T) (RATOM) (EQ NAME (RATOM] (if (EQ (CAAR VAL) - 'NOT-FOUND%:) + '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") + [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] + (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]) + (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") + [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] + (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]) + '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]) + [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") + [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] + (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])] + (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") + [LAMBDA (NAME TYPE DEFINITION REASON) (* lmm "15-Jul-85 11:29") (PROG (COM TYP) [SELECTQ (CAR (LISTP DEFINITION)) (COM (SETQ COM (CDR DEFINITION))) @@ -3005,46 +2944,39 @@ compiling " T) (* ;; "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" - ))) + ((ADD DELETE MACRO CONTENTS CONTAIN COM)) + (ERROR I "not file package command property"))) (* ; - "COM merely adds to spelling list, for builtins") + "COM merely adds to spelling list, for builtins") [FILEPKGCOM NAME 'CONTENTS (OR (LISTGET COM 'CONTENTS) - (LISTGET COM 'CONTAIN] + (LISTGET COM 'CONTAIN] (* ; "Until CONTAIN is de-documented.") - (for PROP in '(ADD DELETE MACRO COM) do (FILEPKGCOM NAME PROP - (LISTGET COM PROP))) + (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" - ] + (SELECTQ I + ((DESCRIPTION TYPE)) + (ERROR I "not file package type/command property"] (* ; - "TYPE merely adds to spelling list, for builtins") + "TYPE merely adds to spelling list, for builtins") (for PROP in (UNION '(DESCRIPTION TYPE) - FILEPKGTYPEPROPS) do (FILEPKGTYPE NAME PROP - (LISTGET TYP PROP]) + FILEPKGTYPEPROPS) do (FILEPKGTYPE NAME PROP (LISTGET TYP PROP]) (FILES.PUTDEF - [LAMBDA (NAME TYPE DEFINITION REASON) (* lmm "15-Jul-85 17:13") + [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") + (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] + (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") + [LAMBDA (NAME TYPE DEFINITION REASON) (* lmm "29-Jul-85 20:59") (/SETTOPVAL NAME DEFINITION T]) (FILES.WHENCHANGED @@ -3140,28 +3072,28 @@ compiling " T) (DEFINEQ (RENAME - [LAMBDA (OLD NEW TYPES FILES METHOD) (* JonL "24-Jul-84 20:01") + [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] + [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)) + ((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] + (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") + [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)) @@ -3176,48 +3108,48 @@ compiling " T) (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 + (MARK %#1) + (ORR (1 !0 P) + NIL) + (MARK %#2) + (COMS (SELECTQ (ASKUSER NIL NIL " Replace ? " + '((Y "Yes ") - (N "No + (N "No ") - (% + (% "") - (% "") - (% + (% "") + (% "") - (& "")) - NIL NIL '(NOECHOFLG T)) - (Y '(R1 OLD NEW)) - (N NIL) - 'TTY%:)) - (MARK %#3) - (IF (EQ (%## (\ %#3)) - (%## (\ %#2))) - ((\ %#1)) - NIL] + (& "")) + 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))) + ((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") @@ -3238,9 +3170,8 @@ compiling " T) (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)))) + 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) @@ -3248,12 +3179,12 @@ compiling " T) (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] + 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 @@ -3264,10 +3195,10 @@ compiling " T) (DEFINEQ (SHOWDEF - [LAMBDA (NAME TYPE FILE) (* ; "Edited 26-Oct-2021 09:21 by rmk:") + [LAMBDA (NAME TYPE FILE) (* ; "Edited 26-Oct-2021 09:21 by rmk:") (* ; "Edited 16-Apr-2018 21:35 by rmk:") (* ; - "prettyprint NAME as it would be dumped as a TYPE (in the current reader environment)") + "prettyprint NAME as it would be dumped as a TYPE (in the current reader environment)") (RESETLST (PROG (ORIGFLG FNSLST FL PRETTYCOMSLST NEWFILEMAP (SOURCEFILENV (MAKE-READER-ENVIRONMENT @@ -3278,43 +3209,43 @@ compiling " T) (if (SETQ FL (OPENP FILE 'OUTPUT)) then (RESETSAVE (OUTPUT FL)) else (OUTFILE FILE) - (RESETSAVE NIL (LIST (FUNCTION CLOSEF?) - (OUTPUT] + (RESETSAVE NIL (LIST (FUNCTION CLOSEF?) + (OUTPUT] (PRETTYCOM (MAKENEWCOM NAME TYPE))))]) (COPYDEF - [LAMBDA (OLD NEW TYPE SOURCE OPTIONS) (* lmm "14-Aug-84 18:38") + [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] + ((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.") + "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]) + (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)) @@ -3331,12 +3262,16 @@ compiling " T) (RETURN NEW]) (GETDEF - [LAMBDA (NAME TYPE SOURCE OPTIONS) (* lmm "13-Jul-85 04:10") + [LAMBDA (NAME TYPE SOURCE OPTIONS) (* ; "Edited 3-Sep-2022 16:43 by larry") + (* 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)) + (* ;; " FROMEDITOR is used if the editing form is different from the defining form (as in LOOPS)") + + (PROG (DEF TEM (EDIT (EQMEMB 'EDIT OPTIONS)) + (NOCOPY (EQMEMB 'NOCOPY OPTIONS))) + (DECLARE (SPECVARS NOCOPY EDIT)) (SELECTQ OPTIONS (0 (SETQQ OPTIONS (NOERROR NODWIM)) (SETQ NOCOPY T)) @@ -3374,37 +3309,34 @@ compiling " T) (RETURN DEF]) (GETDEFCOM - [LAMBDA (X) (* lmm " 4-Jul-85 13:31") + [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") + [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)))) + ((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))) + (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))) + (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") + [LAMBDA (NAME TYPE OPTIONS) (* ; "Edited 2-May-87 19:00 by Pavel") (* ; - "Gets the current definition--source=0") + "Gets the current definition--source=0") (LET (DEF) (COND @@ -3431,31 +3363,30 @@ compiling " T) ((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))) + (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") + "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]) + 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))) + (SETQ DEF (GETTEMPLATE NAME))) then (LIST 'SETTEMPLATE (KWOTE NAME) - (KWOTE DEF)))) + (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]) + (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)) @@ -3494,21 +3425,20 @@ compiling " T) (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] + 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)) @@ -3516,37 +3446,36 @@ compiling " T) 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.") + [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") + "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))) + '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) + (T (for O inside OPTIONS when (STRINGP O) do (RETFROM 'GETDEF O) finally (ERROR NAME (CONS TYPE '(definition not found)) - T]) + T]) (GETDEFFROMFILE - [LAMBDA (NAME TYPE SOURCE OPTIONS) (* bvm%: " 1-Oct-86 22:10") + [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)) + DEF SOURCE TEM2 for FILE inside (COND + ((EQ SOURCE 'FILE) + (WHEREIS NAME TYPE T)) + (T SOURCE)) when (AND (SETQ SOURCE (FINDFILE FILE T)) @@ -3578,7 +3507,7 @@ compiling " T) (EQ NAME (RATOM] (* ; "ick! Should use real closure") (if (EQ (CAAR VAL) - 'NOT-FOUND) + 'NOT-FOUND) then NOTFOUND elseif (CDR VAL) then (CONS 'PROGN VAL) @@ -3588,41 +3517,41 @@ compiling " T) [LET (LOAD-VERBOSE-STREAM) (DECLARE (SPECVARS LOAD-VERBOSE-STREAM)) (* ; - "just in case we get a PRETTYCOMPRINT in here") + "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") + "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))) + (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]) + "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") + [LAMBDA (NAME TYPE OPTIONS) (* ; "Edited 11-Aug-87 18:14 by cutting") (* ; - "Gets the `saved' definition--source=T") + "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") + "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) + 'VALUE) do (RETURN (CADR X)) finally (RETURN (GETDEFERR NAME TYPE OPTIONS - "no saved value for ")))) + "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") + [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 @@ -3638,7 +3567,7 @@ compiling " T) (EDITDEF [LAMBDA (NAME TYPE SOURCE EDITCOMS OPTIONS) (DECLARE (LOCALVARS . T) - (SPECVARS SOURCE)) (* ; "Edited 27-Jul-87 11:04 by cutting") + (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.") @@ -3649,13 +3578,13 @@ compiling " T) NAME TYPE SOURCE EDITCOMS OPTIONS))) ((AND (EQ TYPE 'FNS) (NULL SOURCE)) (* ; - "special hack for EDITDEF of FNS because of ability to EDITLOADFNS") + "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") + [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] @@ -3687,8 +3616,8 @@ compiling " T) (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) + "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) @@ -3699,16 +3628,16 @@ compiling " T) OPTIONS))]) (EDITDEF.FILES - [LAMBDA (NAME TYPE SOURCE EDITCOMS OPTIONS) (* ; "Edited 18-Mar-87 16:07 by woz") + [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") + [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") + [LAMBDA (DEF FN SOURCE) (* lmm " 6-Jun-86 17:23") (AND [OR (EQ DWIMIFYCOMPFLG T) (EQ CLISPIFYPRETTYFLG T) (EQ (CAR (CADDR DEF)) @@ -3730,7 +3659,7 @@ compiling " T) NIL DEF]) (DELDEF - [LAMBDA (NAME TYPE) (* ; "Edited 5-Dec-86 06:20 by lmm") + [LAMBDA (NAME TYPE) (* ; "Edited 5-Dec-86 06:20 by lmm") (PROG (TEM) (SETQ TYPE (GETFILEPKGTYPE TYPE 'TYPE)) LP [COND @@ -3738,7 +3667,7 @@ compiling " T) (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") + "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) @@ -3752,12 +3681,12 @@ compiling " T) (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)) + (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) @@ -3768,8 +3697,7 @@ compiling " T) (/REMPROP (CAR NAME) (CADR NAME)))) (LISPXMACROS (DELFROMLIST 'LISPXMACROS (FASSOC NAME LISPXMACROS)) - (DELFROMLIST 'LISPXHISTORYMACROS (FASSOC NAME LISPXHISTORYMACROS - )) + (DELFROMLIST 'LISPXHISTORYMACROS (FASSOC NAME LISPXHISTORYMACROS)) (DELFROMLIST 'LISPXCOMS NAME) (DELFROMLIST 'HISTORYCOMS NAME)) (PRIN1 (LIST "Note: deleting" TYPE "not implemented yet") @@ -3778,7 +3706,7 @@ compiling " T) (RETURN NAME]) (DELFROMLIST - [LAMBDA (VAR VAL) (* rmk%: " 3-JAN-82 23:22") + [LAMBDA (VAR VAL) (* rmk%: " 3-JAN-82 23:22") (AND (FMEMB VAL (GETTOPVAL VAR)) (/SETTOPVAL VAR (SUBSET (GETTOPVAL VAR) (FUNCTION (LAMBDA (X) @@ -3788,16 +3716,16 @@ compiling " T) VAL]) (HASDEF - [LAMBDA (NAME TYPE SOURCE SPELLFLG) (* ; "Edited 31-Aug-87 18:02 by drc:") + [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") + (LISTP (SETQ TYPE (GETFILEPKGTYPE TYPE 'TYPE] (* ; "ignore SPELLFLG") (for TY in TYPE do (AND (SETQ $$VAL (HASDEF NAME TY SOURCE)) - (RETURN $$VAL] + (RETURN $$VAL] (T (PROG [(NODEF (fetch NULLDEF of TYPE)) (OPTS '(NODWIM NOCOPY NOERROR HASDEF] @@ -3861,8 +3789,7 @@ compiling " T) (FILES FILELST) (FILEPKGCOMS (UNION FILEPKGCOMSPLST FILEPKGTYPES)) (FIELDS (for X in USERRECLST - join (APPEND (RECORDFIELDNAMES - X)))) + join (APPEND (RECORDFIELDNAMES X)))) (RECORDS (for X in USERRECLST when (LITATOM (CADR X)) collect (CADR X))) @@ -3885,22 +3812,22 @@ compiling " T) (NEQ NODEF (GETDEF NAME TYPE SOURCE OPTS]) (GETFILEDEF - [LAMBDA (FILENAME) (* lmm " 4-Jul-85 13:25") + [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") + "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]) + ((EQ (FILENAMEFIELD FILE 'NAME) + FILENAME) + (RETURN FILE]) (SAVEDEF - [LAMBDA (NAME TYPE DEFINITION) (* JonL "24-Jul-84 20:11") + [LAMBDA (NAME TYPE DEFINITION) (* JonL "24-Jul-84 20:11") (COND [(AND (LISTP NAME) (NULL TYPE)) @@ -3922,15 +3849,15 @@ compiling " T) (EQ DEFINITION (GETTOPVAL NAME)) (/PUT NAME (SETQ TYPE 'VALUE) DEFINITION))) - (AND [OR DEFINITION (SETQ DEFINITION (GETDEF NAME TYPE 'CURRENT - '(NOCOPY NOERROR NODWIM] + (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") + [LAMBDA (NAME TYPE DEF) (* lmm " 6-Jun-86 17:24") (SELECTQ TYPE ((NIL EXPR CODE SUBR LIST) (COND @@ -3952,7 +3879,7 @@ compiling " T) (COMPAREDEFS [LAMBDA (NAME TYPE SOURCES) (* ; "Edited 8-Nov-2021 10:52 by rmk:") - (* ; "Edited 30-Oct-2021 20:01 by rmk:") + (* ; "Edited 30-Oct-2021 20:01 by rmk:") (* lmm " 4-Jul-85 14:37") (COND ((AND (LISTP TYPE) @@ -4010,7 +3937,7 @@ compiling " T) (T 'SAME]) (COMPARE - [LAMBDA (NAME1 NAME2 TYPE SOURCE1 SOURCE2) (* lmm " 5-SEP-78 13:37") + [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 @@ -4040,54 +3967,45 @@ compiling " T) (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)) + 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))) + when (AND (LITATOM TYPE) + (NOT (EQMEMB TYPE IMPOSSIBLETYPES)) + (OR (NULL FILTER) + (CL:FUNCALL FILTER TYPE)) + (HASDEF NAME TYPE SOURCE)) do (push FOUND TYPE))) FOUND]) ) @@ -4102,12 +4020,12 @@ compiling " T) (DEFINEQ (FILEPKGCOM - [LAMBDA N (* JonL "10-Jul-84 19:38") + [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)) + (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)) @@ -4143,47 +4061,43 @@ compiling " T) "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"] + (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 (* ; "Edited 13-Jun-2021 10:20 by rmk:") + [LAMBDA N (* ; "Edited 13-Jun-2021 10:20 by rmk:") (PROG ((TYPE (ARG N 1)) TEM) (RETURN (COND [(EQ N 1) (OR (for FIELD in (UNION '(DESCRIPTION) - FILEPKGTYPEPROPS) - when (SETQ TEM (FILEPKGTYPE TYPE FIELD)) + FILEPKGTYPEPROPS) when (SETQ TEM (FILEPKGTYPE TYPE + FIELD)) join (LIST FIELD TEM)) (AND (FMEMB TYPE (GETTOPVAL 'FILEPKGTYPES)) (LIST 'TYPE T)) @@ -4191,46 +4105,42 @@ compiling " T) (LIST 'TYPE TEM] [(EQ N 2) (if (FMEMB (ARG N 2) - FILEPKGTYPEPROPS) + FILEPKGTYPEPROPS) then (GETPROP TYPE (ARG N 2)) else (SELECTQ (ARG N 2) - (DESCRIPTION (fetch (FILEPKGTYPE 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"] + (DESCRIPTION (fetch (FILEPKGTYPE 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 (FILEPKGTYPE - DESCRIPTION) - of TYPE with TEM)) - (ERROR (ARG N I) - "not file package command/type property" - ] + (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 (FILEPKGTYPE DESCRIPTION) + of TYPE with TEM)) + (ERROR (ARG N I) + "not file package command/type property"] (MARKASCHANGED TYPE 'FILEPKGCOMS]) ) @@ -4395,7 +4305,7 @@ compiling " T) (DEFINEQ (FINDCALLERS - [LAMBDA (ATOMS FILES) (* lmm "30-SEP-78 01:36") + [LAMBDA (ATOMS FILES) (* lmm "30-SEP-78 01:36") (PROG ((X (EDITCALLERS ATOMS FILES T))) (RETURN (NCONC (DREVERSE (CDR X)) (AND (CAR X) @@ -4568,7 +4478,7 @@ compiling " T) (CONS OTHERSFILES FNS]) (EDITFROMFILE - [LAMBDA (FNS FILES EDITPATTERN EDITCOMS ONLYTYPES) (* ; "Edited 13-Jun-2021 10:24 by rmk:") + [LAMBDA (FNS FILES EDITPATTERN EDITCOMS ONLYTYPES) (* ; "Edited 13-Jun-2021 10:24 by rmk:") (RESETVARS [(EDITLOADFNSFLG (COND ((EQ EDITLOADFNSFLG T) '(T . NO)) @@ -4578,46 +4488,43 @@ compiling " T) (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)) + 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 + ((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.") + (* ;; "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] + (CONS 'FNS (REMOVE 'FNS FILEPKGTYPES] when (AND (LITATOM TYPE) - (NEQ (fetch (FILEPKGTYPE EDITDEF) of TYPE) - 'NILL)) + (NEQ (fetch (FILEPKGTYPE 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] + ((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] + (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") + (* ;; "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) @@ -4627,8 +4534,7 @@ compiling " T) (COND ((NULL SEEN) (LISPXPRIN1 "editing the " T) - (LISPXPRIN1 (OR (fetch (FILEPKGTYPE - DESCRIPTION) + (LISPXPRIN1 (OR (fetch (FILEPKGTYPE DESCRIPTION) of TYPE) TYPE) T) @@ -4648,7 +4554,7 @@ compiling " T) (LISPXTERPRI T]) (FINDATS - [LAMBDA (X L) (* lmm "11-FEB-78 16:03") + [LAMBDA (X L) (* lmm "11-FEB-78 16:03") (COND ((NLISTP X) (FMEMB X L)) @@ -4658,7 +4564,7 @@ compiling " T) L]) (LOOKIN - [LAMBDA (X PAT) (* lmm "11-MAR-78 14:20") + [LAMBDA (X PAT) (* lmm "11-MAR-78 14:20") (COND ([AND (EQ (CAR PAT) '*ANY*) @@ -4733,33 +4639,33 @@ compiling " T) (DEFINEQ (IMPORTFILE - [LAMBDA (FILE RETURNFLG) (* lmm " 6-Jun-86 17:43") + [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") + "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") + "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] + ''IMPORTDATE + (LIST 'IDATE (GETFILEINFO FILE 'CREATIONDATE] RETURNFLG)))]) (IMPORTEVAL - [LAMBDA (FORM RETURNFLG) (* ; "Edited 2-May-87 18:57 by Pavel") + [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))) + (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") + "Ignore datatype initializations -- we only need the record declaration itself") NIL) (PROGN (* ; "default: eval and/or return it") (AND (NEQ RETURNFLG T) @@ -4767,23 +4673,22 @@ compiling " T) (AND RETURNFLG (LIST FORM]) (IMPORTFILESCAN - [LAMBDA (FILE RETURNFLG) (* bvm%: "24-Oct-86 19:31") + [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))))]) + ENDEXPORTDEFFORM) join (IMPORTEVAL DEF RETURNFLG))))]) (CHECKIMPORTS - [LAMBDA (FILES NOASKFLG) (* rmk%: "19-FEB-83 16:31") + [LAMBDA (FILES NOASKFLG) (* rmk%: "19-FEB-83 16:31") (* ; - "Loads exported definitions from new versions of FILES.") + "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] + (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))) @@ -4797,9 +4702,9 @@ compiling " T) (for FILE in FILES do (IMPORTFILE (CADR FILE]) (GATHEREXPORTS - [LAMBDA (FROMFILES TOFILE FLG) (* ; "Edited 23-Aug-2021 16:40 by rmk:") - (* ; - "Copies all exported definitions from FROMFILES to TOFILE.") + [LAMBDA (FROMFILES TOFILE FLG) (* ; "Edited 23-Aug-2021 16:40 by rmk:") + (* ; + "Copies all exported definitions from FROMFILES to TOFILE.") (RESETLST [RESETSAVE NIL (LIST (FUNCTION CLOSE-AND-MAYBE-DELETE) (SETQ TOFILE (OPENSTREAM TOFILE 'OUTPUT] @@ -4815,21 +4720,21 @@ compiling " T) (DATE) "%" T)" T "(LISPXTERPRI T)" T) (for F inside FROMFILES do (MAPC (IMPORTFILE F (OR FLG T)) - (FUNCTION PRINT)) - (TERPRI)) + (FUNCTION PRINT)) + (TERPRI)) (PRINT 'STOP) (TERPRI) (FULLNAME TOFILE))))]) (\DUMPEXPORTS - [NLAMBDA COMS (* bvm%: "24-Oct-86 19:42") + [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") + "BEGINEXPORTDEFSTRING starts with a * for benefit of IMPORTFILE") (for TAIL on COMS do (PRETTYCOM (CAR TAIL))) (TERPRI) (PRINT ENDEXPORTDEFFORM) @@ -4852,7 +4757,7 @@ compiling " T) (DEFINEQ (CLEARFILEPKG - [LAMBDA (FLG) (* bvm%: "29-Aug-86 13:02") + [LAMBDA (FLG) (* bvm%: "29-Aug-86 13:02") (PROG NIL (COND ((SELECTQ FLG @@ -4872,14 +4777,12 @@ compiling " T) [SETQ FILELST (SUBSET FILELST (FUNCTION (LAMBDA (FILE) (COND ((fetch TOBEDUMPED - of (fetch FILEPROP - of FILE)) + 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) + (T (replace FILEPROP of FILE with NIL) (replace FILECHANGES of FILE with NIL) (SMASHFILECOMS FILE) @@ -4961,46 +4864,46 @@ compiling " T) (PUTPROPS FILEPKG COPYRIGHT ("Venue & Xerox Corporation" T 1982 1983 1984 1985 1986 1987 1988 1989 1990 1991 1992 1993 1995 2018 2020 2021 2022)) (DECLARE%: DONTCOPY - (FILEMAP (NIL (19274 20979 (SEARCHPRETTYTYPELST 19284 . 20263) (PRETTYDEFMACROS 20265 . 20723) ( -FILEPKGCOMPROPS 20725 . 20977)) (21781 57028 (CLEANUP 21791 . 23179) (COMPILEFILES 23181 . 23457) ( -COMPILEFILES0 23459 . 24179) (CONTINUEDIT 24181 . 25601) (MAKEFILE 25603 . 37940) (FILECHANGES 37942 - . 40706) (FILEPKG.MERGECHANGES 40708 . 41531) (FILEPKG.CHANGEDFNS 41533 . 41845) (MAKEFILE1 41847 . -46074) (COMPILE-FILE? 46076 . 47633) (MAKEFILES 47635 . 49328) (ADDFILE 49330 . 51851) (ADDFILE0 51853 - . 55989) (LISTFILES 55991 . 57026)) (57700 92940 (FILEPKGCHANGES 57710 . 59060) (GETFILEPKGTYPE 59062 - . 62135) (MARKASCHANGED 62137 . 63774) (FILECOMS 63776 . 64160) (WHEREIS 64162 . 65582) ( -SMASHFILECOMS 65584 . 65819) (FILEFNSLST 65821 . 65983) (FILECOMSLST 65985 . 66469) (UPDATEFILES 66471 - . 71771) (INFILECOMS? 71773 . 73676) (INFILECOMTAIL 73678 . 74818) (INFILECOMS 74820 . 74981) ( -INFILECOM 74983 . 85192) (INFILECOMSVALS 85194 . 85521) (INFILECOMSVAL 85523 . 86525) (INFILECOMSPROP -86527 . 87356) (IFCPROPS 87358 . 88619) (IFCEXPRTYPE 88621 . 89132) (IFCPROPSCAN 89134 . 90187) ( -IFCDECLARE 90189 . 91500) (INFILEPAIRS 91502 . 91834) (INFILECOMSMACRO 91836 . 92938)) (92975 124395 ( -FILES? 92985 . 95178) (FILES?1 95180 . 95878) (FILES?PRINTLST 95880 . 96662) (ADDTOFILES? 96664 . -107710) (ADDTOFILE 107712 . 108628) (WHATIS 108630 . 110606) (ADDTOCOMS 110608 . 112252) (ADDTOCOM -112254 . 118801) (ADDTOCOM1 118803 . 119974) (ADDNEWCOM 119976 . 121026) (MAKENEWCOM 121028 . 122871) -(DEFAULTMAKENEWCOM 122873 . 124393)) (124465 127282 (MERGEINSERT 124475 . 126818) (MERGEINSERT1 126820 - . 127280)) (127436 128793 (ADDTOFILEKEYLST 127446 . 128791)) (128910 139822 (DELFROMFILES 128920 . -129770) (DELFROMCOMS 129772 . 131451) (DELFROMCOM 131453 . 137321) (DELFROMCOM1 137323 . 138120) ( -REMOVEITEM 138122 . 138996) (MOVETOFILE 138998 . 139820)) (140036 142405 (SAVEPUT 140046 . 142403)) ( -142530 150854 (UNMARKASCHANGED 142540 . 144248) (PREEDITFN 144250 . 146761) (POSTEDITPROPS 146763 . -149264) (POSTEDITALISTS 149266 . 150852)) (150999 171553 (ALISTS.GETDEF 151009 . 151388) ( -ALISTS.WHENCHANGED 151390 . 152034) (CLEARCLISPARRAY 152036 . 153210) (EXPRESSIONS.WHENCHANGED 153212 - . 153586) (MAKEALISTCOMS 153588 . 154661) (MAKEFILESCOMS 154663 . 156100) (MAKELISPXMACROSCOMS 156102 - . 158120) (MAKEPROPSCOMS 158122 . 158820) (MAKEUSERMACROSCOMS 158822 . 160622) (PROPS.WHENCHANGED -160624 . 161245) (FILEGETDEF.LISPXMACROS 161247 . 162689) (FILEGETDEF.ALISTS 162691 . 163310) ( -FILEGETDEF.RECORDS 163312 . 164243) (FILEGETDEF.PROPS 164245 . 165037) (FILEGETDEF.MACROS 165039 . -166099) (FILEGETDEF.VARS 166101 . 166517) (FILEGETDEF.FNS 166519 . 167883) (FILEPKGCOMS.PUTDEF 167885 - . 170325) (FILES.PUTDEF 170327 . 171284) (VARS.PUTDEF 171286 . 171429) (FILES.WHENCHANGED 171431 . -171551)) (173575 181008 (RENAME 173585 . 174986) (CHANGECALLERS 174988 . 181006)) (181009 229865 ( -SHOWDEF 181019 . 182212) (COPYDEF 182214 . 184688) (GETDEF 184690 . 186966) (GETDEFCOM 186968 . 187934 -) (GETDEFCOM0 187936 . 189282) (GETDEFCURRENT 189284 . 195704) (GETDEFERR 195706 . 197007) ( -GETDEFFROMFILE 197009 . 201289) (GETDEFSAVED 201291 . 202395) (PUTDEF 202397 . 203100) (EDITDEF 203102 - . 204079) (DEFAULT.EDITDEF 204081 . 206917) (EDITDEF.FILES 206919 . 207120) (LOADDEF 207122 . 207298) - (DWIMDEF 207300 . 208154) (DELDEF 208156 . 211170) (DELFROMLIST 211172 . 211676) (HASDEF 211678 . -218000) (GETFILEDEF 218002 . 218524) (SAVEDEF 218526 . 220185) (UNSAVEDEF 220187 . 221083) ( -COMPAREDEFS 221085 . 224895) (COMPARE 224897 . 225601) (TYPESOF 225603 . 229863)) (230015 238786 ( -FILEPKGCOM 230025 . 234958) (FILEPKGTYPE 234960 . 238784)) (250819 267961 (FINDCALLERS 250829 . 251344 -) (EDITCALLERS 251346 . 261466) (EDITFROMFILE 261468 . 267276) (FINDATS 267278 . 267550) (LOOKIN -267552 . 267959)) (267962 269633 (SEPRCASE 267972 . 269631)) (270150 275707 (IMPORTFILE 270160 . -271134) (IMPORTEVAL 271136 . 272016) (IMPORTFILESCAN 272018 . 272439) (CHECKIMPORTS 272441 . 273777) ( -GATHEREXPORTS 273779 . 275117) (\DUMPEXPORTS 275119 . 275705)) (276045 278253 (CLEARFILEPKG 276055 . -278251))))) + (FILEMAP (NIL (19253 20926 (SEARCHPRETTYTYPELST 19263 . 20232) (PRETTYDEFMACROS 20234 . 20670) ( +FILEPKGCOMPROPS 20672 . 20924)) (21739 56031 (CLEANUP 21749 . 23139) (COMPILEFILES 23141 . 23417) ( +COMPILEFILES0 23419 . 24232) (CONTINUEDIT 24234 . 25611) (MAKEFILE 25613 . 37339) (FILECHANGES 37341 + . 40105) (FILEPKG.MERGECHANGES 40107 . 40742) (FILEPKG.CHANGEDFNS 40744 . 41056) (MAKEFILE1 41058 . +45270) (COMPILE-FILE? 45272 . 46859) (MAKEFILES 46861 . 48389) (ADDFILE 48391 . 50934) (ADDFILE0 50936 + . 55060) (LISTFILES 55062 . 56029)) (56703 90289 (FILEPKGCHANGES 56713 . 57892) (GETFILEPKGTYPE 57894 + . 60844) (MARKASCHANGED 60846 . 62477) (FILECOMS 62479 . 62863) (WHEREIS 62865 . 64394) ( +SMASHFILECOMS 64396 . 64624) (FILEFNSLST 64626 . 64792) (FILECOMSLST 64794 . 65280) (UPDATEFILES 65282 + . 69780) (INFILECOMS? 69782 . 71625) (INFILECOMTAIL 71627 . 72745) (INFILECOMS 72747 . 72908) ( +INFILECOM 72910 . 82928) (INFILECOMSVALS 82930 . 83237) (INFILECOMSVAL 83239 . 84247) (INFILECOMSPROP +84249 . 85042) (IFCPROPS 85044 . 86124) (IFCEXPRTYPE 86126 . 86742) (IFCPROPSCAN 86744 . 87705) ( +IFCDECLARE 87707 . 88966) (INFILEPAIRS 88968 . 89267) (INFILECOMSMACRO 89269 . 90287)) (90324 121010 ( +FILES? 90334 . 92445) (FILES?1 92447 . 93149) (FILES?PRINTLST 93151 . 93933) (ADDTOFILES? 93935 . +104478) (ADDTOFILE 104480 . 105396) (WHATIS 105398 . 107374) (ADDTOCOMS 107376 . 108914) (ADDTOCOM +108916 . 115403) (ADDTOCOM1 115405 . 116576) (ADDNEWCOM 116578 . 117628) (MAKENEWCOM 117630 . 119477) +(DEFAULTMAKENEWCOM 119479 . 121008)) (121080 123897 (MERGEINSERT 121090 . 123433) (MERGEINSERT1 123435 + . 123895)) (124051 125412 (ADDTOFILEKEYLST 124061 . 125410)) (125529 136330 (DELFROMFILES 125539 . +126369) (DELFROMCOMS 126371 . 128050) (DELFROMCOM 128052 . 133817) (DELFROMCOM1 133819 . 134618) ( +REMOVEITEM 134620 . 135496) (MOVETOFILE 135498 . 136328)) (136544 138915 (SAVEPUT 136554 . 138913)) ( +139040 147283 (UNMARKASCHANGED 139050 . 140534) (PREEDITFN 140536 . 143017) (POSTEDITPROPS 143019 . +145313) (POSTEDITALISTS 145315 . 147281)) (147428 166898 (ALISTS.GETDEF 147438 . 147817) ( +ALISTS.WHENCHANGED 147819 . 148465) (CLEARCLISPARRAY 148467 . 149645) (EXPRESSIONS.WHENCHANGED 149647 + . 150025) (MAKEALISTCOMS 150027 . 151042) (MAKEFILESCOMS 151044 . 152374) (MAKELISPXMACROSCOMS 152376 + . 154394) (MAKEPROPSCOMS 154396 . 155022) (MAKEUSERMACROSCOMS 155024 . 156841) (PROPS.WHENCHANGED +156843 . 157464) (FILEGETDEF.LISPXMACROS 157466 . 158765) (FILEGETDEF.ALISTS 158767 . 159358) ( +FILEGETDEF.RECORDS 159360 . 160287) (FILEGETDEF.PROPS 160289 . 161084) (FILEGETDEF.MACROS 161086 . +161968) (FILEGETDEF.VARS 161970 . 162573) (FILEGETDEF.FNS 162575 . 163815) (FILEPKGCOMS.PUTDEF 163817 + . 165759) (FILES.PUTDEF 165761 . 166629) (VARS.PUTDEF 166631 . 166774) (FILES.WHENCHANGED 166776 . +166896)) (168920 176151 (RENAME 168930 . 170375) (CHANGECALLERS 170377 . 176149)) (176152 224061 ( +SHOWDEF 176162 . 177359) (COPYDEF 177361 . 180109) (GETDEF 180111 . 182654) (GETDEFCOM 182656 . 183622 +) (GETDEFCOM0 183624 . 184817) (GETDEFCURRENT 184819 . 191131) (GETDEFERR 191133 . 192403) ( +GETDEFFROMFILE 192405 . 196634) (GETDEFSAVED 196636 . 197724) (PUTDEF 197726 . 198433) (EDITDEF 198435 + . 199418) (DEFAULT.EDITDEF 199420 . 202258) (EDITDEF.FILES 202260 . 202465) (LOADDEF 202467 . 202643) + (DWIMDEF 202645 . 203499) (DELDEF 203501 . 206395) (DELFROMLIST 206397 . 206901) (HASDEF 206903 . +213140) (GETFILEDEF 213142 . 213654) (SAVEDEF 213656 . 215344) (UNSAVEDEF 215346 . 216242) ( +COMPAREDEFS 216244 . 220050) (COMPARE 220052 . 220756) (TYPESOF 220758 . 224059)) (224211 232459 ( +FILEPKGCOM 224221 . 228997) (FILEPKGTYPE 228999 . 232457)) (244492 261255 (FINDCALLERS 244502 . 245017 +) (EDITCALLERS 245019 . 255139) (EDITFROMFILE 255141 . 260570) (FINDATS 260572 . 260844) (LOOKIN +260846 . 261253)) (261256 262927 (SEPRCASE 261266 . 262925)) (263444 268900 (IMPORTFILE 263454 . +264424) (IMPORTEVAL 264426 . 265312) (IMPORTFILESCAN 265314 . 265727) (CHECKIMPORTS 265729 . 266985) ( +GATHEREXPORTS 266987 . 268308) (\DUMPEXPORTS 268310 . 268898)) (269238 271308 (CLEARFILEPKG 269248 . +271306))))) STOP diff --git a/sources/FILEPKG.LCOM b/sources/FILEPKG.LCOM index 88a51ee806f69ea6b1c163054df638dc2cdbd37c..9eb2b7114f33778c0ab8a6a188c1b6fc8be72119 100644 GIT binary patch delta 1418 zcmZ`(T}&KR6y~zak3$7a3RMI-S<-YSW^v}u>~92inVrR5mfdw`7K-+vlpSCz>~4XY zkjC)VC!^LenP{3A(#FIG4R&cr@d4w5KA4yoAJzC^j1ksCH5y~;&%HBCi)ooma?icz zyWctYobTSdYmGmzHNG(s0MV-%WiRG22EiYe$d5h1dZtSY<-)v?hf)zda4DvZzVhr` zX~7trpITg888lx*PptYmU_5{i5d^|gFf92zaBk7K$1puNRh%`JPKIGb(PK&+3WPGA zOQqoO-v0i659FtoNyvwi20a|Z#uF(;R+Xr(#K3dv!Q92rk+}j6NWK6MVfndedPLE@ zdIne~p4Mtvalnp8RSjr}?C6M`8PhljXH{i9k;!S^7>P*=akyGiSdhXzIV|%)c@~WP zysaETMCNCfs#(Zh5wj zeET=sW!J_r+m^dGT!kZ+AM?26{Q3Q>+ael+D;k-k9 zBfIUe=3UqFSLV99K8{33Tj=f=qPByf_Wq6J!?Q}TK^&$8Md*>_BvJ+LvY3s#xt>r#26I_4oYCx1_#7@ zP6rcLGh?(xfPF#p%5Eno@kb)CM0=Z6Gg-g_rfBoi-5#^2+Uyd1*lewySQU7YVros- zC$kDsnTSOg08zlCMKmQ4dH%q}ApxjpuoMI>I!<(mMadQoi4lS{ku^Pm5c1!*1GLwQ zs%BJj#V`zkAYqVms;Zn$>mZ0ex`h2TK0)w1PT~s%f#w9k5NKJ2+!%7&nrv|Jz!Czs ze!%C*h+!chnLE|q4qph^gTT&7IF6}2^~*_w7&CTz#?7!qkssbRnwfMWMJJUf_kN^K zbZ6FfR_5<$bpFY&`Ch_HtHtJxnL@F!Tp$lav9t^`rHjQp;WgW;9hK9+_0$vi%fEl^ zaJN-EE7N~`)PR^u$KAJ(!}-DAKFaySKVD~k{NGnyh_Tk{(O+b^>Oz;v(C0=$0{UwA zxK(zeKgmj=0eQ(_HJ}N^Z0-#e5u!dCBM9AN~fQGEgD(Y)t66u6)KM1U~p`sjd zE}uuIEI~s9EzDSSRH2#?z*^DJi%rb)xeR$9tZy`Qww__F0Ua6j3~XN4(U;wi{x72S RT^XIA@gCp2b^%TH{s&!(f)W4# delta 1296 zcmb7EU2NM_6zt1-gz7x_!TWkjpLp}R z<)u<>DKS@As1)WCmFn3-C2_7)tdw5kLVV(UwKi9tpABAlXXqkFgP-MgGqYTr3CGzm z$#kYx+R0tIuuxk%8V5P07?POD$eIqitZI^|%TOkT)A>vW9#0esh5S$~yh?~YsX)w6 zdjn}@G9ycxEE;l(pq|*^|85A_DCRK_ap{DZ9h3E-k%K@wyUW-6co#IpRZX5!a(O+N zB0T<0gNep@9LM;-&(*ax*v1C>_UC>EvNJo7Eoj zoblW&-&i?3*ZOc*H3!!e)HDlghep0iisQXDZbqE753l`deKEdcHm|N73N}}cbiAz( zlA_dsH!qJmzlah#$l6#OF^{hgnV+o>4|FX!5(R=#wVVoA5X{T% zK?i2dD~|>*LX@#xX(c186Jy4VD$`VeV;FdzY%NBHWfuoF64?=jDA>DWSsu3QVX)%? z#{|fdTW52{5pGuwM@h7-X*mrr7lY$~aSWuqrpaSjgD9+RVz{k*F|O+)t_Tk{B@hJA zRhispZ1d>MfZq}bUEs0#-G*;~6Cki%r%Rlssm8;NqX>%RF-*0zQ)Z6x_M_9H zi>7I?ZY`hz>%t;BfV@_H5rwRmHFTs`$tuQ_Nd6K5ul2r$@_VJ+q)OIiuTBTA^-x38 wy_4cZ$AF39l#Wh4buynLpP<+JT1TfHB+_S~k^{V}mkjjd;nf!x(c8X%014W2N&o-=