github.com/Interlisp.medley
1
0
Fork 0
mirror of synced 2026-04-25 20:01:51 +00:00
Code Issues Projects Releases Wiki Activity

DUMPDB annoyingly always asked COPYRIGHT owner when dumping DB (unless COPYRIGHTFLG suppressed).

Browse Source 
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.
This commit is contained in:
Matt Heffron
2024-02-06 20:49:51 -08:00
parent 2647d98f8f
commit 6eeccb40cb
2 changed files with 36 additions and 21 deletions
Download Patch File Download Diff File Expand all files Collapse all files

57
library/DATABASEFNS
View File

@@ -1,14 +1,17 @@
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10) (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 " 6-Feb-2024 20:46:33" {DSK}<mnt>e>Interlisp>medley>library>DATABASEFNS.;4 16903
changes to%: (FNS DUMPDB) :EDIT-BY "mth"
previous date%: "24-Oct-2021 20:18:51" {DSK}<home>larry>medley>library>DATABASEFNS.;6) :CHANGES-TO (FNS DUMPDB)
(VARS DATABASEFNSCOMS)
: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) (PRETTYCOMPRINT DATABASEFNSCOMS)
@@ -31,7 +34,8 @@ Copyright (c) 1986, 1990-1993 by Xerox Corporation.
(INITVARS (LOADDBFLG 'ASK) (INITVARS (LOADDBFLG 'ASK)
(SAVEDBFLG 'ASK)) (SAVEDBFLG 'ASK))
(ADDVARS (MAKEFILEFORMS (MAKEDB FILE))) (ADDVARS (MAKEFILEFORMS (MAKEDB FILE)))
(INITVARS (MSFILETABLE)) (INITVARS (MSFILETABLE)
(DEFAULTDATABASECOPYRIGHTOWNER))
(* ; "To permit MSHASH interface") (* ; "To permit MSHASH interface")
(LOCALVARS . T) (LOCALVARS . T)
(BLOCKS (LOADDB LOADDB DBFILE DBFILE1 DBFILE2 (NOLINKFNS . T))) (BLOCKS (LOADDB LOADDB DBFILE DBFILE1 DBFILE2 (NOLINKFNS . T)))
@@ -161,26 +165,35 @@ Copyright (c) 1986, 1990-1993 by Xerox Corporation.
(DEFINEQ (DEFINEQ
(DUMPDB (DUMPDB
[LAMBDA (FILE PROPFLG) (* ; [LAMBDA (FILE PROPFLG) (* ; "Edited 6-Feb-2024 20:46 by mth")
 "Edited 27-Oct-2021 10:51 by larry") (* ; "Edited 27-Oct-2021 10:51 by larry")
(* ; (* ; "Edited 24-Oct-2021 16:24 by rmk:")
 "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.") (* ;; "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) (CL:WHEN (AND FILE (OR (LITATOM FILE)
(STRINGP FILE))) (STRINGP FILE)))
(PROG (DBFILE (FL (NAMEFIELD FILE)) (PROG (DBFILE DBFN DBCPR (FL (NAMEFIELD FILE))
(FNS (FILEFNSLST 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 (COND
(FNS) (FNS)
((AND MSFILETABLE (TESTTABLE FL (CADR MSFILETABLE))) ((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)) (SETQ PROPFLG NIL))
(T (COND (T (COND
(PROPFLG (/REMPROP FL 'DATABASE)) (PROPFLG (/REMPROP FL 'DATABASE))
@@ -203,9 +216,9 @@ Copyright (c) 1986, 1990-1993 by Xerox Corporation.
(PROPFLG (PRINT (FULLNAME DBFILE) (PROPFLG (PRINT (FULLNAME DBFILE)
T)) T))
(T (/PUT FL 'DATABASEFILENAME DBFILE) (* ; (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] (* ; (/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))))]) (RETURN DBFILE))))])
(LOADDB (LOADDB
@@ -321,6 +334,8 @@ Copyright (c) 1986, 1990-1993 by Xerox Corporation.
(RPAQ? MSFILETABLE ) (RPAQ? MSFILETABLE )
(RPAQ? DEFAULTDATABASECOPYRIGHTOWNER )
(* ; "To permit MSHASH interface") (* ; "To permit MSHASH interface")
@@ -337,9 +352,9 @@ Copyright (c) 1986, 1990-1993 by Xerox Corporation.
(RESETSAVE DWIMIFYCOMPFLG T) (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 (DECLARE%: DONTCOPY
(FILEMAP (NIL (1679 6704 (DBFILE 1689 . 3334) (DBFILE1 3336 . 4846) (DBFILE2 4848 . 6070) (LOAD 6072 (FILEMAP (NIL (1802 6827 (DBFILE 1812 . 3457) (DBFILE1 3459 . 4969) (DBFILE2 4971 . 6193) (LOAD 6195
. 6302) (LOADFROM 6304 . 6492) (MAKEFILE 6494 . 6702)) (6760 15499 (DUMPDB 6770 . 9534) (LOADDB 9536 . 6425) (LOADFROM 6427 . 6615) (MAKEFILE 6617 . 6825)) (6883 16302 (DUMPDB 6893 . 10337) (LOADDB
. 14411) (MAKEDB 14413 . 15497))))) 10339 . 15214) (MAKEDB 15216 . 16300)))))
STOP STOP

BIN
library/DATABASEFNS.LCOM
View File

Binary file not shown.