;;; -*- Mode: Lisp; Package: TAPE; Base: 10; Readtable: Common-Lisp -*-

;;;	   All files contained in this directory are copyright
;;;		       (c) LISP Machine, Inc. 1986
;;;			   All Rights Reserved


;;; Inquiries concerning copyright release or licensing should be directed
;;; to LMI Legal Affairs at the following address:

;;; LISP Machine, Inc.
;;; 6 Andover Tech Drive
;;; Andover, Massachusetts  01810
;;; Phone: (617) 682-0500


;;; This file is executed when the user invokes:
;;; (tape:install-distribution-tape)
;;;


(distribution-installation-forms

  (send terminal-io :send-if-handles :clear-window)


  (format t "~&~
**********************************************************~%~
**  THIS IS THE VISTA-LIBRARY SOURCE DISTRIBUTION TAPE  **~%~
**             FOR LMI RELEASE 3.0                      **~%~
**                                                      **~%~
**  All files contained in this tape are copyright      **~%~
**          (c) LISP Machine, Inc. 1986                 **~%~
**              All Rights Reserved                     **~%~
**                                                      **~%~
**  Inquiries concerning copyright release or           **~%~
**  licensing should be directed to LMI Legal           **~%~
**  Affairs at the following address:                   **~%~
**                                                      **~%~
**      LISP Machine, Inc.                              **~%~
**      6 Andover Tech Drive                            **~%~
**      Andover, Massachusetts  01810                   **~%~
**      Phone: (617) 682-0500                           **~%~
**********************************************************~%")
  (cond ((not (y-or-n-p "~&Is VISTA-LIBRARY the product you wanted to install?"))
	 ;; make sure the user is installing the product that was
	 ;; intended
	 (format t "~&~
***  INSTALLATION ABORTING  ***~%")
	 (tape:rewind))
;	((or (not (eq 110 (si:get-system-version)))
;	     (not (eq 3 (si:get-system-version 'system-revision-level))))
;	 (beep)
;	 (format t "~&~
;******************************************************~%~
;**  ERROR:                                          **~%~
;**  This machine is running an incorrect            **~%~
;**  LMI system version for installing this product. **~%~
;**  INSTALLATION ABORTING                           **~%~
;******************************************************~%")
;	 (beep)
;	 (tape:rewind))
	(t
	 (let ((*pn* (fs:parse-pathname "SYS:VISTA; * * *"))
;	       (*sourcep* t)
	       (*query* nil)
	       (*load* nil))
	   (declare (special *pn* *host* *query* *load*))  ;*sourcep*
	   (let ((*default-pathname-defaults* (ncons (cons nil *pn*))))
	     (tv:choose-variable-values '((*pn* "Directory to restore to" :pathname)
;					  (*sourcep* "Restore source files" :boolean)
					  (*query* "Query about each file restored" :boolean)
					  (*load* "Load VISTA-LIBRARY system after installing" :boolean))
					:function #'(lambda (window var oldv newv)
						      (when (eq var '*pn*)
							(let ((pt (pathname newv)))
							  (setq *pn*
								(fs:make-pathname :host (send pt :host)
										  :device (send pt :device)
										  :directory (send pt :directory)))))
						      nil)
					:label "Choose installation parameters"))
	   (setq *pn* (fs:parse-pathname *pn*))	
	   (format t "~&Restoring VISTA-LIBRARY System files to ~A " *pn*)
	   (do () ((not (typep *pn* 'fs:logical-pathname)))
	     (setq *pn* (send *pn* :translated-pathname)))
	   (format t "(~A)~%" *pn*)
	   (restore-files :transform
			  #'(lambda (plist)
			      (flet ((dir (pn)
					  (let ((dir (fs:pathname-directory pn)))
					    (if (atom dir)
						(list dir)
					      dir))))				       
				(let ((pathname (car plist)))
				  (fs:make-pathname :host (send *pn* :host)
						    :directory (append (dir *pn*)
								       (cdr (dir pathname)))
						    :name (fs:pathname-name pathname)
						    :canonical-type (send pathname :canonical-type)
						    :version (fs:pathname-version pathname)))))
			  :query *query*)
	   (tape:rewind)
	   (format t "~&Writing translations file in site directory...~%")
	   (with-open-file (file "SYS:SITE;VISTA TRANSLATIONS >"
				 :direction :output)
	     (let ((*readtable* (si:find-readtable-named "CL")))
	       (flet ((add-subdirs (pt &rest subdirs)
				   (directory-namestring
				     (send pt :new-pathname
					   :directory
					   (append (let ((dir (send pt :directory)))
						     (if (consp dir) dir (list dir)))
						   subdirs)))))
		 (format file ";;; -*- Mode:LISP; Package:USER; Base:10; READTABLE:CL -*-~@
                         ~@
                           ;;; Copyright (C) LISP Machine, Inc. 1986~@
                           ;;;   See filename \"Copyright\" for~@
                           ;;; licensing and release information.~@
                         ~@
                          ;;; This file was generated at installation time~@
                          ;;; by VISTA:VISTA;VISTA-LIBRARY DISTRIBUTION~@
                         ~@
                          (fs:set-logical-pathname-host
                                \"VISTA\"
                                :physical-host ~s
                                :translations
                                `((\"VISTA\" ~s)
                                  (\"VISOBS\" ~s)
                                  (\"LIBRARY\" ~s)
		                  (\"*;\" ~s)
		                  (\"*; *;\" ~s)))~%"
			 (send (send *pn* :host) :name)	; physical host
			 (directory-namestring *pn*)
			 (add-subdirs *pn* "VISOBS")
			 (add-subdirs *pn* "LIBRARY")
			 (add-subdirs *pn* "VISTA" :wild)
			 (add-subdirs *pn* "VISTA" :wild :wild)))))
	   (format t "~&Copying system file to site directory...~%")
	   (fs:make-logical-pathname-host "VISTA")
	   (fs:copy-file "VISTA:LIBRARY;VISTA-LIBRARY SYSTEM >"
			 "SYS:SITE;VISTA-LIBRARY SYSTEM >")
	   (format t "~&VISTA-LIBRARY system installed.")
	   (when *load*
	     (format t "~&Loading VISTA-LIBRARY system...~%")
	     (make-system 'VISTA-LIBRARY :noconfirm :silent)
	     (format t "~&VISTA-LIBRARY system loaded.~%"))))
	 ))

;; since only the first form in this file is processed we might as well
;; put our tape-making procedure here.
;; This code will only run at LMI.


(defun make-VISTA-LIBRARY-dist-tape ()
    (format t "~&Writing VISTA-LIBRARY distribution tape~%")
    (tape:rewind)
    (tape:write-files "sys:VISTA;VISTA-LIBRARY distribution >")
    (tape:write-files "sys:VISTA; LIBRARY; * * >")
    (tape:write-files "sys:VISTA; DEMO; * * >")
    (tape:finish-tape)
    (tape:rewind))