;;; -*- Mode:Lisp; Readtable:ZL; Package:USER; Base:8; Patch-File:T -*-
;;; Patch file for System version 125.17
;;; Reason:
;;;  Rationalize treatment of various READer end-of-file conditions.
;;;  
;;;  1. Packages not followed by symbols -- reading things like "foo:" used
;;;  to blow up with a datatype comparison error from (=) . [I type things
;;;  like that a lot when I stay up too late.]  Now, signals a CERROR, so in a
;;;  listener it just prompts "EOF after package prefix".
;;;  
;;;  2. Used to be, all READ-END-OF-FILE errors had the proceed option that said,
;;;  "Close off all unfinished lists."  What a crock - that hardly applies to strings
;;;  and (now) unterminated symbols.  I defined flavors and separate :NO-ACTION proceed
;;;  methods for these other read-end-of-file types.  Now:
;;;  
;;;  a) with an unterminated string, readers offer to return the null string.
;;;  That's what you got before.
;;;  b) with an unterminated symbol, readers offer to return NIL.  
;;;  That's new.
;;;  c) with an unterminated list, you get the same behavior as before.
;;; Written 22-Jul-88 06:54:43 by keith (Keith Corbett) at site Gigamos Cambridge
;;; while running on Breaking Glass from band 2
;;; with System 125.16, ZWEI 125.2, ZMail 73.0, Local-File 75.0, File-Server 24.0, Unix-Interface 13.0, Tape 24.0, Lambda-Diag 17.0, microcode 1762, SDU Boot Tape 3.14, SDU ROM 103, 7/21/88.



; From modified file DJ: L.IO; READ.LISP#466 at 22-Jul-88 06:54:44
#8R SYSTEM-INTERNALS#: 
(COMPILER-LET ((*PACKAGE* (PKG-FIND-PACKAGE "SYSTEM-INTERNALS")))
  (COMPILER::PATCH-SOURCE-FILE "SYS: IO; READ  "

(DEFUN (:PROPERTY PACKAGE-PREFIX STANDARD-READ-FUNCTION) (STREAM STRING IGNORE)
  (PROG (THING PK
	 ;; Help un-screw the user if *PACKAGE* gets set to NIL.
	 (*PACKAGE* (OR *PACKAGE* PKG-USER-PACKAGE))
	 INTERNAL-OK ENTIRE-LIST-PREFIXED)
	;; Gobble the second colon, if any, and set flag if found.
	;; Note that we do not, currently, DO anything with the flag!
	(MULTIPLE-VALUE-BIND (CH NUM REAL-CH)
	    (XR-XRTYI STREAM NIL T)
	  (if (null ch)
	      (return (cerror :no-action nil 'read-symbol-end-of-file
			  "EOF after package prefix"))
	    (IF (= CH #/:)
		(SETQ INTERNAL-OK T)
	      (IF (= CH #/()
		  (SETQ ENTIRE-LIST-PREFIXED T))
	      (XR-XRUNTYI STREAM REAL-CH NUM))))
	;; Try to find the package.
	;;don't try to find packages if we're not interning -- eg #+slime (dis:foo)
	(UNLESS *READ-SUPPRESS*
	  (DO ((STRING1 (OR STRING "")))
	      ((SETQ PK (FIND-PACKAGE STRING1 *PACKAGE*)))
	    ;; Package not found.
	    (SIGNAL-PROCEED-CASE ((PKG) 'READ-PACKAGE-NOT-FOUND
					"Package ~S does not exist."
					STRING1)
	      (:NO-ACTION
	       (RETURN))
	      (:NEW-NAME
	       (LET ((*PACKAGE* PKG-USER-PACKAGE))
		 (SETQ STRING1 (STRING (READ-FROM-STRING PKG)))))
	      (:CREATE-PACKAGE
	       (OR (FIND-PACKAGE STRING1 *PACKAGE*)
		   (MAKE-PACKAGE STRING1))))))
	(OR PK (SETQ PK PKG-USER-PACKAGE))
	(WHEN STRING (RETURN-READ-STRING STRING))
	(LET ((*PACKAGE* PK)
	      (*INHIBIT-READER-SYMBOL-SUBSTITUTION* T)
	      (READ-INTERN-FUNCTION (COND ((OR (AND (PKG-AUTO-EXPORT-P PK)
						    (PACKAGE-USED-BY-LIST PK)
						    *read-barf-if-auto-export?*)
					       (PKG-READ-LOCK-P PK))
					   'READ-INTERN-SOFT)
					  ((OR ENTIRE-LIST-PREFIXED (EQ PK *PACKAGE*))
					   ;; Here for, e.g., SI: while in SI already.
					   ;; Also here for ZWEI:(BP-LINE (POINT));
					   ;; such constructs are not valid Common Lisp
					   ;; so let's keep their meaning the same.
					   READ-INTERN-FUNCTION)
					  ((OR INTERNAL-OK
					       (PKG-AUTO-EXPORT-P PK)
					       (EQ *READ-SINGLE-COLON-ALLOW-INTERNAL-SYMBOL* T))
					   'INTERN)
					  (T
					   'READ-PACKAGE-PREFIX-EXTERNAL-INTERN))))
	  (SETQ THING (INTERNAL-READ STREAM T NIL T)))
	(RETURN (VALUES THING
			(TYPE-OF THING)
			T))))	;T means we already did RETURN-READ-STRING

))

; From modified file DJ: L.DEBUGGER; EHF.LISP#294 at 22-Jul-88 07:20:23
#8R EH#: 
(COMPILER-LET ((*PACKAGE* (PKG-FIND-PACKAGE "EH")))
  (COMPILER::PATCH-SOURCE-FILE "SYS: DEBUGGER; EHF  "


(defflavor read-end-of-file () (end-of-file parse-error))

(defmethod (read-end-of-file :case :proceed-asking-user :no-action) (continuation ignore)
  "Ignore unterminated input."
  (funcall continuation :no-action))

(defsignal read-end-of-file (read-end-of-file read-error) (stream)
  "End of file within READ on STREAM.
SYS:READ-LIST-END-OF-FILE or SYS:READ-STRING-END-OF-FILE should be used
if they apply.")

(defflavor read-list-end-of-file () (read-end-of-file))

(defmethod (read-list-end-of-file :case :proceed-asking-user :no-action) (continuation ignore)
  "Close off unfinished lists."
  (funcall continuation :no-action))

(defsignal read-list-end-of-file (read-list-end-of-file read-error read-end-of-file)
	   (stream list)
  "End of file within READ constructing a list, on STREAM.
LIST is the list constructed so far.")

(defflavor read-string-end-of-file () (read-end-of-file))

(defmethod (read-string-end-of-file :case :proceed-asking-user :no-action) (continuation ignore)
  "Return null string."
  (funcall continuation :no-action))

(defsignal read-string-end-of-file (read-string-end-of-file read-error read-end-of-file)
	   (stream string)
  "End of file within READ constructing a string, on STREAM.
STRING is the string read so far.")

(defflavor read-symbol-end-of-file () (read-end-of-file))

(defmethod (read-symbol-end-of-file :case :proceed-asking-user :no-action) (continuation ignore)
  "Treat unterminated symbol as NIL."
  (funcall continuation :no-action))

(defsignal read-symbol-end-of-file (read-symbol-end-of-file read-end-of-file read-error)
	   (stream string)
  "End of file within READ constructing a symbol, on STREAM.
Occurs only within a vertical-bar construct.  STRING is the string read so far.")

))

; From modified file DJ: L.DEBUGGER; EHF.LISP#295 at 22-Jul-88 12:44:56
#8R EH#: 
(COMPILER-LET ((*PACKAGE* (PKG-FIND-PACKAGE "EH")))
  (COMPILER::PATCH-SOURCE-FILE "SYS: DEBUGGER; EHF  "

(compile-flavor-methods
 read-end-of-file
 read-end-of-file-list
 read-end-of-file-string
 read-end-of-file-symbol
 )

))
