;;; -*- Mode:Lisp; Readtable:ZL; Package:USER; Base:10; Patch-File:T -*-
;;; Patch file for System version 123.63
;;; Reason:
;;;  Allow :deleted and :sorted options for a the FTP-ACCESS :directory-list
;;;  method -- rather than always including deleted files and giving the list
;;;  in whatever order the server sent it.
;;; Written 21-Oct-87 12:38:53 by pld (Peter L. DeWolf) at site LMI Cambridge
;;; while running on Jack Flanders from band 2
;;; with Don't-dump-a-band! Inconsistent (unreleased patches loaded) System 123.62, Experimental Local-File 73.0, Experimental FILE-Server 22.0, Experimental Unix-Interface 11.0, Experimental Tape 18.0, Experimental KERMIT 34.0, Experimental ZMail 71.0, Experimental Lambda-Diag 15.0, microcode 1754, SDU Boot Tape 3.12, SDU ROM 8.



; From modified file DJ: L.NETWORK.IP-TCP.USER; FTP-ACCESS.LISP#24 at 21-Oct-87 12:38:54
#10R FILE-SYSTEM#: 
(COMPILER-LET ((*PACKAGE* (PKG-FIND-PACKAGE "FILE-SYSTEM")))
  (COMPILER::PATCH-SOURCE-FILE "SYS: NETWORK; IP-TCP; USER; FTP-ACCESS  "

(defmethod (ftp-access :directory-list) (given-pathname options)
  (let ((pathname (normalize-ftp-directory-list-pathname given-pathname host))
	(no-error-p nil)			;T to not generate errors
	(deleted-p nil)				;T to include deleted files
	(sorted-p nil))				;T to sort generated list
    (do ((l options (cdr l)))
	((null l))
      (case (car l)
	(:noerror (setq no-error-p t))
	(:sorted (setq sorted-p t))
	(:deleted (setq deleted-p t))
	(otherwise (ferror nil "~S is not a known DIRECTORY option" (car l)))))
    (with-open-file (s pathname :raw-directory-list t :error (not no-error-p))
      (if (errorp s)
	  s
	(let ((dir-list	(ftp-access-canonicalize-directory-list
			  (cons
			    `(nil :pathname ,pathname)
			    (do ((line) (eofp) (list))
				(eofp (nreverse list))
			      (multiple-value (line eofp) (send s :line-in))
			      (when line
				(let ((plist (ftp-parse-directory-list-line line host pathname)))
				  (when plist
				    (let ((truename (getf (cdr plist) :truename))
					  (deleted (getf (cdr plist) :deleted)))
				      (when (or (not deleted) deleted-p)
					(when truename
					  (setf (car plist) truename))
					(push plist list)))))))))))
	  (when sorted-p
	    (let ((null-elem (assq nil dir-list)))
	      (and null-elem (setq dir-list (delq null-elem dir-list)))
	      (setq dir-list (sortcar dir-list #'pathname-lessp))
	      (and null-elem (push null-elem dir-list))))
	  dir-list)))))

))