;;;; myclisp.el - Stolen heavily from kkkken's clisp-mode and the stuff in the 6.034 locker. 

(defvar clisp-locker "lucidcl")
(defvar clisp-course-locker "6.034")
(defvar clisp-program-name (concat "/mit/lucidcl/" (hosttype) "bin/lisp"))
(defvar clisp-program-args nil)
(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-priority 10)
(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))
      (progn 
	(attach clisp-locker t)
	(attach clisp-course-locker t)
	(find-file-other-window "/mit/6.034/classmotd")))
  (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 nice-program-name (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)))

;;;; Clisp inferior mode
(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)
  (setq clisp-process (get-buffer-process (current-buffer)))
  (make-local-variable 'clisp-top-m)
  (make-local-variable 'clisp-cmdm)
  (make-local-variable 'clisp-prompt-m)
  (setq clisp-top-m (make-marker))
  (setq clisp-prompt-m (make-marker))
  (setq clisp-cmd-m (make-marker))
  (clisp-prompt)
  (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 "\C-c\C-g" 'clisp-interrupt)
	(define-key clisp-inferior-mode-map "\C-l" 'clisp-recenter)))
  (use-local-map clisp-inferior-mode-map)
  (set-process-filter (clisp-process) 'clisp-inferior-filter)
  (run-hooks 'clisp-inferior-mode-hook))

(defun clisp-send ()
  (interactive)
  (delete-region clisp-prompt-m clisp-cmd-m)
  (goto-char clisp-cmd-m)
  (let* ((proc clisp-process)
	 (marker clisp-cmd-m)
	 tosend)
    (if (>= (point) marker)
	(progn
	  (goto-char (point-max))
	  (insert "\n")
	  (process-send-string proc (buffer-substring marker (point-max)))
	  (goto-char (point-max))
	  (clisp-prompt)))))

(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))
	))
  (set-syntax-table clisp-mode-syntax-table)
  (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-c\C-s" '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-region (start end)
  (interactive "r")
  (let ((s (buffer-substring start end)))
    (if (not (string-match "^.*\n$" s))
	(setq s (concat s "\n")))
    (process-send-string (clisp-process) s)
    (clisp-to-end)))

(defun clisp-to-end ()
  (let ((b (clisp-buffer))
	(cb (current-buffer)))
    (switch-to-buffer-other-window b)
    (goto-char (point-max))
    (switch-to-buffer-other-window cb)))

(defun clisp-inferior-filter (proc str)
  (save-excursion
    (set-buffer (process-buffer proc))
    (goto-char clisp-prompt-m)
    (insert str)
    (set-marker clisp-prompt-m (point))))

(defun clisp-prompt ()
  (set-marker clisp-top-m (point))
  (set-marker clisp-prompt-m (point))
  (insert "=->")
  (set-marker clisp-cmd-m (point)))

(defun clisp-recenter (arg)
  (interactive "P")
  (if (or arg (not (clisp-in-input)))
      (recenter arg)
    (recenter (- (window-height (selected-window)) 2))))
  
(defun clisp-in-input ()
  (>= (point) clisp-cmd-m))

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