COPYFILES: respects DEFAULTEXT/VERS in single no-stars case
This commit is contained in:
rmkaplan
parent
74a43b9dea
commit
3364a4af07
@ -1,15 +1,15 @@
|
||||
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
|
||||
(FILECREATED " 6-Apr-2018 21:14:29"
|
||||
{DSK}<Users>kaplan>Local>medley3.5>lispcore>library>COPYFILES.;2 23656
|
||||
|
||||
changes to%: (FNS MAPFILES)
|
||||
(FILECREATED "26-Mar-2022 11:43:49" {DSK}<Users>kaplan>Local>medley3.5>my-medley>library>COPYFILES.;3 23773
|
||||
|
||||
previous date%: "23-Mar-93 02:39:53"
|
||||
{DSK}<Users>kaplan>Local>medley3.5>lispcore>library>COPYFILES.;1)
|
||||
:CHANGES-TO (FNS MAPFILES)
|
||||
|
||||
:PREVIOUS-DATE " 6-Apr-2018 21:14:29"
|
||||
{DSK}<Users>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 <dir>.;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
|
||||
|
||||
Binary file not shown.
Loading…
x
Reference in New Issue
Block a user