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
GitHub
@@ -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
|
||||
|
||||
Reference in New Issue
Block a user