(FILECREATED "18-Dec-84 23:09:57" {ERIS}<LISPCORE>SOURCES>NSFILINGPATCH.;1 15891
changes to: (VARS NSFILINGPATCHCOMS))
(* Copyright (c) 1984 by Xerox Corporation. All rights reserved.)
(PRETTYCOMPRINT NSFILINGPATCHCOMS)
(RPAQQ NSFILINGPATCHCOMS ((FNS \NSFILING.GENERATEFILES \NSFILING.CLOSEFILE \NSFILING.CONNECT
\NSFILING.MAYBE.CREATE)))
(DEFINEQ
(\NSFILING.GENERATEFILES
[LAMBDA (DEVICE PATTERN DESIREDPROPS OPTIONS) (* bvm: "18-Dec-84 21:48")
(PROG (CONNECTION BULKSTREAM RESULT)
[SETQ RESULT
(RESETLST (PROG ((STAR "*")
HOST NAME VERSION DIRECTORY FILTERLIST SCOPELIST INFINITE.DEPTH N)
(for TAIL on (UNPACKFILENAME.STRING PATTERN) by (CDDR TAIL)
do (SELECTQ (CAR TAIL)
(HOST (SETQ HOST (CADR TAIL)))
(DIRECTORY (SETQ DIRECTORY (CADR TAIL)))
(NAME (SETQ NAME (CADR TAIL)))
[EXTENSION (COND
((NOT (CADR TAIL))
NIL)
[(NOT (STREQUAL (CADR TAIL)
STAR))
(SETQ NAME (CONCAT NAME "." (CADR TAIL]
((NEQ (NTHCHARCODE NAME -1)
(CHARCODE *))
(SETQ NAME (CONCAT NAME STAR]
[VERSION (SETQ VERSION (MKATOM (CADR TAIL]
NIL))
[COND
((SETQ N (STRPOS (QUOTE *)
DIRECTORY)) (* Wild card in directory part is hard.
Get as far down in the tree as possible, then enumerate
everything)
(bind (BROKET ← 0)
X while (AND (SETQ X (STRPOS (QUOTE >)
DIRECTORY
(ADD1 BROKET)))
(ILESSP X N))
do (SETQ BROKET X)
finally (SETQ NAME (SUBSTRING DIRECTORY (ADD1 BROKET)
N))
(SETQ DIRECTORY (AND (NEQ BROKET 0)
(SUBSTRING DIRECTORY 1 (SUB1 BROKET]
(SETQ CONNECTION (OR (\GETFILINGCONNECTION DEVICE)
(RETURN NIL)))
(RESETSAVE NIL (LIST (FUNCTION \NSFILING.CLOSE.IF.ERROR)
CONNECTION))
(RETURN (COND
((\NSFILING.CONNECT CONNECTION DIRECTORY T)
[COND
((SETQ DESIREDPROPS
(for PROP in DESIREDPROPS
when (SETQ PROP
(\FILING.ATTRIBUTE.TYPE
(OR (CADR (ASSOC PROP
\LISP.TO.NSFILING.ATTRIBUTES))
PROP)
T))
collect PROP))
(* make sure there are no duplicates, since File server
can object to that)
(SETQ DESIREDPROPS (INTERSECTION DESIREDPROPS
DESIREDPROPS]
(SETQ DESIREDPROPS
(CONS [COND
[(EQ (fetch FSPROTOCOLNAME of CONNECTION)
(QUOTE FILING))
(CONSTANT (\FILING.ATTRIBUTE.TYPE (QUOTE PATHNAME]
(T (CONSTANT (\FILING.ATTRIBUTE.TYPE (QUOTE NAME]
(APPEND [CONSTANT (\FILING.ATTRIBUTE.TYPE.SEQUENCE
(QUOTE (VERSION IS.DIRECTORY]
DESIREDPROPS)))
[COND
[(STRPOS (QUOTE *)
NAME) (* Enumerate entire directory, matching against any
wild cards.)
(COND
((NOT (STREQUAL NAME STAR))
(* The following doesn't quite work because the fileserver won't match against subdirectory names.
So we always enumerate the whole directory, regardless of the pattern.)
(push FILTERLIST (BQUOTE (MATCHES (NAME , NAME]
(T (* Only enumerate versions.)
(push FILTERLIST
(BQUOTE (= , (COURIER.CREATE (FILING .
FILTER.ATTRIBUTE)
ATTRIBUTE ←(LIST
(QUOTE NAME)
NAME)
INTERPRETATION ←(
QUOTE STRING]
[COND
((FIXP VERSION)
(push FILTERLIST
(BQUOTE (= , (COURIER.CREATE (FILING .
FILTER.ATTRIBUTE)
ATTRIBUTE ←(LIST
(QUOTE VERSION)
VERSION)
INTERPRETATION ←(QUOTE
CARDINAL]
[COND
(FILTERLIST (push SCOPELIST (LIST (QUOTE FILTER)
(COND
((CDR FILTERLIST)
(LIST (QUOTE
AND)
FILTERLIST))
(T (CAR FILTERLIST]
[COND
((AND FILING.ENUMERATION.DEPTH DIRECTORY
(EQ (fetch FSPROTOCOLNAME of CONNECTION)
(QUOTE FILING)))
(* Controls how many levels in hierarchy to show.
If FILING.ENUMERATION.DEPTH is infinite, then let's
also ignore the "files" that are subdirectories)
(push SCOPELIST (BQUOTE (DEPTH ,
(OR (SMALLP
FILING.ENUMERATION.DEPTH)
(PROGN (SETQ
INFINITE.DEPTH T)
65535]
(SETQ BULKSTREAM (FILING.CALL CONNECTION (QUOTE LIST)
(fetch FSCURRENTDIRECTORY
of CONNECTION)
DESIREDPROPS SCOPELIST NIL
(fetch FSSESSIONHANDLE
of CONNECTION)))
(create FILEGENOBJ
NEXTFILEFN ←(FUNCTION \NSFILING.NEXTFILE)
FILEINFOFN ←(FUNCTION \NSFILING.FILEINFOFN)
GENFILESTATE ←(create \NSFILING.GENFILESTATE
NSGENERATOR ←(
BULKDATA.GENERATOR
BULKSTREAM
(QUOTE FILING)
(QUOTE ATTRIBUTE.SEQUENCE))
NSFILTER ←(
DIRECTORY.MATCH.SETUP PATTERN)
NSCONNECTION ← CONNECTION
NSIGNOREDIRECTORIES ←
INFINITE.DEPTH]
(COND
((NULL CONNECTION))
((EQMEMB (QUOTE RESETLST)
OPTIONS)
(RESETSAVE NIL (LIST (FUNCTION [LAMBDA (CONNECTION STREAM)
(CLOSEF STREAM)
(\CLOSEFILINGCONNECTION CONNECTION RESETSTATE])
CONNECTION BULKSTREAM)))
((NULL BULKSTREAM)
(\CLOSEFILINGCONNECTION CONNECTION)))
(RETURN (OR RESULT (\NULLFILEGENERATOR])
(\NSFILING.CLOSEFILE
[LAMBDA (FILESTREAM OPTIONS) (* bvm: "18-Dec-84 23:05")
(RESETLST (PROG ((ABORTFLG (EQMEMB (QUOTE ABORT)
OPTIONS))
NEWHANDLE HANDLE CONNECTION INFO)
[COND
((AND (SETQ NEWHANDLE (\BULK.DATA.CLOSE FILESTREAM ABORTFLG))
(NEQ (CAR NEWHANDLE)
(QUOTE ERROR)))
(SETQ HANDLE NEWHANDLE))
(T (SETQ HANDLE (fetch NSFILING.HANDLE of FILESTREAM]
(* Get the handle from the result of the STORE
(for OUTPUT) or from the handle already given to
RETRIEVE or REPLACE)
(OR (SETQ CONNECTION (fetch NSFILING.CONNECTION of FILESTREAM))
(RETURN))
(RESETSAVE NIL (LIST (FUNCTION \NSFILING.RESETCLOSE)
CONNECTION))
(COND
[(EQ (CAR NEWHANDLE)
(QUOTE ERROR))
(COND
((AND (WRITEABLE FILESTREAM)
(NOT ABORTFLG))
(ERROR (CONCAT "CLOSEF: File not written
" (CADR NEWHANDLE)
" -- "
(CADDR NEWHANDLE))
(fetch FULLFILENAME of FILESTREAM]
((AND HANDLE (SPP.OPENP (fetch FSCOURIERSTREAM of CONNECTION)))
(NLSETQ (* errorset protect this because SPP.OPENP can lie, if
we have not blocked recently)
[COND
([AND NEWHANDLE (SETQ INFO (FILING.CALL CONNECTION (QUOTE
GET.ATTRIBUTES)
NEWHANDLE
\NSFILING.USEFUL.ATTRIBUTE.TYPES
(fetch FSSESSIONHANDLE
of CONNECTION)
(QUOTE NOERROR]
(* Save attributes in case caller wants to look at
newly created file)
(replace NSCACHE of (fetch DEVICEINFO
of (fetch DEVICE of FILESTREAM))
with (CONS (LIST (QUOTE FULLNAME)
(fetch FULLFILENAME of FILESTREAM))
INFO]
(\NSFILING.CLOSE.HANDLE CONNECTION HANDLE)
(replace NSFILING.HANDLE of FILESTREAM with NIL])
(\NSFILING.CONNECT
[LAMBDA (CONNECTION PATHNAME REALREQUIRED CREATE?) (* bvm: "18-Dec-84 22:33")
(* Follow the list of directories in PATHNAME and cache the handle for the final one in the connection record.
The special case when PATHNAME is NIL is equivalent to connecting to the root directory. Uses cached current path to
avoid useless reconnecting. WARNING: this may fail if there is ever more than one version of the same subdirectory
name. To fix this we could use the same hack that's in \NSFILING.GETFILE : first enumerate the versions
(also requiring the IS.DIRECTORY attribute) and then use the unique FILE.ID, but since it hasn't been a problem yet,
we don't bother.)
(PROG ((NEW.DIRLIST (OR (LISTP PATHNAME)
(\PATHNAME.TO.DIRECTORY.LIST PATHNAME)))
(OLD.DIRLIST (fetch FSCURRENTPATH of CONNECTION))
(SESSIONHANDLE (fetch FSSESSIONHANDLE of CONNECTION))
(OLD.HANDLE (fetch FSCURRENTDIRECTORY of CONNECTION))
NEW.HANDLE ADDITIONAL.DIRLIST NSPATHNAME)
(COND
((AND (EQUAL NEW.DIRLIST OLD.DIRLIST)
(OR NEW.DIRLIST (NOT REALREQUIRED)
(NEQ OLD.HANDLE \NSFILING.NULL.HANDLE)))
(* Nothing needs to be done because we're already
connected to this path.)
(RETURN T)))
(COND
((AND (CDR NEW.DIRLIST)
(EQ (fetch FSPROTOCOLNAME of CONNECTION)
(QUOTE FILING)))
[SETQ NSPATHNAME (CONCATLIST (CDR (for DIR in NEW.DIRLIST join (LIST (QUOTE /)
DIR]
(SETQ NEW.HANDLE (FILING.CALL CONNECTION (QUOTE OPEN)
(BQUOTE ((PATHNAME , NSPATHNAME)))
\NSFILING.NULL.HANDLE NIL SESSIONHANDLE (QUOTE
RETURNERRORS)))
(SELECTQ (CAR NEW.HANDLE)
(NIL (RETURN))
[ERROR (COND
((AND (EQ (CADDR NEW.HANDLE)
(QUOTE FileNotFound))
(SETQ NEW.HANDLE (\NSFILING.MAYBE.CREATE CREATE? NEW.DIRLIST
(CAR (LAST NEW.DIRLIST)
)
CONNECTION)))
(* Successfully created)
)
(T (RETURN]
NIL)
(UNINTERRUPTABLY
(SETQ OLD.HANDLE (fetch FSCURRENTDIRECTORY of CONNECTION))
(* Need to do this because recursive call to
\NSFILING.CONNECT might have changed it)
(replace FSCURRENTDIRECTORY of CONNECTION with NEW.HANDLE)
(replace FSCURRENTPATH of CONNECTION with NEW.DIRLIST))
(COND
((NEQ OLD.HANDLE \NSFILING.NULL.HANDLE) (* Close the old handle we're not using any more)
(FILING.CALL CONNECTION (QUOTE CLOSE)
OLD.HANDLE SESSIONHANDLE)))
(RETURN T)))
[COND
([AND (CDR NEW.DIRLIST)
(SETQ ADDITIONAL.DIRLIST NEW.DIRLIST)
(for OLD.DIR in OLD.DIRLIST always (STREQUAL OLD.DIR (pop ADDITIONAL.DIRLIST]
(* We're currently connected to a prefix of the desired
path, so we can save some remote calls.)
(SETQ NEW.DIRLIST ADDITIONAL.DIRLIST))
(T
(* We need to start again from the root. If we kept open the handles of all directories in the current path, we
would only have to go back to the nearest common ancestor, but it's probably not worth it.)
(COND
((NEQ OLD.HANDLE \NSFILING.NULL.HANDLE)
(FILING.CALL CONNECTION (QUOTE CLOSE)
(PROG1 OLD.HANDLE (UNINTERRUPTABLY
(replace FSCURRENTDIRECTORY of CONNECTION
with (SETQ OLD.HANDLE \NSFILING.NULL.HANDLE))
(replace FSCURRENTPATH of CONNECTION
with NIL)))
SESSIONHANDLE)))
(COND
((AND REALREQUIRED (NULL NEW.DIRLIST)) (* Caller wants handle of the root of the file system,
and can't use the "null handle" constant)
(replace FSCURRENTDIRECTORY of CONNECTION with (SETQ OLD.HANDLE
(FILING.CALL CONNECTION
(QUOTE OPEN)
NIL
\NSFILING.NULL.HANDLE NIL
SESSIONHANDLE
(QUOTE NOERROR]
(RETURN (for TAIL on NEW.DIRLIST
do (COND
((SETQ NEW.HANDLE (FILING.CALL CONNECTION (QUOTE OPEN)
[BQUOTE ((NAME , (SETQ NEW.DIR (CAR TAIL]
OLD.HANDLE NIL SESSIONHANDLE (QUOTE
RETURNERRORS)))
[COND
((EQ (CAR (LISTP NEW.HANDLE))
(QUOTE ERROR))
(COND
[(AND (NULL (CDR TAIL))
(EQ (CADDR NEW.HANDLE)
(QUOTE FileNotFound))
(SETQ NEW.HANDLE (\NSFILING.MAYBE.CREATE CREATE? NEW.DIRLIST
NEW.DIR CONNECTION T]
(T (RETURN]
(UNINTERRUPTABLY
(replace FSCURRENTDIRECTORY of CONNECTION with NEW.HANDLE)
(replace FSCURRENTPATH of CONNECTION
with (APPEND (fetch FSCURRENTPATH of CONNECTION)
(LIST NEW.DIR))))
(COND
((NEQ OLD.HANDLE \NSFILING.NULL.HANDLE)
(* Close the old handle we're not using any more)
(FILING.CALL CONNECTION (QUOTE CLOSE)
OLD.HANDLE SESSIONHANDLE)))
(SETQ OLD.HANDLE NEW.HANDLE))
(T (RETURN)))
finally (RETURN T])
(\NSFILING.MAYBE.CREATE
[LAMBDA (CREATE? DIRLST NEW.DIR CONNECTION CONNECTED) (* bvm: "18-Dec-84 22:27")
(* * Called to possibly create a nonexistent subdirectory. DIRLST is a list of directories down to the final
NEW.DIR. CONNECTED is true if CONNECTION is already connected to the penultimate dir)
(AND (SELECTQ CREATE?
[ASK (EQ (QUOTE Y)
(ASKUSER DWIMWAIT (QUOTE Y)
(CONCAT "Create subdirectory {" (fetch FSNAMESTRING of CONNECTION)
"}<"
[CONCATLIST (for DIR in DIRLST
join (LIST DIR (QUOTE >]
"? "]
(NIL NIL)
T)
(OR CONNECTED (\NSFILING.CONNECT CONNECTION (for TAIL on DIRLST collect (CAR TAIL)
while (CDR TAIL))
T T))
(FILING.CALL CONNECTION (QUOTE CREATE)
(fetch FSCURRENTDIRECTORY of CONNECTION)
(BQUOTE ((NAME , NEW.DIR)
(IS.DIRECTORY T)
(FILE.TYPE 1)))
NIL
(fetch FSSESSIONHANDLE of CONNECTION)
(QUOTE NOERROR])
)
(PUTPROPS NSFILINGPATCH COPYRIGHT ("Xerox Corporation" 1984))
(DECLARE: DONTCOPY
(FILEMAP (NIL (374 15807 (\NSFILING.GENERATEFILES 384 . 6483) (\NSFILING.CLOSEFILE 6485 . 8767) (
\NSFILING.CONNECT 8769 . 14678) (\NSFILING.MAYBE.CREATE 14680 . 15805)))))
STOP