;;; -*- Mode:Lisp; Readtable:ZL; Package:USER; Base:8; Patch-File:T -*-
;;; Patch file for System version 124.92
;;; Reason:
;;;  When used on wildcard arguments, Zwei's Meta-X Copy File and Meta-X
;;;  Rename File now display the intended from- and to- pathnames during the
;;;  request for confirmation.
;;; Written 23-Jun-88 11:33:22 by saz (David M.J. Saslav) at site Gigamos Cambridge
;;; while running on Brahms' First from band 1
;;; with Experimental System 124.90, Experimental Local-File 74.2, Experimental File-Server 23.1, Experimental Unix-Interface 12.0, Experimental ZMail 72.1, Experimental Tape 23.6, Experimental Lambda-Diag 16.2, Tiger 28.0, microcode 1761, SDU Boot Tape 3.14, SDU ROM 103, Beta 3 for in-house.



; From modified file DJ: L.ZWEI; FILES.LISP#208 at 23-Jun-88 11:33:26
#8R ZWEI#: 
(COMPILER-LET ((*PACKAGE* (PKG-FIND-PACKAGE "ZWEI")))
  (COMPILER::PATCH-SOURCE-FILE "SYS: ZWEI; FILES  "


(DEFCOM COM-RENAME-FILE
  "Rename a file.
If wildcards are used, many files can be renamed." ()
  (LET* ((PATHNAME (READ-DEFAULTED-PATHNAME "Rename file:" (PATHNAME-DEFAULTS)))
	 (TO-SPEC (READ-UNDEFAULTED-PATHNAME-STRING
		    (FORMAT NIL "Rename file ~A to:" PATHNAME)
		    PATHNAME))
	 BUFFERS-CONSIDERED)
    (DECLARE (SPECIAL BUFFERS-CONSIDERED))
    (IF (SEND PATHNAME :WILD-P)
	(LET ((DIR (CDR (FS:DIRECTORY-LIST PATHNAME)))
	      (TO-PATHNAME (FS:MERGE-PATHNAMES TO-SPEC PATHNAME)))
	  (FORMAT T "~&Files to be renamed from ~A to ~A:~%" pathname to-pathname)
	  (MAPC *DIRECTORY-SINGLE-FILE-LISTER* DIR)
	  (WHEN (LET ((*QUERY-IO* *STANDARD-OUTPUT*))
		  (Y-OR-N-P "Rename them all? "))
	    (DOLIST (ELT DIR)
	      (CONDITION-CASE (ERROR)
		  (SEND (CAR ELT) :RENAME
			(SEND PATHNAME :TRANSLATE-WILD-PATHNAME TO-PATHNAME (CAR ELT)))
		((FS:FILE-ERROR SYS:REMOTE-NETWORK-ERROR)
		 (FORMAT T "~&Rename failure: ~A" ERROR))
		(:NO-ERROR
		 (RENAME-FILE-1 PATHNAME
				(SEND PATHNAME :TRANSLATE-WILD-PATHNAME
				      TO-PATHNAME (CAR ELT))))))
	    (FORMAT T "~&Done.~%")))
      (CONDITION-CASE (ERROR OLD-TRUENAME NEW-TRUENAME)
	  (RENAME-FILE PATHNAME TO-SPEC)
	((FS:FILE-ERROR SYS:REMOTE-NETWORK-ERROR)
	 (BARF ERROR))
	(:NO-ERROR
	 (FORMAT *QUERY-IO* "~&~A renamed~% to ~A." OLD-TRUENAME NEW-TRUENAME)
	 (RENAME-FILE-1 OLD-TRUENAME NEW-TRUENAME)))))
  DIS-NONE)

))

; From modified file DJ: L.ZWEI; FILES.LISP#208 at 23-Jun-88 11:33:28
#8R ZWEI#: 
(COMPILER-LET ((*PACKAGE* (PKG-FIND-PACKAGE "ZWEI")))
  (COMPILER::PATCH-SOURCE-FILE "SYS: ZWEI; FILES  "


(DEFUN COPY-FILE-1 (COPY-MODE COPY-CREATION-DATE?)
  (LET* ((FILE-TYPE-STRING
	   (SELECTQ COPY-MODE
	     ((T) "Copy text file")
	     ((NIL) "Copy binary file")
	     (OTHERWISE "Copy file")))
	 (PATHNAME
	   (READ-DEFAULTED-PATHNAME (FORMAT NIL "~A:" FILE-TYPE-STRING)
				    (PATHNAME-DEFAULTS)))
	 (TO-SPEC (READ-UNDEFAULTED-PATHNAME-STRING
		    (FORMAT NIL "Copy file ~A to:" PATHNAME)
		    PATHNAME)))
    (IF (SEND PATHNAME :WILD-P)
	(LET ((DIR (CDR (FS:DIRECTORY-LIST PATHNAME)))
	      (TO-PATHNAME (FS:MERGE-PATHNAMES TO-SPEC PATHNAME)))
	  (PUSH-ON-HISTORY (SEND TO-PATHNAME :STRING-FOR-PRINTING) *PATHNAME-ARGUMENT-HISTORY*)
	  (FORMAT T "~&Files to be copied from ~A to ~A:~%" pathname to-pathname)
	  (MAPC *DIRECTORY-SINGLE-FILE-LISTER* DIR)
	  (WHEN (LET ((*QUERY-IO* *STANDARD-OUTPUT*))
		  (Y-OR-N-P "Copy them all? "))
	    (DOLIST (ELT DIR)
	      (CONDITION-CASE (ERROR)
		  (COPY-FILE (CAR ELT)
			     (SEND PATHNAME :TRANSLATE-WILD-PATHNAME TO-PATHNAME (CAR ELT))
			     :COPY-CREATION-DATE COPY-CREATION-DATE?
			     :COPY-AUTHOR COPY-CREATION-DATE?
			     :CHARACTERS COPY-MODE
			     :REPORT-STREAM *STANDARD-OUTPUT*)
		((FS:FILE-ERROR SYS:REMOTE-NETWORK-ERROR)
		 (FORMAT T "~&Copy failure: ~A" ERROR))))
	    (FORMAT T "~&Done.~%")))
      (CONDITION-CASE (VALUE)
	  (COPY-FILE PATHNAME TO-SPEC
		     :COPY-CREATION-DATE COPY-CREATION-DATE?
		     :COPY-AUTHOR COPY-CREATION-DATE?
		     :CHARACTERS COPY-MODE
		     :REPORT-STREAM *QUERY-IO*)
	((FS:FILE-ERROR SYS:REMOTE-NETWORK-ERROR)
	 (BARF VALUE))))))

))