diff --git a/library/DATABASEFNS b/library/DATABASEFNS index 4742524c..8d6b805f 100644 --- a/library/DATABASEFNS +++ b/library/DATABASEFNS @@ -1,12 +1,13 @@ (DEFINE-FILE-INFO :PACKAGE "INTERLISP" :READTABLE "INTERLISP" :BASE 10) -(FILECREATED "12-May-2026 12:45:18" {MEDLEY}DATABASEFNS.;13 19361 +(FILECREATED "12-May-2026 15:33:42" {DSK}matt>Interlisp>medley>library>DATABASEFNS.;5 19557 - :EDIT-BY rmk + :EDIT-BY "mth" - :CHANGES-TO (FNS DUMPDB MAKEDB) + :CHANGES-TO (FNS DUMPDB) - :PREVIOUS-DATE "11-May-2026 14:41:08" {MEDLEY}DATABASEFNS.;11) + :PREVIOUS-DATE "12-May-2026 12:45:18" {DSK}matt>Interlisp>medley>library>DATABASEFNS.;4 +) (PRETTYCOMPRINT DATABASEFNSCOMS) @@ -161,7 +162,8 @@ (DEFINEQ (DUMPDB - [LAMBDA (FILE PROPFLG) (* ; "Edited 12-May-2026 12:45 by rmk") + [LAMBDA (FILE PROPFLG) (* ; "Edited 12-May-2026 15:31 by mth") + (* ; "Edited 12-May-2026 12:45 by rmk") (* ; "Edited 11-May-2026 14:41 by mth") (* ; "Edited 8-May-2026 16:18 by mth") (* ; "Edited 2-May-2026 17:32 by mth") @@ -186,67 +188,67 @@ (LET ((SAVEDCOPYRIGHTFLG COPYRIGHTFLG) (SAVEDDEFAULTCOPYRIGHTOWNER DEFAULTCOPYRIGHTOWNER)) (CL:UNWIND-PROTECT - (PROG (DBFILE DBFN DBROOTFN FLCPR (FL (ROOTFILENAME FILE)) - (FNS (FILEFNSLST FILE))) - (SETQ DBFN (PACKFILENAME 'EXTENSION 'DATABASE 'VERSION NIL 'BODY FILE)) - (SETQ DBROOTFN (ROOTFILENAME DBFN)) - (CL:UNLESS (OR (EQ COPYRIGHTFLG 'NEVER) - (NULL DEFAULTDATABASECOPYRIGHTOWNER) - (GETPROP DBROOTFN 'COPYRIGHT)) - (SELECTQ DEFAULTDATABASECOPYRIGHTOWNER - ((NONE NEVER) - (* ;; + (PROG* (DBFILE DBFN DBROOTFN FLCPR (FL (ROOTFILENAME FILE)) + (FNS (FILEFNSLST FL))) + (SETQ DBFN (PACKFILENAME 'EXTENSION 'DATABASE 'VERSION NIL 'BODY FILE)) + (SETQ DBROOTFN (ROOTFILENAME DBFN)) + (CL:UNLESS (OR (EQ COPYRIGHTFLG 'NEVER) + (NULL DEFAULTDATABASECOPYRIGHTOWNER) + (GETPROP DBROOTFN 'COPYRIGHT)) + (SELECTQ DEFAULTDATABASECOPYRIGHTOWNER + ((NONE NEVER) + (* ;;  "Set the COPYRIGHT to NONE (I.e., never mention it again.)") - (/PUT DBROOTFN 'COPYRIGHT (LIST 'NONE))) - (SAME - (* ;; + (/PUT DBROOTFN 'COPYRIGHT (LIST 'NONE))) + (SAME + (* ;;  "Same as the source file. If it doesn't have one, then just normal handling") - (CL:WHEN (SETQ FLCPR (GETPROP FL 'COPYRIGHT)) - (/PUT DBROOTFN 'COPYRIGHT (LIST (CAR FLCPR))))) - (DEFAULT - (* ;; "Use the general default for copyright") + (CL:WHEN (SETQ FLCPR (GETPROP FL 'COPYRIGHT)) + (/PUT DBROOTFN 'COPYRIGHT (LIST (CAR FLCPR))))) + (DEFAULT + (* ;; "Use the general default for copyright") - (SETQ COPYRIGHTFLG 'DEFAULT)) - (PROGN (SETQ COPYRIGHTFLG 'DEFAULT) + (SETQ COPYRIGHTFLG 'DEFAULT)) + (PROGN (SETQ COPYRIGHTFLG 'DEFAULT) - (* ;; + (* ;;  "Hopefully, DEFAULTDATABASECOPYRIGHTOWNER is one of the COPYRIGHTOWNERS keys") - (SETQ DEFAULTCOPYRIGHTOWNER DEFAULTDATABASECOPYRIGHTOWNER)))) - (COND - (FNS) - ((AND MSFILETABLE (TESTTABLE FL (CADR MSFILETABLE))) + (SETQ DEFAULTCOPYRIGHTOWNER DEFAULTDATABASECOPYRIGHTOWNER)))) + (COND + (FNS) + ((AND MSFILETABLE (TESTTABLE FL (CADR MSFILETABLE))) (* ;  "Always dump if this is a known file") - (SETQ PROPFLG NIL)) - (T (COND - (PROPFLG (/REMPROP FL 'DATABASE)) - (T (printout T T FILE " has no functions." T))) - (RETURN))) - (CL:WHEN [OR (NULL PROPFLG) - (EQ (GETPROP FL 'DATABASE) - 'YES) - (EQ SAVEDBFLG 'YES) - (AND MSFILETABLE (TESTTABLE FL (CADR MSFILETABLE] - (CL:WHEN MSFILETABLE - [STORETABLE FL MSFILETABLE (CAR (GETPROP FL 'FILEDATES]) - [SETQ DBFILE - (PRETTYDEF NIL DBFN - `((P (PROGN (PRIN1 "Use LOADDB to load database files!" T) - (ERROR!))) - (E [PRINT (CAR (GETPROP ',FL 'FILEDATES] - (DUMPDATABASE ',FNS] - [COND - (PROPFLG (PRINT (FULLNAME DBFILE) - T)) - (T (/PUT FL 'DATABASEFILENAME DBFILE) + (SETQ PROPFLG NIL)) + (T (COND + (PROPFLG (/REMPROP FL 'DATABASE)) + (T (printout T T FILE " has no functions." T))) + (RETURN))) + (CL:WHEN [OR (NULL PROPFLG) + (EQ (GETPROP FL 'DATABASE) + 'YES) + (EQ SAVEDBFLG 'YES) + (AND MSFILETABLE (TESTTABLE FL (CADR MSFILETABLE] + (CL:WHEN MSFILETABLE + [STORETABLE FL MSFILETABLE (CAR (GETPROP FL 'FILEDATES]) + [SETQ DBFILE + (PRETTYDEF NIL DBFN + `((P (PROGN (PRIN1 "Use LOADDB to load database files!" T) + (ERROR!))) + (E [PRINT (CAR (GETPROP ',FL 'FILEDATES] + (DUMPDATABASE ',FNS] + [COND + (PROPFLG (PRINT (FULLNAME DBFILE) + T)) + (T (/PUT FL 'DATABASEFILENAME DBFILE) (* ;  "Remember that we have this file valid already.") - (/PUT FL 'DATABASE 'YES] (* ; + (/PUT FL 'DATABASE 'YES] (* ;  "Take future note of the database on a user call") - (RETURN DBFILE)))) + (RETURN DBFILE)))) (SETQ COPYRIGHTFLG SAVEDCOPYRIGHTFLG) (SETQ DEFAULTCOPYRIGHTOWNER SAVEDDEFAULTCOPYRIGHTOWNER)))]) @@ -386,7 +388,7 @@ (RESETSAVE DWIMIFYCOMPFLG T) ) (DECLARE%: DONTCOPY - (FILEMAP (NIL (1666 6814 (DBFILE 1676 . 3444) (DBFILE1 3446 . 4956) (DBFILE2 4958 . 6180) (LOAD 6182 - . 6412) (LOADFROM 6414 . 6602) (MAKEFILE 6604 . 6812)) (6870 18839 (DUMPDB 6880 . 12478) (LOADDB -12480 . 17551) (MAKEDB 17553 . 18837))))) + (FILEMAP (NIL (1708 6856 (DBFILE 1718 . 3486) (DBFILE1 3488 . 4998) (DBFILE2 5000 . 6222) (LOAD 6224 + . 6454) (LOADFROM 6456 . 6644) (MAKEFILE 6646 . 6854)) (6912 19035 (DUMPDB 6922 . 12674) (LOADDB +12676 . 17747) (MAKEDB 17749 . 19033))))) STOP diff --git a/library/DATABASEFNS.LCOM b/library/DATABASEFNS.LCOM index 4d402590..7f92393e 100644 Binary files a/library/DATABASEFNS.LCOM and b/library/DATABASEFNS.LCOM differ