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

;;;SAZ's LISPM init file
(format t "~%~%~\date\~%~%" (time:get-universal-time))	;What the hell day is it, anyway?
(setq fs:user-id "saz")				;ensure lower case

(load "dj:saz;mass-millions")


(setq zwei:*zmail-init-loaded* t)
(load "dj:saz;zmail.init")			;don't wait for me to fire up zmail to get my init file read in...

;(setq zwei:*from-host* "gsi-cam")		;don't wait for me to fire up zmail to enable me to send mail from
						;Zwei without header canonicalization problems...

(tv:map-over-sheets #'(lambda (win) (send win :set-deexposed-typeout-action ':permit)))

(tv:kbd-esc-more 0)				;turn it off until lispm.init is done loading

(defsubst zwei:wops (thing)
  (condition-case (err)
      (pprint (send thing :which-operations))
    (system:undefined-function (format t "No :which-operations method defined for ~A" thing))))

(export 'zwei:wops 'global)

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

(defmacro with-fdefine-warnings-inhibited ((&body body))
  `(let ((inhibit-fdefine-warnings t))
     ,body))

(defmacro ndelq (object list &optional (times -1))
  ;;really delete object from list regardless of position...
  `(if (mem #'eq ,object ,list)
       (if (zerop (find-position-in-list ,object ,list))
	   (setq ,list (delq ,object ,list ,times))
	 (delq ,object ,list ,times))))

(defmacro watch-vars (vars form)
  ;; indicates any mutations of variables specified in vars which arose
  ;; as a result of evaluating form...
  ;; E.g., (watch-vars (foo bar) (setq foo 3 bar 4))
  ;;   ==> foo: NIL --> 3
  ;;       bar: NIL --> 4
  ;;       4
  ;; ...assuming of course that the two variables were unbound before
  ;; calling watchvars...
  `(let ((vars-before (mapcar #'(lambda (var) (if (boundp var) (symeval var)))
			      ',vars)))
     (let ((return-me (si:eval-special-ok ',form)))
       (loop for var in ',vars and old-val in vars-before do
	     (format t "~%~A: ~S --> ~S" var old-val (symeval var)))
       return-me)))
  
(defmacro ASK-WAIT-AND-EXECUTE (prompt timeout-secs response-if-no-answer value-if-no-answer &body body)
  ;;;prompt and response-if-no-answer are strings, timeout-secs a fixnum.
  `(if (with-timeout ((* ,timeout-secs 60) 
		      (format query-io ,response-if-no-answer)
		      ,value-if-no-answer)			;value to return
	 (y-or-n-p ,prompt))
      ,@body))

(ask-wait-and-execute "Boost all quanta? " 10 " ... Ok, done."           t   (boost-all-quanta 6.))

;;;This will work after fquery gets fixed...!
;(defun SET-GC-DEGREE-OR-TURN-IT-OFF (max-response-time)
;  (let* ((response-seconds (* max-response-time 60.))
;	 (degree (fquery `(:type :tyi
;				:timeout ,response-seconds
;				:default-value no-answer
;				:choices ((0 "0") (1 "1") (2 "2") (3 "3") :any))
;			 "Turn GC on with degree: ")))
;    (cond ((and (fixp degree)
;		( degree 0)
;		( degree 3))
;	   (progn (gc:gc-on :degree degree)
;		  (format t "~%GC turned on at level ~A" degree)))
;	  ((eq degree 'no-answer)			;timed out; what we usually want
;	   (progn
;	     (gc:gc-on :degree 0)
;	     (format t "~%GC turned on at level 1")))
;	  (t (progn (gc:gc-off)
;		    (format t "~%GC turned off"))))))

;(SET-GC-DEGREE-OR-TURN-IT-OFF 5.)
    
(ask-wait-and-execute (format nil "Load system patches and//or site
configuration information? ")
		      			   20 " ... Ok, starting now ..." t   (load-patches :noselective))

(ask-wait-and-execute "Make a BUGMAN system?" 20 " ... Ok, starting now ... " t (make-system 'bugman :noconfirm))
(ask-wait-and-execute "Make a WINDOW-MAKER system?" 20 " ... Ok, starting now ... " t (make-system 'window-maker :noconfirm))
(ask-wait-and-execute "Load lisp macros?" 10 " ... Ok, starting now ... " t (load "dj:saz;macros"))
(load "dj:saz;pathname")
(ask-wait-and-execute "Load zmacs file?" 10 " ... Ok, starting now ... " t (load "dj:saz;zmacs"))

(setq fs:*load-set-default-pathname* t)

(tv:kbd-esc-more 1)