%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%
% Directory.SL - File Directory Primitives (TOPS-20 Version)
%
% Author: Alan Snyder
% Hewlett-Packard/CRC
% Date: 13 July 1982
%
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
(BothTimes (load common jsys pathnames file-primitives))
(de find-matching-files (filename include-deleted-files)
% Return a list describing all files that match the specified filename. The
% filename may specify a directory and/or may contain wildcard characters.
% Each element of the returned list corresponds to one matching file. The
% format of each list element is:
% (file-name full file name string
% deleted-flag T or NIL
% file-size integer count of pages in file
% write-date integer representing date/time of last write
% read-date integer representing date/time of last read
% )
(setf filename (fixup-directory-name filename))
(let (jfn-word jfn file-name deleted-flag file-size write-date read-date)
(cond
((and (stringp filename)
(setf jfn-word (attempt-to-get-jfn
filename
(if include-deleted-files
#.(bits 2 8 11 13 17)
#.(bits 2 11 13 17)
)
)))
(for*
(while (>= jfn-word 0))
(do (setf jfn (lowhalfword jfn-word))
(setf file-name (MkString 100 (char space)))
(jsys1 file-name jfn
#.(bits 2 5 8 11 14 35) 0 (const jsJFNS))
(setf file-name (recopystringtonull file-name))
(setf deleted-flag (jfn-deleted? jfn))
(setf file-size (jfn-page-count jfn))
(setf write-date (jfn-write-date jfn))
(setf read-date (jfn-read-date jfn))
)
(collect (list
file-name
deleted-flag
file-size
write-date
read-date
))
(do (if (FixP (ErrorSet
(list 'jsys1 jfn-word 0 0 0 (const jsGNJFN))
NIL NIL)) (setf jfn-word -1)))
))
)))
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
% Auxiliary Functions:
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
(de fixup-directory-name (pn)
% Replace all missing Name, Type, and Version components of the specified
% filename with "*".
(let ((wild-name (make-pathname 'name 'wild)))
(setf pn (pathname pn))
(namestring (merge-pathname-defaults pn wild-name 'wild 'wild))))