;;; -*- Mode:Lisp; Readtable:CL; Package:USER; Base:10; Patch-File:T -*-
;;; Private patches made by keith
;;; Reason:
;;;  LOAD-PATCHES now issues warning if run-time *PACKAGE* has a non-NIL package root.
;;;  (You might not want to proceed, since patches made under global root probably won't
;;;  work under, e.g., K root.)
;;; Written 9-Nov-88 18:45:51 by keith at site Gigamos Cambridge
;;; while running on Breaking Glass from band 3
;;; with Experimental ZWEI 126.28, Experimental ZMail 74.14, Experimental Local-File 76.0, Experimental File-Server 25.0, Experimental Lambda-Diag 18.0, Experimental Unix-Interface 15.0, Experimental Tape 26.4, Experimental System 129.1, Microcode 1762, SDU Boot Tape 3.14, SDU ROM 103, 11/04.



; From modified file DJ: L.SYS2; PATCH.LISP#191 at 9-Nov-88 18:46:04
#10R SYSTEM-INTERNALS#: 
(COMPILER-LET ((*PACKAGE* (PKG-FIND-PACKAGE "SYSTEM-INTERNALS")))
  (COMPILER::PATCH-SOURCE-FILE "SYS: SYS2; PATCH  "

(DEFUN LOAD-PATCHES (&REST OPTIONS &AUX TEM SOMETHING-CHANGED override-root-query-p)
  "Load any new patches for one or more systems.
Options can include these symbols:
 :NOSELECTIVE - don't ask about each patch.
 :SILENT or :NOWARN - don't print out any information on loading patches
   (and also don't ask).
 :VERBOSE - says to print out information about loading each patch.
   This is the default and is only turned off by :silent and :nowarn.
 :UNRELEASED - says to load or consider unreleased patches.
   Once unreleased patches have been loaded, a band may not be dumped.
 :FORCE-UNFINISHED - load all patches that have not been finished yet,
   if they have QFASL files.  This is good for testing patches.
 :NOOP - do nothing
 :SITE - load latest site configuration info.
 :NOSITE - do not load latest site configuration info.
   :SITE is the default unless systems to load patches for are specified.

Options can also include :SYSTEMS followed by a list of systems to load patches for.
One or more names of systems are also allowed.

LOAD-PATCHES returns T if any patches were loaded, otherwise NIL."
  (CATCH-ERROR-RESTART (SYS:REMOTE-NETWORK-ERROR
			 "Give up on trying to load patches.")
    (LET ((SYSTEM-NAMES NIL)			;A-list of systems to load patches for.
	  (SELECTIVE-P T)			;Ask the user.
	  (VERBOSE-P T)				;Tell the user what's going on.
	  (UNRELEASED-P NIL)
	  (SITE-SPECIFIED-P NIL)
	  (SITE-P T)
	  (FORCE-THROUGH-UNFINISHED-PATCHES-P NIL))
      (DO ((OPTS OPTIONS (CDR OPTS)))
	  ((NULL OPTS))
	(SELECTQ (CAR OPTS)
	  (:SYSTEMS
	   (SETQ OPTS (CDR OPTS))
	   (SETQ SYSTEM-NAMES
		 (IF (CONSP (CAR OPTS))
		     (MAPCAR #'GET-PATCH-SYSTEM-NAMED (CAR OPTS))
		   (LIST (GET-PATCH-SYSTEM-NAMED (CAR OPTS)))))
	   (UNLESS SITE-SPECIFIED-P
	     (SETQ SITE-P NIL)))
	  ((:SILENT :NOWARN) (SETQ VERBOSE-P NIL SELECTIVE-P NIL))
	  (:VERBOSE (SETQ VERBOSE-P T))
	  (:SELECTIVE (SETQ SELECTIVE-P T))
	  (:SITE (SETQ SITE-P T SITE-SPECIFIED-P T))
	  (:NOOP NIL)
	  (:NOSITE (SETQ SITE-P NIL SITE-SPECIFIED-P T))
	  (:UNRELEASED (SETQ UNRELEASED-P T))
	  (:NOSELECTIVE (SETQ SELECTIVE-P NIL))
	  (:FORCE-UNFINISHED (SETQ FORCE-THROUGH-UNFINISHED-PATCHES-P T))
	  (OTHERWISE
	    (COND ((AND (OR (SYMBOLP (CAR OPTS)) (STRINGP (CAR OPTS)))
			(SETQ TEM (GET-PATCH-SYSTEM-NAMED (CAR OPTS) T)))
		   (PUSH TEM SYSTEM-NAMES)
		   (UNLESS SITE-SPECIFIED-P
		     (SETQ SITE-P NIL)))
		  (T (FERROR "~S is neither a ~S option nor a system name."
				 (CAR OPTS) 'LOAD-PATCHES))))))
      ;;;Check that we're in global package root:
      (let ((root (si:pkg-root *package*)))
	(when (and root (null override-root-query-p))
	  (cerror "Proceed to load patches within ~A package root" 
		  "The current package root is ~A.  ~&~
                   Loading patches made for a different package root will probably not work.~&~
                   Proceed with caution, only if you know this will work." root)
	  (setq override-root-query-p t)))
      (WITH-SYS-HOST-ACCESSIBLE
	(LET-IF VERBOSE-P ((TV:MORE-PROCESSING-GLOBAL-ENABLE NIL))
	  (WHEN SITE-P
	    (WHEN VERBOSE-P
	      (FORMAT T "~%Checking whether site configuration has changed..."))
	    (IF (IF SELECTIVE-P
		    (MAKE-SYSTEM "SITE" :NO-RELOAD-SYSTEM-DECLARATION)
		  (IF VERBOSE-P
		      (MAKE-SYSTEM "SITE" :NOCONFIRM :NO-RELOAD-SYSTEM-DECLARATION)
		      (MAKE-SYSTEM "SITE" :NOCONFIRM :NO-RELOAD-SYSTEM-DECLARATION :SILENT)))
		(SETQ SOMETHING-CHANGED T)
	      (WHEN VERBOSE-P (FORMAT T "  it hasn't.")))
	    (LOAD-PATCHES-FOR-LOGICAL-PATHNAME-HOSTS))
	  (OR SYSTEM-NAMES (SETQ SYSTEM-NAMES (SUBSET #'(LAMBDA (X)
							  (NOT (MEMQ X FROZEN-PATCH-SYSTEMS-LIST)))
						      PATCH-SYSTEMS-LIST)))
	  (DOLIST (X SYSTEM-NAMES)
	    (WHEN (MEMQ X FROZEN-PATCH-SYSTEMS-LIST)
	      (FORMAT T "~&Note: Patch System ~S is frozen. There should be no need to load patches from it.~%"
		      (PATCH-NAME X))))
	  (setq something-changed (or (load-patches-for-systems system-names selective-p verbose-p unreleased-p
								force-through-unfinished-patches-p)
				      something-changed))))))
  SOMETHING-CHANGED)

))