From 79fd39f15c5fd8d6539b9f8b08c90bfc0d0bed3a Mon Sep 17 00:00:00 2001 From: rmkaplan Date: Sun, 24 Apr 2022 13:39:44 -0700 Subject: [PATCH] FILEPKG: Added DEPTH=2 to EDITCALLERS, reopen stream after LOADFILEMAP --- sources/FILEPKG | 204 ++++++++++++++++++++++++------------------- sources/FILEPKG.LCOM | Bin 101788 -> 102364 bytes 2 files changed, 113 insertions(+), 91 deletions(-) diff --git a/sources/FILEPKG b/sources/FILEPKG index 8b926bba..d6c2c200 100644 --- a/sources/FILEPKG +++ b/sources/FILEPKG @@ -1,11 +1,11 @@ (DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10) -(FILECREATED " 6-Mar-2022 11:02:12" {DSK}kaplan>Local>medley3.5>my-medley>sources>FILEPKG.;19 278872 +(FILECREATED "28-Mar-2022 20:33:30" {DSK}kaplan>Local>medley3.5>my-medley>sources>FILEPKG.;31 279837 :CHANGES-TO (FNS EDITCALLERS) - :PREVIOUS-DATE " 2-Mar-2022 15:49:32" -{DSK}kaplan>Local>medley3.5>my-medley>sources>FILEPKG.;18) + :PREVIOUS-DATE "28-Mar-2022 14:08:07" +{DSK}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 diff --git a/sources/FILEPKG.LCOM b/sources/FILEPKG.LCOM index 8a73bf27d19b9cde882581edf7975017b566d604..7487b340b3a6fb3766b70fb4e70ec08cc1e75ce7 100644 GIT binary patch delta 2441 zcmZuy-ESLJ7SA2GDRtXmyKcx1W;wM&lw@NwU!D)E+GT2w8>i#B#-4OiD3}nZ>)EEw z0!7**j_o_;pD6JIvvBj3U&mD$;)-FJs?mF!JboZD zSu09rQ8Iep68n&1&Bc2YvB}qp!n;L*yqG_1OOmAYhRtkOk>Dw)gKWYIBRbS=-**}w zV+t@|w@c^kbIv?tHL!hJ!<7kD{2SoYI#L}R?*h^S)EiaLuej%s(SY5d>Ek7sg$gyB z=_=4D`)6HT$xyP9^fzTPiy4Ta;j!PiPrdr3FV+#t5z=JMx8~4rWU^f6RQ$9<*FZfm;>R~srVR4Zp8!X=oo%$ z`CEb1mlbld8{~h>cH-=JsUwP=wkQUgxTb}hY%9ngW5nfVg9k>GGp#iFkfw!Jio8!# z0%=VQy#WN~68Cg*DNrVbl|k&)ZSvhx@`;I{xIOl_apvk1;XT*mO2e%$+FjDhaCaLI z@7|uInGNCUJ$_;;C~(?&2Y0;;;%Gwg(j|i%@wyEr6UgmH0Q3810Q2_3r-rSP7%N_YxITD`KFCYszqOo6NUKk|bO@F^K)Hl^BIf z!KH~#JFK2K!Y8yn1aQad6|gl!(}Fpz@z%)i)QT$>+W8R>7|TP3Y&LKAntzr9MQ z1zdf9ySsub^pd7CvB8N>>h>a?9=sE7?U2?i(?H$F>8v0y-5EODCc#4H7KzRY7R0rM zArrR}NCqE=TOZLGp*6ELpjn}n-M$x|6k_Z}|MykxjgV*hPa`r6^l*3QS3!5-pTYc{ z$IgelgQLL$*9h{#nLrQbJG&6%V>DL%HExz*a#< zEdX{ZHXZ1S32wDnUy1mFp^tdhkqT&5VZ=7;UAyEoK{M0?a?SXWl|fS#pmoQKx>u7l zd{w*5I#M+cXsQSOs0HlXs5L=Vb!a+1XZ;2!Mgcq1>y~UEJGcO~^XR_nox{dfq2v~u z7i(v!n~U%U8()Kw0)hs1d~^Bip1v$G33fk%7ApN9kaZJEi+F~N$fd(2hh@XF-3o2g z@K9N{FrIY1QL-_4mIRk-7cgf&n1$Z%YiYqS`t`?1rV9o_lUt0ew8H*WDEn^jgM}F9 zmDvRmvNc79`%cslO{rT3O_rhR)t7xxEoS373=9=Xg@+MTbwG?PJB=KoXthDRUd{1* z(4;*RmL1x3D!;))K+|N%!nIAf9B!;%UH$#(EU1PB*&^;LhJ=5lx(3-S$d<`j*-{wG zHea!s9_C^8+U9k*y!rCA_S{^Y!C=XDT`Vdb3!)@Lv24a?8HP6;e8HxVbBJMh?}Z!b zW6G#f7BO?Z&6tHVf)^g+5moWYtHq+{qS=$V3%0xL%)wahupo?uPb3AhoIHJ~_xX*f z%c+jIcAPgomN^zLv*L#>djaN@;r`z9;AA=&p(OL^#d8itkG-x7vU#F6J%(+87cG)<<&WGqe-T%O`7+P!m#PNa5}2uUKc9~r%{8$l#D8%8RwaB1t$ zm|sa6JyL`YvK4jz9&heL3v3=E0uu%v$m)@FPrG0p^rl+)K-2qc2unzo3@BF{PRXZ@ zi=JI`FwIu~u1V$|l(DCNcsAMSwT}LxZ&@UlkqxZW(&oz>ZLIL?u>ObDtKqeER7%g5YBFBNP-f@X>g-$lnyH>c1Yaa^?JSQRHYkxojCRGGxnyNl)@6lEq2p3 zsFZ6hwMD%WS=0xLkcvc)b&{GQ70F0ksJL+8!jA;Kb4Vq`4Z^&)P8(JA;mypOZ{Ey~ z-+b@)FM4i$*7J!s0@{?ld}&IN6a{2CB`GOcSzmo?R5qd@LSm0oO(}XxTK{>fw0Aoe zi-}NPzI>+qJh-fi(f&v_m$%YI%XF;_f}WF5g!L=O`eg(9m87mGmHI92$OtHVk|$EC zk%}wzKRELRS&#PD2fM@9QvCfC&s~buZ+ru_0w{4f1t?@#M1iLjOxLxF4mEU`D46LJ z=BzbA%_NvEv8g6QjtU7}Qb5Ik%z|w%p{9f7oJ5&~LNVvK+59XT8qjYkx%e?OIsw^* zd>$1QdL3e$1w=J8nVXqbfw*&4vBcnz1qGo_i7LSnR7*mZx(lS#DU|v3`cFTM)D#2K z#HJf@2{K;J&SjTygC?MRGOM4t6|gcnw{t=i_-{x1y13Av1D@K~g}-<1dg>ZgglhRE zDu>>utIgJas=iwhgi2WuJY87Ps|@SZf>;({GriU8Fv%8Q;QXOB5qN);dq75c&L3%$ zq4Lchdfr3+6d7uPcXXZ|zclY@VScgIeRYF-G#@%1@{VnE-3gGro4+|^sG~DmzP-`)HyPX-ulj>+yKyDXjn=B$Thk|6Z#d_Ikf5Er zZGF2nTs{4ORaFiA6+RStnMArTls2gqc1YoJma-kc*7t*@)iEzXZo1Y(bn7|&DeVG=8Io-%fq>*Vni zVMS?Ew;x8)`o7xyj!g3YWV1ygydT-vsqPQ@^WP&fc(cm7{Ba=KUJ5@p;wfKx(mgTX z>hqMot{V2m_KtfgPpWJW?4xaJS5~AIr83kN(F}=Q<7|=GbS6McCLmL^PT~lmk&pog z8Rrl*RfT-6R9NiT2}2HSI;09DaFCfBM=EWVK-KkKca8d0trJe+GN@`2^2E&0lsLVh z#toRY+^41jrNAt>MNnmJ_b?VLDNjuW;z{GlJVRWI?~RNjw3a4L+H^tD6|herh2)%B z(J#olJ0@8DsLPoBO!)c2) z$T9O-QnWFt98Vs=f(pg7iTyMXV4uW3xuEOy?Q0{vE;S0Tabq<|stTuo@sTV-=^6Msr2t*p`EJVE>=DjgJrA zt~~>f>yUE_3ogVJEQ^$^?3V!Z