UFS: Reworked directory enumeration
Eliminated dependence on DEFAULTEXT and DEFAULTVERS, better job at subdirectories
This commit is contained in:
rmkaplan
parent
79fd39f15c
commit
3a4852cf8b
359
sources/UFS
359
sources/UFS
@ -1,11 +1,9 @@
|
||||
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
|
||||
|
||||
(FILECREATED " 7-Mar-2022 21:08:31" {DSK}<home>larry>medley>sources>UFS.;2 81830
|
||||
(FILECREATED "29-Mar-2022 11:29:33" {DSK}<Users>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}<home>larry>medley>sources>UFS.;1)
|
||||
:PREVIOUS-DATE "28-Mar-2022 22:09:43"
|
||||
{DSK}<Users>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
|
||||
|
||||
BIN
sources/UFS.LCOM
BIN
sources/UFS.LCOM
Binary file not shown.
Loading…
x
Reference in New Issue
Block a user