;;; -*- Mode:Lisp; Readtable:ZL; Package:USER; Base:10; Patch-File:T -*-
;;; Patch file for System version 123.52
;;; Reason:
;;;  Unfortunately, FTP-ACCESS as written uses the :directory-list method for both
;;;  Dired and :multiple-file-plists (called by make-system).  These want contrary
;;;  formats for the directory list: Dired wants the truename as the car, make-system
;;;  wants the pathname it specified.  Solution: :directory-list always sets up the
;;;  truename (and thus Dired's of all flavors work well), and we provide a
;;;  :multiple-file-plists method that doesn't call :directory-list, but
;;;  does the right thing itself.
;;; Written 14-Oct-87 16:25:54 by pld at site LMI Cambridge
;;; while running on Jack Flanders from band 2
;;; with Experimental System 123.51, 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#19 at 14-Oct-87 16:25: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)))
    (with-open-file (s pathname :raw-directory-list t :error (memq :noerror options))
      (if (errorp s)
	  s
	(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))
		       (truename (and plist (getf (cdr plist) :truename))))
		  (when plist
		    (when truename
		      (setf (car plist) truename))
		    (push plist list)))))))))))

(defmethod (ftp-access :multiple-file-plists) (files options)
  (do* ((list files (cdr list))
	(file (car list) (car list))
	(result nil))
       ((null list)
	(nreverse result))
    (let* ((pathname (normalize-ftp-directory-list-pathname file host))
	   (plist (with-open-file (s pathname :raw-directory-list t :error (memq :noerror options))
		    (if (errorp s)
			s
		      (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 (and plist (car plist))
				  (push plist list)))))))))))
      (dolist (elt plist)
	(push elt result)))))

))
