github.com/Interlisp.medley
1
0
Fork 0
mirror of synced 2026-02-26 17:13:17 +00:00
Code Issues Projects Releases Wiki Activity

FINDFILE-WITH-EXTENSIONS update only (#708)

Browse Source
This commit is contained in:
Larry Masinter
2022-03-04 16:49:05 -08:00
committed by GitHub
parent 6de8d3ec77
commit 3c35f6459b
2 changed files with 122 additions and 120 deletions
Download Patch File Download Diff File Expand all files Collapse all files

242
sources/MACHINEINDEPENDENT
View File

@@ -1,15 +1,14 @@
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10 FORMAT XCCS)
(FILECREATED " 5-Aug-2021 21:01:33" 
{DSK}<Users>kaplan>Local>medley3.5>git-medley>sources>MACHINEINDEPENDENT.;23 114018
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
changes to%: (FNS WRITEFILE)
(FILECREATED "17-Feb-2022 23:20:01" {DSK}<home>larry>medley>sources>MACHINEINDEPENDENT.;2 113592
previous date%: " 5-Aug-2021 20:43:52"
{DSK}<Users>kaplan>Local>medley3.5>git-medley>sources>MACHINEINDEPENDENT.;22)
:CHANGES-TO (FNS FINDFILE-WITH-EXTENSIONS)
:PREVIOUS-DATE " 5-Aug-2021 21:01:33" {DSK}<home>larry>medley>sources>MACHINEINDEPENDENT.;1)
(* ; "
Copyright (c) 1983-1991, 2021 by Venue & Xerox Corporation.
Copyright (c) 1983-1991, 2021-2022 by Venue & Xerox Corporation.
The following program was created in 1983 but has not been published
within the meaning of the copyright law, is furnished under license,
and may not be used, copied and/or disclosed except in accordance
@@ -19,11 +18,11 @@ with the terms of said license.
(PRETTYCOMPRINT MACHINEINDEPENDENTCOMS)
(RPAQQ MACHINEINDEPENDENTCOMS
([COMS (* ; " %"File loader%"")
([COMS (* ; " %"File loader%"")
(FNS LOAD? FILESLOAD DOFILESLOAD FINDFILE-WITH-EXTENSIONS READ-FILECREATED)
(INITVARS (*COMPILED-EXTENSIONS* (LIST FASL.EXT COMPILE.EXT]
(COMS (* ;
 "random machine-independent utilities")
(COMS (* ;
 "random machine-independent utilities")
(FNS DMPHASH HASHOVERFLOW)
(DECLARE%: EVAL@COMPILE DONTCOPY (MACROS HASHOVERFLOW.ARRAYTEST
HASHOVERFLOW.UPDATEARRAY))
@@ -32,19 +31,19 @@ with the terms of said license.
READLINE REMPROPLIST RESETBUFS TAB UNSAVED1 WRITEFILE CLOSE-AND-MAYBE-DELETE
UNSAFE.TO.MODIFY)
(VARS UNSAFE.TO.MODIFY.FNS)
[COMS (* ;
 "FILEDATE, for finding out the creation date of source files, from the compiled files.")
[COMS (* ;
 "FILEDATE, for finding out the creation date of source files, from the compiled files.")
(* ;; "FASL isn't loaded when MACHINEINDEPENDENT is, so we have to fake the FASL checker for now. It's defined in FASLOAD.")
(* ;; "FASL isn't loaded when MACHINEINDEPENDENT is, so we have to fake the FASL checker for now. It's defined in FASLOAD.")
(FNS FILEDATE)
(P (MOVD? 'NILL 'FASL-FILEDATE]
(P (MOVD? 'CL:FMAKUNBOUND 'UNDOABLY-FMAKUNBOUND))
(* ;
 "used in FNS.PUTDEF before CMLUNDO loaded")
(* ;
 "used in FNS.PUTDEF before CMLUNDO loaded")
)
(COMS (* ;
 "Functions for retrieving and remembering FILEMAPs and file reader environments")
(COMS (* ;
 "Functions for retrieving and remembering FILEMAPs and file reader environments")
(FNS FILEMAP \PARSE-FILE-HEADER GET-ENVIRONMENT-AND-FILEMAP
LOOKUP-ENVIRONMENT-AND-FILEMAP GET-FILEMAP-FROM-FILECREATED \FILEMAP-HASHOVERFLOW
FLUSHFILEMAPS LISPSOURCEFILEP GETFILEMAP PUTFILEMAP UPDATEFILEMAP)
@@ -57,9 +56,9 @@ with the terms of said license.
(GLOBALVARS *FILEMAP-LIMIT* *FILEMAP-VERSIONS* *FILEMAP-HASH*)))
(COMS (* * LVLPRINT)
(FNS LVLPRINT LVLPRIN1 LVLPRIN2 LVLPRIN LVLPRIN0))
(COMS (* ; "used by PRINTOUT")
(COMS (* ; "used by PRINTOUT")
(FNS FLUSHRIGHT PRINTPARA PRINTPARA1))
(COMS (* ; "SUBLIS and friends")
(COMS (* ; "SUBLIS and friends")
(FNS SUBLIS SUBPAIR DSUBLIS))
[COMS (* * CONSTANTS)
(FNS CONSTANTOK)
@@ -74,8 +73,8 @@ with the terms of said license.
USERWORDS BELLS CLISPARRAY)
(FNS NLAMBDA.ARGS)
[DECLARE%:
DONTEVAL@LOAD DOCOPY (* ;
 "initialization of variables used in many places")
DONTEVAL@LOAD DOCOPY (* ;
 "initialization of variables used in many places")
(ADDVARS (CLISPARRAY)
(CLISPFLG)
(CTRLUFLG)
@@ -399,54 +398,62 @@ with the terms of said license.
NIL])
(FINDFILE-WITH-EXTENSIONS
[LAMBDA (FILE DIRLST EXTENSIONS) (* ; "Edited 8-Dec-86 17:57 by bvm")
[LAMBDA (FILE DIRLST EXTENSIONS) (* ; "Edited 17-Feb-2022 23:15 by larry")
(* ; "Edited 8-Dec-86 17:57 by bvm")
(* ;;; "Search for FILE on the directories contained in DIRLST, where NIL and T refer to the login and connected dirs, respectively. On each directory, prefer files having extension found in EXTENSIONS in the indicated order. If FILE already has an extension, EXTENSIONS is ignored; if FILE already has a host/dir, DIRLST is ignored.")
(* ;;; "Search for FILE on the directories contained in DIRLST, where NIL and T refer to the login and connected dirs, respectively. On each directory, prefer files having extension found in EXTENSIONS in the indicated order. If FILE already has an extension, EXTENSIONS is ignored; if FILE already has a host/dir, DIRLST is ignored.")
(if FILE
then
(LET
((FIELDS (UNPACKFILENAME.STRING FILE))
DIR&FIELDS HASDIRECTORY HASEXTENSION VAL)
(for TAIL on FIELDS by (CDDR TAIL) do (SELECTQ (CAR TAIL)
(EXTENSION (SETQ HASEXTENSION T))
((HOST DEVICE DIRECTORY)
(SETQ HASDIRECTORY T))
NIL))
(if HASDIRECTORY
then (* ;
 "Don't search dirs, just look where it says")
(if HASEXTENSION
then (INFILEP FILE)
else (for EXT in EXTENSIONS
(PROG ((FIELDS (UNPACKFILENAME.STRING FILE))
NM DIR&FIELDS HASDIRECTORY HASEXTENSION VAL)
(for TAIL on FIELDS by (CDDR TAIL)
do (SELECTQ (CAR TAIL)
(EXTENSION (SETQ HASEXTENSION T))
((HOST DEVICE DIRECTORY)
(SETQ HASDIRECTORY T))
(NAME (SETQ NM (CADR TAIL))
[if (SETQ VAL (STRPOS "-" NM))
then (SETQ NM (SUBSTRING NM 1 (IMINUS VAL 1])
NIL))
[if HASDIRECTORY
then
(* ;; "Don't search dirs, just look where it says")
(if HASEXTENSION
then (SETQ VAL (INFILEP FILE))
else (for EXT in EXTENSIONS
when [SETQ VAL (INFILEP (PACKFILENAME.STRING
`(EXTENSION ,EXT ,@FIELDS]
do (RETURN VAL)))
else
(for DIR inside (if (NULL DIRLST)
then (* ;
 "If DIRLST is defaulted, always look first on connected dir.")
(if DIRECTORIES
then (CONS T (REMOVE T DIRECTORIES))
else T)
else (* ;
 "use explicit DIRLST, ignoring connected dir unless it's on DIRECTORIES")
DIRLST)
when [PROGN [SETQ DIR&FIELDS (SELECTQ DIR
(NIL (* ; "Login dir")
`(DIRECTORY ,(DIRECTORYNAME NIL)
,@FIELDS))
(T (* ; "Connected dir")
FIELDS)
`(DIRECTORY ,DIR ,@FIELDS]
(SETQ VAL
(if HASEXTENSION
then (INFILEP (PACKFILENAME.STRING DIR&FIELDS))
else (for EXT in EXTENSIONS
when [SETQ VAL
(INFILEP (PACKFILENAME.STRING
`(EXTENSION ,EXT ,@DIR&FIELDS]
do (RETURN VAL] do (RETURN VAL])
`(EXTENSION ,EXT ,@FIELDS]
do (GO RET)))
else
(for DIR inside (OR DIRLST (if DIRECTORIES
then (CONS T (REMOVE T DIRECTORIES))
else T))
do
[SETQ DIR&FIELDS (SELECTQ DIR
(NIL (* ; "Login dir")
`(DIRECTORY ,(DIRECTORYNAME NIL)
,@FIELDS))
(T (* ; "Connected dir")
FIELDS)
`(DIRECTORY ,DIR ,@FIELDS]
(SETQ VAL
(if HASEXTENSION
then (if (SETQ VAL (INFILEP (PACKFILENAME.STRING DIR&FIELDS)))
then (GO RET))
else
(for EXT in EXTENSIONS
when [SETQ VAL
(OR [INFILEP (PACKFILENAME.STRING `(EXTENSION ,EXT ,@DIR&FIELDS]
(AND NM DIR (NEQ DIR T)
(NULL DIRLST)
(INFILEP (PACKFILENAME.STRING
`(DIRECTORY ,(CONCAT DIR ">" NM)
EXTENSION
,EXT
,@FIELDS] do (GO RET]
RET (RETURN VAL])
(READ-FILECREATED
[LAMBDA (STREAM) (* ; "Edited 19-Sep-2020 20:39 by rmk:")
@@ -554,15 +561,15 @@ with the terms of said license.
(DECLARE%: EVAL@COMPILE
[PROGN (PUTPROPS HASHOVERFLOW.ARRAYTEST MACRO [(HARRAY)
(CAR (OR (LISTP HARRAY)
(ERRORX (LIST 27 HARRAY])
(CAR (OR (LISTP HARRAY)
(ERRORX (LIST 27 HARRAY])
(PUTPROPS HASHOVERFLOW.ARRAYTEST DMACRO ((HARRAY)
(\DTEST HARRAY 'HARRAYP)))]
(\DTEST HARRAY 'HARRAYP)))]
[PROGN (PUTPROPS HASHOVERFLOW.UPDATEARRAY MACRO ((HARRAY NEWARRAY OLDARRAY)
(FRPLACA HARRAY NEWARRAY)))
(FRPLACA HARRAY NEWARRAY)))
(PUTPROPS HASHOVERFLOW.UPDATEARRAY DMACRO ((HARRAY NEWARRAY OLDARRAY)
(\COPYHARRAYP NEWARRAY OLDARRAY)))]
(\COPYHARRAYP NEWARRAY OLDARRAY)))]
)
)
(DEFINEQ
@@ -1770,13 +1777,13 @@ This has little hope of working any more.")
(RPAQ? *FILEMAP-VERSIONS* 2)
(RPAQ? *FILEMAP-HASH* (HASHARRAY *FILEMAP-LIMIT* (FUNCTION \FILEMAP-HASHOVERFLOW)
(FUNCTION STRING-EQUAL-HASHBITS)
(FUNCTION STRING.EQUAL)))
(FUNCTION STRING-EQUAL-HASHBITS)
(FUNCTION STRING.EQUAL)))
(DECLARE%: EVAL@COMPILE DONTCOPY
(DECLARE%: EVAL@COMPILE
(RECORD FILEMAPHASH (FMENVIRONMENT FMROOTNAME FMFROMFILE? FMRECENT? FMFILECREATEDLOC
FMFILECREATEDLST . FMFILEMAP))
(RECORD FILEMAPHASH (FMENVIRONMENT FMROOTNAME FMFROMFILE? FMRECENT? FMFILECREATEDLOC FMFILECREATEDLST
. FMFILEMAP))
)
(DECLARE%: DOEVAL@COMPILE DONTCOPY
@@ -2106,29 +2113,27 @@ This has little hope of working any more.")
(PUTPROPS SCRATCHLIST MACRO ((SCRATCHLIST . FORMS)
([LAMBDA (!SCRATCHLIST !SCRATCHTAIL)
(DECLARE (SPECVARS !SCRATCHLIST !SCRATCHTAIL))
(SETQ !SCRATCHTAIL !SCRATCHLIST)
(PROGN . FORMS)
(COND
((EQ !SCRATCHTAIL !SCRATCHLIST)
NIL)
(T (PROG ((L2 (CDR !SCRATCHLIST)))
(RPLACD !SCRATCHLIST (PROG1 (CDR !SCRATCHTAIL)
(RPLACD !SCRATCHTAIL
NIL)))
(FRPLACD (FLAST !SCRATCHLIST)
L2)
(RETURN L2]
(OR (LISTP SCRATCHLIST)
(CONS))
NIL)))
([LAMBDA (!SCRATCHLIST !SCRATCHTAIL)
(DECLARE (SPECVARS !SCRATCHLIST !SCRATCHTAIL))
(SETQ !SCRATCHTAIL !SCRATCHLIST)
(PROGN . FORMS)
(COND
((EQ !SCRATCHTAIL !SCRATCHLIST)
NIL)
(T (PROG ((L2 (CDR !SCRATCHLIST)))
(RPLACD !SCRATCHLIST (PROG1 (CDR !SCRATCHTAIL)
(RPLACD !SCRATCHTAIL NIL)))
(FRPLACD (FLAST !SCRATCHLIST)
L2)
(RETURN L2]
(OR (LISTP SCRATCHLIST)
(CONS))
NIL)))
(PUTPROPS ADDTOSCRATCHLIST MACRO ((VALUE)
(FRPLACA [SETQ !SCRATCHTAIL (OR (LISTP (CDR !SCRATCHTAIL))
(CDR (FRPLACD !SCRATCHTAIL
(CONS]
VALUE)))
(FRPLACA [SETQ !SCRATCHTAIL (OR (LISTP (CDR !SCRATCHTAIL))
(CDR (FRPLACD !SCRATCHTAIL (CONS]
VALUE)))
(PUTPROPS SCRATCHLIST INFO EVAL)
(DECLARE%: DOEVAL@COMPILE DONTCOPY
@@ -2212,14 +2217,11 @@ This has little hope of working any more.")
(ADDTOVAR SPELLSTATS1 )
(RPAQ? CHCONLST '(NIL NIL NIL NIL NIL NIL NIL NIL NIL NIL NIL NIL NIL NIL NIL NIL NIL NIL NIL NIL
))
(RPAQ? CHCONLST '(NIL NIL NIL NIL NIL NIL NIL NIL NIL NIL NIL NIL NIL NIL NIL NIL NIL NIL NIL NIL))
(RPAQ? CHCONLST1 '(NIL NIL NIL NIL NIL NIL NIL NIL NIL NIL NIL NIL NIL NIL NIL NIL NIL NIL NIL
NIL))
(RPAQ? CHCONLST1 '(NIL NIL NIL NIL NIL NIL NIL NIL NIL NIL NIL NIL NIL NIL NIL NIL NIL NIL NIL NIL))
(RPAQ? CHCONLST2 '(NIL NIL NIL NIL NIL NIL NIL NIL NIL NIL NIL NIL NIL NIL NIL NIL NIL NIL NIL
NIL))
(RPAQ? CHCONLST2 '(NIL NIL NIL NIL NIL NIL NIL NIL NIL NIL NIL NIL NIL NIL NIL NIL NIL NIL NIL NIL))
(RPAQ? CLEARSTKLST T)
@@ -2379,25 +2381,25 @@ This has little hope of working any more.")
(LOCALVARS . T)
)
(PUTPROPS MACHINEINDEPENDENT COPYRIGHT ("Venue & Xerox Corporation" T 1983 1984 1985 1986 1987 1988
1989 1990 1991 2021))
1989 1990 1991 2021 2022))
(DECLARE%: DONTCOPY
(FILEMAP (NIL (12841 26148 (LOAD? 12851 . 14702) (FILESLOAD 14704 . 14993) (DOFILESLOAD 14995 . 22243)
(FINDFILE-WITH-EXTENSIONS 22245 . 25704) (READ-FILECREATED 25706 . 26146)) (26265 31586 (DMPHASH
26275 . 27869) (HASHOVERFLOW 27871 . 31584)) (32382 63719 (BKBUFS 32392 . 33511) (CHANGENAME 33513 .
33774) (CHNGNM 33776 . 35624) (CLBUFS 35626 . 36899) (DEFINE 36901 . 37625) (FNS.PUTDEF 37627 . 41042)
(EQMEMB 41044 . 41226) (EQUALN 41228 . 42057) (FNCHECK 42059 . 44066) (FNTYP1 44068 . 44165) (LCSKIP
44167 . 45011) (MAPRINT 45013 . 45959) (MKLIST 45961 . 46111) (NAMEFIELD 46113 . 47638) (NLIST 47640
. 47975) (PRINTBELLS 47977 . 48103) (PROMPTCHAR 48105 . 49995) (RAISEP 49997 . 50258) (READFILE 50260
. 52604) (READLINE 52606 . 58046) (REMPROPLIST 58048 . 58936) (RESETBUFS 58938 . 59388) (TAB 59390 .
59986) (UNSAVED1 59988 . 61093) (WRITEFILE 61095 . 62837) (CLOSE-AND-MAYBE-DELETE 62839 . 63183) (
UNSAFE.TO.MODIFY 63185 . 63717)) (66043 68987 (FILEDATE 66053 . 68985)) (69217 92956 (FILEMAP 69227 .
69697) (\PARSE-FILE-HEADER 69699 . 73514) (GET-ENVIRONMENT-AND-FILEMAP 73516 . 75743) (
LOOKUP-ENVIRONMENT-AND-FILEMAP 75745 . 77936) (GET-FILEMAP-FROM-FILECREATED 77938 . 78762) (
\FILEMAP-HASHOVERFLOW 78764 . 83428) (FLUSHFILEMAPS 83430 . 84053) (LISPSOURCEFILEP 84055 . 85234) (
GETFILEMAP 85236 . 85655) (PUTFILEMAP 85657 . 87848) (UPDATEFILEMAP 87850 . 92954)) (93573 97159 (
LVLPRINT 93583 . 93756) (LVLPRIN1 93758 . 93940) (LVLPRIN2 93942 . 94174) (LVLPRIN 94176 . 95190) (
LVLPRIN0 95192 . 97157)) (97193 102110 (FLUSHRIGHT 97203 . 98018) (PRINTPARA 98020 . 99118) (
PRINTPARA1 99120 . 102108)) (102146 104431 (SUBLIS 102156 . 102764) (SUBPAIR 102766 . 103994) (DSUBLIS
103996 . 104429)) (104454 105054 (CONSTANTOK 104464 . 105052)) (107132 107837 (NLAMBDA.ARGS 107142 .
107835)))))
(FILEMAP (NIL (12807 26116 (LOAD? 12817 . 14668) (FILESLOAD 14670 . 14959) (DOFILESLOAD 14961 . 22209)
(FINDFILE-WITH-EXTENSIONS 22211 . 25672) (READ-FILECREATED 25674 . 26114)) (26233 31554 (DMPHASH
26243 . 27837) (HASHOVERFLOW 27839 . 31552)) (32310 63647 (BKBUFS 32320 . 33439) (CHANGENAME 33441 .
33702) (CHNGNM 33704 . 35552) (CLBUFS 35554 . 36827) (DEFINE 36829 . 37553) (FNS.PUTDEF 37555 . 40970)
(EQMEMB 40972 . 41154) (EQUALN 41156 . 41985) (FNCHECK 41987 . 43994) (FNTYP1 43996 . 44093) (LCSKIP
44095 . 44939) (MAPRINT 44941 . 45887) (MKLIST 45889 . 46039) (NAMEFIELD 46041 . 47566) (NLIST 47568
. 47903) (PRINTBELLS 47905 . 48031) (PROMPTCHAR 48033 . 49923) (RAISEP 49925 . 50186) (READFILE 50188
. 52532) (READLINE 52534 . 57974) (REMPROPLIST 57976 . 58864) (RESETBUFS 58866 . 59316) (TAB 59318 .
59914) (UNSAVED1 59916 . 61021) (WRITEFILE 61023 . 62765) (CLOSE-AND-MAYBE-DELETE 62767 . 63111) (
UNSAFE.TO.MODIFY 63113 . 63645)) (65971 68915 (FILEDATE 65981 . 68913)) (69145 92884 (FILEMAP 69155 .
69625) (\PARSE-FILE-HEADER 69627 . 73442) (GET-ENVIRONMENT-AND-FILEMAP 73444 . 75671) (
LOOKUP-ENVIRONMENT-AND-FILEMAP 75673 . 77864) (GET-FILEMAP-FROM-FILECREATED 77866 . 78690) (
\FILEMAP-HASHOVERFLOW 78692 . 83356) (FLUSHFILEMAPS 83358 . 83981) (LISPSOURCEFILEP 83983 . 85162) (
GETFILEMAP 85164 . 85583) (PUTFILEMAP 85585 . 87776) (UPDATEFILEMAP 87778 . 92882)) (93550 97136 (
LVLPRINT 93560 . 93733) (LVLPRIN1 93735 . 93917) (LVLPRIN2 93919 . 94151) (LVLPRIN 94153 . 95167) (
LVLPRIN0 95169 . 97134)) (97170 102087 (FLUSHRIGHT 97180 . 97995) (PRINTPARA 97997 . 99095) (
PRINTPARA1 99097 . 102085)) (102123 104408 (SUBLIS 102133 . 102741) (SUBPAIR 102743 . 103971) (DSUBLIS
103973 . 104406)) (104431 105031 (CONSTANTOK 104441 . 105029)) (106784 107489 (NLAMBDA.ARGS 106794 .
107487)))))
STOP

BIN
sources/MACHINEINDEPENDENT.LCOM
View File

Binary file not shown.