;;; -*- Mode:Lisp; Readtable:ZL; Package:USER; Base:8; Patch-File:T -*-
;;; Patch file for System version 126.80
;;; Reason:
;;;  Fix indentation of SET-LOGICAL-PATHNAME-HOST.
;;; Written 13-Sep-88 18:34:52 by keith (Keith Corbett) at site Gigamos Cambridge
;;; while running on Breaking Glass from band 3
;;; with Experimental System 126.77, Experimental ZWEI 126.10, Experimental ZMail 74.1, Experimental Local-File 76.0, Experimental File-Server 25.0, Experimental Unix-Interface 14.0, Experimental Tape 25.1, Experimental Lambda-Diag 18.0, microcode 1762, SDU Boot Tape 3.14, SDU ROM 103, Lambda/Falcon Development System.



; From modified file DJ: L.IO.FILE; PATHST.LISP#217 at 13-Sep-88 18:35:12
#8R FILE-SYSTEM#: 
(COMPILER-LET ((*PACKAGE* (PKG-FIND-PACKAGE "FILE-SYSTEM")))
  (COMPILER::PATCH-SOURCE-FILE "SYS: IO; FILE; PATHST  "

(defun set-logical-pathname-host (logical-host &key physical-host translations)
  "Define a logical host named LOGICAL-HOST, which translates to PHYSICAL-HOST.
TRANSLATIONS is a list of translations to use: each element looks like
 (logical-pattern physical-pattern),
 where each pattern is a file namestring with wildcards.
 Omitted components default to * (:WILD)."
  (declare (zwei:indentation 1 1))
  (let (log phys)
    (tagbody
	retry
	   (setq log (get-pathname-host logical-host t nil))
	   (unless (typep log '(or null logical-host))
	     (multiple-cerror () () ("~Creating the logical host with name /"~A/"
will override that name for the physical host ~S,
making /"~:2*~A/" unacceptable as a name for the physical host~" logical-host log)
	       ("Create the logical host anyway"
		(setq log nil))
	       ("Don't create the logical host"
		(return-from set-logical-pathname-host nil))
	       ("Supply a new name for the logical host"
		(let ((*query-io* *debug-io*))
		  (setq logical-host
			(string-upcase (prompt-and-read :string-trim
							"New name for logical host: "))))
		(go retry))))
	   ;;Changed (get-pathname-host ... NIL) - Don't want "unknown" physical hosts
	   ;;getting added for logical hosts!!! Causes bad brains. -KmC
	   (setq phys (or (get-pathname-host physical-host nil)
			  (si:parse-host physical-host)))
	   ;;Also do this below after getting physical host -- don't add to list
	   ;;if it isn't real. -KmC
	   (unless log
	     (setq log (make-instance 'logical-host :name logical-host))
	     (push log *logical-pathname-host-list*)))
    ;; Here is a bit of a kludge for SI:SET-SITE.  If the physical host is not defined yet,
    ;; add it now.
    ;;(unless (typep phys 'logical-host)
    ;;  (pushnew phys *pathname-host-list* :test 'eq))
    ;;**** NO! Also wrong, and extremely dangerous.   All I know, this is part of
    ;;what caused a si:set-sys-host to a previously unknown host to lay a bomb:
    ;;you can end up with non-EQ phys's (one on si:host-alist and another
    ;;one on *pathname-host-list*).  This occurred if you don't happen to type in
    ;;the exact (case-matching) real name of the sys host.  After doing
    ;;(update-site-configuration-info), the world went mad -- can't get at the
    ;;physical host anymore.  A fix was also needed in set-sys-host.
    ;;-KmC 1/6/88
    (send log :set-physical-host phys)
    (if translations
	(send log :set-translations
	      (loop for trans in translations
		    collect (decode-translation log (car trans) (cadr trans)))))
    (pushnew log *logical-pathname-host-list* :test 'eq)
    log))

))