(FILECREATED "17-Jul-86 15:52:06" {ERIS}<LISPCORE>LIBRARY>CMLFILESYS.;5
 4320   

      changes to:  (FNS CL:DIRECTORY CL:DIRECTORY2)
                   (FUNCTIONS CL:DIRECTORY)
                   (VARS CMLFILESYSCOMS)

      previous date: "20-Jun-86 15:23:25" {ERIS}<LISPCORE>LIBRARY>CMLFILESYS.;1)


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

(PRETTYCOMPRINT CMLFILESYSCOMS)

(RPAQQ CMLFILESYSCOMS
 ((FUNCTIONS FILE-AUTHOR FILE-LENGTH FILE-POSITION USER-HOMEDIR-PATHNAME 
                              FILE-WRITE-DATE)
                       (FUNCTIONS PROBE-FILE RENAME-FILE DELETE-FILE)
                       (FNS CL:DIRECTORY)
                       (PROP FILETYPE CMLFILESYS)))
(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*))
                                              (CL:DECLARE (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 (DIFFERENCE (GETFILEINFO TN (QUOTE IWRITEDATE))
                         MIN.FIXP))))

(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 STREAM))
     then
 (fetch
 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)

(DEFINEQ

(CL:DIRECTORY

  [LAMBDA (PATHNAME)
                                         (* hdj "17-Jul-86 15:50")

          
          (* * "CML directory function.  Returns a list of files matching PATHNAME")


    (for
 FILE infiles
 (DIRECTORY.FILL.PATTERN (\CONVERT-PATHNAME PATHNAME)) collect
 FILE])
)

(PUTPROPS CMLFILESYS FILETYPE
 COMPILE-FILE)
(PUTPROPS CMLFILESYS COPYRIGHT ("Xerox Corporation" 1986))
(DECLARE: DONTCOPY
  (FILEMAP (NIL (3862 4190 (CL:DIRECTORY 3872 . 4188)))))
STOP