(in-package :common-lisp-user)

(pushnew :lkb *features*)
(pushnew :mrs *features*)
(pushnew :tsdb *features*)
(pushnew :mt *features*)
(pushnew :logon *features*)
#+:linux
(pushnew :bdb *features*)
(pushnew :slave *features*)

(let* ((logon (system:getenv "LOGONROOT"))
       (lingo (namestring (parse-namestring (format nil "~a/lingo" logon)))))

  (load (format nil "~a/lkb/src/general/loadup.lisp" lingo)))

;;;
;;; these are copied from ACL 6.0 `develenv.cl', with those modules that cannot
;;; be included in a runtime image deleted.                   (26-sep-01; oe)
;;;
(require :list2)
(require :seq2)
#+(version>= 6 0) (require :safeseq)
(require :regexp)
#-(version>= 8 2)
(require :streama)
(require :srecord)
(require :tpl-debug)
(require :tpl-proc)
(require :foreign)
(require :defftype)
(require :process)
#+(and (version>= 6 0) (not :mswindows)) (require :sigio)
#+(version>= 6 0) (require :excl)
(require :eli)
(require :emacs)
(require :lze)
(require :lep)
(require :scm)
#-(version>= 8 2)
(require :walker)
(require :trace)
(require :inspect)
(require :sock)
(require :loop)
(require :regexp)
#+(version>= 6 0) (require :constructor)
#+(version>= 6 0) (require :mcombin)
#+(version>= 6 0) (require :uri)
#+(version>= 6 2) (require :euc)
#+(version>= 6 2) (require :ffcompat)

;;;
;;; [spr27650] apparently the runtime bundle does not include (all) external
;;; formats; to work around that, for now, preload everything. (22-may-03; oe)
;;;
#+(version>= 6 2)
(loop
    for ef in '("1250" "1251" "1252" "1253" "1254" "1255" "1256" "1257" "1258"
                "874" "932" "936" "949" "950" "big5" "crcrlf" "crlf" "e-cr" 
                "e-crcrlf" "e-crlf" "emacs-mule" "euc" "fat" "gb2312" 
                "iso-2022-jp" "iso8859-1" "iso8859-14" "iso8859-15" "iso8859-2"
                "iso8859-3" "iso8859-4" "iso8859-5" "iso8859-6" "iso8859-7" 
                "iso8859-8" "iso8859-9" "jis" "koi8-r" "latin-14" "latin-15" 
                "latin-2" "latin-3" "latin-4" "latin-5" "latin-6" "latin-7" 
                "latin-8" "latin-9" "latin1" "latin14" "latin15" "latin2"
                "latin3" "latin4" "latin5" "latin6" "latin7" "latin8" "latin9"
                "shiftjis" "ujis" "unicode" "utf8" "void")
    do (excl::find-external-format (intern (string-upcase ef) :keyword)))

(setq make::*building-image-p* t)

(setf (system:getenv "DISPLAY") nil)

(apply (intern "COMPILE-SYSTEM" :make) (list "tsdb" :force nil))

;;;
;;; [spr38460] ACL 8.2 changed the time() macro to expand into something that
;;; requires the compiler, which breaks in run-time images.
;;;
(let ((excl:*enable-package-locked-errors* nil))
  (defmacro time (form)
    `(excl::time-a-funcall
      #'excl::time-report *trace-output* #'(lambda () ,form))))

(setf excl:*restart-init-function* 
  #'(lambda ()
      ;;
      ;; while this should never happen, make an attempt at fixing up our 
      ;; run-time environment; quite likely, other things will go sour down
      ;; the road now.
      ;; 
      (unless (sys:getenv "LOGONROOT")
	(let* ((sys (truename (translate-logical-pathname "sys:")))
               (home (make-pathname 
                      :directory (butlast (pathname-directory sys) 3))))
	  (setf (system:getenv "LOGONROOT") (namestring home))
          (setf mk::sys-home (merge-pathnames home sys))
          (mk::reset-system-paths)))
      (registry:initialize)
      (let* ((display (sys:getenv "DISPLAY"))
             (display (unless (equal display "") display))
             (logon (sys:getenv "LOGONROOT"))
             (logon (and logon (make-pathname :directory logon)))
             (home (and logon (dir-append logon '(:relative "lingo" "lkb")))))
        (when home
          (setf make::sys-home home)
          (reset-system-paths)
          (setf lkb::*tree-discriminants-mode* :modern)
          ;;
          ;; load the global LOGON initialization file ...
          ;;
          (let ((lkbrc (when home (dir-and-name home "dot.lkbrc"))))
            (when (and lkbrc (probe-file lkbrc))
              (lkb::with-package (:lkb) (load lkbrc)))))
        ;;
        ;; ... and see whether there is a per-user `.lkbrc' file
        ;;
        (let* ((lkbrc (dir-and-name (user-homedir-pathname) ".lkbrc")))
          (lkb::with-package (:lkb) (when (probe-file lkbrc) (load lkbrc))))

        (if (system:getenv "SSP")
          (tpl:setq-default *package* (find-package :ssp))
          (tpl:setq-default *package* (find-package :lkb)))
        (when display
          (let ((*package* (find-package "CLIM-USER")))
            (clim-user::set-up-lkb-interaction :core)))
        #+:lui
        (let* ((lui (getenv "LUI"))
               (port (and (stringp lui) (parse-integer lui :junk-allowed t))))
          (when lui
            (lkb::lui-initialize :port port :lui lui)))
        (when (find-package :pvm)
          (let ((symbol (find-symbol "INITIALIZE-PVM" :pvm)))
            (when symbol (funcall (symbol-function symbol)))))
        (when (find-package :mt)
          (let ((symbol (find-symbol "INITIALIZE-MT" :mt)))
            (when symbol (funcall (symbol-function symbol)))))
        (when (find-package :tsdb)
          (tpl:setq-default *package* (find-package :tsdb))
          (let ((symbol (find-symbol "*TSDB-INITIALIZED-P*" :tsdb)))
            (when symbol (set symbol nil)))
          (funcall (intern "INITIALIZE-TSDB" :tsdb))
          (funcall (intern "TSDB" :tsdb) :podium)))))