1
0
mirror of synced 2026-02-26 17:13:17 +00:00

Restore package/reatable eval in define file fino (#415)

* Adds fields to reader-environment to remember evaluation forms for reprinting

For package and readtable, not for base or external format.  This restores previous package/readtable behavior.

ATBL also is now not radix 8

* THINFILES:  now can add extensions/file names to operate on

Not related to other things in this branch, just a useful extension to a simple lispusers package.  You can now add dribble as an extension, and things like I-NEW as a name, to make it easy to clean up the tmp/ loadup directory in particular.
This commit is contained in:
rmkaplan
2021-08-18 12:22:45 -07:00
committed by GitHub
parent 0d2c6622bb
commit af16fb48fa
8 changed files with 777 additions and 750 deletions

View File

@@ -1,23 +1,30 @@
(DEFINE-FILE-INFO READTABLE "INTERLISP" PACKAGE "INTERLISP")
(FILECREATED " 1-May-92 16:49:39" {DSK}<project>lfg>parser>THINFILES.;5 8005
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10 FORMAT XCCS)
(FILECREATED " 8-Aug-2021 15:05:08" 
{DSK}<Users>kaplan>Local>medley3.5>git-medley>lispusers>THINFILES.;3 8422
changes to%: (FNS FB.THINP)
changes to%: (VARS THINFILESCOMS)
(FNS FB.THINP)
previous date%: "28-Sep-89 16:38:11" {DSK}<project>lfg>parser>THINFILES.;2)
previous date%: " 8-Aug-2021 15:00:48"
{DSK}<Users>kaplan>Local>medley3.5>git-medley>lispusers>THINFILES.;2)
(* ; "
Copyright (c) 1987, 1988, 1989, 1992 by Xerox Corporation. All rights reserved.
Copyright (c) 1987-1989, 1992, 2021 by Xerox Corporation.
")
(PRETTYCOMPRINT THINFILESCOMS)
(RPAQQ THINFILESCOMS [(DECLARE%: EVAL@COMPILE DONTCOPY (FILES (LOADCOMP)
FILEBROWSER))
(FNS FB.THINCOMMAND FB.THINP)
(APPENDVARS (FB.MENU.ITEMS (Thin FB.THINCOMMAND
(RPAQQ THINFILESCOMS
[(DECLARE%: EVAL@COMPILE DONTCOPY (FILES (LOADCOMP)
FILEBROWSER))
(FNS FB.THINCOMMAND FB.THINP)
(INITVARS [THINEXTENSIONS (UNION *COMPILED-EXTENSIONS*
'(SYSOUT DCOM DATABASE LCOM DFASL MCOM MFASL DRIBBLE]
(THINNAMES NIL))
(APPENDVARS (FB.MENU.ITEMS (Thin FB.THINCOMMAND
"Delvers non-source files and removes all but the last source file of each day."
])
])
(DECLARE%: EVAL@COMPILE DONTCOPY
(FILESLOAD (LOADCOMP)
@@ -110,34 +117,41 @@ Copyright (c) 1987, 1988, 1989, 1992 by Xerox Corporation. All rights reserved.
(FB.THINP
[LAMBDA (FILENAME AGE DELTATIMESTAMP OLDESTVERSION? ONEDAY)
(* ; "Edited 1-May-92 16:49 by rmk:")
(LET [(EXT (U-CASE (FILENAMEFIELD FILENAME 'EXTENSION]
(COND
((OR (FMEMB EXT '(SYSOUT DCOM DATABASE LCOM DFASL MCOM MFASL))
(FMEMB EXT *COMPILED-EXTENSIONS*)) (* ;
(* ; "Edited 8-Aug-2021 15:05 by rmk:")
(COND
((FMEMB (U-CASE (FILENAMEFIELD FILENAME 'EXTENSION))
THINEXTENSIONS) (* ;
 "always delver files that can be reconstructed from the source.")
T)
(OLDESTVERSION? (* ;
T)
((AND THINNAMES (EQMEMB (U-CASE (FILENAMEFIELD FILENAME 'NAME))
THINNAMES))
T)
(OLDESTVERSION? (* ;
 "don't delete the oldest version of source files.")
NIL)
((ILESSP AGE ONEDAY) (* ;
NIL)
((ILESSP AGE ONEDAY) (* ;
 "don't delete anything written within 24 hours.")
NIL)
((ILESSP (ITIMES DELTATIMESTAMP 3)
ONEDAY) (* ;
NIL)
((ILESSP (ITIMES DELTATIMESTAMP 3)
ONEDAY) (* ;
 "delete anything that occurs on the same day as something else (except for the first day)")
T)
((ILESSP DELTATIMESTAMP (IQUOTIENT AGE 30))
T)
((ILESSP DELTATIMESTAMP (IQUOTIENT AGE 30))
(* ;; "after one month, delete things that are within a day of each other, after two months, within two days, etc.")
(* ;; "after one month, delete things that are within a day of each other, after two months, within two days, etc.")
T])
T])
)
(RPAQ? THINEXTENSIONS (UNION *COMPILED-EXTENSIONS*
'(SYSOUT DCOM DATABASE LCOM DFASL MCOM MFASL DRIBBLE)))
(RPAQ? THINNAMES NIL)
(APPENDTOVAR FB.MENU.ITEMS (Thin FB.THINCOMMAND
"Delvers non-source files and removes all but the last source file of each day."
))
(PUTPROPS THINFILES COPYRIGHT ("Xerox Corporation" 1987 1988 1989 1992))
(PUTPROPS THINFILES COPYRIGHT ("Xerox Corporation" 1987 1988 1989 1992 2021))
(DECLARE%: DONTCOPY
(FILEMAP (NIL (925 7713 (FB.THINCOMMAND 935 . 6343) (FB.THINP 6345 . 7711)))))
(FILEMAP (NIL (1159 7953 (FB.THINCOMMAND 1169 . 6577) (FB.THINP 6579 . 7951)))))
STOP

Binary file not shown.

File diff suppressed because it is too large Load Diff

Binary file not shown.

View File

@@ -1,11 +1,11 @@
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10 FORMAT XCCS)
(FILECREATED "30-Jul-2021 10:02:14" 
{DSK}<Users>kaplan>Local>medley3.5>git-medley>sources>BOOTSTRAP.;49 46093
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
(FILECREATED "17-Aug-2021 00:08:39" 
{DSK}<Users>kaplan>Local>medley3.5>git-medley>sources>BOOTSTRAP.;58 47657
changes to%: (FNS READ-READER-ENVIRONMENT)
changes to%: (FNS \DO-DEFINE-FILE-INFO PRINT-READER-ENVIRONMENT)
previous date%: "29-Jul-2021 20:31:41"
{DSK}<Users>kaplan>Local>medley3.5>git-medley>sources>BOOTSTRAP.;48)
previous date%: "15-Aug-2021 21:21:35"
{DSK}<Users>kaplan>Local>medley3.5>git-medley>sources>BOOTSTRAP.;57)
(* ; "
@@ -714,38 +714,58 @@ Copyright (c) 1983-1990, 1992, 2021 by Venue & Xerox Corporation.
(SET-READER-ENVIRONMENT (\DO-DEFINE-FILE-INFO NIL ARGS])
(\DO-DEFINE-FILE-INFO
[LAMBDA (STREAM ARGS) (* ; "Edited 17-Jul-2021 22:17 by rmk:")
[LAMBDA (STREAM ARGS) (* ; "Edited 17-Aug-2021 00:05 by rmk:")
(* ;;; "Processes the (DEFINE-FILE-INFO . ARGS) at the front of STREAM. This converts the ARGS list to a READER-ENVIRONMENT, and also imposes the external format on STREAM, if non-NIL.")
(* ;; "Include the :PACKAGE... for bootstrapping before in sysouts without an updated version of \LOAD-STREAM")
(LET (PACKAGE READTABLE BASE FORMAT VALUE)
(* ;;; "")
(* ;;; "The LISTP forms for package and readtable are to allow for those to be created if they don't already exist. If they do exist, the forms should not make any incompatiblel changes--those should be in a file command somewhere.")
(* ;;; "It doesn't make sense to produce an a new number base by evaluation in a particular runtime environment. I'm leaving this in for reading, for backward compatibility. Presumably future writing will instantiate to the particular number.")
(LET (PACKAGE READTABLE BASE FORMAT VALUE PACKAGEFORM READTABLEFORM)
[for TAIL on ARGS by (CDDR TAIL)
do (SETQ VALUE (CADR TAIL))
(SELECTQ (CAR TAIL)
((:PACKAGE %:PACKAGE)
(SETQ PACKAGE
(OR (if (LISTP VALUE)
then (LET ((P (EVAL VALUE)))
(if (TYPEP P 'PACKAGE)
then P
else (CL:FIND-PACKAGE P)))
else (CL:FIND-PACKAGE VALUE))
(ERROR "Can't find package for reader environment" VALUE))))
(SETQ PACKAGE (if (LISTP VALUE)
then (SETQ PACKAGEFORM VALUE)
(EVAL VALUE)
ELSE VALUE))
(IF (TYPEP PACKAGE 'PACKAGE)
ELSEIF (SETQ PACKAGE (CL:FIND-PACKAGE PACKAGE))
ELSE
(* ;; "Better message than just \DTEST")
(ERROR
"Can't find package for DEFINE-FILE-INFO reader environment"
VALUE)))
((:READTABLE %:READTABLE)
(SETQ READTABLE (OR (if (LISTP VALUE)
then (\DTEST (EVAL VALUE)
'READTABLEP)
else (FIND-READTABLE VALUE))
(ERROR
"Can't find read table for reader environment"
VALUE))))
((:BASE %:BASE)
(SETQ READTABLE (if (LISTP VALUE)
then (SETQ READTABLEFORM VALUE)
(EVAL VALUE)
ELSE VALUE))
(IF (TYPEP READTABLE 'READTABLEP)
ELSEIF (SETQ READTABLE (FIND-READTABLE READTABLE))
ELSE
(* ;; "Better message than just \DTEST")
(ERROR
"Can't find read table for DEFINE-FILE-INFO reader environment"
VALUE)))
((:BASE %:BASE) (* ;
 "RMK: An EVAL form here makes no sense. ")
(SETQ BASE (OR (\CHECKRADIX (if (LISTP VALUE)
then (EVAL VALUE)
else VALUE))
(ERROR "Bad read base for reader environment" VALUE))))
(ERROR
"Bad read base for DEFINE-FILE-INFO reader environment"
VALUE))))
((:FORMAT FORMAT %:FORMAT)
(SETQ FORMAT (FETCH (EXTERNALFORMAT NAME) OF (FIND-FORMAT
VALUE))))
@@ -759,26 +779,33 @@ Copyright (c) 1983-1990, 1992, 2021 by Venue & Xerox Corporation.
REPACKAGE _ (OR PACKAGE *INTERLISP-PACKAGE*)
REREADTABLE _ (OR READTABLE FILERDTBL)
REBASE _ (OR BASE 10)
REFORMAT _ FORMAT])
REFORMAT _ FORMAT
REPACKAGEFORM _ PACKAGEFORM
REREADTABLEFORM _ READTABLEFORM])
(PRINT-READER-ENVIRONMENT
[LAMBDA (ENV STREAM) (* ; "Edited 18-Jul-2021 09:05 by rmk:")
[LAMBDA (ENV STREAM) (* ; "Edited 16-Aug-2021 23:51 by rmk:")
(* ;;; "If ENV is not the old default interlisp reader environment, writes a DEFINE-FILE-INFO expression on STREAM that will produce this environment when the file is loaded.")
(CL:UNLESS (EQUAL-READER-ENVIRONMENT ENV *OLD-INTERLISP-READ-ENVIRONMENT*)
(LET ((*PACKAGE* *INTERLISP-PACKAGE*)
(*PRINT-BASE* 10)
PKG)
(PRINT [CONS 'DEFINE-FILE-INFO `(,@[AND (SETQ PKG (fetch REPACKAGE of ENV))
`(:PACKAGE ,(CL:PACKAGE-NAME PKG]
:READTABLE
,(READTABLEPROP (fetch REREADTABLE of ENV)
'NAME)
:BASE
,(fetch REBASE of ENV)
:FORMAT
,(FETCH REFORMAT OF ENV]
PKG RDTBL)
[SETQ PKG (IF (FETCH REPACKAGEFORM OF ENV)
ELSEIF (fetch REPACKAGE of ENV)
THEN (CL:PACKAGE-NAME (fetch REPACKAGE of ENV]
[SETQ RDTBL (IF (FETCH REREADTABLEFORM OF ENV)
ELSEIF (fetch REREADTABLE of ENV)
THEN (READTABLEPROP (fetch REREADTABLE of ENV)
'NAME]
(PRINT [CONS 'DEFINE-FILE-INFO
`(,@[AND PKG `(:PACKAGE ,PKG]
,@[AND RDTBL `(:READTABLE ,RDTBL]
:BASE
,(fetch REBASE of ENV)
,@(CL:UNLESS (EQ :XCCS (FETCH REFORMAT OF ENV))
`(:FORMAT ,(FETCH REFORMAT OF ENV)))]
STREAM
(FETCH (READER-ENVIRONMENT REREADTABLE) OF *DEFINE-FILE-INFO-ENV*))))])
@@ -954,13 +981,13 @@ Copyright (c) 1983-1990, 1992, 2021 by Venue & Xerox Corporation.
(PUTPROPS BOOTSTRAP COPYRIGHT ("Venue & Xerox Corporation" 1983 1984 1985 1986 1987 1988 1989 1990
1992 2021))
(DECLARE%: DONTCOPY
(FILEMAP (NIL (4740 14412 (GETPROP 4750 . 5322) (SETATOMVAL 5324 . 5453) (RPAQQ 5455 . 5508) (RPAQ
5510 . 5822) (RPAQ? 5824 . 6194) (MOVD 6196 . 8060) (MOVD? 8062 . 8492) (SELECTQ 8494 . 8681) (
SELECTQ1 8683 . 9025) (NCONC1 9027 . 9223) (PUTPROP 9225 . 10709) (PROPNAMES 10711 . 10902) (ADDPROP
10904 . 12967) (REMPROP 12969 . 13823) (MEMB 13825 . 14084) (CLOSEF? 14086 . 14410)) (14485 35049 (
LOAD 14495 . 15664) (\LOAD-STREAM 15666 . 28740) (FILECREATED 28742 . 30160) (FILECREATED1 30162 .
31270) (PRETTYCOMPRINT 31272 . 31757) (BOOTSTRAP-NAMEFIELD 31759 . 32719) (PUTPROPS 32721 . 33089) (
DECLARE%: 33091 . 33223) (DECLARE%:1 33225 . 34097) (ROOTFILENAME 34099 . 35047)) (35087 43925 (
DEFINE-FILE-INFO 35097 . 35532) (\DO-DEFINE-FILE-INFO 35534 . 38596) (PRINT-READER-ENVIRONMENT 38598
. 39879) (READ-READER-ENVIRONMENT 39881 . 42647) (MAKE-DEFINE-FILE-INFO-ENV 42649 . 43923)))))
(FILEMAP (NIL (4748 14420 (GETPROP 4758 . 5330) (SETATOMVAL 5332 . 5461) (RPAQQ 5463 . 5516) (RPAQ
5518 . 5830) (RPAQ? 5832 . 6202) (MOVD 6204 . 8068) (MOVD? 8070 . 8500) (SELECTQ 8502 . 8689) (
SELECTQ1 8691 . 9033) (NCONC1 9035 . 9231) (PUTPROP 9233 . 10717) (PROPNAMES 10719 . 10910) (ADDPROP
10912 . 12975) (REMPROP 12977 . 13831) (MEMB 13833 . 14092) (CLOSEF? 14094 . 14418)) (14493 35057 (
LOAD 14503 . 15672) (\LOAD-STREAM 15674 . 28748) (FILECREATED 28750 . 30168) (FILECREATED1 30170 .
31278) (PRETTYCOMPRINT 31280 . 31765) (BOOTSTRAP-NAMEFIELD 31767 . 32727) (PUTPROPS 32729 . 33097) (
DECLARE%: 33099 . 33231) (DECLARE%:1 33233 . 34105) (ROOTFILENAME 34107 . 35055)) (35095 45489 (
DEFINE-FILE-INFO 35105 . 35540) (\DO-DEFINE-FILE-INFO 35542 . 39888) (PRINT-READER-ENVIRONMENT 39890
. 41443) (READ-READER-ENVIRONMENT 41445 . 44211) (MAKE-DEFINE-FILE-INFO-ENV 44213 . 45487)))))
STOP

Binary file not shown.

View File

@@ -1,11 +1,11 @@
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10 FORMAT XCCS)
(FILECREATED "29-Jul-2021 20:34:35" 
{DSK}<Users>kaplan>Local>medley3.5>git-medley>sources>CMLREAD.;10 14968
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
(FILECREATED "16-Aug-2021 23:42:49" 
{DSK}<Users>kaplan>Local>medley3.5>git-medley>sources>CMLREAD.;16 12625
changes to%: (FUNCTIONS WITH-READER-ENVIRONMENT)
changes to%: (RECORDS READER-ENVIRONMENT)
previous date%: " 9-Jul-2021 08:09:06"
{DSK}<Users>kaplan>Local>medley3.5>git-medley>sources>CMLREAD.;9)
previous date%: "14-Aug-2021 20:32:52"
{DSK}<Users>kaplan>Local>medley3.5>git-medley>sources>CMLREAD.;15)
(* ; "
@@ -45,9 +45,8 @@ Copyright (c) 1985-1988, 1990, 1993, 2021 by Venue & Xerox Corporation.
(DECLARE%: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY COMPILERVARS
(ADDVARS (NLAMA)
(NLAML)
(LAMA CL:WRITE-BYTE CL:READ-BYTE CL:READ-FROM-STRING CL:CLEAR-INPUT
CL:READ-CHAR-NO-HANG CL:LISTEN CL:PEEK-CHAR CL:UNREAD-CHAR CL:READ-CHAR
CL:READ-LINE CL:COPY-READTABLE])
(LAMA CL:READ-BYTE CL:READ-FROM-STRING CL:CLEAR-INPUT CL:READ-CHAR-NO-HANG
CL:PEEK-CHAR CL:UNREAD-CHAR CL:READ-CHAR CL:READ-LINE CL:COPY-READTABLE])
@@ -240,16 +239,18 @@ Copyright (c) 1985-1988, 1990, 1993, 2021 by Venue & Xerox Corporation.
(DECLARE%: EVAL@COMPILE
(DATATYPE READER-ENVIRONMENT (REPACKAGE REREADTABLE REBASE NIL REFORMAT))
(DATATYPE READER-ENVIRONMENT (REPACKAGE REREADTABLE REBASE REPACKAGEFORM REFORMAT REREADTABLEFORM
))
)
(/DECLAREDATATYPE 'READER-ENVIRONMENT '(POINTER POINTER POINTER POINTER POINTER)
(/DECLAREDATATYPE 'READER-ENVIRONMENT '(POINTER POINTER POINTER POINTER POINTER POINTER)
'((READER-ENVIRONMENT 0 POINTER)
(READER-ENVIRONMENT 2 POINTER)
(READER-ENVIRONMENT 4 POINTER)
(READER-ENVIRONMENT 6 POINTER)
(READER-ENVIRONMENT 8 POINTER))
'10)
(READER-ENVIRONMENT 8 POINTER)
(READER-ENVIRONMENT 10 POINTER))
'12)
(DEFMACRO WITH-READER-ENVIRONMENT (ENV . BODY)
`((CL:LAMBDA (E)
@@ -279,58 +280,13 @@ Copyright (c) 1985-1988, 1990, 1993, 2021 by Venue & Xerox Corporation.
(ADDTOVAR NLAML )
(ADDTOVAR LAMA CL:WRITE-BYTE CL:READ-BYTE CL:READ-FROM-STRING CL:CLEAR-INPUT CL:READ-CHAR-NO-HANG
CL:LISTEN CL:PEEK-CHAR CL:UNREAD-CHAR CL:READ-CHAR CL:READ-LINE
CL:COPY-READTABLE)
)
(PRETTYCOMPRINT CMLREADCOMS)
(RPAQQ CMLREADCOMS
[(COMS
(* ;; "Misc Common Lisp reader functions")
(FNS CL:COPY-READTABLE)
(FNS CL:READ-LINE CL:READ-CHAR CL:UNREAD-CHAR CL:PEEK-CHAR CL:LISTEN
CL:READ-CHAR-NO-HANG CL:CLEAR-INPUT CL:READ-FROM-STRING CL:READ-BYTE CL:WRITE-BYTE
)
(* ;
 "must turn off packed version of CLISP infix")
(VARS [CLISPCHARS (LDIFFERENCE CLISPCHARS '(- *]
(CLISPCHARRAY (MAKEBITTABLE CLISPCHARS))
(DWIMINMACROSFLG))
(VARIABLES *READ-DEFAULT-FLOAT-FORMAT*)
(GLOBALVARS CMLRDTBL READ-LINE-RDTBL))
[COMS
(* ;; "Crude means to aid reading and printing things in same reader environment. There are some fns and an INITRECORDS for this on ATBL to get it early in the loadup")
(RECORDS READER-ENVIRONMENT)
(FUNCTIONS WITH-READER-ENVIRONMENT)
(ADDVARS (SYSSPECVARS *PACKAGE* *READTABLE* *READ-BASE* *PRINT-BASE*))
(PROP INFO WITH-READER-ENVIRONMENT)
(GLOBALVARS *COMMON-LISP-READ-ENVIRONMENT*)
(INITVARS (*COMMON-LISP-READ-ENVIRONMENT* (create READER-ENVIRONMENT REPACKAGE _
(CL:FIND-PACKAGE "USER")
REREADTABLE _ CMLRDTBL REBASE _ 10
REFORMAT _ :XCCS]
(PROP FILETYPE CMLREAD)
(DECLARE%: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY COMPILERVARS
(ADDVARS (NLAMA)
(NLAML)
(LAMA CL:READ-BYTE CL:READ-FROM-STRING CL:CLEAR-INPUT CL:READ-CHAR-NO-HANG
CL:PEEK-CHAR CL:UNREAD-CHAR CL:READ-CHAR CL:READ-LINE CL:COPY-READTABLE])
(DECLARE%: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY COMPILERVARS
(ADDTOVAR NLAMA )
(ADDTOVAR NLAML )
(ADDTOVAR LAMA CL:READ-BYTE CL:READ-FROM-STRING CL:CLEAR-INPUT CL:READ-CHAR-NO-HANG CL:PEEK-CHAR
CL:UNREAD-CHAR CL:READ-CHAR CL:READ-LINE CL:COPY-READTABLE)
)
(PUTPROPS CMLREAD COPYRIGHT ("Venue & Xerox Corporation" 1985 1986 1987 1988 1990 1993 2021))
(DECLARE%: DONTCOPY
(FILEMAP (NIL (2600 3585 (CL:COPY-READTABLE 2610 . 3583)) (3586 10219 (CL:READ-LINE 3596 . 4468) (
CL:READ-CHAR 4470 . 5020) (CL:UNREAD-CHAR 5022 . 5483) (CL:PEEK-CHAR 5485 . 7469) (CL:LISTEN 7471 .
7736) (CL:READ-CHAR-NO-HANG 7738 . 8510) (CL:CLEAR-INPUT 8512 . 8749) (CL:READ-FROM-STRING 8751 . 9506
) (CL:READ-BYTE 9508 . 9961) (CL:WRITE-BYTE 9963 . 10217)))))
(FILEMAP (NIL (2527 3512 (CL:COPY-READTABLE 2537 . 3510)) (3513 10146 (CL:READ-LINE 3523 . 4395) (
CL:READ-CHAR 4397 . 4947) (CL:UNREAD-CHAR 4949 . 5410) (CL:PEEK-CHAR 5412 . 7396) (CL:LISTEN 7398 .
7663) (CL:READ-CHAR-NO-HANG 7665 . 8437) (CL:CLEAR-INPUT 8439 . 8676) (CL:READ-FROM-STRING 8678 . 9433
) (CL:READ-BYTE 9435 . 9888) (CL:WRITE-BYTE 9890 . 10144)))))
STOP

Binary file not shown.