segre@gvax.cs.cornell.edu (Alberto M. Segre) (12/19/88)
In response to recent requests for help running Common Lisp under GNU
Emacs, I am posting our GNU/Common Lisp interface. It has been tested in
post-18.50 versions of GNU.
The following shar archive contains a set of GNU Emacs functions that
support one or more (possibly remote) Common Lisps running in subshells.
We have been using the interface for several months now so it should
be pretty stable. It has been tested with both KCL and Allegro Common
Lisp; other Common Lisps should not be any trouble either.
This is substantially nicer than what is offered in shell.el; it supports
in-editor macro expansion, Common Lisp documentation, multiple Lisp listeners
(including remote lisp listeners) and more. Enjoy!
Alberto Segre
Assistant Professor
Cornell University
Department of Computer Science
Upson Hall
Ithaca, NY 14853-7501
Tel. (607) 255-9196
ARPA: segre@gvax.cs.cornell.edu
Bitnet: segre@crnlcs.bitnet
UUCP: ...decvax!cornell!segre
======
# This is a shell archive.
# Remove everything above and including the cut line.
# Then run the rest of the file through sh.
#----cut here-----cut here-----cut here-----cut here----#
#!/bin/sh
# shar: Shell Archiver
# Run the following text with /bin/sh to create:
# Help
# Install
# Notes
# .emacs
# autoinclude.el
# clisp.el
# header.lsp
# This archive created: Sun Dec 18 15:49:49 1988
cat << \SHAR_EOF > Help
The file clisp.el establishes a set of key bindings and functions to
support one or more Common Lisp processes running in inferior shells.
Instructions for installing this Lisp environment can be found in the
"Install" file. Release notes detailing changes from the previous
version can be found in the "Notes" file.
To use, set your lisp-mode-hook to:
(lambda () (require 'clisp)(start-lisp))
If you want your first lisp started on a different host, use:
(lambda () (require 'clisp)(start-lisp "hostname"))
There are two sets of key bindings established, one for editing
lisp code and the other for interacting with a lisp listener.
Both sets of bindings are available via the C-c prefix.
Editing any file in lisp mode will cause an inferior lisp to be
started automatically. Normally this is accomplished by setting the
auto-mode-alist variable in your ".emacs" file to key off of a
filename extension.
While editing a file in Lisp mode:
C-c l switches to the last inferior lisp process visited (see C-c e)
M-C-l spawns a new lisp buffer, prompting for a host.
You can start as many Lisp listeners as you like, each with a distinct
value space. We use this feature to start a Lisp on a remote machine
that is presumably faster or has more memory.
The notion of "last Lisp process" corresponds to the last Lisp
listener whose GNU window appeared on the screen. You can switch to
any Lisp process by giving a prefix argument to C-c l specifying which
*lispN* buffer to select; the "last Lisp process" notion only controls
the behavior of C-c l (and other keybindings) when no prefix is given.
To pass code from GNU to lisp:
C-c d evals current defun in last inferior lisp process
C-c C-d = (C-c d) + (C-c l)
C-c c compiles current defun in last inferior lisp process
C-c C-c = (C-c c) + (C-c l)
C-c s evals last sexpr in last inferior lisp process
C-c C-s = (C-c s) + (C-c l)
C-c r evals current region in last inferior lisp process
C-c C-r = (C-c r) + (C-c l)
C-c b evals current buffer in last inferior lisp process
C-c C-b = (C-c b) + (C-c l)
The GNU emacs tags facility is used to cross index your source code.
Special bindings to support this feature include:
C-c . finds defun for current function in other window
C-c , looks for next matching defun (C-c .)
M-. finds defun for current function (std GNU)
M-, looks for next matching defun (std GNU)
C-c t lists files indexed by (C-c .)
C-c C-t recomputes lookup table for (C-c .) and (C-c t)
In addition, there are a few bindings that are specific to Common Lisp
support.
C-c m shows Common Lisp macro expansion of current form
C-c f shows Common Lisp documentation for current function
C-c v shows Common Lisp documentation for current variable
M-q reindents current comment or defun
Indentation has been adapted to properly indent the Interlisp-style
FOR macro distributed by segre@gvax.cs.cornell.edu
Note that the "[" and "]" characters can be used as "super-parens" in
either mode. A "]" closes as many open "(" exist up to and including
an open "[". If no open "[" exists, "]" closes up to the top level.
The square brackets are replaced by the appropriate number of "(" and
")" in the buffer, since Common Lisp doesn't understand super-parens.
N.B.; To insert explicit square brackets, they must be prefaced by
C-q.
While typing to an inferior Lisp process buffer:
C-c e returns to last edited file of lisp code (see C-c l)
M-C-l spawns a new lisp buffer, prompting for a host.
C-c l with a prefix argument switches to that inferior lisp.
The notion of "last edit buffer" is the analogue to "last Lisp
buffer". The last GNU buffer visible that was not a Lisp process
buffer is the "last edit buffer". To go to a different buffer, use the
apporpriate GNU command (C-x b).
Finally, there are some "ksh"-like extensions to shell.el to help in
debugging Lisp code:
C-c h show history
C-c C-p previous form in history list
C-c C-n next form in history list
C-c C-a beginning of line
C-c C-r search backwards in history
C-c C-s search forward in history
SHAR_EOF
cat << \SHAR_EOF > Install
GNU Emacs/Common Lisp Environment Installation Instructions.
0. Create a temporary directory containing only the distribution file.
1. Unpack the distribution shar file by stripping the mail header and
passing the file to /bin/sh
2. Create two new directories (in your home directory will be fine): call
them ".elisp" and ".auto". These are "hidden" directories since they begin
with a "." so they won't show up with an "ls" command unless you use the
"-a" option.
3. Included in the distribution is a sample .emacs file. You will need
to integrate any existing .emacs file you have with the contents of this
file. In this file, change references to "/usr/u/cap/.elisp" and
"/usr/u/cap/.auto/" to point to the directories created in step 2.
NOTE: The trailing "/" after ".auto" IS SIGNIFICANT! Place ".emacs" in
your home directory.
4. Move all the files ending in ".el" to the ".elisp" directory.
5. Edit the file "clisp.el" in the .elisp directory using GNU emacs.
Change the reference to "/usr/u/cap/bin/kcl" to point to the Common
Lisp on your system. This need not be Kyoto Common Lisp; any Common
Lisp will be fine. You should also change the pointer to the remote
shell program (for starting remote lisps) to the proper value (see
*remote-shell-program*). In addition, you may need to change the
value of inferior-lisp-prompt for your particular Common Lisp; the
default value works for KCL and a suggested version for Allegro Common
Lisp is mentioned in the comment. Finally, change the pointer to the
"message of the day" file in *clisp-motd-file* to point to a message
you would like displayed in the first lisp buffer.
6. "M-x byte-recompile-directory" to GNU. You should compile all of the
files ending with ".el" in the ".elisp" directory. NOTE: Some people
have reported trouble with this step. You can either try using
"M-x byte-compile-file" and giving each file's name one at a time, or
you can supply a prefix argument, e.g., "C-u 1 M-x byte-recompile-directory".
This will force recompilation of files without exisiting ".elc" versions.
7. Edit the file "header.lsp" to whatever you like. This is the file
that will be read in at the beginning of every new Lisp file you create.
Lisp files all end with ".lsp"; if this isn't the ending you want, edit
the ".emacs" file to reflect the extension you prefer. The sample
header.lsp file included contains a mode line that makes it easy to
transfer your code to a Symbolics.
8. Exit GNU emacs (don't stop it; exit with C-x C-c after saving all
the files).
9. Place your edited header.lsp file in the ".auto" directory. Note that
the autoinclude feature works for any extension you like; thus you can have
a header.txt file to place your favorite troff or latex commands at the
beginning of every fresh file with the ".txt" extension. A header.ltr
file could contain a letter template for new files ending with ".ltr" and
so forth.
10. Now we're ready to go. Start a new emacs on a new file with a ".lsp"
extension. You should end up facing a fresh file containing header.lsp;
"C-c l" should take you to a buffer with a live Lisp session.
11. For a complete list of the commands available, print out the
documentation at the beginning of the file ".elisp/clisp.el"
12. Enjoy. Send bug reports to me. We're still making changes/additions,
so you should periodically get updates provided you are on my environment
mailing list (send mail to "segre@gvax.cs.cornell.edu" to get on the list).
The file "Notes" contains release notes describing changes from release
to release.
SHAR_EOF
cat << \SHAR_EOF > Notes
GNU Emacs/Common Lisp Environment Release Notes.
Mail bug reports to segre@gvax.cs.cornell.edu
=====
December 18, 1988
Minor bug corrections to support Allegro Common Lisp. Suggested
inferior-lisp-prompt string for Allegro is given in clisp.el. Also
minor fixes to macroexpansion and documentation since Allegro prefaces
printed items with a carriage return and doesn't have *print-pretty*
initially t.
=====
December 1, 1988
start-lisp now takes an optional argument if you want your initial *lisp*
started something other than the local host. You would change the call to
start-lisp on your lisp-mode-hook to take the on-local hostname as a string.
=====
November 27, 1988
A few bug fixes that snuck past in the last release. Macro expansion
and documentation functions should now work properly (at least for
KCL).
=====
November 22, 1988
Use M-C-l to start a new Lisp Listener (will prompt for a hostname).
=====
October 26, 1988
1. Common lisp indentation is fixed. It properly indents the FOR macro
for those of you who use it (others who might be interested, drop me a
line and I'll send you a copy).
2. We're working on multiple lisp listeners. Soon you'll be able to
have >1 lisp, some on other machines.
=====
October 2, 1988
Several additions/changes have occured since the last release.
1. The file "kcl.el" has been renamed "clisp.el" to reflect the fact
that any Common Lisp can be used as the inferior lisp process. Simply
set the variable "inferior-lisp-program" in the "clisp.el" to point to
the right place.
2. A "super-paren" feature has been added. The "[" and "]" brackets act
as super-parens (a la Interlisp), replacing themselves with the proper
number of "(" and ")" (since Common Lisp only recognizes these
characters as parens).
3. C-c h has been replaced by C-c f and C-c v, fetching function and
variable documentation respectively.
4. We're still working on the indentation.
=====
September 12, 1988
This message contains a new release of the GNU/KCL environment. This release
features a cleaned up process-filter mechanism that will handle long
doc strings or macroexpansions properly. Enjoy!
=====
September 1, 1988
This message containts four files comprising a simple environment for
Kyoto Common Lisp (or any other lisp with appropriate minimum
modifications) running under GNUemacs. Many of the functions are
modeled after similar functions on the Symbolics machines. Editing a
file in lisp mode (extension ".lsp") will cause a session with KCL to
start in an emacs buffer (only one such session will be started).
These files provide commands for transferring information back and
forth between KCL and GNUemacs.
To use, set your lisp-mode-hook to:
(lambda () (require 'kcl)(start-lisp))
There are two sets of key bindings established, one for editing lisp
code and the other for interacting with the lisp listener. Both sets
of bindings are available via the ^C prefix. See the file kcl.el for
more detail.
The file autoinclude.el provides a mechanism for placing headers in
new files. I use this to place the file ~/.auto/header.lsp containing
a header specifying lisp mode at the beginning of every new file. You
should load autoinclude in your .emacs file to enable this feature,
which may not work properly in older versions of GNUemacs.
The files are packaged in a shar file. Cut below and pass the
resulting file to /bin/sh for extraction. I plan to use this
environment on Vaxen and Suns for students writing lisp code for class
assignments. I am also using it as a development environment until I
can get my hands on something better.
I'd love to hear comments/suggestions from those of you who use it.
Please let me know what you think or if you find any bugs.
Most of the interesting stuff is in kcl.el. The other three files were
grabbed from netnews and are presented with only minor modifications.
I am also including my .emacs file as an example. Good luck and enjoy!
SHAR_EOF
cat << \SHAR_EOF > .emacs
;;; First things first: fix brain-damaged XON/XOFF
(set-input-mode t nil)
;;; Enable eval-ing of an emacs-lisp expression.
(put 'eval-expression 'disabled nil)
;;; Tell emacs where to look for customization files.
(setq load-path (cons (expand-file-name "/usr/u/cap/.elisp") load-path))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; Extend default extensions to use my own set. It's faster when the
;;; ones I use are at the beginning of the alist. Force a file with .lsp
;;; extension into clisp-mode.
(setq auto-mode-alist (append
'(("\\.txt$" . nroff-mode)
("\\.bib$" . nroff-mode)
("\\.ltr$" . nroff-mode)
("\\.ref$" . refer-mode))
auto-mode-alist))
;;; Set up the autoinclude file hack.
(load "autoinclude" nil t)
(setq auto-include-alist (append
'(("\\.lsp$" . "header.lsp"))
auto-include-alist))
(setq auto-include-directory "/usr/u/cap/.auto/")
;;; Set up autoloading of refer.el
(defun refer-mode ()
(load "refer")
(refer-mode))
;;; Change the lisp-mode-hook to load the inferior lisp process stuff.
;;; If you want your default lisp to start on another machine, use
;;; (start-lisp "hostname") instead.
(setq lisp-mode-hook '(lambda ()
(require 'clisp)
(start-lisp)))
;;; Set the mode hooks for other common modes.
(setq text-mode-hook '(lambda ()
(auto-fill-mode 1)))
(setq nroff-mode-hook '(lambda ()
(electric-nroff-mode 1)))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; Key bindings.
;;; Global replace
(global-set-key "r" 'replace-string)
(global-set-key "" 'query-replace)
;;; Change other window commands.
(global-set-key "n" 'select-next-window)
(global-set-key "p" 'select-previous-window)
(global-set-key "d" 'delete-window)
(global-set-key "v" 'find-alternate-file)
(global-set-key "" 'find-file-other-window)
(global-set-key "t" 'line-to-top)
;;; Add kill-some-buffers.
(global-set-key " " 'kill-some-buffers)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; Here are the next and previous window functions.
(defun select-next-window ()
(interactive)
(other-window 1))
(defun select-previous-window ()
(interactive)
(other-window -1))
;;; Brings current line to top of window.
(defun line-to-top ()
(interactive)
(recenter 0))
SHAR_EOF
cat << \SHAR_EOF > autoinclude.el
;;; autoinclude.el
;;;+ ------------------------------------------------------------
;;; Abstract:
;;;
;;; The following defines an association list for files to be
;;; automatically included when a new file is created, and a function
;;; which automatically inserts these files; the idea is to include
;;; default files much as the mode is automatically set using
;;; auto-mode-alist.
;;;
;;; The auto-include-alist consists of dotted pairs of
;;; ( REGEXP . FILENAME ) where REGEXP is a regular expression, and
;;; FILENAME is the file name of a file which is to be included into
;;; all new files matching the regular expression with which it is
;;; paired.
;;;
;;; To use:
;;; load autoinclude.el
;;; setq auto-include-directory to an appropriate value, which
;;; must end in "/"
;;; set the find-file-not-found-hooks list to include
;;; (include-auto-include-files)
;;;
;;; Author: Charlie Martin
;;; Department of Computer Science and
;;; National Biomedical Simulation Resource
;;; Box 3709
;;; Duke University Medical Center
;;; Durham, NC 27710
;;;
;;; Date: Fri Jul 1 16:15:31 EDT 1988
;;;
;;; Copyright (c) 1988 Charles R. Martin
;;;
;;; Copying is permitted under those conditions described by the GNU
;;; Emacs General Public License as clarified 11 February 1988, which
;;; is incorporated here by reference.
;;;
;;; Modified by Alberto M. Segre (1988) Cornell University.
;;; (segre@gvax.cs.cornell.edu)
;;;
;;;- ------------------------------------------------------------
;;; Define the auto-include-alist
(defvar auto-include-alist nil "\
Alist of file name patterns and corresponding include files for
creation of new files. The include files are standard file
headers or trailers found at \"auto-include-file-path\". Each
element looks like (REGEXP . FILENAME). Creating a file whose
name matches REGEXP causes FILENAME to be included.")
(setq auto-include-alist (mapcar 'purecopy
'(("\\.lsp$" . "header.lsp"))))
;;; Establish a default value for auto-include-directory
(defvar auto-include-directory nil "\
Directory from which auto-included files are taken.")
(setq auto-include-directory "~/.auto/")
;;; Include the file if name match found in auto-include-alist.
;;; Uses buffer-file-name, searches auto-include-alist for a matching
;;; REGEXP, then does 'insert-file' to include that file.
;;;
(defun include-auto-include-files ()
"Include the file from the include directory if regexp match
found in auto-include-alist. Silently terminates if the file name
matches none of the regular expressions."
(let ((alist auto-include-alist)
(name buffer-file-name)
(include-file nil))
;; remove backup suffixes from file name
(setq name (file-name-sans-versions name))
;; find first matching alist entry
(while (and (not include-file) alist)
(if (string-match (car (car alist)) name)
(setq include-file (cdr (car alist)))
(setq alist (cdr alist))))
;; Now, if we found an appropriate include file, include it
(if include-file
(let ((file (concat auto-include-directory include-file)))
(if (file-readable-p file)
;; Changed 7/4/88 ams to goto end of file and unmark as
;; changed.
(progn (insert-file file)
(goto-char (point-max))
(set-buffer-modified-p nil))
;;; Corrected 7/4/88 ams to include file name.
(message "Auto-include: file %s not found" file))))))
;;; Add autoinclude handling to find-file-not-found-hooks.
(or (memq 'include-auto-include-files find-file-not-found-hooks)
(setq find-file-not-found-hooks (nconc find-file-not-found-hooks
'(include-auto-include-files))))
;;;
;;; End of file
;;; ------------------------------------------------------------
SHAR_EOF
cat << \SHAR_EOF > clisp.el
;;; clisp.el establishes a set of key bindings and functions to support
;;; a Common Lisp running in an inferior shell.
;;; To use, set your lisp-mode-hook to:
;;; (lambda () (require 'clisp)(start-lisp))
;;; If you want your first lisp started on a different host, use:
;;; (lambda () (require 'clisp)(start-lisp "hostname"))
;;; There are two sets of key bindings established, one for editing
;;; lisp code and the other for interacting with the lisp listener.
;;; Both sets of bindings are available via the ^C prefix.
;;; Editing any file with in lisp mode will cause an inferior lisp to
;;; be started automatically.
;;; While editing a file in Lisp mode:
;;; C-c l switches to inferior lisp process (see C-c e)
;;; M-C-l spawns a new lisp buffer, prompting for a host.
;;; Passing code from GNU to lisp:
;;; C-c d evals current defun in inferior lisp process
;;; C-c C-d = (C-c d) + (C-c l)
;;; C-c c compiles current defun in inferior lisp process
;;; C-c C-c = (C-c c) + (C-c l)
;;; C-c s evals last sexpr in inferior lisp process
;;; C-c C-s = (C-c s) + (C-c l)
;;; C-c r evals current region in inferior lisp process
;;; C-c C-r = (C-c r) + (C-c l)
;;; C-c b evals current buffer in inferior lisp process
;;; C-c C-b = (C-c b) + (C-c l)
;;; Tags for cross-indexing source code:
;;; C-c . finds defun for current function in other window
;;; C-c , looks for next matching defun (C-c .)
;;; M-. finds defun for current function (std GNU)
;;; M-, looks for next matching defun (std GNU)
;;; C-c t lists files indexed by (C-c .)
;;; C-c C-t recomputes lookup table for (C-c .) and (C-c t)
;;; Special lisp support:
;;; C-c m shows Common Lisp macro expansion of current form
;;; C-c f shows Common Lisp documentation for current function
;;; C-c v shows Common Lisp documentation for current variable
;;; M-q reindents current comment or defun
;;; While running in the inferior lisp:
;;; C-c e returns to last edited file of lisp code (see C-c l)
;;; M-C-l spawns a new lisp buffer, prompting for a host.
;;; C-c l with a prefix argument switches to that inferior lisp.
;;; In addition, all of the inferior shell mode commands are active.
;;; The more useful ones are:
;;; C-c h show history
;;; C-c C-p previous form in history list
;;; C-c C-n next form in history list
;;; C-c C-a beginning of line
;;; C-c C-r search backwards in history
;;; C-c C-s search forward in history
;;; The "[" and "]" characters can be used as "super-parens" in either
;;; mode. To insert explicit square brackets, they must be prefaced by
;;; C-q.
;;; Authors: Alberto Segre (segre@gvax.cs.cornell.edu)
;;; David Hubbell (hubbell@svax.cs.cornell.edu)
;;; Department of Computer Science
;;; Cornell University
;;; Upson Hall
;;; Ithaca, NY 14853-7501
;;; Copyright (c) 1988 Alberto M. Segre, David L. Hubbell
;;; A portion of this code was adapted from code originally in the GNU
;;; distribution in file simple.el
;;; A portion of this code was adapted from code originally written by
;;; Wolfgang Rupprecht (wolfgang@mgm.mit.edu), as modified by David
;;; Hubbell (hubbell@svax.cs.cornell.edu).
;;; Copying is permitted under those conditions described by the GNU
;;; Emacs General Public License as clarified 11 February 1988, which
;;; is incorporated here by reference.
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(require 'shell)
(require 'backquote)
(provide 'clisp)
;;; Set the Common Lisp to be the lisp that's run as an inferior
;;; process by shell.el. Any Common Lisp will do; we'll set the
;;; default to be Kyoto Common Lisp. Non-Common Lisps will not support
;;; macro expansion and documentation search. This variable is defvar'd
;;; in shell.el
;;; Note that there is no need to set inferior-lisp-load-command since
;;; we're avoiding the use of /tmp to pass junk back to lisp.
(setq inferior-lisp-program "/usr/u/cap/bin/kcl")
;;; Inferior lisp prompt as in shell.el. The default value is
;;; "^[A-Za-z*]*>+" which handles an atomic package name before the
;;; ">", as in KCL. The appropriate string regexp for Allegro Common
;;; Lisp seems to be "^\\(\\[[0-9]+\\] \\)?<cl> ", since the break
;;; level appears as "[n]" before the prompt.
(setq inferior-lisp-prompt "^[A-Za-z*]*>+")
;;; Remote shell program; used for starting a remote inferior lisp.
(defvar *remote-shell-program* "/usr/ucb/rsh"
"The program that starts a remote shell.")
;;; File containing the motd. Will be displayed at the top of the
;;; first buffer running an inferior lisp.
(defvar *clisp-motd-file* "/usr/u/cap/.motd"
"The filename for the message of the day to be displayed in
the first lisp buffer.")
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; Startup function called on lisp-mode-hook. Note that the lisp
;;; process should only be started one time, hence we alter
;;; lisp-mode-hook to ensure this. Fill-prefix is set to enable ESC-q
;;; to work properly on comment lines.
(defun start-lisp (&optional host) "Called by lisp-mode-hook to start lisp."
(save-excursion
(or (get-process "lisp")
(progn (message "Starting lisp...")
(start-lisp-process-and-buffer "*lisp*" host)
;;; Create the history list variables for the lisp process.
(make-local-variable 'shell-history-list)
(make-local-variable 'shell-history-index)
(make-local-variable 'shell-last-search)
;;; Inferior Lisp mode key bindings
;;; Get rid of M-C-x from lisp-edit.el
(define-key inferior-lisp-mode-map "\M-\C-x" nil)
;;; Get rid of C-c C-y from shell.el. C-c C-p is better.
(define-key inferior-lisp-mode-map "\C-c\C-y" nil)
(define-key inferior-lisp-mode-map "\C-ce"
'clisp-buffer-deselect)
(define-key inferior-lisp-mode-map "\C-cl"
'clisp-buffer-select)
(define-key inferior-lisp-mode-map "\M-\C-l"
'clisp-create-lisp-buffer)
;;; Make sure RET doesn't send input to Lisp unless it's
;;; an s-expression.
(define-key inferior-lisp-mode-map "\C-m"
'clisp-shell-send-input-if-sexpr)
(define-key inferior-lisp-mode-map "\C-c\C-p"
'clisp-shell-previous-command)
(define-key inferior-lisp-mode-map "\C-c\C-n"
'clisp-shell-next-command)
(define-key inferior-lisp-mode-map "\C-c\C-r"
'clisp-shell-history-search-backward)
(define-key inferior-lisp-mode-map "\C-c\C-s"
'clisp-shell-history-search-forward)
(define-key inferior-lisp-mode-map "\C-ch"
'clisp-shell-list-history)
;;; SHOW-OUTPUT-FROM-SHELL must be rebound because
;;; it was originally attached to C-c C-r.
(define-key inferior-lisp-mode-map "\C-c["
'show-output-from-shell)
;;; Lisp editing mode key bindings
;;; Get rid of M-C-x from lisp-edit.el
(define-key lisp-mode-map "\M-\C-x" nil)
;;; Make "[" a kind of open paren so that scan-sexps
;;; won't ignore it.
(modify-syntax-entry 91 "(")
;;; Install superparen as "]" in lisp mode and in inferior
;;; lisp process.
(define-key inferior-lisp-mode-map "]"
'super-close-paren)
(define-key lisp-mode-map "]"
'super-close-paren)
;;; Subsumes fill-paragraph.
(define-key lisp-mode-map "\M-q"
'clisp-reindent-form)
(define-key lisp-mode-map "\C-cl"
'clisp-buffer-select)
(define-key lisp-mode-map "\M-\C-l"
'clisp-create-lisp-buffer)
(define-key lisp-mode-map "\C-cd"
'clisp-eval-defun)
(define-key lisp-mode-map "\C-c\C-d"
'clisp-eval-defun-and-go)
(define-key lisp-mode-map "\C-cc"
'clisp-compile-defun)
(define-key lisp-mode-map "\C-c\C-c"
'clisp-compile-defun-and-go)
(define-key lisp-mode-map "\C-cs"
'clisp-eval-last-sexpr)
(define-key lisp-mode-map "\C-c\C-s"
'clisp-eval-last-sexpr-and-go)
(define-key lisp-mode-map "\C-cr"
'clisp-eval-region)
(define-key lisp-mode-map "\C-c\C-r"
'clisp-eval-region-and-go)
(define-key lisp-mode-map "\C-cb"
'clisp-eval-buffer)
(define-key lisp-mode-map "\C-c\C-b"
'clisp-eval-buffer-and-go)
(define-key lisp-mode-map "\C-c."
'find-tag-other-window)
(define-key lisp-mode-map "\C-c,"
'tags-loop-continue)
(define-key lisp-mode-map "\C-ct"
'clisp-list-tag-files)
(define-key lisp-mode-map "\C-c\C-t"
'clisp-recompute-tag-table)
(define-key lisp-mode-map "\C-cm"
'clisp-show-macro-expansion)
(define-key lisp-mode-map "\C-cf"
'clisp-show-function-documentation)
(define-key lisp-mode-map "\C-cv"
'clisp-show-variable-documentation)
;;; Set the lisp-indent-hook to a function that recognizes
;;; Common Lisp forms.
(setq lisp-indent-hook 'common-lisp-indent-hook)
(message "Starting lisp...done.")))))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; Variables.
(defvar *last-lisp-buffer* nil
"The last Lisp process buffer that the user selected, NOT its name.")
(defvar *last-edit-buffer* nil
"The last edit (non-Lisp) buffer that the user selected.")
(defvar *max-lisp-buffer-number* 1
"The number of the last Lisp buffer created.")
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; MARK-EDIT-BUFFER updates the pointer to the last edit buffer
;;; selected unless the buffer is a lisp process buffer.
(defun mark-edit-buffer (buffer)
(cond ((not (equal (substring (buffer-name buffer) 0 5) "*lisp"))
(setq *last-edit-buffer* buffer))))
;;; MARK-LISP-BUFFER updates the pointer to the last edit buffer
;;; selected only when the buffer is a lisp process buffer.
(defun mark-lisp-buffer (buffer)
(cond ((equal (substring (buffer-name buffer) 0 5) "*lisp")
(setq *last-lisp-buffer* buffer))))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; Select the Lisp process buffer.
(defun clisp-buffer-select (&optional buffernum)
"Select the Lisp process buffer.
If the optional argument is n, select Lisp process buffer n.
If that buffer does not exist, print an error message and give up.
If there is no optional argument, select the last Lisp buffer
selected."
(interactive "P")
(let ((buffer-to-select
(cond ((not (integerp buffernum)) *last-lisp-buffer*)
((= buffernum 1) (get-buffer "*lisp*"))
((<= buffernum *max-lisp-buffer-number*)
(get-buffer (format "*lisp%d*" buffernum))))))
(cond (buffer-to-select
(mark-edit-buffer (current-buffer))
(mark-lisp-buffer buffer-to-select)
(switch-to-buffer buffer-to-select)
(goto-char (point-max)))
(buffernum
(beep)
(message
(format "Lisp buffer *lisp%d* does not exist." buffernum)))
(t (beep)
(message "No lisp buffer.")))))
;;; Return to previous edit buffer from Lisp process buffer.
(defun clisp-buffer-deselect ()
"Return to previous edit buffer from Lisp process buffer."
(interactive)
(cond ((buffer-name *last-edit-buffer*)
(mark-lisp-buffer (current-buffer))
(switch-to-buffer *last-edit-buffer*))
(t (beep)
(message "The last edit buffer has been killed."))))
;;; Create and switch to a new Lisp process buffer with the Lisp process
;;; running on the hostname entered. If none is entered, use the local
;;; host.
(defun clisp-create-lisp-buffer (entered-hostname)
"Create and switch to a new Lisp process buffer."
(interactive "sHost name (return for local host):")
(message "Starting new lisp process...")
(setq *max-lisp-buffer-number* (1+ *max-lisp-buffer-number*))
(let ((newbuffername (format "*lisp%d*" *max-lisp-buffer-number*)))
(mark-edit-buffer (current-buffer))
(save-excursion
(cond ((equal entered-hostname "")
(start-lisp-process-and-buffer newbuffername))
(t (start-lisp-process-and-buffer
newbuffername entered-hostname))))
(clisp-buffer-select *max-lisp-buffer-number*)
(message "Starting new lisp process...done.")))
;;; Start up lisp process in a new *lispN* buffer unless the process
;;; already exists. If a hostname was passed, start the Lisp process
;;; on that machine by invoking *remote-shell-program* on 3 arguments:
;;; a startup-file for make-shell, a hostname, and the
;;; inferior-lisp-program.
(defun start-lisp-process-and-buffer (buffername &optional hostname)
(let ((processname (substring buffername
1 (1- (length buffername)))))
(cond ((not (get-process processname))
(cond (hostname
(switch-to-buffer
(make-shell processname
*remote-shell-program*
nil
hostname
inferior-lisp-program))
(insert
(format
"Remote Lisp Host %s\n\n" (upcase hostname))))
(t (switch-to-buffer
(make-shell processname inferior-lisp-program))))
(mark-lisp-buffer (get-buffer buffername))
(inferior-lisp-mode)
(set-process-filter (get-process processname)
(` (lambda (cls-proc cls-string)
(clisp-startup-filter
cls-proc cls-string
(, (get-buffer buffername))))))
(set-process-buffer (get-process processname)
(get-buffer buffername))
(buffer-flush-undo (get-buffer buffername))
(setq last-input-start (make-marker))
(setq last-input-end (make-marker))
(process-kill-without-query (get-process processname))))))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; Sends current buffer to current Lisp process and evals it.
(defun clisp-eval-buffer ()
"Sends the current buffer to the current Lisp process and evals it."
(interactive)
(message "Evaling buffer...")
(save-excursion
(goto-char (point-max))
(let ((end (point)))
(goto-char (point-min))
(process-send-region
(clisp-buffer-to-process-name *last-lisp-buffer*) (point) end)
(process-send-string
(clisp-buffer-to-process-name *last-lisp-buffer*) "\n")
(message "Evaling buffer...done."))))
;;; Sends current buffer to current Lisp process, evals it, and
;;; switches to lisp buffer.
(defun clisp-eval-buffer-and-go ()
"Send the current buffer to the current Lisp process, evals it, and switches
to lisp buffer."
(interactive)
(clisp-eval-buffer)
(clisp-buffer-select))
;;; Sends current defun to current Lisp process and evals it.
(defun clisp-eval-defun ()
"Send the current defun to the current Lisp process and evals it."
(interactive)
(message "Evaling defun...")
(save-excursion
(beginning-of-defun)
(let ((begin (point)))
(end-of-defun)
(process-send-region
(clisp-buffer-to-process-name *last-lisp-buffer*) begin (point))
(process-send-string
(clisp-buffer-to-process-name *last-lisp-buffer*) "\n")
(message "Evaling defun...done."))))
;;; Sends current defun to current Lisp process, evals it, and
;;; switches to lisp buffer.
(defun clisp-eval-defun-and-go ()
"Send the current defun to the current Lisp process, evals it, and
switches to lisp buffer."
(interactive)
(clisp-eval-defun)
(clisp-buffer-select))
;;; Sends current defun to current Lisp process and compiles it.
(defun clisp-compile-defun ()
"Send the current defun to the current Lisp process and compiles it."
(interactive)
(message "Compiling defun...")
(save-excursion
(process-send-string (clisp-buffer-to-process-name *last-lisp-buffer*)
(format "(progn %s (compile '%s))\n"
(save-excursion
(beginning-of-defun)
(let ((begin (point)))
(end-of-defun)
(buffer-substring begin (point))))
(clisp-extract-defun-name)
(message "Compiling defun...done.")))))
;;; Sends current defun to current Lisp process, compiles it, and
;;; switches to lisp buffer.
(defun clisp-compile-defun-and-go ()
"Send the current defun to the current Lisp process, evals it, and
switches to lisp buffer."
(interactive)
(clisp-compile-defun)
(clisp-buffer-select))
;;; Sends last sexpr to current Lisp process and evals it.
(defun clisp-eval-last-sexpr ()
"Send the last sexpr to the current Lisp process and evals it."
(interactive)
(message "Evaling sexpr...")
(save-excursion
(mark-sexp -1)
(process-send-region
(clisp-buffer-to-process-name *last-lisp-buffer*) (point) (mark))
(process-send-string
(clisp-buffer-to-process-name *last-lisp-buffer*) "\n")
(message "Evaling sexpr...done.")))
;;; Sends last sexpr to current Lisp process, evals it, and switches
;;; to lisp buffer.
(defun clisp-eval-last-sexpr-and-go ()
"Send the last sexp to current Lisp process, evals it, and switches
to lisp buffer."
(interactive)
(clisp-eval-last-sexpr)
(clisp-buffer-select))
;;; Sends current region to current Lisp process and evals it.
(defun clisp-eval-region ()
"Send the current region to current Lisp process and evals it."
(interactive)
(message "Evaling region...")
(save-excursion
(process-send-region
(clisp-buffer-to-process-name *last-lisp-buffer*) (point)(mark))
(process-send-string
(clisp-buffer-to-process-name *last-lisp-buffer*) "\n")
(message "Evaling region...done.")))
;;; Sends current region to current Lisp process, evals it, and
;;; switches to lisp buffer.
(defun clisp-eval-region-and-go ()
"Send the current region to current Lisp process, evals it, and
switches to lisp buffer."
(interactive)
(clisp-eval-region)
(clisp-buffer-select))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; Tags are used to support indexing of functions in lisp files. This
;;; is similar to the Symbolics META-. function. The major difference
;;; is that you must have a tag table constructed ahead of time. The
;;; tag table is stored in the file TAGS in the same directory as the
;;; lisp files it indexes.
;;; This function shows you which files are indexed in the current tag
;;; table.
(defun clisp-list-tag-files ()
"Lists all files currently in tag table."
(interactive)
(or tags-file-name
(visit-tags-table "TAGS"))
(tag-table-files)
(with-output-to-temp-buffer "*Help*"
(princ "Files indexed by current tag table:\n")
(mapcar '(lambda (file)
(terpri)(princ " ")(princ file))
tag-table-files)))
;;; Builds a new tags table in file TAGS, containing all def forms for
;;; all lisp files in the current directory.
(defun clisp-recompute-tag-table ()
"Recomputes tags for all files in current directory."
(interactive)
(message "Computing tags...")
(shell-command "etags *.lsp")
(visit-tags-table default-directory)
(message "Computing tags...done."))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; Diversion functions. These functions send something to Lisp for
;;; evaluation and divert the output from this form to a given buffer.
;;; As far as the user can tell, Lisp hasn't seen these forms at all.
;;; Useful for getting info from current Lisp environment into the
;;; editor.
;;; *CLISP-DIVERSION-BUFFER* tells GNU where to stuff the diverted
;;; output.
(defvar *clisp-diversion-buffer* nil
"Indicates buffer for clisp-diverting-filter.")
;;; Open a new buffer containing the macroexpansion of the current
;;; form. Send a backquoted form to current Lisp for evaluation, where
;;; the header of the form tells GNU to intercept it.
(defun clisp-show-macro-expansion ()
"Show Common Lisp macro expansion for current sexpr in temporary buffer."
(interactive)
(message "Computing macro expansion...")
(save-window-excursion
(setq *clisp-diversion-buffer*
(get-buffer-create "*Macroexpansion Buffer*"))
(set-buffer *clisp-diversion-buffer*)
(erase-buffer))
(save-excursion
(process-send-string
(clisp-buffer-to-process-name *last-lisp-buffer*)
(format "`(*GNU* ,(let ((*print-pretty* t))
(format nil \"~A\" (macroexpand-1 '%s))))\n"
(clisp-extract-sexpr)))
(message "Computing macro expansion...done.")))
;;; The following two functions are bound to keys. They tell
;;; CLISP-SHOW-DOCUMENTATION which kind of symbol to search for and
;;; document.
(defun clisp-show-function-documentation ()
"Look for first symbol name before point and show its documentation"
(interactive)
(clisp-show-documentation 'function))
(defun clisp-show-variable-documentation ()
"Look for first symbol name before point and show its documentation"
(interactive)
(clisp-show-documentation 'variable))
;;; Open a new buffer to show the doc-string for the current function
;;; or variable from Common Lisp. Send a backquoted form to current
;;; Lisp for evaluation, where the header of the form tells GNU to
;;; intercept it.
(defun clisp-show-documentation (symtype)
"Show Common Lisp documentation for current symbol in temporary buffer."
(message "Fetching documentation...")
(save-excursion
(let ((symname (cond ((equal symtype 'function)
(upcase (clisp-extract-function-name)))
((equal symtype 'variable)
(upcase (clisp-extract-variable-name))))))
(setq *clisp-diversion-buffer*
(get-buffer-create "*Documentation Buffer*"))
(save-window-excursion
(set-buffer *clisp-diversion-buffer*)
(erase-buffer)
(insert (format "%s %s: "
(capitalize (symbol-name symtype))
symname)))
(and (equal symtype 'variable)
(process-send-string
(clisp-buffer-to-process-name *last-lisp-buffer*)
(format
"`(*GNU* ,(let ((*print-pretty* t))
(format nil \"~A\"
(cond ((boundp (intern \"%s\"))
(eval (intern \"%s\")))
(t \"Unbound\")))))\n"
symname symname symname)))
(process-send-string
(clisp-buffer-to-process-name *last-lisp-buffer*)
(format
"`(*GNU* ,(format nil \"~2%%~A\" (documentation '%s '%s)))\n"
symname symtype))
(message "Fetching documentation...done.")
(sit-for 1)
(message "Type C-x 1 to remove documentation window."))))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; Utility functions for showing macro expansion and Common Lisp
;;; definition information.
;;; Returns the function name of current defun.
(defun clisp-extract-defun-name ()
"Returns the function name of current defun."
(save-excursion
(beginning-of-defun)
(forward-char 1)
(forward-sexp 2)
(buffer-substring (point)(progn (backward-sexp 1)(point)))))
;;; Returns nearest symbol behind the point. Keep moving backward
;;; until you find a character that is either alphanumeric or another
;;; symbol-name character.
(defun clisp-extract-variable-name ()
"Returns nearest symbol behing the point."
(save-excursion
(while (and (/= (char-syntax (char-after (point))) 119)
(/= (char-syntax (char-after (point))) 95))
(backward-char 1))
(buffer-substring
(progn (backward-sexp 1)(point))
(progn (forward-sexp 1)(point)))))
;;; Returns the function name (car position) of the current sexpr.
(defun clisp-extract-function-name ()
"Returns function name from current non-atomic sexpr."
(save-excursion
(cond ((looking-at "(")
(forward-char 2))
((looking-at ")")
(forward-char 1)
(backward-sexp 1)
(forward-char 2))
(t (search-backward "(")
(forward-char 2)))
(buffer-substring
(progn (backward-sexp 1)(point))
(progn (forward-sexp 1)(point)))))
;;; Extracts the current non-atomic sexpr.
(defun clisp-extract-sexpr ()
"Returns current non-atomic sexpr."
(save-excursion
(cond ((looking-at "(")
(buffer-substring (point)
(progn (forward-sexp 1)(point))))
((looking-at ")")
(forward-char 1)
(buffer-substring
(progn (backward-sexp 1)(point))
(progn (forward-sexp 1)(point))))
(t (search-backward "(")
(buffer-substring (point)
(progn (forward-sexp 1)(point)))))))
;;; Returns the process name corresponding to a lisp buffer.
(defun clisp-buffer-to-process-name (buffer)
(let ((buffername (buffer-name buffer)))
(substring buffername 1 (1- (length buffername)))))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; The process filters allow communication from Common Lisp to GNU (GNU to
;;; Common Lisp is supplied by GNU buffer mechanism).
;;; CLISP-STARTUP-FILTER is a temporary filter used only until the
;;; first lisp prompt. Inserts the message of the day, but doesn't
;;; complain if the motd file doesn't exist.
(defun clisp-startup-filter (proc string buffer)
"Startup filter function for inferior lisp process. Prints the
message of the day if there is one and this is the first call to
this function. Then looks for first prompt and switches control
thereafter to clisp-filter."
(save-window-excursion
(set-buffer buffer)
(cond ((string-match inferior-lisp-prompt string)
(goto-char (point-max))
(insert string)
(move-marker last-input-start (1+ (point)))
(set-marker (process-mark proc) (1+ (point)))
(set-process-filter proc
(` (lambda (cls-proc cls-string)
(clisp-filter
cls-proc cls-string
(, buffer))))))
((equal (process-name proc) "lisp")
(condition-case ()
(insert-file *clisp-motd-file*)
(error nil))
(insert string))
(t (insert string)))))
;;; CLISP-FILTER is the normally used filter. It simply echoes all
;;; output from Common Lisp to the lisp buffer, unless that output is
;;; marked with a special tag indicating GNU should intercept it. Any
;;; output that looks like (*GNU* output-sexpr) will change the
;;; process filter to clisp-diverting-filter until the next lisp
;;; prompt. We can't rely on the output for GNU coming in a single
;;; string. We can, however, rely on the fact that it starts near the
;;; beginning of a string (usually in positions 1 or 2, depending on
;;; leading carriage returns and the like).
(defun clisp-filter (proc string buffer)
"Filter function for inferior lisp process. Looks for any output from
process beginning with the marker *GNU* and intercepts it."
(cond ((and (> (length string) 7)
(or (string-equal "*GNU*" (substring string 1 6))
(string-equal "*GNU*" (substring string 2 7))))
(set-process-filter proc
(` (lambda (cls-proc cls-string)
(clisp-diverting-filter
cls-proc cls-string
(, buffer)))))
(let ((quote-position (string-match "\"" string 6)))
(clisp-diverting-filter proc
(substring string (+ quote-position 1))
buffer)))
(t (save-window-excursion
(set-buffer buffer)
(goto-char (point-max))
(insert string)
(move-marker last-input-start (1+ (point-max)))
(set-marker (process-mark proc) (1+ (point-max)))))))
;;; CLISP-DIVERTING-FILTER hijacks the output from process and dumps it
;;; in the buffer cached in *clisp-diversion-buffer*. When it reaches a
;;; lisp prompt, it stops diverting output.
(defun clisp-diverting-filter (proc string original-buffer)
"Filter function that diverts output from process to a different buffer.
When the inferior-lisp-prompt is found, the process filter is reset to
clisp-filter."
(let ((prompt-position (string-match inferior-lisp-prompt string)))
(cond (prompt-position
(save-window-excursion
(set-buffer *clisp-diversion-buffer*)
(goto-char (point-max))
(insert (substring string 0 prompt-position))
(delete-backward-char 4)
(goto-char (point-min))
(set-buffer-modified-p nil))
(display-buffer *clisp-diversion-buffer*)
(set-process-filter proc
(` (lambda (cls-proc cls-string)
(clisp-filter
cls-proc cls-string
(, original-buffer)))))
(cond ((> (length string) prompt-position)
(clisp-filter proc
(substring string (match-end 0))
original-buffer))))
(t (save-window-excursion
(set-buffer *clisp-diversion-buffer*)
(goto-char (point-max))
(insert string))))))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; Indentation commands.
;;; CLISP-REINDENT-FORM should rejustify a comment if it is called from
;;; within a comment line. Otherwise, if called from within a lisp
;;; form, it should reindent the entire lisp form.
(defun clisp-reindent-form ()
"Reindents the current form, whether it be comment or code."
(interactive)
(save-excursion
(back-to-indentation)
(cond ((looking-at ";")
(clisp-set-prefix-string)
(beginning-of-comment)
(let ((begin (point)))
(end-of-comment)
(fill-region-as-paragraph begin (point))))
(t (beginning-of-defun)
(next-line 1)
(message "Reindenting...")
(while (not (or (eobp)
(let ((indent (calculate-lisp-indent)))
(cond ((consp indent)
(zerop (car indent)))
(t (zerop indent))))))
(lisp-indent-line)
(next-line 1))
(message "Reindenting...done.")))))
;;; CLISP-SET-PREFIX-STRING is used to set the fill prefix string to the
;;; right thing for each type of comment.
(defun clisp-set-prefix-string ()
"Determines what the fill-prefix should be depending on the comment type."
(cond ((looking-at ";;; ")
(setq fill-prefix ";;; "))
((looking-at ";; ")
(setq fill-prefix ";; "))
((looking-at "; ")
(setq fill-prefix "; "))
(t (setq fill-prefix ""))))
(defun beginning-of-comment ()
"Moves to first comment line surrounding point."
(while (and (not (bobp))
(progn (back-to-indentation)
(looking-at ";")))
(previous-line 1))
(next-line 1)
(back-to-indentation))
(defun end-of-comment ()
"Moves to last comment line surrounding point."
(while (and (not (eobp))
(progn (back-to-indentation)
(looking-at ";")))
(next-line 1))
(previous-line 1)
(end-of-line)
(forward-char 1))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; Fix the indentation of FOR macro and other forms that are not normally
;;; well indented by GNU.
(put 'for 'common-lisp-indent-hook 'lisp-indent-for)
(put 'bind 'common-lisp-indent-hook 'lisp-indent-for)
(put 'repeatwhile 'common-lisp-indent-hook 'lisp-indent-for)
(put 'repeatuntil 'common-lisp-indent-hook 'lisp-indent-for)
(put 'merge 'common-lisp-indent-hook 1)
(put 'while 'common-lisp-indent-hook 1)
(put 'until 'common-lisp-indent-hook 1)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; Functions and variables for Interlisp FOR macro indentation.
(defvar lisp-for-keyword-indentation 2
"Indentation of FOR macro keywords relative to containing list.
This variable is used by the function lisp-indent-for.")
(defvar lisp-for-body-indentation t
"Indentation of forms after FOR macro keywords relative to containing list.
This variable is used by the function lisp-indent-for to indent normal
lines (lines without FOR macro keywords).
The indentation is relative to the indentation of the parenthesis enclosing
the special form. If the value is t, the body of tags will be indented
as a block at the same indentation as the first s-expression following
the tag. In this case, any forms before the first tag are indented
by lisp-body-indent.")
;;; LISP-INDENT-FOR is almost exactly like LISP-INDENT-TAGBODY except that
;;; it uses the above-defined variables for indenting a FOR macro and indents
;;; keywords even if you use some on the same line as the FOR.
(defun lisp-indent-for (path state indent-point sexp-column normal-indent)
(save-excursion
(goto-char indent-point)
(beginning-of-line)
(skip-chars-forward " \t")
(list (cond ((looking-at "\\sw\\|\\s_")
;;; a FOR macro keyword
(+ sexp-column lisp-for-keyword-indentation))
((integerp lisp-for-body-indentation)
(+ sexp-column lisp-for-body-indentation))
((eq lisp-for-body-indentation 't)
(condition-case ()
(progn (backward-sexp 1) (current-column))
(error (1+ sexp-column))))
(t (+ sexp-column lisp-body-indent)))
(elt state 1))))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; Superparen functions. These are adapted from functions in
;;; simple.el, part of the standard GNU distribution.
;;; DOES-NOT-MATCH-CLOSE-PAREN-P returns t if the character at the
;;; given character position is not a match for a close paren.
(defun does-not-match-close-paren-p (charpos)
"Returns t if the character at the point doesn't match a close paren."
;;; 41 is the character code for a close paren.
(/= 41
(logand
;;; The character that the one at charpos matches is stored in the
;;; upper 8 bits of its syntax table entry.
(lsh (aref (syntax-table)
(char-after charpos))
-8)
?\177)))
;;; SHOW-MATCHING-CONTEXT will either blink the (visible) open paren
;;; matching the current close paren, or print the part of this line
;;; containing the matching open paren in the minibuffer if it isn't
;;; visible in the current window.
(defun show-matching-context (lastopenpos)
(save-excursion
(goto-char lastopenpos)
;;; If the last-matched open paren is on the screen, just move the
;;; cursor to it temporarily.
(cond ((pos-visible-in-window-p)
(sit-for 1))
;;; Otherwise, print part of the line containing the last-matched open
;;; paren.
(t (goto-char lastopenpos)
(message
"Matches %s"
(cond ((save-excursion
(skip-chars-backward " \t")
(not (bolp)))
(buffer-substring
(progn (beginning-of-line) (point))
(1+ lastopenpos)))
(t (buffer-substring
lastopenpos
(progn
(forward-char 1)
(skip-chars-forward "\n \t")
(end-of-line)
(point))))))))))
;;; SUPER-CLOSE-PAREN searches backwards for open parens and inserts
;;; matching close parens at the point. If an open bracket is
;;; encountered, it is replaced with an open paren and matched, but
;;; the matching stops.
;;; If you are in Common Lisp mode, open parens within comments will
;;; be matched, so you should begin top level forms with an open bracket
;;; to keep from matching parens in comments.
(defun super-close-paren ()
"Insert close parentheses as necessary to balance unmatched open parens."
(interactive)
;;; If the character before the point is a quote, just insert a close
;;; bracket. If not, don't bother looking for open parens if the
;;; point is at the beginning of the buffer.
(cond ((= (char-syntax (char-after (- (point) 2))) ?\\ )
(insert "]"))
((if (> (point) (1+ (point-min)))
;;; If you're not at the beginning of the buffer, start looking for
;;; open parens.
(let* ((openpos t) ; must be t to pass the while test
(mismatch)
(lastopenpos t)) ; used to signal 1st iteration
;;; Insert a close paren to keep scan-sexps from returning the left
;;; end of a symbol instead of a list.
(insert ")")
(while openpos
;;; Keep looking for unmatched open parens to the left and inserting
;;; matching close parens until there are no unmatched parens.
;;; Condition-case traps errors quietly.
(condition-case ()
(setq openpos (scan-sexps (point) -1))
(error nil))
;;; If no new open paren has been found, then the new position will be
;;; the same as the old one. In this case, the while loop should be
;;; terminated, so openpos should be set to nil. Setting lastopenpos
;;; to nil signals that no open parens at all were found.
(cond ((equal openpos lastopenpos)
(setq openpos nil)
(cond ((equal lastopenpos t)
(setq lastopenpos nil)))))
;;; If you have found an open paren, but the syntax table says that it
;;; isn't a "paired delimiter" and doesn't match a close paren, that
;;; open paren is either mismatched or is really a open bracket.
(if (and
openpos
(/= (char-syntax (char-after openpos)) ?\$))
(setq mismatch
(does-not-match-close-paren-p
openpos)))
;;; If you have found a mismatch or open bracket, terminate the while
;;; loop. If the last "paren" found was actually an open bracket, it
;;; should be replaced replaced with an open paren and matched with a
;;; close paren. The open bracket is not a mismatch, but the while
;;; loop should still be exited.
(cond (mismatch
;;; 91 is the character code for open bracket
(cond ((= 91 (char-after openpos))
(setq lastopenpos openpos)
(save-excursion
(goto-char openpos)
(delete-char 1)
(insert "("))
(insert ")")
(setq mismatch nil)))
(setq openpos nil)))
;;; If you've found a matchable open paren, insert a close paren.
;;; Otherwise, get rid of the extra paren inserted earlier.
(cond (openpos
(insert ")")
(setq lastopenpos openpos))
(t (delete-backward-char 1))))
;;; If you found mismatched parens, complain. Otherwise, show what
;;; the last paren inserted matches.
(cond (mismatch
(message "Mismatched parentheses"))
(lastopenpos
(show-matching-context lastopenpos))))))))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; The remainder of this file was adapted from code originally
;;; written by Wolfgang Rupprecht (wolfgang@mgm.mit.edu) by David
;;; Hubbell (hubbell@svax.cs.cornell.edu). The original file
;;; (shellext.el) provided ksh-like extensions to shell.el; we've
;;; usurped the history mechanism and some of the shell options from
;;; Wolfgang's code, and have added much of our own code.
;;; This is a ksh-like extension to shell.el. These extensions
;;; implement command history (backwards, forwards, back-search,
;;; forward-srearch) and history printout for an emacs shell window.
;;; The one glaring difference between this and ksh, is that all of
;;; the shell-mode commands are bound to the Control-C prefix map.
;;; (Eg. previous command is C-c C-p).
(defvar clisp-shell-last-search "" "Last shell search string.")
(defvar clisp-shell-max-history 60
"*Max shell history retained")
(defvar clisp-shell-history-list nil
"History list of past shell commands.")
(defvar clisp-shell-history-index -1
"Where we are on the history list. It is -1 unless currently
walking up/down the list")
;;; CLISP-SHELL-PREVIOUS-COMMAND replaces the region between the last
;;; character output from the shell and the end of the buffer with the
;;; (clisp-shell-history-index + 1)th element in the history list, if
;;; this element exists, and increments clisp-shell-history-index.
;;; Successive calls to CLISP-SHELL-PREVIOUS-COMMAND therefore produce
;;; successively older entries in the history list.
(defun clisp-shell-previous-command ()
"Insert the previous command on the history list into the Lisp buffer."
(interactive)
(let ((history (nthcdr (1+ clisp-shell-history-index)
clisp-shell-history-list)))
(cond (history
(delete-region (process-mark
(get-buffer-process (current-buffer)))
(point-max))
(goto-char (point-max))
(insert (car history))
(setq clisp-shell-history-index
(1+ clisp-shell-history-index)))
(t (error
"Beginning of history list (# of entries: %d)"
(1+ clisp-shell-history-index))))))
;;; CLISP-SHELL-NEXT-COMMAND replaces the region between the last
;;; character output from the shell and the end of the buffer with the
;;; (clisp-shell-history-index)th element in the history list, if this
;;; element exists, and decrements clisp-shell-history-index.
;;; Successive calls to CLISP-SHELL-NEXT-COMMAND therefore produce
;;; successively younger entries in the history list.
(defun clisp-shell-next-command ()
"Insert the next command from the history list into the Lisp buffer."
(interactive)
(cond ((< 0 clisp-shell-history-index)
(delete-region (process-mark
(get-buffer-process (current-buffer)))
(point-max))
(goto-char (point-max))
(insert (nth
(setq clisp-shell-history-index
(1- clisp-shell-history-index))
clisp-shell-history-list)))
(t (error "End of history list"))))
;;; CLISP-SHELL-HISTORY-SEARCH-BACKWARD searches chronologically
;;; backward (not structurally) through the history list for a string
;;; that is a superstring of the argument. If such a string is found,
;;; it replaces the text between the last prompt and the end of the
;;; buffer and clisp-shell-history-index is changed to the index of
;;; this string in the history list. If such a string is not found,
;;; clisp-shell-history-index remains unaltered.
(defun clisp-shell-history-search-backward (string)
"Search backwards through the history list for STRING
and inserts it if the search is successful."
(interactive (list (setq clisp-shell-last-search
(read-string
"History search for: "
clisp-shell-last-search))))
(let* ((index (1+ clisp-shell-history-index)) ; start at next command
(history (nthcdr index clisp-shell-history-list)))
(while (and history
(null (string-match string (car history))))
(setq index (1+ index)
history (cdr history)))
(cond (history
(setq clisp-shell-history-index index)
(delete-region (process-mark
(get-buffer-process (current-buffer)))
(point-max))
(goto-char (point-max))
(insert (car history)))
(t (error "No match found, now at entry %d"
clisp-shell-history-index)))))
;;; CLISP-SHELL-HISTORY-SEARCH-FORWARD searches chronologically
;;; forward (not structurally) through the history list for a string
;;; that is a superstring of the argument. If such a string is found,
;;; it replaces the text between the last prompt and the end of the
;;; buffer and clisp-shell-history-index is changed to the index of
;;; this string in the history list. If such a string is not found,
;;; clisp-shell-history-index remains unaltered.
(defun clisp-shell-history-search-forward (string)
"Search forwards through the history list for STRING
and inserts it if the search is successful."
(interactive (list (setq clisp-shell-last-search
(read-string
"History search for: "
clisp-shell-last-search))))
;;; Reversing the list now is asymptotically more efficient than
;;; doing nth n times, where n is the length of the history list.
(let* ((history-length (length clisp-shell-history-list))
(index (- history-length clisp-shell-history-index 1))
(reverse-history-list
(nthcdr index (reverse clisp-shell-history-list))))
(while (and reverse-history-list
(null (string-match string
(car reverse-history-list))))
(setq index (1+ index)
reverse-history-list (cdr reverse-history-list)))
(cond (reverse-history-list
(setq clisp-shell-history-index (- history-length index 1))
(delete-region (process-mark
(get-buffer-process (current-buffer)))
(point-max))
(goto-char (point-max))
(insert (car reverse-history-list)))
(t (error "No match found, now at entry %d"
clisp-shell-history-index)))))
;;; CLISP-SHELL-LIST-HISTORY prints the contents of the history list
;;; to a temporary *History* buffer, most recent entry first, with a
;;; '*' at the current position.
(defun clisp-shell-list-history ()
"List the history in the *History* buffer. A '*' indicates current
position on the history list."
(interactive)
(with-output-to-temp-buffer "*History*"
(let ((history clisp-shell-history-list)
(index 0))
(while history
(princ (format " %c[%d] %s\n"
(if (= index clisp-shell-history-index)
?* ?\ )
index (car history)))
(setq history (cdr history)
index (1+ index)))))
(message "Type C-x 1 to remove history window."))
;;; CLISP-SHELL-SAVE-HISTORY saves the region between the last prompt
;;; and the end of buffer onto the history list, and sets the
;;; clisp-shell-history-index to the start (most recent entry) of the
;;; list.
(defun clisp-shell-save-history ()
"Save this command on the clisp-shell-history-list."
(let ((command (buffer-substring
last-input-start (1- last-input-end))))
(if (or (string-match "^[ \t]*$" command)
(string-equal command (car clisp-shell-history-list)))
nil ; don't hang dups on list
(setq clisp-shell-history-list
(cons command clisp-shell-history-list))
(let ((prune-pt (nthcdr clisp-shell-max-history
clisp-shell-history-list)))
(and prune-pt (rplacd prune-pt nil)))))
(setq clisp-shell-history-index -1))
;;; CLISP-SHELL-SEND-INPUT-IF-SEXPR: see documentation string.
(defun clisp-shell-send-input-if-sexpr ()
"Send input to subshell if the last input was an s-expression.
At end of buffer, sends all text after last output as input to the
subshell if that text was an s-expression, including a newline inserted
at the end.
If the point is not at the end of the buffer and is after the last prompt,
the point moves to the end of buffer.
If still not at end, copies current line to the end of the buffer and sends
it, if it was an s-expression, after first attempting to discard any prompt
at the beginning of the line by matching the regexp that is the value of
shell-prompt-pattern if possible. This regexp should start with \"^\"."
(interactive)
(or (get-buffer-process (current-buffer))
(error "Current buffer has no process"))
(end-of-line)
;;; The beginning of the input region will be where the process ;;
;;; left off. If the point is after the beginning of the input ;;
;;; region, place it at the end of the buffer.
(move-marker last-input-start
(process-mark (get-buffer-process (current-buffer))))
(cond ((< (marker-position last-input-start) (point))
(goto-char (point-max))))
;;; If you're at the end of the buffer, just insert a newline and
;;; move the input-end marker to the end of the buffer. If you're
;;; not at the end of the buffer, copy everything from the last
;;; prompt to the point to the end of the buffer and treat that as
;;; the input region.
(cond ((eobp)
(newline)
(move-marker last-input-end (point)))
(t (let* ((last-prompt-end
(save-excursion
(re-search-backward shell-prompt-pattern nil t)
(re-search-forward shell-prompt-pattern nil t)
(point)))
(copy (buffer-substring
last-prompt-end
(point))))
(goto-char (point-max))
(move-marker last-input-start (point))
(insert copy)
(move-marker last-input-end (point)))))
;;; If the string between the start of input and the end of the buffer
;;; is an s-expression, send it to the lisp process and save it on
;;; the history list. Otherwise, terminate.
(let ((last-sexp-end
(save-excursion
(goto-char (marker-position last-input-start))
(condition-case ()
(scan-sexps (point) 1)
(error nil)))))
(cond (last-sexp-end
;;; Even if we get an error trying to hack the working directory,
;;; still send the input to the subshell.
(condition-case ()
(save-excursion
(goto-char last-input-start)
(shell-set-directory))
(error (funcall shell-set-directory-error-hook)))
(let ((process (get-buffer-process (current-buffer))))
(process-send-region process last-input-start last-input-end)
(clisp-shell-save-history)
(set-marker (process-mark process) (point)))))))
SHAR_EOF
cat << \SHAR_EOF > header.lsp
;;; -*- Syntax: Common-Lisp; Package: USER; Base: 10; Mode: LISP -*- ;;;
;;; ;;;
;;; Copyright (c) 1989 Cornell Apprentice Project, Cornell University ;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
SHAR_EOF
# End of shell archive
exit 0