github.com/Interlisp.medley
1
0
Fork 0
mirror of synced 2026-05-15 03:11:43 +00:00
Code Issues Projects Releases Wiki Activity

Adjust Ron's fix in DUMPDB for non-uppercase FILE.

Browse Source
This commit is contained in:
Matt Heffron
2026-05-12 15:36:22 -07:00
parent 683ee45f57
commit 8365cac123
2 changed files with 58 additions and 56 deletions
Download Patch File Download Diff File Expand all files Collapse all files

114
library/DATABASEFNS
View File

@@ -1,12 +1,13 @@
(DEFINE-FILE-INFO :PACKAGE "INTERLISP" :READTABLE "INTERLISP" :BASE 10)
(FILECREATED "12-May-2026 12:45:18" {MEDLEY}<library>DATABASEFNS.;13 19361
(FILECREATED "12-May-2026 15:33:42" {DSK}<home>matt>Interlisp>medley>library>DATABASEFNS.;5 19557
:EDIT-BY rmk
:EDIT-BY "mth"
:CHANGES-TO (FNS DUMPDB MAKEDB)
:CHANGES-TO (FNS DUMPDB)
:PREVIOUS-DATE "11-May-2026 14:41:08" {MEDLEY}<library>DATABASEFNS.;11)
:PREVIOUS-DATE "12-May-2026 12:45:18" {DSK}<home>matt>Interlisp>medley>library>DATABASEFNS.;4
)
(PRETTYCOMPRINT DATABASEFNSCOMS)
@@ -161,7 +162,8 @@
(DEFINEQ
(DUMPDB
[LAMBDA (FILE PROPFLG) (* ; "Edited 12-May-2026 12:45 by rmk")
[LAMBDA (FILE PROPFLG) (* ; "Edited 12-May-2026 15:31 by mth")
(* ; "Edited 12-May-2026 12:45 by rmk")
(* ; "Edited 11-May-2026 14:41 by mth")
(* ; "Edited 8-May-2026 16:18 by mth")
(* ; "Edited 2-May-2026 17:32 by mth")
@@ -186,67 +188,67 @@
(LET ((SAVEDCOPYRIGHTFLG COPYRIGHTFLG)
(SAVEDDEFAULTCOPYRIGHTOWNER DEFAULTCOPYRIGHTOWNER))
(CL:UNWIND-PROTECT
(PROG (DBFILE DBFN DBROOTFN FLCPR (FL (ROOTFILENAME FILE))
(FNS (FILEFNSLST FILE)))
(SETQ DBFN (PACKFILENAME 'EXTENSION 'DATABASE 'VERSION NIL 'BODY FILE))
(SETQ DBROOTFN (ROOTFILENAME DBFN))
(CL:UNLESS (OR (EQ COPYRIGHTFLG 'NEVER)
(NULL DEFAULTDATABASECOPYRIGHTOWNER)
(GETPROP DBROOTFN 'COPYRIGHT))
(SELECTQ DEFAULTDATABASECOPYRIGHTOWNER
((NONE NEVER)
(* ;;
(PROG* (DBFILE DBFN DBROOTFN FLCPR (FL (ROOTFILENAME FILE))
(FNS (FILEFNSLST FL)))
(SETQ DBFN (PACKFILENAME 'EXTENSION 'DATABASE 'VERSION NIL 'BODY FILE))
(SETQ DBROOTFN (ROOTFILENAME DBFN))
(CL:UNLESS (OR (EQ COPYRIGHTFLG 'NEVER)
(NULL DEFAULTDATABASECOPYRIGHTOWNER)
(GETPROP DBROOTFN 'COPYRIGHT))
(SELECTQ DEFAULTDATABASECOPYRIGHTOWNER
((NONE NEVER)
(* ;;
 "Set the COPYRIGHT to NONE (I.e., never mention it again.)")
(/PUT DBROOTFN 'COPYRIGHT (LIST 'NONE)))
(SAME
(* ;;
(/PUT DBROOTFN '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 DBROOTFN 'COPYRIGHT (LIST (CAR FLCPR)))))
(DEFAULT
(* ;; "Use the general default for copyright")
(CL:WHEN (SETQ FLCPR (GETPROP FL 'COPYRIGHT))
(/PUT DBROOTFN 'COPYRIGHT (LIST (CAR FLCPR)))))
(DEFAULT
(* ;; "Use the general default for copyright")
(SETQ COPYRIGHTFLG 'DEFAULT))
(PROGN (SETQ COPYRIGHTFLG 'DEFAULT)
(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)))
(SETQ DEFAULTCOPYRIGHTOWNER DEFAULTDATABASECOPYRIGHTOWNER))))
(COND
(FNS)
((AND MSFILETABLE (TESTTABLE FL (CADR MSFILETABLE)))
(* ;
 "Always dump if this is a known file")
(SETQ PROPFLG NIL))
(T (COND
(PROPFLG (/REMPROP FL 'DATABASE))
(T (printout T T FILE " has no functions." T)))
(RETURN)))
(CL:WHEN [OR (NULL PROPFLG)
(EQ (GETPROP FL 'DATABASE)
'YES)
(EQ SAVEDBFLG 'YES)
(AND MSFILETABLE (TESTTABLE FL (CADR MSFILETABLE]
(CL:WHEN MSFILETABLE
[STORETABLE FL MSFILETABLE (CAR (GETPROP FL 'FILEDATES])
[SETQ DBFILE
(PRETTYDEF NIL DBFN
`((P (PROGN (PRIN1 "Use LOADDB to load database files!" T)
(ERROR!)))
(E [PRINT (CAR (GETPROP ',FL 'FILEDATES]
(DUMPDATABASE ',FNS]
[COND
(PROPFLG (PRINT (FULLNAME DBFILE)
T))
(T (/PUT FL 'DATABASEFILENAME DBFILE)
(SETQ PROPFLG NIL))
(T (COND
(PROPFLG (/REMPROP FL 'DATABASE))
(T (printout T T FILE " has no functions." T)))
(RETURN)))
(CL:WHEN [OR (NULL PROPFLG)
(EQ (GETPROP FL 'DATABASE)
'YES)
(EQ SAVEDBFLG 'YES)
(AND MSFILETABLE (TESTTABLE FL (CADR MSFILETABLE]
(CL:WHEN MSFILETABLE
[STORETABLE FL MSFILETABLE (CAR (GETPROP FL 'FILEDATES])
[SETQ DBFILE
(PRETTYDEF NIL DBFN
`((P (PROGN (PRIN1 "Use LOADDB to load database files!" T)
(ERROR!)))
(E [PRINT (CAR (GETPROP ',FL 'FILEDATES]
(DUMPDATABASE ',FNS]
[COND
(PROPFLG (PRINT (FULLNAME DBFILE)
T))
(T (/PUT FL 'DATABASEFILENAME DBFILE)
(* ;
 "Remember that we have this file valid already.")
(/PUT FL 'DATABASE 'YES] (* ;
(/PUT FL 'DATABASE 'YES] (* ;
 "Take future note of the database on a user call")
(RETURN DBFILE))))
(RETURN DBFILE))))
(SETQ COPYRIGHTFLG SAVEDCOPYRIGHTFLG)
(SETQ DEFAULTCOPYRIGHTOWNER SAVEDDEFAULTCOPYRIGHTOWNER)))])
@@ -386,7 +388,7 @@
(RESETSAVE DWIMIFYCOMPFLG T)
)
(DECLARE%: DONTCOPY
(FILEMAP (NIL (1666 6814 (DBFILE 1676 . 3444) (DBFILE1 3446 . 4956) (DBFILE2 4958 . 6180) (LOAD 6182
. 6412) (LOADFROM 6414 . 6602) (MAKEFILE 6604 . 6812)) (6870 18839 (DUMPDB 6880 . 12478) (LOADDB
12480 . 17551) (MAKEDB 17553 . 18837)))))
(FILEMAP (NIL (1708 6856 (DBFILE 1718 . 3486) (DBFILE1 3488 . 4998) (DBFILE2 5000 . 6222) (LOAD 6224
. 6454) (LOADFROM 6456 . 6644) (MAKEFILE 6646 . 6854)) (6912 19035 (DUMPDB 6922 . 12674) (LOADDB
12676 . 17747) (MAKEDB 17749 . 19033)))))
STOP

BIN
library/DATABASEFNS.LCOM
View File

Binary file not shown.