(defvar clisp-locker "lucidcl")
(defvar clisp-program-name (concat "/mit/lucidcl/" hosttype "bin/lisp"))
(defvar clisp-program-args nil)
(defvar clisp-priority 10)
(if (or
     (not (or (string-equal (hosttype) "decmips") (string-equal (hosttype) "vax")))
     (string-equal (cputype) "MVAX-II"))
    (progn
      (setq clisp-program-name "rlogin")
      (setq clisp-program-args '("gevalt" "-l" "kkkken"))))
(defvar clisp-buffer-name "*clisp*")
(defvar clisp-process-name "clisp")
(defvar clisp-inferior-mode-hook nil)
(defvar clisp-inferior-mode-map nil)
(defvar clisp-mode-map nil)
(defvar clisp-mode-hook nil)
(defvar clisp-mode-syntax-table nil)
(defvar clisp-history-size 50)
(defvar nice-program-name "/bin/nice")

(defmacro clisp-buffer () '(get-buffer-create clisp-buffer-name))
(defmacro clisp-process () '(get-buffer-process (clisp-buffer)))

(defun lisp-mode ()
  (interactive)
  (clisp-mode))

(defun clisp-startup ()
  (interactive)
  (if (and clisp-locker (fboundp 'attach))
      (attach clisp-locker t))
  (let ((b (clisp-buffer)))
    (set-buffer b)
    (if (and (boundp 'clisp-process) clisp-process)
	(delete-process clisp-process))
    (apply 'start-process 
	   (append 
	    (list clisp-process-name b)
	    (if clisp-priority
		(list "/bin/nice" (format "-%d" clisp-priority)))
	    (list clisp-program-name) 
	    clisp-program-args))
    (clisp-inferior-mode))
  (clisp-goto))

(defun clisp-goto ()
  (interactive)
  (let ((w (get-buffer-window (clisp-buffer))))
    (if w
	(select-window w)
      (switch-to-buffer-other-window (clisp-buffer)))))

(defun clisp-show ()
  (interactive)
  (display-buffer (clisp-buffer)))


(defun clisp-inferior-mode ()
  (interactive)
  (kill-all-local-variables)
  (setq mode-name "Clisp/inferior")
  (setq major-mode 'clisp-inferior-mode)
  (make-local-variable 'clisp-process)
  (make-local-variable 'clisp-history)
  (make-local-variable 'clisp-hist-last)
  (make-local-variable 'clisp-hist-cur)
  (setq clisp-process (get-buffer-process (current-buffer)))
  (setq clisp-history (make-vector clisp-history-size nil))
  (setq clisp-hist-last 0)
  (setq clisp-hist-cur 0)
  (or clisp-inferior-mode-map 
      (progn
	(setq clisp-inferior-mode-map (make-sparse-keymap))
	(define-key clisp-inferior-mode-map "\C-m" 'clisp-send)
	(define-key clisp-inferior-mode-map "\ep" 'clisp-grab-previous-history)
	(define-key clisp-inferior-mode-map "\e\C-n" 'clisp-goto-next-history)
	(define-key clisp-inferior-mode-map "\C-c\C-g" 'clisp-interrupt)
	(define-key clisp-inferior-mode-map "\e\C-p" 'clisp-goto-previous-history)))
  (use-local-map clisp-inferior-mode-map)
  (run-hooks 'clisp-inferior-mode-hook))

(defun clisp-add-history (m1 m2)
  (setq clisp-hist-last (1+ clisp-hist-last))
  (if (eq clisp-hist-last (length clisp-history))
      (setq clisp-hist-last 0))
  (setq clisp-hist-cur clisp-hist-last)
  (aset clisp-history clisp-hist-last 
	(cons (copy-marker m1) (copy-marker m2))))


(defun clisp-find-history (pos)
  (let ((cell (aref clisp-history clisp-hist-last)))
    (if (and cell
	     (> pos (cdr cell)))
	(cons 'after clisp-hist-last)
      (let ((n (+ clisp-hist-cur 2))
	    (len (length clisp-history))
	    (left (+ 4 (length clisp-history)))
	    (upper-neighbor nil)
	    (un-lm nil)
	    (last nil)
	    (cell nil)
	    (endn nil)
	    (endc nil)
	    (begn nil)
	    (begc nil)
	    (type nil))
	(if (>= n len) (setq n 1))
	(while (and
		(> left 0)
		(not type))
	  (setq n (1- (if (<= n 0) len n)))
	  (if (setq cell (aref clisp-history n))
	      (progn
		(if (or (not endc) (> (car cell) (cdr endc)))
		    (progn
		      (setq endn n)
		      (setq endc cell)))
		(if (or (not begc) (< (cdr cell) (car begc)))
		    (progn
		      (setq begn n)
		      (setq begc cell)))
		(or (and 
		     (>= pos (car cell))
		     (<= pos (cdr cell))
		     (setq type 'inside))
		    (and 
		     last
		     (< pos (car last))
		     (> pos (cdr cell))
		     (setq type 'after)))))
	  (setq last cell)
	  (setq left (1- left)))
	(if type 
	    (progn
	      (setq clisp-hist-cur n)
	      (cons type n))
	  (if (> pos (cdr endc))
	      (cons 'after endn)
	    (if (< pos (car begc))
		(cons 'before begn)
	      nil)))))))

(defun clisp-send ()
  (interactive)
  (let* ((proc clisp-process)
	 (marker (process-mark proc))
	 tosend)
    (if (>= (point) marker)
	(progn
	  (goto-char (point-max))
	  (insert "\n")
	  (if (> (- (point-max) marker) 3)
	      (clisp-add-history marker (point-max)))
	  (process-send-string proc (buffer-substring marker (point-max)))
	  (goto-char (point-max))
	  (set-marker marker (point-max)))
      (let ((histn (clisp-find-history (point))))
	(if (and histn (eq (car histn) 'inside))
	    (let ((pair (aref clisp-history (cdr histn))))
	      (goto-char (point-max))
	      (insert (buffer-substring (car pair) (1- (cdr pair)))))
	  (error "Can't find input line near point!"))))))



(defun clisp-goto-previous-history ()
  (interactive)
  (let ((upper (clisp-find-history (1- (point)))))
    (or upper (error "Can't find this history!"))
    (goto-char (car (aref clisp-history (cdr upper))))))

(defun clisp-goto-next-history ()
  (interactive)
  (let ((upper (clisp-find-history (+ (point) 1))))
    (or upper (error "Can't find this history!"))
    (setq upper (cdr upper))
    (let ((end (1- (cdr (aref clisp-history upper)))))
      (if (< (point) end)
	  (goto-char end)
	(let ((nextcell (aref clisp-history (if (eq (1+ upper) (length clisp-history)) 
						0 (1+ upper)))))
	  (or nextcell (error "Can't find next history!"))
	  (goto-char (1- (cdr nextcell))))))))

(defun clisp-grab-previous-history ()
  (interactive)
  (let ((upper (clisp-find-history (point))))
    (or upper (error "Can't find any history!"))
    (setq upper (cdr upper))
    (let ((cell (aref clisp-history upper)))
      (goto-char (point-max))
      (insert (buffer-substring (car cell) (1- (cdr cell)))))))

(defun clisp-mode ()
  (interactive)
  (kill-all-local-variables)
  (setq mode-name "Clisp")
  (setq major-mode 'clisp-mode)
  (make-local-variable 'indent-line-function)
  (setq indent-line-function 'lisp-indent-line)
  (if (not clisp-mode-syntax-table)
      (progn
	(setq clisp-mode-syntax-table
	      (copy-syntax-table emacs-lisp-mode-syntax-table))
;	(modify-syntax-entry ?- "_" clisp-mode-syntax-table)
	))
  (set-syntax-table clisp-mode-syntax-table)
  (make-local-variable 'comment-start)
  (make-local-variable 'comment-end)
  (make-local-variable 'comment-start-skip)
  (setq comment-start "; ")
  (setq comment-end "")
  (setq comment-start-skip ";+[ \t]*")
  (or clisp-mode-map
      (progn
	(setq clisp-mode-map (make-sparse-keymap))
	(define-key clisp-mode-map "\C-?" 'backward-delete-char-untabify)
	(define-key clisp-mode-map "\C-i" 'lisp-indent-line)
	(define-key clisp-mode-map "\C-c\C-e" 'clisp-send-sexp-and-go)
	(define-key clisp-mode-map "\C-c\C-f" 'clisp-load-file)
	(define-key clisp-mode-map "\C-cg" 'clisp-goto)
	(define-key clisp-mode-map "\C-ce" 'clisp-send-sexp)))
  (use-local-map clisp-mode-map)
  (run-hooks 'clisp-mode-hook))

(defun clisp-send-sexp ()
  (interactive)
  (save-excursion
    (end-of-defun)
    (let ((end (point)))
      (beginning-of-defun)
      (clisp-send-region (point) end))))

(defun clisp-send-sexp-and-go ()
  (interactive)
  (clisp-send-sexp)
  (clisp-goto)
  (goto-char (point-max)))

(defun clisp-send-region (start end)
  (interactive "r")
  (process-send-string (clisp-process) (buffer-substring start end)))

(defun clisp-load-file ()
  (interactive)
  (let ((fname (buffer-file-name)))
    (or fname (error "Not a file buffer"))
    (save-buffer)
    (process-send-string (clisp-process) ":a\n")
    (sit-for 0)
    (sit-for 0)
    (sit-for 0)
    (process-send-string (clisp-process) (format "(load \"%s\")\n" fname))
    (clisp-goto)))

(defun clisp-interrupt ()
  (interactive)
  (if (string-equal hosttype "rsaix")
      (process-send-string (clisp-process) "\C-c")
    (interrupt-process (clisp-process))))

(defun clisp-load-file ()
  (interactive)
  (let ((fname (buffer-file-name)))
    (or fname (error "Not a file buffer"))
    (save-buffer)
    (process-send-string (clisp-process) ":a\n")
    (sit-for 0)
    (sit-for 0)
    (sit-for 0)
    (process-send-string (clisp-process) (format "(load \"%s\")\n" fname))
    (clisp-goto)))