;;; -*- 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))))) ))