segre@baal.cs.cornell.edu (Alberto M. Segre) (08/30/89)
This is the first of 2 shell archives containing the latest release of
GNU emacs/Common Lisp interface "clisp.el". Unshar and see the file
"Help" for more information.
Alberto Segre
Assistant Professor
Cornell University
Department of Computer Science
Upson Hall
Ithaca, NY 14853-7501
ARPA: segre@cs.cornell.edu
# 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:
# Install
# Notes
# .emacs
# autoinclude.el
# xmouse.el
# header.lisp
# This archive created: Fri Aug 18 12:43:09 1989
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.
YOU WILL NEED TO CHANGE THE VARIABLES RIGHT AFTER WHERE IT SAYS
"System-dependent variables."
Change the default value of inferior-lisp-host to be a string
containing the machine where your Common Lisp should be started.
Currently defaults to whatever machine you're running on.
Change the default value of inferior-lisp-program to point to the
Common Lisp executable on the inferior-lisp-host.
Change the default value of inferior-lisp-prompt to be consistent
with the type of Common Lisp used in inferior-lisp-program (e.g.,
Lucid, KCL, etc.). Working prompts for KCL, Allegro, CMU Lisp, Lucid
and BBN Common Lisp are defvar'd for your convenience.
Change the default value of remote-shell-program to point to the
rsh executable on the inferior-lisp-host for your installation. You
probably won't need to change this.
Change the value of *clisp-motd-file* to point to a file where the
"message of the day" is stored. The contents of this file will be
displayed in each users first Common Lisp buffer.
Change the value of *lisp-filename-extenstion* to whatever your
Common Lisp expects (".lsp" for KCL, ".lisp" for Lucid, ".cl" for
Allegro, etc.).
Change the value of *clisp-temporary-directory* to point to a directory
that is readable/writeable by the user. It will be used for temporary
files. Defaults to "/tmp".
6. "C-u 1 M-x byte-recompile-directory" to GNU will compile all of the
files ending with ".el" in the ".elisp" directory.
7. Edit the file "header.lisp" to whatever you like. This is the file
that will be read in at the beginning of every new Lisp file you
create. The sample header.lisp 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.lisp file in the ".auto" directory. You
should change the ".lisp" extension at this time to match whatever you
set *lisp-filename-extenion* to in step 5 (from here on, we'll assume
you're using ".lisp" as your extension). Note that the autoinclude
feature works for any extension you like (provided you've set the
auto-include-alist properly in your .emacs file); 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
".lisp" extension. You should end up facing a fresh file containing
header.lisp; "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 in the file called Help.
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@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
Cornell Apprentice Project (CAP)
GNU Emacs/Common Lisp Environment Release Notes.
Mail bug reports to segre@cs.cornell.edu
=====
August 15, 1989
Compilation of defmacros, defmethods, defstructs and the like now work
properly. Handling these requires writing them out to a temporary file
and then compiling that file. New variable *clisp-temporary-directory*
defaults to /tmp.
Handling of clisp-eval-buffer (C-c b, C-c C-b) and clisp-eval-region
(C-c r, C-c C-r) have been changed to use this intermediate temporary
file mechanism as well.
The functions clisp-eval-file, clisp-eval-file-and-go,
clisp-compile-file, clisp-compile-file-and-go, clisp-compile-region,
clisp-compile-region-and-go, clisp-compile-buffer and
clisp-compile-buffer-and-go are now available although not bound to
keys.
Extensive changes made to startup mechanism in order to support
running different flavors of lisps on different hosts. Check the
Install file for new installation instructions. We've removed the
dependency on shell.el; the parts of shell.el that were used have been
revised for clisp.el.
New variable *clisp-image-table* allows you to specify host names,
images and prompts for a variety of machines.
Function clisp-create-lisp-buffer (M-C-l) now takes a prefix argument.
A 0 creates a new lisp process on the default host (same as start-lisp).
An integer creates the lisp specified as the ith entry in
*clisp-image-table*. No prefix argument cycles through *clisp-image-table*,
allowing you to pick one.
Variable *clisp-default-host* no longer exists.
Function start-lisp no longer takes an argument (check your .emacs
files).
Each installation should establish default values in the clisp.el
file. If a user wishes to make their own default lisp different than
the standard default lisp set in their installation's clisp.el file,
they should change their lisp-mode-hook to look like this:
(setq lisp-mode-hook
'(lambda ()
(require 'clisp)
(setq-default inferior-lisp-host
"myfavoritemachine")
(setq-default inferior-lisp-program
"/usr/u/cap/akcl/xbin/kcl")
(setq-default inferior-lisp-prompt
*clisp-kcl-prompt*)
(setq-default remote-shell-program
"/usr/ucb/rsh")
(start-lisp)))
You probably don't need to set remote-shell-program differently. In
addition, if you are satisfied with the default lisp flavor (e.g.,
Lucid vs. KCL vs. BBN, etc) but want a different default host, you
need not reset the defaults for inferior-lisp-program and
inferior-lisp-prompt; just reset inferior-lisp-host.
Similarly, each site should set a value for *clisp-image-table* in the
clisp.el file, although a user can establish their own value in their
.emacs file. My .emacs file contains the following (which supersedes
the value set in clisp.el for my own site; note that each entry is
eval'd, thus (system-name) refers to the current system):
(defvar *clisp-image-table*
'(((system-name) "/usr/u/cap/akcl/xbin/kcl"
*clisp-kcl-prompt* nil)
((system-name) "/usr/local/bin/lisp-pcl"
*clisp-lucid-prompt* nil)
((system-name) "/usr/local/bin/lisp-clx"
*clisp-lucid-prompt* nil)
("iron" "/usr/blisp/mach/bin/common-lisp"
*clisp-bbn-prompt* "/usr/ucb/rsh")
("rocky" "/usr/local/bin/lisp"
*clisp-lucid-prompt* "/usr/ucb/rsh")
("rocky" "/usr/local/bin/lisp-pcl"
*clisp-lucid-prompt* "/usr/ucb/rsh")))
Fixed a bug in handling packages. Modeline package specifier is
coerced to upper case (as on Symbolics). Argument to in-package
command is coerced to upper case only if its an atom (strings are read
as is).
New Lucid Common Lisp prompt regexp.
Sample .emacs file distributed with past versions caused problems for
some people due to control character strings getting munged in
transit. The global-set-key commands have been rewritten to avoid
using control characters to specify key sequences. Sorry!
=====
June 13, 1989
Distribution now comes in two parts to satisfy the mailing system.
Fixed a bug in the package handling mechanism that arose when evaling
buffers or regions with package commands in them. Provided the package
commands are relatively straight-forward, things ought to work pretty
much correctly now.
C-c a, C-c f, and C-c v now work within the Lisp process as well.
Fixed a bug in handling *clisp-default-host*.
CLOS defgeneric added to template facility (C-c =).
=====
May 5, 1989
We're now tracking the package of the current buffer. Any expression
sent to Lisp will be evaluated in the current package (as read from
the mode line of the file or explicitly set via M-p). In addition, the
file is searched backwards from current point for explicit IN-PACKAGE
statements that would alter the current package. The mode line must
be the first line of the file, and should look like the Symbolics
mode-line; however, only the PACKAGE: specifier is meaningful. Note
that if an operation causes a break in the inferior lisp, and you
abort this break, you may be stuck in an unexpected package.
Added a new interactive template facility. C-c = begins an interactive
dialogue with the user that results in a new DEFUN, DEFVAR, DEPARAMETER,
DEFCONSTANT, DEFSTRUCT, DEFCLASS or DEFMETHOD (appropriately tagged with
user's name and date of creation). A prefix arg to C-c= inserts a
separator (a line of semicolons) before the new definition (you can also
set *clisp-default-separate* to t if you always want this separator).
Specify argument names, slot names, etc when prompted in the minibuffer.
Slots for structures or CLOS classes may be specified as NAME or (NAME
VALUE) pairs.
Prefix arg to C-c d, C-c b, C-c s, C-c r, C-c t, C-c p and their
variants (e.g., C-c C-d, C-c C-b, C-c C-s, C-c C-r, C-c C-t, C-c C-p)
specifies which running Lisp process. Defaults to last selected Lisp
process. Respects packages. Same goes for C-c m, C-c f, C-c v, and C-c a.
Changed behavior of all of the "-and-go" functions to be a little
smarter about bringing up new windows when the proper buffer is
already being displayed.
Changed behavior when attempting to select a dead Lisp process; clisp
now switches to the "next" reasonable Lisp process and prints a message.
A few new keybindings, and a few changed ones. M-C-t and M-t from the
last release overwrote useful transpose commands. These have been
rebound.
C-c = interactive definition facility (prefix arg inserts separator)
C-c / [was M-t] recomputes lookup table for (C-c .) and (M-c-,)
C-c ? [was M-C-t] lists files indexed by (C-c .)
M-p set default package for current buffer
Fixed bug in remote lisp procedures; they are now started using the
current default directory as Lisp's *default-pathname-defaults*.
Fixed bug in output filter function that prevented typeahead from
working correctly in some situations.
Fixed a bug that was evident if you used funny characters in function
or variable names. Common Lisp allows function names like "foo.1.2"
(no quotes) or even "|foo\|.2\|.3|" (no quotes); the interface now
handles these correctly.
Added some bindings for ease of mouse use under X11R3. These are in a
separate file "xmouse.el", and are likely to change in the near
future.
Indentation support for the FOR macro package I distribute also seems
to work fairly well for the Zeta-lispish LOOP macro. This has been
added so you needn't do anything special to get your LOOPs to indent
properly.
Inferior-lisp-prompt for CMU lisp on an IBM RT seems to be "\\*".
=====
March 10, 1989
Added new prompt string for Lucid Common Lisp; this is now the default
lisp. If you use Kyoto Common Lisp or Allegro Common Lisp you will
need to change both inferior-lisp-prompt and inferior-lisp-program;
see the documentation in clisp.el.
Added a new variable *clisp-default-host* which defaults to the
current system. This variable determines which machine should run your
default lisp process.
Fixed a bug that often caused more than one copy of the motd to be
printed in buffer *lisp*. This was most noticeable with Lucid Common
Lisp.
The new string inferior-lisp-extension now needs to be set. This fixes
a bug in the tags facility that expected lisp files to end with the
".lsp" extension from KCL. Defaults to ".lisp"
C-c C-a now works as advertised.
Some new bindings and some bindings have changed:
C-c t Trace current defun
C-c C-t Trace current defun and go to lisp
M-t List tag files (was C-c t)
M-C-t Recompute tag files (was C-c C-t)
C-c a Beginning of current defun
C-c e End of current defun
Fixed a bug with where lisp output is placed in the buffer. Now
properly supports typeahead when the process hasn't finished dumping
output to the lisp buffer.
Hitting return at the end of any sexpr in the lisp buffer brings that
sexpr down to the current prompt and evaluates it.
Previously destroyed lisp process buffers are now reused when starting
new lisps.
=====
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
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).
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.
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.
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).
C-c h has been replaced by C-c f and C-c v, fetching function and
variable documentation respectively.
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))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; Make sure the filename extension your lisp expects is associated
;;; with lisp-mode. Many of the common ones (e.g., ".lisp" or ".l")
;;; are already on auto-mode-alist.
(setq auto-mode-alist (append
'(("\\.lsp$" . lisp-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/")
;;; Change the lisp-mode-hook to load the inferior lisp process stuff.
(setq lisp-mode-hook '(lambda ()
(require 'clisp)
(start-lisp)))
;;; Set the lisp images you will be using. Note that each entry in the
;;; table consists of four elements which are EVALUATED when the image is
;;; constructed. Thus (system-name) returns the name of the system
;;; you're currently logged into. You don't need this if you're satisfied
;;; with your installation's *clisp-image-table* (see file clisp.el).
(defvar *clisp-image-table*
'(((system-name) "/usr/local/bin/lisp"
*clisp-lucid-prompt* "/usr/ucb/rsh")
((system-name) "/usr/local/bin/lisp-pcl"
*clisp-lucid-prompt* "/usr/ucb/rsh")
((system-name) "/usr/local/bin/lisp-clx"
*clisp-lucid-prompt* "/usr/ucb/rsh")
((system-name) "/usr/u/cap/akcl/xbin/kcl"
*clisp-kcl-prompt* "/usr/ucb/rsh")
("iron" "/usr/blisp/mach/bin/common-lisp -nint 16 -nmem 5"
*clisp-bbn-prompt* "/usr/ucb/rsh")
("vali" "/usr/bin/cl"
*clisp-allegro-prompt* "/usr/ucb/rsh")))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; Key bindings.
;;; Global replace
(global-set-key "\M-r" 'replace-string)
(global-set-key "\M-\C-r" 'query-replace)
;;; Change other window commands.
(global-set-key "\C-xn" 'select-next-window)
(global-set-key "\C-xp" 'select-previous-window)
(global-set-key "\C-xd" 'delete-window)
(global-set-key "\C-xv" 'find-alternate-file)
(global-set-key "\C-x\C-v" 'find-file-other-window)
(global-set-key "\C-xt" 'line-to-top)
;;; Add kill-some-buffers.
(global-set-key "\C-x\C-k" '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 > xmouse.el
;;; This file contains fixes to the behavior of x-mouse.el
;;; to make it work in a fashion more consistent with xterm. It is
;;; based on a set of corrections called fix-x-mouse.el by
;;; Jean-Francois Lamy (lamy@ai.utoronto.ca). It also has a number of
;;; fixes (x11cut.el) posted by Reed Hastings (hastings@spar.slb.com)
;;; to make the X11 cut buffer and the top of the emacs kill ring be
;;; the same thing.
;;; Mouse bindings:
;;; Left Middle Right
;;;
;;; Unshifted set-point yank set-mark and
;;; copy to kill buffer
;;;
;;; (Drag) set-mark and set-mark and
;;; copy to kill buffer () copy to kill buffer
;;;
;;; Shifted split-window help buffer menu
;;;
;;; Control unsplit-window yank-pop kill-region
;;;
;;; Control-Shifted () () ()
(define-key mouse-map x-button-left 'x-mouse-set-point)
(define-key mouse-map x-button-middle 'x-yank)
(define-key mouse-map x-button-right 'x-cut-text)
(define-key mouse-map x-button-left-up 'x-cut-text-if-moved)
(define-key mouse-map x-button-right-up 'x-cut-text-if-moved)
(define-key mouse-map x-button-s-left 'x-mouse-select-and-split)
(define-key mouse-map x-button-s-middle 'x-help)
(define-key mouse-map x-button-s-right 'x-buffer-menu)
(define-key mouse-map x-button-c-left 'x-mouse-keep-one-window)
(define-key mouse-map x-button-c-middle 'x-yank-pop)
(define-key mouse-map x-button-c-right 'x-cut-and-wipe-text)
(define-key mouse-map x-button-c-s-left 'x-unbound-mouse)
(define-key mouse-map x-button-c-s-middle 'x-unbound-mouse)
(define-key mouse-map x-button-c-s-right 'x-unbound-mouse)
(defun x-unbound-mouse (arg)
(beep))
(defun x-cut-text (arg &optional kill)
"Copy text between point and mouse into window system cut buffer.
Set mark to current mouse position. Save in Emacs kill ring also."
(if (coordinates-in-window-p arg (selected-window))
(progn
(x-mouse-set-mark arg)
(let ((beg (point)) (end (mark)))
(x-store-cut-buffer (buffer-substring beg end))
(if kill (delete-region beg end))))
(message "Mouse not in selected window")))
(defun x-cut-text-if-moved (arg &optional kill)
"Copy text between point and current mouse position into window
system cut buffer if the mouse has changed position. Set mark to
current mouse position. Save in Emacs kill ring also."
(let ((opoint (point)))
(x-mouse-set-point arg)
(cond
((not (equal (point) opoint))
(goto-char opoint)
(x-cut-text arg kill)))))
(defun x-paste-text (arg)
"Insert window system cut buffer contents at current point."
(insert (x-get-cut-buffer)))
(defun x-cut-and-wipe-text (arg)
"Kill text between point and mark; also copy to window system cut buffer."
(x-cut-text arg t))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; the way yank and yank-pop in simple.el communicate is by
;;; setting the var last-command.
;;; Because of the way the mouse is hacked into Gnu, last-command is
;;; x-mouse-flush-queue, and we have to use a different procedure. We
;;; record the mouse position. If the mouse moves the
;;; yank/yank-pop/yank-pop... chain is broken. This is gross. If
;;; anyone knows how, please fix last command so we can use it.
(defvar mouse-position-on-last-yank nil
"hack holder for yank/yank-top communication.")
(defun x-yank (arg)
"Yank from X cut buffer (which is the same as the top of the
emacs kill ring) after moving the point to the mouse cursor"
(x-mouse-set-point arg)
(yank nil)
(setq mouse-position-on-last-yank arg)) ;; hack for yank-pop's benefit
(defun x-yank-pop (arg)
(if (equal arg mouse-position-on-last-yank)
(progn (let ((last-command 'yank))
(yank-pop 1)))
(setq mouse-position-on-last-yank nil)
(error "Mouse cursor has moved since last yank. Hold it still to cycle the kill ring")))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; from simple.el
(defun copy-region-as-kill (beg end)
"Save the region as if killed, but don't kill it."
(interactive "r")
(if (eq last-command 'kill-region)
(kill-append (buffer-substring beg end) (< end beg))
(let ((this-string (buffer-substring beg end)))
(copy-to-window-system-cut-buffer this-string)
(setq kill-ring (cons this-string kill-ring)))
(if (> (length kill-ring) kill-ring-max)
(setcdr (nthcdr (1- kill-ring-max) kill-ring) nil)))
(setq this-command 'kill-region)
(setq kill-ring-yank-pointer kill-ring))
;;; from simple.el
(defun kill-append (string before-p)
(let ((new-top (if before-p
(concat string (car kill-ring))
(concat (car kill-ring) string))))
(setcar kill-ring new-top)
(copy-to-window-system-cut-buffer new-top)))
(defun copy-to-window-system-cut-buffer (string)
(if window-system
(x-store-cut-buffer string)))
;;; from simple.el
(defun yank (&optional arg)
"Reinsert the last stretch of killed text.
More precisely, reinsert the stretch of killed text most recently
killed OR yanked.
With just C-U as argument, same but put point in front (and mark at end).
With argument n, reinsert the nth most recently killed stretch of killed
text.
See also the command \\[yank-pop]."
(interactive "*P")
(rotate-yank-pointer (if (listp arg) 0
(if (eq arg '-) -1
(1- arg))))
(push-mark (point))
(if (listp arg);;(normal case) we are yanking from the top
;; of the ring, so we do have to hassle
;; with the X cut buffer.
;;see if cut buffer has changed
(if (not (string-equal
(x-get-cut-buffer)
(car kill-ring-yank-pointer)))
;; yes? then push the new cut buffer contents onto the kill ring
(setq kill-ring (setq kill-ring-yank-pointer
(cons (x-get-cut-buffer) kill-ring)))))
(insert (car kill-ring-yank-pointer))
(if (consp arg)
(exchange-point-and-mark)))
;;; from simple.el
(defun rotate-yank-pointer (arg)
"Rotate the yanking point in the kill ring."
(interactive "p")
(if (not (= 0 arg))
(let ((length (length kill-ring)))
(if (zerop length)
(error "Kill ring is empty")
(setq kill-ring-yank-pointer
(nthcdr (% (+ arg (- length (length kill-ring-yank-pointer)))
length)
kill-ring))
(copy-to-window-system-cut-buffer (car kill-ring-yank-pointer))))))
SHAR_EOF
cat << \SHAR_EOF > header.lisp
;;; -*- Syntax: Common-Lisp; Package: USER; Base: 10; Mode: LISP -*- ;;;
;;; ;;;
;;; Copyright (c) 1989 Cornell Apprentice Project, Cornell University ;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
SHAR_EOF
# End of shell archive
exit 0segre@baal.cs.cornell.edu (Alberto M. Segre) (08/30/89)
# 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
# clisp.el
# This archive created: Fri Aug 18 12:43:10 1989
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 either locally or
remotely in inferior shells. You may run Lucid in one buffer, KCL in
another, Allegro in a third, and BBN Common Lisp in yet a fourth lisp
buffer if you wish.
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 the default 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; prompts for image from table.
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. You may run different
images or even different types of lisps (e.g., KCL vs Lucid vs
Allegro) in the different buffers as per current value of
*clisp-image-table*. Prefix arg to M-C-l specifies the nth image in
the table. A 0 prefix arg starts the default image (which may not even
be in *clisp-image-table*).
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)
C-c t traces current defun in last inferior lisp process
C-c C-t = (C-c t) + (C-c l)
C-c p profile current defun in last inferior lisp process
C-c C-p = (C-c p) + (C-c l)
C-c C-a beginning of current defun
C-c C-e end of current defun
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 ? lists files indexed by (C-c .)
C-c / recomputes lookup table for (C-c .) and (M-C-,)
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
C-c a shows Common Lisp arglist for current function (LUCID ONLY!)
M-q reindents current comment or defun
M-p set package for current buffer
C-c = interactive definition facility (prefix arg inserts separator)
Indentation has been adapted to properly indent the Interlisp-style
FOR macro distributed by segre@cs.cornell.edu; also works reasonably
well for the Zetalisp-style LOOP macro. I also distribute a Common
Lisp profiler if your lisp doesn't have one.
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).
There are some "ksh"-like features available in the inferior lisp buffers:
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 position at previous prompt
C-c C-r search backwards in history
C-c C-s search forward in history
Finally, while running in an inferior lisp buffer, if you position the
point after a previous input to lisp and hit return, the old input
will be copied to the end of the buffer and resubmitted to lisp.
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.
(provide 'clisp)
(defvar *clisp-version* "August 15, 1989")
;;; To use, set your lisp-mode-hook to:
;;; (lambda () (require 'clisp)(start-lisp))
;;; See the "Help" file for an explanation and a list of key bindings.
;;; Authors: Alberto Segre (segre@cs.cornell.edu)
;;; David Hubbell (hubbell@cs.cornell.edu)
;;; Riad Mohammed (mohammed@cs.cornell.edu)
;;; Department of Computer Science
;;; Cornell University
;;; Upson Hall
;;; Ithaca, NY 14853-7501
;;; Copyright (c) 1988, 1989 Alberto M. Segre, David L. Hubbell,
;;; Riad Mohammed.
;;; 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 by David Hubbell
;;; (hubbell@cs.cornell.edu) from code originally written by Wolfgang
;;; Rupprecht (wolfgang@mgm.mit.edu).
;;; A portion of this code was adapted by Riad Mohammed
;;; (mohammed@cs.cornell.edu) from code originally written by Rick
;;; Palmer (rick@cs.cornell.edu).
;;; A portion of this code was adapted by Alberto Segre
;;; (segre@cs.cornell.edu) from code originally written by
;;; Jean-Francois Lamy (lamy@ai.toronto.ca) and Reed Hasting
;;; (hastings@spar.slb.com).
;;; 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.
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; System-dependent variables. You should reset these to whatever is
;;; appropriate on your own system.
;;; Machine for running the lisp process. Defaults to current machine.
(defvar inferior-lisp-host (system-name) "Name of host")
;;; Set the Common Lisp to be the lisp that's run as the default
;;; inferior process. Any Common Lisp will do; we'll set the default
;;; to be Lucid Common Lisp. Non-Common Lisps will not support macro
;;; expansion and documentation search.
(defvar inferior-lisp-program "/usr/local/bin/lisp"
"Lisp program to run.")
;;; String regexps to match the Lisp prompt string for various Common
;;; Lisps.
(defvar *clisp-kcl-prompt* "^[A-Za-z]*>+")
(defvar *clisp-allegro-prompt* "^\\(\\[[0-9]+\\] \\)?<cl> ")
(defvar *clisp-cmu-prompt* "\\*")
(defvar *clisp-bbn-prompt* "^\\([0-9] \\)?[A-Za-z]*\\(-\\|]=\\)>")
;;;(defvar *clisp-lucid-prompt* "^.?> ")
(defvar *clisp-lucid-prompt* "^[--->]*> ")
;;; Inferior lisp prompt. We'll set the default value to be the Lucid
;;; prompt, since the default value for inferior-lisp-program is a
;;; Lucid image.
(defvar inferior-lisp-prompt *clisp-lucid-prompt*
"Lisp prompt string regexp.")
;;; Remote shell program; used for starting a remote inferior lisp.
;;; Most of the time, an installation will have a standard place for
;;; rsh on all systems. In case yours doesn't, you can have this
;;; pointer vary from machine to machine.
(defvar remote-shell-program "/usr/ucb/rsh"
"The program that starts a remote shell.")
;;; Table used to determine which image to run. Each entry has form:
;;; (name lisp-program prompt-string rsh-program) where each of these
;;; four components is eval'd before use (thus (system-name) refers
;;; to the current system).
(defvar *clisp-image-table*
'(("bullwinkle" "/usr/local/bin/lisp"
*clisp-lucid-prompt* "/usr/ucb/rsh")
("bullwinkle" "/usr/local/bin/lisp-pcl"
*clisp-lucid-prompt* "/usr/ucb/rsh")
("bullwinkle" "/usr/local/bin/lisp-clx"
*clisp-lucid-prompt* "/usr/ucb/rsh")
((system-name) "/usr/local/bin/lisp-pcl"
*clisp-lucid-prompt* nil)
((system-name) "/usr/local/bin/lisp-clx"
*clisp-lucid-prompt* nil)
((system-name) "/usr/u/cap/akcl/xbin/kcl"
*clisp-kcl-prompt* nil)
("iron" "/usr/blisp/mach/bin/common-lisp"
*clisp-bbn-prompt* "/usr/ucb/rsh")))
;;; File containing the "message of the day." 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 motd to be displayed in the first lisp buffer.")
;;; Filename extension for lisp files. Set to ".lsp" for KCL or CMU
;;; Lisp, ".cl" for Allegro, while Lucid expects ".lisp" (the default).
(defvar *lisp-filename-extension* ".lisp"
"Extension used to indicate lisp file. Used by tags mechanism.")
;;; Location of temporary filespace. Must be read/writeable by user.
(defvar *clisp-temporary-directory* "/tmp")
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; Utilities to make writing elisp code easier.
(defmacro when (condition &rest body)
(list 'and condition (cons 'progn body)))
(defmacro unless (condition &rest body)
(list 'or condition (cons 'progn body)))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; Load the x-mouse stuff if you're using x-windows.
(cond ((eq window-system 'x)
(load-library "/usr/u/cap/.elisp/xmouse")))
;;; Make sure this is properly set to nil.
(setq parse-sexp-ignore-comments nil)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; Ignore compiled lisp files in filename completion.
(setq completion-ignored-extensions
(append '(".o" ".fasl" ".lbin" ".sbin")
completion-ignored-extensions))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; INFERIOR-LISP-MODE-MAP. Much of this is copied from shell.el;
;;; since we don't need the generality of shell.el we copy just what
;;; we need from there. Establish all of the keybindings for the
;;; inferior lisp process, starting with the basic lisp-mode commands.
(defvar inferior-lisp-mode-map nil)
(unless inferior-lisp-mode-map
(setq inferior-lisp-mode-map (make-sparse-keymap))
(lisp-mode-commands inferior-lisp-mode-map)
(define-key inferior-lisp-mode-map "\C-c\C-c" 'clisp-interrupt-process)
(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)
(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-a" 'clisp-shell-previous-prompt)
(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)
(define-key inferior-lisp-mode-map "]" 'super-close-paren)
(define-key inferior-lisp-mode-map "\C-ca" 'clisp-show-arglist)
(define-key inferior-lisp-mode-map "\C-cf" 'clisp-show-function-documentation)
(define-key inferior-lisp-mode-map "\C-cv" 'clisp-show-variable-documentation))
;;; We also need to modify LISP-MODE-MAP which is set up in
;;; lisp-mode.el; we will add many of the same features of the
;;; inferior-lisp-mode-map to lisp-mode-map as well. Some features in
;;; lisp-mode-map will also need to be removed.
(define-key lisp-mode-map "\M-\C-x" nil)
(define-key lisp-mode-map "]" 'super-close-paren)
(define-key lisp-mode-map "\M-q" 'clisp-reindent-form)
(define-key lisp-mode-map "\M-p" 'clisp-set-package)
(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-ct" 'clisp-trace-defun)
(define-key lisp-mode-map "\C-c\C-t" 'clisp-trace-defun-and-go)
(define-key lisp-mode-map "\C-cp" 'clisp-profile-defun)
(define-key lisp-mode-map "\C-c\C-p" 'clisp-profile-defun-and-go)
(define-key lisp-mode-map "\C-c\C-a" 'beginning-of-defun)
(define-key lisp-mode-map "\C-c\C-e" 'end-of-defun)
(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-c?" 'clisp-list-tag-files)
(define-key lisp-mode-map "\C-c/" 'clisp-recompute-tag-table)
(define-key lisp-mode-map "\C-cm" 'clisp-show-macro-expansion)
(define-key lisp-mode-map "\C-c=" 'clisp-make-template)
(define-key lisp-mode-map "\C-ca" 'clisp-show-arglist)
(define-key lisp-mode-map "\C-cf" 'clisp-show-function-documentation)
(define-key lisp-mode-map "\C-cv" 'clisp-show-variable-documentation)
;;; Make "[" a kind of open paren so that scan-sexps won't ignore it.
(modify-syntax-entry 91 "(" lisp-mode-syntax-table)
;;; Interrupts the lisp job. Normally puts you in a break loop. Copied
;;; from shell.el (this is the only function we really need from
;;; there).
(defun clisp-interrupt-process ()
"Interrupt the lisp process."
(interactive)
(interrupt-process nil t))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; Startup function called on lisp-mode-hook. Sets the
;;; lisp-indent-hook to a function that recognizes Common Lisp forms.
(defun start-lisp ()
"Called by lisp-mode-hook to start lisp."
(save-excursion
(or (get-process "lisp")
(progn (message "Starting lisp...")
(start-lisp-process-and-buffer "*lisp*" nil)
(setq lisp-indent-hook 'common-lisp-indent-hook)
(message "Starting lisp...done.")))))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; Create and switch to a new Lisp process buffer. This will reuse
;;; any killed lisp buffers, or, if none are found, will create a
;;; new lisp buffer.
(defun clisp-create-lisp-buffer (&optional image)
"Create and switch to a new Lisp process buffer."
(interactive "P")
(cond ((setq image
(cond ((and image
(< 0 image)
(>= (length *clisp-image-table*) image))
(nth (1- image) *clisp-image-table*))
((and image (zerop image)) t)
((null image)
(clisp-interactive-image-select *clisp-image-table*))))
(message "Starting new lisp process...")
(let ((lisp-number 1))
(while (and (<= lisp-number (1+ *max-lisp-buffer-number*))
(get-buffer (clisp-number-to-buffer-name lisp-number)))
(setq lisp-number (1+ lisp-number)))
(setq *max-lisp-buffer-number*
(max *max-lisp-buffer-number* lisp-number))
(let ((newbuffername (clisp-number-to-buffer-name lisp-number)))
(mark-edit-buffer (current-buffer))
(save-excursion
(start-lisp-process-and-buffer newbuffername image))
(clisp-buffer-select lisp-number)
(message "Starting new lisp process...done."))))
(t (message "No lisp image selected."))))
;;; Walk through *clisp-image-table* until the user selects one of the
;;; entries.
(defun clisp-interactive-image-select (table)
(when table
(cond ((y-or-n-p (format "Run %s:%s? "
(upcase (eval (nth 0 (car table))))
(eval (nth 1 (car table)))))
(car table))
(t (clisp-interactive-image-select (cdr table))))))
;;; Start up lisp process in a new *lispN* buffer unless the process
;;; already exists. If there is a *clisp-motd-file*, insert it at the
;;; beginning of the buffer. Don't complain if *clisp-motd-file* is
;;; not set. If the image argument is not eq to t, override the default
;;; values of inferior-lisp-program and the like with values from
;;; the image, a *clisp-image-table* entry.
(defun start-lisp-process-and-buffer (buffername image)
(let ((buffer (get-buffer-create buffername))
(processname (substring buffername
1 (1- (length buffername))))
process)
(cond ((null (get-process processname))
(switch-to-buffer buffer)
(erase-buffer)
(make-local-variable 'inferior-lisp-host)
(make-local-variable 'inferior-lisp-program)
(make-local-variable 'inferior-lisp-prompt)
(make-local-variable 'remote-shell-program)
(cond ((eq t image)
(setq inferior-lisp-host
(default-value 'inferior-lisp-host))
(setq inferior-lisp-program
(default-value 'inferior-lisp-program))
(setq inferior-lisp-prompt
(default-value 'inferior-lisp-prompt))
(setq remote-shell-program
(default-value 'remote-shell-program)))
(image (setq inferior-lisp-host (eval (nth 0 image)))
(setq inferior-lisp-program (eval (nth 1 image)))
(setq inferior-lisp-prompt (eval (nth 2 image)))
(setq remote-shell-program (eval (nth 3 image)))))
(cond ((equal inferior-lisp-host (system-name))
(insert "Local lisp host\n\n"))
(t (insert
(format
"Remote lisp host %s\n\n"
(upcase inferior-lisp-host)))))
(when (equal processname "lisp")
(condition-case ()
(insert-file *clisp-motd-file*)
(error nil)))
(mark-lisp-buffer buffer)
(buffer-flush-undo buffer)
(setq process
(cond ((equal inferior-lisp-host (system-name))
(start-process processname
buffername
inferior-lisp-program))
(t (start-process processname
buffername
remote-shell-program
inferior-lisp-host
(format "cd %s ; %s"
default-directory
inferior-lisp-program)))))
(set-process-filter process
'clisp-startup-filter)
(set-process-buffer process
(get-buffer buffername))
(process-kill-without-query process)
(setq major-mode 'inferior-lisp-mode)
(setq mode-name "Inferior Lisp")
(setq mode-line-process '(": %s"))
(use-local-map inferior-lisp-mode-map)))))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; 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. It sets the value of process-mark, which is
;;; subsequently used to output from lisp.
(defun clisp-startup-filter (proc string)
"Startup filter function for inferior lisp process. Looks for first
prompt and switches control thereafter to clisp-filter."
(let ((buffer (process-buffer proc)))
(save-window-excursion
(set-buffer buffer)
(goto-char (point-max))
(cond ((string-match inferior-lisp-prompt string)
(insert string)
(set-marker (process-mark proc) (point))
(set-process-filter proc 'clisp-filter))
(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-DIVERT 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).
;;; CLISP-FILTER also flushes any output that looks like (:GNU-FLUSH
;;; output-sexpr). Note that flushed output cannot be nested inside
;;; trapped (e.g., :GNU-DIVERT) output.
(defun clisp-filter (proc string)
"Filter function for inferior lisp process. Looks for any sexprs output
from process beginning with the atoms :GNU-DIVERT or :GNU-FLUSH and
intercepts them."
(let ((buffer (process-buffer proc)))
(cond ((string-match ":GNU-FLUSH" string)
(set-process-filter proc 'clisp-flushing-filter)
(clisp-flushing-filter proc
(substring string (match-end 0))))
((string-match ":GNU-DIVERT" string)
(set-process-filter proc 'clisp-diverting-filter)
;;; Flush the leading double quote.
(clisp-diverting-filter proc
(substring string
(1+ (string-match
"\""
string
(match-end 0))))))
(t (save-window-excursion
(set-buffer buffer)
(let ((old-point (point)))
(goto-char (process-mark proc))
(insert string)
(set-marker (process-mark proc) (point))
(goto-char (+ (length string) old-point))))))))
;;; 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. Note
;;; that we must still switch buffers, if only to get the proper
;;; inferior-lisp-prompt string.
(defun clisp-diverting-filter (proc string)
"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 ((buffer (process-buffer proc))
prompt-position prompt-end)
(save-window-excursion
(set-buffer buffer)
(setq prompt-position (string-match inferior-lisp-prompt string))
(setq prompt-end (match-end 0)))
(cond (prompt-position
(save-window-excursion
(set-buffer *clisp-diversion-buffer*)
(save-excursion
(goto-char (point-max))
(insert (substring string 0 prompt-position))
;;; Remove the trailing double quote and paren from the backquoted expr.
(and (search-backward "\")" 0 t)
(delete-region (point) (point-max)))
(set-buffer-modified-p nil)))
(display-buffer *clisp-diversion-buffer*)
(set-process-filter proc 'clisp-filter)
(clisp-filter proc (substring string prompt-end)))
(*clisp-diversion-buffer*
(save-window-excursion
(set-buffer *clisp-diversion-buffer*)
(goto-char (point-max))
(insert string))))))
;;; CLISP-FLUSHING-FILTER hijacks the output from process and flushes
;;; it. When it reaches a lisp prompt, it stops flushing output. Note
;;; that we must still switch buffers, if only to get the proper
;;; inferior-lisp-prompt string.
(defun clisp-flushing-filter (proc string)
"Filter function that flushes output from process. When the
inferior-lisp-prompt is found, the process filter is reset to clisp-filter."
(let ((buffer (process-buffer proc))
prompt-position prompt-end)
(save-window-excursion
(set-buffer buffer)
(setq prompt-position (string-match inferior-lisp-prompt string))
(setq prompt-end (match-end 0)))
(when prompt-position
(set-process-filter proc 'clisp-filter)
(clisp-filter proc (substring string prompt-end)))))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; 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)
(unless (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)
(when (equal (substring (buffer-name buffer) 0 5) "*lisp")
(setq *last-lisp-buffer* buffer)))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; Select the appropriate 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")
(cond ((and buffernum
(or (<= buffernum 0)
(> buffernum *max-lisp-buffer-number*)))
(beep)
(message (format "Unknown lisp buffer %s."
(clisp-number-to-buffer-name buffernum))))
(t (let ((buffer-to-select (clisp-find-lisp-buffer buffernum))
lisp-window)
(when buffer-to-select
(mark-edit-buffer (current-buffer))
(mark-lisp-buffer buffer-to-select)
(cond ((setq lisp-window (get-buffer-window buffer-to-select))
(select-window lisp-window))
(t (switch-to-buffer buffer-to-select)))
(goto-char (point-max)))))))
;;; CLISP-FIND-LISP-BUFFER takes a buffernum and returns a pointer to
;;; a lisp buffer. If buffernum does not correspond to a legal lisp buffer,
;;; then CLISP-FIND-BUFFER finds the "next" legal lisp buffer.
(defun clisp-find-lisp-buffer (buffernum)
(let ((buffer-to-select
(cond ((and (not (integerp buffernum))
(buffer-name *last-lisp-buffer*))
*last-lisp-buffer*)
((not (integerp buffernum))
(setq buffernum *max-lisp-buffer-number*) nil)
((and (<= buffernum *max-lisp-buffer-number*)
(> buffernum 0))
(get-buffer (clisp-number-to-buffer-name buffernum)))))
(final-buffer (cond ((or (not (integerp buffernum))
(= 1 buffernum))
*max-lisp-buffer-number*)
(t (- buffernum 1)))))
(unless buffer-to-select
(let ((message (format "Buffer %s not found"
(clisp-number-to-buffer-name buffernum))))
(while (and (not (= buffernum final-buffer))
(not (setq buffer-to-select
(progn
(setq buffernum
(cond ((= *max-lisp-buffer-number*
buffernum) 1)
(t (+ buffernum 1))))
(get-buffer (clisp-number-to-buffer-name
buffernum)))))))
(beep)
(cond (buffer-to-select
(message (format "%s; selecting %s."
message (buffer-name buffer-to-select))))
(t (message (format "%s; no other lisp buffers found."
message))))))
buffer-to-select))
;;; Return to previous edit buffer from Lisp process buffer.
(defun clisp-buffer-deselect ()
"Return to previous edit buffer from Lisp process buffer."
(interactive)
(let (lisp-window)
(cond ((buffer-name *last-edit-buffer*)
(mark-lisp-buffer (current-buffer))
(cond ((setq lisp-window (get-buffer-window *last-edit-buffer*))
(select-window lisp-window))
(t (switch-to-buffer *last-edit-buffer*))))
(t (beep)
(message "The last edit buffer has been killed.")))))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; Sends current buffer to specified Lisp process and evals it.
;;; Defaults to last selected lisp process. If the buffer isn't
;;; modified, load the original file instead.
(defun clisp-eval-buffer (&optional lispnum)
"Sends the current buffer to the Lisp process and evals it."
(interactive "P")
(cond ((buffer-modified-p)
(message "Evaling buffer...")
(save-excursion
(goto-char (point-min))
(clisp-create-temp-file (buffer-string)
(clisp-current-package))
(clisp-load-temp-file t lispnum)
(message "Evaling buffer...done.") t))
(t (clisp-eval-file lispnum))))
;;; Sends current buffer to specified Lisp process, evals it, and
;;; switches to lisp buffer. Defaults to last selected lisp process.
(defun clisp-eval-buffer-and-go (&optional lispnum)
"Send the current buffer to the Lisp process, evals it, and switches
to lisp buffer."
(interactive "P")
(when (clisp-eval-buffer lispnum)
(clisp-buffer-select lispnum)))
;;; Sends current buffer to specified Lisp process and compiles it.
;;; Defaults to last selected lisp process. If the buffer isn't
;;; modified, compile the original file instead.
(defun clisp-compile-buffer (&optional lispnum)
"Sends the current buffer to the Lisp process and compiles it."
(interactive "P")
(cond ((buffer-modified-p)
(message "Compiling buffer...")
(save-excursion
(goto-char (point-min))
(clisp-create-temp-file (buffer-string)
(clisp-current-package))
(clisp-compile-and-load-temp-file t lispnum)
(message "Compiling buffer...done.") t))
(t (clisp-compile-file lispnum))))
;;; Sends current buffer to specified Lisp process, compiles it, and
;;; switches to lisp buffer. Defaults to last selected lisp process.
(defun clisp-compile-buffer-and-go (&optional lispnum)
"Send the current buffer to the Lisp process, compiles it, and switches
to lisp buffer."
(interactive "P")
(when (clisp-compile-buffer lispnum)
(clisp-buffer-select lispnum)))
;;; Sends current region to the specified Lisp process and evals it.
;;; Defaults to last selected lisp process.
(defun clisp-eval-region (&optional lispnum)
"Send the current region to the specified Lisp process and evals it."
(interactive "P")
(cond ((and (mark) (= (mark)(point)))
(message "Null region.") nil)
((mark)
(message "Evaling region...")
(let ((bor (min (point)(mark)))
(eor (max (point)(mark))))
(save-excursion
(goto-char bor)
(clisp-create-temp-file (buffer-substring bor eor)
(clisp-current-package))
(clisp-load-temp-file t lispnum)
(message "Evaling region...done.") t)))
(t (message "No mark set.") nil)))
;;; Sends current region to the specified Lisp process, evals it, and
;;; switches to lisp buffer. Defaults to last selected lisp process.
(defun clisp-eval-region-and-go (&optional lispnum)
"Send the current region to the specified Lisp process, evals it, and
switches to lisp buffer."
(interactive "P")
(when (clisp-eval-region lispnum)
(clisp-buffer-select lispnum)))
;;; Sends current region to the specified Lisp process and compiles it.
;;; Defaults to last selected lisp process.
(defun clisp-compile-region (&optional lispnum)
"Send the current region to the specified Lisp process and evals it."
(interactive "P")
(cond ((and (mark) (= (mark)(point)))
(message "Null region.") nil)
((mark)
(message "Compiling region...")
(let ((bor (min (point)(mark)))
(eor (max (point)(mark))))
(save-excursion
(goto-char bor)
(clisp-create-temp-file (buffer-substring bor eor)
(clisp-current-package))
(clisp-compile-and-load-temp-file t lispnum)
(message "Compiling region...done.") t)))
(t (message "No mark set.") nil)))
;;; Sends current region to the specified Lisp process, compiles it, and
;;; switches to lisp buffer. Defaults to last selected lisp process.
(defun clisp-compile-region-and-go (&optional lispnum)
"Send the current region to the specified Lisp process, compiles it, and
switches to lisp buffer."
(interactive "P")
(when (clisp-compile-region lispnum)
(clisp-buffer-select lispnum)))
;;; Sends current defun to specified Lisp process and evals it.
;;; Defaults to last selected lisp process.
(defun clisp-eval-defun (&optional lispnum)
"Send the current defun to the specified Lisp process and evals it."
(interactive "P")
(message "Evaling defun...")
(when (clisp-send-to-lisp (clisp-extract-defun)
(or lispnum 0)
(clisp-current-package))
(message "Evaling defun...done.") t))
;;; Sends current defun to specified Lisp process, evals it, and
;;; switches to lisp buffer. Defaults to last selected lisp process.
(defun clisp-eval-defun-and-go (&optional lispnum)
"Send the current defun to the specified Lisp process, evals it, and
switches to lisp buffer."
(interactive "P")
(when (clisp-eval-defun lispnum)
(clisp-buffer-select lispnum)))
;;; Sends current defun to the specified Lisp process and compiles it.
;;; Defaults to last selected lisp process.
(defun clisp-compile-defun (&optional lispnum)
"Send the current defun to the specified Lisp process and compiles it."
(interactive "P")
(cond ((defun-p)
(message "Compiling defun...")
(when (clisp-send-to-lisp (format "(progn %s (user::compile '%s))"
(clisp-extract-defun)
(clisp-extract-defun-name))
(or lispnum 0)
(clisp-current-package))
(message "Compiling defun...done.") t))
(t (message "Compiling form...")
(clisp-create-temp-file (clisp-extract-defun)
(clisp-current-package))
(clisp-compile-and-load-temp-file
(clisp-extract-defun-name) lispnum)
(message "Compiling form...done.") t)))
;;; Sends current defun to the specified Lisp process, compiles it,
;;; and switches to lisp buffer. Defaults to last selected lisp
;;; process.
(defun clisp-compile-defun-and-go (&optional lispnum)
"Send the current defun to the specified Lisp process, evals it, and
switches to lisp buffer."
(interactive "P")
(when (clisp-compile-defun lispnum)
(clisp-buffer-select lispnum)))
;;; Sends last sexpr to he specified Lisp process and evals it.
;;; Defaults to last selected lisp process.
(defun clisp-eval-last-sexpr (&optional lispnum)
"Send the last sexpr to the specified Lisp process and evals it."
(interactive "P")
(message "Evaling sexpr...")
(save-excursion
(mark-sexp -1)
(when (clisp-send-to-lisp (buffer-substring (point)(mark))
(or lispnum 0)
(clisp-current-package))
(message "Evaling sexpr...done.") t)))
;;; Sends last sexpr to the specified Lisp process, evals it, and
;;; switches to lisp buffer. Defaults to last selected lisp process.
(defun clisp-eval-last-sexpr-and-go (&optional lispnum)
"Send the last sexp to the specified Lisp process, evals it, and switches
to lisp buffer."
(interactive "P")
(when (clisp-eval-last-sexpr lispnum)
(clisp-buffer-select lispnum)))
;;; Trace the current defun in the specified Lisp process. Defaults to
;;; last selected lisp process.
(defun clisp-trace-defun (&optional lispnum)
"Trace the current defun in the specified Lisp process."
(interactive "P")
(when (defun-p)
(message "Tracing defun...")
(when (clisp-send-to-lisp (format "(user::trace %s)"
(clisp-extract-defun-name))
(or lispnum 0)
(clisp-current-package))
(message "Tracing defun...done.") t)))
;;; Trace the current defun in the specified Lisp process and switches
;;; to lisp buffer. Defaults to last selected lisp process.
(defun clisp-trace-defun-and-go (&optional lispnum)
"Trace the current defun in the specified Lisp process and
switches to lisp buffer."
(interactive "P")
(when (clisp-trace-defun lispnum)
(clisp-buffer-select lispnum)))
;;; Profile the current defun in the specified Lisp process. Defaults
;;; to last selected lisp process.
(defun clisp-profile-defun (&optional lispnum)
"Profile the current defun in the specified Lisp process."
(interactive "P")
(when (defun-p)
(message "Profiling defun...")
(when (clisp-send-to-lisp (format "(user::profile %s)"
(clisp-extract-defun-name))
(or lispnum 0)
(clisp-current-package))
(message "Profiling defun...done.") t)))
;;; Profile the current defun in the specified Lisp process and
;;; switches to lisp buffer. Defaults to last selected lisp process.
(defun clisp-profile-defun-and-go (&optional lispnum)
"Profile the current defun in the specified Lisp process and
switches to lisp buffer."
(interactive "P")
(when (clisp-profile-defun lispnum)
(clisp-buffer-select lispnum)))
;;; Loads the current file in the specified Lisp process. Defaults
;;; to last selected lisp process.
(defun clisp-eval-file (&optional lispnum)
"Loads the current file in the specified Lisp process."
(interactive "P")
(cond ((buffer-modified-p)
(message "Loading ORIGINAL file..."))
(t (message "Loading file...")))
(when (clisp-load-file (buffer-file-name) t (or lispnum 0))
(cond ((buffer-modified-p)
(message "Loading ORIGINAL file...done."))
(t (message "Loading file...done."))) t))
;;; Loads the current file into the specified Lisp process and
;;; switches to lisp buffer. Defaults to last selected lisp process.
(defun clisp-eval-file-and-go (&optional lispnum)
"Loads the current file into the specified Lisp process and
switches to lisp buffer."
(interactive "P")
(when (clisp-eval-file lispnum)
(clisp-buffer-select lispnum)))
;;; Compiles and loads the current file in the specified Lisp process.
;;; Defaults to last selected lisp process.
(defun clisp-compile-file (&optional lispnum)
"Compiles and loads the current file in the specified Lisp process."
(interactive "P")
(cond ((buffer-modified-p)
(message "Compiling ORIGINAL file..."))
(t (message "Compiling file...")))
(when (clisp-compile-and-load-file (buffer-file-name) t (or lispnum 0))
(cond ((buffer-modified-p)
(message "Compiling ORIGINAL file...done."))
(t (message "Compiling file...done."))) t))
;;; Compiles and loads the current file into the specified Lisp process
;;; and switches to lisp buffer. Defaults to last selected lisp process.
(defun clisp-compile-file-and-go (&optional lispnum)
"Compiles and loads the current file into the specified Lisp process and
switches to lisp buffer."
(interactive "P")
(when (clisp-compile-file lispnum)
(clisp-buffer-select lispnum)))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; Temporary file operations. Some items that must be sent to lisp
;;; require the use of the file system. For example, a CLOS defmethod
;;; form is a macro that expands to multiple forms. If it is to be
;;; compiled, it is not sufficient to invoke compile on the name of
;;; the method; rather it should be written to a temporary directory
;;; and the file compiled and loaded.
;;; *CLISP-FILESTEM* will be the filename used for transfers. This
;;; will be a unique value for each incarnation of emacs; thus many users
;;; can share the same temporary directory without fear of nuking each
;;; other's forms.
(defvar *clisp-filestem* (make-temp-name "lsp"))
;;; Removes all files with filestem *clisp-filestem* (regardless of
;;; extension) from the temporary directory. Ideally, we could rm the
;;; temporary file after its loaded and/or compiled and loaded, but to
;;; do that we'd have to have emacs block until lisp is done. This
;;; way, we know there is at most one temp file in the temporary
;;; directory.
(defun clisp-clean-temp-directory ()
(mapcar '(lambda (filename)
(when (string-match *clisp-filestem* filename)
(delete-file (expand-file-name filename
*clisp-temporary-directory*))))
(directory-files *clisp-temporary-directory*)))
;;; Temporary source filename.
(defun clisp-temporary-source ()
(format "%s%s"
(expand-file-name *clisp-filestem*
*clisp-temporary-directory*)
*lisp-filename-extension*))
;;; Creates a temporary source file with the proper package containing
;;; the specified string.
(defun clisp-create-temp-file (string package)
(clisp-clean-temp-directory)
(let ((buffer (create-file-buffer
(clisp-temporary-source))))
(save-window-excursion
(set-buffer buffer)
(insert (format "(in-package \"%s\")\n%s\n" package string))
(append-to-file (point-min)(point-max)(clisp-temporary-source))
(kill-buffer buffer)
*clisp-filestem*)))
;;; Loads source file named filestem from temporary directory into
;;; lisp process lispnum. Returns value in inferior lisp. Note that we
;;; don't need to worry about packages, since the load command is not
;;; going to reset the current package anyway.
(defun clisp-load-temp-file (value lispnum)
(clisp-load-file (clisp-temporary-source) value lispnum))
(defun clisp-load-file (filename value lispnum)
(clisp-send-to-lisp (format "(progn (user::load \"%s\") '%s)"
filename value)
(or lispnum 0)))
;;; Causes lisp process lispnum to compile file named filestem in
;;; temporary directory and load the compiled version. Returns value
;;; in inferior lisp. Again, ignore package manipulations.
(defun clisp-compile-and-load-temp-file (value lispnum)
(clisp-compile-and-load-file (clisp-temporary-source)
(expand-file-name *clisp-filestem*
*clisp-temporary-directory*)
value lispnum))
(defun clisp-compile-and-load-file (filename filename-no-ext value lispnum)
(clisp-send-to-lisp (format
"(progn (user::compile-file \"%s\")(user::load \"%s\") '%s)"
filename filename-no-ext value)
(or lispnum 0)))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; CLISP-SEND-TO-LISP is the low-level function that sends an
;;; expression to a lisp process. Careful to switch lisp to be in the
;;; proper package. Some error checking is done in case the package
;;; given is bogus. Returns t if successful, nil if lisp process does
;;; not exist. Note that if no package is given or if the string
;;; matches "in-package", the string is sent without the package
;;; mechanism. This is important, as otherwise you couldn't send an
;;; in-package form over to lisp!
(defun clisp-send-to-lisp (string lispnum &optional package)
"Send STRING to lisp process LISPNUM. If LISPNUM is zero, send to
*last-lisp-buffer*."
(let ((buffer (get-buffer (clisp-number-to-buffer-name lispnum))))
(cond ((get-buffer-process buffer)
(save-excursion
(cond ((or (null package)
(string-match *clisp-package-switch-regexp* string))
(process-send-string
(clisp-buffer-to-process-name buffer)
(format "%s\n" string)))
(package
(process-send-string
(clisp-buffer-to-process-name buffer)
(format
"`(:GNU-FLUSH ,(format nil \"~A\" (unless (equalp (setq user::*old-package* (package-name user::*package*)) \"%s\")(in-package \"%s\") nil)))\n"
package package))
(process-send-string
(clisp-buffer-to-process-name buffer)
(format
"(prog1 (progn %s)(unless (equalp (package-name user::*package*) user::*old-package*)(in-package user::*old-package*)))\n"
string))))) t)
(t (beep)
(message "Buffer %s not found."
(clisp-number-to-buffer-name lispnum)) nil))))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; Functions to handle Common Lisp packages.
(defvar *clisp-package-switch-regexp* "(in-package")
(defvar *clisp-buffer-package* nil)
(make-variable-buffer-local '*clisp-buffer-package*)
;;; When invoked in a buffer containing Lisp code will determine
;;; package specification in force at point.
(defun clisp-current-package ()
"Returns package for current buffer at point."
(interactive)
(or (clisp-scan-back-for-in-package)
*clisp-buffer-package*
(setq *clisp-buffer-package*
(car (clisp-get-package-name)))))
;;; Sets the package for the current buffer. Defaults to USER.
(defun clisp-set-package (&optional name)
"Sets package for current buffer. Won't change current buffer if no
package name is given. Defaults to package USER."
(interactive "sPackage for current buffer: ")
(make-variable-buffer-local '*clisp-buffer-package*)
(cond ((equal name "")
(unless (cdr (assoc '*clisp-buffer-package*
(buffer-local-variables)))
(setq *clisp-buffer-package* "USER")))
(t (setq *clisp-buffer-package* (upcase name)))))
;;; Looks at the mode line (top line of the buffer) in order to
;;; extract package information.
(defun clisp-get-package-name ()
"Parses modeline for package name."
(save-excursion
(goto-char (point-min))
(let ((end (progn (end-of-line) (point)))
begin
(package-name "USER")
package-use)
(beginning-of-line)
(cond ((search-forward "-*-" end t)
(beginning-of-line)
(cond ((re-search-forward "package." end t)
(clisp-flush-whitespace)
(cond ((char-equal (char-after (point)) ?\( )
(clisp-flush-whitespace)
(setq begin (point))
(setq end (progn (forward-sexp) (point)))
(goto-char (+ begin 1))
(clisp-flush-whitespace)
(setq package-name
(buffer-substring
(point)
(progn (clisp-forward-symbol)
(point))))
(when (search-forward "(" (- end 1) t)
(goto-char (- (point) 1))
(setq package-use
(buffer-substring
(point)
(progn (forward-sexp) (point))))))
(t (setq begin (point))
(clisp-forward-symbol)
(when (char-equal (preceding-char) ?\; )
(forward-char -1))
(setq package-name
(buffer-substring begin (point)))))))))
(cons (upcase package-name) package-use))))
;;; Finds the preceeding in-package command by searching backwards
;;; from current point for an in-package command. Argument to
;;; in-package should be a string or a symbol; if its a symbol it
;;; should be coerced to upper case (a string is read as is).
(defun clisp-scan-back-for-in-package ()
(save-excursion
(let ((parse-sexp-ignore-comments nil))
(when (re-search-backward "( *in-package" (point-min) t)
(forward-char 1)
(clisp-flush-whitespace)
(clisp-forward-symbol)
(clisp-flush-whitespace)
(cond ((looking-at "'")
(forward-char 1)
(upcase (buffer-substring (point)
(progn (clisp-forward-symbol)
(point)))))
((looking-at "\"")
(forward-char 1)
(buffer-substring (point)
(progn (while (not (looking-at "\""))
(clisp-forward-char))
(point)))))))))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; 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 (format "etags *%s" *lisp-filename-extension*))
(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 argument list of the current
;;; form. Send a backquoted form to current Lisp for evaluation, where
;;; the header of the form tells GNU to intercept it. WARNING: This
;;; function is LUCID-SPECIFIC. KCL and Allegro show the argument list
;;; as part of the function documentation (more in line with CLtL),
;;; but Lucid fails to implement the documentation function specified
;;; by CLtL.
(defun clisp-show-arglist (&optional lispnum)
"Show Common Lisp argument list for current sexpr in temporary
buffer. WARNING: Lucid-specific."
(interactive "P")
(message "Computing arglist...")
(let ((fnname (clisp-extract-function-name)))
(save-window-excursion
(setq *clisp-diversion-buffer*
(get-buffer-create "*Documentation Buffer*"))
(set-buffer *clisp-diversion-buffer*)
(erase-buffer)
(insert (format "%s: " (upcase fnname))))
(save-excursion
(clisp-send-to-lisp
(format "`(:GNU-DIVERT ,(let ((*print-pretty* t))
(format nil \"~A\" (user::arglist '%s))))\n" fnname)
(or lispnum 0)
(clisp-current-package))
(message "Computing arglist...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 (&optional lispnum)
"Look for first symbol name before point and show its documentation."
(interactive "P")
(clisp-show-documentation 'function lispnum))
(defun clisp-show-variable-documentation (&optional lispnum)
"Look for first symbol name before point and show its documentation"
(interactive "P")
(clisp-show-documentation 'variable lispnum))
;;; 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. The documentation shown is whatever is returned by
;;; the Common Lisp DOCUMENTATION function.
(defun clisp-show-documentation (symtype lispnum)
"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)
(clisp-send-to-lisp
(format
"`(:GNU-DIVERT ,(let ((*print-pretty* t))
(format nil \"~A\"
(cond ((boundp (intern \"%s\"))
(eval (intern \"%s\")))
(t \"Unbound\")))))\n"
symname symname symname)
(or lispnum 0)
(clisp-current-package)))
(clisp-send-to-lisp
(format
"`(:GNU-DIVERT ,(format nil \"~2%%~A\"
(user::documentation '%s '%s)))\n"
symname symtype symname)
(or lispnum 0)
(clisp-current-package))
(message "Fetching documentation...done.")
(sit-for 1)
(message "Type C-x 1 to remove documentation window."))))
;;; 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 (&optional lispnum)
"Show Common Lisp macro expansion for current sexpr in temporary buffer."
(interactive "P")
(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
(clisp-send-to-lisp
(format "`(:GNU-DIVERT ,(let ((*print-pretty* t))
(format nil \"~A\"
(user::macroexpand-1 '%s))))\n"
(clisp-extract-sexpr))
(or lispnum 0)
(clisp-current-package))
(message "Computing macro expansion...done.")))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; Utility functions for showing macro expansion and Common Lisp
;;; definition information.
;;; CLISP-FLUSH-WHITESPACE moves point up until it's looking at something
;;; interesting (e.g., non-blank).
(defun clisp-flush-whitespace ()
(while (looking-at " ")
(forward-char 1)))
;;; CLISP-FORWARD-CHAR moves point forward one character at a time,
;;; taking into account the "\" escape character, which causes point
;;; to move up two characters instead.
(defun clisp-forward-char ()
"Moves forward one character from a Common Lisp symbol."
(cond ((char-equal (following-char) ?\\ )(forward-char 2))
(t (forward-char 1))))
;;; CLISP-FORWARD-SYMBOL moves the point forward one Common Lisp
;;; symbol. Common Lisp allows all sorts of strange things in a
;;; symbol; GNUemacs' idea of a word is not the same as Common Lisp's
;;; idea of a symbol. All sorts of special terminators have to be
;;; accounted for.
(defun clisp-forward-symbol ()
"Moves point forward one Common Lisp symbol."
(clisp-flush-whitespace)
(when (looking-at "|")
(clisp-forward-char)
(while (not (looking-at "|"))
(clisp-forward-char)))
(while (not (or (looking-at " ")
(looking-at "(")
(looking-at ")")
(looking-at "'")
(looking-at "`")
(looking-at "
")))
(clisp-forward-char)))
;;; Returns a string like "defun", "defmethod", "defstruct", etc.
;;; indicating what kind of defun form you're in.
(defun clisp-defun-type ()
"Returns the type of the current defun-like form."
(save-excursion
(when (looking-at "(")
(forward-char 1))
(beginning-of-defun)
(forward-char 1)
(let ((begin (point)))
(clisp-forward-symbol)
(downcase (buffer-substring begin (point))))))
;;; Checks if you're in a defun.
(defmacro defun-p ()
(list 'string-equal "defun" '(clisp-defun-type)))
;;; Extracts the current defun-like form. Note that if you are at
;;; beginning left-paren, you must forward one char or run the risk of
;;; getting the previous defun.
(defun clisp-extract-defun ()
"Returns current defun-like form."
(save-excursion
(when (looking-at "(")
(forward-char 1))
(beginning-of-defun)
(let ((begin (point)))
(end-of-defun)
(buffer-substring begin (point)))))
;;; Returns the function name of current defun. Note that if you are at
;;; beginning left-paren, you must forward one char or run the risk of
;;; getting the previous defun.
(defun clisp-extract-defun-name ()
"Returns the function name of current defun."
(save-excursion
(when (looking-at "(")
(forward-char 1))
(beginning-of-defun)
(forward-char 1)
(forward-sexp 1)
(clisp-flush-whitespace)
(buffer-substring (point)
(progn (clisp-forward-symbol) (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)))))
;;; Returns the name string for the given lisp buffer.
(defun clisp-number-to-buffer-name (buffernum)
(cond ((zerop buffernum) *last-lisp-buffer*)
((= buffernum 1) "*lisp*")
(t (format "*lisp%d*" buffernum))))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; 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))
(lisp-indent-line)
(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 ""))))
;;; BEGINNING-OF-COMMENT and END-OF-COMMENT move the point to the beginning
;;; and end of the commented section, respectively.
(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 'while 'common-lisp-indent-hook 'lisp-indent-for)
(put 'until '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)
;;; LISP-INDENT-FOR also works pretty well for the Zeta-lisp LOOP
;;; macro, currently before the ANSI Common Lisp committee as a
;;; proposed standard.
(put 'loop 'common-lisp-indent-hook 'lisp-indent-for)
(setq lisp-indent-maximum-backtracking 6)
;;; Other Common Lisp forms.
(put 'merge 'common-lisp-indent-hook 1)
(put 'defclass 'common-lisp-indent-hook 'defun)
(put 'defmacro 'common-lisp-indent-hook 'defun)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; 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 "]"))
((when (> (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.
(when (equal openpos lastopenpos)
(setq openpos nil)
(when (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.
(when mismatch
;;; 91 is the character code for open bracket
(when (= 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))))))))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; This part of the file provides an interactive template-based
;;; definition facility. Prompts the user for the different parts of
;;; each definition. Adapted by Riad Mohammed
;;; (mohammed@cs.cornell.edu) from code originally written by Rick
;;; Palmer (rick@cs.cornell.edu).
;;; *TEMPLATE-ALIST* describes the types of templates this facility
;;; knows about. The car is the type of the thing being defined, while
;;; the cdr is a string that is concatenated with "def" to get the
;;; defining form.
(defvar *template-alist* '(("function" . "un")
("macro" . "macro")
("structure" . "struct")
("variable" . "var")
("constant" . "constant")
("parameter" . "parameter")
("class" . "class")
("generic" . "generic")
("method" . "method")))
;;; If set to t, then *clisp-separator-string* will be placed before
;;; every template. If set to nil, then *clisp-separator-string* will
;;; be set only if a prefix argument is given to clisp-make-template.
(defvar *clisp-default-separate* nil)
;;; Sets width (in characters) of the separator and header. Defaults
;;; to 74 (+ the leading ";;;").
(defvar *clisp-separator-width* 74)
(defvar *clisp-separator-character* ?;)
(defvar *clisp-separator-string*
(format "\n;;;%s\n" (make-string *clisp-separator-width*
*clisp-separator-character*)))
(defvar *clisp-default-doc-string* "Undocumented.")
;;; The following strings are used to define the template.
(defvar *clisp-header-string* (concat ";;; %s: %s%sAuthor: "
(user-login-name)
"\n;;; Created: %s\n\n"))
(defvar *clisp-defn-string* "(def%s %s")
;;; CLISP-TEMPLATE-GET-TYPE returns a consed pair from
;;; *template-alist* with the type and the letters required following
;;; "def" to define type.
(defun clisp-template-get-type ()
(let* ((type (completing-read "Type? " *template-alist* nil t)))
(cond ((= (length type) 0) '("function" . "un"))
(t (assoc type *template-alist*)))))
;;; CLISP-PROMPT-USER prompts the user with prompt-string in the
;;; minibuffer and accepts a reply. If reply is not equal to
;;; null-reply, it is returned; else default is returned.
(defun clisp-prompt-user (prompt-string &optional null-reply default)
(let ((reply (read-string prompt-string)))
(cond ((string= reply null-reply) default)
(t reply))))
;;; CLISP-MAKE-TEMPLATE does the brunt of the work setting up the
;;; template. If called with a prefix arg (or if
;;; *clisp-default-separate* is t), the *clisp-separator* (initially a row
;;; of semicolons) is inserted before the template.
(defun clisp-make-template (&optional separate)
"Creates a template interactively for the appropriate defun, defvar,
defconstant, defparamater, defstruct, defclass, or defmethod."
(interactive "P")
(let ((type (clisp-template-get-type)) postfix header)
(setq postfix (cdr type))
(setq type (car type))
(let ((name (clisp-prompt-user (concat (capitalize type) " name? ")
""
(upcase (concat "UNNAMED-" (upcase type))))))
(or (bolp)
(progn (end-of-line 1)
(insert "\n")))
(insert "\n")
(setq header
(concat
(cond ((or separate *clisp-default-separate*)
*clisp-separator-string*)
(t ""))
(format *clisp-header-string*
(capitalize type)
(upcase name)
(make-string (- *clisp-separator-width*
(+ 19 (length type)(length name)))
?\ )
(current-time-string))
(format *clisp-defn-string* postfix name)))
(cond ((string= type "function")
(clisp-make-function-template name header))
((or (string= type "variable")
(string= type "constant")
(string= type "parameter"))
(clisp-make-variable-template name header))
((string= type "macro")
(clisp-make-macro-template name header))
((string= type "structure")
(clisp-make-structure-template name header))
((string= type "class")
(clisp-make-class-template name header))
((string= type "generic")
(clisp-make-generic-template name header))
((string= type "method")
(clisp-make-method-template name header))))))
;;; Each of the following functions writes out the proper template for
;;; a particular type of defining form.
(defun clisp-make-function-template (name header)
(let ((args (clisp-prompt-user "Arguments? "))
(doc (clisp-prompt-user "Documentation? " ""
*clisp-default-doc-string*)))
(insert header)
(insert (format " (%s) \n\"%s\"\n)" args doc))
(clisp-reindent-form)
(backward-char 1)))
(defun clisp-make-macro-template (name header)
(let ((args (clisp-prompt-user "Arguments? "))
(doc (clisp-prompt-user "Documentation? " ""
*clisp-default-doc-string*)))
(insert header)
(insert (format " (%s) \n\"%s\"\n)" args doc))
(clisp-reindent-form)
(backward-char 1)))
(defun clisp-make-variable-template (name header)
(let ((value (clisp-prompt-user "Value? " "" "nil"))
(doc (clisp-prompt-user "Documentation? " ""
*clisp-default-doc-string*)))
(insert header)
(insert (format " %s \"%s\")" value doc))))
(defun clisp-make-structure-template (name header)
(let ((slots (clisp-prompt-user "Slots? "))
(doc (clisp-prompt-user "Documentation? " ""
*clisp-default-doc-string*)))
(insert header)
(or (string= doc *clisp-default-doc-string*)
(progn (beginning-of-line)
(insert (format ";;; %s" doc))
(clisp-reindent-form)
(insert "\n\n")
(end-of-line 1)))
(let ((index 0))
(while (< index (length slots))
(setq index (read-from-string slots index))
(newline-and-indent)
(insert (format " %s" (car index)))
(setq index (cdr index))))
(insert ")")
(backward-char 1)
(clisp-reindent-form)
(end-of-line)))
(defun clisp-make-class-template (name header)
(let ((supers (clisp-prompt-user "Supers? "))
(slots (clisp-prompt-user "Slots? "))
(doc (clisp-prompt-user "Documentation? " ""
*clisp-default-doc-string*)))
(insert header)
(insert (format " (%s)\n ()\n" supers))
(backward-char 2)
(clisp-add-slots slots)
(forward-char 1)
(insert (format "\n (:documentation \"%s\"))\n" doc))
(clisp-reindent-form)
(end-of-line)
(insert "\n")
(insert
(format
"(defun make-%s ()\n (let ((self (make-instance '%s)))\n self))\n\n"
name name))
(clisp-reindent-form)
(insert
(format
"(defmacro %s-p (self)\n`(eq (class-name (class-of ,self)) '%s))\n"
name name))
(clisp-reindent-form)))
(defun clisp-add-slot (var-name var-val)
(insert (format "(%s :initform %s :initarg :%s :accessor %s-%s)\n "
var-name var-val var-name name var-name)))
(defun clisp-add-slots (slot-specifications)
(unless (zerop (length slots))
(let ((index 0) var-name var-val)
(while (< index (length slots))
(setq index (read-from-string slots index))
(setq var-name (car index))
(setq var-val "nil")
(and (consp var-name)
(progn (setq var-val (car (cdr var-name)))
(setq var-name (car var-name))))
(setq index (cdr index))
(clisp-add-slot var-name var-val))
(delete-char -2))))
(defun clisp-make-generic-template (name header)
(let ((args (clisp-prompt-user "Arguments? "))
(doc (clisp-prompt-user "Documentation? " ""
*clisp-default-doc-string*)))
(insert header)
(insert (format " (%s)\n#+CLOS (:documentation \"%s\")\n )" args doc))
(backward-char 1)
(clisp-reindent-form)
(forward-char 2)))
(defun clisp-make-method-template (name header)
(let ((classes (clisp-prompt-user "Class(es)? "))
(doc (clisp-prompt-user "Documentation? " ""
*clisp-default-doc-string*)))
(insert header)
(insert " (")
(clisp-add-class-specifiers classes)
(insert (format ")\n \"%s\"\n)" doc))
(clisp-reindent-form)
(backward-char 1)))
(defun clisp-add-class-specifiers (classes)
(unless (zerop (length classes))
(let ((index 0) name)
(while (< index (length classes))
(setq index (read-from-string classes index))
(setq name (car index))
(setq index (cdr index))
(insert (format "(%s %s)\n " name name)))
(delete-char -2))))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; Part of the remainder of this file was adapted by David
;;; Hubbell (hubbell@svax.cs.cornell.edu) from code
;;; written by Wolfgang Rupprecht (wolfgang@mgm.mit.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 walks back the history list, placing
;;; the entry at the current buffer position. If repeated, it replaces
;;; the last history entry with the previous entry (if one exists).
;;; Successive calls to CLISP-SHELL-PREVIOUS-COMMAND therefore produce
;;; successively older entries in the history list. Note that if you
;;; aren't past the last prompt, it puts you at point-max.
(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 (%d entries)"
(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-PREVIOUS-PROMPT positions the point at the beginning
;;; of the current line but after the prompt, if any.
(defun clisp-shell-previous-prompt ()
(interactive)
(beginning-of-line)
(re-search-forward inferior-lisp-prompt
(save-excursion (end-of-line)
(point)) t))
;;; 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* ((index (- history-length clisp-shell-history-index 1))
(history-length (length clisp-shell-history-list))
(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 (start end)
"Save this command on the clisp-shell-history-list."
(let ((command (buffer-substring start 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, if after the last prompt, 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
;;; before last prompt, copies current line to the end of the buffer
;;; and sends it (if it was an s-expression).
(defun clisp-shell-send-input-if-sexpr ()
"Send input to subshell if the last input was an s-expression."
(interactive)
(let* ((proc (get-buffer-process (current-buffer)))
(old-mark (marker-position (process-mark proc)))
(current (point))
start end)
(or proc (error "Current buffer has no process"))
;;; If not at past the last process mark, copy everything from the
;;; last prompt to the end of buffer and treat that as the input
;;; region.
(save-excursion
(when (> old-mark current)
(setq end current)
(setq start
(save-excursion
(condition-case ()
(scan-sexps (point) -1)
(error nil))))
(goto-char (point-max))
(insert (buffer-substring start end))
(setq current (point)))
;;; Send all complete s-expressions after the process mark and before
;;; the current point to the lisp process as possible.
(goto-char (setq start old-mark))
(while (and (setq end (condition-case ()
(scan-sexps start 1)
(error nil)))
(<= end current))
(clisp-shell-save-history start end)
(setq start end))
;;; If there is a partial sexpr, go to beginning of that sexpr and
;;; process complete sexprs before it. Leaves point at end of buffer.
;;; If there are no complete sexprs, just insert the newline wherever
;;; you were.
(cond ((= start old-mark)
(goto-char current)
(newline))
(t (goto-char start)
(newline)
(move-marker (process-mark proc) (setq end (point)))
(process-send-region proc old-mark end))))
(goto-char (point-max))))
SHAR_EOF
# End of shell archive
exit 0