github.com/Interlisp.medley
1
0
Fork 0
mirror of synced 2026-01-12 00:42:56 +00:00
Code Issues Projects Releases Wiki Activity

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

Browse Source 
DUMPDB annoyingly always asked COPYRIGHT owner when dumping DB
This commit is contained in:
Matt Heffron 2024-02-20 17:24:19 -08:00 committed by GitHub
commit cedc8d1e11
No known key found for this signature in database
GPG Key ID: B5690EEEBB952194
2 changed files with 54 additions and 23 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

77
library/DATABASEFNS
View File

@ -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

BIN
library/DATABASEFNS.LCOM
View File

Binary file not shown.