(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "XCL" BASE 10) (FILECREATED "18-Oct-93 11:06:53" "{Pele:mv:envos}Sources>CLTL2>CMLFILESYS.;2" 8169 |previous| |date:| " 3-Aug-91 11:23:10" "{Pele:mv:envos}Sources>CLTL2>CMLFILESYS.;1" ) ; Copyright (c) 1986, 1987, 1988, 1990, 1991, 1993 by Venue & Xerox Corporation. All rights reserved. (PRETTYCOMPRINT CMLFILESYSCOMS) (RPAQQ CMLFILESYSCOMS ((FUNCTIONS LISP:DIRECTORY LISP:FILE-AUTHOR LISP:FILE-LENGTH LISP:FILE-POSITION LISP:USER-HOMEDIR-PATHNAME LISP:FILE-WRITE-DATE) (FUNCTIONS LISP:PROBE-FILE LISP:RENAME-FILE LISP:DELETE-FILE) (PROP FILETYPE CMLFILESYS))) (LISP:DEFUN LISP:DIRECTORY (PATHNAME) (LISP:WHEN (LISP::LOGICAL-PATHNAME-P PATHNAME) (LISP:SETQ PATHNAME (LISP:TRANSLATE-LOGICAL-PATHNAME PATHNAME))) (LET (GENERATOR FILE) (DECLARE (LISP:SPECIAL GENERATOR)) (RESETLST (|if| (EQL \\MACHINETYPE \\MAIKO) |then| (RESETSAVE NIL '(AND RESETSTATE (\\UFS.ABORT.CL-DIRECTORY)))) (LISP:SETQ GENERATOR (\\GENERATEFILES (DIRECTORY.FILL.PATTERN (LISP:NAMESTRING PATHNAME)) NIL '(SORT RESETLST))) (|while| (SETQ FILE (\\GENERATENEXTFILE GENERATOR)) |collect| (PATHNAME FILE))))) (LISP:DEFUN LISP:FILE-AUTHOR (LISP::FILE) (* |;;;| "Returns author of file as string, or NIL if it cannot be determined. FILE is a filename or stream.") (LET ((LISP::AUTHOR (GETFILEINFO LISP::FILE 'AUTHOR))) (LISP:IF LISP::AUTHOR (COERCE LISP::AUTHOR 'LISP:SIMPLE-STRING) NIL))) (LISP:DEFUN LISP:FILE-LENGTH (FILE-STREAM) (|if| (AND (STREAMP FILE-STREAM) (OPENP FILE-STREAM)) |then| (GETEOFPTR FILE-STREAM))) (LISP:DEFUN LISP:FILE-POSITION (LISP::FILE-STREAM &OPTIONAL (LISP:POSITION NIL LISP::POSITIONP) ) (LISP:UNLESS (STREAMP LISP::FILE-STREAM) (\\ILLEGAL.ARG LISP::FILE-STREAM)) (LISP:IF LISP::POSITIONP (LISP:IF (RANDACCESSP LISP::FILE-STREAM) (PROGN (SETFILEPTR LISP::FILE-STREAM (CASE LISP:POSITION (:START 0) (:END (GETEOFPTR LISP::FILE-STREAM)) (T LISP:POSITION))) T) NIL) (GETFILEPTR LISP::FILE-STREAM))) (LISP:DEFUN LISP:USER-HOMEDIR-PATHNAME (&OPTIONAL HOST) (DECLARE (GLOBALVARS LOGINHOST/DIR *DEFAULT-PATHNAME-DEFAULTS*)) (LISP:IF (MACHINETYPE 'MAIKO) (LISP:IF (AND HOST (LISP:STRING-NOT-EQUAL (STRING HOST) (UNIX-GETPARM "HOSTNAME"))) NIL (LISP:MAKE-PATHNAME :HOST :DSK :DIRECTORY (UNPACKFILENAME.STRING (UNIX-GETENV "HOME") 'DIRECTORY 'RETURN))) (PATHNAME (OR LOGINHOST/DIR *DEFAULT-PATHNAME-DEFAULTS*)))) (LISP:DEFUN LISP:FILE-WRITE-DATE (FILE) (* |;;| "Return file's creation date, or NIL if it doesn't exist.") (* |;;| "N.B. date is returned in Common Lisp Universal Time, not Interlisp-D internal time") (LET ((TN (LISP:PROBE-FILE FILE))) (LISP:WHEN TN (%CONVERT-INTERNAL-TIME-TO-CLUT (GETFILEINFO TN 'ICREATIONDATE))))) (LISP:DEFUN LISP:PROBE-FILE (FILE) (* |;;;| "Return a pathname which is the truename of the file if it exists, NIL otherwise. Returns NIL for non-file args.") (LISP:TYPECASE FILE (STREAM (IF (OPENP FILE) THEN (PATHNAME (FETCH (STREAM FULLNAME) OF FILE)) ELSE (LET ((NAMESTRING-IF-EXISTS (INFILEP (FETCH (STREAM FULLNAME) OF FILE)))) (AND NAMESTRING-IF-EXISTS (PATHNAME NAMESTRING-IF-EXISTS))))) (LISP:LOGICAL-PATHNAME (LISP:PROBE-FILE (LISP:TRANSLATE-LOGICAL-PATHNAME FILE))) (T (LET ((INFILEP (\\GETFILENAME FILE 'OLD))) (IF INFILEP THEN (PATHNAME INFILEP) ELSE NIL))))) (LISP:DEFUN LISP:RENAME-FILE (LISP::FILE LISP::NEW-NAME) (* |;;;| "Give FILE the new name NEW-NAME. If FILE is an open stream, error. Otherwise, do the rename. If successful, return three values: the new name, truename of original file, truename of new file.") (* |;;;| "NEW MESSINESS resulting from acceptance of logical-pathnames: the CLtL2 spec for the first argument, (MERGE-PATHNAMES NEW-NAME FILE), makes no sense if either of FILE or NEW-NAME is a logical-pathname, since the logical-to-normal translation process can do arbitrary weird stuff. Therefore, if either argument is a logical-pathname, we punt and return the new truename as the first argument.") (LET* ((LISP::LOGICAL-USED? NIL) (LISP::OLD-PATHNAME (LISP:IF (LISP::LOGICAL-PATHNAME-P LISP::FILE) (PROGN (LISP:SETQ LISP::LOGICAL-USED? T) (LISP:TRANSLATE-LOGICAL-PATHNAME LISP::FILE)) (PATHNAME LISP::FILE))) (LISP::NEW-FULLNAME)) (LISP:WHEN (LISP::LOGICAL-PATHNAME-P LISP::NEW-NAME) (LISP:SETQ LISP::LOGICAL-USED? T LISP::NEW-NAME (LISP:TRANSLATE-LOGICAL-PATHNAME LISP::NEW-NAME))) (IF (STREAMP LISP::FILE) THEN (IF (OPENP LISP::FILE) THEN (LISP:ERROR "Renaming open streams is not supported: ~S" LISP::FILE) ELSE (LISP:SETQ LISP::NEW-FULLNAME (RENAMEFILE (LISP:SETQ LISP::FILE (FETCH (STREAM FULLNAME ) OF LISP::FILE)) LISP::NEW-NAME))) ELSE (* |;;| "IL:RENAMEFILE will accept logical-pathnames") (LISP:SETQ LISP::NEW-FULLNAME (RENAMEFILE (LISP:IF LISP::LOGICAL-USED? LISP::OLD-PATHNAME LISP::FILE) LISP::NEW-NAME))) (IF LISP::NEW-FULLNAME THEN (LISP:VALUES (LISP:IF LISP::LOGICAL-USED? (PATHNAME LISP::NEW-FULLNAME) (LISP:MERGE-PATHNAMES LISP::NEW-NAME LISP::FILE)) LISP::OLD-PATHNAME (PATHNAME LISP::NEW-FULLNAME)) ELSE (LISP:ERROR "Rename failed")))) (LISP:DEFUN LISP:DELETE-FILE (FILE) (* * "Delete the specified file.") (LET ((TN (LISP:PROBE-FILE FILE))) (LISP:WHEN (STREAMP FILE) (LISP:CLOSE FILE :ABORT T)) (LISP:IF TN (LET ((NS (INTERLISP-NAMESTRING TN))) (LISP:UNLESS (DELFILE NS) (LISP:ERROR "Could not delete the file ~S" FILE))) (LISP:UNLESS (STREAMP FILE) (LISP:ERROR "File to be deleted does not exist: ~S" FILE)))) T) (PUTPROPS CMLFILESYS FILETYPE LISP:COMPILE-FILE) (PUTPROPS CMLFILESYS COPYRIGHT ("Venue & Xerox Corporation" 1986 1987 1988 1990 1991 1993)) (DECLARE\: DONTCOPY (FILEMAP (NIL))) STOP