From 6eeccb40cb26f5ac3fb947926075d56fbd091b66 Mon Sep 17 00:00:00 2001 From: Matt Heffron Date: Tue, 6 Feb 2024 20:49:51 -0800 Subject: [PATCH] DUMPDB annoyingly always asked COPYRIGHT owner when dumping DB (unless COPYRIGHTFLG suppressed). I added DEFAULTDATABASECOPYRIGHTOWNER (INITVARS to NIL; to preserve current behavior). If it is EQ to NEVER, then the COPYRIGHT property on the file.DATABASE is set to (NONE) to forever suppress asking about copyright. If any other non-NIL value, then COPYRIGHTFLG is bound to 'DEFAULT, and DEFAULTCOPYRIGHTOWNER is bound to the value of DEFAULTDATABASECOPYRIGHTOWNER. --- library/DATABASEFNS | 57 ++++++++++++++++++++++++--------------- library/DATABASEFNS.LCOM | Bin 6853 -> 7218 bytes 2 files changed, 36 insertions(+), 21 deletions(-) diff --git a/library/DATABASEFNS b/library/DATABASEFNS index e40098d7..436c18d7 100644 --- a/library/DATABASEFNS +++ b/library/DATABASEFNS @@ -1,14 +1,17 @@ (DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10) -(FILECREATED "27-Oct-2021 10:55:18" {DSK}larry>medley>library>DATABASEFNS.;7 16051 +(FILECREATED " 6-Feb-2024 20:46:33" {DSK}e>Interlisp>medley>library>DATABASEFNS.;4 16903 - changes to%: (FNS DUMPDB) + :EDIT-BY "mth" - previous date%: "24-Oct-2021 20:18:51" {DSK}larry>medley>library>DATABASEFNS.;6) + :CHANGES-TO (FNS DUMPDB) + (VARS DATABASEFNSCOMS) + + :PREVIOUS-DATE "27-Oct-2021 10:55:18" {DSK}e>Interlisp>medley>library>DATABASEFNS.;1) (* ; " -Copyright (c) 1986, 1990-1993 by Xerox Corporation. +Copyright (c) 1986, 1990-1993, 2024 by Xerox Corporation. ") (PRETTYCOMPRINT DATABASEFNSCOMS) @@ -31,7 +34,8 @@ Copyright (c) 1986, 1990-1993 by Xerox Corporation. (INITVARS (LOADDBFLG 'ASK) (SAVEDBFLG 'ASK)) (ADDVARS (MAKEFILEFORMS (MAKEDB FILE))) - (INITVARS (MSFILETABLE)) + (INITVARS (MSFILETABLE) + (DEFAULTDATABASECOPYRIGHTOWNER)) (* ; "To permit MSHASH interface") (LOCALVARS . T) (BLOCKS (LOADDB LOADDB DBFILE DBFILE1 DBFILE2 (NOLINKFNS . T))) @@ -161,26 +165,35 @@ Copyright (c) 1986, 1990-1993 by Xerox Corporation. (DEFINEQ (DUMPDB - [LAMBDA (FILE PROPFLG) (* ; - "Edited 27-Oct-2021 10:51 by larry") - (* ; - "Edited 24-Oct-2021 16:24 by rmk:") + [LAMBDA (FILE PROPFLG) (* ; "Edited 6-Feb-2024 20:46 by mth") + (* ; "Edited 27-Oct-2021 10:51 by larry") + (* ; "Edited 24-Oct-2021 16:24 by rmk:") (* ;; "Dumps a Masterscope database for functions in FILE. Checks the DATABASE property if PROPFLG=T which is how the MAKEFILE advice calls it. A user-level call would default PROPFLG to NIL.") - (* ;; - "The FILE check is because MAKEFILE returns a list when it doesn't understand the options") + (* ;; "The FILE check is because MAKEFILE returns a list when it doesn't understand the options") - (DECLARE (GLOBALVARS MSFILETABLE SAVEDBFLG)) + (DECLARE (GLOBALVARS MSFILETABLE SAVEDBFLG) + (USEDFREE DEFAULTDATABASECOPYRIGHTOWNER COPYRIGHTFLG DEFAULTCOPYRIGHTOWNER)) (CL:WHEN (AND FILE (OR (LITATOM FILE) (STRINGP FILE))) - (PROG (DBFILE (FL (NAMEFIELD FILE)) - (FNS (FILEFNSLST FILE))) + (PROG (DBFILE DBFN DBCPR (FL (NAMEFIELD FILE)) + (FNS (FILEFNSLST FILE)) + (COPYRIGHTFLG COPYRIGHTFLG) + (DEFAULTCOPYRIGHTOWNER DEFAULTCOPYRIGHTOWNER)) + (SETQ DBFN (PACKFILENAME 'EXTENSION 'DATABASE 'VERSION NIL 'BODY FILE)) + [COND + ([NULL (SETQ DBCPR (GETPROP DBFN 'COPYRIGHT] + (COND + [(EQ DEFAULTDATABASECOPYRIGHTOWNER 'NEVER) + (/PUT DBFN 'COPYRIGHT (LIST 'NONE] + (DEFAULTDATABASECOPYRIGHTOWNER (SETQ COPYRIGHTFLG 'DEFAULT) + (SETQ DEFAULTCOPYRIGHTOWNER DEFAULTDATABASECOPYRIGHTOWNER] (COND (FNS) ((AND MSFILETABLE (TESTTABLE FL (CADR MSFILETABLE))) (* ; - "Always dump if this is a known file") + "Always dump if this is a known file") (SETQ PROPFLG NIL)) (T (COND (PROPFLG (/REMPROP FL 'DATABASE)) @@ -203,9 +216,9 @@ Copyright (c) 1986, 1990-1993 by Xerox Corporation. (PROPFLG (PRINT (FULLNAME DBFILE) T)) (T (/PUT FL 'DATABASEFILENAME DBFILE) (* ; - "Remember that we have this file valid already.") + "Remember that we have this file valid already.") (/PUT FL 'DATABASE 'YES] (* ; - "Take future note of the databae on a user call") + "Take future note of the databae on a user call") (RETURN DBFILE))))]) (LOADDB @@ -321,6 +334,8 @@ Copyright (c) 1986, 1990-1993 by Xerox Corporation. (RPAQ? MSFILETABLE ) +(RPAQ? DEFAULTDATABASECOPYRIGHTOWNER ) + (* ; "To permit MSHASH interface") @@ -337,9 +352,9 @@ Copyright (c) 1986, 1990-1993 by Xerox Corporation. (RESETSAVE DWIMIFYCOMPFLG T) ) -(PUTPROPS DATABASEFNS COPYRIGHT ("Xerox Corporation" 1986 1990 1991 1992 1993)) +(PUTPROPS DATABASEFNS COPYRIGHT ("Xerox Corporation" 1986 1990 1991 1992 1993 2024)) (DECLARE%: DONTCOPY - (FILEMAP (NIL (1679 6704 (DBFILE 1689 . 3334) (DBFILE1 3336 . 4846) (DBFILE2 4848 . 6070) (LOAD 6072 - . 6302) (LOADFROM 6304 . 6492) (MAKEFILE 6494 . 6702)) (6760 15499 (DUMPDB 6770 . 9534) (LOADDB 9536 - . 14411) (MAKEDB 14413 . 15497))))) + (FILEMAP (NIL (1802 6827 (DBFILE 1812 . 3457) (DBFILE1 3459 . 4969) (DBFILE2 4971 . 6193) (LOAD 6195 + . 6425) (LOADFROM 6427 . 6615) (MAKEFILE 6617 . 6825)) (6883 16302 (DUMPDB 6893 . 10337) (LOADDB +10339 . 15214) (MAKEDB 15216 . 16300))))) STOP diff --git a/library/DATABASEFNS.LCOM b/library/DATABASEFNS.LCOM index 41d456185a5ba778157c3121b980c5fb3117da4c..1108c0863e09e9b1a067192c0ee7fccfed9f76b9 100644 GIT binary patch delta 1318 zcmaJ=O;6Nd5VoQRD=}&y5u$NYVzNtIc)z;+2vNGb??Pd>Eo~RwctUmqB(fOTn=vGw zJd*SesCN&1T=c@pf1(#p{sgD{QI>?z!<(6T-p)Mp%sapI6Z7cR0u&3?_S*s@OaLRc zDB7HBkkdBzcHi&3Yqwyp0~)9wD$(l4h22i~Mf-)@>9+UZ?Hs&MeC5fZ$b-gMVP&J! zPeQ0oxXpD9-tM=vESuXKovrr4GaJ-OqaIXBu!DK4jam&xf1aD0)1bA{#kyA|HMG2% ztGYE=4y6;z3No9$lK(Yyffg;o!Il*_E|i)oXuI8Q4eau=<1NXk5c`m;dJ*(#<{`K4 zgy=c3Q*t7SNZGGPd9Z^}uDgCCDj+10tx@ndyQu^eD6w_jrsfs8-Ohwl=;?3e%e@e) zAfO_vPNNnNtCanq8M;f$vH!}GVIGtpx0D+<7hB(sm9tihFaG;}zIf*berIE!j+L){ zyMI2=#u8=x@$)yWt@MJL9;XoZy?-Z@=c~PV@7SKco5JU(XZKf>L%|K04;nEDMg|5c zLJ+zhh6sUlSe{dtz%7bl8OKee4V>x_IOWxJEIpW+Iz+LL7o1W}0y8XFl5r6F0We`f zETedU5RoC&Y?}y$SPrO}=65|5vS?)%&0w9wd?@R^jFgL!jFb+TkJKz0qx6!W4`;Dc z22B}ZqeeDZ5ERESobs?2ZZKGD_&8vWd3sM`a0R%~hmasyADrt@c0%Bs45Z^s2mGCw zQ1UBHG}s}m%P?|%512JVfLRRW>sWey$Pkc9n!c_GSkZ)fl==hdisZ5{*kvEfU%Jow z9W!b`bm*+hN~u~~!iBebLQu=fdIu`Z5eFq2O+=}6*~eA#d{2U9LiTFGG{KYDBw!O4 zQRLi{U{)8I0{9??qJt0@{o|ek*F{1mCdW7<$?`^?B;=Oc*$8FRx#01*WC_$DwcVZddN&cEIPsw>7&Y^@mCoUZL06u{eXHKk>G)+Z)ux9qny!U48{UX2f4-ey?##LA_H~Tw# zz3pxX`nzDlYd2hdb9bx1)4jjFF&Mmx{~9+AMIJIHip9p}!6Fi*Kx7elkunpW47yW- z&8>~yr``QqMQ~g7rdx)dW~{b64`zFpmX=KDY#eCC|43<}$hn!%EL3Zrsszf3lnZ8J z^wL?z9t)s0;S?syaM0J{y4w#Y7V@w+=)UarU+j-0HEN=DG6#|(l|@d^p4+g8*HRxZ zk~|pC({ppFQs>i=vEAvg(x1=YN*Ctz^ELhM$Y_t_@q7MqY8cEvFbS2;kRwCu;T#(bbmOoX`#}iYFL+Cr} z$}LyD6`)Lv7C})=X9r=Q#Ck!qG?ti6_3sQQF<#4N(`d=Km#wA<8y;nYb7_6C;@i1O c{496V$i(k+rT9ngcl_(RcRrub_%$!{53nWlg8%>k