Merge (rebase) Cleanup-character-IO-interfaces with master (#356)
* Cleanup of character IO interface Committing this branch for further testing. I know at least that the TTY output stream somehow is defaulting to :XCCS, which is wrong, but I haven't yet found the interface for that. * Clean out \NSIN etc No top-level calls to the NS specific functions, just to the generic \OUTCHAR etc. Updated full.database * MODERNIZE: added dragging for fixed-menu windows They can be dragged by their title bars * UNICODE: Added Greek to the default set Also made spelling of default-externalformats consistent with FILEIO * FASLOAD: EOL conversion in FASL::READ-TEXT EOL's printed as LF's will be read as EOL * LLREAD: Added meta as a CHARACTERSETNAME meta,a maps to 1,a now. But slowly propagating this to TEDIT, SEDIT, etc will make it easier to change the coding of meta characters, e.g. as part of a Unicode transition. * APRINT FILEIO LLREAD: \OUTCHAR now a closed function Removed the macro * LLKEY: call CHARCODE.DECODE directory in \KEYACTION1 Minor cleanup, avoid typical user entry and APPLY* * WHEELSCROLL: re-enable on AFTERMAKESYS/SYSOUT FORMS Also sets up mappings in the \COMMANDKEYACTIONS, whatever that is * ABASIC: NILL and ZERO change from LAMBDA NOBIND to LAMBDA NIL So that things like Masterscope don't break * MASTERSCOPE: Added WHEREIS as last-resort for CONTAINS Looks at the WHEREIS database, if present, for FNS and FUNCTIONS if it has no other information. . WHO CONTAINS ANY CALLING FOO works, but not the inverse: . WHO DOES FUM CONTAIN. We still need to figure out why the CONTAINS table isn't populated * POSTSCRIPTSTREAM: use standard \OUTCHAR conventions Now uses generic \OUTCHAR to get the proper function from the stream (or default) * Recompile with right EXPORTS.ALL Some of the macros weren't correct. * Fix POSTSCRIPTSTREAM Cleaner separation between external \OUTCHAR and internal BOUT * POSTSCRIPTSTREAM gets its own external format * Minor fix * Compile-time warning about EXPORTS.ALL * MODERNIZE: Modern button fn has same args as the original For Notecards #343 * Fixed another glitch in the MODERNIZE arglist thing \TEDIT.BUTTONEVENTFN actually takes a second STREAM argument. I don't see where it is ever called with that. The modernize replacement binds that argument, but it isn't being passed to the original. * FILEWATCH: added missing record field * Update FILEWATCH.LCOM * Eliminating record/type name conflicts Mostly just qualifying references, more work to get BIGBITMAP stuff out of ADISPLAY and to eliminate ambiguity of LINE record (now XXLINE in XXGEOM) * Compile away open calls to \OUTCHAR, add loadups/full.database Mostly new LCOMS where \OUTCHAR calls were compiled open * Remove garbage library/XCCS Old tools for reading wikipedia XCCS tables, sources/XCCS will deal with XCCS external format * Next step: Remove open input-character calls, factor XCCS to separate file XCCS is the default, but can be swapped out (eventually) by setting a few variables, without recompiling everything * Lots of residual cleanup for XCCS isolation * Delete old file MACINTERFACE (migrated to MODERNIZE) * Eliminate straggling NS calls: LAFITE, READINTERPRESS * Typo * READINTERPRESS: removed CHARSET * MODERNIZE: Interface to control title-bar response (for Notecards) * Many changes for external format name consistency Very close to the end of this * Put :FORMAT in file info, fix TEDIT plaintext hardcopy I distributed :FORMAT :XCCS as the default marking, but somehow one of the variables seems to get revert during the loadup. This is correct, as far as it goes. * Getting the format in the file-info This is all very twisty, different variables set in different places. It now seems to do the right thing, at least for new files. Marks them with :FORMAT :XCCS. * Another fileinfo glitch * CLIPBOARD -UNICODE: Make UTF8 to UTF-8 to match standards * MODERNIZE: fix bug in MODERWINDOW * External format as MAKEFILE option, LOAD applies the file's format (MAKEFILE 'XX '((FORMAT :UTF-8))) will dump XX as a UTF-8 file. LOAD will load it back to XCCS internal. * Compilers respect DEFINE-FILE-INFO format * MODERNIZE: little glitch * Delete old FILEIO.LCOM * More edge cases of external format thru MAKEFILE, PRETTY, PRETTYFILEINDEX etc. * FILEBROWSER: Can SEE UTF-8 Lisp sourcefile * INSPECT: Better macro for inspecting readtables * recompile changed files and do new loadup Co-authored-by: rmkaplan <ron.kaplan@post.harvard.edu>
This commit is contained in:
Larry Masinter
GitHub
249
sources/PRETTY
249
sources/PRETTY
@@ -1,11 +1,11 @@
|
||||
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
|
||||
(FILECREATED "21-Feb-2021 10:59:08"
|
||||
{DSK}<Users>kaplan>Local>medley3.5>git-medley>sources>PRETTY.;10 57241
|
||||
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10 FORMAT XCCS)
|
||||
(FILECREATED " 9-Jul-2021 14:12:19"
|
||||
{DSK}<Users>kaplan>Local>medley3.5>git-medley>sources>PRETTY.;19 64744
|
||||
|
||||
changes to%: (FNS PRINTCOPYRIGHT1)
|
||||
changes to%: (FNS PRETTYDEF)
|
||||
|
||||
previous date%: "16-Apr-2018 21:37:09"
|
||||
{DSK}<Users>kaplan>Local>medley3.5>git-medley>sources>PRETTY.;6)
|
||||
previous date%: " 3-Jul-2021 15:24:17"
|
||||
{DSK}<Users>kaplan>Local>medley3.5>git-medley>sources>PRETTY.;17)
|
||||
|
||||
|
||||
(* ; "
|
||||
@@ -45,7 +45,7 @@ with the terms of said license.
|
||||
" EXPLAINSTRING "] - no copyright notice now" NOECHOFLG T RETURN NIL]
|
||||
(COPYRIGHTSRESERVED T)
|
||||
(*NEW-INTERLISP-MAKEFILE-ENVIRONMENT* '(:READTABLE "INTERLISP" :PACKAGE
|
||||
"INTERLISP"))
|
||||
"INTERLISP" :FORMAT :XCCS))
|
||||
(*DEFAULT-MAKEFILE-ENVIRONMENT*))
|
||||
(GLOBALVARS COPYRIGHTOWNERS DEFAULTCOPYRIGHTKEYLST COPYRIGHTPRETTYFLG COMMENTFLG
|
||||
*DEFAULT-MAKEFILE-ENVIRONMENT* *NEW-INTERLISP-MAKEFILE-ENVIRONMENT*))
|
||||
@@ -99,10 +99,214 @@ with the terms of said license.
|
||||
(DEFINEQ
|
||||
|
||||
(PRETTYDEF
|
||||
(LAMBDA (PRTTYFNS PRTTYFILE PRTTYCOMS REPRINTFNS SOURCEFILE CHANGES) (* ; "Edited 16-Feb-88 11:46 by raf") (DECLARE (SPECVARS PRTTYFILE REPRINTFNS SOURCEFILE CHANGES)) (RESETLST (RESETSAVE (RESETUNDO) (QUOTE (AND RESETSTATE (RESETUNDO OLDVALUE)))) (* ;; "Says undo everything if there is an error or control-D This is particularly necessary if user is using the PRINT* prettyprintmacro which updates comments to point to the newest version.") (PROG ((NEWFILEMAP (AND BUILDMAPFLG (LIST NIL))) (%#RPARS %#RPARS) (*PRINT-ARRAY* T) (XCL:*PRINT-STRUCTURE* T) (*PRINT-LEVEL* NIL) (*PRINT-LENGTH* NIL) FILEFLG FNSLST PRTTYTEM PRETTYCOMSLST PRTTYSPELLFLG OLDFILEMAP MAPADR NLAMALST NLAMLST LAMALST LAM?LST FILEDATES ORIGFLG ROOTNAME DESTINATIONENV SOURCEFILENV SOURCEFC FCLOCATION) (DECLARE (SPECVARS *PRINT-ARRAY* XCL:*PRINT-STRUCTURE* *PRINT-LEVEL* *PRINT-LENGTH* NEWFILEMAP ORIGFLG FILEFLG NLAMALST PRTTYSPELLFLG PRETTYCOMSLST PRTTYCOMS LAM?LST FNSLST OLDFILEMAP LAMALST MAPADR ORIGFLG NLAMLST DESTINATIONENV SOURCEFILENV %#RPARS)) (* ; "NEWFILEMAP corresponds to the map being built for the file being written. OLDFILEMAP corresponds to the map that exists for SOURCEFILE, if any.") (COND ((OR (NULL (\DTEST PRTTYFILE (QUOTE LITATOM))) (EQ PRTTYFILE T)) (* ; "we no longer support any of the crufty alternatives to writing a brand new file") (\ILLEGAL.ARG PRTTYFILE))) (SETQ ROOTNAME (ROOTFILENAME PRTTYFILE)) (if (OR (EQ SOURCEFILE T) (AND REPRINTFNS (NULL SOURCEFILE))) then (* ;; "SOURCEFILE plays the role of CFILE for recompiling. It permits PRETTYPRINT to obtain the definitions from the file withou having to reprettyprint them, or even having them loaded into core. T (or NIL if REPRINTFNS is specified) is the same as PRETTYFILE.") (* ;; "REPRINTFNS specifies those functions to be printed anew. REPRINTFNS=T means reprint all EXPRS, a la recompile. For example, if you have an entire file loaded in, but only change a few functions, using this option can speed up dumping the file by a factor of two. If REPRINTFNS=ALL, all functions that contain in core exprs, whether on function definition cell or property lists, are reprinted. REPRINTFNS can also be a list. MAKEFILE uses this for the REMAKE option by specifying as REPRINTFNS the list CHANGES. In any case, if the function does not contain an in core defnition, prettyprint will try to find one on the file. i.e., act as though REPRINTFNS were NIL.") (SETQ SOURCEFILE ROOTNAME)) (if (SETQ DESTINATIONENV (GET ROOTNAME (QUOTE MAKEFILE-ENVIRONMENT))) then (* ; "use this explicit environment. Copy it in case user later on destructively edits it") (SETQ DESTINATIONENV (\DO-DEFINE-FILE-INFO NIL (COPY DESTINATIONENV))) else (* ; "see if we already know the environment of the source") (CL:MULTIPLE-VALUE-SETQ (SOURCEFILENV OLDFILEMAP SOURCEFC) (LOOKUP-ENVIRONMENT-AND-FILEMAP (OR SOURCEFILE ROOTNAME) (OR (NULL SOURCEFILE) (EQ SOURCEFILE ROOTNAME))))) (if SOURCEFILE then (if (NULL (NLSETQ (SETQ SOURCEFILE (OPENSTREAM SOURCEFILE (QUOTE INPUT))))) then (* ; "can't find file to reprint from.") (* ; "OPENSTREAM is called in order that 'correction' take place.") (SETQ SOURCEFILE NIL) (PRIN1 PRTTYFILE T) (PRIN1 (QUOTE " not found, so it will be written anew.
|
||||
") T) elseif (RANDACCESSP SOURCEFILE) then (RESETSAVE NIL (LIST (QUOTE CLOSEF) SOURCEFILE)) (RESETSAVE (INPUT SOURCEFILE)) (if (EQ REPRINTFNS (QUOTE EXPRS)) then (SETQ REPRINTFNS T) elseif (EQ REPRINTFNS (QUOTE CHANGES)) then (SETQ REPRINTFNS (UNION (FILEPKG.CHANGEDFNS CHANGES) (FILEPKG.CHANGEDFNS (fetch FILECHANGES of ROOTNAME))))) (if (NULL SOURCEFILENV) then (* ; "if we didn't have environment cached, look it up from the actual stream now") (CL:MULTIPLE-VALUE-SETQ (SOURCEFILENV OLDFILEMAP SOURCEFC) (GET-ENVIRONMENT-AND-FILEMAP SOURCEFILE))) (if (NULL OLDFILEMAP) then (* ; "no map on file, so we will build one as needed") (SETFILEPTR SOURCEFILE (OR SOURCEFC 0)) elseif (NULL (CAR OLDFILEMAP)) then (* ; "complete map.") elseif (LISTP (CAR OLDFILEMAP)) then (* ; "only partial map built up. should only happen for files that were made with BUILDMAPFLG=NIL, since otherwise there would be a coplete map on the file.") (SETFILEPTR SOURCEFILE (CAAR OLDFILEMAP)) else (* ; "Redundancy check. Should only occur if there was a compiled function in the file. and a partial map was formed that stopped after that function.") (HELP)) else (* ; "Can't copy from non-randaccessp source") (SETQ SOURCEFILE NIL))) (* ;; "Now figure out what environment to write the new file in.") (if DESTINATIONENV then (* ; "have explicit env, ok") elseif SOURCEFILENV then (* ; "use same as source") (SETQ DESTINATIONENV (if (EQUAL-READER-ENVIRONMENT SOURCEFILENV *OLD-INTERLISP-READ-ENVIRONMENT*) then (* ; "write the new style") (\DO-DEFINE-FILE-INFO NIL *NEW-INTERLISP-MAKEFILE-ENVIRONMENT*) else (* ; "use same env on new file as old") SOURCEFILENV)) else (* ; "new file, use default") (SETQ DESTINATIONENV (\DO-DEFINE-FILE-INFO NIL (COPY *DEFAULT-MAKEFILE-ENVIRONMENT*)))) (if (NULL SOURCEFILE) then (* ; "get rid of anything we knew about source") (SETQ OLDFILEMAP NIL) (SETQ SOURCEFC NIL) (SETQ SOURCEFILENV NIL) elseif (AND SOURCEFILENV (EQUAL-READER-ENVIRONMENT SOURCEFILENV DESTINATIONENV)) then (* ; "source and destination compatible, so we won't need to worry about it in PRETTYPRINT1/2") (SETQ SOURCEFILENV NIL)) (RESETSAVE NIL (LIST (FUNCTION PRETTYDEF0) (SETQ PRTTYFILE (OPENSTREAM PRTTYFILE (QUOTE OUTPUT))))) (* ; "Cleans up by closing and deleting file if aborted.") (RESETSAVE (OUTPUT PRTTYFILE)) (PRINT-READER-ENVIRONMENT DESTINATIONENV) (SETQ FCLOCATION (GETFILEPTR PRTTYFILE)) (WITH-READER-ENVIRONMENT DESTINATIONENV (if (NOT (SYNTAXP (CHARCODE "[") (QUOTE LEFTBRACKET))) then (* ; "can't use brackets on this read table") (SETQ %#RPARS NIL)) (SETQ FILEDATES (PRINTDATE PRTTYFILE CHANGES)) (AND (NEQ COPYRIGHTFLG (QUOTE NEVER)) ROOTNAME (PRINTCOPYRIGHT ROOTNAME)) (SETQ FILEFLG T) (SETQ CHANGES (FILEPKG.CHANGEDFNS CHANGES)) (* ; "Used freely by PRETTYPRINT to decide clispifying.") (if (NOT (RANDACCESSP PRTTYFILE)) then (* ; "No point building a map, since we won't be able to go back to the start to point at it") (SETQ NEWFILEMAP NIL)) (if FONTCHANGEFLG then (* ; "this is expensive in that it costs as many conses as there are functions, but you can afford it for a makefile.") (SETQ FNSLST (OR (for FL in (GETPROP ROOTNAME (QUOTE FILEGROUP)) when (fetch FILEPROP of FL) join (FILEFNSLST FL)) (FILEFNSLST ROOTNAME)))) (if (OR (LISTP PRTTYFNS) (LISTP (GETTOPVAL PRTTYFNS))) then (* ; "Ancient cruft from before the days of MAKEFILE.") (PRINTFNS PRTTYFNS T) (PRETTYCOM PRTTYFNS T)) (if (SETQ PRETTYCOMSLST (OR (LISTP PRTTYCOMS) (AND (LITATOM PRTTYCOMS) (LISTP (GETTOPVAL PRTTYCOMS))))) then (PRETTYCOM PRTTYCOMS T) (* ; "PRTTYCOMS is just like the argument to a COMS command. see comment in prettycom1") (for L on PRETTYCOMSLST do (PRETTYCOM (CAR L) NIL L)) (* ; "The original value of PRTTYCOMS is saved so that it can be rewritten if a spelling correction occurs. The list PRTTYCOMSLST is searched by PRETTYCOM1 for * commands to see if the variable has be dumped out as well.")) (if (PRETTYDEF1) then (* ; "The coms were reprinted by PRETTYDEF1 due to a change to nlama and or nlaml") elseif PRTTYSPELLFLG then (* ; "A correction on prettycoms was performed, so dump it out aain to get the corrected version on the file.") (PRETTYCOM PRTTYCOMS T)) (if (NEQ COPYRIGHTFLG (QUOTE NEVER)) then (SAVECOPYRIGHT ROOTNAME)) (if NEWFILEMAP then (PRIN1 "(") (PRIN2 (QUOTE DECLARE%:)) (SPACES 1) (PRIN2 (QUOTE DONTCOPY)) (TERPRI) (SPACES 2) (for ADR in MAPADR do (SETQ PRTTYTEM (GETFILEPTR PRTTYFILE)) (SETFILEPTR PRTTYFILE ADR) (* ; "Write the current file positon into the filecreated expression, and then restores the file pointer.") (PRIN2 PRTTYTEM) (SETFILEPTR PRTTYFILE PRTTYTEM)) (PRIN2 (LIST (QUOTE FILEMAP) NEWFILEMAP)) (* ; "printed instead of prettyprinted, so wont take up two pages of listing.") (PRIN1 (QUOTE ")
|
||||
")) (PUTFILEMAP (FULLNAME PRTTYFILE) NEWFILEMAP NIL DESTINATIONENV NIL FCLOCATION) (* ; "Also save map, so can be used for subsequent makefiles.")) (ENDFILE PRTTYFILE) (if (AND FILEDATES ROOTNAME) then (/replace FILEDATES of ROOTNAME with FILEDATES))) (RETURN (FULLNAME PRTTYFILE)))))
|
||||
)
|
||||
[LAMBDA (PRTTYFNS PRTTYFILE PRTTYCOMS REPRINTFNS SOURCEFILE CHANGES FORMAT)
|
||||
(* ; "Edited 9-Jul-2021 14:12 by rmk:")
|
||||
(* ; "Edited 29-Jun-2021 17:23 by rmk:")
|
||||
(DECLARE (SPECVARS PRTTYFILE REPRINTFNS SOURCEFILE CHANGES))
|
||||
(RESETLST
|
||||
[RESETSAVE (RESETUNDO)
|
||||
'(AND RESETSTATE (RESETUNDO OLDVALUE]
|
||||
|
||||
(* ;; "Says undo everything if there is an error or control-D This is particularly necessary if user is using the PRINT* prettyprintmacro which updates comments to point to the newest version.")
|
||||
|
||||
(PROG ((NEWFILEMAP (AND BUILDMAPFLG (LIST NIL)))
|
||||
(%#RPARS %#RPARS)
|
||||
(*PRINT-ARRAY* T)
|
||||
(XCL:*PRINT-STRUCTURE* T)
|
||||
(*PRINT-LEVEL* NIL)
|
||||
(*PRINT-LENGTH* NIL)
|
||||
FILEFLG FNSLST PRTTYTEM PRETTYCOMSLST PRTTYSPELLFLG OLDFILEMAP MAPADR NLAMALST NLAMLST
|
||||
LAMALST LAM?LST FILEDATES ORIGFLG ROOTNAME DESTINATIONENV SOURCEFILENV SOURCEFC
|
||||
FCLOCATION DEFAULTDESTENV)
|
||||
(DECLARE (SPECVARS *PRINT-ARRAY* XCL:*PRINT-STRUCTURE* *PRINT-LEVEL* *PRINT-LENGTH*
|
||||
NEWFILEMAP ORIGFLG FILEFLG NLAMALST PRTTYSPELLFLG PRETTYCOMSLST
|
||||
PRTTYCOMS LAM?LST FNSLST OLDFILEMAP LAMALST MAPADR ORIGFLG NLAMLST
|
||||
DESTINATIONENV SOURCEFILENV %#RPARS))
|
||||
(* ; "NEWFILEMAP corresponds to the map being built for the file being written. OLDFILEMAP corresponds to the map that exists for SOURCEFILE, if any.")
|
||||
(COND
|
||||
((OR (NULL (\DTEST PRTTYFILE 'LITATOM))
|
||||
(EQ PRTTYFILE T)) (* ;
|
||||
"we no longer support any of the crufty alternatives to writing a brand new file")
|
||||
(\ILLEGAL.ARG PRTTYFILE)))
|
||||
(SETQ ROOTNAME (ROOTFILENAME PRTTYFILE))
|
||||
(if (OR (EQ SOURCEFILE T)
|
||||
(AND REPRINTFNS (NULL SOURCEFILE)))
|
||||
then
|
||||
|
||||
(* ;; "SOURCEFILE plays the role of CFILE for recompiling. It permits PRETTYPRINT to obtain the definitions from the file withou having to reprettyprint them, or even having them loaded into core. T (or NIL if REPRINTFNS is specified) is the same as PRETTYFILE.")
|
||||
|
||||
(* ;; "REPRINTFNS specifies those functions to be printed anew. REPRINTFNS=T means reprint all EXPRS, a la recompile. For example, if you have an entire file loaded in, but only change a few functions, using this option can speed up dumping the file by a factor of two. If REPRINTFNS=ALL, all functions that contain in core exprs, whether on function definition cell or property lists, are reprinted. REPRINTFNS can also be a list. MAKEFILE uses this for the REMAKE option by specifying as REPRINTFNS the list CHANGES. In any case, if the function does not contain an in core defnition, prettyprint will try to find one on the file. i.e., act as though REPRINTFNS were NIL.")
|
||||
|
||||
(SETQ SOURCEFILE ROOTNAME))
|
||||
[if (SETQ DESTINATIONENV (GET ROOTNAME 'MAKEFILE-ENVIRONMENT))
|
||||
then (SETQ DESTINATIONENV (\DO-DEFINE-FILE-INFO NIL DESTINATIONENV))
|
||||
else (* ;
|
||||
"see if we already know the environment of the source")
|
||||
(CL:MULTIPLE-VALUE-SETQ (SOURCEFILENV OLDFILEMAP SOURCEFC)
|
||||
(LOOKUP-ENVIRONMENT-AND-FILEMAP (OR SOURCEFILE ROOTNAME)
|
||||
(OR (NULL SOURCEFILE)
|
||||
(EQ SOURCEFILE ROOTNAME]
|
||||
(if SOURCEFILE
|
||||
then (if [NULL (NLSETQ (SETQ SOURCEFILE (OPENSTREAM SOURCEFILE 'INPUT]
|
||||
then (* ;
|
||||
"can't find file to reprint from.")
|
||||
(* ;
|
||||
"OPENSTREAM was called in order that 'correction' take place.")
|
||||
(SETQ SOURCEFILE NIL)
|
||||
(PRINTOUT T PRTTYFILE " not found, so it will be written anew."
|
||||
T)
|
||||
elseif (RANDACCESSP SOURCEFILE)
|
||||
then (RESETSAVE NIL (LIST 'CLOSEF SOURCEFILE))
|
||||
(* ; "The typical case: File is open")
|
||||
(RESETSAVE (INPUT SOURCEFILE))
|
||||
[if (EQ REPRINTFNS 'EXPRS)
|
||||
then (SETQ REPRINTFNS T)
|
||||
elseif (EQ REPRINTFNS 'CHANGES)
|
||||
then (SETQ REPRINTFNS
|
||||
(UNION (FILEPKG.CHANGEDFNS CHANGES)
|
||||
(FILEPKG.CHANGEDFNS (fetch FILECHANGES
|
||||
of ROOTNAME]
|
||||
(CL:UNLESS SOURCEFILENV (* ;
|
||||
"if we didn't have environment cached, look it up from the actual stream now")
|
||||
(CL:MULTIPLE-VALUE-SETQ (SOURCEFILENV OLDFILEMAP SOURCEFC)
|
||||
(GET-ENVIRONMENT-AND-FILEMAP SOURCEFILE)))
|
||||
(\EXTERNALFORMAT SOURCEFILE (FETCH (READER-ENVIRONMENT
|
||||
REFORMAT) OF
|
||||
SOURCEFILENV
|
||||
))
|
||||
(if (NULL OLDFILEMAP)
|
||||
then (* ;
|
||||
"no map on file, so we will build one as needed")
|
||||
(SETFILEPTR SOURCEFILE (OR SOURCEFC 0))
|
||||
elseif (NULL (CAR OLDFILEMAP))
|
||||
then (* ; "complete map.")
|
||||
elseif (LISTP (CAR OLDFILEMAP))
|
||||
then (* ; "only partial map built up. should only happen for files that were made with BUILDMAPFLG=NIL, since otherwise there would be a coplete map on the file.")
|
||||
(SETFILEPTR SOURCEFILE (CAAR OLDFILEMAP))
|
||||
else (* ; "Redundancy check. Should only occur if there was a compiled function in the file. and a partial map was formed that stopped after that function.")
|
||||
(HELP))
|
||||
else (* ;
|
||||
"Can't copy from non-randaccessp source")
|
||||
(SETQ SOURCEFILE NIL)))
|
||||
|
||||
(* ;; "Now figure out what environment to write the new file in.")
|
||||
|
||||
(CL:UNLESS DESTINATIONENV (* ;
|
||||
"Don't yet have a destination environment")
|
||||
(SETQ DESTINATIONENV (if SOURCEFILENV
|
||||
then (* ; "use same as source")
|
||||
(if (EQUAL-READER-ENVIRONMENT SOURCEFILENV
|
||||
*OLD-INTERLISP-READ-ENVIRONMENT*)
|
||||
then
|
||||
(* ; "Coercing to the new style")
|
||||
(\DO-DEFINE-FILE-INFO NIL
|
||||
*NEW-INTERLISP-MAKEFILE-ENVIRONMENT*
|
||||
)
|
||||
else (* ;
|
||||
"use same env on new file as old. But copy in case something changes")
|
||||
(CREATE READER-ENVIRONMENT USING
|
||||
SOURCEFILENV)
|
||||
)
|
||||
elseif *DEFAULT-MAKEFILE-ENVIRONMENT*
|
||||
then
|
||||
|
||||
(* ;; "new file, use default")
|
||||
|
||||
(\DO-DEFINE-FILE-INFO NIL
|
||||
*DEFAULT-MAKEFILE-ENVIRONMENT*))))
|
||||
(CL:WHEN FORMAT
|
||||
(REPLACE (READER-ENVIRONMENT REFORMAT) OF DESTINATIONENV WITH FORMAT))
|
||||
|
||||
(* ;; "We now have a DESTINATIONENV")
|
||||
|
||||
(if (NULL SOURCEFILE)
|
||||
then (* ;
|
||||
"get rid of anything we knew about source")
|
||||
(SETQ OLDFILEMAP NIL)
|
||||
(SETQ SOURCEFC NIL)
|
||||
(SETQ SOURCEFILENV NIL)
|
||||
elseif (AND SOURCEFILENV (EQUAL-READER-ENVIRONMENT SOURCEFILENV DESTINATIONENV))
|
||||
then (* ;
|
||||
"source and destination compatible, so we won't need to worry about it in PRETTYPRINT1/2")
|
||||
(SETQ SOURCEFILENV NIL))
|
||||
|
||||
(* ;; "Ready to go. Clean up by closing and deleting file if aborted.")
|
||||
|
||||
[RESETSAVE NIL (LIST (FUNCTION PRETTYDEF0)
|
||||
(SETQ PRTTYFILE (OPENSTREAM PRTTYFILE 'OUTPUT]
|
||||
(\EXTERNALFORMAT PRTTYFILE (FETCH (READER-ENVIRONMENT REFORMAT) OF
|
||||
DESTINATIONENV
|
||||
))
|
||||
(RESETSAVE (OUTPUT PRTTYFILE))
|
||||
(PRINT-READER-ENVIRONMENT DESTINATIONENV)
|
||||
(SETQ FCLOCATION (GETFILEPTR PRTTYFILE))
|
||||
(WITH-READER-ENVIRONMENT DESTINATIONENV
|
||||
(CL:UNLESS (SYNTAXP (CHARCODE "[")
|
||||
'LEFTBRACKET) (* ;
|
||||
"can't use brackets on this read table")
|
||||
(SETQ %#RPARS NIL))
|
||||
(SETQ FILEDATES (PRINTDATE PRTTYFILE CHANGES))
|
||||
(AND (NEQ COPYRIGHTFLG 'NEVER)
|
||||
ROOTNAME
|
||||
(PRINTCOPYRIGHT ROOTNAME))
|
||||
(SETQ FILEFLG T)
|
||||
(SETQ CHANGES (FILEPKG.CHANGEDFNS CHANGES))(* ;
|
||||
"Used freely by PRETTYPRINT to decide clispifying.")
|
||||
(CL:UNLESS (RANDACCESSP PRTTYFILE) (* ;
|
||||
"No point building a map, since we won't be able to go back to the start to point at it")
|
||||
(SETQ NEWFILEMAP NIL))
|
||||
(CL:WHEN FONTCHANGEFLG (* ; "this is expensive in that it costs as many conses as there are functions, but you can afford it for a makefile.")
|
||||
(SETQ FNSLST (OR (for FL in (GETPROP ROOTNAME 'FILEGROUP)
|
||||
when (fetch FILEPROP of FL)
|
||||
join (FILEFNSLST FL))
|
||||
(FILEFNSLST ROOTNAME))))
|
||||
(CL:WHEN (OR (LISTP PRTTYFNS)
|
||||
(LISTP (GETTOPVAL PRTTYFNS))) (* ;
|
||||
"Ancient cruft from before the days of MAKEFILE.")
|
||||
(PRINTFNS PRTTYFNS T)
|
||||
(PRETTYCOM PRTTYFNS T))
|
||||
(CL:WHEN [SETQ PRETTYCOMSLST (OR (LISTP PRTTYCOMS)
|
||||
(AND (LITATOM PRTTYCOMS)
|
||||
(LISTP (GETTOPVAL PRTTYCOMS]
|
||||
(PRETTYCOM PRTTYCOMS T) (* ;
|
||||
"PRTTYCOMS is just like the argument to a COMS command. see comment in prettycom1")
|
||||
(for L on PRETTYCOMSLST do (PRETTYCOM (CAR L)
|
||||
NIL L))
|
||||
(* ; "The original value of PRTTYCOMS is saved so that it can be rewritten if a spelling correction occurs. The list PRTTYCOMSLST is searched by PRETTYCOM1 for * commands to see if the variable has be dumped out as well.")
|
||||
)
|
||||
(if (PRETTYDEF1)
|
||||
then (* ;
|
||||
"The coms were reprinted by PRETTYDEF1 due to a change to nlama and or nlaml")
|
||||
elseif PRTTYSPELLFLG
|
||||
then (* ; "A correction on prettycoms was performed, so dump it out aain to get the corrected version on the file.")
|
||||
(PRETTYCOM PRTTYCOMS T))
|
||||
(CL:UNLESS (EQ COPYRIGHTFLG 'NEVER)
|
||||
(SAVECOPYRIGHT ROOTNAME))
|
||||
(CL:WHEN NEWFILEMAP
|
||||
(PRIN1 "(")
|
||||
(PRIN2 'DECLARE%:)
|
||||
(SPACES 1)
|
||||
(PRIN2 'DONTCOPY)
|
||||
(TERPRI)
|
||||
(SPACES 2)
|
||||
(for ADR in MAPADR do (SETQ PRTTYTEM (GETFILEPTR PRTTYFILE))
|
||||
(SETFILEPTR PRTTYFILE ADR)
|
||||
(* ; "Write the current file positon into the filecreated expression, and then restores the file pointer.")
|
||||
(PRIN2 PRTTYTEM)
|
||||
(SETFILEPTR PRTTYFILE PRTTYTEM))
|
||||
(PRIN2 (LIST 'FILEMAP NEWFILEMAP)) (* ;
|
||||
"printed instead of prettyprinted, so wont take up two pages of listing.")
|
||||
(PRIN1 ")")
|
||||
(TERPRI)
|
||||
|
||||
(* ;; "Also save map, so can be used for subsequent makefiles.")
|
||||
|
||||
(PUTFILEMAP (FULLNAME PRTTYFILE)
|
||||
NEWFILEMAP NIL DESTINATIONENV NIL FCLOCATION))
|
||||
(ENDFILE PRTTYFILE)
|
||||
(CL:WHEN (AND FILEDATES ROOTNAME)
|
||||
(/replace FILEDATES of ROOTNAME with FILEDATES)))
|
||||
(RETURN (FULLNAME PRTTYFILE))))])
|
||||
|
||||
(PRETTYDEFCOMS
|
||||
(LAMBDA (PRTTYCOMS FNSLST) (* ; "Edited 19-Aug-88 16:07 by raf") (DECLARE (SPECVARS FNSLST)) (PROG ((%#RPARS %#RPARS) (*PRINT-ARRAY* T) (XCL:*PRINT-STRUCTURE* T) (*PRINT-LEVEL* NIL) (*PRINT-LENGTH* NIL) BUILDMAPFLG PRTTYSPELLFLG ORIGFLG SOURCEFILE) (DECLARE (SPECVARS *PRINT-ARRAY* XCL:*PRINT-STRUCTURE* *PRINT-LEVEL* *PRINT-LENGTH* BUILDMAPFLG NEWFILEMAP ORIGFLG PRTTYSPELLFLG LAM?LST ORIGFLG SOURCEFILE %#RPARS)) (if (NOT (SYNTAXP (CHARCODE "[") (QUOTE LEFTBRACKET))) then (* ; "can't use brackets on this read table") (SETQ %#RPARS NIL)) (for L on (OR (LISTP PRTTYCOMS) (AND (LITATOM PRTTYCOMS) (LISTP (GETTOPVAL PRTTYCOMS)))) do (PRETTYCOM (CAR L) NIL L))))
|
||||
@@ -392,7 +596,8 @@ must replace the declare: by a nop addvars.") (SETQ PRTTYCOM (SUBPAIR (QUOTE (NL
|
||||
|
||||
(RPAQ? COPYRIGHTSRESERVED T)
|
||||
|
||||
(RPAQ? *NEW-INTERLISP-MAKEFILE-ENVIRONMENT* '(:READTABLE "INTERLISP" :PACKAGE "INTERLISP"))
|
||||
(RPAQ? *NEW-INTERLISP-MAKEFILE-ENVIRONMENT* '(:READTABLE "INTERLISP" :PACKAGE "INTERLISP" :FORMAT
|
||||
:XCCS))
|
||||
|
||||
(RPAQ? *DEFAULT-MAKEFILE-ENVIRONMENT* )
|
||||
(DECLARE%: DOEVAL@COMPILE DONTCOPY
|
||||
@@ -484,14 +689,14 @@ must replace the declare: by a nop addvars.") (SETQ PRTTYCOM (SUBPAIR (QUOTE (NL
|
||||
(PUTPROPS PRETTY COPYRIGHT ("Venue & Xerox Corporation" T 1984 1985 1986 1987 1988 1989 1990 1999 2018
|
||||
2021))
|
||||
(DECLARE%: DONTCOPY
|
||||
(FILEMAP (NIL (5927 40668 (PRETTYDEF 5937 . 14200) (PRETTYDEFCOMS 14202 . 14884) (PRETTYDEF0 14886 .
|
||||
15077) (PRETTYDEF1 15079 . 16842) (PRINTDATE 16844 . 18080) (PRINTDATE1 18082 . 19287) (PRINTFNS 19289
|
||||
. 19858) (PRETTYCOM 19860 . 26201) (PRETTYVAR 26203 . 27241) (PRETTYVAR1 27243 . 29461) (PRETTYCOM1
|
||||
29463 . 30167) (ENDFILE 30169 . 30265) (MAKEDEFLIST 30267 . 30671) (PP 30673 . 30949) (PP* 30951 .
|
||||
31264) (PPT 31266 . 31585) (PRETTYPRINT 31587 . 34739) (PRETTYPRINT1 34741 . 36627) (PRETTYPRINT2
|
||||
36629 . 37945) (PRETTYPRINT3 37947 . 38902) (PRINTDEF1 38904 . 39912) (SUPERPRINTEQ 39914 . 40008) (
|
||||
SUPERPRINTGETPROP 40010 . 40154) (CHANGEFONT 40156 . 40666)) (40669 46015 (READARRAY 40679 . 41605) (
|
||||
PRINTARRAY 41607 . 43347) (READARRAY-FROM-LIST 43349 . 44454) (PRINTARRAY-TO-LIST 44456 . 46013)) (
|
||||
46142 53355 (PRINTCOPYRIGHT 46152 . 49924) (PRINTCOPYRIGHT1 49926 . 53050) (SAVECOPYRIGHT 53052 .
|
||||
53353)))))
|
||||
(FILEMAP (NIL (5950 48101 (PRETTYDEF 5960 . 21633) (PRETTYDEFCOMS 21635 . 22317) (PRETTYDEF0 22319 .
|
||||
22510) (PRETTYDEF1 22512 . 24275) (PRINTDATE 24277 . 25513) (PRINTDATE1 25515 . 26720) (PRINTFNS 26722
|
||||
. 27291) (PRETTYCOM 27293 . 33634) (PRETTYVAR 33636 . 34674) (PRETTYVAR1 34676 . 36894) (PRETTYCOM1
|
||||
36896 . 37600) (ENDFILE 37602 . 37698) (MAKEDEFLIST 37700 . 38104) (PP 38106 . 38382) (PP* 38384 .
|
||||
38697) (PPT 38699 . 39018) (PRETTYPRINT 39020 . 42172) (PRETTYPRINT1 42174 . 44060) (PRETTYPRINT2
|
||||
44062 . 45378) (PRETTYPRINT3 45380 . 46335) (PRINTDEF1 46337 . 47345) (SUPERPRINTEQ 47347 . 47441) (
|
||||
SUPERPRINTGETPROP 47443 . 47587) (CHANGEFONT 47589 . 48099)) (48102 53448 (READARRAY 48112 . 49038) (
|
||||
PRINTARRAY 49040 . 50780) (READARRAY-FROM-LIST 50782 . 51887) (PRINTARRAY-TO-LIST 51889 . 53446)) (
|
||||
53575 60788 (PRINTCOPYRIGHT 53585 . 57357) (PRINTCOPYRIGHT1 57359 . 60483) (SAVECOPYRIGHT 60485 .
|
||||
60786)))))
|
||||
STOP
|
||||
|
||||
Reference in New Issue
Block a user