;;; -*- Mode: Common-Lisp; Package: FS; Base: 10.; Patch-File: T -*-

;;; Reason: Modified CHANGE-PROPERTIES-FOR-COPY. It was not allowing properties of remote mac host to be updated.

;;;                           RESTRICTED RIGHTS LEGEND
;;;
;;; Use, duplication, or disclosure by the Government is subject to
;;; restrictions as set forth in subdivision (c)(1)(ii) of the Rights in
;;; Technical Data and Computer Software clause at 52.227-7013.
;;;
;;;   TEXAS INSTRUMENTS INCORPORATED      
;;;   P.O. BOX 2909, M/S 2151             
;;;   AUSTIN, TEXAS 78769                 
;;;
;;; Copyright (C) 1989 Texas Instruments Incorporated.
;;; All rights reserved.

;;; Patch file for BASIC-FILE version 6.6
;;; Written 11/01/89 12:35:34 by BERGER,
;;; while running on ARIES from band LODX
;;; With SYSTEM 6.23, VIRTUAL-MEMORY 6.2, EH 6.5, MAKE-SYSTEM 6.2, MICRONET 6.0, LOCAL-FILE 6.1,
;;;  BASIC-PATHNAME 6.2, NETWORK-SUPPORT-COLD 6.2, BASIC-NAMESPACE 6.6, NETWORK-NAMESPACE 6.0,
;;;  DISK-IO 6.1, DISK-LABEL 6.0, BASIC-FILE 6.5, MAC-PATHNAME 6.0, NETWORK-PATHNAME 6.0,
;;;  COMPILER 6.14, TV 6.18, DATALINK 6.0, CHAOSNET 6.1, GC 6.3, MEMORY-AUX 6.0, NVRAM 6.2,
;;;  SYSLOG 6.2, STREAMER-TAPE 6.4, UCL 6.0, INPUT-EDITOR 6.0, METER 6.1, ZWEI 6.8,
;;;  DEBUG-TOOLS 6.3, NETWORK-SUPPORT 6.0, NETWORK-SERVICE 6.2, DATALINK-DISPLAYS 6.0,
;;;  FONT-EDITOR 6.1, SERIAL 6.0, PRINTER 6.3, MAC-PRINTER-TYPES 6.1, PRINTER-TYPES 6.2,
;;;  IMAGEN 6.1, SUGGESTIONS 6.1, MAIL-DAEMON 6.3, MAIL-READER 6.5, TELNET 6.0, VT100 6.0,
;;;  NAMESPACE-EDITOR 6.4, PROFILE 6.2, VISIDOC 6.5, TI-CLOS 6.26, CLEH 6.5, IP 3.55,
;;;  Experimental CLX 6.6, CLUE 6.27, X11M 6.15, Experimental BUG 11.15,  microcode 429,
;;;  Band Name: rel6.0 10/23

#!C
; From file OPEN.LISP#> BASIC-FILE; sys0:
#10R FILE-SYSTEM#:
(COMPILER-LET ((*PACKAGE* (FIND-PACKAGE "FILE-SYSTEM"))
                          (SI:*LISP-MODE* :COMMON-LISP)
                          (*READTABLE* COMMON-LISP-READTABLE)
                          (SI:*READER-SYMBOL-SUBSTITUTIONS* SYS::*COMMON-LISP-SYMBOL-SUBSTITUTIONS*))
  (COMPILER#:PATCH-SOURCE-FILE "SYS: BASIC-FILE; OPEN.#"


(DEFUN CHANGE-PROPERTIES-FOR-COPY (INPUT-STREAM OUT-STREAM AUTHOR
				   COPY-AUTHOR COPY-CREATION-DATE DO-NOT-COPY-PROPERTIES
				   OUTPUT-DEFAULTS-FROM-STREAMING)
  ;; Do not call change-properties if it is a MAC host -- Tung (6/27/88)
  ;; it is redundant and expensive for NFS.
  (LET ((host (SEND (SEND out-stream :pathname) :host)))
    (WHEN (and (mac-host-p host)
	       (eq host si:local-host)) ; DAB 11-01-89 We want to update properties if networking.
      (SETQ *MAC-NFS-COPY-FHANDLE* (SEND out-stream :pathname))
      (SETQ *MAC-NFS-COPY-CREATION-DATE* (SEND INPUT-STREAM :CREATION-DATE))
      (RETURN-FROM CHANGE-PROPERTIES-FOR-COPY ()) ))

  (IGNORE-ERRORS
   (IF COPY-AUTHOR
     (IF COPY-CREATION-DATE
       (SEND OUT-STREAM :CHANGE-PROPERTIES ()
	     :CREATION-DATE (SEND INPUT-STREAM :CREATION-DATE)
	     :AUTHOR AUTHOR)
       (SEND OUT-STREAM :CHANGE-PROPERTIES ()
	     :AUTHOR AUTHOR))
     (IF COPY-CREATION-DATE
       (SEND OUT-STREAM :CHANGE-PROPERTIES ()
	     :CREATION-DATE (SEND INPUT-STREAM :CREATION-DATE)))))
  
  (IGNORE-ERRORS
   (UNLESS DO-NOT-COPY-PROPERTIES
     (UNLESS OUTPUT-DEFAULTS-FROM-STREAMING
       (do ((out-props  (SEND OUT-STREAM :PLIST))
	    (in-props (SEND INPUT-STREAM :PLIST) (cddr in-props))
	    (l nil)
	    (marker (cons nil nil)))
	   ((null in-props )
	    (when l (APPLY OUT-STREAM :CHANGE-PROPERTIES () l)))
	 (unless (or (member (car in-props) '(:HOST :DIRECTORY :NAME :VERSION :TYPE :TRUENAME):test #'eq)
		     (neq marker (getf (car in-props) out-props marker)))
	   (push (cadr in-props) l)
	   (push (car in-props)  l)))))))
))