From f531e89ddec9a26cbf9963e63d488d49d5c5d9ce Mon Sep 17 00:00:00 2001 From: rmkaplan Date: Mon, 24 Jan 2022 21:12:56 -0800 Subject: [PATCH] COREIO: More accurate directory name processing, added FILEDIRCASEARRAY FILEDIRCASEARRAY does upper/lower case equivalents plus /<> for testing directory string equivalents. Could be in COREIO, but that's probably too early in the loadup. --- sources/COREIO | 140 ++++++++++++++++++++++++++++++++------------ sources/COREIO.LCOM | Bin 16649 -> 17223 bytes 2 files changed, 101 insertions(+), 39 deletions(-) diff --git a/sources/COREIO b/sources/COREIO index c92dc071..c1b40da7 100644 --- a/sources/COREIO +++ b/sources/COREIO @@ -1,11 +1,11 @@ (DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10) -(FILECREATED " 3-Jan-2022 20:02:51" {DSK}kaplan>Local>medley3.5>my-medley>sources>COREIO.;4 55136 +(FILECREATED "18-Jan-2022 11:22:04" {DSK}kaplan>Local>medley3.5>my-medley>sources>COREIO.;14 58002 - :CHANGES-TO (FNS \CORE.SETFILEINFO) + :CHANGES-TO (FNS \CORE.DIRECTORYNAMEP) - :PREVIOUS-DATE "22-Nov-2021 09:25:42" -{DSK}kaplan>Local>medley3.5>my-medley>sources>COREIO.;3) + :PREVIOUS-DATE "11-Jan-2022 16:45:02" +{DSK}kaplan>Local>medley3.5>my-medley>sources>COREIO.;13) (* ; " @@ -27,6 +27,8 @@ Copyright (c) 1981-1988, 1990, 1993, 1999, 2018 by Venue & Xerox Corporation. \CORE.SETACCESSTIME \CORE.SETFILEINFO \CORE.GETNEXTBUFFER \CORE.UNPACKFILENAME) (FNS COREDEVICE \CREATECOREDEVICE) (FNS \NODIRCOREFDEV \NODIRCORE.OPENFILE) + (FNS FILEDIRCASEARRAY) + (VARS (FILEDIRCASEARRAY (FILEDIRCASEARRAY))) (DECLARE%: DONTCOPY (RECORDS CORE.PAGEENTRY COREFILEINFOBLK CORESTREAM COREDEVICE COREGENFILESTATE)) (INITRECORDS COREFILEINFOBLK) @@ -90,10 +92,34 @@ Copyright (c) 1981-1988, 1990, 1993, 1999, 2018 by Venue & Xerox Corporation. (RETURN (fetch IOFILEFULLNAME of INFOBLOCK]) (\CORE.DIRECTORYNAMEP - [LAMBDA (DIRNAME DEV) (* ; "Edited 19-Feb-93 16:04 by jds") - (LET [(DIR (UNPACKFILENAME.STRING DIRNAME 'DIRECTORY] - (AND DIRNAME DIR (> (NCHARS DIR) - 0]) + [LAMBDA (DIRNAME DEV) (* ; "Edited 18-Jan-2022 11:17 by rmk") + (* ; "Edited 10-Jan-2022 22:33 by rmk") + + (* ;; + "Edited 9-Jan-2022 12:42 by rmk: Using the new FILEDIRCASEARRAY so that slashes and brackets match") + + (* ;; "Edited 5-Jan-2022 15:03 by rmk: The previous definition didn't actually check to see if the directory existed. %"existed%" for COREIO means there is at least one file currently in that directory.") + + (* ;; "Edited 19-Feb-93 16:04 by jds") + + (CL:WHEN DIRNAME + + (* ;; "The DIRNAME could be just {CORE}, which always is OK, or {CORE}xxx. If the latter, then we want it to be a directory and not a file (assuming that xxx and xxx> can't both exist.") + + (IF (EQ (CHARCODE }) + (NTHCHARCODE DIRNAME -1)) + ELSE (CL:UNLESS (MEMB (NTHCHARCODE DIRNAME -1) + (CHARCODE (> /))) + (SETQ DIRNAME (CONCAT DIRNAME ">"))) + + (* ;; "DIRPOS because caller may not have stripped off the device. This will match the first < or / (or >)") + + (FOR ENTRY (DIRPOS _ (STRPOS "<" DIRNAME 1 NIL NIL NIL FILEDIRCASEARRAY)) + FIRST (CL:UNLESS (EQ DIRPOS 1) + (SETQ DIRNAME (SUBSTRING DIRNAME DIRPOS))) + IN (CDR (FETCH COREDIRECTORY OF DEV)) WHEN (STRPOS DIRNAME (CAR ENTRY) + 1 NIL T NIL FILEDIRCASEARRAY) + DO (RETURN T))))]) (\CORE.FINDPAGE [LAMBDA (STREAM PN) (* bvm%: "20-Apr-85 13:32") @@ -351,28 +377,30 @@ Copyright (c) 1981-1988, 1990, 1993, 1999, 2018 by Venue & Xerox Corporation. (RETURN INFOBLOCK]) (\CORE.NAMESCAN - [LAMBDA (NAME NAMELST CREATEFLG) (* ; "Edited 23-Oct-87 17:11 by bvm:") + [LAMBDA (NAME NAMELST CREATEFLG) + + (* ;; "Edited 11-Jan-2022 09:30 by rmk: Matching with FILEDIRCASEARRAY, for /") + + (* ;; "Edited 23-Oct-87 17:11 by bvm:") + (COND ((LISTP NAMELST) (bind NEWSEG NEXTNAME while [AND (CDR NAMELST) - (COND - ((STRING-EQUAL (SETQ NEXTNAME (CAAR (CDR NAMELST) - )) - NAME) + (COND + ((STRING.EQUAL (SETQ NEXTNAME (CAAR (CDR NAMELST))) + NAME FILEDIRCASEARRAY) (* ; "Found it") - (RETURN (CADR NAMELST))) - (T (UALPHORDER NEXTNAME NAME] - do (* ; - "Segments are in order, so stop when (CDR NAMELST) is lexicographically greater than NAME") - (SETQ NAMELST (CDR NAMELST)) finally (RETURN (COND - ((AND CREATEFLG (SETQ NEWSEG - ( - \CORE.NAMESEGMENT - NAME))) - (RPLACD NAMELST - (CONS NEWSEG - (CDR NAMELST))) - NEWSEG]) + (RETURN (CADR NAMELST))) + (T (ALPHORDER NEXTNAME NAME FILEDIRCASEARRAY] + do (* ; + "Segments are in order, so stop when (CDR NAMELST) is lexicographically greater than NAME") + (SETQ NAMELST (CDR NAMELST)) finally (RETURN (COND + ((AND CREATEFLG (SETQ NEWSEG + (\CORE.NAMESEGMENT + NAME))) + (RPLACD NAMELST (CONS NEWSEG + (CDR NAMELST))) + NEWSEG]) (\CORE.NAMESEGMENT [LAMBDA (NAME) (* rmk%: "24-FEB-84 21:14") @@ -710,7 +738,12 @@ Copyright (c) 1981-1988, 1990, 1993, 1999, 2018 by Venue & Xerox Corporation. (RETURN T]) (\CORE.UNPACKFILENAME - [LAMBDA (NAME) (* ; "Edited 3-Nov-87 12:12 by bvm:") + [LAMBDA (NAME) (* ; "Edited 10-Jan-2022 22:42 by rmk") + + (* ;; "rmk; Convert / in ROOT to < or >") + (* ; "Edited 10-Jan-2022 21:14 by rmk") + + (* ;; "Edited 3-Nov-87 12:12 by bvm:") (* ;; "Breaks up a file name atom into its fields which it sets freely in its caller") @@ -729,6 +762,17 @@ Copyright (c) 1981-1988, 1990, 1993, 1999, 2018 by Venue & Xerox Corporation. (SETQ DOT SEMI))) (SETQ ROOT (OR (SUBSTRING NAME START (SUB1 DOT)) "")) + (CL:WHEN (STRPOS "/" ROOT) + + (* ;; "If ROOT has slashes, convert to < ..> ..>") + + (SETQ ROOT (DSUBST (CHARCODE >) + (CHARCODE /) + (CHCON ROOT))) + (CL:WHEN (EQ (CAR ROOT) + (CHARCODE >)) + (RPLACA ROOT (CHARCODE <))) + (SETQ ROOT (CONCATCODES ROOT))) (SETQ EXT (COND ((< DOT (- SEMI 1)) (SUBSTRING NAME (ADD1 DOT) @@ -858,6 +902,24 @@ Copyright (c) 1981-1988, 1990, 1993, 1999, 2018 by Venue & Xerox Corporation. (\CORE.SETACCESSTIME NAME ACCESS) NAME]) ) +(DEFINEQ + +(FILEDIRCASEARRAY + [LAMBDA NIL (* ; "Edited 8-Jan-2022 20:15 by rmk") + + (* ;; "Returns a case array suitable for case insensitive directory matching: <, >, and / all map together in any position. Presumably there are other well-formedness conditions that put < and > only in their proper positions.") + (* ; "Edited 8-Jan-2022 20:12 by rmk") + (for I (CA _ (CASEARRAY)) from (CHARCODE a) to (CHARCODE z) + do [SETCASEARRAY CA I (IDIFFERENCE I (CONSTANT (IDIFFERENCE (CHARCODE a) + (CHARCODE A] + finally (SETCASEARRAY CA (CHARCODE <) + (CHARCODE /)) + (SETCASEARRAY CA (CHARCODE >) + (CHARCODE /)) + (RETURN CA]) +) + +(RPAQ FILEDIRCASEARRAY (FILEDIRCASEARRAY)) (DECLARE%: DONTCOPY (DECLARE%: EVAL@COMPILE @@ -955,16 +1017,16 @@ Copyright (c) 1981-1988, 1990, 1993, 1999, 2018 by Venue & Xerox Corporation. (PUTPROPS COREIO COPYRIGHT ("Venue & Xerox Corporation" 1981 1982 1983 1984 1985 1986 1987 1988 1990 1993 1999 2018)) (DECLARE%: DONTCOPY - (FILEMAP (NIL (1707 44342 (\CORE.CLOSEFILE 1717 . 2490) (\CORE.DELETEFILE 2492 . 4478) ( -\CORE.DIRECTORYNAMEP 4480 . 4741) (\CORE.FINDPAGE 4743 . 7972) (\CORE.GENERATEFILES 7974 . 10561) ( -\CORE.NEXTFILEFN 10563 . 11062) (\CORE.FILEINFOFN 11064 . 11293) (\CORE.GETFILEHANDLE 11295 . 13449) ( -\CORE.GETFILEINFO 13451 . 14414) (\CORE.GETFILEINFO.FROM.INFOBLOCK 14416 . 15953) (\CORE.GETFILENAME -15955 . 18244) (\CORE.GETINFOBLOCK 18246 . 20869) (\CORE.NAMESCAN 20871 . 22638) (\CORE.NAMESEGMENT -22640 . 23077) (\CORE.OPENFILE 23079 . 26198) (\COREFILE.SETPARAMETERS 26200 . 28381) ( -\CORE.PACKFILENAME 28383 . 28778) (\CORE.RELEASEPAGES 28780 . 29381) (\CORE.SETFILEPTR 29383 . 30482) -(\CORE.UPDATEOF 30484 . 32113) (\CORE.BACKFILEPTR 32115 . 34323) (\CORE.SETEOFPTR 34325 . 36194) ( -\CORE.SETACCESSTIME 36196 . 36821) (\CORE.SETFILEINFO 36823 . 39125) (\CORE.GETNEXTBUFFER 39127 . -43083) (\CORE.UNPACKFILENAME 43085 . 44340)) (44343 47976 (COREDEVICE 44353 . 44524) ( -\CREATECOREDEVICE 44526 . 47974)) (47977 50278 (\NODIRCOREFDEV 47987 . 48584) (\NODIRCORE.OPENFILE -48586 . 50276))))) + (FILEMAP (NIL (1796 46254 (\CORE.CLOSEFILE 1806 . 2579) (\CORE.DELETEFILE 2581 . 4567) ( +\CORE.DIRECTORYNAMEP 4569 . 6250) (\CORE.FINDPAGE 6252 . 9481) (\CORE.GENERATEFILES 9483 . 12070) ( +\CORE.NEXTFILEFN 12072 . 12571) (\CORE.FILEINFOFN 12573 . 12802) (\CORE.GETFILEHANDLE 12804 . 14958) ( +\CORE.GETFILEINFO 14960 . 15923) (\CORE.GETFILEINFO.FROM.INFOBLOCK 15925 . 17462) (\CORE.GETFILENAME +17464 . 19753) (\CORE.GETINFOBLOCK 19755 . 22378) (\CORE.NAMESCAN 22380 . 23927) (\CORE.NAMESEGMENT +23929 . 24366) (\CORE.OPENFILE 24368 . 27487) (\COREFILE.SETPARAMETERS 27489 . 29670) ( +\CORE.PACKFILENAME 29672 . 30067) (\CORE.RELEASEPAGES 30069 . 30670) (\CORE.SETFILEPTR 30672 . 31771) +(\CORE.UPDATEOF 31773 . 33402) (\CORE.BACKFILEPTR 33404 . 35612) (\CORE.SETEOFPTR 35614 . 37483) ( +\CORE.SETACCESSTIME 37485 . 38110) (\CORE.SETFILEINFO 38112 . 40414) (\CORE.GETNEXTBUFFER 40416 . +44372) (\CORE.UNPACKFILENAME 44374 . 46252)) (46255 49888 (COREDEVICE 46265 . 46436) ( +\CREATECOREDEVICE 46438 . 49886)) (49889 52190 (\NODIRCOREFDEV 49899 . 50496) (\NODIRCORE.OPENFILE +50498 . 52188)) (52191 53096 (FILEDIRCASEARRAY 52201 . 53094))))) STOP diff --git a/sources/COREIO.LCOM b/sources/COREIO.LCOM index 97dd3e7a8c6494f9f8d6e3ec4e5ad7cfd428b3ae..b7187bd1f88992b18e3d6dd920215cd40b50495d 100644 GIT binary patch delta 1226 zcmZvb&uiRP5XU8L+Sp1`)~4h~8_FP(unMfKr`7(jVlR3ty^XZpmDW$PlRzNYmch#^ ziAf7B4XtS@A-&Zo{R2vSNFV{@buNXnr&4;$AuZ&TQxClv`UkX6^44~0>-6S3^XAQb zH1o|@{I3uAZ?CD%(FB|H#1WWf;mhawP z>%}V(h%2A2-TUaGk*t+Y-|XE1sX5n^=_Kkk~Bf zh>9fG_+oY(=^&PCs;VX5^JkM!O7C2f!RS)5;QI4H(Pr1#ZM0u9s$?Z=8~05f4K52t zZXKFXg7i7tr4|kdrWD_hfxDmMIl+v!Zr%Pze9|{&|TT;)!+uwO&y4f`r>g1juTg|WYKbbAQzuH?J#clNRj&ObRPp*Ja z34)Mz{Qzn;2<98iaJ{Qg)&Gy^wzD)qB2TjJctV7c# z3+x0H4Wt=q5_A=$x&&Gc3QW?g^5EyU{>rCZ&{14Wp67Bnw>>kF=diFPVS(o(bM8di z!T>t-sfnnD~&us&DCCA{zpT&z~DW!>= z;5vVAoomH2@l@8;u$8u%9b5U98^!QyS9kj_Z*2a~SgH_^aBp^@RDILdSiR>D2Cz={ z20g7|@YwiKAWbh2kNDw*1xy3T7V_YR99CpmhC^L8T-m z;CfBJ(f&{dF?lgd-cMyVjjlzYFgNeBZB3OlkC>?S76JuAmX=K`?c%vZ#T~9;@MZm> F@GllCDXjni delta 684 zcmZuv&5P4e5KmHZ*|3LJMNxDaf=Y8pn!F^7eSS2r=}QwgO+u2Y1rOG3k!sytWDysU z1rMS(CF)raZwg|2l|A}TcoDn^dJz8sU$!nR>N`AUn3>BbUZ$0K2zrb-q;)eX~s)yRP3gkJKaZmP5xFh~d~;o9B8yAE0%BMY1P51veF z0xtDr;7;%yC)hVQ_Qc|=@SHte@CGmEi|ppFGFL?=gp4^!LD!%g#>81J+=ryYHjyQM z*k*1lX!!|svMA}XY_hrkTX~DYUtsVhQkvpQnIpmnAOg=1>>Z}(+bk*1;ul1?F1-KJ zoF1@uc&|+7iARKEM?J=G*8dnS7*pEr&@cnTfG!DQFG^Z80cOq#Fi!nW98hH@N|}5= za`rI)CabW_FN%KXXUsg)l0tDHyT{QCmSxDlHfZkH2j_~4 X%<^~5#k_ATb0Vma$?{~|ek}Y30LZIv