;;; -*- Mode:Lisp; Readtable:ZL; Package:USER; Base:8; Patch-File:T -*-
;;; Patch file for System version 130.10
;;; Reason:
;;;  When recording source file names, don't query about redefinitions
;;;  between two files with same generic name, e.g. "FOO.LISP" and
;;;  "FOO.FDEF".  (Eliminates warnings while loading Falcon FDEF files.)
;;; Written 22-Nov-88 18:30:09 by keith (Keith Corbett) at site Gigamos Cambridge
;;; while running on Breaking Glass from band 3
;;; with Experimental System 130.7, Experimental ZWEI 128.7, Experimental ZMail 75.0, Experimental Local-File 77.0, Experimental File-Server 26.0, Experimental Unix-Interface 16.0, Experimental Tape 27.0, Experimental Lambda-Diag 19.0, Microcode 1762, SDU Boot Tape 3.14, SDU ROM 103, 11/18 Falcon System Loaded.



; From modified file DJ: L.SYS; QRAND.LISP#526 at 22-Nov-88 18:30:10
#8R SYSTEM-INTERNALS#: 
(COMPILER-LET ((*PACKAGE* (PKG-FIND-PACKAGE "SYSTEM-INTERNALS")))
  (COMPILER::PATCH-SOURCE-FILE "SYS: SYS; QRAND  "

(DEFUN RECORD-SOURCE-FILE-NAME (FUNCTION-SPEC
				&OPTIONAL (TYPE 'DEFUN)
					  (NO-QUERY (EQ INHIBIT-FDEFINE-WARNINGS T))
				&AUX (DEFAULT-CONS-AREA BACKGROUND-CONS-AREA))
  "Record a definition of FUNCTION-SPEC, of type TYPE, in the current source file.
The source file's generic-pathname is found in FDEFINE-FILE-PATHNAME.
FUNCTION-SPEC is actually only a function spec if TYPE is 'DEFUN,
which is the default.  If TYPE is 'DEFVAR, the first arg is a variable name, etc.
NO-QUERY inhibits warnings about redefinition in a different file.

The value is T if you should go ahead and perform the definition,
NIL if the user was asked and said no."
  ;; When defining a function in a patch, record it as coming
  ;; from its real source file.  So the editor knows where to find it.
  (IF (AND FS:THIS-IS-A-PATCH-FILE PATCH-SOURCE-FILE-NAMESTRING)
      (LET* ((FDEFINE-FILE-DEFINITIONS NIL)
	     (FDEFINE-FILE-PATHNAME
	       (SEND (FS:PARSE-PATHNAME PATCH-SOURCE-FILE-NAMESTRING) :GENERIC-PATHNAME))
	     (PATCH-SOURCE-FILE-NAMESTRING NIL)
	     (PKG-SPEC (SEND FDEFINE-FILE-PATHNAME :GET :PACKAGE))
	     (*PACKAGE* (OR (PKG-FIND-PACKAGE PKG-SPEC :FIND) *PACKAGE*)))
	;; Record the source file as having defined this function.
	;; THIS-IS-A-PATCH-FILE is still set, to prevent querying,
	;; but PATCH-SOURCE-FILE-NAMESTRING is not, so we don't recurse forever.
	(RECORD-SOURCE-FILE-NAME FUNCTION-SPEC TYPE NO-QUERY)
	;; Add the function to the source's list of definitions.
	(RECORD-FILE-DEFINITIONS FDEFINE-FILE-PATHNAME FDEFINE-FILE-DEFINITIONS
				 NIL FDEFINE-FILE-PATHNAME)))
  (LET ((PATHNAME FDEFINE-FILE-PATHNAME)
	(DEF (CONS-IN-AREA FUNCTION-SPEC TYPE BACKGROUND-CONS-AREA))
	(PROPERTY (FUNCTION-SPEC-GET FUNCTION-SPEC :SOURCE-FILE-NAME)))
    (OR (NULL FDEFINE-FILE-PATHNAME)
	(MEMBER-EQUAL DEF FDEFINE-FILE-DEFINITIONS)
	(SETQ FDEFINE-FILE-DEFINITIONS
	      (CONS-IN-AREA DEF FDEFINE-FILE-DEFINITIONS BACKGROUND-CONS-AREA)))
    (COND ((AND (NULL PROPERTY)			;Check most common case first
		(EQ TYPE 'DEFUN))
	   ;; We don't record the keyboard as a "source file"
	   ;; so things like the editor don't get confused.
	   (IF FDEFINE-FILE-PATHNAME
	       (FUNCTION-SPEC-PUTPROP FUNCTION-SPEC PATHNAME :SOURCE-FILE-NAME))
	   T)
	  ((IF (ATOM PROPERTY)
	       (AND (EQ TYPE 'DEFUN) (EQ PATHNAME PROPERTY))
	     (EQ PATHNAME (CADR (ASSQ TYPE PROPERTY))))
	   T)					;This pathname already known
	  (T
	   (AND PROPERTY (ATOM PROPERTY)
		(SETQ PROPERTY `((DEFUN ,PROPERTY))))
	   (LET ((THIS-TYPE (ASSQ TYPE PROPERTY))
		 (OLD-FILE))
	     (COND ((COND ((NULL THIS-TYPE)
			   (IF FDEFINE-FILE-PATHNAME
			       (SETQ THIS-TYPE `(,TYPE)
				     PROPERTY (NCONC PROPERTY
						     (NCONS THIS-TYPE))))
			   T)
			  (NO-QUERY T)
			  (FS:THIS-IS-A-PATCH-FILE T)
			  ((AND (NOT FDEFINE-FILE-PATHNAME)
				(MEMBER-EQUAL FUNCTION-SPEC NON-FILE-REDEFINED-FUNCTIONS))
			   ;; If user has ever confirmed redefining this fn from the kbd,
			   ;; it is ok to do so again.
			   T)
			  ;; Before format is loaded, don't bomb out trying to query.
			  ((NOT (FBOUNDP 'FQUERY)) T)
			  ;; If all the old definitions are from patch files, don't query.
			  ((NULL (SETQ OLD-FILE
				       (LOOP FOR FILE IN (CDR THIS-TYPE)
					  UNLESS (OR (STRINGP FILE)	;During QLD
						     (SEND FILE :GET :PATCH-FILE))
					    RETURN FILE)))
			   T)
			  ((and (typep pathname 'fs:pathname) ;never query during cold-load
				;; $$$ Don't query about redefinitions between
				;; two files with same generic name,
				;; e.g. "FOO.LISP" and "FOO.FDEF". <22-Nov-88 keith>
				(or (eq (send pathname :generic-pathname)
					(send old-file :generic-pathname))
				    (QUERY-ABOUT-REDEFINITION FUNCTION-SPEC PATHNAME TYPE
							      OLD-FILE)))
			   ;; Though we don't record the keyboard as a "source file",
			   ;; once the user confirms redefining a certain function
			   ;; from the keyboard, we don't ever ask about it again.
			   (UNLESS FDEFINE-FILE-PATHNAME
			     (PUSH FUNCTION-SPEC NON-FILE-REDEFINED-FUNCTIONS))
			   T))
		    ;; We don't record the keyboard as a "source file"
		    ;; so things like the editor don't get confused.
		    (WHEN FDEFINE-FILE-PATHNAME
		      (SETF (CDR THIS-TYPE)
			    (CONS PATHNAME (DELQ PATHNAME (CDR THIS-TYPE))))
		      (FUNCTION-SPEC-PUTPROP FUNCTION-SPEC PROPERTY :SOURCE-FILE-NAME))
		    T)
		   (T NIL)))))))

))