;;; -*- Mode: LISP; Syntax: Common-Lisp; Package: USER; Base: 10 -*-
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;         The Garnet User Interface Development Environment.      ;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; This code was written as part of the Garnet project at          ;;;
;;; Carnegie Mellon University, and has been placed in the public   ;;;
;;; domain.  If you are using this code or any part of Garnet,      ;;;
;;; please contact garnet@cs.cmu.edu to be put on the mailing list. ;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; 
;;; This file loads all the garnet modules.
;;; 
;;; ** To prevent certain parts from being loaded, first set
;;;      user::load-XX-p to NIL.
;;; ** To get some of the parts which are not loaded by default to be loaded,
;;;    set user::load-XX-p to T.
;;; ** If you are a non-CMU user, set Your-Garnet-Pathname to be your local
;;;    Garnet directory, and set Your-CLX-Pathname to be your local CLX
;;;    directory.
;;; ** To override where something is loaded from, set Garnet-xx-PathName
;;;    before loading this file and/or Garnet-xx-src
;;;
;;; The controlling variables are:
;;; 
;;;      load-clx-p          (Default: NIL => clx not loaded)
;;;      load-kr-p           (Default: T   => kr loaded)
;;;      load-opal-p         (Default: T   => opal loaded)
;;;      load-inter-p        (Default: T   => interactors loaded)
;;;      load-multifont-p    (Default: NIL => multifont *NOT* loaded)
;;;      load-gesture-p      (Default: NIL => gestures *NOT* loaded)
;;;      load-ps-p           (Default: T   => ps loaded)
;;;      load-aggregadgets-p (Default: T   => aggregadgets loaded)
;;;      load-aggregraphs-p  (Default: NIL => aggregraphs *NOT* loaded)
;;;      load-gadgets-p      (Default: NIL => gadgets *NOT* loaded)
;;;      load-debug-p        (Default: T   => debugging tools loaded)
;;;      load-demos-p        (Default: NIL => demos *NOT* loaded)
;;;      load-c32-p          (Default: NIL => C32 *NOT* loaded)
;;;      load-gilt-p         (Default: NIL => gilt *NOT* loaded)
;;;      load-lapidary-p     (Default: NIL => lapidary *NOT* loaded)
;;;
;;; The first part of this file lists the file names where the various
;;; parts of Garnet come from.  This will need to be modified for each new
;;; installation of Garnet.
;;;
;;; To override any particular file name place, it is only necessary to
;;; assign the variable name Garnet-XX-Pathname before this file is loaded
;;; (since they are defined here using defvar, the old name will stay in
;;; affect).
;;;



#|
============================================================
Change log:

10/23/92 Dave Kosbie - Added KATIE package
08/17/92 Andrew Mickish - Added display check, changed names of switches,
           changed names of directories, changed method for determining
           Garnet pathnames
07/29/92 Andrew Mickish - :cmu-sparc now loads from cmu-bin, removed :cmu
           and :test versions.
07/23/92 Dario Giuse - moved loading of C32 before Lapidary, which needs it.
05/27/92 Joly - Interactors package should use kr package.
05/25/92 Joly/Pervin - Package CLTL1 does not exist in LispWorks.
05/21/92 Dario Giuse - Added load-c32-p.
05/14/92 Szekely/Pervin - Do not launch process if compiling.
05/04/92 Russell Almond - Added allegro-v4.1 switches.
04/22/92 Ed Pervin - Added launch-process-p switch.
04/10/92 Andrew Mickish - Added "gg:" prefix to garnet-load and garnet-compile
04/02/92 Rich McDaniel - Added load-multifont-p
03/13/92 Ed Pervin - Added :cmu-test
03/11/92 Andrew Mickish - Removed unlesses from CMU ext:search-list setf's
03/06/92 Andrew Mickish - Added *compiler-extension* switches
02/20/92 Andrew Mickish - Added package definitions for Explorer lisp;
           Added gesture pathnames, etc.
02/11/92 Andrew Mickish - Added :garnet-debug to *features* list;  changed
           pathnames from /afs/cs/ to /afs/cs.cmu.edu/.
04/25/91 Ed Pervin - Official release of version 1.4; alpha directory changed
           back to test.  No longer support :cmu-lucid3.1 and :cmu-lucid4.0.
04/19/91 Ed Pervin - Added lispworks to switches.
04/15/91 Ed Pervin - Changed (make-packages **) to
	   (unless (find-package **) (make-package **)).
04/03/91 Ed Pervin - Changed :sparc-test4.0 --> :sparc-test and
           added :pmax-test.
03/21/91 Ed Pervin - Release 1.4; test directory changed to alpha.
03/07/91 Andrew Mickish - Added aggregraphs.
03/07/91 Brad Myers - Made new motif-gilt-loader, and also garnet-load.
03/01/91 Ed Pervin - Added :sparc-test for version compiled in Allegro 4.0.
02/27/91 Dilip D'Souza - Added everything with #+allegro-v4.0 switches.
02/25/91 Ed Pervin - Pushed :garnet on *features* list.
01/24/91 Andrew Mickish - Added Gilt.
01/02/90 Andrew Mickish - Added :rt-test and :sparc-test options.
11/29/90 Brad Myers - Added :cmu-sparc option.
10/05/90 Ed Pervin - New variables Your-Garnet-Pathname and Your-CLX-Pathname
           which determine all the :external pathnames.
08/09/90 Ed Pervin - Release 1.3
08/07/90 Ed Pervin - rbd --> ecp
07/25/90 Ed Pervin - Added *dont-load-modules-twice*;  amickish --> preddy
04/02/90 Ed Pervin - Call xlib:load-clx in Lucid explicitly.
03/19/90 Ed Pervin - Got rid of Garnet-Font-Pathname
02/14/90 Ed Pervin - Added color screen option
01/04/90 Ed Pervin - Added :external option and version number
12/19/89 Ed Pervin - Now loads CLX.
12/13/89 Ed Pervin - Added :cmu-allegro option.
12/05/89 Brad Myers - Fixed so works with garnet-compiler
10/30/89 Brad Myers - New file structure and src directories;  changed
           dont-load-xx to load-xxx-p
10/17/89 Brad Myers - Added debug
08/18/89 Brad Myers - Added Toolkit
06/07/89 Brad Myers - Created
============================================================
|#

;; The function provide is no longer part of common lisp and so was
;; removed from the lisp package in the most recent release of
;; LispWorks (version 2.1 onwards). This will retrieve its definition.
#+lispworks (setf (symbol-function 'lisp::provide)
                  (symbol-function 'system::provide))
#+lispworks (export 'provide 'lisp)

#+(or allegro-v4.0 allegro-v4.1)
(setf excl::*cltl1-in-package-compatibility-p* t)
#+(or allegro-v4.0 allegro-v4.1)
(setf comp:*cltl1-compile-file-toplevel-compatibility-p* t)

(in-package "USER" :use '("LISP"))

#+(or allegro-v4.0 allegro-v4.1)
(progn
  (unless (find-package "KR")
    (make-package "KR" :use '("LISP" "CLTL1")))
  (unless (find-package "KR-DEBUG")
    (make-package "KR-DEBUG" :use '("LISP" "CLTL1")))
  (unless (find-package "OPAL")
    (make-package "OPAL" :use '("LISP" "KR" "CLTL1")))
  (unless (find-package "KATIE")
    (make-package "KATIE" :use '("LISP" "KR" "CLTL1")
		  :nicknames '("KT")))
  (unless (find-package "INTERACTORS")
    (make-package "INTERACTORS" :use '("LISP" "KR" "CLTL1")
		  :nicknames '("INTER")))
  (unless (find-package "GARNET-GADGETS")
    (make-package "GARNET-GADGETS" :use '("LISP" "KR" "CLTL1")
		  :nicknames '("GG")))
  (unless (find-package "GARNET-DEBUG")
    (make-package "GARNET-DEBUG" :use '("KR" "OPAL" "LISP" "CLTL1")
		  :nicknames '("GD")))
  (unless (find-package "GILT")
    (make-package "GILT" :use '("LISP" "KR" "CLTL1")))
  (unless (find-package "C32")
    (make-package "C32" :use '("LISP" "KR" "CLTL1")))
  (unless (find-package "GARNETDRAW")
    (make-package "GARNETDRAW" :use '("LISP" "KR" "CLTL1")))
  (unless (find-package "LAPIDARY")
    (make-package "LAPIDARY" :use '("LISP" "KR" "CLTL1"))))

#-(or allegro-v4.0 allegro-v4.1)
(progn
  (unless (find-package "KR")
    (make-package "KR" :use '("LISP")))
  (unless (find-package "KR-DEBUG")
    (make-package "KR-DEBUG" :use '("LISP")))
  (unless (find-package "OPAL")
    (make-package "OPAL" :use '("LISP" "KR")))
  (unless (find-package "INTERACTORS")
    (make-package "INTERACTORS" :use '("LISP" "KR")
		  :nicknames '("INTER")))
  (unless (find-package "GARNET-GADGETS")
    (make-package "GARNET-GADGETS" :use '("LISP" "KR")
		  :nicknames '("GG")))
  (unless (find-package "GARNET-DEBUG")
    (make-package "GARNET-DEBUG" :use '("KR" "OPAL" "LISP")
		  :nicknames '("GD")))
  (unless (find-package "GILT")
    (make-package "GILT" :use '("LISP" "KR")))
  (unless (find-package "C32")
    (make-package "C32" :use '("LISP" "KR")))
  (unless (find-package "GARNETDRAW")
    (make-package "GARNETDRAW" :use '("LISP" "KR")))
  (unless (find-package "LAPIDARY")
    (make-package "LAPIDARY" :use '("LISP" "KR"))))



(defparameter Garnet-Version-Number "2.1")
(pushnew :GARNET *features*)
(pushnew :GARNET-V2.1 *features*)

;;; The :GARNET-DEBUG option allows many different kinds of run-time checking,
;;; and also loads some extra test code.  After you have debugged your code
;;; and want it to run faster, remove :GARNET-DEBUG from the *features* list
;;; and RECOMPILE all of Garnet and your code.  The result will be smaller and
;;; somewhat faster.
;;; To remove :GARNET-DEBUG from the *features* list, either defvar
;;; Garnet-Garnet-Debug to NIL before you load the garnet-loader, or simply
;;; comment out the next few lines.
(defvar Garnet-Garnet-Debug T)
(if Garnet-Garnet-Debug
    (pushnew :garnet-debug *features*)
    (setf *features* (delete :garnet-debug *features*)))

;;; *dont-load-modules-twice* tells whether to re-load modules
;;; if a user loads garnet-loader.lisp a second time.
(defparameter *dont-load-modules-twice* t)

(unless (boundp '*Garnet-Going-To-Compile*)
  (defvar load-kr-p T)
  (defvar load-opal-p T)
  (defvar load-inter-p T)
  (defvar load-multifont-p NIL)
  (defvar load-gesture-p NIL)
  (defvar load-ps-p T)
  (defvar load-aggregadgets-p T)
  (defvar load-aggregraphs-p NIL)
  (defvar load-debug-p #+garnet-debug T #-garnet-debug NIL)
  (defvar load-gadgets-p NIL)
  (defvar load-demos-p NIL)
  (defvar load-lapidary-p NIL)
  (defvar load-gilt-p NIL)
  (defvar load-c32-p NIL))

;;; load-XX-p control whether the various parts are loaded or not
;;; Because these use defvar, if they are set before this file is
;;; loaded, their original value will be used.

(defvar load-clx-p #+clx NIL #-clx T)

;;; launch-process-p controls whether Garnet will launch
;;; a separate process to detect keyboard and mouse events.
(defvar launch-process-p T)

;;; update-locking-p controls whether process locks will be activated
;;; around the update method (this keeps two processes from calling update
;;; at the same time).
(defvar update-locking-p T
  "If T, uses process locks to keep Update in a process from interrupting
   itself in a different process.")

(defun Version-Error ()
  (error "Could not determine which compiled binaries are appropriate to
load into your lisp.  Please set user::Garnet-Version before loading
Garnet-Loader again."))

(defun Get-Garnet-Version ()
  #+sparc    (or #+allegro :sparc-allegro
		 #+cmu     :sparc-cmucl
		 #+lucid   :sparc-lucid
		 #-(and allegro cmu lucid) (version-error))
  #+dec3100  (or #+allegro :pmax-allegro
		 #-allegro (version-error))
  #+hp       (or #+lucid   :hp-lucid
		 #-lucid   (version-error))
  #+clisp    :clisp
  #-(or sparc dec3100 hp clisp) (version-error))

;;; Garnet-Version controls where the files are loaded from.
;;; Because this is a defvar, if Garnet-Version is set before this file is
;;; loaded, its original value will be used.

;;; Garnet-Version should be set to :external for non-CMU users, and
;;; Your-Garnet-Pathname should be set appropriately.
;;;
(defvar garnet-version :external)

(format T "** Loading Garnet Version ~a from ~s~%" Garnet-Version-Number Garnet-Version)


;;; Insert your pathname of Garnet into Your-Garnet-Pathname and where
;;; your CLX comes from into Your-CLX-pathname.  All the :external pathnames
;;; will depend on these two pathnames.

(defvar Your-CLX-Pathname
  (if (eq garnet-version :external)
      "~/lisp/clx/"                ;; SET THIS
      "/usr/misc/.allegro/lib/code/"))
(defvar Your-Garnet-Pathname
  (if (eq garnet-version :external)
      "~/lisp/garnet/"                ;; SET THIS
      "/afs/cs.cmu.edu/project/garnet/test/"))


(defun Get-Garnet-Binary-Pathname (version)
  (let ((directory-name
	 (case version
	   (:external "bin/")
	   (:sparc-allegro "sparc-allegro-bin/")
	   (:sparc-cmucl "sparc-cmucl-bin/")
	   (:sparc-lucid "sparc-lucid-bin/")
	   (:pmax-allegro "pmax-allegro-bin/")
	   (:hp-lucid "hp-lucid-bin/")
           (:clisp "clisp-bin/")
	   (t (error "~S is an invalid garnet-version" version)))))
    (merge-pathnames directory-name Your-Garnet-Pathname)))


(defvar Garnet-Src-Pathname (merge-pathnames "src/" Your-Garnet-Pathname))
(defvar Garnet-Binary-Pathname (Get-Garnet-Binary-Pathname garnet-version))
(defvar Garnet-Lib-Pathname (merge-pathnames "lib/" Your-Garnet-Pathname))
(defvar CLX-Pathname Your-CLX-Pathname)

(defvar Garnet-KR-Src (merge-pathnames "kr/" Garnet-Src-Pathname))
(defvar Garnet-KR-Pathname (merge-pathnames "kr/" Garnet-Binary-Pathname))
(defvar Garnet-Opal-Src (merge-pathnames "opal/" Garnet-Src-Pathname))
(defvar Garnet-Opal-Pathname (merge-pathnames "opal/" Garnet-Binary-Pathname))
(defvar Garnet-Inter-Src
  (merge-pathnames "inter/" Garnet-Src-Pathname))
(defvar Garnet-Inter-Pathname
  (merge-pathnames "inter/" Garnet-Binary-Pathname))
(defvar Garnet-Gesture-Src
  (merge-pathnames "gesture/" Garnet-Src-Pathname))
(defvar Garnet-Gesture-Pathname
  (merge-pathnames "gesture/" Garnet-Binary-Pathname))
(defvar Garnet-Aggregadgets-Src
  (merge-pathnames "aggregadgets/" Garnet-Src-Pathname))
(defvar Garnet-Aggregadgets-Pathname
  (merge-pathnames "aggregadgets/" Garnet-Binary-Pathname))
(defvar Garnet-PS-Src (merge-pathnames "ps/" Garnet-Src-Pathname))
(defvar Garnet-PS-Pathname (merge-pathnames "ps/" Garnet-Binary-Pathname))
(defvar Garnet-Gadgets-Src
  (merge-pathnames "gadgets/" Garnet-Src-Pathname))
(defvar Garnet-Gadgets-Pathname
  (merge-pathnames "gadgets/" Garnet-Binary-Pathname))
(defvar Garnet-Debug-Src
  (merge-pathnames "debug/" Garnet-Src-Pathname))
(defvar Garnet-Debug-Pathname
  (merge-pathnames "debug/" Garnet-Binary-Pathname))
(defvar Garnet-Demos-Src
  (merge-pathnames "demos/" Garnet-Src-Pathname))
(defvar Garnet-Demos-Pathname
  (merge-pathnames "demos/" Garnet-Binary-Pathname))
(defvar Garnet-Gilt-Src (merge-pathnames "gilt/" Garnet-Src-Pathname))
(defvar Garnet-Gilt-Pathname (merge-pathnames "gilt/" Garnet-Binary-Pathname))
(defvar Garnet-C32-Src (merge-pathnames "c32/" Garnet-Src-Pathname))
(defvar Garnet-C32-Pathname (merge-pathnames "c32/" Garnet-Binary-Pathname))
(defvar Garnet-Lapidary-Src
  (merge-pathnames "lapidary/" Garnet-Src-Pathname))
(defvar Garnet-Lapidary-Pathname
  (merge-pathnames "lapidary/" Garnet-Binary-Pathname))
(defvar Garnet-Contrib-Src
  (merge-pathnames "contrib/" Garnet-Src-Pathname))
(defvar Garnet-Contrib-Pathname
  (merge-pathnames "contrib/" Garnet-Binary-Pathname))

(defvar Garnet-Bitmap-Pathname
  (merge-pathnames "bitmaps/" Garnet-Lib-Pathname))
(defvar Garnet-Pixmap-Pathname
  (merge-pathnames "pixmaps/" Garnet-Lib-Pathname))
(defvar Garnet-Gilt-Bitmap-Pathname
  (merge-pathnames "gilt/" Garnet-Lib-Pathname))
(defvar Garnet-C32-Bitmap-Pathname
  (merge-pathnames "c32/" Garnet-Lib-Pathname))
(defvar Garnet-DataFile-Pathname (merge-pathnames "data/" Garnet-Lib-Pathname))
(defvar Garnet-Gesture-Data-Pathname
  (merge-pathnames "gesture/" Garnet-Lib-Pathname))


;;;----------------------------------------------------------

;;; When compiling, the binaries will be in the same directories as the
;;; source files, so make all the path names be the same
;;;
;;; After compilation is finished, the user should move all the binaries
;;; into their own directories, as specified by the pathnames above.
(defvar *Garnet-Going-To-Compile*)

(when (and (boundp '*Garnet-Going-To-Compile*)
	   *Garnet-Going-To-Compile*)
  (setf Garnet-KR-Pathname Garnet-KR-Src)
  (setf Garnet-Opal-Pathname Garnet-Opal-Src)
  (setf Garnet-Inter-Pathname Garnet-Inter-Src)
  (setf Garnet-Gesture-Pathname Garnet-Gesture-Src)
  (setf Garnet-PS-Pathname Garnet-PS-Src)
  (setf Garnet-Aggregadgets-Pathname Garnet-Aggregadgets-Src)
  (setf Garnet-Gadgets-Pathname Garnet-Gadgets-Src)
  (setf Garnet-Debug-Pathname Garnet-Debug-Src)
  (setf Garnet-Demos-Pathname Garnet-Demos-Src)
  (setf Garnet-Gilt-Pathname Garnet-Gilt-Src)
  (setf Garnet-C32-Pathname Garnet-C32-Src)
  (setf Garnet-Lapidary-Pathname Garnet-Lapidary-Src)
  (setf Garnet-Contrib-Pathname Garnet-Contrib-Src)
  )

;;;----------------------------------------------------------

;;; If at cmu, then set up the search lists
#+cmu
(progn
  (setf (ext:search-list "kr:")
	(list (namestring Garnet-KR-PathName)))
  (setf (ext:search-list "kr-src:")
	(list (namestring Garnet-KR-Src)))

  (setf (ext:search-list "opal:")
	(list (namestring Garnet-Opal-PathName)))
  (setf (ext:search-list "opal-src:")
	(list (namestring Garnet-Opal-Src)))

  (setf (ext:search-list "inter:")
	(list (namestring Garnet-Inter-PathName)))
  (setf (ext:search-list "inter-src:")
	(list (namestring Garnet-Inter-Src)))

  (setf (ext:search-list "gesture:")
	(list (namestring Garnet-Gesture-PathName)))
  (setf (ext:search-list "gesture-src:")
	(list (namestring Garnet-Gesture-Src)))
  (setf (ext:search-list "gesture-data:")
	(list (namestring Garnet-Gesture-Data-PathName)))

  (setf (ext:search-list "ps:")
	(list (namestring Garnet-PS-PathName)))
  (setf (ext:search-list "ps-src:")
	(list (namestring Garnet-PS-Src)))

  (setf (ext:search-list "aggregadgets:")
	(list (namestring Garnet-Aggregadgets-PathName)))
  (setf (ext:search-list "aggregadgets-src:")
	(list (namestring Garnet-Aggregadgets-Src)))

  (setf (ext:search-list "gadgets:")
	(list (namestring Garnet-Gadgets-PathName)))
  (setf (ext:search-list "gadgets-src:")
	(list (namestring Garnet-Gadgets-Src)))

  (setf (ext:search-list "debug:")
	(list (namestring Garnet-Debug-PathName)))
  (setf (ext:search-list "debug-src:")
	(list (namestring Garnet-Debug-Src)))

  (setf (ext:search-list "demos:")
	(list (namestring Garnet-Demos-PathName)))
  (setf (ext:search-list "demos-src:")
	(list (namestring Garnet-Demos-Src)))

  (setf (ext:search-list "gilt:")
	(list (namestring Garnet-Gilt-PathName)))
  (setf (ext:search-list "gilt-src:")
	(list (namestring Garnet-Gilt-Src)))

  (setf (ext:search-list "c32:")
	(list (namestring Garnet-C32-PathName)))
  (setf (ext:search-list "c32-src:")
	(list (namestring Garnet-C32-Src)))

  (setf (ext:search-list "lapidary:")
	(list (namestring Garnet-Lapidary-PathName)))
  (setf (ext:search-list "lapidary-src:")
	(list (namestring Garnet-Lapidary-Src)))

  (setf (ext:search-list "contrib:")
	(list (namestring Garnet-Contrib-PathName)))
  (setf (ext:search-list "contrib-src:")
	(list (namestring Garnet-Contrib-Src)))

  )

(defparameter CLX-Loader
  #+lucid (merge-pathnames "defsystem" CLX-Pathname)
  #+(or cmu allegro) (merge-pathnames "clx" CLX-Pathname)
  #+clisp nil
)

(defparameter Garnet-KR-Loader
  (merge-pathnames "kr-loader"
		   #+cmu "kr:"
		   #+(not cmu) Garnet-KR-PathName))

(defparameter Garnet-Opal-Loader
  (merge-pathnames "opal-loader"
		   #+cmu "opal:"
		   #+(not cmu) Garnet-Opal-PathName))

(defparameter Garnet-Inter-Loader
  (merge-pathnames "inter-loader"
		   #+cmu "inter:"
		   #+(not cmu) Garnet-Inter-PathName))

(defparameter Garnet-Multifont-Loader
  (merge-pathnames "multifont-loader"
		   #+cmu "opal:"
		   #+(not cmu) Garnet-Opal-PathName))

(defparameter Garnet-Gesture-Loader
  (merge-pathnames "gesture-loader"
		   #+cmu "gesture:"
		   #+(not cmu) Garnet-Gesture-PathName))

(defparameter Garnet-PS-Loader
  (merge-pathnames "ps-loader"
		   #+cmu "ps:"
		   #+(not cmu) Garnet-PS-PathName))

(defparameter Garnet-Aggregadgets-Loader
  (merge-pathnames "aggregadgets-loader"
		   #+cmu "aggregadgets:"
		   #+(not cmu) Garnet-Aggregadgets-PathName))

(defparameter Garnet-Aggregraphs-Loader
  (merge-pathnames "aggregraphs-loader"
		   #+cmu "aggregadgets:"
		   #+(not cmu) Garnet-Aggregadgets-PathName))

(defparameter Garnet-Gadgets-Loader
  (merge-pathnames "gadgets-loader"
		   #+cmu "gadgets:"
		   #+(not cmu) Garnet-Gadgets-PathName))

(defparameter Garnet-Debug-Loader
  (merge-pathnames "debug-loader"
		   #+cmu "debug:"
		   #+(not cmu) Garnet-Debug-PathName))

(defparameter Garnet-Demos-Loader
  (merge-pathnames "demos-loader"
		   #+cmu "demos:"
		   #+(not cmu) Garnet-Demos-PathName))

(defparameter Garnet-Gilt-Loader
  (merge-pathnames "gilt-loader"
		   #+cmu "gilt:"
		   #+(not cmu) Garnet-Gilt-PathName))

(defparameter Garnet-Motif-Gilt-Loader
  (merge-pathnames "motif-gilt-loader"
		   #+cmu "gilt:"
		   #+(not cmu) Garnet-Gilt-PathName))

(defparameter Garnet-C32-Loader
  (merge-pathnames "c32-loader"
		   #+cmu "c32:"
		   #+(not cmu) Garnet-C32-PathName))

(defparameter Garnet-Lapidary-Loader
  (merge-pathnames "lapidary-loader"
		   #+cmu "lapidary:"
		   #+(not cmu) Garnet-Lapidary-PathName))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

;;;
;;; The real load
;;;

(format t "...Loading Garnet ...~%")
(setf *load-verbose* t)

;;;Patches for CLX on the RT.
;;;(load "/afs/cs.cmu.edu/project/clisp-1/chiles/archive/clx-r3/clx")
;;;(load "/afs/cs.cmu.edu/project/clisp-1/chiles/archive/clx-r3/display")

#-clisp ;; use clx.mem instead of loading CLX afterwards
(when load-clx-p
   (format T "~% %%%%%%% Loading CLX %%%%%%%%~%")
   (load CLX-Loader))
#+lucid
(when load-clx-p
#+lcl3.0 (funcall (find-symbol 'load-clx 'xlib) CLX-Pathname)
#-lcl3.0 (     load-clx CLX-Pathname))
#-cmu
(unless load-clx-p (format T "~%****** NOT Loading CLX *******~%"))

;;;
;;;  Functions that will determine whether the display can be opened
;;;

(defun get-full-display-name ()
   #+cmu (cdr (assoc :DISPLAY lisp::*environment-list*))
   #+(or allegro lispworks kcl clisp) (sys::getenv "DISPLAY")
   #+(and lucid lcl3.0) (lucid-common-lisp:environment-variable "DISPLAY")
   #+(and lucid (not lcl3.0)) (system:environment-variable "DISPLAY")
   )

(defun get-display-name (display)
  (do* ((dlist (coerce display 'list) (cdr dlist))
        (c (car dlist) (car dlist))
        (namelist nil))
       ((or (eq c nil) (eq c '#\:)) (coerce (reverse namelist) 'string))
    (push c namelist)))

(defun get-display-number (display)
  (let* ((dlist (coerce display 'list))
         (numstr (progn
                   (do ((c (pop dlist) (pop dlist)))
                       ((or (eq c nil) (eq c '#\:))))
                   (do ((c (pop dlist) (pop dlist))
                        (numlist nil))
                       ((or (eq c nil) (eq c '#\.))
                        (coerce (reverse numlist) 'string))
		     (push c numlist))))
         (num (if (equal numstr "") 0 (read-from-string numstr))))
    num))

(defun verify-display-can-be-opened ()
  (let* ((full-display-name (get-full-display-name))
	 (d-name (if full-display-name
		     (get-display-name full-display-name)
		     #-(or allegro clisp) (machine-instance)
                     #+clisp ""
		     #+allegro (short-site-name)))
	 (d-number (get-display-number full-display-name))
	 val errorp)
    (multiple-value-setq (val errorp)
	#+cmu (ignore-errors (xlib:open-display d-name :display d-number))
	#+lcl3.0 (system::ignore-errors
		  (xlib:open-display d-name :display d-number))
	#+allegro (excl::ignore-errors
		   (xlib:open-display d-name :display d-number))
	#-(or cmu lcl3.0 allegro)
	  (xlib:open-display d-name :display d-number) ; just try it
	  )
    (if errorp
	(error "Could not open a display for ~S.
     You must already be running X to load or compile Garnet.  Your DISPLAY
environment variable must be set with the name of the machine on which the
Garnet windows will be displayed.  Please exit lisp and execute a command
like the following to the unix shell before loading or compiling Garnet:
  \"setenv DISPLAY windowmachine.cs.cmu.edu:0.0\"
  \"setenv DISPLAY unix:0.0\"
  \"setenv DISPLAY 0.0\"
The last two values may be more efficient when you want the Garnet windows
to appear on the same machine that Garnet is running on.
     Additionally, you must execute the command \"xhost +\" on the machine
that the windows will be displayed on, if it is different from the machine
running Garnet."
	       full-display-name)
	T)))

(verify-display-can-be-opened)

;;;
;;; Other auxiliary functions
;;;

(defun probe-directory (filename)
  #+clisp (let ((*error-handler*
                  #'(lambda (&rest args) (return-from probe-directory nil))
               ))
            ; The following causes an error if the directory does not exist
            (and (truename filename) t)
          )
  #-clisp (probe-file filename)
)
(import 'probe-directory "LISP")
(export 'probe-directory "LISP")

;;;
;;; Now back to loading Garnet
;;;

(if load-kr-p
    (if (and *dont-load-modules-twice* (get :garnet-modules :kr))
	(format T "~%****** KR already loaded *******~%")
        (progn
          (format T "~% %%%%%%%% Loading KR %%%%%%%%~%")
          (load Garnet-KR-Loader)))
    (format T "~%****** NOT Loading KR *******~%"))

(if load-opal-p
    (if (and *dont-load-modules-twice* (get :garnet-modules :opal))
	(format T "~%****** Opal already loaded *******~%")
        (progn
          (format T "~% %%%%%%%% Loading Opal %%%%%%%%~%")
          (load Garnet-Opal-Loader)))
    (format T "~%****** NOT Loading Opal *******~%"))

(if load-inter-p
    (if (and *dont-load-modules-twice* (get :garnet-modules :inter))
	(format T "~%****** Interactors already loaded *******~%")
        (progn
          (format T "~% %%%%%%%% Loading Interactors %%%%%%%%~%")
          (load Garnet-Inter-Loader)))
    (format T "~%****** NOT Loading Interactors *******~%"))

(if load-multifont-p
    (if (and *dont-load-modules-twice* (get :garnet-modules :multifont))
	(format T "~%****** Multifont already loaded *******~%")
        (progn
          (format T "~% %%%%%%%% Loading Multifont %%%%%%%%~%")
          (load Garnet-Multifont-Loader)))
    (format T "~%****** NOT Loading Multifont *******~%"))

(if load-gesture-p
    (if (and *dont-load-modules-twice* (get :garnet-modules :gesture))
	(format T "~%****** Gestures already loaded *******~%")
        (progn
          (format T "~% %%%%%%%% Loading Gestures %%%%%%%%~%")
          (load Garnet-Gesture-Loader)))
    (format T "~%****** NOT Loading Gestures *******~%"))

(if load-ps-p
    (if (and *dont-load-modules-twice* (get :garnet-modules :ps))
	(format T "~%****** PS already loaded *******~%")
        (progn
          (format T "~% %%%%%%%% Loading PS %%%%%%%%~%")
          (load Garnet-PS-Loader)))
    (format T "~%****** NOT Loading PS *******~%"))

(if load-aggregadgets-p
    (if (and *dont-load-modules-twice* (get :garnet-modules :aggregadgets))
	(format T "~%****** Aggregadgets already loaded *******~%")
        (progn
          (format T "~% %%%%%%%% Loading Aggregadgets %%%%%%%%~%")
          (load Garnet-Aggregadgets-Loader)))
    (format T "~%****** NOT Loading Aggregadgets *******~%"))

(if load-aggregraphs-p
    (if (and *dont-load-modules-twice* (get :garnet-modules :aggregraphs))
	(format T "~%****** Aggregraphs already loaded *******~%")
        (progn
          (format T "~% %%%%%%%% Loading Aggregraphs %%%%%%%%~%")
          (load Garnet-Aggregraphs-Loader)))
    (format T "~%****** NOT Loading Aggregraphs *******
** To load aggregraph programs, execute (load Garnet-Aggregraphs-Loader)~%"))


(if load-gadgets-p
    (if (and *dont-load-modules-twice* (get :garnet-modules :gadgets))
	(format T "~%****** Gadgets already loaded *******~%")
        (progn
          (format T "~% %%%%%%%% Loading Gadgets %%%%%%%%~%")
          (load Garnet-Gadgets-Loader)))
    (format T "~%****** NOT Loading Gadgets *******~%"))

(if load-debug-p
    (if (and *dont-load-modules-twice* (get :garnet-modules :debug))
	(format T "~%****** Debugging programs already loaded *******~%")
        (progn
          (format T "~% %%%%%%%% Loading Debugging programs %%%%%%%%~%")
          (load Garnet-Debug-Loader)))
    (format T "~%****** NOT Loading Debug Files *******
** To load debug programs, execute (load Garnet-Debug-Loader)~%"))

(if load-demos-p
    (if (and *dont-load-modules-twice* (get :garnet-modules :demos))
	(format T "~%****** Demos already loaded *******~%")
        (progn
          (format T "~% %%%%%%%% Loading Demos %%%%%%%%~%")
          (load Garnet-Demos-Loader)))
    (format T "~%****** NOT Loading Demos *******
** To load Demos, execute (load Garnet-Demos-Loader)~%"))

(if load-gilt-p
    (if (and *dont-load-modules-twice* (get :garnet-modules :gilt))
	(format T "~%****** Gilt already loaded *******~%")
        (progn
          (format T "~% %%%%%%%% Loading Gilt %%%%%%%%~%")
          (load Garnet-Gilt-Loader)))
    (format T "~%****** NOT Loading Gilt *******
** To load Gilt, execute (load Garnet-Gilt-Loader) or
   (load Garnet-Motif-Gilt-Loader)~%"))

(if load-c32-p
    (if (and *dont-load-modules-twice* (get :garnet-modules :c32))
	(format T "~%****** C32 already loaded *******~%")
        (progn
          (format T "~% %%%%%%%% Loading C32 %%%%%%%%~%")
          (load Garnet-C32-Loader)))
    (format T "~%****** NOT Loading C32 *******
** To load C32, execute (load Garnet-C32-Loader)~%"))

(if load-lapidary-p
    (if (and *dont-load-modules-twice* (get :garnet-modules :lapidary))
	(format T "~%****** Lapidary already loaded *******~%")
        (progn
          (format T "~% %%%%%%%% Loading Lapidary %%%%%%%%~%")
          (load Garnet-Lapidary-Loader)))
    (format T "~%****** NOT Loading Lapidary *******
** To load Lapidary, execute (load Garnet-Lapidary-Loader)~%"))



;--------------------------------------------------------------------
(defun user::Garnet-Load (filename)
  (let ((pos (position #\: filename)))
    (if pos
	(let* ((head (subseq filename 0 pos))
	       (tail (subseq filename (1+ pos)))
	       (prefix (cond
			 ((string= head "clx") CLX-PathName)
			 ((string= head "kr") Garnet-KR-PathName)
			 ((string= head "opal") Garnet-Opal-Pathname)
			 ((string= head "inter") Garnet-Inter-PathName)
			 ((string= head "gesture") Garnet-Gesture-PathName)
			 ((string= head "gestures") Garnet-Gesture-PathName)
			 ((string= head "ps") Garnet-PS-PathName)
			 ((string= head "aggregadgets") Garnet-Aggregadgets-PathName)
			 ((string= head "gadgets") Garnet-Gadgets-PathName)
			 ((string= head "gg") Garnet-Gadgets-PathName)
			 ((string= head "debug") Garnet-Debug-PathName)
			 ((string= head "demos") Garnet-Demos-PathName)
			 ((string= head "demo") Garnet-Demos-PathName)
			 ((string= head "gilt") Garnet-Gilt-PathName)
			 ((string= head "c32") Garnet-C32-PathName)
			 ((string= head "lapidary") Garnet-Lapidary-PathName)
			 ((string= head "contrib") Garnet-Contrib-PathName)
			 ((string= head "kr-src") Garnet-KR-Src)
			 ((string= head "opal-src") Garnet-Opal-Src)
			 ((string= head "inter-src") Garnet-Inter-Src)
			 ((string= head "gesture-src") Garnet-Gesture-Src)
			 ((string= head "gestures-src") Garnet-Gesture-Src)
			 ((string= head "ps-src") Garnet-PS-Src)
			 ((string= head "aggregadgets-src") Garnet-Aggregadgets-Src)
			 ((string= head "gadgets-src") Garnet-Gadgets-Src)
			 ((string= head "gg-src") Garnet-Gadgets-Src)
			 ((string= head "debug-src") Garnet-Debug-Src)
			 ((string= head "demos-src") Garnet-Demos-Src)
			 ((string= head "demo-src") Garnet-Demos-Src)
			 ((string= head "gilt-src") Garnet-Gilt-Src)
			 ((string= head "c32-src") Garnet-C32-Src)
			 ((string= head "lapidary-src") Garnet-Lapidary-Src)
			 ((string= head "contrib-src") Garnet-Contrib-Src)
			 (t (error "Bad prefix ~%" head))))
	       (finalname (merge-pathnames tail prefix)))
	  (format T "Loading ~s~%" finalname)
	  (load finalname))
	;; else no colon, load regular
	(progn
	  (format T "NO COLON, Loading ~s~%" filename)
	  (load filename)))))

;;; 
;;; This function will compile your garnet files while keeping the
;;; sources and binaries separated.  If you want to just compile one
;;; file from Garnet, like the gadget file gauge.lisp, then you could
;;; use this function to compile the source file and automatically
;;; save the binary file in the bin directory.
;;;
;;; Example:
;;;    (garnet-compile "gadgets:gauge") 
;;;    Takes the source file from Garnet-Gadgets-Src, compiles it, and
;;;    saves the binary file in Garnet-Gadgets-Pathname (the binary
;;;    gadgets directory).
;;;
(defvar *compiler-extension*
  #+allegro ".fasl"
  #+lucid   ".sbin"
  #+(and cmu sparc)       ".sparcf"
  #+(and cmu (not sparc)) ".fasl")

(defun user::Garnet-Compile (filename)
  (let ((pos (position #\: filename)))
    (if pos
	(let* ((head (subseq filename 0 pos))
	       (tail (subseq filename (1+ pos)))
	       (src-prefix (cond
		 ((string= head "clx") CLX-Src)
		 ((string= head "kr") Garnet-KR-Src)
		 ((string= head "opal") Garnet-Opal-Src)
		 ((string= head "inter") Garnet-Inter-Src)
		 ((string= head "gesture") Garnet-Gesture-Src)
		 ((string= head "gestures") Garnet-Gesture-Src)
		 ((string= head "ps") Garnet-PS-Src)
		 ((string= head "aggregadgets") Garnet-Aggregadgets-Src)
		 ((string= head "gadgets") Garnet-Gadgets-Src)
		 ((string= head "gg") Garnet-Gadgets-Src)
		 ((string= head "debug") Garnet-Debug-Src)
		 ((string= head "demos") Garnet-Demos-Src)
		 ((string= head "demo") Garnet-Demos-Src)
		 ((string= head "gilt") Garnet-Gilt-Src)
		 ((string= head "c32") Garnet-C32-Src)
		 ((string= head "lapidary") Garnet-Lapidary-Src)
		 ((string= head "contrib") Garnet-Contrib-Src)
		 (t (error (concatenate 'string "Bad prefix " head)))))
	       (bin-prefix (cond
		 ((string= head "clx") CLX-PathName)
		 ((string= head "kr") Garnet-KR-PathName)
		 ((string= head "opal") Garnet-Opal-PathName)
		 ((string= head "inter") Garnet-Inter-PathName)
		 ((string= head "gesture") Garnet-Gesture-PathName)
		 ((string= head "gestures") Garnet-Gesture-PathName)
		 ((string= head "ps") Garnet-PS-PathName)
		 ((string= head "aggregadgets") Garnet-Aggregadgets-PathName)
		 ((string= head "gadgets") Garnet-Gadgets-PathName)
		 ((string= head "gg") Garnet-Gadgets-PathName)
		 ((string= head "debug") Garnet-Debug-PathName)
		 ((string= head "demos") Garnet-Demos-PathName)
		 ((string= head "demo") Garnet-Demos-PathName)
		 ((string= head "gilt") Garnet-Gilt-PathName)
		 ((string= head "c32") Garnet-C32-PathName)
		 ((string= head "lapidary") Garnet-Lapidary-PathName)
		 ((string= head "contrib") Garnet-Contrib-PathName)
		 (t (error (concatenate 'string "Bad prefix " head)))))
	       (src-finalname (merge-pathnames
				(concatenate 'string tail ".lisp")
				src-prefix))
	       (bin-finalname (merge-pathnames
			        (concatenate 'string tail *compiler-extension*)
				bin-prefix)))
	  (format T "Compiling ~s~%" src-finalname)
	  (format T "for output to ~s~%" bin-finalname)
	  (compile-file src-finalname :output-file bin-finalname))
	;; else no colon, abort
	(error "NO COLON, aborting compile"))))


(format t "~%... Garnet Load Complete ...~%")
