;;; -*- Mode:Lisp; Readtable:CL; Package:USER; Base:10; Patch-File:T -*-
;;; Patch file for System version 126.56
;;; Reason:
;;;  Improve interface to SI:MAYBE-SET-SYSTEMS-RELEASED.
;;;  
;;;  This gets called when we do a full GC in mode :SYSTEM-RELEASE, typically
;;;  when the system status is changing.  Now, prompt to release some, all,
;;;  or none of the patchable systems.  Also offer to set the system release
;;;  status (printed by PRINT-HERALD) to any of the stanard values.
;;; Written 17-Aug-88 17:10:41 by keith (Keith Corbett) at site Gigamos Cambridge
;;; while running on Breaking Glass from band 2
;;; with Experimental System 126.55, ZMail 73.2, Local-File 75.2, File-Server 24.1, Unix-Interface 13.0, Tape 24.2, Lambda-Diag 17.0, Experimental ZWEI 126.0, microcode 1762, SDU Boot Tape 3.14, SDU ROM 103.



; From modified file DJ: L.SYS; LAST.LISP#2 at 17-Aug-88 17:10:42
#10R SYSTEM-INTERNALS#: 
(COMPILER-LET ((*PACKAGE* (PKG-FIND-PACKAGE "SYSTEM-INTERNALS")))
  (COMPILER::PATCH-SOURCE-FILE "SYS: SYS; LAST  "

(defun maybe-set-systems-released ()
  ;;Status of patchable systems
  (let ((systems-to-release nil) answer)
    (dolist (s patch-systems-list)
      (and (neq (patch-status s) :released)
	   (push s systems-to-release)))
    (when (setq answer
		(and systems-to-release
		     (fquery `(:type :tyi :choices (((:all "All")   #\A)
						    ((:some "Some") #\S)
						    ((nil "None")   #\N))
				     :clear-input t
				     :timeout ,(* 5 60 60)
				     :default-value nil)
			     "Release patchable systems? ")))
      (dolist (s (nreverse systems-to-release))
	(when (or (eq answer :all)
		  (let ((proceed
			  (fquery `(:type :tyi :choices (((t "Yes")      #\Y)
							 ((nil "No")     #\N)
							 ((:quit "Quit") #\Q)
							 ((:proceed "Proceed") #\P))
					  :clear-input t
					  :timeout ,(* 2 60 60)
					  :default-value nil)
				  "~A ~A (version ~D.~D)~&  Release it? "
				  (patch-status s)
				  (patch-name s)
				  (patch-version s)
				  (version-number (first (patch-version-list s))))))
		    (case proceed
		      (:quit (return))
		      (:proceed (setq answer :all)))
		    proceed))
	  (set-system-status (patch-name s) :released)
	  (format t "~A. ~&Released" (patch-name s))))))
  ;;Status keyword
  (when (yes-or-no-p-with-timeout (* 5 60 60) nil
				  "~2&Current release status is ~S.  Change it ?"
				  si:*release-status*)
    (let* ((statuslist  '(:development :released :alpha :beta :obsolete))
	   (choices (loop for status in statuslist
			  as str = (format nil "~1(~A~)" status)
			  collect (list
				    (list status str)
				    (char str 0)))))
      (format t "~%The release status should be one of the following:~%~{~%~3T- ~1(~A~)~}" statuslist)
      (setq si:*release-status*
	    (fquery `(:type :tyi
		      :choices ,choices
		      :clear-input t
		      :timeout ,(* 2 60 60)
		      :default-value :released)
		    "~%Set release status - specify first character: "))))
  (format t "~2&")
  ;;Show results
  (print-herald)
  nil)

))