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


;;;----------------------------------------------------------------------------------+
;;;                                                                                  |
;;;                          TEXAS INSTRUMENTS INCORPORATED                          |
;;;                                  P.O. BOX 149149                                 |
;;;                                AUSTIN, TEXAS 78714                               |
;;;                                                                                  |
;;;             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
  (:name "Common Lisp Interactive Objects")
  (:short-name "CLIO")
  (:pathname-default "clio:source;")
  (:patchable "clio:patch;" "CLIO")
  (:initial-status :experimental)

  ;;  The real source files...
  (:module clio             ("clio"))
  (:module defs             ("ol-defs" "utility"))
  (:module core             ("core-mixins" "gravity"))
  (:module images           "ol-images")
  (:module buttons          "buttons")
  (:module form             "form")
  (:module table            "table")
  (:module choices          "choices")
  (:module scroller         "scroller")
  (:module slider           "slider")
  (:module scroll-frame     "scroll-frame")
  (:module multiple-choices "mchoices")
  (:module menu             "menu")
  (:module property-sheet   "psheet")
  (:module command          "command")
  (:module confirm          "confirm")
  (:module text-defs         ("buffer" "text-command")) 
  (:module display-text     "display-text")
  (:module edit-text        "edit-text")
  (:module display-image    "display-imag")
  (:module dialog-button    "dlog-button")

  ;;  The auxiliary files...
  ;;(:module doc ("readme" "doc;clio.ps" "doc;release.1-0"))
  ;;(:auxiliary doc)

  ;;  The transformations...
  (:compile-load clio)
  
  (:compile-load defs
		 (:fasload clio)
		 (:fasload clio))
  (:compile-load core
		 (:fasload clio defs)
		 (:fasload clio defs))
  (:compile-load images
		 (:fasload clio defs)
		 (:fasload clio defs))
  (:compile-load text-defs
		 (:fasload clio)
		 (:fasload clio))
  (:compile-load display-text
		 (:fasload clio core text-defs)
		 (:fasload clio core text-defs))
  (:compile-load confirm
		 (:fasload clio core display-text)
		 (:fasload clio core display-text))
  (:compile-load edit-text
		 (:fasload clio core text-defs display-text confirm images)
		 (:fasload clio core text-defs display-text confirm images))
  (:compile-load buttons
		 (:fasload clio core display-text images)
		 (:fasload clio core display-text images)) 
  (:compile-load scroller
		 (:fasload clio core defs images)
		 (:fasload clio core defs images)) 
  (:compile-load scroll-frame
		 (:fasload clio core scroller)
		 (:fasload clio core scroller))
  (:compile-load slider
		 (:fasload clio core defs images)
		 (:fasload clio core defs images))
  (:compile-load form
		 (:fasload clio core)
		 (:fasload clio core)) 
  (:compile-load table
		 (:fasload clio core)
		 (:fasload clio core)) 
  (:compile-load choices
		 (:fasload clio core table)
		 (:fasload clio core table)) 
  (:compile-load multiple-choices
		 (:fasload clio core table)
		 (:fasload clio core table)) 
  (:compile-load menu
		 (:fasload clio core display-text choices buttons defs images)
		 (:fasload clio core display-text choices buttons defs images)) 
  (:compile-load property-sheet
		 (:fasload clio core form menu confirm display-text)
		 (:fasload clio core form menu confirm display-text))
  (:compile-load command
		 (:fasload clio core form table confirm display-text)
		 (:fasload clio core form table confirm display-text))
  (:compile-load dialog-button
		 (:fasload clio core confirm menu property-sheet command)
		 (:fasload clio core confirm menu property-sheet command))
  (:compile-load display-image
		 (:fasload clio core)
		 (:fasload clio core))

  )



(defun load-clio (&key (host "CLIO") (directory "SOURCE") (compile-p t) (verbose-p t))
  (dolist (file (mapcar
		  #'(lambda (name)
		      (make-pathname
			:host      host
			:directory directory
			:name      name
			:version   :newest))
		  '("CLIO"
		    "OL-DEFS"
		    "UTILITY"
		    "OL-IMAGES"
		    "CORE-MIXINS"
		    "GRAVITY"
		    "BUFFER"
		    "TEXT-COMMAND"
		    "DISPLAY-TEXT"
		    "BUTTONS"
		    "CONFIRM"
		    "SCROLLER"
		    "TABLE"
		    "CHOICES"
		    "FORM"
		    "MENU"
		    "PSHEET"
		    "COMMAND"
		    "EDIT-TEXT"
		    "SCROLL-FRAME"
		    "SLIDER"
		    "MCHOICES"
		    "DLOG-BUTTON"
		    "DISPLAY-IMAG"
		    )))
    (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-root-directory* "/src/dec/dec-kcl/clue/clio")

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

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

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

(defun compile-clio (&optional
		     (source-pathname-defaults *clio-source-pathname*)
		     (binary-pathname-defaults *clio-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 "*.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-file-table*)))
				  (eql fwd lfwd)))
		     (load binary))
		   (setf (gethash filename *clio-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 "clio")
	(module "ol-defs")
	(module "utility")
	(module "core-mixins")
	(module "gravity")
	(module "buffer")
	(module "text-command")
	(module "display-text")
	(module "ol-images")
	(module "buttons")
	(module "confirm")
	(module "scroller")
	(module "table")
	(module "choices")
	(module "form")
	(module "menu")
	(module "psheet")
	(module "command")
	(module "edit-text")
	(module "slider")
	(module "scroll-frame")
	(module "mchoices")
	(module "dlog-button")
	(module "display-imag")))))

(defun load-clio (&optional
		  (binary-pathname-defaults *clio-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-file-table*)))
				(eql fwd lfwd)))
		   (load binary))
		 (setf (gethash filename *clio-file-table*) fwd)))
	     (module (filename) (load-binary filename)))

      ;; Now load all the files.
      (module "clio")
      (module "ol-defs")
      (module "utility")
      (module "core-mixins")
      (module "gravity")
      (module "buffer")
      (module "text-command")
      (module "display-text")
      (module "ol-images")
      (module "buttons")
      (module "confirm")
      (module "scroller")
      (module "table")
      (module "choices")
      (module "form")
      (module "menu")
      (module "psheet")
      (module "command")
      (module "edit-text")
      (module "slider")
      (module "scroll-frame")
      (module "mchoices")
      (module "dlog-button")
      (module "display-imag"))))

)

