;;; -*- Mode: Lisp; Package: System -*-
;;;
;;; **********************************************************************
;;; This code was written as part of the CMU Common Lisp project at
;;; Carnegie Mellon University, and has been placed in the public domain.
;;;

;;; Heavy modifications by Peter Van Eynde

(in-package "SYSTEM")

(if (probe-file "/etc/lisp-config.lisp")
    (load "/etc/lisp-config.lisp")
  (format t "~%;;; Hey: there is no /etc/lisp-config.lisp file, please run cmuclconfig"))

;;; If you have sources installed on your system, un-comment the following form
;;; and change it to point to the source location.  This will allow the Hemlock
;;; "Edit Definition" command and the debugger to find sources for functions in
;;; the core.
(setf (ext:search-list "target:")
      '(
        "/usr/share/common-lisp/source/cmucl/"      ; object dir
        ))

(setf (ext:search-list "library:") '("/usr/lib/cmucl/"))
;;; for safety...

;;; optional extentions to the lisp image: delete if you
;;; don't like them :-).
(in-package :common-lisp-user)

(defvar hs-index (make-hash-table))

(defun read-hyperspec-index ()
  (with-open-file (table
                   "/usr/share/doc/hyperspec/Data/Symbol-Table.text"
		   :direction :input
		   :if-does-not-exist nil)
    (if (not table)
	(format t "I can't find the symbol table of the Hyperspec,~%Are you sure you've installed the hyperspec package?~%")
	(progn
	  (loop
	   (let* ((symbol (read table nil :einde))
		  (section (read-line table nil :einde)))
	     (if (or (eq symbol :einde)
		     (eq section :einde))
		 (return))
	     (setf (gethash symbol hs-index)
		   section)))))))

(defun lookup-in-hyperspec (key)
  (if (not (gethash 'nil hs-index))
      (read-hyperspec-index))
  (concatenate 'string "/usr/share/doc/hyperspec/Data/"
	       (gethash key hs-index)))

(defun show-hs (symbol)
  "Shows the definition of a lisp symbol in the HyperSpec in a Netscape
  window, or opens Netscape if it can."
  (when (not (gethash 'nil hs-index))
    (read-hyperspec-index))
  (if (not (gethash symbol hs-index))
      (format t "Symbol ~A not found in hyperspec, sorry~%"
	      symbol)
      ;; stupid but works: if there isn't a window open
      ;; the remote will fail, so we try to start a new
      ;; window :-)
      (unless (= 0
	       (process-exit-code
		(run-program "netscape"
			     (list "-remote" (format
					      nil "openURL(file:~A)"
					      (lookup-in-hyperspec symbol)))
			     :env *ENVIRONMENT-LIST*
			     :wait nil
			     :input nil
			     :output nil
			     :error nil)))
	(run-program "netscape"
		     (list (format nil "file:~A"
				   (lookup-in-hyperspec symbol)))
		     :env *ENVIRONMENT-LIST*
		     :wait nil
		     :input nil
		     :output nil
		     :error nil))))

;;; newbie functions, delete if you don't like them, but
;;; also modify the *herald-items* above

#-hemlock
(defun ed (&rest rest)
  (format t "Sorry, you haven't loaded the hemlock package.~%~ 
Configure it in by executing /usr/lib/cmucl/config~
, or do: ~%(load ~Clibrary:subsystems/hemlock-library~C)~%~
Note that this library depends on CLX, so load it too. (load ~Csubsystems/clx-library~C)~%"
 #\" #\" #\" #\"))

(defun help ()
  (format t "~
Welcome to CMUCL for Linux.

If you aren't running this with ilisp in emacs,
or aren't intending to use hemlock then you
deserve to lose. :-)

Read the documentation in /usr/share/doc/cmucl.

Create your own personal image with
/usr/lib/cmucl/config

(quit) is to quit.
(ed) starts hemlock (if installed)
(demo) shows a list of demos
(describe 'progn) gives information about progn for 
 example.
(inspect '*a*) interactively inspects *a* for example.
"))

(defun demo ()
  (format t "Some demos are in the source package, some in the
normal package.

General demos:
CLX demos:
 if you have loaded clx you can do:
 (load \"/usr/src/cmucl/cmucl/src/clx/demo/hello\")
 (xlib::hello-world \"\")
 (load \"/usr/src/cmucl/cmucl/src/clx/demo/menu\")
 (xlib::just-say-lisp \"slartibartfast.org\")
 (xlib::pop-up \"g\"
	       '(\"Linux\" \"FreeBSD\" \"OpenBSD\"))
  exit by pressing control+C followed by a keypress.

Clue demos:
 if you have clue loaded you can do: (after uncompressing the demo file)
 (load \"/usr/doc/clue/examples/menu\")
 (clue-examples::beatlemenuia \"\")
 (clue-examples::pick-one \"\"
			  \"One\"
			  \"Two\"
			  \"Three\")
 (clue-examples::just-say-lisp \"\")

Clio demos:
 if you have clio loaded you can do:
 (load \"/usr/doc/clio/examples/defsystem\")
 (load-clio-examples :host nil
		     :directory \"/usr/doc/clio/examples/defsystem\"
		     :compile-p nil)
 This doesn't work 100% :-(

(clio-examples::sketch :host  \"\")

Pictures demos:
 don't work with me.

Tk demos:
 if you have lisp-tk loaded you can do:
 (tk::tkconnect)
 (load \"/usr/src/tk/demo/load-all\")
 the gc monitor doesn't work yet.

"))

(load "/usr/share/common-lisp/source/common-lisp-controller/common-lisp-controller.lisp")

(common-lisp-controller:init-common-lisp-controller 
 (cond
   ((member :high-security *features*)
    "/usr/lib/common-lisp/cmucl-safe/")
   ((member :small *features*)
    "/usr/lib/common-lisp/cmucl-small/")
   (t
    "/usr/lib/common-lisp/cmucl-normal/")))

;;; make the directory if you're nobody:
(or
 (ignore-errors
   (ensure-directories-exist 
    (make-pathname 
     :directory
     (pathname-directory    
      (translate-logical-pathname "cl-library:;defsystem;defsystem.x86f")))))
 (warn "Count not create directory ~A for the defsystem fasl"
       (make-pathname 
        :directory
        (pathname-directory    
         (translate-logical-pathname "cl-library:;defsystem;defsystem.x86f")))))

;;; try to compile too:
(cond
  ((not (probe-file "cl-library:;defsystem;defsystem.lisp"))
   (warn "I cannot find my defsystem files at ~S"
         (translate-logical-pathname "cl-library:;defsystem;defsystem.lisp")))
  (t
   (when (or (not (probe-file "cl-library:;defsystem;defsystem.x86f"))
             (< (file-write-date "cl-library:;defsystem;defsystem.x86f")
                (file-write-date "cl-library:;defsystem;defsystem.lisp")))
     (let ((*compile-print* nil)               ; tell where the compiler is
           (*compile-progress* nil)
           (*load-verbose* nil)
           (*compile-verbose*  nil)
           (*require-verbose* nil)
           (*gc-verbose* nil))
       
       (locally
           (declare (optimize (inhibit-warnings 3)))
         (compile-file "cl-library:;defsystem;defsystem.lisp"
                       :output-file
                       "cl-library:;defsystem;defsystem.x86f"
                       :progress nil
                       :print nil
                       :verbose nil))))))

;; normally try to load the fasl if it's the latest
;; otherwise try to load the source:

(when (ignore-errors
        (load "cl-library:;defsystem;defsystem.x86f"
              :if-source-newer :load-source
              :verbose t))
  ;; it loaded, configure it for common-lisp-controller use:
  (setf (symbol-value (intern "*CENTRAL-REGISTRY*"
			      (find-package :make)))
	"cl-systems:"))

;(setf *batch-mode* t)