;;; -*- Mode:Lisp; Readtable:ZL; Package:USER; Base:8; Patch-File:T -*-
;;; Patch file for System version 125.18
;;; Reason:
;;;  Cosmetic change to error strings as processed by QFILE-PROCESS-ERROR-NEW:
;;;  we now strip off any "."'s which appear at the end of qfile error
;;;  strings, as some of this function's callers expect to be able to append
;;;  text to the end of this returned string in constructing longer error
;;;  messages.
;;; Written 22-Jul-88 13:31:33 by saz (David M.J. Saslav) at site Gigamos Cambridge
;;; while running on Brahms' First from band 1
;;; with System 125.17, ZWEI 125.2, ZMail 73.0, Local-File 75.0, File-Server 24.0, Unix-Interface 13.0, Tape 24.1, Lambda-Diag 17.0, microcode 1761, SDU Boot Tape 3.14, SDU ROM 103, 7/19.



; From modified file DJ: L.NETWORK.CHAOS; QFILE.LISP#384 at 22-Jul-88 13:31:34
#8R FILE-SYSTEM#: 
(COMPILER-LET ((*PACKAGE* (PKG-FIND-PACKAGE "FILE-SYSTEM")))
  (COMPILER::PATCH-SOURCE-FILE "SYS: NETWORK; CHAOS; QFILE  "

(DEFUN QFILE-PROCESS-ERROR-NEW (STRING &OPTIONAL PATHNAME-OR-STREAM
			       PROCEEDABLE NOERROR &REST MAKE-CONDITION-ARGS
			       &AUX S-P ERROR-CODE ERROR-SEVERITY ERROR-STRING WHO-FOR
			       (DEFAULT-CONS-AREA SYS:BACKGROUND-CONS-AREA))
  (TYPECASE PATHNAME-OR-STREAM
    (PATHNAME (SETQ WHO-FOR PATHNAME-OR-STREAM))
    (SI:FILE-STREAM-MIXIN (SETQ WHO-FOR (SEND PATHNAME-OR-STREAM :PATHNAME)))
    (T (SETQ WHO-FOR PATHNAME-OR-STREAM)))
  (SETQ S-P (QFILE-CHECK-COMMAND "ERROR" STRING))
  (SETQ ERROR-CODE (SUBSTRING STRING S-P (SETQ S-P (STRING-SEARCH-CHAR #/SPACE STRING S-P))))
  (SETQ S-P (1+ S-P))
  (SETQ ERROR-SEVERITY
	(SUBSTRING STRING S-P (SETQ S-P (STRING-SEARCH-CHAR #/SPACE STRING S-P))))
  ;;Some file errors to which we wish to append more text have ugly periods attached.
  (SETQ ERROR-STRING (string-right-trim "." (NSUBSTRING STRING (1+ S-P) (STRING-LENGTH STRING))))
  (APPLY 'FILE-PROCESS-ERROR
	 (GET (INTERN ERROR-CODE (SYMBOL-PACKAGE 'FOO)) 'FS:FILE-ERROR)
	 ERROR-STRING PATHNAME-OR-STREAM PROCEEDABLE NOERROR MAKE-CONDITION-ARGS))

))