| 123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475 |
- %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
- %
- % 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))))
|
