;;; -*- Mode:LISP; Package:USER; Base:10; Readtable:CL -*- 

;;;Keith's LISPM init file

;;;Who I am

(login-setq fs:user-personal-name-first-name-first "Keith M. Corbett")
(fs:file-host-user-id "keith" (si:parse-host "angel"))

;;;Various personal system settings

(when (< (si:get-system-version) 124)
  (import 'format:y-or-n-p-with-timeout))

(defun set-all-quanta (amt)
  (setq si::default-quantum amt)
  (mapcar #'(lambda (proc)
              (send proc :set-quantum amt))
          si::all-processes))

(let((boost-p (y-or-n-p-with-timeout (* 10 60) T   "Boost all quanta?"))
     (goose-p (y-or-n-p-with-timeout (* 10 60) NIL "Goose up GC?"))
     (patch-p (y-or-n-p-with-timeout (* 10 60) T   "Load patches and/or site info?"))
     )
  (and  boost-p
        (set-all-quanta 6.))
  (and goose-p
       (gc:gc-on :degree 2))
  (and patch-p
       (load-patches :noselective))
  )

;;;Make WHO-LINE DOC window readable

(SEND TV:WHO-LINE-DOCUMENTATION-WINDOW :SET-FONT-MAP '(HL10B))
(pushnew '(send tv:who-line-documentation-window :set-font-map '(cptfont)) logout-list)

;;;Make initial windows friendlier

(send tv:initial-lisp-listener :set-deexposed-typeout-action :permit)

(let((supdup (tv:find-window-of-flavor 'supdup)))
  (when supdup
    (send supdup :set-deexposed-typeout-action :permit)))

;;;Use CommonLISP (almost) everywhere

(COMMON-LISP T T)

;;;Zwei

(load (merge-pathnames "zwei-stuff" (fs:user-homedir)))

;;;ZMail

(zwei:load-zmail-init-file)

;;;Tiger stuff

(when (find-package "TIGER")
  (let((*package* (find-package "TIGER")))
    (tv:add-escape-key #\ctrl-L
		       #'(lambda(&rest ignore)
			   (start-tiger)
			   (send *tiger-operator-window* :select))
		       "Select the Tiger Operator Window")
    (login-setq *laser1+-orientation* :portrait)
    (login-setq *laser1-orientation* :portrait)))