;;; -*- Mode:LISP; Package:TAPE; Readtable:CL; Base:10 -*-
;;
;; Copyright LISP Machine, Inc. 1986
;;   See filename "Copyright" for
;; licensing and release information.
;;;
;;; User level lisp code  (Primary user interface layer.)
;;;
;;; -dg 10/4/85
;;; -keith 7/25/88
;;;    Added install-distribution-option-list
;;;    Moved INSTALL stuff to INSTALLATIONS.LISP
;;;

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;
;;; Automated Distribution Tape Installation
;;;

(defmacro distribution-installation-forms (&rest body)
  `(progn . ,body))

(defun install-distribution-tape (&key
				  (device-spec *selected-device*)
				  (format-spec *selected-format*)
				  &aux distribution-form)
  (using-device (device device-spec)
    (using-format (format format-spec)
      (with-open-stream (tape-stream (send format :open-file device))
	(when (string-equal (send tape-stream :type) "DISTRIBUTION")
	  (format t "~&Reading distribution header.")
	  (let* ((*package* (pkg-find-package 'TAPE))
		 (*read-base* 10.)
		 (*readtable* si:common-lisp-readtable))
	    (setq distribution-form (catch-error (read tape-stream))))))
      (cond ((eq (car-safe distribution-form) 'distribution-installation-forms)
	     (format t "~&Running the product specific distribution procedure.")
	     (eval distribution-form))
	    ((eq (car-safe distribution-form) 'install-distribution-option-list)
	     (format t "~&Installing the distributed software systems.")
	     (apply #'install-distribution-option-list (rest distribution-form)))
	    ('else
	     (format t "~&The mounted tape is not a distribution tape."))))))

;;;Installing from lists of options

(defun install-distribution-option-list (tapename herald check-form options &optional (tape-sorted-p t))
  "TAPENAME is a short-name, a string, that describes the tape.
HERALD is a long string to print at the beginning of the installation.
CHECK-FORM is a LISP form that must evaluate non-NIL, or the installation is aborted.
OPTIONS is an association list of information regarding the options on the tape.
TAPE-SORTED-P says whether the files on tape are definitely in pathname order:
  - If NIL, program has to search entire tape;
  - If T, program knows when it can stop restoring."
  ;;;
  (declare (zwei:indentation 1 0 2 2))
  ;;;
  (send terminal-io :send-if-handles :clear-window)
  (format t "~a" herald)
  (cond
    ;;Make sure the user is installing the product he thought s/he was
    ;;going to install, and run the CHECK-FORM; abort if appropriate.
    ((or (not (y-or-n-p "~&Is ~A the product you wanted to install?" tapename))
	 (not (eval check-form)))
     (format t "~&~
*****************************~%~
**  INSTALLATION ABORTING  **~%~
*****************************~%")
     (tape:rewind))
    ('else
    ;;Do the installation.
     ;;Setup the listener:
     (install-distribution-option-list-2 options))))

(defstruct (tape-option-list (:type :list) (:conc-name "OPT"))
  name do system text when)

(defsubst optname (option)
  (if (atom (first option))
      (first option)
    (first (first option))))

(defsubst optdir (option)
  (cons 'RELEASE-4
	(if (atom (first option))
	    (ncons(first option))
	  (rest(first option)))))

(defun install-distribution-option-list-2 (options)
  (send-if-handles *standard-output* :set-more-p t)
  (block install-script
    (tagbody
     start-install-options
	(let
	   ;;;;;Parameters you can modify to change this program:
	  (??debug?? nil)			;Verbose mode for debugging
	  ;;;;;Vars whose values we set but user may change (under certain conditions):
	  (*host* (send (fs:get-pathname-host "SYS") :host))
	  (load-requires-restore-p t)		;Do files need to be restored?
	  ;;;;;Installation state vars
	  (selected nil)			;Option/choice alist from menu
	  (selected-something-p nil)	;Did user actually select anything?
	  (aborted nil)				;Did user abort from menu?
	  (commands-to-eval nil)		;Generated commands to be EVAL'd 
	  (systems-to-copy nil)			;System def files to copy into SYS:SITE;
	  (directories-to-restore nil)		;Directories to be restored
	  (directories-pending nil)		;Directories not [already or in process of being] restored
	  ;;;;;Status/control vars
	  (normal-completion nil)		;Flag - did we terminate normally?
	  (phase 0)				;Sequential phase of installation we're in
	  (catch-last-directory			;Throw tag - escape when done with tape
	    'catch-last-directory)
	  )
	;;;Local functions
	(labels(
		(abort-install(&optional fmt &rest args)
			      (warn "Aborting installation~@[~%   [~a]~]"
				    (if fmt (apply #'format nil fmt args)))
			      (return-from install-script))
		(wait-for-proceed ()
				  (format t "~2%Type any character to proceed:")
				  (read-char)
				  (format t "Ok~&"))
		   (read-carefully ()
				   (format t "~2%Please read the text above carefully")
				   (dotimes(i 6) (format t ".") (sleep 1 "Read carefully")))
		   (debugf (fmt &rest args)
			   (if ??debug??
			       (apply #'format t fmt args)))
		   (phasen (fmt &rest args)
			   (unless (zerop phase) (wait-for-proceed))
			   (incf phase)
			   (send-if-handles *standard-output* :clear-window)
			   (format t "~%**** Phase ~d: ~a **** ~2%" phase
				   (apply #'format fmt args)))
		   (phaseskip() (format t "[Skipping phase ~d]" phase))
		   (directory-under-p (got want)
				      (cond
					((null want) t)
					((null got) nil)
					((string-equal (car got)(car want))
					 (directory-under-p (cdr got) (cdr want)))))
		   (directory-check (dir wanted)
				    ;;This is how we know to stop restoring a sorted tape:
				    (when tape-sorted-p
				      (cond
					(wanted
					 (debugf "~%Removing ~s from ~s " dir
						 directories-pending)
					 (setq directories-pending
					       (remove dir directories-pending :test #'equal))
					 (debugf "...leaves ~s" directories-pending))
					((null directories-pending)
					 (when catch-last-directory
					   (throw catch-last-directory)))))
				    wanted)
		   (directory-wanted-p (got want &aux result)
				       (directory-check got
							(directory-under-p got want))))

		   ;;;
		   ;;;Begin installation
		   ;;;
		   (phasen "Introduce software options available on this distribution tape")
		   (format t "~%
There are multiple software options included in this distribution.  You will
be presented with a menu; you can choose which options, if any, to restore
and/or load. 
\
The available options are:~2%")
		   (mapcar #'(lambda(option)
			       (format t "~&  ~35a - ~a"
				       (optname option)
				       (opttext option)))
			   options)
		   (when (y-or-n-p
			   "~2%Do you want an explanation of each option?")
		     (mapcar #'(lambda(option)
				 (format t "~2%~a: ~a"
					 (optname option) (opttext option))
				 (format t "~%~a~&" (optwhen option)))
			     options))

		   (phasen "Installation parameters")
		   ;;;
		   ;;;What is the sys host?
		   ;;;
		   (format t "~2%
Distributed software files must be restored to the SYS HOST.  On a
multi-host Lambda network, the SYS HOST is one particular Lambda host
that acts as a central location for system and site files.")
		   (format t "~2%Your SYS HOST is the physical host named `~a'" *host*)
		   (setq *host*
			 (do((host *host*)
			     (times 0)
			     (dontparse t))
			    ((and (not dontparse) (si:parse-host host t))
			     (prog1
			       (setq host (si:parse-host host))
			       (format t "~%OK - restore option files to ~a" host)))
			   (cond
			     ((eq host :abort)
			      (abort-install "cannot determine SYS HOST"))
			     ((> times 5)
			      (if (y-or-n-p "Do you want to abort the installation?")
				  (setq host :abort)
				(setq times 0)))
			     ((null host)
			      (setq host
				    (or 
				      (prompt-and-read
					:string-or-nil
					"~&Enter a different host name, ~
                        or just press <Return> or <End> to abort the installation: ")
				      :abort))
			      (setq dontparse t))
			     ((null (si:parse-host host t))
			      (beep)
			      (format t "~%But `~a' is not the name of a known host." host)
			      (setq host nil)
			      (incf times))
			     ((y-or-n-p "Is `~a' the host you want to restore option files to?"
					(si:parse-host host))
			      (setq dontparse nil))
			     (t (setq host nil)))))
		   ;;;
		   ;;;Can user load without restoring? 
		   ;;;
		   (format t "~2%
In the normal course of selecting software options, you choose whether to
restore the files; for some options, you can also load the software. 
\
 RESTORE  == [copy from tape to disk]
 LOAD     == [load files into LISP as executable code]
\
Of course you must restore the files for each software option before you
can load the software into LISP.
\
If this is your first pass through this installation procedure, you must
choose to restore files for any option you select.
\
But if you have previously restored all the options files you need, and
if you are performing this installation only to LOAD options, you need
not be restricted. 
\
In other words, at the next prompt, answer:
\
   `YES' if you already restored the files for each option you will select. 
\
   `NO'  if you have not restored the selected software options, or
         if you are loading a new set of options, or
         if you are not certain.")
		   (read-carefully)
		   (setq load-requires-restore-p
			     (not(yes-or-no-p "Have you previously restored all required files?")))
		   (if load-requires-restore-p
		       (format t "~%OK - you must restore files in order to load options.")
		     (format t "~%OK - you can choose to load options without restoring files."))

		   ;;
		   ;;Present options menu
		   ;;
		   (phasen "Select software options")
		   (format t "~2%
Now make your selections with the following menu.  Use the mouse to click
the boxes under the columns to indicate whether you want the option
restored and, optionally, loaded.")
		   (read-carefully)
		   (multiple-value-setq(selected aborted)
		     (tv:multiple-choose
		       "Software Options"
		       (loop for option in options
			     as name = (optname option)
			     collect
			     (list name
				   (format nil "~:(~a~)" name)
				   (if (optdo option) '(restore load) '(restore))))
		       `((restore "Restore files" nil nil nil ,load-requires-restore-p)
			 (load "Load into world"  ,load-requires-restore-p nil nil nil))))
		   (loop for choice in selected
			 ;;Set flag - something to do?? 
			 (setq selected-something-p
			       (or selected-something-p
				   (or (cdr choice)))))

		   ;;;Got item/choices alist `selected'
		   (unless
		     (cond
		       (aborted
			(format t "~%You aborted out of the choice menu... "))
		       ((or (null selected) (null selected-something-p))
			(format t "~%You didn't select any options... "))
		       (t t))
		     (beep)
		     (if (y-or-n-p "Do you really want to quit?")
			 (abort-install "user exited menu")
		       (go start-install-options)))
		   ;;If they want MEDIUM-RES, they need HACKS
		   (let((medium-res (cdr(assoc 'medium-resolution-color selected)))
			(hacks      (assoc 'hacks selected)))
		     (when medium-res
		       (setq hacks (or hacks (car(push (ncons 'hacks) selected))))
		       (unless (cdr hacks)
			 (format t "~%
**Note: you selected Medium-Resolution-Color, which requires the HACKS [`DEMO'] system."))
		       (rplacd (last hacks) (copy-list medium-res))))
		   ;;If they want any systems to MAKE-SYSTEM, they need CUSTOMER-SITE
		   (let((systems (count-if 
				   #'(lambda(choice &aux option)
					 (and (cdr choice)
					      (setq option (find (car choice) options
									:key #'optname))
					      (optsystem option)))
				   selected))
			(sitefiles (assoc 'customer-site selected)))
		     (when (plusp systems)
		       (setq sitefiles (or sitefiles
					   (car (push (ncons 'customer-site)
						      selected))))
		       (unless (cdr sitefiles)
			 (format t "~%
**Note: you selected some system~p requiring the CUSTOMER-SITE files,
which include the optional system definition files."
				 systems)
			 (when (or (y-or-n-p
				   "Do you want to restore the CUSTOMER-SITE files from tape?")
				 (not (y-or-n-p
					"Are you absolutely sure the system definition files are
located in your SYS:SITE; directory??")))
			   (format t "~%Ok - we will restore CUSTOMER-SITE.")
			   (rplacd (last sitefiles) (ncons 'restore))))))

		   ;;;Review options, setup todo lists
		   (loop for choice in selected
			 as choicename = (car choice)
			 as restore = (member 'restore (cdr choice))
			 as load = (member 'load (cdr choice))
			 as option = (find choicename options :key #'optname)
			 as optname = (optname option)
			 as optdir = (optdir option)
			 as optsystem = (optsystem option)
			 as optdo = (optdo option)
			 do
			 (debugf "~%Choice=~s,~@[ restore~]~@[ load~]" choicename restore load)
			 (debugf "~%  Name=~s, dir=~s, system=~s, do=~s" optname optdir optsystem optdo)
			 (if (null option)
			     (warn "Bug in options installation??? Skipping choice ~a!"
				   (or (catch-error (string choicename) nil) choice))
			 (when (or restore load)
			   (when (and restore optdir)
			     (setq optdir (mapcar #'string optdir))	;Dir-list elts are strings!!!
			     (push optdir directories-to-restore)
			     (push optdir directories-pending))
			   (when (and load optdo)
			     (push optdo commands-to-eval)
			     (debugf "~%Command to eval: ~s" optdo))
			   (when (and load optsystem)
			     (push (if (eq optsystem t) optname optsystem)
				   systems-to-copy)
			     (debugf "~%System to copy=~a" (car systems-to-copy)))
			   (format t "~%For ~a: " optname)
			   (format t "~@[restore ~s~]~@[~* + ~]~@[load via ~s~]"
				 (and restore optdir)
				 (and restore load)
				 (and load optdo)))))
		   (unless (yes-or-no-p "~2%Do you want to restore/load as listed above [NO means abort installation] ?")
		     (abort-install))

		   ;;;Site files... system files... 
		   (phasen "Assure system definition files are available")
		   (if (null systems-to-copy)
		       (phaseskip)
		     (progn
		       (format t "~%
To load some system~P you selected, we must copy the corresponding system
definition file~:P into your site file directory.  But, it is important to
determine at this time whether your site files are set up for release 4."
			       (length systems-to-copy))
		       ;;Try to figure out the state of the site files
		       (let*((current-site (fs:translated-pathname
					     (pathname "SYS:SITE;*.*#>")))
			     (trans-srcs (fs:translated-pathname
					   (pathname "SYS:SOMEWHERE;*.*#>")))
			     (trans-dir (pathname-directory trans-srcs))
			     (src-dir (if (atom trans-dir)
					  (ncons trans-dir)
					(butlast trans-dir)))
			     (current-srcs (make-pathname :defaults trans-srcs
							  :directory src-dir))
			     (sys-host (send current-srcs :host))
			     sys-host-up
			     (local-host (send si:local-host :name))
			     (amnesia-p (eq si:local-host (si:parse-host 'amnesia)))
			     (rel4-p (equal src-dir '("RELEASE-4")))
			     (vanilla-p (and rel4-p (not amnesia-p)
					     (eq (si:parse-host 'lambda-a t) sys-host))))
			 ;;This is hairy, mostly because of all the text
			 (cond
			   (vanilla-p
			    (format t "~%
It appears you are booted with completely defaulted site information;
your SYS HOST is called LAMBDA-A, and this host knows its proper name, ~a."
				    local-host))
			   (amnesia-p
			    (format t "~%
It appears you are booted as AMNESIA, which means that your system's PACK-NAME
contains a host name that is not contained in the loaded site information.  I have
to conclude that either 1] you have created your own site files in the past, and
need to modify and reload them for release 4, or 2] you have changed the pack
name incorrectly.  In either case, you can not perform this installation until
you resolve this, at which time you can start over and repeat the procedure.")
			    (format t "~2%
Recommendations:
  1] Go to the SYS HOST and use SI:SET-SYS-HOST to point to your custom site files;
then save a band; then redo this installation.  SI:SET-SYS-HOST works one of two ways:
    a] Point to directory on this host, e.g. \(SI:SET-SYS-HOST \"LM\" NIL NIL \"MY-SITEFILES;\"\)
    b] Point to remote host/directory,  e.g. \(SI:SET-SYS-HOST \"AHOST\" :LISPM #o3020 \"MY-SITEFILES;\"\)
  2] Execute \(SI:GET-PACK-NAME\) to see the current host name strings.  Then,
     execute \(SI:SET-PACK-NAME\) to set the correct host name strings and reboot.
     For example:
        \(SI:GET-PACK-NAME\)
        \"whoops\"
        \"mistake\"
        \(SI:SET-PACK-NAME \"real-name real-name2\"\)")
			    (if (si:parse-host 'lambda-a t)
				(format t "~%
You can even set the pack name to \"lama lamb\" and reboot now with completely
default site information, which will work temporarily, but you may want to
fix the site files and reload them later.
"))
			    (read-carefully)
			    (abort-install "Local host is AMNESIA"))	;Done with AMNESIA
			   (rel4-p
			    (format t "~2%
Your site files appear to point to a proper source hierarchy for 
release 4; the logical host \"SYS:\" translated to ~a, which appears
to be correct."
				    current-srcs))
			   ;;;Real site info, but not pointing to RELEASE-4 sources
			   (t
			    (format t "~2%
The logical pathname definition for \"SYS:\", which should point to
the release 4 source hierarchy directory \"RELEASE-4;\", is not correct;
your source hierarchy translation works out to ~a." current-srcs)
			    (format t "~%
Perhaps you have not loaded your customized site files, and/or
you have not modified the file SYS:SITE;SYS.TRANSLATIONS 
to point to the RELEASE-4 directory as the source hierarchy.
\
Since we cannot load the optional software unless we can run MAKE-SYSTEM,
WE MUST BE ABSOLUTELY CERTAIN that
\
  1] The system definition files for the optional systems get
     restored into SYS:CUSTOMER-SITE; and copied into your own
     SYS:SITE; directory; and
  2] The translations for SYS:*; point to the RELEASE-4 directory.
\
")
			    (read-carefully)
			    (format t "~%
At this point you have two options:
\
  a) Abort the installation, so that you can manually correct your site files.
  b) This procedure can generate and load a new SYS.TRANSLATIONS file into your
     own SYS:SITE; directory.  This should solve the problem under the usual
     circumstances, but DON'T ELECT TO DO SO if you have customized your own
     SYS.TRANSLATIONS file to execute site-specific procedures!")
			    (case 
			      (fquery '(:type :tyi
					:choices (((:abort "No") #\N)
						  ((:load "Yes") #\Y)
						  (:trap #\h-quote))
					:list-choices nil
					:help-function
					(lambda(stream &rest ignore)
					  (format stream
						  "(Type N (no) to abort or Y (Yes) to generate SYS.TRANSLATIONS"))
					)
				      "~%Should we proceed? ~%
Do you want this procedure to generate SYS:SITE;SYS.TRANSLATIONS for you?")
			      (:ABORT
			       (format t "~%
Recommendations: you can either 1] edit your own SYS.TRANSLATIONS file, or 
2] restore the distribution CUSTOMER-SITE; directory and copy the example
SYS.TRANSLATIONS file into your own SYS:SITE; directory.
\
To correct this situation, we recommend either of the following procedures:")
			       (format t "~%
  1] Working on the SYS HOST, use ZMacs to edit `SYS:SITE;SYS.TRANSLATIONS'.
  If you plan to also run a previous software release, you may want to
  first copy the old site file directory to a new directory location.
  Then edit your new SYS.TRANSLATIONS so that it looks something like:
\
;;; -*- Mode:LISP; Package:USER; Base:10; Readtable:CL; -*-
\
\(fs:set-logical-pathname-host \"SYS\"
  :physical-host \"LAMA\" \; the actual computer where the sources are stored
  :translations '\(\(\"CHAOS;\" \"<RELEASE-4.CUSTOMER-SITE>\"\)
                   \(\"SITE;\" \"<RELEASE-4.CUSTOMER-SITE>\"\)
		   \(\"*;*;*;\" \"<RELEASE-4.*.*.*>\"\)
		   \(\"*;*;\" \"<RELEASE-4.*.*>\"\)
		   \(\"*;\" \"<RELEASE-4.*>\"\)\)\)
")
			       (format t "~%
  2] Repeat this installation, choosing only to restore CUSTOMER-SITE. Then
  copy the example file as follows:
     \(FS:COPY-FILE \"~A:RELEASE-4;SYS.TRANSLATIONS\" \"SYS:SITE;\"\)
\
  ...and edit it to modify only the :PHYSICAL-HOST keyword value to refer to
  your current SYS HOST.
")
			       (read-carefully)
			       (abort-install "invalid SYS:*; translation"))
			      (:trap (format t "~%Ok, we're taking your word for it."))
			      (:load
			       (let*((path (fs:translated-pathname "SYS:SITE;SYS.TEST"))
				     (host (pathname-host path))
				     (fn (namestring path))
				     (*readtable* (si:find-readtable-named "CL" t))
				     temp)
				 (unless (fs:get-pathname-host host t) (abort-install "invalid host ~a" host))
				 (unless (eq (setq temp(send host :system-type)) :lispm)
				   (abort-install "Cannot generate ~a for non-LISPM host ~a [type ~a]"
						  fn host temp))
				 (with-open-file(out path :direction :output :error :reprompt)
				   (format out "~%
;;; -*- Mode:LISP; Package:USER; Base:10; Readtable:CL; -*-
\	      
;;; SYS.TRANSLATIONS written from 4.0 Options Distribution procedure.
\
")
				   (si:write-responsibility-comment out)
				   (format out "~2%
;;; Defines the translations for the SYS logical host.~2%")
				   (pprint `(fs:set-logical-pathname-host
					      "SYS"
					      :physical-host ,(send host :name)
					      :translations
					      '(("CHAOS;" ,(directory-namestring path))
						("SITE;"  ,(directory-namestring path))
						("*;*;*;*;*;" "<RELEASE-4.*.*.*.*.*>")
						("*;*;*;*;" "<RELEASE-4.*.*.*.*>")
						("*;*;*;" "<RELEASE-4.*.*.*>")
						("*;*;" "<RELEASE-4.*.*>")
						("*;" "<RELEASE-4.*>")))
					   out))
				 (format t "~2%Done writing ~a, proceeding to load." path)
				 (load path))
			       )))
			   )			;cond ??all the site file situations
			 (push current-site systems-to-copy)	;save site file dir
			 )))			;If systems-to-copy

		   ;;;
		   ;;;Now we're cooking - restoring files
		   ;;;
		   (phasen "Restore files/directories for software options")
		   (if (null directories-to-restore)
		       (phaseskip)
		     (catch catch-last-directory
		       (tape:restore-files
			 :transform #'(lambda(flist)
					(send (car flist) :new-pathname :host *host*))
			 :match #'(lambda(flist &aux (path (car flist)) result)
				    (prog1
				      (setq result
					    (member (prog(dir)
							 (setq dir (send path :directory))
							 (if (atom dir) (setq dir (ncons dir)))
							 (return dir))
						    directories-to-restore
						    :test #'directory-wanted-p))
				      (unless result
					(format t "~%Skipping ~a" path))))
		       :overwrite :query)))

		   (phasen "Copying system definition files to SYS:SITE;")
		   (cond			;Systems to copy? site files visible?
		     ((null (cdr systems-to-copy))
		       (phaseskip))
		     ((not (pathnamep (car systems-to-copy)))
		      (format t "[Aborting]")
		      (format t "~%>> Sorry, this is a bug! Can't get your site file directory.")
		      (format t "~%>> I suggest you try:
  \(TAPE:REWIND\)
  \(TAPE:RESTORE-FILES\)
\
...and then use \(MAKE-SYSTEM 'name\) to restore any of the systems you selected.
")
		      (read-carefully)
		       (abort-install "internal bug"))
		     (t				;Ok to copy system files
		       ;;;
		       ;;;Should get here iff site files OK and we're copying .SYSTEM files
		       ;;;
		       (let((from-path (make-pathname :host *host*
						      :directory '("RELEASE-4" "CUSTOMER-SITE")))
			    (to-path
			      (make-pathname :defaults (pop systems-to-copy)
					     :name :wild
					     :version :wild
					     :type :wild)))
			 (unless (yes-or-no-p
				   "Ok to copy system definition files to ~a [No means abort installation!] ?"
				   to-path)
			   (abort-install "user chose not to copy system definition files"))
			 (loop for file in systems-to-copy
			       as from = (make-pathname :defaults from-path
							:name (string file)
							:type "SYSTEM"
							:version :highest)
			       do
			       (format t "~%Copying ~a to ~a" from to-path)
			       (copy-file from to-path))))
		     )				;Done phase - copy system def files

		   ;;;
		   ;;;Run commands to MAKE-SYSTEMs
		   ;;;
		   (phasen "Execute commands to load optional systems")
		   (if (null (setq commands-to-eval (reverse commands-to-eval)))
		       (phaseskip)
		     (progn
		       (loop for cmd in commands-to-eval
			     do
			     (if (and (eq (car cmd) 'make-system)
				      (eq (caadr cmd) 'quote)
				      (si:find-system-named (cadadr cmd) t t))
				 (format t "~%Note: system ~a is already loaded. Proceeding anyway." (cadadr cmd)))
			     (condition-case (err)
				 (when (y-or-n-p "Execute `~s'" cmd)
				   (eval cmd))
			       (sys:abort (format t "~%Aborted."))))))
		     (format t "~%Done.")
		     )				;labels local-fcns
		 )				;let local-vars
	       )				;tagbody
	   )					;return-block
	 )					;else [we're doing install]
	)					;cond top-level
  )						;top-level forms