From 6d1506f8c3a99f1e2e037d9107e9e49c9709a658 Mon Sep 17 00:00:00 2001 From: Matt Heffron Date: Wed, 21 Feb 2024 10:50:06 -0800 Subject: [PATCH] The setting to NEVER wasn't suppressing asking. The issue was incorrectly getting the ROOTFILENAME as where to attach the COPYRIGHT property. --- library/DATABASEFNS | 125 +++++++++++++++++++++------------------ library/DATABASEFNS.LCOM | Bin 7383 -> 7757 bytes 2 files changed, 66 insertions(+), 59 deletions(-) diff --git a/library/DATABASEFNS b/library/DATABASEFNS index 190d038b..e25c5366 100644 --- a/library/DATABASEFNS +++ b/library/DATABASEFNS @@ -1,13 +1,12 @@ (DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10) -(FILECREATED "19-Feb-2024 16:29:44" {LIB}DATABASEFNS.;15 17624 +(FILECREATED "20-Feb-2024 23:45:56" {DSK}e>Interlisp>medley>library>DATABASEFNS.;4 18445 :EDIT-BY "mth" - :CHANGES-TO (VARS DATABASEFNSCOMS) - (FNS DUMPDB) + :CHANGES-TO (FNS DUMPDB) - :PREVIOUS-DATE "27-Oct-2021 10:55:18" {DSK}e>Interlisp>medley>library>DATABASEFNS.;1) + :PREVIOUS-DATE "19-Feb-2024 16:29:44" {DSK}e>Interlisp>medley>library>DATABASEFNS.;1) (* ; " @@ -165,7 +164,8 @@ Copyright (c) 1986, 1990-1993, 2024 by Xerox Corporation. (DEFINEQ (DUMPDB - [LAMBDA (FILE PROPFLG) (* ; "Edited 7-Feb-2024 18:26 by mth") + [LAMBDA (FILE PROPFLG) (* ; "Edited 20-Feb-2024 23:45 by mth") + (* ; "Edited 7-Feb-2024 18:26 by mth") (* ; "Edited 27-Oct-2021 10:51 by larry") (* ; "Edited 24-Oct-2021 16:24 by rmk:") @@ -173,69 +173,76 @@ Copyright (c) 1986, 1990-1993, 2024 by Xerox Corporation. (* ;; "The FILE check is because MAKEFILE returns a list when it doesn't understand the options") - (DECLARE (GLOBALVARS MSFILETABLE SAVEDBFLG) - (SPECVARS DEFAULTDATABASECOPYRIGHTOWNER COPYRIGHTFLG DEFAULTCOPYRIGHTOWNER)) + (DECLARE (GLOBALVARS MSFILETABLE SAVEDBFLG COPYRIGHTFLG DEFAULTCOPYRIGHTOWNER) + (SPECVARS DEFAULTDATABASECOPYRIGHTOWNER)) (CL:WHEN (AND FILE (OR (LITATOM FILE) (STRINGP FILE))) - (PROG (DBFILE DBFN FLCPR (FL (NAMEFIELD FILE)) - (FNS (FILEFNSLST FILE)) - (COPYRIGHTFLG COPYRIGHTFLG) - (DEFAULTCOPYRIGHTOWNER DEFAULTCOPYRIGHTOWNER)) - (SETQ DBFN (PACKFILENAME 'EXTENSION 'DATABASE 'VERSION NIL 'BODY FILE)) - (CL:UNLESS (OR (EQ COPYRIGHTFLG 'NEVER) - (NULL DEFAULTDATABASECOPYRIGHTOWNER) - (GETPROP DBFN 'COPYRIGHT)) - (SELECTQ DEFAULTDATABASECOPYRIGHTOWNER - ((NONE NEVER) - (* ;; "Set the COPYRIGHT to NONE (I.e., never mention it again.)") + (LET ((SAVEDCOPYRIGHTFLG COPYRIGHTFLG) + (SAVEDDEFAULTCOPYRIGHTOWNER DEFAULTCOPYRIGHTOWNER)) + (CL:UNWIND-PROTECT + (PROG (DBFILE DBFN DBROOTFN FLCPR (FL (NAMEFIELD 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) + (* ;; + "Set the COPYRIGHT to NONE (I.e., never mention it again.)") - (/PUT DBFN '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 DBFN '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 ',FILE '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 ',FILE '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] (* ; - "Take future note of the databae on a user call") - (RETURN DBFILE))))]) + (/PUT FL 'DATABASE 'YES] (* ; + "Take future note of the database on a user call") + (RETURN DBFILE)))) + (SETQ COPYRIGHTFLG SAVEDCOPYRIGHTFLG) + (SETQ DEFAULTCOPYRIGHTOWNER SAVEDDEFAULTCOPYRIGHTOWNER)))]) (LOADDB [LAMBDA (FILE ASKFLAG) (* ; "Edited 24-Oct-2021 17:44 by rmk:") @@ -370,7 +377,7 @@ Copyright (c) 1986, 1990-1993, 2024 by Xerox Corporation. ) (PUTPROPS DATABASEFNS COPYRIGHT ("Xerox Corporation" 1986 1990 1991 1992 1993 2024)) (DECLARE%: DONTCOPY - (FILEMAP (NIL (1778 6803 (DBFILE 1788 . 3433) (DBFILE1 3435 . 4945) (DBFILE2 4947 . 6169) (LOAD 6171 - . 6401) (LOADFROM 6403 . 6591) (MAKEFILE 6593 . 6801)) (6859 17017 (DUMPDB 6869 . 11052) (LOADDB -11054 . 15929) (MAKEDB 15931 . 17015))))) + (FILEMAP (NIL (1768 6793 (DBFILE 1778 . 3423) (DBFILE1 3425 . 4935) (DBFILE2 4937 . 6159) (LOAD 6161 + . 6391) (LOADFROM 6393 . 6581) (MAKEFILE 6583 . 6791)) (6849 17838 (DUMPDB 6859 . 11873) (LOADDB +11875 . 16750) (MAKEDB 16752 . 17836))))) STOP diff --git a/library/DATABASEFNS.LCOM b/library/DATABASEFNS.LCOM index 44c2991c81d6c2be9ee1ab226676b85859036f24..aa806c4cebcde11dab16bba5c1a9ae89e5cae494 100644 GIT binary patch delta 1741 zcmZux&2QsW5VuoWiBv?{Y`fL2&@y;;MN*MsKR+k7g;1TuN!)efZ0sadEK<8o*;Hav zpyj{;MR0-33WVVVNC?Eou^+2F?4^GJXa0=}i6av8o)f!88!68-^P4v_Z@&IA{(ST6 z!EGWJ>$?w%L?#r7YEsSAN)qIyo&852?7hD`g#9suzlhp|7C=%+qAV+>Oij5g!Gn)> zW9^;M_W0rM!5tIQwO*@JtH9nEqO6=R$bd__d3P8*KPT$P=^vQ&q$P^)Ac%aw}G@Cc3!?YDS-Iz!ki%XUli~c zomVRJ4;hynBTn{TT43ULhFtgl7GpSY{>`!Qc#!@1SomVd1!)GIelo~L?D-$l@5#!U zd%^0B#R*e9>dav2teM<@_r!>lTjJ=(B3FDZa`!#|tZ>m%LZ1z?Tz2N1dRq)US#I)g zO5_23JKD({l?Rz05+{qo(XBoHoU?woHGlnuQFf3CmvgT#onE^7WbX50;is^dgVf#q z@Uz_2@T=TB`-}bXyIgVdY>@eJgWK8Tu8v-bd~EQzr?29Xa=}Jc$ZN6&Z*+PAP+gxA zWs3E2+9)dNz&fmLwQQi8j$%6qHfwer)UpA7;302Su%>ERg@)Y5aSC9nL%wYs1htm#=&Rf7N~jHMQXMStj7#T2xB#!u6UiQs&1CQwV4 z6>zCsx}cQ!6I6VsZ}sh3g-w?#t6WM9HF+4JO8C#x>Krbn@YC$dL@_8-z0PLWX*2_N zOVJI$5?ehtKpMlp1eVJQSe6qSBaRh8q4Gse#f`vPNKr8HUYijyK53#CEI`}t+g-ri za0T>|SS!s?O-rQweHv7}+9nVK@UriCZNR+5B~%Qs-wy0H1F+0Mi30h2RK7U(3xxux zdO7@ixiQf}g3i)q&MblY)3m}8?o$_mIZK{`Lv z<0^Rv6fAhO<=9GO4htZ>l@f&1`tZaYs_W;!uk%@bQsnDl>mIXsB_;9!Gmg2% L>!;qeFBkp;3A2pb delta 1524 zcmZuxO=v4s6mD9q7_l_rwU4J#4xN+sVcapS~&SLI4=R5!Rocr6$e^_61 z$HXet5BE!otWY4jtynhIBq&G+NB7%1CLFV5-c;7Jyt z1uD3#?sWXP7PfkAudyA6-GH?bQD7nBCUr29Ki9Y3M#B6*VqNc~2$_E$U0GVL^uK?Q z`KRAkE9XB>D~~PV_tVPf4>EtHbo%eEck?;An&fgDJC!F^xzd|EclmKX`J}sc_EBFj zSuUBp+g(f9^B-pC+0AKFD2U(S$;Y|gX*C(=Hg3Ol_CksUnK^JP_57tcUcWDnpSx>s zOub2v{GQu`-Jrtt5Z1+*%o|I|<}pym7XDheuk@2qj+D(znT- zJY<^5XZfv6CHXF28b5Tt@rCg)b@fc@*B41nQ$|D*0)Ks}pvel{ZgpayrZyuCetlkm zB3%PMnSs+}Ks6o3ERK74kDwX`L~)3`Q}r3L1R5+J^J@o{5{Ow8r;uXl91@6P%80bl zJ1B-Kq7YE@G#*l#x_~KW(`L=oOwlhnBp6y`Of+lZnW#Dn$5_XuaJ&$w_6nasQ3C34 z8rRj2Vo+t^(z?fd7l?`FV9|{h?iIBR=&=Z>rNDdzfEqY_^M#*#q^be0cET9jqoVGZ zZ}dzDD3RxwtSu6yvJ5q+4XUNhx~y6phXt0`A`m0sl)fg2YF zgo+YW*@DQ~Wp0(PmMRk=RV=co1r#bLk8C`T51%>TE+AYXT~}-ky`c3=D+xrS7Yho6 zQVfNYLKF*vFyO=$98(I|F0MS0^;7|))aI{242C(wbqdwc?SW%rbJjE>-)4@U