1
0
mirror of synced 2026-02-27 09:28:48 +00:00

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.
This commit is contained in:
Matt Heffron
2024-02-07 18:47:37 -08:00
parent 3ca4495c76
commit 4dec18527e
2 changed files with 31 additions and 15 deletions

View File

@@ -1,6 +1,6 @@
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
(FILECREATED " 6-Feb-2024 21:23:34" {DSK}<mnt>e>Interlisp>medley>library>DATABASEFNS.;6 16912
(FILECREATED " 7-Feb-2024 18:26:12" {DSK}<mnt>e>Interlisp>medley>library>DATABASEFNS.;13 17643
:EDIT-BY "mth"
@@ -165,7 +165,7 @@ Copyright (c) 1986, 1990-1993, 2024 by Xerox Corporation.
(DEFINEQ
(DUMPDB
[LAMBDA (FILE PROPFLG) (* ; "Edited 6-Feb-2024 21:23 by mth")
[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:")
@@ -177,18 +177,35 @@ Copyright (c) 1986, 1990-1993, 2024 by Xerox Corporation.
(SPECVARS DEFAULTDATABASECOPYRIGHTOWNER COPYRIGHTFLG DEFAULTCOPYRIGHTOWNER))
(CL:WHEN (AND FILE (OR (LITATOM FILE)
(STRINGP FILE)))
(PROG (DBFILE DBFN DBCPR (FL (NAMEFIELD FILE))
(PROG (DBFILE DBFN FLCPR (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
[(MEMQ DEFAULTDATABASECOPYRIGHTOWNER '(NONE NEVER))
(/PUT DBFN 'COPYRIGHT (LIST 'NONE]
(DEFAULTDATABASECOPYRIGHTOWNER (SETQ COPYRIGHTFLG 'DEFAULT)
(SETQ DEFAULTCOPYRIGHTOWNER DEFAULTDATABASECOPYRIGHTOWNER]
(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)))
@@ -206,8 +223,7 @@ Copyright (c) 1986, 1990-1993, 2024 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]
@@ -354,7 +370,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 (1802 6827 (DBFILE 1812 . 3457) (DBFILE1 3459 . 4969) (DBFILE2 4971 . 6193) (LOAD 6195
. 6425) (LOADFROM 6427 . 6615) (MAKEFILE 6617 . 6825)) (6883 16311 (DUMPDB 6893 . 10346) (LOADDB
10348 . 15223) (MAKEDB 15225 . 16309)))))
(FILEMAP (NIL (1803 6828 (DBFILE 1813 . 3458) (DBFILE1 3460 . 4970) (DBFILE2 4972 . 6194) (LOAD 6196
. 6426) (LOADFROM 6428 . 6616) (MAKEFILE 6618 . 6826)) (6884 17042 (DUMPDB 6894 . 11077) (LOADDB
11079 . 15954) (MAKEDB 15956 . 17040)))))
STOP

Binary file not shown.