(FILECREATED " 2-Oct-86 09:52:13" {ERIS}<LISPCORE>SOURCES>CMLFILESYS.;3
 4492   

      changes to:  (FUNCTIONS DELETE-FILE)

      previous date: " 5-Sep-86 18:08:12" {ERIS}<LISPCORE>SOURCES>CMLFILESYS.;2)


(* "
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)))
                     (CL:UNLESS (DELFILE NS)
                            (CL:ERROR "Could not delete the file ~S" FILE)))
             (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