;;; -*- Mode: Common-Lisp; Package: User; Base: 8.; Patch-File: T -*-
;;; Written 12/07/88 17:32:33 by ab,
;;; Reason: Fix sys:install-update-from-diskette to set up TO-HOST default-device correctly.  12/7/88.
;;; while running on MX6 from band NB22
;;; With SYSTEM 5.19, GC 5.4, VIRTUAL-MEMORY 5.5, MICRONET 5.5, MICRONET-COMM 5.13,
;;;  DISK-IO 5.9, BASIC-PATHNAME 5.2, MAC-PATHNAME 5.0, NETWORK-SUPPORT-COLD 5.1,
;;;  BASIC-NAMESPACE 5.6, BASIC-FILE 5.3, RPC 5.4, NFS 5.12, EH 5.3, MAKE-SYSTEM 5.2,
;;;  MEMORY-AUX 5.1, MACTOOLBOX 1.26, COMPILER 5.1, TV 5.22, NVRAM 5.1, UCL 5.0, INPUT-EDITOR 5.0,
;;;  METER 5.0, ZWEI 5.9, DEBUG-TOOLS 5.1, WINDOW-MX 5.30, PRINTER 5.11, MAC-PRINTER-TYPES 5.4,
;;;  NETWORK-PATHNAME 5.0, NETWORK-NAMESPACE 5.0, DATALINK 5.7, CHAOSNET 5.6, NETWORK-SUPPORT 5.0,
;;;  NETWORK-SERVICE 5.0, DATALINK-DISPLAYS 5.0, NAMESPACE-EDITOR 5.1, IP 3.33, NFS-SERVER 5.3,
;;;  PRINTER-TYPES 5.2, IMAGEN 5.1, MAIL-DAEMON 5.1, MAIL-READER 5.4, TELNET 5.1,
;;;  VT100 5.0, STREAMER-TAPE 5.6, DECNET 1.45, VISIDOC 5.4, PROFILE 5.1, DISK-LABEL 5.1,
;;;   microcode 96, Band Name: microExplorer Network (11/22)

#!C
; From file PATCH.LISP#> MAKE-SYSTEM; MR-X:
#8R SYSTEM#:
(COMPILER-LET ((*PACKAGE* (FIND-PACKAGE "SYSTEM"))
                          (SI:*LISP-MODE* :COMMON-LISP)
                          (*READTABLE* COMMON-LISP-READTABLE)
                          (SI:*READER-SYMBOL-SUBSTITUTIONS* *COMMON-LISP-SYMBOL-SUBSTITUTIONS*))
  (COMPILER#:PATCH-SOURCE-FILE "sys: MAKE-SYSTEM; PATCH.É#É"


(DEFUN install-update-from-diskette (&key (microexplorer-host "LM")
				 (to-host "SYS") 
				 (expsys t) (macsys t) (copy-lisp t)
				 (print-only nil))
  "Copy patch files and other updated materials from diskettes installed on the
microexplorer host specified by the :MICROEXPLORER-HOST keyword.
  :TO-HOST specifies the host to copy to.  This is usually the SYS host, but can
be any Explorer or microExplorer host.
  If :EXPSYS is true, all updated files from the MICROEXP:EXPSYS: folder will be installed.
This includes all PATCH files.  If :COPY-LISP is false, .LISP files will not be copied
for most patches.
  If :MACSYS is true, all updated files from the MICROEXP:MACSYS: folder will be installed.
This includes any changed MacMX (driver) source files. 
  If the value of the :PRINT-ONLY keyword is true, the copy operations to be done
will be displayed only." 
  (LET (host to-host-obj phys-host mac-host-p
	default-device translations)
    (CHECK-ARG microexplorer-host
	       (SETQ host (IGNORE-ERRORS (si:parse-host microexplorer-host)))
	       "a parsable host")
    (CHECK-ARG to-host
	       (SETQ to-host-obj (IGNORE-ERRORS (si:parse-host to-host)))
	       "a parsable host")
    (CHECK-ARG microexplorer-host (EQ (SEND host :pathname-flavor) 'fs:mac-pathname) "a microexplorer host")
    
    (net:set-logical-pathname-host
      "PATCH"
      :physical-host microExplorer-host
      :default-device *update-diskette-name* 
      :translations (name:make-microexplorer-sys-translations))
    
    (SETF phys-host (IF (EQ (SEND to-host-obj :system-type) :logical)
			(SEND (si:translated-pathname (PATHNAME (STRING-APPEND to-host ":FOO;"))) :host)
			to-host-obj)
	  mac-host-p (IF (EQ 'fs:mac-pathname (SEND phys-host :pathname-flavor)) t nil)	       ;ab 12/7/88.  Check physical-host not to-host for mac-ness.
	  default-device (WHEN mac-host-p
			   (OR (SEND to-host-obj :default-device)
			       (WHEN (addin-p) (get-startup-default-device)) "HD"))
	  translations (IF mac-host-p
			   (name:make-microexplorer-sys-translations nil)
			   (SEND to-host-obj :translations)))
    ;; Set up logical host for our target.
    (net:set-logical-pathname-host
      "TO-HOST"
      :physical-host (send phys-host :name)
      :default-device default-device
      :translations translations)
    (LOOP for continue = (Y-OR-N-P (FORMAT nil "Begin installing patches ~a onto host ~a?"
					   (IF (SEND host :local-host-p)
					       "from diskettes on local MAC host"
					       (FORMAT nil "from diskettes on host ~a"
						       (STRING-UPCASE microexplorer-host)))
					   (STRING-UPCASE to-host)))
	  then (PROGN (TERPRI) (TERPRI)
		      (Y-OR-N-P "Insert next PATCH diskette and press Y to continue, N to quit."))
	  with (src dest file this-src this-dest name)
	  until (OR (NOT continue)
		    (NOT (check-for-diskette *update-diskette-name*  microexplorer-host)))
	  do
	  ;; Copy everything in MACSYS subdirectory
	  (WHEN (AND macsys
		     (PROBE-FILE (SEND (PATHNAME "PATCH:MACSYS;") :directory-pathname-as-file)))
	    (SETQ src "PATCH:MACSYS;" dest "TO-HOST:MACSYS;")
	    (FORMAT t "~2%Copying directory ~a ~%     to ~a"
			   (TRANSLATED-PATHNAME src) (si:translated-pathname dest))
	    (UNLESS print-only
	      (COPY-NEWER-FILES src dest nil)))
	  ;; Copy EXPSYS directory, but honor COPY-LISP = NIL for PATCH subdirectory
	  (WHEN (AND expsys
		     (PROBE-FILE (SEND (PATHNAME "PATCH:EXPSYS;") :directory-pathname-as-file)))
	    (DOLIST (file-list (fs:directory-list "PATCH:EXPSYS;"))
	      (WHEN (SETQ file (CAR file-list))
		(SETQ src "PATCH:EXPSYS."
		      dest (IF mac-host-p "TO-HOST:EXPSYS." "TO-HOST:"))
		(COND ((NOT (GET file-list :directory))
		       ;; This is a file.
		       (SETQ name (SEND file :name)
			     this-src (STRING-APPEND src name)
			     this-dest (STRING-APPEND dest name))
		       (FORMAT t "~2%Copying ~a ~%     to ~a"
				      (TRANSLATED-PATHNAME this-src) (si:translated-pathname this-dest))
		       (UNLESS print-only
			 (COPY-NEWER-FILES this-src this-dest nil)))
		      ;; We have a directory
		      ((STRING-EQUAL (SETQ name (SEND file :name)) "PATCH")
		       ;; The directory is "PATCH".  This is the only one we will
		       ;; honor copy-lisp = NIL on.
		       (SETQ this-src "PATCH:PATCH;"
			     this-dest "TO-HOST:PATCH;")
		       (COND (copy-lisp
			      (FORMAT t "~2%Copying ~a ~%     to ~a"
				      (TRANSLATED-PATHNAME this-src) (si:translated-pathname this-dest)))
			     (t
			      (FORMAT t "~2%Copying ~a (except for .LISP files)~%     to ~a"
				      (TRANSLATED-PATHNAME this-src) (si:translated-pathname this-dest))))
		       (DOLIST (f-lst (fs:directory-list "PATCH:PATCH;"))
			 (WHEN (CAR f-lst)
			   (SETQ name (SEND (CAR f-lst) :name))
			   (SETQ this-src (STRING-APPEND "PATCH:PATCH." name ";*.PATCH-DIRECTORY#>")
				 this-dest (STRING-APPEND "TO-HOST:PATCH." name ";"))
			   (FORMAT t "~%  Copying ~a ~%       to ~a"
				   (TRANSLATED-PATHNAME this-src) (si:translated-pathname this-dest))
			   (UNLESS print-only
			     (COPY-NEWER-FILES this-src this-dest nil))
			   (SETQ this-src (STRING-APPEND "PATCH:PATCH." name ";*.XLD#>")
				 this-dest (STRING-APPEND "TO-HOST:PATCH." name ";"))
			   (FORMAT t "~%  Copying ~a ~%       to ~a"
				   (TRANSLATED-PATHNAME this-src) (si:translated-pathname this-dest))
			   (UNLESS print-only
			     (COPY-NEWER-FILES this-src this-dest nil))
			   (WHEN copy-lisp
			     (SETQ this-src (STRING-APPEND "PATCH:PATCH." name ";*.LISP#>")
				   this-dest (STRING-APPEND "TO-HOST:PATCH." name ";"))
			     (FORMAT t "~%  Copying ~a ~%       to ~a"
				     (TRANSLATED-PATHNAME this-src) (si:translated-pathname this-dest))
			     (UNLESS print-only
			       (COPY-NEWER-FILES this-src this-dest nil))))))
		      (t
		       ;; Any other directory under EXPSYS
		       (SETQ this-src (STRING-APPEND src name ";")
			     this-dest (STRING-APPEND dest name ";"))
		       (FORMAT t "~2%Copying ~a ~%     to ~a"
			       (TRANSLATED-PATHNAME this-src) (si:translated-pathname this-dest))
		       (UNLESS print-only
			 (COPY-NEWER-FILES this-src this-dest nil)))
		      ))))
			      
	  ))				;LOOP, LET
  )
))
