;;; -*- Mode:Lisp; Readtable:CL; Package:USER; Base:10; Patch-File:T -*-
;;; Patch file for System version 123.263
;;; Reason:
;;;  For the FTP File Access method, I created a nifty macro (fs:handling-file-errors)
;;;  which is similar, but more powerful than (fs:file-operation-retry).  Wrapped
;;;  around file operations, it gives you a chance to try again if network lossage
;;;  occurs (broken connections, etc.)  QFILE is sadly lacking -- any sort of
;;;  connection screwup, and you must abort out (unless you C-M-R from the right
;;;  frame in the EH...)  Replacing a number of calls to (file-operation-retry)
;;;  in QFILE with (handling-file-errors) did wonders...having the file server
;;;  die in the middle of a lengthy make-system is no longer a big deal.
;;; Written 7-May-88 04:29:26 by pld at site Gigamos Cambridge
;;; while running on Azathoth from band 3
;;; with Experimental System 123.262, Experimental Local-File 73.5, Experimental FILE-Server 22.4, Experimental Unix-Interface 11.0, Experimental KERMIT 34.3, Experimental ZMail 71.2, Experimental Lambda-Diag 15.0, Experimental Tape 22.4, microcode 1756, SDU Boot Tape 3.14, SDU ROM 8, the old ones.



; From file DJ: L.IO.FILE; ACCESS.LISP#37 at 7-May-88 04:33:44
#10R FILE-SYSTEM#: #!:ZL
(COMPILER-LET ((*PACKAGE* (PKG-FIND-PACKAGE "FILE-SYSTEM")))
  (COMPILER::PATCH-SOURCE-FILE "SYS: IO; FILE; ACCESS  "

(defmacro handling-file-errors ((error-p) &body body)
  (let ((tag (gensym))
	(error (gensym)))
    `(condition-case-if (not ,error-p) (,error)
	 (condition-resume-if ,error-p '((file-error remote-network-error)
					 :retry-file-operation t
					 ("Retry the operation on the same file.")
					 (lambda (ignore) (throw ',tag nil)))
	   (block ,tag
	     (loop
	       (catch ',tag
		 (return-from ,tag
		   (progn ,@body))))))
       (file-error ,error))))

))

; From file DJ: L.IO.FILE; ACCESS.LISP#37 at 7-May-88 04:34:07
#10R FILE-SYSTEM#: #!:ZL
(COMPILER-LET ((*PACKAGE* (PKG-FIND-PACKAGE "FILE-SYSTEM")))
  (COMPILER::PATCH-SOURCE-FILE "SYS: IO; FILE; ACCESS  "

(DEFMETHOD (BASIC-ACCESS :PROPERTIES) (PATHNAME ERROR-P)
  (HANDLING-FILE-ERRORS (ERROR-P)
    (LET ((DIR (SEND SELF :DIRECTORY-LIST PATHNAME (IF ERROR-P '(:DELETED)
						     '(:NOERROR :DELETED)))))
      (IF (CONSP DIR)
	  (IF (CADR DIR)
	      (VALUES (CADR DIR) (GET (CAR DIR) :SETTABLE-PROPERTIES))
	    ;; It is possible for a nonexistent file to give no error
	    ;; but just return an empty directory.
	    (LET ((CONDITION (MAKE-CONDITION 'FILE-NOT-FOUND "~A" PATHNAME :PROPERTIES)))
	      (SEND CONDITION :SET-FORMAT-ARGS
		    (LIST (FORMAT NIL "File not found for ~A" PATHNAME)))
	      (IF ERROR-P (SIGNAL-CONDITION :PROCEED-TYPES ())
		CONDITION)))
	DIR))))

))

; From file DJ: L.IO.FILE; ACCESS.LISP#37 at 7-May-88 04:34:29
#10R FILE-SYSTEM#: #!:ZL
(COMPILER-LET ((*PACKAGE* (PKG-FIND-PACKAGE "FILE-SYSTEM")))
  (COMPILER::PATCH-SOURCE-FILE "SYS: IO; FILE; ACCESS  "

(DEFMETHOD (DIRECTORY-STREAM-ACCESS-MIXIN :DIRECTORY-LIST) (PATHNAME OPTIONS &AUX DIR-LIST)
  (HANDLING-FILE-ERRORS ((NOT (MEMQ :NOERROR OPTIONS)))
    (WITH-OPEN-STREAM (STREAM (SEND SELF :DIRECTORY-STREAM PATHNAME (REMQ ':SORTED OPTIONS)))
      (IF (ERRORP STREAM) STREAM
	(SETQ DIR-LIST
	      (LET ((PATHNAME (SEND STREAM :PATHNAME)))
		(LOOP AS ENTRY = (SEND SELF :READ-DIRECTORY-STREAM-ENTRY STREAM PATHNAME options)
		      UNTIL (NULL ENTRY)
		      COLLECTING ENTRY)))
	(IF (MEMQ :SORTED OPTIONS)
	    (LET ((NULL-ELEM (ASSQ NIL DIR-LIST)))
	      (AND NULL-ELEM (SETQ DIR-LIST (DELQ NULL-ELEM DIR-LIST)))
	      (SETQ DIR-LIST (SORTCAR DIR-LIST #'PATHNAME-LESSP))
	      (AND NULL-ELEM (PUSH NULL-ELEM DIR-LIST))))
	DIR-LIST))))

))

; From file DJ: L.NETWORK.CHAOS; QFILE.LISP#380 at 7-May-88 04:35:11
#8R FILE-SYSTEM#: #!:ZL
(COMPILER-LET ((*PACKAGE* (PKG-FIND-PACKAGE "FILE-SYSTEM")))
  (COMPILER::PATCH-SOURCE-FILE "SYS: NETWORK; CHAOS; QFILE  "

(DEFUN DELETE-CHAOS (ACCESS PATHNAME ERROR-P &AUX HOST-UNIT PKT SUCCESS STRING)
  (HANDLING-FILE-ERRORS (ERROR-P)
    (SETQ HOST-UNIT (SEND ACCESS :GET-HOST-UNIT))
    (UNWIND-PROTECT 
	(PROGN
	  (MULTIPLE-VALUE-SETQ (PKT SUCCESS STRING)
	    (SEND HOST-UNIT :COMMAND NIL NIL NIL "Delete" "DELETE" #/NEWLINE
		  (FILE-PRINT-PATHNAME PATHNAME) #/NEWLINE))
	  (OR SUCCESS
	      (QFILE-PROCESS-ERROR-NEW STRING PATHNAME NIL (NOT ERROR-P) :DELETE)))
      (AND PKT (CHAOS:RETURN-PKT PKT)))))

))

; From file DJ: L.NETWORK.CHAOS; QFILE.LISP#380 at 7-May-88 04:35:26
#8R FILE-SYSTEM#: #!:ZL
(COMPILER-LET ((*PACKAGE* (PKG-FIND-PACKAGE "FILE-SYSTEM")))
  (COMPILER::PATCH-SOURCE-FILE "SYS: NETWORK; CHAOS; QFILE  "

(DEFUN RENAME-CHAOS (ACCESS OLD-PATHNAME NEW-PATHNAME ERROR &AUX PKT SUCCESS STRING)
  (DECLARE (VALUES TRUENAME OLD-TRUENAME))
  (HANDLING-FILE-ERRORS (ERROR)
    (LET ((HOST-UNIT (SEND ACCESS :GET-HOST-UNIT)))
      (UNWIND-PROTECT
	  (PROGN (MULTIPLE-VALUE-SETQ (PKT SUCCESS STRING)
		   (SEND HOST-UNIT :COMMAND NIL NIL NIL "Rename" "RENAME" #/NEWLINE
			 (FILE-PRINT-PATHNAME OLD-PATHNAME) #/NEWLINE
			 (FILE-PRINT-PATHNAME NEW-PATHNAME) #/NEWLINE))
		 (IF SUCCESS
		     ;; If there is a second line coming from the file server,
		     ;; it is the new truename.
		     (let* ((from (string-search-char #/newline string)) truename)
		       (if (null from) (values new-pathname old-pathname)
			 (let* ((old (string-search-char #/newline string from))
				(host (send old-pathname :host)))
			   (setq truename (parse-pathname string host nil (1+ from) old))
			   (if (null old) (values truename old-pathname)
			     (values truename
				     (fs:parse-pathname string host nil (1+ old)))))))
		   (QFILE-PROCESS-ERROR-NEW STRING OLD-PATHNAME NIL (NOT ERROR) :RENAME)))
      (AND PKT (CHAOS:RETURN-PKT PKT))))))

))

; From file DJ: L.NETWORK.CHAOS; QFILE.LISP#380 at 7-May-88 04:35:36
#8R FILE-SYSTEM#: #!:ZL
(COMPILER-LET ((*PACKAGE* (PKG-FIND-PACKAGE "FILE-SYSTEM")))
  (COMPILER::PATCH-SOURCE-FILE "SYS: NETWORK; CHAOS; QFILE  "

(DEFUN CHANGE-PROPERTIES-CHAOS (ACCESS PATHNAME ERROR-P PROPERTIES
				&AUX HOST-UNIT PKT SUCCESS STRING)
  (HANDLING-FILE-ERRORS (ERROR-P)
    (SETQ HOST-UNIT (SEND ACCESS :GET-HOST-UNIT))
    (SETQ STRING (CHANGE-PROPERTIES-STRING PROPERTIES PATHNAME))
    (UNWIND-PROTECT
	(PROGN
	  (MULTIPLE-VALUE-SETQ (PKT SUCCESS STRING)
	    (SEND HOST-UNIT :COMMAND NIL NIL NIL "Change Properties" STRING))
	  (UNLESS SUCCESS
	    (QFILE-PROCESS-ERROR-NEW STRING PATHNAME NIL (NOT ERROR-P) :CHANGE-PROPERTIES)))
      (AND PKT (CHAOS:RETURN-PKT PKT)))))

))

; From file DJ: L.NETWORK.CHAOS; QFILE.LISP#380 at 7-May-88 04:35:45
#8R FILE-SYSTEM#: #!:ZL
(COMPILER-LET ((*PACKAGE* (PKG-FIND-PACKAGE "FILE-SYSTEM")))
  (COMPILER::PATCH-SOURCE-FILE "SYS: NETWORK; CHAOS; QFILE  "

(DEFUN CREATE-LINK-CHAOS (ACCESS LINK LINK-TO ERROR-P &AUX HOST-UNIT PKT SUCCESS STRING)
  (HANDLING-FILE-ERRORS (ERROR-P)
    (SETQ HOST-UNIT (SEND ACCESS :GET-HOST-UNIT))
    (UNWIND-PROTECT
	(PROGN
	  (MULTIPLE-VALUE-SETQ (PKT SUCCESS STRING)
	    (SEND HOST-UNIT :COMMAND NIL NIL NIL "Create Link" "CREATE-LINK" #/NEWLINE
		  (FILE-PRINT-PATHNAME LINK) #/NEWLINE
		  (FILE-PRINT-PATHNAME LINK-TO)))
	  (UNLESS SUCCESS
	    (QFILE-PROCESS-ERROR-NEW STRING LINK NIL (NOT ERROR-P) :CREATE-LINK)))
      (AND PKT (CHAOS:RETURN-PKT PKT)))))

))

; From file DJ: L.NETWORK.CHAOS; QFILE.LISP#380 at 7-May-88 04:35:53
#8R FILE-SYSTEM#: #!:ZL
(COMPILER-LET ((*PACKAGE* (PKG-FIND-PACKAGE "FILE-SYSTEM")))
  (COMPILER::PATCH-SOURCE-FILE "SYS: NETWORK; CHAOS; QFILE  "

(DEFUN DIRECTORY-OPERATION-CHAOS (OPERATION ACCESS PATHNAME ERRORP WHOSTATE
				  &AUX HOST-UNIT PKT SUCCESS FILE-STRING)
  (HANDLING-FILE-ERRORS (ERRORP)
    (SETQ HOST-UNIT (SEND ACCESS :GET-HOST-UNIT))
    (UNWIND-PROTECT
	(PROGN
	  (MULTIPLE-VALUE-SETQ (PKT SUCCESS FILE-STRING)
	    (SEND HOST-UNIT :COMMAND NIL NIL NIL WHOSTATE
		  (STRING OPERATION) #/NEWLINE
		  (FILE-PRINT-DIRECTORY PATHNAME) #/NEWLINE))
	  (COND (SUCCESS
		 (LET ((START (QFILE-CHECK-COMMAND (STRING OPERATION) FILE-STRING)))
		   (VALUES (PARSE-NUMBER FILE-STRING START))))
		(T
		 (QFILE-PROCESS-ERROR-NEW FILE-STRING PATHNAME NIL (NOT ERRORP) OPERATION))))
      (AND PKT (CHAOS:RETURN-PKT PKT)))))

))

; From file DJ: L.NETWORK.CHAOS; QFILE.LISP#380 at 7-May-88 04:36:34
#8R FILE-SYSTEM#: #!:ZL
(COMPILER-LET ((*PACKAGE* (PKG-FIND-PACKAGE "FILE-SYSTEM")))
  (COMPILER::PATCH-SOURCE-FILE "SYS: NETWORK; CHAOS; QFILE  "

(DEFUN OPEN-CHAOS (ACCESS FILE PATHNAME &REST OPTIONS
		   &KEY (DIRECTION :INPUT)
		   	(CHARACTERS T)
			(ERROR T)
			(ELEMENT-TYPE 'STRING-CHAR ELEMENT-TYPE-P)
			(IF-EXISTS nil if-exists-p)
			(IF-DOES-NOT-EXIST nil if-does-not-exist-p)
			(BYTE-SIZE :DEFAULT)
			MOBY-MAPPED
		   &ALLOW-OTHER-KEYS
		   &AUX HOST-UNIT DATA-CONN PKT NOT-ABORTED
		        PHONY-CHARACTERS SIGN-EXTEND-BYTES
			(DEFAULT-CONS-AREA SYS:BACKGROUND-CONS-AREA))
  (SETQ PATHNAME (FS:PARSE-PATHNAME PATHNAME))
  (IF IF-EXISTS-P
      (CHECK-TYPE IF-EXISTS (MEMBER :ERROR :NEW-VERSION :RENAME :RENAME-AND-DELETE
				    :OVERWRITE :APPEND :TRUNCATE :SUPERSEDE NIL))
    (SETQ IF-EXISTS (IF (MEMQ (PATHNAME-VERSION PATHNAME)
			      ;; :UNSPECIFIC here is to prevent lossage
			      ;; writing ITS files with no version numbers.
			      '(:NEWEST :UNSPECIFIC))
			:NEW-VERSION :ERROR)))
  (IF IF-DOES-NOT-EXIST-P
      (CHECK-TYPE IF-DOES-NOT-EXIST (MEMBER :ERROR :CREATE NIL))
    (SETQ IF-DOES-NOT-EXIST
	  (COND ((MEMQ DIRECTION '(:PROBE :PROBE-LINK :PROBE-DIRECTORY))
		 NIL)
		((AND (EQ DIRECTION :OUTPUT)
		      (NOT (MEMQ IF-EXISTS '(:OVERWRITE :TRUNCATE :APPEND))))
		 :CREATE)
		;; Note: if DIRECTION is NIL, this defaults to :ERROR
		;; for compatibility with the past.
		;; A Common-Lisp program would use :PROBE
		;; and get NIL as the default for this.
		(T :ERROR))))
  (ECASE DIRECTION
    ((:INPUT :OUTPUT :PROBE-DIRECTORY :PROBE-LINK))
    (:IO (FERROR "Bidirectional file streams are not yet supported."))
    ((NIL :PROBE) (SETQ DIRECTION NIL)))
  ;; IF-EXISTS-P is T if we need to give the IF-EXISTS to the server.
  (SETQ IF-EXISTS-P
	(NOT (MEMQ IF-EXISTS
		   (CASE (PATHNAME-VERSION PATHNAME)
		     (:NEWEST '(:NEW-VERSION))
		     (:UNSPECIFIC '(:NEW-VERSION :SUPERSEDE))))))
  (WHEN ELEMENT-TYPE-P
    (SETF (VALUES CHARACTERS BYTE-SIZE PHONY-CHARACTERS SIGN-EXTEND-BYTES)
	  (DECODE-ELEMENT-TYPE ELEMENT-TYPE BYTE-SIZE)))
  (flet ((make-stream (string)
	   (LET ((PROPERTIES (READ-FILE-PROPERTY-LIST-STRING STRING "OPEN" PATHNAME)))
	     (AND (EQ CHARACTERS :DEFAULT)
		  (SETQ CHARACTERS (GETF PROPERTIES :CHARACTERS)))
	     (UNLESS (OR (EQ BYTE-SIZE :DEFAULT)
			 (GETF PROPERTIES :BYTE-SIZE))
	       (SETF (GETF PROPERTIES :BYTE-SIZE) BYTE-SIZE))
	     (PROG1
	       (cond (moby-mapped
		      (open-chaos-moby-mapped host-unit properties string))  ;defined in moby stuff.
		     (t
		      (MAKE-INSTANCE (CASE DIRECTION
				(:INPUT
				 (IF CHARACTERS
				     'QFILE-INPUT-CHARACTER-STREAM
				   (COND (SIGN-EXTEND-BYTES
					  'QFILE-INPUT-SIGNED-BINARY-STREAM)
					 (PHONY-CHARACTERS
					  'QFILE-INPUT-PHONY-CHARACTER-STREAM)
					 (T
					  'QFILE-INPUT-BINARY-STREAM))))
				(:OUTPUT
				 (IF CHARACTERS
				     'QFILE-OUTPUT-CHARACTER-STREAM
				   (IF PHONY-CHARACTERS
				       'QFILE-OUTPUT-PHONY-CHARACTER-STREAM
				     'QFILE-OUTPUT-BINARY-STREAM)))
				(T 'QFILE-PROBE-STREAM))
			      :HOST-UNIT HOST-UNIT
			      :DATA-CONNECTION DATA-CONN
			      :PROPERTY-LIST PROPERTIES
			      :PATHNAME PATHNAME)))
	       (SETQ NOT-ABORTED T))))
	 (data-connection-handle ()
	   (CASE DIRECTION
	     (:INPUT (DATA-INPUT-HANDLE DATA-CONN))
	     (:OUTPUT (DATA-OUTPUT-HANDLE DATA-CONN)))))
    (HANDLING-FILE-ERRORS (ERROR)
      (PROGN (IF (or moby-mapped (MEMQ DIRECTION '(NIL :PROBE-DIRECTORY :PROBE-LINK)))
		   ;; PROBE mode implies no need for data connection
		     (SETQ HOST-UNIT (SEND ACCESS :GET-HOST-UNIT))
		   (MULTIPLE-VALUE (DATA-CONN HOST-UNIT)
		     (SEND ACCESS :GET-DATA-CONNECTION DIRECTION)))
	     (UNWIND-PROTECT
		 (let ((success nil) (string nil))
		   (MULTIPLE-VALUE (PKT SUCCESS STRING)
		     (lexpr-send access :open-command host-unit (data-connection-handle)
				 file characters byte-size direction
				 if-exists if-exists-p if-does-not-exist options))
		   (SETQ STRING (STRING-APPEND STRING))
		   (AND PKT (CHAOS:RETURN-PKT PKT))
		   (COND ((NOT SUCCESS)
			  (SETQ NOT-ABORTED T)
			  (OR (NULL DATA-CONN)
			      (SETF (DATA-STREAM DATA-CONN DIRECTION) NIL))
			  (CONDITION-CASE-IF (NOT IF-DOES-NOT-EXIST)
					     ()
			      (CONDITION-CASE-IF (NOT IF-EXISTS)
						 ()
				  (QFILE-PROCESS-ERROR-NEW STRING PATHNAME NIL (NOT ERROR) :OPEN)
				(FILE-ALREADY-EXISTS NIL))
			    (FILE-NOT-FOUND NIL)))
			 (T (make-stream string))))
	       ;; cleanup forms of the unwind-protect
	       (UNLESS (OR NOT-ABORTED
			   (NULL DATA-CONN)
			   (NULL (SEND HOST-UNIT :CONTROL-CONNECTION)))
		 ;; Here if aborted out of it and server may have file open.
		 (CONDITION-CASE ()
		     (PROGN
		      (when (EQ DIRECTION :OUTPUT)
			(let ((pkt (SEND HOST-UNIT :COMMAND NIL (DATA-OUTPUT-HANDLE DATA-CONN) NIL "Delete"
					 "DELETE")))
			  (and pkt (chaos:return-pkt pkt))))
		      (multiple-value-bind (pkt success ignore)
			  (SEND HOST-UNIT :COMMAND NIL (data-connection-handle) NIL "Close" "CLOSE")
			(and pkt (chaos:return-pkt pkt))
			(WHEN success
			  (CASE DIRECTION
			    (:INPUT (READ-UNTIL-SYNCHRONOUS-MARK (DATA-CONNECTION DATA-CONN)))
			    (:OUTPUT (CHAOS:SEND-PKT (DATA-CONNECTION DATA-CONN)
						     (CHAOS:GET-PKT) %QFILE-SYNCHRONOUS-MARK-OPCODE)))))
		      (SEND HOST-UNIT :FREE-DATA-CONNECTION DATA-CONN DIRECTION))
		   (SYS:HOST-STOPPED-RESPONDING NIL))))))))

))

; From file DJ: L.NETWORK.CHAOS; QFILE.LISP#380 at 7-May-88 04:36:49
#8R FILE-SYSTEM#: #!:ZL
(COMPILER-LET ((*PACKAGE* (PKG-FIND-PACKAGE "FILE-SYSTEM")))
  (COMPILER::PATCH-SOURCE-FILE "SYS: NETWORK; CHAOS; QFILE  "

(DEFUN DIRECTORY-CHAOS (ACCESS PATHNAME OPTIONS
			&AUX (NO-ERROR-P NIL) (DELETED-P NIL) (FAST-P NIL) (DIRS-ONLY-P NIL)
			     (NO-EXTRA-INFO NIL) (SORTED-P NIL))
  (DO ((L OPTIONS (CDR L)))
      ((NULL L))
    (CASE (CAR L)
      (:NOERROR (SETQ NO-ERROR-P T))
      (:FAST (SETQ FAST-P T))
      (:NO-EXTRA-INFO
       (WHEN (NOT (TYPEP (SEND ACCESS :HOST) 'FS:UNIX-HOST))
	 (SETQ NO-EXTRA-INFO T)))
      (:SORTED (SETQ SORTED-P T))
      ;; This is for the :ALL-DIRECTORIES message
      (:DIRECTORIES-ONLY (SETQ DIRS-ONLY-P T))
      (:DELETED (SETQ DELETED-P T))
      (OTHERWISE (FERROR NIL "~S is not a known DIRECTORY option" (CAR L)))))
  (HANDLING-FILE-ERRORS ((NOT NO-ERROR-P))
    (MAKE-FILE-PROPERTY-LIST-STREAM-CHAOS ACCESS "DIRECTORY" "Directory"
      (FILE-PRINT-PATHNAME PATHNAME)
      (FORMAT NIL "~:[~; DELETED~]~:[~; FAST~]~:[~; DIRECTORIES-ONLY~]~:[~; NO-EXTRA-INFO~]~
		   ~:[~; SORTED~]"
	      DELETED-P FAST-P DIRS-ONLY-P NO-EXTRA-INFO SORTED-P)
      PATHNAME NO-ERROR-P)))

))

; From file DJ: L.NETWORK.CHAOS; QFILE.LISP#380 at 7-May-88 04:37:06
#8R FILE-SYSTEM#: #!:ZL
(COMPILER-LET ((*PACKAGE* (PKG-FIND-PACKAGE "FILE-SYSTEM")))
  (COMPILER::PATCH-SOURCE-FILE "SYS: NETWORK; CHAOS; QFILE  "

(DEFMETHOD (QFILE-DATA-STREAM-MIXIN :DELETE) (&OPTIONAL (ERROR-P T) &AUX SUCCESS STRING)
  (HANDLING-FILE-ERRORS (ERROR-P)
    (CASE STATUS
      ((:OPEN :EOF :SYNC-MARKED :ASYNC-MARKED)
       (MULTIPLE-VALUE (STRING SUCCESS)
	 (SEND SELF :COMMAND NIL "Delete" "DELETE"))
       (OR SUCCESS
	   (QFILE-PROCESS-ERROR-NEW STRING SELF NIL (NOT ERROR-P) :DELETE)))
      (OTHERWISE (FERROR NIL "~S in illegal state for delete." SELF)))))

))

; From file DJ: L.NETWORK.CHAOS; QFILE.LISP#380 at 7-May-88 04:37:17
#8R FILE-SYSTEM#: #!:ZL
(COMPILER-LET ((*PACKAGE* (PKG-FIND-PACKAGE "FILE-SYSTEM")))
  (COMPILER::PATCH-SOURCE-FILE "SYS: NETWORK; CHAOS; QFILE  "

(DEFMETHOD (QFILE-DATA-STREAM-MIXIN :RENAME) (NEW-NAME &OPTIONAL (ERROR-P T)
					     &AUX SUCCESS STRING)
  (HANDLING-FILE-ERRORS (ERROR-P)
    (CASE STATUS
      ((:OPEN :EOF :SYNC-MARKED :ASYNC-MARKED)
       (MULTIPLE-VALUE (STRING SUCCESS)
	 (SEND SELF :COMMAND NIL "Rename"
				 "RENAME" #/NEWLINE
				  (FILE-PRINT-PATHNAME NEW-NAME) #/NEWLINE))
       (COND (SUCCESS
	      ;; If there is a second line coming from the file server,
	      ;; it is the new truename.
	      (LET* ((FROM (STRING-SEARCH #/NEWLINE STRING)))
		(WHEN FROM
		  (send self :putprop (fs:parse-pathname
					string
					(send (get self :truename) :host) nil
					(1+ from) (string-search #/newline string (1+ from)))
			:truename)))
	      (SETQ PATHNAME NEW-NAME)
	      (SEND TV::WHO-LINE-FILE-STATE-SHEET :CLOBBERED)
	      T)
	     (T (QFILE-PROCESS-ERROR-NEW STRING SELF NIL (NOT ERROR-P) :RENAME))))
      (OTHERWISE (FERROR NIL "~S in illegal state for rename." SELF)))))

))

; From file DJ: L.NETWORK.CHAOS; QFILE.LISP#380 at 7-May-88 04:37:26
#8R FILE-SYSTEM#: #!:ZL
(COMPILER-LET ((*PACKAGE* (PKG-FIND-PACKAGE "FILE-SYSTEM")))
  (COMPILER::PATCH-SOURCE-FILE "SYS: NETWORK; CHAOS; QFILE  "

(DEFMETHOD (QFILE-DATA-STREAM-MIXIN :CHANGE-PROPERTIES)
	   (ERROR-P &REST PROPERTIES &AUX SUCCESS STRING)
  (HANDLING-FILE-ERRORS (ERROR-P)
    (CASE STATUS
      ((:OPEN :EOF :SYNC-MARKED :ASYNC-MARKED)
       (MULTIPLE-VALUE (STRING SUCCESS)
	 (SEND SELF :COMMAND NIL "Change Properties"
	       		      (CHANGE-PROPERTIES-STRING PROPERTIES)))
       (OR SUCCESS
	   (QFILE-PROCESS-ERROR-NEW STRING SELF NIL (NOT ERROR-P) :CHANGE-PROPERTIES)))
      (OTHERWISE (FERROR NIL "~S in illegal state for change properties." SELF)))))

))

; From file DJ: L.NETWORK.CHAOS; QFILE.LISP#380 at 7-May-88 04:37:56
#8R FILE-SYSTEM#: #!:ZL
(COMPILER-LET ((*PACKAGE* (PKG-FIND-PACKAGE "FILE-SYSTEM")))
  (COMPILER::PATCH-SOURCE-FILE "SYS: NETWORK; CHAOS; QFILE  "

(DEFMETHOD (BASIC-QFILE-ACCESS :MULTIPLE-FILE-PLISTS) (FILES OPTIONS)
  (HANDLING-FILE-ERRORS (T)
    (MULTIPLE-PLISTS-CHAOS SELF FILES OPTIONS)))

))

; From modified file DJ: L.NETWORK.CHAOS; QFILE.LISP#380 at 7-May-88 04:39:56
#8R FILE-SYSTEM#: #!:ZL
(COMPILER-LET ((*PACKAGE* (PKG-FIND-PACKAGE "FILE-SYSTEM")))
  (COMPILER::PATCH-SOURCE-FILE "SYS: NETWORK; CHAOS; QFILE  "

(DEFMETHOD (QFILE-STREAM-MIXIN :PROPERTIES) (&OPTIONAL (ERROR-P T))
  (HANDLING-FILE-ERRORS (ERROR-P)
    (IF (EQ STATUS :CLOSED)
	(PROPERTIES-CHAOS (SEND HOST-UNIT :ACCESS) :FILE (SEND SELF :TRUENAME) ERROR-P)
      (PROPERTIES-CHAOS (SEND HOST-UNIT :ACCESS) :STREAM SELF ERROR-P))))

))