From eb33dcc7eb3368e6b6a0b8058759f5361794bb49 Mon Sep 17 00:00:00 2001 From: rmkaplan Date: Sun, 24 Apr 2022 13:36:31 -0700 Subject: [PATCH 1/9] FILEIO: Added DEPTh parameter to \GENERATEFILES Binds FILING.ENUMERATION.DEPTH, uses free value of DEPTH not specified --- sources/FILEIO | 95 ++++++++++++++++++++++++-------------------- sources/FILEIO.LCOM | Bin 45452 -> 45612 bytes 2 files changed, 52 insertions(+), 43 deletions(-) diff --git a/sources/FILEIO b/sources/FILEIO index 24dd4816..92669732 100644 --- a/sources/FILEIO +++ b/sources/FILEIO @@ -1,10 +1,11 @@ (DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10) -(FILECREATED " 7-Mar-2022 21:22:44" {DSK}larry>medley>sources>FILEIO.;2 160473 +(FILECREATED "29-Mar-2022 08:52:23" {DSK}kaplan>Local>medley3.5>my-medley>sources>FILEIO.;107 160995 - :CHANGES-TO (RECORDS FDEV) + :CHANGES-TO (FNS \GENERATEFILES) - :PREVIOUS-DATE "13-Jan-2022 19:45:36" {DSK}larry>medley>sources>FILEIO.;1) + :PREVIOUS-DATE " 7-Mar-2022 21:22:44" +{DSK}kaplan>Local>medley3.5>my-medley>sources>FILEIO.;106) (* ; " @@ -1324,13 +1325,21 @@ Copyright (c) 1981-1993, 1999, 2020-2022 by Venue & Xerox Corporation. T]) (\GENERATEFILES - [LAMBDA (PATTERN DESIREDPROPS OPTIONS) (* bvm%: "27-Apr-84 23:21") + [LAMBDA (PATTERN DESIREDPROPS OPTIONS DEPTH) - (* ;; "Returns a file-generator object that will generate all files whose names match PATTERN. A gen-object consists of a device dependent NEXTFILEFN and GENFILESTATE") + (* ;; "Edited 29-Mar-2022 08:52 by rmk: Added local DEPTH parameter, defaults to the free FILING.ENUMERATION.DEPTH.") + (* bvm%: "27-Apr-84 23:21") + + (* ;; "Returns a file-generator object that will generate all files whose names match PATTERN. A gen-object consists of a device dependent NEXTFILEFN and GENFILESTATE") (SETQ PATTERN (\ADD.CONNECTED.DIR PATTERN)) - (PROG ((FDEV (\GETDEVICEFROMNAME PATTERN))) - (RETURN (FDEVOP 'GENERATEFILES FDEV FDEV PATTERN DESIREDPROPS OPTIONS]) + (LET ((FDEV (\GETDEVICEFROMNAME PATTERN)) + (FILING.ENUMERATION.DEPTH (IF (FIXP DEPTH) + ELSEIF DEPTH + THEN MAX.SMALLP + ELSE FILING.ENUMERATION.DEPTH))) + (DECLARE (SPECVARS FILING.ENUMERATION.DEPTH)) + (FDEVOP 'GENERATEFILES FDEV FDEV PATTERN DESIREDPROPS OPTIONS]) (\GENERATENEXTFILE [LAMBDA (GENOBJ NAMEONLY) (* bvm%: " 8-Jul-85 19:30") @@ -3088,40 +3097,40 @@ update the map") (PUTPROPS FILEIO COPYRIGHT ("Venue & Xerox Corporation" 1981 1982 1983 1984 1985 1986 1987 1988 1989 1990 1991 1992 1993 1999 2020 2021 2022)) (DECLARE%: DONTCOPY - (FILEMAP (NIL (26807 30285 (STREAMPROP 26817 . 27251) (GETSTREAMPROP 27253 . 27722) (PUTSTREAMPROP -27724 . 30133) (STREAMP 30135 . 30283)) (30328 32847 (\DEFPRINT.BY.NAME 30338 . 31490) ( -\STREAM.DEFPRINT 31492 . 32540) (\FDEV.DEFPRINT 32542 . 32845)) (33105 38146 (\GETACCESS 33115 . 33569 -) (\SETACCESS 33571 . 38144)) (58308 64277 (\DEFINEDEVICE 58318 . 60634) (\GETDEVICEFROMNAME 60636 . -61109) (\GETDEVICEFROMHOSTNAME 61111 . 62155) (\REMOVEDEVICE 62157 . 63280) (\REMOVEDEVICE.NAMES 63282 - . 64275)) (64317 88594 (\CLOSEFILE 64327 . 65152) (\DELETEFILE 65154 . 65448) (\DEVICEEVENT 65450 . -67220) (\GENERATEFILES 67222 . 67700) (\GENERATENEXTFILE 67702 . 68353) (\GENERATEFILEINFO 68355 . -68816) (\GETFILENAME 68818 . 69207) (\GENERIC.OUTFILEP 69209 . 69679) (\OPENFILE 69681 . 72259) ( -\DO.PARAMS.AT.OPEN 72261 . 74431) (\RENAMEFILE 74433 . 74857) (\REVALIDATEFILE 74859 . 77461) ( -\PAGED.REVALIDATEFILELST 77463 . 79021) (\PAGED.REVALIDATEFILES 79023 . 80742) (\PAGED.REVALIDATEFILE -80744 . 83027) (\BUFFERED.REVALIDATEFILE 83029 . 85315) (\BUFFERED.REVALIDATEFILELST 85317 . 86501) ( -\PRINT-REVALIDATION-RESULT 86503 . 86918) (\TRUNCATEFILE 86920 . 87311) (\FILE-CONFLICT 87313 . 88592) -) (88630 93293 (\GENERATENOFILES 88640 . 90736) (\NULLFILEGENERATOR 90738 . 90982) (\NOFILESNEXTFILEFN - 90984 . 92975) (\NOFILESINFOFN 92977 . 93291)) (93412 95320 (\FILE.NOT.OPEN 93422 . 93935) ( -\FILE.WONT.OPEN 93937 . 94265) (\ILLEGAL.DEVICEOP 94267 . 94549) (\IS.NOT.RANDACCESSP 94551 . 94997) ( -\STREAM.NOT.OPEN 94999 . 95318)) (95455 97753 (\FDEVINSTANCE 95465 . 97751)) (98955 106329 (CNDIR -98965 . 100270) (DIRECTORYNAME 100272 . 104455) (DIRECTORYNAMEP 104457 . 105073) (HOSTNAMEP 105075 . -105882) (\ADD.CONNECTED.DIR 105884 . 106327)) (106374 134254 (\BACKFILEPTR 106384 . 106572) ( -\BACKPEEKBIN 106574 . 106935) (\BACKBIN 106937 . 107288) (BIN 107290 . 107507) (\BIN 107509 . 107786) -(\BINS 107788 . 108074) (BOUT 108076 . 108438) (\BOUT 108440 . 108755) (\BOUTS 108757 . 109068) ( -COPYBYTES 109070 . 112402) (COPYCHARS 112404 . 116070) (COPYFILE 116072 . 116869) (\COPYOPENFILE -116871 . 119944) (\INFER.FILE.TYPE 119946 . 120900) (EOFP 120902 . 121199) (FORCEOUTPUT 121201 . -121448) (\FLUSH.OPEN.STREAMS 121450 . 121806) (CHARSET 121808 . 123472) (ACCESS-CHARSET 123474 . -123691) (GETEOFPTR 123693 . 123943) (GETFILEINFO 123945 . 127138) (\TYPE.FROM.FILETYPE 127140 . 127610 -) (\FILETYPE.FROM.TYPE 127612 . 127791) (GETFILEPTR 127793 . 128045) (SETFILEINFO 128047 . 132153) ( -SETFILEPTR 132155 . 133874) (BOUT16 133876 . 134061) (BIN16 134063 . 134252)) (134357 139562 ( -\GENERIC.BINS 134367 . 134647) (\GENERIC.BOUTS 134649 . 134914) (\GENERIC.RENAMEFILE 134916 . 136747) -(\GENERIC.OPENP 136749 . 138064) (\GENERIC.READP 138066 . 139107) (\GENERIC.CHARSET 139109 . 139560)) -(139563 139902 (\MAP-OPEN-STREAMS 139573 . 139900)) (141686 143766 (\EOF.ACTION 141696 . 141947) ( -\EOSERROR 141949 . 142142) (\GETEOFPTR 142144 . 142326) (\INCFILEPTR 142328 . 142678) (\PEEKBIN 142680 - . 142871) (\SETCLOSEDFILELENGTH 142873 . 143207) (\SETEOFPTR 143209 . 143397) (\SETFILEPTR 143399 . -143764)) (143767 144309 (\FIXPOUT 143777 . 144077) (\FIXPIN 144079 . 144307)) (144310 144876 (\BOUTEOL - 144320 . 144874)) (147772 157636 (\BUFFERED.BIN 147782 . 148634) (\BUFFERED.PEEKBIN 148636 . 149418) -(\BUFFERED.BOUT 149420 . 150280) (\BUFFERED.BINS 150282 . 153967) (\BUFFERED.BOUTS 153969 . 155770) ( -\BUFFERED.COPYBYTES 155772 . 157634)) (157665 160017 (\NULLDEVICE 157675 . 159693) (\NULL.OPENFILE -159695 . 160015))))) + (FILEMAP (NIL (26860 30338 (STREAMPROP 26870 . 27304) (GETSTREAMPROP 27306 . 27775) (PUTSTREAMPROP +27777 . 30186) (STREAMP 30188 . 30336)) (30381 32900 (\DEFPRINT.BY.NAME 30391 . 31543) ( +\STREAM.DEFPRINT 31545 . 32593) (\FDEV.DEFPRINT 32595 . 32898)) (33158 38199 (\GETACCESS 33168 . 33622 +) (\SETACCESS 33624 . 38197)) (58361 64330 (\DEFINEDEVICE 58371 . 60687) (\GETDEVICEFROMNAME 60689 . +61162) (\GETDEVICEFROMHOSTNAME 61164 . 62208) (\REMOVEDEVICE 62210 . 63333) (\REMOVEDEVICE.NAMES 63335 + . 64328)) (64370 89116 (\CLOSEFILE 64380 . 65205) (\DELETEFILE 65207 . 65501) (\DEVICEEVENT 65503 . +67273) (\GENERATEFILES 67275 . 68222) (\GENERATENEXTFILE 68224 . 68875) (\GENERATEFILEINFO 68877 . +69338) (\GETFILENAME 69340 . 69729) (\GENERIC.OUTFILEP 69731 . 70201) (\OPENFILE 70203 . 72781) ( +\DO.PARAMS.AT.OPEN 72783 . 74953) (\RENAMEFILE 74955 . 75379) (\REVALIDATEFILE 75381 . 77983) ( +\PAGED.REVALIDATEFILELST 77985 . 79543) (\PAGED.REVALIDATEFILES 79545 . 81264) (\PAGED.REVALIDATEFILE +81266 . 83549) (\BUFFERED.REVALIDATEFILE 83551 . 85837) (\BUFFERED.REVALIDATEFILELST 85839 . 87023) ( +\PRINT-REVALIDATION-RESULT 87025 . 87440) (\TRUNCATEFILE 87442 . 87833) (\FILE-CONFLICT 87835 . 89114) +) (89152 93815 (\GENERATENOFILES 89162 . 91258) (\NULLFILEGENERATOR 91260 . 91504) (\NOFILESNEXTFILEFN + 91506 . 93497) (\NOFILESINFOFN 93499 . 93813)) (93934 95842 (\FILE.NOT.OPEN 93944 . 94457) ( +\FILE.WONT.OPEN 94459 . 94787) (\ILLEGAL.DEVICEOP 94789 . 95071) (\IS.NOT.RANDACCESSP 95073 . 95519) ( +\STREAM.NOT.OPEN 95521 . 95840)) (95977 98275 (\FDEVINSTANCE 95987 . 98273)) (99477 106851 (CNDIR +99487 . 100792) (DIRECTORYNAME 100794 . 104977) (DIRECTORYNAMEP 104979 . 105595) (HOSTNAMEP 105597 . +106404) (\ADD.CONNECTED.DIR 106406 . 106849)) (106896 134776 (\BACKFILEPTR 106906 . 107094) ( +\BACKPEEKBIN 107096 . 107457) (\BACKBIN 107459 . 107810) (BIN 107812 . 108029) (\BIN 108031 . 108308) +(\BINS 108310 . 108596) (BOUT 108598 . 108960) (\BOUT 108962 . 109277) (\BOUTS 109279 . 109590) ( +COPYBYTES 109592 . 112924) (COPYCHARS 112926 . 116592) (COPYFILE 116594 . 117391) (\COPYOPENFILE +117393 . 120466) (\INFER.FILE.TYPE 120468 . 121422) (EOFP 121424 . 121721) (FORCEOUTPUT 121723 . +121970) (\FLUSH.OPEN.STREAMS 121972 . 122328) (CHARSET 122330 . 123994) (ACCESS-CHARSET 123996 . +124213) (GETEOFPTR 124215 . 124465) (GETFILEINFO 124467 . 127660) (\TYPE.FROM.FILETYPE 127662 . 128132 +) (\FILETYPE.FROM.TYPE 128134 . 128313) (GETFILEPTR 128315 . 128567) (SETFILEINFO 128569 . 132675) ( +SETFILEPTR 132677 . 134396) (BOUT16 134398 . 134583) (BIN16 134585 . 134774)) (134879 140084 ( +\GENERIC.BINS 134889 . 135169) (\GENERIC.BOUTS 135171 . 135436) (\GENERIC.RENAMEFILE 135438 . 137269) +(\GENERIC.OPENP 137271 . 138586) (\GENERIC.READP 138588 . 139629) (\GENERIC.CHARSET 139631 . 140082)) +(140085 140424 (\MAP-OPEN-STREAMS 140095 . 140422)) (142208 144288 (\EOF.ACTION 142218 . 142469) ( +\EOSERROR 142471 . 142664) (\GETEOFPTR 142666 . 142848) (\INCFILEPTR 142850 . 143200) (\PEEKBIN 143202 + . 143393) (\SETCLOSEDFILELENGTH 143395 . 143729) (\SETEOFPTR 143731 . 143919) (\SETFILEPTR 143921 . +144286)) (144289 144831 (\FIXPOUT 144299 . 144599) (\FIXPIN 144601 . 144829)) (144832 145398 (\BOUTEOL + 144842 . 145396)) (148294 158158 (\BUFFERED.BIN 148304 . 149156) (\BUFFERED.PEEKBIN 149158 . 149940) +(\BUFFERED.BOUT 149942 . 150802) (\BUFFERED.BINS 150804 . 154489) (\BUFFERED.BOUTS 154491 . 156292) ( +\BUFFERED.COPYBYTES 156294 . 158156)) (158187 160539 (\NULLDEVICE 158197 . 160215) (\NULL.OPENFILE +160217 . 160537))))) STOP diff --git a/sources/FILEIO.LCOM b/sources/FILEIO.LCOM index 7416487ba526d726a471e9f4204b6e63cd60724b..1e8a6641d2ae69e8903d159c50311849b8e62ad5 100644 GIT binary patch delta 592 zcmeBq%(UhS(}ZweBTHT1#3EfI10y2^0}CrtBP$~lB?S$oa$z|zuG!OGdg(a+sA zSU1F9LBq{27|qF=3RVF@u3?`3p~1Q?K-+;KW{%{4Ly-SXfWb;+Fhas~@=-=1CIhp{ z`xZ!V{=~RLhQnCF#Wf(rLt*kNIpunV00lz@pocyE-1S`jLVZEu=jrdK2T|gtV2o2z zQ-MLBnUR6Tfs+9Uk{D9Jv~!BF!qUlk|Nl1x3korLuz}=GO6>A*aCFLH@!}I;&@eOx d`8vb}=uc(3Qxx*^6qFRIU4p%9Z8Gw6Q|)pRi;61k zCJQi$*Bfana49L6>iQ-Y=^7ar87UYVS{YhcnHni6Bo(E?O-Rm2%u7!#R<%;d%P+~u z%u83u1e)m<>f@t;tXWS_Pe~yqu>@!*R#Q!tG`Td~Jbhf9gIpa$TwN3%gLPei<|!x{ z8tZx`=0Sa8X=P$+Wo(As>k^aW7D{h+W!fP#nN?m{Pg8+Gg^7WI*@2S*2$C35z_g$s pqX!#E;H1P(4+lr592QSL0R|1j$qCA$lQ+nVGZ`6eJ}I9(2>=*&Wa$6^ From 9f5a43abd110229c1b9a5b437e4d30b06477a56c Mon Sep 17 00:00:00 2001 From: rmkaplan Date: Sun, 24 Apr 2022 13:36:50 -0700 Subject: [PATCH 2/9] DIRECTORY: minor cleanup, comments --- sources/DIRECTORY | 231 +++++++++++++++++++++++++---------------- sources/DIRECTORY.LCOM | Bin 11143 -> 11187 bytes 2 files changed, 139 insertions(+), 92 deletions(-) diff --git a/sources/DIRECTORY b/sources/DIRECTORY index 61415748..b5067edf 100644 --- a/sources/DIRECTORY +++ b/sources/DIRECTORY @@ -1,11 +1,11 @@ (DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10) -(FILECREATED " 5-Mar-2022 09:04:27" {DSK}kaplan>Local>medley3.5>my-medley>sources>DIRECTORY.;8 27503 +(FILECREATED "29-Mar-2022 10:53:16" {DSK}kaplan>Local>medley3.5>my-medley>sources>DIRECTORY.;15 28665 - :CHANGES-TO (FNS DIRECTORY FILDIR) + :CHANGES-TO (FNS DIRECTORY) - :PREVIOUS-DATE " 5-Mar-2022 08:46:23" -{DSK}kaplan>Local>medley3.5>my-medley>sources>DIRECTORY.;7) + :PREVIOUS-DATE "29-Mar-2022 08:29:33" +{DSK}kaplan>Local>medley3.5>my-medley>sources>DIRECTORY.;14) (* ; " @@ -49,8 +49,14 @@ Copyright (c) 1986-1988, 1990, 1992 by Venue & Xerox Corporation. (DIRECTORY [LAMBDA (FILES COMMANDS DEFAULTEXT DEFAULTVERS) - (DECLARE (SPECVARS COMMANDS DEFAULTEXT DEFAULTVERS)) (* ; "Edited 4-Mar-2022 23:17 by rmk") + (DECLARE (SPECVARS COMMANDS DEFAULTEXT DEFAULTVERS)) (* ; "Edited 29-Mar-2022 10:53 by rmk") + (* ; "Edited 26-Mar-2022 09:41 by rmk") + (* ; "Edited 4-Mar-2022 23:17 by rmk") (* ; "Edited 30-Apr-92 14:55 by jds") + (CL:UNLESS DEFAULTEXT + (SETQ DEFAULTEXT '*)) + (CL:UNLESS DEFAULTVERS + (SETQ DEFAULTVERS '*)) (PROG (VALUE COLUMNS NAMEFLG DELETEDONLY FILEGROUP PRINTFLG OUTFILE PROMPTFLG LASTHOST&DIR DESIREDPROPS PFLG HEADINGS VALUES-WANTED (FILING.ENUMERATION.DEPTH FILING.ENUMERATION.DEPTH)) @@ -114,7 +120,8 @@ Copyright (c) 1986-1988, 1990, 1992 by Venue & Xerox Corporation. (IGEQ (CADR COMTAIL) 0)) THEN (CADR COMTAIL) - ELSEIF (EQ T (CADR COMTAIL)) + ELSEIF (MEMB (U-CASE (CADR COMTAIL)) + '(T ALL)) THEN MAX.SMALLP ELSE (\ILLEGAL.ARG (CADR COMTAIL] @@ -205,17 +212,46 @@ Copyright (c) 1986-1988, 1990, 1992 by Venue & Xerox Corporation. (while (DIRECTORY.NEXTFILE FILEGROUP) do (DODIRCOMMANDS COMMANDS FILEGROUP)) (COND (PRINTFLG (TAB 0 0)))) - (RETURN (OR VALUE (COND - ((NOT VALUES-WANTED) - (CL:VALUES]) + + (* ;; "DREVERSE because files are pushed.") + + (RETURN (OR (DREVERSE VALUE) + (CL:UNLESS VALUES-WANTED (CL:VALUES]) (DIRECTORY.PARSE -(LAMBDA (FG) (* bvm%: "14-May-84 12:55") (* ;; "This pushes file generators on FILEGROUP for each of the atomic filespecifications it comes to.") (DECLARE (USEDFREE FILEGROUP DESIREDPROPS DEFAULTEXT DEFAULTVERS)) (PROG (TEMP) (RETURN (COND ((NLISTP FG) (push FILEGROUP (\GENERATEFILES (SETQ FG (DIRECTORY.FILL.PATTERN FG DEFAULTEXT DEFAULTVERS)) DESIREDPROPS (QUOTE (SORT RESETLST)))) (DIRECTORY.MATCH.SETUP FG)) ((SETQ TEMP (DIRCONJ (CADR FG))) (CONS TEMP (CONS (DIRECTORY.PARSE (CAR FG)) (DIRECTORY.PARSE (CADDR FG))))) ((SETQ TEMP (DIRCONJ (CAR FG))) (CONS TEMP (CONS (DIRECTORY.PARSE (CADR FG)) (DIRECTORY.PARSE (CADDR FG))))) (T (ERROR "Bad file-group conjunction" (CADR FG))))))) -) + [LAMBDA (FG) (* ; "Edited 26-Mar-2022 18:49 by rmk") + (* bvm%: "14-May-84 12:55") + + (* ;; + "This pushes file generators on FILEGROUP for each of the atomic filespecifications it comes to.") + + (DECLARE (USEDFREE FILEGROUP DESIREDPROPS DEFAULTEXT DEFAULTVERS)) + (LET (TEMP) + (COND + ((NLISTP FG) + [push FILEGROUP (\GENERATEFILES (SETQ FG (DIRECTORY.FILL.PATTERN FG DEFAULTEXT + DEFAULTVERS)) + DESIREDPROPS + '(SORT RESETLST] + (DIRECTORY.MATCH.SETUP FG)) + [(SETQ TEMP (DIRCONJ (CADR FG))) (* ; "Infix operator") + (CONS TEMP (CONS (DIRECTORY.PARSE (CAR FG)) + (DIRECTORY.PARSE (CADDR FG] + [(SETQ TEMP (DIRCONJ (CAR FG))) (* ; "Prefix operator") + (CONS TEMP (CONS (DIRECTORY.PARSE (CADR FG)) + (DIRECTORY.PARSE (CADDR FG] + (T (ERROR "Bad file-group conjunction" (CADR FG]) (DIRECTORY.FILL.PATTERN -(LAMBDA (PATTERN DEFAULTEXT DEFAULTVERS) (* bvm%: " 6-Feb-85 14:16") (DECLARE (GLOBALVARS \CONNECTED.DIRECTORY)) (PACKFILENAME.STRING (QUOTE BODY) PATTERN (QUOTE NAME) (QUOTE *) (QUOTE VERSION) (OR DEFAULTVERS (QUOTE *)) (QUOTE EXTENSION) (OR DEFAULTEXT (QUOTE *)) (QUOTE DIRECTORY) (AND (NOT (FILENAMEFIELD PATTERN (QUOTE HOST))) \CONNECTED.DIRECTORY))) -) + [LAMBDA (PATTERN DEFAULTEXT DEFAULTVERS) (* ; "Edited 26-Mar-2022 17:54 by rmk") + (* bvm%: " 6-Feb-85 14:16") + (DECLARE (GLOBALVARS \CONNECTED.DIRECTORY)) + (PACKFILENAME.STRING 'BODY PATTERN 'NAME '* 'VERSION (OR DEFAULTVERS '*) + 'EXTENSION + (OR DEFAULTEXT '*) + 'DIRECTORY + (AND (NOT (FILENAMEFIELD.STRING PATTERN 'HOST)) + \CONNECTED.DIRECTORY]) (DIRCONJ (LAMBDA (CONJ) (* rmk%: "29-OCT-81 11:01") (* ;; "Returns canonical form of directory conjunction, NIL if invalid") (SELECTQ CONJ ((OR +) (QUOTE OR)) ((AND *) (QUOTE AND)) ((- ANDNOT) (QUOTE ANDNOT)) NIL)) @@ -242,7 +278,8 @@ Copyright (c) 1986-1988, 1990, 1992 by Venue & Xerox Corporation. ) (DODIRCOMMANDS - [LAMBDA (COMMANDS FILEGROUP) (* ; "Edited 30-Apr-92 15:03 by jds") + [LAMBDA (COMMANDS FILEGROUP) (* ; "Edited 29-Mar-2022 08:16 by rmk") + (* ; "Edited 30-Apr-92 15:03 by jds") (PROG ((COMTAIL COMMANDS) (I 0) (FILENAME (fetch LITERALNAME of FILEGROUP)) @@ -259,82 +296,80 @@ Copyright (c) 1986-1988, 1990, 1992 by Venue & Xerox Corporation. (SETQ I 0))) (while COMTAIL do (SELECTQ (SETQ COM (pop COMTAIL)) - (P (DIRPRINTNAME FILEGROUP)) - (PP (DIRPRINTNAME FILEGROUP T)) - (COUNTSIZE (add VALUE (DIRGETFILEINFO FILEGROUP 'SIZE))) - (PAUSE (READC T) - (SETQ I (IPLUS I 2))) - (@ (* ; - "Arbitrary predicate -- next thing is form") - (AND NAMEFLG (DIRFILENAME FILEGROUP)) - (COND - ((NOT (EVAL (pop COMTAIL))) - (RETURN)))) - ((OLDERTHAN NEWERTHAN) - [LET ((COMDATE (pop COMTAIL)) - DT) - (COND - ([OR [EQ (EQ COM 'OLDERTHAN) - (OR (AND (SETQ DT (DIRGETFILEINFO FILEGROUP - 'ICREATIONDATE)) - (IGEQ DT COMDATE)) - (AND (SETQ DT (DIRGETFILEINFO FILEGROUP - 'IWRITEDATE)) - (IGEQ DT COMDATE] - (AND (EQ COM 'OLDERTHAN) - (AND (SETQ DT (DIRGETFILEINFO FILEGROUP - 'IREADDATE)) - (IGEQ DT COMDATE] + (P (DIRPRINTNAME FILEGROUP)) + (PP (DIRPRINTNAME FILEGROUP T)) + (COUNTSIZE (add VALUE (DIRGETFILEINFO FILEGROUP 'SIZE))) + (PAUSE (READC T) + (SETQ I (IPLUS I 2))) + (@ (* ; + "Arbitrary predicate -- next thing is form") + (AND NAMEFLG (DIRFILENAME FILEGROUP)) + (COND + ((NOT (EVAL (pop COMTAIL))) + (RETURN)))) + ((OLDERTHAN NEWERTHAN) + [LET ((COMDATE (pop COMTAIL)) + DT) + (COND + ([OR [EQ (EQ COM 'OLDERTHAN) + (OR (AND (SETQ DT (DIRGETFILEINFO FILEGROUP 'ICREATIONDATE) + ) + (IGEQ DT COMDATE)) + (AND (SETQ DT (DIRGETFILEINFO FILEGROUP 'IWRITEDATE)) + (IGEQ DT COMDATE] + (AND (EQ COM 'OLDERTHAN) + (AND (SETQ DT (DIRGETFILEINFO FILEGROUP 'IREADDATE)) + (IGEQ DT COMDATE] (* ;; "Only check Read date for the OLDERTHAN case, where it is useful for archiving. NEWERTHAN is only interested in files actually created recently") - (RETURN]) - (BY (SETQ COM (pop COMTAIL)) - (COND - ((AND (SETQ ATTRVALUE (DIRGETFILEINFO FILEGROUP 'AUTHOR)) - (NOT (STRPOS COM ATTRVALUE NIL NIL NIL NIL UPPERCASEARRAY))) - (RETURN)))) - (DELETE (DTAB 12) - (PRIN1 (COND - ((DELFILE (DIRFILENAME FILEGROUP)) - "deleted") - (T "can't delete")))) - (PROMPT (OR (DREAD (pop COMTAIL)) - (RETURN))) - (PRINT (DPRIN1 (pop COMTAIL))) - (COLLECT (SETQ VALUE (NCONC1 VALUE (DIRFILENAME FILEGROUP)))) - (OLDVERSIONS (* ; - "Not implemented, but user might continue from error in DIRECTORY") - (COND - ((NEQ (CAR COMTAIL) - 1) - (ERROR "can't count more than 1 version"))) - (COND - ((STRING.EQUAL (INFILEP (DIRFILENAME FILEGROUP)) - (INFILEP (PACKFILENAME 'VERSION NIL 'BODY FILENAME))) + (RETURN]) + (BY (SETQ COM (pop COMTAIL)) + (COND + ((AND (SETQ ATTRVALUE (DIRGETFILEINFO FILEGROUP 'AUTHOR)) + (NOT (STRPOS COM ATTRVALUE NIL NIL NIL NIL UPPERCASEARRAY))) + (RETURN)))) + (DELETE (DTAB 12) + (PRIN1 (COND + ((DELFILE (DIRFILENAME FILEGROUP)) + "deleted") + (T "can't delete")))) + (PROMPT (OR (DREAD (pop COMTAIL)) + (RETURN))) + (PRINT (DPRIN1 (pop COMTAIL))) + (COLLECT (PUSH VALUE (DIRFILENAME FILEGROUP))) + (OLDVERSIONS (* ; + "Not implemented, but user might continue from error in DIRECTORY") + (COND + ((NEQ (CAR COMTAIL) + 1) + (ERROR "can't count more than 1 version"))) + (COND + ((STRING.EQUAL (INFILEP (DIRFILENAME FILEGROUP)) + (INFILEP (PACKFILENAME 'VERSION NIL 'BODY FILENAME))) - (* ;; "Used to be EQ, but that fails for dsk files?") + (* ;; "Used to be EQ, but that fails for dsk files?") - (RETURN))) - (pop COMTAIL)) - ((DELETED UNDELETE) (* ; "Not implemented") - ) - (NOP) - (LET ((TYPE (FASSOC COM FILEINFOTYPES))) - (COND - [TYPE (DTAB (CADR TYPE)) + (RETURN))) + (pop COMTAIL)) + ((DELETED UNDELETE) (* ; "Not implemented") + ) + (NOP) + (LET ((TYPE (FASSOC COM FILEINFOTYPES))) + (COND + [TYPE (DTAB (CADR TYPE)) + (COND + ((SETQ ATTRVALUE (DIRGETFILEINFO FILEGROUP COM)) (COND - ((SETQ ATTRVALUE (DIRGETFILEINFO FILEGROUP COM)) - (COND - ((FIXP ATTRVALUE) - (PRINTNUM (OR (CDDR TYPE) - (LIST 'FIX (CADR TYPE))) - ATTRVALUE)) - ((AND (LISTP ATTRVALUE) - (LISTP (CAR ATTRVALUE))) - (PRINTDEF ATTRVALUE (POSITION))) - (T (PRIN1 ATTRVALUE] - (T (SHOULDNT]) + ((FIXP ATTRVALUE) + (PRINTNUM (OR (CDDR TYPE) + (LIST 'FIX (CADR TYPE))) + ATTRVALUE)) + ((AND (LISTP ATTRVALUE) + (LISTP (CAR ATTRVALUE))) + (PRINTDEF ATTRVALUE (POSITION))) + (T (PRIN1 ATTRVALUE] + (T (SHOULDNT]) (DIRPRINTNAME (LAMBDA (FILEGROUP FLG) (DECLARE (USEDFREE LASTHOST&DIR NAMEPRINTED)) (* ; "Edited 27-Apr-90 10:07 by nm") (COND ((NOT NAMEPRINTED) (PROG ((STREAM (GETSTREAM NIL (QUOTE OUTPUT))) (FULLNAME (fetch STRINGNAME of FILEGROUP)) (LASTNAME (CAR LASTHOST&DIR)) DIFFERENT DIRECTORYEND) (for I from 1 bind THISCHAR LASTCHAR do (* ; "Scan for end of directory name, and notice whether it matches previously printed directory") (SELCHARQ (SETQ THISCHAR (NTHCHARCODE FULLNAME I)) (NIL (RETURN)) ((} < > / %)) (SETQ DIRECTORYEND I)) NIL) (COND ((AND (NOT DIFFERENT) (COND ((NULL (SETQ LASTCHAR (NTHCHARCODE LASTNAME I)))) ((> LASTCHAR \MAXTHINCHAR) (* ; "Fat chars don't go thru casearray") (NEQ LASTCHAR THISCHAR)) ((> THISCHAR \MAXTHINCHAR)) (T (* ; "Two thin chars, are they really different?") (NEQ (GETCASEARRAY UPPERCASEARRAY LASTCHAR) (GETCASEARRAY UPPERCASEARRAY THISCHAR))))) (SETQ DIFFERENT I)))) (COND ((AND DIFFERENT DIRECTORYEND (OR (NEQ DIRECTORYEND (CADR LASTHOST&DIR)) (<= DIFFERENT DIRECTORYEND))) (TAB 0 0) (* ; "New directory") (TERPRI) (SPACES 3) (for I from 1 to DIRECTORYEND do (\OUTCHAR STREAM (NTHCHARCODE FULLNAME I))) (SETQ LASTHOST&DIR (LIST FULLNAME DIRECTORYEND)))) (DTAB 20) (for I from (ADD1 (OR DIRECTORYEND 0)) do (COND ((AND FLG (EQ (NTHCHARCODE FULLNAME I) (CHARCODE ;))) (RETURN))) (\OUTCHAR STREAM (OR (NTHCHARCODE FULLNAME I) (RETURN)))) (SPACES 1) (SETQ NAMEPRINTED T))))) @@ -344,8 +379,20 @@ Copyright (c) 1986-1988, 1990, 1992 by Venue & Xerox Corporation. (LAMBDA (STR) (* lmm "20-OCT-78 02:53") (DTAB (NCHARS STR)) (PRIN1 STR))) (DIRFILENAME -(LAMBDA (FILEGROUP) (* ; "Edited 28-Jul-87 14:55 by bvm:") (DECLARE (USEDFREE FILE FILENAME)) (* ; "These might be used freely by user predicates, with @ commands") (OR (fetch LITERALNAME of FILEGROUP) (replace LITERALNAME of FILEGROUP with (SETQ FILE (SETQ FILENAME (MKATOM (LET ((NAME (fetch STRINGNAME of FILEGROUP))) (COND ((AND *UPPER-CASE-FILE-NAMES* (NOT (U-CASEP NAME))) (U-CASE NAME)) (T NAME))))))))) -) + [LAMBDA (FILEGROUP) + + (* ;; "Edited 28-Mar-2022 11:08 by rmk: Don't convert to atoms, always return strings") + + (* ;; "Edited 28-Jul-87 14:55 by bvm:") + + (DECLARE (USEDFREE FILE FILENAME)) (* ; + "These might be used freely by user predicates, with @ commands") + (IF (fetch LITERALNAME of FILEGROUP) + ELSE (SETQ FILENAME (fetch STRINGNAME of FILEGROUP)) + (CL:WHEN (AND *UPPER-CASE-FILE-NAMES* (NOT (U-CASEP FILENAME))) + (SETQ FILENAME (U-CASE FILENAME))) + (SETQ FILE FILENAME) + (replace LITERALNAME of FILEGROUP with FILENAME]) (DIRGETFILEINFO (LAMBDA (FILEGROUP ATTRIBUTE) (* bvm%: " 5-May-84 15:19") (\GENERATEFILEINFO (CAR (fetch FILEGENERATORS of FILEGROUP)) ATTRIBUTE)) @@ -418,10 +465,10 @@ Copyright (c) 1986-1988, 1990, 1992 by Venue & Xerox Corporation. ) (PUTPROPS DIRECTORY COPYRIGHT ("Venue & Xerox Corporation" 1986 1987 1988 1990 1992)) (DECLARE%: DONTCOPY - (FILEMAP (NIL (1330 25982 (DODIR 1340 . 1887) (FILDIR 1889 . 2169) (DIRECTORY 2171 . 12442) ( -DIRECTORY.PARSE 12444 . 13152) (DIRECTORY.FILL.PATTERN 13154 . 13538) (DIRCONJ 13540 . 13760) ( -DIRECTORY.NEXTFILE 13762 . 14355) (DMATCH 14357 . 14732) (DIRECTORY.MATCH.SETUP 14734 . 15268) ( -DIRECTORY.MATCH 15270 . 15687) (DIRECTORY.MATCH1 15689 . 17802) (DODIRCOMMANDS 17804 . 23577) ( -DIRPRINTNAME 23579 . 24995) (DPRIN1 24997 . 25082) (DIRFILENAME 25084 . 25513) (DIRGETFILEINFO 25515 - . 25667) (DREAD 25669 . 25980))))) + (FILEMAP (NIL (1325 27144 (DODIR 1335 . 1882) (FILDIR 1884 . 2164) (DIRECTORY 2166 . 12883) ( +DIRECTORY.PARSE 12885 . 14179) (DIRECTORY.FILL.PATTERN 14181 . 14711) (DIRCONJ 14713 . 14933) ( +DIRECTORY.NEXTFILE 14935 . 15528) (DMATCH 15530 . 15905) (DIRECTORY.MATCH.SETUP 15907 . 16441) ( +DIRECTORY.MATCH 16443 . 16860) (DIRECTORY.MATCH1 16862 . 18975) (DODIRCOMMANDS 18977 . 24447) ( +DIRPRINTNAME 24449 . 25865) (DPRIN1 25867 . 25952) (DIRFILENAME 25954 . 26675) (DIRGETFILEINFO 26677 + . 26829) (DREAD 26831 . 27142))))) STOP diff --git a/sources/DIRECTORY.LCOM b/sources/DIRECTORY.LCOM index 82fa91b3c596e37dc4a5068c2cbce0c2d8a21388..0348d4da3708ae7ef164bde477752bc603c93a57 100644 GIT binary patch delta 1937 zcmZvc-D@0G6u@_;NlGT6jkPpQ`gPd0>8`NL+?l!au^?o!b2piGzB(V-rWQ+^4H{c* zX?+j`xAa9pMC;%ON-bEVeNo(Q`yhg$uRbaGAP5Ej0<8~HC@r3u-A%t-n7ikmd+#~t zp7T5R-DbD>QFE(gRNNEiDv~HkK*SoAYecwS~ZGgq13P)Ru7pO zGYcl4@I45u2$$ZOJxHhklCG*0YV`%vn`coa_Mz19qDN7bp%#Q}(e{(5Vxh%nyh=t* zmM^_s=ZVs-@&`6fUEawThUTulQo!HIp|yHn8d*z^j@rBL=lZ{IO!_k|o|EDFDSw8a zo?64P!{147kIu+9ds{wPJwDyxulc1`Z~k$I|DrEmS$pk=T7T+r?$dN+>^+$q?|HaU z&x0D~&_2e)-TfvTzu%jUxur9iIUyU;n`19>?ew29#u=$TKF{4vFN{xef25y}SK9gB zTY^7*bstxlcy*#sGKd5grjdma14ASb*|l28A{HlJ)AlUT4Hb^Li;f+|D3eF|H$_o2 zK-ZM)yz4JA(5VP44E+#vS%HRqBnlWpq7$^>)qSttmO!Hl95aJ}d6opKrhY~FOLW{8Vu&}Hr%sFDInrEX%hR3}evqM8JDjsm6XKvLEvNpAO* zibDE<%909=kg-KGjF4su4KH2_KvF1pNFFK)8d#4}*4BeZnsr@$HeIR?77OA9&?Oz* zB#QB}VV)gA+FADMzU!Kv6@iAS%NoM=8a_H@s1fC-G^(ycfa!^W8e-qDVrYP^Xj=JI z71aBV#ljdH1r*Gv-3)DPu&gB%jewmuob7v-+0Im|1RiS+_EYKc(~<^>XEBFm8;OPv zGtmMC1M~aFj)_Gq<-cUee( z-O?HoN@byIJb!+K`>y-#)X&`J%Vyr5&27`m+d2=I(hqi62evQpM>-ED2Jg(n;X~_h z&Vzdc?SsG4dpl0IFBVEFrafBl6URbgR87v=A=p}3#*re6HE@DO@gqCNlwqT3y%jHU zK_zkq=sb%DSb{22h|M{mG8QWD(<(chm<~{+8^J|<1C-H`snic;)4cptL<|S3_^6=O z^)EHHtH~t6o C7vygM delta 1861 zcmZuxOKcle6!mk`v~g=le<@8WK+4qf91k7OOy?6fP!Xj`MGXC^ zxY8kNsRs1AaQOU8gU{$d~>Ix*bAhD}hpt3#z77tpo*-xArKl3QARC1vqp0?DEC)m)hsf zu0ZbWo0l$MIa-CfX&I&m`0-lccni?J0EK#JS#ZCTnVFdatSr5XHy`3$77C?Y5k2vm zcbMw|H}KR$(knppE1BJ)L5`|SkfIyp&{O>cN>Ft@K5sgqUpCOg0}iyRtW;_AGckzT zJCZ%NecKz8+01aXJZh5Pqi;qh$&b8he`jqDwZ~FLcRY(Pz174Dx-h zKyF6A<)+Bh=+T|;o`WUFFVt&YAdfie$!C$1+7t(ZDyWRge2T28=xr?oNmrr zrXPUDw5`|D1wp8QCW~Nryy?ty&_oru=Q$o|f{5gv@?DOPscPuKt~qv%f=Wd=t-CI_ z4GM}Zb)b2|4?NSJ14W{cnl30JgVUyE@j2a^(Y-lf3f}tYcWX~Saj18q&_BN zz%(aGP@wK{KCgQ|pa`ID2MZk+C}m*R8Zj!OgUx)fm_eqfFpWw7r$%C6a5rdxT4B%( z{QxWTVkT5IA*$vyo4RfIpdw4LMoqi!1PdD&)71};(&0K?7Hv8<|q?V%e< zsWRe@WpFQO=r+g<%WZikYCcx2%tSD2cs4K{J4Iv)Hg64%Bfs}u7E}mrqr)wZccqGo z0b|nu37^Y$T#ytD76u^6TDqn()Ep~p+DKoelGJ1CO%9Y*U=}Erh{ZSE04Oq@79v(+ zD*;7x>zmJW5LF5Ngmw_GIv^^v9~wkii6dYu2Ovrk=wZ-6F^Qr8#}`mWar*Pz^RYf8 zkb>(1s=x&-)73*i&SY>OUkv3aK%sr%^`&#|l`Yu<&Y|;57glgeNFqE_5X;Z$b{T0F zgsLDQih?Q72SIdou!s`&!8Wb4L<&be~cO!eMyD>VL9QQU( zY)+ATe{7<6B6IRw=dDap(G>6-PG}h@8buQl)xLZBZ9CJX&uoZ%-!-9oMypmmG SVx@1nr9>Mjgte*O_J08?qt-b9 From 3b9a8254820852870245f776a6ca0850aef29839 Mon Sep 17 00:00:00 2001 From: rmkaplan Date: Sun, 24 Apr 2022 13:37:49 -0700 Subject: [PATCH 3/9] ADIR: added FILENAMEFIELD.STRING --- sources/ADIR | 41 +++++++++++++++++++++++++++-------------- sources/ADIR.LCOM | Bin 24547 -> 24825 bytes 2 files changed, 27 insertions(+), 14 deletions(-) diff --git a/sources/ADIR b/sources/ADIR index c07c861c..26e56a82 100644 --- a/sources/ADIR +++ b/sources/ADIR @@ -1,11 +1,12 @@ (DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10) -(FILECREATED "26-Jan-2022 10:18:43" {DSK}kaplan>Local>medley3.5>my-medley>sources>ADIR.;12 66655 +(FILECREATED "26-Mar-2022 09:39:50" {DSK}kaplan>Local>medley3.5>my-medley>sources>ADIR.;13 67302 :CHANGES-TO (VARS ADIRCOMS) + (FNS FILENAMEFIELD.STRING) - :PREVIOUS-DATE "25-Jan-2022 17:19:00" -{DSK}kaplan>Local>medley3.5>my-medley>sources>ADIR.;11) + :PREVIOUS-DATE "26-Jan-2022 10:18:43" +{DSK}kaplan>Local>medley3.5>my-medley>sources>ADIR.;12) (* ; " @@ -26,7 +27,7 @@ Copyright (c) 1981-1988, 1990-1992, 1920, 2017, 2020-2021 by Venue & Xerox Corpo (MOVD? 'NILL 'CL:PATHNAMEP] (COMS (FNS UNPACKFILENAME UNPACKFILENAME.STRING LASTCHPOS \UPF.NEXTPOS \UPF.TEMPFILEP - FILENAMEFIELD PACKFILENAME PACKFILENAME.STRING) + FILENAMEFIELD FILENAMEFIELD.STRING PACKFILENAME PACKFILENAME.STRING) (DECLARE%: DONTCOPY (MACROS CANONICAL.DIRECTORY UNPACKFILE1.DIRECTORY PACKFILENAME.ASSEMBLE UNPACKFILE1)) (VARS \FILENAME.SYNTAX) @@ -593,6 +594,17 @@ Copyright (c) 1981-1988, 1990-1992, 1920, 2017, 2020-2021 by Venue & Xerox Corpo FIELDNAME) 'FIELD NIL T]) +(FILENAMEFIELD.STRING + [LAMBDA (FILE FIELDNAME) (* ; "Edited 26-Mar-2022 09:38 by rmk") + (* ; "Edited 6-Mar-90 19:38 by nm") + (UNPACKFILENAME.STRING FILE (SELECTQ FIELDNAME + ((VERSION GENERATION) + 'VERSION) + ((DEVICE STRUCTURE) + 'DEVICE) + FIELDNAME) + 'FIELD]) + (PACKFILENAME [LAMBDA N (* bvm%: " 5-Jul-85 15:40") (COND @@ -1176,14 +1188,15 @@ Copyright (c) 1981-1988, 1990-1992, 1920, 2017, 2020-2021 by Venue & Xerox Corpo (PUTPROPS ADIR COPYRIGHT ("Venue & Xerox Corporation" 1981 1982 1983 1984 1985 1986 1987 1988 1990 1991 1992 1920 2017 2020 2021)) (DECLARE%: DONTCOPY - (FILEMAP (NIL (2771 13896 (DELFILE 2781 . 2942) (FULLNAME 2944 . 3311) (INFILE 3313 . 3461) (INFILEP -3463 . 3598) (IOFILE 3600 . 3740) (OPENFILE 3742 . 4142) (OPENSTREAM 4144 . 8484) (OUTFILE 8486 . 8637 -) (OUTFILEP 8639 . 8775) (RENAMEFILE 8777 . 9083) (SIMPLE.FINDFILE 9085 . 9495) (VMEMSIZE 9497 . 9664) - (\COPYSYS 9666 . 12615) (\FLUSHVM 12617 . 13689) (\LOGOUT0 13691 . 13894)) (14268 34500 ( -UNPACKFILENAME 14278 . 14464) (UNPACKFILENAME.STRING 14466 . 31379) (LASTCHPOS 31381 . 32075) ( -\UPF.NEXTPOS 32077 . 32722) (\UPF.TEMPFILEP 32724 . 33301) (FILENAMEFIELD 33303 . 33788) (PACKFILENAME - 33790 . 34133) (PACKFILENAME.STRING 34135 . 34498)) (56022 56935 (FILEDIRCASEARRAY 56032 . 56933)) ( -57102 64282 (LOGOUT 57112 . 58029) (MAKESYS 58031 . 59660) (SYSOUT 59662 . 61214) (SAVEVM 61216 . -62016) (HERALD 62018 . 62178) (INTERPRET.REM.CM 62180 . 63905) (\USEREVENT 63907 . 64280)) (64464 -66191 (USERNAME 64474 . 65430) (SETUSERNAME 65432 . 66189))))) + (FILEMAP (NIL (2837 13962 (DELFILE 2847 . 3008) (FULLNAME 3010 . 3377) (INFILE 3379 . 3527) (INFILEP +3529 . 3664) (IOFILE 3666 . 3806) (OPENFILE 3808 . 4208) (OPENSTREAM 4210 . 8550) (OUTFILE 8552 . 8703 +) (OUTFILEP 8705 . 8841) (RENAMEFILE 8843 . 9149) (SIMPLE.FINDFILE 9151 . 9561) (VMEMSIZE 9563 . 9730) + (\COPYSYS 9732 . 12681) (\FLUSHVM 12683 . 13755) (\LOGOUT0 13757 . 13960)) (14334 35147 ( +UNPACKFILENAME 14344 . 14530) (UNPACKFILENAME.STRING 14532 . 31445) (LASTCHPOS 31447 . 32141) ( +\UPF.NEXTPOS 32143 . 32788) (\UPF.TEMPFILEP 32790 . 33367) (FILENAMEFIELD 33369 . 33854) ( +FILENAMEFIELD.STRING 33856 . 34435) (PACKFILENAME 34437 . 34780) (PACKFILENAME.STRING 34782 . 35145)) +(56669 57582 (FILEDIRCASEARRAY 56679 . 57580)) (57749 64929 (LOGOUT 57759 . 58676) (MAKESYS 58678 . +60307) (SYSOUT 60309 . 61861) (SAVEVM 61863 . 62663) (HERALD 62665 . 62825) (INTERPRET.REM.CM 62827 . +64552) (\USEREVENT 64554 . 64927)) (65111 66838 (USERNAME 65121 . 66077) (SETUSERNAME 66079 . 66836))) +)) STOP diff --git a/sources/ADIR.LCOM b/sources/ADIR.LCOM index 88f2aa6dd953ce5d27d563ca6a531b9649ac72cc..685d6ed82b637de70e27247819bfda995b36505e 100644 GIT binary patch delta 498 zcmZvY%}T>S5XX&pkQIxfpn@M`w2)OAVnQs9#j-Y=8oEjAwhEe7@S_Lulj^~X^%bmp z6MO)VQt#pe_yS%$_yiusi+k|v(7DVoGynhmn72pe<4L*N=nuB)3DYo5Fj9_{a_qV0 ze&N!>pqh5#cV=47T+*>D6}IcOo#Vrky@T2=pxXIK{WR`?=QA3TfO>f6jAl6{W$MbU`9F+rL_>vUBi(HQnonAWDQ=W8 zta)LnEe8gt$myD2SS=-7X(<+!;pRoAHQM=V4YmUpv-X6N7I`~`dOBqEb!c`{H0>b; zi90*&LK;S`PdgT$YNv)G$>x6sfW&)xK;WoXB%=kXuSYZDHZo-O9GTaZaaoL4awE%> z6Xt>+mMNF8Wu4PN&jwQ7sDv@la;&gK*c#y_*?Ot0$1rFv%`(EN{5}$-y51>Mp*k!c YszEPC7|TEMB3W4hk=dMXnVa{@7mR3yQ2+n{ delta 420 zcmZvW!Ab&A6owfWSr-(dMYxa-gTjp9FpfIqSjcVWYEz>lcT_S)%Thur6KfF!wQZT) z);)wiKm@IOhM*UyWwdF8B8hef&i{Y^_wmTRK5(}?^P8<+T#*$860(+9(Nf9bk$tU* zz$@wa?=PdJWKB_d*dKHbPEY#X<4zk;=b}G2i)xTJEn=8d#}2`i;yQGDz~`%$1=A2o zl6Yvh&b{V8@T9_vNSKgx8YZ|x3@@clDSYekFuYowRRF1~nohHOE*#Oyl+;YS>ckDN z_XobLB{G^U4=-~w2@x5@V%WbpuKAvl<4-jh4V1CIHCZj;A_4Zkw!m_3fJ4l3v+Tx= zdDqC5+1y@)`5VC{ Date: Sun, 24 Apr 2022 13:39:44 -0700 Subject: [PATCH 4/9] 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 From 3a4852cf8b4961b44c122dc2d0c820bc7d801d12 Mon Sep 17 00:00:00 2001 From: rmkaplan Date: Sun, 24 Apr 2022 13:44:39 -0700 Subject: [PATCH 5/9] UFS: Reworked directory enumeration Eliminated dependence on DEFAULTEXT and DEFAULTVERS, better job at subdirectories --- sources/UFS | 359 +++++++++++++++++++++-------------------------- sources/UFS.LCOM | Bin 37570 -> 36883 bytes 2 files changed, 159 insertions(+), 200 deletions(-) diff --git a/sources/UFS b/sources/UFS index e72d96bf..9097604b 100644 --- a/sources/UFS +++ b/sources/UFS @@ -1,11 +1,9 @@ (DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10) -(FILECREATED " 7-Mar-2022 21:08:31" {DSK}larry>medley>sources>UFS.;2 81830 +(FILECREATED "29-Mar-2022 11:29:33" {DSK}kaplan>Local>medley3.5>my-medley>sources>UFS.;32 78036 - :CHANGES-TO (VARS UFSCOMS) - (FNS \UFSSetFileType \UFStoOtherCopyMess \UFStoOtherRenameMess) - - :PREVIOUS-DATE "22-Jan-2022 09:06:35" {DSK}larry>medley>sources>UFS.;1) + :PREVIOUS-DATE "28-Mar-2022 22:09:43" +{DSK}kaplan>Local>medley3.5>my-medley>sources>UFS.;31) (* ; " @@ -192,21 +190,18 @@ Copyright (c) 1988-1995, 2000, 2021-2022 by Venue & Xerox Corporation. (PROTECTION FIXP) AUTHOR (AULEN FIXP) - SUBGENERATORS (* ; - "A push-down list of generators for subdirectories. Used to generate to multiple-directory depths.") + SUBGENERATOR (* ; "Generator for an immediate subdirectory. Recursive function calls descend and return to lower depths") CURRENT-DEPTH (* ;  "Current depth in the directory tree, so we can obey FILING.ENUMERATION.DEPTH") MAX-DEPTH (* ;  "Value of FILING.ENUMERATION.DEPTH we were started with, so we can obey it.") - DEFAULTEXT (* ; - "Value of DEFAULTEXT, so we can propagate it through subdirectories") - DEFAULTVERS (* ; "Value of DEFAULTVERS") + FILTER (* ; "The original undefaulted pattern") )) ) (/DECLAREDATATYPE 'UFSGENFILESTATE '(FIXP FIXP FIXP POINTER POINTER FLAG POINTER FIXP POINTER FIXP FIXP FIXP FIXP POINTER FIXP - POINTER POINTER POINTER POINTER POINTER) + POINTER POINTER POINTER POINTER) '((UFSGENFILESTATE 0 FIXP) (UFSGENFILESTATE 2 FIXP) (UFSGENFILESTATE 4 FIXP) @@ -225,9 +220,8 @@ Copyright (c) 1988-1995, 2000, 2021-2022 by Venue & Xerox Corporation. (UFSGENFILESTATE 28 POINTER) (UFSGENFILESTATE 30 POINTER) (UFSGENFILESTATE 32 POINTER) - (UFSGENFILESTATE 34 POINTER) - (UFSGENFILESTATE 36 POINTER)) - '38) + (UFSGENFILESTATE 34 POINTER)) + '36) (* "END EXPORTED DEFINITIONS") @@ -235,7 +229,7 @@ Copyright (c) 1988-1995, 2000, 2021-2022 by Venue & Xerox Corporation. (/DECLAREDATATYPE 'UFSGENFILESTATE '(FIXP FIXP FIXP POINTER POINTER FLAG POINTER FIXP POINTER FIXP FIXP FIXP FIXP POINTER FIXP - POINTER POINTER POINTER POINTER POINTER) + POINTER POINTER POINTER POINTER) '((UFSGENFILESTATE 0 FIXP) (UFSGENFILESTATE 2 FIXP) (UFSGENFILESTATE 4 FIXP) @@ -254,9 +248,8 @@ Copyright (c) 1988-1995, 2000, 2021-2022 by Venue & Xerox Corporation. (UFSGENFILESTATE 28 POINTER) (UFSGENFILESTATE 30 POINTER) (UFSGENFILESTATE 32 POINTER) - (UFSGENFILESTATE 34 POINTER) - (UFSGENFILESTATE 36 POINTER)) - '38) + (UFSGENFILESTATE 34 POINTER)) + '36) (ADDTOVAR SYSTEMRECLST (DATATYPE UFSGENFILESTATE ((FINFOID FIXP) @@ -272,7 +265,7 @@ Copyright (c) 1988-1995, 2000, 2021-2022 by Venue & Xerox Corporation. (PROTECTION FIXP) AUTHOR (AULEN FIXP) - SUBGENERATORS CURRENT-DEPTH MAX-DEPTH DEFAULTEXT DEFAULTVERS)) + SUBGENERATOR CURRENT-DEPTH MAX-DEPTH FILTER)) ) @@ -348,8 +341,12 @@ Copyright (c) 1988-1995, 2000, 2021-2022 by Venue & Xerox Corporation. (\UFSGenerateFiles [LAMBDA (FDEV PATTERN DESIREDPROPS OPTIONS) + (* ;; "Edited 27-Mar-2022 15:55 by rmk: Use the EXTENSION and VERFSION in the pattern instead of the inherited defaults") + + (* ;; "rmk; Use the EXTENSION and VERFSION in the pattern instead of the inherited defaults") + (* ;; - "Edited 22-Jan-2022 09:06 by rmk: Capture current free values of DEFAULTEXT and DEFAULTVERS") + "Edited 25-Mar-2022 23:11 by rmk: Capture current free values of DEFAULTEXT and DEFAULTVERS") (* ;; "Edited 27-Sep-93 16:17 by jds") @@ -364,36 +361,36 @@ Copyright (c) 1988-1995, 2000, 2021-2022 by Venue & Xerox Corporation. FDEV) (\UFS.DEFAULT.DIR FDEV))) (DEVICE (LISTGET PARSED 'DEVICE)) + (NAME (OR (LISTGET PARSED 'NAME) + "*")) + (EXTENSION (OR (LISTGET PARSED 'EXTENSION) + "*")) + (VERSION (OR (LISTGET PARSED 'VERSION) + "*")) (NAMEAREA (ALLOCSTRING MAX-PATHNAME-LEN)) - FILTER LEN) + FILTER LEN (DEFAULTEXT (OR (LISTGET PARSED 'EXTENSION) + DEFAULTEXT)) + (DEFAULTVERS (OR (LISTGET PARSED 'VERSION) + DEFAULTVERS))) + + (* ;; "rmk: uses the default below, don't want NIL if the pattern includes something else.") + (COND ((STREQUAL DIRECTORY "/") (SETQ DIRECTORY "<"))) [SETQ FILTER (COND - [(STREQUAL DIRECTORY "<") + ((STREQUAL DIRECTORY "<") (CONCAT "{" (LISTGET PARSED 'HOST) "}" (OR DEVICE "") "<" - (PACKFILENAME.STRING 'NAME (OR (LISTGET PARSED 'NAME) - "*") - 'EXTENSION - (OR (LISTGET PARSED 'EXTENSION) - "*") - 'VERSION - (OR (LISTGET PARSED 'VERSION) - "*"] + (PACKFILENAME.STRING 'NAME NAME 'EXTENSION EXTENSION + 'VERSION VERSION))) (T (PACKFILENAME.STRING 'DIRECTORY DIRECTORY 'HOST (LISTGET PARSED 'HOST) - 'DEVICE DEVICE 'NAME (OR (LISTGET PARSED 'NAME) - "*") - 'EXTENSION - (OR (LISTGET PARSED 'EXTENSION) - "*") - 'VERSION - (OR (LISTGET PARSED 'VERSION) - "*"] + 'DEVICE DEVICE 'NAME NAME 'EXTENSION EXTENSION 'VERSION + VERSION] (SETQ LEN (\UFS.DIRECTORY.NAME (CONCAT (OR DEVICE "") DIRECTORY) NAMEAREA FDEV)) @@ -442,148 +439,120 @@ Copyright (c) 1988-1995, 2000, 2021-2022 by Venue & Xerox Corporation. CURRENT-DEPTH _ 1 MAX-DEPTH _ FILING.ENUMERATION.DEPTH - DEFAULTEXT _ DEFAULTEXT - DEFAULTVERS _ DEFAULTVERS])]) + FILTER _ ( + PACKFILENAME.STRING + 'NAME NAME + 'EXTENSION + EXTENSION + 'VERSION VERSION]) + ]) (\UFS.NEXTFILEFN [LAMBDA (GENFILESTATE NAMEONLY) (* ;; - "Edited 22-Jan-2022 09:05 by rmk: Bind DEFAULTEXT and DEFAULTVERS to values in GENFILESTATE") + "Edited 27-Mar-2022 21:59 by rmk: Add FILTER to construct proper generator for subdirectories") (* ;; "Edited 7-Oct-93 14:31 by jds") (* ;; "Given a UFS filesystem generator, return the %"next%" file in line.") - - (LET ((SUBGEN (fetch (UFSGENFILESTATE SUBGENERATORS) of GENFILESTATE))) - (DECLARE (SPECVARS FILEGROUP)) + (* ; "") + (LET ((SUBGEN (fetch (UFSGENFILESTATE SUBGENERATOR) of GENFILESTATE)) + FILENAME NAMELEN NEWNAME) (COND [SUBGEN - (* ;; "We're in a sub-directory.") + (* ;; "We've climbed down through subdirectories, one more to go. The recursive calls and returns walk through subdirectories at lower depths. starting from the top at each call.") - (LET (FILENAME NAMELEN NEWWNAME FILEGROUP) - (SETQ FILENAME (\UFS.NEXTFILEFN SUBGEN NAMEONLY)) - (COND - (FILENAME (CL:WHEN (fetch (UFSGENFILESTATE PROPP) of GENFILESTATE) - (replace (UFSGENFILESTATE LENGTH) of GENFILESTATE - with (fetch (UFSGENFILESTATE LENGTH) of SUBGEN)) - (replace (UFSGENFILESTATE RDATE) of GENFILESTATE - with (fetch (UFSGENFILESTATE RDATE) of SUBGEN)) - (replace (UFSGENFILESTATE WDATE) of GENFILESTATE - with (fetch (UFSGENFILESTATE WDATE) of SUBGEN)) - (replace (UFSGENFILESTATE PROTECTION) of GENFILESTATE - with (fetch (UFSGENFILESTATE PROTECTION) of SUBGEN)) - (replace (UFSGENFILESTATE AULEN) of GENFILESTATE - with (fetch (UFSGENFILESTATE AULEN) of SUBGEN)) - (replace (UFSGENFILESTATE AUTHOR) of GENFILESTATE - with (fetch (UFSGENFILESTATE AUTHOR) of SUBGEN))) - FILENAME) - (T (replace (UFSGENFILESTATE SUBGENERATORS) of GENFILESTATE with NIL) - (\UFS.NEXTFILEFN GENFILESTATE NAMEONLY] + (* ;; "The property values are read out of the original, top-level generator, so we have to make sure that those fields are updated at each level up the chain, so they end up in the top-level generator.") + + (SETQ FILENAME (\UFS.NEXTFILEFN SUBGEN NAMEONLY)) + (COND + (FILENAME (CL:WHEN (fetch (UFSGENFILESTATE PROPP) of GENFILESTATE) + (replace (UFSGENFILESTATE LENGTH) of GENFILESTATE + with (fetch (UFSGENFILESTATE LENGTH) of SUBGEN)) + (replace (UFSGENFILESTATE RDATE) of GENFILESTATE + with (fetch (UFSGENFILESTATE RDATE) of SUBGEN)) + (replace (UFSGENFILESTATE WDATE) of GENFILESTATE + with (fetch (UFSGENFILESTATE WDATE) of SUBGEN)) + (replace (UFSGENFILESTATE PROTECTION) of GENFILESTATE + with (fetch (UFSGENFILESTATE PROTECTION) of SUBGEN)) + (replace (UFSGENFILESTATE AULEN) of GENFILESTATE + with (fetch (UFSGENFILESTATE AULEN) of SUBGEN)) + (replace (UFSGENFILESTATE AUTHOR) of GENFILESTATE + with (fetch (UFSGENFILESTATE AUTHOR) of SUBGEN))) + FILENAME) + (T (replace (UFSGENFILESTATE SUBGENERATOR) of GENFILESTATE with NIL) + (\UFS.NEXTFILEFN GENFILESTATE NAMEONLY] (T (* ;; "Not in a sub-directory, so act directly on the top-level generator.") - (LET* [(FINFOID (fetch (UFSGENFILESTATE FINFOID) of GENFILESTATE)) - (FILEID (fetch (UFSGENFILESTATE FILEID) of GENFILESTATE)) - (ERRNO (LOCF (fetch (UFSGENFILESTATE ERRONO) of GENFILESTATE))) - FILENAME NAMELEN NEWNAME SUBGEN FILEGROUP (DEFAULTEXT (FETCH (UFSGENFILESTATE - DEFAULTEXT) - OF GENFILESTATE)) - (DEFAULTVERS (FETCH (UFSGENFILESTATE DEFAULTVERS) OF GENFILESTATE)) - (DESIREDPROPS (COND - ((fetch (UFSGENFILESTATE PROPP) of GENFILESTATE) - '(SIZE CREATIONDATE AUTHOR)) - (T NIL] - (DECLARE (SPECVARS FILEGROUP DEFAULTEXT DESIREDPROPS DEFAULTVERS)) - (AND (> FINFOID -1) - (< FILEID (fetch (UFSGENFILESTATE TOTALNUM) of GENFILESTATE)) - (CL:UNWIND-PROTECT - [COND - ((> (SETQ NAMELEN (\UFSNextFile-C GENFILESTATE)) - 0) - [replace (UFSGENFILESTATE THISFILE) of GENFILESTATE - with (SETQ FILENAME (\UFS.FULLNAME.M - (fetch (UFSGENFILESTATE DIRECTORY) - of GENFILESTATE) - (SETQ NEWNAME (CL:SUBSEQ - (fetch (UFSGENFILESTATE - NAME) of + (LET [(FINFOID (fetch (UFSGENFILESTATE FINFOID) of GENFILESTATE)) + (FILEID (fetch (UFSGENFILESTATE FILEID) of GENFILESTATE)) + (ERRNO (LOCF (fetch (UFSGENFILESTATE ERRONO) of GENFILESTATE] + (AND (> FINFOID -1) + (< FILEID (fetch (UFSGENFILESTATE TOTALNUM) of GENFILESTATE)) + (CL:UNWIND-PROTECT + (CL:WHEN (> (SETQ NAMELEN (\UFSNextFile-C GENFILESTATE)) + 0) + (SETQ NEWNAME (CL:SUBSEQ (fetch (UFSGENFILESTATE NAME) of GENFILESTATE - ) - 0 NAMELEN)) - (fetch (UFSGENFILESTATE DEV) of - GENFILESTATE - ] - (COND - ((= (add FILEID 1) - (fetch (UFSGENFILESTATE TOTALNUM) of GENFILESTATE)) + ) + 0 NAMELEN)) + (SETQ FILENAME (\UFS.FULLNAME.M (fetch (UFSGENFILESTATE DIRECTORY) + of GENFILESTATE) + NEWNAME + (fetch (UFSGENFILESTATE DEV) of GENFILESTATE)) + ) + (replace (UFSGENFILESTATE THISFILE) of GENFILESTATE with FILENAME) + (COND + ((= (add FILEID 1) + (fetch (UFSGENFILESTATE TOTALNUM) of GENFILESTATE)) (* ; "Generator exhausted. ") - (\UFS.UNREGISTER.GFS GENFILESTATE T)) - (T (replace (UFSGENFILESTATE FILEID) of GENFILESTATE - with FILEID))) - (COND - [(AND FILENAME (OR (EQ (fetch (UFSGENFILESTATE MAX-DEPTH) - of GENFILESTATE) - T) - (ILESSP (fetch (UFSGENFILESTATE CURRENT-DEPTH - ) of GENFILESTATE) - (fetch (UFSGENFILESTATE MAX-DEPTH) - of GENFILESTATE))) - (IEQP (CHARCODE >) - (NTHCHARCODE FILENAME (NCHARS FILENAME))) - (DIRECTORY.PARSE (fetch (UFSGENFILESTATE THISFILE) - of GENFILESTATE)) - (fetch (FILEGENOBJ GENFILESTATE) of (CAR FILEGROUP))) + (\UFS.UNREGISTER.GFS GENFILESTATE T)) + (T (replace (UFSGENFILESTATE FILEID) of GENFILESTATE with FILEID) + )) + (COND + ((AND (EQ (CHARCODE >) + (NTHCHARCODE FILENAME -1)) + (OR (EQ (fetch (UFSGENFILESTATE MAX-DEPTH) of GENFILESTATE) + T) + (ILESSP (fetch (UFSGENFILESTATE CURRENT-DEPTH) + of GENFILESTATE) + (fetch (UFSGENFILESTATE MAX-DEPTH) of + GENFILESTATE + ))) + [SETQ SUBGEN (\GENERATEFILES (CONCAT FILENAME + (FETCH (UFSGENFILESTATE + FILTER) + OF GENFILESTATE)) + (CL:WHEN (fetch (UFSGENFILESTATE PROPP) + of GENFILESTATE) - (* ;; "It's a directory, so let's recurse into it.") + (* ;; + "Need any legal attributes to cause string allocation.") - [replace (UFSGENFILESTATE SUBGENERATORS) of GENFILESTATE - with (SETQ SUBGEN (fetch (FILEGENOBJ GENFILESTATE) - of (CAR FILEGROUP] - (replace (UFSGENFILESTATE CURRENT-DEPTH) of SUBGEN - with (ADD1 (fetch (UFSGENFILESTATE CURRENT-DEPTH) - of GENFILESTATE))) - (replace (UFSGENFILESTATE MAX-DEPTH) of SUBGEN - with (fetch (UFSGENFILESTATE MAX-DEPTH) of GENFILESTATE)) - (SETQ FILENAME (\UFS.NEXTFILEFN SUBGEN NAMEONLY)) - (COND - (FILENAME (CL:WHEN (fetch (UFSGENFILESTATE PROPP) - of GENFILESTATE) - (replace (UFSGENFILESTATE LENGTH) of - GENFILESTATE - with (fetch (UFSGENFILESTATE LENGTH) - of SUBGEN)) - (replace (UFSGENFILESTATE RDATE) of - GENFILESTATE - with (fetch (UFSGENFILESTATE RDATE) - of SUBGEN)) - (replace (UFSGENFILESTATE WDATE) of - GENFILESTATE - with (fetch (UFSGENFILESTATE WDATE) - of SUBGEN)) - (replace (UFSGENFILESTATE PROTECTION) - of GENFILESTATE with (fetch ( - UFSGENFILESTATE - PROTECTION) - of SUBGEN)) - (replace (UFSGENFILESTATE AULEN) of - GENFILESTATE - with (fetch (UFSGENFILESTATE AULEN) - of SUBGEN)) - (replace (UFSGENFILESTATE AUTHOR) of - GENFILESTATE - with (fetch (UFSGENFILESTATE AUTHOR) - of SUBGEN))) - FILENAME) - (NIL T (replace (UFSGENFILESTATE SUBGENERATORS) of - GENFILESTATE - with NIL) - (\UFS.NEXTFILEFN GENFILESTATE NAMEONLY] - (T (COND - (NAMEONLY NEWNAME) - (T FILENAME] - (AND RESETSTATE (\UFS.UNREGISTER.GFS GENFILESTATE T)))]) + '(SIZE CREATIONDATE AUTHOR)) + '(SORT RESETLST] + (fetch (FILEGENOBJ GENFILESTATE) of SUBGEN)) + + (* ;; "It's a directory, so let's recurse into it.") + + (SETQ SUBGEN (fetch (FILEGENOBJ GENFILESTATE) of SUBGEN)) + (replace (UFSGENFILESTATE SUBGENERATOR) of GENFILESTATE + with SUBGEN) + (replace (UFSGENFILESTATE CURRENT-DEPTH) of SUBGEN + with (ADD1 (fetch (UFSGENFILESTATE CURRENT-DEPTH) + of GENFILESTATE))) + (replace (UFSGENFILESTATE MAX-DEPTH) of SUBGEN + with (fetch (UFSGENFILESTATE MAX-DEPTH) of GENFILESTATE)) + + (* ;; "We're set up to recurse into the SUBGEN above") + + (\UFS.NEXTFILEFN GENFILESTATE NAMEONLY)) + (NAMEONLY NEWNAME) + (T FILENAME))) + (AND RESETSTATE (\UFS.UNREGISTER.GFS GENFILESTATE T)))]) (\UFS.FILEINFOFN (LAMBDA (GENFILESTATE ATTRIBUTE) (* ; "Edited 7-May-90 23:21 by nm") (* ;;; "FILEINFOFN for UFS--return the value of the specified ATTRIBUTE. ALLPROPS is fetched when a file is generated if GENERATEFILES method is invoked with some valid PROPs when the generator is created. ALLPROPS strucure is re-used. We have to be careful to COPY the values that come out.") (AND (fetch (UFSGENFILESTATE PROPP) of GENFILESTATE) (CL:UNWIND-PROTECT (if (EQ ATTRIBUTE (QUOTE TYPE)) then (\UFSGetFileType (fetch (UFSGENFILESTATE THISFILE) of GENFILESTATE)) else (BLOCK) (SELECTQ ATTRIBUTE (LENGTH (* ; "Copy numeric value") (+ 0 (fetch (UFSGENFILESTATE LENGTH) of GENFILESTATE))) (PROTECTION (* ; "Copy numeric value") (+ 0 (fetch (UFSGENFILESTATE PROTECTION) of GENFILESTATE))) (SIZE (FOLDHI (fetch (UFSGENFILESTATE LENGTH) of GENFILESTATE) BYTESPERPAGE)) ((CREATIONDATE WRITEDATE) (GDATE (fetch (UFSGENFILESTATE WDATE) of GENFILESTATE))) (READDATE (GDATE (fetch (UFSGENFILESTATE RDATE) of GENFILESTATE))) ((ICREATIONDATE IWRITEDATE) (+ 0 (fetch (UFSGENFILESTATE WDATE) of GENFILESTATE))) (IREADDATE (+ 0 (fetch (UFSGENFILESTATE RDATE) of GENFILESTATE))) (AUTHOR (* ; "Copy the string out of the buffer") (CL:SUBSEQ (fetch (UFSGENFILESTATE AUTHOR) of GENFILESTATE) 0 (fetch (UFSGENFILESTATE AULEN) of GENFILESTATE))) NIL)) (AND RESETSTATE (> (fetch (UFSGENFILESTATE FINFOID) of GENFILESTATE) -1) (\UFS.UNREGISTER.GFS GENFILESTATE T))))) @@ -876,31 +845,21 @@ update the map") (SETQ PAGES (RESTOREMAP STREAM))) (DELETED (* ; "the file disap (* ; "For \devicefile.eoserror"))) (DECLARE%: EVAL@COMPILE -(PUTPROPS \UFS.FULLNAME.M MACRO [LAMBDA (DIR NAME DEV ATOMP) +(PUTPROPS \UFS.FULLNAME.M MACRO [LAMBDA (DIR NAME DEV) (DECLARE (GLOBALVARS *DSK-HOST-NAME* *UFS-HOST-NAME*)) - (* ;; "NAME is a name string returned from UNIX. We turn it into a Lisp %"full file name%". This function is redefinable by code that hacks ufs names.") + (* ;; + "NAME is a name string returned from UNIX. We turn it into a Lisp %"full file name%". ") - (COND - (NAME (* ; "Pass NIL thru transparently") - (COND - [(DSKP DEV) - (SETQ NAME (CONCAT *DSK-HOST-NAME* DIR NAME)) - (COND - [*DSK-UPPER-CASE-FILE-NAMES* + (* ;; "jds? DSK code uses *DSK-UPPER-CASE-FILE-NAMES* instead of *UPPER-CASE-FILE-NAMES*. I think the capability of case insensitive file recognition in Medley's {DSK} device is essentially optional and implemented only to keep the compatibility with D-Machines. Actually the case insensitive file recognition is significantly slower than on the correct case (AR 11074). There is no reasonable way to solve this problem because the underlying UNIX file system is case sensitive. Thus, I introduced the new parameter *DSK-UPPER-CASE-FILE-NAMES* with its default value NIL.") - (* ;; "DSK code uses *DSK-UPPER-CASE-FILE-NAMES* instead of *UPPER-CASE-FILE-NAMES*. I think the capability of case insensitive file recognition in Medley-S {DSK} device is essentially optional and implemented only to keep the compatibility with D-Machines. Actually the case insensitive file recognition is significantly slower than on the correct case (AR 11074). There is no reasonable way to solve this problem because the underlying UNIX file ysystem is case sensitive. Thus, I introduced the new parameter *DSK-UPPER-CASE-FILE-NAMES* with its default value NIL.") - - (COND - (ATOMP (MKATOM (U-CASE NAME))) - (T (U-CASE NAME] - (T (COND - (ATOMP (MKATOM NAME)) - (T NAME] - (T (SETQ NAME (CONCAT *UFS-HOST-NAME* DIR NAME)) - (COND - (ATOMP (MKATOM NAME)) - (T NAME]) + (CL:WHEN NAME (* ; "Pass NIL thru transparently") + (SETQ NAME (CONCAT "{" (FETCH (FDEV DEVICENAME) OF DEV) + "}" DIR NAME)) + (CL:IF (AND (DSKP DEV) + *DSK-UPPER-CASE-FILE-NAMES*) + (U-CASE NAME) + NAME))]) (PUTPROPS \UFSGetMonitor MACRO ((DEV) (SELECTQ (fetch (FDEV DEVICENAME) of DEV) @@ -1170,23 +1129,23 @@ update the map") (SETQ PAGES (RESTOREMAP STREAM))) (DELETED (* ; "the file disap (PUTPROPS UFS COPYRIGHT ("Venue & Xerox Corporation" 1988 1989 1990 1991 1992 1993 1994 1995 2000 2021 2022)) (DECLARE%: DONTCOPY - (FILEMAP (NIL (9021 10574 (\UFSCreateDevice 9031 . 9396) (\UFS.CREATE.DEVICE 9398 . 10254) ( -\UFSOpenDevice 10256 . 10433) (\UFSCloseDevice 10435 . 10572)) (15115 53437 (\UFSOpenFile 15125 . -18419) (\UFS.OPENP 18421 . 18918) (\UFS.RECOGNIZE.FILE 18920 . 19673) (\UFS.DIRECTORY.NAME 19675 . -20418) (\UFSCloseFile 20420 . 21396) (\UFSGetFileName 21398 . 21597) (\UFSDeleteFile 21599 . 22139) ( -\UFSRenameFile 22141 . 23306) (\UFSReadPages 23308 . 24443) (\UFSWritePages 24445 . 25665) ( -\UFSTruncateFile 25667 . 27164) (\UFSDirectoryNameP 27166 . 28220) (\UFSEventFn 28222 . 28884) ( -\UFSGetFileInfo 28886 . 31168) (\UFS.CREATE.PROPS 31170 . 31523) (\UFSSetFileInfo 31525 . 32754) ( -\UFSGenerateFiles 32756 . 39188) (\UFS.NEXTFILEFN 39190 . 50025) (\UFS.FILEINFOFN 50027 . 51476) ( -\UFS.VALID.PROPP 51478 . 51770) (\UFS.REGISTER.GFS 51772 . 52027) (\UFS.UNREGISTER.GFS 52029 . 52612) -(\UFS.ABORT.DIRECTORY 52614 . 52962) (\UFS.ABORT.CL-DIRECTORY 52964 . 53251) (\UFS.CLEANUP.GFS.TABLE -53253 . 53435)) (53472 60156 (\UFSMakeUnixFormatName 53482 . 54503) (\UFSParseNameString 54505 . 54879 -) (\UFSParse-Directory 54881 . 55422) (\UFS.PARSE.BODY 55424 . 55969) (\UFS.ADJUST.HOST 55971 . 56130) - (\UFS.FULLNAME 56132 . 57340) (\UFS.ADD.HOST.FIELD 57342 . 57702) (\UFS.REMOVE.HOST.FIELD 57704 . -59374) (\UFS.HANDLE.RELATIVEDIRECTORY 59376 . 60154)) (60972 61585 (CHDIR 60982 . 61583)) (61657 62643 - (\DEVICEFILE.EOSERROR 61667 . 62641)) (62716 63953 (\UNVISIBLE.PAGED.REVALIDATEFILELST 62726 . 63571) - (\UNVISIBLE.FLUSH.OPEN.STREAMS 63573 . 63951)) (63986 65612 (\UFSError 63996 . 65610)) (65656 68071 ( -\UFSGetFileType 65666 . 66267) (\UFSSetFileType 66269 . 66866) (\UFSeol 66868 . 68069)) (77414 78538 ( -\UFSGetPrintFileType 77424 . 77836) (\UFSGetFileTypeConfirm 77838 . 78286) (\UFSPrintTypeMenu 78288 . -78536)) (78568 81406 (\UFStoOtherCopyMess 78578 . 80256) (\UFStoOtherRenameMess 80258 . 81404))))) + (FILEMAP (NIL (8950 10503 (\UFSCreateDevice 8960 . 9325) (\UFS.CREATE.DEVICE 9327 . 10183) ( +\UFSOpenDevice 10185 . 10362) (\UFSCloseDevice 10364 . 10501)) (14766 50339 (\UFSOpenFile 14776 . +18070) (\UFS.OPENP 18072 . 18569) (\UFS.RECOGNIZE.FILE 18571 . 19324) (\UFS.DIRECTORY.NAME 19326 . +20069) (\UFSCloseFile 20071 . 21047) (\UFSGetFileName 21049 . 21248) (\UFSDeleteFile 21250 . 21790) ( +\UFSRenameFile 21792 . 22957) (\UFSReadPages 22959 . 24094) (\UFSWritePages 24096 . 25316) ( +\UFSTruncateFile 25318 . 26815) (\UFSDirectoryNameP 26817 . 27871) (\UFSEventFn 27873 . 28535) ( +\UFSGetFileInfo 28537 . 30819) (\UFS.CREATE.PROPS 30821 . 31174) (\UFSSetFileInfo 31176 . 32405) ( +\UFSGenerateFiles 32407 . 39287) (\UFS.NEXTFILEFN 39289 . 46927) (\UFS.FILEINFOFN 46929 . 48378) ( +\UFS.VALID.PROPP 48380 . 48672) (\UFS.REGISTER.GFS 48674 . 48929) (\UFS.UNREGISTER.GFS 48931 . 49514) +(\UFS.ABORT.DIRECTORY 49516 . 49864) (\UFS.ABORT.CL-DIRECTORY 49866 . 50153) (\UFS.CLEANUP.GFS.TABLE +50155 . 50337)) (50374 57058 (\UFSMakeUnixFormatName 50384 . 51405) (\UFSParseNameString 51407 . 51781 +) (\UFSParse-Directory 51783 . 52324) (\UFS.PARSE.BODY 52326 . 52871) (\UFS.ADJUST.HOST 52873 . 53032) + (\UFS.FULLNAME 53034 . 54242) (\UFS.ADD.HOST.FIELD 54244 . 54604) (\UFS.REMOVE.HOST.FIELD 54606 . +56276) (\UFS.HANDLE.RELATIVEDIRECTORY 56278 . 57056)) (57874 58487 (CHDIR 57884 . 58485)) (58559 59545 + (\DEVICEFILE.EOSERROR 58569 . 59543)) (59618 60855 (\UNVISIBLE.PAGED.REVALIDATEFILELST 59628 . 60473) + (\UNVISIBLE.FLUSH.OPEN.STREAMS 60475 . 60853)) (60888 62514 (\UFSError 60898 . 62512)) (62558 64973 ( +\UFSGetFileType 62568 . 63169) (\UFSSetFileType 63171 . 63768) (\UFSeol 63770 . 64971)) (73620 74744 ( +\UFSGetPrintFileType 73630 . 74042) (\UFSGetFileTypeConfirm 74044 . 74492) (\UFSPrintTypeMenu 74494 . +74742)) (74774 77612 (\UFStoOtherCopyMess 74784 . 76462) (\UFStoOtherRenameMess 76464 . 77610))))) STOP diff --git a/sources/UFS.LCOM b/sources/UFS.LCOM index 8ce36b327619dacda61e1820ed8c893d7a6c0218..44b3ed671bd5c9423f66a1244494a487cd222c00 100644 GIT binary patch delta 4898 zcmbVPZ){sv6}O!~P2D!L6DM7hw7q>x)3|NC_t$=Q+c4LDj-T`F=lVUzZ5pY|;;2cQ zI#rShrmAuU+LyIOXjf{51Y?`DX%Z4NN%Ns&k_AJ8!3Tuk0|Eh~d_eF4G7Tgow1#u< zdvFMPWp5=MOaS=Wo5kd?aW@eVI z-dK3iOzeN6~Rqt{;>v53)? zrB|0{W>-e@2_tYu;QffH--VSUk`xhn2EDR8TdwWno|&62U7cMy9zmt0)w%i7RWuJ< zC-Rzx>X!!s0R|PPSHZMrsSPuJ_i#ehlvqxQno7J;$UdRKAp1b&|La63B(p-$jUw5c zGNI~uVKru#+O_zemRRo6xCG2L|G)DOf;<+>ZAe$ zkIv^42_*+Z4k@`@Mu!oL$oYvBj-Kk*B@_oEV+u;3ATmsFOB#kDGzC|>x^yGGRGMF1 zS_YPkqNbTs&*x3WkDNblYjrsD?GE_+#8tdXzFW9b=)`y3hsqNl6Z)GI*7U%`o(U?D z-$&T_Ir>?29rZFT$ww_;U31PAJhqDU!xfmAOkPW=`-$+IYtF8uYAvkE^fk(?f0`;e zw}12JCshF)KYd8Fg%(}5ruFwzdx^%X(0Wy%r7G}x3O|?bEg!VB*A~9JwtYEOTUDK{ zu7cTfJF|n8lFLE2nM^LW*@`cN%%Rl6I6d|*MeVlKyK7JXnetq9s9@t3@ygS`cMy9& zOfGipD0=!!>d92E*V(ESUAEFgDUV}V6hkPcMU4D;L%D!Np2x=m-G@YuLsKNvtbh+> zb9&Z5f-I9+uMiaK)(8?yxZQ#fhIrES7=(kG8AAdm0pI76$){%@kH%;`^P))D`?+wH z!Etyx(BqWxmjixh7{3!>y294(Bu`1mp%9OM*xBO}1^iiOZ&?(06wRASJ%@xa-4qES z7J-qb5;Ijjg9JWQmEgl6q(Xegt=)q_6>=&hF-b073L}-C5ms3oK8R}4Tv$Lm!kjE2 zB3mX~P+=|@M&_lgf;a)PfMgHHvIx>-%uJ$S5b0VRNwxeC!_`a?WK>YiWFW0)RFj;7 zr{}Fp99~5EjCv6iBgiNup#p0H+H8B#TbOx=uX znS7cgZjiVmn*RwWV5YvzQKGYEsPGL(x158(PC-AxMv=!t+CrXUdo z4*($}vXuBb3uzyOWlF{-gH#UqHIN`s6NgKP!C^1K1l(0LXDD$3C0S0UhXbsDkkGTl zxdsqC5i-Gq3?VphZzOUurx=Qv&~s_yB;kVFn(>Ag@Y}%w4g6=HkQ@j^i7h)P21XDV z2G|s*vF%5$zjf_(I17Wj!09xAQ~wJzJ-u8@l4jD0&5%7P47y3aZJsC$;*T!AP=*Y% zXS~j~s_>pABI9+oH#7D$GdfC63kkf(_EqOv3#`| z_4AZzuc71grey^s=pi!nSMRhwo&)sc*6%}+GBx^ZYoX&b{cT=JLH9~;CB1pj+C-yP z=v{?D3SU=z_$xAU4&%ui{bh~PT8m&uhJEiUK-)QU=R(X~(=wd#yL)O_ugVqwtNQ7P)^t!wwFjqCTV?H7L0;iyzE z>~T@`byjrr$Xx~V4~r?^^OfQ?-w{v|@FB80?BDD>>h>QL$9+tNYVYgw%mFZm08S|c z=aexh(n>BcmM{PaWk`$Ic(oV@Y_JUiHr0b~5OA)6mIO4F0XR+I_Q-SPAeu@{DgY2D z$iqZ7Z=R1DNrT{Pigp%T8)eKRR@%JM=rz9TWOU-ad1YosCV5mJ}0qT?- z5CH!i{zs(u6`4mdJrj$XNC-;LbdUg;R~3Qv&+;K}1N4P_6uLu!rD#nF4hrAZGgpQ} z07_NZ3xUEN)C+-5TB)Qkk3TsxPzD!~vyyvKGYLJBK@u2Ac^Ozn_=G3PP;CIyG-$&l ziQ6GaT?S-IXU&3|iR%UM1lPm>e>Y0NMO7JPx<-&fHG82<*V!wGqGhiDwa9Me1SmsE z9Sjiw9PI&Hhub_{Y4!Acn6J~u%QoioL0iRH9!f}6n1d3$<0?`#Ycp`sbu)rQjl#p{ z9y>$$$+;1i$Yby5(K7g&iA|SItfJY{tJi0jp;JeU8>)T~F%05m4l!rpYm-44F}Hw( z(#zb0FPxQ5LoCrR6a(f(1}bIeY>94@fcMJE#!p8lo#l*D zpjS-#Tzao@C@eCy7)m~jtpcfMv`f(HYAt&lPJ?FjjA!9<+OeK7tm@LaQ1DQInb~i1 z+9&KmhquM0K8jG>O4+rD63Mc9pp5{?<0_lN$=0`CCd~UP-RZX4HRHB4<$dl#=e1wY zbXw$MD~06k2gW=deBEZd3Y`|z<*#qkiN(>a^$WH!Xnt#>*B&3KF~9h1oy*%?hOV)Q zpLIAEw%()0-kzf$>x>ytvN?{ z2;wOlW&olz#el*uSCg4sV#Z9ylF?jDk3$0nm)`(ioW$dIPWb$YgX;x7J4nZIEXt3> z0QgWHesK8Pu_Fhec|{}&lnmX`B+a70hVl2}5v-+rJp%M+P1DdiPp7(_EcPno*E!yu zljU7f9CVz`D@pgbiw7;wE*>l3HRbTBF!V0a6v|<%aRR6(-5~(%t`!2lWghQy4?`~S zXxPwmW({HdkQWmE?RbAD3PFBAz62qQZZdc@@%jk#n*_K>uLw^=JMPKLkR$*Jc4!fI z9)xGcPD4eZIA#z}LG=6EoetMaR{Rc-wrTUSMJ>?Fw#JJtN_bsu+VyRkA&$SM?I|l< zzp%K!qM=SBoc>Hac*%<5%3!S=g9@G^-_KcHlDWbyEP+QpMdJmZIk zua~?=nxmZy;vwY>33ESye)BX*wp~1k-c)xF)X?Uc5WFi>y~A)Z%`&lvF4>JQ-0jDIc!R}LcRl#%9XC9p z{C85AxpS};jIyNPzcWOqe^00Xaz}$jeTSgbh$yS88R$Fwem@$%kcYP>G#mJ9cmH(^ j#qznFk}*f(N){e|>F7m!1W7~};Gf?+yz!HJ|7ra%-6*ZR delta 5374 zcma)AU2Gf25hf|yk!hKrBubHK+TO5oED0fVzdVw*7188TJesHj*T<1IKu_eNN|2->GH*D zrHodVQ4qbD(oes1Vqs;eGG3iqU44FhsZy?1o*%!m^4#it<;r+5t%r|uqsSdZ;*LI+ zjkD3X2>PB`t!yitUzl6IP`Pq6j%JGK{kmScng&D0^Oq|KzjDQgPrf=}y3s{2n=a;Z zs8L}!91f!L+*MdsCqrUz)IE|`a&odDCk#0SLM`4!<2?Hi-khZFpeP&V85B=u66&O^ zhYSskOeYFDa)Y}`ZAu?SBWYD9ZgleE(Of)Vkf#-`sE1Op90(4_g|c(YRKxoS2BnTLlVhGS}ydv83q{B{WG7Atyu$VIQQsO<-|8Jm8XI_+)t08O0aELHs`dlqv90 zlqeb*t$+lUCAtwGhLrSTjKnjv`&qV~J(3FH( z7KMwUZD}?ppdDd08bL&Mn3$l#ti&MWTwX>j59eJuFQZrtq3?b6kqkXF$L>mYr!?dy2kY*!(hy!c`ZaUbQ?ofgUv@g^te-8+{8aOl zSBM-Heyc|Nvz{H&#s%89r_#Q9_YvCC54BpiZP7cDOt8@`wx4=reQ%$qlQd7`T-sL~ zDYoHE_W z%V|E%tMyThvxBuoZSelaqnbzSvz5KE?)bz~q75!?Z9b?rI+2o?5vy>kNbk~9q|p<=p4V_yWn+< zNN}VHG=vNCq@u&g4o{|a6p1oTU=WFL&0`^oW>mOc$z?eyt8yV>Xl4OL1QyMt&&zPU zQG}JyOulHGO6YQ0IST{^QlpU|###v+Om9_NKqAXEz?TrSMuo~;IdyS0lth9AmWt_F zJv^PrDXB2Yt~?SVEYbnvEI1QHnANUY0MyF^-mwHb>pfVwO=DODA%OuvR|Nm!g#iyQ zMNv{ylL-Uy5e}c38Qc$GWmC9F1SkWCSP4wS#d@Zg$N@}n4Fg`p11Dy?L{RtkiGT_I zlHijtDr#Cwt4Or5I;;XD5IUiO3W_p0-9Vxs?hFJ7IJi5NH%f|{(n?6+#1;YsuStT3 zsMiT5ox{U!61<_9EO0x0Kv`IXtXdq7Zyd1;!g zIualqAYanZ3g-|9{!oK5+yWeILESpXH`?Ghslg%#CzV>{n5flZp_C!o@z%+EP8Pp6 z9&+&!{Q3A1laWv`Ik$Z5Dyl3$w^Uh$iVp?dh=+X%1`#htP;d-d9>hosz)V^W?pE4D zP-zQy9Btup3Z4ie7CeOMYz)L+f)smI2CWMJI8I~=;GGq5b3K>B_6I5zxo110@d+incAaT zK407d;v=?*n=)>$JN{kjbGls6`G>`!!})HEP7Rwz$w#NoyUQdZj`u8)-*!6|w*ZXa zwuV)&K|QZ}sj#(1o8_}vmYyb7pUvuPpEYQ)%<5n}&u>rjx3Mh7$3woMqPOJR_+QBj zuq!|f)`W!uAneSfyn~j40EJ#7S_)9TPzkdRr~=d`%_5K)O-cZ@nkD!sAWowh9u94j z4qk){p-F-P2?A2vfCPxd@eTPL&cmYy$}~2HR3ihgokCJekufAJ8R?KBu=Yl0SdqaA zb--lFh0$n@h5E@xQx?*$7)pY-C<-kor-Ogm#)J0?lj@guHE=%tbrUIv9bwqIE7G0}omj!#6G_ZLg3A2x$}Suoxb~ z-X_Nh_&_r5l<=8UKlx_*og#K-`dvJSU&tIk)9w=s)qJZO7K-sU8f^U-5JLoILjr`hS)qjbBPiHy-*fVrAi9Ad;{|45d)U- zs(h4z3zJ^9^zZ-(KhxuMxF#$V4fOUpGk{8;^rEgzg68^pd?5Y4ne|!{3%^!(+Pk!7e0gEEucj;N0HDiQ|SjfcYoR>@+!Ri3U!Vzf}A$4UF9B?fF#*z}TQ3Bp_ zO)B6q*u;nGY@0tq%TNeGqXH81=Rc8m&P{OrJ z!Qt8=;b#>8F2u!n{Ceu33qtxMwIBas>@j#<`!_#Pwoc*?u65&&uJ!bhU&EU4n!#UO zKY;IFJJIhRY2`)n#M(jp_3Mn&jc;7{6#CIr1<;Vzc?Kwi-m%$8ljY&H!^4{an|lNyvZ9dW^@z>UOTio J^xBuZ{tt|jAesOG From 74a43b9dea2336c32c8b9845a1ecf8616e17bd80 Mon Sep 17 00:00:00 2001 From: rmkaplan Date: Sun, 24 Apr 2022 13:46:57 -0700 Subject: [PATCH 6/9] LLCHAR: Expose interation variables fo I.S.OPRS instring inpname... So can be used (carefully) in more, trickier situations. $$OFFSET also now is the index of the current character --- sources/LLCHAR | 196 ++++++++++++++++++++------------------------ sources/LLCHAR.LCOM | Bin 22298 -> 22466 bytes 2 files changed, 88 insertions(+), 108 deletions(-) diff --git a/sources/LLCHAR b/sources/LLCHAR index db262b7d..80e08dd8 100644 --- a/sources/LLCHAR +++ b/sources/LLCHAR @@ -1,11 +1,11 @@ (DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10) -(FILECREATED " 8-Jan-2022 19:08:41" {DSK}kaplan>Local>medley3.5>my-medley>sources>LLCHAR.;8 106473 +(FILECREATED "23-Apr-2022 17:19:02" {DSK}kaplan>Local>medley3.5>my-medley>sources>LLCHAR.;12 105415 - :CHANGES-TO (FNS STRING.EQUAL) + :CHANGES-TO (VARS LLCHARCOMS) - :PREVIOUS-DATE "21-Jun-2021 18:08:19" -{DSK}kaplan>Local>medley3.5>my-medley>sources>LLCHAR.;6) + :PREVIOUS-DATE "23-Apr-2022 07:49:25" +{DSK}kaplan>Local>medley3.5>my-medley>sources>LLCHAR.;11) (* ; " @@ -31,6 +31,9 @@ Copyright (c) 1982-1988, 1990, 1994, 2018, 2021 by Venue & Xerox Corporation. (CONSTANTS (\FATPNAMESTRINGP T)) (MACROS \PNAMESTRINGPUTCHAR) (OPTIMIZERS FCHARACTER) + + (* ;; "Iterators expose control variables, $$OFFSET corresponds to current character (except inside user's repeatwhile or repeatuntil)") + (I.S.OPRS inpname inatom instring) (* ;  "For use when the inner-loop test in the generic operators is too expensive") @@ -1557,24 +1560,19 @@ Copyright (c) 1982-1988, 1990, 1994, 2018, 2021 by Venue & Xerox Corporation. ,NUM)) (DECLARE%: EVAL@COMPILE -(I.S.OPR 'inpname NIL '[SUBPAIR '($$END $$BODY $$FATP $$BASE $$OFFSET) - (LIST (GETDUMMYVAR) - (GETDUMMYVAR) - (GETDUMMYVAR) - (GETDUMMYVAR) - (GETDUMMYVAR)) - `(bind $$OFFSET _ 0 $$BODY _ BODY $$BASE $$END $$FATP +(I.S.OPR 'inpname NIL '[SUBST (GETDUMMYVAR) + '$$BODY + `(bind $$OFFSET _ 1 $$BODY _ BODY $$BASE $$END $$FATP declare (LOCALVARS $$END $$BODY $$FATP $$BASE $$OFFSET) first [PROG NIL $$RETRY (COND ((STRINGP $$BODY) (SETQ $$BASE (ffetch (STRINGP BASE) of $$BODY)) - (SETQ $$OFFSET (SUB1 (ffetch (STRINGP OFFST) - of $$BODY))) - (SETQ $$END (IPLUS $$OFFSET (ffetch (STRINGP LENGTH - ) - of $$BODY))) + (SETQ $$OFFSET (ffetch (STRINGP OFFST) of $$BODY)) + (SETQ $$END (IPLUS $$OFFSET -1 (ffetch (STRINGP + LENGTH) + of $$BODY))) (SETQ $$FATP (ffetch (STRINGP FATSTRINGP) of $$BODY))) ((LITATOM $$BODY) @@ -1585,120 +1583,102 @@ Copyright (c) 1982-1988, 1990, 1994, 2018, 2021 by Venue & Xerox Corporation. (SETQ $$FATP (ffetch (LITATOM FATPNAMEP) of $$BODY))) (T (SETQ $$BODY (MKSTRING $$BODY)) - (GO $$RETRY] - eachtime (SETQ $$OFFSET (ADD1 $$OFFSET)) - (AND (IGREATERP $$OFFSET $$END) - (GO $$OUT)) - (SETQ I.V. (COND - ($$FATP (\GETBASEFAT $$BASE $$OFFSET)) - (T (\GETBASETHIN $$BASE $$OFFSET] + (GO $$RETRY] eachtime (AND (IGREATERP $$OFFSET + $$END) + (GO $$OUT)) + (SETQ I.V. + (\GETBASECHAR $$FATP $$BASE + $$OFFSET)) + repeatwhile (PROGN (SETQ $$OFFSET (ADD1 $$OFFSET)) + T] T) -(I.S.OPR 'inatom NIL '[SUBPAIR '($$OFFSET $$BODY $$BASE $$END $$FATP) - (LIST (GETDUMMYVAR) - (GETDUMMYVAR) - (GETDUMMYVAR) - (GETDUMMYVAR) - (GETDUMMYVAR)) - '(bind $$OFFSET _ 0 $$BODY _ BODY $$BASE $$END $$FATP +(I.S.OPR 'inatom NIL '[SUBST (GETDUMMYVAR) + '$$BODY + '(bind $$OFFSET _ 1 $$BODY _ BODY $$BASE $$END $$FATP declare (LOCALVARS $$OFFSET $$BODY $$BASE $$END $$FATP) first (SETQ $$BASE (ffetch (LITATOM PNAMEBASE) of $$BODY)) (SETQ $$END (ffetch (PNAMEBASE PNAMELENGTH) of $$BASE)) (SETQ $$FATP (ffetch (LITATOM FATPNAMEP) of $$BODY)) - eachtime (SETQ $$OFFSET (ADD1 $$OFFSET)) - (AND (IGREATERP $$OFFSET $$END) - (GO $$OUT)) - (SETQ I.V. (COND - ($$FATP (\GETBASEFAT $$BASE $$OFFSET)) - (T (\GETBASETHIN $$BASE $$OFFSET] + eachtime (AND (IGREATERP $$OFFSET $$END) + (GO $$OUT)) + (SETQ I.V. (\GETBASECHAR $$FATP $$BASE $$OFFSET)) + repeatwhile (PROGN (SETQ $$OFFSET (ADD1 $$OFFSET)) + T] T) -(I.S.OPR 'instring NIL '[SUBPAIR '($$BODY $$END $$OFFSET $$BASE $$FATP) - (LIST (GETDUMMYVAR) - (GETDUMMYVAR) - (GETDUMMYVAR) - (GETDUMMYVAR) - (GETDUMMYVAR)) +(I.S.OPR 'instring NIL '[SUBST (GETDUMMYVAR) + '$$BODY '(bind $$BODY _ BODY $$END $$OFFSET $$BASE $$FATP declare (LOCALVARS $$BODY $$END $$OFFSET $$BASE $$FATP) - first (SETQ $$OFFSET (SUB1 (ffetch (STRINGP OFFST) of $$BODY))) + first (SETQ $$OFFSET (ffetch (STRINGP OFFST) of $$BODY)) (SETQ $$BASE (ffetch (STRINGP BASE) of $$BODY)) - (SETQ $$END (IPLUS $$OFFSET (ffetch (STRINGP LENGTH) - of $$BODY))) + (SETQ $$END (IPLUS $$OFFSET -1 (ffetch (STRINGP LENGTH) + of $$BODY))) (SETQ $$FATP (ffetch (STRINGP FATSTRINGP) of $$BODY)) - eachtime (SETQ $$OFFSET (ADD1 $$OFFSET)) - (AND (IGREATERP $$OFFSET $$END) - (GO $$OUT)) - (SETQ I.V. (COND - ($$FATP (\GETBASEFAT $$BASE $$OFFSET)) - (T (\GETBASETHIN $$BASE $$OFFSET] + eachtime (AND (IGREATERP $$OFFSET $$END) + (GO $$OUT)) + (SETQ I.V. (\GETBASECHAR $$FATP $$BASE $$OFFSET)) + repeatwhile (PROGN (SETQ $$OFFSET (ADD1 $$OFFSET)) + T] T) ) (DECLARE%: EVAL@COMPILE -(I.S.OPR 'infatatom NIL '[SUBPAIR '($$OFFSET $$BODY $$BASE $$END) - (LIST (GETDUMMYVAR) - (GETDUMMYVAR) - (GETDUMMYVAR) - (GETDUMMYVAR)) - '(bind $$OFFSET _ 0 $$BODY _ BODY $$BASE $$END +(I.S.OPR 'infatatom NIL '[SUBST (GETDUMMYVAR) + '$$BODY + '(bind $$OFFSET _ 1 $$BODY _ BODY $$BASE $$END declare (LOCALVARS $$OFFSET $$BODY $$BASE $$END) first (SETQ $$BASE (ffetch (LITATOM PNAMEBASE) of $$BODY)) (SETQ $$END (ffetch (PNAMEBASE PNAMELENGTH) of $$BASE)) - eachtime (SETQ $$OFFSET (ADD1 $$OFFSET)) - (AND (IGREATERP $$OFFSET $$END) - (GO $$OUT)) - (SETQ I.V. (\GETBASEFAT $$BASE $$OFFSET] + eachtime (AND (IGREATERP $$OFFSET $$END) + (GO $$OUT)) + (SETQ I.V. (\GETBASEFAT $$BASE $$OFFSET)) + repeatwhile (PROGN (SETQ $$OFFSET (ADD1 $$OFFSET)) + T] T) -(I.S.OPR 'inthinatom NIL '[SUBPAIR '($$OFFSET $$BODY $$BASE $$END) - (LIST (GETDUMMYVAR) - (GETDUMMYVAR) - (GETDUMMYVAR) - (GETDUMMYVAR)) - '(bind $$OFFSET _ 0 $$BODY _ BODY $$BASE $$END +(I.S.OPR 'inthinatom NIL '[SUBST (GETDUMMYVAR) + '$$BODY + '(bind $$OFFSET _ 1 $$BODY _ BODY $$BASE $$END declare (LOCALVARS $$OFFSET $$BODY $$BASE $$END) first (SETQ $$BASE (ffetch (LITATOM PNAMEBASE) of $$BODY)) (SETQ $$END (ffetch (PNAMEBASE PNAMELENGTH) of $$BASE)) - eachtime (SETQ $$OFFSET (ADD1 $$OFFSET)) - (AND (IGREATERP $$OFFSET $$END) - (GO $$OUT)) - (SETQ I.V. (\GETBASETHIN $$BASE $$OFFSET] + eachtime (AND (IGREATERP $$OFFSET $$END) + (GO $$OUT)) + (SETQ I.V. (\GETBASETHIN $$BASE $$OFFSET)) + repeatwhile (PROGN (SETQ $$OFFSET (ADD1 $$OFFSET)) + T] T) -(I.S.OPR 'infatstring NIL '[SUBPAIR '($$BODY $$END $$OFFSET $$BASE) - (LIST (GETDUMMYVAR) - (GETDUMMYVAR) - (GETDUMMYVAR) - (GETDUMMYVAR)) +(I.S.OPR 'infatstring NIL '[SUBST (GETDUMMYVAR) + '$$BODY '(bind $$BODY _ BODY $$END $$OFFSET $$BASE declare (LOCALVARS $$BODY $$END $$OFFSET $$BASE) - first (SETQ $$OFFSET (SUB1 (ffetch (STRINGP OFFST) of $$BODY))) + first (SETQ $$OFFSET (ffetch (STRINGP OFFST) of $$BODY)) (SETQ $$BASE (ffetch (STRINGP BASE) of $$BODY)) - (SETQ $$END (IPLUS $$OFFSET (ffetch (STRINGP LENGTH) - of $$BODY))) - eachtime (SETQ $$OFFSET (ADD1 $$OFFSET)) - (AND (IGREATERP $$OFFSET $$END) - (GO $$OUT)) - (SETQ I.V. (\GETBASEFAT $$BASE $$OFFSET] + (SETQ $$END (IPLUS $$OFFSET -1 (ffetch (STRINGP LENGTH) + of $$BODY))) + eachtime (AND (IGREATERP $$OFFSET $$END) + (GO $$OUT)) + (SETQ I.V. (\GETBASEFAT $$BASE $$OFFSET)) + repeatwhile (PROGN (SETQ $$OFFSET (ADD1 $$OFFSET)) + T] T) -(I.S.OPR 'inthinstring NIL '[SUBPAIR '($$BODY $$END $$OFFSET $$BASE) - (LIST (GETDUMMYVAR) - (GETDUMMYVAR) - (GETDUMMYVAR) - (GETDUMMYVAR)) +(I.S.OPR 'inthinstring NIL '[SUBST (GETDUMMYVAR) + '$$BODY '(bind $$BODY _ BODY $$END $$OFFSET $$BASE declare (LOCALVARS $$BODY $$END $$OFFSET $$BASE) - first (SETQ $$OFFSET (SUB1 (ffetch (STRINGP OFFST) - of $$BODY))) + first (SETQ $$OFFSET (ffetch (STRINGP OFFST) of $$BODY)) (SETQ $$BASE (ffetch (STRINGP BASE) of $$BODY)) - (SETQ $$END (IPLUS $$OFFSET (ffetch (STRINGP LENGTH) - of $$BODY))) - eachtime (SETQ $$OFFSET (ADD1 $$OFFSET)) - (AND (IGREATERP $$OFFSET $$END) - (GO $$OUT)) - (SETQ I.V. (\GETBASETHIN $$BASE $$OFFSET] + (SETQ $$END (IPLUS $$OFFSET -1 (ffetch (STRINGP LENGTH) + of $$BODY))) + eachtime (AND (IGREATERP $$OFFSET $$END) + (GO $$OUT)) + (SETQ I.V. (\GETBASETHIN $$BASE $$OFFSET)) + repeatwhile (PROGN (SETQ $$OFFSET (ADD1 $$OFFSET)) + T] T) ) (DECLARE%: EVAL@COMPILE @@ -1875,16 +1855,16 @@ Copyright (c) 1982-1988, 1990, 1994, 2018, 2021 by Venue & Xerox Corporation. (PUTPROPS LLCHAR COPYRIGHT ("Venue & Xerox Corporation" 1982 1983 1984 1985 1986 1987 1988 1990 1994 2018 2021)) (DECLARE%: DONTCOPY - (FILEMAP (NIL (4009 74195 (ALLOCSTRING 4019 . 6042) (MKATOM 6044 . 6679) (SUBATOM 6681 . 8551) ( -CHARACTER 8553 . 9557) (\PARSE.NUMBER 9559 . 25279) (\INVALID.DOTTED.SYMBOL 25281 . 25776) ( -\INVALID.INTEGER 25778 . 27230) (\MKINTEGER 27232 . 29939) (MKSTRING 29941 . 32084) ( -\PRINDATUM.TO.STRING 32086 . 38264) (BKSYSBUF 38266 . 39800) (NCHARS 39802 . 41502) (NTHCHARCODE 41504 - . 43550) (RPLCHARCODE 43552 . 44613) (\RPLCHARCODE 44615 . 46150) (NTHCHAR 46152 . 46345) (RPLSTRING -46347 . 49558) (SUBSTRING 49560 . 52483) (GNC 52485 . 52658) (GNCCODE 52660 . 53428) (GLC 53430 . -53603) (GLCCODE 53605 . 54370) (STREQUAL 54372 . 56486) (STRING.EQUAL 56488 . 60826) (STRINGP 60828 . -60979) (CHCON1 60981 . 61768) (U-CASE 61770 . 64997) (L-CASE 64999 . 68859) (U-CASEP 68861 . 69435) ( -\SMASHABLESTRING 69437 . 69899) (\MAKEWRITABLESTRING 69901 . 70337) (\SMASHSTRING 70339 . 74045) ( -\FATTENSTRING 74047 . 74193)) (74380 79542 (\GETBASESTRING 74390 . 75044) (\PUTBASESTRING 75046 . -77785) (\PUTBASESTRINGFAT 77787 . 78533) (GetBcplString 78535 . 79200) (SetBcplString 79202 . 79540)) -(102859 105673 (%%COPY-ONED-ARRAY 102869 . 104719) (%%COPY-STRING-TO-ARRAY 104721 . 105671))))) + (FILEMAP (NIL (4223 74409 (ALLOCSTRING 4233 . 6256) (MKATOM 6258 . 6893) (SUBATOM 6895 . 8765) ( +CHARACTER 8767 . 9771) (\PARSE.NUMBER 9773 . 25493) (\INVALID.DOTTED.SYMBOL 25495 . 25990) ( +\INVALID.INTEGER 25992 . 27444) (\MKINTEGER 27446 . 30153) (MKSTRING 30155 . 32298) ( +\PRINDATUM.TO.STRING 32300 . 38478) (BKSYSBUF 38480 . 40014) (NCHARS 40016 . 41716) (NTHCHARCODE 41718 + . 43764) (RPLCHARCODE 43766 . 44827) (\RPLCHARCODE 44829 . 46364) (NTHCHAR 46366 . 46559) (RPLSTRING +46561 . 49772) (SUBSTRING 49774 . 52697) (GNC 52699 . 52872) (GNCCODE 52874 . 53642) (GLC 53644 . +53817) (GLCCODE 53819 . 54584) (STREQUAL 54586 . 56700) (STRING.EQUAL 56702 . 61040) (STRINGP 61042 . +61193) (CHCON1 61195 . 61982) (U-CASE 61984 . 65211) (L-CASE 65213 . 69073) (U-CASEP 69075 . 69649) ( +\SMASHABLESTRING 69651 . 70113) (\MAKEWRITABLESTRING 70115 . 70551) (\SMASHSTRING 70553 . 74259) ( +\FATTENSTRING 74261 . 74407)) (74594 79756 (\GETBASESTRING 74604 . 75258) (\PUTBASESTRING 75260 . +77999) (\PUTBASESTRINGFAT 78001 . 78747) (GetBcplString 78749 . 79414) (SetBcplString 79416 . 79754)) +(101801 104615 (%%COPY-ONED-ARRAY 101811 . 103661) (%%COPY-STRING-TO-ARRAY 103663 . 104613))))) STOP diff --git a/sources/LLCHAR.LCOM b/sources/LLCHAR.LCOM index b2e9905752b99f2c958fbae78c4293b170f93997..979ec6c16c31646bd5dfc75e9a6f28fad7642d3d 100644 GIT binary patch delta 2451 zcmZ`)OKcNI7~ZwR%OxZvfk2=zF^||0Nq6?)7pQn`ue0mj^*Xkb@`$M1*b-q)5;=y_ zUIMMuLt9knkXC9>g;Mp@nwVBV0ui|s0iyzH((G*Ps==MRckD@Q?v2jQ{fqnTT<@Rxuk7De=W)Es= zOj3ldFn*-%U}zZF!+nYZmVe*f-E9ZyR6djbPaLn^X>%CsgK>dR3L*1Ha830n$WI9!J#-lQNjs)vAEDLX?=;V5XLk^;`6g!AI+hM zq~8KzvEDLn9q+V({rho3Qa+PQu}#)i@vaB3`*>lg#M z%xET+fBX1QHUma-mDl=I{?u@ODC@M_oWM~$zbXyJ*R8b>R{qm##C3l<&G;8456tNP zjdY!KckO-R$Q-d|O1f*Avw{-~#}}qWxr~~x5l@tfi1_Fp@m@rnT}R;GjHs6m6@IUb zCr|h{@^xZ*&eC{d;c6vx?w<9QIdGqtiky6260>M{@Ahre5vg3N>Ok+2Jb0hN!%qP!~LqO%|t*MdSK(Jl1zN>dQ6dXS z)=N`Sy>zTllAB6rPm~%72V_w%-`dPzD$VIL#q-XlEe#JE2!dRcz~yVi1JodRNF9j+ zSfw?Uiy~?W9IzR%sy=_a@FVIC>?40e&pKPs>hLD?YIuv)INRMos4iMA%BVhgpkCXc zm++w@`uwdz5oy645(oOaf|z)~vh323VLf2a9zGuD4|f?w0SvftPu8iBYQE~}0Hv~_Yb$=i%x z@>{Ok{FcRW8!jB{Wq?wp%>$Q)jLTiiZIL#PHPgmo@hz`3L%$#z&DF2>Fpx2SL1RWu zrC84B5`i3r32fcUyxx=ImCcW_gd zi+i+2ZNuzsMf|JSCdrS~pNW}j3p_my-R)2a4_?PB_553ddj=bvjaTgYYs`U$j!$~0lSZ+n9u#C4>`D)rM&D27R z0`uUW5w$)g6iosKJEK`$*p*G%Vesv_6wulhZ!#K7c_~)Gq+K4P9h)hS84Y^8#n$M@ zmd0yXI(30`MG4rJo}*&y*nU00Zw$O7iRqP+xUFCc#ifEwDRQ~kfugHl*mh}0X zg%TR+703(dhu-eio*4s{Syj3B2JpRiTf{Egf&Rt|upDnxY^;QK#9jLmxGAydRk`X= zEM;^+ja|mY0U;jO;((zzbT-~H?lK&vHcxZ3Ia~T=_UV=E)5adl+Zj_--34NsGf%OU ZiDuNC_|n38Q6XU`8T{N?{4?RO{tH+s_Z9#E delta 2260 zcmb7FUu+X~9PhQGjHz20+aLwUj}l;A=yLbF>-Aa?dTp=m{p)qtb}(opOKLK96*Z9; zNu1)FF;Vx+d{BA7K%y_$twsYIH0%M{5){m$T>``yqdxes#z$lHch{|33orJez5f1u z?)&|GKEKaz;Y;G#?JX52_c|@A(9I*)Q3iTlJf!&@Nb&qLXZsk84vJ8 zH8m|Nf-jE03Z4#d_8joUbBY2suOAv3@_@qF>n|0aiWBsBI|fXEs4nnXA%+(<72>Q{ zf_UP%%7G4wWSIaBLeV6jN(dQWRs#d^R0d?Sx|m7~3Bx&F@q$oV7e+)am+{3gCh$PY zC!M!?qX5O3h*S{WBfo(`Spd4T-EMR6Q!}=iaG^klS7(n@Cc@icn|Ql@ z(ROOdwslUtZC`SLiPiDdd?jgAPs%m4W5)J_GA$+V-?d$ok_+2x_*44T`k5U^4-WS9 z8Y?%Fg(bUdV)d#u{Pv=4PC|bl?04rYl2JV+*2+D~v@DqjvQ$Sv%%M|)p96W7Pp4D7 zDga1RAgyarA(I&rMtEfeK#FS_p)fTOIWwBU^ypD7CIE^-)bTzC1^oy}V3Gz04)D6p zkNUKDJR@X5fLWt14cI{QUaSlBll8GkF3yuANdd?(01Fk%@)1Qy0|;3#nC7E0pAZId zK{Oa_%;Ntf4f1*}l`^FFV&9rC<>IPUf?kicbqfi!qj9rvyL*&_3aO z*PqYWZ1x6skDlc21aic+I(Jtr?tcFt+~rVjLUmf)T}7`X_DUQFlr@fUH*1eHyU|CT zBR_2B2>Y~2dK$7OM;uL2%@Z)#0tNAzXgMX237VUCLmD<%GEd(+OOT{6OMW}_PYL}F zNV1ryQREbNb}c&_Mw{g;6X>w$9>lq!)Nsm7snfC*8**~tMsZB4m4B0pZ`8^^kGtye zQADqaW_--G#>c#jJ`uq_>{Yx8sMCsUW``m#TrZB{H2Fg`VSX8Rp@*Woo5JS-_gFU? zR+pj7UT`F^=($0Fo*md-J}oT}#CND)IZE6?mxp`Ns|rUXP)I#wH&)P?x{HyDZ5?K^ zRc~pXYcB8CTw3SCO(pqPd50+9SMS*>vavj;7|Zjehh{2bq@Ff>ye@76I`$MGuL*=3 zu%Py+#eZwl?dH2GqO5+qf%#xZDTIK&4?R}*Oj^;XjR=v^tdIc=6KF_g*@3}f*`gss zwdhQ9*z!p&r^HfOKr>j)%~3&Psn-$e4#UP-AJE+O^n_fnF=j1-EMt<}1Ia)$92KO> z^Qrgjeb=xd+9Cx@V9d=wmFR3D%;UZQdUKe2;cSH89@)~Y_g#mvGT%J3Xp*%q38uW7 zmuuzys5ZRYDH_YyODm{P7l`*!ULSJDD-#%$-eTQid3=lAG;b~(sr%7oeRut+t)M$P zJ2`?QiDH2&uLTW5ve@DcmT8s+g05>ipv_=U=d56@uZ{Cr0GmZIFOMclA-$o}dicN% oQX{k(c28q&?X46JuO>i>f#_Q1b303-3)#JGIIR5T3)zI@KRQpa+5i9m From 3364a4af07b62efeb60b18d1cdcc1f722497d8fd Mon Sep 17 00:00:00 2001 From: rmkaplan Date: Sun, 24 Apr 2022 13:48:23 -0700 Subject: [PATCH 7/9] COPYFILES: respects DEFAULTEXT/VERS in single no-stars case --- library/COPYFILES | 92 +++++++++++++++++++++-------------------- library/COPYFILES.LCOM | Bin 15651 -> 15667 bytes 2 files changed, 48 insertions(+), 44 deletions(-) diff --git a/library/COPYFILES b/library/COPYFILES index 09914769..58154427 100644 --- a/library/COPYFILES +++ b/library/COPYFILES @@ -1,15 +1,15 @@ (DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10) -(FILECREATED " 6-Apr-2018 21:14:29"  -{DSK}kaplan>Local>medley3.5>lispcore>library>COPYFILES.;2 23656 - changes to%: (FNS MAPFILES) +(FILECREATED "26-Mar-2022 11:43:49" {DSK}kaplan>Local>medley3.5>my-medley>library>COPYFILES.;3 23773 - previous date%: "23-Mar-93 02:39:53" -{DSK}kaplan>Local>medley3.5>lispcore>library>COPYFILES.;1) + :CHANGES-TO (FNS MAPFILES) + + :PREVIOUS-DATE " 6-Apr-2018 21:14:29" +{DSK}kaplan>Local>medley3.5>my-medley>library>COPYFILES.;1) (* ; " -Copyright (c) 1989, 1990, 1991, 1993, 2018 by Venue & Xerox Corporation. All rights reserved. +Copyright (c) 1989-1991, 1993, 2018 by Venue & Xerox Corporation. ") (PRETTYCOMPRINT COPYFILESCOMS) @@ -18,15 +18,15 @@ Copyright (c) 1989, 1990, 1991, 1993, 2018 by Venue & Xerox Corporation. All ri ((FNS COPYFILES MAPFILES MAPFILES1 COPIEDFILENAME COPIEDFILEPATTERN COPIEDFILEMATCH COPIEDFROMSPEC COPIEDTOSPEC ESPATTERN NOHOST COMPAREFILES) (COMS - (* ;; "For concatenating a list of files into one file.") + (* ;; "For concatenating a list of files into one file.") (FNS CONCATFILES)) (COMS - (* ;; "For splitting a big file into several files.") + (* ;; "For splitting a big file into several files.") (FNS SPLITFILE)) (COMS - (* ;; "For making DOS file systems") + (* ;; "For making DOS file systems") (FNS DOSLINKER SHORTEN)) (I.S.OPRS INFILES))) @@ -37,37 +37,41 @@ Copyright (c) 1989, 1990, 1991, 1993, 2018 by Venue & Xerox Corporation. All ri ) (MAPFILES - [LAMBDA (FILESPEC FN ATTRIBUTES DEFAULTEXT DEFAULTVERS INCLUDE-DIRECTORIES ENUMERATE-FIRST) - (* ; "Edited 6-Apr-2018 21:14 by rmk:") + [LAMBDA (FILESPEC FN ATTRIBUTES DEFAULTEXT DEFAULTVERS INCLUDE-DIRECTORIES ENUMERATE-FIRST) - (* ;; "Run thru all the files that match FILESPEC, calling FN on each such file name, with remaining args being the value of each of the ATTRIBUTES of the file") + (* ;; "Edited 26-Mar-2022 11:43 by rmk: Respect DEFAULTEXT/VERS in singleton no-stars case") + + (* ;; "Edited 6-Apr-2018 21:14 by rmk:") + + (* ;; "Run thru all the files that match FILESPEC, calling FN on each such file name, with remaining args being the value of each of the ATTRIBUTES of the file") (if (LISTP FILESPEC) - then (for X in FILESPEC do (MAPFILES X FN DEFAULTEXT DEFAULTVERS - ATTRIBUTES INCLUDE-DIRECTORIES - ENUMERATE-FIRST)) + then (for X in FILESPEC do (MAPFILES X FN DEFAULTEXT DEFAULTVERS ATTRIBUTES + INCLUDE-DIRECTORIES ENUMERATE-FIRST)) elseif [OR (STRPOS "*" FILESPEC) - (FMEMB (NTHCHARCODE FILESPEC -1) - (CHARCODE (/ > %) %] } %:] - then (* ; "Pattern or directory spec") - (SETQ FILESPEC (DIRECTORY.FILL.PATTERN FILESPEC DEFAULTEXT DEFAULTVERS)) - (if ENUMERATE-FIRST - then (* ; - "Generate all the files first, then apply fn") - (for PAIR in [XCL:WITH-COLLECTION (MAPFILES1 - FILESPEC ATTRIBUTES - INCLUDE-DIRECTORIES - (FUNCTION (CL:LAMBDA - (NAME &REST ATTRS) - (XCL:COLLECT - (CONS NAME ATTRS] - do (CL:APPLY FN (CAR PAIR) - (CDR PAIR))) - else (* ; "Call on each one as we go") - (MAPFILES1 FILESPEC ATTRIBUTES INCLUDE-DIRECTORIES FN)) - elseif (SETQ FILESPEC (INFILEP FILESPEC)) - then (CL:APPLY FN FILESPEC (for ATTR inside ATTRIBUTES - collect (GETFILEINFO FILESPEC ATTR]) + (FMEMB (NTHCHARCODE FILESPEC -1) + (CHARCODE (/ > %) %] } %:] + then (* ; "Pattern or directory spec") + (SETQ FILESPEC (DIRECTORY.FILL.PATTERN FILESPEC DEFAULTEXT DEFAULTVERS)) + (if ENUMERATE-FIRST + then (* ; + "Generate all the files first, then apply fn") + (for PAIR in [XCL:WITH-COLLECTION (MAPFILES1 FILESPEC ATTRIBUTES + INCLUDE-DIRECTORIES + (FUNCTION (CL:LAMBDA + (NAME &REST ATTRS) + (XCL:COLLECT (CONS NAME + ATTRS] + do (CL:APPLY FN (CAR PAIR) + (CDR PAIR))) + else (* ; "Call on each one as we go") + (MAPFILES1 FILESPEC ATTRIBUTES INCLUDE-DIRECTORIES FN)) + elseif (SETQ FILESPEC (INFILEP (PACKFILENAME.STRING 'BODY FILESPEC 'EXTENSION DEFAULTEXT + 'VERSION DEFAULTVERS))) + then + (* ;; "rmk: Singleton, no stars. We don't want to coerce NIL DEFAULTVERS/EXT to *, but still we want to pay attention to them. Hence, do the packfilename") + + (CL:APPLY FN FILESPEC (for ATTR inside ATTRIBUTES collect (GETFILEINFO FILESPEC ATTR]) (MAPFILES1 (LAMBDA (FILESPEC ATTRIBUTES INCLUDE-DIRECTORIES FN) (* ; "Edited 27-Sep-89 14:49 by bvm") (* ;; "Enumerate FILESPEC (pattern must already be filled) and apply FN to each file and its ATTRIBUTES") (RESETLST (LET ((FILEGROUP (\GENERATEFILES FILESPEC (SETQ ATTRIBUTES (MKLIST ATTRIBUTES)) (QUOTE (SORT RESETLST)))) NAME LEN) (while (SETQ NAME (\GENERATENEXTFILE FILEGROUP)) unless (PROGN (* ; "Skip IFS's .;1 file. Also other dir files unless INCLUDE-DIRECTORIES is true.") (OR (AND (>= (SETQ LEN (NCHARS NAME)) 4) (STRING-EQUAL NAME ".;1" :START1 (- LEN 4))) (AND (NOT INCLUDE-DIRECTORIES) (FMEMB (NTHCHARCODE NAME LEN) (CHARCODE (/ >)))))) do (if (NULL (CDR ATTRIBUTES)) then (* ; "Optimize slightly for the case of one attribute") (CL:FUNCALL FN NAME (\GENERATEFILEINFO FILEGROUP (CAR ATTRIBUTES))) else (CL:APPLY FN NAME (for ATTR in ATTRIBUTES collect (\GENERATEFILEINFO FILEGROUP ATTR)))))))) @@ -213,16 +217,16 @@ Copyright (c) 1989, 1990, 1991, 1993, 2018 by Venue & Xerox Corporation. All ri 'GENVAR '(BIND GENVAR _ (\GENERATEFILES BODY NIL '(SORT)) EACHTIME (PROGN (OR (SETQ I.V. (\GENERATENEXTFILE GENVAR)) - (GO $$OUT)) - (IF (LISTP I.V.) - THEN (SETQ I.V. (CONCATCODES I.V.] + (GO $$OUT)) + (IF (LISTP I.V.) + THEN (SETQ I.V. (CONCATCODES I.V.] T) ) (PUTPROPS COPYFILES COPYRIGHT ("Venue & Xerox Corporation" 1989 1990 1991 1993 2018)) (DECLARE%: DONTCOPY - (FILEMAP (NIL (1047 20469 (COPYFILES 1057 . 9186) (MAPFILES 9188 . 11549) (MAPFILES1 11551 . 12470) ( -COPIEDFILENAME 12472 . 13818) (COPIEDFILEPATTERN 13820 . 14874) (COPIEDFILEMATCH 14876 . 15368) ( -COPIEDFROMSPEC 15370 . 16169) (COPIEDTOSPEC 16171 . 16831) (ESPATTERN 16833 . 17114) (NOHOST 17116 . -17277) (COMPAREFILES 17279 . 20467)) (20536 20846 (CONCATFILES 20546 . 20844)) (20909 22086 (SPLITFILE - 20919 . 22084)) (22132 23009 (DOSLINKER 22142 . 22919) (SHORTEN 22921 . 23007))))) + (FILEMAP (NIL (1019 20598 (COPYFILES 1029 . 9158) (MAPFILES 9160 . 11678) (MAPFILES1 11680 . 12599) ( +COPIEDFILENAME 12601 . 13947) (COPIEDFILEPATTERN 13949 . 15003) (COPIEDFILEMATCH 15005 . 15497) ( +COPIEDFROMSPEC 15499 . 16298) (COPIEDTOSPEC 16300 . 16960) (ESPATTERN 16962 . 17243) (NOHOST 17245 . +17406) (COMPAREFILES 17408 . 20596)) (20665 20975 (CONCATFILES 20675 . 20973)) (21038 22215 (SPLITFILE + 21048 . 22213)) (22261 23138 (DOSLINKER 22271 . 23048) (SHORTEN 23050 . 23136))))) STOP diff --git a/library/COPYFILES.LCOM b/library/COPYFILES.LCOM index f4daa2dc86df9175788830b31b9b32d51969665f..1afc550a422dc006aa5c475037efbee01b35534a 100644 GIT binary patch delta 1047 zcmah{OHUI~6sB!>IEc1@F%~E%BjD87GLO>7v>|;>p-|eUEiZ#gYpXOCA;pCyF-G_U zlB>~$CMK9D%7R!)T&XO&aAk1k0(4>AxN^_Jb0^rk!dZOxo^!tQ-8&xZk`$Ghv5=bb%loAA1v|Gl~MT^LbA_#(PlVqEV1&+PCFu#~DTpXN`OeG)=4)RRbUS4gQZ9?`BeFYct>deL| zCK`?~oSCV*DF>YlnKORXc!0z^9xLrRK1e>fV7p^G-a4Tfo6?eJaY)h?SBU47SmfEI7VK7E%5EKhTlo;?iKdmqwAa-I8*Xyn!qH@TOH zw7Y2T(c$*dg-eHtR*Rdmqt+>GePQjU!4BU+HY6iC=r3TD=O?kW!xw1DDkd>l5u0ng z3Z@rq(`sK=`KRp{Eq$>gkMuddA-lo(oTgs8mJqvT$}GvKNp@vQ>UEDHF1aI!AKe!b TJ3QAAS3DuaPoD95b$b2)Pc;&K delta 1051 zcmah{OH30{6z#M@P#99gPb?5_Mvy7mI-hoIr=;lsEjIL*wge$U>}Q0AN}DMd%R-E< z+^8@yapA&56F)0rCB|rUMPlMYSZHM7cV*(rjVn#OGh#8(;4IF&_n!0a+;`rq%-x*3 zG9Zw2AQTsXUbKA$TU zGX+KV=5uK!rIfvW(b$OAEMfO>R#dq+S}_c;E|FnHo}(bG$kkq?e5R=ONH4P0LSKJcDtSOK{hpm15tkxII@!yd4aP2|6FR6I54s0 zA%Ns~!6`syGBrIRmtdxVv(kY`qB^h@ii&(XSC}p7(;!W8ye*tkY;GPHoWw0U`Copu zZ}ltIN~&PoOOWd2T2G~9v=9VYxn#PgEnPJya6#gzy1MPD9<5+`sP0@HF0aiixTx3n z-Q7(_f+3Q&l2tdweix~ZTGk1x>S!5n%=r5H>kas&4T1Y1^+wCC<6M?#B23a$ld)!y z7&ItB2V@b1oNzf{B_P@{hPpYH$Ii$ zhOv4p&}~~|+A3^0m^c_TP z_jzlF3B%im#x@F+&7-Nu?ZBi^DmFnP?%%rH`G7-Qn)5|}J<^_x1p zcXi$|qVH>~d~ Date: Sun, 24 Apr 2022 13:51:26 -0700 Subject: [PATCH 8/9] COMPAREDIRECTORIES: A little bit better on DEPTH --- lispusers/COMPAREDIRECTORIES | 75 ++++++++++++++---------------- lispusers/COMPAREDIRECTORIES.LCOM | Bin 40082 -> 40150 bytes 2 files changed, 36 insertions(+), 39 deletions(-) diff --git a/lispusers/COMPAREDIRECTORIES b/lispusers/COMPAREDIRECTORIES index 46ffd005..5a2e2446 100644 --- a/lispusers/COMPAREDIRECTORIES +++ b/lispusers/COMPAREDIRECTORIES @@ -1,12 +1,12 @@ (DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10) -(FILECREATED " 6-Mar-2022 19:53:40"  -{DSK}kaplan>Local>medley3.5>my-medley>lispusers>COMPAREDIRECTORIES.;214 123835 +(FILECREATED "29-Mar-2022 11:53:34"  +{DSK}kaplan>Local>medley3.5>my-medley>lispusers>COMPAREDIRECTORIES.;215 123553 - :CHANGES-TO (FNS CD.COMMANDSELECTEDFN) + :CHANGES-TO (FNS COMPAREDIRECTORIES COMPAREDIRECTORIES.INFOS) - :PREVIOUS-DATE " 5-Mar-2022 15:10:31" -{DSK}kaplan>Local>medley3.5>my-medley>lispusers>COMPAREDIRECTORIES.;213) + :PREVIOUS-DATE " 6-Mar-2022 19:53:40" +{DSK}kaplan>Local>medley3.5>my-medley>lispusers>COMPAREDIRECTORIES.;214) (* ; " @@ -66,10 +66,8 @@ Copyright (c) 1985-1988, 1990, 1994, 1998, 2018, 2020-2021 by Venue & Xerox Corp (COMPAREDIRECTORIES [LAMBDA (DIR1 DIR2 SELECT INCLUDEDFILES EXCLUDEDFILES USEDIRECTORYDATE OUTPUTFILE ALLVERSIONS - FIXDIRECTORYDATES) (* ; "Edited 23-Feb-2022 21:10 by rmk") - (* ; "Edited 4-Feb-2022 13:44 by rmk") - (* ; "Edited 31-Jan-2022 21:52 by rmk") - (* ; "Edited 26-Jan-2022 13:33 by rmk") + FIXDIRECTORYDATES) (* ; "Edited 29-Mar-2022 11:50 by rmk") + (* ; "Edited 23-Feb-2022 21:10 by rmk") (* ; "Edited 4-Jan-2022 12:09 by rmk") (* ; "Edited 31-Oct-2021 11:01 by rmk:") (* ; "Edited 7-Jan-2021 23:21 by rmk:") @@ -121,12 +119,10 @@ Copyright (c) 1985-1988, 1990, 1994, 1998, 2018, 2020-2021 by Venue & Xerox Corp (FIX-DIRECTORY-DATES DIR2)) (CDPRINT.HEADER DIR1 DIR2 SELECT DATE T) (PRINTOUT T " ... ") - (SETQ INFOS1 (COMPAREDIRECTORIES.INFOS (CDFILES DIR1 INCLUDEDFILES EXCLUDEDFILES - ALLVERSIONS DEPTH1) - USEDIRECTORYDATE DIR1 ALLVERSIONS)) - (SETQ INFOS2 (COMPAREDIRECTORIES.INFOS (CDFILES DIR2 INCLUDEDFILES EXCLUDEDFILES - ALLVERSIONS DEPTH2) - USEDIRECTORYDATE DIR2 ALLVERSIONS)) + (SETQ INFOS1 (COMPAREDIRECTORIES.INFOS DIR1 INCLUDEDFILES EXCLUDEDFILES ALLVERSIONS DEPTH1 + USEDIRECTORYDATE)) + (SETQ INFOS2 (COMPAREDIRECTORIES.INFOS DIR2 INCLUDEDFILES EXCLUDEDFILES ALLVERSIONS DEPTH2 + USEDIRECTORYDATE)) (* ;; "The CAR of each info is the atomic match-name, the CDR is a list of infos with that matchname, only 1 unless AllVERSIONS. ") @@ -152,13 +148,14 @@ Copyright (c) 1985-1988, 1990, 1994, 1998, 2018, 2020-2021 by Venue & Xerox Corp (RETURN (CDPRINT CDVALUE OUTPUTFILE NIL (MEMB 'AUTHOR SELECT]) (COMPAREDIRECTORIES.INFOS - [LAMBDA (FILES USEDIRECTORYDATE DIR ALLVERSIONS) + [LAMBDA (DIR INCLUDEDFILES EXCLUDEDFILES ALLVERSIONS DEPTH USEDIRECTORYDATE) - (* ;; "Edited 24-Feb-2022 09:19 by rmk: is a list of CDINFOS with the match-name consed on to the front. If ALLVERSIONS") + (* ;; "Edited 29-Mar-2022 11:53 by rmk: Produces a list of CDINFOS with the match-name consed on to the front.") - (* ;; "Value is a list of the form (matchname . CDINFOS). CDINFOS is guaranteed to be a singleton, unless ALLVERSIONS. ") + (* ;; "Each entry is a list of the form (matchname . CDINFOS). CDINFOS is guaranteed to be a singleton, unless ALLVERSIONS. ") - (FOR FULLNAME TYPE LDATE STREAM (STARTPOS _ (ADD1 (NCHARS DIR))) IN FILES + (FOR FULLNAME TYPE LDATE STREAM (STARTPOS _ (ADD1 (NCHARS DIR))) + IN (CDFILES DIR INCLUDEDFILES EXCLUDEDFILES ALLVERSIONS DEPTH) COLLECT (* ;; "GDATE/IDATE in case Y2K") @@ -2102,24 +2099,24 @@ Copyright (c) 1985-1988, 1990, 1994, 1998, 2018, 2020-2021 by Venue & Xerox Corp (PUTPROPS COMPAREDIRECTORIES COPYRIGHT ("Venue & Xerox Corporation" 1985 1986 1987 1988 1990 1994 1998 2018 2020 2021)) (DECLARE%: DONTCOPY - (FILEMAP (NIL (2610 22171 (COMPAREDIRECTORIES 2620 . 7847) (COMPAREDIRECTORIES.INFOS 7849 . 10611) ( -COMPAREDIRECTORIES.CANDIDATES 10613 . 13998) (CDENTRIES.SELECT 14000 . 18775) ( -COMPAREDIRECTORIES.INFOS.TYPE 18777 . 19405) (MATCHNAME 19407 . 20087) (CD.INSURECDVALUE 20089 . 21703 -) (CD.UPDATEWIDTHS 21705 . 22169)) (22172 31711 (CDFILES 22182 . 27805) (CDFILES.MATCH 27807 . 29432) -(CDFILES.PATS 29434 . 31709)) (31712 46797 (CDPRINT 31722 . 34067) (CDPRINT.HEADER 34069 . 34966) ( -CDPRINT.LINE 34968 . 37524) (CDPRINT.MAXWIDTHS 37526 . 41641) (CDPRINT.COLHEADERS 41643 . 42281) ( -CDPRINT.COLUMNS 42283 . 46162) (CDTEDIT 46164 . 46795)) (46798 55167 (CDMAP 46808 . 48240) (CDENTRY -48242 . 48551) (CDSUBSET 48553 . 49992) (CDMERGE 49994 . 53848) (CDMERGE.COMMON 53850 . 55165)) (55168 - 62706 (BINCOMP 55178 . 59467) (EOLTYPE 59469 . 62031) (EOLTYPE.SHOW 62033 . 62704)) (63234 76441 ( -FIND-UNCOMPILED-FILES 63244 . 66887) (FIND-UNSOURCED-FILES 66889 . 69698) (FIND-SOURCE-FILES 69700 . -71404) (FIND-COMPILED-FILES 71406 . 73484) (FIND-UNLOADED-FILES 73486 . 74230) (FIND-LOADED-FILES -74232 . 74786) (FIND-MULTICOMPILED-FILES 74788 . 76439)) (76442 84644 (CREATED-AS 76452 . 81249) ( -SOURCE-FOR-COMPILED-P 81251 . 83949) (COMPILE-SOURCE-DATE-DIFF 83951 . 84642)) (84645 94951 ( -FIX-DIRECTORY-DATES 84655 . 87648) (FIX-EQUIV-DATES 87650 . 89175) (COPY-COMPARED-FILES 89177 . 90998) - (COPY-MISSING-FILES 91000 . 93157) (COMPILED-ON-SAME-SOURCE 93159 . 94949)) (95145 102491 (CDBROWSER -95155 . 99082) (CDBROWSER.STRINGS 99084 . 102489)) (102653 104389 (CD.TABLEITEM 102663 . 102883) ( -CD.TABLEITEM.PRINTFN 102885 . 103084) (CD.TABLEITEM.COPYFN 103086 . 104144) ( -CDTABLEBROWSER.HEADING.REPAINTFN 104146 . 104387)) (104390 123251 (CDTABLEBROWSER.WHENSELECTEDFN -104400 . 104868) (CD.COMMANDSELECTEDFN 104870 . 109971) (CD-MENUFN 109973 . 116336) (CDBROWSER-COPY -116338 . 119709) (CDBROWSER-DELETE-FILE 119711 . 122730) (CD-SWAPDIRS 122732 . 123249))))) + (FILEMAP (NIL (2633 21889 (COMPAREDIRECTORIES 2643 . 7476) (COMPAREDIRECTORIES.INFOS 7478 . 10329) ( +COMPAREDIRECTORIES.CANDIDATES 10331 . 13716) (CDENTRIES.SELECT 13718 . 18493) ( +COMPAREDIRECTORIES.INFOS.TYPE 18495 . 19123) (MATCHNAME 19125 . 19805) (CD.INSURECDVALUE 19807 . 21421 +) (CD.UPDATEWIDTHS 21423 . 21887)) (21890 31429 (CDFILES 21900 . 27523) (CDFILES.MATCH 27525 . 29150) +(CDFILES.PATS 29152 . 31427)) (31430 46515 (CDPRINT 31440 . 33785) (CDPRINT.HEADER 33787 . 34684) ( +CDPRINT.LINE 34686 . 37242) (CDPRINT.MAXWIDTHS 37244 . 41359) (CDPRINT.COLHEADERS 41361 . 41999) ( +CDPRINT.COLUMNS 42001 . 45880) (CDTEDIT 45882 . 46513)) (46516 54885 (CDMAP 46526 . 47958) (CDENTRY +47960 . 48269) (CDSUBSET 48271 . 49710) (CDMERGE 49712 . 53566) (CDMERGE.COMMON 53568 . 54883)) (54886 + 62424 (BINCOMP 54896 . 59185) (EOLTYPE 59187 . 61749) (EOLTYPE.SHOW 61751 . 62422)) (62952 76159 ( +FIND-UNCOMPILED-FILES 62962 . 66605) (FIND-UNSOURCED-FILES 66607 . 69416) (FIND-SOURCE-FILES 69418 . +71122) (FIND-COMPILED-FILES 71124 . 73202) (FIND-UNLOADED-FILES 73204 . 73948) (FIND-LOADED-FILES +73950 . 74504) (FIND-MULTICOMPILED-FILES 74506 . 76157)) (76160 84362 (CREATED-AS 76170 . 80967) ( +SOURCE-FOR-COMPILED-P 80969 . 83667) (COMPILE-SOURCE-DATE-DIFF 83669 . 84360)) (84363 94669 ( +FIX-DIRECTORY-DATES 84373 . 87366) (FIX-EQUIV-DATES 87368 . 88893) (COPY-COMPARED-FILES 88895 . 90716) + (COPY-MISSING-FILES 90718 . 92875) (COMPILED-ON-SAME-SOURCE 92877 . 94667)) (94863 102209 (CDBROWSER +94873 . 98800) (CDBROWSER.STRINGS 98802 . 102207)) (102371 104107 (CD.TABLEITEM 102381 . 102601) ( +CD.TABLEITEM.PRINTFN 102603 . 102802) (CD.TABLEITEM.COPYFN 102804 . 103862) ( +CDTABLEBROWSER.HEADING.REPAINTFN 103864 . 104105)) (104108 122969 (CDTABLEBROWSER.WHENSELECTEDFN +104118 . 104586) (CD.COMMANDSELECTEDFN 104588 . 109689) (CD-MENUFN 109691 . 116054) (CDBROWSER-COPY +116056 . 119427) (CDBROWSER-DELETE-FILE 119429 . 122448) (CD-SWAPDIRS 122450 . 122967))))) STOP diff --git a/lispusers/COMPAREDIRECTORIES.LCOM b/lispusers/COMPAREDIRECTORIES.LCOM index d66465987ff13922b347aa0bb588c58fbb4e4e1d..990c0e425159c3742579537a14af430c8ec00354 100644 GIT binary patch delta 749 zcmZuvzi-n(6pkI$rHL9rnhXRao+2TUA(qeQvtuvRwJ)(H|B~%cMX1n_Mx_D*DvU^- zkUAmCjSTz)3`m(e@)xl2pD?j-PFj>m+;Do|yZgTP?tAz7Qv7u(e%f!SW;Yz4c2z}H z0U?WE3zLf%hYIOHd-Y7|S%g@c+OEK})9K{(t2ZYvr$;b(KAs&<-`=;_SlVG1gqg zZ%wZ*G;5`jv}^A+Uy?!_r@9bbEm WR2>!{#*d?A%Sc^M=<|arx%dl#JiBcG delta 844 zcmZuv&rj4q6lM!3?Bd24F6!mWCK~pzOQ+K*+a83{&h9qpwoPXi!oft4jUoOb=)sHO zk&O2&XgJKImAcWr4Y# z;GS)syneB4x6y*Qab|l~&okXt9Xkh;m+#;1@4cDqV)AMK;KLIS1^c`xvG)$G{y2_t zv$EUmwy?YXk#7Hok=dfvtrfAYW)1zXx3`W=V#MjYOQ;-Q?%sTpt(>6&;1}AG}8xH zuupK|%pM&I2SJ$SQKBIP!$^+SA-G9kcbt`in^CBT3WD{ZWllFKWGE{bY}dVxIAWO$ z^bmGWK&82cz2Xv$OmrSe)m4(-U4k4zI?DW9hEXny1!J!G(P&KDmUU`8ybqhvc~}lf zfx9kY4cg0oN~}1#^V6_Jv2*uqT9~4knfv{W!;j+)nX4#G6e3t4V%izTs?rE_nr~IJ zi(sOnZll&{PEF0MtrwH|t(sqapa1rlxg;H@O7>U5RvgGQ)?1kbbILXjyH|;cfz%~S zl=M?DyLUV14hEGN;|$SdWO1mQHRj5#8hT!7rNkde^f*So4u(}ivnquul0(P-o6xVN znM{->BaL8lgyaz#fdqNG8oq;s43#T#91{ZmSP#>jy1o7;#^~ouAJW(^yELua0NEi* Qvau$Lc0D-%+E_aI0}D&eSpWb4 From 3de8a6d028138d148ff29d93d24887694a12d9bc Mon Sep 17 00:00:00 2001 From: rmkaplan Date: Sun, 24 Apr 2022 13:53:31 -0700 Subject: [PATCH 9/9] GITFNS: Doesn't hang on pagefull, cob improved --- lispusers/GITFNS | 55 +++++++++++++++++++++--------------------- lispusers/GITFNS.LCOM | Bin 31664 -> 31689 bytes 2 files changed, 27 insertions(+), 28 deletions(-) diff --git a/lispusers/GITFNS b/lispusers/GITFNS index 118a9017..89e1eba7 100644 --- a/lispusers/GITFNS +++ b/lispusers/GITFNS @@ -1,11 +1,11 @@ (DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10) -(FILECREATED " 7-Mar-2022 08:14:19" {DSK}kaplan>Local>medley3.5>my-medley>lispusers>GITFNS.;129 74976 +(FILECREATED "29-Mar-2022 13:59:00" {DSK}kaplan>Local>medley3.5>my-medley>lispusers>GITFNS.;132 74961 - :CHANGES-TO (FNS GIT-GET-DIFFERENT-FILES) + :CHANGES-TO (FNS GIT-COMPARE-WITH-MYMEDLEY) - :PREVIOUS-DATE " 6-Mar-2022 21:51:16" -{DSK}kaplan>Local>medley3.5>my-medley>lispusers>GITFNS.;128) + :PREVIOUS-DATE "10-Mar-2022 20:26:42" +{DSK}kaplan>Local>medley3.5>my-medley>lispusers>GITFNS.;131) (PRETTYCOMPRINT GITFNSCOMS) @@ -218,13 +218,11 @@ (* ;; "Switches to BRANCH. T means my current branch, NEW/NEXT means my next branch (under wherever we are now). Default is to bring up a menu of locally available branches.") - (SELECTQ (U-CASE BRANCH) + [SELECTQ (U-CASE BRANCH) (T (GIT-CHECKOUT (GIT-MY-CURRENT-BRANCH))) ((NEW NEXT) (GIT-MAKE-BRANCH)) - (GIT-CHECKOUT (OR BRANCH (PICK-BRANCH NIL "Branches" 'LOCAL)) - BRANCH - 'LOCAL))) + (GIT-CHECKOUT (OR BRANCH (PICK-BRANCH NIL "Branches" 'LOCAL]) (DEFCOMMAND b? (BRANCH) (GIT-WHICH-BRANCH)) @@ -1090,7 +1088,7 @@ [LAMBDA (SUBDIRS SELECT EXCLUDEDFILES TEDIT FIXDIRECTORYDATES UPDATE HOST1 HOST2) (* ;; - "Edited 6-Mar-2022 21:51 by rmk: my medley subdirectories with the current local git branch.") + "Edited 29-Mar-2022 13:58 by rmk: my medley subdirectories with the current local git branch.") (* ;; "Compares my medley subdirectories with the current local git branch.") @@ -1100,13 +1098,14 @@ (SETQ SUBDIRS (CAR SUBDIRS))) (SETQ SUBDIRS (L-CASE SUBDIRS)) (PRINTOUT T "Comparing " (SELECTQ SUBDIRS - (nil (SETQ SUBDIRS '(scripts sources library lispusers))) + (nil (SETQ SUBDIRS '(greetfiles scripts sources library lispusers))) (all (SETQ SUBDIRS (ALLSUBDIRS HOST1 HOST2)) "ALL subdirectories") SUBDIRS) " of My Medley and " (GIT-WHICH-BRANCH) T) + (BKSYSBUF " ") (for SUBDIR TITLE CDVAL (NENTRIES _ 0) (BRANCH2 _ (GIT-WHICH-BRANCH)) INSIDE SUBDIRS collect (TERPRI T) @@ -1437,22 +1436,22 @@ (ERROR "INITIALS is not set"]) ) (DECLARE%: DONTCOPY - (FILEMAP (NIL (4694 5540 (GIT-CLONEP 4704 . 5538)) (8022 10002 (ALLSUBDIRS 8032 . 9200) (MEDLEYSUBDIRS - 9202 . 9641) (GITSUBDIRS 9643 . 10000)) (10003 15477 (TOGIT 10013 . 12161) (FROMGIT 12163 . 13141) ( -GIT-DELETE-FILE 13143 . 14037) (MYMEDLEY-DELETE-FILES 14039 . 15475)) (15478 17627 (MYMEDLEYSUBDIR -15488 . 15934) (GITSUBDIR 15936 . 16259) (STRIPDIR 16261 . 16632) (STRIPHOST 16634 . 16870) (STRIPNAME - 16872 . 17625)) (17628 19156 (GFILE4MFILE 17638 . 17884) (MFILE4GFILE 17886 . 18228) ( -GIT-REPO-FILENAME 18230 . 19154)) (19205 30157 (GIT-COMMIT 19215 . 19793) (GIT-PUSH 19795 . 20351) ( -GIT-PULL 20353 . 20759) (GIT-BRANCH-DIFF 20761 . 24741) (GIT-APPROVAL 24743 . 24944) (GIT-GET-FILE -24946 . 27246) (GIT-FILE-EXISTS? 27248 . 28075) (GIT-REMOTE-UPDATE 28077 . 29119) (GIT-REMOTE-ADD -29121 . 29428) (GIT-FILE-DATE 29430 . 30155)) (30202 36259 (GIT-CHECKOUT 30212 . 30453) ( -GIT-WHICH-BRANCH 30455 . 31039) (GIT-MAKE-BRANCH 31041 . 32532) (GIT-BRANCHES 32534 . 33708) ( -GIT-BRANCH-EXISTS? 33710 . 34907) (PICK-BRANCH 34909 . 35359) (GIT-PULL-REQUESTS 35361 . 36257)) ( -36289 39121 (GIT-MY-CURRENT-BRANCH 36299 . 36472) (GIT-MY-BRANCHP 36474 . 37393) (GIT-MY-NEXT-BRANCH -37395 . 37836) (GIT-MY-BRANCHES 37838 . 39119)) (39167 43059 (GIT-ADD-WORKTREE 39177 . 41059) ( -GIT-REMOVE-WORKTREE 41061 . 41639) (GIT-LIST-WORKTREES 41641 . 42445) (WORKTREEDIR 42447 . 43057)) ( -43107 71214 (GIT-GET-DIFFERENT-FILES 43117 . 49552) (GIT-COMPARE-BRANCHES 49554 . 55346) ( -GIT-COMPARE-WITH-MYMEDLEY 55348 . 59076) (GIT-COMPARE-WORKTREE 59078 . 62555) (GITCDOBJBUTTONFN 62557 - . 67561) (GIT-CD-LABELFN 67563 . 68645) (GIT-CD-MENUFN 68647 . 71212)) (71284 74953 (CDGITDIR 71294 - . 71990) (GIT-COMMAND 71992 . 74066) (GITORIGIN 74068 . 74645) (GIT-INITIALS 74647 . 74951))))) + (FILEMAP (NIL (4696 5542 (GIT-CLONEP 4706 . 5540)) (7977 9957 (ALLSUBDIRS 7987 . 9155) (MEDLEYSUBDIRS +9157 . 9596) (GITSUBDIRS 9598 . 9955)) (9958 15432 (TOGIT 9968 . 12116) (FROMGIT 12118 . 13096) ( +GIT-DELETE-FILE 13098 . 13992) (MYMEDLEY-DELETE-FILES 13994 . 15430)) (15433 17582 (MYMEDLEYSUBDIR +15443 . 15889) (GITSUBDIR 15891 . 16214) (STRIPDIR 16216 . 16587) (STRIPHOST 16589 . 16825) (STRIPNAME + 16827 . 17580)) (17583 19111 (GFILE4MFILE 17593 . 17839) (MFILE4GFILE 17841 . 18183) ( +GIT-REPO-FILENAME 18185 . 19109)) (19160 30112 (GIT-COMMIT 19170 . 19748) (GIT-PUSH 19750 . 20306) ( +GIT-PULL 20308 . 20714) (GIT-BRANCH-DIFF 20716 . 24696) (GIT-APPROVAL 24698 . 24899) (GIT-GET-FILE +24901 . 27201) (GIT-FILE-EXISTS? 27203 . 28030) (GIT-REMOTE-UPDATE 28032 . 29074) (GIT-REMOTE-ADD +29076 . 29383) (GIT-FILE-DATE 29385 . 30110)) (30157 36214 (GIT-CHECKOUT 30167 . 30408) ( +GIT-WHICH-BRANCH 30410 . 30994) (GIT-MAKE-BRANCH 30996 . 32487) (GIT-BRANCHES 32489 . 33663) ( +GIT-BRANCH-EXISTS? 33665 . 34862) (PICK-BRANCH 34864 . 35314) (GIT-PULL-REQUESTS 35316 . 36212)) ( +36244 39076 (GIT-MY-CURRENT-BRANCH 36254 . 36427) (GIT-MY-BRANCHP 36429 . 37348) (GIT-MY-NEXT-BRANCH +37350 . 37791) (GIT-MY-BRANCHES 37793 . 39074)) (39122 43014 (GIT-ADD-WORKTREE 39132 . 41014) ( +GIT-REMOVE-WORKTREE 41016 . 41594) (GIT-LIST-WORKTREES 41596 . 42400) (WORKTREEDIR 42402 . 43012)) ( +43062 71199 (GIT-GET-DIFFERENT-FILES 43072 . 49507) (GIT-COMPARE-BRANCHES 49509 . 55301) ( +GIT-COMPARE-WITH-MYMEDLEY 55303 . 59061) (GIT-COMPARE-WORKTREE 59063 . 62540) (GITCDOBJBUTTONFN 62542 + . 67546) (GIT-CD-LABELFN 67548 . 68630) (GIT-CD-MENUFN 68632 . 71197)) (71269 74938 (CDGITDIR 71279 + . 71975) (GIT-COMMAND 71977 . 74051) (GITORIGIN 74053 . 74630) (GIT-INITIALS 74632 . 74936))))) STOP diff --git a/lispusers/GITFNS.LCOM b/lispusers/GITFNS.LCOM index 0570c82be07ad6da7252cdc3d8e5fc471f2f099c..51b211feb964c7044a93031727f055604cfe9c51 100644 GIT binary patch delta 856 zcmZWn%Wl(95G9pZ5F`Yms(37VxS}Yju<*V1O=43(iS5Kz?WD3Ds_Y1jgQ7lCoKjI$ zqCdcb%1ajf0#bi~En?4--{_V}f87 zQ&ms5BUKY+u>X>J%~U1B>onOK@9vLwl0gy4`~7sXVj}At-n%~918a7DAHv9P6_$+4 z{hYIMvDEZ@#|oW#?AVuv%oJp=3XS`kD59zx6%NyK>+O~kDRBp-W;>cryZfjNb0c(K zdYx{h*u(|K)ql$f)f5#|7pKS8g2vBYEc|o|pR*n+9*RMu_JAt9k5d%JzRNAH1_7f0QO?SQy+jn|-s8-D< zak`LY2Ts^>=n3^{pR(zCma8f}GNGtl`5mD63di%5*GRfxhV`7!UDR h2>N>iuwwQtxO0;(g3_BbNe*UXarP@XRI<@=>o=bH*?9l} delta 926 zcmZuw-D(p-6ehV0B3@JwQT$k}B!#Uzv;S)qH=Aj8ag&X^8%x2PwAnx~P0FTc zmm$+E>oT2@$c~8H0*q_t_v9@<@O-%$yIs!*V^)bRe!Lnl2tOQ;Mp>Rsce6QkjhdY8 zAFg6UhOR0|vJ5&W_4M|GoNR>#vQ(lg3YM%KnqArqDk;3;grQ(CnLtx99Z%@hY1k^H zr?h4UNAW#eyR9pb_6GBVET^DW{0<*4Xs8l7G?04eHbuDEy=cX2$(L?}N)o1Xh)y<~ zWQP(oi(U6=(AV