Merge pull request #1532 from Interlisp/mth4--Add-default-to-suppress-DUMPDB-asking-copyright-owner

DUMPDB annoyingly always asked COPYRIGHT owner when dumping DB
Make macros that expand to fetch or replace note the record fields used. (#1548 )
2026-04-17 09:10:55 +00:00 · 2024-02-20 17:24:19 -08:00 · 2024-02-20 15:16:55 -08:00 · 2024-02-19 16:34:26 -08:00 · 2024-02-07 18:47:37 -08:00 · 2024-02-06 21:31:30 -08:00
4 changed files with 391 additions and 376 deletions
--- 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}<home>larry>medley>library>DATABASEFNS.;7 16051  
+(FILECREATED "19-Feb-2024 16:29:44" {LIB}DATABASEFNS.;15 17624  

-      changes to%:  (FNS DUMPDB)
+      :EDIT-BY "mth"

-      previous date%: "24-Oct-2021 20:18:51" {DSK}<home>larry>medley>library>DATABASEFNS.;6)
+      :CHANGES-TO (VARS DATABASEFNSCOMS)
+                  (FNS DUMPDB)
+
+      :PREVIOUS-DATE "27-Oct-2021 10:55:18" {DSK}<mnt>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 'NEVER))
                                                             (* ; "To permit MSHASH interface")
        (LOCALVARS . T)
        (BLOCKS (LOADDB LOADDB DBFILE DBFILE1 DBFILE2 (NOLINKFNS . T)))
@@ -161,26 +165,52 @@ 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  7-Feb-2024 18:26 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)
+           (SPECVARS DEFAULTDATABASECOPYRIGHTOWNER COPYRIGHTFLG DEFAULTCOPYRIGHTOWNER))
    (CL:WHEN (AND FILE (OR (LITATOM FILE)
                           (STRINGP FILE)))
-        (PROG (DBFILE (FL (NAMEFIELD FILE))
-                     (FNS (FILEFNSLST 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.)")
+
+                           (/PUT DBFN '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")
+
+                               (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)))
                                                             (* ; 
-                                                           "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))
@@ -193,8 +223,7 @@ Copyright (c) 1986, 1990-1993 by Xerox Corporation.
                           (AND MSFILETABLE (TESTTABLE FL (CADR MSFILETABLE]
                  (CL:WHEN MSFILETABLE
                      [STORETABLE FL MSFILETABLE (CAR (GETPROP FL 'FILEDATES])
-                  [SETQ DBFILE (PRETTYDEF NIL (PACKFILENAME 'EXTENSION 'DATABASE 'VERSION NIL
-                                                     'BODY FILE)
+                  [SETQ DBFILE (PRETTYDEF NIL DBFN
                                      `((P (PROGN (PRIN1 "Use LOADDB to load database files!" T)
                                                  (ERROR!)))
                                        (E [PRINT (CAR (GETPROP ',FILE 'FILEDATES]
@@ -203,9 +232,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 +350,8 @@ Copyright (c) 1986, 1990-1993 by Xerox Corporation.

 (RPAQ? MSFILETABLE )

+(RPAQ? DEFAULTDATABASECOPYRIGHTOWNER 'NEVER)
+


 (* ; "To permit MSHASH interface")
@@ -337,9 +368,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 (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)))))
 STOP
--- a/library/DATABASEFNS.LCOM
+++ b/library/DATABASEFNS.LCOM
--- a/library/MSANALYZE
+++ b/library/MSANALYZE
--- a/library/MSANALYZE.DFASL
+++ b/library/MSANALYZE.DFASL
Author	SHA1	Message	Date
Matt Heffron	cedc8d1e11	Merge pull request #1532 from Interlisp/mth4--Add-default-to-suppress-DUMPDB-asking-copyright-owner DUMPDB annoyingly always asked COPYRIGHT owner when dumping DB	2024-02-20 17:24:19 -08:00
Larry Masinter	496fa408c2	Make macros that expand to fetch or replace note the record fields used. (#1548 )	2024-02-20 15:16:55 -08:00
Matt Heffron	60e390789c	Change the default value for DEFAULTDATABASECOPYRIGHTOWNER to 'NEVER. This is so dumping the database never asks about copyright. Copyright on these database files is pretty nonsensical.	2024-02-19 16:34:26 -08:00
Matt Heffron	4dec18527e	Made this "smarter": If COPYRIGHTFLG is NEVER or DEFAULTDATABASECOPYRIGHTOWNER is NIL or the .DATABASE file already has a COPYRIGHT property Then No need to do anything special (it already shouldn't ask) Else If DEFAULTDATABASECOPYRIGHTOWNER is NONE or NEVER Then Set the COPYRIGHT to NONE (I.e., never mention it again.) is SAME Then Same as the source file. If it doesn't have one, then just normal handling is DEFAULT Then Use the general default for copyright: DEFAULTCOPYRIGHTOWNER Otherwise: Enable the general copyright defaulting. Hopefully, DEFAULTDATABASECOPYRIGHTOWNER is one of the COPYRIGHTOWNERS keys.	2024-02-07 18:47:37 -08:00
Matt Heffron	3ca4495c76	Added NONE in addition to NEVER as DEFAULTDATABASECOPYRIGHTOWNER to preset to (NONE). The change from USEDFREE to SPECVARS may be irrelevant. I thought that was the issue when using NONE as DEFAULTDATABASECOPYRIGHTOWNER didn't do as expected. The DEFAULTCOPYRIGHTOWNER must be one of the "real" entry keys on COPYRIGHTOWNERS.	2024-02-06 21:31:30 -08:00
Matt Heffron	6eeccb40cb	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.	2024-02-06 20:49:51 -08:00