From 8e22a4dcb9ae48b6d895801d223e914a1b2e31e5 Mon Sep 17 00:00:00 2001 From: rmkaplan <69548581+rmkaplan@users.noreply.github.com> Date: Mon, 13 May 2024 15:27:52 -0700 Subject: [PATCH] UNPACKFILENAME produces lt-gt for top-level directory (#1696) * UNPACKFILENAME produces <> for top-level directory For virtually any combination of leading <, > or /. Addresses #1685. * Produce < instead of <> for top-level empty directory Does not yet deal with all combinations of directory-internal bracket sequences --- sources/ADIR | 98 ++++++++++++++++++++++------------------------ sources/ADIR.LCOM | Bin 19564 -> 19441 bytes 2 files changed, 47 insertions(+), 51 deletions(-) diff --git a/sources/ADIR b/sources/ADIR index 2000ef9a..d88e0bed 100644 --- a/sources/ADIR +++ b/sources/ADIR @@ -1,12 +1,12 @@ (DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10) -(FILECREATED " 9-Mar-2024 10:24:39" {WMEDLEY}ADIR.;38 67777 +(FILECREATED " 6-May-2024 15:54:01" {WMEDLEY}ADIR.;45 67756 :EDIT-BY rmk - :CHANGES-TO (FNS UNPACKFILENAME.STRING FILENAMEFIELD FILENAMEFIELD.STRING \UPF.DIRECTORY) + :CHANGES-TO (FNS \UPF.DIRECTORY) - :PREVIOUS-DATE "13-Nov-2023 20:28:57" {WMEDLEY}ADIR.;31) + :PREVIOUS-DATE " 4-May-2024 16:25:09" {WMEDLEY}ADIR.;44) (PRETTYCOMPRINT ADIRCOMS) @@ -317,7 +317,8 @@ (DEFINEQ (UNPACKFILENAME.STRING - [LAMBDA (FILE ONEFIELDFLG DIRFLG OSTYPE PACKFLG CLFLG) (* ; "Edited 9-Mar-2024 10:23 by rmk") + [LAMBDA (FILE ONEFIELDFLG DIRFLG OSTYPE PACKFLG CLFLG) (* ; "Edited 4-May-2024 12:45 by rmk") + (* ; "Edited 9-Mar-2024 10:23 by rmk") (* ; "Edited 13-Nov-2023 20:28 by rmk") (* ; "Edited 28-Apr-2022 11:40 by rmk") (* ; "Edited 24-Apr-2022 14:11 by rmk") @@ -350,7 +351,6 @@ (* ;; "") (* ;; " If there is at least one / or > then the last one ends the directory, anything before is possibly a relative or subdirectory. Anything after is a name") - (* ; "") (* ;; " (Rationale: Those are not sub-directory brackets)") @@ -662,52 +662,48 @@ (PUSH $$VAL F FVAL]) (\UPF.DIRECTORY - [LAMBDA (DIRSTART DIREND DIRDIRTY $$BASE $$FATP $$READONLY)(* ; "Edited 8-Mar-2024 23:03 by rmk") + [LAMBDA (DIRSTART DIREND DIRDIRTY $$BASE $$FATP $$READONLY)(* ; "Edited 6-May-2024 15:53 by rmk") + (* ; "Edited 4-May-2024 16:25 by rmk") + (* ; "Edited 8-Mar-2024 23:03 by rmk") (* ; "Edited 28-Apr-2022 09:15 by rmk") (* ; "Edited 27-Apr-2022 08:50 by rmk") (* ; "Edited 23-Apr-2022 17:09 by rmk") - (* ;; "Relative directory {abc}, subdirectory >foo or > with no host or device (DIRSTART=1). ") + (* ;; "Extract the directory field, producing <> for the empty (top-level) directory, normalizing / to < or >.") - (* ;; "Advance DIRSTART through initial duplicates") + (if (ILEQ DIREND DIRSTART) + then + (* ;; "An empty directory field is interpreted as the top as per issue #1685: xy /xy all map to <>") - (LET ((BRACKET (SELCHARQ (\GETBASECHAR $$FATP $$BASE DIRSTART) - ((< /) - "<") - (> ">") - NIL))) - (IF (EQ DIREND DIRSTART) - THEN - (* ;; "If EQ, the directory is is empty.") + (MKSTRING "<") + else (CL:WHEN (MEMB (\GETBASECHAR $$FATP $$BASE DIRSTART) + (CHARCODE (< / >))) (* ; "Skip leading brackets") + (ADD DIRSTART 1)) - (MKSTRING "") - ELSE (CL:WHEN BRACKET (* ; "Skip the < or /") - (ADD DIRSTART 1)) + (* ;; + "If DIRDIRTY, the string contained at least one / that has to be converted to < or >") - (* ;; - "Convert / to >, remove all // /> >> duplicate sequences (keep the first, skip the others)") + (IF DIRDIRTY + THEN (FOR DIROFF C DEST DESTBASE (DESTPOS _ -1) FROM DIRSTART TO DIREND + FIRST (SETQ DEST (ALLOCSTRING (ADD1 (IDIFFERENCE DIREND DIRSTART)) + NIL NIL $$FATP)) + (SETQ DESTBASE (FETCH (STRINGP BASE) OF DEST)) + DO (ADD DESTPOS 1) + (SETQ C (\GETBASECHAR $$FATP $$BASE DIROFF)) + (SELCHARQ C + ((> /) + (\PUTBASECHAR $$FATP DESTBASE DESTPOS (CHARCODE >)) - (IF DIRDIRTY - THEN (FOR DIROFF C DEST DESTBASE (DESTPOS _ -1) FROM DIRSTART TO DIREND - FIRST (SETQ DEST (ALLOCSTRING (ADD1 (IDIFFERENCE DIREND DIRSTART)) - NIL NIL $$FATP)) - (SETQ DESTBASE (FETCH (STRINGP BASE) OF DEST)) - DO (ADD DESTPOS 1) - (SETQ C (\GETBASECHAR $$FATP $$BASE DIROFF)) - (SELCHARQ C - ((> /) - (\PUTBASECHAR $$FATP DESTBASE DESTPOS (CHARCODE >)) + (* ;; "Advance past duplicates") - (* ;; "Advance past duplicates") - - (FIND I FROM (ADD1 DIROFF) TO DIREND - WHILE (FMEMB (\GETBASECHAR $$FATP $$BASE I) - (CHARCODE (> /))) - FINALLY (SETQ DIROFF (SUB1 I)))) - (\PUTBASECHAR $$FATP DESTBASE DESTPOS C)) - FINALLY (REPLACE (STRINGP LENGTH) OF DEST WITH DESTPOS) - (RETURN DEST)) - ELSE (\UPF.EXTRACT DIRSTART (SUB1 DIREND]) + (FIND I FROM (ADD1 DIROFF) TO DIREND + WHILE (FMEMB (\GETBASECHAR $$FATP $$BASE I) + (CHARCODE (> /))) FINALLY (SETQ DIROFF + (SUB1 I)))) + (\PUTBASECHAR $$FATP DESTBASE DESTPOS C)) + FINALLY (REPLACE (STRINGP LENGTH) OF DEST WITH DESTPOS) + (RETURN DEST)) + ELSE (\UPF.EXTRACT DIRSTART (SUB1 DIREND]) ) (DECLARE%: DONTCOPY (DECLARE%: EVAL@COMPILE @@ -1254,14 +1250,14 @@ (ADDTOVAR LAMA PACKFILENAME.STRING PACKFILENAME) ) (DECLARE%: DONTCOPY - (FILEMAP (NIL (3169 15826 (DELFILE 3179 . 3340) (FULLNAME 3342 . 3709) (INFILE 3711 . 3970) (INFILEP -3972 . 4107) (IOFILE 4109 . 4360) (OPENFILE 4362 . 4665) (OPENSTREAM 4667 . 9007) (OUTFILE 9009 . 9271 -) (OUTFILEP 9273 . 9409) (RENAMEFILE 9411 . 9717) (SIMPLE.FINDFILE 9719 . 10129) (VMEMSIZE 10131 . -10298) (\COPYSYS 10300 . 14545) (\FLUSHVM 14547 . 15619) (\LOGOUT0 15621 . 15824)) (16284 38972 ( -UNPACKFILENAME.STRING 16294 . 36274) (\UPF.DIRECTORY 36276 . 38970)) (40500 42806 (UNPACKFILENAME -40510 . 40696) (LASTCHPOS 40698 . 41392) (FILENAMEFIELD 41394 . 41688) (FILENAMEFIELD.STRING 41690 . -42094) (PACKFILENAME 42096 . 42439) (PACKFILENAME.STRING 42441 . 42804)) (57276 58189 ( -FILEDIRCASEARRAY 57286 . 58187)) (58356 65536 (LOGOUT 58366 . 59283) (MAKESYS 59285 . 60914) (SYSOUT -60916 . 62468) (SAVEVM 62470 . 63270) (HERALD 63272 . 63432) (INTERPRET.REM.CM 63434 . 65159) ( -\USEREVENT 65161 . 65534)) (65718 67445 (USERNAME 65728 . 66684) (SETUSERNAME 66686 . 67443))))) + (FILEMAP (NIL (3112 15769 (DELFILE 3122 . 3283) (FULLNAME 3285 . 3652) (INFILE 3654 . 3913) (INFILEP +3915 . 4050) (IOFILE 4052 . 4303) (OPENFILE 4305 . 4608) (OPENSTREAM 4610 . 8950) (OUTFILE 8952 . 9214 +) (OUTFILEP 9216 . 9352) (RENAMEFILE 9354 . 9660) (SIMPLE.FINDFILE 9662 . 10072) (VMEMSIZE 10074 . +10241) (\COPYSYS 10243 . 14488) (\FLUSHVM 14490 . 15562) (\LOGOUT0 15564 . 15767)) (16227 38951 ( +UNPACKFILENAME.STRING 16237 . 36252) (\UPF.DIRECTORY 36254 . 38949)) (40479 42785 (UNPACKFILENAME +40489 . 40675) (LASTCHPOS 40677 . 41371) (FILENAMEFIELD 41373 . 41667) (FILENAMEFIELD.STRING 41669 . +42073) (PACKFILENAME 42075 . 42418) (PACKFILENAME.STRING 42420 . 42783)) (57255 58168 ( +FILEDIRCASEARRAY 57265 . 58166)) (58335 65515 (LOGOUT 58345 . 59262) (MAKESYS 59264 . 60893) (SYSOUT +60895 . 62447) (SAVEVM 62449 . 63249) (HERALD 63251 . 63411) (INTERPRET.REM.CM 63413 . 65138) ( +\USEREVENT 65140 . 65513)) (65697 67424 (USERNAME 65707 . 66663) (SETUSERNAME 66665 . 67422))))) STOP diff --git a/sources/ADIR.LCOM b/sources/ADIR.LCOM index 46046aa7e220748ec3734547ee3710d7faef7e14..fbb324e03e20a707c1468607af8992c4d7a13327 100644 GIT binary patch delta 741 zcmaDegYn~Z#t9L^X1czKmAXa-MkWe|rdFmVRtAO>v$Z5lOf?mh6p$s2txPSgj3%y? z$czaMaMN?~403f2@ehhr$jnnvatrnGQ9xF%r>Cc+kdj!Enu66BQzcC<4L468SLYyC z#}HQ+G(|9nR7-J~m@1f=o12oQyE}UR!a&|Zb z7UcqoPIbt>lEkpzY0*Z86OInK{{@5D9UX3F-^fUD;Q`6Vq?}?B$ojApY((QphP|F1 zpEp-~Wnb9^G|m%joadqF9J>!oy>s+GZ1Q!P?(20Sr{3-?LyNChj@|M7j-J^!;`#RP z^XE(P`@C6czsodde?FkTW*~Ja1*maJ3Q*&u{h5vXGnV@EW#8N&2_&z?^KH23G7V^! z_gRK!UoY?D`#rO-L~dyH$zk#0203iMPYxT5mBK18eZP-ahLi}0kAR>9bB-vVd`gB0 z!~T@4^GrZ8`#h7ueuv1(8|1|6Jnam6=DKHL!2CgUEMq*0u+o5(FBZ)EKyY$8KMbT7`Q8_syYS*IY#P& z%mGHdf}@X*zjJU%kf)!!g0ZQBudA<<0?=e%Z-|&Cm!GE(mxh9|fr5safr5#-f|-$~ Lg2m=G`DZ!+!tve8 delta 736 zcmex3o$<{K#t9L^mb$))MY=`?MkWe|23AHUR>qbSv$Z6QEi@IB6fBS=jjW8#txP7a zm6&``U2L+UyK;19o&uMWTd0qZ0;u~BTMxF@_fR|^(4J-fd_apgxx38p7xKH1V|SLJ70Af3 zJHFr1H~Yq}on9%PpEt|z2kP?zYx4rS)(+y@N&7P!_h&5e%D%Zl+AI4?)P`#iL;U$5 zhWPUx-|w4!C3Zurzd#O)A2-Nx`+-a&HaI(lRbVDi$S*@mgu`DzK+u3Khfh8wLxf>} zO4fNMAenuh$zZ=j>|{MT@p|90%=;a)Z-V@~Cnbl)2V!7K4jYse2ht<3-_IGS-OqJm zb_3W50R|0YQzM0#fY1;p$6!}C&xim8V-qw1BU4jU6-Fi|r~-xt4n_*9s*XWHj*+?` zgA^<*6dZkg{GEeCf;|1)6--SOe7zxTO)fuAA1)0A6H5gpB?V)11tmKr1tYV~-15(K E0QN85OaK4?