(in-package :common-lisp)

(defparameter %logon% 
  (let ((root (system:getenv "LOGONROOT")))
    (when root (namestring (parse-namestring root)))))

(let ((excl:*enable-package-locked-errors* nil))

  (defun lmt (&optional forcep)
    (pushnew :lkb *features*)
    (pushnew :logon *features*)
    (load (format nil "~a/lingo/lkb/src/general/loadup.lisp" %logon%))
    (apply (intern "COMPILE-SYSTEM" :make) (list "tsdb" :force forcep)))

  (defun lxle (&optional forcep)
    (load (format nil "~a/uib/analysis.lisp" %logon%))
    (apply (intern "COMPILE-SYSTEM" :make) (list "logon" :force forcep)))

  (defun rsa (&optional (name :erg) indexp)
    (unless (find-package :lkb) 
      (lmt)
      (sleep 5))
    (labels ((registry (&rest rest)
               (apply (symbol-function (intern "LOOKUP" :registry)) rest)))
      (let* ((name (intern (string-upcase name) :keyword))
             (script
              (case name
                (:erg (registry :erg "~a~a~a" :ln :rt :lb))
                (:terg (registry :terg "~a~a~a" :ln :rt :lb))
                (:redwoods
                 (format nil "~a/lingo/redwoods/erg/lkb/script" %logon%))
                (:jacy (registry :jacy "~a~a~a" :ln :rt :lb))
                (:jacy+chasen
                 (format nil "~a/dfki/jacy/lkb/script.chasen" %logon%))
                (:gg (registry :gg "~a~a~a" :ln :rt :lb))
                (:srg (registry :srg "~a~a~a" :ln :rt :lb))
                (:norsource
                 (format nil "~a/ntnu/norsource/lkb/script" %logon%))
                (:wmb (format nil "~a/uw/wmb/lkb/script" %logon%))
                (:cst (format nil "~a/cst/danish/lkb/script" %logon%))
                (:lxgram (format nil "~a/nlx/lxgram/lkb/script" %logon%))
                (:cheetah
                 (format nil "~a/coli/cheetah/lkb/script-stat" %logon%))
                (:hag (format nil "~a/crysmann/hag/lkb/script" %logon%))
                (:krg (format nil "~a/khu/krg/lkb/script" %logon%))
                (t
                 (format nil "~a/uio/tm/~(~a~)/lkb/script" %logon% name)))))
        (apply (intern "READ-SCRIPT-FILE-AUX" :lkb) (list script))
        (when indexp
          (funcall (intern "INDEX-FOR-GENERATOR" :lkb))
          (funcall (intern "START-GENERATOR-SERVER" :lkb))
          (when (eq indexp :filter)
            (set (intern "*BYPASS-EQUALITY-CHECK*" :lkb) indexp))))))
  
  (defun verbose-gc (&key (verbose t) tenure)
    (when verbose
      (when (find-package :tsdb)
        (set (find-symbol "*TSDB-GC-VERBOSITY*" :tsdb) '(:verbose :stats)))
      (setf (sys:gsgc-switch :print) t)
      (setf (sys:gsgc-switch :stats) t)
      (setf (sys:gsgc-switch :verbose) t))
    (unless verbose
      (setf (sys:gsgc-switch :print) nil)
      (setf (sys:gsgc-switch :stats) nil)
      (setf (sys:gsgc-switch :verbose) nil))
    (setf (sys:gsgc-parameter :auto-step) tenure))
  
  (export '(%logon% lmt lxle rsa verbose-gc)))