;;; _clisprc.lisp                         -*- Mode: Lisp; Package: CL-USER -*-
;;; Touched: <Sun 08-31-2003, Madhu>               Bugs-To: <enometh@net.meer>
;;; (C) Madhu 2003
(in-package "CL-USER")

#+w32
(setf (EXT:getenv "EDITOR") "C:\\MADHU\\VIM\\VIM62\\GVIM.EXE"
      (EXT:getenv "CLHSROOT") "file:///c:/madhu/HyperSpec"
      *browser*
      '("start"
	"C:\\Program Files\\Netscape\\Communicator\\Program\\netscape.exe"
	#+nil "C:\\Program Files\\Internet Explorer\\iexplore.exe"
	"~a"))

(setq CUSTOM:*ansi* t)

;; no point setting this here:
;; (setf CUSTOM:*load-compiling* t)
#-nil
(ext:without-package-lock ("CLOS")
  (setf CLOS::*GF-WARN-ON-REPLACING-METHOD*  NIL
	CLOS::*WARN-IF-GF-ALREADY-CALLED* NIL))

#+nil
(setq custom:*FLOATING-POINT-CONTAGION-ANSI* nil
      custom:*WARN-ON-FLOATING-POINT-CONTAGION* nil)

;;; 2.31 Onwards: work around bug in system::c-require.
#+ignore
(when (or (search "2.31" (%fasldir "") :start2 1)
	  (search "2.32" (%fasldir "") :start2 1)
	  (search "2.33" (%fasldir "") :start2 1))
  (setf (symbol-function 'SYSTEM::c-require) #'require))

(defvar *my-package*)

(defun funnel (&key (pipe #p"c:/madhu/VIlisp-2.0/.lisp-pipe")
		    (force nil) &aux (last-touched 0))
  "Poor man's joke for a fifo. Used with Larry Clapp's `VIlisp' for
sending lisp forms from VIM for evaluation in CLISP on win32. Call
this function instead of the funnel.pl perlscript.
Does not return, but can (and will) break into the debugger.
PIPE is the pathname to the pipe named in VIlisp.vim; We create it
and delete it on exit.
FORCE is a boolean which governs our behaviour when PIPE exists.
If FORCE is non-nil we warn if PIPE exists. (But supersede it anyway).
If FORCE is nil, and PIPE exists, we signal an error."
 (when (probe-file pipe)
   (with-simple-restart
     (continue "funnel: supersede and continue anyway")
     (apply (if force #'warn #'error) (list "~a exists" pipe))))
 (unwind-protect
  (loop initially ; create or truncate the file
	(with-open-file (stream pipe :direction :io :if-exists :supersede
				:if-does-not-exist :create)
	  (setf last-touched (file-write-date pipe)))
	do  ; wait until someone writes into it. load and truncate.
	(with-simple-restart
	  (abort-sleep "funnel: resume funneling")
	  (sleep 0.3)) ; ugh!
	(when (> (file-write-date pipe) last-touched)
	  (with-simple-restart
	    (abort-this "funnel: abort eval and resume funneling")
	    (load pipe :verbose t :echo nil :compiling t :print nil))
	  (with-open-file (stream pipe :direction :io  :if-exists :supersede
				  :if-does-not-exist :error))
	  (setf last-touched (file-write-date pipe))
          (when (and (boundp '*my-package*) (find-package *my-package*))
            (setf *package* (find-package *my-package*))
            (warn "set package to ~a" *package*)
            (makunbound '*my-package*)) ))
  (delete-file pipe)))

(shadow 'pprint)
(defmacro pprint (form &optional (output-stream t)) ; pprint multiple-values
  (let ((eval (gensym)))
    `(let ((,eval (multiple-value-list ,form)))
       (format ,output-stream "~&~A~{ ;~&~A~}~&" (car ,eval) (cdr ,eval))
       (force-output ,output-stream))))

(setf custom:*foreign-encoding*
      (ext:make-encoding :charset 'charset:iso-8859-1
		      :line-terminator :unix))
(setf CUSTOM:*DEFAULT-FILE-ENCODING*
      (ext:make-encoding :charset 'charset:iso-8859-1
		      :line-terminator :unix))