;;; -*- Mode:Lisp; Readtable:ZL; Package:USER; Base:8; Patch-File:T -*-
;;; Patch file for System version 121.12
;;; Reason:
;;;  Patches to fs:balance-directories from Release 3:
;;;     Preserve version numbers.
;;;     Copy files with same version number and later creation dates
;;; Written 23-Jan-87 23:31:04 by pld (Peter L. DeWolf) at site LMI Cambridge
;;; while running on Azathoth from band 3
;;; with Experimental System 121.11, Experimental Lambda-Diag 15.0, Experimental ZMail 70.1, Experimental KERMIT 32.0, Experimental Unix-Interface 10.0, Experimental Local-File 72.0, Experimental FILE-Server 21.0, Experimental Tape 13.0, microcode 1730, SDU Boot Tape 3.12, SDU ROM 102, the old ones.


;; *** Note: ***
;;   You may lose because the buffer has no readtable attribute.
;; *************

; From modified file DJ: L.IO.FILE; BALDIR.LISP#117 at 23-Jan-87 23:31:12
#8R FILE-SYSTEM#: 
(COMPILER-LET ((*PACKAGE* (PKG-FIND-PACKAGE "FILE-SYSTEM")))
  (COMPILER::PATCH-SOURCE-FILE "SYS: IO; FILE; BALDIR  "


(DEFSUBST WILD-PATHNAME-VERSION-COMPONENT? (COMPONENT)
  (MEMQ COMPONENT '(NIL :WILD :NEWEST)))


))
;; *** Note: ***
;;   You may lose because the buffer has no readtable attribute.
;; *************

; From modified file DJ: L.IO.FILE; BALDIR.LISP#117 at 23-Jan-87 23:31:16
#8R FILE-SYSTEM#: 
(COMPILER-LET ((*PACKAGE* (PKG-FIND-PACKAGE "FILE-SYSTEM")))
  (COMPILER::PATCH-SOURCE-FILE "SYS: IO; FILE; BALDIR  "


(DEFUN DEFAULT-WILD-PATHNAME-COMPONENTS (PATH1 PATH2)
  "Fill in the unspecified or wild parts of PATH1 with the corresponding parts of PATH2."

  (FAST-NEW-PATHNAME PATH1
		     (AND (WILD-PATHNAME-COMPONENT? (PATHNAME-DEVICE PATH1))
			  (PATHNAME-DEVICE PATH2))
		     (AND (WILD-PATHNAME-COMPONENT? (PATHNAME-DIRECTORY PATH1))
			  (PATHNAME-DIRECTORY PATH2))
		     (AND (WILD-PATHNAME-COMPONENT? (PATHNAME-NAME PATH1))
			  (PATHNAME-NAME PATH2))
		     (AND (WILD-PATHNAME-COMPONENT? (PATHNAME-TYPE PATH1))
			  (PATHNAME-TYPE PATH2))
		     (AND (WILD-PATHNAME-VERSION-COMPONENT? (PATHNAME-VERSION PATH1))
			  (PATHNAME-VERSION PATH2))))

))
;; *** Note: ***
;;   You may lose because the buffer has no readtable attribute.
;; *************

; From modified file DJ: L.IO.FILE; BALDIR.LISP#117 at 23-Jan-87 23:31:33
#8R FILE-SYSTEM#: 
(COMPILER-LET ((*PACKAGE* (PKG-FIND-PACKAGE "FILE-SYSTEM")))
  (COMPILER::PATCH-SOURCE-FILE "SYS: IO; FILE; BALDIR  "


(DEFUN COMPARE-CDIRECTORIES (CDIR1 CDIR2 &OPTIONAL TAPE-LOSSAGE)
  (LET ((ISOCLASSES (SORT-ISOMORPHIC-CLASSES 'SAME-NAME-AND-TYPE?
					     'SAME-NAME-AND-CANONICAL-TYPE?
					     (CDIRECTORY-CFILES CDIR1)
					     (CDIRECTORY-CFILES CDIR2)))
	(NEWEST? (NOT (OR (EQ (PATHNAME-VERSION (CDIRECTORY-PATHNAME CDIR1)) ':WILD)
			  (EQ (PATHNAME-VERSION (CDIRECTORY-PATHNAME CDIR2)) ':WILD)))))
    (DOLIST (CLASS (ISOSET-IN-1-ONLY ISOCLASSES))
      (COMPARE-CDIRECTORIES-1 CLASS CDIR2 NEWEST? TAPE-LOSSAGE))
    (DOLIST (CLASS (ISOSET-IN-2-ONLY ISOCLASSES))
      (COMPARE-CDIRECTORIES-1 CLASS CDIR1 NEWEST? TAPE-LOSSAGE))
    (DOLIST (CLASS-PAIR (ISOSET-IN-BOTH ISOCLASSES))
      (LET ((REP1 (CLASS-REPRESENTATIVE (CAR CLASS-PAIR)))
	    (REP2 (CLASS-REPRESENTATIVE (CDR CLASS-PAIR)))
	    (ISOSET (SORT-ISOMORPHIC-ELEMENTS #'SAME-VERSION?
					      (CAR CLASS-PAIR)
					      (CDR CLASS-PAIR))))
	(COND (NEWEST?
	       (LET ((V1 (CFILE-VERSION REP1))
		     (CD1 (CFILE-CREATION-DATE REP1))
		     (V2 (CFILE-VERSION REP2))
		     (CD2 (CFILE-CREATION-DATE REP2)))
		 (COND ((OR (NOT (FIXP V1))
			    (NOT (FIXP V2)))
			(COND ((> CD1 CD2)
			       (MARK-CFILE-FOR-TRANSFER REP1 CDIR2 TAPE-LOSSAGE))
			      ((> CD2 CD1)
			       (MARK-CFILE-FOR-TRANSFER REP2 CDIR1 TAPE-LOSSAGE))))
		       ((> V1 V2)
			(MARK-CFILE-FOR-TRANSFER REP1 CDIR2 TAPE-LOSSAGE))
		       ((> V2 V1)
			(MARK-CFILE-FOR-TRANSFER REP2 CDIR1 TAPE-LOSSAGE))
		       ((> CD1 CD2)
			(MARK-CFILE-FOR-TRANSFER REP1 CDIR2 TAPE-LOSSAGE))
		       ((> CD2 CD1)
			(MARK-CFILE-FOR-TRANSFER REP2 CDIR1 TAPE-LOSSAGE)))))
	      (T
	       (DOLIST (CFILE (ISOSET-IN-1-ONLY ISOSET))
		 (MARK-CFILE-FOR-TRANSFER CFILE CDIR2 TAPE-LOSSAGE))
	       (DOLIST (CFILE (ISOSET-IN-2-ONLY ISOSET))
		 (MARK-CFILE-FOR-TRANSFER CFILE CDIR1 TAPE-LOSSAGE))))))))

))
