;;; -*- 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 (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 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)