FILEPKG: Added DEPTH=2 to EDITCALLERS, reopen stream after LOADFILEMAP
This commit is contained in:
rmkaplan
parent
3b9a825482
commit
79fd39f15c
204
sources/FILEPKG
204
sources/FILEPKG
@ -1,11 +1,11 @@
|
||||
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
|
||||
|
||||
(FILECREATED " 6-Mar-2022 11:02:12" {DSK}<Users>kaplan>Local>medley3.5>my-medley>sources>FILEPKG.;19 278872
|
||||
(FILECREATED "28-Mar-2022 20:33:30" {DSK}<Users>kaplan>Local>medley3.5>my-medley>sources>FILEPKG.;31 279837
|
||||
|
||||
:CHANGES-TO (FNS EDITCALLERS)
|
||||
|
||||
:PREVIOUS-DATE " 2-Mar-2022 15:49:32"
|
||||
{DSK}<Users>kaplan>Local>medley3.5>my-medley>sources>FILEPKG.;18)
|
||||
:PREVIOUS-DATE "28-Mar-2022 14:08:07"
|
||||
{DSK}<Users>kaplan>Local>medley3.5>my-medley>sources>FILEPKG.;29)
|
||||
|
||||
|
||||
(* ; "
|
||||
@ -4407,87 +4407,102 @@ compiling " T)
|
||||
(EDITCALLERS
|
||||
[LAMBDA (ATOMS FILES COMS)
|
||||
|
||||
(* ;; "Edited 6-Mar-2022 11:02 by rmk: If FILES contains *, use FILDIR")
|
||||
(* ;; "Edited 28-Mar-2022 20:32 by rmk: FILDIR with depth 2, reopen stream after LOADFILEMAP")
|
||||
|
||||
(* ;; "Edited 24-Mar-2022 16:38 by rmk: If FILES contains *, use FILDIR")
|
||||
|
||||
(* ;; "Edited 28-Jun-2021 09:50 by rmk:")
|
||||
(* bvm%: " 3-Nov-86 17:30")
|
||||
(LET
|
||||
(FFILEPOSPATTERNS FNS OTHERSFILES EDITPATTERN)
|
||||
[SETQ EDITPATTERN (EDITFPAT (CONS '*ANY* (SETQ ATOMS (MKLIST ATOMS]
|
||||
[for FILE in (COND
|
||||
((NULL FILES)
|
||||
FILELST)
|
||||
((EQ FILES T)
|
||||
(UNION SYSFILES FILELST))
|
||||
((LISTP FILES)
|
||||
FILES)
|
||||
((STRPOS "*" FILES)
|
||||
(FILDIR FILES))
|
||||
(T (LIST FILES)))
|
||||
(for FILE FULL in (COND
|
||||
((NULL FILES)
|
||||
FILELST)
|
||||
((EQ FILES T)
|
||||
(UNION SYSFILES FILELST))
|
||||
((LISTP FILES)
|
||||
FILES)
|
||||
((STRPOS "*" FILES) (* ; "Depth 2 for TMAX>TMAX")
|
||||
(FILDIR FILES 2))
|
||||
(T (LIST FILES))) unless (DIRECTORYNAMEP FILE)
|
||||
do
|
||||
(RESETLST
|
||||
[PROG (PATTERNS CA RDTBL MAP NOMAPFLG FULL FILESTREAM PRINTFLG ENV DUMMY TOP I)
|
||||
(OR (SETQ FULL (FINDFILE FILE))
|
||||
(RETURN (LISPXPRINT (CONS FILE '(not found))
|
||||
T T)))
|
||||
[RESETSAVE NIL (LIST (FUNCTION CLOSEF?)
|
||||
(SETQ FILESTREAM (OPENSTREAM FULL 'INPUT]
|
||||
(CL:FORMAT T "~A: " (SETQ FULL (FULLNAME FILESTREAM)))
|
||||
(CL:MULTIPLE-VALUE-SETQ (ENV MAP TOP)
|
||||
(OR (GET-ENVIRONMENT-AND-FILEMAP FULL)
|
||||
(\PARSE-FILE-HEADER FILESTREAM)))
|
||||
(CL:UNLESS
|
||||
[NLSETQ
|
||||
(RESETLST
|
||||
[PROG (PATTERNS CA RDTBL MAP FILESTREAM PRINTFLG ENV TOP I)
|
||||
(OR (SETQ FULL (FINDFILE FILE))
|
||||
(RETURN (LISPXPRINT (CONS FILE '(not found))
|
||||
T T)))
|
||||
[RESETSAVE NIL (LIST (FUNCTION CLOSEF?)
|
||||
(SETQ FILESTREAM (OPENSTREAM FULL 'INPUT]
|
||||
(CL:FORMAT T "~A: " FULL)
|
||||
(CL:MULTIPLE-VALUE-SETQ (ENV MAP TOP)
|
||||
(OR (GET-ENVIRONMENT-AND-FILEMAP FILESTREAM)
|
||||
(\PARSE-FILE-HEADER FILESTREAM)))
|
||||
|
||||
(* ;; "Get reader environment of file. The call to GET-ENVIRONMENT-AND-FILEMAP with the filename will get cached info if it exists. Otherwise, read the top of the file")
|
||||
(* ;; "Get reader environment of file. The call to GET-ENVIRONMENT-AND-FILEMAP with the filename will get cached info if it exists. Otherwise, read the top of the file")
|
||||
|
||||
(SETQ RDTBL (AND ENV (fetch (READER-ENVIRONMENT REREADTABLE) of ENV)))
|
||||
(CL:WHEN (AND ENV (FETCH (READER-ENVIRONMENT REFORMAT) OF ENV))
|
||||
(\EXTERNALFORMAT FILESTREAM (FETCH (READER-ENVIRONMENT REFORMAT) OF ENV)))
|
||||
(SETQ CA (SEPRCASE DWIMIFYCOMPFLG RDTBL))
|
||||
[OR (SETQ PATTERNS (CDR (ASSOC RDTBL FFILEPOSPATTERNS)))
|
||||
(push FFILEPOSPATTERNS
|
||||
(CONS RDTBL (SETQ PATTERNS
|
||||
(for ATOM in ATOMS
|
||||
collect (CONCAT (COND
|
||||
((EQ (CHCON1 ATOM)
|
||||
(CHARCODE ESCAPE))
|
||||
(SETQ ATOM (SUBSTRING ATOM 2 -1))
|
||||
"")
|
||||
(T " "))
|
||||
[COND
|
||||
((SETQ I (STRPOS ' ATOM))
|
||||
(SUBSTRING ATOM 1 (SUB1 I)))
|
||||
((STRINGP ATOM))
|
||||
(T (LET ((*PACKAGE* (CL:SYMBOL-PACKAGE
|
||||
ATOM)))
|
||||
(CL:WHEN ENV
|
||||
(SETQ RDTBL (fetch (READER-ENVIRONMENT REREADTABLE) of ENV))
|
||||
(\EXTERNALFORMAT FILESTREAM ENV))
|
||||
(SETQ CA (SEPRCASE DWIMIFYCOMPFLG RDTBL))
|
||||
[OR (SETQ PATTERNS (CDR (ASSOC RDTBL FFILEPOSPATTERNS)))
|
||||
(push FFILEPOSPATTERNS
|
||||
(CONS RDTBL
|
||||
(SETQ PATTERNS
|
||||
(for ATOM in ATOMS
|
||||
collect (CONCAT (COND
|
||||
((EQ (CHCON1 ATOM)
|
||||
(CHARCODE ESCAPE))
|
||||
(SETQ ATOM (SUBSTRING ATOM 2 -1))
|
||||
"")
|
||||
(T " "))
|
||||
[COND
|
||||
((SETQ I (STRPOS ' ATOM))
|
||||
(SUBSTRING ATOM 1 (SUB1 I)))
|
||||
((STRINGP ATOM))
|
||||
(T (LET ((*PACKAGE* (CL:SYMBOL-PACKAGE
|
||||
ATOM)))
|
||||
(* ;
|
||||
"Keep MKSTRING from putting a prefix on")
|
||||
(MKSTRING ATOM T RDTBL]
|
||||
(COND
|
||||
(I "")
|
||||
(T " "]
|
||||
(for PATTERN in PATTERNS
|
||||
do
|
||||
(SETFILEPTR FILESTREAM (SETQ I (OR TOP 0)))
|
||||
(while (SETQ I (FFILEPOS PATTERN FILESTREAM I NIL NIL T CA))
|
||||
do
|
||||
(COND
|
||||
((NULL PRINTFLG) (* ;
|
||||
(MKSTRING ATOM T RDTBL]
|
||||
(COND
|
||||
(I "")
|
||||
(T " "]
|
||||
(for PATTERN in PATTERNS
|
||||
do
|
||||
(SETFILEPTR FILESTREAM (SETQ I (OR TOP 0)))
|
||||
(while (SETQ I (FFILEPOS PATTERN FILESTREAM I NIL NIL T CA))
|
||||
do
|
||||
|
||||
(* ;; "The next search begins after the last search, since I is the tail of a match, even if the fileptr is set to 0 to get the map")
|
||||
|
||||
(CL:UNLESS PRINTFLG (* ;
|
||||
"cause the printing of the filename to be saved on history list")
|
||||
(SETQ PRINTFLG T)
|
||||
(LISPXPRIN2 FULL T T T)
|
||||
(SETQ PRINTFLG T)
|
||||
(LISPXPRIN2 FULL T T T)
|
||||
|
||||
(* ;; "print with NODOFLG=T means just to record the printing; the idea is that only those files in which something is found will be remembered on the history list")
|
||||
(* ;; "print with NODOFLG=T means just to record the printing; the idea is that only those files in which something is found will be remembered on the history list")
|
||||
|
||||
(LISPXPRIN1 ": " T NIL T)))
|
||||
[OR
|
||||
[AND (NEQ MAP T)
|
||||
(for X in (CDR (OR MAP [PROGN (SETFILEPTR FILESTREAM 0)
|
||||
(SETQ MAP (OR (GETFILEMAP FILESTREAM)
|
||||
(LOADFILEMAP FILESTREAM]
|
||||
(PROGN (* ; "file has no filemap")
|
||||
(SETQ MAP (SETQ NOMAPFLG T))
|
||||
(LISPXPRIN1 " no filemap!" T)
|
||||
NIL)))
|
||||
(LISPXPRIN1 ": " T NIL T))
|
||||
(CL:UNLESS MAP
|
||||
|
||||
(* ;;
|
||||
"After the first hit, use LOADFNS to try harder, perhaps scanning to create a map")
|
||||
|
||||
(SETQ MAP (LOADFNS NIL FILESTREAM NIL 'FILEMAP))
|
||||
|
||||
(* ;;
|
||||
"LOADFNS may implicitly close the file, so reopen for next hit")
|
||||
|
||||
[OPENSTREAM FILESTREAM 'INPUT 'OLD `((EXTERNALFORMAT ,ENV]
|
||||
(CL:UNLESS MAP (* ;
|
||||
"Set to T so only try and print once")
|
||||
(LISPXPRIN1 " no filemap!" T)
|
||||
(SETQ MAP T)))
|
||||
[OR
|
||||
[for X in (CDR (LISTP MAP))
|
||||
thereis (AND (ILESSP (CAR X)
|
||||
I)
|
||||
(IGREATERP (CADR X)
|
||||
@ -4507,21 +4522,28 @@ compiling " T)
|
||||
FNS]
|
||||
(SETQ I (CDDR Z))
|
||||
T]
|
||||
(PROGN (LISPXPRIN2 I T T)
|
||||
(OR (FMEMB FILE OTHERSFILES)
|
||||
(SETQ OTHERSFILES (CONS FILE OTHERSFILES]
|
||||
(LISPXSPACES 1 T)))
|
||||
(COND
|
||||
(PRINTFLG (LISPXTERPRI T))
|
||||
(T (TERPRI T)))
|
||||
(COND
|
||||
((NEQ COMS T)
|
||||
(COND
|
||||
((OR FNS OTHERSFILES)
|
||||
(EDITFROMFILE (OR NOMAPFLG (DREVERSE FNS))
|
||||
FULL EDITPATTERN COMS (NULL OTHERSFILES))
|
||||
(SETQ OTHERSFILES)
|
||||
(SETQ FNS])]
|
||||
(PROGN (LISPXPRIN2 I T T)
|
||||
(OR (FMEMB FILE OTHERSFILES)
|
||||
(SETQ OTHERSFILES (CONS FILE OTHERSFILES]
|
||||
(LISPXSPACES 1 T)))
|
||||
(COND
|
||||
(PRINTFLG (LISPXTERPRI T))
|
||||
(T (TERPRI T)))
|
||||
(COND
|
||||
((NEQ COMS T)
|
||||
(COND
|
||||
((OR FNS OTHERSFILES)
|
||||
(EDITFROMFILE (OR (EQ MAP T)
|
||||
(DREVERSE FNS))
|
||||
FULL EDITPATTERN COMS (NULL OTHERSFILES))
|
||||
(SETQ OTHERSFILES)
|
||||
(SETQ FNS])]
|
||||
(LISPXTERPRI T)
|
||||
(LISPXTERPRI T)
|
||||
(LISPXPRIN1 "Could not examine " T)
|
||||
(LISPXPRIN1 FULL T)
|
||||
(LISPXTERPRI T)
|
||||
(LISPXTERPRI T)))
|
||||
(COND
|
||||
((EQ COMS T)
|
||||
(CONS OTHERSFILES FNS])
|
||||
@ -4951,10 +4973,10 @@ GETDEFFROMFILE 196989 . 201269) (GETDEFSAVED 201271 . 202375) (PUTDEF 202377 . 2
|
||||
(DWIMDEF 207280 . 208134) (DELDEF 208136 . 211150) (DELFROMLIST 211152 . 211656) (HASDEF 211658 .
|
||||
217980) (GETFILEDEF 217982 . 218504) (SAVEDEF 218506 . 220165) (UNSAVEDEF 220167 . 221063) (
|
||||
COMPAREDEFS 221065 . 224875) (COMPARE 224877 . 225581) (TYPESOF 225583 . 229843)) (229995 238766 (
|
||||
FILEPKGCOM 230005 . 234938) (FILEPKGTYPE 234940 . 238764)) (250799 265262 (FINDCALLERS 250809 . 251324
|
||||
) (EDITCALLERS 251326 . 258767) (EDITFROMFILE 258769 . 264577) (FINDATS 264579 . 264851) (LOOKIN
|
||||
264853 . 265260)) (265263 266990 (SEPRCASE 265273 . 266988)) (267507 273064 (IMPORTFILE 267517 .
|
||||
268491) (IMPORTEVAL 268493 . 269373) (IMPORTFILESCAN 269375 . 269796) (CHECKIMPORTS 269798 . 271134) (
|
||||
GATHEREXPORTS 271136 . 272474) (\DUMPEXPORTS 272476 . 273062)) (273402 275610 (CLEARFILEPKG 273412 .
|
||||
275608)))))
|
||||
FILEPKGCOM 230005 . 234938) (FILEPKGTYPE 234940 . 238764)) (250799 266227 (FINDCALLERS 250809 . 251324
|
||||
) (EDITCALLERS 251326 . 259732) (EDITFROMFILE 259734 . 265542) (FINDATS 265544 . 265816) (LOOKIN
|
||||
265818 . 266225)) (266228 267955 (SEPRCASE 266238 . 267953)) (268472 274029 (IMPORTFILE 268482 .
|
||||
269456) (IMPORTEVAL 269458 . 270338) (IMPORTFILESCAN 270340 . 270761) (CHECKIMPORTS 270763 . 272099) (
|
||||
GATHEREXPORTS 272101 . 273439) (\DUMPEXPORTS 273441 . 274027)) (274367 276575 (CLEARFILEPKG 274377 .
|
||||
276573)))))
|
||||
STOP
|
||||
|
||||
Binary file not shown.
Loading…
x
Reference in New Issue
Block a user