From 8365cac123d2d30da847fa9852c5d1657a1065f0 Mon Sep 17 00:00:00 2001 From: Matt Heffron Date: Tue, 12 May 2026 15:36:22 -0700 Subject: [PATCH] Adjust Ron's fix in DUMPDB for non-uppercase FILE. --- library/DATABASEFNS | 114 ++++++++++++++++++++------------------- library/DATABASEFNS.LCOM | Bin 7663 -> 7722 bytes 2 files changed, 58 insertions(+), 56 deletions(-) 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 4d402590ff222e67a99f648e9fa25491647942d3..7f92393e15763d64c7e9990013c827364e9791f3 100644 GIT binary patch delta 1539 zcmbVM&u<%55Vlh_fC<4tN*X|dkwt_fWZ3s(cfD?8X&pbuPS(4wckN(MrKE|eE$pO9 zbBPc#H^c$ab~(a@Bd4_K0R&R7MO=~i3pm4td*{7%);8R_ht-?!n;+lIo87;!|G07Q zaHJO)D{wsn+04Q5@J@fwJ%r;U$Uy3|vcL2BM(=poEe`ijPm8sq)9%TjfA>yt*gYI{ z&x(Wot&{zevtro}?2_$^itE3BU0;U`A-VegS&nMd04lQ=xS4@lC*8QhL2v))cK7aD zVGdIFe}8xRe<4PJ^6j!}XeU%^C;8_d247EQAH1=8@mKPX#dM?TH7d>)RKSEv%@N^m>9v)A z=dUD^OM6#$7hg)?^O1W09KO1+ytcde%DlvGD(u%idA==Q|2%k@_?tDye{KI+5j;2_H0C0r0#wJ{Sfxnl%?8LxW1oaa_ADfa?Td5d@vG zr~or5_<@JEU2+64jM);wNZto9u0bIDAfl*cNlGy^&yZ(>hbhR|Ns*WFkHRFt1 z#w`jR;p1dXxcnZ0n>;q+M4VB$(ei>3j)|f(?)@Y{(-nu5rp3~jrNgG(1ZHXDVY9pr za*#x6!f>q2a3FPGmKl#3JD#x_o3TG-^gjW_R4p)q*JZawxg@_9rg4Q*Ytjo)PUFUa zQZkd6lG#F33QgVik>oE83z7*o|_)DwBBQlEoiZjH)4+Q1Z$hU<5GOuX!$R r;?x8Phz|qdN&Ptb~S+>V{tGsZJ^umA~20*QDkTtK_X zf(s|4WrriHMI1SxgmB`*g(KYf3!LE(ETXz6jK>HcM)lQK{newZ{p$4BQ-81Isl#=L z8F?t=mv7&^vwmZB1#aJhJp9=dm4@g&IQ{g$DUGlqjOPg{H80;UQH>fvn8P%O&^%n( zSWQl@-n+AL_qYR3znqxzK=+^yCP^!40fZ+nU!-=C=!<~!}vVCCWYi^=i zZwRP@39Yu@sy61M{gcPN|M!e$vfZ%^{^IXsdG|Gm2A?%$b`R{4?(-`u_QE9z6!Gn! zt<009iI-cM$1Bmp$v>uQ$~`UvF21oF3N@q8lg`Q7CFvZ=D(>0Za&FUH$~{lTZysA$ z^6$IR_tBZvwTY$Nn=>gsPPkoCIy(Rqcsu%NE3-Y6K)GJT?4g)RNoDt8DVg_ci_z+v_k_9~(Z%(Nj0eZ+1VZ-to*=0!i0Hv^0_2t^Ra6tyj+Vuo4-nKr5e z-N{0L8dT*&OXmsA4VZ0Ce1x)15 zEhd-{kTz~^N#G^`rvwUx_!^VzDHeADv&`tP>FS7KZGV`) Gy7vcNBvSGK