(FILECREATED " 5-Sep-86 18:08:12" {ERIS}<LISPCORE>LIBRARY>CMLFILESYS.;9
 4547   

      changes to:  (FUNCTIONS USER-HOMEDIR-PATHNAME PROBE-FILE)

      previous date: "31-Jul-86 11:26:29" {ERIS}<LISPCORE>LIBRARY>CMLFILESYS.;8)


(* Copyright (c) 1986 by Xerox Corporation. All rights reserved.)

(PRETTYCOMPRINT CMLFILESYSCOMS)

(RPAQQ CMLFILESYSCOMS
 ((FUNCTIONS CL:DIRECTORY FILE-AUTHOR FILE-LENGTH FILE-POSITION 
                              USER-HOMEDIR-PATHNAME FILE-WRITE-DATE)
                       (FUNCTIONS PROBE-FILE RENAME-FILE DELETE-FILE)
                       (PROP FILETYPE CMLFILESYS)))
(DEFUN CL:DIRECTORY
 (PATHNAME) (LET ((GENERATOR (\GENERATEFILES (DIRECTORY.FILL.PATTERN (NAMESTRING
                                                                                         PATHNAME))
                                                       NIL
                                                       (QUOTE (SORT))))
                                     (FILE NIL))
                                    (while (SETQ FILE (\GENERATENEXTFILE GENERATOR))
                                           collect
                                           (PATHNAME FILE))))

(DEFUN FILE-AUTHOR
 (FILE) 
          
          (* * "Returns author of file")

 (COERCE (OR (GETFILEINFO FILE (QUOTE AUTHOR))
             "")
        (QUOTE SIMPLE-STRING)))

(DEFUN FILE-LENGTH
 (FILE-STREAM) (if (AND (STREAMP FILE-STREAM)
                                          (OPENP FILE-STREAM))
                                     then
                                     (GETEOFPTR FILE-STREAM)))

(DEFUN FILE-POSITION
 (FILE-STREAM &OPTIONAL (POSITION NIL POSITIONP))
   (COND
      (POSITIONP (GETFILEPTR FILE-STREAM))
      (T (SETFILEPTR FILE-STREAM (CASE POSITION (:START 0)
                                       (:END (GETEOFPTR FILE-STREAM))
                                       (T POSITION)))
         T)))

(DEFUN USER-HOMEDIR-PATHNAME
 (&OPTIONAL HOST) (DECLARE (GLOBALVARS LOGINHOST/DIR 
                                                              *DEFAULT-PATHNAME-DEFAULTS*)
                                                     (IGNORE HOST))
                                              (PATHNAME (OR LOGINHOST/DIR *DEFAULT-PATHNAME-DEFAULTS*
                                                            )))

(DEFUN 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 (PROBE-FILE FILE)))
      (CL:WHEN TN (%%CONVERT-INTERNAL-TIME-TO-CLUT (GETFILEINFO TN (QUOTE IWRITEDATE))))))

(DEFUN PROBE-FILE
 (FILE) 
          
          (* * "Return a pathname which is the truename of the file if it exists, NIL otherwise.  Returns NIL for directories and other non-file entries.")

 (if (AND (STREAMP FILE)
          (OPENP FILE))
     then
     (fetch (STREAM FULLNAME)
            of FILE)
     else
     (if (INFILEP FILE)
         then
         (PATHNAME FILE)
         else NIL)))

(DEFUN RENAME-FILE
 (FILE 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.")

 (LET ((OLD-PATHNAME (PATHNAME FILE))
       (NEW-FULLNAME))
      (if (STREAMP FILE)
          then
          (if (OPENP FILE)
              then
              (CL:ERROR "Renaming open streams is not supported: ~S" FILE)
              else
              (SETQ NEW-FULLNAME (RENAMEFILE (SETQ FILE (fetch (STREAM FULLNAME)
                                                               of FILE))
                                        NEW-NAME)))
          else
          (SETQ NEW-FULLNAME (RENAMEFILE FILE NEW-NAME)))
      (VALUES (MERGE-PATHNAMES NEW-NAME FILE)
             OLD-PATHNAME
             (PATHNAME NEW-FULLNAME))))

(DEFUN DELETE-FILE
 (FILE) 
          
          (* * "Delete the specified file.")

 (LET ((TN (PROBE-FILE FILE)))
      (CL:WHEN (STREAMP FILE)
             (CLOSE FILE :ABORT T))
      (CL:IF TN (LET ((NS (NAMESTRING TN)))
                     (DELFILE NS))
             (CL:UNLESS (STREAMP FILE)
                    (CL:ERROR "File to be deleted does not exist: ~S" FILE))))
 T)


(PUTPROPS CMLFILESYS FILETYPE
 COMPILE-FILE)
(PUTPROPS CMLFILESYS COPYRIGHT ("Xerox Corporation" 1986))
(DECLARE: DONTCOPY
  (FILEMAP (NIL)))
STOP