;;; -*- Mode:Lisp; Package:USER; Syntax:COMMON-LISP; Base:10; Lowercase:T -*-


;;;----------------------------------------------------------------------------------+
;;;                                                                                  |
;;;                          TEXAS INSTRUMENTS INCORPORATED                          |
;;;                                   P.O. BOX 149149                                |
;;;                              AUSTIN, TEXAS 78714-9149                            |
;;;                                                                                  |
;;;             Copyright (C) 1989, 1990 Texas Instruments Incorporated.             |
;;;                                                                                  |
;;; Permission is granted to any individual or institution to use, copy, modify, and |
;;; distribute this software, provided that  this complete copyright and  permission |
;;; notice is maintained, intact, in all copies and supporting documentation.        |
;;;                                                                                  |
;;; Texas Instruments Incorporated provides this software "as is" without express or |
;;; implied warranty.                                                                |
;;;                                                                                  |
;;;----------------------------------------------------------------------------------+


(in-package "USER")

#-kcl
(progn
#+explorer
(defsystem clio-examples
  (:name "CLIO Example Programs")
  (:short-name "CLIO Examples")
  (:pathname-default "CLIO:EXAMPLES;")
  
  (:initial-status :experimental)

  ;;  The real source files...
  (:module package          ("package"))
  (:module clio-extras      ("cmd-frame"))
  (:module example-contacts ("sketchpad"))
  (:module sketch           ("sketch"))

  ;;  The transformations...
  (:compile-load package)
  (:compile-load clio-extras)
  (:compile-load example-contacts
		 (:fasload  package)
		 (:fasload  package))
  
  (:compile-load sketch
		 (:fasload  package clio-extras example-contacts)
		 (:fasload  package clio-extras example-contacts)))






(defun load-clio-examples (&key (host "CLIO") (directory "EXAMPLES") (compile-p t) (verbose-p t))
  (dolist (file (mapcar
		  #'(lambda (name)
		      (make-pathname
			:host      host
			:directory directory
			:name      name
			:version   :newest))
		  '("PACKAGE"
		    "CMD-FRAME"
		    "SKETCHPAD"
		    "SKETCH")))
    (when compile-p
      (when verbose-p
	(format t "~% Compiling ~12t~a..." file))
      (compile-file file))
    
    (when verbose-p
      (format t "~% Loading ~12t~a..." file))
    (load file)
    
    (when (and compile-p verbose-p)
      (format t "~%"))))
)

#+kcl
(progn

(defvar *clio-examples-root-directory* "/src/dec/dec-kcl/clue/clio/examples")

(defvar *clio-examples-source-pathname*
	(pathname (format nil "~A/*.l" *clio-examples-root-directory*)))

(defvar *clio-examples-binary-pathname*
	(pathname (format nil "~A/*.o" *clio-examples-root-directory*)))

(defvar *clio-examples-file-table* (make-hash-table :test 'equal))

(defun compile-clio-examples (&optional
			      (source-pathname-defaults *clio-examples-source-pathname*)
			      (binary-pathname-defaults *clio-examples-binary-pathname*)
			      &key
			      (force-p nil))

  ;; The pathname-defaults above might only be strings, so coerce them
  ;; to pathnames.  Build a default binary path with every component
  ;; of the source except the file type.  This should prevent
  ;; (compile-clio-examples "*.lisp") from destroying source files.
  (let* ((source-path (pathname source-pathname-defaults))
	 (path        (make-pathname
		       :host      (pathname-host      source-path)
		       :device    (pathname-device    source-path)
		       :directory (pathname-directory source-path)
		       :name      (pathname-name      source-path)
		       :type      nil
		       :version   (pathname-version   source-path)))
	 (binary-path (merge-pathnames binary-pathname-defaults
				       path)))
				       
    ;; Make sure source-path and binary-path file types are distinct so
    ;; we don't accidently overwrite the source files.  NIL should be an
    ;; ok type, but anything else spells trouble.
    (if (and (equal (pathname-type source-path)
		    (pathname-type binary-path))
	     (not (null (pathname-type binary-path))))
	(error "Source and binary pathname defaults have same type ~s ~s"
	       source-path binary-path))

    (format t ";;; Default paths: ~s ~s~%" source-path binary-path)

    (let ((newest-source-fwd 0))
      (labels ((compile-lisp (filename &optional (binary-filename filename))
		 (let ((source (merge-pathnames filename source-path))
		       (binary (merge-pathnames binary-filename binary-path)))
		   (when (or force-p
			     (not (probe-file source)) ; maybe no type in pathname
			     (not (probe-file binary))
			     (< (file-write-date binary)
				(setq newest-source-fwd
				      (max newest-source-fwd
					   (file-write-date source)))))
		     ;; If the source and binary pathnames are the same,
		     ;; then don't supply an output file just to be sure
		     ;; compile-file defaults correctly.
		     #+(or kcl ibcl) (load source)
		     (if (equal source binary)
			 (compile-file source)
			 (compile-file source :output-file binary)))
		   binary))
	       (load-binary (filename)
		 (let* ((binary (merge-pathnames filename binary-path))
			(fwd (and (probe-file binary) (file-write-date binary))))
		   (unless (and fwd
				(let ((lfwd (gethash filename *clio-examples-file-table*)))
				  (eql fwd lfwd)))
		     (load binary))
		   (setf (gethash filename *clio-examples-file-table*) fwd)))
	       (compile-and-load (filename &optional (binary-filename filename))
		 (compile-lisp filename binary-filename)
		 (load-binary binary-filename))
	       (module (filename) (compile-and-load filename)))

	;; Now compile and load all the files.
	(module "package")
	(module "cmd-frame")
	(module "sketchpad")
	(module "sketch")
	(module "precom")))))

(defun load-clio-examples (&optional
			   (binary-pathname-defaults *clio-examples-binary-pathname*))

  ;; The pathname-defaults above might only be strings, so coerce them
  ;; to pathnames.  Build a default binary path with every component
  ;; of the source except the file type.  
  (let* ((source-path (pathname ""))
	 (path        (make-pathname
		       :host      (pathname-host      source-path)
		       :device    (pathname-device    source-path)
		       :directory (pathname-directory source-path)
		       :name      (pathname-name      source-path)
		       :type      nil
		       :version   (pathname-version   source-path)))
	 (binary-path (merge-pathnames binary-pathname-defaults
				       path)))

    (labels ((load-binary (filename)
	       (let* ((binary (merge-pathnames filename binary-path))
		      (fwd (and (probe-file binary) (file-write-date binary))))
		 (unless (and fwd
			      (let ((lfwd (gethash filename *clio-examples-file-table*)))
				(eql fwd lfwd)))
		   (load binary))
		 (setf (gethash filename *clio-examples-file-table*) fwd)))
	     (module (filename) (load-binary filename)))

      ;; Now load all the files.
      (module "package")
      (module "cmd-frame")
      (module "sketchpad")
      (module "sketch")
      (module "precom"))))


)

