;;; -*- Syntax:Common-Lisp; Mode: LISP; Package: (TMS Lisp 1000.); Base: 10. -*-

"(c) Copyright 1986 Xerox Corporation.  All rights reserved.  Subject to
the following conditions, permission is granted to use and copy this
software and to prepare derivative works:  Such use, copying or
preparation of derivative works must be for non-commercial research or
educational purposes; each copy or derivative work must include this
copyright notice in full; a copy of each completed derivative work must
be returned to:  DEKLEER@XEROX.COM (Arpanet) or Johan de Kleer,
Xerox PARC, 3333 Coyote Hill Road, Palo Alto, CA 94304.  This software
is made available AS IS, and Xerox Corporation makes no warranty about
the software or its performance."

(in-package 'tms)

(defvar *atms-files* '(
     "bd:>atms>rel7>load-atms.lisp"
     "sys:site;tms.system"
     "sys:site;atms.translations"
     "bd:>atms>rel7>walk.lisp"			;"spiff:>gregor>pcl>walk.lisp"
     "bd:>atms>manual.txt"
     "bd:>atms>profile.lisp"
     "bd:>atms>latms1.lisp"
     "bd:>atms>forbus-atms.lisp"
     "bd:>atms>rel7>install.lisp"
     "bd:>atms>rel7>batms3.lisp"
     "bd:>atms>rel7>blists.lisp"
     "bd:>atms>rel7>cons3.lisp"
     "bd:>atms>copy.txt"
     "bd:>atms>rel7>examples.lisp"
     "bd:>atms>rel7>diags.lisp"
     "bd:>atms>rel7>defs.lisp"
     "bd:>atms>rel7>user.lisp"
     "bd:>atms>rel7>hash.lisp"
     "bd:>atms>rel7>interp.lisp"  
     "bd:>atms>rel7>nml.lisp"
     "bd:>atms>rel7>tree.lisp"
     "bd:>atms>rel7>label.lisp"
     "bd:>atms>rel7>tms7.lisp"  
     "bd:>atms>rel7>tp-rel6.lisp"
     "bd:>atms>rel7>tp-rel7.lisp"
     "bd:>atms>rel7>tp.lisp"
     "bd:>atms>rel7>vector.lisp"
     "bd:>atms>rel7>replay.lisp"
     "bd:>atms>rel7>allocate.lisp"
     "bd:>atms>rel7>blots.lisp"
     "bd:>atms>rel7>blits.lisp"
  ))

(defun install-atms-ftp (directory)
  (dolist (file *atms-files*)
    (zl:copyf file directory)))

(defun update-atms-ftp (directory &aux old-file new-file new-name old-name)
  (setq directory (fs:parse-pathname directory))
  (dolist (file *atms-files*)
    (setq new-name (fs:parse-pathname file)
	  new-file (open new-name :direction :probe)
	  old-name (funcall directory :new-name (funcall new-name :name))
	  old-name (funcall old-name :new-type (funcall new-name :type))
	  old-file (open old-name :direction :probe))
    (when (< (funcall old-file :creation-date)
	     (funcall new-file :creation-date))
      (format T "~% Updating ~A" file)
      (zl:copyf new-name old-name))))


(defun make-tape ()
  (tape:carry-dump
    (mapcar #'car *atms-files*))
  ;; Make sure we won:
  (tape:carry-list)
  )