;;; -*- Mode:Lisp; Readtable:ZL; Package:USER; Base:8; Patch-File:T -*-
;;; Patch file for System version 126.101
;;; Reason:
;;;  Make RENAME-FILE and DELETE-FILE work for logical pathnames.  (Again.)
;;;  There  are some wild-card cases that still don't work for <any> kind of
;;;  pathnames.
;;; Written 6-Oct-88 12:34:08 by keith (Keith Corbett) at site Gigamos Cambridge
;;; while running on Breaking Glass from band 3
;;; with Experimental System 126.100, Experimental ZWEI 126.14, Experimental ZMail 74.8, Experimental Local-File 76.0, Experimental File-Server 25.0, Experimental Lambda-Diag 18.0, Experimental Unix-Interface 15.0, Experimental Tape 26.4, microcode 1762, SDU Boot Tape 3.14, SDU ROM 103.



; From modified file DJ: L.IO.FILE; OPEN.LISP#211 at 6-Oct-88 12:34:21
#8R FILE-SYSTEM#: 
(COMPILER-LET ((*PACKAGE* (PKG-FIND-PACKAGE "FILE-SYSTEM")))
  (COMPILER::PATCH-SOURCE-FILE "SYS: IO; FILE; OPEN  "


(DEFUN PRIMITIVE-RENAME-FILE (OLD-NAME MAPPED-PATHNAME NEW-NAME &OPTIONAL (ERROR-P T) QUERYF)
  (LET ((TRUENAME (IF (or (EQ OLD-NAME MAPPED-PATHNAME)
			  (typep old-name 'logical-pathname))
		      (SEND OLD-NAME ':TRUENAME ERROR-P)
		    OLD-NAME))
	(newname (if (typep new-name 'logical-pathname)
		     (translated-pathname (merge-pathname-defaults new-name mapped-pathname))
		   new-name)))
    (IF (ERRORP TRUENAME)
	(LIST MAPPED-PATHNAME OLD-NAME NIL OLD-NAME TRUENAME)
      (LET* ((DEFAULTED-NEW-NAME
	       (LET ((*ALWAYS-MERGE-TYPE-AND-VERSION* T))
		 (MERGE-PATHNAME-DEFAULTS
		   (SEND MAPPED-PATHNAME ':TRANSLATE-WILD-PATHNAME newname TRUENAME)
		   TRUENAME)))
	     (RENAMED? (FUNCALL QUERYF "~&Rename ~A to ~A? "
				TRUENAME DEFAULTED-NEW-NAME))
	     (RESULT (AND RENAMED? (SEND TRUENAME ':RENAME
					 DEFAULTED-NEW-NAME ERROR-P))))
	(LIST MAPPED-PATHNAME OLD-NAME DEFAULTED-NEW-NAME TRUENAME RESULT)))))

))

; From modified file DJ: L.IO.FILE; OPEN.LISP#211 at 6-Oct-88 12:34:22
#8R FILE-SYSTEM#: 
(COMPILER-LET ((*PACKAGE* (PKG-FIND-PACKAGE "FILE-SYSTEM")))
  (COMPILER::PATCH-SOURCE-FILE "SYS: IO; FILE; OPEN  "


(DEFUN PRIMITIVE-DELETE-FILE (PATHNAME MAPPED-PATHNAME &OPTIONAL (ERROR-P T) QUERYF)
  "QUERYF should be a function that takes a format-string and a pathname
and returns T or NIL saying whether to delete that file.
If you don't want any querying, pass FILE-QUERY-TRUE as QUERYF."
  (LET ((TRUENAME (cond
		    ((EQ PATHNAME MAPPED-PATHNAME) (SEND PATHNAME ':TRUENAME ERROR-P))
		    ((typep pathname 'logical-pathname) (translated-pathname pathname))
		    (t PATHNAME))))
    (IF (ERRORP TRUENAME)
	(LIST PATHNAME TRUENAME)
      (LET* ((DELETE? (FUNCALL QUERYF "~&Delete ~A? " TRUENAME))
	     (RESULT (AND DELETE? (SEND TRUENAME ':DELETE ERROR-P))))
	(LIST TRUENAME (IF (ERRORP RESULT) RESULT DELETE?))))))

))