;;; -*- Mode:Lisp; Readtable:ZL; Package:USER; Base:8; Patch-File:T -*-
;;; Patch file for System version 123.222
;;; Reason:
;;;  Fix Dired's Copy (C), Rename (R), and Srccom () commands to really use
;;;  the defaults they say they will use, rather than always using .LISP#>
;;; Written 7-Apr-88 13:21:55 by pld at site LMI
;;; while running on Opus from band 2
;;; with Experimental System 123.221, Experimental Local-File 73.4, Experimental FILE-Server 22.2, Experimental Unix-Interface 11.0, Experimental KERMIT 34.3, Experimental ZMail 71.0, Experimental Lambda-Diag 15.0, Experimental Tiger 27.0, Experimental Site Data Editor 9.0, Experimental Tape 22.0, microcode 1755, SDU Boot Tape 3.14, SDU ROM 8, Beta II/site/patch.



; From modified file OPUS: L.ZWEI; DIRED.LISP#329 at 7-Apr-88 13:22:18
#8R ZWEI#: 
(COMPILER-LET ((*PACKAGE* (PKG-FIND-PACKAGE "ZWEI")))
  (COMPILER::PATCH-SOURCE-FILE "SYS: ZWEI; DIRED  "


(DEFCOM COM-DIRED-COPY "Copy the file on this line" ()
  (WHEN (GETF (LINE-PLIST (BP-LINE (POINT))) ':DELETED)
    (BARF))
  (LET ((FILE (DIRED-LINE-PATHNAME-OR-BARF (BP-LINE (POINT)))))
    (LET ((NEWFILE (READ-DEFAULTED-PATHNAME (FORMAT NIL "Pathname to copy ~A to" FILE)
					    FILE))
	  RESULT FILE-PLIST)
      (SETQ RESULT (MULTIPLE-VALUE-LIST (COPY-FILE FILE NEWFILE :ERROR NIL)))
      (COND ((ERRORP (THIRD RESULT))
	     (FORMAT *QUERY-IO* "~&Not copied: ~A" (THIRD RESULT)))
	    (T
	     (FORMAT *QUERY-IO* "~&File copied to ~A" (THIRD RESULT))
	     ;; Save a copy of this file's directory list entry.
	     (SETQ FILE-PLIST (COPY-LIST (LINE-PLIST (BP-LINE (POINT)))))
	     (SETF (GETF FILE-PLIST ':PATHNAME) (THIRD RESULT))
	     ;; insert a line for the new file.
	     (WITH-READ-ONLY-SUPPRESSED (*INTERVAL*)
	       (MULTIPLE-VALUE-BIND (BP LEVEL)
		   (DIRED-PATHNAME-INSERTION-BP (THIRD RESULT))
		 (COND (BP
			(WITH-BP (SAVE-BP BP :NORMAL)
			  (INSERT BP #/NEWLINE)
			  (SETF (LINE-PLIST (BP-LINE SAVE-BP)) FILE-PLIST)
			  (SETF (DIRED-LINE-LEVEL (BP-LINE SAVE-BP))
				(OR LEVEL 0))
			  (DIRED-REGENERATE-LINE (BP-LINE SAVE-BP))))
		       (T
			(FORMAT *QUERY-IO* ", in a directory not in this display.")))))))))
  DIS-TEXT)

))

; From modified file OPUS: L.ZWEI; DIRED.LISP#329 at 7-Apr-88 13:22:21
#8R ZWEI#: 
(COMPILER-LET ((*PACKAGE* (PKG-FIND-PACKAGE "ZWEI")))
  (COMPILER::PATCH-SOURCE-FILE "SYS: ZWEI; DIRED  "


(DEFCOM COM-DIRED-RENAME "Rename the file on this line" () 
  (WHEN (GETF (LINE-PLIST (BP-LINE (POINT))) ':DELETED)
    (BARF))
  (LET* ((LINE (BP-LINE (POINT)))
	 (DIR-P (GETF (LINE-PLIST LINE) ':DIRECTORY))   ;is this a directory?
	 (FILE (DIRED-LINE-PATHNAME-OR-BARF LINE)))
    (WHEN DIR-P (BARF "~A is a directory.  Command not applicable!" FILE))
    (LET ((NEWFILE (READ-DEFAULTED-PATHNAME (FORMAT NIL "Pathname to rename ~A to" FILE)
					    FILE
					    (send file :type)
					    (send file :version)))
	  FILE-PLIST)
      (WITH-OPEN-FILE (STREAM FILE)
	(FILE-RETRY-NEW-PATHNAME (NEWFILE FS:RENAME-FAILURE)
	  (SEND STREAM :RENAME NEWFILE))
	(CLOSE STREAM)
	(SETQ NEWFILE (SEND STREAM :TRUENAME))
	(SETF (GETF (LINE-PLIST (BP-LINE (POINT))) ':PATHNAME) NEWFILE)
	(FORMAT *QUERY-IO* "~&File renamed to ~A" NEWFILE)
	;; Save a copy of this file's directory list entry.
	(SETQ FILE-PLIST (LINE-PLIST (BP-LINE (POINT))))
	;; Delete this line.
	(WITH-READ-ONLY-SUPPRESSED (*INTERVAL*)
	  (DELETE-INTERVAL (BEG-LINE (POINT)) (BEG-LINE (POINT) 1) T)
	  (MULTIPLE-VALUE-BIND (BP LEVEL)
	      (DIRED-PATHNAME-INSERTION-BP NEWFILE)
	    (COND (BP
		   (WITH-BP (SAVE-BP BP :NORMAL)
		     (INSERT BP #/NEWLINE)
		     (SETF (LINE-PLIST (BP-LINE SAVE-BP)) FILE-PLIST)
		     (SETF (DIRED-LINE-LEVEL (BP-LINE SAVE-BP))
			   (OR LEVEL 0))
		     (DIRED-REGENERATE-LINE (BP-LINE SAVE-BP))))
		  (T
		   (FORMAT *QUERY-IO* ", in a directory not in this display."))))))))
  DIS-TEXT)

))

; From modified file OPUS: L.ZWEI; DIRED.LISP#329 at 7-Apr-88 13:22:23
#8R ZWEI#: 
(COMPILER-LET ((*PACKAGE* (PKG-FIND-PACKAGE "ZWEI")))
  (COMPILER::PATCH-SOURCE-FILE "SYS: ZWEI; DIRED  "


(DEFCOM COM-DIRED-SRCCOM-FILE "Compare the current file against another file" ()
  (WHEN (GETF (LINE-PLIST (BP-LINE (POINT))) ':DELETED)
    (BARF))
  (LET* ((FILE (DIRED-LINE-PATHNAME-OR-BARF (BP-LINE (POINT))))
	 (NEWFILE (READ-DEFAULTED-PATHNAME (FORMAT NIL "Pathname to compare ~A to" FILE)
					    (send FILE :new-version :newest)
					    (send file :type))))
      (srccom-file file newfile))
  DIS-NONE)

))