Running CLISP inside Emacs

[yue@maxwell.mmwb.ucsf.EDU (Kaizhi Yue)]

The OS2 port of Clisp makes it possible to run LISP in an Emacs subprocess,
which makes it much easier to develop LISP programs. Bruno Haible suggested
that I describe some functionalities that I know of. They are mainly the
following. 
 
M-x run-lisp allows one to start an inferior lisp process in emacs.
 
LISP-SEND-DEFUN, invoked by c-m-x (in the convention of symbolics), sends an
lisp expression (usually defun form) inside a LISP buffer to the lisp
process to be evaluated and the value will be printed to the inferior lisp
buffer.
 
LISP-SEND-COMPILE (c-m-c) allows one to compile a function in a LISP buffer.
 
 By defining a proper shell-prompt-pattern (the default is used in the
definition of RUN-LISP), the commands SHELL-PREV-COMMAND (alt-p),
SHELL-NEXT-COMMAND (alt-n), etc allow one to move the cursor to the previous
user inputs. Thus are accomplished functionalities similar to KEYS in OS2,
when combined with other emacs shell commands, e.g., SHELL-SEND-INPUT,
COPY-LAST-SHELL-INPUT, etc. These shell commands and key bindings are
described in the Emacs manual.
 
 Most of the functions that are needed such as RUN-LISP, LISP-SEND-DEFUN,
SHELL-SEND-INPUT, SHELL-PREV-COMMAND, SHELL-NEXT-COMMAND, etc. already exist
in shell.el in EMACS LISP.  (The latter two are not found in the OS/2 port
of Emacs release but can be found in the Unix port. --- At least I did at
our site.)
 
 Some slight modifications are needed to make the functions work in OS2. And
some are very ad hoc. E.g., when running CLISP in EMACS shell, when the
input is more than one line, the read-eval-print loop fails to print the
prompt for the next command.  So I put in a second (one-line) expression for
the lisp process to evaluate so that a prompt will be generated. I do it by
evaluating "!" which should be previously defined in CLISP as (setq ! '!).
 
I have included the code for the above functionalities in this post. This
includes some LISP code and some Emacs lisp code. They are provided as is
(and other standard disclaimers apply).  I am sure there are better ways to
do these things. But if you would like to take some existing code and play
with it, here it is. By the way, Bill Schelter has quite some goodies for
using LISP in Emacs shell. E.g., he has a utility for reading documentations
of common lisp functions that is similar to C-h d in Emacs.  These can be
found in his enhancement for AKCL, which is available through FTP at
rascal.ics.utexas.edu:pub/akcl-XX.tar.Z. The files are in a directory named
something like .../kcl/doc/.... Look for the following files: akcl.el,
find-doc.el, etc.
 
 
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;; Put the following in an init file for ***LISP***
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 
(defmacro compile-if-wellformed (def)
  `(if (and (eq 'defun (car ,def))
	    (symbolp (cadr ,def))
	    (listp (caddr ,def))
	    (>= (length ,def) 4))
       (compile (cadr ,def)(cons 'lambda (cddr ,def)))
     'NOT-A-FUNCTION-DEFINITION-FORM-AND-NOT-COMPILED))
 
 
(setq ! '!)
 
 
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; Put the following in an initialization file for Emacs
;;; --- I did not figure out a way of putting them into shell-mode-map.
;;;;;;;;;;;;;;;;;;;;;;;
 
(define-key ext-map "\061" 'shell-next-command) ;;; A-p
(define-key ext-map "\031" 'shell-prev-command) ;;; A-n
 
 
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; Load the following part at startup or through
;;;  (autoload 'run-lisp "f:/emacs/custom/inferior-lisp" nil t)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(require 'shell)
 
(defun run-lisp (&optional startup-name)
  "Run an inferior Lisp process, input and output via buffer *lisp*."
  (interactive nil)  ;(interactive "sEnter  CL program name: ") 
  (switch-to-buffer (make-shell "lisp"  "c:\\os2\\cmd.exe" nil)) 
  (process-send-string "lisp" "f:\\usr\\bin\\lisp.cmd\n")
 
;; (switch-to-buffer (make-shell "lisp"  "c:\\os2\\cmd.exe" "f:\\usr\\bin\\lisp.
  (inferior-lisp-mode)
  (make-local-variable 'shell-prompt-pattern)
  (setq shell-prompt-pattern "^[^#%)>]*[#%)>]+ *"))
 
 
(defun define-lisp-mode-key (key command)
  (define-key lisp-mode-map key command)
  (define-key inferior-lisp-mode-map key command))
		   
;; %%% copied from /emacs/lisp/lisp-mode.el 
 
 
							    
;;;; **** to use the kludge in this function, you must have (setq > '>)
(defun lisp-send-defun ()
  "Send the current defun to the Lisp process made by  run-lisp."
  (interactive)
  (save-excursion
   (end-of-defun) (message "defining common lisp function ....")
   (let ((end (point)))
     (beginning-of-defun)
     ;; Reset so we can grab the value.
     (setq lisp-last-output-position nil)
     (process-send-region "lisp" (point) end)
    (process-send-string "lisp" "!\n") ;;; well, now it works 3/14, while it did
    (switch-to-buffer (process-buffer(get-process "lisp")))
    (em-end-of-buffer)
     (message "defined"))))
 
  ; using the code in shell.el can move the cursor, but the point and mark are w
 
;;(define-lisp-mode-key "\C-\M-x" 'lisp-send-defun)
 
(define-lisp-mode-key "\e\C-x" 'lisp-send-defun)
 
 
 
;(define-lisp-mode-key "\e\C-y" 'lisp-send-defun) not necessary
 
;(defun lisp-send-compile ()		;
;  "Send the current defun to the Lisp process made by  run-lisp."
;  (interactive)
;  (save-excursion
;   (end-of-defun)
;   (message "Compiling common  lisp function ....")
;   (let ((end (point)))
;     (beginning-of-defun)
;     ;; Reset so we can grab the value.
;     (setq lisp-last-output-position nil)
;     (process-send-string "lisp" "(let ((def ' ")
;     (process-send-region "lisp" (point) end)
;     (process-send-string "lisp"       "))")
;     (process-send-string "lisp"
;			  "(if (and (eq 'defun (car def))
;                                    (symbolp (cadr def))
;                                    (listp (caddr def))
;                                    (every #'atom (caddr def))
;                                    (>= (length def) 4))
;                               (compile (cadr def)(cons 'lambda (cddr def)))
;                                'Not-a-function-definition-form))")
;     (process-send-string "lisp" "\n"))))
 
;; this is IN CL
 
 
 
(defun lisp-send-compile ()
  "Send the current defun to the run-lisp process for compilation."
  (interactive)
  (save-excursion
   (end-of-defun)
   (message "Compiling COMMON LISP function ....")
   (let ((end (point)))
     (beginning-of-defun)
     ;; Reset so we can grab the value.
     (setq lisp-last-output-position nil)
     (process-send-string "lisp" "(let ((def ' ")
     (process-send-region "lisp" (point) end)
     (process-send-string "lisp"       "))") ;; closed ...((def...))
     (process-send-string "lisp" "(compile-if-wellformed def))")
     (process-send-string "lisp" ":q\n") ;;; surprise! 
     )))
 
 
(define-lisp-mode-key "\e\C-c" 'lisp-send-compile)
 
(define-lisp-mode-key "\e\C-x" 'lisp-send-defun)
 
 
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;  The following  is copied from a Unix version of SHELL.EL,
;;;  included here for your convenience. They should be loaded 
;;;  in shell mode or through autoload.
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 
  (define-key shell-mode-map "\C-i" 'shell-file-name-completion)
  (define-key shell-mode-map "\C-m" 'shell-send-input)
 
;;; We have to put these in ext-map. 
;;;  (define-key shell-mode-map "\061" 'shell-next-command)
;;; (define-key shell-mode-map "\031" 'shell-prev-command)
 
 
 
(defun shell-file-name-completion ()
  "Preform file name completion in shell mode"
  (interactive)
  (let ((shell-expand-name nil)
	(shell-expand-dir nil)
	(shell-expand-file nil)
	(shell-expand-try nil)
	(shell-expand-name-begin nil)
	(shell-expand-name-end nil))
 
    ;; look ahead
    (re-search-backward shell-pathname-pattern nil t)
    (forward-char)
    (setq shell-expand-name-begin (point))
    ;; look back
    (if (re-search-forward shell-pathname-pattern nil 0) (backward-char))
    (setq shell-expand-name-end (point))
    
    ;; the name requiring expansion
    (setq shell-expand-name
	  (buffer-substring shell-expand-name-begin shell-expand-name-end))
    ;; directory part of name
    (setq shell-expand-dir
	  (or (file-name-directory shell-expand-name) default-directory))
    ;; file part of name
    (setq shell-expand-file
	  (file-name-nondirectory shell-expand-name))
    
    ;; do the expansion
    (setq shell-expand-try
	  (file-name-completion shell-expand-file shell-expand-dir))
    ;; display the results
    (if (eq shell-expand-try t) (message "Sole completion")
      (if (eq shell-expand-try nil) (message "No match")
	(if (equal shell-expand-try shell-expand-file)
	    (progn
	      (if shell-completions-window nil
		(setq shell-completions-window
		      (current-window-configuration)))
	      (message "Making completion list...")
	      (with-output-to-temp-buffer " *Completions*"
		(display-completion-list
		 (sort (file-name-all-completions
			shell-expand-try shell-expand-dir)
		       'string-lessp)))
	      (message ""))
	  (progn
	    ;; put in the expansion
	    (re-search-backward
	     (concat shell-filename-pattern "\\|"
		     shell-pathname-pattern) nil t)
	    (forward-char)
	    (delete-region (point) shell-expand-name-end)
	    (insert shell-expand-try)))))))
 
(defun shell-completion-cleanup ()
  "Clean up windows after shell file name completion.
Modified to deal with screens created by show-temp-buffer.el -- MON."
  (interactive)
  (if (and (boundp 'read-minibuf-unwind-hook)		;MON
	   (boundp 'epoch-temp-buffer-unwind-screen)	;MON
	   epoch-temp-buffer-unwind-screen) 		;MON
      (funcall read-minibuf-unwind-hook))		;MON
  (if shell-completions-window
      (save-excursion
	(set-window-configuration shell-completions-window)
	(setq shell-completions-window nil))))
 
(defun kill-all-output-from-shell ()
  "Kill shell buffer above current prompt."
  (interactive)
  (goto-char (point-max))
  (re-search-backward shell-prompt-pattern nil t)
  (kill-region (point-min) (point))
  (goto-char (point-max)))
 
(defun shell-next-command ()
  "Search for the next command in a shell."
  (interactive)
  (re-search-forward shell-prompt-pattern nil t))
 
(defun shell-prev-command ()
  "Search for the previous command in a shell."
  (interactive)
  (beginning-of-line)
  (re-search-backward shell-prompt-pattern nil t)
  (re-search-forward shell-prompt-pattern nil t))